--- gforth/Attic/engine.c 1994/05/03 19:10:34 1.3 +++ gforth/Attic/engine.c 1995/02/23 20:17:18 1.24 @@ -1,5 +1,4 @@ /* - $Id: engine.c,v 1.3 1994/05/03 19:10:34 pazsan Exp $ Copyright 1992 by the ANSI figForth Development Group */ @@ -13,15 +12,19 @@ #include #include #include +#include +#include #include "forth.h" #include "io.h" -extern unlink(char *); -extern ftruncate(int, int); +#ifndef SEEK_SET +/* should be defined in stdio.h, but some systems don't have it */ +#define SEEK_SET 0 +#endif typedef union { struct { -#ifdef BIG_ENDIAN +#ifdef WORDS_BIGENDIAN Cell high; Cell low; #else @@ -43,18 +46,68 @@ 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 */ +/* !!someone should organize this ifdef chaos */ +#if defined(LONG_LATENCY) +#if defined(AUTO_INCREMENT) +#define NEXT_P0 (cfa=*ip++) +#define IP (ip-1) +#else /* AUTO_INCREMENT */ +#define NEXT_P0 (cfa=*ip) +#define IP ip +#endif /* AUTO_INCREMENT */ +#define NEXT_INST (cfa) +#define INC_IP(const_inc) ({cfa=IP[const_inc]; ip+=(const_inc);}) +#else /* LONG_LATENCY */ +/* NEXT and NEXT1 are split into several parts to help scheduling, + unless CISC_NEXT is defined */ +#define NEXT_P0 +/* in order for execute to work correctly, NEXT_P0 (or other early + fetches) should not update the ip (or should we put + compensation-code into execute? */ +#define NEXT_INST (*ip) +/* the next instruction (or what is in its place, e.g., an immediate + argument */ +#define INC_IP(const_inc) (ip+=(const_inc)) +/* increment the ip by const_inc and perform NEXT_P0 (or prefetching) again */ +#define IP ip +/* the pointer to the next instruction (i.e., NEXT_INST could be + defined as *IP) */ +#endif /* LONG_LATENCY */ + +#if defined(CISC_NEXT) && !defined(LONG_LATENCY) +#define NEXT1_P1 +#define NEXT_P1 +#define DEF_CA #ifdef DIRECT_THREADED -#define NEXT1_P1 #define NEXT1_P2 ({goto *cfa;}) #else +#define NEXT1_P2 ({goto **cfa;}) +#endif /* DIRECT_THREADED */ +#define NEXT_P2 ({cfa = *ip++; NEXT1_P2;}) +#else /* defined(CISC_NEXT) && !defined(LONG_LATENCY) */ +#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;}) -#endif -#define NEXT_P1 ({cfa = *ip++; NEXT1_P1;}) +#define DEF_CA Label ca; +#endif /* DIRECT_THREADED */ +#if defined(LONG_LATENCY) +#if defined(AUTO_INCREMENT) +#define NEXT_P1 NEXT1_P1 +#else /* AUTO_INCREMENT */ +#define NEXT_P1 ({ip++; NEXT1_P1;}) +#endif /* AUTO_INCREMENT */ +#else /* LONG_LATENCY */ +#define NEXT_P1 ({cfa=*ip++; NEXT1_P1;}) +#endif /* LONG_LATENCY */ +#define NEXT_P2 NEXT1_P2 +#endif /* defined(CISC_NEXT) && !defined(LONG_LATENCY) */ -#define NEXT1 ({Label ca; NEXT1_P1; NEXT1_P2;}) -#define NEXT ({Label ca; NEXT_P1; NEXT1_P2;}) +#define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;}) +#define NEXT ({DEF_CA NEXT_P1; NEXT_P2;}) #ifdef USE_TOS #define IF_TOS(x) x @@ -70,66 +123,138 @@ typedef struct F83Name { #define FTOS (fp[0]) #endif -#define DODOES (symbols[3]) - 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' +#ifndef HAVE_RINT +#define rint(x) floor((x)+0.5) +#endif + static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"}; -Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp) +static Address up0=NULL; + +/* if machine.h has not defined explicit registers, define them as implicit */ +#ifndef IPREG +#define IPREG +#endif +#ifndef SPREG +#define SPREG +#endif +#ifndef RPREG +#define RPREG +#endif +#ifndef FPREG +#define FPREG +#endif +#ifndef LPREG +#define LPREG +#endif +#ifndef CFAREG +#define CFAREG +#endif +#ifndef UPREG +#define UPREG +#endif +#ifndef TOSREG +#define TOSREG +#endif +#ifndef FTOSREG +#define FTOSREG +#endif + +Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0) /* executes code at ip, if ip!=NULL returns array of machine code labels (for use in a loader), if ip==NULL - This is very preliminary, as the bootstrap architecture is not yet decided */ { - Xt cfa; - Address lp=NULL; + register Xt *ip IPREG = ip0; + register Cell *sp SPREG = sp0; + register Cell *rp RPREG = rp0; + register Float *fp FPREG = fp0; + register Address lp LPREG = lp0; + register Xt cfa CFAREG; + register Address up UPREG = up0; + IF_TOS(register Cell TOS TOSREG;) + IF_FTOS(register Float FTOS FTOSREG;) static Label symbols[]= { &&docol, &&docon, &&dovar, + &&douser, + &&dodefer, + &&dostruc, &&dodoes, + &&dodoes, /* dummy for does handler address */ #include "prim_labels.i" }; -#ifndef DIRECT_THREADED -/* Label ca; */ -#endif - IF_TOS(register Cell TOS;) - IF_FTOS(Float FTOS;) #ifdef CPU_DEP CPU_DEP; #endif +#ifdef DEBUG + fprintf(stderr,"ip=%x, sp=%x, rp=%x, fp=%x, lp=%x, up=%x\n", + (unsigned)ip,(unsigned)sp,(unsigned)rp, + (unsigned)fp,(unsigned)lp,(unsigned)up); +#endif + if (ip == NULL) return symbols; - + IF_TOS(TOS = sp[0]); IF_FTOS(FTOS = fp[0]); prep_terminal(); + NEXT_P0; NEXT; docol: #ifdef DEBUG - printf("col: %x\n",(Cell)PFA1(cfa)); + fprintf(stderr,"%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); #endif -#ifdef undefined +#ifdef CISC_NEXT /* this is the simple version */ *--rp = (Cell)ip; ip = (Xt *)PFA1(cfa); + NEXT_P0; NEXT; -#endif +#else /* this one is important, so we help the compiler optimizing The following version may be better (for scheduling), but probably has problems with code fields employing calls and delay slots */ { - Label ca; + DEF_CA Xt *current_ip = (Xt *)PFA1(cfa); cfa = *current_ip; NEXT1_P1; @@ -137,10 +262,11 @@ Label *engine(Xt *ip, Cell *sp, Cell *rp ip = current_ip+1; NEXT1_P2; } - +#endif + docon: #ifdef DEBUG - printf("con: %x\n",*(Cell*)PFA1(cfa)); + fprintf(stderr,"%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa)); #endif #ifdef USE_TOS *sp-- = TOS; @@ -148,11 +274,12 @@ Label *engine(Xt *ip, Cell *sp, Cell *rp #else *--sp = *(Cell *)PFA1(cfa); #endif + NEXT_P0; NEXT; dovar: #ifdef DEBUG - printf("var: %x\n",(Cell)PFA1(cfa)); + fprintf(stderr,"%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); #endif #ifdef USE_TOS *sp-- = TOS; @@ -160,10 +287,37 @@ Label *engine(Xt *ip, Cell *sp, Cell *rp #else *--sp = (Cell)PFA1(cfa); #endif + NEXT_P0; NEXT; - /* !! user? */ + douser: +#ifdef DEBUG + fprintf(stderr,"%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); +#endif +#ifdef USE_TOS + *sp-- = TOS; + TOS = (Cell)(up+*(Cell*)PFA1(cfa)); +#else + *--sp = (Cell)(up+*(Cell*)PFA1(cfa)); +#endif + NEXT_P0; + NEXT; + dodefer: +#ifdef DEBUG + fprintf(stderr,"%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); +#endif + cfa = *(Xt *)PFA1(cfa); + NEXT1; + + dostruc: +#ifdef DEBUG + fprintf(stderr,"%08x: struc: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); +#endif + TOS += *(Cell*)PFA1(cfa); + NEXT_P0; + NEXT; + dodoes: /* this assumes the following structure: defining-word: @@ -183,18 +337,20 @@ Label *engine(Xt *ip, Cell *sp, Cell *rp */ #ifdef DEBUG - printf("does: %x\n",(Cell)PFA(cfa)); + fprintf(stderr,"%08x/%08x: does: %08x\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa)); + fflush(stderr); #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_P0; NEXT; - + #include "primitives.i" }