--- gforth/prims2x.fs	2007/02/24 14:45:53	1.166
+++ gforth/prims2x.fs	2011/12/31 15:29:25	1.175
@@ -1,12 +1,12 @@
 \ converts primitives to, e.g., C code 
 
-\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006 Free Software Foundation, Inc.
+\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2009,2010,2011 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
 \ Gforth is free software; you can redistribute it and/or
 \ modify it under the terms of the GNU General Public License
-\ as published by the Free Software Foundation; either version 2
+\ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.
 
 \ This program is distributed in the hope that it will be useful,
@@ -15,8 +15,7 @@
 \ GNU General Public License for more details.
 
 \ You should have received a copy of the GNU General Public License
-\ along with this program; if not, write to the Free Software
-\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
+\ along with this program. If not, see http://www.gnu.org/licenses/.
 
 
 \ This is not very nice (hard limits, no checking, assumes 1 chars = 1).
@@ -371,7 +370,7 @@ variable name-line
 2variable last-name-filename
 Variable function-number 0 function-number !
 Variable function-old 0 function-old !
-: function-diff ( n -- )
+: function-diff ( -- )
     ." GROUPADD(" function-number @ function-old @ - 0 .r ." )" cr
     function-number @ function-old ! ;
 : forth-fdiff ( -- )
@@ -685,7 +684,7 @@ get-current prefixes set-current
 set-current
 
 create ...-item ( -- addr ) \ just used for letting stack-prefixes work on it
-item% %allot                \ stores the stack temporarily until used by ...
+item% %allot drop           \ 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
@@ -922,11 +921,14 @@ stack inst-stream IP Cell
 : stack-pointer-update { stack -- }
     \ and moves
     \ stacks grow downwards
+\    ." /* stack pointer update " stack stack-pointer 2@ type ."  */" cr
     stack stack-prim-stacks-sync @ if
+\	." /* synced "  stack stack-in ? stack stack-out ? stack state-in  stack-offset . ." */" cr
 	stack stack-in @
 	stack state-in  stack-offset -
 	stack swap update-stack-pointer
     else
+\	." /* unsynced "  stack stack-in ? stack stack-out ? ." */" cr
 	stack stack-diff ( in-out )
 	stack state-in  stack-offset -
 	stack state-out stack-offset + ( [in-in_offset]-[out-out_offset] )
@@ -938,6 +940,7 @@ stack inst-stream IP Cell
     ['] stack-pointer-update map-stacks ;
 
 : stack-pointer-update2 { stack -- }
+\    ." /* stack pointer update2 " stack stack-pointer 2@ type ."  */" cr
     stack stack-prim-stacks-sync @ if
 	stack state-out stack-offset
 	stack stack-out @ -
@@ -1054,6 +1057,7 @@ variable tail-nextp2 \ xt to execute for
     tail-nextp2 @ output-c-tail1-no-stores ;
 
 : output-c-tail2-no-stores ( -- )
+    prim prim-c-code 2@ s" VM_JUMP(" search nip nip abort" Currently VM_JUMP is not supported in static superinstructions"
     ['] output-label2 output-c-tail1-no-stores ;
 
 : type-c-code ( c-addr u xt -- )
@@ -1349,6 +1353,7 @@ is output-c-prim-num
 \  NEXT_P2;
 
 : init-combined ( -- )
+    ['] clear-prim-stacks-sync map-stacks
     prim to combined
     0 num-combined !
     current-depth max-stacks cells erase
@@ -1556,8 +1561,8 @@ variable reprocessed-num 0 reprocessed-n
     stores ;
 
 : output-combined-tail ( -- )
-    part-output-c-tail
     in-part @ >r in-part off
+    part-output-c-tail
     combined ['] output-c-tail-no-stores prim-context
     r> in-part ! ;
 
@@ -1855,15 +1860,18 @@ Variable c-flag
 )) <- else-comment
 
 (( ` + {{ start }} nonl ** {{ end
-	dup
-	IF	c-flag @
-	    IF
-		function-diff
-		." #ifdef HAS_" bounds ?DO  I c@ toupper emit  LOOP cr
-		THEN
-		forth-flag @
-		IF  forth-fdiff  ." has? " type ."  [IF]"  cr THEN
-	ELSE	2drop
+        dup
+        IF
+            c-flag @ IF
+                function-diff
+                ." #ifdef HAS_" 2dup bounds ?DO  I c@ toupper emit  LOOP cr
+            THEN
+            forth-flag @ IF
+                forth-fdiff  ." has? " 2dup type ."  [IF]"  cr
+            THEN
+            2drop
+        ELSE
+            2drop
 	    c-flag @      IF
 		function-diff  ." #endif" cr THEN
 	    forth-flag @  IF  forth-fdiff  ." [THEN]"  cr THEN
@@ -1872,9 +1880,10 @@ Variable c-flag
 
 (( (( ` g || ` G )) {{ start }} nonl **
    {{ end
-      forth-flag @ IF  forth-fdiff  ." group " type cr  THEN
+      forth-flag @ IF  forth-fdiff  ." group " 2dup type cr  THEN
       c-flag @     IF  function-diff
-	  ." GROUP(" type ." , " function-number @ 0 .r ." )" cr  THEN }}
+          ." GROUP(" 2dup type ." , " function-number @ 0 .r ." )" cr  THEN
+      2drop }}
 )) <- group-comment
 
 (( (( eval-comment || forth-comment || c-comment || else-comment || if-comment || group-comment )) ?? nonl ** )) <- comment-body
@@ -1892,7 +1901,7 @@ Variable c-flag
 (( {{ prim create-prim prim init-simple }}
    ` ( white ** {{ start }} stack-effect {{ end prim prim-stack-string 2! }} ` ) white **
    (( {{ start }} forth-ident {{ end prim prim-wordset 2! }} white **
-      (( {{ start }}  c-ident {{ end 2dup prim-c-name-2! }} )) ??
+      (( {{ start }}  c-ident {{ end prim-c-name-2! }} )) ??
    )) ??  nleof
    (( ` " ` "  {{ start }} (( noquote ++ ` " )) ++ {{ end 1- prim prim-doc 2! }} ` " white ** nleof )) ??
    {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }}