1: /*
2: $Id: engine.c,v 1.13 1994/08/31 19:42:44 pazsan 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: #ifdef DIRECT_THREADED
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
52: # define DEF_CA
53: #else
54: # define NEXT1_P1 ({ca = *cfa;})
55: # define NEXT1_P2 ({goto *ca;})
56: # define DEF_CA Label ca;
57: #endif
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
65:
66: #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
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:
85: #ifdef copycstr
86: # define cstr(to,from,size)\
87: { memcpy(to,from,size);\
88: to[size]=NULLC;}
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:
108: #define NEWLINE '\n'
109:
110:
111: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
112:
113: static Address up0=NULL;
114:
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:
126: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
127: {
128: #endif
129: /* executes code at ip, if ip!=NULL
130: returns array of machine code labels (for use in a loader), if ip==NULL
131: */
132: register Xt cfa
133: #ifdef i386
134: # ifdef USE_TOS
135: REG("%ecx")
136: # else
137: REG("%edx")
138: # endif
139: #endif
140: ;
141: Address up=up0;
142: static Label symbols[]= {
143: &&docol,
144: &&docon,
145: &&dovar,
146: &&douser,
147: &&dodefer,
148: &&dodoes,
149: &&dodoes, /* dummy for does handler address */
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;
160:
161: IF_TOS(TOS = sp[0]);
162: IF_FTOS(FTOS = fp[0]);
163: prep_terminal();
164: NEXT;
165:
166: docol:
167: #ifdef DEBUG
168: printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
169: #endif
170: #ifdef i386
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: {
181: DEF_CA
182: Xt *current_ip = (Xt *)PFA1(cfa);
183: cfa = *current_ip;
184: NEXT1_P1;
185: *--rp = (Cell)ip;
186: ip = current_ip+1;
187: NEXT1_P2;
188: }
189:
190: docon:
191: #ifdef DEBUG
192: printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
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
204: printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
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:
216: douser:
217: #ifdef DEBUG
218: printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
219: #endif
220: #ifdef USE_TOS
221: *sp-- = TOS;
222: TOS = (Cell)(up+*(Cell*)PFA1(cfa));
223: #else
224: *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
225: #endif
226: NEXT;
227:
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:
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
254: printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
255: fflush(stdout);
256: #endif
257: *--rp = (Cell)ip;
258: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
259: ip = DOES_CODE1(cfa);
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>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to engine.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth