Annotation of gforth/engine.c, revision 1.12
1.1 anton 1: /*
1.12 ! anton 2: $Id: engine.c,v 1.11 1994/07/13 19:21:02 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.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:
44: /* NEXT and NEXT1 are split into several parts to help scheduling */
45: #ifdef DIRECT_THREADED
1.4 pazsan 46: # define NEXT1_P1
47: # define NEXT1_P2 ({goto *cfa;})
48: # define DEF_CA
1.1 anton 49: #else
1.4 pazsan 50: # define NEXT1_P1 ({ca = *cfa;})
51: # define NEXT1_P2 ({goto *ca;})
52: # define DEF_CA Label ca;
1.1 anton 53: #endif
54: #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
55:
1.4 pazsan 56: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
57: #define NEXT ({DEF_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: int emitcounter;
74: #define NULLC '\0'
75:
1.3 pazsan 76: #define cstr(to,from,size)\
77: { memcpy(to,from,size);\
1.1 anton 78: to[size]=NULLC;}
79: #define NEWLINE '\n'
80:
81: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
1.6 pazsan 82:
1.11 pazsan 83: static Address up0=NULL;
84:
1.5 anton 85: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
1.1 anton 86: /* executes code at ip, if ip!=NULL
87: returns array of machine code labels (for use in a loader), if ip==NULL
88: */
89: {
90: Xt cfa;
1.11 pazsan 91: Address up=up0;
1.1 anton 92: static Label symbols[]= {
93: &&docol,
94: &&docon,
95: &&dovar,
1.4 pazsan 96: &&douser,
1.12 ! anton 97: &&dodefer,
1.1 anton 98: &&dodoes,
1.6 pazsan 99: &&dodoes, /* dummy for does handler address */
1.1 anton 100: #include "prim_labels.i"
101: };
102: IF_TOS(register Cell TOS;)
103: IF_FTOS(Float FTOS;)
104: #ifdef CPU_DEP
105: CPU_DEP;
106: #endif
107:
108: if (ip == NULL)
109: return symbols;
1.10 anton 110:
1.1 anton 111: IF_TOS(TOS = sp[0]);
112: IF_FTOS(FTOS = fp[0]);
113: prep_terminal();
114: NEXT;
115:
116: docol:
117: #ifdef DEBUG
1.6 pazsan 118: printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1 anton 119: #endif
120: #ifdef undefined
121: /* this is the simple version */
122: *--rp = (Cell)ip;
123: ip = (Xt *)PFA1(cfa);
124: NEXT;
125: #endif
126: /* this one is important, so we help the compiler optimizing
127: The following version may be better (for scheduling), but probably has
128: problems with code fields employing calls and delay slots
129: */
130: {
1.4 pazsan 131: DEF_CA
1.1 anton 132: Xt *current_ip = (Xt *)PFA1(cfa);
133: cfa = *current_ip;
134: NEXT1_P1;
135: *--rp = (Cell)ip;
136: ip = current_ip+1;
1.3 pazsan 137: NEXT1_P2;
1.1 anton 138: }
139:
140: docon:
141: #ifdef DEBUG
1.6 pazsan 142: printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
1.1 anton 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
1.6 pazsan 154: printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1 anton 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:
1.4 pazsan 166: douser:
167: #ifdef DEBUG
1.6 pazsan 168: printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.4 pazsan 169: #endif
170: #ifdef USE_TOS
171: *sp-- = TOS;
1.5 anton 172: TOS = (Cell)(up+*(Cell*)PFA1(cfa));
1.4 pazsan 173: #else
1.5 anton 174: *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
1.4 pazsan 175: #endif
176: NEXT;
177:
1.12 ! anton 178: dodefer:
! 179: #ifdef DEBUG
! 180: printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
! 181: #endif
! 182: cfa = *(Xt *)PFA1(cfa);
! 183: NEXT1;
! 184:
1.1 anton 185: dodoes:
186: /* this assumes the following structure:
187: defining-word:
188:
189: ...
190: DOES>
191: (possible padding)
192: possibly handler: jmp dodoes
193: (possible branch delay slot(s))
194: Forth code after DOES>
195:
196: defined word:
197:
198: cfa: address of or jump to handler OR
199: address of or jump to dodoes, address of DOES-code
200: pfa:
201:
202: */
203: #ifdef DEBUG
1.6 pazsan 204: printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
205: fflush(stdout);
1.1 anton 206: #endif
207: *--rp = (Cell)ip;
208: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
209: #ifdef USE_TOS
210: *sp-- = TOS;
211: TOS = (Cell)PFA(cfa);
212: #else
213: *--sp = (Cell)PFA(cfa);
214: #endif
215: ip = DOES_CODE1(cfa);
216: NEXT;
217:
218: #include "primitives.i"
219: }
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