1: /*
2: $Id: engine.c,v 1.6 1994/05/18 17:29:52 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: #ifndef unlink
21: extern unlink(char *);
22: #endif
23: #ifndef ftruncate
24: extern ftruncate(int, int);
25: #endif
26:
27: typedef union {
28: struct {
29: #ifdef BIG_ENDIAN
30: Cell high;
31: Cell low;
32: #else
33: Cell low;
34: Cell high;
35: #endif;
36: } cells;
37: DCell dcell;
38: } Double_Store;
39:
40: typedef struct F83Name {
41: struct F83Name *next; /* the link field for old hands */
42: char countetc;
43: Char name[0];
44: } F83Name;
45:
46: /* are macros for setting necessary? */
47: #define F83NAME_COUNT(np) ((np)->countetc & 0x1f)
48: #define F83NAME_SMUDGE(np) (((np)->countetc & 0x40) != 0)
49: #define F83NAME_IMMEDIATE(np) (((np)->countetc & 0x20) != 0)
50:
51: /* NEXT and NEXT1 are split into several parts to help scheduling */
52: #ifdef DIRECT_THREADED
53: # define NEXT1_P1
54: # define NEXT1_P2 ({goto *cfa;})
55: # define DEF_CA
56: #else
57: # define NEXT1_P1 ({ca = *cfa;})
58: # define NEXT1_P2 ({goto *ca;})
59: # define DEF_CA Label ca;
60: #endif
61: #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
62:
63: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
64: #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
65:
66: #ifdef USE_TOS
67: #define IF_TOS(x) x
68: #else
69: #define IF_TOS(x)
70: #define TOS (sp[0])
71: #endif
72:
73: #ifdef USE_FTOS
74: #define IF_FTOS(x) x
75: #else
76: #define IF_FTOS(x)
77: #define FTOS (fp[0])
78: #endif
79:
80: int emitcounter;
81: #define NULLC '\0'
82:
83: #define cstr(to,from,size)\
84: { memcpy(to,from,size);\
85: to[size]=NULLC;}
86: #define NEWLINE '\n'
87:
88: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
89:
90: #if ~defined(select) && defined(DOS)
91: /* select replacement for DOS computers for ms only */
92: void select(int n, int a, int b, int c, struct timeval * timeout)
93: {
94: struct timeval time1;
95: struct timeval time2;
96: struct timezone zone1;
97:
98: gettimeofday(&time1,&zone1);
99: time1.tv_sec += timeout->tv_sec;
100: time1.tv_usec += timeout->tv_usec;
101: while(time1.tv_usec >= 1000000)
102: {
103: time1.tv_usec -= 1000000;
104: time1.tv_sec++;
105: }
106: do
107: {
108: gettimeofday(&time2,&zone1);
109: }
110: while(time2.tv_usec < time1.tv_usec || time2.tv_sec < time1.tv_sec);
111: }
112: #endif
113:
114: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
115: /* executes code at ip, if ip!=NULL
116: returns array of machine code labels (for use in a loader), if ip==NULL
117: */
118: {
119: Xt cfa;
120: Address up=NULL;
121: static Label symbols[]= {
122: &&docol,
123: &&docon,
124: &&dovar,
125: &&douser,
126: &&dodoes,
127: &&dodoes, /* dummy for does handler address */
128: #include "prim_labels.i"
129: };
130: IF_TOS(register Cell TOS;)
131: IF_FTOS(Float FTOS;)
132: #ifdef CPU_DEP
133: CPU_DEP;
134: #endif
135:
136: if (ip == NULL)
137: return symbols;
138:
139: IF_TOS(TOS = sp[0]);
140: IF_FTOS(FTOS = fp[0]);
141: prep_terminal();
142: NEXT;
143:
144: docol:
145: #ifdef DEBUG
146: printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
147: #endif
148: #ifdef undefined
149: /* this is the simple version */
150: *--rp = (Cell)ip;
151: ip = (Xt *)PFA1(cfa);
152: NEXT;
153: #endif
154: /* this one is important, so we help the compiler optimizing
155: The following version may be better (for scheduling), but probably has
156: problems with code fields employing calls and delay slots
157: */
158: {
159: DEF_CA
160: Xt *current_ip = (Xt *)PFA1(cfa);
161: cfa = *current_ip;
162: NEXT1_P1;
163: *--rp = (Cell)ip;
164: ip = current_ip+1;
165: NEXT1_P2;
166: }
167:
168: docon:
169: #ifdef DEBUG
170: printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
171: #endif
172: #ifdef USE_TOS
173: *sp-- = TOS;
174: TOS = *(Cell *)PFA1(cfa);
175: #else
176: *--sp = *(Cell *)PFA1(cfa);
177: #endif
178: NEXT;
179:
180: dovar:
181: #ifdef DEBUG
182: printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
183: #endif
184: #ifdef USE_TOS
185: *sp-- = TOS;
186: TOS = (Cell)PFA1(cfa);
187: #else
188: *--sp = (Cell)PFA1(cfa);
189: #endif
190: NEXT;
191:
192: /* !! user? */
193:
194: douser:
195: #ifdef DEBUG
196: printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
197: #endif
198: #ifdef USE_TOS
199: *sp-- = TOS;
200: TOS = (Cell)(up+*(Cell*)PFA1(cfa));
201: #else
202: *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
203: #endif
204: NEXT;
205:
206: dodoes:
207: /* this assumes the following structure:
208: defining-word:
209:
210: ...
211: DOES>
212: (possible padding)
213: possibly handler: jmp dodoes
214: (possible branch delay slot(s))
215: Forth code after DOES>
216:
217: defined word:
218:
219: cfa: address of or jump to handler OR
220: address of or jump to dodoes, address of DOES-code
221: pfa:
222:
223: */
224: #ifdef DEBUG
225: printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
226: fflush(stdout);
227: #endif
228: *--rp = (Cell)ip;
229: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
230: #ifdef USE_TOS
231: *sp-- = TOS;
232: TOS = (Cell)PFA(cfa);
233: #else
234: *--sp = (Cell)PFA(cfa);
235: #endif
236: ip = DOES_CODE1(cfa);
237: NEXT;
238:
239: #include "primitives.i"
240: }
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