]> gitweb.factorcode.org Git - factor.git/blob - core/bootstrap/primitives.factor
Remove bignum>float VM primitive, and use bignum/f to implement >float on bignums...
[factor.git] / core / bootstrap / primitives.factor
1 ! Copyright (C) 2004, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.strings arrays byte-arrays generic hashtables
4 hashtables.private io io.encodings.ascii kernel math
5 math.private math.order namespaces make parser sequences strings
6 vectors words quotations assocs layouts classes classes.private
7 classes.builtin classes.tuple classes.tuple.private
8 kernel.private vocabs vocabs.loader source-files definitions
9 slots classes.union classes.intersection classes.predicate
10 compiler.units bootstrap.image.private io.files accessors
11 combinators ;
12 IN: bootstrap.primitives
13
14 "Creating primitives and basic runtime structures..." print flush
15
16 H{ } clone sub-primitives set
17
18 "vocab:bootstrap/syntax.factor" parse-file
19
20 architecture get {
21     { "winnt-x86.32" "x86/32/winnt" }
22     { "unix-x86.32" "x86/32/unix" }
23     { "winnt-x86.64" "x86/64/winnt" }
24     { "unix-x86.64" "x86/64/unix" }
25 } ?at [ "Bad architecture: " prepend throw ] unless
26 "vocab:cpu/" "/bootstrap.factor" surround parse-file
27
28 "vocab:bootstrap/layouts/layouts.factor" parse-file
29
30 ! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
31
32 ! Bring up a bare cross-compiling vocabulary.
33 "syntax" vocab vocab-words bootstrap-syntax set
34
35 H{ } clone dictionary set
36 H{ } clone root-cache set
37 H{ } clone source-files set
38 H{ } clone update-map set
39 H{ } clone implementors-map set
40
41 init-caches
42
43 bootstrapping? on
44
45 call( -- )
46 call( -- )
47
48 ! Vocabulary for slot accessors
49 "accessors" create-vocab drop
50
51 ! After we execute bootstrap/layouts
52 num-types get f <array> builtins set
53
54 [
55
56 call( -- )
57
58 ! Create some empty vocabs where the below primitives and
59 ! classes will go
60 {
61     "alien"
62     "alien.accessors"
63     "alien.libraries"
64     "alien.private"
65     "arrays"
66     "byte-arrays"
67     "classes.private"
68     "classes.tuple"
69     "classes.tuple.private"
70     "classes.predicate"
71     "compiler.units"
72     "continuations.private"
73     "generic.single"
74     "generic.single.private"
75     "growable"
76     "hashtables"
77     "hashtables.private"
78     "io"
79     "io.files"
80     "io.files.private"
81     "io.streams.c"
82     "locals.backend"
83     "kernel"
84     "kernel.private"
85     "math"
86     "math.parser.private"
87     "math.private"
88     "memory"
89     "memory.private"
90     "quotations"
91     "quotations.private"
92     "sbufs"
93     "sbufs.private"
94     "scratchpad"
95     "sequences"
96     "sequences.private"
97     "slots.private"
98     "strings"
99     "strings.private"
100     "system"
101     "system.private"
102     "threads.private"
103     "tools.dispatch.private"
104     "tools.profiler.private"
105     "words"
106     "words.private"
107     "vectors"
108     "vectors.private"
109     "vm"
110 } [ create-vocab drop ] each
111
112 ! Builtin classes
113 : lookup-type-number ( word -- n )
114     global [ target-word ] bind type-number ;
115
116 : register-builtin ( class -- )
117     [ dup lookup-type-number "type" set-word-prop ]
118     [ dup "type" word-prop builtins get set-nth ]
119     [ f f f builtin-class define-class ]
120     tri ;
121
122 : prepare-slots ( slots -- slots' )
123     [ [ dup pair? [ first2 create ] when ] map ] map ;
124
125 : define-builtin-slots ( class slots -- )
126     prepare-slots make-slots 1 finalize-slots
127     [ "slots" set-word-prop ] [ define-accessors ] 2bi ;
128
129 : define-builtin-predicate ( class -- )
130     dup class>type [ eq? ] curry [ tag ] prepend define-predicate ;
131
132 : define-builtin ( symbol slotspec -- )
133     [ [ define-builtin-predicate ] keep ] dip define-builtin-slots ;
134
135 "fixnum" "math" create register-builtin
136 "bignum" "math" create register-builtin
137 "tuple" "kernel" create register-builtin
138 "float" "math" create register-builtin
139 "f" "syntax" lookup register-builtin
140 "array" "arrays" create register-builtin
141 "wrapper" "kernel" create register-builtin
142 "callstack" "kernel" create register-builtin
143 "string" "strings" create register-builtin
144 "quotation" "quotations" create register-builtin
145 "dll" "alien" create register-builtin
146 "alien" "alien" create register-builtin
147 "word" "words" create register-builtin
148 "byte-array" "byte-arrays" create register-builtin
149
150 ! We need this before defining c-ptr below
151 "f" "syntax" lookup { } define-builtin
152
153 "f" "syntax" create [ not ] "predicate" set-word-prop
154 "f?" "syntax" vocab-words delete-at
155
156 ! Some unions
157 "c-ptr" "alien" create [
158     "alien" "alien" lookup ,
159     "f" "syntax" lookup ,
160     "byte-array" "byte-arrays" lookup ,
161 ] { } make define-union-class
162
163 ! A predicate class used for declarations
164 "array-capacity" "sequences.private" create
165 "fixnum" "math" lookup
166 [
167     [ dup 0 fixnum>= ] %
168     bootstrap-max-array-capacity <fake-bignum> [ fixnum<= ] curry ,
169     [ [ drop f ] if ] %
170 ] [ ] make
171 define-predicate-class
172
173 "array-capacity" "sequences.private" lookup
174 [ >fixnum ] bootstrap-max-array-capacity <fake-bignum> [ fixnum-bitand ] curry append
175 "coercer" set-word-prop
176
177 ! Catch-all class for providing a default method.
178 "object" "kernel" create
179 [ f f { } intersection-class define-class ]
180 [ [ drop t ] "predicate" set-word-prop ]
181 bi
182
183 "object?" "kernel" vocab-words delete-at
184
185 ! Empty class with no instances
186 "null" "kernel" create
187 [ f { } f union-class define-class ]
188 [ [ drop f ] "predicate" set-word-prop ]
189 bi
190
191 "null?" "kernel" vocab-words delete-at
192
193 "fixnum" "math" create { } define-builtin
194 "fixnum" "math" create ">fixnum" "math" create 1quotation "coercer" set-word-prop
195
196 "bignum" "math" create { } define-builtin
197 "bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop
198
199 "float" "math" create { } define-builtin
200 "float" "math" create ">float" "math" create 1quotation "coercer" set-word-prop
201
202 "array" "arrays" create {
203     { "length" { "array-capacity" "sequences.private" } read-only }
204 } define-builtin
205
206 "wrapper" "kernel" create {
207     { "wrapped" read-only }
208 } define-builtin
209
210 "string" "strings" create {
211     { "length" { "array-capacity" "sequences.private" } read-only }
212     "aux"
213 } define-builtin
214
215 "quotation" "quotations" create {
216     { "array" { "array" "arrays" } read-only }
217     "cached-effect"
218     "cache-counter"
219 } define-builtin
220
221 "dll" "alien" create {
222     { "path" { "byte-array" "byte-arrays" } read-only }
223 } define-builtin
224
225 "alien" "alien" create {
226     { "underlying" { "c-ptr" "alien" } read-only }
227     "expired"
228 } define-builtin
229
230 "word" "words" create {
231     { "hashcode" { "fixnum" "math" } }
232     "name"
233     "vocabulary"
234     { "def" { "quotation" "quotations" } initial: [ ] }
235     "props"
236     "pic-def"
237     "pic-tail-def"
238     { "counter" { "fixnum" "math" } }
239     { "sub-primitive" read-only }
240 } define-builtin
241
242 "byte-array" "byte-arrays" create {
243     { "length" { "array-capacity" "sequences.private" } read-only }
244 } define-builtin
245
246 "callstack" "kernel" create { } define-builtin
247
248 "tuple" "kernel" create
249 [ { } define-builtin ]
250 [ define-tuple-layout ]
251 bi
252
253 ! Create special tombstone values
254 "tombstone" "hashtables.private" create
255 tuple
256 { "state" } define-tuple-class
257
258 "((empty))" "hashtables.private" create
259 "tombstone" "hashtables.private" lookup f
260 2array >tuple 1quotation (( -- value )) define-inline
261
262 "((tombstone))" "hashtables.private" create
263 "tombstone" "hashtables.private" lookup t
264 2array >tuple 1quotation (( -- value )) define-inline
265
266 ! Some tuple classes
267 "curry" "kernel" create
268 tuple
269 {
270     { "obj" read-only }
271     { "quot" read-only }
272 } prepare-slots define-tuple-class
273
274 "curry" "kernel" lookup
275 {
276     [ f "inline" set-word-prop ]
277     [ make-flushable ]
278     [ ]
279     [
280         [
281             callable instance-check-quot %
282             tuple-layout ,
283             \ <tuple-boa> ,
284         ] [ ] make
285     ]
286 } cleave
287 (( obj quot -- curry )) define-declared
288
289 "compose" "kernel" create
290 tuple
291 {
292     { "first" read-only }
293     { "second" read-only }
294 } prepare-slots define-tuple-class
295
296 "compose" "kernel" lookup
297 {
298     [ f "inline" set-word-prop ]
299     [ make-flushable ]
300     [ ]
301     [
302         [
303             callable instance-check-quot [ dip ] curry %
304             callable instance-check-quot %
305             tuple-layout ,
306             \ <tuple-boa> ,
307         ] [ ] make
308     ]
309 } cleave
310 (( quot1 quot2 -- compose )) define-declared
311
312 ! Sub-primitive words
313 : make-sub-primitive ( word vocab effect -- )
314     [
315         create
316         dup t "primitive" set-word-prop
317         dup 1quotation
318     ] dip define-declared ;
319
320 {
321     { "mega-cache-lookup" "generic.single.private" (( methods index cache -- )) }
322     { "inline-cache-miss" "generic.single.private" (( generic methods index cache -- )) }
323     { "inline-cache-miss-tail" "generic.single.private" (( generic methods index cache -- )) }
324     { "drop" "kernel" (( x -- )) }
325     { "2drop" "kernel" (( x y -- )) }
326     { "3drop" "kernel" (( x y z -- )) }
327     { "dup" "kernel" (( x -- x x )) }
328     { "2dup" "kernel" (( x y -- x y x y )) }
329     { "3dup" "kernel" (( x y z -- x y z x y z )) }
330     { "rot" "kernel" (( x y z -- y z x )) }
331     { "-rot" "kernel" (( x y z -- z x y )) }
332     { "dupd" "kernel" (( x y -- x x y )) }
333     { "swapd" "kernel" (( x y z -- y x z )) }
334     { "nip" "kernel" (( x y -- y )) }
335     { "2nip" "kernel" (( x y z -- z )) }
336     { "over" "kernel" (( x y -- x y x )) }
337     { "pick" "kernel" (( x y z -- x y z x )) }
338     { "swap" "kernel" (( x y -- y x )) }
339     { "eq?" "kernel" (( obj1 obj2 -- ? )) }
340     { "tag" "kernel.private" (( object -- n )) }
341     { "(execute)" "kernel.private" (( word -- )) }
342     { "(call)" "kernel.private" (( quot -- )) }
343     { "fpu-state" "kernel.private" (( -- )) }
344     { "set-fpu-state" "kernel.private" (( -- )) }
345     { "unwind-native-frames" "kernel.private" (( -- )) }
346     { "set-callstack" "kernel.private" (( callstack -- * )) }
347     { "lazy-jit-compile" "kernel.private" (( -- )) }
348     { "c-to-factor" "kernel.private" (( -- )) }
349     { "slot" "slots.private" (( obj m -- value )) }
350     { "get-local" "locals.backend" (( n -- obj )) }
351     { "load-local" "locals.backend" (( obj -- )) }
352     { "drop-locals" "locals.backend" (( n -- )) }
353     { "both-fixnums?" "math.private" (( x y -- ? )) }
354     { "fixnum+fast" "math.private" (( x y -- z )) }
355     { "fixnum-fast" "math.private" (( x y -- z )) }
356     { "fixnum*fast" "math.private" (( x y -- z )) }
357     { "fixnum-bitand" "math.private" (( x y -- z )) }
358     { "fixnum-bitor" "math.private" (( x y -- z )) }
359     { "fixnum-bitxor" "math.private" (( x y -- z )) }
360     { "fixnum-bitnot" "math.private" (( x -- y )) }
361     { "fixnum-mod" "math.private" (( x y -- z )) }
362     { "fixnum-shift-fast" "math.private" (( x y -- z )) }
363     { "fixnum/i-fast" "math.private" (( x y -- z )) }
364     { "fixnum/mod-fast" "math.private" (( x y -- z w )) }
365     { "fixnum+" "math.private" (( x y -- z )) }
366     { "fixnum-" "math.private" (( x y -- z )) }
367     { "fixnum*" "math.private" (( x y -- z )) }
368     { "fixnum<" "math.private" (( x y -- ? )) }
369     { "fixnum<=" "math.private" (( x y -- z )) }
370     { "fixnum>" "math.private" (( x y -- ? )) }
371     { "fixnum>=" "math.private" (( x y -- ? )) }
372     { "string-nth-fast" "strings.private" (( n string -- ch )) }
373     { "(set-context)" "threads.private" (( obj context -- obj' )) }
374     { "(set-context-and-delete)" "threads.private" (( obj context -- * )) }
375     { "(start-context)" "threads.private" (( obj quot -- obj' )) }
376     { "(start-context-and-delete)" "threads.private" (( obj quot -- * )) }
377 } [ first3 make-sub-primitive ] each
378
379 ! Primitive words
380 : make-primitive ( word vocab function effect -- )
381     [
382         [
383             create
384             dup reset-word
385             dup t "primitive" set-word-prop
386         ] dip
387         ascii string>alien [ do-primitive ] curry
388     ] dip define-declared ;
389
390 {
391     { "<callback>" "alien" "primitive_callback" (( return-rewind word -- alien )) }
392     { "<displaced-alien>" "alien" "primitive_displaced_alien" (( displacement c-ptr -- alien )) }
393     { "alien-address" "alien" "primitive_alien_address" (( c-ptr -- addr )) }
394     { "alien-cell" "alien.accessors" "primitive_alien_cell" (( c-ptr n -- value )) }
395     { "alien-double" "alien.accessors" "primitive_alien_double" (( c-ptr n -- value )) }
396     { "alien-float" "alien.accessors" "primitive_alien_float" (( c-ptr n -- value )) }
397     { "alien-signed-1" "alien.accessors" "primitive_alien_signed_1" (( c-ptr n -- value )) }
398     { "alien-signed-2" "alien.accessors" "primitive_alien_signed_2" (( c-ptr n -- value )) }
399     { "alien-signed-4" "alien.accessors" "primitive_alien_signed_4" (( c-ptr n -- value )) }
400     { "alien-signed-8" "alien.accessors" "primitive_alien_signed_8" (( c-ptr n -- value )) }
401     { "alien-signed-cell" "alien.accessors" "primitive_alien_signed_cell" (( c-ptr n -- value )) }
402     { "alien-unsigned-1" "alien.accessors" "primitive_alien_unsigned_1" (( c-ptr n -- value )) }
403     { "alien-unsigned-2" "alien.accessors" "primitive_alien_unsigned_2" (( c-ptr n -- value )) }
404     { "alien-unsigned-4" "alien.accessors" "primitive_alien_unsigned_4" (( c-ptr n -- value )) }
405     { "alien-unsigned-8" "alien.accessors" "primitive_alien_unsigned_8" (( c-ptr n -- value )) }
406     { "alien-unsigned-cell" "alien.accessors" "primitive_alien_unsigned_cell" (( c-ptr n -- value )) }
407     { "set-alien-cell" "alien.accessors" "primitive_set_alien_cell" (( value c-ptr n -- )) }
408     { "set-alien-double" "alien.accessors" "primitive_set_alien_double" (( value c-ptr n -- )) }
409     { "set-alien-float" "alien.accessors" "primitive_set_alien_float" (( value c-ptr n -- )) }
410     { "set-alien-signed-1" "alien.accessors" "primitive_set_alien_signed_1" (( value c-ptr n -- )) }
411     { "set-alien-signed-2" "alien.accessors" "primitive_set_alien_signed_2" (( value c-ptr n -- )) }
412     { "set-alien-signed-4" "alien.accessors" "primitive_set_alien_signed_4" (( value c-ptr n -- )) }
413     { "set-alien-signed-8" "alien.accessors" "primitive_set_alien_signed_8" (( value c-ptr n -- )) }
414     { "set-alien-signed-cell" "alien.accessors" "primitive_set_alien_signed_cell" (( value c-ptr n -- )) }
415     { "set-alien-unsigned-1" "alien.accessors" "primitive_set_alien_unsigned_1" (( value c-ptr n -- )) }
416     { "set-alien-unsigned-2" "alien.accessors" "primitive_set_alien_unsigned_2" (( value c-ptr n -- )) }
417     { "set-alien-unsigned-4" "alien.accessors" "primitive_set_alien_unsigned_4" (( value c-ptr n -- )) }
418     { "set-alien-unsigned-8" "alien.accessors" "primitive_set_alien_unsigned_8" (( value c-ptr n -- )) }
419     { "set-alien-unsigned-cell" "alien.accessors" "primitive_set_alien_unsigned_cell" (( value c-ptr n -- )) }
420     { "(dlopen)" "alien.libraries" "primitive_dlopen" (( path -- dll )) }
421     { "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) }
422     { "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) }
423     { "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) }
424     { "current-callback" "alien.private" "primitive_current_callback" (( -- n )) }
425     { "<array>" "arrays" "primitive_array" (( n elt -- array )) }
426     { "resize-array" "arrays" "primitive_resize_array" (( n array -- new-array )) }
427     { "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" (( n -- byte-array )) }
428     { "<byte-array>" "byte-arrays" "primitive_byte_array" (( n -- byte-array )) }
429     { "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" (( n byte-array -- new-byte-array )) }
430     { "<tuple-boa>" "classes.tuple.private" "primitive_tuple_boa" (( slots... layout -- tuple )) }
431     { "<tuple>" "classes.tuple.private" "primitive_tuple" (( layout -- tuple )) }
432     { "modify-code-heap" "compiler.units" "primitive_modify_code_heap" (( alist update-existing? reset-pics? -- )) }
433     { "lookup-method" "generic.single.private" "primitive_lookup_method" (( object methods -- method )) }
434     { "mega-cache-miss" "generic.single.private" "primitive_mega_cache_miss" (( methods index cache -- method )) }
435     { "(exists?)" "io.files.private" "primitive_existsp" (( path -- ? )) }
436     { "(fopen)" "io.streams.c" "primitive_fopen" (( path mode -- alien )) }
437     { "fclose" "io.streams.c" "primitive_fclose" (( alien -- )) }
438     { "fflush" "io.streams.c" "primitive_fflush" (( alien -- )) }
439     { "fgetc" "io.streams.c" "primitive_fgetc" (( alien -- ch/f )) }
440     { "fputc" "io.streams.c" "primitive_fputc" (( ch alien -- )) }
441     { "fread" "io.streams.c" "primitive_fread" (( n alien -- str/f )) }
442     { "fseek" "io.streams.c" "primitive_fseek" (( alien offset whence -- )) }
443     { "ftell" "io.streams.c" "primitive_ftell" (( alien -- n )) }
444     { "fwrite" "io.streams.c" "primitive_fwrite" (( data length alien -- )) }
445     { "(clone)" "kernel" "primitive_clone" (( obj -- newobj )) }
446     { "<wrapper>" "kernel" "primitive_wrapper" (( obj -- wrapper )) }
447     { "callstack" "kernel" "primitive_callstack" (( -- callstack )) }
448     { "callstack>array" "kernel" "primitive_callstack_to_array" (( callstack -- array )) }
449     { "datastack" "kernel" "primitive_datastack" (( -- array )) }
450     { "die" "kernel" "primitive_die" (( -- )) }
451     { "retainstack" "kernel" "primitive_retainstack" (( -- array )) }
452     { "(identity-hashcode)" "kernel.private" "primitive_identity_hashcode" (( obj -- code )) }
453     { "become" "kernel.private" "primitive_become" (( old new -- )) }
454     { "callstack-bounds" "kernel.private" "primitive_callstack_bounds" (( -- start end )) }
455     { "check-datastack" "kernel.private" "primitive_check_datastack" (( array in# out# -- ? )) }
456     { "compute-identity-hashcode" "kernel.private" "primitive_compute_identity_hashcode" (( obj -- )) }
457     { "context-object" "kernel.private" "primitive_context_object" (( n -- obj )) }
458     { "innermost-frame-executing" "kernel.private" "primitive_innermost_stack_frame_executing" (( callstack -- obj )) }
459     { "innermost-frame-scan" "kernel.private" "primitive_innermost_stack_frame_scan" (( callstack -- n )) }
460     { "set-context-object" "kernel.private" "primitive_set_context_object" (( obj n -- )) }
461     { "set-datastack" "kernel.private" "primitive_set_datastack" (( array -- )) }
462     { "set-innermost-frame-quot" "kernel.private" "primitive_set_innermost_stack_frame_quot" (( n callstack -- )) }
463     { "set-retainstack" "kernel.private" "primitive_set_retainstack" (( array -- )) }
464     { "set-special-object" "kernel.private" "primitive_set_special_object" (( obj n -- )) }
465     { "special-object" "kernel.private" "primitive_special_object" (( n -- obj )) }
466     { "strip-stack-traces" "kernel.private" "primitive_strip_stack_traces" (( -- )) }
467     { "unimplemented" "kernel.private" "primitive_unimplemented" (( -- * )) }
468     { "load-locals" "locals.backend" "primitive_load_locals" (( ... n -- )) }
469     { "bits>double" "math" "primitive_bits_double" (( n -- x )) }
470     { "bits>float" "math" "primitive_bits_float" (( n -- x )) }
471     { "byte-array>bignum" "math" "primitive_byte_array_to_bignum" (( x -- y )) }
472     { "double>bits" "math" "primitive_double_bits" (( x -- n )) }
473     { "float>bits" "math" "primitive_float_bits" (( x -- n )) }
474     { "(format-float)" "math.parser.private" "primitive_format_float" (( n format -- byte-array )) }
475     { "bignum*" "math.private" "primitive_bignum_multiply" (( x y -- z )) }
476     { "bignum+" "math.private" "primitive_bignum_add" (( x y -- z )) }
477     { "bignum-" "math.private" "primitive_bignum_subtract" (( x y -- z )) }
478     { "bignum-bit?" "math.private" "primitive_bignum_bitp" (( n x -- ? )) }
479     { "bignum-bitand" "math.private" "primitive_bignum_and" (( x y -- z )) }
480     { "bignum-bitnot" "math.private" "primitive_bignum_not" (( x -- y )) }
481     { "bignum-bitor" "math.private" "primitive_bignum_or" (( x y -- z )) }
482     { "bignum-bitxor" "math.private" "primitive_bignum_xor" (( x y -- z )) }
483     { "bignum-log2" "math.private" "primitive_bignum_log2" (( x -- n )) }
484     { "bignum-mod" "math.private" "primitive_bignum_mod" (( x y -- z )) }
485     { "bignum-shift" "math.private" "primitive_bignum_shift" (( x y -- z )) }
486     { "bignum/i" "math.private" "primitive_bignum_divint" (( x y -- z )) }
487     { "bignum/mod" "math.private" "primitive_bignum_divmod" (( x y -- z w )) }
488     { "bignum<" "math.private" "primitive_bignum_less" (( x y -- ? )) }
489     { "bignum<=" "math.private" "primitive_bignum_lesseq" (( x y -- ? )) }
490     { "bignum=" "math.private" "primitive_bignum_eq" (( x y -- ? )) }
491     { "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) }
492     { "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) }
493     { "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) }
494     { "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) }
495     { "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) }
496     { "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) }
497     { "fixnum>bignum" "math.private" "primitive_fixnum_to_bignum" (( x -- y )) }
498     { "fixnum>float" "math.private" "primitive_fixnum_to_float" (( x -- y )) }
499     { "float*" "math.private" "primitive_float_multiply" (( x y -- z )) }
500     { "float+" "math.private" "primitive_float_add" (( x y -- z )) }
501     { "float-" "math.private" "primitive_float_subtract" (( x y -- z )) }
502     { "float-u<" "math.private" "primitive_float_less" (( x y -- ? )) }
503     { "float-u<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) }
504     { "float-u>" "math.private" "primitive_float_greater" (( x y -- ? )) }
505     { "float-u>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) }
506     { "float/f" "math.private" "primitive_float_divfloat" (( x y -- z )) }
507     { "float<" "math.private" "primitive_float_less" (( x y -- ? )) }
508     { "float<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) }
509     { "float=" "math.private" "primitive_float_eq" (( x y -- ? )) }
510     { "float>" "math.private" "primitive_float_greater" (( x y -- ? )) }
511     { "float>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) }
512     { "float>bignum" "math.private" "primitive_float_to_bignum" (( x -- y )) }
513     { "float>fixnum" "math.private" "primitive_float_to_fixnum" (( x -- y )) }
514     { "all-instances" "memory" "primitive_all_instances" (( -- array )) }
515     { "(code-blocks)" "memory.private" "primitive_code_blocks" (( -- array )) }
516     { "code-room" "memory" "primitive_code_room" (( -- code-room )) }
517     { "compact-gc" "memory" "primitive_compact_gc" (( -- )) }
518     { "data-room" "memory" "primitive_data_room" (( -- data-room )) }
519     { "disable-gc-events" "memory" "primitive_disable_gc_events" (( -- events )) }
520     { "enable-gc-events" "memory" "primitive_enable_gc_events" (( -- )) }
521     { "gc" "memory" "primitive_full_gc" (( -- )) }
522     { "minor-gc" "memory" "primitive_minor_gc" (( -- )) }
523     { "size" "memory" "primitive_size" (( obj -- n )) }
524     { "(save-image)" "memory.private" "primitive_save_image" (( path1 path2 -- )) }
525     { "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" (( path1 path2 -- )) }
526     { "jit-compile" "quotations" "primitive_jit_compile" (( quot -- )) }
527     { "quot-compiled?" "quotations" "primitive_quot_compiled_p" (( quot -- ? )) }
528     { "quotation-code" "quotations" "primitive_quotation_code" (( quot -- start end )) }
529     { "array>quotation" "quotations.private" "primitive_array_to_quotation" (( array -- quot )) }
530     { "set-slot" "slots.private" "primitive_set_slot" (( value obj n -- )) }
531     { "<string>" "strings" "primitive_string" (( n ch -- string )) }
532     { "resize-string" "strings" "primitive_resize_string" (( n str -- newstr )) }
533     { "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" (( ch n string -- )) }
534     { "(exit)" "system" "primitive_exit" (( n -- * )) }
535     { "nano-count" "system" "primitive_nano_count" (( -- ns )) }
536     { "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
537     { "callstack-for" "threads.private" "primitive_callstack_for" (( context -- array )) }
538     { "context-object-for" "threads.private" "primitive_context_object_for" (( n context -- obj )) }
539     { "datastack-for" "threads.private" "primitive_datastack_for" (( context -- array )) }
540     { "retainstack-for" "threads.private" "primitive_retainstack_for" (( context -- array )) }
541     { "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) }
542     { "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) }
543     { "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) }
544     { "optimized?" "words" "primitive_optimized_p" (( word -- ? )) }
545     { "word-code" "words" "primitive_word_code" (( word -- start end )) }
546     { "(word)" "words.private" "primitive_word" (( name vocab hashcode -- word )) }
547 } [ first4 make-primitive ] each
548
549 ! Bump build number
550 "build" "kernel" create build 1 + [ ] curry (( -- n )) define-declared
551
552 ] with-compilation-unit