[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.22 and 1.37

version 1.22, Thu Jan 21 20:09:14 1999 UTC version 1.37, Thu Jul 27 10:40:42 2000 UTC
Line 28 
Line 28 
 #include <string.h>  #include <string.h>
 #include <math.h>  #include <math.h>
 #include <sys/types.h>  #include <sys/types.h>
   #ifndef STANDALONE
 #include <sys/stat.h>  #include <sys/stat.h>
   #endif
 #include <fcntl.h>  #include <fcntl.h>
 #include <assert.h>  #include <assert.h>
 #include <stdlib.h>  #include <stdlib.h>
Line 72 
Line 74 
 int die_on_signal=0;  int die_on_signal=0;
 #ifndef INCLUDE_IMAGE  #ifndef INCLUDE_IMAGE
 static int clear_dictionary=0;  static int clear_dictionary=0;
 static size_t pagesize=0;  UCell pagesize=1;
 char *progname;  char *progname;
 #else  #else
 char *progname = "gforth";  char *progname = "gforth";
 int optind = 1;  int optind = 1;
 #endif  #endif
   
   #ifdef HAS_DEBUG
 static int debug=0;  static int debug=0;
   #else
   # define debug 0
   # define perror(x...)
   # define fprintf(x...)
   #endif
   
   ImageHeader *gforth_header;
   
   #ifdef MEMCMP_AS_SUBROUTINE
   int gforth_memcmp(const char * s1, const char * s2, size_t n)
   {
     return memcmp(s1, s2, n);
   }
   #endif
   
 /* image file format:  /* image file format:
  *  "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n")   *  "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n")
Line 92 
Line 110 
  *              bit 0:   endian, big=0, little=1.   *              bit 0:   endian, big=0, little=1.
  *  The magic are always 8 octets, no matter what the native AU/character size is   *  The magic are always 8 octets, no matter what the native AU/character size is
  *  padding to max alignment (no padding necessary on current machines)   *  padding to max alignment (no padding necessary on current machines)
  *  ImageHeader structure (see below)   *  ImageHeader structure (see forth.h)
  *  data (size in ImageHeader.image_size)   *  data (size in ImageHeader.image_size)
  *  tags ((if relocatable, 1 bit/data cell)   *  tags ((if relocatable, 1 bit/data cell)
  *   *
Line 107 
Line 125 
  * If the word is <CF(DOESJUMP), it's a primitive   * If the word is <CF(DOESJUMP), it's a primitive
  */   */
   
 typedef struct {  
   Address base;         /* base address of image (0 if relocatable) */  
   UCell checksum;       /* checksum of ca's to protect against some  
                            incompatible binary/executable combinations  
                            (0 if relocatable) */  
   UCell image_size;     /* all sizes in bytes */  
   UCell dict_size;  
   UCell data_stack_size;  
   UCell fp_stack_size;  
   UCell return_stack_size;  
   UCell locals_stack_size;  
   Xt *boot_entry;       /* initial ip for booting (in BOOT) */  
   Xt *throw_entry;      /* ip after signal (in THROW) */  
   Cell unused1;         /* possibly tib stack size */  
   Cell unused2;  
   Address data_stack_base; /* this and the following fields are initialized by the loader */  
   Address fp_stack_base;  
   Address return_stack_base;  
   Address locals_stack_base;  
 } ImageHeader;  
 /* the image-header is created in main.fs */  
   
 void relocate(Cell *image, const char *bitstring, int size, Label symbols[])  void relocate(Cell *image, const char *bitstring, int size, 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;
 /*   static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/    Cell max_symbols;
   
 /*  printf("relocating %x[%x]\n", image, size); */  /*  printf("relocating %x[%x]\n", image, size); */
   
   for(k=0; k<=steps; k++)    for (max_symbols=DOESJUMP+1; symbols[max_symbols]!=0; max_symbols++)
       ;
     size/=sizeof(Cell);
   
     for(k=0; k<=steps; k++) {
     for(j=0, bits=bitstring[k]; j<RELINFOBITS; j++, i++, bits<<=1) {      for(j=0, bits=bitstring[k]; j<RELINFOBITS; j++, i++, bits<<=1) {
       /*      fprintf(stderr,"relocate: image[%d]\n", i);*/        /*      fprintf(stderr,"relocate: image[%d]\n", i);*/
       if(bits & (1U << (RELINFOBITS-1))) {        if((i < size) && (bits & (1U << (RELINFOBITS-1)))) {
         /* fprintf(stderr,"relocate: image[%d]=%d\n", i, image[i]);*/          /* fprintf(stderr,"relocate: image[%d]=%d of %d\n", i, image[i], size/sizeof(Cell)); */
         if((token=image[i])<0)          if((token=image[i])<0)
           switch(token)            switch(token)
             {              {
Line 157 
Line 157 
             case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;              case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
 #endif /* !defined(DOUBLY_INDIRECT) */  #endif /* !defined(DOUBLY_INDIRECT) */
             case CF(DODOES)  :              case CF(DODOES)  :
               MAKE_DOES_CF(image+i,image[i+1]+((Cell)image));                MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)image)));
               break;                break;
             default          :              default          :
 /*            printf("Code field generation image[%x]:=CA(%x)\n",  /*            printf("Code field generation image[%x]:=CA(%x)\n",
                      i, CF(image[i])); */                       i, CF(image[i])); */
                 if (CF(token)<max_symbols)
               image[i]=(Cell)CA(CF(token));                image[i]=(Cell)CA(CF(token));
                 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);
             }              }
         else          else
           image[i]+=(Cell)image;            image[i]+=(Cell)image;
       }        }
     }      }
   ((ImageHeader*)(image))->base = image;    }
     ((ImageHeader*)(image))->base = (Address) image;
 }  }
   
 UCell checksum(Label symbols[])  UCell checksum(Label symbols[])
Line 209 
Line 213 
   return r;    return r;
 }  }
   
 Address my_alloc(Cell size)  
 {  
 #if HAVE_MMAP  
   static Address next_address=0;    static Address next_address=0;
   void after_alloc(Address r, Cell size)
   {
     if (r != (Address)-1) {
       if (debug)
         fprintf(stderr, "success, address=$%lx\n", (long) r);
       if (pagesize != 1)
         next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */
     } else {
       if (debug)
         fprintf(stderr, "failed: %s\n", strerror(errno));
     }
   }
   
   #ifndef MAP_FAILED
   #define MAP_FAILED ((Address) -1)
   #endif
   #ifndef MAP_FILE
   # define MAP_FILE 0
   #endif
   #ifndef MAP_PRIVATE
   # define MAP_PRIVATE 0
   #endif
   
   #if defined(HAVE_MMAP)
   static Address alloc_mmap(Cell size)
   {
   Address r;    Address r;
   
 #if defined(MAP_ANON)  #if defined(MAP_ANON)
Line 222 
Line 249 
 #else /* !defined(MAP_ANON) */  #else /* !defined(MAP_ANON) */
   /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are    /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are
      apparently defaults) */       apparently defaults) */
 #ifndef MAP_FILE  
 # define MAP_FILE 0  
 #endif  
 #ifndef MAP_PRIVATE  
 # define MAP_PRIVATE 0  
 #endif  
   static int dev_zero=-1;    static int dev_zero=-1;
   
   if (dev_zero == -1)    if (dev_zero == -1)
     dev_zero = open("/dev/zero", O_RDONLY);      dev_zero = open("/dev/zero", O_RDONLY);
   if (dev_zero == -1) {    if (dev_zero == -1) {
     r = (Address)-1;      r = MAP_FAILED;
     if (debug)      if (debug)
       fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ",        fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ",
               strerror(errno));                strerror(errno));
Line 243 
Line 264 
     r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0);      r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0);
   }    }
 #endif /* !defined(MAP_ANON) */  #endif /* !defined(MAP_ANON) */
     after_alloc(r, size);
   if (r != (Address)-1) {  
     if (debug)  
       fprintf(stderr, "success, address=$%lx\n", (long) r);  
     if (pagesize != 0)  
       next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */  
     return r;      return r;
   }    }
   if (debug)  #endif
     fprintf(stderr, "failed: %s\n", strerror(errno));  
   Address my_alloc(Cell size)
   {
   #if HAVE_MMAP
     Address r;
   
     r=alloc_mmap(size);
     if (r!=MAP_FAILED)
       return r;
 #endif /* HAVE_MMAP */  #endif /* HAVE_MMAP */
   /* use malloc as fallback */    /* use malloc as fallback */
   return verbose_malloc(size);    return verbose_malloc(size);
Line 261 
Line 285 
 #if (defined(mips) && !defined(INDIRECT_THREADED))  #if (defined(mips) && !defined(INDIRECT_THREADED))
 /* the 256MB jump restriction on the MIPS architecture makes the  /* the 256MB jump restriction on the MIPS architecture makes the
    combination of direct threading and mmap unsafe. */     combination of direct threading and mmap unsafe. */
   #define mips_dict_alloc 1
 #define dict_alloc(size) verbose_malloc(size)  #define dict_alloc(size) verbose_malloc(size)
 #else  #else
 #define dict_alloc(size) my_alloc(size)  #define dict_alloc(size) my_alloc(size)
 #endif  #endif
   
   Address dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)
   {
     Address image = MAP_FAILED;
   
   #if defined(HAVE_MMAP) && !defined(mips_dict_alloc)
     if (offset==0) {
       image=alloc_mmap(dictsize);
       if (debug)
         fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);
       image = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE, fileno(file), 0);
       after_alloc(image,dictsize);
     }
   #endif /* defined(MAP_ANON) && !defined(mips_dict_alloc) */
     if (image == MAP_FAILED) {
       image = dict_alloc(dictsize+offset)+offset;
       rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */
       fread(image, 1, imagesize, file);
     }
     return image;
   }
   
 void set_stack_sizes(ImageHeader * header)  void set_stack_sizes(ImageHeader * header)
 {  {
   if (dictsize==0)    if (dictsize==0)
Line 318 
Line 364 
   for(;stack>0;stack--)    for(;stack>0;stack--)
     *--sp0=entries[stack-1];      *--sp0=entries[stack-1];
   
 #if !defined(MSDOS) && !defined(SHARC) && !defined(_WIN32) && !defined(__EMX__)  #ifdef SYSSIGNALS
   get_winsize();    get_winsize();
 #endif  
   
 #ifdef SYSSIGNALS  
   install_signal_handlers(); /* right place? */    install_signal_handlers(); /* right place? */
   
   if ((throw_code=setjmp(throw_jmp_buf))) {    if ((throw_code=setjmp(throw_jmp_buf))) {
Line 336 
Line 380 
     if (rp <= rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {      if (rp <= rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {
       /* no rstack overflow or underflow */        /* no rstack overflow or underflow */
       rp0 = rp;        rp0 = rp;
       *--rp0 = ip;        *--rp0 = (Cell)ip;
     }      }
     else /* I love non-syntactic ifdefs :-) */      else /* I love non-syntactic ifdefs :-) */
 #endif  #endif
     rp0 = signal_return_stack+8;      rp0 = signal_return_stack+8;
       /* fprintf(stderr, "rp=$%x\n",rp0);*/
   
     return((int)engine(image_header->throw_entry, signal_data_stack+7,      return((int)(Cell)engine(image_header->throw_entry, signal_data_stack+7,
                        rp0, signal_fp_stack, 0));                         rp0, signal_fp_stack, 0));
   }    }
 #endif  #endif
   
   return((int)engine(ip0,sp0,rp0,fp0,lp0));    return((int)(Cell)engine(ip0,sp0,rp0,fp0,lp0));
 }  }
   
   
   #ifndef INCLUDE_IMAGE
 void print_sizes(Cell sizebyte)  void print_sizes(Cell sizebyte)
      /* print size information */       /* print size information */
 {  {
Line 363 
Line 409 
           1 << ((sizebyte >> 5) & 3));            1 << ((sizebyte >> 5) & 3));
 }  }
   
 #ifndef INCLUDE_IMAGE  
 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 437 
Line 482 
   if (debug)    if (debug)
     fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize);      fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize);
   
   image = dict_alloc(preamblesize+dictsize+data_offset)+data_offset;    image = dict_alloc_read(imagefile, preamblesize+header.image_size,
   rewind(imagefile);  /* fseek(imagefile,0L,SEEK_SET); */                            preamblesize+dictsize, data_offset);
   if (clear_dictionary)  
     memset(image, 0, dictsize);  
   fread(image, 1, preamblesize+header.image_size, imagefile);  
   imp=image+preamblesize;    imp=image+preamblesize;
     if (clear_dictionary)
       memset(imp+header.image_size, 0, dictsize-header.image_size);
   if(header.base==0) {    if(header.base==0) {
     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);
     fread(reloc_bits, 1, reloc_size, imagefile);      fread(reloc_bits, 1, reloc_size, imagefile);
     relocate((Cell *)imp, reloc_bits, header.image_size, symbols);      relocate((Cell *)imp, reloc_bits, header.image_size, symbols);
 #if 0  #if 0
Line 477 
Line 522 
   return imp;    return imp;
 }  }
   
   /* index of last '/' or '\' in file, 0 if there is none. !! Hmm, could
      be implemented with strrchr and the separator should be
      OS-dependent */
 int onlypath(char *file)  int onlypath(char *file)
 {  {
   int i;    int i;
Line 491 
Line 539 
 FILE *openimage(char *fullfilename)  FILE *openimage(char *fullfilename)
 {  {
   FILE *image_file;    FILE *image_file;
     char * expfilename = tilde_cstr(fullfilename, strlen(fullfilename), 1);
   
   image_file=fopen(fullfilename,"rb");    image_file=fopen(expfilename,"rb");
   if (image_file!=NULL && debug)    if (image_file!=NULL && debug)
     fprintf(stderr, "Opened image file: %s\n", fullfilename);      fprintf(stderr, "Opened image file: %s\n", expfilename);
   return image_file;    return image_file;
 }  }
   
   /* try to open image file concat(path[0:len],imagename) */
 FILE *checkimage(char *path, int len, char *imagename)  FILE *checkimage(char *path, int len, char *imagename)
 {  {
   int dirlen=len;    int dirlen=len;
Line 513 
Line 563 
 FILE * open_image_file(char * imagename, char * path)  FILE * open_image_file(char * imagename, char * path)
 {  {
   FILE * image_file=NULL;    FILE * image_file=NULL;
     char *origpath=path;
   
   if(strchr(imagename, '/')==NULL) {    if(strchr(imagename, '/')==NULL) {
     /* first check the directory where the exe file is in !! 01may97jaw */      /* first check the directory where the exe file is in !! 01may97jaw */
Line 533 
Line 584 
   
   if (!image_file) {    if (!image_file) {
     fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n",      fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n",
             progname, imagename, path);              progname, imagename, origpath);
     exit(1);      exit(1);
   }    }
   
Line 563 
Line 614 
       m=1024*1024*1024;        m=1024*1024*1024;
     else if (strcmp(endp,"T")==0) {      else if (strcmp(endp,"T")==0) {
 #if (SIZEOF_CHAR_P > 4)  #if (SIZEOF_CHAR_P > 4)
       m=1024*1024*1024*1024;        m=1024L*1024*1024*1024;
 #else  #else
       fprintf(stderr,"%s: size specification \"%s\" too large for this machine\n", progname, endp);        fprintf(stderr,"%s: size specification \"%s\" too large for this machine\n", progname, endp);
       exit(1);        exit(1);
Line 584 
Line 635 
   while (1) {    while (1) {
     int option_index=0;      int option_index=0;
     static struct option opts[] = {      static struct option opts[] = {
         {"appl-image", required_argument, NULL, 'a'},
       {"image-file", required_argument, NULL, 'i'},        {"image-file", required_argument, NULL, 'i'},
       {"dictionary-size", required_argument, NULL, 'm'},        {"dictionary-size", required_argument, NULL, 'm'},
       {"data-stack-size", required_argument, NULL, 'd'},        {"data-stack-size", required_argument, NULL, 'd'},
Line 603 
Line 655 
       /* no-init-file, no-rc? */        /* no-init-file, no-rc? */
     };      };
   
     c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:vh", opts, &option_index);      c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:vhoncsx", opts, &option_index);
   
     if (c==EOF)  
       break;  
     if (c=='?') {  
       optind--;  
       break;  
     }  
     switch (c) {      switch (c) {
       case EOF: return;
       case '?': optind--; return;
       case 'a': *imagename = optarg; return;
     case 'i': *imagename = optarg; break;      case 'i': *imagename = optarg; break;
     case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;      case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
     case 'd': dsize = convsize(optarg,sizeof(Cell)); break;      case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
Line 619 
Line 668 
     case 'f': fsize = convsize(optarg,sizeof(Float)); break;      case 'f': fsize = convsize(optarg,sizeof(Float)); break;
     case 'l': lsize = convsize(optarg,sizeof(Cell)); break;      case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
     case 'p': *path = optarg; break;      case 'p': *path = optarg; break;
       case 'o': offset_image = 1; break;
       case 'n': offset_image = 0; break;
       case 'c': clear_dictionary = 1; break;
       case 's': die_on_signal = 1; break;
       case 'x': debug = 1; break;
     case 'v': fprintf(stderr, "gforth %s\n", VERSION); exit(0);      case 'v': fprintf(stderr, "gforth %s\n", VERSION); exit(0);
     case 'h':      case 'h':
       fprintf(stderr, "Usage: %s [engine options] [image arguments]\n\        fprintf(stderr, "Usage: %s [engine options] ['--'] [image arguments]\n\
 Engine Options:\n\  Engine Options:\n\
     --appl-image FILE                 equivalent to '--image-file=FILE --'\n\
   --clear-dictionary                Initialize the dictionary with 0 bytes\n\    --clear-dictionary                Initialize the dictionary with 0 bytes\n\
   -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\
Line 642 
Line 697 
               argv[0]);                argv[0]);
       optind--;        optind--;
       return;        return;
       exit(0);  
     }      }
   }    }
 }  }
Line 655 
Line 709 
   
 int main(int argc, char **argv, char **env)  int main(int argc, char **argv, char **env)
 {  {
   #ifdef HAS_OS
   char *path = getenv("GFORTHPATH") ? : DEFAULTPATH;    char *path = getenv("GFORTHPATH") ? : DEFAULTPATH;
   #else
     char *path = DEFAULTPATH;
   #endif
 #ifndef INCLUDE_IMAGE  #ifndef INCLUDE_IMAGE
   char *imagename="gforth.fi";    char *imagename="gforth.fi";
   FILE *image_file;    FILE *image_file;
Line 697 
Line 755 
   image_file = open_image_file(imagename, path);    image_file = open_image_file(imagename, path);
   image = loader(image_file, imagename);    image = loader(image_file, imagename);
 #endif  #endif
     gforth_header=(ImageHeader *)image; /* used in SIGSEGV handler */
   
   {    {
     char path2[strlen(path)+1];      char path2[strlen(path)+1];

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help