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

version 1.3, 1998/04/16 15:34:41 version 1.10, 1999/01/08 16:58:31
Line 1 Line 1
 /* Gforth virtual machine (aka inner interpreter)  /* Gforth virtual machine (aka inner interpreter)
   
   Copyright (C) 1995 Free Software Foundation, Inc.    Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
Line 24 Line 24
 #include <stdio.h>  #include <stdio.h>
 #include <string.h>  #include <string.h>
 #include <math.h>  #include <math.h>
   #include <assert.h>
   #include <stdlib.h>
   #include <errno.h>
   #include "forth.h"
   #include "io.h"
   #include "threaded.h"
   #ifndef STANDALONE
 #include <sys/types.h>  #include <sys/types.h>
 #include <sys/stat.h>  #include <sys/stat.h>
 #include <fcntl.h>  #include <fcntl.h>
 #include <assert.h>  
 #include <stdlib.h>  
 #include <time.h>  #include <time.h>
 #include <sys/time.h>  #include <sys/time.h>
 #include <unistd.h>  #include <unistd.h>
 #include <errno.h>  
 #include <pwd.h>  #include <pwd.h>
 #include "forth.h"  #else
 #include "io.h"  #include "systypes.h"
 #include "threaded.h"  #endif
   
 #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 52 Line 59
   
 #define IOR(flag)       ((flag)? -512-errno : 0)  #define IOR(flag)       ((flag)? -512-errno : 0)
   
 typedef struct F83Name {  struct F83Name {
   struct F83Name        *next;  /* the link field for old hands */    struct F83Name *next;  /* the link field for old hands */
   char                  countetc;    char          countetc;
   Char                  name[0];    char          name[0];
 } F83Name;  };
   
 /* are macros for setting necessary? */  /* are macros for setting necessary? */
 #define F83NAME_COUNT(np)       ((np)->countetc & 0x1f)  #define F83NAME_COUNT(np)       ((np)->countetc & 0x1f)
Line 73  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 146  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
   
 #define NEWLINE '\n'  #define NEWLINE '\n'
   
Line 154  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 167  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 209  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
Line 231  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 251  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #else /* !defined(DOUBLY_INDIRECT) */  #else /* !defined(DOUBLY_INDIRECT) */
   static Label symbols[]= {    static Label symbols[]= {
 #endif /* !defined(DOUBLY_INDIRECT) */  #endif /* !defined(DOUBLY_INDIRECT) */
     &&docol,      (Label)&&docol,
     &&docon,      (Label)&&docon,
     &&dovar,      (Label)&&dovar,
     &&douser,      (Label)&&douser,
     &&dodefer,      (Label)&&dodefer,
     &&dofield,      (Label)&&dofield,
     &&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's there because its index indicates a does-handler */
     CPU_DEP1,      CPU_DEP1,
 #include "prim_lab.i"  #include "prim_lab.i"
     0      (Label)0
   };    };
 #ifdef CPU_DEP2  #ifdef CPU_DEP2
   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,

Removed from v.1.3  
changed lines
  Added in v.1.10


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