Fix compiler

core/bootstrap/image/image-tests.factor

@@ -0,0 +1,5 @@
+IN: temporary
+USING: bootstrap.image tools.test.infer ;
+
+\ ' must-infer
+\ write-image must-infer

core/bootstrap/primitives.factor

@@ -407,7 +407,8 @@ builtins get num-tags get tail f union-class define-class
 2array >tuple 1quotation define-inline
 
 ! Primitive words
-: make-primitive ( word vocab n -- ) >r create r> define ;
+: make-primitive ( word vocab n -- )
+    >r create dup reset-word r> define ;
 
 {
     { "(execute)" "words.private" }

core/bootstrap/stage2.factor

@@ -72,8 +72,8 @@ IN: bootstrap.stage2
         [ ] count-words " words total" print
 
         "Bootstrapping is complete." print
-        "Now, you can run ./factor -i=" write
+        "Now, you can run Factor:" print
-        "output-image" get print flush
+        vm write " -i=" write "output-image" get print flush
 
         "output-image" get resource-path save-image-and-exit
     ] if

core/compiler/compiler.factor

@@ -35,7 +35,8 @@ SYMBOL: compiler-hook
     ] [
         print-error f over compiled get set-at f
     ] recover
-    2dup ripple-up save-effect ;
+    2drop ;
+!    2dup ripple-up save-effect ;
 
 : delete-any ( assoc -- element )
     [ [ 2drop t ] assoc-find 2drop dup ] keep delete-at ;

core/compiler/test/simple.factor

@@ -59,3 +59,7 @@ IN: temporary
 
 [ [ dup ] compile-call ] unit-test-fails
 [ [ drop ] compile-call ] unit-test-fails
+
+! Regression
+
+[ ] [ [ callstack ] compile-call drop ] unit-test

core/compiler/test/templates-early.factor

@@ -44,7 +44,7 @@ words kernel math effects ;
 [
     [ ] [ init-templates ] unit-test
 
-    [ ] [ init-generator ] unit-test
+    [ ] [ \ + init-generator ] unit-test
 
     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
 

core/cpu/x86/bootstrap.factor.new

@@ -1,68 +0,0 @@
-[! Copyright (C) 2007 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private kernel namespaces system
-cpu.x86.assembler layouts vocabs math ;
-IN: bootstrap.x86
-
-big-endian off
-
-1 jit-code-format set
-
-: stack-frame-size 4 bootstrap-cells ;
-
-[
-    arg0 0 MOV
-    stack-frame-size PUSH                      ! save stack frame size
-    arg0 PUSH                                  ! save XT
-    0 PUSH                                     ! reserved
-] { } make jit-prolog set
-
-[
-    arg0 0 [] MOV                              ! load literal
-    ds-reg bootstrap-cell ADD                  ! increment datastack pointer
-    ds-reg [] arg0 MOV                         ! store literal on datastack
-] { } make jit-push-literal set
-
-[
-    arg1 stack-reg MOV                         ! pass callstack pointer as arg 2
-] { } make jit-word-primitive-jump set
-
-[
-    arg1 stack-reg bootstrap-cell neg [+] LEA  ! pass callstack pointer as arg 2
-] { } make jit-word-primitive-call set
-
-[
-    0 JMP
-] { } make jit-word-jump set
-
-[
-    0 CALL
-] { } make jit-word-call set
-
-[
-    arg1 0 MOV                                 ! load addr of true quotation
-    arg0 ds-reg [] MOV                         ! load boolean
-    ds-reg bootstrap-cell SUB                  ! pop boolean
-    arg0 \ f tag-number CMP                    ! compare it with f
-    arg0 arg1 [] CMOVE                         ! load false branch if equal
-    arg0 arg1 bootstrap-cell [+] CMOVNE        ! load true branch if not equal
-    arg0 quot-xt@ [+] JMP                      ! execute branch
-] { } make jit-if set
-
-[
-    arg1 0 [] MOV                              ! load dispatch table
-    arg0 ds-reg [] MOV                         ! load index
-    fixnum>slot@                               ! turn it into an array offset
-    ds-reg bootstrap-cell SUB                  ! pop index
-    arg0 arg1 ADD                              ! compute quotation location
-    arg0 arg0 array-start [+] MOV              ! load quotation
-    arg0 quot-xt@ [+] JMP                      ! execute branch
-] { } make jit-dispatch set
-
-[
-    stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame
-] { } make jit-epilog set
-
-[ 0 RET ] { } make jit-return set
-
-"bootstrap.x86" forget-vocab