--- gforth/engine/engine.c 2000/09/23 15:06:07 1.22 +++ gforth/engine/engine.c 2001/02/27 21:17:11 1.28 @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. */ #include "config.h" @@ -72,10 +72,15 @@ struct F83Name { char name[0]; }; -/* are macros for setting necessary? */ #define F83NAME_COUNT(np) ((np)->countetc & 0x1f) -#define F83NAME_SMUDGE(np) (((np)->countetc & 0x40) != 0) -#define F83NAME_IMMEDIATE(np) (((np)->countetc & 0x20) != 0) + +struct Longname { + struct Longname *next; /* the link field for old hands */ + Cell countetc; + char name[0]; +}; + +#define LONGNAME_COUNT(np) ((np)->countetc & (((~((UCell)0))<<3)>>3)) Cell *SP; Float *FP; @@ -205,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 @@ -246,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 @@ -273,13 +325,15 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * MORE_VARS #endif register Address up UPREG = UP; - IF_TOS(register Cell TOS TOSREG;) - IF_FTOS(register Float FTOS FTOSREG;) + IF_spTOS(register Cell spTOS TOSREG;) + IF_fpTOS(register Float fpTOS FTOSREG;) #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, @@ -308,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; @@ -327,10 +380,11 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * return symbols; } - IF_TOS(TOS = sp[0]); - IF_FTOS(FTOS = fp[0]); + IF_spTOS(spTOS = sp[0]); + IF_fpTOS(fpTOS = fp[0]); /* prep_terminal(); */ SET_IP(ip); + SUPER_END; /* count the first block, too */ NEXT; @@ -348,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 */ @@ -355,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; @@ -369,8 +425,8 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * fprintf(stderr,"%08lx: con: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa)); #endif #ifdef USE_TOS - *sp-- = TOS; - TOS = *(Cell *)PFA1(cfa); + *sp-- = spTOS; + spTOS = *(Cell *)PFA1(cfa); #else *--sp = *(Cell *)PFA1(cfa); #endif @@ -385,8 +441,8 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * fprintf(stderr,"%08lx: var: %08lx\n",(Cell)ip,(Cell)PFA1(cfa)); #endif #ifdef USE_TOS - *sp-- = TOS; - TOS = (Cell)PFA1(cfa); + *sp-- = spTOS; + spTOS = (Cell)PFA1(cfa); #else *--sp = (Cell)PFA1(cfa); #endif @@ -401,8 +457,8 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * fprintf(stderr,"%08lx: user: %08lx\n",(Cell)ip,(Cell)PFA1(cfa)); #endif #ifdef USE_TOS - *sp-- = TOS; - TOS = (Cell)(up+*(Cell*)PFA1(cfa)); + *sp-- = spTOS; + spTOS = (Cell)(up+*(Cell*)PFA1(cfa)); #else *--sp = (Cell)(up+*(Cell*)PFA1(cfa)); #endif @@ -416,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)); } @@ -425,7 +482,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #ifdef DEBUG fprintf(stderr,"%08lx: field: %08lx\n",(Cell)ip,(Cell)PFA1(cfa)); #endif - TOS += *(Cell*)PFA1(cfa); + spTOS += *(Cell*)PFA1(cfa); } NEXT_P0; NEXT; @@ -459,13 +516,14 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * *--rp = (Cell)ip; /* PFA1 might collide with DOES_CODE1 here, so we use PFA */ #ifdef USE_TOS - *sp-- = TOS; - TOS = (Cell)PFA(cfa); + *sp-- = spTOS; + spTOS = (Cell)PFA(cfa); #else *--sp = (Cell)PFA(cfa); #endif SET_IP(DOES_CODE1(cfa)); - /* fprintf(stderr,"TOS = %08lx, IP=%08lx\n", TOS, IP);*/ + SUPER_END; + /* fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/ } NEXT;