[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.84 and 1.98

version 1.84, Fri Dec 27 17:19:34 2002 UTC version 1.98, Mon Jan 27 18:59:42 2003 UTC
Line 118 
Line 118 
 int optind = 1;  int optind = 1;
 #endif  #endif
   
 #define CODE_BLOCK_SIZE (64*1024)  #define CODE_BLOCK_SIZE (256*1024)
 Address code_area=0;  Address code_area=0;
 Cell code_area_size = CODE_BLOCK_SIZE;  Cell code_area_size = CODE_BLOCK_SIZE;
 Address code_here=NULL+CODE_BLOCK_SIZE; /* does for code-area what HERE  Address code_here=NULL+CODE_BLOCK_SIZE; /* does for code-area what HERE
Line 178 
Line 178 
  * If the word is <CF(DOESJUMP) and bit 14 is set, it's the xt of a primitive   * If the word is <CF(DOESJUMP) and bit 14 is set, it's the xt of a primitive
  * If the word is <CF(DOESJUMP) and bit 14 is clear,   * If the word is <CF(DOESJUMP) and bit 14 is clear,
  *                                        it's the threaded code of a primitive   *                                        it's the threaded code of a primitive
    * bits 13..9 of a primitive token state which group the primitive belongs to,
    * bits 8..0 of a primitive token index into the group
  */   */
   
   static Cell groups[32] = {
     0,
   #undef GROUP
   #define GROUP(x, n) DOESJUMP+1+n,
   #include "prim_grp.i"
   #undef GROUP
   #define GROUP(x, n)
   };
   
 void relocate(Cell *image, const char *bitstring,  void relocate(Cell *image, const char *bitstring,
               int size, int base, Label symbols[])                int size, Cell base, Label symbols[])
 {  {
   int i=0, j, k, steps=(size/sizeof(Cell))/RELINFOBITS;    int i=0, j, k, steps=(size/sizeof(Cell))/RELINFOBITS;
   Cell token;    Cell token;
   char bits;    char bits;
   Cell max_symbols;    Cell max_symbols;
   /*    /*
    * A virtial start address that's the real start address minus     * A virtual start address that's the real start address minus
    * the one in the image     * the one in the image
    */     */
   Cell *start = (Cell * ) (((void *) image) - ((void *) base));    Cell *start = (Cell * ) (((void *) image) - ((void *) base));
   
     /* group index into table */
   
 /* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */  /* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */
   
Line 207 
Line 219 
       if((i < size) && (bits & (1U << (RELINFOBITS-1)))) {        if((i < size) && (bits & (1U << (RELINFOBITS-1)))) {
         /* fprintf(stderr,"relocate: image[%d]=%d of %d\n", i, image[i], size/sizeof(Cell)); */          /* fprintf(stderr,"relocate: image[%d]=%d of %d\n", i, image[i], size/sizeof(Cell)); */
         token=image[i];          token=image[i];
         if(token<0)          if(token<0) {
           switch(token|0x4000)            int group = (-token & 0x3E00) >> 9;
             {            if(group == 0) {
               switch(token|0x4000) {
             case CF_NIL      : image[i]=0; break;              case CF_NIL      : image[i]=0; break;
 #if !defined(DOUBLY_INDIRECT)  #if !defined(DOUBLY_INDIRECT)
             case CF(DOCOL)   :              case CF(DOCOL)   :
Line 218 
Line 231 
             case CF(DOUSER)  :              case CF(DOUSER)  :
             case CF(DODEFER) :              case CF(DODEFER) :
             case CF(DOFIELD) : MAKE_CF(image+i,symbols[CF(token)]); break;              case CF(DOFIELD) : MAKE_CF(image+i,symbols[CF(token)]); break;
             case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;              case CF(DOESJUMP): image[i]=0; break;
 #endif /* !defined(DOUBLY_INDIRECT) */  #endif /* !defined(DOUBLY_INDIRECT) */
             case CF(DODOES)  :              case CF(DODOES)  :
               MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)start)));                MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)start)));
               break;                break;
             default          :              default          : /* backward compatibility */
 /*            printf("Code field generation image[%x]:=CFA(%x)\n",  /*            printf("Code field generation image[%x]:=CFA(%x)\n",
                      i, CF(image[i])); */                       i, CF(image[i])); */
               if (CF((token | 0x4000))<max_symbols) {                if (CF((token | 0x4000))<max_symbols) {
Line 233 
Line 246 
                   compile_prim1(&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],PACKAGE_VERSION);                  fprintf(stderr,"Primitive %ld used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n",(long)CF(token),(long)&image[i],PACKAGE_VERSION);
             }              }
         else {            } else {
               int tok = -token & 0x1FF;
               if (tok < (groups[group+1]-groups[group])) {
   #if defined(DOUBLY_INDIRECT)
                 image[i]=(Cell)CFA(((groups[group]+tok) | (CF(token) & 0x4000)));
   #else
                 image[i]=(Cell)CFA((groups[group]+tok));
   #endif
   #ifdef DIRECT_THREADED
                 if ((token & 0x4000) == 0) /* threade code, no CFA */
                   compile_prim1(&image[i]);
   #endif
               } else
                 fprintf(stderr,"Primitive %lx, %d of group %d used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n", (long)-token, tok, group, (long)&image[i],PACKAGE_VERSION);
             }
           } else {
           // if base is > 0: 0 is a null reference so don't adjust            // if base is > 0: 0 is a null reference so don't adjust
           if (token>=base) {            if (token>=base) {
             image[i]+=(Cell)start;              image[i]+=(Cell)start;
Line 309 
Line 337 
 #ifndef MAP_PRIVATE  #ifndef MAP_PRIVATE
 # define MAP_PRIVATE 0  # define MAP_PRIVATE 0
 #endif  #endif
   #if !defined(MAP_ANON) && defined(MAP_ANONYMOUS)
   # define MAP_ANON MAP_ANONYMOUS
   #endif
   
 #if defined(HAVE_MMAP)  #if defined(HAVE_MMAP)
 static Address alloc_mmap(Cell size)  static Address alloc_mmap(Cell size)
Line 445 
Line 476 
     signal_data_stack[7]=throw_code;      signal_data_stack[7]=throw_code;
   
 #ifdef GFORTH_DEBUGGING  #ifdef GFORTH_DEBUGGING
     /* fprintf(stderr,"\nrp=%ld\n",(long)rp); */      if (debug)
         fprintf(stderr,"\ncaught signal, throwing exception %d, ip=%p rp=%p\n",
                 throw_code, saved_ip, rp);
     if (rp <= orig_rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {      if (rp <= orig_rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {
       /* no rstack overflow or underflow */        /* no rstack overflow or underflow */
       rp0 = rp;        rp0 = rp;
       *--rp0 = (Cell)saved_ip;        *--rp0 = (Cell)saved_ip;
     }      }
     else /* I love non-syntactic ifdefs :-) */      else /* I love non-syntactic ifdefs :-) */
 #endif  
     rp0 = signal_return_stack+8;      rp0 = signal_return_stack+8;
   #else  /* !defined(GFORTH_DEBUGGING) */
       if (debug)
         fprintf(stderr,"\ncaught signal, throwing exception %d\n", throw_code);
         rp0 = signal_return_stack+8;
   #endif /* !defined(GFORTH_DEBUGGING) */
     /* fprintf(stderr, "rp=$%x\n",rp0);*/      /* fprintf(stderr, "rp=$%x\n",rp0);*/
   
     return((int)(Cell)engine(image_header->throw_entry, signal_data_stack+7,      return((int)(Cell)engine(image_header->throw_entry, signal_data_stack+7,
Line 496 
Line 533 
 PrimInfo *priminfos;  PrimInfo *priminfos;
 PrimInfo **decomp_prims;  PrimInfo **decomp_prims;
   
 int compare_priminfo_length(PrimInfo **a, PrimInfo **b)  int compare_priminfo_length(const void *_a, const void *_b)
 {  {
     PrimInfo **a = (PrimInfo **)_a;
     PrimInfo **b = (PrimInfo **)_b;
   Cell diff = (*a)->length - (*b)->length;    Cell diff = (*a)->length - (*b)->length;
   if (diff)    if (diff)
     return diff;      return diff;
Line 514 
Line 553 
 void check_prims(Label symbols1[])  void check_prims(Label symbols1[])
 {  {
   int i;    int i;
   #ifndef NO_DYNAMIC
   Label *symbols2, *symbols3, *ends1;    Label *symbols2, *symbols3, *ends1;
   static char superend[]={    static char superend[]={
 #include "prim_superend.i"  #include "prim_superend.i"
   };    };
   #endif
   
   if (debug)    if (debug)
 #ifdef __VERSION__  #ifdef __VERSION__
Line 559 
Line 600 
     pi->restlength = symbols1[i+1] - symbols1[i] - pi->length;      pi->restlength = symbols1[i+1] - symbols1[i] - pi->length;
     pi->nimmargs = 0;      pi->nimmargs = 0;
     if (debug)      if (debug)
       fprintf(stderr, "Prim %3d @ %p %p %p, length=%3d restlength=%2d superend=%1d",        fprintf(stderr, "Prim %3d @ %p %p %p, length=%3ld restlength=%2ld superend=%1d",
               i, s1, s2, s3, pi->length, pi->restlength, pi->superend);                i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength), pi->superend);
     assert(prim_len>=0);      assert(prim_len>=0);
     while (j<(pi->length+pi->restlength)) {      while (j<(pi->length+pi->restlength)) {
       if (s1[j]==s3[j]) {        if (s1[j]==s3[j]) {
Line 607 
Line 648 
 #endif  #endif
 }  }
   
 #ifndef NO_DYNAMIC  
 void flush_to_here(void)  void flush_to_here(void)
 {  {
   #ifndef NO_DYNAMIC
   FLUSH_ICACHE(start_flush, code_here-start_flush);    FLUSH_ICACHE(start_flush, code_here-start_flush);
   start_flush=code_here;    start_flush=code_here;
   #endif
 }  }
   
   #ifndef NO_DYNAMIC
 void append_jump(void)  void append_jump(void)
 {  {
   if (last_jump) {    if (last_jump) {
Line 622 
Line 665 
     memcpy(code_here, pi->start+pi->length, pi->restlength);      memcpy(code_here, pi->start+pi->length, pi->restlength);
     code_here += pi->restlength;      code_here += pi->restlength;
     last_jump=0;      last_jump=0;
     flush_to_here();  
   }    }
 }  }
   
Line 647 
Line 689 
   if (code_area+code_area_size < code_here+pi->length+pi->restlength) {    if (code_area+code_area_size < code_here+pi->length+pi->restlength) {
     struct code_block_list *p;      struct code_block_list *p;
     append_jump();      append_jump();
       flush_to_here();
     if (*next_code_blockp == NULL) {      if (*next_code_blockp == NULL) {
       code_here = start_flush = code_area = my_alloc(code_area_size);        code_here = start_flush = code_area = my_alloc(code_area_size);
       p = (struct code_block_list *)malloc(sizeof(struct code_block_list));        p = (struct code_block_list *)malloc(sizeof(struct code_block_list));
Line 663 
Line 706 
   }    }
   memcpy(code_here, pi->start, pi->length);    memcpy(code_here, pi->start, pi->length);
   code_here += pi->length;    code_here += pi->length;
   if (pi->superend)  
     flush_to_here();  
   return old_code_here;    return old_code_here;
 }  }
 #endif  #endif
Line 689 
Line 730 
 #endif /* !defined(NO_DYNAMIC) */  #endif /* !defined(NO_DYNAMIC) */
 }  }
   
 Label decompile_code(Label code)  Label decompile_code(Label _code)
 {  {
 #ifdef NO_DYNAMIC  #ifdef NO_DYNAMIC
   return code;    return _code;
 #else /* !defined(NO_DYNAMIC) */  #else /* !defined(NO_DYNAMIC) */
   Cell i;    Cell i;
   struct code_block_list *p;    struct code_block_list *p;
     Address code=_code;
   
   /* first, check if we are in code at all */    /* first, check if we are in code at all */
   for (p = code_block_list;; p = p->next) {    for (p = code_block_list;; p = p->next) {
Line 782 
Line 824 
     set_rel_target(bi->addressptr, *(bi->targetptr));      set_rel_target(bi->addressptr, *(bi->targetptr));
   }    }
   nbranchinfos = 0;    nbranchinfos = 0;
   FLUSH_ICACHE(start_flush, code_here-start_flush);  
   start_flush=code_here;  
 #endif  #endif
     flush_to_here();
 }  }
   
 void compile_prim1(Cell *start)  void compile_prim1(Cell *start)
Line 796 
Line 837 
     *start=(Cell)prim;      *start=(Cell)prim;
     return;      return;
   } else {    } else {
     *start = prim-((Label)xts)+((Label)vm_prims);      *start = (Cell)(prim-((Label)xts)+((Label)vm_prims));
     return;      return;
   }    }
 #elif defined(NO_IP)  #elif defined(NO_IP)
Line 868 
Line 909 
   }    }
   assert(priminfos[i].start = prim);    assert(priminfos[i].start = prim);
 #ifdef ALIGN_CODE  #ifdef ALIGN_CODE
   ALIGN_CODE;    /*  ALIGN_CODE;*/
 #endif  #endif
   assert(prim==priminfos[i].start);    assert(prim==priminfos[i].start);
   old_code_here = append_prim(i);    old_code_here = append_prim(i);
Line 983 
Line 1024 
   alloc_stacks((ImageHeader *)imp);    alloc_stacks((ImageHeader *)imp);
   if (clear_dictionary)    if (clear_dictionary)
     memset(imp+header.image_size, 0, dictsize-header.image_size);      memset(imp+header.image_size, 0, dictsize-header.image_size);
   if(header.base==0 || header.base  == 0x100) {    if(header.base==0 || header.base  == (Address)0x100) {
     Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1;      Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1;
     char reloc_bits[reloc_size];      char reloc_bits[reloc_size];
     fseek(imagefile, preamblesize+header.image_size, SEEK_SET);      fseek(imagefile, preamblesize+header.image_size, SEEK_SET);
     fread(reloc_bits, 1, reloc_size, imagefile);      fread(reloc_bits, 1, reloc_size, imagefile);
     relocate((Cell *)imp, reloc_bits, header.image_size, header.base, vm_prims);      relocate((Cell *)imp, reloc_bits, header.image_size, (Cell)header.base, vm_prims);
 #if 0  #if 0
     { /* let's see what the relocator did */      { /* let's see what the relocator did */
       FILE *snapshot=fopen("snapshot.fi","wb");        FILE *snapshot=fopen("snapshot.fi","wb");
Line 1203 
Line 1244 
 extern const char reloc_bits[];  extern const char reloc_bits[];
 #endif  #endif
   
 DCell double2ll(Float r)  
 {  
 #ifndef BUGGY_LONG_LONG  
   return (DCell)(r);  
 #else  
   DCell d;  
   d.hi = ldexp(r,-(int)(CELL_BITS)) - (r<0);  
   d.lo = r-ldexp((Float)d.hi,CELL_BITS);  
   return d;  
 #endif  
 }  
   
 int main(int argc, char **argv, char **env)  int main(int argc, char **argv, char **env)
 {  {
 #ifdef HAS_OS  #ifdef HAS_OS

Generate output suitable for use with a patch program
Legend:
Removed from v.1.84  
changed lines
  Added in v.1.98
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help