Annotation of gforth/engine.c, revision 1.13
1.1 anton 1: /*
1.13 ! pazsan 2: $Id: engine.c,v 1.12 1994/08/25 15:25:21 anton Exp $
1.1 anton 3: Copyright 1992 by the ANSI figForth Development Group
4: */
5:
6: #include <ctype.h>
7: #include <stdio.h>
8: #include <string.h>
9: #include <math.h>
10: #include <sys/types.h>
11: #include <sys/stat.h>
12: #include <fcntl.h>
13: #include <assert.h>
14: #include <stdlib.h>
1.2 pazsan 15: #include <time.h>
1.6 pazsan 16: #include <sys/time.h>
1.1 anton 17: #include "forth.h"
18: #include "io.h"
19:
20: typedef union {
21: struct {
22: #ifdef BIG_ENDIAN
23: Cell high;
24: Cell low;
25: #else
26: Cell low;
27: Cell high;
28: #endif;
29: } cells;
30: DCell dcell;
31: } Double_Store;
32:
33: typedef struct F83Name {
34: struct F83Name *next; /* the link field for old hands */
35: char countetc;
36: Char name[0];
37: } F83Name;
38:
39: /* are macros for setting necessary? */
40: #define F83NAME_COUNT(np) ((np)->countetc & 0x1f)
41: #define F83NAME_SMUDGE(np) (((np)->countetc & 0x40) != 0)
42: #define F83NAME_IMMEDIATE(np) (((np)->countetc & 0x20) != 0)
43:
44: /* NEXT and NEXT1 are split into several parts to help scheduling */
45: #ifdef DIRECT_THREADED
1.13 ! pazsan 46: # define NEXT1_P1
! 47: # ifdef i386
! 48: # define NEXT1_P2 ({cfa=*ip++; goto *cfa;})
! 49: # else
! 50: # define NEXT1_P2 ({goto *cfa;})
! 51: # endif
1.4 pazsan 52: # define DEF_CA
1.1 anton 53: #else
1.4 pazsan 54: # define NEXT1_P1 ({ca = *cfa;})
55: # define NEXT1_P2 ({goto *ca;})
56: # define DEF_CA Label ca;
1.1 anton 57: #endif
1.13 ! pazsan 58: #if defined(i386) && defined(DIRECT_THREADED)
! 59: # define NEXT_P1
! 60: # define NEXT1 ({goto *cfa;})
! 61: #else
! 62: # define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
! 63: # define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
! 64: #endif
1.1 anton 65:
1.4 pazsan 66: #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
1.1 anton 67:
68: #ifdef USE_TOS
69: #define IF_TOS(x) x
70: #else
71: #define IF_TOS(x)
72: #define TOS (sp[0])
73: #endif
74:
75: #ifdef USE_FTOS
76: #define IF_FTOS(x) x
77: #else
78: #define IF_FTOS(x)
79: #define FTOS (fp[0])
80: #endif
81:
82: int emitcounter;
83: #define NULLC '\0'
84:
1.13 ! pazsan 85: #ifdef copycstr
! 86: # define cstr(to,from,size)\
1.3 pazsan 87: { memcpy(to,from,size);\
1.1 anton 88: to[size]=NULLC;}
1.13 ! pazsan 89: #else
! 90: char scratch[1024];
! 91: int soffset;
! 92: # define cstr(from,size) \
! 93: ({ char * to = scratch; \
! 94: memcpy(to,from,size); \
! 95: to[size] = NULLC; \
! 96: soffset = size+1; \
! 97: to; \
! 98: })
! 99: # define cstr1(from,size) \
! 100: ({ char * to = scratch+soffset; \
! 101: memcpy(to,from,size); \
! 102: to[size] = NULLC; \
! 103: soffset += size+1; \
! 104: to; \
! 105: })
! 106: #endif
! 107:
1.1 anton 108: #define NEWLINE '\n'
109:
1.13 ! pazsan 110:
1.1 anton 111: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
1.6 pazsan 112:
1.11 pazsan 113: static Address up0=NULL;
114:
1.13 ! pazsan 115: #if defined(i386) && defined(FORCE_REG)
! 116: # define REG(reg) __asm__(reg)
! 117:
! 118: Label *engine(Xt *ip0, Cell *sp0, Cell *rp, Float *fp, Address lp)
! 119: {
! 120: register Xt *ip REG("%esi")=ip0;
! 121: register Cell *sp REG("%edi")=sp0;
! 122:
! 123: #else
! 124: # define REG(reg)
! 125:
1.5 anton 126: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
1.13 ! pazsan 127: {
! 128: #endif
1.1 anton 129: /* executes code at ip, if ip!=NULL
130: returns array of machine code labels (for use in a loader), if ip==NULL
131: */
1.13 ! pazsan 132: register Xt cfa
! 133: #ifdef i386
! 134: # ifdef USE_TOS
! 135: REG("%ecx")
! 136: # else
! 137: REG("%edx")
! 138: # endif
! 139: #endif
! 140: ;
1.11 pazsan 141: Address up=up0;
1.1 anton 142: static Label symbols[]= {
143: &&docol,
144: &&docon,
145: &&dovar,
1.4 pazsan 146: &&douser,
1.12 anton 147: &&dodefer,
1.1 anton 148: &&dodoes,
1.6 pazsan 149: &&dodoes, /* dummy for does handler address */
1.1 anton 150: #include "prim_labels.i"
151: };
152: IF_TOS(register Cell TOS;)
153: IF_FTOS(Float FTOS;)
154: #ifdef CPU_DEP
155: CPU_DEP;
156: #endif
157:
158: if (ip == NULL)
159: return symbols;
1.10 anton 160:
1.1 anton 161: IF_TOS(TOS = sp[0]);
162: IF_FTOS(FTOS = fp[0]);
163: prep_terminal();
164: NEXT;
165:
166: docol:
167: #ifdef DEBUG
1.6 pazsan 168: printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1 anton 169: #endif
1.13 ! pazsan 170: #ifdef i386
1.1 anton 171: /* this is the simple version */
172: *--rp = (Cell)ip;
173: ip = (Xt *)PFA1(cfa);
174: NEXT;
175: #endif
176: /* this one is important, so we help the compiler optimizing
177: The following version may be better (for scheduling), but probably has
178: problems with code fields employing calls and delay slots
179: */
180: {
1.4 pazsan 181: DEF_CA
1.1 anton 182: Xt *current_ip = (Xt *)PFA1(cfa);
183: cfa = *current_ip;
184: NEXT1_P1;
185: *--rp = (Cell)ip;
186: ip = current_ip+1;
1.3 pazsan 187: NEXT1_P2;
1.1 anton 188: }
189:
190: docon:
191: #ifdef DEBUG
1.6 pazsan 192: printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
1.1 anton 193: #endif
194: #ifdef USE_TOS
195: *sp-- = TOS;
196: TOS = *(Cell *)PFA1(cfa);
197: #else
198: *--sp = *(Cell *)PFA1(cfa);
199: #endif
200: NEXT;
201:
202: dovar:
203: #ifdef DEBUG
1.6 pazsan 204: printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1 anton 205: #endif
206: #ifdef USE_TOS
207: *sp-- = TOS;
208: TOS = (Cell)PFA1(cfa);
209: #else
210: *--sp = (Cell)PFA1(cfa);
211: #endif
212: NEXT;
213:
214: /* !! user? */
215:
1.4 pazsan 216: douser:
217: #ifdef DEBUG
1.6 pazsan 218: printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.4 pazsan 219: #endif
220: #ifdef USE_TOS
221: *sp-- = TOS;
1.5 anton 222: TOS = (Cell)(up+*(Cell*)PFA1(cfa));
1.4 pazsan 223: #else
1.5 anton 224: *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
1.4 pazsan 225: #endif
226: NEXT;
227:
1.12 anton 228: dodefer:
229: #ifdef DEBUG
230: printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
231: #endif
232: cfa = *(Xt *)PFA1(cfa);
233: NEXT1;
234:
1.1 anton 235: dodoes:
236: /* this assumes the following structure:
237: defining-word:
238:
239: ...
240: DOES>
241: (possible padding)
242: possibly handler: jmp dodoes
243: (possible branch delay slot(s))
244: Forth code after DOES>
245:
246: defined word:
247:
248: cfa: address of or jump to handler OR
249: address of or jump to dodoes, address of DOES-code
250: pfa:
251:
252: */
253: #ifdef DEBUG
1.6 pazsan 254: printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
255: fflush(stdout);
1.1 anton 256: #endif
257: *--rp = (Cell)ip;
258: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
1.13 ! pazsan 259: ip = DOES_CODE1(cfa);
1.1 anton 260: #ifdef USE_TOS
261: *sp-- = TOS;
262: TOS = (Cell)PFA(cfa);
263: #else
264: *--sp = (Cell)PFA(cfa);
265: #endif
266: NEXT;
267:
268: #include "primitives.i"
269: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>