--- gforth/prims2x.fs	2004/12/31 13:23:58	1.152
+++ gforth/prims2x.fs	2005/07/27 19:44:20	1.156
@@ -246,7 +246,7 @@ variable next-state-number 0 next-state-
 
 : init-item ( addr u addr1 -- )
     \ initialize item at addr1 with name addr u
-    \ !! remove stack prefix
+    \ the stack prefix is removed by the stack-prefix
     dup item% %size erase
     item-name 2! ;
 
@@ -280,6 +280,7 @@ struct%
     cell%    field prim-effect-out-end
     cell% max-stacks * field prim-stacks-in  \ number of in items per stack
     cell% max-stacks * field prim-stacks-out \ number of out items per stack
+    cell% max-stacks * field prim-stacks-sync \ sync flag per stack
 end-struct prim%
 
 : make-prim ( -- prim )
@@ -649,6 +650,33 @@ does> ( item -- )
     stack item item-stack !
     item declaration ;
 
+get-current prefixes set-current
+: ... ( item -- )
+    \ this "prefix" ensures that the appropriate stack is synced with memory
+    dup item-name 2@ s" ..." str= 0= abort" '...' must end the item name"
+    item-stack @ dup if
+	stack-number @ prim prim-stacks-sync swap th on
+    else \ prefixless "..." syncs all stacks
+	max-stacks 0 +do
+	    prim prim-stacks-sync i th on
+	loop
+    endif ;
+set-current
+
+create ...-item ( -- addr ) \ just used for letting stack-prefixes work on it
+item% %allot                \ stores the stack temporarily until used by ...
+
+: init-item1 ( addr1 addr u -- addr2 )
+    \ initialize item at addr1 with name addr u, next item is at addr2
+    \ !! make sure that any mention of "..." is only stack-prefixed
+    2dup s" ..." search nip nip if ( addr1 addr u )
+	0 ...-item item-stack ! \ initialize to prefixless
+	2dup ...-item item-name 2!
+	...-item rot rot execute-prefix ( addr1 )
+    else
+	2 pick init-item item% %size +
+    endif ;
+
 \ types pointed to by stacks for use in combined prims
 \ !! output-c-combined shouldn't use these names!
 : stack-type-name ( addr u "name" -- )
@@ -745,7 +773,14 @@ stack inst-stream IP Cell
     prim prim-effect-out prim prim-effect-out-end @ ['] compute-offset-out map-items
     inst-stream stack-out @ 0= s" # can only be on the input side" ?print-error ;
 
+: init-simple { prim -- }
+    \ much of the initialization is elsewhere
+    max-stacks 0 +do
+	prim prim-stacks-sync i th off
+    loop ;
+
 : process-simple ( -- )
+    prim init-simple
     prim prim { W^ key } key cell
     combinations ['] constant insert-wordlist
     declarations compute-offsets
@@ -913,7 +948,9 @@ variable tail-nextp2 \ xt to execute for
 
 : output-label2 ( -- )
     ." LABEL2(" prim prim-c-name 2@ type ." )" cr
-    ." NEXT_P2;" cr ;
+    ." NEXT_P1_5;" cr
+    ." LABEL3(" prim prim-c-name 2@ type ." )" cr
+    ." DO_GOTO;" cr ;
 
 : output-c-tail1 { xt -- }
     \ the final part of the generated C code, with xt printing LABEL2 or not.
@@ -924,6 +961,16 @@ variable tail-nextp2 \ xt to execute for
     fill-state 
     xt execute ;
 
+: output-c-vm-jump-tail ( -- )
+    \ !! this functionality not yet implemented for superinstructions
+    output-super-end
+    print-debug-results
+    stores
+    fill-state 
+    ." LABEL2(" prim prim-c-name 2@ type ." )" cr
+    ." LABEL3(" prim prim-c-name 2@ type ." )" cr
+    ." DO_GOTO;" cr ;
+
 : output-c-tail1-no-stores { xt -- }
     \ the final part of the generated C code for combinations
     output-super-end
@@ -935,7 +982,11 @@ variable tail-nextp2 \ xt to execute for
     tail-nextp2 @ output-c-tail1 ;
 
 : output-c-tail2 ( -- )
-    ['] output-label2 output-c-tail1 ;
+    prim prim-c-code 2@ s" VM_JUMP(" search nip nip if
+	output-c-vm-jump-tail
+    else
+	['] output-label2 output-c-tail1
+    endif ;
 
 : output-c-tail-no-stores ( -- )
     tail-nextp2 @ output-c-tail1-no-stores ;
@@ -962,9 +1013,15 @@ variable tail-nextp2 \ xt to execute for
 
 : print-entry ( -- )
     ." LABEL(" prim prim-c-name 2@ type ." )" ;
-    
+
+: prim-type ( addr u -- )
+    \ print out a primitive, but avoid "*/"
+    2dup s" */" search  nip nip  IF
+	bounds ?DO  I c@ dup '* = IF  drop 'x  THEN  emit  LOOP
+    ELSE  type  THEN ;
+
 : output-c ( -- ) 
-    print-entry ."  /* " prim prim-name 2@ type
+    print-entry ."  /* " prim prim-name 2@ prim-type
     ."  ( " prim prim-stack-string 2@ type ." ) "
     state-in .state ." -- " state-out .state ."  */" cr
     ." /* " prim prim-doc 2@ type ."  */" cr
@@ -1044,7 +1101,7 @@ variable tail-nextp2 \ xt to execute for
     prim prim-branch?
     prim prim-c-code 2@  s" SUPER_END" search nip nip 0<> or
     prim prim-c-code 2@  s" SUPER_CONTINUE" search nip nip 0= and
-    negate 0 .r ." , /* " prim prim-name 2@ type ."  */" cr ;
+    negate 0 .r ." , /* " prim prim-name 2@ prim-type ."  */" cr ;
 
 : gen-arg-parm { item -- }
     item item-stack @ inst-stream = if
@@ -1450,7 +1507,7 @@ variable reprocessed-num 0 reprocessed-n
 
 : output-part ( p -- )
     to prim
-    ." /* " prim prim-name 2@ type ."  ( " prim prim-stack-string 2@ type ." ) */" cr
+    ." /* " prim prim-name 2@ prim-type ."  ( " prim prim-stack-string 2@ type ." ) */" cr
     ." NAME(" quote prim prim-name 2@ type quote ." )" cr \ debugging
     ." {" cr
     print-declarations
@@ -1558,7 +1615,7 @@ variable reprocessed-num 0 reprocessed-n
     \ prim-num @ 4 .r ." ," ;
 
 : output-name-comment ( -- )
-    ."  /* " prim prim-name 2@ type ."  */" ;
+    ."  /* " prim prim-name 2@ prim-type ."  */" ;
 
 variable offset-super2  0 offset-super2 ! \ offset into the super2 table
 
@@ -1698,7 +1755,7 @@ nl-char singleton eof-char over add-memb
 (( letter (( letter || digit )) **
 )) <- c-ident ( -- )
 
-(( ` # ?? (( letter || digit || ` : )) ++
+(( ` # ?? (( letter || digit || ` : )) ++ (( ` . ` . ` . )) ??
 )) <- stack-ident ( -- )
 
 (( nowhitebq nowhite ** ))
@@ -1753,8 +1810,8 @@ Variable c-flag
 
 (( ` \ comment-body nleof )) <- comment ( -- )
 
-(( {{ start }} stack-ident {{ end 2 pick init-item item% %size + }} white ** )) **
-<- stack-items
+(( {{ start }} stack-ident {{ end init-item1 }} white ** )) **
+<- stack-items ( addr1 -- addr2 )
 
 (( {{ prim prim-effect-in }}  stack-items {{ prim prim-effect-in-end ! }}
    ` - ` - white **