--- gforth/prims2x.fs	2001/02/28 22:31:43	1.87
+++ gforth/prims2x.fs	2001/03/18 10:33:25	1.91
@@ -60,8 +60,8 @@ warnings off
 			\ different directory with the wordlibraries)
 include ./search.fs			
 include ./extend.fs
-[THEN]
 include ./stuff.fs
+[THEN]
 
 [IFUNDEF] environment?
 include ./environ.fs
@@ -585,6 +585,34 @@ s" IP" save-mem w s" error don't use # o
 : stores ( -- )
     prim prim-effect-out prim prim-effect-out-end @ ['] store map-items ;
 
+: print-debug-arg { item -- }
+    ." fputs(" quote space item item-name 2@ type ." =" quote ." , vm_out); "
+    ." printarg_" item item-type @ print-type-prefix
+    ." (" item item-name 2@ type ." );" cr ;
+    
+: print-debug-args ( -- )
+    ." #ifdef VM_DEBUG" cr
+    ." if (vm_debug) {" cr
+    prim prim-effect-in prim prim-effect-in-end @ ['] print-debug-arg map-items
+\    ." fputc('\n', vm_out);" cr
+    ." }" cr
+    ." #endif" cr ;
+
+: print-debug-result { item -- }
+    item item-first @ if
+	item print-debug-arg
+    endif ;
+
+: print-debug-results ( -- )
+    cr
+    ." #ifdef VM_DEBUG" cr
+    ." if (vm_debug) {" cr
+    ." fputs(" quote ."  -- " quote ." , vm_out); "
+    prim prim-effect-out prim prim-effect-out-end @ ['] print-debug-result map-items
+    ." fputc('\n', vm_out);" cr
+    ." }" cr
+    ." #endif" cr ;
+
 : output-super-end ( -- )
     prim prim-c-code 2@ s" SET_IP" search if
 	." SUPER_END;" cr
@@ -594,6 +622,7 @@ s" IP" save-mem w s" error don't use # o
 : output-c-tail ( -- )
     \ the final part of the generated C code
     output-super-end
+    print-debug-results
     ." NEXT_P1;" cr
     stores
     fill-tos
@@ -612,19 +641,6 @@ s" IP" save-mem w s" error don't use # o
     repeat
     2drop type ;
 
-: print-debug-arg { item -- }
-    ." fputs(" quote space item item-name 2@ type ." =" quote ." , vm_out); "
-    ." printarg_" item item-type @ print-type-prefix
-    ." (" item item-name 2@ type ." );" cr ;
-    
-: print-debug-args ( -- )
-    ." #ifdef VM_DEBUG" cr
-    ." if (vm_debug) {" cr
-    prim prim-effect-in prim prim-effect-in-end @ ['] print-debug-arg map-items
-    ." fputc('\n', vm_out);" cr
-    ." }" cr
-    ." #endif" cr ;
-
 : print-entry ( -- )
     ." I_" prim prim-c-name 2@ type ." :" ;
     
@@ -666,7 +682,8 @@ s" IP" save-mem w s" error don't use # o
     ."   fputs(" quote prim prim-name 2@ type quote ." , vm_out);" cr
     disasm-args
     ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
-    ." } else " ;
+    ."   goto _endif_;" cr
+    ." }" cr ;
 
 : output-profile ( -- )
     \ generate code for postprocessing the VM block profile stuff
@@ -676,8 +693,10 @@ s" IP" save-mem w s" error don't use # o
     prim prim-c-code 2@  s" SET_IP"    search nip nip
     prim prim-c-code 2@  s" SUPER_END" search nip nip or if
 	."   return;" cr
+    else
+	."   goto _endif_;" cr
     endif
-    ." } else " cr ;
+    ." }" cr ;
 
 : gen-arg-parm { item -- }
     item item-stack @ inst-stream = if
@@ -943,6 +962,7 @@ s" IP" save-mem w s" error don't use # o
     fetches ;
 
 : part-output-c-tail ( -- )
+    print-debug-results
     stores ;
 
 : output-combined-tail ( -- )
@@ -1013,6 +1033,15 @@ s" IP" save-mem w s" error don't use # o
     combined prim-c-name 2@ type ."  */"
     cr ;
 
+: output-forth-peephole ( -- )
+    combined-prims num-combined @ 1- cells combinations search-wordlist
+    s" the prefix for this combination must be defined earlier" ?print-error
+    execute prim-num @ 5 .r
+    combined-prims num-combined @ 1- th @ prim-num @ 5 .r
+    combined prim-num @ 5 .r ."  prim, \ "
+    combined prim-c-name 2@ type
+    cr ;
+
 
 \ the parser
 
@@ -1167,7 +1196,7 @@ Variable c-flag
 )) <- simple-primitive ( -- )
 
 (( {{ init-combined }}
-   ` = (( white ++ {{ start }} forth-ident {{ end add-prim }} )) ++
+   ` = white ** (( {{ start }} forth-ident {{ end add-prim }} white ** )) ++
    nleof {{ process-combined }}
 )) <- combined-primitive