| #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" |
| |
|
| |
#ifndef unlink |
| extern unlink(char *); |
extern unlink(char *); |
| |
#endif |
| |
#ifndef ftruncate |
| extern ftruncate(int, int); |
extern ftruncate(int, int); |
| |
#endif |
| |
|
| typedef union { |
typedef union { |
| struct { |
struct { |
| #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' |
| |
|
| |
|
| static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"}; |
static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"}; |
| |
|
| |
#if ~defined(select) && defined(DOS) |
| |
/* select replacement for DOS computers for ms only */ |
| |
void select(int n, int a, int b, int c, struct timeval * timeout) |
| |
{ |
| |
struct timeval time1; |
| |
struct timeval time2; |
| |
struct timezone zone1; |
| |
|
| |
gettimeofday(&time1,&zone1); |
| |
time1.tv_sec += timeout->tv_sec; |
| |
time1.tv_usec += timeout->tv_usec; |
| |
while(time1.tv_usec >= 1000000) |
| |
{ |
| |
time1.tv_usec -= 1000000; |
| |
time1.tv_sec++; |
| |
} |
| |
do |
| |
{ |
| |
gettimeofday(&time2,&zone1); |
| |
} |
| |
while(time2.tv_usec < time1.tv_usec || time2.tv_sec < time1.tv_sec); |
| |
} |
| |
#endif |
| |
|
| 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; |
| &&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" |
| }; |
}; |
| IF_TOS(register Cell TOS;) |
IF_TOS(register Cell TOS;) |
| |
|
| 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 */ |
| |
|
| 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; |
| |
|
| 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; |
| |
|
| 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; |
| |
|
| */ |
*/ |
| #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 */ |