--- gforth/prim	2003/08/20 09:23:45	1.139
+++ gforth/prim	2003/11/02 22:15:28	1.147
@@ -136,17 +136,23 @@
 \ throw execute, cfa and NEXT1 out?
 \ macroize *ip, ip++, *ip++ (pipelining)?
 
+\ Stack caching setup
+
+ifdef(`M4_ENGINE_FAST', `include(cache1.vmg)', `include(cache0.vmg)')
+
 \ these m4 macros would collide with identifiers
 undefine(`index')
 undefine(`shift')
 undefine(`symbols')
 
+\F 0 [if]
+
 \ run-time routines for non-primitives.  They are defined as
 \ primitives, because that simplifies things.
 
 (docol)	( -- R:a_retaddr )	gforth-internal	paren_docol
 ""run-time routine for colon definitions""
-a_retaddr = (Cell *)ip;
+a_retaddr = (Cell *)IP;
 SET_IP((Xt *)PFA(CFA));
 
 (docon) ( -- w )	gforth-internal	paren_docon
@@ -163,7 +169,8 @@ a_user = (Cell *)(up+*(Cell *)PFA(CFA));
 
 (dodefer) ( -- )	gforth-internal	paren_dodefer
 ""run-time routine for deferred words""
-SUPER_END;
+ip=IP; /* undo any ip updating that may have been performed by NEXT_P0 */
+SUPER_END; /* !! probably unnecessary and may lead to measurement errors */
 EXEC(*(Xt *)PFA(CFA));
 
 (dofield) ( n1 -- n2 )	gforth-internal	paren_field
@@ -172,7 +179,7 @@ n2 = n1 + *(Cell *)PFA(CFA);
 
 (dodoes) ( -- a_body R:a_retaddr )	gforth-internal	paren_dodoes
 ""run-time routine for @code{does>}-defined words""
-a_retaddr = (Cell *)ip;
+a_retaddr = (Cell *)IP;
 a_body = PFA(CFA);
 SET_IP(DOES_CODE1(CFA));
 
@@ -180,6 +187,8 @@ SET_IP(DOES_CODE1(CFA));
 ""just a slot to have an encoding for the DOESJUMP, 
 which is no longer used anyway (!! eliminate this)""
 
+\F [endif]
+
 \g control
 
 noop	( -- )		gforth
@@ -633,6 +642,10 @@ n = compare(c_addr1, u1, c_addr2, u2);
 :
  rot 2dup swap - >r min swap -text dup
  IF  rdrop  ELSE  drop r> sgn  THEN ;
+: -text ( c_addr1 u c_addr2 -- n )
+ swap bounds
+ ?DO  dup c@ I c@ = WHILE  1+  LOOP  drop 0
+ ELSE  c@ I c@ - unloop  THEN  sgn ;
 : sgn ( n -- -1/0/1 )
  dup 0= IF EXIT THEN  0< 2* 1+ ;
 
@@ -1391,6 +1404,14 @@ longname2=listlfind(c_addr, u, longname1
     REPEAT  THEN  nip nip ;
 : (findl-samelen) ( u longname1 -- u longname2/0 )
     BEGIN  2dup cell+ @ lcount-mask and <> WHILE  @  dup 0= UNTIL  THEN ;
+: capscomp ( c_addr1 u c_addr2 -- n )
+ swap bounds
+ ?DO  dup c@ I c@ <>
+     IF  dup c@ toupper I c@ toupper =
+     ELSE  true  THEN  WHILE  1+  LOOP  drop 0
+ ELSE  c@ toupper I c@ toupper - unloop  THEN  sgn ;
+: sgn ( n -- -1/0/1 )
+ dup 0= IF EXIT THEN  0< 2* 1+ ;
 
 \+hash
 
@@ -2262,6 +2283,14 @@ u3 = 0;
 #  endif
 #endif
 
+wcall	( u -- )	gforth
+IF_fpTOS(fp[0]=fpTOS);
+FP=fp;
+sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP);
+fp=FP;
+IF_spTOS(spTOS=sp[0];)
+IF_fpTOS(fpTOS=fp[0]);
+
 \+FFCALL
 
 av-start-void	( c_addr -- )	gforth  av_start_void
@@ -2411,7 +2440,9 @@ va-return-double ( r -- )	gforth va_retu
 va_return_double(clist, r);
 return 0;
 
-\-
+\+
+
+\+OLDCALL
 
 define(`uploop',
        `pushdef(`$1', `$2')_uploop(`$1', `$2', `$3', `$4', `$5')`'popdef(`$1')')
@@ -2452,18 +2483,10 @@ fcall(20)
 \+
 \+
 
-wcall	( u -- )	gforth
-IF_fpTOS(fp[0]=fpTOS);
-FP=fp;
-sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP);
-fp=FP;
-IF_spTOS(spTOS=sp[0];)
-IF_fpTOS(fpTOS=fp[0]);
+\g peephole
 
 \+peephole
 
-\g peephole
-
 compile-prim1 ( a_prim -- ) gforth compile_prim1
 ""compile prim (incl. immargs) at @var{a_prim}""
 compile_prim1(a_prim);
@@ -2506,10 +2529,7 @@ a_addr = groups;
 
 \g static_super
 
-\C #if !defined(GFORTH_DEBUGGING) && !defined(INDIRECT_THREADED) && !defined(DOUBLY_INDIRECT) && !defined(VM_PROFILING)
-
-include(peeprules.vmg)
-
-\C #endif
+ifdef(`M4_ENGINE_FAST',
+`include(peeprules.vmg)')
 
 \g end