Return to main.c CVS log

Up to [gforth] / gforth

float.fs: Added f~ (f-proximate)
wordsets.fs: Added missing float words
Added 16 bit and 64 bit support in cross.fs
Fixed some bugs which asume sizeof(int)=sizeof(Cell)

    1: /*
    2:   $Id: main.c,v 1.21 1995/01/19 17:48:08 pazsan Exp $
    3:   Copyright 1993 by the ANSI figForth Development Group
    4: */
    5: 
    6: #include <ctype.h>
    7: #include <stdio.h>
    8: #include <string.h>
    9: #include <math.h>
   10: #include <sys/types.h>
   11: #include <sys/stat.h>
   12: #include <fcntl.h>
   13: #include <assert.h>
   14: #include <stdlib.h>
   15: #include "forth.h"
   16: #include "io.h"
   17: #include "getopt.h"
   18: 
   19: #ifndef DEFAULTPATH
   20: #  define DEFAULTPATH "/usr/local/lib/gforth:."
   21: #endif
   22: 
   23: #ifdef DIRECT_THREADED
   24: #  define CA(n)	(symbols[(n)])
   25: #else
   26: #  define CA(n)	((Cell)(symbols+(n)))
   27: #endif
   28: 
   29: #define maxaligned(n)	((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
   30: 
   31: static Cell dictsize=0;
   32: static Cell dsize=0;
   33: static Cell rsize=0;
   34: static Cell fsize=0;
   35: static Cell lsize=0;
   36: char *progname;
   37: 
   38: 
   39: /* image file format:
   40:  *   preamble (is skipped off), size multiple of 8
   41:  *   magig: "gforth00" (means format version 0.0)
   42:  *   size of image with stacks without tags (in bytes)
   43:  *   size of image without stacks and tags (in bytes)
   44:  *   size of data and FP stack (in bytes)
   45:  *   pointer to start of code
   46:  *   pointer into throw (for signal handling)
   47:  *   pointer to dictionary
   48:  *   data (size in image[1])
   49:  *   tags (1 bit/data cell)
   50:  *
   51:  * tag==1 mean that the corresponding word is an address;
   52:  * If the word is >=0, the address is within the image;
   53:  * addresses within the image are given relative to the start of the image.
   54:  * If the word is =-1, the address is NIL,
   55:  * If the word is between -2 and -5, it's a CFA (:, Create, Constant, User)
   56:  * If the word is -6, it's a DOES> CFA
   57:  * If the word is -7, it's a DOES JUMP
   58:  * If the word is <-7, it's a primitive
   59:  */
   60: 
   61: void relocate(Cell *image, char *bitstring, int size, Label symbols[])
   62: {
   63:   int i=0, j, k, steps=(size/sizeof(Cell))/8;
   64:   char bits;
   65: /*   static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/
   66:    
   67:   for(k=0; k<=steps; k++)
   68:     for(j=0, bits=bitstring[k]; j<8; j++, i++, bits<<=1)
   69:       if(bits & 0x80)
   70: 	if(image[i]<0)
   71: 	  switch(image[i])
   72: 	    {
   73: 	    case CF_NIL      : image[i]=0; break;
   74: 	    case CF(DOCOL)   :
   75: 	    case CF(DOVAR)   :
   76: 	    case CF(DOCON)   :
   77: 	    case CF(DOUSER)  : 
   78: 	    case CF(DODEFER) : MAKE_CF(image+i,symbols[CF(image[i])]); break;
   79: 	    case CF(DODOES)  : MAKE_DOES_CF(image+i,image[i+1]+((Cell)image));
   80: 	      break;
   81: 	    case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
   82: 	    default          : image[i]=(Cell)CA(CF(image[i]));
   83: 	    }
   84: 	else
   85: 	  image[i]+=(Cell)image;
   86: }
   87: 
   88: Cell *loader(FILE *imagefile)
   89: {
   90:   Cell header[3];
   91:   Cell *image;
   92:   Char magic[8];
   93:   int wholesize;
   94:   int imagesize; /* everything needed by the image */
   95: 
   96:   do
   97:     {
   98:       if(fread(magic,sizeof(Char),8,imagefile) < 8) {
   99: 	fprintf(stderr,"This file doesn't seem to be a gforth image\n");
  100: 	exit(1);
  101:       }
  102: #ifdef DEBUG
  103:       printf("Magic found: %s\n",magic);
  104: #endif
  105:     }
  106:   while(memcmp(magic,"gforth00",8));
  107: 
  108:   fread(header,sizeof(Cell),3,imagefile);
  109:   if (dictsize==0)
  110:     dictsize = header[0];
  111:   if (dsize==0)
  112:     dsize=header[2];
  113:   if (rsize==0)
  114:     rsize=header[2];
  115:   if (fsize==0)
  116:     fsize=header[2];
  117:   if (lsize==0)
  118:     lsize=header[2];
  119:   dictsize=maxaligned(dictsize);
  120:   dsize=maxaligned(dsize);
  121:   rsize=maxaligned(rsize);
  122:   lsize=maxaligned(lsize);
  123:   fsize=maxaligned(fsize);
  124:   
  125:   wholesize = dictsize+dsize+rsize+fsize+lsize;
  126:   imagesize = header[1]+((header[1]-1)/sizeof(Cell))/8+1;
  127:   image=malloc(wholesize>imagesize?wholesize:imagesize);
  128:   memset(image,0,wholesize); /* why? - anton */
  129:   image[0]=header[0];
  130:   image[1]=header[1];
  131:   image[2]=header[2];
  132:   
  133:   fread(image+3,1,header[1]-3*sizeof(Cell),imagefile);
  134:   fread(((void *)image)+header[1],1,((header[1]-1)/sizeof(Cell))/8+1,
  135: 	imagefile);
  136:   fclose(imagefile);
  137:   
  138:   if(image[5]==0) {
  139:     relocate(image,(char *)image+header[1],header[1],engine(0,0,0,0,0));
  140:   }
  141:   else if(image[5]!=(Cell)image) {
  142:     fprintf(stderr,"Corrupted image address, please recompile image\n");
  143:     exit(1);
  144:   }
  145: 
  146:   CACHE_FLUSH(image,image[1]);
  147:   
  148:   return(image);
  149: }
  150: 
  151: int go_forth(Cell *image, int stack, Cell *entries)
  152: {
  153:   Cell *sp=(Cell*)((void *)image+dictsize+dsize);
  154:   Address lp=(Address)((void *)sp+lsize);
  155:   Float *fp=(Float *)((void *)lp+fsize);
  156:   Cell *rp=(Cell*)((void *)fp+rsize);
  157:   Xt *ip=(Xt *)((Cell)image[3]);
  158:   int throw_code;
  159:   
  160:   for(;stack>0;stack--)
  161:     *--sp=entries[stack-1];
  162:   
  163:   install_signal_handlers(); /* right place? */
  164:   
  165:   if ((throw_code=setjmp(throw_jmp_buf))) {
  166:     static Cell signal_data_stack[8];
  167:     static Cell signal_return_stack[8];
  168:     static Float signal_fp_stack[1];
  169:     
  170:     signal_data_stack[7]=throw_code;
  171:     
  172:     return((int)engine((Xt *)image[4],signal_data_stack+7,
  173: 		       signal_return_stack+8,signal_fp_stack,0));
  174:   }
  175:   
  176:   return((int)engine(ip,sp,rp,fp,lp));
  177: }
  178: 
  179: int convsize(char *s, int elemsize)
  180: /* converts s of the format #+u (e.g. 25k) into the number of bytes.
  181:    the unit u can be one of bekM, where e stands for the element
  182:    size. default is e */
  183: {
  184:   char *endp;
  185:   int n,m;
  186: 
  187:   m = elemsize;
  188:   n = strtoul(s,&endp,0);
  189:   if (endp!=NULL) {
  190:     if (strcmp(endp,"b")==0)
  191:       m=1;
  192:     else if (strcmp(endp,"k")==0)
  193:       m=1024;
  194:     else if (strcmp(endp,"M")==0)
  195:       m=1024*1024;
  196:     else if (strcmp(endp,"e")!=0) {
  197:       fprintf(stderr,"%s: cannot grok size specification %s\n", progname, s);
  198:       exit(1);
  199:     }
  200:   }
  201:   return n*m;
  202: }
  203: 
  204: int main(int argc, char **argv, char **env)
  205: {
  206:   char *path, *path1;
  207:   char *imagename="gforth.fi";
  208:   FILE *image_file;
  209:   int c, retvalue;
  210: 	  
  211: #if defined(i386) && defined(ALIGNMENT_CHECK) && !defined(DIRECT_THREADED)
  212: 	/* turn on alignment checks on the 486.
  213: 	 * on the 386 this should have no effect. */
  214: 	__asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");
  215: #endif
  216: 
  217:   progname = argv[0];
  218:   if ((path=getenv("GFORTHPATH"))==NULL)
  219:     path = strcpy(malloc(strlen(DEFAULTPATH)+1),DEFAULTPATH);
  220:   opterr=0;
  221:   while (1) {
  222:     int option_index=0;
  223:     static struct option opts[] = {
  224:       {"image-file", required_argument, NULL, 'i'},
  225:       {"dictionary-size", required_argument, NULL, 'm'},
  226:       {"data-stack-size", required_argument, NULL, 'd'},
  227:       {"return-stack-size", required_argument, NULL, 'r'},
  228:       {"fp-stack-size", required_argument, NULL, 'f'},
  229:       {"locals-stack-size", required_argument, NULL, 'l'},
  230:       {"path", required_argument, NULL, 'p'},
  231:       {0,0,0,0}
  232:       /* no-init-file, no-rc? */
  233:     };
  234: 
  235:     c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:", opts, &option_index);
  236: 
  237:     if (c==EOF)
  238:       break;
  239:     if (c=='?') {
  240:       optind--;
  241:       break;
  242:     }
  243:     switch (c) {
  244:     case 'i': imagename = optarg; break;
  245:     case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
  246:     case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
  247:     case 'r': rsize = convsize(optarg,sizeof(Cell)); break;
  248:     case 'f': fsize = convsize(optarg,sizeof(Float)); break;
  249:     case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
  250:     case 'p': path = optarg; break;
  251:     }
  252:   }
  253:   path1=path;
  254:   do {
  255:     char *pend=strchr(path, ':');
  256:     if (pend==NULL)
  257:       pend=path+strlen(path);
  258:     if (strlen(path)==0) {
  259:       fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n",
  260: 	      progname, imagename, path1);
  261:       exit(1);
  262:     }
  263:     {
  264:       int dirlen=pend-path;
  265:       char fullfilename[dirlen+strlen(imagename)+2];
  266:       memcpy(fullfilename, path, dirlen);
  267:       if (fullfilename[dirlen-1]!='/')
  268: 	fullfilename[dirlen++]='/';
  269:       strcpy(fullfilename+dirlen,imagename);
  270:       image_file=fopen(fullfilename,"rb");
  271:     }
  272:     path=pend+(*pend==':');
  273:   } while (image_file==NULL);
  274:   
  275:   {
  276:     Cell environ[]= {
  277:       (Cell)argc-(optind-1),
  278:       (Cell)(argv+(optind-1)),
  279:       (Cell)path1};
  280:     argv[optind-1] = progname;
  281:     /*
  282:        for (i=0; i<environ[0]; i++)
  283:        printf("%s\n", ((char **)(environ[1]))[i]);
  284:        */
  285:     retvalue=go_forth(loader(image_file),3,environ);
  286:     deprep_terminal();
  287:     exit(retvalue);
  288:   }
  289: }