Return to main.c CVS log

Up to [gforth] / gforth / engine

Added some documentation (files stup, blocks stub, Mini-OOF implementation)
Added Benchres for my machine
made DOS and Win32 compile and run
New gforthmi.bat script for DOS - needs a temporary file for the commands
instead of the -e option.
Added select.o again for DOS (DJGPP's select is broken wrt timing)
Improved select.c
Bug with DOS: engine-ditc doesn't compile with optimization on. Maybe I need
to get a new GCC version for DOS?

    1: /* command line interpretation, image loading etc. for Gforth
    2: 
    3: 
    4:   Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
    5: 
    6:   This file is part of Gforth.
    7: 
    8:   Gforth is free software; you can redistribute it and/or
    9:   modify it under the terms of the GNU General Public License
   10:   as published by the Free Software Foundation; either version 2
   11:   of the License, or (at your option) any later version.
   12: 
   13:   This program is distributed in the hope that it will be useful,
   14:   but WITHOUT ANY WARRANTY; without even the implied warranty of
   15:   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16:   GNU General Public License for more details.
   17: 
   18:   You should have received a copy of the GNU General Public License
   19:   along with this program; if not, write to the Free Software
   20:   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   21: */
   22: 
   23: #include "config.h"
   24: #include <errno.h>
   25: #include <ctype.h>
   26: #include <stdio.h>
   27: #include <unistd.h>
   28: #include <string.h>
   29: #include <math.h>
   30: #include <sys/types.h>
   31: #include <sys/stat.h>
   32: #include <fcntl.h>
   33: #include <assert.h>
   34: #include <stdlib.h>
   35: #ifndef STANDALONE
   36: #if HAVE_SYS_MMAN_H
   37: #include <sys/mman.h>
   38: #endif
   39: #endif
   40: #include "forth.h"
   41: #include "io.h"
   42: #include "getopt.h"
   43: #ifdef STANDALONE
   44: #include <systypes.h>
   45: #endif
   46: 
   47: #define PRIM_VERSION 1
   48: /* increment this whenever the primitives change in an incompatible way */
   49: 
   50: #ifdef MSDOS
   51: jmp_buf throw_jmp_buf;
   52: #  ifndef DEFAULTPATH
   53: #    define DEFAULTPATH "."
   54: #  endif
   55: #endif
   56: 
   57: #if defined(DIRECT_THREADED) 
   58: #  define CA(n)	(symbols[(n)])
   59: #else
   60: #  define CA(n)	((Cell)(symbols+(n)))
   61: #endif
   62: 
   63: #define maxaligned(n)	(typeof(n))((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
   64: 
   65: static UCell dictsize=0;
   66: static UCell dsize=0;
   67: static UCell rsize=0;
   68: static UCell fsize=0;
   69: static UCell lsize=0;
   70: int offset_image=0;
   71: int die_on_signal=0;
   72: #ifndef INCLUDE_IMAGE
   73: static int clear_dictionary=0;
   74: static size_t pagesize=0;
   75: #endif
   76: static int debug=0;
   77: char *progname;
   78: 
   79: /* image file format:
   80:  *  "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.3.0 -i\n")
   81:  *   padding to a multiple of 8
   82:  *   magic: "Gforth1x" means format 0.2,
   83:  *              where x is even for big endian and odd for little endian
   84:  *              and x & ~1 is the size of the cell in bytes.
   85:  *  padding to max alignment (no padding necessary on current machines)
   86:  *  ImageHeader structure (see below)
   87:  *  data (size in ImageHeader.image_size)
   88:  *  tags ((if relocatable, 1 bit/data cell)
   89:  *
   90:  * tag==1 means that the corresponding word is an address;
   91:  * If the word is >=0, the address is within the image;
   92:  * addresses within the image are given relative to the start of the image.
   93:  * If the word =-1 (CF_NIL), the address is NIL,
   94:  * If the word is <CF_NIL and >CF(DODOES), it's a CFA (:, Create, ...)
   95:  * If the word =CF(DODOES), it's a DOES> CFA
   96:  * If the word =CF(DOESJUMP), it's a DOES JUMP (2 Cells after DOES>,
   97:  *					possibly containing a jump to dodoes)
   98:  * If the word is <CF(DOESJUMP), it's a primitive
   99:  */
  100: 
  101: typedef struct {
  102:   Address base;		/* base address of image (0 if relocatable) */
  103:   UCell checksum;	/* checksum of ca's to protect against some
  104: 			   incompatible	binary/executable combinations
  105: 			   (0 if relocatable) */
  106:   UCell image_size;	/* all sizes in bytes */
  107:   UCell dict_size;
  108:   UCell data_stack_size;
  109:   UCell fp_stack_size;
  110:   UCell return_stack_size;
  111:   UCell locals_stack_size;
  112:   Xt *boot_entry;	/* initial ip for booting (in BOOT) */
  113:   Xt *throw_entry;	/* ip after signal (in THROW) */
  114:   Cell unused1;		/* possibly tib stack size */
  115:   Cell unused2;
  116:   Address data_stack_base; /* this and the following fields are initialized by the loader */
  117:   Address fp_stack_base;
  118:   Address return_stack_base;
  119:   Address locals_stack_base;
  120: } ImageHeader;
  121: /* the image-header is created in main.fs */
  122: 
  123: void relocate(Cell *image, const char *bitstring, int size, Label symbols[])
  124: {
  125:   int i=0, j, k, steps=(size/sizeof(Cell))/8;
  126:   Cell token;
  127:   char bits;
  128: /*   static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/
  129: 
  130: /*  printf("relocating %x[%x]\n", image, size); */
  131:    
  132:   for(k=0; k<=steps; k++)
  133:     for(j=0, bits=bitstring[k]; j<RELINFOBITS; j++, i++, bits<<=1) {
  134:       /*      fprintf(stderr,"relocate: image[%d]\n", i);*/
  135:       if(bits & (1U << (RELINFOBITS-1))) {
  136: 	/* fprintf(stderr,"relocate: image[%d]=%d\n", i, image[i]);*/
  137: 	if((token=image[i])<0)
  138: 	  switch(token)
  139: 	    {
  140: 	    case CF_NIL      : image[i]=0; break;
  141: #if !defined(DOUBLY_INDIRECT)
  142: 	    case CF(DOCOL)   :
  143: 	    case CF(DOVAR)   :
  144: 	    case CF(DOCON)   :
  145: 	    case CF(DOUSER)  : 
  146: 	    case CF(DODEFER) : 
  147: 	    case CF(DOFIELD) : MAKE_CF(image+i,symbols[CF(token)]); break;
  148: 	    case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
  149: #endif /* !defined(DOUBLY_INDIRECT) */
  150: 	    case CF(DODOES)  :
  151: 	      MAKE_DOES_CF(image+i,image[i+1]+((Cell)image));
  152: 	      break;
  153: 	    default          :
  154: /*	      printf("Code field generation image[%x]:=CA(%x)\n",
  155: 		     i, CF(image[i])); */
  156: 	      image[i]=(Cell)CA(CF(token));
  157: 	    }
  158: 	else
  159: 	  image[i]+=(Cell)image;
  160:       }
  161:     }
  162: }
  163: 
  164: UCell checksum(Label symbols[])
  165: {
  166:   UCell r=PRIM_VERSION;
  167:   Cell i;
  168: 
  169:   for (i=DOCOL; i<=DOESJUMP; i++) {
  170:     r ^= (UCell)(symbols[i]);
  171:     r = (r << 5) | (r >> (8*sizeof(Cell)-5));
  172:   }
  173: #ifdef DIRECT_THREADED
  174:   /* we have to consider all the primitives */
  175:   for (; symbols[i]!=(Label)0; i++) {
  176:     r ^= (UCell)(symbols[i]);
  177:     r = (r << 5) | (r >> (8*sizeof(Cell)-5));
  178:   }
  179: #else
  180:   /* in indirect threaded code all primitives are accessed through the
  181:      symbols table, so we just have to put the base address of symbols
  182:      in the checksum */
  183:   r ^= (UCell)symbols;
  184: #endif
  185:   return r;
  186: }
  187: 
  188: Address verbose_malloc(Cell size)
  189: {
  190:   Address r;
  191:   /* leave a little room (64B) for stack underflows */
  192:   if ((r = malloc(size+64))==NULL) {
  193:     perror(progname);
  194:     exit(1);
  195:   }
  196:   r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));
  197:   if (debug)
  198:     fprintf(stderr, "malloc succeeds, address=$%lx\n", (long)r);
  199:   return r;
  200: }
  201: 
  202: Address my_alloc(Cell size)
  203: {
  204: #if HAVE_MMAP
  205:   static Address next_address=0;
  206:   Address r;
  207: 
  208: #if defined(MAP_ANON)
  209:   if (debug)
  210:     fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size);
  211:   r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0);
  212: #else /* !defined(MAP_ANON) */
  213:   /* Ultrix (at least does not define MAP_FILE and MAP_PRIVATE (both are
  214:      apparently defaults*/
  215: #ifndef MAP_FILE
  216: # define MAP_FILE 0
  217: #endif
  218: #ifndef MAP_PRIVATE
  219: # define MAP_PRIVATE 0
  220: #endif
  221:   static int dev_zero=-1;
  222: 
  223:   if (dev_zero == -1)
  224:     dev_zero = open("/dev/zero", O_RDONLY);
  225:   if (dev_zero == -1) {
  226:     r = (Address)-1;
  227:     if (debug)
  228:       fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ", 
  229: 	      strerror(errno));
  230:   } else {
  231:     if (debug)
  232:       fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size);
  233:     r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0);
  234:   }
  235: #endif /* !defined(MAP_ANON) */
  236: 
  237:   if (r != (Address)-1) {
  238:     if (debug)
  239:       fprintf(stderr, "success, address=$%lx\n", (long) r);
  240:     if (pagesize != 0)
  241:       next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */
  242:     return r;
  243:   }
  244:   if (debug)
  245:     fprintf(stderr, "failed: %s\n", strerror(errno));
  246: #endif /* HAVE_MMAP */
  247:   /* use malloc as fallback */
  248:   return verbose_malloc(size);
  249: }
  250: 
  251: #if (defined(mips) && !defined(INDIRECT_THREADED))
  252: /* the 256MB jump restriction on the MIPS architecture makes the
  253:    combination of direct threading and mmap unsafe. */
  254: #define dict_alloc(size) verbose_malloc(size)
  255: #else
  256: #define dict_alloc(size) my_alloc(size)
  257: #endif
  258: 
  259: void set_stack_sizes(ImageHeader * header)
  260: {
  261:   if (dictsize==0)
  262:     dictsize = header->dict_size;
  263:   if (dsize==0)
  264:     dsize = header->data_stack_size;
  265:   if (rsize==0)
  266:     rsize = header->return_stack_size;
  267:   if (fsize==0)
  268:     fsize = header->fp_stack_size;
  269:   if (lsize==0)
  270:     lsize = header->locals_stack_size;
  271:   dictsize=maxaligned(dictsize);
  272:   dsize=maxaligned(dsize);
  273:   rsize=maxaligned(rsize);
  274:   lsize=maxaligned(lsize);
  275:   fsize=maxaligned(fsize);
  276: }
  277: 
  278: void alloc_stacks(ImageHeader * header)
  279: {
  280:   header->dict_size=dictsize;
  281:   header->data_stack_size=dsize;
  282:   header->fp_stack_size=fsize;
  283:   header->return_stack_size=rsize;
  284:   header->locals_stack_size=lsize;
  285: 
  286:   header->data_stack_base=my_alloc(dsize);
  287:   header->fp_stack_base=my_alloc(fsize);
  288:   header->return_stack_base=my_alloc(rsize);
  289:   header->locals_stack_base=my_alloc(lsize);
  290: }
  291: 
  292: int go_forth(Address image, int stack, Cell *entries)
  293: {
  294:   Cell *sp=(Cell*)(((ImageHeader *)image)->data_stack_base + dsize);
  295:   Float *fp=(Float *)(((ImageHeader *)image)->fp_stack_base + fsize);
  296:   Cell *rp=(Cell *)(((ImageHeader *)image)->return_stack_base + rsize);
  297:   Address lp=((ImageHeader *)image)->locals_stack_base + lsize;
  298:   Xt *ip=(Xt *)(((ImageHeader *)image)->boot_entry);
  299: #ifdef SYSSIGNALS
  300:   int throw_code;
  301: #endif
  302: 
  303:   /* ensure that the cached elements (if any) are accessible */
  304:   IF_TOS(sp--);
  305:   IF_FTOS(fp--);
  306:   
  307:   for(;stack>0;stack--)
  308:     *--sp=entries[stack-1];
  309: 
  310: #if !defined(MSDOS) && !defined(_WIN32) && !defined(__EMX__)
  311:   get_winsize();
  312: #endif
  313:    
  314: #ifdef SYSSIGNALS
  315:   install_signal_handlers(); /* right place? */
  316:   
  317:   if ((throw_code=setjmp(throw_jmp_buf))) {
  318:     static Cell signal_data_stack[8];
  319:     static Cell signal_return_stack[8];
  320:     static Float signal_fp_stack[1];
  321: 
  322:     signal_data_stack[7]=throw_code;
  323:     
  324:     return((int)engine(((ImageHeader *)image)->throw_entry,signal_data_stack+7,
  325: 		       signal_return_stack+8,signal_fp_stack,0));
  326:   }
  327: #endif
  328: 
  329:   return((int)engine(ip,sp,rp,fp,lp));
  330: }
  331: 
  332: #ifndef INCLUDE_IMAGE
  333: Address loader(FILE *imagefile, char* filename)
  334: /* returns the address of the image proper (after the preamble) */
  335: {
  336:   ImageHeader header;
  337:   Address image;
  338:   Address imp; /* image+preamble */
  339:   Char magic[9];
  340:   Cell preamblesize=0;
  341:   Label *symbols = engine(0,0,0,0,0);
  342:   Cell data_offset = offset_image ? 56*sizeof(Cell) : 0;
  343:   UCell check_sum;
  344:   static char* endianstring[]= { "big","little" };
  345: 
  346: #ifndef DOUBLY_INDIRECT
  347:   check_sum = checksum(symbols);
  348: #else /* defined(DOUBLY_INDIRECT) */
  349:   check_sum = (UCell)symbols;
  350: #endif /* defined(DOUBLY_INDIRECT) */
  351:   
  352:   do {
  353:     if(fread(magic,sizeof(Char),8,imagefile) < 8) {
  354:       fprintf(stderr,"%s: image %s doesn't seem to be a Gforth (>=0.2) image.\n",
  355: 	      progname, filename);
  356:       exit(1);
  357:     }
  358:     preamblesize+=8;
  359:   } while(memcmp(magic,"Gforth1",7));
  360:   if (debug) {
  361:     magic[8]='\0';
  362:     fprintf(stderr,"Magic found: %s\n", magic);
  363:   }
  364: 
  365:   if(magic[7] != sizeof(Cell) +
  366: #ifdef WORDS_BIGENDIAN
  367:        '0'
  368: #else
  369:        '1'
  370: #endif
  371:        )
  372:     { fprintf(stderr,"This image is %d bit %s-endian, whereas the machine is %d bit %s-endian.\n", 
  373: 	      ((magic[7]-'0')&~1)*8, endianstring[magic[7]&1],
  374: 	      (int) sizeof(Cell)*8, endianstring[
  375: #ifdef WORDS_BIGENDIAN
  376: 		      0
  377: #else
  378: 		      1
  379: #endif
  380: 		      ]);
  381:       exit(-2);
  382:     };
  383: 
  384:   fread((void *)&header,sizeof(ImageHeader),1,imagefile);
  385: 
  386:   set_stack_sizes(&header);
  387:   
  388: #if HAVE_GETPAGESIZE
  389:   pagesize=getpagesize(); /* Linux/GNU libc offers this */
  390: #elif HAVE_SYSCONF && defined(_SC_PAGESIZE)
  391:   pagesize=sysconf(_SC_PAGESIZE); /* POSIX.4 */
  392: #elif PAGESIZE
  393:   pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */
  394: #endif
  395:   if (debug)
  396:     fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize);
  397: 
  398:   image = dict_alloc(preamblesize+dictsize+data_offset)+data_offset;
  399:   rewind(imagefile);  /* fseek(imagefile,0L,SEEK_SET); */
  400:   if (clear_dictionary)
  401:     memset(image, 0, dictsize);
  402:   fread(image, 1, preamblesize+header.image_size, imagefile);
  403:   imp=image+preamblesize;
  404:   if(header.base==0) {
  405:     Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1;
  406:     char reloc_bits[reloc_size];
  407:     fread(reloc_bits, 1, reloc_size, imagefile);
  408:     relocate((Cell *)imp, reloc_bits, header.image_size, symbols);
  409: #if 0
  410:     { /* let's see what the relocator did */
  411:       FILE *snapshot=fopen("snapshot.fi","wb");
  412:       fwrite(image,1,imagesize,snapshot);
  413:       fclose(snapshot);
  414:     }
  415: #endif
  416:   }
  417:   else if(header.base!=imp) {
  418:     fprintf(stderr,"%s: Cannot load nonrelocatable image (compiled for address $%lx) at address $%lx\n",
  419: 	    progname, (unsigned long)header.base, (unsigned long)imp);
  420:     exit(1);
  421:   }
  422:   if (header.checksum==0)
  423:     ((ImageHeader *)imp)->checksum=check_sum;
  424:   else if (header.checksum != check_sum) {
  425:     fprintf(stderr,"%s: Checksum of image ($%lx) does not match the executable ($%lx)\n",
  426: 	    progname, (unsigned long)(header.checksum),(unsigned long)check_sum);
  427:     exit(1);
  428:   }
  429:   fclose(imagefile);
  430: 
  431:   alloc_stacks((ImageHeader *)imp);
  432: 
  433:   CACHE_FLUSH(imp, header.image_size);
  434: 
  435:   return imp;
  436: }
  437: 
  438: int onlypath(char *file)
  439: {
  440:   int i;
  441:   i=strlen(file);
  442:   while (i) {
  443:     if (file[i]=='\\' || file[i]=='/') break;
  444:     i--;
  445:   }
  446:   return i;
  447: }
  448: 
  449: FILE *openimage(char *fullfilename)
  450: {
  451:   FILE *image_file;
  452: 
  453:   image_file=fopen(fullfilename,"rb");
  454:   if (image_file!=NULL && debug)
  455:     fprintf(stderr, "Opened image file: %s\n", fullfilename);
  456:   return image_file;
  457: }
  458: 
  459: FILE *checkimage(char *path, int len, char *imagename)
  460: {
  461:   int dirlen=len;
  462:   char fullfilename[dirlen+strlen(imagename)+2];
  463: 
  464:   memcpy(fullfilename, path, dirlen);
  465:   if (fullfilename[dirlen-1]!='/')
  466:     fullfilename[dirlen++]='/';
  467:   strcpy(fullfilename+dirlen,imagename);
  468:   return openimage(fullfilename);
  469: }
  470: 
  471: FILE * open_image_file(char * imagename, char * path)
  472: {
  473:   FILE * image_file=NULL;
  474:   
  475:   if(strchr(imagename, '/')==NULL) {
  476:     /* first check the directory where the exe file is in !! 01may97jaw */
  477:     if (onlypath(progname))
  478:       image_file=checkimage(progname, onlypath(progname), imagename);
  479:     if (!image_file)
  480:       do {
  481: 	char *pend=strchr(path, PATHSEP);
  482: 	if (pend==NULL)
  483: 	  pend=path+strlen(path);
  484: 	if (strlen(path)==0) break;
  485: 	image_file=checkimage(path, pend-path, imagename);
  486: 	path=pend+(*pend==PATHSEP);
  487:       } while (image_file==NULL);
  488:   } else {
  489:     image_file=openimage(imagename);
  490:   }
  491: 
  492:   if (!image_file) {
  493:     fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n",
  494: 	    progname, imagename, path);
  495:     exit(1);
  496:   }
  497: 
  498:   return image_file;
  499: }
  500: #endif
  501: 
  502: #ifdef HAS_OS
  503: UCell convsize(char *s, UCell elemsize)
  504: /* converts s of the format [0-9]+[bekMGT]? (e.g. 25k) into the number
  505:    of bytes.  the letter at the end indicates the unit, where e stands
  506:    for the element size. default is e */
  507: {
  508:   char *endp;
  509:   UCell n,m;
  510: 
  511:   m = elemsize;
  512:   n = strtoul(s,&endp,0);
  513:   if (endp!=NULL) {
  514:     if (strcmp(endp,"b")==0)
  515:       m=1;
  516:     else if (strcmp(endp,"k")==0)
  517:       m=1024;
  518:     else if (strcmp(endp,"M")==0)
  519:       m=1024*1024;
  520:     else if (strcmp(endp,"G")==0)
  521:       m=1024*1024*1024;
  522:     else if (strcmp(endp,"T")==0) {
  523: #if (SIZEOF_CHAR_P > 4)
  524:       m=1024*1024*1024*1024;
  525: #else
  526:       fprintf(stderr,"%s: size specification \"%s\" too large for this machine\n", progname, endp);
  527:       exit(1);
  528: #endif
  529:     } else if (strcmp(endp,"e")!=0 && strcmp(endp,"")!=0) {
  530:       fprintf(stderr,"%s: cannot grok size specification %s: invalid unit \"%s\"\n", progname, s, endp);
  531:       exit(1);
  532:     }
  533:   }
  534:   return n*m;
  535: }
  536: 
  537: void gforth_args(int argc, char ** argv, char ** path, char ** imagename)
  538: {
  539:   int c;
  540: 
  541:   opterr=0;
  542:   while (1) {
  543:     int option_index=0;
  544:     static struct option opts[] = {
  545:       {"image-file", required_argument, NULL, 'i'},
  546:       {"dictionary-size", required_argument, NULL, 'm'},
  547:       {"data-stack-size", required_argument, NULL, 'd'},
  548:       {"return-stack-size", required_argument, NULL, 'r'},
  549:       {"fp-stack-size", required_argument, NULL, 'f'},
  550:       {"locals-stack-size", required_argument, NULL, 'l'},
  551:       {"path", required_argument, NULL, 'p'},
  552:       {"version", no_argument, NULL, 'v'},
  553:       {"help", no_argument, NULL, 'h'},
  554:       /* put something != 0 into offset_image */
  555:       {"offset-image", no_argument, &offset_image, 1},
  556:       {"no-offset-im", no_argument, &offset_image, 0},
  557:       {"clear-dictionary", no_argument, &clear_dictionary, 1},
  558:       {"die-on-signal", no_argument, &die_on_signal, 1},
  559:       {"debug", no_argument, &debug, 1},
  560:       {0,0,0,0}
  561:       /* no-init-file, no-rc? */
  562:     };
  563:     
  564:     c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:vh", opts, &option_index);
  565:     
  566:     if (c==EOF)
  567:       break;
  568:     if (c=='?') {
  569:       optind--;
  570:       break;
  571:     }
  572:     switch (c) {
  573:     case 'i': *imagename = optarg; break;
  574:     case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
  575:     case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
  576:     case 'r': rsize = convsize(optarg,sizeof(Cell)); break;
  577:     case 'f': fsize = convsize(optarg,sizeof(Float)); break;
  578:     case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
  579:     case 'p': *path = optarg; break;
  580:     case 'v': fprintf(stderr, "gforth %s\n", VERSION); exit(0);
  581:     case 'h': 
  582:       fprintf(stderr, "Usage: %s [engine options] [image arguments]\n\
  583: Engine Options:\n\
  584:   --clear-dictionary		    Initialize the dictionary with 0 bytes\n\
  585:   -d SIZE, --data-stack-size=SIZE   Specify data stack size\n\
  586:   --debug			    Print debugging information during startup\n\
  587:   --die-on-signal		    exit instead of CATCHing some signals\n\
  588:   -f SIZE, --fp-stack-size=SIZE	    Specify floating point stack size\n\
  589:   -h, --help			    Print this message and exit\n\
  590:   -i FILE, --image-file=FILE	    Use image FILE instead of `gforth.fi'\n\
  591:   -l SIZE, --locals-stack-size=SIZE Specify locals stack size\n\
  592:   -m SIZE, --dictionary-size=SIZE   Specify Forth dictionary size\n\
  593:   --no-offset-im		    Load image at normal position\n\
  594:   --offset-image		    Load image at a different position\n\
  595:   -p PATH, --path=PATH		    Search path for finding image and sources\n\
  596:   -r SIZE, --return-stack-size=SIZE Specify return stack size\n\
  597:   -v, --version			    Print version and exit\n\
  598: SIZE arguments consist of an integer followed by a unit. The unit can be\n\
  599:   `b' (byte), `e' (element; default), `k' (KB), `M' (MB), `G' (GB) or `T' (TB).\n",
  600: 	      argv[0]);
  601:       optind--;
  602:       return;
  603:       exit(0);
  604:     }
  605:   }
  606: }
  607: #endif
  608: 
  609: #ifdef INCLUDE_IMAGE
  610: extern Cell image[];
  611: extern const char reloc_bits[];
  612: #endif
  613: 
  614: int main(int argc, char **argv, char **env)
  615: {
  616:   char *path = getenv("GFORTHPATH") ? : DEFAULTPATH;
  617: #ifndef INCLUDE_IMAGE
  618:   char *imagename="gforth.fi";
  619:   FILE *image_file;
  620:   Address image;
  621: #endif
  622:   int retvalue;
  623: 	  
  624: #if defined(i386) && defined(ALIGNMENT_CHECK) && !defined(DIRECT_THREADED)
  625:   /* turn on alignment checks on the 486.
  626:    * on the 386 this should have no effect. */
  627:   __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");
  628:   /* this is unusable with Linux' libc.4.6.27, because this library is
  629:      not alignment-clean; we would have to replace some library
  630:      functions (e.g., memcpy) to make it work. Also GCC doesn't try to keep
  631:      the stack FP-aligned. */
  632: #endif
  633: 
  634:   /* buffering of the user output device */
  635: #ifdef _IONBF
  636:   if (isatty(fileno(stdout))) {
  637:     fflush(stdout);
  638:     setvbuf(stdout,NULL,_IONBF,0);
  639:   }
  640: #endif
  641: 
  642:   progname = argv[0];
  643: 
  644: #ifdef HAS_OS
  645:   gforth_args(argc, argv, &path, &imagename);
  646: #endif
  647: 
  648: #ifdef INCLUDE_IMAGE
  649:   set_stack_sizes((ImageHeader *)image);
  650:   relocate(image, reloc_bits, ((ImageHeader*)&image)->image_size, (Label*)engine(0, 0, 0, 0, 0));
  651:   alloc_stacks((ImageHeader *)image);
  652: #else
  653:   image_file = open_image_file(imagename, path);
  654:   image = loader(image_file, imagename);
  655: #endif
  656: 
  657:   {
  658:     char path2[strlen(path)+1];
  659:     char *p1, *p2;
  660:     Cell environ[]= {
  661:       (Cell)argc-(optind-1),
  662:       (Cell)(argv+(optind-1)),
  663:       (Cell)strlen(path),
  664:       (Cell)path2};
  665:     argv[optind-1] = progname;
  666:     /*
  667:        for (i=0; i<environ[0]; i++)
  668:        printf("%s\n", ((char **)(environ[1]))[i]);
  669:        */
  670:     /* make path OS-independent by replacing path separators with NUL */
  671:     for (p1=path, p2=path2; *p1!='\0'; p1++, p2++)
  672:       if (*p1==PATHSEP)
  673: 	*p2 = '\0';
  674:       else
  675: 	*p2 = *p1;
  676:     *p2='\0';
  677:     retvalue = go_forth(image, 4, environ);
  678:     deprep_terminal();
  679:   }
  680:   return retvalue;
  681: }