--- gforth/engine/engine.c	2001/12/25 16:55:10	1.35
+++ gforth/engine/engine.c	2002/02/04 21:25:18	1.40
@@ -19,6 +19,8 @@
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 */
 
+undefine(`symbols')
+
 #include "config.h"
 #include "forth.h"
 #include <ctype.h>
@@ -280,14 +282,6 @@ static int ufileattr[6]= {
 # define CPU_DEP1 0
 #endif
 
-/* declare and compute cfa for certain threading variants */
-/* warning: this is nonsyntactical; it will not work in place of a statement */
-#ifndef GETCFA
-#define DOCFA
-#else
-#define DOCFA	Xt cfa; GETCFA(cfa)
-#endif
-
 /* instructions containing these must be the last instruction of a
    super-instruction (e.g., branches, EXECUTE, and other instructions
    ending the basic block). Instructions containing SET_IP get this
@@ -310,18 +304,29 @@ Xt *ip;
 Cell *rp;
 #endif
 
+#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)
+     /* used in primitive primtable for peephole optimization */
 {
-#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) */
 }
 
 
@@ -338,9 +343,7 @@ define(enginerest,
   register Cell *sp SPREG = sp0;
   register Float *fp FPREG = fp0;
   register Address lp LPREG = lp0;
-#ifdef CFA_NEXT
   register Xt cfa CFAREG;
-#endif
 #ifdef MORE_VARS
   MORE_VARS
 #endif
@@ -390,19 +393,22 @@ define(enginerest,
 
   if (ip == NULL) {
 #if defined(DOUBLY_INDIRECT)
-#define CODE_OFFSET (22*sizeof(Cell))
+#define CODE_OFFSET (26*sizeof(Cell))
+#define XT_OFFSET (22*sizeof(Cell))
     int i;
     Cell code_offset = offset_image? CODE_OFFSET : 0;
+    Cell xt_offset = offset_image? XT_OFFSET : 0;
 
     symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset);
+    xts = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+XT_OFFSET)+xt_offset);
     for (i=0; i<DOESJUMP+1; i++)
-      symbols[i] = (Label)routines[i];
+      xts[i] = symbols[i] = (Label)routines[i];
     for (; routines[i]!=0; i++) {
       if (i>=MAX_SYMBOLS) {
 	fprintf(stderr,"gforth-ditc: more than %d primitives\n",MAX_SYMBOLS);
 	exit(1);
       }
-      symbols[i] = &routines[i];
+      xts[i] = symbols[i] = &routines[i];
     }
 #endif /* defined(DOUBLY_INDIRECT) */
     return symbols;
@@ -422,9 +428,12 @@ define(enginerest,
   
  docol:
   {
-    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 */
@@ -448,7 +457,6 @@ define(enginerest,
 
  docon:
   {
-    DOCFA;
 #ifdef DEBUG
     fprintf(stderr,"%08lx: con: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
 #endif
@@ -464,7 +472,6 @@ define(enginerest,
   
  dovar:
   {
-    DOCFA;
 #ifdef DEBUG
     fprintf(stderr,"%08lx: var: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif
@@ -480,7 +487,6 @@ define(enginerest,
   
  douser:
   {
-    DOCFA;
 #ifdef DEBUG
     fprintf(stderr,"%08lx: user: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif
@@ -496,7 +502,6 @@ define(enginerest,
   
  dodefer:
   {
-    DOCFA;
 #ifdef DEBUG
     fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
 #endif
@@ -506,7 +511,6 @@ define(enginerest,
 
  dofield:
   {
-    DOCFA;
 #ifdef DEBUG
     fprintf(stderr,"%08lx: field: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif
@@ -534,8 +538,6 @@ define(enginerest,
      
      */
   {
-    DOCFA;
-
     /*    fprintf(stderr, "Got CFA %08lx at doescode %08lx/%08lx: does: %08lx\n",cfa,(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));*/
 #ifdef DEBUG
     fprintf(stderr,"%08lx/%08lx: does: %08lx\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));