Diff for /gforth/engine/engine.c between versions 1.7 and 1.11

version 1.7, 1998/12/11 22:54:30 version 1.11, 1999/02/06 22:28:24
Line 45 Line 45
 #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) /* what else? */  #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) /* what else? */
 #include <dlfcn.h>  #include <dlfcn.h>
 #endif  #endif
   #if defined(_WIN32)
   #include <windows.h>
   #endif
 #ifdef hpux  #ifdef hpux
 #include <dl.h>  #include <dl.h>
 #endif  #endif
Line 77  int emitcounter; Line 80  int emitcounter;
 #endif  #endif
 #define NULLC '\0'  #define NULLC '\0'
   
   #ifdef HAS_FILE
 char *cstr(Char *from, UCell size, int clear)  char *cstr(Char *from, UCell size, int clear)
 /* return a C-string corresponding to the Forth string ( FROM SIZE ).  /* 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 */     the C-string lives until the next call of cstr with CLEAR being true */
Line 109  char *cstr(Char *from, UCell size, int c Line 113  char *cstr(Char *from, UCell size, int c
   return b->buffer;    return b->buffer;
 }  }
   
 #ifdef STANDALONE  
 char *tilde_cstr(Char *from, UCell size, int clear)  
 {  
   return cstr(from, size, clear);  
 }  
 #else  
 char *tilde_cstr(Char *from, UCell size, int clear)  char *tilde_cstr(Char *from, UCell size, int clear)
 /* like cstr(), but perform tilde expansion on the string */  /* like cstr(), but perform tilde expansion on the string */
 {  {
Line 156  char *tilde_cstr(Char *from, UCell size, Line 154  char *tilde_cstr(Char *from, UCell size,
     return cstr(path,s1_len+s2_len,clear);      return cstr(path,s1_len+s2_len,clear);
   }    }
 }  }
 #endif     #endif
   
 #define NEWLINE '\n'  #define NEWLINE '\n'
   
Line 164  char *tilde_cstr(Char *from, UCell size, Line 162  char *tilde_cstr(Char *from, UCell size,
 #define rint(x) floor((x)+0.5)  #define rint(x) floor((x)+0.5)
 #endif  #endif
   
   #ifdef HAS_FILE
 static char* fileattr[6]={"r","rb","r+","r+b","w","wb"};  static char* fileattr[6]={"r","rb","r+","r+b","w","wb"};
   
 #ifndef O_BINARY  #ifndef O_BINARY
Line 177  static int ufileattr[6]= { Line 176  static int ufileattr[6]= {
   O_RDONLY|O_TEXT, O_RDONLY|O_BINARY,    O_RDONLY|O_TEXT, O_RDONLY|O_BINARY,
   O_RDWR  |O_TEXT, O_RDWR  |O_BINARY,    O_RDWR  |O_TEXT, O_RDWR  |O_BINARY,
   O_WRONLY|O_TEXT, O_WRONLY|O_BINARY };    O_WRONLY|O_TEXT, O_WRONLY|O_BINARY };
   #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 */
 #ifndef IPREG  #ifndef IPREG
Line 219  static int ufileattr[6]= { Line 219  static int ufileattr[6]= {
 #define DOCFA   Xt cfa; GETCFA(cfa)  #define DOCFA   Xt cfa; GETCFA(cfa)
 #endif  #endif
   
   #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
    returns array of machine code labels (for use in a loader), if ip==NULL     returns array of machine code labels (for use in a loader), if ip==NULL
 */  */
 {  {
   register Xt *ip IPREG = ip0;  #ifndef GFORTH_DEBUGGING
     register Xt *ip IPREG;
     register Cell *rp RPREG;
   #endif
   register Cell *sp SPREG = sp0;    register Cell *sp SPREG = sp0;
   register Cell *rp RPREG = rp0;  
   register Float *fp FPREG = fp0;    register Float *fp FPREG = fp0;
   register Address lp LPREG = lp0;    register Address lp LPREG = lp0;
 #ifdef CFA_NEXT  #ifdef CFA_NEXT
   register Xt cfa CFAREG;    register Xt cfa CFAREG;
 #endif  #endif
   #ifdef MORE_VARS
     MORE_VARS
   #endif
   register Address up UPREG = UP;    register Address up UPREG = UP;
   IF_TOS(register Cell TOS TOSREG;)    IF_TOS(register Cell TOS TOSREG;)
   IF_FTOS(register Float FTOS FTOSREG;)    IF_FTOS(register Float FTOS FTOSREG;)
Line 258  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 271  Label *engine(Xt *ip0, Cell *sp0, Cell *
   CPU_DEP2    CPU_DEP2
 #endif  #endif
   
     ip = ip0;
     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)ip,(unsigned)sp,(unsigned)rp,
Line 288  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 303  Label *engine(Xt *ip0, Cell *sp0, Cell *
   IF_TOS(TOS = sp[0]);    IF_TOS(TOS = sp[0]);
   IF_FTOS(FTOS = fp[0]);    IF_FTOS(FTOS = fp[0]);
 /*  prep_terminal(); */  /*  prep_terminal(); */
   NEXT_P0;    SET_IP(ip);
   NEXT;    NEXT;
   
   
 #ifdef CPU_DEP3  #ifdef CPU_DEP3
   CPU_DEP3    CPU_DEP3
 #endif  #endif
Line 304  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 320  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #ifdef CISC_NEXT  #ifdef CISC_NEXT
     /* this is the simple version */      /* this is the simple version */
     *--rp = (Cell)ip;      *--rp = (Cell)ip;
     ip = (Xt *)PFA1(cfa);      SET_IP((Xt *)PFA1(cfa));
     NEXT_P0;  
     NEXT;      NEXT;
 #else  #else
     /* this one is important, so we help the compiler optimizing      /* this one is important, so we help the compiler optimizing */
        The following version may be better (for scheduling), but probably has  
        problems with code fields employing calls and delay slots  
        */  
     {      {
       DEF_CA        DEF_CA
       Xt *current_ip = (Xt *)PFA1(cfa);        rp[-1] = (Cell)ip;
       cfa = *current_ip;        SET_IP((Xt *)PFA1(cfa));
       NEXT1_P1;        NEXT_P1;
       *--rp = (Cell)ip;        rp--;
       ip = current_ip+1;        NEXT_P2;
       NEXT1_P2;  
     }      }
 #endif  #endif
   }    }
Line 387  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 398  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #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);       TOS += *(Cell*)PFA1(cfa);
   }    }
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
Line 420  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 431  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #endif  #endif
     *--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 */
     ip = DOES_CODE1(cfa);  
 #ifdef USE_TOS  #ifdef USE_TOS
     *sp-- = TOS;      *sp-- = TOS;
     TOS = (Cell)PFA(cfa);      TOS = (Cell)PFA(cfa);
 #else  #else
     *--sp = (Cell)PFA(cfa);      *--sp = (Cell)PFA(cfa);
 #endif  #endif
       SET_IP(DOES_CODE1(cfa));
     /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", TOS, IP);*/      /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", TOS, IP);*/
   }    }
   NEXT_P0;  
   NEXT;    NEXT;
   
 #include "prim.i"  #include "prim.i"

Removed from v.1.7  
changed lines
  Added in v.1.11


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