gforth/engine/engine.c - view

File: [gforth] / gforth / engine / engine.c
Revision 1.74: download - view: text, annotated - select for diffs
Sun Jan 25 12:35:58 2004 UTC (17 years, 1 month 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: }