File:  [gforth] / gforth / engine / main.c
Revision 1.71: download - view: text, annotated - select for diffs
Sun Nov 24 21:02:04 2002 UTC (21 years, 4 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Added check for directory separation

    1: /* command line interpretation, image loading etc. for Gforth
    2: 
    3: 
    4:   Copyright (C) 1995,1996,1997,1998,2000 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., 59 Temple Place, Suite 330, Boston, MA 02111, 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: #ifndef STANDALONE
   32: #include <sys/stat.h>
   33: #endif
   34: #include <fcntl.h>
   35: #include <assert.h>
   36: #include <stdlib.h>
   37: #ifndef STANDALONE
   38: #if HAVE_SYS_MMAN_H
   39: #include <sys/mman.h>
   40: #endif
   41: #endif
   42: #include "forth.h"
   43: #include "io.h"
   44: #include "getopt.h"
   45: #ifdef STANDALONE
   46: #include <systypes.h>
   47: #endif
   48: 
   49: #define PRIM_VERSION 1
   50: /* increment this whenever the primitives change in an incompatible way */
   51: 
   52: #ifndef DEFAULTPATH
   53: #  define DEFAULTPATH "."
   54: #endif
   55: 
   56: #ifdef MSDOS
   57: jmp_buf throw_jmp_buf;
   58: #endif
   59: 
   60: #if defined(DOUBLY_INDIRECT)
   61: #  define CFA(n)	({Cell _n = (n); ((Cell)(((_n & 0x4000) ? symbols : xts)+(_n&~0x4000UL)));})
   62: #else
   63: #  define CFA(n)	((Cell)(symbols+((n)&~0x4000UL)))
   64: #endif
   65: 
   66: #define maxaligned(n)	(typeof(n))((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
   67: 
   68: static UCell dictsize=0;
   69: static UCell dsize=0;
   70: static UCell rsize=0;
   71: static UCell fsize=0;
   72: static UCell lsize=0;
   73: int offset_image=0;
   74: int die_on_signal=0;
   75: #ifndef INCLUDE_IMAGE
   76: static int clear_dictionary=0;
   77: UCell pagesize=1;
   78: char *progname;
   79: #else
   80: char *progname = "gforth";
   81: int optind = 1;
   82: #endif
   83: 
   84: Address code_area=0;
   85: Address code_here=0; /* does for code-area what HERE does for the dictionary */
   86: Address start_flush=0; /* start of unflushed code */
   87: 
   88: static int no_super=0;   /* true if compile_prim should not fuse prims */
   89: /* --no-dynamic by default on gcc versions >=3.1 (it works with 3.0.4,
   90:    but not with 3.2) */
   91: #if (__GNUC__>2 && __GNUC_MINOR__>=1)
   92: static int no_dynamic=1; /* true if compile_prim should not generate code */
   93: #else
   94: static int no_dynamic=0; /* true if compile_prim should not generate code */
   95: #endif
   96: 
   97: #ifdef HAS_DEBUG
   98: int debug=0;
   99: #else
  100: # define perror(x...)
  101: # define fprintf(x...)
  102: #endif
  103: 
  104: ImageHeader *gforth_header;
  105: Label *vm_prims;
  106: #ifdef DOUBLY_INDIRECT
  107: Label *xts; /* same content as vm_prims, but should only be used for xts */
  108: #endif
  109: 
  110: #ifdef MEMCMP_AS_SUBROUTINE
  111: int gforth_memcmp(const char * s1, const char * s2, size_t n)
  112: {
  113:   return memcmp(s1, s2, n);
  114: }
  115: #endif
  116: 
  117: /* image file format:
  118:  *  "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n")
  119:  *   padding to a multiple of 8
  120:  *   magic: "Gforth2x" means format 0.4,
  121:  *              where x is a byte with
  122:  *              bit 7:   reserved = 0
  123:  *              bit 6:5: address unit size 2^n octets
  124:  *              bit 4:3: character size 2^n octets
  125:  *              bit 2:1: cell size 2^n octets
  126:  *              bit 0:   endian, big=0, little=1.
  127:  *  The magic are always 8 octets, no matter what the native AU/character size is
  128:  *  padding to max alignment (no padding necessary on current machines)
  129:  *  ImageHeader structure (see forth.h)
  130:  *  data (size in ImageHeader.image_size)
  131:  *  tags ((if relocatable, 1 bit/data cell)
  132:  *
  133:  * tag==1 means that the corresponding word is an address;
  134:  * If the word is >=0, the address is within the image;
  135:  * addresses within the image are given relative to the start of the image.
  136:  * If the word =-1 (CF_NIL), the address is NIL,
  137:  * If the word is <CF_NIL and >CF(DODOES), it's a CFA (:, Create, ...)
  138:  * If the word =CF(DODOES), it's a DOES> CFA
  139:  * If the word =CF(DOESJUMP), it's a DOES JUMP (2 Cells after DOES>,
  140:  *					possibly containing a jump to dodoes)
  141:  * If the word is <CF(DOESJUMP) and bit 14 is set, it's the xt of a primitive
  142:  * If the word is <CF(DOESJUMP) and bit 14 is clear, 
  143:  *                                        it's the threaded code of a primitive
  144:  */
  145: 
  146: void relocate(Cell *image, const char *bitstring, 
  147:               int size, int base, Label symbols[])
  148: {
  149:   int i=0, j, k, steps=(size/sizeof(Cell))/RELINFOBITS;
  150:   Cell token;
  151:   char bits;
  152:   Cell max_symbols;
  153:   /* 
  154:    * A virtial start address that's the real start address minus 
  155:    * the one in the image 
  156:    */
  157:   Cell *start = (Cell * ) (((void *) image) - ((void *) base));
  158: 
  159:   
  160: /* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */
  161:   
  162:   for (max_symbols=DOESJUMP+1; symbols[max_symbols]!=0; max_symbols++)
  163:     ;
  164:   max_symbols--;
  165:   size/=sizeof(Cell);
  166: 
  167:   for(k=0; k<=steps; k++) {
  168:     for(j=0, bits=bitstring[k]; j<RELINFOBITS; j++, i++, bits<<=1) {
  169:       /*      fprintf(stderr,"relocate: image[%d]\n", i);*/
  170:       if((i < size) && (bits & (1U << (RELINFOBITS-1)))) {
  171: 	/* fprintf(stderr,"relocate: image[%d]=%d of %d\n", i, image[i], size/sizeof(Cell)); */
  172:         token=image[i];
  173: 	if(token<0)
  174: 	  switch(token|0x4000)
  175: 	    {
  176: 	    case CF_NIL      : image[i]=0; break;
  177: #if !defined(DOUBLY_INDIRECT)
  178: 	    case CF(DOCOL)   :
  179: 	    case CF(DOVAR)   :
  180: 	    case CF(DOCON)   :
  181: 	    case CF(DOUSER)  : 
  182: 	    case CF(DODEFER) : 
  183: 	    case CF(DOFIELD) : MAKE_CF(image+i,symbols[CF(token)]); break;
  184: 	    case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
  185: #endif /* !defined(DOUBLY_INDIRECT) */
  186: 	    case CF(DODOES)  :
  187: 	      MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)start)));
  188: 	      break;
  189: 	    default          :
  190: /*	      printf("Code field generation image[%x]:=CFA(%x)\n",
  191: 		     i, CF(image[i])); */
  192: 	      if (CF((token | 0x4000))<max_symbols) {
  193: 		image[i]=(Cell)CFA(CF(token));
  194: #ifdef DIRECT_THREADED
  195: 		if ((token & 0x4000) == 0) /* threade code, no CFA */
  196: 		  compile_prim1(&image[i]);
  197: #endif
  198: 	      } else
  199: 		fprintf(stderr,"Primitive %d used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n",CF(token),(long)&image[i],VERSION);
  200: 	    }
  201: 	else {
  202:           // if base is > 0: 0 is a null reference so don't adjust
  203:           if (token>=base) {
  204:             image[i]+=(Cell)start;
  205:           }
  206:         }
  207:       }
  208:     }
  209:   }
  210:   finish_code();
  211:   ((ImageHeader*)(image))->base = (Address) image;
  212: }
  213: 
  214: UCell checksum(Label symbols[])
  215: {
  216:   UCell r=PRIM_VERSION;
  217:   Cell i;
  218: 
  219:   for (i=DOCOL; i<=DOESJUMP; i++) {
  220:     r ^= (UCell)(symbols[i]);
  221:     r = (r << 5) | (r >> (8*sizeof(Cell)-5));
  222:   }
  223: #ifdef DIRECT_THREADED
  224:   /* we have to consider all the primitives */
  225:   for (; symbols[i]!=(Label)0; i++) {
  226:     r ^= (UCell)(symbols[i]);
  227:     r = (r << 5) | (r >> (8*sizeof(Cell)-5));
  228:   }
  229: #else
  230:   /* in indirect threaded code all primitives are accessed through the
  231:      symbols table, so we just have to put the base address of symbols
  232:      in the checksum */
  233:   r ^= (UCell)symbols;
  234: #endif
  235:   return r;
  236: }
  237: 
  238: Address verbose_malloc(Cell size)
  239: {
  240:   Address r;
  241:   /* leave a little room (64B) for stack underflows */
  242:   if ((r = malloc(size+64))==NULL) {
  243:     perror(progname);
  244:     exit(1);
  245:   }
  246:   r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));
  247:   if (debug)
  248:     fprintf(stderr, "malloc succeeds, address=$%lx\n", (long)r);
  249:   return r;
  250: }
  251: 
  252: static Address next_address=0;
  253: void after_alloc(Address r, Cell size)
  254: {
  255:   if (r != (Address)-1) {
  256:     if (debug)
  257:       fprintf(stderr, "success, address=$%lx\n", (long) r);
  258:     if (pagesize != 1)
  259:       next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */
  260:   } else {
  261:     if (debug)
  262:       fprintf(stderr, "failed: %s\n", strerror(errno));
  263:   }
  264: }
  265: 
  266: #ifndef MAP_FAILED
  267: #define MAP_FAILED ((Address) -1)
  268: #endif
  269: #ifndef MAP_FILE
  270: # define MAP_FILE 0
  271: #endif
  272: #ifndef MAP_PRIVATE
  273: # define MAP_PRIVATE 0
  274: #endif
  275: 
  276: #if defined(HAVE_MMAP)
  277: static Address alloc_mmap(Cell size)
  278: {
  279:   Address r;
  280: 
  281: #if defined(MAP_ANON)
  282:   if (debug)
  283:     fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size);
  284:   r = mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0);
  285: #else /* !defined(MAP_ANON) */
  286:   /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are
  287:      apparently defaults) */
  288:   static int dev_zero=-1;
  289: 
  290:   if (dev_zero == -1)
  291:     dev_zero = open("/dev/zero", O_RDONLY);
  292:   if (dev_zero == -1) {
  293:     r = MAP_FAILED;
  294:     if (debug)
  295:       fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ", 
  296: 	      strerror(errno));
  297:   } else {
  298:     if (debug)
  299:       fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size);
  300:     r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0);
  301:   }
  302: #endif /* !defined(MAP_ANON) */
  303:   after_alloc(r, size);
  304:   return r;  
  305: }
  306: #endif
  307: 
  308: Address my_alloc(Cell size)
  309: {
  310: #if HAVE_MMAP
  311:   Address r;
  312: 
  313:   r=alloc_mmap(size);
  314:   if (r!=MAP_FAILED)
  315:     return r;
  316: #endif /* HAVE_MMAP */
  317:   /* use malloc as fallback */
  318:   return verbose_malloc(size);
  319: }
  320: 
  321: Address dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)
  322: {
  323:   Address image = MAP_FAILED;
  324: 
  325: #if defined(HAVE_MMAP)
  326:   if (offset==0) {
  327:     image=alloc_mmap(dictsize);
  328:     if (debug)
  329:       fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);
  330:     image = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE, fileno(file), 0);
  331:     after_alloc(image,dictsize);
  332:   }
  333: #endif /* defined(HAVE_MMAP) */
  334:   if (image == MAP_FAILED) {
  335:     image = my_alloc(dictsize+offset)+offset;
  336:     rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */
  337:     fread(image, 1, imagesize, file);
  338:   }
  339:   return image;
  340: }
  341: 
  342: void set_stack_sizes(ImageHeader * header)
  343: {
  344:   if (dictsize==0)
  345:     dictsize = header->dict_size;
  346:   if (dsize==0)
  347:     dsize = header->data_stack_size;
  348:   if (rsize==0)
  349:     rsize = header->return_stack_size;
  350:   if (fsize==0)
  351:     fsize = header->fp_stack_size;
  352:   if (lsize==0)
  353:     lsize = header->locals_stack_size;
  354:   dictsize=maxaligned(dictsize);
  355:   dsize=maxaligned(dsize);
  356:   rsize=maxaligned(rsize);
  357:   lsize=maxaligned(lsize);
  358:   fsize=maxaligned(fsize);
  359: }
  360: 
  361: void alloc_stacks(ImageHeader * header)
  362: {
  363:   header->dict_size=dictsize;
  364:   header->data_stack_size=dsize;
  365:   header->fp_stack_size=fsize;
  366:   header->return_stack_size=rsize;
  367:   header->locals_stack_size=lsize;
  368: 
  369:   header->data_stack_base=my_alloc(dsize);
  370:   header->fp_stack_base=my_alloc(fsize);
  371:   header->return_stack_base=my_alloc(rsize);
  372:   header->locals_stack_base=my_alloc(lsize);
  373:   code_here = start_flush = code_area = my_alloc(dictsize);
  374: }
  375: 
  376: #warning You can ignore the warnings about clobbered variables in go_forth
  377: int go_forth(Address image, int stack, Cell *entries)
  378: {
  379:   volatile ImageHeader *image_header = (ImageHeader *)image;
  380:   Cell *sp0=(Cell*)(image_header->data_stack_base + dsize);
  381:   Cell *rp0=(Cell *)(image_header->return_stack_base + rsize);
  382:   Float *fp0=(Float *)(image_header->fp_stack_base + fsize);
  383: #ifdef GFORTH_DEBUGGING
  384:   volatile Cell *orig_rp0=rp0;
  385: #endif
  386:   Address lp0=image_header->locals_stack_base + lsize;
  387:   Xt *ip0=(Xt *)(image_header->boot_entry);
  388: #ifdef SYSSIGNALS
  389:   int throw_code;
  390: #endif
  391: 
  392:   /* ensure that the cached elements (if any) are accessible */
  393:   IF_spTOS(sp0--);
  394:   IF_fpTOS(fp0--);
  395:   
  396:   for(;stack>0;stack--)
  397:     *--sp0=entries[stack-1];
  398: 
  399: #ifdef SYSSIGNALS
  400:   get_winsize();
  401:    
  402:   install_signal_handlers(); /* right place? */
  403:   
  404:   if ((throw_code=setjmp(throw_jmp_buf))) {
  405:     static Cell signal_data_stack[8];
  406:     static Cell signal_return_stack[8];
  407:     static Float signal_fp_stack[1];
  408: 
  409:     signal_data_stack[7]=throw_code;
  410: 
  411: #ifdef GFORTH_DEBUGGING
  412:     /* fprintf(stderr,"\nrp=%ld\n",(long)rp); */
  413:     if (rp <= orig_rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {
  414:       /* no rstack overflow or underflow */
  415:       rp0 = rp;
  416:       *--rp0 = (Cell)saved_ip;
  417:     }
  418:     else /* I love non-syntactic ifdefs :-) */
  419: #endif
  420:     rp0 = signal_return_stack+8;
  421:     /* fprintf(stderr, "rp=$%x\n",rp0);*/
  422:     
  423:     return((int)(Cell)engine(image_header->throw_entry, signal_data_stack+7,
  424: 		       rp0, signal_fp_stack, 0));
  425:   }
  426: #endif
  427: 
  428:   return((int)(Cell)engine(ip0,sp0,rp0,fp0,lp0));
  429: }
  430: 
  431: 
  432: #ifndef INCLUDE_IMAGE
  433: void print_sizes(Cell sizebyte)
  434:      /* print size information */
  435: {
  436:   static char* endianstring[]= { "   big","little" };
  437:   
  438:   fprintf(stderr,"%s endian, cell=%d bytes, char=%d bytes, au=%d bytes\n",
  439: 	  endianstring[sizebyte & 1],
  440: 	  1 << ((sizebyte >> 1) & 3),
  441: 	  1 << ((sizebyte >> 3) & 3),
  442: 	  1 << ((sizebyte >> 5) & 3));
  443: }
  444: 
  445: #define MAX_IMMARGS 2
  446: 
  447: #ifndef NO_DYNAMIC
  448: typedef struct {
  449:   Label start;
  450:   Cell length; /* excluding the jump */
  451:   char superend; /* true if primitive ends superinstruction, i.e.,
  452:                      unconditional branch, execute, etc. */
  453:   Cell nimmargs;
  454:   struct immarg {
  455:     Cell offset; /* offset of immarg within prim */
  456:     char rel;    /* true if immarg is relative */
  457:   } immargs[MAX_IMMARGS];
  458: } PrimInfo;
  459: 
  460: PrimInfo *priminfos;
  461: #endif /* defined(NO_DYNAMIC) */
  462: Cell npriminfos=0;
  463: 
  464: void check_prims(Label symbols1[])
  465: {
  466:   int i;
  467:   Label *symbols2, *symbols3, *ends1;
  468:   static char superend[]={
  469: #include "prim_superend.i"
  470:   };
  471: 
  472:   if (debug)
  473: #ifdef __VERSION__
  474:     fprintf(stderr, "Compiled with gcc-" __VERSION__ "\n");
  475: #else
  476: #define xstr(s) str(s)
  477: #define str(s) #s
  478:   fprintf(stderr, "Compiled with gcc-" xstr(__GNUC__) "." xstr(__GNUC_MINOR__) "\n"); 
  479: #endif
  480:   for (i=DOESJUMP+1; symbols1[i+1]!=0; i++)
  481:     ;
  482:   npriminfos = i;
  483:   
  484: #ifndef NO_DYNAMIC
  485:   if (no_dynamic)
  486:     return;
  487:   symbols2=engine2(0,0,0,0,0);
  488: #if NO_IP
  489:   symbols3=engine3(0,0,0,0,0);
  490: #else
  491:   symbols3=symbols1;
  492: #endif
  493:   ends1 = symbols1+i+1-DOESJUMP;
  494:   priminfos = calloc(i,sizeof(PrimInfo));
  495:   for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) {
  496:     int prim_len = ends1[i]-symbols1[i];
  497:     PrimInfo *pi=&priminfos[i];
  498:     int j=0;
  499:     char *s1 = (char *)symbols1[i];
  500:     char *s2 = (char *)symbols2[i];
  501:     char *s3 = (char *)symbols3[i];
  502: 
  503:     pi->start = s1;
  504:     pi->superend = superend[i-DOESJUMP-1]|no_super;
  505:     if (pi->superend)
  506:       pi->length = symbols1[i+1]-symbols1[i];
  507:     else
  508:       pi->length = prim_len;
  509:     pi->nimmargs = 0;
  510:     if (debug)
  511:       fprintf(stderr, "Prim %3d @ %p %p %p, length=%3d superend=%1d",
  512: 	      i, s1, s2, s3, prim_len, pi->superend);
  513:     assert(prim_len>=0);
  514:     while (j<prim_len) {
  515:       if (s1[j]==s3[j]) {
  516: 	if (s1[j] != s2[j]) {
  517: 	  pi->start = NULL; /* not relocatable */
  518: 	  if (debug)
  519: 	    fprintf(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);
  520: 	  break;
  521: 	}
  522: 	j++;
  523:       } else {
  524: 	struct immarg *ia=&pi->immargs[pi->nimmargs];
  525: 
  526: 	pi->nimmargs++;
  527: 	ia->offset=j;
  528: 	if ((~*(Cell *)&(s1[j]))==*(Cell *)&(s3[j])) {
  529: 	  ia->rel=0;
  530: 	  if (debug)
  531: 	    fprintf(stderr,"\n   absolute immarg: offset %3d",j);
  532: 	} else if ((&(s1[j]))+(*(Cell *)&(s1[j]))+4 ==
  533: 		   symbols1[DOESJUMP+1]) {
  534: 	  ia->rel=1;
  535: 	  if (debug)
  536: 	    fprintf(stderr,"\n   relative immarg: offset %3d",j);
  537: 	} else {
  538: 	  pi->start = NULL; /* not relocatable */
  539: 	  if (debug)
  540: 	    fprintf(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);
  541: 	  break;
  542: 	}
  543: 	j+=4;
  544:       }
  545:     }
  546:     if (debug)
  547:       fprintf(stderr,"\n");
  548:   }
  549: #endif
  550: }
  551: 
  552: #ifdef NO_IP
  553: int nbranchinfos=0;
  554: 
  555: struct branchinfo {
  556:   Label *targetptr; /* *(bi->targetptr) is the target */
  557:   Cell *addressptr; /* store the target here */
  558: } branchinfos[100000];
  559: 
  560: int ndoesexecinfos=0;
  561: struct doesexecinfo {
  562:   int branchinfo; /* fix the targetptr of branchinfos[...->branchinfo] */
  563:   Cell *xt; /* cfa of word whose does-code needs calling */
  564: } doesexecinfos[10000];
  565: 
  566: #define N_EXECUTE 10
  567: #define N_PERFORM 11
  568: #define N_LIT_PERFORM 337
  569: #define N_CALL 333
  570: #define N_DOES_EXEC 339
  571: #define N_LIT 9
  572: #define N_CALL2 362
  573: #define N_ABRANCH 341
  574: #define N_SET_NEXT_CODE 361
  575: 
  576: void set_rel_target(Cell *source, Label target)
  577: {
  578:   *source = ((Cell)target)-(((Cell)source)+4);
  579: }
  580: 
  581: void register_branchinfo(Label source, Cell targetptr)
  582: {
  583:   struct branchinfo *bi = &(branchinfos[nbranchinfos]);
  584:   bi->targetptr = (Label *)targetptr;
  585:   bi->addressptr = (Cell *)source;
  586:   nbranchinfos++;
  587: }
  588: 
  589: Cell *compile_prim1arg(Cell p)
  590: {
  591:   int l = priminfos[p].length;
  592:   Address old_code_here=code_here;
  593: 
  594:   memcpy(code_here, vm_prims[p], l);
  595:   code_here+=l;
  596:   return (Cell*)(old_code_here+priminfos[p].immargs[0].offset);
  597: }
  598: 
  599: Cell *compile_call2(Cell targetptr)
  600: {
  601:   Cell *next_code_target;
  602:   PrimInfo *pi = &priminfos[N_CALL2];
  603: 
  604:   memcpy(code_here, pi->start, pi->length);
  605:   next_code_target = (Cell *)(code_here + pi->immargs[0].offset);
  606:   register_branchinfo(code_here + pi->immargs[1].offset, targetptr);
  607:   code_here += pi->length;
  608:   return next_code_target;
  609: }
  610: #endif
  611: 
  612: void finish_code(void)
  613: {
  614: #ifdef NO_IP
  615:   Cell i;
  616: 
  617:   compile_prim1(NULL);
  618:   for (i=0; i<ndoesexecinfos; i++) {
  619:     struct doesexecinfo *dei = &doesexecinfos[i];
  620:     branchinfos[dei->branchinfo].targetptr = DOES_CODE1((dei->xt));
  621:   }
  622:   ndoesexecinfos = 0;
  623:   for (i=0; i<nbranchinfos; i++) {
  624:     struct branchinfo *bi=&branchinfos[i];
  625:     set_rel_target(bi->addressptr, *(bi->targetptr));
  626:   }
  627:   nbranchinfos = 0;
  628:   FLUSH_ICACHE(start_flush, code_here-start_flush);
  629:   start_flush=code_here;
  630: #endif
  631: }
  632: 
  633: void compile_prim1(Cell *start)
  634: {
  635: #if defined(DOUBLY_INDIRECT)
  636:   Label prim=(Label)*start;
  637:   if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) {
  638:     fprintf(stderr,"compile_prim encountered xt %p\n", prim);
  639:     *start=(Cell)prim;
  640:     return;
  641:   } else {
  642:     *start = prim-((Label)xts)+((Label)vm_prims);
  643:     return;
  644:   }
  645: #elif defined(NO_IP)
  646:   static Cell *last_start=NULL;
  647:   static Xt last_prim=NULL;
  648:   /* delay work by one call in order to get relocated immargs */
  649: 
  650:   if (last_start) {
  651:     unsigned i = last_prim-vm_prims;
  652:     PrimInfo *pi=&priminfos[i];
  653:     Cell *next_code_target=NULL;
  654: 
  655:     assert(i<npriminfos);
  656:     if (i==N_EXECUTE||i==N_PERFORM||i==N_LIT_PERFORM) {
  657:       next_code_target = compile_prim1arg(N_SET_NEXT_CODE);
  658:     }
  659:     if (i==N_CALL) {
  660:       next_code_target = compile_call2(last_start[1]);
  661:     } else if (i==N_DOES_EXEC) {
  662:       struct doesexecinfo *dei = &doesexecinfos[ndoesexecinfos++];
  663:       *compile_prim1arg(N_LIT) = (Cell)PFA(last_start[1]);
  664:       /* we cannot determine the callee now (last_start[1] may be a
  665:          forward reference), so just register an arbitrary target, and
  666:          register in dei that we need to fix this before resolving
  667:          branches */
  668:       dei->branchinfo = nbranchinfos;
  669:       dei->xt = (Cell *)(last_start[1]);
  670:       next_code_target = compile_call2(NULL);
  671:     } else if (pi->start == NULL) { /* non-reloc */
  672:       next_code_target = compile_prim1arg(N_SET_NEXT_CODE);
  673:       set_rel_target(compile_prim1arg(N_ABRANCH),*(Xt)last_prim);
  674:     } else {
  675:       unsigned j;
  676: 
  677:       memcpy(code_here, *last_prim, pi->length);
  678:       for (j=0; j<pi->nimmargs; j++) {
  679: 	struct immarg *ia = &(pi->immargs[j]);
  680: 	Cell argval = last_start[pi->nimmargs - j]; /* !! specific to prims */
  681: 	if (ia->rel) { /* !! assumption: relative refs are branches */
  682: 	  register_branchinfo(code_here + ia->offset, argval);
  683: 	} else /* plain argument */
  684: 	  *(Cell *)(code_here + ia->offset) = argval;
  685:       }
  686:       code_here += pi->length;
  687:     }
  688:     if (next_code_target!=NULL)
  689:       *next_code_target = (Cell)code_here;
  690:   }
  691:   if (start) {
  692:     last_prim = (Xt)*start;
  693:     *start = (Cell)code_here;
  694:   }
  695:   last_start = start;
  696:   return;
  697: #elif !defined(NO_DYNAMIC)
  698:   Label prim=(Label)*start;
  699:   unsigned i;
  700:   Address old_code_here=code_here;
  701:   static Address last_jump=0;
  702: 
  703:   i = ((Xt)prim)-vm_prims;
  704:   prim = *(Xt)prim;
  705:   if (no_dynamic) {
  706:     *start = (Cell)prim;
  707:     return;
  708:   }
  709:   if (i>=npriminfos || priminfos[i].start == 0) { /* not a relocatable prim */
  710:     if (last_jump) { /* make sure the last sequence is complete */
  711:       memcpy(code_here, last_jump, IND_JUMP_LENGTH);
  712:       code_here += IND_JUMP_LENGTH;
  713:       last_jump = 0;
  714:       FLUSH_ICACHE(start_flush, code_here-start_flush);
  715:       start_flush=code_here;
  716:     }
  717:     *start = (Cell)prim;
  718:     return;
  719:   }
  720:   assert(priminfos[i].start = prim); 
  721: #ifdef ALIGN_CODE
  722:   ALIGN_CODE;
  723: #endif
  724:   memcpy(code_here, (Address)prim, priminfos[i].length);
  725:   code_here += priminfos[i].length;
  726:   last_jump = (priminfos[i].superend) ? 0 : (prim+priminfos[i].length);
  727:   if (last_jump == 0) {
  728:     FLUSH_ICACHE(start_flush, code_here-start_flush);
  729:     start_flush=code_here;
  730:   }
  731:   *start = (Cell)old_code_here;
  732:   return;
  733: #else /* !defined(DOUBLY_INDIRECT), no code replication */
  734:   Label prim=(Label)*start;
  735: #if !defined(INDIRECT_THREADED)
  736:   prim = *(Xt)prim;
  737: #endif
  738:   *start = (Cell)prim;
  739:   return;
  740: #endif /* !defined(DOUBLY_INDIRECT) */
  741: }
  742: 
  743: Label compile_prim(Label prim)
  744: {
  745:   Cell x=(Cell)prim;
  746:   compile_prim1(&x);
  747:   return (Label)x;
  748: }
  749: 
  750: #if defined(PRINT_SUPER_LENGTHS) && !defined(NO_DYNAMIC)
  751: Cell prim_length(Cell prim)
  752: {
  753:   return priminfos[prim+DOESJUMP+1].length;
  754: }
  755: #endif
  756: 
  757: Address loader(FILE *imagefile, char* filename)
  758: /* returns the address of the image proper (after the preamble) */
  759: {
  760:   ImageHeader header;
  761:   Address image;
  762:   Address imp; /* image+preamble */
  763:   Char magic[8];
  764:   char magic7; /* size byte of magic number */
  765:   Cell preamblesize=0;
  766:   Cell data_offset = offset_image ? 56*sizeof(Cell) : 0;
  767:   UCell check_sum;
  768:   Cell ausize = ((RELINFOBITS ==  8) ? 0 :
  769: 		 (RELINFOBITS == 16) ? 1 :
  770: 		 (RELINFOBITS == 32) ? 2 : 3);
  771:   Cell charsize = ((sizeof(Char) == 1) ? 0 :
  772: 		   (sizeof(Char) == 2) ? 1 :
  773: 		   (sizeof(Char) == 4) ? 2 : 3) + ausize;
  774:   Cell cellsize = ((sizeof(Cell) == 1) ? 0 :
  775: 		   (sizeof(Cell) == 2) ? 1 :
  776: 		   (sizeof(Cell) == 4) ? 2 : 3) + ausize;
  777:   Cell sizebyte = (ausize << 5) + (charsize << 3) + (cellsize << 1) +
  778: #ifdef WORDS_BIGENDIAN
  779:        0
  780: #else
  781:        1
  782: #endif
  783:     ;
  784: 
  785:   vm_prims = engine(0,0,0,0,0);
  786:   check_prims(vm_prims);
  787: #ifndef DOUBLY_INDIRECT
  788: #ifdef PRINT_SUPER_LENGTHS
  789:   print_super_lengths();
  790: #endif
  791:   check_sum = checksum(vm_prims);
  792: #else /* defined(DOUBLY_INDIRECT) */
  793:   check_sum = (UCell)vm_prims;
  794: #endif /* defined(DOUBLY_INDIRECT) */
  795:   
  796:   do {
  797:     if(fread(magic,sizeof(Char),8,imagefile) < 8) {
  798:       fprintf(stderr,"%s: image %s doesn't seem to be a Gforth (>=0.4) image.\n",
  799: 	      progname, filename);
  800:       exit(1);
  801:     }
  802:     preamblesize+=8;
  803:   } while(memcmp(magic,"Gforth2",7));
  804:   magic7 = magic[7];
  805:   if (debug) {
  806:     magic[7]='\0';
  807:     fprintf(stderr,"Magic found: %s ", magic);
  808:     print_sizes(magic7);
  809:   }
  810: 
  811:   if (magic7 != sizebyte)
  812:     {
  813:       fprintf(stderr,"This image is:         ");
  814:       print_sizes(magic7);
  815:       fprintf(stderr,"whereas the machine is ");
  816:       print_sizes(sizebyte);
  817:       exit(-2);
  818:     };
  819: 
  820:   fread((void *)&header,sizeof(ImageHeader),1,imagefile);
  821: 
  822:   set_stack_sizes(&header);
  823:   
  824: #if HAVE_GETPAGESIZE
  825:   pagesize=getpagesize(); /* Linux/GNU libc offers this */
  826: #elif HAVE_SYSCONF && defined(_SC_PAGESIZE)
  827:   pagesize=sysconf(_SC_PAGESIZE); /* POSIX.4 */
  828: #elif PAGESIZE
  829:   pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */
  830: #endif
  831:   if (debug)
  832:     fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize);
  833: 
  834:   image = dict_alloc_read(imagefile, preamblesize+header.image_size,
  835: 			  preamblesize+dictsize, data_offset);
  836:   imp=image+preamblesize;
  837:   alloc_stacks((ImageHeader *)imp);
  838:   if (clear_dictionary)
  839:     memset(imp+header.image_size, 0, dictsize-header.image_size);
  840:   if(header.base==0 || header.base  == 0x100) {
  841:     Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1;
  842:     char reloc_bits[reloc_size];
  843:     fseek(imagefile, preamblesize+header.image_size, SEEK_SET);
  844:     fread(reloc_bits, 1, reloc_size, imagefile);
  845:     relocate((Cell *)imp, reloc_bits, header.image_size, header.base, vm_prims);
  846: #if 0
  847:     { /* let's see what the relocator did */
  848:       FILE *snapshot=fopen("snapshot.fi","wb");
  849:       fwrite(image,1,imagesize,snapshot);
  850:       fclose(snapshot);
  851:     }
  852: #endif
  853:   }
  854:   else if(header.base!=imp) {
  855:     fprintf(stderr,"%s: Cannot load nonrelocatable image (compiled for address $%lx) at address $%lx\n",
  856: 	    progname, (unsigned long)header.base, (unsigned long)imp);
  857:     exit(1);
  858:   }
  859:   if (header.checksum==0)
  860:     ((ImageHeader *)imp)->checksum=check_sum;
  861:   else if (header.checksum != check_sum) {
  862:     fprintf(stderr,"%s: Checksum of image ($%lx) does not match the executable ($%lx)\n",
  863: 	    progname, (unsigned long)(header.checksum),(unsigned long)check_sum);
  864:     exit(1);
  865:   }
  866: #ifdef DOUBLY_INDIRECT
  867:   ((ImageHeader *)imp)->xt_base = xts;
  868: #endif
  869:   fclose(imagefile);
  870: 
  871:   /* unnecessary, except maybe for CODE words */
  872:   /* FLUSH_ICACHE(imp, header.image_size);*/
  873: 
  874:   return imp;
  875: }
  876: 
  877: /* index of last '/' or '\' in file, 0 if there is none. */
  878: int onlypath(char *file)
  879: {
  880:   return strrchr(file, DIRSEP)-file;
  881: }
  882: 
  883: FILE *openimage(char *fullfilename)
  884: {
  885:   FILE *image_file;
  886:   char * expfilename = tilde_cstr(fullfilename, strlen(fullfilename), 1);
  887: 
  888:   image_file=fopen(expfilename,"rb");
  889:   if (image_file!=NULL && debug)
  890:     fprintf(stderr, "Opened image file: %s\n", expfilename);
  891:   return image_file;
  892: }
  893: 
  894: /* try to open image file concat(path[0:len],imagename) */
  895: FILE *checkimage(char *path, int len, char *imagename)
  896: {
  897:   int dirlen=len;
  898:   char fullfilename[dirlen+strlen(imagename)+2];
  899: 
  900:   memcpy(fullfilename, path, dirlen);
  901:   if (fullfilename[dirlen-1]!=DIRSEP)
  902:     fullfilename[dirlen++]=DIRSEP;
  903:   strcpy(fullfilename+dirlen,imagename);
  904:   return openimage(fullfilename);
  905: }
  906: 
  907: FILE * open_image_file(char * imagename, char * path)
  908: {
  909:   FILE * image_file=NULL;
  910:   char *origpath=path;
  911:   
  912:   if(strchr(imagename, DIRSEP)==NULL) {
  913:     /* first check the directory where the exe file is in !! 01may97jaw */
  914:     if (onlypath(progname))
  915:       image_file=checkimage(progname, onlypath(progname), imagename);
  916:     if (!image_file)
  917:       do {
  918: 	char *pend=strchr(path, PATHSEP);
  919: 	if (pend==NULL)
  920: 	  pend=path+strlen(path);
  921: 	if (strlen(path)==0) break;
  922: 	image_file=checkimage(path, pend-path, imagename);
  923: 	path=pend+(*pend==PATHSEP);
  924:       } while (image_file==NULL);
  925:   } else {
  926:     image_file=openimage(imagename);
  927:   }
  928: 
  929:   if (!image_file) {
  930:     fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n",
  931: 	    progname, imagename, origpath);
  932:     exit(1);
  933:   }
  934: 
  935:   return image_file;
  936: }
  937: #endif
  938: 
  939: #ifdef HAS_OS
  940: UCell convsize(char *s, UCell elemsize)
  941: /* converts s of the format [0-9]+[bekMGT]? (e.g. 25k) into the number
  942:    of bytes.  the letter at the end indicates the unit, where e stands
  943:    for the element size. default is e */
  944: {
  945:   char *endp;
  946:   UCell n,m;
  947: 
  948:   m = elemsize;
  949:   n = strtoul(s,&endp,0);
  950:   if (endp!=NULL) {
  951:     if (strcmp(endp,"b")==0)
  952:       m=1;
  953:     else if (strcmp(endp,"k")==0)
  954:       m=1024;
  955:     else if (strcmp(endp,"M")==0)
  956:       m=1024*1024;
  957:     else if (strcmp(endp,"G")==0)
  958:       m=1024*1024*1024;
  959:     else if (strcmp(endp,"T")==0) {
  960: #if (SIZEOF_CHAR_P > 4)
  961:       m=1024L*1024*1024*1024;
  962: #else
  963:       fprintf(stderr,"%s: size specification \"%s\" too large for this machine\n", progname, endp);
  964:       exit(1);
  965: #endif
  966:     } else if (strcmp(endp,"e")!=0 && strcmp(endp,"")!=0) {
  967:       fprintf(stderr,"%s: cannot grok size specification %s: invalid unit \"%s\"\n", progname, s, endp);
  968:       exit(1);
  969:     }
  970:   }
  971:   return n*m;
  972: }
  973: 
  974: void gforth_args(int argc, char ** argv, char ** path, char ** imagename)
  975: {
  976:   int c;
  977: 
  978:   opterr=0;
  979:   while (1) {
  980:     int option_index=0;
  981:     static struct option opts[] = {
  982:       {"appl-image", required_argument, NULL, 'a'},
  983:       {"image-file", required_argument, NULL, 'i'},
  984:       {"dictionary-size", required_argument, NULL, 'm'},
  985:       {"data-stack-size", required_argument, NULL, 'd'},
  986:       {"return-stack-size", required_argument, NULL, 'r'},
  987:       {"fp-stack-size", required_argument, NULL, 'f'},
  988:       {"locals-stack-size", required_argument, NULL, 'l'},
  989:       {"path", required_argument, NULL, 'p'},
  990:       {"version", no_argument, NULL, 'v'},
  991:       {"help", no_argument, NULL, 'h'},
  992:       /* put something != 0 into offset_image */
  993:       {"offset-image", no_argument, &offset_image, 1},
  994:       {"no-offset-im", no_argument, &offset_image, 0},
  995:       {"clear-dictionary", no_argument, &clear_dictionary, 1},
  996:       {"die-on-signal", no_argument, &die_on_signal, 1},
  997:       {"debug", no_argument, &debug, 1},
  998:       {"no-super", no_argument, &no_super, 1},
  999:       {"no-dynamic", no_argument, &no_dynamic, 1},
 1000:       {"dynamic", no_argument, &no_dynamic, 0},
 1001:       {0,0,0,0}
 1002:       /* no-init-file, no-rc? */
 1003:     };
 1004:     
 1005:     c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:vhoncsx", opts, &option_index);
 1006:     
 1007:     switch (c) {
 1008:     case EOF: return;
 1009:     case '?': optind--; return;
 1010:     case 'a': *imagename = optarg; return;
 1011:     case 'i': *imagename = optarg; break;
 1012:     case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
 1013:     case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
 1014:     case 'r': rsize = convsize(optarg,sizeof(Cell)); break;
 1015:     case 'f': fsize = convsize(optarg,sizeof(Float)); break;
 1016:     case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
 1017:     case 'p': *path = optarg; break;
 1018:     case 'o': offset_image = 1; break;
 1019:     case 'n': offset_image = 0; break;
 1020:     case 'c': clear_dictionary = 1; break;
 1021:     case 's': die_on_signal = 1; break;
 1022:     case 'x': debug = 1; break;
 1023:     case 'v': fprintf(stderr, "gforth %s\n", VERSION); exit(0);
 1024:     case 'h': 
 1025:       fprintf(stderr, "Usage: %s [engine options] ['--'] [image arguments]\n\
 1026: Engine Options:\n\
 1027:   --appl-image FILE		    equivalent to '--image-file=FILE --'\n\
 1028:   --clear-dictionary		    Initialize the dictionary with 0 bytes\n\
 1029:   -d SIZE, --data-stack-size=SIZE   Specify data stack size\n\
 1030:   --debug			    Print debugging information during startup\n\
 1031:   --die-on-signal		    exit instead of CATCHing some signals\n\
 1032:   --dynamic			    use dynamic native code\n\
 1033:   -f SIZE, --fp-stack-size=SIZE	    Specify floating point stack size\n\
 1034:   -h, --help			    Print this message and exit\n\
 1035:   -i FILE, --image-file=FILE	    Use image FILE instead of `gforth.fi'\n\
 1036:   -l SIZE, --locals-stack-size=SIZE Specify locals stack size\n\
 1037:   -m SIZE, --dictionary-size=SIZE   Specify Forth dictionary size\n\
 1038:   --no-dynamic			    Use only statically compiled primitives\n\
 1039:   --no-offset-im		    Load image at normal position\n\
 1040:   --no-super                        No dynamically formed superinstructions\n\
 1041:   --offset-image		    Load image at a different position\n\
 1042:   -p PATH, --path=PATH		    Search path for finding image and sources\n\
 1043:   -r SIZE, --return-stack-size=SIZE Specify return stack size\n\
 1044:   -v, --version			    Print engine version and exit\n\
 1045: SIZE arguments consist of an integer followed by a unit. The unit can be\n\
 1046:   `b' (byte), `e' (element; default), `k' (KB), `M' (MB), `G' (GB) or `T' (TB).\n",
 1047: 	      argv[0]);
 1048:       optind--;
 1049:       return;
 1050:     }
 1051:   }
 1052: }
 1053: #endif
 1054: 
 1055: #ifdef INCLUDE_IMAGE
 1056: extern Cell image[];
 1057: extern const char reloc_bits[];
 1058: #endif
 1059: 
 1060: DCell double2ll(Float r)
 1061: {
 1062: #ifndef BUGGY_LONG_LONG
 1063:   return (DCell)(r);
 1064: #else
 1065:   DCell d;
 1066:   d.hi = ldexp(r,-(int)(CELL_BITS)) - (r<0);
 1067:   d.lo = r-ldexp((Float)d.hi,CELL_BITS);
 1068:   return d;
 1069: #endif
 1070: }
 1071: 
 1072: int main(int argc, char **argv, char **env)
 1073: {
 1074: #ifdef HAS_OS
 1075:   char *path = getenv("GFORTHPATH") ? : DEFAULTPATH;
 1076: #else
 1077:   char *path = DEFAULTPATH;
 1078: #endif
 1079: #ifndef INCLUDE_IMAGE
 1080:   char *imagename="gforth.fi";
 1081:   FILE *image_file;
 1082:   Address image;
 1083: #endif
 1084:   int retvalue;
 1085: 	  
 1086: #if defined(i386) && defined(ALIGNMENT_CHECK)
 1087:   /* turn on alignment checks on the 486.
 1088:    * on the 386 this should have no effect. */
 1089:   __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");
 1090:   /* this is unusable with Linux' libc.4.6.27, because this library is
 1091:      not alignment-clean; we would have to replace some library
 1092:      functions (e.g., memcpy) to make it work. Also GCC doesn't try to keep
 1093:      the stack FP-aligned. */
 1094: #endif
 1095: 
 1096:   /* buffering of the user output device */
 1097: #ifdef _IONBF
 1098:   if (isatty(fileno(stdout))) {
 1099:     fflush(stdout);
 1100:     setvbuf(stdout,NULL,_IONBF,0);
 1101:   }
 1102: #endif
 1103: 
 1104:   progname = argv[0];
 1105: 
 1106: #ifdef HAS_OS
 1107:   gforth_args(argc, argv, &path, &imagename);
 1108: #endif
 1109: 
 1110: #ifdef INCLUDE_IMAGE
 1111:   set_stack_sizes((ImageHeader *)image);
 1112:   if(((ImageHeader *)image)->base != image)
 1113:     relocate(image, reloc_bits, ((ImageHeader *)image)->image_size,
 1114: 	     (Label*)engine(0, 0, 0, 0, 0));
 1115:   alloc_stacks((ImageHeader *)image);
 1116: #else
 1117:   image_file = open_image_file(imagename, path);
 1118:   image = loader(image_file, imagename);
 1119: #endif
 1120:   gforth_header=(ImageHeader *)image; /* used in SIGSEGV handler */
 1121: 
 1122:   {
 1123:     char path2[strlen(path)+1];
 1124:     char *p1, *p2;
 1125:     Cell environ[]= {
 1126:       (Cell)argc-(optind-1),
 1127:       (Cell)(argv+(optind-1)),
 1128:       (Cell)strlen(path),
 1129:       (Cell)path2};
 1130:     argv[optind-1] = progname;
 1131:     /*
 1132:        for (i=0; i<environ[0]; i++)
 1133:        printf("%s\n", ((char **)(environ[1]))[i]);
 1134:        */
 1135:     /* make path OS-independent by replacing path separators with NUL */
 1136:     for (p1=path, p2=path2; *p1!='\0'; p1++, p2++)
 1137:       if (*p1==PATHSEP)
 1138: 	*p2 = '\0';
 1139:       else
 1140: 	*p2 = *p1;
 1141:     *p2='\0';
 1142:     retvalue = go_forth(image, 4, environ);
 1143: #ifdef VM_PROFILING
 1144:     vm_print_profile(stderr);
 1145: #endif
 1146:     deprep_terminal();
 1147:   }
 1148:   return retvalue;
 1149: }

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