Diff for /gforth/engine/engine.c between versions 1.13 and 1.56

version 1.13, 1999/06/17 15:32:14 version 1.56, 2003/01/19 23:35:33
Line 1 Line 1
 /* Gforth virtual machine (aka inner interpreter)  /* Gforth virtual machine (aka inner interpreter)
   
   Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.    Copyright (C) 1995-2003 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
Line 16 Line 16
   
   You should have received a copy of the GNU General Public License    You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software    along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 */  */
   
 #include "config.h"  #include "config.h"
   #include "forth.h"
 #include <ctype.h>  #include <ctype.h>
 #include <stdio.h>  #include <stdio.h>
 #include <string.h>  #include <string.h>
Line 27 Line 28
 #include <assert.h>  #include <assert.h>
 #include <stdlib.h>  #include <stdlib.h>
 #include <errno.h>  #include <errno.h>
 #include "forth.h"  
 #include "io.h"  #include "io.h"
 #include "threaded.h"  #include "threaded.h"
 #ifndef STANDALONE  #ifndef STANDALONE
Line 38 Line 38
 #include <sys/time.h>  #include <sys/time.h>
 #include <unistd.h>  #include <unistd.h>
 #include <pwd.h>  #include <pwd.h>
   #include <dirent.h>
   #include <sys/resource.h>
   #ifdef HAVE_FNMATCH_H
   #include <fnmatch.h>
   #else
   #include "fnmatch.h"
   #endif
 #else  #else
 #include "systypes.h"  #include "systypes.h"
 #endif  #endif
Line 57 Line 64
 #define SEEK_SET 0  #define SEEK_SET 0
 #endif  #endif
   
   #ifndef HAVE_FSEEKO
   #define fseeko fseek
   #endif
   
   #ifndef HAVE_FTELLO
   #define ftello ftell
   #endif
   
 #define IOR(flag)       ((flag)? -512-errno : 0)  #define IOR(flag)       ((flag)? -512-errno : 0)
   
 struct F83Name {  struct F83Name {
Line 65  struct F83Name { Line 80  struct F83Name {
   char          name[0];    char          name[0];
 };  };
   
 /* are macros for setting necessary? */  
 #define F83NAME_COUNT(np)       ((np)->countetc & 0x1f)  #define F83NAME_COUNT(np)       ((np)->countetc & 0x1f)
 #define F83NAME_SMUDGE(np)      (((np)->countetc & 0x40) != 0)  
 #define F83NAME_IMMEDIATE(np)   (((np)->countetc & 0x20) != 0)  
   
 Cell *SP;  struct Longname {
 Float *FP;    struct Longname *next;  /* the link field for old hands */
 Address UP=NULL;    Cell          countetc;
     char          name[0];
 #if 0  };
 /* not used currently */  
 int emitcounter;  
 #endif  
 #define NULLC '\0'  
   
 #ifdef HAS_FILE  #define LONGNAME_COUNT(np)      ((np)->countetc & (((~((UCell)0))<<3)>>3))
 char *cstr(Char *from, UCell size, int clear)  
 /* return a C-string corresponding to the Forth string ( FROM SIZE ).  
    the C-string lives until the next call of cstr with CLEAR being true */  
 {  
   static struct cstr_buffer {  
     char *buffer;  
     size_t size;  
   } *buffers=NULL;  
   static int nbuffers=0;  
   static int used=0;  
   struct cstr_buffer *b;  
   
   if (buffers==NULL)  
     buffers=malloc(0);  
   if (clear)  
     used=0;  
   if (used>=nbuffers) {  
     buffers=realloc(buffers,sizeof(struct cstr_buffer)*(used+1));  
     buffers[used]=(struct cstr_buffer){malloc(0),0};  
     nbuffers=used+1;  
   }  
   b=&buffers[used];  
   if (size+1 > b->size) {  
     b->buffer = realloc(b->buffer,size+1);  
     b->size = size+1;  
   }  
   memcpy(b->buffer,from,size);  
   b->buffer[size]='\0';  
   used++;  
   return b->buffer;  
 }  
   
 char *tilde_cstr(Char *from, UCell size, int clear)  #define NULLC '\0'
 /* like cstr(), but perform tilde expansion on the string */  
 {  #ifdef MEMCMP_AS_SUBROUTINE
   char *s1,*s2;  extern int gforth_memcmp(const char * s1, const char * s2, size_t n);
   int s1_len, s2_len;  #define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n)
   struct passwd *getpwnam (), *user_entry;  
   
   if (size<1 || from[0]!='~')  
     return cstr(from, size, clear);  
   if (size<2 || from[1]=='/') {  
     s1 = (char *)getenv ("HOME");  
     if(s1 == NULL)  
       s1 = "";  
     s2 = from+1;  
     s2_len = size-1;  
   } else {  
     UCell i;  
     for (i=1; i<size && from[i]!='/'; i++)  
       ;  
     if (i==2 && from[1]=='+') /* deal with "~+", i.e., the wd */  
       return cstr(from+3, size<3?0:size-3,clear);  
     {  
       char user[i];  
       memcpy(user,from+1,i-1);  
       user[i-1]='\0';  
       user_entry=getpwnam(user);  
     }  
     if (user_entry==NULL)  
       return cstr(from, size, clear);  
     s1 = user_entry->pw_dir;  
     s2 = from+i;  
     s2_len = size-i;  
   }  
   s1_len = strlen(s1);  
   if (s1_len>1 && s1[s1_len-1]=='/')  
     s1_len--;  
   {  
     char path[s1_len+s2_len];  
     memcpy(path,s1,s1_len);  
     memcpy(path+s1_len,s2,s2_len);  
     return cstr(path,s1_len+s2_len,clear);  
   }  
 }  
 #endif  #endif
   
 #define NEWLINE '\n'  #define NEWLINE '\n'
   
 #ifndef HAVE_RINT  /* conversion on fetch */
 #define rint(x) floor((x)+0.5)  
 #endif  
   
 #ifdef HAS_FILE  #define vm_Cell2f(_cell,_x)             ((_x)=(Bool)(_cell))
 static char* fileattr[6]={"r","rb","r+","r+b","w","wb"};  #define vm_Cell2c(_cell,_x)             ((_x)=(Char)(_cell))
   #define vm_Cell2n(_cell,_x)             ((_x)=(Cell)(_cell))
   #define vm_Cell2w(_cell,_x)             ((_x)=(Cell)(_cell))
   #define vm_Cell2u(_cell,_x)             ((_x)=(UCell)(_cell))
   #define vm_Cell2a_(_cell,_x)            ((_x)=(Cell *)(_cell))
   #define vm_Cell2c_(_cell,_x)            ((_x)=(Char *)(_cell))
   #define vm_Cell2f_(_cell,_x)            ((_x)=(Float *)(_cell))
   #define vm_Cell2df_(_cell,_x)           ((_x)=(DFloat *)(_cell))
   #define vm_Cell2sf_(_cell,_x)           ((_x)=(SFloat *)(_cell))
   #define vm_Cell2xt(_cell,_x)            ((_x)=(Xt)(_cell))
   #define vm_Cell2f83name(_cell,_x)       ((_x)=(struct F83Name *)(_cell))
   #define vm_Cell2longname(_cell,_x)      ((_x)=(struct Longname *)(_cell))
   #define vm_Float2r(_float,_x)           (_x=_float)
   
   /* conversion on store */
   
   #define vm_f2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
   #define vm_c2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
   #define vm_n2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
   #define vm_w2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
   #define vm_u2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
   #define vm_a_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
   #define vm_c_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
   #define vm_f_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
   #define vm_df_2Cell(_x,_cell)           ((_cell)=(Cell)(_x))
   #define vm_sf_2Cell(_x,_cell)           ((_cell)=(Cell)(_x))
   #define vm_xt2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
   #define vm_f83name2Cell(_x,_cell)       ((_cell)=(Cell)(_x))
   #define vm_longname2Cell(_x,_cell)      ((_cell)=(Cell)(_x))
   #define vm_r2Float(_x,_float)           (_float=_x)
   
 #ifndef O_BINARY  #define vm_Cell2Cell(_x,_y)             (_y=_x)
 #define O_BINARY 0  
 #endif  
 #ifndef O_TEXT  
 #define O_TEXT 0  
 #endif  
   
 static int ufileattr[6]= {  #ifdef NO_IP
   O_RDONLY|O_TEXT, O_RDONLY|O_BINARY,  #define IMM_ARG(access,value)           (VARIANT(value))
   O_RDWR  |O_TEXT, O_RDWR  |O_BINARY,  #else
   O_WRONLY|O_TEXT, O_WRONLY|O_BINARY };  #define IMM_ARG(access,value)           (access)
 #endif  #endif
   
 /* if machine.h has not defined explicit registers, define them as implicit */  /* if machine.h has not defined explicit registers, define them as implicit */
Line 213  static int ufileattr[6]= { Line 174  static int ufileattr[6]= {
 # define CPU_DEP1 0  # define CPU_DEP1 0
 #endif  #endif
   
 /* declare and compute cfa for certain threading variants */  /* instructions containing these must be the last instruction of a
 /* warning: this is nonsyntactical; it will not work in place of a statement */     super-instruction (e.g., branches, EXECUTE, and other instructions
 #ifndef GETCFA     ending the basic block). Instructions containing SET_IP get this
 #define DOCFA     automatically, so you usually don't have to write it.  If you have
 #else     to write it, write it after IP points to the next instruction.
 #define DOCFA   Xt cfa; GETCFA(cfa)     Used for profiling.  Don't write it in a word containing SET_IP, or
      the following block will be counted twice. */
   #ifdef VM_PROFILING
   #define SUPER_END  vm_count_block(IP)
   #else
   #define SUPER_END
 #endif  #endif
   #define SUPER_CONTINUE
   
   #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
   
   #if !defined(ENGINE)
   /* normal engine */
   #define VARIANT(v)      (v)
   #define JUMP(target)    goto I_noop
   #define LABEL(name) J_##name: asm(""); I_##name:
   
   #elif ENGINE==2
   /* variant with padding between VM instructions for finding out
      cross-inst jumps (for dynamic code) */
   #define engine engine2
   #define VARIANT(v)      (v)
   #define JUMP(target)    goto I_noop
   #define LABEL(name) J_##name: SKIP16; I_##name:
   #define IN_ENGINE2
   
   #elif ENGINE==3
   /* variant with different immediate arguments for finding out
      immediate arguments (for native code) */
   #define engine engine3
   #define VARIANT(v)      ((v)^0xffffffff)
   #define JUMP(target)    goto K_lit
   #define LABEL(name) J_##name: asm(""); I_##name:
   #else
   #error illegal ENGINE value
   #endif /* ENGINE */
   
   #define LABEL2(name) K_##name:
   
 #ifdef GFORTH_DEBUGGING  
 /* define some VM registers as global variables, so they survive exceptions;  
    global register variables are not up to the task (according to the   
    GNU C manual) */  
 Xt *ip;  
 Cell *rp;  
 #endif  
   
 Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)  Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
 /* executes code at ip, if ip!=NULL  /* executes code at ip, if ip!=NULL
Line 235  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 237  Label *engine(Xt *ip0, Cell *sp0, Cell *
 */  */
 {  {
 #ifndef GFORTH_DEBUGGING  #ifndef GFORTH_DEBUGGING
   register Xt *ip IPREG;  
   register Cell *rp RPREG;    register Cell *rp RPREG;
 #endif  #endif
   #ifndef NO_IP
     register Xt *ip IPREG = ip0;
   #endif
   register Cell *sp SPREG = sp0;    register Cell *sp SPREG = sp0;
   register Float *fp FPREG = fp0;    register Float *fp FPREG = fp0;
   register Address lp LPREG = lp0;    register Address lp LPREG = lp0;
 #ifdef CFA_NEXT  
   register Xt cfa CFAREG;    register Xt cfa CFAREG;
 #endif  
 #ifdef MORE_VARS  #ifdef MORE_VARS
   MORE_VARS    MORE_VARS
 #endif  #endif
   register Address up UPREG = UP;    register Address up UPREG = UP;
   IF_TOS(register Cell TOS TOSREG;)    IF_spTOS(register Cell spTOS TOSREG;)
   IF_FTOS(register Float FTOS FTOSREG;)    IF_fpTOS(register Float fpTOS FTOSREG;)
 #if defined(DOUBLY_INDIRECT)  #if defined(DOUBLY_INDIRECT)
   static Label *symbols;    static Label *symbols;
   static void *routines[]= {    static void *routines[]= {
   #define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0]))
 #else /* !defined(DOUBLY_INDIRECT) */  #else /* !defined(DOUBLY_INDIRECT) */
   static Label symbols[]= {    static Label symbols[]= {
   #define MAX_SYMBOLS (sizeof(symbols)/sizeof(symbols[0]))
 #endif /* !defined(DOUBLY_INDIRECT) */  #endif /* !defined(DOUBLY_INDIRECT) */
     (Label)&&docol,      (Label)&&docol,
     (Label)&&docon,      (Label)&&docon,
Line 264  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 268  Label *engine(Xt *ip0, Cell *sp0, Cell *
     (Label)&&dofield,      (Label)&&dofield,
     (Label)&&dodoes,      (Label)&&dodoes,
     /* the following entry is normally unused;      /* 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,      CPU_DEP1,
   #define INST_ADDR(name) ((Label)&&I_##name)
   #include "prim_lab.i"
   #undef INST_ADDR
       (Label)&&after_last,
       (Label)0,
   #define INST_ADDR(name) ((Label)&&K_##name)
 #include "prim_lab.i"  #include "prim_lab.i"
     (Label)0  #undef INST_ADDR
   #define INST_ADDR(name) ((Label)&&J_##name)
   #include "prim_lab.i"
   #undef INST_ADDR
   };    };
 #ifdef CPU_DEP2  #ifdef CPU_DEP2
   CPU_DEP2    CPU_DEP2
 #endif  #endif
   
   ip = ip0;  
   rp = rp0;    rp = rp0;
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"ip=%x, sp=%x, rp=%x, fp=%x, lp=%x, up=%x\n",    fprintf(stderr,"ip=%x, sp=%x, rp=%x, fp=%x, lp=%x, up=%x\n",
           (unsigned)ip,(unsigned)sp,(unsigned)rp,            (unsigned)ip0,(unsigned)sp,(unsigned)rp,
           (unsigned)fp,(unsigned)lp,(unsigned)up);            (unsigned)fp,(unsigned)lp,(unsigned)up);
 #endif  #endif
   
   if (ip == NULL) {    if (ip0 == NULL) {
 #if defined(DOUBLY_INDIRECT)  #if defined(DOUBLY_INDIRECT)
 #define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0]))  #define CODE_OFFSET (26*sizeof(Cell))
 #define CODE_OFFSET (22*sizeof(Cell))  #define XT_OFFSET (22*sizeof(Cell))
     int i;      int i;
     Cell code_offset = offset_image? CODE_OFFSET : 0;      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);      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++)      for (i=0; i<DOESJUMP+1; i++)
       symbols[i] = (Label)routines[i];        xts[i] = symbols[i] = (Label)routines[i];
     for (; routines[i]!=0; i++) {      for (; routines[i]!=0; i++) {
       if (i>=MAX_SYMBOLS) {        if (i>=MAX_SYMBOLS) {
         fprintf(stderr,"gforth-ditc: more than %d primitives\n",MAX_SYMBOLS);          fprintf(stderr,"gforth-ditc: more than %d primitives\n",MAX_SYMBOLS);
         exit(1);          exit(1);
         }
         xts[i] = symbols[i] = &routines[i];
     }      }
     symbols[i] = &routines[i];  
   }  
 #endif /* defined(DOUBLY_INDIRECT) */  #endif /* defined(DOUBLY_INDIRECT) */
   return symbols;      return symbols;
 }    }
   
   IF_TOS(TOS = sp[0]);    IF_spTOS(spTOS = sp[0]);
   IF_FTOS(FTOS = fp[0]);    IF_fpTOS(fpTOS = fp[0]);
 /*  prep_terminal(); */  /*  prep_terminal(); */
   #ifdef NO_IP
     goto *(*(Label *)ip0);
   #else
   SET_IP(ip);    SET_IP(ip);
     SUPER_END; /* count the first block, too */
   NEXT;    NEXT;
   #endif
   
 #ifdef CPU_DEP3  #ifdef CPU_DEP3
   CPU_DEP3    CPU_DEP3
Line 315  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 333  Label *engine(Xt *ip0, Cell *sp0, Cell *
       
  docol:   docol:
   {    {
     DOCFA;  #ifdef NO_IP
       *--rp = next_code;
       goto **(Label *)PFA1(cfa);
   #else
 #ifdef DEBUG  #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  #endif
 #ifdef CISC_NEXT  #ifdef CISC_NEXT
     /* this is the simple version */      /* this is the simple version */
     *--rp = (Cell)ip;      *--rp = (Cell)ip;
     SET_IP((Xt *)PFA1(cfa));      SET_IP((Xt *)PFA1(cfa));
       SUPER_END;
     NEXT;      NEXT;
 #else  #else
     /* this one is important, so we help the compiler optimizing */      /* this one is important, so we help the compiler optimizing */
Line 330  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 356  Label *engine(Xt *ip0, Cell *sp0, Cell *
       DEF_CA        DEF_CA
       rp[-1] = (Cell)ip;        rp[-1] = (Cell)ip;
       SET_IP((Xt *)PFA1(cfa));        SET_IP((Xt *)PFA1(cfa));
         SUPER_END;
       NEXT_P1;        NEXT_P1;
       rp--;        rp--;
       NEXT_P2;        NEXT_P2;
     }      }
 #endif  #endif
   #endif
   }    }
   
  docon:   docon:
   {    {
     DOCFA;  
 #ifdef DEBUG  #ifdef DEBUG
     fprintf(stderr,"%08lx: con: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));      fprintf(stderr,"%08lx: con: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
     *sp-- = TOS;      *sp-- = spTOS;
     TOS = *(Cell *)PFA1(cfa);      spTOS = *(Cell *)PFA1(cfa);
 #else  #else
     *--sp = *(Cell *)PFA1(cfa);      *--sp = *(Cell *)PFA1(cfa);
 #endif  #endif
   }    }
   #ifdef NO_IP
     goto *next_code;
   #else
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
   #endif
       
  dovar:   dovar:
   {    {
     DOCFA;  
 #ifdef DEBUG  #ifdef DEBUG
     fprintf(stderr,"%08lx: var: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));      fprintf(stderr,"%08lx: var: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
     *sp-- = TOS;      *sp-- = spTOS;
     TOS = (Cell)PFA1(cfa);      spTOS = (Cell)PFA1(cfa);
 #else  #else
     *--sp = (Cell)PFA1(cfa);      *--sp = (Cell)PFA1(cfa);
 #endif  #endif
   }    }
   #ifdef NO_IP
     goto *next_code;
   #else
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
   #endif
       
  douser:   douser:
   {    {
     DOCFA;  
 #ifdef DEBUG  #ifdef DEBUG
     fprintf(stderr,"%08lx: user: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));      fprintf(stderr,"%08lx: user: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
     *sp-- = TOS;      *sp-- = spTOS;
     TOS = (Cell)(up+*(Cell*)PFA1(cfa));      spTOS = (Cell)(up+*(Cell*)PFA1(cfa));
 #else  #else
     *--sp = (Cell)(up+*(Cell*)PFA1(cfa));      *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
 #endif  #endif
   }    }
   #ifdef NO_IP
     goto *next_code;
   #else
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
   #endif
       
  dodefer:   dodefer:
   {    {
     DOCFA;  
 #ifdef DEBUG  #ifdef DEBUG
     fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));      fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
 #endif  #endif
       SUPER_END;
     EXEC(*(Xt *)PFA1(cfa));      EXEC(*(Xt *)PFA1(cfa));
   }    }
   
  dofield:   dofield:
   {    {
     DOCFA;  
 #ifdef DEBUG  #ifdef DEBUG
     fprintf(stderr,"%08lx: field: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));      fprintf(stderr,"%08lx: field: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
     TOS += *(Cell*)PFA1(cfa);      spTOS += *(Cell*)PFA1(cfa);
   }    }
   #ifdef NO_IP
     goto *next_code;
   #else
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
   #endif
   
  dodoes:   dodoes:
   /* this assumes the following structure:    /* this assumes the following structure:
Line 423  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 463  Label *engine(Xt *ip0, Cell *sp0, Cell *
      pfa:       pfa:
             
      */       */
   #ifdef NO_IP
     *--rp = next_code;
     IF_spTOS(spTOS = sp[0]);
     sp--;
     spTOS = (Cell)PFA(cfa);
     goto **(Label *)DOES_CODE1(cfa);
   #else
   {    {
     DOCFA;  
   
     /*    fprintf(stderr, "Got CFA %08lx at doescode %08lx/%08lx: does: %08lx\n",cfa,(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));*/      /*    fprintf(stderr, "Got CFA %08lx at doescode %08lx/%08lx: does: %08lx\n",cfa,(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));*/
 #ifdef DEBUG  #ifdef DEBUG
     fprintf(stderr,"%08lx/%08lx: does: %08lx\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));      fprintf(stderr,"%08lx/%08lx: does: %08lx\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));
Line 434  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 479  Label *engine(Xt *ip0, Cell *sp0, Cell *
     *--rp = (Cell)ip;      *--rp = (Cell)ip;
     /* PFA1 might collide with DOES_CODE1 here, so we use PFA */      /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
 #ifdef USE_TOS  #ifdef USE_TOS
     *sp-- = TOS;      *sp-- = spTOS;
     TOS = (Cell)PFA(cfa);      spTOS = (Cell)PFA(cfa);
 #else  #else
     *--sp = (Cell)PFA(cfa);      *--sp = (Cell)PFA(cfa);
 #endif  #endif
     SET_IP(DOES_CODE1(cfa));      SET_IP(DOES_CODE1(cfa));
     /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", TOS, IP);*/      SUPER_END;
       /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/
   }    }
   NEXT;    NEXT;
   #endif
   
 #include "prim.i"  #include "prim.i"
     after_last: return (Label *)0;
     /*needed only to get the length of the last primitive */
 }  }

Removed from v.1.13  
changed lines
  Added in v.1.56


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>