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 new-classes set
35 H{ } clone changed-definitions set
36 H{ } clone forgotten-definitions set
37 H{ } clone root-cache set
38 H{ } clone source-files set
39 H{ } clone update-map set
42 ! Vocabulary for slot accessors
43 "accessors" create-vocab drop
45 ! Trivial recompile hook. We don't want to touch the code heap
46 ! during stage1 bootstrap, it would just waste time.
47 [ drop { } ] recompile-hook set
53 ! After we execute bootstrap/layouts
54 num-types get f <array> builtins set
58 ! Create some empty vocabs where the below primitives and
69 "classes.tuple.private"
71 "continuations.private"
99 "tools.profiler.private"
104 } [ create-vocab drop ] each
107 : lo-tag-eq-quot ( n -- quot )
108 [ \ tag , , \ eq? , ] [ ] make ;
110 : hi-tag-eq-quot ( n -- quot )
112 [ dup tag ] % \ hi-tag tag-number , \ eq? ,
113 [ [ hi-tag ] % , \ eq? , ] [ ] make ,
118 : builtin-predicate-quot ( class -- quot )
121 [ lo-tag-eq-quot ] [ hi-tag-eq-quot ] if ;
123 : define-builtin-predicate ( class -- )
124 dup builtin-predicate-quot define-predicate ;
126 : lookup-type-number ( word -- n )
127 global [ target-word ] bind type-number ;
129 : register-builtin ( class -- )
130 [ dup lookup-type-number "type" set-word-prop ]
131 [ dup "type" word-prop builtins get set-nth ]
132 [ f f f builtin-class define-class ]
135 : define-builtin-slots ( symbol slotspec -- )
136 [ drop ] [ 1 simple-slots ] 2bi
137 [ "slots" set-word-prop ] [ define-slots ] 2bi ;
139 : define-builtin ( symbol slotspec -- )
140 >r [ define-builtin-predicate ] keep
141 r> define-builtin-slots ;
143 "fixnum" "math" create register-builtin
144 "bignum" "math" create register-builtin
145 "tuple" "kernel" create register-builtin
146 "ratio" "math" create register-builtin
147 "float" "math" create register-builtin
148 "complex" "math" create register-builtin
149 "f" "syntax" lookup register-builtin
150 "array" "arrays" create register-builtin
151 "wrapper" "kernel" create register-builtin
152 "float-array" "float-arrays" create register-builtin
153 "callstack" "kernel" create register-builtin
154 "string" "strings" create register-builtin
155 "bit-array" "bit-arrays" create register-builtin
156 "quotation" "quotations" create register-builtin
157 "dll" "alien" create register-builtin
158 "alien" "alien" create register-builtin
159 "word" "words" create register-builtin
160 "byte-array" "byte-arrays" create register-builtin
161 "tuple-layout" "classes.tuple.private" create register-builtin
163 ! Catch-all class for providing a default method.
164 "object" "kernel" create
165 [ f f { } intersection-class define-class ]
166 [ [ drop t ] "predicate" set-word-prop ]
169 "object?" "kernel" vocab-words delete-at
171 ! Class of objects with object tag
172 "hi-tag" "kernel.private" create
173 builtins get num-tags get tail define-union-class
175 ! Empty class with no instances
176 "null" "kernel" create
177 [ f { } f union-class define-class ]
178 [ [ drop f ] "predicate" set-word-prop ]
181 "null?" "kernel" vocab-words delete-at
183 "fixnum" "math" create { } define-builtin
184 "fixnum" "math" create ">fixnum" "math" create 1quotation "coercer" set-word-prop
186 "bignum" "math" create { } define-builtin
187 "bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop
189 "ratio" "math" create {
193 { "numerator" "math" }
199 { "denominator" "math" }
204 "float" "math" create { } define-builtin
205 "float" "math" create ">float" "math" create 1quotation "coercer" set-word-prop
207 "complex" "math" create {
211 { "real-part" "math" }
217 { "imaginary-part" "math" }
222 "f" "syntax" lookup { } define-builtin
224 "array" "arrays" create { } define-builtin
226 "wrapper" "kernel" create {
228 { "object" "kernel" }
230 { "wrapped" "kernel" }
235 "string" "strings" create {
237 { "array-capacity" "sequences.private" }
239 { "length" "sequences" }
242 { "object" "kernel" }
244 { "string-aux" "strings.private" }
245 { "set-string-aux" "strings.private" }
249 "quotation" "quotations" create {
251 { "object" "kernel" }
253 { "quotation-array" "quotations.private" }
257 { "object" "kernel" }
259 { "quotation-compiled?" "quotations" }
264 "dll" "alien" create {
266 { "byte-array" "byte-arrays" }
268 { "(dll-path)" "alien" }
274 "alien" "alien" create {
278 { "underlying-alien" "alien" }
281 { "object" "kernel" }
283 { "expired?" "alien" }
289 "word" "words" create {
292 { "object" "kernel" }
294 { "word-name" "words" }
295 { "set-word-name" "words" }
298 { "object" "kernel" }
300 { "word-vocabulary" "words" }
301 { "set-word-vocabulary" "words" }
304 { "quotation" "quotations" }
306 { "word-def" "words" }
307 { "set-word-def" "words.private" }
310 { "object" "kernel" }
312 { "word-props" "words" }
313 { "set-word-props" "words" }
316 { "object" "kernel" }
318 { "compiled?" "words" }
324 { "profile-counter" "tools.profiler.private" }
325 { "set-profile-counter" "tools.profiler.private" }
329 "byte-array" "byte-arrays" create { } define-builtin
331 "bit-array" "bit-arrays" create { } define-builtin
333 "float-array" "float-arrays" create { } define-builtin
335 "callstack" "kernel" create { } define-builtin
337 "tuple-layout" "classes.tuple.private" create {
341 { "layout-hashcode" "classes.tuple.private" }
347 { "layout-class" "classes.tuple.private" }
353 { "layout-size" "classes.tuple.private" }
359 { "layout-superclasses" "classes.tuple.private" }
365 { "layout-echelon" "classes.tuple.private" }
370 "tuple" "kernel" create {
371 [ { } define-builtin ]
372 [ { "delegate" } "slot-names" set-word-prop ]
373 [ define-tuple-layout ]
377 { "object" "kernel" }
379 { "delegate" "kernel" }
380 { "set-delegate" "kernel" }
383 [ drop ] [ generate-tuple-slots ] 2bi
384 [ "slots" set-word-prop ]
390 "f" "syntax" create [ not ] "predicate" set-word-prop
391 "f?" "syntax" vocab-words delete-at
393 ! Create special tombstone values
394 "tombstone" "hashtables.private" create
396 { } define-tuple-class
398 "((empty))" "hashtables.private" create
399 "tombstone" "hashtables.private" lookup f
400 2array >tuple 1quotation define-inline
402 "((tombstone))" "hashtables.private" create
403 "tombstone" "hashtables.private" lookup t
404 2array >tuple 1quotation define-inline
407 "hashtable" "hashtables" create
411 { "array-capacity" "sequences.private" }
413 { "hash-count" "hashtables.private" }
414 { "set-hash-count" "hashtables.private" }
416 { "array-capacity" "sequences.private" }
418 { "hash-deleted" "hashtables.private" }
419 { "set-hash-deleted" "hashtables.private" }
423 { "hash-array" "hashtables.private" }
424 { "set-hash-array" "hashtables.private" }
428 "sbuf" "sbufs" create
432 { "string" "strings" }
434 { "underlying" "growable" }
435 { "set-underlying" "growable" }
437 { "array-capacity" "sequences.private" }
439 { "length" "sequences" }
440 { "set-fill" "growable" }
444 "vector" "vectors" create
450 { "underlying" "growable" }
451 { "set-underlying" "growable" }
453 { "array-capacity" "sequences.private" }
455 { "length" "sequences" }
456 { "set-fill" "growable" }
460 "byte-vector" "byte-vectors" create
464 { "byte-array" "byte-arrays" }
466 { "underlying" "growable" }
467 { "set-underlying" "growable" }
469 { "array-capacity" "sequences.private" }
471 { "length" "sequences" }
472 { "set-fill" "growable" }
476 "curry" "kernel" create
480 { "object" "kernel" }
482 { "curry-obj" "kernel" }
485 { "object" "kernel" }
487 { "curry-quot" "kernel" }
492 "curry" "kernel" lookup
493 [ f "inline" set-word-prop ]
495 [ tuple-layout [ <tuple-boa> ] curry ] tri define
497 "compose" "kernel" create
501 { "object" "kernel" }
503 { "compose-first" "kernel" }
506 { "object" "kernel" }
508 { "compose-second" "kernel" }
513 "compose" "kernel" lookup
514 [ f "inline" set-word-prop ]
516 [ tuple-layout [ <tuple-boa> ] curry ] tri define
519 : make-primitive ( word vocab n -- )
520 >r create dup reset-word r>
521 [ do-primitive ] curry [ ] like define ;
524 { "(execute)" "words.private" }
525 { "(call)" "kernel.private" }
526 { "bignum>fixnum" "math.private" }
527 { "float>fixnum" "math.private" }
528 { "fixnum>bignum" "math.private" }
529 { "float>bignum" "math.private" }
530 { "fixnum>float" "math.private" }
531 { "bignum>float" "math.private" }
532 { "<ratio>" "math.private" }
533 { "string>float" "math.private" }
534 { "float>string" "math.private" }
535 { "float>bits" "math" }
536 { "double>bits" "math" }
537 { "bits>float" "math" }
538 { "bits>double" "math" }
539 { "<complex>" "math.private" }
540 { "fixnum+" "math.private" }
541 { "fixnum+fast" "math.private" }
542 { "fixnum-" "math.private" }
543 { "fixnum-fast" "math.private" }
544 { "fixnum*" "math.private" }
545 { "fixnum*fast" "math.private" }
546 { "fixnum/i" "math.private" }
547 { "fixnum-mod" "math.private" }
548 { "fixnum/mod" "math.private" }
549 { "fixnum-bitand" "math.private" }
550 { "fixnum-bitor" "math.private" }
551 { "fixnum-bitxor" "math.private" }
552 { "fixnum-bitnot" "math.private" }
553 { "fixnum-shift" "math.private" }
554 { "fixnum-shift-fast" "math.private" }
555 { "fixnum<" "math.private" }
556 { "fixnum<=" "math.private" }
557 { "fixnum>" "math.private" }
558 { "fixnum>=" "math.private" }
559 { "bignum=" "math.private" }
560 { "bignum+" "math.private" }
561 { "bignum-" "math.private" }
562 { "bignum*" "math.private" }
563 { "bignum/i" "math.private" }
564 { "bignum-mod" "math.private" }
565 { "bignum/mod" "math.private" }
566 { "bignum-bitand" "math.private" }
567 { "bignum-bitor" "math.private" }
568 { "bignum-bitxor" "math.private" }
569 { "bignum-bitnot" "math.private" }
570 { "bignum-shift" "math.private" }
571 { "bignum<" "math.private" }
572 { "bignum<=" "math.private" }
573 { "bignum>" "math.private" }
574 { "bignum>=" "math.private" }
575 { "bignum-bit?" "math.private" }
576 { "bignum-log2" "math.private" }
577 { "byte-array>bignum" "math" }
578 { "float=" "math.private" }
579 { "float+" "math.private" }
580 { "float-" "math.private" }
581 { "float*" "math.private" }
582 { "float/f" "math.private" }
583 { "float-mod" "math.private" }
584 { "float<" "math.private" }
585 { "float<=" "math.private" }
586 { "float>" "math.private" }
587 { "float>=" "math.private" }
589 { "word-xt" "words" }
609 { "getenv" "kernel.private" }
610 { "setenv" "kernel.private" }
611 { "(exists?)" "io.files.private" }
612 { "(directory)" "io.files.private" }
614 { "gc-stats" "memory" }
615 { "save-image" "memory" }
616 { "save-image-and-exit" "memory" }
617 { "datastack" "kernel" }
618 { "retainstack" "kernel" }
619 { "callstack" "kernel" }
620 { "set-datastack" "kernel" }
621 { "set-retainstack" "kernel" }
622 { "set-callstack" "kernel" }
624 { "data-room" "memory" }
625 { "code-room" "memory" }
626 { "os-env" "system" }
627 { "millis" "system" }
628 { "tag" "kernel.private" }
629 { "modify-code-heap" "compiler.units" }
632 { "dlclose" "alien" }
633 { "<byte-array>" "byte-arrays" }
634 { "<bit-array>" "bit-arrays" }
635 { "<displaced-alien>" "alien" }
636 { "alien-signed-cell" "alien.accessors" }
637 { "set-alien-signed-cell" "alien.accessors" }
638 { "alien-unsigned-cell" "alien.accessors" }
639 { "set-alien-unsigned-cell" "alien.accessors" }
640 { "alien-signed-8" "alien.accessors" }
641 { "set-alien-signed-8" "alien.accessors" }
642 { "alien-unsigned-8" "alien.accessors" }
643 { "set-alien-unsigned-8" "alien.accessors" }
644 { "alien-signed-4" "alien.accessors" }
645 { "set-alien-signed-4" "alien.accessors" }
646 { "alien-unsigned-4" "alien.accessors" }
647 { "set-alien-unsigned-4" "alien.accessors" }
648 { "alien-signed-2" "alien.accessors" }
649 { "set-alien-signed-2" "alien.accessors" }
650 { "alien-unsigned-2" "alien.accessors" }
651 { "set-alien-unsigned-2" "alien.accessors" }
652 { "alien-signed-1" "alien.accessors" }
653 { "set-alien-signed-1" "alien.accessors" }
654 { "alien-unsigned-1" "alien.accessors" }
655 { "set-alien-unsigned-1" "alien.accessors" }
656 { "alien-float" "alien.accessors" }
657 { "set-alien-float" "alien.accessors" }
658 { "alien-double" "alien.accessors" }
659 { "set-alien-double" "alien.accessors" }
660 { "alien-cell" "alien.accessors" }
661 { "set-alien-cell" "alien.accessors" }
662 { "(throw)" "kernel.private" }
663 { "alien-address" "alien" }
664 { "slot" "slots.private" }
665 { "set-slot" "slots.private" }
666 { "string-nth" "strings.private" }
667 { "set-string-nth" "strings.private" }
668 { "resize-array" "arrays" }
669 { "resize-string" "strings" }
670 { "<array>" "arrays" }
671 { "begin-scan" "memory" }
672 { "next-object" "memory" }
673 { "end-scan" "memory" }
676 { "fopen" "io.streams.c" }
677 { "fgetc" "io.streams.c" }
678 { "fread" "io.streams.c" }
679 { "fputc" "io.streams.c" }
680 { "fwrite" "io.streams.c" }
681 { "fflush" "io.streams.c" }
682 { "fclose" "io.streams.c" }
683 { "<wrapper>" "kernel" }
684 { "(clone)" "kernel" }
685 { "<string>" "strings" }
686 { "array>quotation" "quotations.private" }
687 { "quotation-xt" "quotations" }
688 { "<tuple>" "classes.tuple.private" }
689 { "<tuple-layout>" "classes.tuple.private" }
690 { "profiling" "tools.profiler.private" }
691 { "become" "kernel.private" }
692 { "(sleep)" "threads.private" }
693 { "<float-array>" "float-arrays" }
694 { "<tuple-boa>" "classes.tuple.private" }
695 { "callstack>array" "kernel" }
696 { "innermost-frame-quot" "kernel.private" }
697 { "innermost-frame-scan" "kernel.private" }
698 { "set-innermost-frame-quot" "kernel.private" }
699 { "call-clear" "kernel" }
700 { "(os-envs)" "system.private" }
701 { "set-os-env" "system" }
702 { "unset-os-env" "system" }
703 { "(set-os-envs)" "system.private" }
704 { "resize-byte-array" "byte-arrays" }
705 { "resize-bit-array" "bit-arrays" }
706 { "resize-float-array" "float-arrays" }
707 { "dll-valid?" "alien" }
708 { "unimplemented" "kernel.private" }
709 { "gc-reset" "memory" }
711 dup length [ >r first2 r> make-primitive ] 2each
714 "build" "kernel" create build 1+ 1quotation define