version 1.97, 2008/05/04 17:52:27
|
version 1.133, 2012/12/31 15:25:19
|
Line 1
|
Line 1
|
/* common header file |
/* common header file |
|
|
Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007 Free Software Foundation, Inc. |
Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012 Free Software Foundation, Inc. |
|
|
This file is part of Gforth. |
This file is part of Gforth. |
|
|
Line 24
|
Line 24
|
#include <sys/time.h> |
#include <sys/time.h> |
#include <unistd.h> |
#include <unistd.h> |
#ifndef STANDALONE |
#ifndef STANDALONE |
|
#if defined(HAVE_LIBLTDL) |
#include <ltdl.h> |
#include <ltdl.h> |
#endif |
#endif |
|
#endif |
|
|
#if !defined(FORCE_LL) && !defined(BUGGY_LONG_LONG) |
#if !defined(FORCE_LL) && !defined(BUGGY_LONG_LONG) |
#define BUGGY_LONG_LONG |
#define BUGGY_LONG_LONG |
Line 98
|
Line 100
|
#define DOFIELD 5 |
#define DOFIELD 5 |
#define DOVAL 6 |
#define DOVAL 6 |
#define DODOES 7 |
#define DODOES 7 |
#define DOESJUMP 8 |
#define DOABICODE 8 |
|
#define DOSEMIABICODE 9 |
/* the size of the DOESJUMP, which resides between DOES> and the does-code */ |
#define DOER_MAX 9 |
#define DOES_HANDLER_SIZE (2*sizeof(Cell)) |
|
|
|
#include "machine.h" |
#include "machine.h" |
|
|
Line 109
|
Line 110
|
|
|
typedef WYDE_TYPE Wyde; |
typedef WYDE_TYPE Wyde; |
typedef TETRABYTE_TYPE Tetrabyte; |
typedef TETRABYTE_TYPE Tetrabyte; |
|
typedef OCTABYTE_TYPE Octabyte; |
typedef unsigned WYDE_TYPE UWyde; |
typedef unsigned WYDE_TYPE UWyde; |
typedef unsigned TETRABYTE_TYPE UTetrabyte; |
typedef unsigned TETRABYTE_TYPE UTetrabyte; |
|
typedef unsigned OCTABYTE_TYPE UOctabyte; |
|
|
/* Forth data types */ |
/* Forth data types */ |
/* Cell and UCell must be the same size as a pointer */ |
/* Cell and UCell must be the same size as a pointer */ |
Line 168 typedef struct {
|
Line 171 typedef struct {
|
#define D2UD(d) ({DCell _d1=(d); (UDCell){_d1.hi,_d1.lo};}) |
#define D2UD(d) ({DCell _d1=(d); (UDCell){_d1.hi,_d1.lo};}) |
|
|
/* shifts by less than CELL_BITS */ |
/* shifts by less than CELL_BITS */ |
#define DLSHIFT(d,u) ({DCell _d=(d); UCell _u=(u); \ |
#define DLSHIFT(d,u) ({DCell _d=(d); UCell _u=(u); \ |
(DCell){(_d.hi<<_u)|(_d.lo>>(CELL_BITS-_u)),_d.lo<<_u};}) |
((_u==0) ? \ |
|
_d : \ |
|
(DCell){(_d.hi<<_u)|(_d.lo>>(CELL_BITS-_u)), \ |
|
_d.lo<<_u});}) |
|
|
#define UDLSHIFT(ud,u) D2UD(DLSHIFT(UD2D(ud),u)) |
#define UDLSHIFT(ud,u) D2UD(DLSHIFT(UD2D(ud),u)) |
|
|
#if SMALL_OFF_T |
#if SMALL_OFF_T |
Line 262 typedef Label *Xt;
|
Line 269 typedef Label *Xt;
|
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,DOES_CA); \ |
|
((Cell *)cfa)[1] = (Cell)(does_code);}) |
|
|
|
#define CF(const) (-const-2) |
#define CF(const) (-const-2) |
|
|
Line 277 typedef Label *Xt;
|
Line 282 typedef Label *Xt;
|
#define NO_DYNAMIC_DEFAULT 1 |
#define NO_DYNAMIC_DEFAULT 1 |
#endif |
#endif |
|
|
|
#ifndef CHECK_PRIM |
|
#define CHECK_PRIM(start,len) 0 |
|
#endif |
|
|
#if defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING) |
#if defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING) |
#define STACK_CACHE_DEFAULT 0 |
#define STACK_CACHE_DEFAULT 0 |
#else |
#else |
Line 294 typedef Label *Xt;
|
Line 303 typedef Label *Xt;
|
#define rpTOS (rp[0]) |
#define rpTOS (rp[0]) |
|
|
typedef struct { |
typedef struct { |
|
Cell next_task; |
|
Cell prev_task; |
|
Cell save_task; |
|
Cell* sp0; |
|
Cell* rp0; |
|
Float* fp0; |
|
Address lp0; |
|
Xt *throw_entry; |
|
} user_area; |
|
|
|
typedef struct { |
Address base; /* base address of image (0 if relocatable) */ |
Address base; /* base address of image (0 if relocatable) */ |
UCell checksum; /* checksum of ca's to protect against some |
UCell checksum; /* checksum of ca's to protect against some |
incompatible binary/executable combinations |
incompatible binary/executable combinations |
Line 306 typedef struct {
|
Line 326 typedef struct {
|
UCell locals_stack_size; |
UCell locals_stack_size; |
Xt *boot_entry; /* initial ip for booting (in BOOT) */ |
Xt *boot_entry; /* initial ip for booting (in BOOT) */ |
Xt *throw_entry; /* ip after signal (in THROW) */ |
Xt *throw_entry; /* ip after signal (in THROW) */ |
Cell unused1; /* possibly tib stack size */ |
Xt *quit_entry; |
|
Xt *execute_entry; |
|
Xt *find_entry; |
Label *xt_base; /* base of DOUBLE_INDIRECT xts[], for comp-i.fs */ |
Label *xt_base; /* base of DOUBLE_INDIRECT xts[], for comp-i.fs */ |
Address data_stack_base; /* this and the following fields are initialized by the loader */ |
|
Address fp_stack_base; |
|
Address return_stack_base; |
|
Address locals_stack_base; |
|
} ImageHeader; |
} ImageHeader; |
/* the image-header is created in main.fs */ |
/* the image-header is created in main.fs */ |
|
|
Line 330 struct Longname {
|
Line 348 struct Longname {
|
char name[0]; |
char name[0]; |
}; |
}; |
|
|
#define LONGNAME_COUNT(np) ((np)->countetc & (((~((UCell)0))<<3)>>3)) |
#define LONGNAME_COUNT(np) ((np)->countetc & (((~((UCell)0))<<4)>>4)) |
|
|
struct Cellpair { |
struct Cellpair { |
Cell n1; |
Cell n1; |
Line 354 typedef struct saved_regs {
|
Line 372 typedef struct saved_regs {
|
Xt *sr_saved_ip; |
Xt *sr_saved_ip; |
Cell *sr_rp; |
Cell *sr_rp; |
} saved_regs; |
} saved_regs; |
extern saved_regs saved_regs_v, *saved_regs_p; |
extern saved_regs saved_regs_v; |
|
extern PER_THREAD saved_regs *saved_regs_p; |
#define saved_ip (saved_regs_p->sr_saved_ip) |
#define saved_ip (saved_regs_p->sr_saved_ip) |
#define rp (saved_regs_p->sr_rp) |
#define rp (saved_regs_p->sr_rp) |
/* for use in gforth_engine header */ |
/* for use in gforth_engine header */ |
Line 362 extern saved_regs saved_regs_v, *saved_r
|
Line 381 extern saved_regs saved_regs_v, *saved_r
|
#define sr_proto , struct saved_regs *saved_regs_p0 |
#define sr_proto , struct saved_regs *saved_regs_p0 |
#define sr_call , saved_regs_p |
#define sr_call , saved_regs_p |
#else /* !defined(GLOBALS_NONRELOC) */ |
#else /* !defined(GLOBALS_NONRELOC) */ |
extern Xt *saved_ip; |
extern PER_THREAD Xt *saved_ip; |
extern Cell *rp; |
extern PER_THREAD Cell *rp; |
#define sr_proto |
#define sr_proto |
#define sr_call |
#define sr_call |
#endif /* !defined(GLOBALS_NONRELOC) */ |
#endif /* !defined(GLOBALS_NONRELOC) */ |
Line 372 extern Cell *rp;
|
Line 391 extern Cell *rp;
|
#define sr_call |
#define sr_call |
#endif /* !defined(GFORTH_DEBUGGING) */ |
#endif /* !defined(GFORTH_DEBUGGING) */ |
|
|
Label *gforth_engine(Xt *ip, Cell *sp, Cell *rp0, Float *fp, Address lp sr_proto); |
Label *gforth_engine(Xt *ip sr_proto); |
Label *gforth_engine2(Xt *ip, Cell *sp, Cell *rp0, Float *fp, Address lp sr_proto); |
Label *gforth_engine2(Xt *ip sr_proto); |
Label *gforth_engine3(Xt *ip, Cell *sp, Cell *rp0, Float *fp, Address lp sr_proto); |
Label *gforth_engine3(Xt *ip sr_proto); |
|
|
|
|
|
int gforth_main(int argc, char **argv, char **env); |
|
void gforth_args(int argc, char ** argv, char ** path, char ** imagename); |
|
Address gforth_loader(char* imagename, char* path); |
|
user_area* gforth_stacks(Cell dsize, Cell rsize, Cell fsize, Cell lsize); |
|
void gforth_free_stacks(user_area* t); |
|
void gforth_free(); |
|
Cell gforth_go(Xt* ip0); |
|
int gforth_boot(int argc, char** argv, char* path); |
|
int gforth_start(int argc, char ** argv); |
|
int gforth_quit(); |
|
Xt gforth_find(Char * name); |
|
int gforth_execute(Xt xt); |
|
void gforth_cleanup(); |
|
void gforth_printmetrics(); |
|
#if defined(DOUBLY_INDIRECT) |
|
int gforth_make_image(int debugflag); |
|
#endif |
|
|
|
/* for ABI-CODE and ;ABI-CODE */ |
|
typedef Cell *abifunc(Cell *sp, Float **fpp); |
|
typedef Cell *semiabifunc(Cell *sp, Float **fpp, Address body); |
|
|
/* engine/prim support routines */ |
/* engine/prim support routines */ |
Address gforth_alloc(Cell size); |
Address gforth_alloc(Cell size); |
char *cstr(Char *from, UCell size, int clear); |
char *cstr(Char *from, UCell size); |
char *tilde_cstr(Char *from, UCell size, int clear); |
char *tilde_cstr(Char *from, UCell size); |
Cell opencreate_file(char *s, Cell wfam, int flags, Cell *wiorp); |
Cell opencreate_file(char *s, Cell wfam, int flags, Cell *wiorp); |
DCell timeval2us(struct timeval *tvp); |
DCell timeval2us(struct timeval *tvp); |
|
DCell timespec2ns(struct timespec *tvp); |
void cmove(Char *c_from, Char *c_to, UCell u); |
void cmove(Char *c_from, Char *c_to, UCell u); |
void cmove_up(Char *c_from, Char *c_to, UCell u); |
void cmove_up(Char *c_from, Char *c_to, UCell u); |
Cell compare(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2); |
Cell compare(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2); |
Line 391 struct Longname *tablelfind(Char *c_addr
|
Line 434 struct Longname *tablelfind(Char *c_addr
|
UCell hashkey1(Char *c_addr, UCell u, UCell ubits); |
UCell hashkey1(Char *c_addr, UCell u, UCell ubits); |
struct Cellpair parse_white(Char *c_addr1, UCell u1); |
struct Cellpair parse_white(Char *c_addr1, UCell u1); |
Cell rename_file(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2); |
Cell rename_file(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2); |
struct Cellquad read_line(Char *c_addr, UCell u1, Cell wfileid); |
struct Cellquad read_line(Char *c_addr, UCell u1, FILE *wfileid); |
struct Cellpair file_status(Char *c_addr, UCell u); |
struct Cellpair file_status(Char *c_addr, UCell u); |
Cell to_float(Char *c_addr, UCell u, Float *r_p); |
Cell to_float(Char *c_addr, UCell u, Float *r_p, Char dot); |
Float v_star(Float *f_addr1, Cell nstride1, Float *f_addr2, Cell nstride2, UCell ucount); |
Float v_star(Float *f_addr1, Cell nstride1, Float *f_addr2, Cell nstride2, UCell ucount); |
void faxpy(Float ra, Float *f_x, Cell nstridex, Float *f_y, Cell nstridey, UCell ucount); |
void faxpy(Float ra, Float *f_x, Cell nstridex, Float *f_y, Cell nstridey, UCell ucount); |
UCell lshift(UCell u1, UCell n); |
UCell lshift(UCell u1, UCell n); |
UCell rshift(UCell u1, UCell n); |
UCell rshift(UCell u1, UCell n); |
int gforth_system(Char *c_addr, UCell u); |
int gforth_system(Char *c_addr, UCell u); |
void gforth_ms(UCell u); |
void gforth_ms(UCell u); |
|
UCell gforth_dlopen(Char *c_addr, UCell u); |
Cell capscompare(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2); |
Cell capscompare(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2); |
|
int gf_ungetc(int c, FILE *stream); |
|
void gf_regetc(FILE *stream); |
|
int gf_ungottenc(FILE *stream); |
|
|
/* signal handler stuff */ |
/* signal handler stuff */ |
void install_signal_handlers(void); |
void install_signal_handlers(void); |
Line 446 extern int debug;
|
Line 493 extern int debug;
|
# define debug 0 |
# define debug 0 |
#endif |
#endif |
|
|
extern Cell *gforth_SP; |
extern PER_THREAD Cell *gforth_SP; |
extern Float *gforth_FP; |
extern PER_THREAD Cell *gforth_RP; |
extern Address gforth_UP; |
extern PER_THREAD Address gforth_LP; |
|
extern PER_THREAD Float *gforth_FP; |
|
extern PER_THREAD user_area* gforth_UP; |
|
|
|
extern void * gforth_pointers(Cell n); |
|
|
#ifdef HAS_FFCALL |
#ifdef HAS_FFCALL |
extern Cell *gforth_RP; |
|
extern Address gforth_LP; |
|
extern void gforth_callback(Xt* fcall, void * alist); |
extern void gforth_callback(Xt* fcall, void * alist); |
#endif |
#endif |
|
|
#ifdef HAS_LIBFFI |
|
extern Cell *gforth_RP; |
|
extern Address gforth_LP; |
|
#include <ffi.h> |
|
extern void gforth_callback(ffi_cif * cif, void * resp, void ** args, void * ip); |
|
#endif |
|
|
|
#ifdef NO_IP |
#ifdef NO_IP |
extern Label next_code; |
extern Label next_code; |
#endif |
#endif |
Line 505 extern unsigned long int strtoul(const c
|
Line 547 extern unsigned long int strtoul(const c
|
|
|
#define GROUP(x, n) |
#define GROUP(x, n) |
#define GROUPADD(n) |
#define GROUPADD(n) |
|
|
|
#ifdef HAVE_ENDIAN_H |
|
#include <endian.h> |
|
#else |
|
#define BSWAP16(x) ((((x) >> 8) & 0xff | (((x) & 0xff) << 8))) |
|
#define BSWAP32(x) ((BSWAP16((x) >> 16) | (BSWAP16(x) << 16))) |
|
#define BSWAP64(x) ((BSWAP32((x) >> 32) | (BSWAP32(x) << 32))) |
|
#ifdef WORDS_BIGENDIAN |
|
#define htobe16(x) (x) |
|
#define htobe32(x) (x) |
|
#define htobe64(x) (x) |
|
#define be16toh(x) (x) |
|
#define be32toh(x) (x) |
|
#define be64toh(x) (x) |
|
#define htole16(x) BSWAP16(x) |
|
#define htole32(x) BSWAP32(x) |
|
#define htole64(x) BSWAP64(x) |
|
#define le16toh(x) BSWAP16(x) |
|
#define le32toh(x) BSWAP32(x) |
|
#define le64toh(x) BSWAP64(x) |
|
#else |
|
#define htobe16(x) BSWAP16(x) |
|
#define htobe32(x) BSWAP32(x) |
|
#define htobe64(x) BSWAP64(x) |
|
#define be16toh(x) BSWAP16(x) |
|
#define be32toh(x) BSWAP32(x) |
|
#define be64toh(x) BSWAP64(x) |
|
#define htole16(x) (x) |
|
#define htole32(x) (x) |
|
#define htole64(x) (x) |
|
#define le16toh(x) (x) |
|
#define le32toh(x) (x) |
|
#define le64toh(x) (x) |
|
#endif |
|
#endif |