File:  [gforth] / gforth / engine / engine.c
Revision 1.74: download - view: text, annotated - select for diffs
Sun Jan 25 12:35:58 2004 UTC (16 years, 4 months ago) by anton
Branches: MAIN
CVS tags: HEAD
minore bugfixes (Makefile.in)
enabled 3-state stack caching for gforth-fast and gforth-native
   bugfixes (EXECUTE and PERFORM; spbREG use)
   explicit register allocation to spb for gforth-native, but not gforth-fast
   Due to the shortest-path algorithm this means that gforth-fast uses only
     S0 and S1, not S2, so we could keep that.
     However, we probably want to use more states etc. for other
     architectures, so we may want to have a way to select different
       cache.vmg and different peeprules.vmg files for different
       archs, builds, and binaries.

    1: /* Gforth virtual machine (aka inner interpreter)
    2: 
    3:   Copyright (C) 1995,1996,1997,1998,2000,2003 Free Software Foundation, Inc.
    4: 
    5:   This file is part of Gforth.
    6: 
    7:   Gforth is free software; you can redistribute it and/or
    8:   modify it under the terms of the GNU General Public License
    9:   as published by the Free Software Foundation; either version 2
   10:   of the License, or (at your option) any later version.
   11: 
   12:   This program is distributed in the hope that it will be useful,
   13:   but WITHOUT ANY WARRANTY; without even the implied warranty of
   14:   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15:   GNU General Public License for more details.
   16: 
   17:   You should have received a copy of the GNU General Public License
   18:   along with this program; if not, write to the Free Software
   19:   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   20: */
   21: 
   22: #if defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING)
   23: #define USE_NO_TOS
   24: #else
   25: #define USE_TOS
   26: #endif
   27: #define USE_NO_FTOS
   28: 
   29: #include "config.h"
   30: #include "forth.h"
   31: #include <ctype.h>
   32: #include <stdio.h>
   33: #include <string.h>
   34: #include <math.h>
   35: #include <assert.h>
   36: #include <stdlib.h>
   37: #include <errno.h>
   38: #include "io.h"
   39: #include "threaded.h"
   40: #ifndef STANDALONE
   41: #include <sys/types.h>
   42: #include <sys/stat.h>
   43: #include <fcntl.h>
   44: #include <time.h>
   45: #include <sys/time.h>
   46: #include <unistd.h>
   47: #include <pwd.h>
   48: #include <dirent.h>
   49: #include <sys/resource.h>
   50: #ifdef HAVE_FNMATCH_H
   51: #include <fnmatch.h>
   52: #else
   53: #include "fnmatch.h"
   54: #endif
   55: #else
   56: #include "systypes.h"
   57: #endif
   58: 
   59: #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) /* what else? */
   60: #include <dlfcn.h>
   61: #endif
   62: #if defined(_WIN32)
   63: #include <windows.h>
   64: #endif
   65: #ifdef hpux
   66: #include <dl.h>
   67: #endif
   68: 
   69: #ifdef HAS_FFCALL
   70: #include <avcall.h>
   71: #include <callback.h>
   72: #endif
   73: 
   74: #ifndef SEEK_SET
   75: /* should be defined in stdio.h, but some systems don't have it */
   76: #define SEEK_SET 0
   77: #endif
   78: 
   79: #ifndef HAVE_FSEEKO
   80: #define fseeko fseek
   81: #endif
   82: 
   83: #ifndef HAVE_FTELLO
   84: #define ftello ftell
   85: #endif
   86: 
   87: #define NULLC '\0'
   88: 
   89: #ifdef MEMCMP_AS_SUBROUTINE
   90: extern int gforth_memcmp(const char * s1, const char * s2, size_t n);
   91: #define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n)
   92: #endif
   93: 
   94: #define NEWLINE	'\n'
   95: 
   96: /* conversion on fetch */
   97: 
   98: #define vm_Cell2f(_cell,_x)		((_x)=(Bool)(_cell))
   99: #define vm_Cell2c(_cell,_x)		((_x)=(Char)(_cell))
  100: #define vm_Cell2n(_cell,_x)		((_x)=(Cell)(_cell))
  101: #define vm_Cell2w(_cell,_x)		((_x)=(Cell)(_cell))
  102: #define vm_Cell2u(_cell,_x)		((_x)=(UCell)(_cell))
  103: #define vm_Cell2a_(_cell,_x)		((_x)=(Cell *)(_cell))
  104: #define vm_Cell2c_(_cell,_x)		((_x)=(Char *)(_cell))
  105: #define vm_Cell2f_(_cell,_x)		((_x)=(Float *)(_cell))
  106: #define vm_Cell2df_(_cell,_x)		((_x)=(DFloat *)(_cell))
  107: #define vm_Cell2sf_(_cell,_x)		((_x)=(SFloat *)(_cell))
  108: #define vm_Cell2xt(_cell,_x)		((_x)=(Xt)(_cell))
  109: #define vm_Cell2f83name(_cell,_x)	((_x)=(struct F83Name *)(_cell))
  110: #define vm_Cell2longname(_cell,_x)	((_x)=(struct Longname *)(_cell))
  111: #define vm_Float2r(_float,_x)		(_x=_float)
  112: 
  113: /* conversion on store */
  114: 
  115: #define vm_f2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  116: #define vm_c2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  117: #define vm_n2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  118: #define vm_w2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  119: #define vm_u2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  120: #define vm_a_2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  121: #define vm_c_2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  122: #define vm_f_2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  123: #define vm_df_2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  124: #define vm_sf_2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  125: #define vm_xt2Cell(_x,_cell)		((_cell)=(Cell)(_x))
  126: #define vm_f83name2Cell(_x,_cell)	((_cell)=(Cell)(_x))
  127: #define vm_longname2Cell(_x,_cell)	((_cell)=(Cell)(_x))
  128: #define vm_r2Float(_x,_float)		(_float=_x)
  129: 
  130: #define vm_Cell2Cell(_x,_y)		(_y=_x)
  131: 
  132: #ifdef NO_IP
  133: #define IMM_ARG(access,value)		(VARIANT(value))
  134: #else
  135: #define IMM_ARG(access,value)		(access)
  136: #endif
  137: 
  138: /* if machine.h has not defined explicit registers, define them as implicit */
  139: #ifndef IPREG
  140: #define IPREG
  141: #endif
  142: #ifndef SPREG
  143: #define SPREG
  144: #endif
  145: #ifndef RPREG
  146: #define RPREG
  147: #endif
  148: #ifndef FPREG
  149: #define FPREG
  150: #endif
  151: #ifndef LPREG
  152: #define LPREG
  153: #endif
  154: #ifndef CFAREG
  155: #define CFAREG
  156: #endif
  157: #ifndef UPREG
  158: #define UPREG
  159: #endif
  160: #ifndef TOSREG
  161: #define TOSREG
  162: #endif
  163: #ifndef spbREG
  164: #define spbREG
  165: #endif
  166: #ifndef spcREG
  167: #define spcREG
  168: #endif
  169: #ifndef FTOSREG
  170: #define FTOSREG
  171: #endif
  172: 
  173: #ifndef CPU_DEP1
  174: # define CPU_DEP1 0
  175: #endif
  176: 
  177: /* instructions containing SUPER_END must be the last instruction of a
  178:    super-instruction (e.g., branches, EXECUTE, and other instructions
  179:    ending the basic block). Instructions containing SET_IP get this
  180:    automatically, so you usually don't have to write it.  If you have
  181:    to write it, write it after IP points to the next instruction.
  182:    Used for profiling.  Don't write it in a word containing SET_IP, or
  183:    the following block will be counted twice. */
  184: #ifdef VM_PROFILING
  185: #define SUPER_END  vm_count_block(IP)
  186: #else
  187: #define SUPER_END
  188: #endif
  189: #define SUPER_CONTINUE
  190: 
  191: #ifdef GFORTH_DEBUGGING
  192: #if DEBUG
  193: #define NAME(string) { saved_ip=ip; asm("# "string); fprintf(stderr,"%08lx depth=%3ld: "string"\n",(Cell)ip,sp0+3-sp);}
  194: #else /* !DEBUG */
  195: #define NAME(string) { saved_ip=ip; asm(""); }
  196: /* the asm here is to avoid reordering of following stuff above the
  197:    assignment; this is an old-style asm (no operands), and therefore
  198:    is treated like "asm volatile ..."; i.e., it prevents most
  199:    reorderings across itself.  We want the assignment above first,
  200:    because the stack loads may already cause a stack underflow. */
  201: #endif /* !DEBUG */
  202: #elif DEBUG
  203: #       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); }
  204: #else
  205: #	define	NAME(string) asm("# "string);
  206: #endif
  207: 
  208: #ifdef DEBUG
  209: #define CFA_TO_NAME(__cfa) \
  210:       Cell len, i; \
  211:       char * name = __cfa; \
  212:       for(i=0; i<32; i+=sizeof(Cell)) { \
  213:         len = ((Cell*)name)[-1]; \
  214:         if(len < 0) { \
  215: 	  len &= 0x1F; \
  216:           if((len+sizeof(Cell)) > i) break; \
  217: 	} len = 0; \
  218: 	name -= sizeof(Cell); \
  219:       }
  220: #endif
  221: 
  222: #ifdef HAS_FFCALL
  223: #define SAVE_REGS IF_spTOS(sp[0]=spTOS); IF_fpTOS(fp[0]=fpTOS); SP=sp; FP=fp; RP=rp; LP=lp;
  224: #define REST_REGS sp=SP; fp=FP; rp=RP; lp=LP; IF_spTOS(spTOS=sp[0]); IF_fpTOS(fpTOS=fp[0]);
  225: #endif
  226: 
  227: #if !defined(ENGINE)
  228: /* normal engine */
  229: #define VARIANT(v)	(v)
  230: #define JUMP(target)	goto I_noop
  231: #define LABEL(name) J_##name: asm(""); I_##name:
  232: 
  233: #elif ENGINE==2
  234: /* variant with padding between VM instructions for finding out
  235:    cross-inst jumps (for dynamic code) */
  236: #define engine engine2
  237: #define VARIANT(v)	(v)
  238: #define JUMP(target)	goto I_noop
  239: #define LABEL(name) J_##name: SKIP16; I_##name:
  240: #define IN_ENGINE2
  241: 
  242: #elif ENGINE==3
  243: /* variant with different immediate arguments for finding out
  244:    immediate arguments (for native code) */
  245: #define engine engine3
  246: #define VARIANT(v)	((v)^0xffffffff)
  247: #define JUMP(target)	goto K_lit
  248: #define LABEL(name) J_##name: asm(""); I_##name:
  249: #else
  250: #error illegal ENGINE value
  251: #endif /* ENGINE */
  252: 
  253: /* the asm(""); is there to get a stop compiled on Itanium */
  254: #define LABEL2(name) K_##name: asm("");
  255: 
  256: Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
  257: /* executes code at ip, if ip!=NULL
  258:    returns array of machine code labels (for use in a loader), if ip==NULL
  259: */
  260: {
  261: #ifndef GFORTH_DEBUGGING
  262:   register Cell *rp RPREG;
  263: #endif
  264: #ifndef NO_IP
  265:   register Xt *ip IPREG = ip0;
  266: #endif
  267:   register Cell *sp SPREG = sp0;
  268:   register Float *fp FPREG = fp0;
  269:   register Address lp LPREG = lp0;
  270:   register Xt cfa CFAREG;
  271: #ifdef MORE_VARS
  272:   MORE_VARS
  273: #endif
  274: #ifdef HAS_FFCALL
  275:   av_alist alist;
  276:   extern va_alist clist;
  277:   float frv;
  278:   int irv;
  279:   double drv;
  280:   long long llrv;
  281:   void * prv;
  282: #endif
  283:   register Address up UPREG = UP;
  284:   IF_spTOS(register Cell MAYBE_UNUSED spTOS TOSREG;)
  285:   register Cell MAYBE_UNUSED spb spbREG;
  286:   register Cell MAYBE_UNUSED spc spcREG;
  287:   IF_fpTOS(register Float fpTOS FTOSREG;)
  288: #if defined(DOUBLY_INDIRECT)
  289:   static Label *symbols;
  290:   static void *routines[]= {
  291: #define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0]))
  292: #else /* !defined(DOUBLY_INDIRECT) */
  293:   static Label symbols[]= {
  294: #define MAX_SYMBOLS (sizeof(symbols)/sizeof(symbols[0]))
  295: #endif /* !defined(DOUBLY_INDIRECT) */
  296: #define INST_ADDR(name) ((Label)&&I_##name)
  297: #include PRIM_LAB_I
  298: #undef INST_ADDR
  299:     (Label)0,
  300: #define INST_ADDR(name) ((Label)&&K_##name)
  301: #include PRIM_LAB_I
  302: #undef INST_ADDR
  303: #define INST_ADDR(name) ((Label)&&J_##name)
  304: #include PRIM_LAB_I
  305: #undef INST_ADDR
  306:     (Label)&&after_last
  307:   };
  308: #ifdef CPU_DEP2
  309:   CPU_DEP2
  310: #endif
  311: 
  312:   rp = rp0;
  313: #ifdef DEBUG
  314:   fprintf(stderr,"ip=%x, sp=%x, rp=%x, fp=%x, lp=%x, up=%x\n",
  315:           (unsigned)ip0,(unsigned)sp,(unsigned)rp,
  316: 	  (unsigned)fp,(unsigned)lp,(unsigned)up);
  317: #endif
  318: 
  319:   if (ip0 == NULL) {
  320: #if defined(DOUBLY_INDIRECT)
  321: #define CODE_OFFSET (26*sizeof(Cell))
  322: #define XT_OFFSET (22*sizeof(Cell))
  323:     int i;
  324:     Cell code_offset = offset_image? CODE_OFFSET : 0;
  325:     Cell xt_offset = offset_image? XT_OFFSET : 0;
  326: 
  327:     symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset);
  328:     xts = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+XT_OFFSET)+xt_offset);
  329:     for (i=0; i<DOESJUMP+1; i++)
  330:       xts[i] = symbols[i] = (Label)routines[i];
  331:     for (; routines[i]!=0; i++) {
  332:       if (i>=MAX_SYMBOLS) {
  333: 	fprintf(stderr,"gforth-ditc: more than %ld primitives\n",(long)MAX_SYMBOLS);
  334: 	exit(1);
  335:       }
  336:       xts[i] = symbols[i] = &routines[i];
  337:     }
  338: #endif /* defined(DOUBLY_INDIRECT) */
  339:     return symbols;
  340:   }
  341: 
  342:   IF_spTOS(spTOS = sp[0]);
  343:   IF_fpTOS(fpTOS = fp[0]);
  344: /*  prep_terminal(); */
  345: #ifdef NO_IP
  346:   goto *(*(Label *)ip0);
  347: #else
  348:   SET_IP(ip);
  349:   SUPER_END; /* count the first block, too */
  350:   NEXT;
  351: #endif
  352: 
  353: #ifdef CPU_DEP3
  354:   CPU_DEP3
  355: #endif
  356: 
  357: #include PRIM_I
  358:   after_last: return (Label *)0;
  359:   /*needed only to get the length of the last primitive */
  360: }

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