[BACK]Return to engine.c CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/Attic/engine.c between versions 1.26 and 1.31

version 1.26, 1995/04/20 09:42:47 version 1.31, 1995/11/07 18:06:37
Line 1 Line 1
 /*  /* Gforth virtual machine (aka inner interpreter)
   Copyright 1992 by the ANSI figForth Development Group  
     Copyright (C) 1995 Free Software Foundation, Inc.
   
     This file is part of Gforth.
   
     Gforth is free software; you can redistribute it and/or
     modify it under the terms of the GNU General Public License
     as published by the Free Software Foundation; either version 2
     of the License, or (at your option) any later version.
   
     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     GNU General Public License for more details.
   
     You should have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */  */
   
 #include <ctype.h>  #include <ctype.h>
Line 15 Line 32
 #include <sys/time.h>  #include <sys/time.h>
 #include <unistd.h>  #include <unistd.h>
 #include <errno.h>  #include <errno.h>
   #include <pwd.h>
 #include "forth.h"  #include "forth.h"
 #include "io.h"  #include "io.h"
   #include "threading.h"
   
 #ifndef SEEK_SET  #ifndef SEEK_SET
 /* should be defined in stdio.h, but some systems don't have it */  /* should be defined in stdio.h, but some systems don't have it */
Line 49  typedef struct F83Name { Line 68  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)
   
 /* !!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_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;})  
 #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 ({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
 #else  #else
Line 160  char *cstr(Char *from, UCell size, int c Line 116  char *cstr(Char *from, UCell size, int c
   return oldnextscratch;    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  #ifndef HAVE_RINT
Line 209  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 206  Label *engine(Xt *ip0, Cell *sp0, Cell *
   register Cell *rp RPREG = rp0;    register Cell *rp RPREG = rp0;
   register Float *fp FPREG = fp0;    register Float *fp FPREG = fp0;
   register Address lp LPREG = lp0;    register Address lp LPREG = lp0;
   #ifdef CFA_NEXT
   register Xt cfa CFAREG;    register Xt cfa CFAREG;
   #endif
   register Address up UPREG = up0;    register Address up UPREG = up0;
   IF_TOS(register Cell TOS TOSREG;)    IF_TOS(register Cell TOS TOSREG;)
   IF_FTOS(register Float FTOS FTOSREG;)    IF_FTOS(register Float FTOS FTOSREG;)
Line 219  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 218  Label *engine(Xt *ip0, Cell *sp0, Cell *
     &&dovar,      &&dovar,
     &&douser,      &&douser,
     &&dodefer,      &&dodefer,
     &&dostruc,      &&dofield,
     &&dodoes,      &&dodoes,
     &&dodoes,  /* dummy for does handler address */      &&dodoes,  /* dummy for does handler address */
 #include "prim_labels.i"  #include "prim_labels.i"
Line 239  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 238  Label *engine(Xt *ip0, Cell *sp0, Cell *
   
   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_P0;
   NEXT;    NEXT;
       
  docol:   docol:
   #ifndef CFA_NEXT
     {
       Xt cfa; GETCFA(cfa);
   #endif
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08lx: col: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
 #ifdef CISC_NEXT  #ifdef CISC_NEXT
   /* this is the simple version */    /* this is the simple version */
Line 268  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 271  Label *engine(Xt *ip0, Cell *sp0, Cell *
     NEXT1_P2;      NEXT1_P2;
   }    }
 #endif  #endif
   #ifndef CFA_NEXT
     }
   #endif
   
  docon:   docon:
   #ifndef CFA_NEXT
     {
       Xt cfa; GETCFA(cfa);
   #endif
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));    fprintf(stderr,"%08lx: con: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
   *sp-- = TOS;    *sp-- = TOS;
Line 279  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 289  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #else  #else
   *--sp = *(Cell *)PFA1(cfa);    *--sp = *(Cell *)PFA1(cfa);
 #endif  #endif
   #ifndef CFA_NEXT
     }
   #endif
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
       
  dovar:   dovar:
   #ifndef CFA_NEXT
     {
       Xt cfa; GETCFA(cfa);
   #endif
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08lx: var: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
   *sp-- = TOS;    *sp-- = TOS;
Line 292  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 309  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #else  #else
   *--sp = (Cell)PFA1(cfa);    *--sp = (Cell)PFA1(cfa);
 #endif  #endif
   #ifndef CFA_NEXT
     }
   #endif
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
       
  douser:   douser:
   #ifndef CFA_NEXT
     {
       Xt cfa; GETCFA(cfa);
   #endif
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08lx: user: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
 #ifdef USE_TOS  #ifdef USE_TOS
   *sp-- = TOS;    *sp-- = TOS;
Line 305  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 329  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #else  #else
   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));    *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
 #endif  #endif
   #ifndef CFA_NEXT
     }
   #endif
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
       
  dodefer:   dodefer:
   #ifndef CFA_NEXT
     {
       Xt cfa; GETCFA(cfa);
   #endif
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
   #endif
     EXEC(*(Xt *)PFA1(cfa));
   #ifndef CFA_NEXT
     }
 #endif  #endif
   cfa = *(Xt *)PFA1(cfa);  
   NEXT1;  
   
  dostruc:   dofield:
   #ifndef CFA_NEXT
     {
       Xt cfa; GETCFA(cfa);
   #endif
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08x: struc: %08x\n",(Cell)ip,(Cell)PFA1(cfa));    fprintf(stderr,"%08lx: field: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif  #endif
   TOS += *(Cell*)PFA1(cfa);     TOS += *(Cell*)PFA1(cfa); 
   #ifndef CFA_NEXT
     }
   #endif
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
   
Line 341  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 381  Label *engine(Xt *ip0, Cell *sp0, Cell *
      pfa:       pfa:
             
      */       */
   #ifndef CFA_NEXT
     {
       Xt cfa; GETCFA(cfa);
   
   /*    fprintf(stderr, "Got CFA %08lx at doescode %08lx/%08lx: does: %08lx\n",cfa,(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));*/
   #endif
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08x/%08x: does: %08x\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));    fprintf(stderr,"%08lx/%08lx: does: %08lx\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));
   fflush(stderr);    fflush(stderr);
 #endif  #endif
   *--rp = (Cell)ip;    *--rp = (Cell)ip;
Line 354  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 400  Label *engine(Xt *ip0, Cell *sp0, Cell *
 #else  #else
   *--sp = (Cell)PFA(cfa);    *--sp = (Cell)PFA(cfa);
 #endif  #endif
   #ifndef CFA_NEXT
   /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", TOS, IP);*/
     }
   #endif
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
   
Removed from v.1.26  
changed lines
  Added in v.1.31

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