Annotation of gforth/engine.c, revision 1.14
1.1 anton 1: /*
1.14 ! anton 2: $Id: engine.c,v 1.13 1994/08/31 19:42:44 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:
1.14 ! anton 44: /* NEXT and NEXT1 are split into several parts to help scheduling,
! 45: unless CISC_NEXT is defined */
! 46: #ifdef CISC_NEXT
! 47: #define NEXT1_P1
! 48: #define NEXT_P1
! 49: #define DEF_CA
1.1 anton 50: #ifdef DIRECT_THREADED
1.14 ! anton 51: #define NEXT1_P2 ({goto *cfa;})
1.1 anton 52: #else
1.14 ! anton 53: #define NEXT1_P2 ({goto **cfa;})
! 54: #endif /* DIRECT_THREADED */
! 55: #define NEXT_P2 ({cfa = *ip++; NEXT1_P2;})
! 56: #else /* CISC_NEXT */
! 57: #ifdef DIRECT_THREADED
! 58: #define NEXT1_P1
! 59: #define NEXT1_P2 ({goto *cfa;})
! 60: #define DEF_CA
! 61: #else /* DIRECT_THREADED */
! 62: #define NEXT1_P1 ({ca = *cfa;})
! 63: #define NEXT1_P2 ({goto *ca;})
! 64: #define DEF_CA Label ca;
! 65: #endif /* DIRECT_THREADED */
! 66: #define NEXT_P1 ({cfa=*ip++; NEXT1_P1;})
! 67: #define NEXT_P2 NEXT1_P2
! 68: #endif /* CISC_NEXT */
1.1 anton 69:
1.14 ! anton 70: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
! 71: #define NEXT ({DEF_CA NEXT_P1; NEXT_P2;})
1.1 anton 72:
73: #ifdef USE_TOS
74: #define IF_TOS(x) x
75: #else
76: #define IF_TOS(x)
77: #define TOS (sp[0])
78: #endif
79:
80: #ifdef USE_FTOS
81: #define IF_FTOS(x) x
82: #else
83: #define IF_FTOS(x)
84: #define FTOS (fp[0])
85: #endif
86:
87: int emitcounter;
88: #define NULLC '\0'
89:
1.14 ! anton 90: char *cstr(Char *from, UCell size, int clear)
! 91: /* if clear is true, scratch can be reused, otherwise we want more of
! 92: the same */
! 93: {
! 94: static char *scratch=NULL;
! 95: static unsigned scratchsize=0;
! 96: static char *nextscratch;
! 97: char *oldnextscratch;
! 98:
! 99: if (clear)
! 100: nextscratch=scratch;
! 101: if (scratch==NULL) {
! 102: scratch=malloc(size+1);
! 103: nextscratch=scratch;
! 104: scratchsize=size;
! 105: }
! 106: else if (nextscratch+size>scratch+scratchsize) {
! 107: char *oldscratch=scratch;
! 108: scratch = realloc(scratch, (nextscratch-scratch)+size+1);
! 109: nextscratch=scratch+(nextscratch-oldscratch);
! 110: scratchsize=size;
! 111: }
! 112: memcpy(nextscratch,from,size);
! 113: nextscratch[size]='\0';
! 114: oldnextscratch = nextscratch;
! 115: nextscratch += size+1;
! 116: return oldnextscratch;
! 117: }
1.13 pazsan 118:
1.1 anton 119: #define NEWLINE '\n'
120:
1.13 pazsan 121:
1.1 anton 122: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
1.6 pazsan 123:
1.11 pazsan 124: static Address up0=NULL;
125:
1.13 pazsan 126: #if defined(i386) && defined(FORCE_REG)
127: # define REG(reg) __asm__(reg)
128:
129: Label *engine(Xt *ip0, Cell *sp0, Cell *rp, Float *fp, Address lp)
130: {
131: register Xt *ip REG("%esi")=ip0;
132: register Cell *sp REG("%edi")=sp0;
133:
134: #else
135: # define REG(reg)
136:
1.5 anton 137: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
1.13 pazsan 138: {
139: #endif
1.1 anton 140: /* executes code at ip, if ip!=NULL
141: returns array of machine code labels (for use in a loader), if ip==NULL
142: */
1.13 pazsan 143: register Xt cfa
144: #ifdef i386
145: # ifdef USE_TOS
146: REG("%ecx")
147: # else
148: REG("%edx")
149: # endif
150: #endif
151: ;
1.11 pazsan 152: Address up=up0;
1.1 anton 153: static Label symbols[]= {
154: &&docol,
155: &&docon,
156: &&dovar,
1.4 pazsan 157: &&douser,
1.12 anton 158: &&dodefer,
1.1 anton 159: &&dodoes,
1.6 pazsan 160: &&dodoes, /* dummy for does handler address */
1.1 anton 161: #include "prim_labels.i"
162: };
163: IF_TOS(register Cell TOS;)
164: IF_FTOS(Float FTOS;)
165: #ifdef CPU_DEP
166: CPU_DEP;
167: #endif
168:
169: if (ip == NULL)
170: return symbols;
1.10 anton 171:
1.1 anton 172: IF_TOS(TOS = sp[0]);
173: IF_FTOS(FTOS = fp[0]);
174: prep_terminal();
175: NEXT;
176:
177: docol:
178: #ifdef DEBUG
1.6 pazsan 179: printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1 anton 180: #endif
1.13 pazsan 181: #ifdef i386
1.1 anton 182: /* this is the simple version */
183: *--rp = (Cell)ip;
184: ip = (Xt *)PFA1(cfa);
185: NEXT;
186: #endif
187: /* this one is important, so we help the compiler optimizing
188: The following version may be better (for scheduling), but probably has
189: problems with code fields employing calls and delay slots
190: */
191: {
1.4 pazsan 192: DEF_CA
1.1 anton 193: Xt *current_ip = (Xt *)PFA1(cfa);
194: cfa = *current_ip;
195: NEXT1_P1;
196: *--rp = (Cell)ip;
197: ip = current_ip+1;
1.3 pazsan 198: NEXT1_P2;
1.1 anton 199: }
200:
201: docon:
202: #ifdef DEBUG
1.6 pazsan 203: printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
1.1 anton 204: #endif
205: #ifdef USE_TOS
206: *sp-- = TOS;
207: TOS = *(Cell *)PFA1(cfa);
208: #else
209: *--sp = *(Cell *)PFA1(cfa);
210: #endif
211: NEXT;
212:
213: dovar:
214: #ifdef DEBUG
1.6 pazsan 215: printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1 anton 216: #endif
217: #ifdef USE_TOS
218: *sp-- = TOS;
219: TOS = (Cell)PFA1(cfa);
220: #else
221: *--sp = (Cell)PFA1(cfa);
222: #endif
223: NEXT;
224:
225: /* !! user? */
226:
1.4 pazsan 227: douser:
228: #ifdef DEBUG
1.6 pazsan 229: printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.4 pazsan 230: #endif
231: #ifdef USE_TOS
232: *sp-- = TOS;
1.5 anton 233: TOS = (Cell)(up+*(Cell*)PFA1(cfa));
1.4 pazsan 234: #else
1.5 anton 235: *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
1.4 pazsan 236: #endif
237: NEXT;
238:
1.12 anton 239: dodefer:
240: #ifdef DEBUG
241: printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
242: #endif
243: cfa = *(Xt *)PFA1(cfa);
244: NEXT1;
245:
1.1 anton 246: dodoes:
247: /* this assumes the following structure:
248: defining-word:
249:
250: ...
251: DOES>
252: (possible padding)
253: possibly handler: jmp dodoes
254: (possible branch delay slot(s))
255: Forth code after DOES>
256:
257: defined word:
258:
259: cfa: address of or jump to handler OR
260: address of or jump to dodoes, address of DOES-code
261: pfa:
262:
263: */
264: #ifdef DEBUG
1.6 pazsan 265: printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
266: fflush(stdout);
1.1 anton 267: #endif
268: *--rp = (Cell)ip;
269: /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
1.13 pazsan 270: ip = DOES_CODE1(cfa);
1.1 anton 271: #ifdef USE_TOS
272: *sp-- = TOS;
273: TOS = (Cell)PFA(cfa);
274: #else
275: *--sp = (Cell)PFA(cfa);
276: #endif
277: NEXT;
278:
279: #include "primitives.i"
280: }
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