Diff for /gforth/engine/engine.c between versions 1.33 and 1.40

version 1.33, 2001/12/09 19:12:46 version 1.40, 2002/02/04 21:25:18
Line 19 Line 19
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 */  */
   
   undefine(`symbols')
   
 #include "config.h"  #include "config.h"
 #include "forth.h"  #include "forth.h"
 #include <ctype.h>  #include <ctype.h>
Line 280  static int ufileattr[6]= { Line 282  static int ufileattr[6]= {
 # define CPU_DEP1 0  # define CPU_DEP1 0
 #endif  #endif
   
 /* declare and compute cfa for certain threading variants */  
 /* warning: this is nonsyntactical; it will not work in place of a statement */  
 #ifndef GETCFA  
 #define DOCFA  
 #else  
 #define DOCFA   Xt cfa; GETCFA(cfa)  
 #endif  
   
 /* instructions containing these must be the last instruction of a  /* instructions containing these must be the last instruction of a
    super-instruction (e.g., branches, EXECUTE, and other instructions     super-instruction (e.g., branches, EXECUTE, and other instructions
    ending the basic block). Instructions containing SET_IP get this     ending the basic block). Instructions containing SET_IP get this
Line 300  static int ufileattr[6]= { Line 294  static int ufileattr[6]= {
 #else  #else
 #define SUPER_END  #define SUPER_END
 #endif  #endif
   #define SUPER_CONTINUE
   
 #ifdef GFORTH_DEBUGGING  #ifdef GFORTH_DEBUGGING
 /* define some VM registers as global variables, so they survive exceptions;  /* define some VM registers as global variables, so they survive exceptions;
Line 309  Xt *ip; Line 304  Xt *ip;
 Cell *rp;  Cell *rp;
 #endif  #endif
   
   #ifdef DEBUG
   #define CFA_TO_NAME(__cfa) \
         Cell len, i; \
         char * name = __cfa; \
         for(i=0; i<32; i+=sizeof(Cell)) { \
           len = ((Cell*)name)[-1]; \
           if(len < 0) { \
             len &= 0x1F; \
             if((len+sizeof(Cell)) > i) break; \
           } len = 0; \
           name -= sizeof(Cell); \
         }
   #endif
   
 Xt *primtable(Label symbols[], Cell size)  Xt *primtable(Label symbols[], Cell size)
        /* used in primitive primtable for peephole optimization */
 {  {
 #ifdef DIRECT_THREADED  
   return symbols;  
 #else /* !defined(DIRECT_THREADED) */  
   Xt *xts = (Xt *)malloc(size*sizeof(Xt));    Xt *xts = (Xt *)malloc(size*sizeof(Xt));
   Cell i;    Cell i;
   
   for (i=0; i<size; i++)    for (i=0; i<size; i++)
     xts[i] = &symbols[i];      xts[i] = &symbols[i];
   return xts;    return xts;
 #endif /* !defined(DIRECT_THREADED) */  
 }  }
   
 Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)  
   define(enginerest,
   `(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 335  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 343  Label *engine(Xt *ip0, Cell *sp0, Cell *
   register Cell *sp SPREG = sp0;    register Cell *sp SPREG = sp0;
   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  
 #ifdef MORE_VARS  #ifdef MORE_VARS
   MORE_VARS    MORE_VARS
 #endif  #endif
Line 360  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 366  Label *engine(Xt *ip0, Cell *sp0, Cell *
     (Label)&&dofield,      (Label)&&dofield,
     (Label)&&dodoes,      (Label)&&dodoes,
     /* the following entry is normally unused;      /* the following entry is normally unused;
        it's there because its index indicates a does-handler */         it is there because its index indicates a does-handler */
     CPU_DEP1,      CPU_DEP1,
   #define INST_ADDR(name) (Label)&&I_##name
   #include "prim_lab.i"
   #undef INST_ADDR
       (Label)&&after_last,
       (Label)0,
   #ifdef IN_ENGINE2
   #define INST_ADDR(name) (Label)&&J_##name
 #include "prim_lab.i"  #include "prim_lab.i"
     (Label)0  #undef INST_ADDR
   #endif
   };    };
 #ifdef CPU_DEP2  #ifdef CPU_DEP2
   CPU_DEP2    CPU_DEP2
Line 379  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 393  Label *engine(Xt *ip0, Cell *sp0, Cell *
   
   if (ip == NULL) {    if (ip == NULL) {
 #if defined(DOUBLY_INDIRECT)  #if defined(DOUBLY_INDIRECT)
 #define CODE_OFFSET (22*sizeof(Cell))  #define CODE_OFFSET (26*sizeof(Cell))
   #define XT_OFFSET (22*sizeof(Cell))
     int i;      int i;
     Cell code_offset = offset_image? CODE_OFFSET : 0;      Cell code_offset = offset_image? CODE_OFFSET : 0;
       Cell xt_offset = offset_image? XT_OFFSET : 0;
   
     symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset);      symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset);
       xts = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+XT_OFFSET)+xt_offset);
     for (i=0; i<DOESJUMP+1; i++)      for (i=0; i<DOESJUMP+1; i++)
       symbols[i] = (Label)routines[i];        xts[i] = symbols[i] = (Label)routines[i];
     for (; routines[i]!=0; i++) {      for (; routines[i]!=0; i++) {
       if (i>=MAX_SYMBOLS) {        if (i>=MAX_SYMBOLS) {
         fprintf(stderr,"gforth-ditc: more than %d primitives\n",MAX_SYMBOLS);          fprintf(stderr,"gforth-ditc: more than %d primitives\n",MAX_SYMBOLS);
         exit(1);          exit(1);
       }        }
       symbols[i] = &routines[i];        xts[i] = symbols[i] = &routines[i];
     }      }
 #endif /* defined(DOUBLY_INDIRECT) */  #endif /* defined(DOUBLY_INDIRECT) */
     return symbols;      return symbols;
Line 411  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 428  Label *engine(Xt *ip0, Cell *sp0, Cell *
       
  docol:   docol:
   {    {
     DOCFA;  
 #ifdef DEBUG  #ifdef DEBUG
     fprintf(stderr,"%08lx: col: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));      {
         CFA_TO_NAME(cfa);
         fprintf(stderr,"%08lx: col: %08lx %.*s\n",(Cell)ip,(Cell)PFA1(cfa),
                 len,name);
       }
 #endif  #endif
 #ifdef CISC_NEXT  #ifdef CISC_NEXT
     /* this is the simple version */      /* this is the simple version */
Line 437  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 457  Label *engine(Xt *ip0, Cell *sp0, Cell *
   
  docon:   docon:
   {    {
     DOCFA;  
 #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
Line 453  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 472  Label *engine(Xt *ip0, Cell *sp0, Cell *
       
  dovar:   dovar:
   {    {
     DOCFA;  
 #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
Line 469  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 487  Label *engine(Xt *ip0, Cell *sp0, Cell *
       
  douser:   douser:
   {    {
     DOCFA;  
 #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
Line 485  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 502  Label *engine(Xt *ip0, Cell *sp0, Cell *
       
  dodefer:   dodefer:
   {    {
     DOCFA;  
 #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
Line 495  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 511  Label *engine(Xt *ip0, Cell *sp0, Cell *
   
  dofield:   dofield:
   {    {
     DOCFA;  
 #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
Line 523  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 538  Label *engine(Xt *ip0, Cell *sp0, Cell *
             
      */       */
   {    {
     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));*/
 #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));
Line 544  Label *engine(Xt *ip0, Cell *sp0, Cell * Line 557  Label *engine(Xt *ip0, Cell *sp0, Cell *
   }    }
   NEXT;    NEXT;
   
   #ifndef IN_ENGINE2
 #define LABEL(name) I_##name  #define LABEL(name) I_##name
   #else
   #define LABEL(name) J_##name: asm(".skip 16"); I_##name
   #endif
 #include "prim.i"  #include "prim.i"
 }  #undef LABEL
     after_last: return (Label *)0;
     /*needed only to get the length of the last primitive */
   }'
   )
   
   Label *engine enginerest
   
   #define IN_ENGINE2
   Label *engine2 enginerest
   

Removed from v.1.33  
changed lines
  Added in v.1.40


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