--- gforth/prim	2005/02/01 10:29:00	1.169
+++ gforth/prim	2005/08/02 12:00:51	1.174
@@ -100,6 +100,8 @@
 \E s" struct F83Name *"	single data-stack type-prefix f83name
 \E s" struct Longname *" single data-stack type-prefix longname
 \E 
+\E data-stack   stack-prefix S:
+\E fp-stack     stack-prefix F:
 \E return-stack stack-prefix R:
 \E inst-stream  stack-prefix #
 \E 
@@ -138,7 +140,7 @@
 
 \ Stack caching setup
 
-ifdef(`M4_ENGINE_FAST', `include(cache1.vmg)', `include(cache0.vmg)')
+ifdef(`STACK_CACHE_FILE', `include(STACK_CACHE_FILE)', `include(cache0.vmg)')
 
 \ these m4 macros would collide with identifiers
 undefine(`index')
@@ -291,7 +293,6 @@ assert(0);
 #else
 a_pfa = PFA(a_cfa);
 nest = (Cell)IP;
-IF_spTOS(spTOS = sp[0]);
 #ifdef DEBUG
     {
       CFA_TO_NAME(a_cfa);
@@ -408,37 +409,31 @@ condbranch(?branch,f --,f83	question_bra
 
 \+xconds
 
-?dup-?branch	( #a_target f -- f )	new	question_dupe_question_branch
+?dup-?branch	( #a_target f -- S:... )	new	question_dupe_question_branch
 ""The run-time procedure compiled by @code{?DUP-IF}.""
 if (f==0) {
-  sp++;
-  IF_spTOS(spTOS = sp[0]);
 #ifdef NO_IP
 INST_TAIL;
 JUMP(a_target);
 #else
 SET_IP((Xt *)a_target);
-  INST_TAIL; NEXT_P2;
 #endif
+} else {
+sp--;
+sp[0]=f;
 }
-SUPER_CONTINUE;
 
-?dup-0=-?branch ( #a_target f -- ) new	question_dupe_zero_equals_question_branch
+?dup-0=-?branch ( #a_target f -- S:... ) new	question_dupe_zero_equals_question_branch
 ""The run-time procedure compiled by @code{?DUP-0=-IF}.""
-/* the approach taken here of declaring the word as having the stack
-effect ( f -- ) and correcting for it in the branch-taken case costs a
-few cycles in that case, but is easy to convert to a CONDBRANCH
-invocation */
 if (f!=0) {
   sp--;
+  sp[0]=f;
 #ifdef NO_IP
   JUMP(a_target);
 #else
   SET_IP((Xt *)a_target);
-  NEXT;
 #endif
 }
-SUPER_CONTINUE;
 
 \+
 \fhas? skiploopprims 0= [IF]
@@ -1239,12 +1234,11 @@ UP=up=(char *)a_addr;
  up ! ;
 Variable UP
 
-sp@	( -- a_addr )		gforth		sp_fetch
-a_addr = sp+1;
+sp@	( S:... -- a_addr )		gforth		sp_fetch
+a_addr = sp;
 
-sp!	( a_addr -- )		gforth		sp_store
+sp!	( a_addr -- S:... )		gforth		sp_store
 sp = a_addr;
-/* works with and without spTOS caching */
 
 rp@	( -- a_addr )		gforth		rp_fetch
 a_addr = rp;
@@ -1254,10 +1248,10 @@ rp = a_addr;
 
 \+floating
 
-fp@	( -- f_addr )	gforth	fp_fetch
+fp@	( f:... -- f_addr )	gforth	fp_fetch
 f_addr = fp;
 
-fp!	( f_addr -- )	gforth	fp_store
+fp!	( f_addr -- f:... )	gforth	fp_store
 fp = f_addr;
 
 \+
@@ -1330,21 +1324,18 @@ tuck	( w1 w2 -- w2 w1 w2 )	core-ext
 :
  swap over ;
 
-?dup	( w -- w )			core	question_dupe
+?dup	( w -- S:... w )	core	question_dupe
 ""Actually the stack effect is: @code{( w -- 0 | w w )}.  It performs a
 @code{dup} if w is nonzero.""
 if (w!=0) {
-  IF_spTOS(*sp-- = w;)
-#ifndef USE_TOS
   *--sp = w;
-#endif
 }
 :
  dup IF dup THEN ;
 
-pick	( u -- w )			core-ext
+pick	( S:... u -- S:... w )		core-ext
 ""Actually the stack effect is @code{ x0 ... xu u -- x0 ... xu x0 }.""
-w = sp[u+1];
+w = sp[u];
 :
  1+ cells sp@ + @ ;
 
@@ -1791,20 +1782,17 @@ strsignal	( n -- c_addr u )	gforth
 c_addr = (Address)strsignal(n);
 u = strlen(c_addr);
 
-call-c	( w -- )	gforth	call_c
+call-c	( ... w -- ... )	gforth	call_c
 ""Call the C function pointed to by @i{w}. The C function has to
 access the stack itself. The stack pointers are exported in the global
 variables @code{SP} and @code{FP}.""
 /* This is a first attempt at support for calls to C. This may change in
    the future */
-IF_fpTOS(fp[0]=fpTOS);
 FP=fp;
 SP=sp;
 ((void (*)())w)();
 sp=SP;
 fp=FP;
-IF_spTOS(spTOS=sp[0]);
-IF_fpTOS(fpTOS=fp[0]);
 
 \+
 \+file
@@ -2150,10 +2138,13 @@ f2=FLAG(isdigit((unsigned)(sig[0]))!=0);
 siglen=strlen(sig);
 if (siglen>u) /* happens in glibc-2.1.3 if 999.. is rounded up */
   siglen=u;
+if (!f2) /* workaround Cygwin trailing 0s for Inf and Nan */
+  for (; sig[siglen-1]=='0'; siglen--);
+    ;
 memcpy(c_addr,sig,siglen);
 memset(c_addr+siglen,f2?'0':' ',u-siglen);
 
->float	( c_addr u -- flag )	float	to_float
+>float	( c_addr u -- f:... flag )	float	to_float
 ""Actual stack effect: ( c_addr u -- r t | f ).  Attempt to convert the
 character string @i{c-addr u} to internal floating-point
 representation. If the string represents a valid floating-point number
@@ -2163,9 +2154,8 @@ case and represents the floating-point n
 Float r;
 flag = to_float(c_addr, u, &r);
 if (flag) {
-  IF_fpTOS(fp[0] = fpTOS);
-  fp += -1;
-  fpTOS = r;
+  fp--;
+  fp[0]=r;
 }
 
 fabs	( r1 -- r2 )	float-ext	f_abs
@@ -2391,9 +2381,9 @@ f>l	( r -- )	gforth	f_to_l
 lp -= sizeof(Float);
 *(Float *)lp = r;
 
-fpick	( u -- r )		gforth
+fpick	( f:... u -- f:... r )		gforth
 ""Actually the stack effect is @code{ r0 ... ru u -- r0 ... ru r0 }.""
-r = fp[u+1]; /* +1, because update of fp happens before this fragment */
+r = fp[u];
 :
  floats fp@ + f@ ;
 
@@ -2431,13 +2421,10 @@ u3 = 0;
 #  endif
 #endif
 
-wcall	( u -- )	gforth
-IF_fpTOS(fp[0]=fpTOS);
+wcall	( ... u -- ... )	gforth
 FP=fp;
 sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP);
 fp=FP;
-IF_spTOS(spTOS=sp[0];)
-IF_fpTOS(fpTOS=fp[0]);
 
 \+FFCALL
 
@@ -2501,30 +2488,30 @@ av_longlong(alist, d);
 av-ptr-r	( R:c_addr -- )	gforth  av_ptr_r
 av_ptr(alist, void*, c_addr);
 
-av-call-void	( -- )	gforth  av_call_void
+av-call-void	( ... -- ... )	gforth  av_call_void
 SAVE_REGS
 av_call(alist);
 REST_REGS
 
-av-call-int	( -- w )	gforth  av_call_int
+av-call-int	( ... -- ... w )	gforth  av_call_int
 SAVE_REGS
 av_call(alist);
 REST_REGS
 w = irv;
 
-av-call-float	( -- r )	gforth  av_call_float
+av-call-float	( ... -- ... r )	gforth  av_call_float
 SAVE_REGS
 av_call(alist);
 REST_REGS
 r = frv;
 
-av-call-double	( -- r )	gforth  av_call_double
+av-call-double	( ... -- ... r )	gforth  av_call_double
 SAVE_REGS
 av_call(alist);
 REST_REGS
 r = drv;
 
-av-call-longlong	( -- d )	gforth  av_call_longlong
+av-call-longlong	( ... -- ... d )	gforth  av_call_longlong
 SAVE_REGS
 av_call(alist);
 REST_REGS
@@ -2535,7 +2522,7 @@ DHI_IS(d, 0);
 d = llrv;
 #endif
 
-av-call-ptr	( -- c_addr )	gforth  av_call_ptr
+av-call-ptr	( ... -- ... c_addr )	gforth  av_call_ptr
 SAVE_REGS
 av_call(alist);
 REST_REGS
@@ -2661,13 +2648,12 @@ compile-prim1 ( a_prim -- ) gforth compi
 ""compile prim (incl. immargs) at @var{a_prim}""
 compile_prim1(a_prim);
 
-finish-code ( -- ) gforth finish_code
+finish-code ( ... -- ... ) gforth finish_code
 ""Perform delayed steps in code generation (branch resolution, I-cache
 flushing).""
-IF_spTOS(sp[0]=spTOS); /* workaround for failing to save spTOS
-			  (gcc-2.95.1, gforth-fast --enable-force-reg) */
+/* The ... above are a workaround for a bug in gcc-2.95, which fails
+   to save spTOS (gforth-fast --enable-force-reg) */
 finish_code();
-IF_spTOS(spTOS=sp[0]);
 
 forget-dyncode ( c_code -- f ) gforth-internal forget_dyncode
 f = forget_dyncode(c_code);
@@ -2702,7 +2688,7 @@ a_addr = groups;
 
 \g static_super
 
-ifdef(`M4_ENGINE_FAST',
+ifdef(`STACK_CACHE_FILE',
 `include(peeprules.vmg)')
 
 \g end