Annotation of gforth/engine.c, revision 1.3
1.1 anton 1: /*
2: $Id: engine.c,v 1.17 1993/11/09 15:08:25 anton 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>
1.2 pazsan 15: #include <time.h>
1.1 anton 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:
1.3 ! pazsan 56: #define NEXT1 ({Label ca; NEXT1_P1; NEXT1_P2;})
! 57: #define NEXT ({Label ca; NEXT_P1; NEXT1_P2;})
1.1 anton 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:
1.3 ! pazsan 78: #define cstr(to,from,size)\
! 79: { memcpy(to,from,size);\
1.1 anton 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
1.3 ! pazsan 101: /* Label ca; */
1.1 anton 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: {
1.3 ! pazsan 132: Label ca;
1.1 anton 133: Xt *current_ip = (Xt *)PFA1(cfa);
134: cfa = *current_ip;
135: NEXT1_P1;
136: *--rp = (Cell)ip;
137: ip = current_ip+1;
1.3 ! pazsan 138: NEXT1_P2;
1.1 anton 139: }
140:
141: docon:
142: #ifdef DEBUG
143: printf("con: %x\n",*(Cell*)PFA1(cfa));
144: #endif
145: #ifdef USE_TOS
146: *sp-- = TOS;
147: TOS = *(Cell *)PFA1(cfa);
148: #else
149: *--sp = *(Cell *)PFA1(cfa);
150: #endif
151: NEXT;
152:
153: dovar:
154: #ifdef DEBUG
155: printf("var: %x\n",(Cell)PFA1(cfa));
156: #endif
157: #ifdef USE_TOS
158: *sp-- = TOS;
159: TOS = (Cell)PFA1(cfa);
160: #else
161: *--sp = (Cell)PFA1(cfa);
162: #endif
163: NEXT;
164:
165: /* !! user? */
166:
167: dodoes:
168: /* this assumes the following structure:
169: defining-word:
170:
171: ...
172: DOES>
173: (possible padding)
174: possibly handler: jmp dodoes
175: (possible branch delay slot(s))
176: Forth code after DOES>
177:
178: defined word:
179:
180: cfa: address of or jump to handler OR
181: address of or jump to dodoes, address of DOES-code
182: pfa:
183:
184: */
185: #ifdef DEBUG
186: printf("does: %x\n",(Cell)PFA(cfa));
187: #endif
188: *--rp = (Cell)ip;
189: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
190: #ifdef USE_TOS
191: *sp-- = TOS;
192: TOS = (Cell)PFA(cfa);
193: #else
194: *--sp = (Cell)PFA(cfa);
195: #endif
196: ip = DOES_CODE1(cfa);
197: NEXT;
198:
199: #include "primitives.i"
200: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>