--- gforth/prims2x.fs	2001/12/09 19:12:45	1.101
+++ gforth/prims2x.fs	2002/08/07 10:11:18	1.107
@@ -312,26 +312,26 @@ defer inst-stream-f ( -- stack )
     item-stack @ stack-type @ type-c-name 2@ ;
 
 : fetch-single ( item -- )
- \ fetch a single stack item from its stack
- >r
- r@ item-name 2@ type
- ."  = vm_" r@ item-stack-type-name type
- ." 2" r@ item-type @ print-type-prefix ." ("
- r@ item-in-index r@ item-stack @ stack-access
- ." );" cr
- rdrop ; 
+    \ fetch a single stack item from its stack
+    >r
+    ." vm_" r@ item-stack-type-name type
+    ." 2" r@ item-type @ print-type-prefix ." ("
+    r@ item-in-index r@ item-stack @ stack-access ." ,"
+    r@ item-name 2@ type
+    ." );" cr
+    rdrop ; 
 
 : fetch-double ( item -- )
- \ fetch a double stack item from its stack
- >r
- ." vm_two"
- r@ item-stack-type-name type ." 2"
- r@ item-type @ print-type-prefix ." ("
- r@ item-name 2@ type ." , "
- r@ item-in-index r@ item-stack @ 2dup ." (Cell)" stack-access
- ." , "                      -1 under+ ." (Cell)" stack-access
- ." );" cr
- rdrop ;
+    \ fetch a double stack item from its stack
+    >r
+    ." vm_two"
+    r@ item-stack-type-name type ." 2"
+    r@ item-type @ print-type-prefix ." ("
+    r@ item-in-index r@ item-stack @ 2dup ." (Cell)" stack-access
+    ." , "                      -1 under+ ." (Cell)" stack-access
+    ." , " r@ item-name 2@ type
+    ." )" cr
+    rdrop ;
 
 : same-as-in? ( item -- f )
  \ f is true iff the offset and stack of item is the same as on input
@@ -355,12 +355,13 @@ defer inst-stream-f ( -- stack )
     >r r@ item-stack @ stack-out @ r> item-offset @ - 1- ;
 
 : really-store-single ( item -- )
- >r
- r@ item-out-index r@ item-stack @ stack-access ."  = vm_"
- r@ item-type @ print-type-prefix ." 2"
- r@ item-stack-type-name type ." ("
- r@ item-name 2@ type ." );"
- rdrop ;
+    >r
+    ." vm_"
+    r@ item-type @ print-type-prefix ." 2"
+    r@ item-stack-type-name type ." ("
+    r@ item-name 2@ type ." ,"
+    r@ item-out-index r@ item-stack @ stack-access ." );"
+    rdrop ;
 
 : store-single ( item -- )
  >r
@@ -385,7 +386,7 @@ defer inst-stream-f ( -- stack )
  r@ item-name 2@ type ." , "
  r@ item-out-index r@ item-stack @ 2dup stack-access
  ." , "                       -1 under+ stack-access
- ." );" cr
+ ." )" cr
  rdrop ;
 
 : single ( -- xt1 xt2 n )
@@ -423,7 +424,7 @@ wordlist constant prefixes
     stack r@ type-stack !
     rdrop ;
 
-: type-prefix ( xt1 xt2 n stack "prefix" -- )
+: type-prefix ( addr u xt1 xt2 n stack "prefix" -- )
     get-current >r prefixes set-current
     create-type r> set-current
 does> ( item -- )
@@ -672,10 +673,11 @@ stack inst-stream IP Cell
 
 : disasm-arg { item -- }
     item item-stack @ inst-stream = if
-	."   fputc(' ', vm_out); "
-	." printarg_" item item-type @ print-type-prefix
-	." ((" item item-type @ type-c-name 2@ type ." )"
-	." ip[" item item-offset @ 1+ 0 .r ." ]);" cr
+	." {" cr
+	item print-declaration
+	item fetch
+	item print-debug-arg
+	." }" cr
     endif ;
 
 : disasm-args ( -- )
@@ -683,7 +685,7 @@ stack inst-stream IP Cell
 
 : output-disasm ( -- )
     \ generate code for disassembling VM instructions
-    ." if (ip[0] == prim[" function-number @ 0 .r ." ]) {" cr
+    ." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr
     ."   fputs(" quote prim prim-name 2@ type quote ." , vm_out);" cr
     disasm-args
     ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
@@ -693,7 +695,7 @@ stack inst-stream IP Cell
 : output-profile ( -- )
     \ generate code for postprocessing the VM block profile stuff
     ." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr
-    ."   add_inst(b, " quote  prim prim-name 2@ type quote ." );" cr
+    ."   add_inst(b, " quote prim prim-name 2@ type quote ." );" cr
     ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
     prim prim-c-code 2@  s" SET_IP"    search nip nip
     prim prim-c-code 2@  s" SUPER_END" search nip nip or if
@@ -703,6 +705,30 @@ stack inst-stream IP Cell
     endif
     ." }" cr ;
 
+: output-profile-combined ( -- )
+    \ generate code for postprocessing the VM block profile stuff
+    ." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr
+    num-combined @ 0 +do
+	."   add_inst(b, " quote
+	combined-prims i th @ prim-name 2@ type
+	quote ." );" cr
+    loop
+    ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
+    combined-prims num-combined @ 1- th @ prim-c-code 2@  s" SET_IP"    search nip nip
+    combined-prims num-combined @ 1- th @ prim-c-code 2@  s" SUPER_END" search nip nip or if
+	."   return;" cr
+    else
+	."   goto _endif_;" cr
+    endif
+    ." }" cr ;
+
+: output-superend ( -- )
+    \ output flag specifying whether the current word ends a dynamic superinst
+    prim prim-c-code 2@  s" SET_IP"    search nip nip
+    prim prim-c-code 2@  s" SUPER_END" search nip nip or 0<>
+    prim prim-c-code 2@  s" SUPER_CONTINUE" search nip nip 0= and
+    negate 0 .r ." , /* " prim prim-name 2@ type ."  */" cr ;
+
 : gen-arg-parm { item -- }
     item item-stack @ inst-stream = if
 	." , " item item-type @ type-c-name 2@ type space
@@ -767,7 +793,7 @@ stack inst-stream IP Cell
 \      cr ;
 
 : output-label ( -- )  
-    ." (Label)&&I_" prim prim-c-name 2@ type ." ," cr ;
+    ." INST_ADDR(" prim prim-c-name 2@ type ." )," cr ;
 
 : output-alias ( -- ) 
     ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;
@@ -1221,6 +1247,7 @@ Variable c-flag
       line @ name-line ! filename 2@ name-filename 2!
       function-number @ prim prim-num !
       start }} forth-ident {{ end 2dup prim prim-name 2! prim prim-c-name 2! }}  white ++
+   (( ` / white ** {{ start }} c-ident {{ end prim prim-c-name 2! }} white ** )) ??
    (( simple-primitive || combined-primitive )) {{ 1 function-number +! }}
 )) <- primitive ( -- )