--- gforth/Attic/engine.c 1994/06/01 16:40:01 1.8 +++ gforth/Attic/engine.c 1994/09/08 17:20:05 1.14 @@ -1,5 +1,5 @@ /* - $Id: engine.c,v 1.8 1994/06/01 16:40:01 pazsan Exp $ + $Id: engine.c,v 1.14 1994/09/08 17:20:05 anton Exp $ Copyright 1992 by the ANSI figForth Development Group */ @@ -14,7 +14,6 @@ #include #include #include -#include #include "forth.h" #include "io.h" @@ -42,20 +41,34 @@ typedef struct F83Name { #define F83NAME_SMUDGE(np) (((np)->countetc & 0x40) != 0) #define F83NAME_IMMEDIATE(np) (((np)->countetc & 0x20) != 0) -/* NEXT and NEXT1 are split into several parts to help scheduling */ +/* NEXT and NEXT1 are split into several parts to help scheduling, + unless CISC_NEXT is defined */ +#ifdef CISC_NEXT +#define NEXT1_P1 +#define NEXT_P1 +#define DEF_CA #ifdef DIRECT_THREADED -# define NEXT1_P1 -# define NEXT1_P2 ({goto *cfa;}) -# define DEF_CA -#else -# define NEXT1_P1 ({ca = *cfa;}) -# define NEXT1_P2 ({goto *ca;}) -# define DEF_CA Label ca; -#endif -#define NEXT_P1 ({cfa = *ip++; NEXT1_P1;}) +#define NEXT1_P2 ({goto *cfa;}) +#else +#define NEXT1_P2 ({goto **cfa;}) +#endif /* DIRECT_THREADED */ +#define NEXT_P2 ({cfa = *ip++; NEXT1_P2;}) +#else /* CISC_NEXT */ +#ifdef DIRECT_THREADED +#define NEXT1_P1 +#define NEXT1_P2 ({goto *cfa;}) +#define DEF_CA +#else /* DIRECT_THREADED */ +#define NEXT1_P1 ({ca = *cfa;}) +#define NEXT1_P2 ({goto *ca;}) +#define DEF_CA Label ca; +#endif /* DIRECT_THREADED */ +#define NEXT_P1 ({cfa=*ip++; NEXT1_P1;}) +#define NEXT_P2 NEXT1_P2 +#endif /* CISC_NEXT */ #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;}) -#define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;}) +#define NEXT ({DEF_CA NEXT_P1; NEXT_P2;}) #ifdef USE_TOS #define IF_TOS(x) x @@ -74,25 +87,75 @@ typedef struct F83Name { int emitcounter; #define NULLC '\0' -#define cstr(to,from,size)\ - { memcpy(to,from,size);\ - to[size]=NULLC;} +char *cstr(Char *from, UCell size, int clear) +/* if clear is true, scratch can be reused, otherwise we want more of + the same */ +{ + static char *scratch=NULL; + static unsigned scratchsize=0; + static char *nextscratch; + char *oldnextscratch; + + if (clear) + nextscratch=scratch; + if (scratch==NULL) { + scratch=malloc(size+1); + nextscratch=scratch; + scratchsize=size; + } + else if (nextscratch+size>scratch+scratchsize) { + char *oldscratch=scratch; + scratch = realloc(scratch, (nextscratch-scratch)+size+1); + nextscratch=scratch+(nextscratch-oldscratch); + scratchsize=size; + } + memcpy(nextscratch,from,size); + nextscratch[size]='\0'; + oldnextscratch = nextscratch; + nextscratch += size+1; + return oldnextscratch; +} + #define NEWLINE '\n' + static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"}; +static Address up0=NULL; + +#if defined(i386) && defined(FORCE_REG) +# define REG(reg) __asm__(reg) + +Label *engine(Xt *ip0, Cell *sp0, Cell *rp, Float *fp, Address lp) +{ + register Xt *ip REG("%esi")=ip0; + register Cell *sp REG("%edi")=sp0; + +#else +# define REG(reg) + Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp) +{ +#endif /* executes code at ip, if ip!=NULL returns array of machine code labels (for use in a loader), if ip==NULL */ -{ - Xt cfa; - Address up=NULL; + register Xt cfa +#ifdef i386 +# ifdef USE_TOS + REG("%ecx") +# else + REG("%edx") +# endif +#endif + ; + Address up=up0; static Label symbols[]= { &&docol, &&docon, &&dovar, &&douser, + &&dodefer, &&dodoes, &&dodoes, /* dummy for does handler address */ #include "prim_labels.i" @@ -105,7 +168,7 @@ Label *engine(Xt *ip, Cell *sp, Cell *rp if (ip == NULL) return symbols; - + IF_TOS(TOS = sp[0]); IF_FTOS(FTOS = fp[0]); prep_terminal(); @@ -115,7 +178,7 @@ Label *engine(Xt *ip, Cell *sp, Cell *rp #ifdef DEBUG printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); #endif -#ifdef undefined +#ifdef i386 /* this is the simple version */ *--rp = (Cell)ip; ip = (Xt *)PFA1(cfa); @@ -173,6 +236,13 @@ Label *engine(Xt *ip, Cell *sp, Cell *rp #endif NEXT; + dodefer: +#ifdef DEBUG + printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); +#endif + cfa = *(Xt *)PFA1(cfa); + NEXT1; + dodoes: /* this assumes the following structure: defining-word: @@ -197,13 +267,13 @@ Label *engine(Xt *ip, Cell *sp, Cell *rp #endif *--rp = (Cell)ip; /* PFA1 might collide with DOES_CODE1 here, so we use PFA */ + ip = DOES_CODE1(cfa); #ifdef USE_TOS *sp-- = TOS; TOS = (Cell)PFA(cfa); #else *--sp = (Cell)PFA(cfa); #endif - ip = DOES_CODE1(cfa); NEXT; #include "primitives.i"