steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

vm: remove primitive table, non-optimizing compiler now looks up primitives with dlsym()

db4
Slava Pestov 2010-01-19 20:00:33 +13:00
parent 8836ce2581
commit 5606825e8b
16 changed files with 329 additions and 492 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/compiler/codegen/fixup/fixup.factor
View File

@ -70,9 +70,6 @@ MEMO: cached-string>symbol ( symbol -- obj ) string>symbol ;
: rel-word-pic-tail ( word class -- ) : rel-word-pic-tail ( word class -- )
[ add-literal ] dip rt-entry-point-pic-tail rel-fixup ; [ add-literal ] dip rt-entry-point-pic-tail rel-fixup ;
: rel-primitive ( word class -- )
[ def>> first add-parameter ] dip rt-primitive rel-fixup ;
: rel-immediate ( literal class -- ) : rel-immediate ( literal class -- )
[ add-literal ] dip rt-literal rel-fixup ; [ add-literal ] dip rt-literal rel-fixup ;

6
basis/compiler/compiler.factor
View File

@ -32,7 +32,6 @@ SYMBOL: compiled
[ "forgotten" word-prop ] [ "forgotten" word-prop ]
[ compiled get key? ] [ compiled get key? ]
[ inlined-block? ] [ inlined-block? ]
[ primitive? ]
} 1|| not ; } 1|| not ;
: queue-compile ( word -- ) : queue-compile ( word -- )
@ -126,7 +125,10 @@ M: word combinator? inline? ;
} cond ; } cond ;
: optimize? ( word -- ? ) : optimize? ( word -- ? )
single-generic? not ; {
[ single-generic? ]
[ primitive? ]
} 1|| not ;
: contains-breakpoints? ( -- ? ) : contains-breakpoints? ( -- ? )
dependencies get keys [ "break?" word-prop ] any? ; dependencies get keys [ "break?" word-prop ] any? ;

25
basis/compiler/constants/constants.factor
View File

@ -47,19 +47,18 @@ CONSTANT: rc-indirect-arm-pc 9
CONSTANT: rc-absolute-2 10 CONSTANT: rc-absolute-2 10
! Relocation types ! Relocation types
CONSTANT: rt-primitive 0 CONSTANT: rt-dlsym 0
CONSTANT: rt-dlsym 1 CONSTANT: rt-entry-point 1
CONSTANT: rt-entry-point 2 CONSTANT: rt-entry-point-pic 2
CONSTANT: rt-entry-point-pic 3 CONSTANT: rt-entry-point-pic-tail 3
CONSTANT: rt-entry-point-pic-tail 4 CONSTANT: rt-here 4
CONSTANT: rt-here 5 CONSTANT: rt-this 5
CONSTANT: rt-this 6 CONSTANT: rt-literal 6
CONSTANT: rt-literal 7 CONSTANT: rt-untagged 7
CONSTANT: rt-untagged 8 CONSTANT: rt-megamorphic-cache-hits 8
CONSTANT: rt-megamorphic-cache-hits 9 CONSTANT: rt-vm 9
CONSTANT: rt-vm 10 CONSTANT: rt-cards-offset 10
CONSTANT: rt-cards-offset 11 CONSTANT: rt-decks-offset 11
CONSTANT: rt-decks-offset 12
: rc-absolute? ( n -- ? ) : rc-absolute? ( n -- ? )
${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ; ${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;

2
basis/cpu/ppc/bootstrap.factor
View File

@ -125,7 +125,7 @@ CONSTANT: ctx-reg 16
[ [
jit-save-context jit-save-context
3 vm-reg MR 3 vm-reg MR
0 4 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel 0 4 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel
4 MTLR 4 MTLR
BLRL BLRL
jit-restore-context jit-restore-context

2
basis/cpu/x86/32/bootstrap.factor
View File

@ -59,7 +59,7 @@ IN: bootstrap.x86
jit-save-context jit-save-context
! call the primitive ! call the primitive
ESP [] vm-reg MOV ESP [] vm-reg MOV
0 CALL rc-relative rt-primitive jit-rel 0 CALL rc-relative rt-dlsym jit-rel
! restore ds, rs registers ! restore ds, rs registers
jit-restore-context jit-restore-context
] jit-primitive jit-define ] jit-primitive jit-define

2
basis/cpu/x86/64/bootstrap.factor
View File

@ -56,7 +56,7 @@ IN: bootstrap.x86
jit-save-context jit-save-context
! call the primitive ! call the primitive
arg1 vm-reg MOV arg1 vm-reg MOV
RAX 0 MOV rc-absolute-cell rt-primitive jit-rel RAX 0 MOV rc-absolute-cell rt-dlsym jit-rel
RAX CALL RAX CALL
jit-restore-context jit-restore-context
] jit-primitive jit-define ] jit-primitive jit-define

2
basis/stack-checker/known-words/known-words.factor
View File

@ -648,6 +648,8 @@ M: bad-executable summary
\ fseek { alien integer integer } { } define-primitive \ fseek { alien integer integer } { } define-primitive
\ ftell { alien } { integer } define-primitive
\ fclose { alien } { } define-primitive \ fclose { alien } { } define-primitive
\ <wrapper> { object } { wrapper } define-primitive \ <wrapper> { object } { wrapper } define-primitive

9
basis/tools/annotations/annotations-tests.factor
View File

@ -1,5 +1,5 @@
USING: tools.test tools.annotations tools.time math parser eval USING: tools.test tools.annotations tools.time math parser eval
io.streams.string kernel strings ; io.streams.string kernel strings sequences memory ;
IN: tools.annotations.tests IN: tools.annotations.tests
: foo ( -- ) ; : foo ( -- ) ;
@ -60,3 +60,10 @@ M: object my-generic ;
f my-generic drop ; f my-generic drop ;
[ ] [ some-code ] unit-test [ ] [ some-code ] unit-test
! Make sure annotations work on primitives
\ gc watch
[ f ] [ [ gc ] with-string-writer empty? ] unit-test
\ gc reset

342
core/bootstrap/primitives.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2004, 2009 Slava Pestov. ! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays byte-arrays generic hashtables USING: alien alien.strings arrays byte-arrays generic hashtables
hashtables.private io kernel math math.private math.order hashtables.private io io.encodings.ascii kernel math
namespaces make parser sequences strings vectors words math.private math.order namespaces make parser sequences strings
quotations assocs layouts classes classes.builtin classes.tuple vectors words quotations assocs layouts classes classes.builtin
classes.tuple.private kernel.private vocabs vocabs.loader classes.tuple classes.tuple.private kernel.private vocabs
source-files definitions slots classes.union vocabs.loader source-files definitions slots classes.union
classes.intersection classes.predicate compiler.units classes.intersection classes.predicate compiler.units
bootstrap.image.private io.files accessors combinators ; bootstrap.image.private io.files accessors combinators ;
IN: bootstrap.primitives IN: bootstrap.primitives
@ -309,7 +309,11 @@ tuple
! Sub-primitive words ! Sub-primitive words
: make-sub-primitive ( word vocab effect -- ) : make-sub-primitive ( word vocab effect -- )
[ create dup 1quotation ] dip define-declared ; [
create
dup t "primitive" set-word-prop
dup 1quotation
] dip define-declared ;
{ {
{ "mega-cache-lookup" "generic.single.private" (( methods index cache -- )) } { "mega-cache-lookup" "generic.single.private" (( methods index cache -- )) }
@ -364,169 +368,173 @@ tuple
} [ first3 make-sub-primitive ] each } [ first3 make-sub-primitive ] each
! Primitive words ! Primitive words
: make-primitive ( word vocab n effect -- ) : make-primitive ( word vocab function effect -- )
[ [
[ create dup reset-word ] dip [
[ do-primitive ] curry create
dup reset-word
dup t "primitive" set-word-prop
] dip
ascii string>alien [ do-primitive ] curry
] dip define-declared ; ] dip define-declared ;
{ {
{ "bignum>fixnum" "math.private" (( x -- y )) } { "<callback>" "alien" "primitive_callback" (( return-rewind word -- alien )) }
{ "float>fixnum" "math.private" (( x -- y )) } { "<displaced-alien>" "alien" "primitive_displaced_alien" (( displacement c-ptr -- alien )) }
{ "fixnum>bignum" "math.private" (( x -- y )) } { "alien-address" "alien" "primitive_alien_address" (( c-ptr -- addr )) }
{ "float>bignum" "math.private" (( x -- y )) } { "alien-cell" "alien.accessors" "primitive_alien_cell" (( c-ptr n -- value )) }
{ "fixnum>float" "math.private" (( x -- y )) } { "alien-double" "alien.accessors" "primitive_alien_double" (( c-ptr n -- value )) }
{ "bignum>float" "math.private" (( x -- y )) } { "alien-float" "alien.accessors" "primitive_alien_float" (( c-ptr n -- value )) }
{ "(string>float)" "math.parser.private" (( str -- n/f )) } { "alien-signed-1" "alien.accessors" "primitive_alien_signed_1" (( c-ptr n -- value )) }
{ "(float>string)" "math.parser.private" (( n -- str )) } { "alien-signed-2" "alien.accessors" "primitive_alien_signed_2" (( c-ptr n -- value )) }
{ "float>bits" "math" (( x -- n )) } { "alien-signed-4" "alien.accessors" "primitive_alien_signed_4" (( c-ptr n -- value )) }
{ "double>bits" "math" (( x -- n )) } { "alien-signed-8" "alien.accessors" "primitive_alien_signed_8" (( c-ptr n -- value )) }
{ "bits>float" "math" (( n -- x )) } { "alien-signed-cell" "alien.accessors" "primitive_alien_signed_cell" (( c-ptr n -- value )) }
{ "bits>double" "math" (( n -- x )) } { "alien-unsigned-1" "alien.accessors" "primitive_alien_unsigned_1" (( c-ptr n -- value )) }
{ "fixnum/i" "math.private" (( x y -- z )) } { "alien-unsigned-2" "alien.accessors" "primitive_alien_unsigned_2" (( c-ptr n -- value )) }
{ "fixnum/mod" "math.private" (( x y -- z w )) } { "alien-unsigned-4" "alien.accessors" "primitive_alien_unsigned_4" (( c-ptr n -- value )) }
{ "fixnum-shift" "math.private" (( x y -- z )) } { "alien-unsigned-8" "alien.accessors" "primitive_alien_unsigned_8" (( c-ptr n -- value )) }
{ "bignum=" "math.private" (( x y -- ? )) } { "alien-unsigned-cell" "alien.accessors" "primitive_alien_unsigned_cell" (( c-ptr n -- value )) }
{ "bignum+" "math.private" (( x y -- z )) } { "set-alien-cell" "alien.accessors" "primitive_set_alien_cell" (( value c-ptr n -- )) }
{ "bignum-" "math.private" (( x y -- z )) } { "set-alien-double" "alien.accessors" "primitive_set_alien_double" (( value c-ptr n -- )) }
{ "bignum*" "math.private" (( x y -- z )) } { "set-alien-float" "alien.accessors" "primitive_set_alien_float" (( value c-ptr n -- )) }
{ "bignum/i" "math.private" (( x y -- z )) } { "set-alien-signed-1" "alien.accessors" "primitive_set_alien_signed_1" (( value c-ptr n -- )) }
{ "bignum-mod" "math.private" (( x y -- z )) } { "set-alien-signed-2" "alien.accessors" "primitive_set_alien_signed_2" (( value c-ptr n -- )) }
{ "bignum/mod" "math.private" (( x y -- z w )) } { "set-alien-signed-4" "alien.accessors" "primitive_set_alien_signed_4" (( value c-ptr n -- )) }
{ "bignum-bitand" "math.private" (( x y -- z )) } { "set-alien-signed-8" "alien.accessors" "primitive_set_alien_signed_8" (( value c-ptr n -- )) }
{ "bignum-bitor" "math.private" (( x y -- z )) } { "set-alien-signed-cell" "alien.accessors" "primitive_set_alien_signed_cell" (( value c-ptr n -- )) }
{ "bignum-bitxor" "math.private" (( x y -- z )) } { "set-alien-unsigned-1" "alien.accessors" "primitive_set_alien_unsigned_1" (( value c-ptr n -- )) }
{ "bignum-bitnot" "math.private" (( x -- y )) } { "set-alien-unsigned-2" "alien.accessors" "primitive_set_alien_unsigned_2" (( value c-ptr n -- )) }
{ "bignum-shift" "math.private" (( x y -- z )) } { "set-alien-unsigned-4" "alien.accessors" "primitive_set_alien_unsigned_4" (( value c-ptr n -- )) }
{ "bignum<" "math.private" (( x y -- ? )) } { "set-alien-unsigned-8" "alien.accessors" "primitive_set_alien_unsigned_8" (( value c-ptr n -- )) }
{ "bignum<=" "math.private" (( x y -- ? )) } { "set-alien-unsigned-cell" "alien.accessors" "primitive_set_alien_unsigned_cell" (( value c-ptr n -- )) }
{ "bignum>" "math.private" (( x y -- ? )) } { "(dlopen)" "alien.libraries" "primitive_dlopen" (( path -- dll )) }
{ "bignum>=" "math.private" (( x y -- ? )) } { "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) }
{ "bignum-bit?" "math.private" (( n x -- ? )) } { "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) }
{ "bignum-log2" "math.private" (( x -- n )) } { "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) }
{ "byte-array>bignum" "math" (( x -- y )) } { "<array>" "arrays" "primitive_array" (( n elt -- array )) }
{ "float=" "math.private" (( x y -- ? )) } { "resize-array" "arrays" "primitive_resize_array" (( n array -- newarray )) }
{ "float+" "math.private" (( x y -- z )) } { "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" (( n -- byte-array )) }
{ "float-" "math.private" (( x y -- z )) } { "<byte-array>" "byte-arrays" "primitive_byte_array" (( n -- byte-array )) }
{ "float*" "math.private" (( x y -- z )) } { "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" (( n byte-array -- newbyte-array )) }
{ "float/f" "math.private" (( x y -- z )) } { "<tuple-boa>" "classes.tuple.private" "primitive_tuple_boa" (( ... layout -- tuple )) }
{ "float-mod" "math.private" (( x y -- z )) } { "<tuple>" "classes.tuple.private" "primitive_tuple" (( layout -- tuple )) }
{ "float<" "math.private" (( x y -- ? )) } { "modify-code-heap" "compiler.units" "primitive_modify_code_heap" (( alist -- )) }
{ "float<=" "math.private" (( x y -- ? )) } { "lookup-method" "generic.single.private" "primitive_lookup_method" (( object methods -- method )) }
{ "float>" "math.private" (( x y -- ? )) } { "mega-cache-miss" "generic.single.private" "primitive_mega_cache_miss" (( methods index cache -- method )) }
{ "float>=" "math.private" (( x y -- ? )) } { "(exists?)" "io.files.private" "primitive_existsp" (( path -- ? )) }
{ "float-u<" "math.private" (( x y -- ? )) } { "(fopen)" "io.streams.c" "primitive_fopen" (( path mode -- alien )) }
{ "float-u<=" "math.private" (( x y -- ? )) } { "fclose" "io.streams.c" "primitive_fclose" (( alien -- )) }
{ "float-u>" "math.private" (( x y -- ? )) } { "fflush" "io.streams.c" "primitive_fflush" (( alien -- )) }
{ "float-u>=" "math.private" (( x y -- ? )) } { "fgetc" "io.streams.c" "primitive_fgetc" (( alien -- ch/f )) }
{ "(word)" "words.private" (( name vocab -- word )) } { "fputc" "io.streams.c" "primitive_fputc" (( ch alien -- )) }
{ "word-code" "words" (( word -- start end )) } { "fread" "io.streams.c" "primitive_fread" (( n alien -- str/f )) }
{ "special-object" "kernel.private" (( n -- obj )) } { "fseek" "io.streams.c" "primitive_fseek" (( alien offset whence -- )) }
{ "set-special-object" "kernel.private" (( obj n -- )) } { "ftell" "io.streams.c" "primitive_ftell" (( alien -- n )) }
{ "(exists?)" "io.files.private" (( path -- ? )) } { "fwrite" "io.streams.c" "primitive_fwrite" (( string alien -- )) }
{ "minor-gc" "memory" (( -- )) } { "(clone)" "kernel" "primitive_clone" (( obj -- newobj )) }
{ "gc" "memory" (( -- )) } { "<wrapper>" "kernel" "primitive_wrapper" (( obj -- wrapper )) }
{ "compact-gc" "memory" (( -- )) } { "callstack" "kernel" "primitive_callstack" (( -- cs )) }
{ "(save-image)" "memory.private" (( path -- )) } { "callstack>array" "kernel" "primitive_callstack_to_array" (( callstack -- array )) }
{ "(save-image-and-exit)" "memory.private" (( path -- )) } { "datastack" "kernel" "primitive_datastack" (( -- ds )) }
{ "datastack" "kernel" (( -- ds )) } { "die" "kernel" "primitive_die" (( -- )) }
{ "retainstack" "kernel" (( -- rs )) } { "retainstack" "kernel" "primitive_retainstack" (( -- rs )) }
{ "callstack" "kernel" (( -- cs )) } { "(identity-hashcode)" "kernel.private" "primitive_identity_hashcode" (( obj -- code )) }
{ "set-datastack" "kernel.private" (( ds -- )) } { "become" "kernel.private" "primitive_become" (( old new -- )) }
{ "set-retainstack" "kernel.private" (( rs -- )) } { "call-clear" "kernel.private" "primitive_call_clear" (( quot -- * )) }
{ "(exit)" "system" (( n -- )) } { "check-datastack" "kernel.private" "primitive_check_datastack" (( array in# out# -- ? )) }
{ "data-room" "memory" (( -- data-room )) } { "compute-identity-hashcode" "kernel.private" "primitive_compute_identity_hashcode" (( obj -- )) }
{ "code-room" "memory" (( -- code-room )) } { "innermost-frame-executing" "kernel.private" "primitive_innermost_stack_frame_executing" (( callstack -- obj )) }
{ "system-micros" "system" (( -- us )) } { "innermost-frame-scan" "kernel.private" "primitive_innermost_stack_frame_scan" (( callstack -- n )) }
{ "nano-count" "system" (( -- ns )) } { "set-datastack" "kernel.private" "primitive_set_datastack" (( ds -- )) }
{ "modify-code-heap" "compiler.units" (( alist -- )) } { "set-innermost-frame-quot" "kernel.private" "primitive_set_innermost_stack_frame_quot" (( n callstack -- )) }
{ "(dlopen)" "alien.libraries" (( path -- dll )) } { "set-retainstack" "kernel.private" "primitive_set_retainstack" (( rs -- )) }
{ "(dlsym)" "alien.libraries" (( name dll -- alien )) } { "set-special-object" "kernel.private" "primitive_set_special_object" (( obj n -- )) }
{ "dlclose" "alien.libraries" (( dll -- )) } { "special-object" "kernel.private" "primitive_special_object" (( n -- obj )) }
{ "<byte-array>" "byte-arrays" (( n -- byte-array )) } { "strip-stack-traces" "kernel.private" "primitive_strip_stack_traces" (( -- )) }
{ "(byte-array)" "byte-arrays" (( n -- byte-array )) } { "unimplemented" "kernel.private" "primitive_unimplemented" (( -- * )) }
{ "<displaced-alien>" "alien" (( displacement c-ptr -- alien )) } { "load-locals" "locals.backend" "primitive_load_locals" (( ... n -- )) }
{ "alien-signed-cell" "alien.accessors" (( c-ptr n -- value )) } { "bits>double" "math" "primitive_bits_double" (( n -- x )) }
{ "set-alien-signed-cell" "alien.accessors" (( value c-ptr n -- )) } { "bits>float" "math" "primitive_bits_float" (( n -- x )) }
{ "alien-unsigned-cell" "alien.accessors" (( c-ptr n -- value )) } { "byte-array>bignum" "math" "primitive_byte_array_to_bignum" (( x -- y )) }
{ "set-alien-unsigned-cell" "alien.accessors" (( value c-ptr n -- )) } { "double>bits" "math" "primitive_double_bits" (( x -- n )) }
{ "alien-signed-8" "alien.accessors" (( c-ptr n -- value )) } { "float>bits" "math" "primitive_float_bits" (( x -- n )) }
{ "set-alien-signed-8" "alien.accessors" (( value c-ptr n -- )) } { "(float>string)" "math.parser.private" "primitive_float_to_str" (( n -- str )) }
{ "alien-unsigned-8" "alien.accessors" (( c-ptr n -- value )) } { "(string>float)" "math.parser.private" "primitive_str_to_float" (( str -- n/f )) }
{ "set-alien-unsigned-8" "alien.accessors" (( value c-ptr n -- )) } { "bignum*" "math.private" "primitive_bignum_multiply" (( x y -- z )) }
{ "alien-signed-4" "alien.accessors" (( c-ptr n -- value )) } { "bignum+" "math.private" "primitive_bignum_add" (( x y -- z )) }
{ "set-alien-signed-4" "alien.accessors" (( value c-ptr n -- )) } { "bignum-" "math.private" "primitive_bignum_subtract" (( x y -- z )) }
{ "alien-unsigned-4" "alien.accessors" (( c-ptr n -- value )) } { "bignum-bit?" "math.private" "primitive_bignum_bitp" (( n x -- ? )) }
{ "set-alien-unsigned-4" "alien.accessors" (( value c-ptr n -- )) } { "bignum-bitand" "math.private" "primitive_bignum_and" (( x y -- z )) }
{ "alien-signed-2" "alien.accessors" (( c-ptr n -- value )) } { "bignum-bitnot" "math.private" "primitive_bignum_not" (( x -- y )) }
{ "set-alien-signed-2" "alien.accessors" (( value c-ptr n -- )) } { "bignum-bitor" "math.private" "primitive_bignum_or" (( x y -- z )) }
{ "alien-unsigned-2" "alien.accessors" (( c-ptr n -- value )) } { "bignum-bitxor" "math.private" "primitive_bignum_xor" (( x y -- z )) }
{ "set-alien-unsigned-2" "alien.accessors" (( value c-ptr n -- )) } { "bignum-log2" "math.private" "primitive_bignum_log2" (( x -- n )) }
{ "alien-signed-1" "alien.accessors" (( c-ptr n -- value )) } { "bignum-mod" "math.private" "primitive_bignum_mod" (( x y -- z )) }
{ "set-alien-signed-1" "alien.accessors" (( value c-ptr n -- )) } { "bignum-shift" "math.private" "primitive_bignum_shift" (( x y -- z )) }
{ "alien-unsigned-1" "alien.accessors" (( c-ptr n -- value )) } { "bignum/i" "math.private" "primitive_bignum_divint" (( x y -- z )) }
{ "set-alien-unsigned-1" "alien.accessors" (( value c-ptr n -- )) } { "bignum/mod" "math.private" "primitive_bignum_divmod" (( x y -- z w )) }
{ "alien-float" "alien.accessors" (( c-ptr n -- value )) } { "bignum<" "math.private" "primitive_bignum_less" (( x y -- ? )) }
{ "set-alien-float" "alien.accessors" (( value c-ptr n -- )) } { "bignum<=" "math.private" "primitive_bignum_lesseq" (( x y -- ? )) }
{ "alien-double" "alien.accessors" (( c-ptr n -- value )) } { "bignum=" "math.private" "primitive_bignum_eq" (( x y -- ? )) }
{ "set-alien-double" "alien.accessors" (( value c-ptr n -- )) } { "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) }
{ "alien-cell" "alien.accessors" (( c-ptr n -- value )) } { "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) }
{ "set-alien-cell" "alien.accessors" (( value c-ptr n -- )) } { "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) }
{ "alien-address" "alien" (( c-ptr -- addr )) } { "bignum>float" "math.private" "primitive_bignum_to_float" (( x -- y )) }
{ "set-slot" "slots.private" (( value obj n -- )) } { "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) }
{ "string-nth" "strings.private" (( n string -- ch )) } { "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) }
{ "set-string-nth-fast" "strings.private" (( ch n string -- )) } { "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) }
{ "set-string-nth-slow" "strings.private" (( ch n string -- )) } { "fixnum>bignum" "math.private" "primitive_fixnum_to_bignum" (( x -- y )) }
{ "resize-array" "arrays" (( n array -- newarray )) } { "fixnum>float" "math.private" "primitive_fixnum_to_float" (( x -- y )) }
{ "resize-string" "strings" (( n str -- newstr )) } { "float*" "math.private" "primitive_float_multiply" (( x y -- z )) }
{ "<array>" "arrays" (( n elt -- array )) } { "float+" "math.private" "primitive_float_add" (( x y -- z )) }
{ "all-instances" "memory" (( -- array )) } { "float-" "math.private" "primitive_float_subtract" (( x y -- z )) }
{ "size" "memory" (( obj -- n )) } { "float-mod" "math.private" "primitive_float_mod" (( x y -- z )) }
{ "die" "kernel" (( -- )) } { "float-u<" "math.private" "primitive_float_less" (( x y -- ? )) }
{ "(fopen)" "io.streams.c" (( path mode -- alien )) } { "float-u<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) }
{ "fgetc" "io.streams.c" (( alien -- ch/f )) } { "float-u>" "math.private" "primitive_float_greater" (( x y -- ? )) }
{ "fread" "io.streams.c" (( n alien -- str/f )) } { "float-u>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) }
{ "fputc" "io.streams.c" (( ch alien -- )) } { "float/f" "math.private" "primitive_float_divfloat" (( x y -- z )) }
{ "fwrite" "io.streams.c" (( string alien -- )) } { "float<" "math.private" "primitive_float_less" (( x y -- ? )) }
{ "fflush" "io.streams.c" (( alien -- )) } { "float<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) }
{ "ftell" "io.streams.c" (( alien -- n )) } { "float=" "math.private" "primitive_float_eq" (( x y -- ? )) }
{ "fseek" "io.streams.c" (( alien offset whence -- )) } { "float>" "math.private" "primitive_float_greater" (( x y -- ? )) }
{ "fclose" "io.streams.c" (( alien -- )) } { "float>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) }
{ "<wrapper>" "kernel" (( obj -- wrapper )) } { "float>bignum" "math.private" "primitive_float_to_bignum" (( x -- y )) }
{ "(clone)" "kernel" (( obj -- newobj )) } { "float>fixnum" "math.private" "primitive_float_to_fixnum" (( x -- y )) }
{ "<string>" "strings" (( n ch -- string )) } { "all-instances" "memory" "primitive_all_instances" (( -- array )) }
{ "array>quotation" "quotations.private" (( array -- quot )) } { "code-room" "memory" "primitive_code_room" (( -- code-room )) }
{ "quotation-code" "quotations" (( quot -- start end )) } { "compact-gc" "memory" "primitive_compact_gc" (( -- )) }
{ "<tuple>" "classes.tuple.private" (( layout -- tuple )) } { "data-room" "memory" "primitive_data_room" (( -- data-room )) }
{ "profiling" "tools.profiler.private" (( ? -- )) } { "disable-gc-events" "memory" "primitive_disable_gc_events" (( -- events )) }
{ "become" "kernel.private" (( old new -- )) } { "enable-gc-events" "memory" "primitive_enable_gc_events" (( -- )) }
{ "(sleep)" "threads.private" (( nanos -- )) } { "gc" "memory" "primitive_full_gc" (( -- )) }
{ "<tuple-boa>" "classes.tuple.private" (( ... layout -- tuple )) } { "minor-gc" "memory" "primitive_minor_gc" (( -- )) }
{ "callstack>array" "kernel" (( callstack -- array )) } { "size" "memory" "primitive_size" (( obj -- n )) }
{ "innermost-frame-executing" "kernel.private" (( callstack -- obj )) } { "(save-image)" "memory.private" "primitive_save_image" (( path -- )) }
{ "innermost-frame-scan" "kernel.private" (( callstack -- n )) } { "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" (( path -- )) }
{ "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) } { "jit-compile" "quotations" "primitive_jit_compile" (( quot -- )) }
{ "call-clear" "kernel.private" (( quot -- * )) } { "quot-compiled?" "quotations" "primitive_quot_compiled_p" (( quot -- ? )) }
{ "resize-byte-array" "byte-arrays" (( n byte-array -- newbyte-array )) } { "quotation-code" "quotations" "primitive_quotation_code" (( quot -- start end )) }
{ "dll-valid?" "alien.libraries" (( dll -- ? )) } { "array>quotation" "quotations.private" "primitive_array_to_quotation" (( array -- quot )) }
{ "unimplemented" "kernel.private" (( -- * )) } { "set-slot" "slots.private" "primitive_set_slot" (( value obj n -- )) }
{ "jit-compile" "quotations" (( quot -- )) } { "<string>" "strings" "primitive_string" (( n ch -- string )) }
{ "load-locals" "locals.backend" (( ... n -- )) } { "resize-string" "strings" "primitive_resize_string" (( n str -- newstr )) }
{ "check-datastack" "kernel.private" (( array in# out# -- ? )) } { "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" (( ch n string -- )) }
{ "mega-cache-miss" "generic.single.private" (( methods index cache -- method )) } { "set-string-nth-slow" "strings.private" "primitive_set_string_nth_slow" (( ch n string -- )) }
{ "lookup-method" "generic.single.private" (( object methods -- method )) } { "string-nth" "strings.private" "primitive_string_nth" (( n string -- ch )) }
{ "reset-dispatch-stats" "tools.dispatch.private" (( -- )) } { "(exit)" "system" "primitive_exit" (( n -- )) }
{ "dispatch-stats" "tools.dispatch.private" (( -- stats )) } { "nano-count" "system" "primitive_nano_count" (( -- ns )) }
{ "optimized?" "words" (( word -- ? )) } { "system-micros" "system" "primitive_system_micros" (( -- us )) }
{ "quot-compiled?" "quotations" (( quot -- ? )) } { "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
{ "vm-ptr" "vm" (( -- ptr )) } { "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) }
{ "strip-stack-traces" "kernel.private" (( -- )) } { "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) }
{ "<callback>" "alien" (( return-rewind word -- alien )) } { "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) }
{ "enable-gc-events" "memory" (( -- )) } { "vm-ptr" "vm" "primitive_vm_ptr" (( -- ptr )) }
{ "disable-gc-events" "memory" (( -- events )) } { "optimized?" "words" "primitive_optimized_p" (( word -- ? )) }
{ "(identity-hashcode)" "kernel.private" (( obj -- code )) } { "word-code" "words" "primitive_word_code" (( word -- start end )) }
{ "compute-identity-hashcode" "kernel.private" (( obj -- )) } { "(word)" "words.private" "primitive_word" (( name vocab -- word )) }
} [ [ first3 ] dip swap make-primitive ] each-index } [ first4 make-primitive ] each
! Bump build number ! Bump build number
"build" "kernel" create build 1 + [ ] curry (( -- n )) define-declared "build" "kernel" create build 1 + [ ] curry (( -- n )) define-declared

26
core/words/words.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2009 Slava Pestov. ! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions kernel kernel.private USING: accessors arrays definitions kernel kernel.private
slots.private math namespaces sequences strings vectors sbufs slots.private math namespaces sequences strings vectors sbufs
@ -21,20 +21,6 @@ M: word definer drop \ : \ ; ;
M: word definition def>> ; M: word definition def>> ;
ERROR: undefined ;
PREDICATE: deferred < word ( obj -- ? )
def>> [ undefined ] = ;
M: deferred definer drop \ DEFER: f ;
M: deferred definition drop f ;
PREDICATE: primitive < word ( obj -- ? )
[ def>> [ do-primitive ] tail? ]
[ sub-primitive>> >boolean ]
bi or ;
M: primitive definer drop \ PRIMITIVE: f ;
M: primitive definition drop f ;
: word-prop ( word name -- value ) swap props>> at ; : word-prop ( word name -- value ) swap props>> at ;
: remove-word-prop ( word name -- ) swap props>> delete-at ; : remove-word-prop ( word name -- ) swap props>> delete-at ;
@ -46,6 +32,16 @@ M: primitive definition drop f ;
: reset-props ( word seq -- ) [ remove-word-prop ] with each ; : reset-props ( word seq -- ) [ remove-word-prop ] with each ;
ERROR: undefined ;
PREDICATE: deferred < word ( obj -- ? ) def>> [ undefined ] = ;
M: deferred definer drop \ DEFER: f ;
M: deferred definition drop f ;
PREDICATE: primitive < word ( obj -- ? ) "primitive" word-prop ;
M: primitive definer drop \ PRIMITIVE: f ;
M: primitive definition drop f ;
: lookup ( name vocab -- word ) vocab-words at ; : lookup ( name vocab -- word ) vocab-words at ;
: target-word ( word -- target ) : target-word ( word -- target )

9
vm/code_blocks.cpp
View File

@ -136,12 +136,6 @@ void factor_vm::check_code_address(cell address)
#endif #endif
} }
cell factor_vm::compute_primitive_address(cell arg)
{
return (cell)primitives[untag_fixnum(arg)];
}
/* References to undefined symbols are patched up to call this function on /* References to undefined symbols are patched up to call this function on
image load */ image load */
void factor_vm::undefined_symbol() void factor_vm::undefined_symbol()
@ -209,9 +203,6 @@ void factor_vm::store_external_address(instruction_operand op)
switch(op.rel_type()) switch(op.rel_type())
{ {
case RT_PRIMITIVE:
op.store_value(compute_primitive_address(array_nth(parameters,index)));
break;
case RT_DLSYM: case RT_DLSYM:
op.store_value(compute_dlsym_address(parameters,index)); op.store_value(compute_dlsym_address(parameters,index));
break; break;

5
vm/instruction_operands.hpp
View File

@ -2,9 +2,7 @@ namespace factor
{ {
enum relocation_type { enum relocation_type {
/* arg is a primitive number */ /* arg is a literal table index, holding a pair (symbol/dll) */
RT_PRIMITIVE,
/* arg is a literal table index, holding an array pair (symbol/dll) */
RT_DLSYM, RT_DLSYM,
/* a word or quotation's general entry point */ /* a word or quotation's general entry point */
RT_ENTRY_POINT, RT_ENTRY_POINT,
@ -93,7 +91,6 @@ struct relocation_entry {
{ {
switch(rel_type()) switch(rel_type())
{ {
case RT_PRIMITIVE:
case RT_VM: case RT_VM:
return 1; return 1;
case RT_DLSYM: case RT_DLSYM:

373
vm/primitives.cpp
View File

@ -3,290 +3,135 @@
namespace factor namespace factor
{ {
#define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(factor_vm *parent) \
{ \
parent->primitive_##name(); \
}
PRIMITIVE_FORWARD(alien_address)
PRIMITIVE_FORWARD(all_instances)
PRIMITIVE_FORWARD(array)
PRIMITIVE_FORWARD(array_to_quotation)
PRIMITIVE_FORWARD(become)
PRIMITIVE_FORWARD(bignum_add)
PRIMITIVE_FORWARD(bignum_and)
PRIMITIVE_FORWARD(bignum_bitp)
PRIMITIVE_FORWARD(bignum_divint)
PRIMITIVE_FORWARD(bignum_divmod)
PRIMITIVE_FORWARD(bignum_eq)
PRIMITIVE_FORWARD(bignum_greater)
PRIMITIVE_FORWARD(bignum_greatereq)
PRIMITIVE_FORWARD(bignum_less)
PRIMITIVE_FORWARD(bignum_lesseq)
PRIMITIVE_FORWARD(bignum_log2)
PRIMITIVE_FORWARD(bignum_mod)
PRIMITIVE_FORWARD(bignum_multiply)
PRIMITIVE_FORWARD(bignum_not)
PRIMITIVE_FORWARD(bignum_or)
PRIMITIVE_FORWARD(bignum_shift)
PRIMITIVE_FORWARD(bignum_subtract)
PRIMITIVE_FORWARD(bignum_to_fixnum) PRIMITIVE_FORWARD(bignum_to_fixnum)
PRIMITIVE_FORWARD(float_to_fixnum)
PRIMITIVE_FORWARD(fixnum_to_bignum)
PRIMITIVE_FORWARD(float_to_bignum)
PRIMITIVE_FORWARD(fixnum_to_float)
PRIMITIVE_FORWARD(bignum_to_float) PRIMITIVE_FORWARD(bignum_to_float)
PRIMITIVE_FORWARD(str_to_float) PRIMITIVE_FORWARD(bignum_xor)
PRIMITIVE_FORWARD(float_to_str)
PRIMITIVE_FORWARD(float_bits)
PRIMITIVE_FORWARD(double_bits)
PRIMITIVE_FORWARD(bits_float)
PRIMITIVE_FORWARD(bits_double) PRIMITIVE_FORWARD(bits_double)
PRIMITIVE_FORWARD(bits_float)
PRIMITIVE_FORWARD(byte_array)
PRIMITIVE_FORWARD(byte_array_to_bignum)
PRIMITIVE_FORWARD(call_clear)
PRIMITIVE_FORWARD(callback)
PRIMITIVE_FORWARD(callstack)
PRIMITIVE_FORWARD(callstack_to_array)
PRIMITIVE_FORWARD(check_datastack)
PRIMITIVE_FORWARD(clone)
PRIMITIVE_FORWARD(code_room)
PRIMITIVE_FORWARD(compact_gc)
PRIMITIVE_FORWARD(compute_identity_hashcode)
PRIMITIVE_FORWARD(data_room)
PRIMITIVE_FORWARD(datastack)
PRIMITIVE_FORWARD(die)
PRIMITIVE_FORWARD(disable_gc_events)
PRIMITIVE_FORWARD(dispatch_stats)
PRIMITIVE_FORWARD(displaced_alien)
PRIMITIVE_FORWARD(dlclose)
PRIMITIVE_FORWARD(dll_validp)
PRIMITIVE_FORWARD(dlopen)
PRIMITIVE_FORWARD(dlsym)
PRIMITIVE_FORWARD(double_bits)
PRIMITIVE_FORWARD(enable_gc_events)
PRIMITIVE_FORWARD(existsp)
PRIMITIVE_FORWARD(exit)
PRIMITIVE_FORWARD(fclose)
PRIMITIVE_FORWARD(fflush)
PRIMITIVE_FORWARD(fgetc)
PRIMITIVE_FORWARD(fixnum_divint) PRIMITIVE_FORWARD(fixnum_divint)
PRIMITIVE_FORWARD(fixnum_divmod) PRIMITIVE_FORWARD(fixnum_divmod)
PRIMITIVE_FORWARD(fixnum_shift) PRIMITIVE_FORWARD(fixnum_shift)
PRIMITIVE_FORWARD(bignum_eq) PRIMITIVE_FORWARD(fixnum_to_bignum)
PRIMITIVE_FORWARD(bignum_add) PRIMITIVE_FORWARD(fixnum_to_float)
PRIMITIVE_FORWARD(bignum_subtract)
PRIMITIVE_FORWARD(bignum_multiply)
PRIMITIVE_FORWARD(bignum_divint)
PRIMITIVE_FORWARD(bignum_mod)
PRIMITIVE_FORWARD(bignum_divmod)
PRIMITIVE_FORWARD(bignum_and)
PRIMITIVE_FORWARD(bignum_or)
PRIMITIVE_FORWARD(bignum_xor)
PRIMITIVE_FORWARD(bignum_not)
PRIMITIVE_FORWARD(bignum_shift)
PRIMITIVE_FORWARD(bignum_less)
PRIMITIVE_FORWARD(bignum_lesseq)
PRIMITIVE_FORWARD(bignum_greater)
PRIMITIVE_FORWARD(bignum_greatereq)
PRIMITIVE_FORWARD(bignum_bitp)
PRIMITIVE_FORWARD(bignum_log2)
PRIMITIVE_FORWARD(byte_array_to_bignum)
PRIMITIVE_FORWARD(float_eq)
PRIMITIVE_FORWARD(float_add) PRIMITIVE_FORWARD(float_add)
PRIMITIVE_FORWARD(float_subtract) PRIMITIVE_FORWARD(float_bits)
PRIMITIVE_FORWARD(float_multiply)
PRIMITIVE_FORWARD(float_divfloat) PRIMITIVE_FORWARD(float_divfloat)
PRIMITIVE_FORWARD(float_mod) PRIMITIVE_FORWARD(float_eq)
PRIMITIVE_FORWARD(float_less)
PRIMITIVE_FORWARD(float_lesseq)
PRIMITIVE_FORWARD(float_greater) PRIMITIVE_FORWARD(float_greater)
PRIMITIVE_FORWARD(float_greatereq) PRIMITIVE_FORWARD(float_greatereq)
PRIMITIVE_FORWARD(word) PRIMITIVE_FORWARD(float_less)
PRIMITIVE_FORWARD(word_code) PRIMITIVE_FORWARD(float_lesseq)
PRIMITIVE_FORWARD(special_object) PRIMITIVE_FORWARD(float_mod)
PRIMITIVE_FORWARD(set_special_object) PRIMITIVE_FORWARD(float_multiply)
PRIMITIVE_FORWARD(existsp) PRIMITIVE_FORWARD(float_subtract)
PRIMITIVE_FORWARD(minor_gc) PRIMITIVE_FORWARD(float_to_bignum)
PRIMITIVE_FORWARD(full_gc) PRIMITIVE_FORWARD(float_to_fixnum)
PRIMITIVE_FORWARD(compact_gc) PRIMITIVE_FORWARD(float_to_str)
PRIMITIVE_FORWARD(save_image)
PRIMITIVE_FORWARD(save_image_and_exit)
PRIMITIVE_FORWARD(datastack)
PRIMITIVE_FORWARD(retainstack)
PRIMITIVE_FORWARD(callstack)
PRIMITIVE_FORWARD(set_datastack)
PRIMITIVE_FORWARD(set_retainstack)
PRIMITIVE_FORWARD(exit)
PRIMITIVE_FORWARD(data_room)
PRIMITIVE_FORWARD(code_room)
PRIMITIVE_FORWARD(system_micros)
PRIMITIVE_FORWARD(nano_count)
PRIMITIVE_FORWARD(modify_code_heap)
PRIMITIVE_FORWARD(dlopen)
PRIMITIVE_FORWARD(dlsym)
PRIMITIVE_FORWARD(dlclose)
PRIMITIVE_FORWARD(byte_array)
PRIMITIVE_FORWARD(uninitialized_byte_array)
PRIMITIVE_FORWARD(displaced_alien)
PRIMITIVE_FORWARD(alien_address)
PRIMITIVE_FORWARD(set_slot)
PRIMITIVE_FORWARD(string_nth)
PRIMITIVE_FORWARD(set_string_nth_fast)
PRIMITIVE_FORWARD(set_string_nth_slow)
PRIMITIVE_FORWARD(resize_array)
PRIMITIVE_FORWARD(resize_string)
PRIMITIVE_FORWARD(array)
PRIMITIVE_FORWARD(all_instances)
PRIMITIVE_FORWARD(size)
PRIMITIVE_FORWARD(die)
PRIMITIVE_FORWARD(fopen) PRIMITIVE_FORWARD(fopen)
PRIMITIVE_FORWARD(fgetc)
PRIMITIVE_FORWARD(fread)
PRIMITIVE_FORWARD(fputc) PRIMITIVE_FORWARD(fputc)
PRIMITIVE_FORWARD(fwrite) PRIMITIVE_FORWARD(fread)
PRIMITIVE_FORWARD(fflush)
PRIMITIVE_FORWARD(ftell)
PRIMITIVE_FORWARD(fseek) PRIMITIVE_FORWARD(fseek)
PRIMITIVE_FORWARD(fclose) PRIMITIVE_FORWARD(ftell)
PRIMITIVE_FORWARD(wrapper) PRIMITIVE_FORWARD(full_gc)
PRIMITIVE_FORWARD(clone) PRIMITIVE_FORWARD(fwrite)
PRIMITIVE_FORWARD(string) PRIMITIVE_FORWARD(identity_hashcode)
PRIMITIVE_FORWARD(array_to_quotation)
PRIMITIVE_FORWARD(quotation_code)
PRIMITIVE_FORWARD(tuple)
PRIMITIVE_FORWARD(profiling)
PRIMITIVE_FORWARD(become)
PRIMITIVE_FORWARD(sleep)
PRIMITIVE_FORWARD(tuple_boa)
PRIMITIVE_FORWARD(callstack_to_array)
PRIMITIVE_FORWARD(innermost_stack_frame_executing) PRIMITIVE_FORWARD(innermost_stack_frame_executing)
PRIMITIVE_FORWARD(innermost_stack_frame_scan) PRIMITIVE_FORWARD(innermost_stack_frame_scan)
PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
PRIMITIVE_FORWARD(call_clear)
PRIMITIVE_FORWARD(resize_byte_array)
PRIMITIVE_FORWARD(dll_validp)
PRIMITIVE_FORWARD(unimplemented)
PRIMITIVE_FORWARD(jit_compile) PRIMITIVE_FORWARD(jit_compile)
PRIMITIVE_FORWARD(load_locals) PRIMITIVE_FORWARD(load_locals)
PRIMITIVE_FORWARD(check_datastack)
PRIMITIVE_FORWARD(mega_cache_miss)
PRIMITIVE_FORWARD(lookup_method) PRIMITIVE_FORWARD(lookup_method)
PRIMITIVE_FORWARD(reset_dispatch_stats) PRIMITIVE_FORWARD(mega_cache_miss)
PRIMITIVE_FORWARD(dispatch_stats) PRIMITIVE_FORWARD(minor_gc)
PRIMITIVE_FORWARD(modify_code_heap)
PRIMITIVE_FORWARD(nano_count)
PRIMITIVE_FORWARD(optimized_p) PRIMITIVE_FORWARD(optimized_p)
PRIMITIVE_FORWARD(profiling)
PRIMITIVE_FORWARD(quot_compiled_p) PRIMITIVE_FORWARD(quot_compiled_p)
PRIMITIVE_FORWARD(vm_ptr) PRIMITIVE_FORWARD(quotation_code)
PRIMITIVE_FORWARD(reset_dispatch_stats)
PRIMITIVE_FORWARD(resize_array)
PRIMITIVE_FORWARD(resize_byte_array)
PRIMITIVE_FORWARD(resize_string)
PRIMITIVE_FORWARD(retainstack)
PRIMITIVE_FORWARD(save_image)
PRIMITIVE_FORWARD(save_image_and_exit)
PRIMITIVE_FORWARD(set_datastack)
PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
PRIMITIVE_FORWARD(set_retainstack)
PRIMITIVE_FORWARD(set_slot)
PRIMITIVE_FORWARD(set_special_object)
PRIMITIVE_FORWARD(set_string_nth_fast)
PRIMITIVE_FORWARD(set_string_nth_slow)
PRIMITIVE_FORWARD(size)
PRIMITIVE_FORWARD(sleep)
PRIMITIVE_FORWARD(special_object)
PRIMITIVE_FORWARD(str_to_float)
PRIMITIVE_FORWARD(string)
PRIMITIVE_FORWARD(string_nth)
PRIMITIVE_FORWARD(strip_stack_traces) PRIMITIVE_FORWARD(strip_stack_traces)
PRIMITIVE_FORWARD(callback) PRIMITIVE_FORWARD(system_micros)
PRIMITIVE_FORWARD(enable_gc_events) PRIMITIVE_FORWARD(tuple)
PRIMITIVE_FORWARD(disable_gc_events) PRIMITIVE_FORWARD(tuple_boa)
PRIMITIVE_FORWARD(identity_hashcode) PRIMITIVE_FORWARD(unimplemented)
PRIMITIVE_FORWARD(compute_identity_hashcode) PRIMITIVE_FORWARD(uninitialized_byte_array)
PRIMITIVE_FORWARD(vm_ptr)
const primitive_type primitives[] = { PRIMITIVE_FORWARD(word)
primitive_bignum_to_fixnum, PRIMITIVE_FORWARD(word_code)
primitive_float_to_fixnum, PRIMITIVE_FORWARD(wrapper)
primitive_fixnum_to_bignum,
primitive_float_to_bignum,
primitive_fixnum_to_float,
primitive_bignum_to_float,
primitive_str_to_float,
primitive_float_to_str,
primitive_float_bits,
primitive_double_bits,
primitive_bits_float,
primitive_bits_double,
primitive_fixnum_divint,
primitive_fixnum_divmod,
primitive_fixnum_shift,
primitive_bignum_eq,
primitive_bignum_add,
primitive_bignum_subtract,
primitive_bignum_multiply,
primitive_bignum_divint,
primitive_bignum_mod,
primitive_bignum_divmod,
primitive_bignum_and,
primitive_bignum_or,
primitive_bignum_xor,
primitive_bignum_not,
primitive_bignum_shift,
primitive_bignum_less,
primitive_bignum_lesseq,
primitive_bignum_greater,
primitive_bignum_greatereq,
primitive_bignum_bitp,
primitive_bignum_log2,
primitive_byte_array_to_bignum,
primitive_float_eq,
primitive_float_add,
primitive_float_subtract,
primitive_float_multiply,
primitive_float_divfloat,
primitive_float_mod,
primitive_float_less,
primitive_float_lesseq,
primitive_float_greater,
primitive_float_greatereq,
/* The unordered comparison primitives don't have a non-optimizing
compiler implementation */
primitive_float_less,
primitive_float_lesseq,
primitive_float_greater,
primitive_float_greatereq,
primitive_word,
primitive_word_code,
primitive_special_object,
primitive_set_special_object,
primitive_existsp,
primitive_minor_gc,
primitive_full_gc,
primitive_compact_gc,
primitive_save_image,
primitive_save_image_and_exit,
primitive_datastack,
primitive_retainstack,
primitive_callstack,
primitive_set_datastack,
primitive_set_retainstack,
primitive_exit,
primitive_data_room,
primitive_code_room,
primitive_system_micros,
primitive_nano_count,
primitive_modify_code_heap,
primitive_dlopen,
primitive_dlsym,
primitive_dlclose,
primitive_byte_array,
primitive_uninitialized_byte_array,
primitive_displaced_alien,
primitive_alien_signed_cell,
primitive_set_alien_signed_cell,
primitive_alien_unsigned_cell,
primitive_set_alien_unsigned_cell,
primitive_alien_signed_8,
primitive_set_alien_signed_8,
primitive_alien_unsigned_8,
primitive_set_alien_unsigned_8,
primitive_alien_signed_4,
primitive_set_alien_signed_4,
primitive_alien_unsigned_4,
primitive_set_alien_unsigned_4,
primitive_alien_signed_2,
primitive_set_alien_signed_2,
primitive_alien_unsigned_2,
primitive_set_alien_unsigned_2,
primitive_alien_signed_1,
primitive_set_alien_signed_1,
primitive_alien_unsigned_1,
primitive_set_alien_unsigned_1,
primitive_alien_float,
primitive_set_alien_float,
primitive_alien_double,
primitive_set_alien_double,
primitive_alien_cell,
primitive_set_alien_cell,
primitive_alien_address,
primitive_set_slot,
primitive_string_nth,
primitive_set_string_nth_fast,
primitive_set_string_nth_slow,
primitive_resize_array,
primitive_resize_string,
primitive_array,
primitive_all_instances,
primitive_size,
primitive_die,
primitive_fopen,
primitive_fgetc,
primitive_fread,
primitive_fputc,
primitive_fwrite,
primitive_fflush,
primitive_ftell,
primitive_fseek,
primitive_fclose,
primitive_wrapper,
primitive_clone,
primitive_string,
primitive_array_to_quotation,
primitive_quotation_code,
primitive_tuple,
primitive_profiling,
primitive_become,
primitive_sleep,
primitive_tuple_boa,
primitive_callstack_to_array,
primitive_innermost_stack_frame_executing,
primitive_innermost_stack_frame_scan,
primitive_set_innermost_stack_frame_quot,
primitive_call_clear,
primitive_resize_byte_array,
primitive_dll_validp,
primitive_unimplemented,
primitive_jit_compile,
primitive_load_locals,
primitive_check_datastack,
primitive_mega_cache_miss,
primitive_lookup_method,
primitive_reset_dispatch_stats,
primitive_dispatch_stats,
primitive_optimized_p,
primitive_quot_compiled_p,
primitive_vm_ptr,
primitive_strip_stack_traces,
primitive_callback,
primitive_enable_gc_events,
primitive_disable_gc_events,
primitive_identity_hashcode,
primitive_compute_identity_hashcode,
};
} }

9
vm/primitives.hpp
View File

@ -1,16 +1,9 @@
namespace factor namespace factor
{ {
extern "C" typedef void (*primitive_type)(factor_vm *parent);
#define PRIMITIVE(name) extern "C" void primitive_##name(factor_vm *parent) #define PRIMITIVE(name) extern "C" void primitive_##name(factor_vm *parent)
#define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(factor_vm *parent) \
{ \
parent->primitive_##name(); \
}
extern const primitive_type primitives[]; /* These are generated with macros in alien.cpp */
/* These are generated with macros in alien.c */
PRIMITIVE(alien_signed_cell); PRIMITIVE(alien_signed_cell);
PRIMITIVE(set_alien_signed_cell); PRIMITIVE(set_alien_signed_cell);
PRIMITIVE(alien_unsigned_cell); PRIMITIVE(alien_unsigned_cell);

5
vm/quotations.cpp
View File

@ -43,7 +43,7 @@ void quotation_jit::init_quotation(cell quot)
bool quotation_jit::primitive_call_p(cell i, cell length) bool quotation_jit::primitive_call_p(cell i, cell length)
{ {
return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_PRIMITIVE_WORD]; return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_PRIMITIVE_WORD];
} }
bool quotation_jit::fast_if_p(cell i, cell length) bool quotation_jit::fast_if_p(cell i, cell length)
@ -178,7 +178,7 @@ void quotation_jit::iterate_quotation()
case WRAPPER_TYPE: case WRAPPER_TYPE:
push(obj.as<wrapper>()->object); push(obj.as<wrapper>()->object);
break; break;
case FIXNUM_TYPE: case BYTE_ARRAY_TYPE:
/* Primitive calls */ /* Primitive calls */
if(primitive_call_p(i,length)) if(primitive_call_p(i,length))
{ {
@ -189,6 +189,7 @@ void quotation_jit::iterate_quotation()
parameter(tag_fixnum(0)); parameter(tag_fixnum(0));
#endif #endif
parameter(obj.value()); parameter(obj.value());
parameter(false_object);
emit(parent->special_objects[JIT_PRIMITIVE]); emit(parent->special_objects[JIT_PRIMITIVE]);
i++; i++;

1
vm/vm.hpp
View File

@ -510,7 +510,6 @@ struct factor_vm
cell code_block_owner(code_block *compiled); cell code_block_owner(code_block *compiled);
void update_word_references(code_block *compiled); void update_word_references(code_block *compiled);
void check_code_address(cell address); void check_code_address(cell address);
cell compute_primitive_address(cell arg);
void undefined_symbol(); void undefined_symbol();
cell compute_dlsym_address(array *literals, cell index); cell compute_dlsym_address(array *literals, cell index);
cell compute_vm_address(cell arg); cell compute_vm_address(cell arg);