--- gforth/engine/engine.c	2001/03/18 12:39:34	1.29
+++ gforth/engine/engine.c	2002/01/04 20:31:54	1.37
@@ -19,7 +19,10 @@
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 */
 
+undefine(`symbols')
+
 #include "config.h"
+#include "forth.h"
 #include <ctype.h>
 #include <stdio.h>
 #include <string.h>
@@ -27,7 +30,6 @@
 #include <assert.h>
 #include <stdlib.h>
 #include <errno.h>
-#include "forth.h"
 #include "io.h"
 #include "threaded.h"
 #ifndef STANDALONE
@@ -196,6 +198,7 @@ DCell timeval2us(struct timeval *tvp)
 
 #ifdef HAS_FILE
 static char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};
+static char* pfileattr[6]={"r","r","r+","r+","w","w"};
 
 #ifndef O_BINARY
 #define O_BINARY 0
@@ -299,6 +302,7 @@ static int ufileattr[6]= {
 #else
 #define SUPER_END
 #endif
+#define SUPER_CONTINUE
 
 #ifdef GFORTH_DEBUGGING
 /* define some VM registers as global variables, so they survive exceptions;
@@ -308,7 +312,37 @@ Xt *ip;
 Cell *rp;
 #endif
 
-Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
+#ifdef DEBUG
+#define CFA_TO_NAME(__cfa) \
+      Cell len, i; \
+      char * name = __cfa; \
+      for(i=0; i<32; i+=sizeof(Cell)) { \
+        len = ((Cell*)name)[-1]; \
+        if(len < 0) { \
+	  len &= 0x1F; \
+          if((len+sizeof(Cell)) > i) break; \
+	} len = 0; \
+	name -= sizeof(Cell); \
+      }
+#endif
+
+Xt *primtable(Label symbols[], Cell size)
+{
+#ifdef DIRECT_THREADED
+  return symbols;
+#else /* !defined(DIRECT_THREADED) */
+  Xt *xts = (Xt *)malloc(size*sizeof(Xt));
+  Cell i;
+
+  for (i=0; i<size; i++)
+    xts[i] = &symbols[i];
+  return xts;
+#endif /* !defined(DIRECT_THREADED) */
+}
+
+
+define(enginerest,
+`(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
 /* executes code at ip, if ip!=NULL
    returns array of machine code labels (for use in a loader), if ip==NULL
 */
@@ -345,10 +379,18 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
     (Label)&&dofield,
     (Label)&&dodoes,
     /* the following entry is normally unused;
-       it's there because its index indicates a does-handler */
+       it is there because its index indicates a does-handler */
     CPU_DEP1,
+#define INST_ADDR(name) (Label)&&I_##name
 #include "prim_lab.i"
-    (Label)0
+#undef INST_ADDR
+    (Label)&&after_last,
+    (Label)0,
+#ifdef IN_ENGINE2
+#define INST_ADDR(name) (Label)&&J_##name
+#include "prim_lab.i"
+#undef INST_ADDR
+#endif
   };
 #ifdef CPU_DEP2
   CPU_DEP2
@@ -398,7 +440,11 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
   {
     DOCFA;
 #ifdef DEBUG
-    fprintf(stderr,"%08lx: col: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
+    {
+      CFA_TO_NAME(cfa);
+      fprintf(stderr,"%08lx: col: %08lx %.*s\n",(Cell)ip,(Cell)PFA1(cfa),
+	      len,name);
+    }
 #endif
 #ifdef CISC_NEXT
     /* this is the simple version */
@@ -529,5 +575,20 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
   }
   NEXT;
 
+#ifndef IN_ENGINE2
+#define LABEL(name) I_##name
+#else
+#define LABEL(name) J_##name: asm(".skip 16"); I_##name
+#endif
 #include "prim.i"
-}
+#undef LABEL
+  after_last: return (Label *)0;
+  /*needed only to get the length of the last primitive */
+}'
+)
+
+Label *engine enginerest
+
+#define IN_ENGINE2
+Label *engine2 enginerest
+