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