--- gforth/engine/engine.c 2001/01/27 20:14:55 1.25 +++ gforth/engine/engine.c 2001/02/27 21:17:11 1.28 @@ -210,6 +210,40 @@ static int ufileattr[6]= { O_WRONLY|O_BINARY, O_WRONLY|O_BINARY }; #endif +/* 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) + +/* 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) + /* if machine.h has not defined explicit registers, define them as implicit */ #ifndef IPREG #define IPREG @@ -251,6 +285,19 @@ static int ufileattr[6]= { #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 + automatically, so you usually don't have to write it. If you have + to write it, write it after IP points to the next instruction. + Used for profiling. Don't write it in a word containing SET_IP, or + the following block will be counted twice. */ +#ifdef VM_PROFILING +#define SUPER_END vm_count_block(IP) +#else +#define SUPER_END +#endif + #ifdef GFORTH_DEBUGGING /* define some VM registers as global variables, so they survive exceptions; global register variables are not up to the task (according to the @@ -283,8 +330,10 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #if defined(DOUBLY_INDIRECT) static Label *symbols; static void *routines[]= { +#define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0])) #else /* !defined(DOUBLY_INDIRECT) */ static Label symbols[]= { +#define MAX_SYMBOLS (sizeof(symbols)/sizeof(symbols[0])) #endif /* !defined(DOUBLY_INDIRECT) */ (Label)&&docol, (Label)&&docon, @@ -313,7 +362,6 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * if (ip == NULL) { #if defined(DOUBLY_INDIRECT) -#define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0])) #define CODE_OFFSET (22*sizeof(Cell)) int i; Cell code_offset = offset_image? CODE_OFFSET : 0; @@ -336,6 +384,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * IF_fpTOS(fpTOS = fp[0]); /* prep_terminal(); */ SET_IP(ip); + SUPER_END; /* count the first block, too */ NEXT; @@ -353,6 +402,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * /* this is the simple version */ *--rp = (Cell)ip; SET_IP((Xt *)PFA1(cfa)); + SUPER_END; NEXT; #else /* this one is important, so we help the compiler optimizing */ @@ -360,6 +410,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * DEF_CA rp[-1] = (Cell)ip; SET_IP((Xt *)PFA1(cfa)); + SUPER_END; NEXT_P1; rp--; NEXT_P2; @@ -421,6 +472,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #ifdef DEBUG fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa)); #endif + SUPER_END; EXEC(*(Xt *)PFA1(cfa)); } @@ -470,6 +522,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * *--sp = (Cell)PFA(cfa); #endif SET_IP(DOES_CODE1(cfa)); + SUPER_END; /* fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/ } NEXT;