Annotation of gforth/engine.c, revision 1.16
1.1 anton 1: /*
1.16 ! pazsan 2: $Id: engine.c,v 1.15 1994/09/09 16:27:18 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:
1.14 anton 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
1.1 anton 50: #ifdef DIRECT_THREADED
1.14 anton 51: #define NEXT1_P2 ({goto *cfa;})
1.1 anton 52: #else
1.14 anton 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 */
1.1 anton 69:
1.14 anton 70: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
71: #define NEXT ({DEF_CA NEXT_P1; NEXT_P2;})
1.1 anton 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:
1.14 anton 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: }
1.13 pazsan 118:
1.1 anton 119: #define NEWLINE '\n'
120:
1.13 pazsan 121:
1.1 anton 122: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
1.6 pazsan 123:
1.11 pazsan 124: static Address up0=NULL;
125:
1.15 anton 126: /* if machine.h has not defined explicit registers, define them as implicit */
127: #ifndef IPREG
128: #define IPREG
129: #endif
130: #ifndef SPREG
131: #define SPREG
132: #endif
133: #ifndef RPREG
134: #define RPREG
135: #endif
136: #ifndef FPREG
137: #define FPREG
138: #endif
139: #ifndef LPREG
140: #define LPREG
141: #endif
142: #ifndef CFAREG
143: #define CFAREG
144: #endif
145: #ifndef UPREG
146: #define UPREG
147: #endif
148: #ifndef TOSREG
149: #define TOSREG
150: #endif
151: #ifndef FTOSREG
152: #define FTOSREG
153: #endif
1.13 pazsan 154:
1.15 anton 155: Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
1.1 anton 156: /* executes code at ip, if ip!=NULL
157: returns array of machine code labels (for use in a loader), if ip==NULL
158: */
1.15 anton 159: {
160: register Xt *ip IPREG = ip0;
161: register Cell *sp SPREG = sp0;
162: register Cell *rp RPREG = rp0;
163: register Float *fp FPREG = fp0;
164: register Address lp LPREG = lp0;
165: register Xt cfa CFAREG;
166: register Address up UPREG = up0;
167: IF_TOS(register Cell TOS TOSREG;)
168: IF_FTOS(register Float FTOS FTOSREG;)
1.1 anton 169: static Label symbols[]= {
170: &&docol,
171: &&docon,
172: &&dovar,
1.4 pazsan 173: &&douser,
1.12 anton 174: &&dodefer,
1.1 anton 175: &&dodoes,
1.6 pazsan 176: &&dodoes, /* dummy for does handler address */
1.1 anton 177: #include "prim_labels.i"
178: };
179: #ifdef CPU_DEP
180: CPU_DEP;
181: #endif
182:
1.16 ! pazsan 183: #ifdef DEBUG
! 184: fprintf(stderr,"ip=%x, sp=%x, rp=%x, fp=%x, lp=%x, up=%x\n",
! 185: ip,sp,rp,fp,lp,up);
! 186: #endif
! 187:
1.1 anton 188: if (ip == NULL)
189: return symbols;
1.10 anton 190:
1.1 anton 191: IF_TOS(TOS = sp[0]);
192: IF_FTOS(FTOS = fp[0]);
193: prep_terminal();
194: NEXT;
195:
196: docol:
197: #ifdef DEBUG
1.16 ! pazsan 198: fprintf(stderr,"%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1 anton 199: #endif
1.15 anton 200: #ifdef CISC_NEXT
1.1 anton 201: /* this is the simple version */
202: *--rp = (Cell)ip;
203: ip = (Xt *)PFA1(cfa);
204: NEXT;
1.15 anton 205: #else
1.1 anton 206: /* this one is important, so we help the compiler optimizing
207: The following version may be better (for scheduling), but probably has
208: problems with code fields employing calls and delay slots
209: */
210: {
1.4 pazsan 211: DEF_CA
1.1 anton 212: Xt *current_ip = (Xt *)PFA1(cfa);
213: cfa = *current_ip;
214: NEXT1_P1;
215: *--rp = (Cell)ip;
216: ip = current_ip+1;
1.3 pazsan 217: NEXT1_P2;
1.1 anton 218: }
1.15 anton 219: #endif
1.1 anton 220:
221: docon:
222: #ifdef DEBUG
1.16 ! pazsan 223: fprintf(stderr,"%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
1.1 anton 224: #endif
225: #ifdef USE_TOS
226: *sp-- = TOS;
227: TOS = *(Cell *)PFA1(cfa);
228: #else
229: *--sp = *(Cell *)PFA1(cfa);
230: #endif
231: NEXT;
232:
233: dovar:
234: #ifdef DEBUG
1.16 ! pazsan 235: fprintf(stderr,"%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1 anton 236: #endif
237: #ifdef USE_TOS
238: *sp-- = TOS;
239: TOS = (Cell)PFA1(cfa);
240: #else
241: *--sp = (Cell)PFA1(cfa);
242: #endif
243: NEXT;
244:
245: /* !! user? */
246:
1.4 pazsan 247: douser:
248: #ifdef DEBUG
1.16 ! pazsan 249: fprintf(stderr,"%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.4 pazsan 250: #endif
251: #ifdef USE_TOS
252: *sp-- = TOS;
1.5 anton 253: TOS = (Cell)(up+*(Cell*)PFA1(cfa));
1.4 pazsan 254: #else
1.5 anton 255: *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
1.4 pazsan 256: #endif
257: NEXT;
258:
1.12 anton 259: dodefer:
260: #ifdef DEBUG
1.16 ! pazsan 261: fprintf(stderr,"%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.12 anton 262: #endif
263: cfa = *(Xt *)PFA1(cfa);
264: NEXT1;
265:
1.1 anton 266: dodoes:
267: /* this assumes the following structure:
268: defining-word:
269:
270: ...
271: DOES>
272: (possible padding)
273: possibly handler: jmp dodoes
274: (possible branch delay slot(s))
275: Forth code after DOES>
276:
277: defined word:
278:
279: cfa: address of or jump to handler OR
280: address of or jump to dodoes, address of DOES-code
281: pfa:
282:
283: */
284: #ifdef DEBUG
1.16 ! pazsan 285: fprintf(stderr,"%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,DOES_CODE1(cfa));
! 286: fflush(stderr);
1.1 anton 287: #endif
288: *--rp = (Cell)ip;
289: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
1.13 pazsan 290: ip = DOES_CODE1(cfa);
1.1 anton 291: #ifdef USE_TOS
292: *sp-- = TOS;
293: TOS = (Cell)PFA(cfa);
294: #else
295: *--sp = (Cell)PFA(cfa);
296: #endif
297: NEXT;
1.16 ! pazsan 298:
1.1 anton 299: #include "primitives.i"
300: }
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