Diff for /gforth/Attic/engine.c between versions 1.13 and 1.27

version 1.13, 1994/08/31 19:42:44 version 1.27, 1995/06/07 10:05:04
Line 1 Line 1
 /*  /*
   $Id$  
   Copyright 1992 by the ANSI figForth Development Group    Copyright 1992 by the ANSI figForth Development Group
 */  */
   
Line 14 Line 13
 #include <stdlib.h>  #include <stdlib.h>
 #include <time.h>  #include <time.h>
 #include <sys/time.h>  #include <sys/time.h>
   #include <unistd.h>
   #include <errno.h>
   #include <pwd.h>
 #include "forth.h"  #include "forth.h"
 #include "io.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 {  typedef union {
   struct {    struct {
 #ifdef BIG_ENDIAN  #ifdef WORDS_BIGENDIAN
     Cell high;      Cell high;
     Cell low;      Cell low;
 #else  #else
Line 41  typedef struct F83Name { Line 50  typedef struct F83Name {
 #define F83NAME_SMUDGE(np)      (((np)->countetc & 0x40) != 0)  #define F83NAME_SMUDGE(np)      (((np)->countetc & 0x40) != 0)
 #define F83NAME_IMMEDIATE(np)   (((np)->countetc & 0x20) != 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  #ifdef DIRECT_THREADED
 #       define NEXT1_P1  #define NEXT1_P2 ({goto *cfa;})
 #       ifdef i386  
 #               define NEXT1_P2 ({cfa=*ip++; goto *cfa;})  
 #       else  
 #               define NEXT1_P2 ({goto *cfa;})  
 #       endif  
 #       define DEF_CA  
 #else  
 #       define NEXT1_P1 ({ca = *cfa;})  
 #       define NEXT1_P2 ({goto *ca;})  
 #       define DEF_CA   Label ca;  
 #endif  
 #if defined(i386) && defined(DIRECT_THREADED)  
 #       define NEXT_P1  
 #       define NEXT1 ({goto *cfa;})  
 #else  #else
 #       define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})  #define NEXT1_P2 ({goto **cfa;})
 #       define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})  #endif /* DIRECT_THREADED */
 #endif  #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;})
   #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 NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})  #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
   #define NEXT ({DEF_CA NEXT_P1; NEXT_P2;})
   
 #ifdef USE_TOS  #ifdef USE_TOS
 #define IF_TOS(x) x  #define IF_TOS(x) x
Line 79  typedef struct F83Name { Line 127  typedef struct F83Name {
 #define FTOS (fp[0])  #define FTOS (fp[0])
 #endif  #endif
   
   Cell *SP;
   Float *FP;
 int emitcounter;  int emitcounter;
 #define NULLC '\0'  #define NULLC '\0'
   
 #ifdef copycstr  char *cstr(Char *from, UCell size, int clear)
 #   define cstr(to,from,size)\  /* if clear is true, scratch can be reused, otherwise we want more of
         {       memcpy(to,from,size);\     the same */
                 to[size]=NULLC;}  {
 #else    static char *scratch=NULL;
 char scratch[1024];    static unsigned scratchsize=0;
 int soffset;    static char *nextscratch;
 #   define cstr(from,size) \    char *oldnextscratch;
            ({ char * to = scratch; \  
               memcpy(to,from,size); \    if (clear)
               to[size] = NULLC; \      nextscratch=scratch;
               soffset = size+1; \    if (scratch==NULL) {
               to; \      scratch=malloc(size+1);
            })      nextscratch=scratch;
 #   define cstr1(from,size) \      scratchsize=size;
            ({ char * to = scratch+soffset; \    }
               memcpy(to,from,size); \    else if (nextscratch+size>scratch+scratchsize) {
               to[size] = NULLC; \      char *oldscratch=scratch;
               soffset += size+1; \      scratch = realloc(scratch, (nextscratch-scratch)+size+1);
               to; \      nextscratch=scratch+(nextscratch-oldscratch);
            })      scratchsize=size;
 #endif    }
     memcpy(nextscratch,from,size);
     nextscratch[size]='\0';
     oldnextscratch = nextscratch;
     nextscratch += size+1;
     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; i<size && from[i]!='/'; i++)
         ;
       {
         char user[i];
         memcpy(user,from+1,i-1);
         user[i-1]='\0';
         user_entry=getpwnam(user);
       }
       if (user_entry==NULL)
         return cstr(from, size, clear);
       s1 = user_entry->pw_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'  #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;  static Address up0=NULL;
   
 #if defined(i386) && defined(FORCE_REG)  /* if machine.h has not defined explicit registers, define them as implicit */
 #  define REG(reg) __asm__(reg)  #ifndef IPREG
   #define IPREG
 Label *engine(Xt *ip0, Cell *sp0, Cell *rp, Float *fp, Address lp)  #endif
 {  #ifndef SPREG
    register Xt *ip REG("%esi")=ip0;  #define SPREG
    register Cell *sp REG("%edi")=sp0;  
   
 #else  
 #  define REG(reg)  
   
 Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)  
 {  
 #endif  #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  /* executes code at ip, if ip!=NULL
    returns array of machine code labels (for use in a loader), if ip==NULL     returns array of machine code labels (for use in a loader), if ip==NULL
 */  */
   register Xt cfa  {
 #ifdef i386    register Xt *ip IPREG = ip0;
 #  ifdef USE_TOS    register Cell *sp SPREG = sp0;
    REG("%ecx")    register Cell *rp RPREG = rp0;
 #  else    register Float *fp FPREG = fp0;
    REG("%edx")    register Address lp LPREG = lp0;
 #  endif    register Xt cfa CFAREG;
 #endif    register Address up UPREG = up0;
    ;    IF_TOS(register Cell TOS TOSREG;)
   Address up=up0;    IF_FTOS(register Float FTOS FTOSREG;)
   static Label symbols[]= {    static Label symbols[]= {
     &&docol,      &&docol,
     &&docon,      &&docon,
     &&dovar,      &&dovar,
     &&douser,      &&douser,
     &&dodefer,      &&dodefer,
       &&dostruc,
     &&dodoes,      &&dodoes,
     &&dodoes,  /* dummy for does handler address */      &&dodoes,  /* dummy for does handler address */
 #include "prim_labels.i"  #include "prim_labels.i"
   };    };
   IF_TOS(register Cell TOS;)  
   IF_FTOS(Float FTOS;)  
 #ifdef CPU_DEP  #ifdef CPU_DEP
   CPU_DEP;    CPU_DEP;
 #endif  #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)    if (ip == NULL)
     return symbols;      return symbols;
   
   IF_TOS(TOS = sp[0]);    IF_TOS(TOS = sp[0]);
   IF_FTOS(FTOS = fp[0]);    IF_FTOS(FTOS = fp[0]);
   prep_terminal();    prep_terminal();
     NEXT_P0;
   NEXT;    NEXT;
       
  docol:   docol:
 #ifdef DEBUG  #ifdef DEBUG
   printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
 #ifdef i386  #ifdef CISC_NEXT
   /* this is the simple version */    /* this is the simple version */
   *--rp = (Cell)ip;    *--rp = (Cell)ip;
   ip = (Xt *)PFA1(cfa);    ip = (Xt *)PFA1(cfa);
     NEXT_P0;
   NEXT;    NEXT;
 #endif  #else
   /* this one is important, so we help the compiler optimizing    /* this one is important, so we help the compiler optimizing
      The following version may be better (for scheduling), but probably has       The following version may be better (for scheduling), but probably has
      problems with code fields employing calls and delay slots       problems with code fields employing calls and delay slots
Line 186  Label *engine(Xt *ip, Cell *sp, Cell *rp Line 309  Label *engine(Xt *ip, Cell *sp, Cell *rp
     ip = current_ip+1;      ip = current_ip+1;
     NEXT1_P2;      NEXT1_P2;
   }    }
     #endif
   
  docon:   docon:
 #ifdef DEBUG  #ifdef DEBUG
   printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));    fprintf(stderr,"%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
   *sp-- = TOS;    *sp-- = TOS;
Line 197  Label *engine(Xt *ip, Cell *sp, Cell *rp Line 321  Label *engine(Xt *ip, Cell *sp, Cell *rp
 #else  #else
   *--sp = *(Cell *)PFA1(cfa);    *--sp = *(Cell *)PFA1(cfa);
 #endif  #endif
     NEXT_P0;
   NEXT;    NEXT;
       
  dovar:   dovar:
 #ifdef DEBUG  #ifdef DEBUG
   printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
   *sp-- = TOS;    *sp-- = TOS;
Line 209  Label *engine(Xt *ip, Cell *sp, Cell *rp Line 334  Label *engine(Xt *ip, Cell *sp, Cell *rp
 #else  #else
   *--sp = (Cell)PFA1(cfa);    *--sp = (Cell)PFA1(cfa);
 #endif  #endif
     NEXT_P0;
   NEXT;    NEXT;
       
   /* !! user? */  
     
  douser:   douser:
 #ifdef DEBUG  #ifdef DEBUG
   printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
   *sp-- = TOS;    *sp-- = TOS;
Line 223  Label *engine(Xt *ip, Cell *sp, Cell *rp Line 347  Label *engine(Xt *ip, Cell *sp, Cell *rp
 #else  #else
   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));    *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
 #endif  #endif
     NEXT_P0;
   NEXT;    NEXT;
       
  dodefer:   dodefer:
 #ifdef DEBUG  #ifdef DEBUG
   printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
   cfa = *(Xt *)PFA1(cfa);    cfa = *(Xt *)PFA1(cfa);
   NEXT1;    NEXT1;
   
    dostruc:
   #ifdef DEBUG
     fprintf(stderr,"%08x: struc: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
   #endif
     TOS += *(Cell*)PFA1(cfa); 
     NEXT_P0;
     NEXT;
   
  dodoes:   dodoes:
   /* this assumes the following structure:    /* this assumes the following structure:
      defining-word:       defining-word:
Line 251  Label *engine(Xt *ip, Cell *sp, Cell *rp Line 384  Label *engine(Xt *ip, Cell *sp, Cell *rp
             
      */       */
 #ifdef DEBUG  #ifdef DEBUG
   printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));    fprintf(stderr,"%08x/%08x: does: %08x\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));
   fflush(stdout);    fflush(stderr);
 #endif  #endif
   *--rp = (Cell)ip;    *--rp = (Cell)ip;
   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */    /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
Line 263  Label *engine(Xt *ip, Cell *sp, Cell *rp Line 396  Label *engine(Xt *ip, Cell *sp, Cell *rp
 #else  #else
   *--sp = (Cell)PFA(cfa);    *--sp = (Cell)PFA(cfa);
 #endif  #endif
     NEXT_P0;
   NEXT;    NEXT;
     
 #include "primitives.i"  #include "primitives.i"
 }  }

Removed from v.1.13  
changed lines
  Added in v.1.27


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>