[BACK]Return to engine.c CVS log [TXT] [DIR] Up to [gforth] / gforth / engine

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

version 1.11, 1999/02/06 22:28:24 version 1.25, 2001/01/27 20:14:55
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 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"
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 65  struct F83Name { Line 72  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)  struct Longname {
     struct Longname *next;  /* the link field for old hands */
     Cell          countetc;
     char          name[0];
   };
   
   #define LONGNAME_COUNT(np)      ((np)->countetc & (((~((UCell)0))<<3)>>3))
   
 Cell *SP;  Cell *SP;
 Float *FP;  Float *FP;
Line 80  int emitcounter; Line 92  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 149  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 175  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 195  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 205  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 245  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 246  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 278  Label *engine(Xt *ip0, Cell *sp0, Cell *
   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[]= {
Line 293  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 325  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_spTOS(spTOS = sp[0]);
   IF_FTOS(FTOS = fp[0]);    IF_fpTOS(fpTOS = fp[0]);
 /*  prep_terminal(); */  /*  prep_terminal(); */
   SET_IP(ip);    SET_IP(ip);
   NEXT;    NEXT;
Line 342  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 374  Label *engine(Xt *ip0, Cell *sp0, Cell *
     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
Line 358  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 390  Label *engine(Xt *ip0, Cell *sp0, Cell *
     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
Line 374  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 406  Label *engine(Xt *ip0, Cell *sp0, Cell *
     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
Line 398  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 430  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);      spTOS += *(Cell*)PFA1(cfa);
   }    }
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
Line 432  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 464  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);*/      /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/
   }    }
   NEXT;    NEXT;
   
Removed from v.1.11  
changed lines
  Added in v.1.25

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