version 1.5, 1994/05/07 14:55:47
|
version 1.10, 1994/07/08 15:00:35
|
Line 13
|
Line 13
|
#include <assert.h> |
#include <assert.h> |
#include <stdlib.h> |
#include <stdlib.h> |
#include <time.h> |
#include <time.h> |
|
#include <sys/time.h> |
#include "forth.h" |
#include "forth.h" |
#include "io.h" |
#include "io.h" |
|
|
extern unlink(char *); |
|
extern ftruncate(int, int); |
|
|
|
typedef union { |
typedef union { |
struct { |
struct { |
#ifdef BIG_ENDIAN |
#ifdef BIG_ENDIAN |
Line 72 typedef struct F83Name {
|
Line 70 typedef struct F83Name {
|
#define FTOS (fp[0]) |
#define FTOS (fp[0]) |
#endif |
#endif |
|
|
/* |
|
#define CA_DODOES (symbols[DODOES]) |
|
*/ |
|
|
|
int emitcounter; |
int emitcounter; |
#define NULLC '\0' |
#define NULLC '\0' |
|
|
Line 89 static char* fileattr[6]={"r","rb","r+",
|
Line 83 static char* fileattr[6]={"r","rb","r+",
|
Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp) |
Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp) |
/* executes code at ip, if ip!=NULL |
/* executes code at ip, if ip!=NULL |
returns array of machine code labels (for use in a loader), if ip==NULL |
returns array of machine code labels (for use in a loader), if ip==NULL |
This is very preliminary, as the bootstrap architecture is not yet decided |
|
*/ |
*/ |
{ |
{ |
Xt cfa; |
Xt cfa; |
Line 100 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 93 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
&&dovar, |
&&dovar, |
&&douser, |
&&douser, |
&&dodoes, |
&&dodoes, |
&&docol, /* dummy for does handler address */ |
&&dodoes, /* dummy for does handler address */ |
#include "prim_labels.i" |
#include "prim_labels.i" |
}; |
}; |
|
int throw_code; |
IF_TOS(register Cell TOS;) |
IF_TOS(register Cell TOS;) |
IF_FTOS(Float FTOS;) |
IF_FTOS(Float FTOS;) |
#ifdef CPU_DEP |
#ifdef CPU_DEP |
Line 112 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 106 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
if (ip == NULL) |
if (ip == NULL) |
return symbols; |
return symbols; |
|
|
|
if ((throw_code=setjmp(throw_jmp_buf))) { |
|
static Cell signal_data_stack[8]; |
|
|
|
/* AFAIK, it's not guarateed that the registers have the right value |
|
after a longjump, so we avoid using the current values. |
|
If it were guaranteed that the registers keep their values, we could |
|
call a signal handler in Forth instead of doing the throw from C */ |
|
sp = &signal_data_stack[7]; |
|
TOS = throw_code; |
|
ip = throw_ip; |
|
NEXT; |
|
} |
|
|
IF_TOS(TOS = sp[0]); |
IF_TOS(TOS = sp[0]); |
IF_FTOS(FTOS = fp[0]); |
IF_FTOS(FTOS = fp[0]); |
prep_terminal(); |
prep_terminal(); |
Line 119 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 126 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
|
|
docol: |
docol: |
#ifdef DEBUG |
#ifdef DEBUG |
printf("col: %x\n",(Cell)PFA1(cfa)); |
printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); |
#endif |
#endif |
#ifdef undefined |
#ifdef undefined |
/* this is the simple version */ |
/* this is the simple version */ |
Line 143 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 150 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
|
|
docon: |
docon: |
#ifdef DEBUG |
#ifdef DEBUG |
printf("con: %x\n",*(Cell*)PFA1(cfa)); |
printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa)); |
#endif |
#endif |
#ifdef USE_TOS |
#ifdef USE_TOS |
*sp-- = TOS; |
*sp-- = TOS; |
Line 155 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 162 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
|
|
dovar: |
dovar: |
#ifdef DEBUG |
#ifdef DEBUG |
printf("var: %x\n",(Cell)PFA1(cfa)); |
printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); |
#endif |
#endif |
#ifdef USE_TOS |
#ifdef USE_TOS |
*sp-- = TOS; |
*sp-- = TOS; |
Line 169 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 176 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
|
|
douser: |
douser: |
#ifdef DEBUG |
#ifdef DEBUG |
printf("user: %x\n",(Cell)PFA1(cfa)); |
printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); |
#endif |
#endif |
#ifdef USE_TOS |
#ifdef USE_TOS |
*sp-- = TOS; |
*sp-- = TOS; |
Line 198 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 205 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
|
|
*/ |
*/ |
#ifdef DEBUG |
#ifdef DEBUG |
printf("does: %x\n",(Cell)PFA(cfa)); fflush(stdout); |
printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa)); |
|
fflush(stdout); |
#endif |
#endif |
*--rp = (Cell)ip; |
*--rp = (Cell)ip; |
/* PFA1 might collide with DOES_CODE1 here, so we use PFA */ |
/* PFA1 might collide with DOES_CODE1 here, so we use PFA */ |