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