--- gforth/prims2x.fs	2005/07/28 14:12:33	1.157
+++ gforth/prims2x.fs	2005/12/27 11:58:31	1.159
@@ -51,6 +51,7 @@
 \ (stack-in-index-xt and a test for stack==instruction-stream); there
 \ should be only one.
 
+
 \ for backwards compatibility, jaw
 require compat/strcomp.fs
 
@@ -102,6 +103,9 @@ variable include-skipped-insts
 \ inline arguments (false)
 include-skipped-insts off
 
+2variable threaded-code-pointer-type \ type used for geninst etc.
+s" Inst **" threaded-code-pointer-type 2!
+
 variable immarg \ values for immediate arguments (to be used in IMM_ARG macros)
 $12340000 immarg !
 
@@ -351,6 +355,9 @@ wordlist constant primitives
     \ address of number of stack items in effect out
     stack-number @ cells prim prim-stacks-out + ;
 
+: stack-prim-stacks-sync ( stack -- addr )
+    prim prim-stacks-sync swap stack-number @ th ;
+
 \ global vars
 variable c-line
 2variable c-filename
@@ -504,21 +511,24 @@ defer inst-stream-f ( -- stack )
     rdrop ;
 
 : same-as-in? ( item -- f )
- \ f is true iff the offset and stack of item is the same as on input
- >r
- r@ item-first @ if
-     rdrop false exit
- endif
- r@ item-name 2@ prim prim-items-wordlist @ search-wordlist 0= abort" bug"
- execute @
- dup r@ =
- if \ item first appeared in output
-   drop false
- else
-   dup  item-stack  @ r@ item-stack  @ = 
-   swap item-offset @ r@ item-offset @ = and
- endif
- rdrop ;
+    \ f is true iff the offset and stack of item is the same as on input
+    >r
+    r@ item-stack @ stack-prim-stacks-sync @ if
+	rdrop false exit
+    endif
+    r@ item-first @ if
+	rdrop false exit
+    endif
+    r@ item-name 2@ prim prim-items-wordlist @ search-wordlist 0= abort" bug"
+    execute @
+    dup r@ =
+    if \ item first appeared in output
+	drop false
+    else
+	dup  item-stack  @ r@ item-stack  @ = 
+	swap item-offset @ r@ item-offset @ = and
+    endif
+    rdrop ;
 
 : item-out-index ( item -- n )
     \ n is the index of item (in the out-effect)
@@ -616,7 +626,8 @@ does> ( item -- )
 	    UNLOOP EXIT
 	endif
 	-1 s+loop
-    \ we did not find a type, abort
+	\ we did not find a type, abort
+	abort
     false s" unknown prefix" ?print-error ;
 
 : declaration ( item -- )
@@ -650,9 +661,6 @@ does> ( item -- )
     stack item item-stack !
     item declaration ;
 
-: stack-prim-stacks-sync ( stack -- addr )
-    prim prim-stacks-sync swap stack-number @ th ;
-
 : set-prim-stacks-sync ( stack -- )
     stack-prim-stacks-sync on ;
 
@@ -667,7 +675,7 @@ get-current prefixes set-current
     item-stack @ dup if
 	set-prim-stacks-sync
     else \ prefixless "..." syncs all stacks
-	['] set-prim-stacks-sync map-stacks1
+	drop ['] set-prim-stacks-sync map-stacks1
     endif ;
 set-current
 
@@ -1165,9 +1173,10 @@ variable tail-nextp2 \ xt to execute for
 
 : output-gen ( -- )
     \ generate C code for generating VM instructions
-    ." void gen_" prim prim-c-name 2@ type ." (Inst **ctp" gen-args-parm ." )" cr
+    ." void gen_" prim prim-c-name 2@ type ." ("
+    threaded-code-pointer-type 2@ type ." ctp" gen-args-parm ." )" cr
     ." {" cr
-    ."   gen_inst(ctp, vm_prim[" function-number @ 0 .r ." ]);" cr
+    ."   gen_inst(ctp, " function-number @ 0 .r ." );" cr
     gen-args-gen
     ." }" cr ;
 
@@ -1800,7 +1809,11 @@ nl-char singleton eof-char over add-memb
 (( letter (( letter || digit )) **
 )) <- c-ident ( -- )
 
-(( ` # ?? (( letter || digit || ` : )) ++ (( ` . ` . ` . )) ??
+(( ` . ` . ` .
+)) <- sync-stack ( -- )
+
+(( ` # ?? (( letter || digit || ` : )) ++ sync-stack ??
+|| sync-stack
 )) <- stack-ident ( -- )
 
 (( nowhitebq nowhite ** ))