Diff for /gforth/engine/engine.c between versions 1.16 and 1.28

version 1.16, 2000/05/16 09:51:21 version 1.28, 2001/02/27 21:17:11
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 163  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 185  static int ufileattr[6]= { Line 210  static int ufileattr[6]= {
   O_WRONLY|O_BINARY, O_WRONLY|O_BINARY };    O_WRONLY|O_BINARY, O_WRONLY|O_BINARY };
 #endif  #endif
   
   /* conversion on fetch */
   
   #define vm_Cell2f(x)            ((Bool)(x))
   #define vm_Cell2c(x)            ((Char)(x))
   #define vm_Cell2n(x)            ((Cell)x)
   #define vm_Cell2w(x)            ((Cell)x)
   #define vm_Cell2u(x)            ((UCell)(x))
   #define vm_Cell2a_(x)           ((Cell *)(x))
   #define vm_Cell2c_(x)           ((Char *)(x))
   #define vm_Cell2f_(x)           ((Float *)(x))
   #define vm_Cell2df_(x)          ((DFloat *)(x))
   #define vm_Cell2sf_(x)          ((SFloat *)(x))
   #define vm_Cell2xt(x)           ((Xt)(x))
   #define vm_Cell2f83name(x)      ((struct F83Name *)(x))
   #define vm_Cell2longname(x)     ((struct Longname *)(x))
   #define vm_Float2r(x)   (x)
   
   /* conversion on store */
   
   #define vm_f2Cell(x)            ((Cell)(x))
   #define vm_c2Cell(x)            ((Cell)(x))
   #define vm_n2Cell(x)            ((Cell)(x))
   #define vm_w2Cell(x)            ((Cell)(x))
   #define vm_u2Cell(x)            ((Cell)(x))
   #define vm_a_2Cell(x)           ((Cell)(x))
   #define vm_c_2Cell(x)           ((Cell)(x))
   #define vm_f_2Cell(x)           ((Cell)(x))
   #define vm_df_2Cell(x)          ((Cell)(x))
   #define vm_sf_2Cell(x)          ((Cell)(x))
   #define vm_xt2Cell(x)           ((Cell)(x))
   #define vm_f83name2Cell(x)      ((Cell)(x))
   #define vm_longname2Cell(x)     ((Cell)(x))
   #define vm_r2Float(x)   (x)
   
 /* 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
 #define IPREG  #define IPREG
Line 226  static int ufileattr[6]= { Line 285  static int ufileattr[6]= {
 #define DOCFA   Xt cfa; GETCFA(cfa)  #define DOCFA   Xt cfa; GETCFA(cfa)
 #endif  #endif
   
   /* instructions containing these must be the last instruction of a
      super-instruction (e.g., branches, EXECUTE, and other instructions
      ending the basic block). Instructions containing SET_IP get this
      automatically, so you usually don't have to write it.  If you have
      to write it, write it after IP points to the next instruction.
      Used for profiling.  Don't write it in a word containing SET_IP, or
      the following block will be counted twice. */
   #ifdef VM_PROFILING
   #define SUPER_END  vm_count_block(IP)
   #else
   #define SUPER_END
   #endif
   
 #ifdef GFORTH_DEBUGGING  #ifdef GFORTH_DEBUGGING
 /* 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 
Line 253  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 325  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[]= {
   #define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0]))
 #else /* !defined(DOUBLY_INDIRECT) */  #else /* !defined(DOUBLY_INDIRECT) */
   static Label symbols[]= {    static Label symbols[]= {
   #define MAX_SYMBOLS (sizeof(symbols)/sizeof(symbols[0]))
 #endif /* !defined(DOUBLY_INDIRECT) */  #endif /* !defined(DOUBLY_INDIRECT) */
     (Label)&&docol,      (Label)&&docol,
     (Label)&&docon,      (Label)&&docon,
Line 288  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 362  Label *engine(Xt *ip0, Cell *sp0, Cell *
   
   if (ip == NULL) {    if (ip == NULL) {
 #if defined(DOUBLY_INDIRECT)  #if defined(DOUBLY_INDIRECT)
 #define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0]))  
 #define CODE_OFFSET (22*sizeof(Cell))  #define CODE_OFFSET (22*sizeof(Cell))
     int i;      int i;
     Cell code_offset = offset_image? CODE_OFFSET : 0;      Cell code_offset = offset_image? CODE_OFFSET : 0;
Line 300  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 373  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);
     SUPER_END; /* count the first block, too */
   NEXT;    NEXT;
   
   
Line 328  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 402  Label *engine(Xt *ip0, Cell *sp0, Cell *
     /* this is the simple version */      /* this is the simple version */
     *--rp = (Cell)ip;      *--rp = (Cell)ip;
     SET_IP((Xt *)PFA1(cfa));      SET_IP((Xt *)PFA1(cfa));
       SUPER_END;
     NEXT;      NEXT;
 #else  #else
     /* this one is important, so we help the compiler optimizing */      /* this one is important, so we help the compiler optimizing */
Line 335  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 410  Label *engine(Xt *ip0, Cell *sp0, Cell *
       DEF_CA        DEF_CA
       rp[-1] = (Cell)ip;        rp[-1] = (Cell)ip;
       SET_IP((Xt *)PFA1(cfa));        SET_IP((Xt *)PFA1(cfa));
         SUPER_END;
       NEXT_P1;        NEXT_P1;
       rp--;        rp--;
       NEXT_P2;        NEXT_P2;
Line 349  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 425  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 365  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 441  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 381  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 457  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 396  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 472  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #ifdef DEBUG  #ifdef DEBUG
     fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));      fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
 #endif  #endif
       SUPER_END;
     EXEC(*(Xt *)PFA1(cfa));      EXEC(*(Xt *)PFA1(cfa));
   }    }
   
Line 405  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 482  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 439  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 516  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);*/      SUPER_END;
       /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/
   }    }
   NEXT;    NEXT;
   

Removed from v.1.16  
changed lines
  Added in v.1.28


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