--- gforth/Attic/engine.c 1994/09/09 16:27:18 1.15 +++ gforth/Attic/engine.c 1995/04/06 16:56:09 1.25 @@ -1,5 +1,4 @@ /* - $Id: engine.c,v 1.15 1994/09/09 16:27:18 anton Exp $ Copyright 1992 by the ANSI figForth Development Group */ @@ -14,12 +13,21 @@ #include #include #include +#include +#include #include "forth.h" #include "io.h" +#ifndef SEEK_SET +/* should be defined in stdio.h, but some systems don't have it */ +#define SEEK_SET 0 +#endif + +#define IOR(flag) ((flag)? -512-errno : 0) + typedef union { struct { -#ifdef BIG_ENDIAN +#ifdef WORDS_BIGENDIAN Cell high; Cell low; #else @@ -41,9 +49,35 @@ typedef struct F83Name { #define F83NAME_SMUDGE(np) (((np)->countetc & 0x40) != 0) #define F83NAME_IMMEDIATE(np) (((np)->countetc & 0x20) != 0) +/* !!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 */ -#ifdef CISC_NEXT +#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 @@ -53,7 +87,7 @@ typedef struct F83Name { #define NEXT1_P2 ({goto **cfa;}) #endif /* DIRECT_THREADED */ #define NEXT_P2 ({cfa = *ip++; NEXT1_P2;}) -#else /* CISC_NEXT */ +#else /* defined(CISC_NEXT) && !defined(LONG_LATENCY) */ #ifdef DIRECT_THREADED #define NEXT1_P1 #define NEXT1_P2 ({goto *cfa;}) @@ -63,9 +97,17 @@ typedef struct F83Name { #define NEXT1_P2 ({goto *ca;}) #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 /* CISC_NEXT */ +#endif /* defined(CISC_NEXT) && !defined(LONG_LATENCY) */ #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;}) #define NEXT ({DEF_CA NEXT_P1; NEXT_P2;}) @@ -84,6 +126,8 @@ typedef struct F83Name { #define FTOS (fp[0]) #endif +Cell *SP; +Float *FP; int emitcounter; #define NULLC '\0' @@ -118,6 +162,9 @@ char *cstr(Char *from, UCell size, int c #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"}; @@ -172,6 +219,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * &&dovar, &&douser, &&dodefer, + &&dostruc, &&dodoes, &&dodoes, /* dummy for does handler address */ #include "prim_labels.i" @@ -180,22 +228,30 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * 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("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); + fprintf(stderr,"%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); #endif #ifdef CISC_NEXT /* this is the simple version */ *--rp = (Cell)ip; ip = (Xt *)PFA1(cfa); + NEXT_P0; NEXT; #else /* this one is important, so we help the compiler optimizing @@ -212,10 +268,10 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * NEXT1_P2; } #endif - + docon: #ifdef DEBUG - printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa)); + fprintf(stderr,"%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa)); #endif #ifdef USE_TOS *sp-- = TOS; @@ -223,11 +279,12 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #else *--sp = *(Cell *)PFA1(cfa); #endif + NEXT_P0; NEXT; dovar: #ifdef DEBUG - printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); + fprintf(stderr,"%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); #endif #ifdef USE_TOS *sp-- = TOS; @@ -235,13 +292,12 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #else *--sp = (Cell)PFA1(cfa); #endif + NEXT_P0; NEXT; - /* !! user? */ - douser: #ifdef DEBUG - printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); + fprintf(stderr,"%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); #endif #ifdef USE_TOS *sp-- = TOS; @@ -249,15 +305,24 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #else *--sp = (Cell)(up+*(Cell*)PFA1(cfa)); #endif + NEXT_P0; NEXT; dodefer: #ifdef DEBUG - printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); + 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: @@ -277,8 +342,8 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * */ #ifdef DEBUG - printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa)); - fflush(stdout); + 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 */ @@ -289,7 +354,8 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #else *--sp = (Cell)PFA(cfa); #endif + NEXT_P0; NEXT; - + #include "primitives.i" }