]> gitweb.factorcode.org Git - factor.git/blobdiff - core/bootstrap/primitives.factor
vm: strip out call-counting profiler
[factor.git] / core / bootstrap / primitives.factor
index adba748606e56c0fbcb05f2d00805268d20af0af..2f9b079e45b5f96d11db3f80d9fe28936c88e59b 100755 (executable)
@@ -105,6 +105,7 @@ call( -- )
     "tools.dispatch.private"
     "tools.memory.private"
     "tools.profiler.counting.private"
+    "tools.profiler.sampling.private"
     "words"
     "words.private"
     "vectors"
@@ -139,7 +140,7 @@ call( -- )
 "bignum" "math" create register-builtin
 "tuple" "kernel" create register-builtin
 "float" "math" create register-builtin
-"f" "syntax" lookup register-builtin
+"f" "syntax" lookup-word register-builtin
 "array" "arrays" create register-builtin
 "wrapper" "kernel" create register-builtin
 "callstack" "kernel" create register-builtin
@@ -151,23 +152,23 @@ call( -- )
 "byte-array" "byte-arrays" create register-builtin
 
 ! We need this before defining c-ptr below
-"f" "syntax" lookup { } define-builtin
+"f" "syntax" lookup-word { } define-builtin
 
 "f" "syntax" create [ not ] "predicate" set-word-prop
 "f?" "syntax" vocab-words delete-at
 
-"t" "syntax" lookup define-singleton-class
+"t" "syntax" lookup-word define-singleton-class
 
 ! Some unions
 "c-ptr" "alien" create [
-    "alien" "alien" lookup ,
-    "f" "syntax" lookup ,
-    "byte-array" "byte-arrays" lookup ,
+    "alien" "alien" lookup-word ,
+    "f" "syntax" lookup-word ,
+    "byte-array" "byte-arrays" lookup-word ,
 ] { } make define-union-class
 
 ! A predicate class used for declarations
 "array-capacity" "sequences.private" create
-"fixnum" "math" lookup
+"fixnum" "math" lookup-word
 [
     [ dup 0 fixnum>= ] %
     bootstrap-max-array-capacity <fake-bignum> [ fixnum<= ] curry ,
@@ -175,7 +176,7 @@ call( -- )
 ] [ ] make
 define-predicate-class
 
-"array-capacity" "sequences.private" lookup
+"array-capacity" "sequences.private" lookup-word
 [ >fixnum ] bootstrap-max-array-capacity <fake-bignum> [ fixnum-bitand ] curry append
 "coercer" set-word-prop
 
@@ -240,7 +241,6 @@ bi
     "props"
     "pic-def"
     "pic-tail-def"
-    { "counter" { "fixnum" "math" } }
     { "sub-primitive" read-only }
 } define-builtin
 
@@ -261,11 +261,11 @@ tuple
 { "state" } define-tuple-class
 
 "((empty))" "hashtables.private" create
-"tombstone" "hashtables.private" lookup f
+"tombstone" "hashtables.private" lookup-word f
 2array >tuple 1quotation ( -- value ) define-inline
 
 "((tombstone))" "hashtables.private" create
-"tombstone" "hashtables.private" lookup t
+"tombstone" "hashtables.private" lookup-word t
 2array >tuple 1quotation ( -- value ) define-inline
 
 ! Some tuple classes
@@ -276,7 +276,7 @@ tuple
     { "quot" read-only }
 } prepare-slots define-tuple-class
 
-"curry" "kernel" lookup
+"curry" "kernel" lookup-word
 {
     [ f "inline" set-word-prop ]
     [ make-flushable ]
@@ -298,7 +298,7 @@ tuple
     { "second" read-only }
 } prepare-slots define-tuple-class
 
-"compose" "kernel" lookup
+"compose" "kernel" lookup-word
 {
     [ f "inline" set-word-prop ]
     [ make-flushable ]
@@ -349,6 +349,8 @@ tuple
     { "set-fpu-state" "kernel.private" ( -- ) }
     { "signal-handler" "kernel.private" ( -- ) }
     { "leaf-signal-handler" "kernel.private" ( -- ) }
+    { "ffi-signal-handler" "kernel.private" ( -- ) }
+    { "ffi-leaf-signal-handler" "kernel.private" ( -- ) }
     { "unwind-native-frames" "kernel.private" ( -- ) }
     { "set-callstack" "kernel.private" ( callstack -- * ) }
     { "lazy-jit-compile" "kernel.private" ( -- ) }
@@ -551,6 +553,9 @@ tuple
     { "optimized?" "words" "primitive_optimized_p" ( word -- ? ) }
     { "word-code" "words" "primitive_word_code" ( word -- start end ) }
     { "(word)" "words.private" "primitive_word" ( name vocab hashcode -- word ) }
+    { "profiling" "tools.profiler.sampling.private" "primitive_sampling_profiler" ( ? -- ) }
+    { "(get-samples)" "tools.profiler.sampling.private" "primitive_get_samples" ( -- samples/f ) }
+    { "(clear-samples)" "tools.profiler.sampling.private" "primitive_clear_samples" ( -- ) }
 } [ first4 make-primitive ] each
 
 ! Bump build number