--- gforth/engine/engine.c 2001/12/24 14:09:08 1.34 +++ gforth/engine/engine.c 2002/08/19 07:38:16 1.43 @@ -19,6 +19,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. */ +undefine(`symbols') + #include "config.h" #include "forth.h" #include @@ -213,39 +215,39 @@ static int ufileattr[6]= { /* conversion on fetch */ -#define vm_Cell2f(x) ((Bool)(x)) -#define vm_Cell2c(x) ((Char)(x)) -#define vm_Cell2n(x) ((Cell)x) -#define vm_Cell2w(x) ((Cell)x) -#define vm_Cell2u(x) ((UCell)(x)) -#define vm_Cell2a_(x) ((Cell *)(x)) -#define vm_Cell2c_(x) ((Char *)(x)) -#define vm_Cell2f_(x) ((Float *)(x)) -#define vm_Cell2df_(x) ((DFloat *)(x)) -#define vm_Cell2sf_(x) ((SFloat *)(x)) -#define vm_Cell2xt(x) ((Xt)(x)) -#define vm_Cell2f83name(x) ((struct F83Name *)(x)) -#define vm_Cell2longname(x) ((struct Longname *)(x)) -#define vm_Float2r(x) (x) +#define vm_Cell2f(_cell,_x) ((_x)=(Bool)(_cell)) +#define vm_Cell2c(_cell,_x) ((_x)=(Char)(_cell)) +#define vm_Cell2n(_cell,_x) ((_x)=(Cell)(_cell)) +#define vm_Cell2w(_cell,_x) ((_x)=(Cell)(_cell)) +#define vm_Cell2u(_cell,_x) ((_x)=(UCell)(_cell)) +#define vm_Cell2a_(_cell,_x) ((_x)=(Cell *)(_cell)) +#define vm_Cell2c_(_cell,_x) ((_x)=(Char *)(_cell)) +#define vm_Cell2f_(_cell,_x) ((_x)=(Float *)(_cell)) +#define vm_Cell2df_(_cell,_x) ((_x)=(DFloat *)(_cell)) +#define vm_Cell2sf_(_cell,_x) ((_x)=(SFloat *)(_cell)) +#define vm_Cell2xt(_cell,_x) ((_x)=(Xt)(_cell)) +#define vm_Cell2f83name(_cell,_x) ((_x)=(struct F83Name *)(_cell)) +#define vm_Cell2longname(_cell,_x) ((_x)=(struct Longname *)(_cell)) +#define vm_Float2r(_float,_x) (_x=_float) /* conversion on store */ -#define vm_f2Cell(x) ((Cell)(x)) -#define vm_c2Cell(x) ((Cell)(x)) -#define vm_n2Cell(x) ((Cell)(x)) -#define vm_w2Cell(x) ((Cell)(x)) -#define vm_u2Cell(x) ((Cell)(x)) -#define vm_a_2Cell(x) ((Cell)(x)) -#define vm_c_2Cell(x) ((Cell)(x)) -#define vm_f_2Cell(x) ((Cell)(x)) -#define vm_df_2Cell(x) ((Cell)(x)) -#define vm_sf_2Cell(x) ((Cell)(x)) -#define vm_xt2Cell(x) ((Cell)(x)) -#define vm_f83name2Cell(x) ((Cell)(x)) -#define vm_longname2Cell(x) ((Cell)(x)) -#define vm_r2Float(x) (x) +#define vm_f2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_c2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_n2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_w2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_u2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_a_2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_c_2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_f_2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_df_2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_sf_2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_xt2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_f83name2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_longname2Cell(_x,_cell) ((_cell)=(Cell)(_x)) +#define vm_r2Float(_x,_float) (_float=_x) -#define vm_Cell2Cell(x) (x) +#define vm_Cell2Cell(_x,_y) (_y=_x) /* if machine.h has not defined explicit registers, define them as implicit */ #ifndef IPREG @@ -280,14 +282,6 @@ static int ufileattr[6]= { # define CPU_DEP1 0 #endif -/* declare and compute cfa for certain threading variants */ -/* warning: this is nonsyntactical; it will not work in place of a statement */ -#ifndef GETCFA -#define DOCFA -#else -#define DOCFA Xt cfa; GETCFA(cfa) -#endif - /* instructions containing these must be the last instruction of a super-instruction (e.g., branches, EXECUTE, and other instructions ending the basic block). Instructions containing SET_IP get this @@ -300,6 +294,7 @@ static int ufileattr[6]= { #else #define SUPER_END #endif +#define SUPER_CONTINUE #ifdef GFORTH_DEBUGGING /* define some VM registers as global variables, so they survive exceptions; @@ -309,18 +304,29 @@ Xt *ip; Cell *rp; #endif +#ifdef DEBUG +#define CFA_TO_NAME(__cfa) \ + Cell len, i; \ + char * name = __cfa; \ + for(i=0; i<32; i+=sizeof(Cell)) { \ + len = ((Cell*)name)[-1]; \ + if(len < 0) { \ + len &= 0x1F; \ + if((len+sizeof(Cell)) > i) break; \ + } len = 0; \ + name -= sizeof(Cell); \ + } +#endif + Xt *primtable(Label symbols[], Cell size) + /* used in primitive primtable for peephole optimization */ { -#ifdef DIRECT_THREADED - return symbols; -#else /* !defined(DIRECT_THREADED) */ Xt *xts = (Xt *)malloc(size*sizeof(Xt)); Cell i; for (i=0; i=MAX_SYMBOLS) { fprintf(stderr,"gforth-ditc: more than %d primitives\n",MAX_SYMBOLS); exit(1); } - symbols[i] = &routines[i]; + xts[i] = symbols[i] = &routines[i]; } #endif /* defined(DOUBLY_INDIRECT) */ return symbols; @@ -421,9 +428,12 @@ define(enginerest, docol: { - DOCFA; #ifdef DEBUG - fprintf(stderr,"%08lx: col: %08lx\n",(Cell)ip,(Cell)PFA1(cfa)); + { + CFA_TO_NAME(cfa); + fprintf(stderr,"%08lx: col: %08lx %.*s\n",(Cell)ip,(Cell)PFA1(cfa), + len,name); + } #endif #ifdef CISC_NEXT /* this is the simple version */ @@ -447,7 +457,6 @@ define(enginerest, docon: { - DOCFA; #ifdef DEBUG fprintf(stderr,"%08lx: con: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa)); #endif @@ -463,7 +472,6 @@ define(enginerest, dovar: { - DOCFA; #ifdef DEBUG fprintf(stderr,"%08lx: var: %08lx\n",(Cell)ip,(Cell)PFA1(cfa)); #endif @@ -479,7 +487,6 @@ define(enginerest, douser: { - DOCFA; #ifdef DEBUG fprintf(stderr,"%08lx: user: %08lx\n",(Cell)ip,(Cell)PFA1(cfa)); #endif @@ -495,7 +502,6 @@ define(enginerest, dodefer: { - DOCFA; #ifdef DEBUG fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa)); #endif @@ -505,7 +511,6 @@ define(enginerest, dofield: { - DOCFA; #ifdef DEBUG fprintf(stderr,"%08lx: field: %08lx\n",(Cell)ip,(Cell)PFA1(cfa)); #endif @@ -533,8 +538,6 @@ define(enginerest, */ { - DOCFA; - /* fprintf(stderr, "Got CFA %08lx at doescode %08lx/%08lx: does: %08lx\n",cfa,(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));*/ #ifdef DEBUG fprintf(stderr,"%08lx/%08lx: does: %08lx\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa)); @@ -555,10 +558,11 @@ define(enginerest, NEXT; #ifndef IN_ENGINE2 -#define LABEL(name) I_##name +#define LABEL(name) I_##name: #else -#define LABEL(name) J_##name: asm(".skip 16"); I_##name +#define LABEL(name) J_##name: asm(".skip 16"); I_##name: #endif +#define LABEL2(name) #include "prim.i" #undef LABEL after_last: return (Label *)0;