Powered by ViewCVS 1.0-dev
| 1 : | anton | 1.1 | /* |
| 2 : | anton | 1.5 | $Id: engine.c,v 1.4 1994/05/05 15:46:42 pazsan Exp $ |
| 3 : | anton | 1.1 | 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> | ||
| 15 : | pazsan | 1.2 | #include <time.h> |
| 16 : | anton | 1.1 | #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 : | pazsan | 1.4 | # define NEXT1_P1 |
| 49 : | # define NEXT1_P2 ({goto *cfa;}) | ||
| 50 : | # define DEF_CA | ||
| 51 : | anton | 1.1 | #else |
| 52 : | pazsan | 1.4 | # define NEXT1_P1 ({ca = *cfa;}) |
| 53 : | # define NEXT1_P2 ({goto *ca;}) | ||
| 54 : | # define DEF_CA Label ca; | ||
| 55 : | anton | 1.1 | #endif |
| 56 : | #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;}) | ||
| 57 : | |||
| 58 : | pazsan | 1.4 | #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;}) |
| 59 : | #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;}) | ||
| 60 : | anton | 1.1 | |
| 61 : | #ifdef USE_TOS | ||
| 62 : | #define IF_TOS(x) x | ||
| 63 : | #else | ||
| 64 : | #define IF_TOS(x) | ||
| 65 : | #define TOS (sp[0]) | ||
| 66 : | #endif | ||
| 67 : | |||
| 68 : | #ifdef USE_FTOS | ||
| 69 : | #define IF_FTOS(x) x | ||
| 70 : | #else | ||
| 71 : | #define IF_FTOS(x) | ||
| 72 : | #define FTOS (fp[0]) | ||
| 73 : | #endif | ||
| 74 : | |||
| 75 : | pazsan | 1.4 | /* |
| 76 : | #define CA_DODOES (symbols[DODOES]) | ||
| 77 : | */ | ||
| 78 : | anton | 1.1 | |
| 79 : | int emitcounter; | ||
| 80 : | #define NULLC '\0' | ||
| 81 : | |||
| 82 : | pazsan | 1.3 | #define cstr(to,from,size)\ |
| 83 : | { memcpy(to,from,size);\ | ||
| 84 : | anton | 1.1 | to[size]=NULLC;} |
| 85 : | #define NEWLINE '\n' | ||
| 86 : | |||
| 87 : | static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"}; | ||
| 88 : | |||
| 89 : | anton | 1.5 | Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp) |
| 90 : | anton | 1.1 | /* executes code at ip, if ip!=NULL |
| 91 : | returns array of machine code labels (for use in a loader), if ip==NULL | ||
| 92 : | This is very preliminary, as the bootstrap architecture is not yet decided | ||
| 93 : | */ | ||
| 94 : | { | ||
| 95 : | Xt cfa; | ||
| 96 : | pazsan | 1.4 | Address up=NULL; |
| 97 : | anton | 1.1 | static Label symbols[]= { |
| 98 : | &&docol, | ||
| 99 : | &&docon, | ||
| 100 : | &&dovar, | ||
| 101 : | pazsan | 1.4 | &&douser, |
| 102 : | anton | 1.1 | &&dodoes, |
| 103 : | pazsan | 1.4 | &&docol, /* dummy for does handler address */ |
| 104 : | anton | 1.1 | #include "prim_labels.i" |
| 105 : | }; | ||
| 106 : | IF_TOS(register Cell TOS;) | ||
| 107 : | IF_FTOS(Float FTOS;) | ||
| 108 : | #ifdef CPU_DEP | ||
| 109 : | CPU_DEP; | ||
| 110 : | #endif | ||
| 111 : | |||
| 112 : | if (ip == NULL) | ||
| 113 : | return symbols; | ||
| 114 : | |||
| 115 : | IF_TOS(TOS = sp[0]); | ||
| 116 : | IF_FTOS(FTOS = fp[0]); | ||
| 117 : | prep_terminal(); | ||
| 118 : | NEXT; | ||
| 119 : | |||
| 120 : | docol: | ||
| 121 : | #ifdef DEBUG | ||
| 122 : | printf("col: %x\n",(Cell)PFA1(cfa)); | ||
| 123 : | #endif | ||
| 124 : | #ifdef undefined | ||
| 125 : | /* this is the simple version */ | ||
| 126 : | *--rp = (Cell)ip; | ||
| 127 : | ip = (Xt *)PFA1(cfa); | ||
| 128 : | NEXT; | ||
| 129 : | #endif | ||
| 130 : | /* this one is important, so we help the compiler optimizing | ||
| 131 : | The following version may be better (for scheduling), but probably has | ||
| 132 : | problems with code fields employing calls and delay slots | ||
| 133 : | */ | ||
| 134 : | { | ||
| 135 : | pazsan | 1.4 | DEF_CA |
| 136 : | anton | 1.1 | Xt *current_ip = (Xt *)PFA1(cfa); |
| 137 : | cfa = *current_ip; | ||
| 138 : | NEXT1_P1; | ||
| 139 : | *--rp = (Cell)ip; | ||
| 140 : | ip = current_ip+1; | ||
| 141 : | pazsan | 1.3 | NEXT1_P2; |
| 142 : | anton | 1.1 | } |
| 143 : | |||
| 144 : | docon: | ||
| 145 : | #ifdef DEBUG | ||
| 146 : | printf("con: %x\n",*(Cell*)PFA1(cfa)); | ||
| 147 : | #endif | ||
| 148 : | #ifdef USE_TOS | ||
| 149 : | *sp-- = TOS; | ||
| 150 : | TOS = *(Cell *)PFA1(cfa); | ||
| 151 : | #else | ||
| 152 : | *--sp = *(Cell *)PFA1(cfa); | ||
| 153 : | #endif | ||
| 154 : | NEXT; | ||
| 155 : | |||
| 156 : | dovar: | ||
| 157 : | #ifdef DEBUG | ||
| 158 : | printf("var: %x\n",(Cell)PFA1(cfa)); | ||
| 159 : | #endif | ||
| 160 : | #ifdef USE_TOS | ||
| 161 : | *sp-- = TOS; | ||
| 162 : | TOS = (Cell)PFA1(cfa); | ||
| 163 : | #else | ||
| 164 : | *--sp = (Cell)PFA1(cfa); | ||
| 165 : | #endif | ||
| 166 : | NEXT; | ||
| 167 : | |||
| 168 : | /* !! user? */ | ||
| 169 : | |||
| 170 : | pazsan | 1.4 | douser: |
| 171 : | #ifdef DEBUG | ||
| 172 : | printf("user: %x\n",(Cell)PFA1(cfa)); | ||
| 173 : | #endif | ||
| 174 : | #ifdef USE_TOS | ||
| 175 : | *sp-- = TOS; | ||
| 176 : | anton | 1.5 | TOS = (Cell)(up+*(Cell*)PFA1(cfa)); |
| 177 : | pazsan | 1.4 | #else |
| 178 : | anton | 1.5 | *--sp = (Cell)(up+*(Cell*)PFA1(cfa)); |
| 179 : | pazsan | 1.4 | #endif |
| 180 : | NEXT; | ||
| 181 : | |||
| 182 : | anton | 1.1 | dodoes: |
| 183 : | /* this assumes the following structure: | ||
| 184 : | defining-word: | ||
| 185 : | |||
| 186 : | ... | ||
| 187 : | DOES> | ||
| 188 : | (possible padding) | ||
| 189 : | possibly handler: jmp dodoes | ||
| 190 : | (possible branch delay slot(s)) | ||
| 191 : | Forth code after DOES> | ||
| 192 : | |||
| 193 : | defined word: | ||
| 194 : | |||
| 195 : | cfa: address of or jump to handler OR | ||
| 196 : | address of or jump to dodoes, address of DOES-code | ||
| 197 : | pfa: | ||
| 198 : | |||
| 199 : | */ | ||
| 200 : | #ifdef DEBUG | ||
| 201 : | pazsan | 1.4 | printf("does: %x\n",(Cell)PFA(cfa)); fflush(stdout); |
| 202 : | anton | 1.1 | #endif |
| 203 : | *--rp = (Cell)ip; | ||
| 204 : | /* PFA1 might collide with DOES_CODE1 here, so we use PFA */ | ||
| 205 : | #ifdef USE_TOS | ||
| 206 : | *sp-- = TOS; | ||
| 207 : | TOS = (Cell)PFA(cfa); | ||
| 208 : | #else | ||
| 209 : | *--sp = (Cell)PFA(cfa); | ||
| 210 : | #endif | ||
| 211 : | ip = DOES_CODE1(cfa); | ||
| 212 : | NEXT; | ||
| 213 : | |||
| 214 : | #include "primitives.i" | ||
| 215 : | } |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |