--- gforth/engine/forth.h 2008/09/18 02:42:24 1.101 +++ gforth/engine/forth.h 2012/12/31 15:25:19 1.133 @@ -1,6 +1,6 @@ /* common header file - Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008 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. @@ -24,8 +24,10 @@ #include #include #ifndef STANDALONE +#if defined(HAVE_LIBLTDL) #include #endif +#endif #if !defined(FORCE_LL) && !defined(BUGGY_LONG_LONG) #define BUGGY_LONG_LONG @@ -98,10 +100,9 @@ #define DOFIELD 5 #define DOVAL 6 #define DODOES 7 -#define DOESJUMP 8 - -/* the size of the DOESJUMP, which resides between DOES> and the does-code */ -#define DOES_HANDLER_SIZE (2*sizeof(Cell)) +#define DOABICODE 8 +#define DOSEMIABICODE 9 +#define DOER_MAX 9 #include "machine.h" @@ -109,8 +110,10 @@ typedef WYDE_TYPE Wyde; typedef TETRABYTE_TYPE Tetrabyte; +typedef OCTABYTE_TYPE Octabyte; typedef unsigned WYDE_TYPE UWyde; typedef unsigned TETRABYTE_TYPE UTetrabyte; +typedef unsigned OCTABYTE_TYPE UOctabyte; /* Forth data types */ /* Cell and UCell must be the same size as a pointer */ @@ -168,8 +171,12 @@ typedef struct { #define D2UD(d) ({DCell _d1=(d); (UDCell){_d1.hi,_d1.lo};}) /* shifts by less than CELL_BITS */ -#define DLSHIFT(d,u) ({DCell _d=(d); UCell _u=(u); \ - (DCell){(_d.hi<<_u)|(_d.lo>>(CELL_BITS-_u)),_d.lo<<_u};}) +#define DLSHIFT(d,u) ({DCell _d=(d); UCell _u=(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)) #if SMALL_OFF_T @@ -262,8 +269,6 @@ typedef Label *Xt; ca is the code address */ #define MAKE_CF(cfa,ca) ((*(Label *)(cfa)) = ((Label)ca)) /* 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) @@ -277,6 +282,10 @@ typedef Label *Xt; #define NO_DYNAMIC_DEFAULT 1 #endif +#ifndef CHECK_PRIM +#define CHECK_PRIM(start,len) 0 +#endif + #if defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING) #define STACK_CACHE_DEFAULT 0 #else @@ -294,6 +303,17 @@ typedef Label *Xt; #define rpTOS (rp[0]) 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) */ UCell checksum; /* checksum of ca's to protect against some incompatible binary/executable combinations @@ -306,12 +326,10 @@ typedef struct { UCell locals_stack_size; Xt *boot_entry; /* initial ip for booting (in BOOT) */ 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 */ - 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; /* the image-header is created in main.fs */ @@ -330,7 +348,7 @@ struct Longname { 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 { Cell n1; @@ -354,7 +372,8 @@ typedef struct saved_regs { Xt *sr_saved_ip; Cell *sr_rp; } 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 rp (saved_regs_p->sr_rp) /* for use in gforth_engine header */ @@ -362,8 +381,8 @@ extern saved_regs saved_regs_v, *saved_r #define sr_proto , struct saved_regs *saved_regs_p0 #define sr_call , saved_regs_p #else /* !defined(GLOBALS_NONRELOC) */ -extern Xt *saved_ip; -extern Cell *rp; +extern PER_THREAD Xt *saved_ip; +extern PER_THREAD Cell *rp; #define sr_proto #define sr_call #endif /* !defined(GLOBALS_NONRELOC) */ @@ -372,16 +391,40 @@ extern Cell *rp; #define sr_call #endif /* !defined(GFORTH_DEBUGGING) */ -Label *gforth_engine(Xt *ip, Cell *sp, Cell *rp0, Float *fp, Address lp sr_proto); -Label *gforth_engine2(Xt *ip, Cell *sp, Cell *rp0, Float *fp, Address lp sr_proto); -Label *gforth_engine3(Xt *ip, Cell *sp, Cell *rp0, Float *fp, Address lp sr_proto); +Label *gforth_engine(Xt *ip sr_proto); +Label *gforth_engine2(Xt *ip 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 */ Address gforth_alloc(Cell size); -char *cstr(Char *from, UCell size, int clear); -char *tilde_cstr(Char *from, UCell size, int clear); +char *cstr(Char *from, UCell size); +char *tilde_cstr(Char *from, UCell size); Cell opencreate_file(char *s, Cell wfam, int flags, Cell *wiorp); DCell timeval2us(struct timeval *tvp); +DCell timespec2ns(struct timespec *tvp); void cmove(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); @@ -391,16 +434,20 @@ struct Longname *tablelfind(Char *c_addr UCell hashkey1(Char *c_addr, UCell u, UCell ubits); struct Cellpair parse_white(Char *c_addr1, UCell u1); 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); -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); void faxpy(Float ra, Float *f_x, Cell nstridex, Float *f_y, Cell nstridey, UCell ucount); UCell lshift(UCell u1, UCell n); UCell rshift(UCell u1, UCell n); int gforth_system(Char *c_addr, 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); +int gf_ungetc(int c, FILE *stream); +void gf_regetc(FILE *stream); +int gf_ungottenc(FILE *stream); /* signal handler stuff */ void install_signal_handlers(void); @@ -446,18 +493,15 @@ extern int debug; # define debug 0 #endif -extern Cell *gforth_SP; -extern Cell *gforth_RP; -extern Address gforth_LP; -extern Float *gforth_FP; -extern Address gforth_UP; -#ifndef HAS_LINKBACK -extern void * gforth_pointers[]; -#endif +extern PER_THREAD Cell *gforth_SP; +extern PER_THREAD Cell *gforth_RP; +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 -extern Cell *gforth_RP; -extern Address gforth_LP; extern void gforth_callback(Xt* fcall, void * alist); #endif @@ -503,3 +547,38 @@ extern unsigned long int strtoul(const c #define GROUP(x, n) #define GROUPADD(n) + +#ifdef HAVE_ENDIAN_H +#include +#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