1: /*
2: $Id: engine.c,v 1.2 1994/04/20 17:12:00 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: #else
51: #define NEXT1_P1 ({ca = *cfa;})
52: #define NEXT1_P2 ({goto *ca;})
53: #endif
54: #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
55:
56: #define NEXT1 ({NEXT1_P1; NEXT1_P2;})
57: #define NEXT ({NEXT_P1; NEXT1_P2;})
58:
59: #ifdef USE_TOS
60: #define IF_TOS(x) x
61: #else
62: #define IF_TOS(x)
63: #define TOS (sp[0])
64: #endif
65:
66: #ifdef USE_FTOS
67: #define IF_FTOS(x) x
68: #else
69: #define IF_FTOS(x)
70: #define FTOS (fp[0])
71: #endif
72:
73: #define DODOES (symbols[3])
74:
75: int emitcounter;
76: #define NULLC '\0'
77:
78: #define cstr(to, from, size)\
79: { memcpy(to, from, size);\
80: to[size]=NULLC;}
81: #define NEWLINE '\n'
82:
83: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
84:
85: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp)
86: /* executes code at ip, if ip!=NULL
87: returns array of machine code labels (for use in a loader), if ip==NULL
88: This is very preliminary, as the bootstrap architecture is not yet decided
89: */
90: {
91: Xt cfa;
92: Address lp=NULL;
93: static Label symbols[]= {
94: &&docol,
95: &&docon,
96: &&dovar,
97: &&dodoes,
98: #include "prim_labels.i"
99: };
100: #ifndef DIRECT_THREADED
101: Label ca;
102: #endif
103: IF_TOS(register Cell TOS;)
104: IF_FTOS(Float FTOS;)
105: #ifdef CPU_DEP
106: CPU_DEP;
107: #endif
108:
109: if (ip == NULL)
110: return symbols;
111:
112: IF_TOS(TOS = sp[0]);
113: IF_FTOS(FTOS = fp[0]);
114: prep_terminal();
115: NEXT;
116:
117: docol:
118: #ifdef DEBUG
119: printf("col: %x\n",(Cell)PFA1(cfa));
120: #endif
121: #ifdef undefined
122: /* this is the simple version */
123: *--rp = (Cell)ip;
124: ip = (Xt *)PFA1(cfa);
125: NEXT;
126: #endif
127: /* this one is important, so we help the compiler optimizing
128: The following version may be better (for scheduling), but probably has
129: problems with code fields employing calls and delay slots
130: */
131: {
132: Xt *current_ip = (Xt *)PFA1(cfa);
133: cfa = *current_ip;
134: NEXT1_P1;
135: *--rp = (Cell)ip;
136: ip = current_ip+1;
137: }
138: NEXT1_P2;
139:
140: docon:
141: #ifdef DEBUG
142: printf("con: %x\n",*(Cell*)PFA1(cfa));
143: #endif
144: #ifdef USE_TOS
145: *sp-- = TOS;
146: TOS = *(Cell *)PFA1(cfa);
147: #else
148: *--sp = *(Cell *)PFA1(cfa);
149: #endif
150: NEXT;
151:
152: dovar:
153: #ifdef DEBUG
154: printf("var: %x\n",(Cell)PFA1(cfa));
155: #endif
156: #ifdef USE_TOS
157: *sp-- = TOS;
158: TOS = (Cell)PFA1(cfa);
159: #else
160: *--sp = (Cell)PFA1(cfa);
161: #endif
162: NEXT;
163:
164: /* !! user? */
165:
166: dodoes:
167: /* this assumes the following structure:
168: defining-word:
169:
170: ...
171: DOES>
172: (possible padding)
173: possibly handler: jmp dodoes
174: (possible branch delay slot(s))
175: Forth code after DOES>
176:
177: defined word:
178:
179: cfa: address of or jump to handler OR
180: address of or jump to dodoes, address of DOES-code
181: pfa:
182:
183: */
184: #ifdef DEBUG
185: printf("does: %x\n",(Cell)PFA(cfa));
186: #endif
187: *--rp = (Cell)ip;
188: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
189: #ifdef USE_TOS
190: *sp-- = TOS;
191: TOS = (Cell)PFA(cfa);
192: #else
193: *--sp = (Cell)PFA(cfa);
194: #endif
195: ip = DOES_CODE1(cfa);
196: NEXT;
197:
198: #include "primitives.i"
199: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>