1: /*
2: $Id: engine.c,v 1.14 1994/09/08 17:20:05 anton Exp $
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>
15: #include <time.h>
16: #include <sys/time.h>
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: unless CISC_NEXT is defined */
46: #ifdef CISC_NEXT
47: #define NEXT1_P1
48: #define NEXT_P1
49: #define DEF_CA
50: #ifdef DIRECT_THREADED
51: #define NEXT1_P2 ({goto *cfa;})
52: #else
53: #define NEXT1_P2 ({goto **cfa;})
54: #endif /* DIRECT_THREADED */
55: #define NEXT_P2 ({cfa = *ip++; NEXT1_P2;})
56: #else /* CISC_NEXT */
57: #ifdef DIRECT_THREADED
58: #define NEXT1_P1
59: #define NEXT1_P2 ({goto *cfa;})
60: #define DEF_CA
61: #else /* DIRECT_THREADED */
62: #define NEXT1_P1 ({ca = *cfa;})
63: #define NEXT1_P2 ({goto *ca;})
64: #define DEF_CA Label ca;
65: #endif /* DIRECT_THREADED */
66: #define NEXT_P1 ({cfa=*ip++; NEXT1_P1;})
67: #define NEXT_P2 NEXT1_P2
68: #endif /* CISC_NEXT */
69:
70: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
71: #define NEXT ({DEF_CA NEXT_P1; NEXT_P2;})
72:
73: #ifdef USE_TOS
74: #define IF_TOS(x) x
75: #else
76: #define IF_TOS(x)
77: #define TOS (sp[0])
78: #endif
79:
80: #ifdef USE_FTOS
81: #define IF_FTOS(x) x
82: #else
83: #define IF_FTOS(x)
84: #define FTOS (fp[0])
85: #endif
86:
87: int emitcounter;
88: #define NULLC '\0'
89:
90: char *cstr(Char *from, UCell size, int clear)
91: /* if clear is true, scratch can be reused, otherwise we want more of
92: the same */
93: {
94: static char *scratch=NULL;
95: static unsigned scratchsize=0;
96: static char *nextscratch;
97: char *oldnextscratch;
98:
99: if (clear)
100: nextscratch=scratch;
101: if (scratch==NULL) {
102: scratch=malloc(size+1);
103: nextscratch=scratch;
104: scratchsize=size;
105: }
106: else if (nextscratch+size>scratch+scratchsize) {
107: char *oldscratch=scratch;
108: scratch = realloc(scratch, (nextscratch-scratch)+size+1);
109: nextscratch=scratch+(nextscratch-oldscratch);
110: scratchsize=size;
111: }
112: memcpy(nextscratch,from,size);
113: nextscratch[size]='\0';
114: oldnextscratch = nextscratch;
115: nextscratch += size+1;
116: return oldnextscratch;
117: }
118:
119: #define NEWLINE '\n'
120:
121:
122: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
123:
124: static Address up0=NULL;
125:
126: #if defined(i386) && defined(FORCE_REG)
127: # define REG(reg) __asm__(reg)
128:
129: Label *engine(Xt *ip0, Cell *sp0, Cell *rp, Float *fp, Address lp)
130: {
131: register Xt *ip REG("%esi")=ip0;
132: register Cell *sp REG("%edi")=sp0;
133:
134: #else
135: # define REG(reg)
136:
137: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
138: {
139: #endif
140: /* executes code at ip, if ip!=NULL
141: returns array of machine code labels (for use in a loader), if ip==NULL
142: */
143: register Xt cfa
144: #ifdef i386
145: # ifdef USE_TOS
146: REG("%ecx")
147: # else
148: REG("%edx")
149: # endif
150: #endif
151: ;
152: Address up=up0;
153: static Label symbols[]= {
154: &&docol,
155: &&docon,
156: &&dovar,
157: &&douser,
158: &&dodefer,
159: &&dodoes,
160: &&dodoes, /* dummy for does handler address */
161: #include "prim_labels.i"
162: };
163: IF_TOS(register Cell TOS;)
164: IF_FTOS(Float FTOS;)
165: #ifdef CPU_DEP
166: CPU_DEP;
167: #endif
168:
169: if (ip == NULL)
170: return symbols;
171:
172: IF_TOS(TOS = sp[0]);
173: IF_FTOS(FTOS = fp[0]);
174: prep_terminal();
175: NEXT;
176:
177: docol:
178: #ifdef DEBUG
179: printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
180: #endif
181: #ifdef i386
182: /* this is the simple version */
183: *--rp = (Cell)ip;
184: ip = (Xt *)PFA1(cfa);
185: NEXT;
186: #endif
187: /* this one is important, so we help the compiler optimizing
188: The following version may be better (for scheduling), but probably has
189: problems with code fields employing calls and delay slots
190: */
191: {
192: DEF_CA
193: Xt *current_ip = (Xt *)PFA1(cfa);
194: cfa = *current_ip;
195: NEXT1_P1;
196: *--rp = (Cell)ip;
197: ip = current_ip+1;
198: NEXT1_P2;
199: }
200:
201: docon:
202: #ifdef DEBUG
203: printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
204: #endif
205: #ifdef USE_TOS
206: *sp-- = TOS;
207: TOS = *(Cell *)PFA1(cfa);
208: #else
209: *--sp = *(Cell *)PFA1(cfa);
210: #endif
211: NEXT;
212:
213: dovar:
214: #ifdef DEBUG
215: printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
216: #endif
217: #ifdef USE_TOS
218: *sp-- = TOS;
219: TOS = (Cell)PFA1(cfa);
220: #else
221: *--sp = (Cell)PFA1(cfa);
222: #endif
223: NEXT;
224:
225: /* !! user? */
226:
227: douser:
228: #ifdef DEBUG
229: printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
230: #endif
231: #ifdef USE_TOS
232: *sp-- = TOS;
233: TOS = (Cell)(up+*(Cell*)PFA1(cfa));
234: #else
235: *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
236: #endif
237: NEXT;
238:
239: dodefer:
240: #ifdef DEBUG
241: printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
242: #endif
243: cfa = *(Xt *)PFA1(cfa);
244: NEXT1;
245:
246: dodoes:
247: /* this assumes the following structure:
248: defining-word:
249:
250: ...
251: DOES>
252: (possible padding)
253: possibly handler: jmp dodoes
254: (possible branch delay slot(s))
255: Forth code after DOES>
256:
257: defined word:
258:
259: cfa: address of or jump to handler OR
260: address of or jump to dodoes, address of DOES-code
261: pfa:
262:
263: */
264: #ifdef DEBUG
265: printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
266: fflush(stdout);
267: #endif
268: *--rp = (Cell)ip;
269: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
270: ip = DOES_CODE1(cfa);
271: #ifdef USE_TOS
272: *sp-- = TOS;
273: TOS = (Cell)PFA(cfa);
274: #else
275: *--sp = (Cell)PFA(cfa);
276: #endif
277: NEXT;
278:
279: #include "primitives.i"
280: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>