version 1.27, 1996/12/28 17:19:24
|
version 1.28, 1997/03/04 17:49:48
|
Line 20
|
Line 20
|
*/ |
*/ |
|
|
#include "config.h" |
#include "config.h" |
|
|
|
#if defined(DOUBLY_INDIRECT) |
|
# undef DIRECT_THREADED |
|
# define INDIRECT_THREADED |
|
#endif |
|
|
#include <limits.h> |
#include <limits.h> |
|
|
#if defined(NeXT) |
#if defined(NeXT) |
# include <libc.h> |
# include <libc.h> |
#endif /* NeXT */ |
#endif /* NeXT */ |
|
|
|
#if defined(DOUBLY_INDIRECT) |
|
typedef void **Label; |
|
#else /* !defined(DOUBLY_INDIRECT) */ |
typedef void *Label; |
typedef void *Label; |
|
#endif /* !defined(DOUBLY_INDIRECT) */ |
|
|
/* symbol indexed constants */ |
/* symbol indexed constants */ |
|
|
Line 38 typedef void *Label;
|
Line 49 typedef void *Label;
|
#define DODOES 6 |
#define DODOES 6 |
#define DOESJUMP 7 |
#define DOESJUMP 7 |
|
|
|
/* the size of the DOESJUMP, which resides between DOES> and the does-code */ |
|
#define DOES_HANDLER_SIZE (2*sizeof(Cell)) |
|
|
#include "machine.h" |
#include "machine.h" |
|
|
/* Forth data types */ |
/* Forth data types */ |
Line 124 typedef Label Xt;
|
Line 138 typedef Label Xt;
|
typedef Label *Xt; |
typedef Label *Xt; |
#endif |
#endif |
|
|
#ifndef DIRECT_THREADED |
|
/* i.e. indirect threaded */ |
#if !defined(DIRECT_THREADED) |
|
/* i.e. indirect threaded our doubly indirect threaded */ |
/* the direct threaded version is machine dependent and resides in machine.h */ |
/* the direct threaded version is machine dependent and resides in machine.h */ |
|
|
/* PFA gives the parameter field address corresponding to a cfa */ |
/* PFA gives the parameter field address corresponding to a cfa */ |
Line 133 typedef Label *Xt;
|
Line 148 typedef Label *Xt;
|
/* PFA1 is a special version for use just after a NEXT1 */ |
/* PFA1 is a special version for use just after a NEXT1 */ |
#define PFA1(cfa) PFA(cfa) |
#define PFA1(cfa) PFA(cfa) |
/* CODE_ADDRESS is the address of the code jumped to through the code field */ |
/* CODE_ADDRESS is the address of the code jumped to through the code field */ |
#define CODE_ADDRESS(cfa) (*(Label *)(cfa)) |
#define CODE_ADDRESS(cfa) (*(Xt)(cfa)) |
|
|
/* DOES_CODE is the Forth code does jumps to */ |
/* DOES_CODE is the Forth code does jumps to */ |
|
#if !defined(DOUBLY_INDIRECT) |
|
# define DOES_CA (symbols[DODOES]) |
|
#else /* defined(DOUBLY_INDIRECT) */ |
|
# define DOES_CA ((Label)&symbols[DODOES]) |
|
#endif /* defined(DOUBLY_INDIRECT) */ |
|
|
|
|
|
|
#define DOES_CODE(cfa) ({Xt _cfa=(Xt)(cfa); \ |
#define DOES_CODE(cfa) ({Xt _cfa=(Xt)(cfa); \ |
_cfa[0] == symbols[DODOES] ? _cfa[1] : NULL;}) |
(Xt *)(_cfa[0]==DOES_CA ? _cfa[1] : NULL);}) |
#define DOES_CODE1(cfa) (cfa[1]) |
#define DOES_CODE1(cfa) ((Xt *)(cfa[1])) |
/* MAKE_CF creates an appropriate code field at the cfa; |
/* MAKE_CF creates an appropriate code field at the cfa; |
ca is the code address */ |
ca is the code address */ |
#define MAKE_CF(cfa,ca) ((*(Label *)(cfa)) = ((Label)ca)) |
#define MAKE_CF(cfa,ca) ((*(Label *)(cfa)) = ((Label)ca)) |
/* make a code field for a defining-word-defined word */ |
/* make a code field for a defining-word-defined word */ |
#define MAKE_DOES_CF(cfa,does_code) ({MAKE_CF(cfa,symbols[DODOES]); \ |
#define MAKE_DOES_CF(cfa,does_code) ({MAKE_CF(cfa,DOES_CA); \ |
((Cell *)cfa)[1] = (Cell)does_code;}) |
((Cell *)cfa)[1] = (Cell)(does_code);}) |
/* the does handler resides between DOES> and the following Forth code */ |
/* the does handler resides between DOES> and the following Forth code */ |
#define DOES_HANDLER_SIZE (2*sizeof(Cell)) |
/* not needed in indirect threaded code */ |
#define MAKE_DOES_HANDLER(addr) 0 /* do nothing */ |
#if defined(DOUBLY_INDIRECT) |
|
#define MAKE_DOES_HANDLER(addr) MAKE_CF(addr, ((Label)&symbols[DOESJUMP])) |
|
#else /* !defined(DOUBLY_INDIRECT) */ |
|
#define MAKE_DOES_HANDLER(addr) 0 |
|
#endif /* !defined(DOUBLY_INDIRECT) */ |
#endif /* !defined(DIRECT_THREADED) */ |
#endif /* !defined(DIRECT_THREADED) */ |
|
|
#ifdef DEBUG |
#ifdef DEBUG |
Line 164 typedef Label *Xt;
|
Line 192 typedef Label *Xt;
|
# define FLUSH_ICACHE(addr,size) |
# define FLUSH_ICACHE(addr,size) |
#endif |
#endif |
|
|
#ifdef DIRECT_THREADED |
#if defined(DIRECT_THREADED) |
#define CACHE_FLUSH(addr,size) FLUSH_ICACHE(addr,size) |
#define CACHE_FLUSH(addr,size) FLUSH_ICACHE(addr,size) |
#else |
#else |
#define CACHE_FLUSH(addr,size) |
#define CACHE_FLUSH(addr,size) |
Line 185 typedef Label *Xt;
|
Line 213 typedef Label *Xt;
|
#endif |
#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); |
|
Address my_alloc(Cell size); |
|
|
/* dblsub routines */ |
/* dblsub routines */ |
DCell dnegate(DCell d1); |
DCell dnegate(DCell d1); |
Line 196 DCell fmdiv (DCell num, Cell denom);
|
Line 225 DCell fmdiv (DCell num, Cell denom);
|
|
|
int memcasecmp(const char *s1, const char *s2, long n); |
int memcasecmp(const char *s1, const char *s2, long n); |
|
|
|
extern int offset_image; |