Diff for /gforth/engine/engine.c between versions 1.10 and 1.22

version 1.10, 1999/01/08 16:58:31 version 1.22, 2000/09/23 15:06:07
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,1996,1997,1998,2000 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
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 80  int emitcounter; Line 87  int emitcounter;
 #endif  #endif
 #define NULLC '\0'  #define NULLC '\0'
   
   #ifdef MEMCMP_AS_SUBROUTINE
   extern int gforth_memcmp(const char * s1, const char * s2, size_t n);
   #define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n)
   #endif
   
 #ifdef HAS_FILE  #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 ).
Line 132  char *tilde_cstr(Char *from, UCell size, Line 144  char *tilde_cstr(Char *from, UCell size,
     UCell i;      UCell i;
     for (i=1; i<size && from[i]!='/'; 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];        char user[i];
       memcpy(user,from+1,i-1);        memcpy(user,from+1,i-1);
Line 156  char *tilde_cstr(Char *from, UCell size, Line 170  char *tilde_cstr(Char *from, UCell size,
 }  }
 #endif  #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  #ifndef HAVE_RINT
Line 163  char *tilde_cstr(Char *from, UCell size, Line 190  char *tilde_cstr(Char *from, UCell size,
 #endif  #endif
   
 #ifdef HAS_FILE  #ifdef HAS_FILE
 static char* fileattr[6]={"r","rb","r+","r+b","w","wb"};  static char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};
   
 #ifndef O_BINARY  #ifndef O_BINARY
 #define O_BINARY 0  #define O_BINARY 0
Line 173  static char* fileattr[6]={"r","rb","r+", Line 200  static char* fileattr[6]={"r","rb","r+",
 #endif  #endif
   
 static int ufileattr[6]= {  static int ufileattr[6]= {
   O_RDONLY|O_TEXT, O_RDONLY|O_BINARY,    O_RDONLY|O_BINARY, O_RDONLY|O_BINARY,
   O_RDWR  |O_TEXT, O_RDWR  |O_BINARY,    O_RDWR  |O_BINARY, O_RDWR  |O_BINARY,
   O_WRONLY|O_TEXT, O_WRONLY|O_BINARY };    O_WRONLY|O_BINARY, O_WRONLY|O_BINARY };
 #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 240  static int ufileattr[6]= {
   
 /* declare and compute cfa for certain threading variants */  /* declare and compute cfa for certain threading variants */
 /* warning: this is nonsyntactical; it will not work in place of a statement */  /* warning: this is nonsyntactical; it will not work in place of a statement */
 #ifdef CFA_NEXT  #ifndef GETCFA
 #define DOCFA  #define DOCFA
 #else  #else
 #define DOCFA   Xt cfa; GETCFA(cfa)  #define DOCFA   Xt cfa; GETCFA(cfa)
Line 242  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 269  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #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 290  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 320  Label *engine(Xt *ip0, Cell *sp0, Cell *
       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);
         }
         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_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 316  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 347  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 399  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 425  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 432  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 458  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.10  
changed lines
  Added in v.1.22


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