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 namespaces parser sequences
5 strings vectors words quotations assocs layouts classes
6 classes.builtin classes.tuple classes.tuple.private
7 kernel.private vocabs vocabs.loader source-files definitions
8 slots.deprecated classes.union classes.intersection
9 compiler.units bootstrap.image.private io.files accessors
11 IN: bootstrap.primitives
13 "Creating primitives and basic runtime structures..." print flush
17 "resource:core/bootstrap/syntax.factor" parse-file
19 "resource:core/cpu/" architecture get {
22 { "linux-ppc" "ppc/linux" }
23 { "macosx-ppc" "ppc/macosx" }
25 } at "/bootstrap.factor" 3append parse-file
27 "resource:core/bootstrap/layouts/layouts.factor" parse-file
29 ! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
31 ! Bring up a bare cross-compiling vocabulary.
32 "syntax" vocab vocab-words bootstrap-syntax set
33 H{ } clone dictionary set
34 H{ } clone changed-definitions set
35 H{ } clone forgotten-definitions set
36 H{ } clone root-cache set
37 H{ } clone source-files set
38 H{ } clone update-map set
41 ! Vocabulary for slot accessors
42 "accessors" create-vocab drop
44 ! Trivial recompile hook. We don't want to touch the code heap
45 ! during stage1 bootstrap, it would just waste time.
46 [ drop { } ] recompile-hook set
52 ! After we execute bootstrap/layouts
53 num-types get f <array> builtins set
57 ! Create some empty vocabs where the below primitives and
68 "classes.tuple.private"
70 "continuations.private"
98 "tools.profiler.private"
103 } [ create-vocab drop ] each
106 : lo-tag-eq-quot ( n -- quot )
107 [ \ tag , , \ eq? , ] [ ] make ;
109 : hi-tag-eq-quot ( n -- quot )
111 [ dup tag ] % \ hi-tag tag-number , \ eq? ,
112 [ [ hi-tag ] % , \ eq? , ] [ ] make ,
117 : builtin-predicate-quot ( class -- quot )
120 [ lo-tag-eq-quot ] [ hi-tag-eq-quot ] if ;
122 : define-builtin-predicate ( class -- )
123 dup builtin-predicate-quot define-predicate ;
125 : lookup-type-number ( word -- n )
126 global [ target-word ] bind type-number ;
128 : register-builtin ( class -- )
129 [ dup lookup-type-number "type" set-word-prop ]
130 [ dup "type" word-prop builtins get set-nth ]
131 [ f f f builtin-class define-class ]
134 : define-builtin-slots ( symbol slotspec -- )
135 [ drop ] [ 1 simple-slots ] 2bi
136 [ "slots" set-word-prop ] [ define-slots ] 2bi ;
138 : define-builtin ( symbol slotspec -- )
139 >r [ define-builtin-predicate ] keep
140 r> define-builtin-slots ;
142 "fixnum" "math" create register-builtin
143 "bignum" "math" create register-builtin
144 "tuple" "kernel" create register-builtin
145 "ratio" "math" create register-builtin
146 "float" "math" create register-builtin
147 "complex" "math" create register-builtin
148 "f" "syntax" lookup register-builtin
149 "array" "arrays" create register-builtin
150 "wrapper" "kernel" create register-builtin
151 "float-array" "float-arrays" create register-builtin
152 "callstack" "kernel" create register-builtin
153 "string" "strings" create register-builtin
154 "bit-array" "bit-arrays" create register-builtin
155 "quotation" "quotations" create register-builtin
156 "dll" "alien" create register-builtin
157 "alien" "alien" create register-builtin
158 "word" "words" create register-builtin
159 "byte-array" "byte-arrays" create register-builtin
160 "tuple-layout" "classes.tuple.private" create register-builtin
162 ! Catch-all class for providing a default method.
163 "object" "kernel" create
164 [ f f { } intersection-class define-class ]
165 [ [ drop t ] "predicate" set-word-prop ]
168 "object?" "kernel" vocab-words delete-at
170 ! Class of objects with object tag
171 "hi-tag" "kernel.private" create
172 builtins get num-tags get tail define-union-class
174 ! Empty class with no instances
175 "null" "kernel" create
176 [ f { } f union-class define-class ]
177 [ [ drop f ] "predicate" set-word-prop ]
180 "null?" "kernel" vocab-words delete-at
182 "fixnum" "math" create { } define-builtin
183 "fixnum" "math" create ">fixnum" "math" create 1quotation "coercer" set-word-prop
185 "bignum" "math" create { } define-builtin
186 "bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop
188 "ratio" "math" create {
192 { "numerator" "math" }
198 { "denominator" "math" }
203 "float" "math" create { } define-builtin
204 "float" "math" create ">float" "math" create 1quotation "coercer" set-word-prop
206 "complex" "math" create {
210 { "real-part" "math" }
216 { "imaginary-part" "math" }
221 "f" "syntax" lookup { } define-builtin
223 "array" "arrays" create { } define-builtin
225 "wrapper" "kernel" create {
227 { "object" "kernel" }
229 { "wrapped" "kernel" }
234 "string" "strings" create {
236 { "array-capacity" "sequences.private" }
238 { "length" "sequences" }
241 { "object" "kernel" }
243 { "string-aux" "strings.private" }
244 { "set-string-aux" "strings.private" }
248 "quotation" "quotations" create {
250 { "object" "kernel" }
252 { "quotation-array" "quotations.private" }
256 { "object" "kernel" }
258 { "quotation-compiled?" "quotations" }
263 "dll" "alien" create {
265 { "byte-array" "byte-arrays" }
267 { "(dll-path)" "alien" }
273 "alien" "alien" create {
277 { "underlying-alien" "alien" }
280 { "object" "kernel" }
282 { "expired?" "alien" }
288 "word" "words" create {
291 { "object" "kernel" }
293 { "word-name" "words" }
294 { "set-word-name" "words" }
297 { "object" "kernel" }
299 { "word-vocabulary" "words" }
300 { "set-word-vocabulary" "words" }
303 { "quotation" "quotations" }
305 { "word-def" "words" }
306 { "set-word-def" "words.private" }
309 { "object" "kernel" }
311 { "word-props" "words" }
312 { "set-word-props" "words" }
315 { "object" "kernel" }
317 { "compiled?" "words" }
323 { "profile-counter" "tools.profiler.private" }
324 { "set-profile-counter" "tools.profiler.private" }
328 "byte-array" "byte-arrays" create { } define-builtin
330 "bit-array" "bit-arrays" create { } define-builtin
332 "float-array" "float-arrays" create { } define-builtin
334 "callstack" "kernel" create { } define-builtin
336 "tuple-layout" "classes.tuple.private" create {
340 { "layout-hashcode" "classes.tuple.private" }
346 { "layout-class" "classes.tuple.private" }
352 { "layout-size" "classes.tuple.private" }
358 { "layout-superclasses" "classes.tuple.private" }
364 { "layout-echelon" "classes.tuple.private" }
369 "tuple" "kernel" create {
370 [ { } define-builtin ]
371 [ { "delegate" } "slot-names" set-word-prop ]
372 [ define-tuple-layout ]
376 { "object" "kernel" }
378 { "delegate" "kernel" }
379 { "set-delegate" "kernel" }
382 [ drop ] [ generate-tuple-slots ] 2bi
383 [ "slots" set-word-prop ]
389 "f" "syntax" create [ not ] "predicate" set-word-prop
390 "f?" "syntax" vocab-words delete-at
392 ! Create special tombstone values
393 "tombstone" "hashtables.private" create
395 { } define-tuple-class
397 "((empty))" "hashtables.private" create
398 "tombstone" "hashtables.private" lookup f
399 2array >tuple 1quotation define-inline
401 "((tombstone))" "hashtables.private" create
402 "tombstone" "hashtables.private" lookup t
403 2array >tuple 1quotation define-inline
406 "hashtable" "hashtables" create
410 { "array-capacity" "sequences.private" }
412 { "hash-count" "hashtables.private" }
413 { "set-hash-count" "hashtables.private" }
415 { "array-capacity" "sequences.private" }
417 { "hash-deleted" "hashtables.private" }
418 { "set-hash-deleted" "hashtables.private" }
422 { "hash-array" "hashtables.private" }
423 { "set-hash-array" "hashtables.private" }
427 "sbuf" "sbufs" create
431 { "string" "strings" }
433 { "underlying" "growable" }
434 { "set-underlying" "growable" }
436 { "array-capacity" "sequences.private" }
438 { "length" "sequences" }
439 { "set-fill" "growable" }
443 "vector" "vectors" create
449 { "underlying" "growable" }
450 { "set-underlying" "growable" }
452 { "array-capacity" "sequences.private" }
454 { "length" "sequences" }
455 { "set-fill" "growable" }
459 "byte-vector" "byte-vectors" create
463 { "byte-array" "byte-arrays" }
465 { "underlying" "growable" }
466 { "set-underlying" "growable" }
468 { "array-capacity" "sequences.private" }
470 { "length" "sequences" }
471 { "set-fill" "growable" }
475 "curry" "kernel" create
479 { "object" "kernel" }
481 { "curry-obj" "kernel" }
484 { "object" "kernel" }
486 { "curry-quot" "kernel" }
491 "curry" "kernel" lookup
492 [ f "inline" set-word-prop ]
494 [ tuple-layout [ <tuple-boa> ] curry ] tri define
496 "compose" "kernel" create
500 { "object" "kernel" }
502 { "compose-first" "kernel" }
505 { "object" "kernel" }
507 { "compose-second" "kernel" }
512 "compose" "kernel" lookup
513 [ f "inline" set-word-prop ]
515 [ tuple-layout [ <tuple-boa> ] curry ] tri define
518 : make-primitive ( word vocab n -- )
519 >r create dup reset-word r>
520 [ do-primitive ] curry [ ] like define ;
523 { "(execute)" "words.private" }
524 { "(call)" "kernel.private" }
525 { "bignum>fixnum" "math.private" }
526 { "float>fixnum" "math.private" }
527 { "fixnum>bignum" "math.private" }
528 { "float>bignum" "math.private" }
529 { "fixnum>float" "math.private" }
530 { "bignum>float" "math.private" }
531 { "<ratio>" "math.private" }
532 { "string>float" "math.private" }
533 { "float>string" "math.private" }
534 { "float>bits" "math" }
535 { "double>bits" "math" }
536 { "bits>float" "math" }
537 { "bits>double" "math" }
538 { "<complex>" "math.private" }
539 { "fixnum+" "math.private" }
540 { "fixnum+fast" "math.private" }
541 { "fixnum-" "math.private" }
542 { "fixnum-fast" "math.private" }
543 { "fixnum*" "math.private" }
544 { "fixnum*fast" "math.private" }
545 { "fixnum/i" "math.private" }
546 { "fixnum-mod" "math.private" }
547 { "fixnum/mod" "math.private" }
548 { "fixnum-bitand" "math.private" }
549 { "fixnum-bitor" "math.private" }
550 { "fixnum-bitxor" "math.private" }
551 { "fixnum-bitnot" "math.private" }
552 { "fixnum-shift" "math.private" }
553 { "fixnum-shift-fast" "math.private" }
554 { "fixnum<" "math.private" }
555 { "fixnum<=" "math.private" }
556 { "fixnum>" "math.private" }
557 { "fixnum>=" "math.private" }
558 { "bignum=" "math.private" }
559 { "bignum+" "math.private" }
560 { "bignum-" "math.private" }
561 { "bignum*" "math.private" }
562 { "bignum/i" "math.private" }
563 { "bignum-mod" "math.private" }
564 { "bignum/mod" "math.private" }
565 { "bignum-bitand" "math.private" }
566 { "bignum-bitor" "math.private" }
567 { "bignum-bitxor" "math.private" }
568 { "bignum-bitnot" "math.private" }
569 { "bignum-shift" "math.private" }
570 { "bignum<" "math.private" }
571 { "bignum<=" "math.private" }
572 { "bignum>" "math.private" }
573 { "bignum>=" "math.private" }
574 { "bignum-bit?" "math.private" }
575 { "bignum-log2" "math.private" }
576 { "byte-array>bignum" "math" }
577 { "float=" "math.private" }
578 { "float+" "math.private" }
579 { "float-" "math.private" }
580 { "float*" "math.private" }
581 { "float/f" "math.private" }
582 { "float-mod" "math.private" }
583 { "float<" "math.private" }
584 { "float<=" "math.private" }
585 { "float>" "math.private" }
586 { "float>=" "math.private" }
588 { "word-xt" "words" }
608 { "getenv" "kernel.private" }
609 { "setenv" "kernel.private" }
610 { "(exists?)" "io.files.private" }
611 { "(directory)" "io.files.private" }
613 { "gc-stats" "memory" }
614 { "save-image" "memory" }
615 { "save-image-and-exit" "memory" }
616 { "datastack" "kernel" }
617 { "retainstack" "kernel" }
618 { "callstack" "kernel" }
619 { "set-datastack" "kernel" }
620 { "set-retainstack" "kernel" }
621 { "set-callstack" "kernel" }
623 { "data-room" "memory" }
624 { "code-room" "memory" }
625 { "os-env" "system" }
626 { "millis" "system" }
627 { "tag" "kernel.private" }
628 { "modify-code-heap" "compiler.units" }
631 { "dlclose" "alien" }
632 { "<byte-array>" "byte-arrays" }
633 { "<bit-array>" "bit-arrays" }
634 { "<displaced-alien>" "alien" }
635 { "alien-signed-cell" "alien.accessors" }
636 { "set-alien-signed-cell" "alien.accessors" }
637 { "alien-unsigned-cell" "alien.accessors" }
638 { "set-alien-unsigned-cell" "alien.accessors" }
639 { "alien-signed-8" "alien.accessors" }
640 { "set-alien-signed-8" "alien.accessors" }
641 { "alien-unsigned-8" "alien.accessors" }
642 { "set-alien-unsigned-8" "alien.accessors" }
643 { "alien-signed-4" "alien.accessors" }
644 { "set-alien-signed-4" "alien.accessors" }
645 { "alien-unsigned-4" "alien.accessors" }
646 { "set-alien-unsigned-4" "alien.accessors" }
647 { "alien-signed-2" "alien.accessors" }
648 { "set-alien-signed-2" "alien.accessors" }
649 { "alien-unsigned-2" "alien.accessors" }
650 { "set-alien-unsigned-2" "alien.accessors" }
651 { "alien-signed-1" "alien.accessors" }
652 { "set-alien-signed-1" "alien.accessors" }
653 { "alien-unsigned-1" "alien.accessors" }
654 { "set-alien-unsigned-1" "alien.accessors" }
655 { "alien-float" "alien.accessors" }
656 { "set-alien-float" "alien.accessors" }
657 { "alien-double" "alien.accessors" }
658 { "set-alien-double" "alien.accessors" }
659 { "alien-cell" "alien.accessors" }
660 { "set-alien-cell" "alien.accessors" }
661 { "(throw)" "kernel.private" }
662 { "alien-address" "alien" }
663 { "slot" "slots.private" }
664 { "set-slot" "slots.private" }
665 { "string-nth" "strings.private" }
666 { "set-string-nth" "strings.private" }
667 { "resize-array" "arrays" }
668 { "resize-string" "strings" }
669 { "<array>" "arrays" }
670 { "begin-scan" "memory" }
671 { "next-object" "memory" }
672 { "end-scan" "memory" }
675 { "fopen" "io.streams.c" }
676 { "fgetc" "io.streams.c" }
677 { "fread" "io.streams.c" }
678 { "fputc" "io.streams.c" }
679 { "fwrite" "io.streams.c" }
680 { "fflush" "io.streams.c" }
681 { "fclose" "io.streams.c" }
682 { "<wrapper>" "kernel" }
683 { "(clone)" "kernel" }
684 { "<string>" "strings" }
685 { "array>quotation" "quotations.private" }
686 { "quotation-xt" "quotations" }
687 { "<tuple>" "classes.tuple.private" }
688 { "<tuple-layout>" "classes.tuple.private" }
689 { "profiling" "tools.profiler.private" }
690 { "become" "kernel.private" }
691 { "(sleep)" "threads.private" }
692 { "<float-array>" "float-arrays" }
693 { "<tuple-boa>" "classes.tuple.private" }
694 { "callstack>array" "kernel" }
695 { "innermost-frame-quot" "kernel.private" }
696 { "innermost-frame-scan" "kernel.private" }
697 { "set-innermost-frame-quot" "kernel.private" }
698 { "call-clear" "kernel" }
699 { "(os-envs)" "system.private" }
700 { "set-os-env" "system" }
701 { "unset-os-env" "system" }
702 { "(set-os-envs)" "system.private" }
703 { "resize-byte-array" "byte-arrays" }
704 { "resize-bit-array" "bit-arrays" }
705 { "resize-float-array" "float-arrays" }
706 { "dll-valid?" "alien" }
707 { "unimplemented" "kernel.private" }
708 { "gc-reset" "memory" }
710 dup length [ >r first2 r> make-primitive ] 2each
713 "build" "kernel" create build 1+ 1quotation define