[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.17 and 1.134

version 1.17, Fri Jan 1 15:20:37 1999 UTC version 1.134, Sun Nov 9 11:51:55 2003 UTC
Line 1 
Line 1 
 /* command line interpretation, image loading etc. for Gforth  /* command line interpretation, image loading etc. for Gforth
   
   
   Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.    Copyright (C) 1995,1996,1997,1998,2000,2003 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
Line 17 
Line 17 
   
   You should have received a copy of the GNU General Public License    You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software    along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 */  */
   
 #include "config.h"  #include "config.h"
   #include "forth.h"
 #include <errno.h>  #include <errno.h>
 #include <ctype.h>  #include <ctype.h>
 #include <stdio.h>  #include <stdio.h>
Line 28 
Line 29 
 #include <string.h>  #include <string.h>
 #include <math.h>  #include <math.h>
 #include <sys/types.h>  #include <sys/types.h>
   #ifndef STANDALONE
 #include <sys/stat.h>  #include <sys/stat.h>
   #endif
 #include <fcntl.h>  #include <fcntl.h>
 #include <assert.h>  #include <assert.h>
 #include <stdlib.h>  #include <stdlib.h>
   #include <signal.h>
 #ifndef STANDALONE  #ifndef STANDALONE
 #if HAVE_SYS_MMAN_H  #if HAVE_SYS_MMAN_H
 #include <sys/mman.h>  #include <sys/mman.h>
 #endif  #endif
 #endif  #endif
 #include "forth.h"  
 #include "io.h"  #include "io.h"
 #include "getopt.h"  #include "getopt.h"
 #ifdef STANDALONE  #ifdef STANDALONE
 #include <systypes.h>  #include <systypes.h>
 #endif  #endif
   
   typedef enum prim_num {
   /* definitions of N_execute etc. */
   #include PRIM_NUM_I
     N_START_SUPER
   } PrimNum;
   
   /* global variables for engine.c
      We put them here because engine.c is compiled several times in
      different ways for the same engine. */
   Cell *SP;
   Float *FP;
   Address UP=NULL;
   
   #ifdef HAS_FFCALL
   Cell *RP;
   Address LP;
   
   #include <callback.h>
   
   va_alist clist;
   
   void engine_callback(Xt* fcall, void * alist)
   {
     clist = (va_alist)alist;
     engine(fcall, SP, RP, FP, LP);
   }
   #endif
   
   #ifdef GFORTH_DEBUGGING
   /* define some VM registers as global variables, so they survive exceptions;
      global register variables are not up to the task (according to the
      GNU C manual) */
   Xt *saved_ip;
   Cell *rp;
   #endif
   
   #ifdef NO_IP
   Label next_code;
   #endif
   
   #ifdef HAS_FILE
   char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};
   char* pfileattr[6]={"r","r","r+","r+","w","w"};
   
   #ifndef O_BINARY
   #define O_BINARY 0
   #endif
   #ifndef O_TEXT
   #define O_TEXT 0
   #endif
   
   int ufileattr[6]= {
     O_RDONLY|O_BINARY, O_RDONLY|O_BINARY,
     O_RDWR  |O_BINARY, O_RDWR  |O_BINARY,
     O_WRONLY|O_BINARY, O_WRONLY|O_BINARY };
   #endif
   /* end global vars for engine.c */
   
 #define PRIM_VERSION 1  #define PRIM_VERSION 1
 /* increment this whenever the primitives change in an incompatible way */  /* increment this whenever the primitives change in an incompatible way */
   
 #ifndef DEFAULTPATH  #ifndef DEFAULTPATH
 #  define DEFAULTPATH "~+"  #  define DEFAULTPATH "."
 #endif  #endif
   
 #ifdef MSDOS  #ifdef MSDOS
 jmp_buf throw_jmp_buf;  jmp_buf throw_jmp_buf;
 #endif  #endif
   
 #if defined(DIRECT_THREADED)  #if defined(DOUBLY_INDIRECT)
 #  define CA(n) (symbols[(n)])  #  define CFA(n)        ({Cell _n = (n); ((Cell)(((_n & 0x4000) ? symbols : xts)+(_n&~0x4000UL)));})
 #else  #else
 #  define CA(n) ((Cell)(symbols+(n)))  #  define CFA(n)        ((Cell)(symbols+((n)&~0x4000UL)))
 #endif  #endif
   
 #define maxaligned(n)   (typeof(n))((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))  #define maxaligned(n)   (typeof(n))((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
Line 72 
Line 133 
 int die_on_signal=0;  int die_on_signal=0;
 #ifndef INCLUDE_IMAGE  #ifndef INCLUDE_IMAGE
 static int clear_dictionary=0;  static int clear_dictionary=0;
 static size_t pagesize=0;  UCell pagesize=1;
 #endif  
 static int debug=0;  
 char *progname;  char *progname;
   #else
   char *progname = "gforth";
   int optind = 1;
   #endif
   
   #define CODE_BLOCK_SIZE (4096*1024) /* !! overflow handling for -native */
   Address code_area=0;
   Cell code_area_size = CODE_BLOCK_SIZE;
   Address code_here=NULL+CODE_BLOCK_SIZE; /* does for code-area what HERE
                                              does for the dictionary */
   Address start_flush=NULL; /* start of unflushed code */
   Cell last_jump=0; /* if the last prim was compiled without jump, this
                        is it's number, otherwise this contains 0 */
   
   static int no_super=0;   /* true if compile_prim should not fuse prims */
   static int no_dynamic=NO_DYNAMIC_DEFAULT; /* if true, no code is generated
                                                dynamically */
   static int print_metrics=0; /* if true, print metrics on exit */
   static int static_super_number = 10000000; /* number of ss used if available */
   #define MAX_STATE 4 /* maximum number of states */
   static int maxstates = MAX_STATE; /* number of states for stack caching */
   static int ss_greedy = 0; /* if true: use greedy, not optimal ss selection */
   
   #ifdef HAS_DEBUG
   int debug=0;
   #else
   # define perror(x...)
   # define fprintf(x...)
   #endif
   
   ImageHeader *gforth_header;
   Label *vm_prims;
   #ifdef DOUBLY_INDIRECT
   Label *xts; /* same content as vm_prims, but should only be used for xts */
   #endif
   
   #ifndef NO_DYNAMIC
   #define MAX_IMMARGS 2
   
   typedef struct {
     Label start; /* NULL if not relocatable */
     Cell length; /* only includes the jump iff superend is true*/
     Cell restlength; /* length of the rest (i.e., the jump or (on superend) 0) */
     char superend; /* true if primitive ends superinstruction, i.e.,
                        unconditional branch, execute, etc. */
     Cell nimmargs;
     struct immarg {
       Cell offset; /* offset of immarg within prim */
       char rel;    /* true if immarg is relative */
     } immargs[MAX_IMMARGS];
   } PrimInfo;
   
   PrimInfo *priminfos;
   PrimInfo **decomp_prims;
   
   static int is_relocatable(int p)
   {
     return !no_dynamic && priminfos[p].start != NULL;
   }
   #else /* defined(NO_DYNAMIC) */
   static int is_relocatable(int p)
   {
     return 0;
   }
   #endif /* defined(NO_DYNAMIC) */
   
   #ifdef MEMCMP_AS_SUBROUTINE
   int gforth_memcmp(const char * s1, const char * s2, size_t n)
   {
     return memcmp(s1, s2, n);
   }
   #endif
   
   static Cell max(Cell a, Cell b)
   {
     return a>b?a:b;
   }
   
   static Cell min(Cell a, Cell b)
   {
     return a<b?a:b;
   }
   
 /* image file format:  /* image file format:
  *  "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n")   *  "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n")
  *   padding to a multiple of 8   *   padding to a multiple of 8
  *   magic: "Gforth2x" means format 0.4,   *   magic: "Gforth3x" means format 0.6,
  *              where x is a byte with   *              where x is a byte with
  *              bit 7:   reserved = 0   *              bit 7:   reserved = 0
  *              bit 6:5: address unit size 2^n octets   *              bit 6:5: address unit size 2^n octets
Line 89 
Line 230 
  *              bit 0:   endian, big=0, little=1.   *              bit 0:   endian, big=0, little=1.
  *  The magic are always 8 octets, no matter what the native AU/character size is   *  The magic are always 8 octets, no matter what the native AU/character size is
  *  padding to max alignment (no padding necessary on current machines)   *  padding to max alignment (no padding necessary on current machines)
  *  ImageHeader structure (see below)   *  ImageHeader structure (see forth.h)
  *  data (size in ImageHeader.image_size)   *  data (size in ImageHeader.image_size)
  *  tags ((if relocatable, 1 bit/data cell)   *  tags ((if relocatable, 1 bit/data cell)
  *   *
Line 101 
Line 242 
  * If the word =CF(DODOES), it's a DOES> CFA   * If the word =CF(DODOES), it's a DOES> CFA
  * If the word =CF(DOESJUMP), it's a DOES JUMP (2 Cells after DOES>,   * If the word =CF(DOESJUMP), it's a DOES JUMP (2 Cells after DOES>,
  *                                      possibly containing a jump to dodoes)   *                                      possibly containing a jump to dodoes)
  * If the word is <CF(DOESJUMP), it's a primitive   * If the word is <CF(DOESJUMP) and bit 14 is set, it's the xt of a primitive
    * If the word is <CF(DOESJUMP) and bit 14 is clear,
    *                                        it's the threaded code of a primitive
    * bits 13..9 of a primitive token state which group the primitive belongs to,
    * bits 8..0 of a primitive token index into the group
  */   */
   
 typedef struct {  Cell groups[32] = {
   Address base;         /* base address of image (0 if relocatable) */    0,
   UCell checksum;       /* checksum of ca's to protect against some    0
                            incompatible binary/executable combinations  #undef GROUP
                            (0 if relocatable) */  #undef GROUPADD
   UCell image_size;     /* all sizes in bytes */  #define GROUPADD(n) +n
   UCell dict_size;  #define GROUP(x, n) , 0
   UCell data_stack_size;  #include PRIM_GRP_I
   UCell fp_stack_size;  #undef GROUP
   UCell return_stack_size;  #undef GROUPADD
   UCell locals_stack_size;  #define GROUP(x, n)
   Xt *boot_entry;       /* initial ip for booting (in BOOT) */  #define GROUPADD(n)
   Xt *throw_entry;      /* ip after signal (in THROW) */  };
   Cell unused1;         /* possibly tib stack size */  
   Cell unused2;  unsigned char *branch_targets(Cell *image, const unsigned char *bitstring,
   Address data_stack_base; /* this and the following fields are initialized by the loader */                                int size, Cell base)
   Address fp_stack_base;       /* produce a bitmask marking all the branch targets */
   Address return_stack_base;  {
   Address locals_stack_base;    int i=0, j, k, steps=(((size-1)/sizeof(Cell))/RELINFOBITS)+1;
 } ImageHeader;    Cell token;
 /* the image-header is created in main.fs */    unsigned char bits;
     unsigned char *result=malloc(steps);
   
     memset(result, 0, steps);
     for(k=0; k<steps; k++) {
       for(j=0, bits=bitstring[k]; j<RELINFOBITS; j++, i++, bits<<=1) {
         if(bits & (1U << (RELINFOBITS-1))) {
           assert(i*sizeof(Cell) < size);
           token=image[i];
           if (token>=base) { /* relocatable address */
             UCell bitnum=(token-base)/sizeof(Cell);
             result[bitnum/RELINFOBITS] |= 1U << ((~bitnum)&(RELINFOBITS-1));
           }
         }
       }
     }
     return result;
   }
   
 void relocate(Cell *image, const char *bitstring, int size, Label symbols[])  void relocate(Cell *image, const unsigned char *bitstring,
                 int size, Cell base, Label symbols[])
 {  {
   int i=0, j, k, steps=(size/sizeof(Cell))/RELINFOBITS;    int i=0, j, k, steps=(((size-1)/sizeof(Cell))/RELINFOBITS)+1;
   Cell token;    Cell token;
   char bits;    char bits;
 /*   static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/    Cell max_symbols;
     /*
      * A virtual start address that's the real start address minus
      * the one in the image
      */
     Cell *start = (Cell * ) (((void *) image) - ((void *) base));
     unsigned char *targets = branch_targets(image, bitstring, size, base);
   
     /* group index into table */
     if(groups[31]==0) {
       int groupsum=0;
       for(i=0; i<32; i++) {
         groupsum += groups[i];
         groups[i] = groupsum;
         /* printf("group[%d]=%d\n",i,groupsum); */
       }
       i=0;
     }
   
   /* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */
   
 /*  printf("relocating %x[%x]\n", image, size); */    for (max_symbols=0; symbols[max_symbols]!=0; max_symbols++)
       ;
     max_symbols--;
   
   for(k=0; k<=steps; k++)    for(k=0; k<steps; k++) {
     for(j=0, bits=bitstring[k]; j<RELINFOBITS; j++, i++, bits<<=1) {      for(j=0, bits=bitstring[k]; j<RELINFOBITS; j++, i++, bits<<=1) {
       /*      fprintf(stderr,"relocate: image[%d]\n", i);*/        /*      fprintf(stderr,"relocate: image[%d]\n", i);*/
       if(bits & (1U << (RELINFOBITS-1))) {        if(bits & (1U << (RELINFOBITS-1))) {
         /* fprintf(stderr,"relocate: image[%d]=%d\n", i, image[i]);*/          assert(i*sizeof(Cell) < size);
         if((token=image[i])<0)          /* fprintf(stderr,"relocate: image[%d]=%d of %d\n", i, image[i], size/sizeof(Cell)); */
           switch(token)          token=image[i];
             {          if(token<0) {
             int group = (-token & 0x3E00) >> 9;
             if(group == 0) {
               switch(token|0x4000) {
             case CF_NIL      : image[i]=0; break;              case CF_NIL      : image[i]=0; break;
 #if !defined(DOUBLY_INDIRECT)  #if !defined(DOUBLY_INDIRECT)
             case CF(DOCOL)   :              case CF(DOCOL)   :
Line 151 
Line 338 
             case CF(DOUSER)  :              case CF(DOUSER)  :
             case CF(DODEFER) :              case CF(DODEFER) :
             case CF(DOFIELD) : MAKE_CF(image+i,symbols[CF(token)]); break;              case CF(DOFIELD) : MAKE_CF(image+i,symbols[CF(token)]); break;
             case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;              case CF(DOESJUMP): image[i]=0; break;
 #endif /* !defined(DOUBLY_INDIRECT) */  #endif /* !defined(DOUBLY_INDIRECT) */
             case CF(DODOES)  :              case CF(DODOES)  :
               MAKE_DOES_CF(image+i,image[i+1]+((Cell)image));                MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)start)));
               break;                break;
             default          :              default          : /* backward compatibility */
 /*            printf("Code field generation image[%x]:=CA(%x)\n",  /*            printf("Code field generation image[%x]:=CFA(%x)\n",
                      i, CF(image[i])); */                       i, CF(image[i])); */
               image[i]=(Cell)CA(CF(token));                if (CF((token | 0x4000))<max_symbols) {
                   image[i]=(Cell)CFA(CF(token));
   #ifdef DIRECT_THREADED
                   if ((token & 0x4000) == 0) { /* threade code, no CFA */
                     if (targets[k] & (1U<<(RELINFOBITS-1-j)))
                       compile_prim1(0);
                     compile_prim1(&image[i]);
             }              }
         else  #endif
           image[i]+=(Cell)image;                } else
                   fprintf(stderr,"Primitive %ld used in this image at $%lx (offset $%x) is not implemented by this\n engine (%s); executing this code will crash.\n",(long)CF(token),(long)&image[i], i, PACKAGE_VERSION);
               }
             } else {
               int tok = -token & 0x1FF;
               if (tok < (groups[group+1]-groups[group])) {
   #if defined(DOUBLY_INDIRECT)
                 image[i]=(Cell)CFA(((groups[group]+tok) | (CF(token) & 0x4000)));
   #else
                 image[i]=(Cell)CFA((groups[group]+tok));
   #endif
   #ifdef DIRECT_THREADED
                 if ((token & 0x4000) == 0) { /* threade code, no CFA */
                   if (targets[k] & (1U<<(RELINFOBITS-1-j)))
                     compile_prim1(0);
                   compile_prim1(&image[i]);
                 }
   #endif
               } else
                 fprintf(stderr,"Primitive %lx, %d of group %d used in this image at $%lx (offset $%x) is not implemented by this\n engine (%s); executing this code will crash.\n", (long)-token, tok, group, (long)&image[i],i,PACKAGE_VERSION);
             }
           } else {
             /* if base is > 0: 0 is a null reference so don't adjust*/
             if (token>=base) {
               image[i]+=(Cell)start;
       }        }
     }      }
 }  }
       }
     }
     free(targets);
     finish_code();
     ((ImageHeader*)(image))->base = (Address) image;
   }
   
 UCell checksum(Label symbols[])  UCell checksum(Label symbols[])
 {  {
Line 205 
Line 428 
   return r;    return r;
 }  }
   
 Address my_alloc(Cell size)  
 {  
 #if HAVE_MMAP  
   static Address next_address=0;    static Address next_address=0;
   void after_alloc(Address r, Cell size)
   {
     if (r != (Address)-1) {
       if (debug)
         fprintf(stderr, "success, address=$%lx\n", (long) r);
       if (pagesize != 1)
         next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */
     } else {
       if (debug)
         fprintf(stderr, "failed: %s\n", strerror(errno));
     }
   }
   
   #ifndef MAP_FAILED
   #define MAP_FAILED ((Address) -1)
   #endif
   #ifndef MAP_FILE
   # define MAP_FILE 0
   #endif
   #ifndef MAP_PRIVATE
   # define MAP_PRIVATE 0
   #endif
   #if !defined(MAP_ANON) && defined(MAP_ANONYMOUS)
   # define MAP_ANON MAP_ANONYMOUS
   #endif
   
   #if defined(HAVE_MMAP)
   static Address alloc_mmap(Cell size)
   {
   Address r;    Address r;
   
 #if defined(MAP_ANON)  #if defined(MAP_ANON)
Line 218 
Line 467 
 #else /* !defined(MAP_ANON) */  #else /* !defined(MAP_ANON) */
   /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are    /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are
      apparently defaults) */       apparently defaults) */
 #ifndef MAP_FILE  
 # define MAP_FILE 0  
 #endif  
 #ifndef MAP_PRIVATE  
 # define MAP_PRIVATE 0  
 #endif  
   static int dev_zero=-1;    static int dev_zero=-1;
   
   if (dev_zero == -1)    if (dev_zero == -1)
     dev_zero = open("/dev/zero", O_RDONLY);      dev_zero = open("/dev/zero", O_RDONLY);
   if (dev_zero == -1) {    if (dev_zero == -1) {
     r = (Address)-1;      r = MAP_FAILED;
     if (debug)      if (debug)
       fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ",        fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ",
               strerror(errno));                strerror(errno));
Line 239 
Line 482 
     r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0);      r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0);
   }    }
 #endif /* !defined(MAP_ANON) */  #endif /* !defined(MAP_ANON) */
     after_alloc(r, size);
   if (r != (Address)-1) {  
     if (debug)  
       fprintf(stderr, "success, address=$%lx\n", (long) r);  
     if (pagesize != 0)  
       next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */  
     return r;      return r;
   }    }
   if (debug)  #endif
     fprintf(stderr, "failed: %s\n", strerror(errno));  
   Address my_alloc(Cell size)
   {
   #if HAVE_MMAP
     Address r;
   
     r=alloc_mmap(size);
     if (r!=(Address)MAP_FAILED)
       return r;
 #endif /* HAVE_MMAP */  #endif /* HAVE_MMAP */
   /* use malloc as fallback */    /* use malloc as fallback */
   return verbose_malloc(size);    return verbose_malloc(size);
 }  }
   
 #if (defined(mips) && !defined(INDIRECT_THREADED))  Address dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)
 /* the 256MB jump restriction on the MIPS architecture makes the  {
    combination of direct threading and mmap unsafe. */    Address image = MAP_FAILED;
 #define dict_alloc(size) verbose_malloc(size)  
 #else  #if defined(HAVE_MMAP)
 #define dict_alloc(size) my_alloc(size)    if (offset==0) {
 #endif      image=alloc_mmap(dictsize);
       if (debug)
         fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);
       image = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE, fileno(file), 0);
       after_alloc(image,dictsize);
     }
   #endif /* defined(HAVE_MMAP) */
     if (image == (Address)MAP_FAILED) {
       image = my_alloc(dictsize+offset)+offset;
       rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */
       fread(image, 1, imagesize, file);
     }
     return image;
   }
   
 void set_stack_sizes(ImageHeader * header)  void set_stack_sizes(ImageHeader * header)
 {  {
Line 295 
Line 554 
   header->locals_stack_base=my_alloc(lsize);    header->locals_stack_base=my_alloc(lsize);
 }  }
   
   #warning You can ignore the warnings about clobbered variables in go_forth
 int go_forth(Address image, int stack, Cell *entries)  int go_forth(Address image, int stack, Cell *entries)
 {  {
   Cell *sp=(Cell*)(((ImageHeader *)image)->data_stack_base + dsize);    volatile ImageHeader *image_header = (ImageHeader *)image;
   Float *fp=(Float *)(((ImageHeader *)image)->fp_stack_base + fsize);    Cell *sp0=(Cell*)(image_header->data_stack_base + dsize);
   Cell *rp=(Cell *)(((ImageHeader *)image)->return_stack_base + rsize);    Cell *rp0=(Cell *)(image_header->return_stack_base + rsize);
   Address lp=((ImageHeader *)image)->locals_stack_base + lsize;    Float *fp0=(Float *)(image_header->fp_stack_base + fsize);
   Xt *ip=(Xt *)(((ImageHeader *)image)->boot_entry);  #ifdef GFORTH_DEBUGGING
     volatile Cell *orig_rp0=rp0;
   #endif
     Address lp0=image_header->locals_stack_base + lsize;
     Xt *ip0=(Xt *)(image_header->boot_entry);
 #ifdef SYSSIGNALS  #ifdef SYSSIGNALS
   int throw_code;    int throw_code;
 #endif  #endif
   
   /* ensure that the cached elements (if any) are accessible */    /* ensure that the cached elements (if any) are accessible */
   IF_TOS(sp--);    IF_spTOS(sp0--);
   IF_FTOS(fp--);    IF_fpTOS(fp0--);
   
   for(;stack>0;stack--)    for(;stack>0;stack--)
     *--sp=entries[stack-1];      *--sp0=entries[stack-1];
   
 #if !defined(MSDOS) && !defined(SHARC) && !defined(_WIN32) && !defined(__EMX__)  #ifdef SYSSIGNALS
   get_winsize();    get_winsize();
 #endif  
   
 #ifdef SYSSIGNALS  
   install_signal_handlers(); /* right place? */    install_signal_handlers(); /* right place? */
   
   if ((throw_code=setjmp(throw_jmp_buf))) {    if ((throw_code=setjmp(throw_jmp_buf))) {
Line 327 
Line 589 
   
     signal_data_stack[7]=throw_code;      signal_data_stack[7]=throw_code;
   
     return((int)engine(((ImageHeader *)image)->throw_entry,signal_data_stack+7,  #ifdef GFORTH_DEBUGGING
                        signal_return_stack+8,signal_fp_stack,0));      if (debug)
         fprintf(stderr,"\ncaught signal, throwing exception %d, ip=%p rp=%p\n",
                 throw_code, saved_ip, rp);
       if (rp <= orig_rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {
         /* no rstack overflow or underflow */
         rp0 = rp;
         *--rp0 = (Cell)saved_ip;
       }
       else /* I love non-syntactic ifdefs :-) */
         rp0 = signal_return_stack+8;
   #else  /* !defined(GFORTH_DEBUGGING) */
       if (debug)
         fprintf(stderr,"\ncaught signal, throwing exception %d\n", throw_code);
         rp0 = signal_return_stack+8;
   #endif /* !defined(GFORTH_DEBUGGING) */
       /* fprintf(stderr, "rp=$%x\n",rp0);*/
   
       return((int)(Cell)engine(image_header->throw_entry, signal_data_stack+7,
                          rp0, signal_fp_stack, 0));
   }    }
 #endif  #endif
   
   return((int)engine(ip,sp,rp,fp,lp));    return((int)(Cell)engine(ip0,sp0,rp0,fp0,lp0));
 }  }
   
 #ifndef INCLUDE_IMAGE  #ifndef INCLUDE_IMAGE
   void print_sizes(Cell sizebyte)
        /* print size information */
   {
     static char* endianstring[]= { "   big","little" };
   
     fprintf(stderr,"%s endian, cell=%d bytes, char=%d bytes, au=%d bytes\n",
             endianstring[sizebyte & 1],
             1 << ((sizebyte >> 1) & 3),
             1 << ((sizebyte >> 3) & 3),
             1 << ((sizebyte >> 5) & 3));
   }
   
   /* static superinstruction stuff */
   
   struct cost {
     char loads;       /* number of stack loads */
     char stores;      /* number of stack stores */
     char updates;     /* number of stack pointer updates */
     char branch;      /* is it a branch (SET_IP) */
     unsigned char state_in;    /* state on entry */
     unsigned char state_out;   /* state on exit */
     short offset;     /* offset into super2 table */
     unsigned char length;      /* number of components */
   };
   
   PrimNum super2[] = {
   #include SUPER2_I
   };
   
   struct cost super_costs[] = {
   #include COSTS_I
   };
   
   struct super_state {
     struct super_state *next;
     PrimNum super;
   };
   
   #define HASH_SIZE 256
   
   struct super_table_entry {
     struct super_table_entry *next;
     PrimNum *start;
     short length;
     struct super_state *ss_list; /* list of supers */
   } *super_table[HASH_SIZE];
   int max_super=2;
   
   struct super_state *state_transitions=NULL;
   
   int hash_super(PrimNum *start, int length)
   {
     int i, r;
   
     for (i=0, r=0; i<length; i++) {
       r <<= 1;
       r += start[i];
     }
     return r & (HASH_SIZE-1);
   }
   
   struct super_state **lookup_super(PrimNum *start, int length)
   {
     int hash=hash_super(start,length);
     struct super_table_entry *p = super_table[hash];
   
     /* assert(length >= 2); */
     for (; p!=NULL; p = p->next) {
       if (length == p->length &&
           memcmp((char *)p->start, (char *)start, length*sizeof(PrimNum))==0)
         return &(p->ss_list);
     }
     return NULL;
   }
   
   void prepare_super_table()
   {
     int i;
     int nsupers = 0;
   
     for (i=0; i<sizeof(super_costs)/sizeof(super_costs[0]); i++) {
       struct cost *c = &super_costs[i];
       if ((c->length < 2 || nsupers < static_super_number) &&
           c->state_in < maxstates && c->state_out < maxstates) {
         struct super_state **ss_listp= lookup_super(super2+c->offset, c->length);
         struct super_state *ss = malloc(sizeof(struct super_state));
         ss->super= i;
         if (c->offset==N_noop && i != N_noop) {
           if (is_relocatable(i)) {
             ss->next = state_transitions;
             state_transitions = ss;
           }
         } else if (ss_listp != NULL) {
           ss->next = *ss_listp;
           *ss_listp = ss;
         } else {
           int hash = hash_super(super2+c->offset, c->length);
           struct super_table_entry **p = &super_table[hash];
           struct super_table_entry *e = malloc(sizeof(struct super_table_entry));
           ss->next = NULL;
           e->next = *p;
           e->start = super2 + c->offset;
           e->length = c->length;
           e->ss_list = ss;
           *p = e;
         }
         if (c->length > max_super)
           max_super = c->length;
         if (c->length >= 2)
           nsupers++;
       }
     }
     if (debug)
       fprintf(stderr, "Using %d static superinsts\n", nsupers);
   }
   
   /* dynamic replication/superinstruction stuff */
   
   #ifndef NO_DYNAMIC
   int compare_priminfo_length(const void *_a, const void *_b)
   {
     PrimInfo **a = (PrimInfo **)_a;
     PrimInfo **b = (PrimInfo **)_b;
     Cell diff = (*a)->length - (*b)->length;
     if (diff)
       return diff;
     else /* break ties by start address; thus the decompiler produces
             the earliest primitive with the same code (e.g. noop instead
             of (char) and @ instead of >code-address */
       return (*b)->start - (*a)->start;
   }
   #endif /* !defined(NO_DYNAMIC) */
   
   static char MAYBE_UNUSED superend[]={
   #include PRIM_SUPEREND_I
   };
   
   Cell npriminfos=0;
   
   int compare_labels(const void *pa, const void *pb)
   {
     Label a = *(Label *)pa;
     Label b = *(Label *)pb;
     return a-b;
   }
   
   Label bsearch_next(Label key, Label *a, UCell n)
        /* a is sorted; return the label >=key that is the closest in a;
           return NULL if there is no label in a >=key */
   {
     int mid = (n-1)/2;
     if (n<1)
       return NULL;
     if (n == 1) {
       if (a[0] < key)
         return NULL;
       else
         return a[0];
     }
     if (a[mid] < key)
       return bsearch_next(key, a+mid+1, n-mid-1);
     else
       return bsearch_next(key, a, mid+1);
   }
   
   void check_prims(Label symbols1[])
   {
     int i;
   #ifndef NO_DYNAMIC
     Label *symbols2, *symbols3, *ends1, *ends1j, *ends1jsorted;
     int nends1j;
   #endif
   
     if (debug)
   #ifdef __VERSION__
       fprintf(stderr, "Compiled with gcc-" __VERSION__ "\n");
   #else
   #define xstr(s) str(s)
   #define str(s) #s
     fprintf(stderr, "Compiled with gcc-" xstr(__GNUC__) "." xstr(__GNUC_MINOR__) "\n");
   #endif
     for (i=0; symbols1[i]!=0; i++)
       ;
     npriminfos = i;
   
   #ifndef NO_DYNAMIC
     if (no_dynamic)
       return;
     symbols2=engine2(0,0,0,0,0);
   #if NO_IP
     symbols3=engine3(0,0,0,0,0);
   #else
     symbols3=symbols1;
   #endif
     ends1 = symbols1+i+1;
     ends1j =   ends1+i;
     nends1j = i+1;
     ends1jsorted = (Label *)alloca(nends1j*sizeof(Label));
     memcpy(ends1jsorted,ends1j,nends1j*sizeof(Label));
     qsort(ends1jsorted, nends1j, sizeof(Label), compare_labels);
   
     priminfos = calloc(i,sizeof(PrimInfo));
     for (i=0; symbols1[i]!=0; i++) {
       int prim_len = ends1[i]-symbols1[i];
       PrimInfo *pi=&priminfos[i];
       int j=0;
       char *s1 = (char *)symbols1[i];
       char *s2 = (char *)symbols2[i];
       char *s3 = (char *)symbols3[i];
       Label endlabel = bsearch_next(symbols1[i]+1,ends1jsorted,nends1j);
   
       pi->start = s1;
       pi->superend = superend[i]|no_super;
       if (pi->superend)
         pi->length = endlabel-symbols1[i];
       else
         pi->length = prim_len;
       pi->restlength = endlabel - symbols1[i] - pi->length;
       pi->nimmargs = 0;
       if (debug)
         fprintf(stderr, "Prim %3d @ %p %p %p, length=%3ld restlength=%2ld superend=%1d",
                 i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength), pi->superend);
       if (endlabel == NULL) {
         pi->start = NULL; /* not relocatable */
         if (pi->length<0) pi->length=100;
         if (debug)
           fprintf(stderr,"\n   non_reloc: no J label > start found\n");
         continue;
       }
       if (ends1[i] > endlabel && !pi->superend) {
         pi->start = NULL; /* not relocatable */
         pi->length = endlabel-symbols1[i];
         if (debug)
           fprintf(stderr,"\n   non_reloc: there is a J label before the K label (restlength<0)\n");
         continue;
       }
       if (ends1[i] < pi->start && !pi->superend) {
         pi->start = NULL; /* not relocatable */
         pi->length = endlabel-symbols1[i];
         if (debug)
           fprintf(stderr,"\n   non_reloc: K label before I label (length<0)\n");
         continue;
       }
       assert(prim_len>=0);
       assert(pi->restlength >=0);
       while (j<(pi->length+pi->restlength)) {
         if (s1[j]==s3[j]) {
           if (s1[j] != s2[j]) {
             pi->start = NULL; /* not relocatable */
             if (debug)
               fprintf(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);
             /* assert(j<prim_len); */
             break;
           }
           j++;
         } else {
           struct immarg *ia=&pi->immargs[pi->nimmargs];
   
           pi->nimmargs++;
           ia->offset=j;
           if ((~*(Cell *)&(s1[j]))==*(Cell *)&(s3[j])) {
             ia->rel=0;
             if (debug)
               fprintf(stderr,"\n   absolute immarg: offset %3d",j);
           } else if ((&(s1[j]))+(*(Cell *)&(s1[j]))+4 ==
                      symbols1[DOESJUMP+1]) {
             ia->rel=1;
             if (debug)
               fprintf(stderr,"\n   relative immarg: offset %3d",j);
           } else {
             pi->start = NULL; /* not relocatable */
             if (debug)
               fprintf(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);
             /* assert(j<prim_len);*/
             break;
           }
           j+=4;
         }
       }
       if (debug)
         fprintf(stderr,"\n");
     }
     decomp_prims = calloc(i,sizeof(PrimInfo *));
     for (i=DOESJUMP+1; i<npriminfos; i++)
       decomp_prims[i] = &(priminfos[i]);
     qsort(decomp_prims+DOESJUMP+1, npriminfos-DOESJUMP-1, sizeof(PrimInfo *),
           compare_priminfo_length);
   #endif
   }
   
   void flush_to_here(void)
   {
   #ifndef NO_DYNAMIC
     if (start_flush)
       FLUSH_ICACHE(start_flush, code_here-start_flush);
     start_flush=code_here;
   #endif
   }
   
   #ifndef NO_DYNAMIC
   void append_jump(void)
   {
     if (last_jump) {
       PrimInfo *pi = &priminfos[last_jump];
   
       memcpy(code_here, pi->start+pi->length, pi->restlength);
       code_here += pi->restlength;
       last_jump=0;
     }
   }
   
   /* Gforth remembers all code blocks in this list.  On forgetting (by
   executing a marker) the code blocks are not freed (because Gforth does
   not remember how they were allocated; hmm, remembering that might be
   easier and cleaner).  Instead, code_here etc. are reset to the old
   value, and the "forgotten" code blocks are reused when they are
   needed. */
   
   struct code_block_list {
     struct code_block_list *next;
     Address block;
     Cell size;
   } *code_block_list=NULL, **next_code_blockp=&code_block_list;
   
   Address append_prim(Cell p)
   {
     PrimInfo *pi = &priminfos[p];
     Address old_code_here = code_here;
   
     if (code_area+code_area_size < code_here+pi->length+pi->restlength) {
       struct code_block_list *p;
       append_jump();
       flush_to_here();
       if (*next_code_blockp == NULL) {
         code_here = start_flush = code_area = my_alloc(code_area_size);
         p = (struct code_block_list *)malloc(sizeof(struct code_block_list));
         *next_code_blockp = p;
         p->next = NULL;
         p->block = code_here;
         p->size = code_area_size;
       } else {
         p = *next_code_blockp;
         code_here = start_flush = code_area = p->block;
       }
       old_code_here = code_here;
       next_code_blockp = &(p->next);
     }
     memcpy(code_here, pi->start, pi->length);
     code_here += pi->length;
     return old_code_here;
   }
   #endif
   
   int forget_dyncode(Address code)
   {
   #ifdef NO_DYNAMIC
     return -1;
   #else
     struct code_block_list *p, **pp;
   
     for (pp=&code_block_list, p=*pp; p!=NULL; pp=&(p->next), p=*pp) {
       if (code >= p->block && code < p->block+p->size) {
         next_code_blockp = &(p->next);
         code_here = start_flush = code;
         code_area = p->block;
         last_jump = 0;
         return -1;
       }
     }
     return -no_dynamic;
   #endif /* !defined(NO_DYNAMIC) */
   }
   
   long dyncodesize(void)
   {
   #ifndef NO_DYNAMIC
     struct code_block_list *p;
     long size=0;
     for (p=code_block_list; p!=NULL; p=p->next) {
       if (code_here >= p->block && code_here < p->block+p->size)
         return size + (code_here - p->block);
       else
         size += p->size;
     }
   #endif /* !defined(NO_DYNAMIC) */
     return 0;
   }
   
   Label decompile_code(Label _code)
   {
   #ifdef NO_DYNAMIC
     return _code;
   #else /* !defined(NO_DYNAMIC) */
     Cell i;
     struct code_block_list *p;
     Address code=_code;
   
     /* first, check if we are in code at all */
     for (p = code_block_list;; p = p->next) {
       if (p == NULL)
         return code;
       if (code >= p->block && code < p->block+p->size)
         break;
     }
     /* reverse order because NOOP might match other prims */
     for (i=npriminfos-1; i>DOESJUMP; i--) {
       PrimInfo *pi=decomp_prims[i];
       if (pi->start==code || (pi->start && memcmp(code,pi->start,pi->length)==0))
         return vm_prims[super2[super_costs[pi-priminfos].offset]];
       /* return pi->start;*/
     }
     return code;
   #endif /* !defined(NO_DYNAMIC) */
   }
   
   #ifdef NO_IP
   int nbranchinfos=0;
   
   struct branchinfo {
     Label *targetptr; /* *(bi->targetptr) is the target */
     Cell *addressptr; /* store the target here */
   } branchinfos[100000];
   
   int ndoesexecinfos=0;
   struct doesexecinfo {
     int branchinfo; /* fix the targetptr of branchinfos[...->branchinfo] */
     Cell *xt; /* cfa of word whose does-code needs calling */
   } doesexecinfos[10000];
   
   void set_rel_target(Cell *source, Label target)
   {
     *source = ((Cell)target)-(((Cell)source)+4);
   }
   
   void register_branchinfo(Label source, Cell targetptr)
   {
     struct branchinfo *bi = &(branchinfos[nbranchinfos]);
     bi->targetptr = (Label *)targetptr;
     bi->addressptr = (Cell *)source;
     nbranchinfos++;
   }
   
   Address compile_prim1arg(PrimNum p, Cell **argp)
   {
     Address old_code_here=append_prim(p);
   
     assert(vm_prims[p]==priminfos[p].start);
     *argp = (Cell*)(old_code_here+priminfos[p].immargs[0].offset);
     return old_code_here;
   }
   
   Address compile_call2(Cell targetptr, Cell **next_code_targetp)
   {
     PrimInfo *pi = &priminfos[N_call2];
     Address old_code_here = append_prim(N_call2);
   
     *next_code_targetp = (Cell *)(old_code_here + pi->immargs[0].offset);
     register_branchinfo(old_code_here + pi->immargs[1].offset, targetptr);
     return old_code_here;
   }
   #endif
   
   void finish_code(void)
   {
   #ifdef NO_IP
     Cell i;
   
     compile_prim1(NULL);
     for (i=0; i<ndoesexecinfos; i++) {
       struct doesexecinfo *dei = &doesexecinfos[i];
       branchinfos[dei->branchinfo].targetptr = (Label *)DOES_CODE1((dei->xt));
     }
     ndoesexecinfos = 0;
     for (i=0; i<nbranchinfos; i++) {
       struct branchinfo *bi=&branchinfos[i];
       set_rel_target(bi->addressptr, *(bi->targetptr));
     }
     nbranchinfos = 0;
   #else
     compile_prim1(NULL);
   #endif
     flush_to_here();
   }
   
   #ifdef NO_IP
   Cell compile_prim_dyn(PrimNum p, Cell *tcp)
        /* compile prim #p dynamically (mod flags etc.) and return start
           address of generated code for putting it into the threaded
           code. This function is only called if all the associated
           inline arguments of p are already in place (at tcp[1] etc.) */
   {
     PrimInfo *pi=&priminfos[p];
     Cell *next_code_target=NULL;
     Cell codeaddr = (Cell)code_here;
   
     assert(p<npriminfos);
     if (p==N_execute || p==N_perform || p==N_lit_perform) {
       codeaddr = compile_prim1arg(N_set_next_code, &next_code_target);
     }
     if (p==N_call) {
       codeaddr = compile_call2(tcp[1], &next_code_target);
     } else if (p==N_does_exec) {
       struct doesexecinfo *dei = &doesexecinfos[ndoesexecinfos++];
       Cell *arg;
       codeaddr = compile_prim1arg(N_lit,&arg);
       *arg = (Cell)PFA(tcp[1]);
       /* we cannot determine the callee now (last_start[1] may be a
          forward reference), so just register an arbitrary target, and
          register in dei that we need to fix this before resolving
          branches */
       dei->branchinfo = nbranchinfos;
       dei->xt = (Cell *)(tcp[1]);
       compile_call2(0, &next_code_target);
     } else if (!is_relocatable(p)) {
       Cell *branch_target;
       codeaddr = compile_prim1arg(N_set_next_code, &next_code_target);
       compile_prim1arg(N_branch,&branch_target);
       set_rel_target(branch_target,vm_prims[p]);
     } else {
       unsigned j;
       Address old_code_here = append_prim(p);
   
       for (j=0; j<pi->nimmargs; j++) {
         struct immarg *ia = &(pi->immargs[j]);
         Cell argval = tcp[pi->nimmargs - j]; /* !! specific to prims */
         if (ia->rel) { /* !! assumption: relative refs are branches */
           register_branchinfo(old_code_here + ia->offset, argval);
         } else /* plain argument */
           *(Cell *)(old_code_here + ia->offset) = argval;
       }
     }
     if (next_code_target!=NULL)
       *next_code_target = (Cell)code_here;
     return codeaddr;
   }
   #else /* !defined(NO_IP) */
   Cell compile_prim_dyn(PrimNum p, Cell *tcp)
        /* compile prim #p dynamically (mod flags etc.) and return start
           address of generated code for putting it into the threaded code */
   {
     Cell static_prim = (Cell)vm_prims[p];
   #if defined(NO_DYNAMIC)
     return static_prim;
   #else /* !defined(NO_DYNAMIC) */
     Address old_code_here;
   
     if (no_dynamic)
       return static_prim;
     if (p>=npriminfos || !is_relocatable(p)) {
       append_jump();
       return static_prim;
     }
     old_code_here = append_prim(p);
     last_jump = (priminfos[p].superend) ? 0 : p;
     return (Cell)old_code_here;
   #endif  /* !defined(NO_DYNAMIC) */
   }
   #endif /* !defined(NO_IP) */
   
   #ifndef NO_DYNAMIC
   int cost_codesize(int prim)
   {
     return priminfos[prim].length;
   }
   #endif
   
   int cost_ls(int prim)
   {
     struct cost *c = super_costs+prim;
   
     return c->loads + c->stores;
   }
   
   int cost_lsu(int prim)
   {
     struct cost *c = super_costs+prim;
   
     return c->loads + c->stores + c->updates;
   }
   
   int cost_nexts(int prim)
   {
     return 1;
   }
   
   typedef int Costfunc(int);
   Costfunc *ss_cost =  /* cost function for optimize_bb */
   #ifdef NO_DYNAMIC
   cost_lsu;
   #else
   cost_codesize;
   #endif
   
   struct {
     Costfunc *costfunc;
     char *metricname;
     long sum;
   } cost_sums[] = {
   #ifndef NO_DYNAMIC
     { cost_codesize, "codesize", 0 },
   #endif
     { cost_ls,       "ls",       0 },
     { cost_lsu,      "lsu",      0 },
     { cost_nexts,    "nexts",    0 }
   };
   
   #define MAX_BB 128 /* maximum number of instructions in BB */
   #define INF_COST 1000000 /* infinite cost */
   #define CANONICAL_STATE 0
   
   struct waypoint {
     int cost;     /* the cost from here to the end */
     PrimNum inst; /* the inst used from here to the next waypoint */
     char relocatable; /* the last non-transition was relocatable */
     char no_transition; /* don't use the next transition (relocatability)
                          * or this transition (does not change state) */
   };
   
   void init_waypoints(struct waypoint ws[])
   {
     int k;
   
     for (k=0; k<maxstates; k++)
       ws[k].cost=INF_COST;
   }
   
   void transitions(struct waypoint inst[], struct waypoint trans[])
   {
     int k;
     struct super_state *l;
   
     for (k=0; k<maxstates; k++) {
       trans[k] = inst[k];
       trans[k].no_transition = 1;
     }
     for (l = state_transitions; l != NULL; l = l->next) {
       PrimNum s = l->super;
       int jcost;
       struct cost *c=super_costs+s;
       struct waypoint *wi=&(trans[c->state_in]);
       struct waypoint *wo=&(inst[c->state_out]);
       if (wo->cost == INF_COST)
         continue;
       jcost = wo->cost + ss_cost(s);
       if (jcost <= wi->cost) {
         wi->cost = jcost;
         wi->inst = s;
         wi->relocatable = wo->relocatable;
         wi->no_transition = 0;
         /* if (ss_greedy) wi->cost = wo->cost ? */
       }
     }
   }
   
   /* use dynamic programming to find the shortest paths within the basic
      block origs[0..ninsts-1] and rewrite the instructions pointed to by
      instps to use it */
   void optimize_rewrite(Cell *instps[], PrimNum origs[], int ninsts)
   {
     int i,j;
     static struct waypoint inst[MAX_BB+1][MAX_STATE];  /* before instruction*/
     static struct waypoint trans[MAX_BB+1][MAX_STATE]; /* before transition */
     int nextdyn, nextstate, no_transition;
   
     init_waypoints(inst[ninsts]);
     inst[ninsts][CANONICAL_STATE].cost=0;
     transitions(inst[ninsts],trans[ninsts]);
     for (i=ninsts-1; i>=0; i--) {
       init_waypoints(inst[i]);
       for (j=1; j<=max_super && i+j<=ninsts; j++) {
         struct super_state **superp = lookup_super(origs+i, j);
         if (superp!=NULL) {
           struct super_state *supers = *superp;
           for (; supers!=NULL; supers = supers->next) {
             PrimNum s = supers->super;
             int jcost;
             struct cost *c=super_costs+s;
             struct waypoint *wi=&(inst[i][c->state_in]);
             struct waypoint *wo=&(trans[i+j][c->state_out]);
             int no_transition = wo->no_transition;
             if (!(is_relocatable(s)) && !wo->relocatable) {
               wo=&(inst[i+j][c->state_out]);
               no_transition=1;
             }
             if (wo->cost == INF_COST)
               continue;
             jcost = wo->cost + ss_cost(s);
             if (jcost <= wi->cost) {
               wi->cost = jcost;
               wi->inst = s;
               wi->relocatable = is_relocatable(s);
               wi->no_transition = no_transition;
               /* if (ss_greedy) wi->cost = wo->cost ? */
             }
           }
         }
       }
       transitions(inst[i],trans[i]);
     }
     /* now rewrite the instructions */
     nextdyn=0;
     nextstate=CANONICAL_STATE;
     no_transition = ((!trans[0][nextstate].relocatable)
                      ||trans[0][nextstate].no_transition);
     for (i=0; i<ninsts; i++) {
       Cell tc=0, tc2;
       if (i==nextdyn) {
         if (!no_transition) {
           /* process trans */
           PrimNum p = trans[i][nextstate].inst;
           struct cost *c = super_costs+p;
           assert(trans[i][nextstate].cost != INF_COST);
           assert(c->state_in==nextstate);
           tc = compile_prim_dyn(p,NULL);
           nextstate = c->state_out;
         }
         {
           /* process inst */
           PrimNum p = inst[i][nextstate].inst;
           struct cost *c=super_costs+p;
           assert(c->state_in==nextstate);
           assert(inst[i][nextstate].cost != INF_COST);
   #if defined(GFORTH_DEBUGGING)
           assert(p == origs[i]);
   #endif
           tc2 = compile_prim_dyn(p,instps[i]);
           if (no_transition || !is_relocatable(p))
             /* !! actually what we care about is if and where
              * compile_prim_dyn() puts NEXTs */
             tc=tc2;
           no_transition = inst[i][nextstate].no_transition;
           nextstate = c->state_out;
           nextdyn += c->length;
         }
       } else {
   #if defined(GFORTH_DEBUGGING)
         assert(0);
   #endif
         tc=0;
         /* tc= (Cell)vm_prims[inst[i][CANONICAL_STATE].inst]; */
       }
       *(instps[i]) = tc;
     }
     if (!no_transition) {
       PrimNum p = trans[i][nextstate].inst;
       struct cost *c = super_costs+p;
       assert(c->state_in==nextstate);
       assert(trans[i][nextstate].cost != INF_COST);
       assert(i==nextdyn);
       (void)compile_prim_dyn(p,NULL);
       nextstate = c->state_out;
     }
     assert(nextstate==CANONICAL_STATE);
   }
   
   /* compile *start, possibly rewriting it into a static and/or dynamic
      superinstruction */
   void compile_prim1(Cell *start)
   {
   #if defined(DOUBLY_INDIRECT)
     Label prim;
   
     if (start==NULL)
       return;
     prim = (Label)*start;
     if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) {
       fprintf(stderr,"compile_prim encountered xt %p\n", prim);
       *start=(Cell)prim;
       return;
     } else {
       *start = (Cell)(prim-((Label)xts)+((Label)vm_prims));
       return;
     }
   #elif defined(INDIRECT_THREADED)
     return;
   #else /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */
     /* !! does not work, for unknown reasons; but something like this is
        probably needed to ensure that we don't call compile_prim_dyn
        before the inline arguments are there */
     static Cell *instps[MAX_BB];
     static PrimNum origs[MAX_BB];
     static int ninsts=0;
     PrimNum prim_num;
   
     if (start==NULL || ninsts >= MAX_BB ||
         (ninsts>0 && superend[origs[ninsts-1]])) {
       /* after bb, or at the start of the next bb */
       optimize_rewrite(instps,origs,ninsts);
       /* fprintf(stderr,"optimize_rewrite(...,%d)\n",ninsts); */
       ninsts=0;
       if (start==NULL)
         return;
     }
     prim_num = ((Xt)*start)-vm_prims;
     if(prim_num >= npriminfos) {
       optimize_rewrite(instps,origs,ninsts);
       /* fprintf(stderr,"optimize_rewrite(...,%d)\n",ninsts);*/
       ninsts=0;
       return;
     }
     assert(ninsts<MAX_BB);
     instps[ninsts] = start;
     origs[ninsts] = prim_num;
     ninsts++;
   #endif /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */
   }
   
 Address loader(FILE *imagefile, char* filename)  Address loader(FILE *imagefile, char* filename)
 /* returns the address of the image proper (after the preamble) */  /* returns the address of the image proper (after the preamble) */
 {  {
Line 345 
Line 1432 
   Char magic[8];    Char magic[8];
   char magic7; /* size byte of magic number */    char magic7; /* size byte of magic number */
   Cell preamblesize=0;    Cell preamblesize=0;
   Label *symbols = engine(0,0,0,0,0);  
   Cell data_offset = offset_image ? 56*sizeof(Cell) : 0;    Cell data_offset = offset_image ? 56*sizeof(Cell) : 0;
   UCell check_sum;    UCell check_sum;
   static char* endianstring[]= { "big","little" };  
   Cell ausize = ((RELINFOBITS ==  8) ? 0 :    Cell ausize = ((RELINFOBITS ==  8) ? 0 :
                  (RELINFOBITS == 16) ? 1 :                   (RELINFOBITS == 16) ? 1 :
                  (RELINFOBITS == 32) ? 2 : 3);                   (RELINFOBITS == 32) ? 2 : 3);
Line 358 
Line 1443 
   Cell cellsize = ((sizeof(Cell) == 1) ? 0 :    Cell cellsize = ((sizeof(Cell) == 1) ? 0 :
                    (sizeof(Cell) == 2) ? 1 :                     (sizeof(Cell) == 2) ? 1 :
                    (sizeof(Cell) == 4) ? 2 : 3) + ausize;                     (sizeof(Cell) == 4) ? 2 : 3) + ausize;
     Cell sizebyte = (ausize << 5) + (charsize << 3) + (cellsize << 1) +
   #ifdef WORDS_BIGENDIAN
          0
   #else
          1
   #endif
       ;
   
     vm_prims = engine(0,0,0,0,0);
     check_prims(vm_prims);
     prepare_super_table();
 #ifndef DOUBLY_INDIRECT  #ifndef DOUBLY_INDIRECT
   check_sum = checksum(symbols);  #ifdef PRINT_SUPER_LENGTHS
     print_super_lengths();
   #endif
     check_sum = checksum(vm_prims);
 #else /* defined(DOUBLY_INDIRECT) */  #else /* defined(DOUBLY_INDIRECT) */
   check_sum = (UCell)symbols;    check_sum = (UCell)vm_prims;
 #endif /* defined(DOUBLY_INDIRECT) */  #endif /* defined(DOUBLY_INDIRECT) */
   
   do {    do {
     if(fread(magic,sizeof(Char),8,imagefile) < 8) {      if(fread(magic,sizeof(Char),8,imagefile) < 8) {
       fprintf(stderr,"%s: image %s doesn't seem to be a Gforth (>=0.4) image.\n",        fprintf(stderr,"%s: image %s doesn't seem to be a Gforth (>=0.6) image.\n",
               progname, filename);                progname, filename);
       exit(1);        exit(1);
     }      }
     preamblesize+=8;      preamblesize+=8;
   } while(memcmp(magic,"Gforth2",7));    } while(memcmp(magic,"Gforth3",7));
   magic7 = magic[7];    magic7 = magic[7];
   if (debug) {    if (debug) {
     magic[7]='\0';      magic[7]='\0';
     fprintf(stderr,"Magic found: %s $%x\n", magic, magic7);      fprintf(stderr,"Magic found: %s ", magic);
       print_sizes(magic7);
   }    }
   
   if(magic7 != (ausize << 5) + (charsize << 3) + (cellsize << 1) +    if (magic7 != sizebyte)
 #ifdef WORDS_BIGENDIAN      {
        0        fprintf(stderr,"This image is:         ");
 #else        print_sizes(magic7);
        1        fprintf(stderr,"whereas the machine is ");
 #endif        print_sizes(sizebyte);
        )  
     { fprintf(stderr,"This image is %d bit cell, %d bit char, %d bit address unit %s-endian,\n"  
               "whereas the machine is %d bit cell, %d bit char, %d bit address unit, %s-endian.\n",  
               (1<<((magic7>>1)&3))*8,  
               (1<<((magic7>>3)&3))*8,  
               (1<<((magic7>>5)&3))*8,  
               endianstring[magic7&1],  
               (1<<cellsize)*8,  
               (1<<charsize)*8,  
               (1<<ausize)*8,  
               endianstring[  
 #ifdef WORDS_BIGENDIAN  
                       0  
 #else  
                       1  
 #endif  
                       ]);  
       exit(-2);        exit(-2);
     };      };
   
Line 420 
Line 1501 
   if (debug)    if (debug)
     fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize);      fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize);
   
   image = dict_alloc(preamblesize+dictsize+data_offset)+data_offset;    image = dict_alloc_read(imagefile, preamblesize+header.image_size,
   rewind(imagefile);  /* fseek(imagefile,0L,SEEK_SET); */                            preamblesize+dictsize, data_offset);
   if (clear_dictionary)  
     memset(image, 0, dictsize);  
   fread(image, 1, preamblesize+header.image_size, imagefile);  
   imp=image+preamblesize;    imp=image+preamblesize;
   if(header.base==0) {    alloc_stacks((ImageHeader *)imp);
     if (clear_dictionary)
       memset(imp+header.image_size, 0, dictsize-header.image_size);
     if(header.base==0 || header.base  == (Address)0x100) {
     Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1;      Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1;
     char reloc_bits[reloc_size];      char reloc_bits[reloc_size];
       fseek(imagefile, preamblesize+header.image_size, SEEK_SET);
     fread(reloc_bits, 1, reloc_size, imagefile);      fread(reloc_bits, 1, reloc_size, imagefile);
     relocate((Cell *)imp, reloc_bits, header.image_size, symbols);      relocate((Cell *)imp, reloc_bits, header.image_size, (Cell)header.base, vm_prims);
 #if 0  #if 0
     { /* let's see what the relocator did */      { /* let's see what the relocator did */
       FILE *snapshot=fopen("snapshot.fi","wb");        FILE *snapshot=fopen("snapshot.fi","wb");
Line 451 
Line 1533 
             progname, (unsigned long)(header.checksum),(unsigned long)check_sum);              progname, (unsigned long)(header.checksum),(unsigned long)check_sum);
     exit(1);      exit(1);
   }    }
   #ifdef DOUBLY_INDIRECT
     ((ImageHeader *)imp)->xt_base = xts;
   #endif
   fclose(imagefile);    fclose(imagefile);
   
   alloc_stacks((ImageHeader *)imp);    /* unnecessary, except maybe for CODE words */
     /* FLUSH_ICACHE(imp, header.image_size);*/
   CACHE_FLUSH(imp, header.image_size);  
   
   return imp;    return imp;
 }  }
   
 int onlypath(char *file)  /* pointer to last '/' or '\' in file, 0 if there is none. */
   char *onlypath(char *filename)
 {  {
   int i;    return strrchr(filename, DIRSEP);
   i=strlen(file);  
   while (i) {  
     if (file[i]=='\\' || file[i]=='/') break;  
     i--;  
   }  
   return i;  
 }  }
   
 FILE *openimage(char *fullfilename)  FILE *openimage(char *fullfilename)
 {  {
   FILE *image_file;    FILE *image_file;
     char * expfilename = tilde_cstr(fullfilename, strlen(fullfilename), 1);
   
   image_file=fopen(fullfilename,"rb");    image_file=fopen(expfilename,"rb");
   if (image_file!=NULL && debug)    if (image_file!=NULL && debug)
     fprintf(stderr, "Opened image file: %s\n", fullfilename);      fprintf(stderr, "Opened image file: %s\n", expfilename);
   return image_file;    return image_file;
 }  }
   
   /* try to open image file concat(path[0:len],imagename) */
 FILE *checkimage(char *path, int len, char *imagename)  FILE *checkimage(char *path, int len, char *imagename)
 {  {
   int dirlen=len;    int dirlen=len;
   char fullfilename[dirlen+strlen(imagename)+2];    char fullfilename[dirlen+strlen(imagename)+2];
   
   memcpy(fullfilename, path, dirlen);    memcpy(fullfilename, path, dirlen);
   if (fullfilename[dirlen-1]!='/')    if (fullfilename[dirlen-1]!=DIRSEP)
     fullfilename[dirlen++]='/';      fullfilename[dirlen++]=DIRSEP;
   strcpy(fullfilename+dirlen,imagename);    strcpy(fullfilename+dirlen,imagename);
   return openimage(fullfilename);    return openimage(fullfilename);
 }  }
Line 496 
Line 1577 
 FILE * open_image_file(char * imagename, char * path)  FILE * open_image_file(char * imagename, char * path)
 {  {
   FILE * image_file=NULL;    FILE * image_file=NULL;
     char *origpath=path;
   
   if(strchr(imagename, '/')==NULL) {    if(strchr(imagename, DIRSEP)==NULL) {
     /* first check the directory where the exe file is in !! 01may97jaw */      /* first check the directory where the exe file is in !! 01may97jaw */
     if (onlypath(progname))      if (onlypath(progname))
       image_file=checkimage(progname, onlypath(progname), imagename);        image_file=checkimage(progname, onlypath(progname)-progname, imagename);
     if (!image_file)      if (!image_file)
       do {        do {
         char *pend=strchr(path, PATHSEP);          char *pend=strchr(path, PATHSEP);
Line 516 
Line 1598 
   
   if (!image_file) {    if (!image_file) {
     fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n",      fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n",
             progname, imagename, path);              progname, imagename, origpath);
     exit(1);      exit(1);
   }    }
   
Line 546 
Line 1628 
       m=1024*1024*1024;        m=1024*1024*1024;
     else if (strcmp(endp,"T")==0) {      else if (strcmp(endp,"T")==0) {
 #if (SIZEOF_CHAR_P > 4)  #if (SIZEOF_CHAR_P > 4)
       m=1024*1024*1024*1024;        m=1024L*1024*1024*1024;
 #else  #else
       fprintf(stderr,"%s: size specification \"%s\" too large for this machine\n", progname, endp);        fprintf(stderr,"%s: size specification \"%s\" too large for this machine\n", progname, endp);
       exit(1);        exit(1);
Line 559 
Line 1641 
   return n*m;    return n*m;
 }  }
   
   enum {
     ss_number = 256,
     ss_states,
     ss_min_codesize,
     ss_min_ls,
     ss_min_lsu,
     ss_min_nexts,
   };
   
 void gforth_args(int argc, char ** argv, char ** path, char ** imagename)  void gforth_args(int argc, char ** argv, char ** path, char ** imagename)
 {  {
   int c;    int c;
Line 567 
Line 1658 
   while (1) {    while (1) {
     int option_index=0;      int option_index=0;
     static struct option opts[] = {      static struct option opts[] = {
         {"appl-image", required_argument, NULL, 'a'},
       {"image-file", required_argument, NULL, 'i'},        {"image-file", required_argument, NULL, 'i'},
       {"dictionary-size", required_argument, NULL, 'm'},        {"dictionary-size", required_argument, NULL, 'm'},
       {"data-stack-size", required_argument, NULL, 'd'},        {"data-stack-size", required_argument, NULL, 'd'},
Line 582 
Line 1674 
       {"clear-dictionary", no_argument, &clear_dictionary, 1},        {"clear-dictionary", no_argument, &clear_dictionary, 1},
       {"die-on-signal", no_argument, &die_on_signal, 1},        {"die-on-signal", no_argument, &die_on_signal, 1},
       {"debug", no_argument, &debug, 1},        {"debug", no_argument, &debug, 1},
         {"no-super", no_argument, &no_super, 1},
         {"no-dynamic", no_argument, &no_dynamic, 1},
         {"dynamic", no_argument, &no_dynamic, 0},
         {"print-metrics", no_argument, &print_metrics, 1},
         {"ss-number", required_argument, NULL, ss_number},
         {"ss-states", required_argument, NULL, ss_states},
   #ifndef NO_DYNAMIC
         {"ss-min-codesize", no_argument, NULL, ss_min_codesize},
   #endif
         {"ss-min-ls",       no_argument, NULL, ss_min_ls},
         {"ss-min-lsu",      no_argument, NULL, ss_min_lsu},
         {"ss-min-nexts",    no_argument, NULL, ss_min_nexts},
         {"ss-greedy",       no_argument, &ss_greedy, 1},
       {0,0,0,0}        {0,0,0,0}
       /* no-init-file, no-rc? */        /* no-init-file, no-rc? */
     };      };
   
     c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:vh", opts, &option_index);      c = getopt_long(argc, argv, "+i:m:d:r:f:l:p:vhoncsx", opts, &option_index);
   
     if (c==EOF)  
       break;  
     if (c=='?') {  
       optind--;  
       break;  
     }  
     switch (c) {      switch (c) {
       case EOF: return;
       case '?': optind--; return;
       case 'a': *imagename = optarg; return;
     case 'i': *imagename = optarg; break;      case 'i': *imagename = optarg; break;
     case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;      case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
     case 'd': dsize = convsize(optarg,sizeof(Cell)); break;      case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
Line 602 
Line 1704 
     case 'f': fsize = convsize(optarg,sizeof(Float)); break;      case 'f': fsize = convsize(optarg,sizeof(Float)); break;
     case 'l': lsize = convsize(optarg,sizeof(Cell)); break;      case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
     case 'p': *path = optarg; break;      case 'p': *path = optarg; break;
     case 'v': fprintf(stderr, "gforth %s\n", VERSION); exit(0);      case 'o': offset_image = 1; break;
       case 'n': offset_image = 0; break;
       case 'c': clear_dictionary = 1; break;
       case 's': die_on_signal = 1; break;
       case 'x': debug = 1; break;
       case 'v': fputs(PACKAGE_STRING"\n", stderr); exit(0);
       case ss_number: static_super_number = atoi(optarg); break;
       case ss_states: maxstates = max(min(atoi(optarg),MAX_STATE),1); break;
   #ifndef NO_DYNAMIC
       case ss_min_codesize: ss_cost = cost_codesize; break;
   #endif
       case ss_min_ls:       ss_cost = cost_ls;       break;
       case ss_min_lsu:      ss_cost = cost_lsu;      break;
       case ss_min_nexts:    ss_cost = cost_nexts;    break;
     case 'h':      case 'h':
       fprintf(stderr, "Usage: %s [engine options] [image arguments]\n\        fprintf(stderr, "Usage: %s [engine options] ['--'] [image arguments]\n\
 Engine Options:\n\  Engine Options:\n\
     --appl-image FILE                 equivalent to '--image-file=FILE --'\n\
   --clear-dictionary                Initialize the dictionary with 0 bytes\n\    --clear-dictionary                Initialize the dictionary with 0 bytes\n\
   -d SIZE, --data-stack-size=SIZE   Specify data stack size\n\    -d SIZE, --data-stack-size=SIZE   Specify data stack size\n\
   --debug                           Print debugging information during startup\n\    --debug                           Print debugging information during startup\n\
   --die-on-signal                   exit instead of CATCHing some signals\n\    --die-on-signal                   exit instead of CATCHing some signals\n\
     --dynamic                         use dynamic native code\n\
   -f SIZE, --fp-stack-size=SIZE     Specify floating point stack size\n\    -f SIZE, --fp-stack-size=SIZE     Specify floating point stack size\n\
   -h, --help                        Print this message and exit\n\    -h, --help                        Print this message and exit\n\
   -i FILE, --image-file=FILE        Use image FILE instead of `gforth.fi'\n\    -i FILE, --image-file=FILE        Use image FILE instead of `gforth.fi'\n\
   -l SIZE, --locals-stack-size=SIZE Specify locals stack size\n\    -l SIZE, --locals-stack-size=SIZE Specify locals stack size\n\
   -m SIZE, --dictionary-size=SIZE   Specify Forth dictionary size\n\    -m SIZE, --dictionary-size=SIZE   Specify Forth dictionary size\n\
     --no-dynamic                      Use only statically compiled primitives\n\
   --no-offset-im                    Load image at normal position\n\    --no-offset-im                    Load image at normal position\n\
     --no-super                        No dynamically formed superinstructions\n\
   --offset-image                    Load image at a different position\n\    --offset-image                    Load image at a different position\n\
   -p PATH, --path=PATH              Search path for finding image and sources\n\    -p PATH, --path=PATH              Search path for finding image and sources\n\
     --print-metrics                   Print some code generation metrics on exit\n\
   -r SIZE, --return-stack-size=SIZE Specify return stack size\n\    -r SIZE, --return-stack-size=SIZE Specify return stack size\n\
   -v, --version                     Print version and exit\n\    --ss-greedy                       greedy, not optimal superinst selection\n\
     --ss-min-codesize                 select superinsts for smallest native code\n\
     --ss-min-ls                       minimize loads and stores\n\
     --ss-min-lsu                      minimize loads, stores, and pointer updates\n\
     --ss-min-nexts                    minimize the number of static superinsts\n\
     --ss-number=N                     use N static superinsts (default max)\n\
     --ss-states=N                     N states for stack caching (default max)\n\
     -v, --version                     Print engine version and exit\n\
 SIZE arguments consist of an integer followed by a unit. The unit can be\n\  SIZE arguments consist of an integer followed by a unit. The unit can be\n\
   `b' (byte), `e' (element; default), `k' (KB), `M' (MB), `G' (GB) or `T' (TB).\n",    `b' (byte), `e' (element; default), `k' (KB), `M' (MB), `G' (GB) or `T' (TB).\n",
               argv[0]);                argv[0]);
       optind--;        optind--;
       return;        return;
       exit(0);  
     }      }
   }    }
 }  }
Line 638 
Line 1764 
   
 int main(int argc, char **argv, char **env)  int main(int argc, char **argv, char **env)
 {  {
   #ifdef HAS_OS
   char *path = getenv("GFORTHPATH") ? : DEFAULTPATH;    char *path = getenv("GFORTHPATH") ? : DEFAULTPATH;
   #else
     char *path = DEFAULTPATH;
   #endif
 #ifndef INCLUDE_IMAGE  #ifndef INCLUDE_IMAGE
   char *imagename="gforth.fi";    char *imagename="gforth.fi";
   FILE *image_file;    FILE *image_file;
Line 646 
Line 1776 
 #endif  #endif
   int retvalue;    int retvalue;
   
 #if defined(i386) && defined(ALIGNMENT_CHECK) && !defined(DIRECT_THREADED)  #if defined(i386) && defined(ALIGNMENT_CHECK)
   /* turn on alignment checks on the 486.    /* turn on alignment checks on the 486.
    * on the 386 this should have no effect. */     * on the 386 this should have no effect. */
   __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");    __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");
Line 668 
Line 1798 
   
 #ifdef HAS_OS  #ifdef HAS_OS
   gforth_args(argc, argv, &path, &imagename);    gforth_args(argc, argv, &path, &imagename);
 #endif  #ifndef NO_DYNAMIC
     if (no_dynamic && ss_cost == cost_codesize) {
       ss_cost = cost_nexts;
       cost_sums[0] = cost_sums[1]; /* don't use cost_codesize for print-metrics */
       if (debug)
         fprintf(stderr, "--no-dynamic conflicts with --ss-min-codesize, reverting to --ss-min-nexts\n");
     }
   #endif /* !defined(NO_DYNAMIC) */
   #endif /* defined(HAS_OS) */
   
 #ifdef INCLUDE_IMAGE  #ifdef INCLUDE_IMAGE
   set_stack_sizes((ImageHeader *)image);    set_stack_sizes((ImageHeader *)image);
   relocate(image, reloc_bits, ((ImageHeader*)&image)->image_size, (Label*)engine(0, 0, 0, 0, 0));    if(((ImageHeader *)image)->base != image)
       relocate(image, reloc_bits, ((ImageHeader *)image)->image_size,
                (Label*)engine(0, 0, 0, 0, 0));
   alloc_stacks((ImageHeader *)image);    alloc_stacks((ImageHeader *)image);
 #else  #else
   image_file = open_image_file(imagename, path);    image_file = open_image_file(imagename, path);
   image = loader(image_file, imagename);    image = loader(image_file, imagename);
 #endif  #endif
     gforth_header=(ImageHeader *)image; /* used in SIGSEGV handler */
   
   {    {
     char path2[strlen(path)+1];      char path2[strlen(path)+1];
Line 700 
Line 1841 
         *p2 = *p1;          *p2 = *p1;
     *p2='\0';      *p2='\0';
     retvalue = go_forth(image, 4, environ);      retvalue = go_forth(image, 4, environ);
   #ifdef SIGPIPE
       bsd_signal(SIGPIPE, SIG_IGN);
   #endif
   #ifdef VM_PROFILING
       vm_print_profile(stderr);
   #endif
     deprep_terminal();      deprep_terminal();
   }    }
     if (print_metrics) {
       int i;
       fprintf(stderr, "code size = %8ld\n", dyncodesize());
       for (i=0; i<sizeof(cost_sums)/sizeof(cost_sums[0]); i++)
         fprintf(stderr, "metric %8s: %8ld\n",
                 cost_sums[i].metricname, cost_sums[i].sum);
     }
   return retvalue;    return retvalue;
 }  }

Generate output suitable for use with a patch program
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.134
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help