[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.45 and 1.71

version 1.45, Wed Sep 12 14:45:10 2001 UTC version 1.71, Sun Nov 24 21:02:04 2002 UTC
Line 57 
Line 57 
 jmp_buf throw_jmp_buf;  jmp_buf throw_jmp_buf;
 #endif  #endif
   
 #if defined(DIRECT_THREADED)  #if defined(DOUBLY_INDIRECT)
 #  define CA(n) (symbols[(n)])  #  define CFA(n)        ({Cell _n = (n); ((Cell)(((_n & 0x4000) ? symbols : xts)+(_n&~0x4000UL)));})
 #else  #else
 #  define CA(n) ((Cell)(symbols+(n)))  #  define CFA(n)        ((Cell)(symbols+((n)&~0x4000UL)))
 #endif  #endif
   
 #define maxaligned(n)   (typeof(n))((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))  #define maxaligned(n)   (typeof(n))((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
Line 81 
Line 81 
 int optind = 1;  int optind = 1;
 #endif  #endif
   
   Address code_area=0;
   Address code_here=0; /* does for code-area what HERE does for the dictionary */
   Address start_flush=0; /* start of unflushed code */
   
   static int no_super=0;   /* true if compile_prim should not fuse prims */
   /* --no-dynamic by default on gcc versions >=3.1 (it works with 3.0.4,
      but not with 3.2) */
   #if (__GNUC__>2 && __GNUC_MINOR__>=1)
   static int no_dynamic=1; /* true if compile_prim should not generate code */
   #else
   static int no_dynamic=0; /* true if compile_prim should not generate code */
   #endif
   
 #ifdef HAS_DEBUG  #ifdef HAS_DEBUG
 static int debug=0;  int debug=0;
 #else  #else
 # define debug 0  
 # define perror(x...)  # define perror(x...)
 # define fprintf(x...)  # define fprintf(x...)
 #endif  #endif
   
 ImageHeader *gforth_header;  ImageHeader *gforth_header;
 Label *vm_prims;  Label *vm_prims;
   #ifdef DOUBLY_INDIRECT
   Label *xts; /* same content as vm_prims, but should only be used for xts */
   #endif
   
 #ifdef MEMCMP_AS_SUBROUTINE  #ifdef MEMCMP_AS_SUBROUTINE
 int gforth_memcmp(const char * s1, const char * s2, size_t n)  int gforth_memcmp(const char * s1, const char * s2, size_t n)
Line 123 
Line 138 
  * If the word =CF(DODOES), it's a DOES> CFA   * If the word =CF(DODOES), it's a DOES> CFA
  * If the word =CF(DOESJUMP), it's a DOES JUMP (2 Cells after DOES>,   * If the word =CF(DOESJUMP), it's a DOES JUMP (2 Cells after DOES>,
  *                                      possibly containing a jump to dodoes)   *                                      possibly containing a jump to dodoes)
  * If the word is <CF(DOESJUMP), it's 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,
    *                                        it's the threaded code of a primitive
  */   */
   
 void relocate(Cell *image, const char *bitstring, int size, int base, Label symbols[])  void relocate(Cell *image, const char *bitstring,
                 int size, int 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 the one in the image */    /*
      * A virtial start address that's the real start address minus
      * the one in the image
      */
   Cell *start = (Cell * ) (((void *) image) - ((void *) base));    Cell *start = (Cell * ) (((void *) image) - ((void *) base));
   
   
   /* 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); */
   
   for (max_symbols=DOESJUMP+1; symbols[max_symbols]!=0; max_symbols++)    for (max_symbols=DOESJUMP+1; symbols[max_symbols]!=0; max_symbols++)
     ;      ;
     max_symbols--;
   size/=sizeof(Cell);    size/=sizeof(Cell);
   
   for(k=0; k<=steps; k++) {    for(k=0; k<=steps; k++) {
Line 148 
Line 171 
         /* 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)            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)
Line 164 
Line 187 
               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          :
 /*            printf("Code field generation image[%x]:=CA(%x)\n",  /*            printf("Code field generation image[%x]:=CFA(%x)\n",
                      i, CF(image[i])); */                       i, CF(image[i])); */
               if (CF(token)<max_symbols)                if (CF((token | 0x4000))<max_symbols) {
                 image[i]=(Cell)CA(CF(token));                  image[i]=(Cell)CFA(CF(token));
               else  #ifdef DIRECT_THREADED
                   if ((token & 0x4000) == 0) /* threade code, no CFA */
                     compile_prim1(&image[i]);
   #endif
                 } 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);
             }              }
         else          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 179 
Line 206 
       }        }
     }      }
   }    }
     }
     finish_code();
   ((ImageHeader*)(image))->base = (Address) image;    ((ImageHeader*)(image))->base = (Address) image;
 }  }
   
Line 289 
Line 318 
   return verbose_malloc(size);    return verbose_malloc(size);
 }  }
   
 #if (defined(mips) && !defined(INDIRECT_THREADED))  
 /* the 256MB jump restriction on the MIPS architecture makes the  
    combination of direct threading and mmap unsafe. */  
 #define mips_dict_alloc 1  
 #define dict_alloc(size) verbose_malloc(size)  
 #else  
 #define dict_alloc(size) my_alloc(size)  
 #endif  
   
 Address dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)  Address dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)
 {  {
   Address image = MAP_FAILED;    Address image = MAP_FAILED;
   
 #if defined(HAVE_MMAP) && !defined(mips_dict_alloc)  #if defined(HAVE_MMAP)
   if (offset==0) {    if (offset==0) {
     image=alloc_mmap(dictsize);      image=alloc_mmap(dictsize);
     if (debug)      if (debug)
Line 310 
Line 330 
     image = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE, fileno(file), 0);      image = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE, fileno(file), 0);
     after_alloc(image,dictsize);      after_alloc(image,dictsize);
   }    }
 #endif /* defined(MAP_ANON) && !defined(mips_dict_alloc) */  #endif /* defined(HAVE_MMAP) */
   if (image == MAP_FAILED) {    if (image == MAP_FAILED) {
     image = dict_alloc(dictsize+offset)+offset;      image = my_alloc(dictsize+offset)+offset;
     rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */      rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */
     fread(image, 1, imagesize, file);      fread(image, 1, imagesize, file);
   }    }
Line 350 
Line 370 
   header->fp_stack_base=my_alloc(fsize);    header->fp_stack_base=my_alloc(fsize);
   header->return_stack_base=my_alloc(rsize);    header->return_stack_base=my_alloc(rsize);
   header->locals_stack_base=my_alloc(lsize);    header->locals_stack_base=my_alloc(lsize);
     code_here = start_flush = code_area = my_alloc(dictsize);
 }  }
   
 #warning You can ignore the warnings about clobbered variables in go_forth  #warning You can ignore the warnings about clobbered variables in go_forth
Line 392 
Line 413 
     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)ip;        *--rp0 = (Cell)saved_ip;
     }      }
     else /* I love non-syntactic ifdefs :-) */      else /* I love non-syntactic ifdefs :-) */
 #endif  #endif
Line 421 
Line 442 
           1 << ((sizebyte >> 5) & 3));            1 << ((sizebyte >> 5) & 3));
 }  }
   
   #define MAX_IMMARGS 2
   
   #ifndef NO_DYNAMIC
   typedef struct {
     Label start;
     Cell length; /* excluding the jump */
     char superend; /* true if primitive ends superinstruction, i.e.,
                        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 *priminfos;
   #endif /* defined(NO_DYNAMIC) */
   Cell npriminfos=0;
   
   void check_prims(Label symbols1[])
   {
     int i;
     Label *symbols2, *symbols3, *ends1;
     static char superend[]={
   #include "prim_superend.i"
     };
   
     if (debug)
   #ifdef __VERSION__
       fprintf(stderr, "Compiled with gcc-" __VERSION__ "\n");
   #else
   #define xstr(s) str(s)
   #define str(s) #s
     fprintf(stderr, "Compiled with gcc-" xstr(__GNUC__) "." xstr(__GNUC_MINOR__) "\n");
   #endif
     for (i=DOESJUMP+1; symbols1[i+1]!=0; i++)
       ;
     npriminfos = i;
   
   #ifndef NO_DYNAMIC
     if (no_dynamic)
       return;
     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));
     for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) {
       int prim_len = ends1[i]-symbols1[i];
       PrimInfo *pi=&priminfos[i];
       int j=0;
       char *s1 = (char *)symbols1[i];
       char *s2 = (char *)symbols2[i];
       char *s3 = (char *)symbols3[i];
   
       pi->start = s1;
       pi->superend = superend[i-DOESJUMP-1]|no_super;
       if (pi->superend)
         pi->length = symbols1[i+1]-symbols1[i];
       else
         pi->length = prim_len;
       pi->nimmargs = 0;
       if (debug)
         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;
         }
       }
       if (debug)
         fprintf(stderr,"\n");
     }
   #endif
   }
   
   #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)
     Label prim=(Label)*start;
     if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) {
       fprintf(stderr,"compile_prim encountered xt %p\n", prim);
       *start=(Cell)prim;
       return;
     } else {
       *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;
     Address old_code_here=code_here;
     static Address last_jump=0;
   
     i = ((Xt)prim)-vm_prims;
     prim = *(Xt)prim;
     if (no_dynamic) {
       *start = (Cell)prim;
       return;
     }
     if (i>=npriminfos || priminfos[i].start == 0) { /* not a relocatable prim */
       if (last_jump) { /* make sure the last sequence is complete */
         memcpy(code_here, last_jump, IND_JUMP_LENGTH);
         code_here += IND_JUMP_LENGTH;
         last_jump = 0;
         FLUSH_ICACHE(start_flush, code_here-start_flush);
         start_flush=code_here;
       }
       *start = (Cell)prim;
       return;
     }
     assert(priminfos[i].start = prim);
   #ifdef ALIGN_CODE
     ALIGN_CODE;
   #endif
     memcpy(code_here, (Address)prim, priminfos[i].length);
     code_here += priminfos[i].length;
     last_jump = (priminfos[i].superend) ? 0 : (prim+priminfos[i].length);
     if (last_jump == 0) {
       FLUSH_ICACHE(start_flush, code_here-start_flush);
       start_flush=code_here;
     }
     *start = (Cell)old_code_here;
     return;
   #else /* !defined(DOUBLY_INDIRECT), no code replication */
     Label prim=(Label)*start;
   #if !defined(INDIRECT_THREADED)
     prim = *(Xt)prim;
   #endif
     *start = (Cell)prim;
     return;
   #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)
   Cell prim_length(Cell prim)
   {
     return priminfos[prim+DOESJUMP+1].length;
   }
   #endif
   
 Address loader(FILE *imagefile, char* filename)  Address loader(FILE *imagefile, char* filename)
 /* returns the address of the image proper (after the preamble) */  /* returns the address of the image proper (after the preamble) */
 {  {
Line 450 
Line 783 
     ;      ;
   
   vm_prims = engine(0,0,0,0,0);    vm_prims = engine(0,0,0,0,0);
     check_prims(vm_prims);
 #ifndef DOUBLY_INDIRECT  #ifndef DOUBLY_INDIRECT
   #ifdef PRINT_SUPER_LENGTHS
     print_super_lengths();
   #endif
   check_sum = checksum(vm_prims);    check_sum = checksum(vm_prims);
 #else /* defined(DOUBLY_INDIRECT) */  #else /* defined(DOUBLY_INDIRECT) */
   check_sum = (UCell)vm_prims;    check_sum = (UCell)vm_prims;
Line 497 
Line 834 
   image = dict_alloc_read(imagefile, preamblesize+header.image_size,    image = dict_alloc_read(imagefile, preamblesize+header.image_size,
                           preamblesize+dictsize, data_offset);                            preamblesize+dictsize, data_offset);
   imp=image+preamblesize;    imp=image+preamblesize;
     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) {
     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);
Line 513 
Line 851 
     }      }
 #endif  #endif
   }    }
     else if(header.base!=imp) {
       fprintf(stderr,"%s: Cannot load nonrelocatable image (compiled for address $%lx) at address $%lx\n",
               progname, (unsigned long)header.base, (unsigned long)imp);
       exit(1);
     }
   if (header.checksum==0)    if (header.checksum==0)
     ((ImageHeader *)imp)->checksum=check_sum;      ((ImageHeader *)imp)->checksum=check_sum;
   else if (header.checksum != check_sum) {    else if (header.checksum != check_sum) {
Line 520 
Line 863 
             progname, (unsigned long)(header.checksum),(unsigned long)check_sum);              progname, (unsigned long)(header.checksum),(unsigned long)check_sum);
     exit(1);      exit(1);
   }    }
   #ifdef DOUBLY_INDIRECT
     ((ImageHeader *)imp)->xt_base = xts;
   #endif
   fclose(imagefile);    fclose(imagefile);
   
   alloc_stacks((ImageHeader *)imp);    /* unnecessary, except maybe for CODE words */
     /* FLUSH_ICACHE(imp, header.image_size);*/
   CACHE_FLUSH(imp, header.image_size);  
   
   return imp;    return imp;
 }  }
   
 /* index of last '/' or '\' in file, 0 if there is none. !! Hmm, could  /* index of last '/' or '\' in file, 0 if there is none. */
    be implemented with strrchr and the separator should be  
    OS-dependent */  
 int onlypath(char *file)  int onlypath(char *file)
 {  {
   int i;    return strrchr(file, DIRSEP)-file;
   i=strlen(file);  
   while (i) {  
     if (file[i]=='\\' || file[i]=='/') break;  
     i--;  
   }  
   return i;  
 }  }
   
 FILE *openimage(char *fullfilename)  FILE *openimage(char *fullfilename)
Line 561 
Line 898 
   char fullfilename[dirlen+strlen(imagename)+2];    char fullfilename[dirlen+strlen(imagename)+2];
   
   memcpy(fullfilename, path, dirlen);    memcpy(fullfilename, path, dirlen);
   if (fullfilename[dirlen-1]!='/')    if (fullfilename[dirlen-1]!=DIRSEP)
     fullfilename[dirlen++]='/';      fullfilename[dirlen++]=DIRSEP;
   strcpy(fullfilename+dirlen,imagename);    strcpy(fullfilename+dirlen,imagename);
   return openimage(fullfilename);    return openimage(fullfilename);
 }  }
Line 572 
Line 909 
   FILE * image_file=NULL;    FILE * image_file=NULL;
   char *origpath=path;    char *origpath=path;
   
   if(strchr(imagename, '/')==NULL) {    if(strchr(imagename, DIRSEP)==NULL) {
     /* first check the directory where the exe file is in !! 01may97jaw */      /* first check the directory where the exe file is in !! 01may97jaw */
     if (onlypath(progname))      if (onlypath(progname))
       image_file=checkimage(progname, onlypath(progname), imagename);        image_file=checkimage(progname, onlypath(progname), imagename);
Line 658 
Line 995 
       {"clear-dictionary", no_argument, &clear_dictionary, 1},        {"clear-dictionary", no_argument, &clear_dictionary, 1},
       {"die-on-signal", no_argument, &die_on_signal, 1},        {"die-on-signal", no_argument, &die_on_signal, 1},
       {"debug", no_argument, &debug, 1},        {"debug", no_argument, &debug, 1},
         {"no-super", no_argument, &no_super, 1},
         {"no-dynamic", no_argument, &no_dynamic, 1},
         {"dynamic", no_argument, &no_dynamic, 0},
       {0,0,0,0}        {0,0,0,0}
       /* no-init-file, no-rc? */        /* no-init-file, no-rc? */
     };      };
Line 689 
Line 1029 
   -d SIZE, --data-stack-size=SIZE   Specify data stack size\n\    -d SIZE, --data-stack-size=SIZE   Specify data stack size\n\
   --debug                           Print debugging information during startup\n\    --debug                           Print debugging information during startup\n\
   --die-on-signal                   exit instead of CATCHing some signals\n\    --die-on-signal                   exit instead of CATCHing some signals\n\
     --dynamic                         use dynamic native code\n\
   -f SIZE, --fp-stack-size=SIZE     Specify floating point stack size\n\    -f SIZE, --fp-stack-size=SIZE     Specify floating point stack size\n\
   -h, --help                        Print this message and exit\n\    -h, --help                        Print this message and exit\n\
   -i FILE, --image-file=FILE        Use image FILE instead of `gforth.fi'\n\    -i FILE, --image-file=FILE        Use image FILE instead of `gforth.fi'\n\
   -l SIZE, --locals-stack-size=SIZE Specify locals stack size\n\    -l SIZE, --locals-stack-size=SIZE Specify locals stack size\n\
   -m SIZE, --dictionary-size=SIZE   Specify Forth dictionary size\n\    -m SIZE, --dictionary-size=SIZE   Specify Forth dictionary size\n\
     --no-dynamic                      Use only statically compiled primitives\n\
   --no-offset-im                    Load image at normal position\n\    --no-offset-im                    Load image at normal position\n\
     --no-super                        No dynamically formed superinstructions\n\
   --offset-image                    Load image at a different position\n\    --offset-image                    Load image at a different position\n\
   -p PATH, --path=PATH              Search path for finding image and sources\n\    -p PATH, --path=PATH              Search path for finding image and sources\n\
   -r SIZE, --return-stack-size=SIZE Specify return stack size\n\    -r SIZE, --return-stack-size=SIZE Specify return stack size\n\
   -v, --version                     Print version and exit\n\    -v, --version                     Print engine version and exit\n\
 SIZE arguments consist of an integer followed by a unit. The unit can be\n\  SIZE arguments consist of an integer followed by a unit. The unit can be\n\
   `b' (byte), `e' (element; default), `k' (KB), `M' (MB), `G' (GB) or `T' (TB).\n",    `b' (byte), `e' (element; default), `k' (KB), `M' (MB), `G' (GB) or `T' (TB).\n",
               argv[0]);                argv[0]);
Line 714 
Line 1057 
 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
Line 728 
Line 1083 
 #endif  #endif
   int retvalue;    int retvalue;
   
 #if defined(i386) && defined(ALIGNMENT_CHECK) && !defined(DIRECT_THREADED)  #if defined(i386) && defined(ALIGNMENT_CHECK)
   /* turn on alignment checks on the 486.    /* turn on alignment checks on the 486.
    * on the 386 this should have no effect. */     * on the 386 this should have no effect. */
   __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");    __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help