]> gitweb.factorcode.org Git - factor.git/blobdiff - core/bootstrap/primitives.factor
vm: strip out call-counting profiler
[factor.git] / core / bootstrap / primitives.factor
index 55b134abacc09114491f35113959e7f79479938b..2f9b079e45b5f96d11db3f80d9fe28936c88e59b 100755 (executable)
@@ -4,11 +4,11 @@ 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.private
-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 ;
+classes.builtin classes.singleton 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
 
 "Creating primitives and basic runtime structures..." print flush
@@ -104,7 +104,8 @@ call( -- )
     "threads.private"
     "tools.dispatch.private"
     "tools.memory.private"
-    "tools.profiler.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,21 +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-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 ,
@@ -173,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
 
@@ -238,7 +241,6 @@ bi
     "props"
     "pic-def"
     "pic-tail-def"
-    { "counter" { "fixnum" "math" } }
     { "sub-primitive" read-only }
 } define-builtin
 
@@ -259,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
@@ -274,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 ]
@@ -296,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 ]
@@ -345,6 +347,10 @@ tuple
     { "(call)" "kernel.private" ( quot -- ) }
     { "fpu-state" "kernel.private" ( -- ) }
     { "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" ( -- ) }
@@ -543,10 +549,13 @@ tuple
     { "retainstack-for" "threads.private" "primitive_retainstack_for" ( context -- array ) }
     { "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" ( ? -- ) }
+    { "profiling" "tools.profiler.counting.private" "primitive_counting_profiler" ( ? -- ) }
     { "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