more work on assembler

diff --git a/library/compiler/assembly-x86.factor b/library/compiler/assembly-x86.factor
index 01beb90a71d91de315d8b5438383c10d9db91687..b2e0ca2ef31a9f6138fb6f5486f404f8b3103a45 100644 (file)
--- a/library/compiler/assembly-x86.factor
+++ b/library/compiler/assembly-x86.factor
@@ -30,6 +30,7 @@ USE: kernel
 USE: compiler
 USE: math
 USE: stack
+USE: combinators
 
 : EAX 0 ;
 : ECX 1 ;
@@ -48,16 +49,31 @@ USE: stack
 
 : I>R ( imm reg -- )
     #! MOV <imm> TO <reg>
-    HEX: b8 + compile-byte  compile-cell ;
+    dup EAX = [
+        drop HEX: b8 compile-byte
+    ] [
+        HEX: 8b compile-byte
+        3 shift BIN: 101 bitor compile-byte
+    ] ifte compile-cell ;
 
 : [I]>R ( imm reg -- )
     #! MOV INDIRECT <imm> TO <reg>
-    HEX: a1 + compile-byte  compile-cell ;
+    dup EAX = [
+        drop HEX: a1 compile-byte
+    ] [
+        HEX: 8d compile-byte
+        3 shift BIN: 101 bitor compile-byte
+    ] ifte compile-cell ;
 
 : I>[R] ( imm reg -- )
     #! MOV <imm> TO INDIRECT <reg>
     HEX: c7 compile-byte  compile-byte  compile-cell ;
 
+: R>[I] ( reg imm -- )
+    #! MOV INDIRECT <imm> TO <reg>.
+    #! Actually only works with EAX (?)
+    swap HEX: a3 + compile-byte  compile-cell ;
+
 : [R]>R ( reg reg -- )
     #! MOV INDIRECT <reg> TO <reg>.
     HEX: 8b compile-byte  swap 3 shift bitor compile-byte ;
@@ -91,16 +107,26 @@ USE: stack
     4 DATASTACK I+[I]
     ECX POP ;
 
-: (JMP) ( xt opcode -- )
+: POP-DS ( -- )
+    #! Pop datastack into EAX.
+    ( ECX PUSH )
+    DATASTACK ECX I>R
+    ! LEA...
+    HEX: 8d compile-byte HEX: 41 compile-byte HEX: fc compile-byte
+    EAX DATASTACK R>[I]
+    EAX EAX [R]>R
+    ( ECX POP ) ;
+
+: (JUMP) ( xt opcode -- )
     #! JMP, CALL insn is 5 bytes long
     #! addr is relative to *after* insn
     compile-byte  compiled-offset 4 + - compile-cell ;
 
-: JMP ( -- )
-    HEX: e9 (JMP) ;
+: JUMP ( -- )
+    HEX: e9 (JUMP) ;
 
 : CALL ( -- )
-    HEX: e8 (JMP) ;
+    HEX: e8 (JUMP) ;
 
 : RET ( -- )
     HEX: c3 compile-byte ;

diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index 14fde7ddb1458984f3701e4f62f5a1c8a817cf9b..8bab12a5bcb26bf6610e633108ff45cd4479e327 100644 (file)
--- a/library/compiler/compiler.factor
+++ b/library/compiler/compiler.factor
@@ -39,9 +39,8 @@ USE: logic
 USE: kernel
 USE: vectors
 
-: compile-word ( word -- )
-    #! Compile a JMP at the end (tail call optimization)
-    word-xt "compile-last" get [ JMP ] [ CALL ] ifte ;
+: pop-literal ( -- obj )
+    "compile-datastack" get vector-pop ;
 
 : compile-literal ( obj -- )
     dup fixnum? [
@@ -55,11 +54,27 @@ USE: vectors
     0 swap set-vector-length ;
 
 : postpone ( obj -- )
+    #! Literals are not compiled immediately, so that words like
+    #! ifte with special compilation behavior can work.
     "compile-datastack" get vector-push ;
 
+: compile-simple-word ( word -- )
+    #! Compile a JMP at the end (tail call optimization)
+    commit-literals word-xt
+    "compile-last" get [ JUMP ] [ CALL ] ifte ;
+
+: compile-word ( word -- )
+    #! If a word has a compiling property, then it has special
+    #! compilation behavior.
+    "compiling" over word-property dup [
+        nip call
+    ] [
+        drop compile-simple-word
+    ] ifte ;
+
 : compile-atom ( obj -- )
     [
-        [ word? ] [ commit-literals compile-word ]
+        [ word? ] [ compile-word ]
         [ drop t ] [ postpone ]
     ] cond ;
 

diff --git a/native/error.c b/native/error.c
index f0a77ee833ed4b819b70c2f326f7ff9d9c2190e3..29ce6771d6a5b7d190770afd2ca1b1b3ec344179 100644 (file)
--- a/native/error.c
+++ b/native/error.c
@@ -15,6 +15,8 @@ void critical_error(char* msg, CELL tagged)
 
 void fix_stacks(void)
 {
+       fprintf(stderr,"%x\n",ds);
+       fprintf(stderr,"%x\n",ds_bot);
        if(STACK_UNDERFLOW(ds,ds_bot)
                || STACK_OVERFLOW(ds,ds_bot))
                reset_datastack();