--- gforth/prims2x.fs	2002/12/27 16:22:03	1.124
+++ gforth/prims2x.fs	2003/01/30 17:11:02	1.131
@@ -162,6 +162,7 @@ struct%
     cell% 2* field stack-pointer \ stackpointer name
     cell%    field stack-type \ name for default type of stack items
     cell%    field stack-in-index-xt \ ( in-size item -- in-index )
+    cell%    field stack-access-transform \ ( nitem -- index )
 end-struct stack%
 
 struct%
@@ -197,7 +198,9 @@ create stacks max-stacks cells allot \ a
     1 next-stack-number +!
     r@ stack-type !
     save-mem r@ stack-pointer 2! 
-    ['] stack-in-index r> stack-in-index-xt ! ;
+    ['] stack-in-index r@ stack-in-index-xt !
+    ['] noop r@ stack-access-transform !
+    rdrop ;
 
 : map-stacks { xt -- }
     \ perform xt for all stacks
@@ -333,13 +336,15 @@ defer inst-stream-f ( -- stack )
 
 \ stack access stuff
 
-: normal-stack-access1 ( n stack -- )
-    stack-pointer 2@ type
-    dup
-    if
-	." [" 0 .r ." ]"
+: normal-stack-access0 { n stack -- }
+    n stack stack-access-transform @ execute ." [" 0 .r ." ]" ;
+    
+: normal-stack-access1 { n stack -- }
+    stack stack-pointer 2@ type
+    n if
+	n stack normal-stack-access0
     else
-	drop ." TOS"
+	." TOS"
     endif ;
 
 : normal-stack-access ( n stack -- )
@@ -645,7 +650,7 @@ stack inst-stream IP Cell
     stack stack-out @ 0<> stack stack-in @ 0= and
     if
 	." IF_" stack stack-pointer 2@ 2dup type ." TOS("
-	2dup type ." [0] = " type ." TOS);" cr
+	2dup type 0 stack normal-stack-access0 ."  = " type ." TOS);" cr
     endif ;
 
 : flush-tos ( -- )
@@ -655,7 +660,7 @@ stack inst-stream IP Cell
     stack stack-out @ 0= stack stack-in @ 0<> and
     if
 	." IF_" stack stack-pointer 2@ 2dup type ." TOS("
-	2dup type ." TOS = " type ." [0]);" cr
+	2dup type ." TOS = " type 0 stack normal-stack-access0 ." );" cr
     endif ;
 
 : fill-tos ( -- )
@@ -668,6 +673,12 @@ stack inst-stream IP Cell
 : fetches ( -- )
     prim prim-effect-in prim prim-effect-in-end @ ['] fetch map-items ;
 
+: stack-update-transform ( n1 stack -- n2 )
+    \ n2 is the number by which the stack pointer should be
+    \ incremented to pop n1 items
+    stack-access-transform @ dup >r execute
+    0 r> execute - ;
+
 : stack-pointer-update { stack -- }
     \ stacks grow downwards
     stack stack-diff
@@ -675,7 +686,8 @@ stack inst-stream IP Cell
 	stack inst-stream = if
 	    ." INC_IP(" 0 .r ." );" cr
 	else
-	    stack stack-pointer 2@ type ."  += " 0 .r ." ;" cr
+	    stack stack-pointer 2@ type ."  += "
+	    stack stack-update-transform 0 .r ." ;" cr
 	endif
     endif ;
 
@@ -1316,25 +1328,25 @@ print-token !
  getinput member? ;
 ' testchar? test-vector !
 
-: checksyncline ( -- )
+: checksynclines ( -- )
     \ when input points to a newline, check if the next line is a
     \ sync line.  If it is, perform the appropriate actions.
-    rawinput @ >r
-    s" #line " r@ over compare if
-	rdrop 1 line +! EXIT
-    endif
-    0. r> 6 chars + 20 >number drop >r drop line ! r> ( c-addr )
-    dup c@ bl = if
-	char+ dup c@ [char] " <> 0= s" sync line syntax" ?print-error
-	char+ dup 100 [char] " scan drop swap 2dup - save-mem filename 2!
-	char+
-    endif
-    dup c@ nl-char <> 0= s" sync line syntax" ?print-error
-    skipsynclines @ if
-	dup char+ rawinput !
-	rawinput @ c@ cookedinput @ c!
-    endif
-    drop ;
+    rawinput @ begin >r
+	s" #line " r@ over compare if
+	    rdrop 1 line +! EXIT
+	endif
+	0. r> 6 chars + 20 >number drop >r drop line ! r> ( c-addr )
+	dup c@ bl = if
+	    char+ dup c@ [char] " <> 0= s" sync line syntax" ?print-error
+	    char+ dup 100 [char] " scan drop swap 2dup - save-mem filename 2!
+	    char+
+	endif
+	dup c@ nl-char <> 0= s" sync line syntax" ?print-error
+	skipsynclines @ if
+	    char+ dup rawinput !
+	    rawinput @ c@ cookedinput @ c!
+	endif
+    again ;
 
 : ?nextchar ( f -- )
     s" syntax error, wrong char" ?print-error
@@ -1343,10 +1355,11 @@ print-token !
 	1 chars rawinput +!
 	1 chars cookedinput +!
 	nl-char = if
-	    checksyncline
+	    checksynclines
 	    rawinput @ line-start !
 	endif
-	rawinput @ c@ cookedinput @ c!
+	rawinput @ c@
+	cookedinput @ c!
     endif ;
 
 : charclass ( set "name" -- )
@@ -1424,7 +1437,7 @@ Variable c-flag
 (( (( ` g || ` G )) {{ start }} nonl **
    {{ end
       forth-flag @ IF  ." group " type cr  THEN
-      c-flag @     IF  ." GROUP(" type ." )" cr  THEN }}
+      c-flag @     IF  ." GROUP(" type ." , " function-number @ 0 .r ." )" cr  THEN }}
 )) <- group-comment
 
 (( (( eval-comment || forth-comment || c-comment || else-comment || if-comment || group-comment )) ?? nonl ** )) <- comment-body
@@ -1491,13 +1504,24 @@ warnings @ [IF]
     \ process the string at addr u
     over dup rawinput ! dup line-start ! cookedinput !
     + endrawinput !
-    checksyncline
+    checksynclines
     primitives2something ;    
 
+: unixify ( c-addr u1 -- c-addr u2 )
+    \ delete crs from the string
+    bounds tuck tuck ?do ( c-addr1 )
+	i c@ dup #cr <> if
+	    over c! char+
+	else
+	    drop
+	endif
+    loop
+    over - ;
+
 : process-file ( addr u xt-simple x-combined -- )
     output-combined ! output !
     save-mem 2dup filename 2!
-    slurp-file
+    slurp-file unixify
     warnings @ if
 	." ------------ CUT HERE -------------" cr  endif
     primfilter ;