--- gforth/prims2x0.6.2.fs	2009/02/17 20:48:47	1.6
+++ gforth/prims2x0.6.2.fs	2009/12/31 15:32:35	1.9
@@ -1,6 +1,6 @@
 \ converts primitives to, e.g., C code 
 
-\ Copyright (C) 1995,1996,1997,1998,2000,2003,2008 Free Software Foundation, Inc.
+\ Copyright (C) 1995,1996,1997,1998,2000,2003,2008,2009 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -54,6 +54,10 @@
 \ for backwards compatibility, jaw
 require compat/strcomp.fs
 
+[undefined] endtry-iferror [if]
+    : endtry-iferror postpone recover ; immediate compile-only
+[then]
+
 warnings off
 
 \ redefinitions of kernel words not present in gforth-0.6.1
@@ -71,7 +75,7 @@ warnings off
 
 include ./gray.fs
 128 constant max-effect \ number of things on one side of a stack effect
-4 constant max-stacks  \ the max. number of stacks (including inst-stream).
+9 constant max-stacks  \ the max. number of stacks (including inst-stream).
 255 constant maxchar
 maxchar 1+ constant eof-char
 #tab constant tab-char
@@ -315,6 +319,17 @@ create depths max-stacks max-combined 1+
 : s-c-depth  ( nstack ncomponent -- addr )
     max-stacks * + cells depths + ;
 
+: print-depths1 { stack# xt -- }
+    num-combined @ 1+ 0 +do
+        stack# i xt execute @ 3 .r
+    loop ;
+
+: print-depths { stack# -- }
+    \ for debugging
+    cr ."          depths: " stack# [']          s-c-depth print-depths1
+    cr ."      max-depths: " stack# [']      s-c-max-depth print-depths1
+    cr ." max-back-depths: " stack# ['] s-c-max-back-depth print-depths1 ;
+
 : final-max-depth? { nstack ncomponent -- flag }
     \ does the stack reach its final maxdepth before the component?
     nstack ncomponent s-c-max-depth @
@@ -679,12 +694,14 @@ stack inst-stream IP Cell
 : flush-tos ( -- )
     ['] flush-a-tos map-stacks1 ;
 
-: fill-a-tos { stack -- }
-    stack stack-out @ 0= stack stack-in @ 0<> and
-    if
-	." IF_" stack stack-pointer 2@ 2dup type ." TOS("
-	2dup type ." TOS = " type 0 stack normal-stack-access0 ." );" cr
+: ?really-fill-a-tos { f stack -- }
+    f if
+        ." IF_" stack stack-pointer 2@ 2dup type ." TOS("
+        2dup type ." TOS = " type 0 stack normal-stack-access0 ." );" cr
     endif ;
+    
+: fill-a-tos { stack -- }
+    stack stack-out @ 0= stack stack-in @ 0<> and stack ?really-fill-a-tos ;
 
 : fill-tos ( -- )
     \ !! inst-stream for prefetching?
@@ -794,9 +811,6 @@ variable tail-nextp2 \ xt to execute for
 : output-c-tail2 ( -- )
     ['] output-label2 output-c-tail1 ;
 
-: output-c-tail-no-stores ( -- )
-    tail-nextp2 @ output-c-tail1-no-stores ;
-
 : output-c-tail2-no-stores ( -- )
     ['] output-label2 output-c-tail1-no-stores ;
 
@@ -1205,14 +1219,17 @@ variable tail-nextp2 \ xt to execute for
     print-debug-results
     stores ;
 
-: stack-combined-tail-stores { stack -- }
-    \ the top stack-out items of this part are stored elsewhere; so
-    \ this store everything between max-depth, unless it was stored
-    \ previously (below back-max-depth) and stack-out
+: stack-combined-tail-stores-limits { stack -- nupper nlower }
     stack stack-number @ part-num @ 2dup 2>r s-c-max-depth @ 
     2r> s-c-max-back-depth @ min
     stack stack-depth -
-    stack stack-out @ +do
+    stack stack-out @ ;
+
+: stack-combined-tail-stores { stack -- }
+    \ the top stack-out items of this part are stored elsewhere; so
+    \ this store everything between max-depth and stack-out, unless it
+    \ was stored previously (below back-max-depth)
+    stack stack-combined-tail-stores-limits +do
         i stack normal-stack-access ."  = "
         i stack part-stack-access ." ;" cr
     loop ;
@@ -1224,17 +1241,48 @@ variable tail-nextp2 \ xt to execute for
     \ earlier part).
     ['] stack-combined-tail-stores map-stacks ;
 
-: combined-tail-stack-pointer-update { stack -- }
+: combined-tail-stack-pointer-update-n { stack -- }
     stack stack-number @ { nstack }
     nstack part-num @ 1+ s-c-depth @ ( nupdate-raw )
     \ correct for possible earlier update
     nstack part-num @ 1+ final-max-depth? if
-        stack combined ['] stack-diff prim-context - endif
-    stack n-stack-pointer-update ;
+        stack combined ['] stack-diff prim-context -
+    endif ;
+
+: combined-tail-stack-pointer-update { stack -- }
+    stack combined-tail-stack-pointer-update-n stack n-stack-pointer-update ;
 
 : combined-tail-stack-pointer-updates ( -- )
     ['] combined-tail-stack-pointer-update map-stacks ;
 
+: stack-combined-tail-stores-limits { stack -- nupper nlower }
+    stack stack-number @ part-num @ 2dup 2>r s-c-max-depth @ 
+    2r> s-c-max-back-depth @ min
+    stack stack-depth -
+    stack stack-out @ ;
+
+: tail-fill-a-tos { stack -- }
+    \ 1 print-depths
+    stack stack-number @ part-num @ 2dup s-c-max-depth @ { scmde }
+    1+ 2dup s-c-max-depth @ { scmd } s-c-depth @ { scd }
+    scmd scd = scmd 0<> and \ normal fill (TOS consumed)
+    \ or it was stored to (what's now) sp[0] by an earlier part:
+    stack stack-combined-tail-stores-limits <= \ no stores in this tail
+    scmde 0= and \ there were stores to this stack earlier
+    stack combined-tail-stack-pointer-update-n 0<> and \ but not to spTOS
+    or stack ?really-fill-a-tos ;
+
+: tail-fill-tos ( -- )
+    \ fill tos in INST_TAIL
+    ['] tail-fill-a-tos map-stacks1 ;
+
+: output-c-tail-no-stores ( -- )
+    \ the final part of INST_TAIL
+    output-super-end
+    ." NEXT_P1;" cr
+    tail-fill-tos 
+    tail-nextp2 perform ;
+
 : output-combined-tail ( -- )
     in-part @ >r in-part off
     combined-tail-stack-pointer-updates