Diff for /gforth/engine/engine.c between versions 1.39 and 1.48

version 1.39, 2002/01/20 19:04:11 version 1.48, 2002/12/19 20:14:57
Line 99  extern int gforth_memcmp(const char * s1 Line 99  extern int gforth_memcmp(const char * s1
 #define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n)  #define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n)
 #endif  #endif
   
 #ifdef HAS_FILE  
 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)  
 /* like cstr(), but perform tilde expansion on the string */  
 {  
   char *s1,*s2;  
   int s1_len, s2_len;  
   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  
   
 DCell timeval2us(struct timeval *tvp)  
 {  
 #ifndef BUGGY_LONG_LONG  
   return (tvp->tv_sec*(DCell)1000000)+tvp->tv_usec;  
 #else  
   DCell d2;  
   DCell d1=mmul(tvp->tv_sec,1000000);  
   d2.lo = d1.lo+tvp->tv_usec;  
   d2.hi = d1.hi + (d2.lo<d1.lo);  
   return d2;  
 #endif  
 }  
   
 #define NEWLINE '\n'  #define NEWLINE '\n'
   
 #ifndef HAVE_RINT  
 #define rint(x) floor((x)+0.5)  
 #endif  
   
 #ifdef HAS_FILE  #ifdef HAS_FILE
 static char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};  static char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};
 static char* pfileattr[6]={"r","r","r+","r+","w","w"};  static char* pfileattr[6]={"r","r","r+","r+","w","w"};
Line 215  static int ufileattr[6]= { Line 120  static int ufileattr[6]= {
   
 /* conversion on fetch */  /* conversion on fetch */
   
 #define vm_Cell2f(x)            ((Bool)(x))  #define vm_Cell2f(_cell,_x)             ((_x)=(Bool)(_cell))
 #define vm_Cell2c(x)            ((Char)(x))  #define vm_Cell2c(_cell,_x)             ((_x)=(Char)(_cell))
 #define vm_Cell2n(x)            ((Cell)x)  #define vm_Cell2n(_cell,_x)             ((_x)=(Cell)(_cell))
 #define vm_Cell2w(x)            ((Cell)x)  #define vm_Cell2w(_cell,_x)             ((_x)=(Cell)(_cell))
 #define vm_Cell2u(x)            ((UCell)(x))  #define vm_Cell2u(_cell,_x)             ((_x)=(UCell)(_cell))
 #define vm_Cell2a_(x)           ((Cell *)(x))  #define vm_Cell2a_(_cell,_x)            ((_x)=(Cell *)(_cell))
 #define vm_Cell2c_(x)           ((Char *)(x))  #define vm_Cell2c_(_cell,_x)            ((_x)=(Char *)(_cell))
 #define vm_Cell2f_(x)           ((Float *)(x))  #define vm_Cell2f_(_cell,_x)            ((_x)=(Float *)(_cell))
 #define vm_Cell2df_(x)          ((DFloat *)(x))  #define vm_Cell2df_(_cell,_x)           ((_x)=(DFloat *)(_cell))
 #define vm_Cell2sf_(x)          ((SFloat *)(x))  #define vm_Cell2sf_(_cell,_x)           ((_x)=(SFloat *)(_cell))
 #define vm_Cell2xt(x)           ((Xt)(x))  #define vm_Cell2xt(_cell,_x)            ((_x)=(Xt)(_cell))
 #define vm_Cell2f83name(x)      ((struct F83Name *)(x))  #define vm_Cell2f83name(_cell,_x)       ((_x)=(struct F83Name *)(_cell))
 #define vm_Cell2longname(x)     ((struct Longname *)(x))  #define vm_Cell2longname(_cell,_x)      ((_x)=(struct Longname *)(_cell))
 #define vm_Float2r(x)   (x)  #define vm_Float2r(_float,_x)           (_x=_float)
   
 /* conversion on store */  /* conversion on store */
   
 #define vm_f2Cell(x)            ((Cell)(x))  #define vm_f2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_c2Cell(x)            ((Cell)(x))  #define vm_c2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_n2Cell(x)            ((Cell)(x))  #define vm_n2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_w2Cell(x)            ((Cell)(x))  #define vm_w2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_u2Cell(x)            ((Cell)(x))  #define vm_u2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_a_2Cell(x)           ((Cell)(x))  #define vm_a_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
 #define vm_c_2Cell(x)           ((Cell)(x))  #define vm_c_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
 #define vm_f_2Cell(x)           ((Cell)(x))  #define vm_f_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
 #define vm_df_2Cell(x)          ((Cell)(x))  #define vm_df_2Cell(_x,_cell)           ((_cell)=(Cell)(_x))
 #define vm_sf_2Cell(x)          ((Cell)(x))  #define vm_sf_2Cell(_x,_cell)           ((_cell)=(Cell)(_x))
 #define vm_xt2Cell(x)           ((Cell)(x))  #define vm_xt2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
 #define vm_f83name2Cell(x)      ((Cell)(x))  #define vm_f83name2Cell(_x,_cell)       ((_cell)=(Cell)(_x))
 #define vm_longname2Cell(x)     ((Cell)(x))  #define vm_longname2Cell(_x,_cell)      ((_cell)=(Cell)(_x))
 #define vm_r2Float(x)   (x)  #define vm_r2Float(_x,_float)           (_float=_x)
   
 #define vm_Cell2Cell(x)         (x)  #define vm_Cell2Cell(_x,_y)             (_y=_x)
   
   #ifdef NO_IP
   #define IMM_ARG(access,value)           (VARIANT(value))
   #else
   #define IMM_ARG(access,value)           (access)
   #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 300  static int ufileattr[6]= { Line 211  static int ufileattr[6]= {
 /* define some VM registers as global variables, so they survive exceptions;  /* define some VM registers as global variables, so they survive exceptions;
    global register variables are not up to the task (according to the      global register variables are not up to the task (according to the 
    GNU C manual) */     GNU C manual) */
 Xt *ip;  Xt *saved_ip;
 Cell *rp;  Cell *rp;
 #endif  #endif
   
   #ifdef NO_IP
   static Label next_code;
   #endif
   
 #ifdef DEBUG  #ifdef DEBUG
 #define CFA_TO_NAME(__cfa) \  #define CFA_TO_NAME(__cfa) \
       Cell len, i; \        Cell len, i; \
Line 318  Cell *rp; Line 233  Cell *rp;
       }        }
 #endif  #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) */  
 }  
   
   
 define(enginerest,  define(enginerest,
 `(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)  `(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 341  define(enginerest, Line 240  define(enginerest,
 */  */
 {  {
 #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;
Line 377  define(enginerest, Line 278  define(enginerest,
 #undef INST_ADDR  #undef INST_ADDR
     (Label)&&after_last,      (Label)&&after_last,
     (Label)0,      (Label)0,
   #define INST_ADDR(name) (Label)&&K_##name
   #include "prim_lab.i"
   #undef INST_ADDR
 #ifdef IN_ENGINE2  #ifdef IN_ENGINE2
 #define INST_ADDR(name) (Label)&&J_##name  #define INST_ADDR(name) (Label)&&J_##name
 #include "prim_lab.i"  #include "prim_lab.i"
Line 387  define(enginerest, Line 291  define(enginerest,
   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 CODE_OFFSET (26*sizeof(Cell))  #define CODE_OFFSET (26*sizeof(Cell))
 #define XT_OFFSET (22*sizeof(Cell))  #define XT_OFFSET (22*sizeof(Cell))
Line 421  define(enginerest, Line 324  define(enginerest,
   IF_spTOS(spTOS = sp[0]);    IF_spTOS(spTOS = sp[0]);
   IF_fpTOS(fpTOS = 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 */    SUPER_END; /* count the first block, too */
   NEXT;    NEXT;
   #endif
   
 #ifdef CPU_DEP3  #ifdef CPU_DEP3
   CPU_DEP3    CPU_DEP3
Line 432  define(enginerest, Line 338  define(enginerest,
       
  docol:   docol:
   {    {
   #ifdef NO_IP
       *--rp = next_code;
       goto **(Label *)PFA1(cfa);
   #else
 #ifdef DEBUG  #ifdef DEBUG
     {      {
       CFA_TO_NAME(cfa);        CFA_TO_NAME(cfa);
Line 457  define(enginerest, Line 367  define(enginerest,
       NEXT_P2;        NEXT_P2;
     }      }
 #endif  #endif
   #endif
   }    }
   
  docon:   docon:
Line 471  define(enginerest, Line 382  define(enginerest,
     *--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:
   {    {
Line 486  define(enginerest, Line 401  define(enginerest,
     *--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:
   {    {
Line 501  define(enginerest, Line 420  define(enginerest,
     *--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:
   {    {
Line 520  define(enginerest, Line 443  define(enginerest,
 #endif  #endif
     spTOS += *(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 541  define(enginerest, Line 468  define(enginerest,
      pfa:       pfa:
             
      */       */
   #ifdef NO_IP
     *--rp = next_code;
     IF_spTOS(spTOS = sp[0]);
     sp--;
     spTOS = (Cell)PFA(cfa);
     goto **(Label *)DOES_CODE1(cfa);
   #else
   {    {
     /*    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
Line 560  define(enginerest, Line 494  define(enginerest,
     /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/      /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/
   }    }
   NEXT;    NEXT;
   #endif
   
 #ifndef IN_ENGINE2  #ifndef IN_ENGINE2
 #define LABEL(name) I_##name  #define LABEL(name) I_##name:
 #else  #else
 #define LABEL(name) J_##name: asm(".skip 16"); I_##name  #define LABEL(name) J_##name: asm(".skip 16"); I_##name:
 #endif  #endif
   #define LABEL2(name) K_##name:
 #include "prim.i"  #include "prim.i"
 #undef LABEL  #undef LABEL
   after_last: return (Label *)0;    after_last: return (Label *)0;
Line 573  define(enginerest, Line 509  define(enginerest,
 }'  }'
 )  )
   
   #define VARIANT(v)      (v)
   #define JUMP(target)    goto I_noop
   
 Label *engine enginerest  Label *engine enginerest
   
   #ifndef NO_DYNAMIC
   
   #ifdef NO_IP
   #undef VARIANT
   #define VARIANT(v)      ((v)^0xffffffff)
   #undef JUMP
   #define JUMP(target)    goto K_lit
   Label *engine3 enginerest
   #endif
   
   #undef VARIANT
   #define VARIANT(v)      (v)
   #undef JUMP
   #define JUMP(target)    goto I_noop
 #define IN_ENGINE2  #define IN_ENGINE2
 Label *engine2 enginerest  Label *engine2 enginerest
   #endif

Removed from v.1.39  
changed lines
  Added in v.1.48


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