Diff for /gforth/Attic/engine.c between versions 1.30 and 1.32

version 1.30, 1995/10/26 22:48:39 version 1.32, 1995/12/10 19:02:07
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 179  static Address up0=NULL; Line 196  static Address up0=NULL;
 #define FTOSREG  #define FTOSREG
 #endif  #endif
   
   /* declare and compute cfa for certain threading variants */
   /* warning: this is nonsyntactical; it will not work in place of a statement */
   #ifdef CFA_NEXT
   #define DOCFA
   #else
   #define DOCFA   Xt cfa; GETCFA(cfa)
   #endif
   
 Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)  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
Line 203  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 228  Label *engine(Xt *ip0, Cell *sp0, Cell *
     &&dodefer,      &&dodefer,
     &&dofield,      &&dofield,
     &&dodoes,      &&dodoes,
     &&dodoes,  /* dummy for does handler address */      /* the following entry is normally unused;
          it's there because its index indicates a does-handler */
   #ifdef CPU_DEP1
       CPU_DEP1,
   #else
       (Label)0,
   #endif
 #include "prim_labels.i"  #include "prim_labels.i"
   };    };
 #ifdef CPU_DEP  #ifdef CPU_DEP2
   CPU_DEP;    CPU_DEP2
 #endif  #endif
   
 #ifdef DEBUG  #ifdef DEBUG
Line 224  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 255  Label *engine(Xt *ip0, Cell *sp0, Cell *
 /*  prep_terminal(); */  /*  prep_terminal(); */
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
   
   #ifdef CPU_DEP3
     CPU_DEP3
   #endif
       
  docol:   docol:
 #ifndef CFA_NEXT  
   {    {
     Xt cfa; GETCFA(cfa);      DOCFA;
 #endif  
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08lx: col: %08lx\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 */
   *--rp = (Cell)ip;  
   ip = (Xt *)PFA1(cfa);  
   NEXT_P0;  
   NEXT;  
 #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  
   */  
   {  
     DEF_CA  
     Xt *current_ip = (Xt *)PFA1(cfa);  
     cfa = *current_ip;  
     NEXT1_P1;  
     *--rp = (Cell)ip;      *--rp = (Cell)ip;
     ip = current_ip+1;      ip = (Xt *)PFA1(cfa);
     NEXT1_P2;      NEXT_P0;
   }      NEXT;
   #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
          */
       {
         DEF_CA
         Xt *current_ip = (Xt *)PFA1(cfa);
         cfa = *current_ip;
         NEXT1_P1;
         *--rp = (Cell)ip;
         ip = current_ip+1;
         NEXT1_P2;
       }
 #endif  #endif
 #ifndef CFA_NEXT  
   }    }
 #endif  
   
  docon:   docon:
 #ifndef CFA_NEXT  
   {    {
     Xt cfa; GETCFA(cfa);      DOCFA;
 #endif  
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08lx: con: %08lx\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;
   TOS = *(Cell *)PFA1(cfa);      TOS = *(Cell *)PFA1(cfa);
 #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);      DOCFA;
 #endif  
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08lx: var: %08lx\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;
   TOS = (Cell)PFA1(cfa);      TOS = (Cell)PFA1(cfa);
 #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);      DOCFA;
 #endif  
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08lx: user: %08lx\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;
   TOS = (Cell)(up+*(Cell*)PFA1(cfa));      TOS = (Cell)(up+*(Cell*)PFA1(cfa));
 #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);      DOCFA;
 #endif  
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));      fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
 #endif  #endif
   EXEC(*(Xt *)PFA1(cfa));      EXEC(*(Xt *)PFA1(cfa));
 #ifndef CFA_NEXT  
   }    }
 #endif  
   
  dofield:   dofield:
 #ifndef CFA_NEXT  
   {    {
     Xt cfa; GETCFA(cfa);      DOCFA;
 #endif  
 #ifdef DEBUG  #ifdef DEBUG
   fprintf(stderr,"%08lx: field: %08lx\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 364  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 375  Label *engine(Xt *ip0, Cell *sp0, Cell *
      pfa:       pfa:
             
      */       */
 #ifndef CFA_NEXT  
   {    {
     Xt cfa; GETCFA(cfa);      DOCFA;
   
 /*    fprintf(stderr, "Got CFA %08lx at doescode %08lx/%08lx: does: %08lx\n",cfa,(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(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,"%08lx/%08lx: does: %08lx\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;
   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */      /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
   ip = DOES_CODE1(cfa);      ip = DOES_CODE1(cfa);
 #ifdef USE_TOS  #ifdef USE_TOS
   *sp-- = TOS;      *sp-- = TOS;
   TOS = (Cell)PFA(cfa);      TOS = (Cell)PFA(cfa);
 #else  #else
   *--sp = (Cell)PFA(cfa);      *--sp = (Cell)PFA(cfa);
 #endif  #endif
 #ifndef CFA_NEXT      /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", TOS, IP);*/
 /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", TOS, IP);*/  
   }    }
 #endif  
   NEXT_P0;    NEXT_P0;
   NEXT;    NEXT;
   

Removed from v.1.30  
changed lines
  Added in v.1.32


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