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