File:  [gforth] / gforth / engine / main.c
Revision 1.29: download - view: text, annotated - select for diffs
Sat Jul 24 13:07:23 1999 UTC (24 years, 8 months ago) by anton
Branches: MAIN
CVS tags: HEAD
added engine option --appl-image and gforthmi option --application
minor objects.fs changes

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

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