[gforth] / gforth / Attic / main.c  

gforth: gforth/Attic/main.c

Diff for /gforth/Attic/main.c between version 1.39 and 1.53

version 1.39, Mon Sep 23 20:42:00 1996 UTC version 1.53, Sun Feb 16 20:51:08 1997 UTC
Line 31 
Line 31 
 #include <fcntl.h>  #include <fcntl.h>
 #include <assert.h>  #include <assert.h>
 #include <stdlib.h>  #include <stdlib.h>
   #if HAVE_SYS_MMAN_H
   #include <sys/mman.h>
   #endif
 #include "forth.h"  #include "forth.h"
 #include "io.h"  #include "io.h"
 #include "getopt.h"  #include "getopt.h"
   #include "version.h"
   
   #define PRIM_VERSION 1
   /* increment this whenever the primitives change in an incompatible way */
   
 #ifdef MSDOS  #ifdef MSDOS
 jmp_buf throw_jmp_buf;  jmp_buf throw_jmp_buf;
Line 51 
Line 58 
   
 #define maxaligned(n)   (typeof(n))((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))  #define maxaligned(n)   (typeof(n))((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
   
 static Cell dictsize=0;  static UCell dictsize=0;
 static Cell dsize=0;  static UCell dsize=0;
 static Cell rsize=0;  static UCell rsize=0;
 static Cell fsize=0;  static UCell fsize=0;
 static Cell lsize=0;  static UCell lsize=0;
   static int image_offset=0;
   static int clear_dictionary=0;
   static int debug=0;
   static size_t pagesize=0;
 char *progname;  char *progname;
   
 /* image file format:  /* image file format:
Line 93 
Line 104 
   UCell locals_stack_size;    UCell locals_stack_size;
   Xt *boot_entry;       /* initial ip for booting (in BOOT) */    Xt *boot_entry;       /* initial ip for booting (in BOOT) */
   Xt *throw_entry;      /* ip after signal (in THROW) */    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;  } ImageHeader;
 /* the image-header is created in main.fs */  /* the image-header is created in main.fs */
   
Line 131 
Line 148 
   
 UCell checksum(Label symbols[])  UCell checksum(Label symbols[])
 {  {
   UCell r=0;    UCell r=PRIM_VERSION;
   Cell i;    Cell i;
   
   for (i=DOCOL; i<=DOESJUMP; i++) {    for (i=DOCOL; i<=DOESJUMP; i++) {
Line 153 
Line 170 
   return r;    return r;
 }  }
   
   Address my_alloc(Cell size)
   {
     static Address next_address=0;
     Address r;
   
   #if HAVE_MMAP && defined(MAP_ANON)
     if (debug)
       fprintf(stderr,"try mmap($%lx, $%lx, ...); ", (long)next_address, (long)size);
     r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0);
     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;
     }
     if (debug)
       fprintf(stderr, "failed: %s\n", strerror(errno));
   #endif
     /* use malloc as fallback, leave a little room (64B) for stack underflows */
     if ((r = malloc(size+64))==NULL) {
       perror(progname);
       exit(1);
     }
     r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));
     if (debug)
       fprintf(stderr, "malloc succeeds, address=$%lx\n", (long)r);
     return r;
   }
   
 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) */
 {  {
   ImageHeader header;    ImageHeader header;
   Address image;    Address image;
   Address imp; /* image+preamble */    Address imp; /* image+preamble */
   Char magic[8];    Char magic[9];
   Cell wholesize;  
   Cell imagesize; /* everything needed by the image */  
   Cell preamblesize=0;    Cell preamblesize=0;
   Label *symbols=engine(0,0,0,0,0);    Label *symbols=engine(0,0,0,0,0);
   UCell check_sum=checksum(symbols);    UCell check_sum=checksum(symbols);
Line 176 
Line 221 
         exit(1);          exit(1);
       }        }
       preamblesize+=8;        preamblesize+=8;
 #ifdef DEBUG  
       fprintf(stderr,"Magic found: %-8s\n",magic);  
 #endif  
     }      }
   while(memcmp(magic,"Gforth1",7));    while(memcmp(magic,"Gforth1",7));
     if (debug) {
       magic[8]='\0';
       fprintf(stderr,"Magic found: %s\n", magic);
     }
   
   if(magic[7] != sizeof(Cell) +    if(magic[7] != sizeof(Cell) +
 #ifdef WORDS_BIGENDIAN  #ifdef WORDS_BIGENDIAN
Line 218 
Line 264 
   lsize=maxaligned(lsize);    lsize=maxaligned(lsize);
   fsize=maxaligned(fsize);    fsize=maxaligned(fsize);
   
   wholesize = preamblesize+dictsize+dsize+rsize+fsize+lsize;  #if HAVE_GETPAGESIZE
   imagesize = preamblesize+header.image_size+((header.image_size-1)/sizeof(Cell))/8+1;    pagesize=getpagesize(); /* Linux/GNU libc offers this */
   image=malloc((wholesize>imagesize?wholesize:imagesize)/*+sizeof(Float)*/);  #elif HAVE_SYSCONF && defined(_SC_PAGESIZE)
   /*image = maxaligned(image);*/    pagesize=sysconf(_SC_PAGESIZE); /* POSIX.4 */
   memset(image,0,wholesize); /* why? - anton */  #elif PAGESIZE
     pagesize=PAGESIZE; /* in limits.h accoring to Gallmeister's POSIX.4 book */
   #endif
     if (debug)
       fprintf(stderr,"pagesize=%d\n",pagesize);
   
     image = my_alloc(preamblesize+dictsize+image_offset)+image_offset;
   rewind(imagefile);  /* fseek(imagefile,0L,SEEK_SET); */    rewind(imagefile);  /* fseek(imagefile,0L,SEEK_SET); */
   fread(image,1,imagesize,imagefile);    if (clear_dictionary)
   fclose(imagefile);      memset(image,0,dictsize);
     fread(image,1,preamblesize+header.image_size,imagefile);
   imp=image+preamblesize;    imp=image+preamblesize;
   
   if(header.base==0) {    if(header.base==0) {
     relocate((Cell *)imp,imp+header.image_size,header.image_size,symbols);      Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1;
     ((ImageHeader *)imp)->checksum=check_sum;      char reloc_bits[reloc_size];
       fread(reloc_bits,1,reloc_size,imagefile);
       relocate((Cell *)imp,reloc_bits,header.image_size,symbols);
   #if 0
       { /* let's see what the relocator did */
         FILE *snapshot=fopen("snapshot.fi","wb");
         fwrite(image,1,imagesize,snapshot);
         fclose(snapshot);
       }
   #endif
   }    }
   else if(header.base!=imp) {    else if(header.base!=imp) {
     fprintf(stderr,"%s: Cannot load nonrelocatable image (compiled for address $%lx) at address $%lx\nThe Gforth installer should look into the INSTALL file\n",      fprintf(stderr,"%s: Cannot load nonrelocatable image (compiled for address $%lx) at address $%lx\n",
             progname, (unsigned long)header.base, (unsigned long)imp);              progname, (unsigned long)header.base, (unsigned long)imp);
     exit(1);      exit(1);
   } else if (header.checksum != check_sum) {    }
     if (header.checksum==0)
       ((ImageHeader *)imp)->checksum=check_sum;
     else if (header.checksum != check_sum) {
     fprintf(stderr,"%s: Checksum of image ($%lx) does not match the executable ($%lx)\nThe Gforth installer should look into the INSTALL file\n",      fprintf(stderr,"%s: Checksum of image ($%lx) does not match the executable ($%lx)\nThe Gforth installer should look into the INSTALL file\n",
             progname, (unsigned long)(header.checksum),(unsigned long)check_sum);              progname, (unsigned long)(header.checksum),(unsigned long)check_sum);
     exit(1);      exit(1);
   }    }
     fclose(imagefile);
   
   ((ImageHeader *)imp)->dict_size=dictsize;    ((ImageHeader *)imp)->dict_size=dictsize;
   ((ImageHeader *)imp)->data_stack_size=dsize;    ((ImageHeader *)imp)->data_stack_size=dsize;
   ((ImageHeader *)imp)->return_stack_size=rsize;  
   ((ImageHeader *)imp)->fp_stack_size=fsize;    ((ImageHeader *)imp)->fp_stack_size=fsize;
     ((ImageHeader *)imp)->return_stack_size=rsize;
   ((ImageHeader *)imp)->locals_stack_size=lsize;    ((ImageHeader *)imp)->locals_stack_size=lsize;
   
     ((ImageHeader *)imp)->data_stack_base=my_alloc(dsize);
     ((ImageHeader *)imp)->fp_stack_base=my_alloc(fsize);
     ((ImageHeader *)imp)->return_stack_base=my_alloc(rsize);
     ((ImageHeader *)imp)->locals_stack_base=my_alloc(lsize);
   
   CACHE_FLUSH(imp, header.image_size);    CACHE_FLUSH(imp, header.image_size);
   
   return imp;    return imp;
Line 255 
Line 325 
   
 int go_forth(Address image, int stack, Cell *entries)  int go_forth(Address image, int stack, Cell *entries)
 {  {
   Cell *sp=(Cell*)(image+dictsize+dsize);    Cell *sp=(Cell*)(((ImageHeader *)image)->data_stack_base + dsize);
   Address lp=(Address)((void *)sp+lsize);    Float *fp=(Float *)(((ImageHeader *)image)->fp_stack_base + fsize);
   Float *fp=(Float *)((void *)lp+fsize);    Cell *rp=(Cell *)(((ImageHeader *)image)->return_stack_base + rsize);
   Cell *rp=(Cell*)((void *)fp+rsize);    Address lp=((ImageHeader *)image)->locals_stack_base + lsize;
   Xt *ip=(Xt *)(((ImageHeader *)image)->boot_entry);    Xt *ip=(Xt *)(((ImageHeader *)image)->boot_entry);
   int throw_code;    int throw_code;
   
     /* ensure that the cached elements (if any) are accessible */
     IF_TOS(sp--);
     IF_FTOS(fp--);
   
   for(;stack>0;stack--)    for(;stack>0;stack--)
     *--sp=entries[stack-1];      *--sp=entries[stack-1];
   
 #ifndef MSDOS  #if !defined(MSDOS) && !defined(_WIN32) && !defined(__EMX__)
   get_winsize();    get_winsize();
 #endif  #endif
   
Line 285 
Line 359 
   return((int)engine(ip,sp,rp,fp,lp));    return((int)engine(ip,sp,rp,fp,lp));
 }  }
   
 int convsize(char *s, int elemsize)  UCell convsize(char *s, UCell elemsize)
 /* converts s of the format #+u (e.g. 25k) into the number of bytes.  /* converts s of the format #+u (e.g. 25k) into the number of bytes.
    the unit u can be one of bekM, where e stands for the element     the unit u can be one of bekM, where e stands for the element
    size. default is e */     size. default is e */
 {  {
   char *endp;    char *endp;
   int n,m;    UCell n,m;
   
   m = elemsize;    m = elemsize;
   n = strtoul(s,&endp,0);    n = strtoul(s,&endp,0);
Line 327 
Line 401 
 #endif  #endif
   
   progname = argv[0];    progname = argv[0];
   if ((path=getenv("GFORTHPATH"))==NULL)    if ((path1=getenv("GFORTHPATH"))==NULL)
     path = strcpy(malloc(strlen(DEFAULTPATH)+1),DEFAULTPATH);      path1 = DEFAULTPATH;
   
   opterr=0;    opterr=0;
   while (1) {    while (1) {
     int option_index=0;      int option_index=0;
Line 340 
Line 415 
       {"fp-stack-size", required_argument, NULL, 'f'},        {"fp-stack-size", required_argument, NULL, 'f'},
       {"locals-stack-size", required_argument, NULL, 'l'},        {"locals-stack-size", required_argument, NULL, 'l'},
       {"path", required_argument, NULL, 'p'},        {"path", required_argument, NULL, 'p'},
         {"version", no_argument, NULL, 'v'},
         {"help", no_argument, NULL, 'h'},
         {"clear-dictionary", no_argument, NULL, 'c'},
         /* put something != 0 into image_offset; it should be a
            not-too-large max-aligned number */
         {"offset-image", no_argument, NULL, 'o'},
         {"debug", no_argument, &debug, 1},
       {0,0,0,0}        {0,0,0,0}
       /* no-init-file, no-rc? */        /* no-init-file, no-rc? */
     };      };
   
     c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:", opts, &option_index);      c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:vhco", opts, &option_index);
   
     if (c==EOF)      if (c==EOF)
       break;        break;
Line 353 
Line 435 
       break;        break;
     }      }
     switch (c) {      switch (c) {
       case 'c': clear_dictionary=1; break;
       case 'o': image_offset=28*sizeof(Cell); break;
     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;
     case 'r': rsize = convsize(optarg,sizeof(Cell)); break;      case 'r': rsize = convsize(optarg,sizeof(Cell)); break;
     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': path1 = optarg; break;
       case 'v': fprintf(stderr, "gforth %s\n", gforth_version); exit(0);
       case 'h':
         fprintf(stderr, "Usage: %s [engine options] [image arguments]\n\
   Engine Options:\n\
    -c, --clear-dictionary             Initialize the dictionary with 0 bytes\n\
    -d SIZE, --data-stack-size=SIZE    Specify data stack size\n\
    --debug                            Print debugging information during startup\n\
    -f SIZE, --fp-stack-size=SIZE      Specify floating point stack size\n\
    -h, --help                         Print this message and exit\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\
    -m SIZE, --dictionary-size=SIZE    Specify Forth dictionary size\n\
    --offset-image                     Load image at a different position\n\
    -p PATH, --path=PATH               Search path for finding image and sources\n\
    -r SIZE, --return-stack-size=SIZE  Specify return stack size\n\
    -v, --version                      Print version and exit\n\
   SIZE arguments consists of an integer followed by a unit. The unit can be\n\
     `b' (bytes), `e' (elements), `k' (kilobytes), or `M' (Megabytes).\n\
   \n\
   Arguments of default image `gforth.fi':\n\
    FILE                               load FILE (with `require')\n\
    -e STRING, --evaluate STRING       interpret STRING (with `EVALUATE')\n",
                 argv[0]); exit(0);
     }      }
   }    }
   path1=path;    path=path1;
   
   if(strchr(imagename, '/')==NULL)    if(strchr(imagename, '/')==NULL)
     {      {
       do {        do {
         char *pend=strchr(path, ':');          char *pend=strchr(path, PATHSEP);
         if (pend==NULL)          if (pend==NULL)
           pend=path+strlen(path);            pend=path+strlen(path);
         if (strlen(path)==0) {          if (strlen(path)==0) {
Line 384 
Line 491 
           strcpy(fullfilename+dirlen,imagename);            strcpy(fullfilename+dirlen,imagename);
           image_file=fopen(fullfilename,"rb");            image_file=fopen(fullfilename,"rb");
         }          }
         path=pend+(*pend==':');          path=pend+(*pend==PATHSEP);
       } while (image_file==NULL);        } while (image_file==NULL);
     }      }
   else    else
     {      {
       image_file=fopen(imagename,"rb");        image_file=fopen(imagename,"rb");
       if(image_file==NULL) {  
         fprintf(stderr,"%s: %s: %s\n", progname, imagename, strerror(errno));  
         exit(1);  
       }  
     }      }
   
   {    {
       char path2[strlen(path1)+1];
       char *p1, *p2;
     Cell environ[]= {      Cell environ[]= {
       (Cell)argc-(optind-1),        (Cell)argc-(optind-1),
       (Cell)(argv+(optind-1)),        (Cell)(argv+(optind-1)),
       (Cell)path1};        (Cell)strlen(path1),
         (Cell)path2};
     argv[optind-1] = progname;      argv[optind-1] = progname;
     /*      /*
        for (i=0; i<environ[0]; i++)         for (i=0; i<environ[0]; i++)
        printf("%s\n", ((char **)(environ[1]))[i]);         printf("%s\n", ((char **)(environ[1]))[i]);
        */         */
     retvalue=go_forth(loader(image_file, imagename),3,environ);      /* make path OS-independent by replacing path separators with NUL */
       for (p1=path1, p2=path2; *p1!='\0'; p1++, p2++)
         if (*p1==PATHSEP)
           *p2 = '\0';
         else
           *p2 = *p1;
       *p2='\0';
       retvalue=go_forth(loader(image_file, imagename),4,environ);
     deprep_terminal();      deprep_terminal();
     exit(retvalue);      exit(retvalue);
   }    }

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help