Diff for /gforth/engine/main.c between versions 1.69 and 1.70

version 1.69, 2002/11/10 11:24:08 version 1.70, 2002/11/24 13:54:01
Line 193  void relocate(Cell *image, const char *b Line 193  void relocate(Cell *image, const char *b
                 image[i]=(Cell)CFA(CF(token));                  image[i]=(Cell)CFA(CF(token));
 #ifdef DIRECT_THREADED  #ifdef DIRECT_THREADED
                 if ((token & 0x4000) == 0) /* threade code, no CFA */                  if ((token & 0x4000) == 0) /* threade code, no CFA */
                   image[i] = (Cell)compile_prim((Label)image[i]);                    compile_prim1(&image[i]);
 #endif  #endif
               } else                } else
                 fprintf(stderr,"Primitive %d used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n",CF(token),(long)&image[i],VERSION);                  fprintf(stderr,"Primitive %d used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n",CF(token),(long)&image[i],VERSION);
Line 207  void relocate(Cell *image, const char *b Line 207  void relocate(Cell *image, const char *b
       }        }
     }      }
   }    }
     finish_code();
   ((ImageHeader*)(image))->base = (Address) image;    ((ImageHeader*)(image))->base = (Address) image;
 }  }
   
Line 441  void print_sizes(Cell sizebyte) Line 442  void print_sizes(Cell sizebyte)
           1 << ((sizebyte >> 5) & 3));            1 << ((sizebyte >> 5) & 3));
 }  }
   
   #define MAX_IMMARGS 2
   
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
 typedef struct {  typedef struct {
   Label start;    Label start;
   Cell length; /* excluding the jump */    Cell length; /* excluding the jump */
   char super_end; /* true if primitive ends superinstruction, i.e.,    char superend; /* true if primitive ends superinstruction, i.e.,
                      unconditional branch, execute, etc. */                       unconditional branch, execute, etc. */
     Cell nimmargs;
     struct immarg {
       Cell offset; /* offset of immarg within prim */
       char rel;    /* true if immarg is relative */
     } immargs[MAX_IMMARGS];
 } PrimInfo;  } PrimInfo;
   
 PrimInfo *priminfos;  PrimInfo *priminfos;
 #endif /* defined(NO_DYNAMIC) */  #endif /* defined(NO_DYNAMIC) */
 Cell npriminfos=0;  Cell npriminfos=0;
   
   
 void check_prims(Label symbols1[])  void check_prims(Label symbols1[])
 {  {
   int i;    int i;
   Label *symbols2;    Label *symbols2, *symbols3, *ends1;
   static char superend[]={    static char superend[]={
 #include "prim_superend.i"  #include "prim_superend.i"
   };    };
Line 473  void check_prims(Label symbols1[]) Line 480  void check_prims(Label symbols1[])
   for (i=DOESJUMP+1; symbols1[i+1]!=0; i++)    for (i=DOESJUMP+1; symbols1[i+1]!=0; i++)
     ;      ;
   npriminfos = i;    npriminfos = i;
     
 #if defined(IS_NEXT_JUMP) && !defined(NO_DYNAMIC)  #ifndef NO_DYNAMIC
   if (no_dynamic)    if (no_dynamic)
     return;      return;
   symbols2=engine2(0,0,0,0,0);    symbols2=engine2(0,0,0,0,0);
   #if NO_IP
     symbols3=engine3(0,0,0,0,0);
   #else
     symbols3=symbols1;
   #endif
     ends1 = symbols1+i+1-DOESJUMP;
   priminfos = calloc(i,sizeof(PrimInfo));    priminfos = calloc(i,sizeof(PrimInfo));
   for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) {    for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) {
     int prim_len=symbols1[i+1]-symbols1[i];      int prim_len = ends1[i]-symbols1[i];
     PrimInfo *pi=&priminfos[i];      PrimInfo *pi=&priminfos[i];
     int j;      int j=0;
     pi->super_end = superend[i-DOESJUMP-1]|no_super;      char *s1 = (char *)symbols1[i];
     for (j=prim_len-IND_JUMP_LENGTH; ; j--) {      char *s2 = (char *)symbols2[i];
       if (IS_NEXT_JUMP(symbols1[i]+j)) {      char *s3 = (char *)symbols3[i];
         prim_len = j;  
         if (pi->super_end)      pi->start = s1;
           prim_len += IND_JUMP_LENGTH; /* include the jump */      pi->superend = superend[i-DOESJUMP-1]|no_super;
         break;      if (pi->superend)
       }        pi->length = symbols1[i+1]-symbols1[i];
       if (j==0) { /* NEXT jump not found, e.g., execute */      else
         if (!pi->super_end && debug)        pi->length = prim_len;
           fprintf(stderr, "NEXT jump not found for primitive %d, making it super_end\n", i);      pi->nimmargs = 0;
         pi->super_end = 1;      if (debug)
         break;        fprintf(stderr, "Prim %3d @ %p %p %p, length=%3d superend=%1d",
                 i, s1, s2, s3, prim_len, pi->superend);
       assert(prim_len>=0);
       while (j<prim_len) {
         if (s1[j]==s3[j]) {
           if (s1[j] != s2[j]) {
             pi->start = NULL; /* not relocatable */
             if (debug)
               fprintf(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);
             break;
           }
           j++;
         } else {
           struct immarg *ia=&pi->immargs[pi->nimmargs];
   
           pi->nimmargs++;
           ia->offset=j;
           if ((~*(Cell *)&(s1[j]))==*(Cell *)&(s3[j])) {
             ia->rel=0;
             if (debug)
               fprintf(stderr,"\n   absolute immarg: offset %3d",j);
           } else if ((&(s1[j]))+(*(Cell *)&(s1[j]))+4 ==
                      symbols1[DOESJUMP+1]) {
             ia->rel=1;
             if (debug)
               fprintf(stderr,"\n   relative immarg: offset %3d",j);
           } else {
             pi->start = NULL; /* not relocatable */
             if (debug)
               fprintf(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);
             break;
           }
           j+=4;
       }        }
     }      }
     pi->length = prim_len;      if (debug)
     /* fprintf(stderr,"checking primitive %d: memcmp(%p, %p, %d)\n",        fprintf(stderr,"\n");
        i, symbols1[i], symbols2[i], prim_len);*/    }
     if (memcmp(symbols1[i],symbols2[i],prim_len)!=0) {  
       if (debug)  
         fprintf(stderr,"Primitive %d not relocatable: memcmp(%p, %p, %d)\n",  
                 i, symbols1[i], symbols2[i], prim_len);  
     } else {  
       pi->start = symbols1[i];  
       if (debug)  
         fprintf(stderr,"Primitive %d relocatable: start %p, length %ld, super_end %d\n",  
                 i, pi->start, pi->length, pi->super_end);  
     }        
   }    
 #endif  #endif
 }  }
   
 Label compile_prim(Label prim)  #ifdef NO_IP
   int nbranchinfos=0;
   
   struct branchinfo {
     Label *targetptr; /* *(bi->targetptr) is the target */
     Cell *addressptr; /* store the target here */
   } branchinfos[100000];
   
   int ndoesexecinfos=0;
   struct doesexecinfo {
     int branchinfo; /* fix the targetptr of branchinfos[...->branchinfo] */
     Cell *xt; /* cfa of word whose does-code needs calling */
   } doesexecinfos[10000];
   
   #define N_EXECUTE 10
   #define N_PERFORM 11
   #define N_LIT_PERFORM 337
   #define N_CALL 333
   #define N_DOES_EXEC 339
   #define N_LIT 9
   #define N_CALL2 362
   #define N_ABRANCH 341
   #define N_SET_NEXT_CODE 361
   
   void set_rel_target(Cell *source, Label target)
   {
     *source = ((Cell)target)-(((Cell)source)+4);
   }
   
   void register_branchinfo(Label source, Cell targetptr)
   {
     struct branchinfo *bi = &(branchinfos[nbranchinfos]);
     bi->targetptr = (Label *)targetptr;
     bi->addressptr = (Cell *)source;
     nbranchinfos++;
   }
   
   Cell *compile_prim1arg(Cell p)
   {
     int l = priminfos[p].length;
     Address old_code_here=code_here;
   
     memcpy(code_here, vm_prims[p], l);
     code_here+=l;
     return (Cell*)(old_code_here+priminfos[p].immargs[0].offset);
   }
   
   Cell *compile_call2(Cell targetptr)
   {
     Cell *next_code_target;
     PrimInfo *pi = &priminfos[N_CALL2];
   
     memcpy(code_here, pi->start, pi->length);
     next_code_target = (Cell *)(code_here + pi->immargs[0].offset);
     register_branchinfo(code_here + pi->immargs[1].offset, targetptr);
     code_here += pi->length;
     return next_code_target;
   }
   #endif
   
   void finish_code(void)
   {
   #ifdef NO_IP
     Cell i;
   
     compile_prim1(NULL);
     for (i=0; i<ndoesexecinfos; i++) {
       struct doesexecinfo *dei = &doesexecinfos[i];
       branchinfos[dei->branchinfo].targetptr = DOES_CODE1((dei->xt));
     }
     ndoesexecinfos = 0;
     for (i=0; i<nbranchinfos; i++) {
       struct branchinfo *bi=&branchinfos[i];
       set_rel_target(bi->addressptr, *(bi->targetptr));
     }
     nbranchinfos = 0;
     FLUSH_ICACHE(start_flush, code_here-start_flush);
     start_flush=code_here;
   #endif
   }
   
   void compile_prim1(Cell *start)
 {  {
 #if defined(DOUBLY_INDIRECT)  #if defined(DOUBLY_INDIRECT)
     Label prim=(Label)*start;
   if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) {    if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) {
     fprintf(stderr,"compile_prim encountered xt %p\n", prim);      fprintf(stderr,"compile_prim encountered xt %p\n", prim);
     return prim;      *start=(Cell)prim;
   } else      return;
     return prim-((Label)xts)+((Label)vm_prims);    } else {
 #elif defined(IND_JUMP_LENGTH) && !defined(NO_DYNAMIC)      *start = prim-((Label)xts)+((Label)vm_prims);
       return;
     }
   #elif defined(NO_IP)
     static Cell *last_start=NULL;
     static Xt last_prim=NULL;
     /* delay work by one call in order to get relocated immargs */
   
     if (last_start) {
       unsigned i = last_prim-vm_prims;
       PrimInfo *pi=&priminfos[i];
       Cell *next_code_target=NULL;
   
       assert(i<npriminfos);
       if (i==N_EXECUTE||i==N_PERFORM||i==N_LIT_PERFORM) {
         next_code_target = compile_prim1arg(N_SET_NEXT_CODE);
       }
       if (i==N_CALL) {
         next_code_target = compile_call2(last_start[1]);
       } else if (i==N_DOES_EXEC) {
         struct doesexecinfo *dei = &doesexecinfos[ndoesexecinfos++];
         *compile_prim1arg(N_LIT) = (Cell)PFA(last_start[1]);
         /* we cannot determine the callee now (last_start[1] may be a
            forward reference), so just register an arbitrary target, and
            register in dei that we need to fix this before resolving
            branches */
         dei->branchinfo = nbranchinfos;
         dei->xt = (Cell *)(last_start[1]);
         next_code_target = compile_call2(NULL);
       } else if (pi->start == NULL) { /* non-reloc */
         next_code_target = compile_prim1arg(N_SET_NEXT_CODE);
         set_rel_target(compile_prim1arg(N_ABRANCH),*(Xt)last_prim);
       } else {
         unsigned j;
   
         memcpy(code_here, *last_prim, pi->length);
         for (j=0; j<pi->nimmargs; j++) {
           struct immarg *ia = &(pi->immargs[j]);
           Cell argval = last_start[pi->nimmargs - j]; /* !! specific to prims */
           if (ia->rel) { /* !! assumption: relative refs are branches */
             register_branchinfo(code_here + ia->offset, argval);
           } else /* plain argument */
             *(Cell *)(code_here + ia->offset) = argval;
         }
         code_here += pi->length;
       }
       if (next_code_target!=NULL)
         *next_code_target = (Cell)code_here;
     }
     if (start) {
       last_prim = (Xt)*start;
       *start = (Cell)code_here;
     }
     last_start = start;
     return;
   #elif !defined(NO_DYNAMIC)
     Label prim=(Label)*start;
   unsigned i;    unsigned i;
   Address old_code_here=code_here;    Address old_code_here=code_here;
   static Address last_jump=0;    static Address last_jump=0;
   
   i = ((Xt)prim)-vm_prims;    i = ((Xt)prim)-vm_prims;
   prim = *(Xt)prim;    prim = *(Xt)prim;
   if (no_dynamic)    if (no_dynamic) {
     return prim;      *start = (Cell)prim;
       return;
     }
   if (i>=npriminfos || priminfos[i].start == 0) { /* not a relocatable prim */    if (i>=npriminfos || priminfos[i].start == 0) { /* not a relocatable prim */
     if (last_jump) { /* make sure the last sequence is complete */      if (last_jump) { /* make sure the last sequence is complete */
       memcpy(code_here, last_jump, IND_JUMP_LENGTH);        memcpy(code_here, last_jump, IND_JUMP_LENGTH);
Line 540  Label compile_prim(Label prim) Line 714  Label compile_prim(Label prim)
       FLUSH_ICACHE(start_flush, code_here-start_flush);        FLUSH_ICACHE(start_flush, code_here-start_flush);
       start_flush=code_here;        start_flush=code_here;
     }      }
     return prim;      *start = (Cell)prim;
       return;
   }    }
   assert(priminfos[i].start = prim);     assert(priminfos[i].start = prim); 
 #ifdef ALIGN_CODE  #ifdef ALIGN_CODE
Line 548  Label compile_prim(Label prim) Line 723  Label compile_prim(Label prim)
 #endif  #endif
   memcpy(code_here, (Address)prim, priminfos[i].length);    memcpy(code_here, (Address)prim, priminfos[i].length);
   code_here += priminfos[i].length;    code_here += priminfos[i].length;
   last_jump = (priminfos[i].super_end) ? 0 : (prim+priminfos[i].length);    last_jump = (priminfos[i].superend) ? 0 : (prim+priminfos[i].length);
   if (last_jump == 0) {    if (last_jump == 0) {
     FLUSH_ICACHE(start_flush, code_here-start_flush);      FLUSH_ICACHE(start_flush, code_here-start_flush);
     start_flush=code_here;      start_flush=code_here;
   }    }
   return (Label)old_code_here;    *start = (Cell)old_code_here;
     return;
 #else /* !defined(DOUBLY_INDIRECT), no code replication */  #else /* !defined(DOUBLY_INDIRECT), no code replication */
     Label prim=(Label)*start;
 #if !defined(INDIRECT_THREADED)  #if !defined(INDIRECT_THREADED)
   prim = *(Xt)prim;    prim = *(Xt)prim;
 #endif  #endif
   return prim;    *start = (Cell)prim;
     return;
 #endif /* !defined(DOUBLY_INDIRECT) */  #endif /* !defined(DOUBLY_INDIRECT) */
 }  }
   
   Label compile_prim(Label prim)
   {
     Cell x=(Cell)prim;
     compile_prim1(&x);
     return (Label)x;
   }
   
 #if defined(PRINT_SUPER_LENGTHS) && !defined(NO_DYNAMIC)  #if defined(PRINT_SUPER_LENGTHS) && !defined(NO_DYNAMIC)
 Cell prim_length(Cell prim)  Cell prim_length(Cell prim)
 {  {

Removed from v.1.69  
changed lines
  Added in v.1.70


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