version 1.35, 1996/02/09 17:34:08
|
version 1.41, 1997/03/04 17:49:48
|
Line 45
|
Line 45
|
|
|
#define IOR(flag) ((flag)? -512-errno : 0) |
#define IOR(flag) ((flag)? -512-errno : 0) |
|
|
typedef union { |
|
struct { |
|
#ifdef WORDS_BIGENDIAN |
|
Cell high; |
|
UCell low; |
|
#else |
|
UCell low; |
|
Cell high; |
|
#endif; |
|
} cells; |
|
DCell dcell; |
|
} Double_Store; |
|
|
|
typedef struct F83Name { |
typedef struct F83Name { |
struct F83Name *next; /* the link field for old hands */ |
struct F83Name *next; /* the link field for old hands */ |
char countetc; |
char countetc; |
Line 69 typedef struct F83Name {
|
Line 56 typedef struct F83Name {
|
#define F83NAME_SMUDGE(np) (((np)->countetc & 0x40) != 0) |
#define F83NAME_SMUDGE(np) (((np)->countetc & 0x40) != 0) |
#define F83NAME_IMMEDIATE(np) (((np)->countetc & 0x20) != 0) |
#define F83NAME_IMMEDIATE(np) (((np)->countetc & 0x20) != 0) |
|
|
#ifdef USE_TOS |
|
#define IF_TOS(x) x |
|
#else |
|
#define IF_TOS(x) |
|
#define TOS (sp[0]) |
|
#endif |
|
|
|
#ifdef USE_FTOS |
|
#define IF_FTOS(x) x |
|
#else |
|
#define IF_FTOS(x) |
|
#define FTOS (fp[0]) |
|
#endif |
|
|
|
Cell *SP; |
Cell *SP; |
Float *FP; |
Float *FP; |
|
Address UP=NULL; |
|
|
#if 0 |
#if 0 |
/* not used currently */ |
/* not used currently */ |
int emitcounter; |
int emitcounter; |
Line 134 char *tilde_cstr(Char *from, UCell size,
|
Line 109 char *tilde_cstr(Char *from, UCell size,
|
return cstr(from, size, clear); |
return cstr(from, size, clear); |
if (size<2 || from[1]=='/') { |
if (size<2 || from[1]=='/') { |
s1 = (char *)getenv ("HOME"); |
s1 = (char *)getenv ("HOME"); |
|
if(s1 == NULL) |
|
s1 = ""; |
s2 = from+1; |
s2 = from+1; |
s2_len = size-1; |
s2_len = size-1; |
} else { |
} else { |
int i; |
UCell i; |
for (i=1; i<size && from[i]!='/'; i++) |
for (i=1; i<size && from[i]!='/'; i++) |
; |
; |
{ |
{ |
Line 172 char *tilde_cstr(Char *from, UCell size,
|
Line 149 char *tilde_cstr(Char *from, UCell size,
|
|
|
static char* fileattr[6]={"r","rb","r+","r+b","w","wb"}; |
static char* fileattr[6]={"r","rb","r+","r+b","w","wb"}; |
|
|
static Address up0=NULL; |
#ifndef O_BINARY |
|
#define O_BINARY 0 |
|
#endif |
|
#ifndef O_TEXT |
|
#define O_TEXT 0 |
|
#endif |
|
|
|
static int ufileattr[6]= { |
|
O_RDONLY|O_TEXT, O_RDONLY|O_BINARY, |
|
O_RDWR |O_TEXT, O_RDWR |O_BINARY, |
|
O_WRONLY|O_TEXT, O_WRONLY|O_BINARY }; |
|
|
/* if machine.h has not defined explicit registers, define them as implicit */ |
/* if machine.h has not defined explicit registers, define them as implicit */ |
#ifndef IPREG |
#ifndef IPREG |
Line 203 static Address up0=NULL;
|
Line 190 static Address up0=NULL;
|
#define FTOSREG |
#define FTOSREG |
#endif |
#endif |
|
|
|
#ifndef CPU_DEP1 |
|
# define CPU_DEP1 0 |
|
#endif |
|
|
/* declare and compute cfa for certain threading variants */ |
/* declare and compute cfa for certain threading variants */ |
/* warning: this is nonsyntactical; it will not work in place of a statement */ |
/* warning: this is nonsyntactical; it will not work in place of a statement */ |
#ifdef CFA_NEXT |
#ifdef CFA_NEXT |
Line 224 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
Line 215 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
#ifdef CFA_NEXT |
#ifdef CFA_NEXT |
register Xt cfa CFAREG; |
register Xt cfa CFAREG; |
#endif |
#endif |
register Address up UPREG = up0; |
register Address up UPREG = UP; |
IF_TOS(register Cell TOS TOSREG;) |
IF_TOS(register Cell TOS TOSREG;) |
IF_FTOS(register Float FTOS FTOSREG;) |
IF_FTOS(register Float FTOS FTOSREG;) |
|
#if defined(DOUBLY_INDIRECT) |
|
static Label *symbols; |
|
static void *routines[]= { |
|
#else /* !defined(DOUBLY_INDIRECT) */ |
static Label symbols[]= { |
static Label symbols[]= { |
|
#endif /* !defined(DOUBLY_INDIRECT) */ |
&&docol, |
&&docol, |
&&docon, |
&&docon, |
&&dovar, |
&&dovar, |
Line 237 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
Line 233 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
&&dodoes, |
&&dodoes, |
/* the following entry is normally unused; |
/* the following entry is normally unused; |
it's there because its index indicates a does-handler */ |
it's there because its index indicates a does-handler */ |
#ifdef CPU_DEP1 |
|
CPU_DEP1, |
CPU_DEP1, |
#else |
|
(Label)0, |
|
#endif |
|
#include "prim_labels.i" |
#include "prim_labels.i" |
|
0 |
}; |
}; |
#ifdef CPU_DEP2 |
#ifdef CPU_DEP2 |
CPU_DEP2 |
CPU_DEP2 |
Line 254 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
Line 247 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
(unsigned)fp,(unsigned)lp,(unsigned)up); |
(unsigned)fp,(unsigned)lp,(unsigned)up); |
#endif |
#endif |
|
|
if (ip == NULL) |
if (ip == NULL) { |
return symbols; |
#if defined(DOUBLY_INDIRECT) |
|
#define MAX_SYMBOLS 1000 |
|
int i; |
|
Cell code_offset = offset_image? 11*sizeof(Cell) : 0; |
|
|
|
symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+code_offset)+code_offset); |
|
for (i=0; i<DOESJUMP+1; i++) |
|
symbols[i] = (Label)routines[i]; |
|
for (; routines[i]!=0; i++) { |
|
if (i>=MAX_SYMBOLS) { |
|
fprintf(stderr,"gforth-ditc: more than %d primitives\n",MAX_SYMBOLS); |
|
exit(1); |
|
} |
|
symbols[i] = &routines[i]; |
|
} |
|
#endif /* defined(DOUBLY_INDIRECT) */ |
|
return symbols; |
|
} |
|
|
IF_TOS(TOS = sp[0]); |
IF_TOS(TOS = sp[0]); |
IF_FTOS(FTOS = fp[0]); |
IF_FTOS(FTOS = fp[0]); |