Diff for /gforth/engine/engine.c between versions 1.85 and 1.120

version 1.85, 2005/12/11 20:08:09 version 1.120, 2012/07/23 13:27:47
Line 1 Line 1
 /* Gforth virtual machine (aka inner interpreter)  /* Gforth virtual machine (aka inner interpreter)
   
   Copyright (C) 1995,1996,1997,1998,2000,2003,2004 Free Software Foundation, Inc.    Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2010,2011 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
   Gforth is free software; you can redistribute it and/or    Gforth is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License    modify it under the terms of the GNU General Public License
   as published by the Free Software Foundation; either version 2    as published by the Free Software Foundation, either version 3
   of the License, or (at your option) any later version.    of the License, or (at your option) any later version.
   
   This program is distributed in the hope that it will be useful,    This program is distributed in the hope that it will be useful,
Line 15 Line 15
   GNU General Public License for more details.    GNU General Public License for more details.
   
   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, see http://www.gnu.org/licenses/.
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.  
 */  */
   
 #if defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING)  #if defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING)
Line 24 Line 23
 #else  #else
 #define USE_TOS  #define USE_TOS
 #endif  #endif
 #define USE_NO_FTOS  
   
 #include "config.h"  #include "config.h"
 #include "forth.h"  #include "forth.h"
Line 46 Line 44
 #include <unistd.h>  #include <unistd.h>
 #include <pwd.h>  #include <pwd.h>
 #include <dirent.h>  #include <dirent.h>
   #ifdef HAVE_WCHAR_H
   #include <wchar.h>
   #endif
 #include <sys/resource.h>  #include <sys/resource.h>
 #ifdef HAVE_FNMATCH_H  #ifdef HAVE_FNMATCH_H
 #include <fnmatch.h>  #include <fnmatch.h>
Line 53 Line 54
 #include "fnmatch.h"  #include "fnmatch.h"
 #endif  #endif
 #else  #else
 #include "systypes.h"  /* #include <systypes.h> */
 #endif  #endif
   
 #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) /* what else? */  #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) /* what else? */
Line 71 Line 72
 #include <callback.h>  #include <callback.h>
 #endif  #endif
   
 #ifdef HAS_LIBFFI  
 #include <ffi.h>  
 #endif  
   
 #ifndef SEEK_SET  #ifndef SEEK_SET
 /* should be defined in stdio.h, but some systems don't have it */  /* should be defined in stdio.h, but some systems don't have it */
 #define SEEK_SET 0  #define SEEK_SET 0
Line 92 Line 89
   
 #ifdef MEMCMP_AS_SUBROUTINE  #ifdef MEMCMP_AS_SUBROUTINE
 extern int gforth_memcmp(const char * s1, const char * s2, size_t n);  extern int gforth_memcmp(const char * s1, const char * s2, size_t n);
   extern Char *gforth_memmove(Char * dest, const Char* src, Cell n);
   extern Char *gforth_memset(Char * s, Cell c, UCell n);
   extern Char *gforth_memcpy(Char * dest, const Char* src, Cell n);
 #define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n)  #define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n)
   #define memmove(a,b,c) gforth_memmove(a,b,c)
   #define memset(a,b,c) gforth_memset(a,b,c)
   #define memcpy(a,b,c) gforth_memcpy(a,b,c)
 #endif  #endif
   
 #define NEWLINE '\n'  #define NEWLINE '\n'
   
   /* These two flags control whether divisions are checked by software.
      The CHECK_DIVISION_SW is for those cases where the event is a
      division by zero or overflow on the C level, and might be reported
      by hardware; we might check forr that in autoconf and set the
      switch appropriately, but currently don't.  The CHECK_DIVISION flag
      is for the other cases. */
   #ifdef GFORTH_DEBUGGING
   #define CHECK_DIVISION_SW 1
   #define CHECK_DIVISION 1
   #else
   #define CHECK_DIVISION_SW 0
   #define CHECK_DIVISION 0
   #endif
   
 /* conversion on fetch */  /* conversion on fetch */
   
 #define vm_Cell2f(_cell,_x)             ((_x)=(Bool)(_cell))  #define vm_Cell2f(_cell,_x)             ((_x)=(Bool)(_cell))
Line 191  extern int gforth_memcmp(const char * s1 Line 208  extern int gforth_memcmp(const char * s1
 #ifndef FTOSREG  #ifndef FTOSREG
 #define FTOSREG  #define FTOSREG
 #endif  #endif
   #ifndef OPREG
   #define OPREG
   #endif
   
 #ifndef CPU_DEP1  #ifndef CPU_DEP1
 # define CPU_DEP1 0  # define CPU_DEP1 0
Line 210  extern int gforth_memcmp(const char * s1 Line 230  extern int gforth_memcmp(const char * s1
 #endif  #endif
 #define SUPER_CONTINUE  #define SUPER_CONTINUE
   
   #ifdef ASMCOMMENT
   /* an individualized asm statement so that (hopefully) gcc's optimizer
      does not do cross-jumping */
   #define asmcomment(string) asm(ASMCOMMENT string)
   #else
   /* we don't know how to do an asm comment, so we just do an empty asm */
   #define asmcomment(string) asm("")
   #endif
   
   #define DEPTHOFF 4
 #ifdef GFORTH_DEBUGGING  #ifdef GFORTH_DEBUGGING
 #if DEBUG  #if DEBUG
 #define NAME(string) { saved_ip=ip; asm("# "string); fprintf(stderr,"%08lx depth=%3ld: "string"\n",(Cell)ip,sp0+3-sp);}  #define NAME(string) { saved_ip=ip; asmcomment(string); fprintf(stderr,"%08lx depth=%3ld tos=%016lx: "string"\n",(Cell)ip,sp0+DEPTHOFF-sp,sp[0]);}
 #else /* !DEBUG */  #else /* !DEBUG */
 #define NAME(string) { saved_ip=ip; asm(""); }  #define NAME(string) { saved_ip=ip; asm(""); }
 /* the asm here is to avoid reordering of following stuff above the  /* the asm here is to avoid reordering of following stuff above the
Line 222  extern int gforth_memcmp(const char * s1 Line 252  extern int gforth_memcmp(const char * s1
    because the stack loads may already cause a stack underflow. */     because the stack loads may already cause a stack underflow. */
 #endif /* !DEBUG */  #endif /* !DEBUG */
 #elif DEBUG  #elif DEBUG
 #       define  NAME(string)    {Cell __depth=sp0+3-sp; int i; fprintf(stderr,"%08lx depth=%3ld: "string,(Cell)ip,sp0+3-sp); for (i=__depth-1; i>0; i--) fprintf(stderr, " $%lx",sp[i]); fprintf(stderr, " $%lx\n",spTOS); }  #       define  NAME(string)    {Cell __depth=sp0+DEPTHOFF-sp; int i; fprintf(stderr,"%08lx depth=%3ld: "string,(Cell)ip,sp0+DEPTHOFF-sp); for (i=__depth-1; i>0; i--) fprintf(stderr, " $%lx",sp[i]); fprintf(stderr, " $%lx\n",spTOS); }
 #else  #else
 #       define  NAME(string) asm("# "string);  #       define  NAME(string) asmcomment(string);
 #endif  #endif
   
 #ifdef DEBUG  #ifdef DEBUG
Line 241  extern int gforth_memcmp(const char * s1 Line 271  extern int gforth_memcmp(const char * s1
       }        }
 #endif  #endif
   
   #ifdef STANDALONE
   jmp_buf * throw_jmp_handler;
   
   void throw(int code)
   {
     longjmp(*throw_jmp_handler,code); /* !! or use siglongjmp ? */
   }
   #endif
   
 #if defined(HAS_FFCALL) || defined(HAS_LIBFFI)  #if defined(HAS_FFCALL) || defined(HAS_LIBFFI)
 #define SAVE_REGS IF_fpTOS(fp[0]=fpTOS); SP=sp; FP=fp; RP=rp; LP=lp;  #define SAVE_REGS IF_fpTOS(fp[0]=fpTOS); gforth_SP=sp; gforth_FP=fp; gforth_RP=rp; gforth_LP=lp;
 #define REST_REGS sp=SP; fp=FP; rp=RP; lp=LP; IF_fpTOS(fpTOS=fp[0]);  #define REST_REGS sp=gforth_SP; fp=gforth_FP; rp=gforth_RP; lp=gforth_LP; IF_fpTOS(fpTOS=fp[0]);
 #endif  #endif
   
 #if !defined(ENGINE)  #if !defined(ENGINE)
Line 251  extern int gforth_memcmp(const char * s1 Line 290  extern int gforth_memcmp(const char * s1
 #define VARIANT(v)      (v)  #define VARIANT(v)      (v)
 #define JUMP(target)    goto I_noop  #define JUMP(target)    goto I_noop
 #define LABEL(name) H_##name: asm(""); I_##name:  #define LABEL(name) H_##name: asm(""); I_##name:
   #define LABEL3(name) J_##name: asm("");
   
 #elif ENGINE==2  #elif ENGINE==2
 /* variant with padding between VM instructions for finding out  /* variant with padding between VM instructions for finding out
    cross-inst jumps (for dynamic code) */     cross-inst jumps (for dynamic code) */
 #define engine engine2  #define gforth_engine gforth_engine2
 #define VARIANT(v)      (v)  #define VARIANT(v)      (v)
 #define JUMP(target)    goto I_noop  #define JUMP(target)    goto I_noop
 #define LABEL(name) H_##name: SKIP16; I_##name:  #define LABEL(name) H_##name: SKIP16; I_##name:
 #define IN_ENGINE2  /* the SKIP16 after LABEL3 is there, because the ARM gcc may place
      some constants after the final branch, and may refer to them from
      the code before label3.  Since we don't copy the constants, we have
      to make sure that such code is recognized as non-relocatable. */
   #define LABEL3(name) J_##name: SKIP16;
   
 #elif ENGINE==3  #elif ENGINE==3
 /* variant with different immediate arguments for finding out  /* variant with different immediate arguments for finding out
    immediate arguments (for native code) */     immediate arguments (for native code) */
 #define engine engine3  #define gforth_engine gforth_engine3
 #define VARIANT(v)      ((v)^0xffffffff)  #define VARIANT(v)      ((v)^0xffffffff)
 #define JUMP(target)    goto K_lit  #define JUMP(target)    goto K_lit
 #define LABEL(name) H_##name: asm(""); I_##name:  #define LABEL(name) H_##name: asm(""); I_##name:
   #define LABEL3(name) J_##name: asm("");
 #else  #else
 #error illegal ENGINE value  #error illegal ENGINE value
 #endif /* ENGINE */  #endif /* ENGINE */
   
 /* the asm(""); is there to get a stop compiled on Itanium */  /* the asm(""); is there to get a stop compiled on Itanium */
 #define LABEL2(name) K_##name: asm("");  #define LABEL2(name) K_##name: asm("");
 #define LABEL3(name) J_##name: asm("");  
   
 Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)  Label *gforth_engine(Xt *ip0 sr_proto)
 /* 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
 */  */
 {  {
 #ifndef GFORTH_DEBUGGING  #if defined(GFORTH_DEBUGGING)
   #if defined(GLOBALS_NONRELOC)
     register saved_regs *saved_regs_p TOSREG = saved_regs_p0;
   #endif /* defined(GLOBALS_NONRELOC) */
   #else /* !defined(GFORTH_DEBUGGING) */
   register Cell *rp RPREG;    register Cell *rp RPREG;
 #endif  #endif /* !defined(GFORTH_DEBUGGING) */
 #ifndef NO_IP  #ifndef NO_IP
   register Xt *ip IPREG = ip0;    register Xt *ip IPREG = ip0;
 #endif  #endif
   register Cell *sp SPREG = sp0;    register Cell *sp SPREG = gforth_SP;
   register Float *fp FPREG = fp0;    register Float *fp FPREG = gforth_FP;
   register Address lp LPREG = lp0;    register Address lp LPREG = gforth_LP;
   register Xt cfa CFAREG;    register Xt cfa CFAREG;
   register Label real_ca CAREG;    register Label real_ca CAREG;
   #ifdef HAS_OBJECTS
     register Char * op OPREG = NULL;
   #endif
 #ifdef MORE_VARS  #ifdef MORE_VARS
   MORE_VARS    MORE_VARS
 #endif  #endif
 #ifdef HAS_FFCALL  #ifdef HAS_FFCALL
   av_alist alist;    av_alist alist;
   extern va_alist clist;    extern va_alist gforth_clist;
   float frv;    float frv;
   int irv;    int irv;
   double drv;    double drv;
   long long llrv;    long long llrv;
   void * prv;    void * prv;
 #endif  #endif
 #ifdef HAS_LIBFFI    register Address up UPREG = gforth_UP;
   extern void * ritem;  #if !defined(GFORTH_DEBUGGING)
   extern void ** clist;  
   extern void ffi_callback(ffi_cif * cif, void * resp, void ** args, Xt * ip);  
 #endif  
   register Address up UPREG = UP;  
   register Cell MAYBE_UNUSED spTOS TOSREG;    register Cell MAYBE_UNUSED spTOS TOSREG;
   register Cell MAYBE_UNUSED spb spbREG;    register Cell MAYBE_UNUSED spb spbREG;
   register Cell MAYBE_UNUSED spc spcREG;    register Cell MAYBE_UNUSED spc spcREG;
   register Cell MAYBE_UNUSED spd spdREG;    register Cell MAYBE_UNUSED spd spdREG;
   register Cell MAYBE_UNUSED spe speREG;    register Cell MAYBE_UNUSED spe speREG;
   register Cell MAYBE_UNUSED spf speREG;    register Cell MAYBE_UNUSED spf spfREG;
   register Cell MAYBE_UNUSED spg speREG;    register Cell MAYBE_UNUSED spg spgREG;
   register Cell MAYBE_UNUSED sph speREG;    register Cell MAYBE_UNUSED sph sphREG;
   IF_fpTOS(register Float fpTOS FTOSREG;)    IF_fpTOS(register Float fpTOS FTOSREG;)
   #endif /* !defined(GFORTH_DEBUGGING) */
 #if defined(DOUBLY_INDIRECT)  #if defined(DOUBLY_INDIRECT)
   static Label *symbols;    static Label *symbols;
   static void *routines[]= {    static void *routines[]= {
Line 345  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 393  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #include PRIM_LAB_I  #include PRIM_LAB_I
 #undef INST_ADDR  #undef INST_ADDR
   };    };
   #ifdef STANDALONE
   #define INST_ADDR(name) ((Label)&&I_##name)
   #include "image.i"
   #undef INST_ADDR
   #endif
 #ifdef CPU_DEP2  #ifdef CPU_DEP2
   CPU_DEP2    CPU_DEP2
 #endif  #endif
   
   rp = rp0;    rp = gforth_RP;
 #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)ip0,(unsigned)sp,(unsigned)rp,            (unsigned)ip0,(unsigned)sp,(unsigned)rp,
Line 366  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 419  Label *engine(Xt *ip0, Cell *sp0, Cell *
   
     symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset);      symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset);
     xts = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+XT_OFFSET)+xt_offset);      xts = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+XT_OFFSET)+xt_offset);
     for (i=0; i<DOESJUMP+1; i++)      for (i=0; i<DOER_MAX+1; i++)
       xts[i] = symbols[i] = (Label)routines[i];        xts[i] = symbols[i] = (Label)routines[i];
     for (; routines[i]!=0; i++) {      for (; routines[i]!=0; i++) {
       if (i>=MAX_SYMBOLS) {        if (i>=MAX_SYMBOLS) {
Line 376  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 429  Label *engine(Xt *ip0, Cell *sp0, Cell *
       xts[i] = symbols[i] = &routines[i];        xts[i] = symbols[i] = &routines[i];
     }      }
 #endif /* defined(DOUBLY_INDIRECT) */  #endif /* defined(DOUBLY_INDIRECT) */
   #ifdef STANDALONE
       return image;
   #else
     return symbols;      return symbols;
   #endif
   }    }
   
 #if !(defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING))  #ifdef USE_TOS
   sp += STACK_CACHE_DEFAULT-1;    sp += STACK_CACHE_DEFAULT-1;
   /* some of those registers are dead, but its simpler to initialize them all */  spTOS = sp[0];    /* some of those registers are dead, but its simpler to initialize them all */  spTOS = sp[0];
   spb = sp[-1];    spb = sp[-1];

Removed from v.1.85  
changed lines
  Added in v.1.120


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