--- gforth/Attic/engine.c 1994/09/28 17:02:46 1.17 +++ gforth/Attic/engine.c 1995/10/07 17:38:12 1.29 @@ -1,5 +1,4 @@ /* - $Id: engine.c,v 1.17 1994/09/28 17:02:46 anton Exp $ Copyright 1992 by the ANSI figForth Development Group */ @@ -14,12 +13,22 @@ #include #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 +50,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 +88,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 +98,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 +127,8 @@ typedef struct F83Name { #define FTOS (fp[0]) #endif +Cell *SP; +Float *FP; int emitcounter; #define NULLC '\0' @@ -116,10 +161,54 @@ char *cstr(Char *from, UCell size, int c return oldnextscratch; } +char *tilde_cstr(Char *from, UCell size, int clear) +/* like cstr(), but perform tilde expansion on the string */ +{ + char *s1,*s2; + int s1_len, s2_len; + struct passwd *getpwnam (), *user_entry; + + if (size<1 || from[0]!='~') + return cstr(from, size, clear); + if (size<2 || from[1]=='/') { + s1 = (char *)getenv ("HOME"); + s2 = from+1; + s2_len = size-1; + } else { + int i; + for (i=1; ipw_dir; + s2 = from+i; + s2_len = size-i; + } + s1_len = strlen(s1); + if (s1_len>1 && s1[s1_len-1]=='/') + s1_len--; + { + char path[s1_len+s2_len]; + memcpy(path,s1,s1_len); + memcpy(path+s1_len,s2,s2_len); + return cstr(path,s1_len+s2_len,clear); + } +} + + #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"}; +static char* fileattr[6]={"r","rb","r+","r+b","w","wb"}; static Address up0=NULL; @@ -172,6 +261,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * &&dovar, &&douser, &&dodefer, + &&dofield, &&dodoes, &&dodoes, /* dummy for does handler address */ #include "prim_labels.i" @@ -182,7 +272,8 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #ifdef DEBUG fprintf(stderr,"ip=%x, sp=%x, rp=%x, fp=%x, lp=%x, up=%x\n", - ip,sp,rp,fp,lp,up); + (unsigned)ip,(unsigned)sp,(unsigned)rp, + (unsigned)fp,(unsigned)lp,(unsigned)up); #endif if (ip == NULL) @@ -190,7 +281,8 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * IF_TOS(TOS = sp[0]); IF_FTOS(FTOS = fp[0]); - prep_terminal(); +/* prep_terminal(); */ + NEXT_P0; NEXT; docol: @@ -201,6 +293,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * /* 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 @@ -217,7 +310,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * NEXT1_P2; } #endif - + docon: #ifdef DEBUG fprintf(stderr,"%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa)); @@ -228,6 +321,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #else *--sp = *(Cell *)PFA1(cfa); #endif + NEXT_P0; NEXT; dovar: @@ -240,10 +334,9 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #else *--sp = (Cell)PFA1(cfa); #endif + NEXT_P0; NEXT; - /* !! user? */ - douser: #ifdef DEBUG fprintf(stderr,"%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); @@ -254,6 +347,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #else *--sp = (Cell)(up+*(Cell*)PFA1(cfa)); #endif + NEXT_P0; NEXT; dodefer: @@ -263,6 +357,14 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * cfa = *(Xt *)PFA1(cfa); NEXT1; + dofield: +#ifdef DEBUG + fprintf(stderr,"%08x: field: %08x\n",(Cell)ip,(Cell)PFA1(cfa)); +#endif + TOS += *(Cell*)PFA1(cfa); + NEXT_P0; + NEXT; + dodoes: /* this assumes the following structure: defining-word: @@ -294,6 +396,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * #else *--sp = (Cell)PFA(cfa); #endif + NEXT_P0; NEXT; #include "primitives.i"