new bootstrap system; some other code cleanups

TODO.FACTOR.txt

@@ -12,8 +12,6 @@
 - <array> ( length initial )
 - <string> ( length initial )
 - remove repetitions
-- load-indirect cannot use a scratch register since its vop is basic-blockish
-- benchmark/fib out of memory on powerpc
 - need something like uncons but for arbitrary sequences
 - on win64: to_cell will break
 - .h .b .o for ratios and floats is broken
@@ -87,38 +85,22 @@ parsing word sections:
 + compiler:
 
 - declare slot types for built-ins
-- check that set-datastack and set-callstack compile correctly in the
-  face of optimization
-- [ ] [ throw ] ifte ==> should raise 'unbalanced branches' error
 - remove dead code after a 'throw'
 - flushing optimization
 - [ [ dup call ] dup call ] infer hangs
-- compile continuations
-
-+ sequences:
-
-- split: return vectors
-- set-path: iterative
-- slice: if sequence or seq start is changed, abstraction violation
-- mutable strings simplifying string operarations
 
 + kernel:
 
-- first-class methods:
+- slice: if sequence or seq start is changed, abstraction violation
-  - methods outliner
+- annotations for methods
-  - annotations for methods
+- originating source file for methods
-  - originating source file for methods
-- reader syntax for byte arrays, displaced aliens
 - out of memory error when printing global namespace
-- merge timers with sleeping tasks
 - delegating generic words with a non-standard picker
 - code gc
 
 + i/o:
 
 - i/o tasks hanging around
-- faster stream-copy
-- reading and writing byte arrays
 - stream server can hang because of exception handler limitations
 - better i/o scheduler
 - if two tasks write to a unix stream, the buffer can overflow

contrib/httpd/html.factor

@@ -101,6 +101,16 @@ presentation sequences strings styles words ;
         drop call
     ] if ;
 
+TUPLE: wrapper-stream scope ;
+
+C: wrapper-stream ( stream -- stream )
+    2dup set-delegate [
+        >r stdio associate r> set-wrapper-stream-scope
+    ] keep ;
+
+: with-wrapper ( stream quot -- )
+    >r wrapper-stream-scope r> bind ; inline
+
 TUPLE: html-stream ;
 
 M: html-stream stream-write1 ( char stream -- )

library/alien/c-types.factor

@@ -31,7 +31,7 @@ SYMBOL: c-types
     >r <c-type> [ swap bind ] keep r> c-types get set-hash ;
     inline
 
-: bytes>cells cell / ceiling ;
+: bytes>cells cell get / ceiling ;
 
 : <c-object> ( size -- c-ptr ) bytes>cells <byte-array> ;
 
@@ -91,5 +91,3 @@ SYMBOL: c-types
 
 : typedef ( old new -- )
     over "*" append over "*" append (typedef) (typedef) ;
-
-global [ c-types nest drop ] bind

library/alien/compiler.factor

@@ -67,7 +67,7 @@ C: alien-node make-node ;
 
 : parameters alien-node-parameters reverse ;
 
-: c-aligned c-size cell align ;
+: c-aligned c-size cell get align ;
 
 : stack-space ( parameters -- n )
     0 [ c-aligned + ] reduce ;

library/alien/primitive-types.factor

@@ -6,8 +6,8 @@ math namespaces ;
     [
         >r >r alien-address r> r> set-alien-unsigned-cell
     ] "setter" set
-    cell "width" set
+    cell get "width" set
-    cell "align" set
+    cell get "align" set
     "box_alien" "boxer" set
     "unbox_alien" "unboxer" set
 ] "void*" define-primitive-type
@@ -33,8 +33,8 @@ math namespaces ;
 [
     [ alien-signed-cell ] "getter" set
     [ set-alien-signed-cell ] "setter" set
-    cell "width" set
+    cell get "width" set
-    cell "align" set
+    cell get "align" set
     "box_signed_cell" "boxer" set
     "unbox_signed_cell" "unboxer" set
 ] "long" define-primitive-type
@@ -42,8 +42,8 @@ math namespaces ;
 [
     [ alien-unsigned-cell ] "getter" set
     [ set-alien-unsigned-cell ] "setter" set
-    cell "width" set
+    cell get "width" set
-    cell "align" set
+    cell get "align" set
     "box_unsigned_cell" "boxer" set
     "unbox_unsigned_cell" "unboxer" set
 ] "ulong" define-primitive-type
@@ -108,8 +108,8 @@ math namespaces ;
         >r >r string>alien alien-address r> r>
         set-alien-unsigned-cell
     ] "setter" set
-    cell "width" set
+    cell get "width" set
-    cell "align" set
+    cell get "align" set
     "box_c_string" "boxer" set
     "unbox_c_string" "unboxer" set
 ] "char*" define-primitive-type
@@ -117,8 +117,8 @@ math namespaces ;
 [
     [ alien-unsigned-4 ] "getter" set
     [ set-alien-unsigned-4 ] "setter" set
-    cell "width" set
+    cell get "width" set
-    cell "align" set
+    cell get "align" set
     "box_utf16_string" "boxer" set
     "unbox_utf16_string" "unboxer" set
 ] "ushort*" define-primitive-type
@@ -126,8 +126,8 @@ math namespaces ;
 [
     [ alien-unsigned-4 0 = not ] "getter" set
     [ 1 0 ? set-alien-unsigned-4 ] "setter" set
-    cell "width" set
+    cell get "width" set
-    cell "align" set
+    cell get "align" set
     "box_boolean" "boxer" set
     "unbox_boolean" "unboxer" set
 ] "bool" define-primitive-type
@@ -135,8 +135,8 @@ math namespaces ;
 [
     [ alien-float ] "getter" set
     [ set-alien-float ] "setter" set
-    cell "width" set
+    cell get "width" set
-    cell "align" set
+    cell get "align" set
     "box_float" "boxer" set
     "unbox_float" "unboxer" set
     T{ float-regs f 4 } "reg-class" set
@@ -145,8 +145,8 @@ math namespaces ;
 [
     [ alien-double ] "getter" set
     [ set-alien-double ] "setter" set
-    cell 2 * "width" set
+    cell get 2 * "width" set
-    cell 2 * "align" set
+    cell get 2 * "align" set
     "box_double" "boxer" set
     "unbox_double" "unboxer" set
     T{ float-regs f 8 } "reg-class" set

library/alien/structs.factor

@@ -35,7 +35,7 @@ sequences strings words ;
     #! type is exactly like void*.
     [
         "width" set
-        cell "align" set
+        cell get "align" set
         [ swap <displaced-alien> ] "getter" set
     ] "struct-name" get define-c-type
     "struct-name" get "in" get init-c-type ;

library/alien/syntax.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Alex Chapman.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: alien
+IN: !syntax
-USING: compiler kernel lists math namespaces parser
+USING: alien compiler kernel lists math namespaces parser
-sequences words ;
+sequences syntax words ;
 
 ! usage of 'LIBRARY:' and 'FUNCTION:' :
 !

library/bootstrap/boot-stage1.factor

@@ -80,9 +80,6 @@ vectors words ;
         "/library/generic/math-combination.factor"
         "/library/generic/tuple.factor"
         
-        "/library/syntax/generic.factor"
-        "/library/syntax/parse-syntax.factor"
-        
         "/library/alien/aliens.factor"
         
         "/library/syntax/prettyprint.factor"
@@ -136,16 +133,111 @@ vectors words ;
         "/library/compiler/compiler.factor"
 
         "/library/alien/c-types.factor"
-        "/library/alien/primitive-types.factor"
         "/library/alien/structs.factor"
         "/library/alien/compiler.factor"
         "/library/alien/syntax.factor"
+        "/library/alien/malloc.factor"
+        
+        "/library/io/buffer.factor"
+
+        "/library/syntax/generic.factor"
 
         "/library/cli.factor"
         
         "/library/bootstrap/init.factor"
+        
+        "/library/sdl/sdl.factor"
+        "/library/sdl/sdl-video.factor"
+        "/library/sdl/sdl-event.factor"
+        "/library/sdl/sdl-keysym.factor"
+        "/library/sdl/sdl-keyboard.factor"
+        "/library/sdl/sdl-utils.factor"
+
+        "/library/opengl/gl.factor"
+        "/library/opengl/glu.factor"
+        "/library/opengl/opengl-utils.factor"
+
+        "/library/freetype/freetype.factor"
+        "/library/freetype/freetype-gl.factor"
+
+        "/library/ui/gadgets.factor"
+        "/library/ui/layouts.factor"
+        "/library/ui/hierarchy.factor"
+        "/library/ui/paint.factor"
+        "/library/ui/gestures.factor"
+        "/library/ui/theme.factor"
+        "/library/ui/hand.factor"
+        "/library/ui/frames.factor"
+        "/library/ui/world.factor"
+        "/library/ui/events.factor"
+        "/library/ui/borders.factor"
+        "/library/ui/labels.factor"
+        "/library/ui/buttons.factor"
+        "/library/ui/line-editor.factor"
+        "/library/ui/sliders.factor"
+        "/library/ui/scrolling.factor"
+        "/library/ui/menus.factor"
+        "/library/ui/editors.factor"
+        "/library/ui/splitters.factor"
+        "/library/ui/incremental.factor"
+        "/library/ui/panes.factor"
+        "/library/ui/books.factor"
+        "/library/ui/outliner.factor"
+        "/library/ui/presentations.factor"
+        "/library/ui/listener.factor"
+        "/library/ui/ui.factor"
+
+        "/library/help/database.factor"
+        "/library/help/markup.factor"
+        "/library/help/help.factor"
+        "/library/help/tutorial.factor"
+        "/library/help/syntax.factor"
+
+        "/library/syntax/parse-syntax.factor"
     } [ parse-resource % ] each
     
+    architecture get {
+        {
+            [ dup "x86" = ] [
+                {
+                    "/library/compiler/x86/assembler.factor"
+                    "/library/compiler/amd64/assembler.factor"
+                    "/library/compiler/amd64/architecture.factor"
+                    "/library/compiler/x86/generator.factor"
+                    "/library/compiler/x86/slots.factor"
+                    "/library/compiler/x86/stack.factor"
+                    "/library/compiler/x86/fixnum.factor"
+                    "/library/compiler/amd64/alien.factor"
+                }
+            ]
+        } {
+            [ dup "ppc" = ] [
+                {
+                    "/library/compiler/ppc/assembler.factor"
+                    "/library/compiler/ppc/architecture.factor"
+                    "/library/compiler/ppc/generator.factor"
+                    "/library/compiler/ppc/slots.factor"
+                    "/library/compiler/ppc/stack.factor"
+                    "/library/compiler/ppc/fixnum.factor"
+                    "/library/compiler/ppc/alien.factor"
+                }
+            ]
+        } {
+            [ dup "amd64" = ] [
+                {
+                    "/library/compiler/x86/assembler.factor"
+                    "/library/compiler/amd64/assembler.factor"
+                    "/library/compiler/amd64/architecture.factor"
+                    "/library/compiler/x86/generator.factor"
+                    "/library/compiler/x86/slots.factor"
+                    "/library/compiler/x86/stack.factor"
+                    "/library/compiler/x86/fixnum.factor"
+                    "/library/compiler/amd64/alien.factor"
+                }
+            ]
+        }
+    } cond [ parse-resource % ] each
+    
     [
         "/library/bootstrap/boot-stage2.factor" run-resource
         [ print-error die ] recover
@@ -160,3 +252,6 @@ vocabularies get [
 ] bind
 
 "!syntax" vocabularies get remove-hash
+
+H{ } clone crossref set
+recrossref

library/bootstrap/boot-stage2.factor

@@ -1,43 +1,10 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-USING: alien assembler compiler compiler-backend
+USING: compiler compiler-backend io io-internals kernel
-errors generic hashtables io io-internals kernel
 kernel-internals lists math memory namespaces optimizer parser
 sequences sequences-internals words ;
 
-"Loading compiler backend..." print
+"compile" get [
-
-cpu "x86" = [
-    "/library/compiler/x86/load.factor" run-resource
-] when
-
-cpu "ppc" = [
-    "/library/compiler/ppc/load.factor" run-resource
-] when
-
-cpu "amd64" = [
-    "/library/compiler/amd64/load.factor" run-resource
-] when
-
-"Loading more library code..." print
-
-[
-    "/library/alien/malloc.factor"
-    "/library/io/buffer.factor"
-
-    "/library/sdl/load.factor"
-    "/library/opengl/load.factor"
-    "/library/freetype/load.factor"
-    "/library/ui/load.factor"
-    "/library/help/load.factor"
-] [
-    run-resource
-] each
-
-! Handle -libraries:... overrides
-parse-command-line
-
-"compile" get supported-cpu? and [
     "native-io" get [
         unix? [
             "/library/unix/load.factor" run-resource
@@ -72,13 +39,10 @@ parse-command-line
 [
     boot
     run-user-init
-    "shell" get [ "shells" ] search execute
+    "shell" get "shells" lookup execute
     0 exit
 ] set-boot
 
-"Building cross-reference database..." print
-recrossref
-
 [ compiled? ] word-subset length
 number>string write " compiled words" print
 

library/bootstrap/image.factor

@@ -22,7 +22,9 @@ SYMBOL: objects
 
 ! Image output format
 SYMBOL: big-endian
-SYMBOL: 64-bits
+
+! Bootstrap architecture name
+SYMBOL: architecture
 
 : emit ( cell -- ) image get push ;
 
@@ -30,7 +32,7 @@ SYMBOL: 64-bits
     dup HEX: ffffffff bitand swap -32 shift HEX: ffffffff bitand ;
 
 : emit-64 ( cell -- )
-    64-bits get [
+    cell get 8 = [
         emit
     ] [
         d>w/w big-endian get [ swap ] unless emit emit
@@ -45,8 +47,7 @@ SYMBOL: 64-bits
 : image-magic HEX: 0f0e0d0c ;
 : image-version 0 ;
 
-: cell 64-bits get 8 4 ? ;
+: char cell get 2 /i ;
-: char 64-bits get 4 2 ? ;
 
 : untag ( cell tag -- ) tag-mask bitnot bitand ;
 : tag ( cell -- tag ) tag-mask bitand ;
@@ -93,7 +94,7 @@ GENERIC: ' ( obj -- ptr )
 ( Allocator )
 
 : here ( -- size ) 
-    image get length header-size - cell * base + ;
+    image get length header-size - cells base + ;
 
 : here-as ( tag -- pointer )
     here swap bitor ;
@@ -109,7 +110,7 @@ M: fixnum ' ( n -- tagged ) fixnum-tag immediate ;
 
 ( Bignums )
 
-: bignum-bits cell 8 * 2 - ;
+: bignum-bits cell-bits 2 - ;
 
 : bignum-radix bignum-bits 1 swap shift 1- ;
 
@@ -163,7 +164,7 @@ M: f ' ( obj -- ptr )
 ! The image begins with the header, then T,
 ! and the bignums 0, 1, and -1.
 
-: begin ( -- ) header t, 0, 1, -1, ;
+: begin-image ( -- ) header t, 0, 1, -1, ;
 
 ( Words )
 
@@ -296,9 +297,9 @@ M: hashtable ' ( hashtable -- pointer )
 
 : boot, ( quot -- ) ' boot-quot-offset fixup ;
 
-: heap-size image get length header-size - cell * ;
+: heap-size image get length header-size - cells ;
 
-: end ( quot -- )
+: end-image ( quot -- )
     "Generating words..." print
     words,
     "Generating global namespace..." print
@@ -307,12 +308,15 @@ M: hashtable ' ( hashtable -- pointer )
     boot,
     "Performing some word fixups..." print
     fixup-words
-    heap-size heap-size-offset fixup ;
+    heap-size heap-size-offset fixup
+    "Image length: " write image get length .
+    "Object cache size: " write objects get hash-size .
+    \ word global remove-hash ;
 
 ( Image output )
 
 : (write-image) ( image -- )
-    64-bits get 8 4 ? swap big-endian get [
+    cell swap big-endian get [
         [ swap >be write ] each-with
     ] [
         [ swap >le write ] each-with
@@ -322,33 +326,27 @@ M: hashtable ' ( hashtable -- pointer )
     "Writing image to " write dup write "..." print
     <file-writer> [ (write-image) ] with-stream ;
 
-: with-image ( quot -- image )
+: prepare-profile ( arch -- )
+    "/library/bootstrap/profile-" swap ".factor" append3
+    run-resource ;
+
+: prepare-image ( arch -- )
+    bootstrapping? on dup architecture set prepare-profile
+    800000 <vector> image set 20000 <hashtable> objects set ;
+
+: <image> ( architecture -- image )
     [
-        bootstrapping? on
+        prepare-image
-        800000 <vector> image set
+        begin-image
-        20000 <hashtable> objects set
+        "/library/bootstrap/boot-stage1.factor" run-resource
-        call
+        end-image
-        "Image length: " write image get length .
-        "Object cache size: " write objects get hash-size .
         image get
-        \ word global remove-hash
     ] with-scope ;
 
-: make-image ( name -- )
+: make-image ( architecture -- )
-    #! Make a bootstrap image.
+    #! Make a bootstrap image for the given architecture
-    [
+    #! (x86, ppc, or amd64).
-        begin
+    dup <image> "boot.image." rot append write-image ;
-        "/library/bootstrap/boot-stage1.factor" run-resource
-        end
-    ] with-image
-
-    swap write-image ;
 
 : make-images ( -- )
-    64-bits off
+    "x86" make-image "ppc" make-image "amd64" make-image ;
-    big-endian off "boot.image.le32" make-image
-    big-endian on  "boot.image.be32" make-image
-    64-bits on
-    big-endian off "boot.image.le64" make-image
-    big-endian on  "boot.image.be64" make-image
-    64-bits off ;

library/bootstrap/init.factor

@@ -11,7 +11,8 @@ parser threads words ;
     init-threads
     init-io
     "HOME" os-env [ "." ] unless* "~" set
+    17 getenv cell set
     init-error-handler
     default-cli-args
     parse-command-line
-    "null-stdio" get [ T{ null-stream } stdio set ] when ;
+    "null-stdio" get [ stdio off ] when ;

library/bootstrap/primitives.factor

@@ -1,18 +1,21 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: image
-USING: arrays alien generic hashtables io kernel
+USING: alien arrays generic hashtables io kernel
-kernel-internals lists math namespaces sequences strings vectors
+kernel-internals lists math namespaces parser sequences strings
-words ;
+vectors words ;
 
 ! Some very tricky code creating a bootstrap embryo in the
 ! host image.
 
 "Creating primitives and basic runtime structures..." print
 
+H{ } clone c-types set
+"/library/alien/primitive-types.factor" parse-resource
+
 ! These symbols need the same hashcode in the target as in the
 ! host.
-{ vocabularies typemap builtins }
+{ vocabularies typemap builtins c-types cell }
 
 ! Bring up a bare cross-compiling vocabulary.
 "syntax" vocab
@@ -22,6 +25,9 @@ crossref off
 
 vocabularies get [ "syntax" set [ reveal ] each ] bind
 
+! Call the quotation parsed from primitive-types.factor
+call
+
 : make-primitive ( { vocab word } n -- )
     >r first2 create r> f define ;
 

library/bootstrap/profile-amd64.factor

@@ -0,0 +1,6 @@
+USING: image kernel-internals namespaces ;
+
+! Do not load this file into a running image, ever.
+
+8 cell set
+big-endian off

library/bootstrap/profile-ppc.factor

@@ -0,0 +1,6 @@
+USING: image kernel-internals namespaces ;
+
+! Do not load this file into a running image, ever.
+
+4 cell set
+big-endian on

library/bootstrap/profile-x86.factor

@@ -0,0 +1,6 @@
+USING: image kernel-internals namespaces ;
+
+! Do not load this file into a running image, ever.
+
+4 cell set
+big-endian off

library/compiler/amd64/load.factor

@@ -1,14 +0,0 @@
-USING: io kernel parser sequences ;
-
-[
-    "/library/compiler/x86/assembler.factor"
-    "/library/compiler/amd64/assembler.factor"
-    "/library/compiler/amd64/architecture.factor"
-    "/library/compiler/x86/generator.factor"
-    "/library/compiler/x86/slots.factor"
-    "/library/compiler/x86/stack.factor"
-    "/library/compiler/x86/fixnum.factor"
-    "/library/compiler/amd64/alien.factor"
-] [
-    run-resource
-] each

library/compiler/assembler.factor

@@ -18,7 +18,7 @@ math memory namespaces ;
 
 : add-literal ( obj -- lit# )
     address literal-top [ set-compiled-cell ] keep
-    dup cell + set-literal-top ;
+    dup cell get + set-literal-top ;
 
 : assemble-1 ( n -- )
     compiled-offset set-compiled-1
@@ -30,7 +30,7 @@ math memory namespaces ;
 
 : assemble-cell ( n -- )
     compiled-offset set-compiled-cell
-    compiled-offset cell + set-compiled-offset ; inline
+    compiled-offset cell get + set-compiled-offset ; inline
 
 : begin-assembly ( -- code-len-fixup reloc-len-fixup )
     compiled-header assemble-cell

library/compiler/compiler.factor

@@ -4,9 +4,6 @@ USING: compiler-backend compiler-frontend errors inference io
 kernel lists math namespaces optimizer prettyprint sequences
 words ;
 
-: supported-cpu? ( -- ? )
-    cpu "unknown" = not ;
-
 : precompile ( quotation -- basic-blocks )
     dataflow optimize linearize split-blocks simplify ;
 

library/compiler/generator.factor

@@ -26,7 +26,7 @@ GENERIC: generate-node ( vop -- )
 : generate-reloc ( -- length )
     relocation-table get
     dup [ assemble-cell ] each
-    length cell * ;
+    length cells ;
 
 : (generate) ( word linear -- )
     #! Compile a word definition from linear IR.
@@ -68,4 +68,4 @@ M: %parameters generate-node ( vop -- ) drop ;
 
 : shift-add ( by -- n )
     #! Used in fixnum-shift overflow check.
-    1 swap cell 8 * swap 1- - shift ;
+    1 swap cell-bits * swap 1- - shift ;

library/compiler/intrinsics.factor

@@ -23,7 +23,7 @@ namespaces sequences words ;
 : slot@ ( node -- n/f )
     #! Compute slot offset.
     dup node-in-d reverse-slice dup first dup literal? [
-        literal-value cell * swap second
+        literal-value cells swap second
         rot value-tag dup [ - ] [ 2drop f ] if
     ] [
         3drop f
@@ -223,7 +223,7 @@ namespaces sequences words ;
 : negative-shift ( n -- )
     -1 %inc-d ,
     in-1
-    dup cell -8 * <= [
+    dup cell-bits neg * <= [
         drop 0 <vreg> 2 <vreg> %fixnum-sgn ,
         T{ vreg f 2 } 0 %replace-d ,
     ] [
@@ -232,7 +232,7 @@ namespaces sequences words ;
     ] if ;
 
 : positive-shift ( n -- )
-    dup cell 8 * tag-bits - <= [
+    dup cell-bits * tag-bits - <= [
         -1 %inc-d ,
         in-1
         0 <vreg> 0 <vreg> %fixnum<< ,

library/compiler/ppc/fixnum.factor

@@ -142,7 +142,7 @@ M: %fixnum>> generate-node ( vop -- )
     0 output-operand dup untag ;
 
 M: %fixnum-sgn generate-node ( vop -- )
-    drop dest/src cell 8 * 1- SRAWI 0 output-operand dup untag ;
+    drop dest/src cell-bits 1- SRAWI 0 output-operand dup untag ;
 
 : fixnum-jump ( -- label )
     1 input-operand 0 0 input-operand CMP label ;

library/compiler/ppc/load.factor

@@ -1,13 +0,0 @@
-USING: io kernel parser sequences ;
-
-[
-    "/library/compiler/ppc/assembler.factor"
-    "/library/compiler/ppc/architecture.factor"
-    "/library/compiler/ppc/generator.factor"
-    "/library/compiler/ppc/slots.factor"
-    "/library/compiler/ppc/stack.factor"
-    "/library/compiler/ppc/fixnum.factor"
-    "/library/compiler/ppc/alien.factor"
-] [
-    run-resource
-] each

library/compiler/ppc/slots.factor

@@ -14,7 +14,7 @@ kernel-internals lists math memory namespaces sequences words ;
     0 output-operand dup r> call ; inline
 
 M: %slot generate-node ( vop -- )
-    drop cell log2 [ 0 LWZ ] generate-slot ;
+    drop cell get log2 [ 0 LWZ ] generate-slot ;
 
 M: %fast-slot generate-node ( vop -- )
     drop 0 output-operand dup 0 input LWZ ;
@@ -29,7 +29,7 @@ M: %fast-slot generate-node ( vop -- )
     0 input-operand 2 input-operand r> call ; inline
 
 M: %set-slot generate-node ( vop -- )
-    drop cell log2 [ 0 STW ] generate-set-slot ;
+    drop cell get log2 [ 0 STW ] generate-set-slot ;
 
 M: %fast-set-slot generate-node ( vop -- )
     drop 0 input-operand 1 input-operand 2 input STW ;
@@ -43,7 +43,7 @@ M: %write-barrier generate-node ( vop -- )
     0 scratch dup card-mark ORI
     0 scratch 0 input-operand 0 STB ;
 
-: string-offset cell 3 * object-tag - ;
+: string-offset 3 cells object-tag - ;
 
 M: %char-slot generate-node ( vop -- )
     drop 1 [ string-offset LHZ ] generate-slot
@@ -59,8 +59,8 @@ M: %set-char-slot generate-node ( vop -- )
     "userenv" f dlsym swap LOAD32 0 rel-2/2 rel-userenv ;
 
 M: %getenv generate-node ( vop -- )
-    drop 0 output-operand dup dup userenv 0 input cell * LWZ ;
+    drop 0 output-operand dup dup userenv 0 input cells LWZ ;
 
 M: %setenv generate-node ( vop -- )
     drop 0 scratch userenv
-    0 input-operand 0 scratch 1 input cell * STW ;
+    0 input-operand 0 scratch 1 input cells STW ;

library/compiler/ppc/stack.factor

@@ -2,12 +2,12 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-backend
 USING: assembler compiler errors kernel kernel-internals math
-memory words ;
+memory namespaces words ;
 
 GENERIC: loc>operand
 
-M: ds-loc loc>operand ds-loc-n cell * neg 14 swap ;
+M: ds-loc loc>operand ds-loc-n cells neg 14 swap ;
-M: cs-loc loc>operand cs-loc-n cell * neg 15 swap ;
+M: cs-loc loc>operand cs-loc-n cells neg 15 swap ;
 
 M: %immediate generate-node ( vop -- )
     drop 0 input address 0 output-operand LOAD ;

library/compiler/x86/alien.factor

@@ -15,7 +15,7 @@ M: %parameter generate-node
 GENERIC: reg-size ( reg-class -- n )
 GENERIC: push-reg ( reg-class -- )
 
-M: int-regs reg-size drop cell ;
+M: int-regs reg-size drop cell get ;
 M: int-regs push-reg drop EAX PUSH ;
 
 M: float-regs reg-size float-regs-size ;

library/compiler/x86/assembler.factor

@@ -20,7 +20,7 @@ GENERIC: operand-64? ( op -- ? )
 
 M: object canonicalize ;
 M: object extended? drop f ;
-M: object operand-64? drop cell 8 = ;
+M: object operand-64? drop cell get 8 = ;
 
 ( Register operands -- eg, ECX                                 )
 : REGISTER:

library/compiler/x86/load.factor

@@ -1,13 +0,0 @@
-USING: io kernel parser sequences ;
-
-[
-    "/library/compiler/x86/assembler.factor"
-    "/library/compiler/x86/architecture.factor"
-    "/library/compiler/x86/generator.factor"
-    "/library/compiler/x86/slots.factor"
-    "/library/compiler/x86/stack.factor"
-    "/library/compiler/x86/fixnum.factor"
-    "/library/compiler/x86/alien.factor"
-] [
-    run-resource
-] each

library/compiler/x86/slots.factor

@@ -42,7 +42,7 @@ M: %set-slot generate-node ( vop -- )
 M: %fast-set-slot generate-node ( vop -- )
     drop 1 input-operand 2 input 2array 0 input-operand MOV ;
 
-: userenv@ ( n -- addr ) cell * "userenv" f dlsym + ;
+: userenv@ ( n -- addr ) cells "userenv" f dlsym + ;
 
 M: %getenv generate-node ( vop -- )
     drop

library/compiler/x86/stack.factor

@@ -4,7 +4,7 @@ IN: compiler-backend
 USING: alien arrays assembler compiler inference kernel
 kernel-internals lists math memory sequences words ;
 
-: reg-stack ( n reg -- op ) swap cell * neg 2array ;
+: reg-stack ( n reg -- op ) swap cells neg 2array ;
 
 M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
 
@@ -16,7 +16,7 @@ M: %peek generate-node ( vop -- )
 M: %replace generate-node ( vop -- )
     drop 0 output-operand 0 input-operand MOV ;
 
-: (%inc) 0 input cell * dup 0 > [ ADD ] [ neg SUB ] if ;
+: (%inc) 0 input cells dup 0 > [ ADD ] [ neg SUB ] if ;
 
 M: %inc-d generate-node ( vop -- ) drop ds-reg (%inc) ;
 

library/compiler/xt.factor

@@ -34,7 +34,7 @@ SYMBOL: relocation-table
 
 : rel, ( n -- ) relocation-table get push ;
 
-: cell-just-compiled compiled-offset cell - ;
+: cell-just-compiled compiled-offset cell get - ;
 
 : 4-just-compiled compiled-offset 4 - ;
 
@@ -47,10 +47,11 @@ SYMBOL: relocation-table
     #! Write a relocation instruction for the runtime image
     #! loader.
     over >r >r >r 16 shift r> 8 shift bitor r> bitor rel,
-    compiled-offset r> rel-absolute-cell = cell 4 ? - rel, ;
+    compiled-offset r> rel-absolute-cell = cell get 4 ? - rel, ;
 
 : rel-dlsym ( name dll class -- )
-    >r cons add-literal compiled-base - cell / r> 1 rel-type, ;
+    >r cons add-literal compiled-base - cell get / r>
+    1 rel-type, ;
 
 : rel-address ( class -- )
     #! Relocate address just compiled.

library/continuations.factor

@@ -10,31 +10,17 @@ USING: kernel kernel-internals ;
 IN: kernel
 USING: namespaces sequences ;
 
-TUPLE: continuation data c call name catch ;
+TUPLE: continuation data call name catch ;
-
-: c-stack ( -- c-stack )
-    #! In the interpreter, this is a no-op. The compiler has an
-    #! an intrinsic for this word.
-    f ;
-
-: set-c-stack ( c-stack -- )
-    [ "not supported" throw ] when ;
-
-: interpret ( quot -- )
-    #! Call the quotation in the interpreter. When compiled,
-    #! the quotation is ignored.
-    call ;
 
 : continuation ( -- interp )
     #! The continuation is reified from after the *caller* of
     #! this word returns. It must be declared inline for this
     #! invariant to be preserved in compiled code too.
-    datastack c-stack callstack [ dup pop* dup pop* ] interpret
+    datastack callstack dup pop* dup pop*
     namestack catchstack <continuation> ; inline
 
-: >continuation< ( continuation -- data c call name catch )
+: >continuation< ( continuation -- data call name catch )
     [ continuation-data ] keep
-    [ continuation-c ] keep
     [ continuation-call ] keep
     [ continuation-name ] keep
     continuation-catch ; inline
@@ -54,8 +40,9 @@ TUPLE: continuation data c call name catch ;
 
 : continue ( continuation -- )
     #! Restore a continuation.
-    >continuation< set-catchstack set-namestack set-callstack
+    >continuation<
-    >r set-datastack r> set-c-stack ; inline
+    set-catchstack set-namestack set-callstack set-datastack ;
+    inline
 
 : (continue-with) 9 getenv ;
 

library/freetype/freetype.factor

@@ -1,10 +1,16 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-USING: alien ;
+USING: alien kernel ;
 IN: freetype
 
 ! Some code to render TrueType fonts with OpenGL.
 
+"freetype" {
+    { [ os "macosx" = ] [ "libfreetype.dylib" ] }
+    { [ os "win32" = ] [ "freetype6.dll" ] }
+    { [ t ] [ "libfreetype.so.6" ] }
+} cond "cdecl" add-library
+
 LIBRARY: freetype
 
 TYPEDEF: uchar FT_Byte

library/freetype/load.factor

@@ -1,14 +0,0 @@
-USING: alien io kernel parser sequences ;
-
-"freetype" {
-    { [ os "macosx" = ] [ "libfreetype.dylib" ] }
-    { [ os "win32" = ] [ "freetype6.dll" ] }
-    { [ t ] [ "libfreetype.so.6" ] }
-} cond "cdecl" add-library
-    
-[
-    "/library/freetype/freetype.factor"
-    "/library/freetype/freetype-gl.factor"
-] [
-    run-resource
-] each

library/help/help.factor

@@ -10,15 +10,6 @@ namespaces parser sequences words ;
 
 : glossary ( name -- ) <term> help ;
 
-: HELP:
-    scan-word [ >array "help" set-word-prop ] [ ] ; parsing
-
-: ARTICLE:
-    [ >array [ first2 2 ] keep tail add-article ] [ ] ; parsing
-
-: GLOSSARY:
-    [ >array [ first 1 ] keep tail add-term ] [ ] ; parsing
-
 [ word? ] "Show word documentation" [ help ] define-command
 [ term? ] "Show term definition" [ help ] define-command
 [ link? ] "Show article" [ help ] define-command

library/help/load.factor

@@ -1,10 +0,0 @@
-USING: io kernel parser sequences ;
-
-[
-    "/library/help/database.factor"
-    "/library/help/markup.factor"
-    "/library/help/help.factor"
-    "/library/help/tutorial.factor"
-] [
-    run-resource
-] each

library/inference/known-words.factor

@@ -508,18 +508,4 @@ sequences strings vectors words prettyprint ;
 \ array>vector [ [ array ] [ vector ] ] "infer-effect" set-word-prop
 \ array>vector t "flushable" set-word-prop
 
-\ datastack [ [ ] [ vector ] ] "infer-effect" set-word-prop
-\ set-datastack [ [ vector ] [ ] ] "infer-effect" set-word-prop
-
-\ callstack [ [ ] [ vector ] ] "infer-effect" set-word-prop
-\ set-callstack [ [ vector ] [ ] ] "infer-effect" set-word-prop
-
-\ c-stack [
-    "c-stack cannot be compiled (yet)" throw
-] "infer" set-word-prop
-
-\ set-c-stack [
-    "set-c-stack cannot be compiled (yet)" throw
-] "infer" set-word-prop
-
 \ flush-icache [ [ ] [ ] ] "infer-effect" set-word-prop

library/io/stdio.factor

@@ -15,9 +15,6 @@ styles ;
 : terpri ( -- )              stdio get stream-terpri ;
 : close  ( -- )              stdio get stream-close ;
 
-: write-object ( string object -- )
-    presented associate format ;
-
 : write-outliner ( string object quot -- )
     [ outline set presented set ] make-hash format terpri ;
 

library/io/stream.factor

@@ -34,24 +34,11 @@ GENERIC: set-timeout   ( timeout stream -- )
     [ 2dup (stream-copy) ] [ stream-close stream-close ] cleanup ;
 
 ! Think '/dev/null'.
-TUPLE: null-stream ;
+M: f stream-flush drop ;
-M: null-stream stream-flush drop ;
+M: f stream-finish drop ;
-M: null-stream stream-finish drop ;
+M: f stream-readln drop f ;
-M: null-stream stream-readln drop f ;
+M: f stream-read 2drop f ;
-M: null-stream stream-read 2drop f ;
+M: f stream-read1 drop f ;
-M: null-stream stream-read1 drop f ;
+M: f stream-write1 2drop ;
-M: null-stream stream-write1 2drop ;
+M: f stream-format 3drop ;
-M: null-stream stream-format 3drop ;
+M: f stream-close drop ;
-M: null-stream stream-close drop ;
-
-! Sometimes, we want to have a delegating stream that uses stdio
-! words.
-TUPLE: wrapper-stream scope ;
-
-C: wrapper-stream ( stream -- stream )
-    2dup set-delegate [
-        >r stdio associate r> set-wrapper-stream-scope
-    ] keep ;
-
-: with-wrapper ( stream quot -- )
-    >r wrapper-stream-scope r> bind ; inline

library/math/constants.factor

@@ -1,5 +1,11 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
+IN: kernel-internals
+USING: namespaces math ;
+
+: cells cell get * ; inline
+: cell-bits 8 cells ; inline
+
 IN: math
 
 : i C{ 0 1 } ; inline
@@ -9,3 +15,6 @@ IN: math
 : e 2.7182818284590452354 ; inline
 : pi 3.14159265358979323846 ; inline
 : epsilon 2.2204460492503131e-16 ; inline
+: first-bignum 1 cell-bits tag-bits - 1- shift ; inline
+: most-positive-fixnum first-bignum 1- >fixnum ; inline
+: most-negative-fixnum first-bignum neg >fixnum ; inline

library/math/integer.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: math
-USING: errors generic kernel kernel-internals math sequences
+USING: errors generic kernel kernel-internals sequences
 sequences-internals ;
 
 UNION: integer fixnum bignum ;
@@ -32,15 +32,6 @@ UNION: integer fixnum bignum ;
 : next-power-of-2 ( n -- n )
     1 swap (next-power-of-2) ;
 
-: first-bignum ( -- n )
-    1 cell 8 * tag-bits - 1- shift ; inline
-
-: most-positive-fixnum ( -- n )
-    first-bignum 1- >fixnum ; inline
-
-: most-negative-fixnum ( -- n )
-    first-bignum neg >fixnum ; inline
-
 IN: math-internals
 
 : fraction> ( a b -- a/b )

library/opengl/gl.factor

@@ -4,7 +4,19 @@
 ! This file is based on the gl.h that comes with xorg-x11 6.8.2
 
 IN: opengl 
-USING: alien ;
+USING: alien kernel ;
+
+{
+    { [ os "macosx" = ] [ ] }
+    { [ os "win32" = ] [
+            "gl" "opengl32.dll" "stdcall" add-library
+            "glu" "glu32.dll" "stdcall" add-library
+    ] }
+    { [ t ] [
+            "gl" "libGL.so.1" "cdecl" add-library
+            "glu" "libGLU.so.1" "cdecl" add-library
+    ] }
+} cond
 
 TYPEDEF: uint    GLenum
 TYPEDEF: uchar   GLboolean

library/opengl/load.factor

@@ -1,21 +0,0 @@
-USING: alien io kernel parser sequences ;
-
-{
-    { [ os "macosx" = ] [ ] }
-    { [ os "win32" = ] [
-            "gl" "opengl32.dll" "stdcall" add-library
-            "glu" "glu32.dll" "stdcall" add-library
-    ] }
-    { [ t ] [
-            "gl" "libGL.so.1" "cdecl" add-library
-            "glu" "libGLU.so.1" "cdecl" add-library
-    ] }
-} cond
-
-[
-    "/library/opengl/gl.factor"
-    "/library/opengl/glu.factor"
-    "/library/opengl/opengl-utils.factor"
-] [
-    run-resource
-] each

library/sdl/load.factor

@@ -1,18 +0,0 @@
-USING: alien io kernel parser sequences ;
-
-{
-    { [ os "macosx" = ] [ ] }
-    { [ os "win32" = ] [ "sdl" "sdl.dll" "cdecl" add-library ] }
-    { [ t ] [ "sdl" "libSDL.so" "cdecl" add-library ] }
-} cond
-
-[
-    "/library/sdl/sdl.factor"
-    "/library/sdl/sdl-video.factor"
-    "/library/sdl/sdl-event.factor"
-    "/library/sdl/sdl-keysym.factor"
-    "/library/sdl/sdl-keyboard.factor"
-    "/library/sdl/sdl-utils.factor"
-] [
-    run-resource
-] each

library/sdl/sdl.factor

@@ -1,6 +1,13 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: sdl USING: alien ;
+IN: sdl
+USING: alien kernel ;
+
+{
+    { [ os "macosx" = ] [ ] }
+    { [ os "win32" = ] [ "sdl" "sdl.dll" "cdecl" add-library ] }
+    { [ t ] [ "sdl" "libSDL.so" "cdecl" add-library ] }
+} cond
 
 : SDL_INIT_TIMER        HEX: 00000001 ;
 : SDL_INIT_AUDIO        HEX: 00000010 ;

library/tools/interpreter.factor

@@ -30,12 +30,10 @@ SYMBOL: meta-executing
     meta-cf get [ meta-cf [ uncons ] change ] [ up next ] if ;
 
 : meta-interp ( -- interp )
-    meta-d get f meta-r get meta-n get meta-c get
+    meta-d get meta-r get meta-n get meta-c get <continuation> ;
-    <continuation> ;
 
 : set-meta-interp ( interp -- )
-    >continuation<
+    >continuation< meta-c set meta-n set meta-r set meta-d set ;
-    meta-c set meta-n set meta-r set drop meta-d set ;
 
 : host-word ( word -- )
     [

library/ui/load.factor

@@ -1,31 +0,0 @@
-USING: kernel parser sequences io ;
-[
-    "/library/ui/gadgets.factor"
-    "/library/ui/layouts.factor"
-    "/library/ui/hierarchy.factor"
-    "/library/ui/paint.factor"
-    "/library/ui/gestures.factor"
-    "/library/ui/theme.factor"
-    "/library/ui/hand.factor"
-    "/library/ui/frames.factor"
-    "/library/ui/world.factor"
-    "/library/ui/events.factor"
-    "/library/ui/borders.factor"
-    "/library/ui/labels.factor"
-    "/library/ui/buttons.factor"
-    "/library/ui/line-editor.factor"
-    "/library/ui/sliders.factor"
-    "/library/ui/scrolling.factor"
-    "/library/ui/menus.factor"
-    "/library/ui/editors.factor"
-    "/library/ui/splitters.factor"
-    "/library/ui/incremental.factor"
-    "/library/ui/panes.factor"
-    "/library/ui/books.factor"
-    "/library/ui/outliner.factor"
-    "/library/ui/presentations.factor"
-    "/library/ui/listener.factor"
-    "/library/ui/ui.factor"
-] [
-    run-resource
-] each

library/vocabularies.factor

@@ -41,8 +41,7 @@ SYMBOL: vocabularies
 
 : recrossref ( -- )
     #! Update word cross referencing information.
-    H{ } clone crossref global set-hash
+    crossref get clear-hash [ add-crossref ] each-word ;
-    [ add-crossref ] each-word ;
 
 : lookup ( name vocab -- word ) vocab ?hash ;