1 ! Copyright (C) 2004, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien arrays byte-arrays generic hashtables
4 hashtables.private io kernel math math.private math.order
5 namespaces make parser sequences strings vectors words
6 quotations assocs layouts classes classes.builtin classes.tuple
7 classes.tuple.private kernel.private vocabs vocabs.loader
8 source-files definitions slots classes.union
9 classes.intersection classes.predicate compiler.units
10 bootstrap.image.private io.files accessors combinators ;
11 IN: bootstrap.primitives
13 "Creating primitives and basic runtime structures..." print flush
17 H{ } clone sub-primitives set
19 "vocab:bootstrap/syntax.factor" parse-file
21 "vocab:cpu/" architecture get {
23 { "winnt-x86.64" "x86/64/winnt" }
24 { "unix-x86.64" "x86/64/unix" }
25 { "linux-ppc" "ppc/linux" }
26 { "macosx-ppc" "ppc/macosx" }
28 } ?at [ "Bad architecture: " prepend throw ] unless
29 "/bootstrap.factor" 3append parse-file
31 "vocab:bootstrap/layouts/layouts.factor" parse-file
33 ! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
35 ! Bring up a bare cross-compiling vocabulary.
36 "syntax" vocab vocab-words bootstrap-syntax set {
39 changed-definitions changed-generics
40 outdated-generics forgotten-definitions
41 root-cache source-files update-map implementors-map
42 } [ H{ } clone swap set ] each
46 ! Vocabulary for slot accessors
47 "accessors" create-vocab drop
49 dummy-compiler compiler-impl set
55 ! After we execute bootstrap/layouts
56 num-types get f <array> builtins set
60 ! Create some empty vocabs where the below primitives and
69 "classes.tuple.private"
72 "continuations.private"
99 "tools.profiler.private"
104 } [ create-vocab drop ] each
107 : lookup-type-number ( word -- n )
108 global [ target-word ] bind type-number ;
110 : register-builtin ( class -- )
111 [ dup lookup-type-number "type" set-word-prop ]
112 [ dup "type" word-prop builtins get set-nth ]
113 [ f f f builtin-class define-class ]
116 : prepare-slots ( slots -- slots' )
117 [ [ dup pair? [ first2 create ] when ] map ] map ;
119 : define-builtin-slots ( class slots -- )
120 prepare-slots make-slots 1 finalize-slots
121 [ "slots" set-word-prop ] [ define-accessors ] 2bi ;
123 : define-builtin ( symbol slotspec -- )
124 [ [ define-builtin-predicate ] keep ] dip define-builtin-slots ;
126 "fixnum" "math" create register-builtin
127 "bignum" "math" create register-builtin
128 "tuple" "kernel" create register-builtin
129 "ratio" "math" create register-builtin
130 "float" "math" create register-builtin
131 "complex" "math" create register-builtin
132 "f" "syntax" lookup register-builtin
133 "array" "arrays" create register-builtin
134 "wrapper" "kernel" create register-builtin
135 "callstack" "kernel" create register-builtin
136 "string" "strings" create register-builtin
137 "quotation" "quotations" create register-builtin
138 "dll" "alien" create register-builtin
139 "alien" "alien" create register-builtin
140 "word" "words" create register-builtin
141 "byte-array" "byte-arrays" create register-builtin
143 ! For predicate classes
144 "predicate-instance?" "classes.predicate" create drop
146 ! We need this before defining c-ptr below
147 "f" "syntax" lookup { } define-builtin
149 "f" "syntax" create [ not ] "predicate" set-word-prop
150 "f?" "syntax" vocab-words delete-at
153 "integer" "math" create
154 "fixnum" "math" lookup
155 "bignum" "math" lookup
159 "rational" "math" create
160 "integer" "math" lookup
161 "ratio" "math" lookup
166 "rational" "math" lookup
167 "float" "math" lookup
171 "c-ptr" "alien" create [
172 "alien" "alien" lookup ,
173 "f" "syntax" lookup ,
174 "byte-array" "byte-arrays" lookup ,
175 ] { } make define-union-class
177 ! A predicate class used for declarations
178 "array-capacity" "sequences.private" create
179 "fixnum" "math" lookup
182 bootstrap-max-array-capacity <fake-bignum> [ fixnum<= ] curry ,
185 define-predicate-class
187 "array-capacity" "sequences.private" lookup
188 [ >fixnum ] bootstrap-max-array-capacity <fake-bignum> [ fixnum-bitand ] curry append
189 "coercer" set-word-prop
191 ! Catch-all class for providing a default method.
192 "object" "kernel" create
193 [ f f { } intersection-class define-class ]
194 [ [ drop t ] "predicate" set-word-prop ]
197 "object?" "kernel" vocab-words delete-at
199 ! Class of objects with object tag
200 "hi-tag" "kernel.private" create
201 builtins get num-tags get tail define-union-class
203 ! Empty class with no instances
204 "null" "kernel" create
205 [ f { } f union-class define-class ]
206 [ [ drop f ] "predicate" set-word-prop ]
209 "null?" "kernel" vocab-words delete-at
211 "fixnum" "math" create { } define-builtin
212 "fixnum" "math" create ">fixnum" "math" create 1quotation "coercer" set-word-prop
214 "bignum" "math" create { } define-builtin
215 "bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop
217 "ratio" "math" create {
218 { "numerator" { "integer" "math" } read-only }
219 { "denominator" { "integer" "math" } read-only }
222 "float" "math" create { } define-builtin
223 "float" "math" create ">float" "math" create 1quotation "coercer" set-word-prop
225 "complex" "math" create {
226 { "real" { "real" "math" } read-only }
227 { "imaginary" { "real" "math" } read-only }
230 "array" "arrays" create {
231 { "length" { "array-capacity" "sequences.private" } read-only }
234 "wrapper" "kernel" create {
235 { "wrapped" read-only }
238 "string" "strings" create {
239 { "length" { "array-capacity" "sequences.private" } read-only }
243 "quotation" "quotations" create {
244 { "array" { "array" "arrays" } read-only }
245 { "compiled" read-only }
250 "dll" "alien" create {
251 { "path" { "byte-array" "byte-arrays" } read-only }
254 "alien" "alien" create {
255 { "underlying" { "c-ptr" "alien" } read-only }
259 "word" "words" create {
260 { "hashcode" { "fixnum" "math" } }
263 { "def" { "quotation" "quotations" } initial: [ ] }
265 { "optimized" read-only }
266 { "counter" { "fixnum" "math" } }
267 { "sub-primitive" read-only }
270 "byte-array" "byte-arrays" create {
271 { "length" { "array-capacity" "sequences.private" } read-only }
274 "callstack" "kernel" create { } define-builtin
276 "tuple" "kernel" create
277 [ { } define-builtin ]
278 [ define-tuple-layout ]
281 ! Create special tombstone values
282 "tombstone" "hashtables.private" create
284 { "state" } define-tuple-class
286 "((empty))" "hashtables.private" create
287 "tombstone" "hashtables.private" lookup f
288 2array >tuple 1quotation (( -- value )) define-inline
290 "((tombstone))" "hashtables.private" create
291 "tombstone" "hashtables.private" lookup t
292 2array >tuple 1quotation (( -- value )) define-inline
295 "curry" "kernel" create
300 } prepare-slots define-tuple-class
302 "curry" "kernel" lookup
304 [ f "inline" set-word-prop ]
309 callable instance-check-quot %
315 (( obj quot -- curry )) define-declared
317 "compose" "kernel" create
320 { "first" read-only }
321 { "second" read-only }
322 } prepare-slots define-tuple-class
324 "compose" "kernel" lookup
326 [ f "inline" set-word-prop ]
331 callable instance-check-quot [ dip ] curry %
332 callable instance-check-quot %
338 (( quot1 quot2 -- compose )) define-declared
340 ! Sub-primitive words
341 : make-sub-primitive ( word vocab -- )
344 dup 1quotation define ;
347 { "(execute)" "words.private" }
348 { "(call)" "kernel.private" }
349 { "both-fixnums?" "math.private" }
350 { "fixnum+fast" "math.private" }
351 { "fixnum-fast" "math.private" }
352 { "fixnum*fast" "math.private" }
353 { "fixnum-bitand" "math.private" }
354 { "fixnum-bitor" "math.private" }
355 { "fixnum-bitxor" "math.private" }
356 { "fixnum-bitnot" "math.private" }
357 { "fixnum-mod" "math.private" }
358 { "fixnum-shift-fast" "math.private" }
359 { "fixnum/i-fast" "math.private" }
360 { "fixnum/mod-fast" "math.private" }
361 { "fixnum<" "math.private" }
362 { "fixnum<=" "math.private" }
363 { "fixnum>" "math.private" }
364 { "fixnum>=" "math.private" }
382 { "tag" "kernel.private" }
383 { "slot" "slots.private" }
384 { "get-local" "locals.backend" }
385 { "load-local" "locals.backend" }
386 { "drop-locals" "locals.backend" }
387 } [ make-sub-primitive ] assoc-each
390 : make-primitive ( word vocab n -- )
391 [ create dup reset-word ] dip
392 [ do-primitive ] curry [ ] like define ;
395 { "bignum>fixnum" "math.private" }
396 { "float>fixnum" "math.private" }
397 { "fixnum>bignum" "math.private" }
398 { "float>bignum" "math.private" }
399 { "fixnum>float" "math.private" }
400 { "bignum>float" "math.private" }
401 { "<ratio>" "math.private" }
402 { "string>float" "math.private" }
403 { "float>string" "math.private" }
404 { "float>bits" "math" }
405 { "double>bits" "math" }
406 { "bits>float" "math" }
407 { "bits>double" "math" }
408 { "<complex>" "math.private" }
409 { "fixnum+" "math.private" }
410 { "fixnum-" "math.private" }
411 { "fixnum*" "math.private" }
412 { "fixnum/i" "math.private" }
413 { "fixnum/mod" "math.private" }
414 { "fixnum-shift" "math.private" }
415 { "bignum=" "math.private" }
416 { "bignum+" "math.private" }
417 { "bignum-" "math.private" }
418 { "bignum*" "math.private" }
419 { "bignum/i" "math.private" }
420 { "bignum-mod" "math.private" }
421 { "bignum/mod" "math.private" }
422 { "bignum-bitand" "math.private" }
423 { "bignum-bitor" "math.private" }
424 { "bignum-bitxor" "math.private" }
425 { "bignum-bitnot" "math.private" }
426 { "bignum-shift" "math.private" }
427 { "bignum<" "math.private" }
428 { "bignum<=" "math.private" }
429 { "bignum>" "math.private" }
430 { "bignum>=" "math.private" }
431 { "bignum-bit?" "math.private" }
432 { "bignum-log2" "math.private" }
433 { "byte-array>bignum" "math" }
434 { "float=" "math.private" }
435 { "float+" "math.private" }
436 { "float-" "math.private" }
437 { "float*" "math.private" }
438 { "float/f" "math.private" }
439 { "float-mod" "math.private" }
440 { "float<" "math.private" }
441 { "float<=" "math.private" }
442 { "float>" "math.private" }
443 { "float>=" "math.private" }
445 { "word-xt" "words" }
446 { "getenv" "kernel.private" }
447 { "setenv" "kernel.private" }
448 { "(exists?)" "io.files.private" }
450 { "gc-stats" "memory" }
451 { "save-image" "memory" }
452 { "save-image-and-exit" "memory" }
453 { "datastack" "kernel" }
454 { "retainstack" "kernel" }
455 { "callstack" "kernel" }
456 { "set-datastack" "kernel" }
457 { "set-retainstack" "kernel" }
458 { "set-callstack" "kernel" }
460 { "data-room" "memory" }
461 { "code-room" "memory" }
462 { "micros" "system" }
463 { "modify-code-heap" "compiler.units" }
466 { "dlclose" "alien" }
467 { "<byte-array>" "byte-arrays" }
468 { "(byte-array)" "byte-arrays" }
469 { "<displaced-alien>" "alien" }
470 { "alien-signed-cell" "alien.accessors" }
471 { "set-alien-signed-cell" "alien.accessors" }
472 { "alien-unsigned-cell" "alien.accessors" }
473 { "set-alien-unsigned-cell" "alien.accessors" }
474 { "alien-signed-8" "alien.accessors" }
475 { "set-alien-signed-8" "alien.accessors" }
476 { "alien-unsigned-8" "alien.accessors" }
477 { "set-alien-unsigned-8" "alien.accessors" }
478 { "alien-signed-4" "alien.accessors" }
479 { "set-alien-signed-4" "alien.accessors" }
480 { "alien-unsigned-4" "alien.accessors" }
481 { "set-alien-unsigned-4" "alien.accessors" }
482 { "alien-signed-2" "alien.accessors" }
483 { "set-alien-signed-2" "alien.accessors" }
484 { "alien-unsigned-2" "alien.accessors" }
485 { "set-alien-unsigned-2" "alien.accessors" }
486 { "alien-signed-1" "alien.accessors" }
487 { "set-alien-signed-1" "alien.accessors" }
488 { "alien-unsigned-1" "alien.accessors" }
489 { "set-alien-unsigned-1" "alien.accessors" }
490 { "alien-float" "alien.accessors" }
491 { "set-alien-float" "alien.accessors" }
492 { "alien-double" "alien.accessors" }
493 { "set-alien-double" "alien.accessors" }
494 { "alien-cell" "alien.accessors" }
495 { "set-alien-cell" "alien.accessors" }
496 { "alien-address" "alien" }
497 { "set-slot" "slots.private" }
498 { "string-nth" "strings.private" }
499 { "set-string-nth-fast" "strings.private" }
500 { "set-string-nth-slow" "strings.private" }
501 { "resize-array" "arrays" }
502 { "resize-string" "strings" }
503 { "<array>" "arrays" }
504 { "begin-scan" "memory" }
505 { "next-object" "memory" }
506 { "end-scan" "memory" }
509 { "fopen" "io.streams.c" }
510 { "fgetc" "io.streams.c" }
511 { "fread" "io.streams.c" }
512 { "fputc" "io.streams.c" }
513 { "fwrite" "io.streams.c" }
514 { "fflush" "io.streams.c" }
515 { "fclose" "io.streams.c" }
516 { "<wrapper>" "kernel" }
517 { "(clone)" "kernel" }
518 { "<string>" "strings" }
519 { "array>quotation" "quotations.private" }
520 { "quotation-xt" "quotations" }
521 { "<tuple>" "classes.tuple.private" }
522 { "profiling" "tools.profiler.private" }
523 { "become" "kernel.private" }
524 { "(sleep)" "threads.private" }
525 { "<tuple-boa>" "classes.tuple.private" }
526 { "callstack>array" "kernel" }
527 { "innermost-frame-quot" "kernel.private" }
528 { "innermost-frame-scan" "kernel.private" }
529 { "set-innermost-frame-quot" "kernel.private" }
530 { "call-clear" "kernel" }
531 { "resize-byte-array" "byte-arrays" }
532 { "dll-valid?" "alien" }
533 { "unimplemented" "kernel.private" }
534 { "gc-reset" "memory" }
535 { "jit-compile" "quotations" }
536 { "load-locals" "locals.backend" }
537 { "check-datastack" "kernel.private" }
539 [ [ first2 ] dip make-primitive ] each-index
542 "build" "kernel" create build 1+ [ ] curry (( -- n )) define-declared