[BACK]Return to main.c CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/Attic/main.c between versions 1.9 and 1.10

version 1.9, 1994/08/25 15:25:30 version 1.10, 1994/09/05 17:36:22
Line 14 Line 14
 #include <stdlib.h>  #include <stdlib.h>
 #include "forth.h"  #include "forth.h"
 #include "io.h"  #include "io.h"
   #include "getopt.h"
 Xt *throw_ip;  
   
   
 #ifndef DEFAULTBIN  #ifndef DEFAULTBIN
 #       define DEFAULTBIN ""  #       define DEFAULTBIN ""
 #endif  #endif
   
   #ifndef DEFAULTPATH
   #       define DEFAULTPATH "/usr/local/lib/gforth:."
   #endif
   
 #ifdef DIRECT_THREADED  #ifdef DIRECT_THREADED
 #       define CA(n)    (symbols[(n)])  #       define CA(n)    (symbols[(n)])
 #else  #else
 #       define CA(n)    ((int)(symbols+(n)))  #       define CA(n)    ((int)(symbols+(n)))
 #endif  #endif
   
   #define maxaligned(n)   ((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
   
   static int dictsize=0;
   static int dsize=0;
   static int rsize=0;
   static int fsize=0;
   static int lsize=0;
   char *progname;
   
   
 /* image file format:  /* image file format:
  *   size of image with stacks without tags (in bytes)   *   size of image with stacks without tags (in bytes)
  *   size of image without stacks and tags (in bytes)   *   size of image without stacks and tags (in bytes)
Line 47  Xt *throw_ip; Line 59  Xt *throw_ip;
  * If the word is <-7, it's a primitive   * If the word is <-7, it's a primitive
  */   */
   
 void relocate(int *image, char *bitstring, int size, Label symbols[])  void relocate(Cell *image, char *bitstring, int size, Label symbols[])
 {  {
    int i=0, j, k, steps=(size/sizeof(Cell))/8;     int i=0, j, k, steps=(size/sizeof(Cell))/8;
    char bits;     char bits;
Line 77  void relocate(int *image, char *bitstrin Line 89  void relocate(int *image, char *bitstrin
    CACHE_FLUSH(image,size);     CACHE_FLUSH(image,size);
 }  }
   
 int* loader(const char* filename)  Cell *loader(FILE *imagefile)
 {       int header[2];  {
         FILE *imagefile;          Cell header[3];
         int *image;          Cell *image;
           int wholesize;
         if(!(int)(imagefile=fopen(filename,"rb")))          int imagesize; /* everything needed by the image */
         {  
                 fprintf(stderr,"Can't open image file '%s'",filename);          fread(header,1,3*sizeof(Cell),imagefile);
                 exit(1);          if (dictsize==0)
         }            dictsize = header[0];
           if (dsize==0)
         fread(header,1,2*sizeof(int),imagefile);            dsize=header[2];
           if (rsize==0)
         image=malloc(header[0]+((header[0]-1)/sizeof(Cell))/8+1);            rsize=header[2];
           if (fsize==0)
         memset(image,0,header[0]+((header[0]-1)/sizeof(Cell))/8+1);            fsize=header[2];
           if (lsize==0)
             lsize=header[2];
           dictsize=maxaligned(dictsize);
           dsize=maxaligned(dsize);
           rsize=maxaligned(rsize);
           lsize=maxaligned(lsize);
           fsize=maxaligned(fsize);
   
           wholesize = dictsize+dsize+rsize+fsize+lsize;
           imagesize = header[1]+((header[1]-1)/sizeof(Cell))/8+1;
           image=malloc(wholesize>imagesize?wholesize:imagesize);
           memset(image,0,wholesize); /* why? - anton */
         image[0]=header[0];          image[0]=header[0];
         image[1]=header[1];          image[1]=header[1];
           image[2]=header[2];
   
         fread(image+2,1,header[1]-2*sizeof(Cell),imagefile);          fread(image+3,1,header[1]-3*sizeof(Cell),imagefile);
         fread(((void *)image)+header[0],1,((header[1]-1)/sizeof(Cell))/8+1,          fread(((void *)image)+header[1],1,((header[1]-1)/sizeof(Cell))/8+1,
               imagefile);                imagefile);
         fclose(imagefile);          fclose(imagefile);
   
         relocate(image,(char *)image+header[0],header[1],engine(0,0,0,0,0));          relocate(image,(char *)image+header[1],header[1],engine(0,0,0,0,0));
   
         return(image);          return(image);
 }  }
   
 int go_forth(int *image, int stack, Cell *entries)  int go_forth(Cell *image, int stack, Cell *entries)
 {  {
         Cell* rp=(Cell*)((void *)image+image[0]);          Cell *sp=(Cell*)((void *)image+dictsize+dsize);
         double* fp=(double*)((void *)rp-image[2]);          Address lp=(Address)((void *)sp+lsize);
         Address lp=(Address)((void *)fp-image[2]);          Float *fp=(Float *)((void *)lp+fsize);
         Cell* sp=(Cell*)((void *)lp-image[2]);          Cell *rp=(Cell*)((void *)fp+rsize);
         Cell* ip=(Cell*)(image[3]);          Xt *ip=(Xt *)(image[3]);
         int throw_code;          int throw_code;
           
         throw_ip = (Xt *)(image[4]);  
         for(;stack>0;stack--)          for(;stack>0;stack--)
                 *--sp=entries[stack-1];                  *--sp=entries[stack-1];
   
Line 128  int go_forth(int *image, int stack, Cell Line 151  int go_forth(int *image, int stack, Cell
   
                 signal_data_stack[7]=throw_code;                  signal_data_stack[7]=throw_code;
   
                 return((int)engine(image[4],signal_data_stack+7,                  return((int)engine((Xt *)image[4],signal_data_stack+7,
                                             signal_return_stack+8,0,0));                                                    signal_return_stack+8,0,0));
         }          }
   
         return((int)engine(ip,sp,rp,fp,lp));          return((int)engine(ip,sp,rp,fp,lp));
 }  }
   
 int main(int argc, char **argv, char **env)  int convsize(char *s, int elemsize)
   /* 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
      size. default is e */
 {  {
         char imagefile[256];    char *endp;
         Cell environ[3] = {(Cell)argc, (Cell)argv, (Cell)env};    int n,m;
         char* imagepath;  
   
     m = elemsize;
     n = strtoul(s,&endp,0);
     if (endp!=NULL) {
       if (strcmp(endp,"b")==0)
         m=1;
       else if (strcmp(endp,"k")==0)
         m=1024;
       else if (strcmp(endp,"M")==0)
         m=1024*1024;
       else if (strcmp(endp,"e")!=0) {
         fprintf(stderr,"%s: cannot grok size specification %s\n", progname, s);
         exit(1);
       }
     }
     return n*m;
   }
   
   int main(int argc, char **argv, char **env)
   {
           char *path, *path1;
           char *imagename="gforth.fi";
           FILE *image_file;
           int c;
             
 #if defined(i386) && defined(ALIGNMENT_CHECK)  #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;");
 #endif  #endif
         if((int)(imagepath=getenv("FORTHBIN")))  
         {  
                 strcpy(imagefile,imagepath);  
   
                 if(imagefile[strlen(imagefile)-1]!='/')  
                         imagefile[strlen(imagefile)]='/';  
         }  
         else  
         {  
                 strcpy(imagefile,DEFAULTBIN);  
   
                 if(imagefile[0]!=0 && imagefile[strlen(imagefile)-1]!='/')          progname = argv[0];
                         imagefile[strlen(imagefile)]='/';          if ((path=getenv("GFORTHPATH"))==NULL)
             path = strcpy(malloc(strlen(DEFAULTPATH)+1),DEFAULTPATH);
           opterr=0;
           while (1) {
             int option_index=0;
             static struct option opts[] = {
               {"image-file", required_argument, NULL, 'i'},
               {"dictionary-size", required_argument, NULL, 'm'},
               {"data-stack-size", required_argument, NULL, 'd'},
               {"return-stack-size", required_argument, NULL, 'r'},
               {"fp-stack-size", required_argument, NULL, 'f'},
               {"locals-stack-size", required_argument, NULL, 'l'},
               {"path", required_argument, NULL, 'p'},
               {0,0,0,0}
               /* no-init-file, no-rc? */
             };
   
             c = getopt_long(argc, argv, "+drfl", opts, &option_index);
             if (c==EOF)
               break;
             if (c=='?') {
               optind--;
               break;
             }
             switch (c) {
             case 'i': imagename = optarg; break;
             case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
             case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
             case 'r': rsize = convsize(optarg,sizeof(Cell)); break;
             case 'f': fsize = convsize(optarg,sizeof(Float)); break;
             case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
             case 'p': path = optarg; break;
             }
         }          }
           path1=path;
           do {
             char *pend=strchr(path, ':');
             if (pend==NULL)
               pend=path+strlen(path);
             if (strlen(path)==0) {
               fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n", progname, imagename, path1);
               exit(1);
             }
             {
               int dirlen=pend-path;
               char fullfilename[dirlen+strlen(imagename)+2];
               memcpy(fullfilename, path, dirlen);
               if (fullfilename[dirlen-1]!='/')
                 fullfilename[dirlen++]='/';
               strcpy(fullfilename+dirlen,imagename);
               image_file=fopen(fullfilename,"rb");
             }
             path=pend+(*pend==':');
           } while (image_file==NULL);
   
         if(argc>1 && argv[1][0]=='@')  
         {          {
                 if(argv[1][1]=='/')            Cell environ[]= {(Cell)argc-(optind-1), (Cell)(argv+(optind-1)), (Cell)path1};
                         strcpy(imagefile,argv[1]+1);            argv[optind-1] = progname;
                 else  /*
                         strcpy(imagefile+strlen(imagefile),argv[1]+1);            for (i=0; i<environ[0]; i++)
               printf("%s\n", ((char **)(environ[1]))[i]);
                 environ[0]-=1;  */
                 environ[1]+=sizeof(argv);            exit(go_forth(loader(image_file),3, environ));
                 argv[1]=argv[0];  
         }          }
         else  
                 strcpy(imagefile+strlen(imagefile),"kernal.fi");  
   
         exit(go_forth(loader(imagefile),3,environ));  
 }  }
Removed from v.1.9  
changed lines
  Added in v.1.10

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