version 1.2, 1994/04/20 17:12:00
|
version 1.12, 1994/08/25 15:25:21
|
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 45 typedef struct F83Name {
|
Line 43 typedef struct F83Name {
|
|
|
/* NEXT and NEXT1 are split into several parts to help scheduling */ |
/* NEXT and NEXT1 are split into several parts to help scheduling */ |
#ifdef DIRECT_THREADED |
#ifdef DIRECT_THREADED |
#define NEXT1_P1 |
# define NEXT1_P1 |
#define NEXT1_P2 ({goto *cfa;}) |
# define NEXT1_P2 ({goto *cfa;}) |
#else |
# define DEF_CA |
#define NEXT1_P1 ({ca = *cfa;}) |
#else |
#define NEXT1_P2 ({goto *ca;}) |
# define NEXT1_P1 ({ca = *cfa;}) |
|
# define NEXT1_P2 ({goto *ca;}) |
|
# define DEF_CA Label ca; |
#endif |
#endif |
#define NEXT_P1 ({cfa = *ip++; NEXT1_P1;}) |
#define NEXT_P1 ({cfa = *ip++; NEXT1_P1;}) |
|
|
#define NEXT1 ({NEXT1_P1; NEXT1_P2;}) |
#define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;}) |
#define NEXT ({NEXT_P1; NEXT1_P2;}) |
#define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;}) |
|
|
#ifdef USE_TOS |
#ifdef USE_TOS |
#define IF_TOS(x) x |
#define IF_TOS(x) x |
Line 70 typedef struct F83Name {
|
Line 70 typedef struct F83Name {
|
#define FTOS (fp[0]) |
#define FTOS (fp[0]) |
#endif |
#endif |
|
|
#define DODOES (symbols[3]) |
|
|
|
int emitcounter; |
int emitcounter; |
#define NULLC '\0' |
#define NULLC '\0' |
|
|
#define cstr(to, from, size)\ |
#define cstr(to,from,size)\ |
{ memcpy(to, from, size);\ |
{ memcpy(to,from,size);\ |
to[size]=NULLC;} |
to[size]=NULLC;} |
#define NEWLINE '\n' |
#define NEWLINE '\n' |
|
|
static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"}; |
static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"}; |
|
|
Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp) |
static Address up0=NULL; |
|
|
|
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; |
Address lp=NULL; |
Address up=up0; |
static Label symbols[]= { |
static Label symbols[]= { |
&&docol, |
&&docol, |
&&docon, |
&&docon, |
&&dovar, |
&&dovar, |
|
&&douser, |
|
&&dodefer, |
&&dodoes, |
&&dodoes, |
|
&&dodoes, /* dummy for does handler address */ |
#include "prim_labels.i" |
#include "prim_labels.i" |
}; |
}; |
#ifndef DIRECT_THREADED |
|
Label ca; |
|
#endif |
|
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 108 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 107 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
|
|
if (ip == NULL) |
if (ip == NULL) |
return symbols; |
return symbols; |
|
|
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 116 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 115 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 129 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 128 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
problems with code fields employing calls and delay slots |
problems with code fields employing calls and delay slots |
*/ |
*/ |
{ |
{ |
|
DEF_CA |
Xt *current_ip = (Xt *)PFA1(cfa); |
Xt *current_ip = (Xt *)PFA1(cfa); |
cfa = *current_ip; |
cfa = *current_ip; |
NEXT1_P1; |
NEXT1_P1; |
*--rp = (Cell)ip; |
*--rp = (Cell)ip; |
ip = current_ip+1; |
ip = current_ip+1; |
|
NEXT1_P2; |
} |
} |
NEXT1_P2; |
|
|
|
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 151 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 151 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 163 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 163 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
|
|
/* !! user? */ |
/* !! user? */ |
|
|
|
douser: |
|
#ifdef DEBUG |
|
printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); |
|
#endif |
|
#ifdef USE_TOS |
|
*sp-- = TOS; |
|
TOS = (Cell)(up+*(Cell*)PFA1(cfa)); |
|
#else |
|
*--sp = (Cell)(up+*(Cell*)PFA1(cfa)); |
|
#endif |
|
NEXT; |
|
|
|
dodefer: |
|
#ifdef DEBUG |
|
printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); |
|
#endif |
|
cfa = *(Xt *)PFA1(cfa); |
|
NEXT1; |
|
|
dodoes: |
dodoes: |
/* this assumes the following structure: |
/* this assumes the following structure: |
defining-word: |
defining-word: |
Line 182 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
Line 201 Label *engine(Xt *ip, Cell *sp, Cell *rp
|
|
|
*/ |
*/ |
#ifdef DEBUG |
#ifdef DEBUG |
printf("does: %x\n",(Cell)PFA(cfa)); |
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 */ |