bootstrap fix

TODO.FACTOR.txt

@@ -1,5 +1,6 @@
 + 0.80:
 
+- make-image leaks memory
 - does parsing cons excessive amounts of bignums with c-streams
 - -with combinators are awkward
 - cleanups:

library/bootstrap/boot-stage1.factor

@@ -201,13 +201,12 @@ vectors words ;
             [ dup "x86" = ] [
                 {
                     "/library/compiler/x86/assembler.factor"
-                    "/library/compiler/amd64/assembler.factor"
+                    "/library/compiler/x86/architecture.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"
+                    "/library/compiler/x86/alien.factor"
                 }
             ]
         } {
@@ -236,7 +235,7 @@ vectors words ;
                 }
             ]
         }
-    } cond [ parse-resource % ] each
+    } cond [ parse-resource % ] each drop
     
     [
         "/library/bootstrap/boot-stage2.factor" run-resource

library/bootstrap/image.factor

@@ -317,13 +317,16 @@ M: hashtable ' ( hashtable -- pointer )
 ( Image output )
 
 : (write-image) ( image -- )
-    cell swap big-endian get [
+    cell get swap big-endian get [
         [ swap >be write ] each-with
     ] [
         [ swap >le write ] each-with
     ] if ;
 
-: write-image ( image file -- )
+: image-name
+    "boot.image." architecture get append ;
+
+: write-image ( image -- )
     "Writing image to " write dup write "..." print
     <file-writer> [ (write-image) ] with-stream ;
 
@@ -335,19 +338,16 @@ M: hashtable ' ( hashtable -- pointer )
     bootstrapping? on dup architecture set prepare-profile
     800000 <vector> image set 20000 <hashtable> objects set ;
 
-: <image> ( architecture -- image )
+: make-image ( architecture -- )
+    #! Make a bootstrap image for the given architecture
+    #! (x86, ppc, or amd64).
     [
         prepare-image
         begin-image
         "/library/bootstrap/boot-stage1.factor" run-resource
         end-image
-        image get
+        image get image-name write-image
     ] with-scope ;
 
-: make-image ( architecture -- )
-    #! Make a bootstrap image for the given architecture
-    #! (x86, ppc, or amd64).
-    dup <image> "boot.image." rot append write-image ;
-
 : make-images ( -- )
     "x86" make-image "ppc" make-image "amd64" make-image ;

library/compiler/amd64/assembler.factor

@@ -3,20 +3,19 @@
 IN: assembler
 
 ! AMD64 registers
-REGISTER: RAX 0 64
+SYMBOL: RAX \ RAX 0  64 define-register
-REGISTER: RCX 1 64
+SYMBOL: RCX \ RCX 1  64 define-register
-REGISTER: RDX 2 64
+SYMBOL: RDX \ RDX 2  64 define-register
-REGISTER: RBX 3 64
+SYMBOL: RBX \ RBX 3  64 define-register
-REGISTER: RSP 4 64
+SYMBOL: RSP \ RSP 4  64 define-register
-REGISTER: RBP 5 64
+SYMBOL: RBP \ RBP 5  64 define-register
-REGISTER: RSI 6 64
+SYMBOL: RSI \ RSI 6  64 define-register
-REGISTER: RDI 7 64
+SYMBOL: RDI \ RDI 7  64 define-register
-
+SYMBOL: R8  \ R8  8  64 define-register
-REGISTER: R8 8 64
+SYMBOL: R9  \ R9  9  64 define-register
-REGISTER: R9 9 64
+SYMBOL: R10 \ R10 10 64 define-register
-REGISTER: R10 10 64
+SYMBOL: R11 \ R11 11 64 define-register
-REGISTER: R11 11 64
+SYMBOL: R12 \ R12 12 64 define-register
-REGISTER: R12 12 64
+SYMBOL: R13 \ R13 13 64 define-register
-REGISTER: R13 13 64
+SYMBOL: R14 \ R14 14 64 define-register
-REGISTER: R14 14 64
+SYMBOL: R15 \ R15 15 64 define-register
-REGISTER: R15 15 64

library/compiler/ppc/stack.factor

@@ -25,7 +25,7 @@ M: %replace generate-node ( vop -- )
     drop 0 input-operand 0 output loc>operand STW ;
 
 M: %inc-d generate-node ( vop -- )
-    drop 14 14 0 input cell * ADDI ;
+    drop 14 14 0 input cells ADDI ;
 
 M: %inc-r generate-node ( vop -- )
-    drop 15 15 0 input cell * ADDI ;
+    drop 15 15 0 input cells ADDI ;

library/compiler/x86/assembler.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: assembler
 USING: arrays compiler errors generic kernel kernel-internals
-lists math parser sequences words ;
+lists math namespaces parser sequences words ;
 
 ! A postfix assembler for x86 and AMD64.
 
@@ -23,29 +23,28 @@ M: object extended? drop f ;
 M: object operand-64? drop cell get 8 = ;
 
 ( Register operands -- eg, ECX                                 )
-: REGISTER:
+: define-register ( symbol num size -- )
-    CREATE dup define-symbol
+    >r dupd "register" set-word-prop r>
-    dup scan-word "register" set-word-prop
+    "register-size" set-word-prop ;
-    scan-word "register-size" set-word-prop ; parsing
 
 ! x86 registers
-REGISTER: AX 0 16
+SYMBOL: AX \ AX 0 16 define-register
-REGISTER: CX 1 16
+SYMBOL: CX \ CX 1 16 define-register
-REGISTER: DX 2 16
+SYMBOL: DX \ DX 2 16 define-register
-REGISTER: BX 3 16
+SYMBOL: BX \ BX 3 16 define-register
-REGISTER: SP 4 16
+SYMBOL: SP \ SP 4 16 define-register
-REGISTER: BP 5 16
+SYMBOL: BP \ BP 5 16 define-register
-REGISTER: SI 6 16
+SYMBOL: SI \ SI 6 16 define-register
-REGISTER: DI 7 16
+SYMBOL: DI \ DI 7 16 define-register
 
-REGISTER: EAX 0 32
+SYMBOL: EAX \ EAX 0 32 define-register
-REGISTER: ECX 1 32
+SYMBOL: ECX \ ECX 1 32 define-register
-REGISTER: EDX 2 32
+SYMBOL: EDX \ EDX 2 32 define-register
-REGISTER: EBX 3 32
+SYMBOL: EBX \ EBX 3 32 define-register
-REGISTER: ESP 4 32
+SYMBOL: ESP \ ESP 4 32 define-register
-REGISTER: EBP 5 32
+SYMBOL: EBP \ EBP 5 32 define-register
-REGISTER: ESI 6 32
+SYMBOL: ESI \ ESI 6 32 define-register
-REGISTER: EDI 7 32
+SYMBOL: EDI \ EDI 7 32 define-register
 
 PREDICATE: word register "register" word-prop ;
 

library/kernel.factor

@@ -139,4 +139,4 @@ IN: kernel-internals
 : float-tag   BIN: 101 ; inline
 : complex-tag BIN: 110 ; inline
 
-: cell 17 getenv ; inline
+SYMBOL: cell

library/test/compiler/optimizer.factor

@@ -50,11 +50,11 @@ IN: temporary
 
 [ t ] [ [ [ 1 ] [ 2 ] ] [ [ 1 ] [ 2 ] if ] kill-set= ] unit-test
 
-: literal-kill-test-1 4 compiled-offset cell 2 * - ; compiled
+: literal-kill-test-1 4 compiled-offset 2 cells - ; compiled
 
 [ 4 ] [ literal-kill-test-1 drop ] unit-test
 
-: literal-kill-test-2 3 compiled-offset cell 2 * - ; compiled
+: literal-kill-test-2 3 compiled-offset 2 cells - ; compiled
 
 [ 3 ] [ literal-kill-test-2 drop ] unit-test
 

library/test/kernel.factor

@@ -1,8 +1,12 @@
 IN: scratchpad
-USING: kernel memory namespaces sequences test ;
+USING: kernel kernel-internals math memory namespaces sequences
+test ;
 
 [ 0 ] [ f size ] unit-test
 [ t ] [ [ \ = \ = ] all-equal? ] unit-test
 
 ! (clone) primitive was missing GC check
 [ ] [ 1000000 [ drop H{ } clone >n n> drop ] each ] unit-test
+
+[ cell ] [ cell ] unit-test
+[ t ] [ cell get integer? ] unit-test