: rel-word-pic-tail ( word class -- )
[ 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 -- )
[ add-literal ] dip rt-literal rel-fixup ;
[ "forgotten" word-prop ]
[ compiled get key? ]
[ inlined-block? ]
- [ primitive? ]
} 1|| not ;
: queue-compile ( word -- )
} cond ;
: optimize? ( word -- ? )
- single-generic? not ;
+ {
+ [ single-generic? ]
+ [ primitive? ]
+ } 1|| not ;
: contains-breakpoints? ( -- ? )
dependencies get keys [ "break?" word-prop ] any? ;
CONSTANT: rc-absolute-2 10
! Relocation types
-CONSTANT: rt-primitive 0
-CONSTANT: rt-dlsym 1
-CONSTANT: rt-entry-point 2
-CONSTANT: rt-entry-point-pic 3
-CONSTANT: rt-entry-point-pic-tail 4
-CONSTANT: rt-here 5
-CONSTANT: rt-this 6
-CONSTANT: rt-literal 7
-CONSTANT: rt-untagged 8
-CONSTANT: rt-megamorphic-cache-hits 9
-CONSTANT: rt-vm 10
-CONSTANT: rt-cards-offset 11
-CONSTANT: rt-decks-offset 12
+CONSTANT: rt-dlsym 0
+CONSTANT: rt-entry-point 1
+CONSTANT: rt-entry-point-pic 2
+CONSTANT: rt-entry-point-pic-tail 3
+CONSTANT: rt-here 4
+CONSTANT: rt-this 5
+CONSTANT: rt-literal 6
+CONSTANT: rt-untagged 7
+CONSTANT: rt-megamorphic-cache-hits 8
+CONSTANT: rt-vm 9
+CONSTANT: rt-cards-offset 10
+CONSTANT: rt-decks-offset 11
: rc-absolute? ( n -- ? )
${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
[\r
jit-save-context\r
3 vm-reg MR\r
- 0 4 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel\r
+ 0 4 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel\r
4 MTLR\r
BLRL\r
jit-restore-context\r
jit-save-context
! call the primitive
ESP [] vm-reg MOV
- 0 CALL rc-relative rt-primitive jit-rel
+ 0 CALL rc-relative rt-dlsym jit-rel
! restore ds, rs registers
jit-restore-context
] jit-primitive jit-define
jit-save-context
! call the primitive
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
jit-restore-context
] jit-primitive jit-define
\ fseek { alien integer integer } { } define-primitive
+\ ftell { alien } { integer } define-primitive
+
\ fclose { alien } { } define-primitive
\ <wrapper> { object } { wrapper } define-primitive
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
: foo ( -- ) ;
f my-generic drop ;
[ ] [ some-code ] unit-test
+
+! Make sure annotations work on primitives
+\ gc watch
+
+[ f ] [ [ gc ] with-string-writer empty? ] unit-test
+
+\ gc reset
-! Copyright (C) 2004, 2009 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays byte-arrays generic hashtables
-hashtables.private io kernel math math.private math.order
-namespaces make parser sequences strings vectors words
-quotations assocs layouts classes classes.builtin classes.tuple
-classes.tuple.private kernel.private vocabs vocabs.loader
-source-files definitions slots classes.union
+USING: alien alien.strings arrays byte-arrays generic hashtables
+hashtables.private io io.encodings.ascii kernel math
+math.private math.order namespaces make parser sequences strings
+vectors words quotations assocs layouts classes classes.builtin
+classes.tuple classes.tuple.private kernel.private vocabs
+vocabs.loader source-files definitions slots classes.union
classes.intersection classes.predicate compiler.units
bootstrap.image.private io.files accessors combinators ;
IN: bootstrap.primitives
! Sub-primitive words
: 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 -- )) }
} [ first3 make-sub-primitive ] each
! 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 ;
{
- { "bignum>fixnum" "math.private" (( x -- y )) }
- { "float>fixnum" "math.private" (( x -- y )) }
- { "fixnum>bignum" "math.private" (( x -- y )) }
- { "float>bignum" "math.private" (( x -- y )) }
- { "fixnum>float" "math.private" (( x -- y )) }
- { "bignum>float" "math.private" (( x -- y )) }
- { "(string>float)" "math.parser.private" (( str -- n/f )) }
- { "(float>string)" "math.parser.private" (( n -- str )) }
- { "float>bits" "math" (( x -- n )) }
- { "double>bits" "math" (( x -- n )) }
- { "bits>float" "math" (( n -- x )) }
- { "bits>double" "math" (( n -- x )) }
- { "fixnum/i" "math.private" (( x y -- z )) }
- { "fixnum/mod" "math.private" (( x y -- z w )) }
- { "fixnum-shift" "math.private" (( x y -- z )) }
- { "bignum=" "math.private" (( x y -- ? )) }
- { "bignum+" "math.private" (( x y -- z )) }
- { "bignum-" "math.private" (( x y -- z )) }
- { "bignum*" "math.private" (( x y -- z )) }
- { "bignum/i" "math.private" (( x y -- z )) }
- { "bignum-mod" "math.private" (( x y -- z )) }
- { "bignum/mod" "math.private" (( x y -- z w )) }
- { "bignum-bitand" "math.private" (( x y -- z )) }
- { "bignum-bitor" "math.private" (( x y -- z )) }
- { "bignum-bitxor" "math.private" (( x y -- z )) }
- { "bignum-bitnot" "math.private" (( x -- y )) }
- { "bignum-shift" "math.private" (( x y -- z )) }
- { "bignum<" "math.private" (( x y -- ? )) }
- { "bignum<=" "math.private" (( x y -- ? )) }
- { "bignum>" "math.private" (( x y -- ? )) }
- { "bignum>=" "math.private" (( x y -- ? )) }
- { "bignum-bit?" "math.private" (( n x -- ? )) }
- { "bignum-log2" "math.private" (( x -- n )) }
- { "byte-array>bignum" "math" (( x -- y )) }
- { "float=" "math.private" (( x y -- ? )) }
- { "float+" "math.private" (( x y -- z )) }
- { "float-" "math.private" (( x y -- z )) }
- { "float*" "math.private" (( x y -- z )) }
- { "float/f" "math.private" (( x y -- z )) }
- { "float-mod" "math.private" (( x y -- z )) }
- { "float<" "math.private" (( x y -- ? )) }
- { "float<=" "math.private" (( x y -- ? )) }
- { "float>" "math.private" (( x y -- ? )) }
- { "float>=" "math.private" (( x y -- ? )) }
- { "float-u<" "math.private" (( x y -- ? )) }
- { "float-u<=" "math.private" (( x y -- ? )) }
- { "float-u>" "math.private" (( x y -- ? )) }
- { "float-u>=" "math.private" (( x y -- ? )) }
- { "(word)" "words.private" (( name vocab -- word )) }
- { "word-code" "words" (( word -- start end )) }
- { "special-object" "kernel.private" (( n -- obj )) }
- { "set-special-object" "kernel.private" (( obj n -- )) }
- { "(exists?)" "io.files.private" (( path -- ? )) }
- { "minor-gc" "memory" (( -- )) }
- { "gc" "memory" (( -- )) }
- { "compact-gc" "memory" (( -- )) }
- { "(save-image)" "memory.private" (( path -- )) }
- { "(save-image-and-exit)" "memory.private" (( path -- )) }
- { "datastack" "kernel" (( -- ds )) }
- { "retainstack" "kernel" (( -- rs )) }
- { "callstack" "kernel" (( -- cs )) }
- { "set-datastack" "kernel.private" (( ds -- )) }
- { "set-retainstack" "kernel.private" (( rs -- )) }
- { "(exit)" "system" (( n -- )) }
- { "data-room" "memory" (( -- data-room )) }
- { "code-room" "memory" (( -- code-room )) }
- { "system-micros" "system" (( -- us )) }
- { "nano-count" "system" (( -- ns )) }
- { "modify-code-heap" "compiler.units" (( alist -- )) }
- { "(dlopen)" "alien.libraries" (( path -- dll )) }
- { "(dlsym)" "alien.libraries" (( name dll -- alien )) }
- { "dlclose" "alien.libraries" (( dll -- )) }
- { "<byte-array>" "byte-arrays" (( n -- byte-array )) }
- { "(byte-array)" "byte-arrays" (( n -- byte-array )) }
- { "<displaced-alien>" "alien" (( displacement c-ptr -- alien )) }
- { "alien-signed-cell" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-signed-cell" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-unsigned-cell" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-unsigned-cell" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-signed-8" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-signed-8" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-unsigned-8" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-unsigned-8" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-signed-4" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-signed-4" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-unsigned-4" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-unsigned-4" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-signed-2" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-signed-2" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-unsigned-2" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-unsigned-2" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-signed-1" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-signed-1" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-unsigned-1" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-unsigned-1" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-float" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-float" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-double" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-double" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-cell" "alien.accessors" (( c-ptr n -- value )) }
- { "set-alien-cell" "alien.accessors" (( value c-ptr n -- )) }
- { "alien-address" "alien" (( c-ptr -- addr )) }
- { "set-slot" "slots.private" (( value obj n -- )) }
- { "string-nth" "strings.private" (( n string -- ch )) }
- { "set-string-nth-fast" "strings.private" (( ch n string -- )) }
- { "set-string-nth-slow" "strings.private" (( ch n string -- )) }
- { "resize-array" "arrays" (( n array -- newarray )) }
- { "resize-string" "strings" (( n str -- newstr )) }
- { "<array>" "arrays" (( n elt -- array )) }
- { "all-instances" "memory" (( -- array )) }
- { "size" "memory" (( obj -- n )) }
- { "die" "kernel" (( -- )) }
- { "(fopen)" "io.streams.c" (( path mode -- alien )) }
- { "fgetc" "io.streams.c" (( alien -- ch/f )) }
- { "fread" "io.streams.c" (( n alien -- str/f )) }
- { "fputc" "io.streams.c" (( ch alien -- )) }
- { "fwrite" "io.streams.c" (( string alien -- )) }
- { "fflush" "io.streams.c" (( alien -- )) }
- { "ftell" "io.streams.c" (( alien -- n )) }
- { "fseek" "io.streams.c" (( alien offset whence -- )) }
- { "fclose" "io.streams.c" (( alien -- )) }
- { "<wrapper>" "kernel" (( obj -- wrapper )) }
- { "(clone)" "kernel" (( obj -- newobj )) }
- { "<string>" "strings" (( n ch -- string )) }
- { "array>quotation" "quotations.private" (( array -- quot )) }
- { "quotation-code" "quotations" (( quot -- start end )) }
- { "<tuple>" "classes.tuple.private" (( layout -- tuple )) }
- { "profiling" "tools.profiler.private" (( ? -- )) }
- { "become" "kernel.private" (( old new -- )) }
- { "(sleep)" "threads.private" (( nanos -- )) }
- { "<tuple-boa>" "classes.tuple.private" (( ... layout -- tuple )) }
- { "callstack>array" "kernel" (( callstack -- array )) }
- { "innermost-frame-executing" "kernel.private" (( callstack -- obj )) }
- { "innermost-frame-scan" "kernel.private" (( callstack -- n )) }
- { "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) }
- { "call-clear" "kernel.private" (( quot -- * )) }
- { "resize-byte-array" "byte-arrays" (( n byte-array -- newbyte-array )) }
- { "dll-valid?" "alien.libraries" (( dll -- ? )) }
- { "unimplemented" "kernel.private" (( -- * )) }
- { "jit-compile" "quotations" (( quot -- )) }
- { "load-locals" "locals.backend" (( ... n -- )) }
- { "check-datastack" "kernel.private" (( array in# out# -- ? )) }
- { "mega-cache-miss" "generic.single.private" (( methods index cache -- method )) }
- { "lookup-method" "generic.single.private" (( object methods -- method )) }
- { "reset-dispatch-stats" "tools.dispatch.private" (( -- )) }
- { "dispatch-stats" "tools.dispatch.private" (( -- stats )) }
- { "optimized?" "words" (( word -- ? )) }
- { "quot-compiled?" "quotations" (( quot -- ? )) }
- { "vm-ptr" "vm" (( -- ptr )) }
- { "strip-stack-traces" "kernel.private" (( -- )) }
- { "<callback>" "alien" (( return-rewind word -- alien )) }
- { "enable-gc-events" "memory" (( -- )) }
- { "disable-gc-events" "memory" (( -- events )) }
- { "(identity-hashcode)" "kernel.private" (( obj -- code )) }
- { "compute-identity-hashcode" "kernel.private" (( obj -- )) }
-} [ [ first3 ] dip swap make-primitive ] each-index
+ { "<callback>" "alien" "primitive_callback" (( return-rewind word -- alien )) }
+ { "<displaced-alien>" "alien" "primitive_displaced_alien" (( displacement c-ptr -- alien )) }
+ { "alien-address" "alien" "primitive_alien_address" (( c-ptr -- addr )) }
+ { "alien-cell" "alien.accessors" "primitive_alien_cell" (( c-ptr n -- value )) }
+ { "alien-double" "alien.accessors" "primitive_alien_double" (( c-ptr n -- value )) }
+ { "alien-float" "alien.accessors" "primitive_alien_float" (( c-ptr n -- value )) }
+ { "alien-signed-1" "alien.accessors" "primitive_alien_signed_1" (( c-ptr n -- value )) }
+ { "alien-signed-2" "alien.accessors" "primitive_alien_signed_2" (( c-ptr n -- value )) }
+ { "alien-signed-4" "alien.accessors" "primitive_alien_signed_4" (( c-ptr n -- value )) }
+ { "alien-signed-8" "alien.accessors" "primitive_alien_signed_8" (( c-ptr n -- value )) }
+ { "alien-signed-cell" "alien.accessors" "primitive_alien_signed_cell" (( c-ptr n -- value )) }
+ { "alien-unsigned-1" "alien.accessors" "primitive_alien_unsigned_1" (( c-ptr n -- value )) }
+ { "alien-unsigned-2" "alien.accessors" "primitive_alien_unsigned_2" (( c-ptr n -- value )) }
+ { "alien-unsigned-4" "alien.accessors" "primitive_alien_unsigned_4" (( c-ptr n -- value )) }
+ { "alien-unsigned-8" "alien.accessors" "primitive_alien_unsigned_8" (( c-ptr n -- value )) }
+ { "alien-unsigned-cell" "alien.accessors" "primitive_alien_unsigned_cell" (( c-ptr n -- value )) }
+ { "set-alien-cell" "alien.accessors" "primitive_set_alien_cell" (( value c-ptr n -- )) }
+ { "set-alien-double" "alien.accessors" "primitive_set_alien_double" (( value c-ptr n -- )) }
+ { "set-alien-float" "alien.accessors" "primitive_set_alien_float" (( value c-ptr n -- )) }
+ { "set-alien-signed-1" "alien.accessors" "primitive_set_alien_signed_1" (( value c-ptr n -- )) }
+ { "set-alien-signed-2" "alien.accessors" "primitive_set_alien_signed_2" (( value c-ptr n -- )) }
+ { "set-alien-signed-4" "alien.accessors" "primitive_set_alien_signed_4" (( value c-ptr n -- )) }
+ { "set-alien-signed-8" "alien.accessors" "primitive_set_alien_signed_8" (( value c-ptr n -- )) }
+ { "set-alien-signed-cell" "alien.accessors" "primitive_set_alien_signed_cell" (( value c-ptr n -- )) }
+ { "set-alien-unsigned-1" "alien.accessors" "primitive_set_alien_unsigned_1" (( value c-ptr n -- )) }
+ { "set-alien-unsigned-2" "alien.accessors" "primitive_set_alien_unsigned_2" (( value c-ptr n -- )) }
+ { "set-alien-unsigned-4" "alien.accessors" "primitive_set_alien_unsigned_4" (( value c-ptr n -- )) }
+ { "set-alien-unsigned-8" "alien.accessors" "primitive_set_alien_unsigned_8" (( value c-ptr n -- )) }
+ { "set-alien-unsigned-cell" "alien.accessors" "primitive_set_alien_unsigned_cell" (( value c-ptr n -- )) }
+ { "(dlopen)" "alien.libraries" "primitive_dlopen" (( path -- dll )) }
+ { "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) }
+ { "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) }
+ { "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) }
+ { "<array>" "arrays" "primitive_array" (( n elt -- array )) }
+ { "resize-array" "arrays" "primitive_resize_array" (( n array -- newarray )) }
+ { "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" (( n -- byte-array )) }
+ { "<byte-array>" "byte-arrays" "primitive_byte_array" (( n -- byte-array )) }
+ { "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" (( n byte-array -- newbyte-array )) }
+ { "<tuple-boa>" "classes.tuple.private" "primitive_tuple_boa" (( ... layout -- tuple )) }
+ { "<tuple>" "classes.tuple.private" "primitive_tuple" (( layout -- tuple )) }
+ { "modify-code-heap" "compiler.units" "primitive_modify_code_heap" (( alist -- )) }
+ { "lookup-method" "generic.single.private" "primitive_lookup_method" (( object methods -- method )) }
+ { "mega-cache-miss" "generic.single.private" "primitive_mega_cache_miss" (( methods index cache -- method )) }
+ { "(exists?)" "io.files.private" "primitive_existsp" (( path -- ? )) }
+ { "(fopen)" "io.streams.c" "primitive_fopen" (( path mode -- alien )) }
+ { "fclose" "io.streams.c" "primitive_fclose" (( alien -- )) }
+ { "fflush" "io.streams.c" "primitive_fflush" (( alien -- )) }
+ { "fgetc" "io.streams.c" "primitive_fgetc" (( alien -- ch/f )) }
+ { "fputc" "io.streams.c" "primitive_fputc" (( ch alien -- )) }
+ { "fread" "io.streams.c" "primitive_fread" (( n alien -- str/f )) }
+ { "fseek" "io.streams.c" "primitive_fseek" (( alien offset whence -- )) }
+ { "ftell" "io.streams.c" "primitive_ftell" (( alien -- n )) }
+ { "fwrite" "io.streams.c" "primitive_fwrite" (( string alien -- )) }
+ { "(clone)" "kernel" "primitive_clone" (( obj -- newobj )) }
+ { "<wrapper>" "kernel" "primitive_wrapper" (( obj -- wrapper )) }
+ { "callstack" "kernel" "primitive_callstack" (( -- cs )) }
+ { "callstack>array" "kernel" "primitive_callstack_to_array" (( callstack -- array )) }
+ { "datastack" "kernel" "primitive_datastack" (( -- ds )) }
+ { "die" "kernel" "primitive_die" (( -- )) }
+ { "retainstack" "kernel" "primitive_retainstack" (( -- rs )) }
+ { "(identity-hashcode)" "kernel.private" "primitive_identity_hashcode" (( obj -- code )) }
+ { "become" "kernel.private" "primitive_become" (( old new -- )) }
+ { "call-clear" "kernel.private" "primitive_call_clear" (( quot -- * )) }
+ { "check-datastack" "kernel.private" "primitive_check_datastack" (( array in# out# -- ? )) }
+ { "compute-identity-hashcode" "kernel.private" "primitive_compute_identity_hashcode" (( obj -- )) }
+ { "innermost-frame-executing" "kernel.private" "primitive_innermost_stack_frame_executing" (( callstack -- obj )) }
+ { "innermost-frame-scan" "kernel.private" "primitive_innermost_stack_frame_scan" (( callstack -- n )) }
+ { "set-datastack" "kernel.private" "primitive_set_datastack" (( ds -- )) }
+ { "set-innermost-frame-quot" "kernel.private" "primitive_set_innermost_stack_frame_quot" (( n callstack -- )) }
+ { "set-retainstack" "kernel.private" "primitive_set_retainstack" (( rs -- )) }
+ { "set-special-object" "kernel.private" "primitive_set_special_object" (( obj n -- )) }
+ { "special-object" "kernel.private" "primitive_special_object" (( n -- obj )) }
+ { "strip-stack-traces" "kernel.private" "primitive_strip_stack_traces" (( -- )) }
+ { "unimplemented" "kernel.private" "primitive_unimplemented" (( -- * )) }
+ { "load-locals" "locals.backend" "primitive_load_locals" (( ... n -- )) }
+ { "bits>double" "math" "primitive_bits_double" (( n -- x )) }
+ { "bits>float" "math" "primitive_bits_float" (( n -- x )) }
+ { "byte-array>bignum" "math" "primitive_byte_array_to_bignum" (( x -- y )) }
+ { "double>bits" "math" "primitive_double_bits" (( x -- n )) }
+ { "float>bits" "math" "primitive_float_bits" (( x -- n )) }
+ { "(float>string)" "math.parser.private" "primitive_float_to_str" (( n -- str )) }
+ { "(string>float)" "math.parser.private" "primitive_str_to_float" (( str -- n/f )) }
+ { "bignum*" "math.private" "primitive_bignum_multiply" (( x y -- z )) }
+ { "bignum+" "math.private" "primitive_bignum_add" (( x y -- z )) }
+ { "bignum-" "math.private" "primitive_bignum_subtract" (( x y -- z )) }
+ { "bignum-bit?" "math.private" "primitive_bignum_bitp" (( n x -- ? )) }
+ { "bignum-bitand" "math.private" "primitive_bignum_and" (( x y -- z )) }
+ { "bignum-bitnot" "math.private" "primitive_bignum_not" (( x -- y )) }
+ { "bignum-bitor" "math.private" "primitive_bignum_or" (( x y -- z )) }
+ { "bignum-bitxor" "math.private" "primitive_bignum_xor" (( x y -- z )) }
+ { "bignum-log2" "math.private" "primitive_bignum_log2" (( x -- n )) }
+ { "bignum-mod" "math.private" "primitive_bignum_mod" (( x y -- z )) }
+ { "bignum-shift" "math.private" "primitive_bignum_shift" (( x y -- z )) }
+ { "bignum/i" "math.private" "primitive_bignum_divint" (( x y -- z )) }
+ { "bignum/mod" "math.private" "primitive_bignum_divmod" (( x y -- z w )) }
+ { "bignum<" "math.private" "primitive_bignum_less" (( x y -- ? )) }
+ { "bignum<=" "math.private" "primitive_bignum_lesseq" (( x y -- ? )) }
+ { "bignum=" "math.private" "primitive_bignum_eq" (( x y -- ? )) }
+ { "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) }
+ { "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) }
+ { "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) }
+ { "bignum>float" "math.private" "primitive_bignum_to_float" (( x -- y )) }
+ { "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) }
+ { "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) }
+ { "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) }
+ { "fixnum>bignum" "math.private" "primitive_fixnum_to_bignum" (( x -- y )) }
+ { "fixnum>float" "math.private" "primitive_fixnum_to_float" (( x -- y )) }
+ { "float*" "math.private" "primitive_float_multiply" (( x y -- z )) }
+ { "float+" "math.private" "primitive_float_add" (( x y -- z )) }
+ { "float-" "math.private" "primitive_float_subtract" (( x y -- z )) }
+ { "float-mod" "math.private" "primitive_float_mod" (( x y -- z )) }
+ { "float-u<" "math.private" "primitive_float_less" (( x y -- ? )) }
+ { "float-u<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) }
+ { "float-u>" "math.private" "primitive_float_greater" (( x y -- ? )) }
+ { "float-u>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) }
+ { "float/f" "math.private" "primitive_float_divfloat" (( x y -- z )) }
+ { "float<" "math.private" "primitive_float_less" (( x y -- ? )) }
+ { "float<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) }
+ { "float=" "math.private" "primitive_float_eq" (( x y -- ? )) }
+ { "float>" "math.private" "primitive_float_greater" (( x y -- ? )) }
+ { "float>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) }
+ { "float>bignum" "math.private" "primitive_float_to_bignum" (( x -- y )) }
+ { "float>fixnum" "math.private" "primitive_float_to_fixnum" (( x -- y )) }
+ { "all-instances" "memory" "primitive_all_instances" (( -- array )) }
+ { "code-room" "memory" "primitive_code_room" (( -- code-room )) }
+ { "compact-gc" "memory" "primitive_compact_gc" (( -- )) }
+ { "data-room" "memory" "primitive_data_room" (( -- data-room )) }
+ { "disable-gc-events" "memory" "primitive_disable_gc_events" (( -- events )) }
+ { "enable-gc-events" "memory" "primitive_enable_gc_events" (( -- )) }
+ { "gc" "memory" "primitive_full_gc" (( -- )) }
+ { "minor-gc" "memory" "primitive_minor_gc" (( -- )) }
+ { "size" "memory" "primitive_size" (( obj -- n )) }
+ { "(save-image)" "memory.private" "primitive_save_image" (( path -- )) }
+ { "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" (( path -- )) }
+ { "jit-compile" "quotations" "primitive_jit_compile" (( quot -- )) }
+ { "quot-compiled?" "quotations" "primitive_quot_compiled_p" (( quot -- ? )) }
+ { "quotation-code" "quotations" "primitive_quotation_code" (( quot -- start end )) }
+ { "array>quotation" "quotations.private" "primitive_array_to_quotation" (( array -- quot )) }
+ { "set-slot" "slots.private" "primitive_set_slot" (( value obj n -- )) }
+ { "<string>" "strings" "primitive_string" (( n ch -- string )) }
+ { "resize-string" "strings" "primitive_resize_string" (( n str -- newstr )) }
+ { "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" (( ch n string -- )) }
+ { "set-string-nth-slow" "strings.private" "primitive_set_string_nth_slow" (( ch n string -- )) }
+ { "string-nth" "strings.private" "primitive_string_nth" (( n string -- ch )) }
+ { "(exit)" "system" "primitive_exit" (( n -- )) }
+ { "nano-count" "system" "primitive_nano_count" (( -- ns )) }
+ { "system-micros" "system" "primitive_system_micros" (( -- us )) }
+ { "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
+ { "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) }
+ { "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) }
+ { "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) }
+ { "vm-ptr" "vm" "primitive_vm_ptr" (( -- ptr )) }
+ { "optimized?" "words" "primitive_optimized_p" (( word -- ? )) }
+ { "word-code" "words" "primitive_word_code" (( word -- start end )) }
+ { "(word)" "words.private" "primitive_word" (( name vocab -- word )) }
+} [ first4 make-primitive ] each
! Bump build number
"build" "kernel" create build 1 + [ ] curry (( -- n )) define-declared
-! Copyright (C) 2004, 2009 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions kernel kernel.private
slots.private math namespaces sequences strings vectors sbufs
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 ;
: remove-word-prop ( word name -- ) swap props>> delete-at ;
: 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 ;
: target-word ( word -- target )
#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
image load */
void factor_vm::undefined_symbol()
switch(op.rel_type())
{
- case RT_PRIMITIVE:
- op.store_value(compute_primitive_address(array_nth(parameters,index)));
- break;
case RT_DLSYM:
op.store_value(compute_dlsym_address(parameters,index));
break;
{
enum relocation_type {
- /* arg is a primitive number */
- RT_PRIMITIVE,
- /* arg is a literal table index, holding an array pair (symbol/dll) */
+ /* arg is a literal table index, holding a pair (symbol/dll) */
RT_DLSYM,
/* a word or quotation's general entry point */
RT_ENTRY_POINT,
{
switch(rel_type())
{
- case RT_PRIMITIVE:
case RT_VM:
return 1;
case RT_DLSYM:
namespace factor
{
-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(str_to_float)
-PRIMITIVE_FORWARD(float_to_str)
-PRIMITIVE_FORWARD(float_bits)
-PRIMITIVE_FORWARD(double_bits)
-PRIMITIVE_FORWARD(bits_float)
-PRIMITIVE_FORWARD(bits_double)
-PRIMITIVE_FORWARD(fixnum_divint)
-PRIMITIVE_FORWARD(fixnum_divmod)
-PRIMITIVE_FORWARD(fixnum_shift)
-PRIMITIVE_FORWARD(bignum_eq)
+#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_subtract)
-PRIMITIVE_FORWARD(bignum_multiply)
+PRIMITIVE_FORWARD(bignum_and)
+PRIMITIVE_FORWARD(bignum_bitp)
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_eq)
PRIMITIVE_FORWARD(bignum_greater)
PRIMITIVE_FORWARD(bignum_greatereq)
-PRIMITIVE_FORWARD(bignum_bitp)
+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_float)
+PRIMITIVE_FORWARD(bignum_xor)
+PRIMITIVE_FORWARD(bits_double)
+PRIMITIVE_FORWARD(bits_float)
+PRIMITIVE_FORWARD(byte_array)
PRIMITIVE_FORWARD(byte_array_to_bignum)
-PRIMITIVE_FORWARD(float_eq)
+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_divmod)
+PRIMITIVE_FORWARD(fixnum_shift)
+PRIMITIVE_FORWARD(fixnum_to_bignum)
+PRIMITIVE_FORWARD(fixnum_to_float)
PRIMITIVE_FORWARD(float_add)
-PRIMITIVE_FORWARD(float_subtract)
-PRIMITIVE_FORWARD(float_multiply)
+PRIMITIVE_FORWARD(float_bits)
PRIMITIVE_FORWARD(float_divfloat)
-PRIMITIVE_FORWARD(float_mod)
-PRIMITIVE_FORWARD(float_less)
-PRIMITIVE_FORWARD(float_lesseq)
+PRIMITIVE_FORWARD(float_eq)
PRIMITIVE_FORWARD(float_greater)
PRIMITIVE_FORWARD(float_greatereq)
-PRIMITIVE_FORWARD(word)
-PRIMITIVE_FORWARD(word_code)
-PRIMITIVE_FORWARD(special_object)
-PRIMITIVE_FORWARD(set_special_object)
-PRIMITIVE_FORWARD(existsp)
-PRIMITIVE_FORWARD(minor_gc)
+PRIMITIVE_FORWARD(float_less)
+PRIMITIVE_FORWARD(float_lesseq)
+PRIMITIVE_FORWARD(float_mod)
+PRIMITIVE_FORWARD(float_multiply)
+PRIMITIVE_FORWARD(float_subtract)
+PRIMITIVE_FORWARD(float_to_bignum)
+PRIMITIVE_FORWARD(float_to_fixnum)
+PRIMITIVE_FORWARD(float_to_str)
+PRIMITIVE_FORWARD(fopen)
+PRIMITIVE_FORWARD(fputc)
+PRIMITIVE_FORWARD(fread)
+PRIMITIVE_FORWARD(fseek)
+PRIMITIVE_FORWARD(ftell)
PRIMITIVE_FORWARD(full_gc)
-PRIMITIVE_FORWARD(compact_gc)
+PRIMITIVE_FORWARD(fwrite)
+PRIMITIVE_FORWARD(identity_hashcode)
+PRIMITIVE_FORWARD(innermost_stack_frame_executing)
+PRIMITIVE_FORWARD(innermost_stack_frame_scan)
+PRIMITIVE_FORWARD(jit_compile)
+PRIMITIVE_FORWARD(load_locals)
+PRIMITIVE_FORWARD(lookup_method)
+PRIMITIVE_FORWARD(mega_cache_miss)
+PRIMITIVE_FORWARD(minor_gc)
+PRIMITIVE_FORWARD(modify_code_heap)
+PRIMITIVE_FORWARD(nano_count)
+PRIMITIVE_FORWARD(optimized_p)
+PRIMITIVE_FORWARD(profiling)
+PRIMITIVE_FORWARD(quot_compiled_p)
+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(datastack)
-PRIMITIVE_FORWARD(retainstack)
-PRIMITIVE_FORWARD(callstack)
PRIMITIVE_FORWARD(set_datastack)
+PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
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_special_object)
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(fgetc)
-PRIMITIVE_FORWARD(fread)
-PRIMITIVE_FORWARD(fputc)
-PRIMITIVE_FORWARD(fwrite)
-PRIMITIVE_FORWARD(fflush)
-PRIMITIVE_FORWARD(ftell)
-PRIMITIVE_FORWARD(fseek)
-PRIMITIVE_FORWARD(fclose)
-PRIMITIVE_FORWARD(wrapper)
-PRIMITIVE_FORWARD(clone)
+PRIMITIVE_FORWARD(sleep)
+PRIMITIVE_FORWARD(special_object)
+PRIMITIVE_FORWARD(str_to_float)
PRIMITIVE_FORWARD(string)
-PRIMITIVE_FORWARD(array_to_quotation)
-PRIMITIVE_FORWARD(quotation_code)
+PRIMITIVE_FORWARD(string_nth)
+PRIMITIVE_FORWARD(strip_stack_traces)
+PRIMITIVE_FORWARD(system_micros)
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_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(load_locals)
-PRIMITIVE_FORWARD(check_datastack)
-PRIMITIVE_FORWARD(mega_cache_miss)
-PRIMITIVE_FORWARD(lookup_method)
-PRIMITIVE_FORWARD(reset_dispatch_stats)
-PRIMITIVE_FORWARD(dispatch_stats)
-PRIMITIVE_FORWARD(optimized_p)
-PRIMITIVE_FORWARD(quot_compiled_p)
+PRIMITIVE_FORWARD(uninitialized_byte_array)
PRIMITIVE_FORWARD(vm_ptr)
-PRIMITIVE_FORWARD(strip_stack_traces)
-PRIMITIVE_FORWARD(callback)
-PRIMITIVE_FORWARD(enable_gc_events)
-PRIMITIVE_FORWARD(disable_gc_events)
-PRIMITIVE_FORWARD(identity_hashcode)
-PRIMITIVE_FORWARD(compute_identity_hashcode)
-
-const primitive_type primitives[] = {
- primitive_bignum_to_fixnum,
- primitive_float_to_fixnum,
- 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,
-};
+PRIMITIVE_FORWARD(word)
+PRIMITIVE_FORWARD(word_code)
+PRIMITIVE_FORWARD(wrapper)
}
namespace factor
{
-extern "C" typedef void (*primitive_type)(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.c */
+/* These are generated with macros in alien.cpp */
PRIMITIVE(alien_signed_cell);
PRIMITIVE(set_alien_signed_cell);
PRIMITIVE(alien_unsigned_cell);
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)
case WRAPPER_TYPE:
push(obj.as<wrapper>()->object);
break;
- case FIXNUM_TYPE:
+ case BYTE_ARRAY_TYPE:
/* Primitive calls */
if(primitive_call_p(i,length))
{
parameter(tag_fixnum(0));
#endif
parameter(obj.value());
+ parameter(false_object);
emit(parent->special_objects[JIT_PRIMITIVE]);
i++;
cell code_block_owner(code_block *compiled);
void update_word_references(code_block *compiled);
void check_code_address(cell address);
- cell compute_primitive_address(cell arg);
void undefined_symbol();
cell compute_dlsym_address(array *literals, cell index);
cell compute_vm_address(cell arg);
projects / factor.git / commitdiff