Diff for /gforth/engine/engine.c between versions 1.37 and 1.44

version 1.37, 2002/01/04 20:31:54 version 1.44, 2002/08/28 17:50:29
Line 215  static int ufileattr[6]= { Line 215  static int ufileattr[6]= {
   
 /* conversion on fetch */  /* conversion on fetch */
   
 #define vm_Cell2f(x)            ((Bool)(x))  #define vm_Cell2f(_cell,_x)             ((_x)=(Bool)(_cell))
 #define vm_Cell2c(x)            ((Char)(x))  #define vm_Cell2c(_cell,_x)             ((_x)=(Char)(_cell))
 #define vm_Cell2n(x)            ((Cell)x)  #define vm_Cell2n(_cell,_x)             ((_x)=(Cell)(_cell))
 #define vm_Cell2w(x)            ((Cell)x)  #define vm_Cell2w(_cell,_x)             ((_x)=(Cell)(_cell))
 #define vm_Cell2u(x)            ((UCell)(x))  #define vm_Cell2u(_cell,_x)             ((_x)=(UCell)(_cell))
 #define vm_Cell2a_(x)           ((Cell *)(x))  #define vm_Cell2a_(_cell,_x)            ((_x)=(Cell *)(_cell))
 #define vm_Cell2c_(x)           ((Char *)(x))  #define vm_Cell2c_(_cell,_x)            ((_x)=(Char *)(_cell))
 #define vm_Cell2f_(x)           ((Float *)(x))  #define vm_Cell2f_(_cell,_x)            ((_x)=(Float *)(_cell))
 #define vm_Cell2df_(x)          ((DFloat *)(x))  #define vm_Cell2df_(_cell,_x)           ((_x)=(DFloat *)(_cell))
 #define vm_Cell2sf_(x)          ((SFloat *)(x))  #define vm_Cell2sf_(_cell,_x)           ((_x)=(SFloat *)(_cell))
 #define vm_Cell2xt(x)           ((Xt)(x))  #define vm_Cell2xt(_cell,_x)            ((_x)=(Xt)(_cell))
 #define vm_Cell2f83name(x)      ((struct F83Name *)(x))  #define vm_Cell2f83name(_cell,_x)       ((_x)=(struct F83Name *)(_cell))
 #define vm_Cell2longname(x)     ((struct Longname *)(x))  #define vm_Cell2longname(_cell,_x)      ((_x)=(struct Longname *)(_cell))
 #define vm_Float2r(x)   (x)  #define vm_Float2r(_float,_x)           (_x=_float)
   
 /* conversion on store */  /* conversion on store */
   
 #define vm_f2Cell(x)            ((Cell)(x))  #define vm_f2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_c2Cell(x)            ((Cell)(x))  #define vm_c2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_n2Cell(x)            ((Cell)(x))  #define vm_n2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_w2Cell(x)            ((Cell)(x))  #define vm_w2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_u2Cell(x)            ((Cell)(x))  #define vm_u2Cell(_x,_cell)             ((_cell)=(Cell)(_x))
 #define vm_a_2Cell(x)           ((Cell)(x))  #define vm_a_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
 #define vm_c_2Cell(x)           ((Cell)(x))  #define vm_c_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
 #define vm_f_2Cell(x)           ((Cell)(x))  #define vm_f_2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
 #define vm_df_2Cell(x)          ((Cell)(x))  #define vm_df_2Cell(_x,_cell)           ((_cell)=(Cell)(_x))
 #define vm_sf_2Cell(x)          ((Cell)(x))  #define vm_sf_2Cell(_x,_cell)           ((_cell)=(Cell)(_x))
 #define vm_xt2Cell(x)           ((Cell)(x))  #define vm_xt2Cell(_x,_cell)            ((_cell)=(Cell)(_x))
 #define vm_f83name2Cell(x)      ((Cell)(x))  #define vm_f83name2Cell(_x,_cell)       ((_cell)=(Cell)(_x))
 #define vm_longname2Cell(x)     ((Cell)(x))  #define vm_longname2Cell(_x,_cell)      ((_cell)=(Cell)(_x))
 #define vm_r2Float(x)   (x)  #define vm_r2Float(_x,_float)           (_float=_x)
   
 #define vm_Cell2Cell(x)         (x)  #define vm_Cell2Cell(_x,_y)             (_y=_x)
   
 /* if machine.h has not defined explicit registers, define them as implicit */  /* if machine.h has not defined explicit registers, define them as implicit */
 #ifndef IPREG  #ifndef IPREG
Line 282  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 308  static int ufileattr[6]= { Line 300  static int ufileattr[6]= {
 /* define some VM registers as global variables, so they survive exceptions;  /* define some VM registers as global variables, so they survive exceptions;
    global register variables are not up to the task (according to the      global register variables are not up to the task (according to the 
    GNU C manual) */     GNU C manual) */
 Xt *ip;  Xt *saved_ip;
 Cell *rp;  Cell *rp;
 #endif  #endif
   
Line 327  Cell *rp; Line 319  Cell *rp;
 #endif  #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) */  
 }  }
   
   
Line 348  define(enginerest, Line 337  define(enginerest,
 */  */
 {  {
 #ifndef GFORTH_DEBUGGING  #ifndef GFORTH_DEBUGGING
   register Xt *ip IPREG;  
   register Cell *rp RPREG;    register Cell *rp RPREG;
 #endif  #endif
     register Xt *ip IPREG;
   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 406  define(enginerest, Line 393  define(enginerest,
   
   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 438  define(enginerest, Line 428  define(enginerest,
       
  docol:   docol:
   {    {
     DOCFA;  
 #ifdef DEBUG  #ifdef DEBUG
     {      {
       CFA_TO_NAME(cfa);        CFA_TO_NAME(cfa);
Line 468  define(enginerest, Line 457  define(enginerest,
   
  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 484  define(enginerest, Line 472  define(enginerest,
       
  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 500  define(enginerest, Line 487  define(enginerest,
       
  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 516  define(enginerest, Line 502  define(enginerest,
       
  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 526  define(enginerest, Line 511  define(enginerest,
   
  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 554  define(enginerest, Line 538  define(enginerest,
             
      */       */
   {    {
     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 576  define(enginerest, Line 558  define(enginerest,
   NEXT;    NEXT;
   
 #ifndef IN_ENGINE2  #ifndef IN_ENGINE2
 #define LABEL(name) I_##name  #define LABEL(name) I_##name:
 #else  #else
 #define LABEL(name) J_##name: asm(".skip 16"); I_##name  #define LABEL(name) J_##name: asm(".skip 16"); I_##name:
 #endif  #endif
   #define LABEL2(name)
 #include "prim.i"  #include "prim.i"
 #undef LABEL  #undef LABEL
   after_last: return (Label *)0;    after_last: return (Label *)0;

Removed from v.1.37  
changed lines
  Added in v.1.44


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