Better compilation of code words (no need to use LIT-EXECUTE for them)

earl · May 2, 2010 · a85cf14 · a85cf14
1 parent 243c4fe
commit a85cf14
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 7 deletions.
diff --git a/abi-code-test.fs b/abi-code-test.fs
@@ -28,7 +28,7 @@ end-code
 
 : my-constant ( w "name" -- )
     create ,
-    ;abi-code ( -- w )
+;abi-code ( -- w )
     \ sp in di, address of fp in si, body address in dx
     -8 di d) ax lea \ compute new sp in result reg
     dx )     cx mov \ load w
@@ -45,7 +45,7 @@ foo-compiled 5 <> throw
 
 : my-constant2 ( w "name" -- )
     create ,
-    ;code ( -- w )
+;code ( -- w )
     \ sp=r15, tos=r14, ip=bx
     8 #        bx add
     r14     r15 ) mov
@@ -56,3 +56,23 @@ end-code
 
 7 my-constant2 bar
 : bar-compiled bar ;
+
+bar 7 <> throw
+bar-compiled 7 <> throw
+
+code my-1+ ( n1 -- n2 )
+    8 #        bx add
+    r14 inc
+    -8 bx d)   jmp
+end-code
+
+: compiled-my-1+
+    my-1+ ;
+
+7 my-1+ 8 <> throw
+8 compiled-my-1+ 9 <> throw
+
+: funny-compiler-test
+    drop my-1+ 1 ;
+
+\ 6 9 funny-compiler-test 1 <> throw 7 <> throw
diff --git a/engine/main.c b/engine/main.c
@@ -1832,9 +1832,6 @@ void compile_prim1(Cell *start)
 #elif defined(INDIRECT_THREADED)
   return;
 #else /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */
-  /* !! does not work, for unknown reasons; but something like this is
-     probably needed to ensure that we don't call compile_prim_dyn
-     before the inline arguments are there */
   static Cell *instps[MAX_BB];
   static PrimNum origs[MAX_BB];
   static int ninsts=0;
@@ -1853,9 +1850,12 @@ void compile_prim1(Cell *start)
   }
   prim_num = ((Xt)*start)-vm_prims;
   if(prim_num >= npriminfos) {
+    /* code word */
     optimize_rewrite(instps,origs,ninsts);
     /* fprintf(stderr,"optimize_rewrite(...,%d)\n",ninsts);*/
     ninsts=0;
+    append_jump();
+    *start = *(Cell *)*start;
     return;
   }    
   assert(ninsts<MAX_BB);

diff --git a/kernel/comp.fs b/kernel/comp.fs
@@ -294,8 +294,12 @@ has? primcentric [IF]
 	do;abicode: OF ['] ;abi-code-exec peephole-compile, , EXIT ENDOF
 	\ code words and ;code-defined words (code words could be
 	\ optimized, if we could identify them):
-	dup in-dictionary? IF
-	    drop ['] lit-execute peephole-compile, , EXIT
+	dup in-dictionary? IF ( xt code-address )
+	    over >body = if ( xt )
+		\ definitely a CODE word
+		peephole-compile, EXIT THEN
+	    \ not sure, might be a ;CODE word
+	    ['] lit-execute peephole-compile, , EXIT
 	    \ drop POSTPONE literal ['] execute peephole-compile, EXIT
 	THEN
     ENDCASE