[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.133 and 1.189

version 1.133, Sun Nov 9 11:45:33 2003 UTC version 1.189, Mon Oct 29 13:45:50 2007 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,2000,2003 Free Software Foundation, Inc.    Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
Line 44 
Line 44 
 #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 {  typedef enum prim_num {
Line 56 
Line 56 
 /* global variables for engine.c  /* global variables for engine.c
    We put them here because engine.c is compiled several times in     We put them here because engine.c is compiled several times in
    different ways for the same engine. */     different ways for the same engine. */
 Cell *SP;  Cell *gforth_SP;
 Float *FP;  Float *gforth_FP;
 Address UP=NULL;  Address gforth_UP=NULL;
   
 #ifdef HAS_FFCALL  #ifdef HAS_FFCALL
 Cell *RP;  Cell *gforth_RP;
 Address LP;  Address gforth_LP;
   
 #include <callback.h>  #include <callback.h>
   
 va_alist clist;  va_alist gforth_clist;
   
 void engine_callback(Xt* fcall, void * alist)  void gforth_callback(Xt* fcall, void * alist)
 {  {
   clist = (va_alist)alist;    /* save global valiables */
   engine(fcall, SP, RP, FP, LP);    Cell *rp = gforth_RP;
     Cell *sp = gforth_SP;
     Float *fp = gforth_FP;
     Address lp = gforth_LP;
     va_alist clist = gforth_clist;
   
     gforth_clist = (va_alist)alist;
   
     gforth_engine(fcall, sp, rp, fp, lp);
   
     /* restore global variables */
     gforth_RP = rp;
     gforth_SP = sp;
     gforth_FP = fp;
     gforth_LP = lp;
     gforth_clist = clist;
   }
   #endif
   
   #ifdef HAS_LIBFFI
   Cell *gforth_RP;
   Address gforth_LP;
   
   #include <ffi.h>
   
   void ** gforth_clist;
   void * gforth_ritem;
   
   void gforth_callback(ffi_cif * cif, void * resp, void ** args, void * ip)
   {
     Cell *rp = gforth_RP;
     Cell *sp = gforth_SP;
     Float *fp = gforth_FP;
     Address lp = gforth_LP;
     void ** clist = gforth_clist;
     void * ritem = gforth_ritem;
   
     gforth_clist = args;
     gforth_ritem = resp;
   
     gforth_engine((Xt *)ip, sp, rp, fp, lp);
   
     /* restore global variables */
     gforth_RP = rp;
     gforth_SP = sp;
     gforth_FP = fp;
     gforth_LP = lp;
     gforth_clist = clist;
     gforth_ritem = ritem;
 }  }
 #endif  #endif
   
Line 131 
Line 179 
 static UCell lsize=0;  static UCell lsize=0;
 int offset_image=0;  int offset_image=0;
 int die_on_signal=0;  int die_on_signal=0;
   int ignore_async_signals=0;
 #ifndef INCLUDE_IMAGE  #ifndef INCLUDE_IMAGE
 static int clear_dictionary=0;  static int clear_dictionary=0;
 UCell pagesize=1;  UCell pagesize=1;
Line 139 
Line 188 
 char *progname = "gforth";  char *progname = "gforth";
 int optind = 1;  int optind = 1;
 #endif  #endif
   #ifndef MAP_NORESERVE
   #define MAP_NORESERVE 0
   #endif
   /* IF you have an old Cygwin, this may help:
   #ifdef __CYGWIN__
   #define MAP_NORESERVE 0
   #endif
   */
   static int map_noreserve=MAP_NORESERVE;
   
 #define CODE_BLOCK_SIZE (4096*1024) /* !! overflow handling for -native */  #define CODE_BLOCK_SIZE (512*1024) /* !! overflow handling for -native */
 Address code_area=0;  Address code_area=0;
 Cell code_area_size = CODE_BLOCK_SIZE;  Cell code_area_size = CODE_BLOCK_SIZE;
 Address code_here=NULL+CODE_BLOCK_SIZE; /* does for code-area what HERE  Address code_here=NULL+CODE_BLOCK_SIZE; /* does for code-area what HERE
Line 153 
Line 211 
 static int no_dynamic=NO_DYNAMIC_DEFAULT; /* if true, no code is generated  static int no_dynamic=NO_DYNAMIC_DEFAULT; /* if true, no code is generated
                                              dynamically */                                               dynamically */
 static int print_metrics=0; /* if true, print metrics on exit */  static int print_metrics=0; /* if true, print metrics on exit */
 static int static_super_number = 10000000; /* number of ss used if available */  static int static_super_number = 0; /* number of ss used if available */
 #define MAX_STATE 4 /* maximum number of states */                                      /* disabled because of tpa */
   #define MAX_STATE 9 /* maximum number of states */
 static int maxstates = MAX_STATE; /* number of states for stack caching */  static int maxstates = MAX_STATE; /* number of states for stack caching */
 static int ss_greedy = 0; /* if true: use greedy, not optimal ss selection */  static int ss_greedy = 0; /* if true: use greedy, not optimal ss selection */
   static int diag = 0; /* if true: print diagnostic informations */
   static int tpa_noequiv = 0;     /* if true: no state equivalence checking */
   static int tpa_noautomaton = 0; /* if true: no tree parsing automaton */
   static int tpa_trace = 0; /* if true: data for line graph of new states etc. */
   static int print_sequences = 0; /* print primitive sequences for optimization */
   static int relocs = 0;
   static int nonrelocs = 0;
   
 #ifdef HAS_DEBUG  #ifdef HAS_DEBUG
 int debug=0;  int debug=0;
   # define debugp(x...) if (debug) fprintf(x);
 #else  #else
 # define perror(x...)  # define perror(x...)
 # define fprintf(x...)  # define fprintf(x...)
   # define debugp(x...)
 #endif  #endif
   
 ImageHeader *gforth_header;  ImageHeader *gforth_header;
Line 172 
Line 240 
 #endif  #endif
   
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   #ifndef CODE_ALIGNMENT
   #define CODE_ALIGNMENT 0
   #endif
   
 #define MAX_IMMARGS 2  #define MAX_IMMARGS 2
   
 typedef struct {  typedef struct {
Line 190 
Line 262 
 PrimInfo *priminfos;  PrimInfo *priminfos;
 PrimInfo **decomp_prims;  PrimInfo **decomp_prims;
   
   const char const* const prim_names[]={
   #include PRIM_NAMES_I
   };
   
   void init_ss_cost(void);
   
 static int is_relocatable(int p)  static int is_relocatable(int p)
 {  {
   return !no_dynamic && priminfos[p].start != NULL;    return !no_dynamic && priminfos[p].start != NULL;
Line 218 
Line 296 
   return a<b?a:b;    return a<b?a:b;
 }  }
   
   #ifndef STANDALONE
 /* 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
Line 263 
Line 342 
 #define GROUPADD(n)  #define GROUPADD(n)
 };  };
   
 unsigned char *branch_targets(Cell *image, const unsigned char *bitstring,  static unsigned char *branch_targets(Cell *image, const unsigned char *bitstring,
                               int size, Cell base)                                int size, Cell base)
      /* produce a bitmask marking all the branch targets */       /* produce a bitmask marking all the branch targets */
 {  {
Line 280 
Line 359 
         token=image[i];          token=image[i];
         if (token>=base) { /* relocatable address */          if (token>=base) { /* relocatable address */
           UCell bitnum=(token-base)/sizeof(Cell);            UCell bitnum=(token-base)/sizeof(Cell);
             if (bitnum/RELINFOBITS < (UCell)steps)
           result[bitnum/RELINFOBITS] |= 1U << ((~bitnum)&(RELINFOBITS-1));            result[bitnum/RELINFOBITS] |= 1U << ((~bitnum)&(RELINFOBITS-1));
         }          }
       }        }
Line 288 
Line 368 
   return result;    return result;
 }  }
   
 void relocate(Cell *image, const unsigned char *bitstring,  void gforth_relocate(Cell *image, const Char *bitstring,
               int size, Cell base, Label symbols[])                       UCell size, Cell base, Label symbols[])
 {  {
   int i=0, j, k, steps=(((size-1)/sizeof(Cell))/RELINFOBITS)+1;    int i=0, j, k, steps=(((size-1)/sizeof(Cell))/RELINFOBITS)+1;
   Cell token;    Cell token;
Line 335 
Line 415 
             case CF(DOCOL)   :              case CF(DOCOL)   :
             case CF(DOVAR)   :              case CF(DOVAR)   :
             case CF(DOCON)   :              case CF(DOCON)   :
               case CF(DOVAL)   :
             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;
Line 390 
Line 471 
   ((ImageHeader*)(image))->base = (Address) image;    ((ImageHeader*)(image))->base = (Address) image;
 }  }
   
 UCell checksum(Label symbols[])  #ifndef DOUBLY_INDIRECT
   static UCell checksum(Label symbols[])
 {  {
   UCell r=PRIM_VERSION;    UCell r=PRIM_VERSION;
   Cell i;    Cell i;
Line 413 
Line 495 
 #endif  #endif
   return r;    return r;
 }  }
   #endif
   
 Address verbose_malloc(Cell size)  static Address verbose_malloc(Cell size)
 {  {
   Address r;    Address r;
   /* leave a little room (64B) for stack underflows */    /* leave a little room (64B) for stack underflows */
Line 423 
Line 506 
     exit(1);      exit(1);
   }    }
   r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));    r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));
   if (debug)    debugp(stderr, "malloc succeeds, address=$%lx\n", (long)r);
     fprintf(stderr, "malloc succeeds, address=$%lx\n", (long)r);  
   return r;    return r;
 }  }
   
 static Address next_address=0;  static Address next_address=0;
 void after_alloc(Address r, Cell size)  static void after_alloc(Address r, Cell size)
 {  {
   if (r != (Address)-1) {    if (r != (Address)-1) {
     if (debug)      debugp(stderr, "success, address=$%lx\n", (long) r);
       fprintf(stderr, "success, address=$%lx\n", (long) r);  #if 0
       /* not needed now that we protect the stacks with mprotect */
     if (pagesize != 1)      if (pagesize != 1)
       next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */        next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */
   #endif
   } else {    } else {
     if (debug)      debugp(stderr, "failed: %s\n", strerror(errno));
       fprintf(stderr, "failed: %s\n", strerror(errno));  
   }    }
 }  }
   
Line 461 
Line 544 
   Address r;    Address r;
   
 #if defined(MAP_ANON)  #if defined(MAP_ANON)
   if (debug)    debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size);
     fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size);    r = mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE|map_noreserve, -1, 0);
   r = mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0);  
 #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) */
Line 473 
Line 555 
     dev_zero = open("/dev/zero", O_RDONLY);      dev_zero = open("/dev/zero", O_RDONLY);
   if (dev_zero == -1) {    if (dev_zero == -1) {
     r = MAP_FAILED;      r = MAP_FAILED;
     if (debug)      debugp(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ",
       fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ",  
               strerror(errno));                strerror(errno));
   } else {    } else {
     if (debug)      debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size);
       fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size);      r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE|map_noreserve, 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);    after_alloc(r, size);
   return r;    return r;
 }  }
   
   static void page_noaccess(Address a)
   {
     /* try mprotect first; with munmap the page might be allocated later */
     debugp(stderr, "try mprotect(%p,%ld,PROT_NONE); ", a, (long)pagesize);
     if (mprotect(a, pagesize, PROT_NONE)==0) {
       debugp(stderr, "ok\n");
       return;
     }
     debugp(stderr, "failed: %s\n", strerror(errno));
     debugp(stderr, "try munmap(%p,%ld); ", a, (long)pagesize);
     if (munmap(a,pagesize)==0) {
       debugp(stderr, "ok\n");
       return;
     }
     debugp(stderr, "failed: %s\n", strerror(errno));
   }
   
   static size_t wholepage(size_t n)
   {
     return (n+pagesize-1)&~(pagesize-1);
   }
 #endif  #endif
   
 Address my_alloc(Cell size)  Address gforth_alloc(Cell size)
 {  {
 #if HAVE_MMAP  #if HAVE_MMAP
   Address r;    Address r;
Line 500 
Line 602 
   return verbose_malloc(size);    return verbose_malloc(size);
 }  }
   
 Address dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)  static Address dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)
 {  {
   Address image = MAP_FAILED;    Address image = MAP_FAILED;
   
 #if defined(HAVE_MMAP)  #if defined(HAVE_MMAP)
   if (offset==0) {    if (offset==0) {
     image=alloc_mmap(dictsize);      image=alloc_mmap(dictsize);
     if (debug)      if (image != (Address)MAP_FAILED) {
       fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);        Address image1;
     image = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE, fileno(file), 0);        debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);
     after_alloc(image,dictsize);        image1 = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE|map_noreserve, fileno(file), 0);
         after_alloc(image1,dictsize);
         if (image1 == (Address)MAP_FAILED)
           goto read_image;
       }
   }    }
 #endif /* defined(HAVE_MMAP) */  #endif /* defined(HAVE_MMAP) */
   if (image == (Address)MAP_FAILED) {    if (image == (Address)MAP_FAILED) {
     image = my_alloc(dictsize+offset)+offset;      image = gforth_alloc(dictsize+offset)+offset;
     read_image:
     rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */      rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */
     fread(image, 1, imagesize, file);      fread(image, 1, imagesize, file);
   }    }
   return image;    return image;
 }  }
   #endif
   
 void set_stack_sizes(ImageHeader * header)  void set_stack_sizes(ImageHeader * header)
 {  {
Line 540 
Line 648 
   fsize=maxaligned(fsize);    fsize=maxaligned(fsize);
 }  }
   
 void alloc_stacks(ImageHeader * header)  #ifdef STANDALONE
   void alloc_stacks(ImageHeader * h)
 {  {
   header->dict_size=dictsize;  #define SSTACKSIZE 0x200
   header->data_stack_size=dsize;    static Cell dstack[SSTACKSIZE+1];
   header->fp_stack_size=fsize;    static Cell rstack[SSTACKSIZE+1];
   header->return_stack_size=rsize;  
   header->locals_stack_size=lsize;    h->dict_size=dictsize;
     h->data_stack_size=dsize;
   header->data_stack_base=my_alloc(dsize);    h->fp_stack_size=fsize;
   header->fp_stack_base=my_alloc(fsize);    h->return_stack_size=rsize;
   header->return_stack_base=my_alloc(rsize);    h->locals_stack_size=lsize;
   header->locals_stack_base=my_alloc(lsize);  
     h->data_stack_base=dstack+SSTACKSIZE;
     //  h->fp_stack_base=gforth_alloc(fsize);
     h->return_stack_base=rstack+SSTACKSIZE;
     //  h->locals_stack_base=gforth_alloc(lsize);
   }
   #else
   void alloc_stacks(ImageHeader * h)
   {
     h->dict_size=dictsize;
     h->data_stack_size=dsize;
     h->fp_stack_size=fsize;
     h->return_stack_size=rsize;
     h->locals_stack_size=lsize;
   
   #if defined(HAVE_MMAP) && !defined(STANDALONE)
     if (pagesize > 1) {
       size_t p = pagesize;
       size_t totalsize =
         wholepage(dsize)+wholepage(fsize)+wholepage(rsize)+wholepage(lsize)+5*p;
       Address a = alloc_mmap(totalsize);
       if (a != (Address)MAP_FAILED) {
         page_noaccess(a); a+=p; h->  data_stack_base=a; a+=wholepage(dsize);
         page_noaccess(a); a+=p; h->    fp_stack_base=a; a+=wholepage(fsize);
         page_noaccess(a); a+=p; h->return_stack_base=a; a+=wholepage(rsize);
         page_noaccess(a); a+=p; h->locals_stack_base=a; a+=wholepage(lsize);
         page_noaccess(a);
         debugp(stderr,"stack addresses: d=%p f=%p r=%p l=%p\n",
                h->data_stack_base,
                h->fp_stack_base,
                h->return_stack_base,
                h->locals_stack_base);
         return;
       }
     }
   #endif
     h->data_stack_base=gforth_alloc(dsize);
     h->fp_stack_base=gforth_alloc(fsize);
     h->return_stack_base=gforth_alloc(rsize);
     h->locals_stack_base=gforth_alloc(lsize);
 }  }
   #endif
   
 #warning You can ignore the warnings about clobbered variables in go_forth  #warning You can ignore the warnings about clobbered variables in gforth_go
 int go_forth(Address image, int stack, Cell *entries)  int gforth_go(Address image, int stack, Cell *entries)
 {  {
   volatile ImageHeader *image_header = (ImageHeader *)image;    volatile ImageHeader *image_header = (ImageHeader *)image;
   Cell *sp0=(Cell*)(image_header->data_stack_base + dsize);    Cell *sp0=(Cell*)(image_header->data_stack_base + dsize);
Line 571 
Line 720 
 #endif  #endif
   
   /* ensure that the cached elements (if any) are accessible */    /* ensure that the cached elements (if any) are accessible */
   IF_spTOS(sp0--);  #if !(defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING))
   IF_fpTOS(fp0--);    sp0 -= 8; /* make stuff below bottom accessible for stack caching */
     fp0--;
   #endif
   
   for(;stack>0;stack--)    for(;stack>0;stack--)
     *--sp0=entries[stack-1];      *--sp0=entries[stack-1];
   
 #ifdef SYSSIGNALS  #if defined(SYSSIGNALS) && !defined(STANDALONE)
   get_winsize();    get_winsize();
   
   install_signal_handlers(); /* right place? */    install_signal_handlers(); /* right place? */
   
   if ((throw_code=setjmp(throw_jmp_buf))) {    if ((throw_code=setjmp(throw_jmp_buf))) {
     static Cell signal_data_stack[8];      static Cell signal_data_stack[24];
     static Cell signal_return_stack[8];      static Cell signal_return_stack[16];
     static Float signal_fp_stack[1];      static Float signal_fp_stack[1];
   
     signal_data_stack[7]=throw_code;      signal_data_stack[15]=throw_code;
   
 #ifdef GFORTH_DEBUGGING  #ifdef GFORTH_DEBUGGING
     if (debug)      debugp(stderr,"\ncaught signal, throwing exception %d, ip=%p rp=%p\n",
       fprintf(stderr,"\ncaught signal, throwing exception %d, ip=%p rp=%p\n",  
               throw_code, saved_ip, rp);                throw_code, saved_ip, rp);
     if (rp <= orig_rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {      if (rp <= orig_rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {
       /* no rstack overflow or underflow */        /* no rstack overflow or underflow */
Line 599 
Line 749 
       *--rp0 = (Cell)saved_ip;        *--rp0 = (Cell)saved_ip;
     }      }
     else /* I love non-syntactic ifdefs :-) */      else /* I love non-syntactic ifdefs :-) */
       rp0 = signal_return_stack+8;        rp0 = signal_return_stack+16;
 #else  /* !defined(GFORTH_DEBUGGING) */  #else  /* !defined(GFORTH_DEBUGGING) */
     if (debug)      debugp(stderr,"\ncaught signal, throwing exception %d\n", throw_code);
       fprintf(stderr,"\ncaught signal, throwing exception %d\n", throw_code);        rp0 = signal_return_stack+16;
       rp0 = signal_return_stack+8;  
 #endif /* !defined(GFORTH_DEBUGGING) */  #endif /* !defined(GFORTH_DEBUGGING) */
     /* fprintf(stderr, "rp=$%x\n",rp0);*/      /* fprintf(stderr, "rp=$%x\n",rp0);*/
   
     return((int)(Cell)engine(image_header->throw_entry, signal_data_stack+7,      return((int)(Cell)gforth_engine(image_header->throw_entry, signal_data_stack+15,
                        rp0, signal_fp_stack, 0));                         rp0, signal_fp_stack, 0));
   }    }
 #endif  #endif
   
   return((int)(Cell)engine(ip0,sp0,rp0,fp0,lp0));    return((int)(Cell)gforth_engine(ip0,sp0,rp0,fp0,lp0));
 }  }
   
 #ifndef INCLUDE_IMAGE  #if !defined(INCLUDE_IMAGE) && !defined(STANDALONE)
 void print_sizes(Cell sizebyte)  static void print_sizes(Cell sizebyte)
      /* print size information */       /* print size information */
 {  {
   static char* endianstring[]= { "   big","little" };    static char* endianstring[]= { "   big","little" };
Line 630 
Line 779 
   
 /* static superinstruction stuff */  /* static superinstruction stuff */
   
 struct cost {  struct cost { /* super_info might be a more accurate name */
   char loads;       /* number of stack loads */    char loads;       /* number of stack loads */
   char stores;      /* number of stack stores */    char stores;      /* number of stack stores */
   char updates;     /* number of stack pointer updates */    char updates;     /* number of stack pointer updates */
   char branch;      /* is it a branch (SET_IP) */    char branch;      /* is it a branch (SET_IP) */
   unsigned char state_in;    /* state on entry */    unsigned char state_in;    /* state on entry */
   unsigned char state_out;   /* state on exit */    unsigned char state_out;   /* state on exit */
     unsigned char imm_ops;     /* number of immediate operands */
   short offset;     /* offset into super2 table */    short offset;     /* offset into super2 table */
   unsigned char length;      /* number of components */    unsigned char length;      /* number of components */
 };  };
Line 666 
Line 816 
   
 struct super_state *state_transitions=NULL;  struct super_state *state_transitions=NULL;
   
 int hash_super(PrimNum *start, int length)  static int hash_super(PrimNum *start, int length)
 {  {
   int i, r;    int i, r;
   
Line 677 
Line 827 
   return r & (HASH_SIZE-1);    return r & (HASH_SIZE-1);
 }  }
   
 struct super_state **lookup_super(PrimNum *start, int length)  static struct super_state **lookup_super(PrimNum *start, int length)
 {  {
   int hash=hash_super(start,length);    int hash=hash_super(start,length);
   struct super_table_entry *p = super_table[hash];    struct super_table_entry *p = super_table[hash];
Line 691 
Line 841 
   return NULL;    return NULL;
 }  }
   
 void prepare_super_table()  static void prepare_super_table()
 {  {
   int i;    int i;
   int nsupers = 0;    int nsupers = 0;
Line 728 
Line 878 
         nsupers++;          nsupers++;
     }      }
   }    }
   if (debug)    debugp(stderr, "Using %d static superinsts\n", nsupers);
     fprintf(stderr, "Using %d static superinsts\n", nsupers);  
 }  }
   
 /* dynamic replication/superinstruction stuff */  /* dynamic replication/superinstruction stuff */
   
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
 int compare_priminfo_length(const void *_a, const void *_b)  static int compare_priminfo_length(const void *_a, const void *_b)
 {  {
   PrimInfo **a = (PrimInfo **)_a;    PrimInfo **a = (PrimInfo **)_a;
   PrimInfo **b = (PrimInfo **)_b;    PrimInfo **b = (PrimInfo **)_b;
Line 755 
Line 904 
   
 Cell npriminfos=0;  Cell npriminfos=0;
   
 int compare_labels(const void *pa, const void *pb)  Label goto_start;
   Cell goto_len;
   
   #ifndef NO_DYNAMIC
   static int compare_labels(const void *pa, const void *pb)
 {  {
   Label a = *(Label *)pa;    Label a = *(Label *)pa;
   Label b = *(Label *)pb;    Label b = *(Label *)pb;
   return a-b;    return a-b;
 }  }
   #endif
   
 Label bsearch_next(Label key, Label *a, UCell n)  static Label bsearch_next(Label key, Label *a, UCell n)
      /* a is sorted; return the label >=key that is the closest in a;       /* a is sorted; return the label >=key that is the closest in a;
         return NULL if there is no label in a >=key */          return NULL if there is no label in a >=key */
 {  {
Line 781 
Line 935 
     return bsearch_next(key, a, mid+1);      return bsearch_next(key, a, mid+1);
 }  }
   
 void check_prims(Label symbols1[])  static void check_prims(Label symbols1[])
 {  {
   int i;    int i;
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   Label *symbols2, *symbols3, *ends1, *ends1j, *ends1jsorted;    Label *symbols2, *symbols3, *ends1, *ends1j, *ends1jsorted, *goto_p;
   int nends1j;    int nends1j;
 #endif  #endif
   
Line 804 
Line 958 
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   if (no_dynamic)    if (no_dynamic)
     return;      return;
   symbols2=engine2(0,0,0,0,0);    symbols2=gforth_engine2(0,0,0,0,0);
 #if NO_IP  #if NO_IP
   symbols3=engine3(0,0,0,0,0);    symbols3=gforth_engine3(0,0,0,0,0);
 #else  #else
   symbols3=symbols1;    symbols3=symbols1;
 #endif  #endif
   ends1 = symbols1+i+1;    ends1 = symbols1+i+1;
   ends1j =   ends1+i;    ends1j =   ends1+i;
     goto_p = ends1j+i+1; /* goto_p[0]==before; ...[1]==after;*/
   nends1j = i+1;    nends1j = i+1;
   ends1jsorted = (Label *)alloca(nends1j*sizeof(Label));    ends1jsorted = (Label *)alloca(nends1j*sizeof(Label));
   memcpy(ends1jsorted,ends1j,nends1j*sizeof(Label));    memcpy(ends1jsorted,ends1j,nends1j*sizeof(Label));
   qsort(ends1jsorted, nends1j, sizeof(Label), compare_labels);    qsort(ends1jsorted, nends1j, sizeof(Label), compare_labels);
   
     /* check whether the "goto *" is relocatable */
     goto_len = goto_p[1]-goto_p[0];
     debugp(stderr, "goto * %p %p len=%ld\n",
            goto_p[0],symbols2[goto_p-symbols1],goto_len);
     if (memcmp(goto_p[0],symbols2[goto_p-symbols1],goto_len)!=0) { /* unequal */
       no_dynamic=1;
       debugp(stderr,"  not relocatable, disabling dynamic code generation\n");
       init_ss_cost();
       return;
     }
     goto_start = goto_p[0];
   
   priminfos = calloc(i,sizeof(PrimInfo));    priminfos = calloc(i,sizeof(PrimInfo));
   for (i=0; symbols1[i]!=0; i++) {    for (i=0; symbols1[i]!=0; i++) {
     int prim_len = ends1[i]-symbols1[i];      int prim_len = ends1[i]-symbols1[i];
     PrimInfo *pi=&priminfos[i];      PrimInfo *pi=&priminfos[i];
       struct cost *sc=&super_costs[i];
     int j=0;      int j=0;
     char *s1 = (char *)symbols1[i];      char *s1 = (char *)symbols1[i];
     char *s2 = (char *)symbols2[i];      char *s2 = (char *)symbols2[i];
Line 829 
Line 997 
   
     pi->start = s1;      pi->start = s1;
     pi->superend = superend[i]|no_super;      pi->superend = superend[i]|no_super;
     if (pi->superend)  
       pi->length = endlabel-symbols1[i];  
     else  
       pi->length = prim_len;        pi->length = prim_len;
     pi->restlength = endlabel - symbols1[i] - pi->length;      pi->restlength = endlabel - symbols1[i] - pi->length;
     pi->nimmargs = 0;      pi->nimmargs = 0;
     if (debug)      relocs++;
       fprintf(stderr, "Prim %3d @ %p %p %p, length=%3ld restlength=%2ld superend=%1d",      debugp(stderr, "%-15s %d-%d %4d %p %p %p len=%3ld rest=%2ld send=%1d",
               i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength), pi->superend);             prim_names[i], sc->state_in, sc->state_out,
              i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength),
              pi->superend);
     if (endlabel == NULL) {      if (endlabel == NULL) {
       pi->start = NULL; /* not relocatable */        pi->start = NULL; /* not relocatable */
       if (pi->length<0) pi->length=100;        if (pi->length<0) pi->length=100;
       if (debug)        debugp(stderr,"\n   non_reloc: no J label > start found\n");
         fprintf(stderr,"\n   non_reloc: no J label > start found\n");        relocs--;
         nonrelocs++;
       continue;        continue;
     }      }
     if (ends1[i] > endlabel && !pi->superend) {      if (ends1[i] > endlabel && !pi->superend) {
       pi->start = NULL; /* not relocatable */        pi->start = NULL; /* not relocatable */
       pi->length = endlabel-symbols1[i];        pi->length = endlabel-symbols1[i];
       if (debug)        debugp(stderr,"\n   non_reloc: there is a J label before the K label (restlength<0)\n");
         fprintf(stderr,"\n   non_reloc: there is a J label before the K label (restlength<0)\n");        relocs--;
         nonrelocs++;
       continue;        continue;
     }      }
     if (ends1[i] < pi->start && !pi->superend) {      if (ends1[i] < pi->start && !pi->superend) {
       pi->start = NULL; /* not relocatable */        pi->start = NULL; /* not relocatable */
       pi->length = endlabel-symbols1[i];        pi->length = endlabel-symbols1[i];
       if (debug)        debugp(stderr,"\n   non_reloc: K label before I label (length<0)\n");
         fprintf(stderr,"\n   non_reloc: K label before I label (length<0)\n");        relocs--;
         nonrelocs++;
       continue;        continue;
     }      }
     assert(prim_len>=0);      assert(pi->length>=0);
     assert(pi->restlength >=0);      assert(pi->restlength >=0);
     while (j<(pi->length+pi->restlength)) {      while (j<(pi->length+pi->restlength)) {
       if (s1[j]==s3[j]) {        if (s1[j]==s3[j]) {
         if (s1[j] != s2[j]) {          if (s1[j] != s2[j]) {
           pi->start = NULL; /* not relocatable */            pi->start = NULL; /* not relocatable */
           if (debug)            debugp(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);
             fprintf(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);  
           /* assert(j<prim_len); */            /* assert(j<prim_len); */
             relocs--;
             nonrelocs++;
           break;            break;
         }          }
         j++;          j++;
Line 878 
Line 1049 
         ia->offset=j;          ia->offset=j;
         if ((~*(Cell *)&(s1[j]))==*(Cell *)&(s3[j])) {          if ((~*(Cell *)&(s1[j]))==*(Cell *)&(s3[j])) {
           ia->rel=0;            ia->rel=0;
           if (debug)            debugp(stderr,"\n   absolute immarg: offset %3d",j);
             fprintf(stderr,"\n   absolute immarg: offset %3d",j);  
         } else if ((&(s1[j]))+(*(Cell *)&(s1[j]))+4 ==          } else if ((&(s1[j]))+(*(Cell *)&(s1[j]))+4 ==
                    symbols1[DOESJUMP+1]) {                     symbols1[DOESJUMP+1]) {
           ia->rel=1;            ia->rel=1;
           if (debug)            debugp(stderr,"\n   relative immarg: offset %3d",j);
             fprintf(stderr,"\n   relative immarg: offset %3d",j);  
         } else {          } else {
           pi->start = NULL; /* not relocatable */            pi->start = NULL; /* not relocatable */
           if (debug)            debugp(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);
             fprintf(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);  
           /* assert(j<prim_len);*/            /* assert(j<prim_len);*/
             relocs--;
             nonrelocs++;
           break;            break;
         }          }
         j+=4;          j+=4;
       }        }
     }      }
     if (debug)      debugp(stderr,"\n");
       fprintf(stderr,"\n");  
   }    }
   decomp_prims = calloc(i,sizeof(PrimInfo *));    decomp_prims = calloc(i,sizeof(PrimInfo *));
   for (i=DOESJUMP+1; i<npriminfos; i++)    for (i=DOESJUMP+1; i<npriminfos; i++)
Line 906 
Line 1075 
 #endif  #endif
 }  }
   
 void flush_to_here(void)  static void flush_to_here(void)
 {  {
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   if (start_flush)    if (start_flush)
Line 915 
Line 1084 
 #endif  #endif
 }  }
   
   static void align_code(void)
        /* align code_here on some platforms */
   {
   #ifndef NO_DYNAMIC
   #if defined(CODE_PADDING)
     Cell alignment = CODE_ALIGNMENT;
     static char nops[] = CODE_PADDING;
     UCell maxpadding=MAX_PADDING;
     UCell offset = ((UCell)code_here)&(alignment-1);
     UCell length = alignment-offset;
     if (length <= maxpadding) {
       memcpy(code_here,nops+offset,length);
       code_here += length;
     }
   #endif /* defined(CODE_PADDING) */
   #endif /* defined(NO_DYNAMIC */
   }
   
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
 void append_jump(void)  static void append_jump(void)
 {  {
   if (last_jump) {    if (last_jump) {
     PrimInfo *pi = &priminfos[last_jump];      PrimInfo *pi = &priminfos[last_jump];
   
     memcpy(code_here, pi->start+pi->length, pi->restlength);      memcpy(code_here, pi->start+pi->length, pi->restlength);
     code_here += pi->restlength;      code_here += pi->restlength;
       memcpy(code_here, goto_start, goto_len);
       code_here += goto_len;
       align_code();
     last_jump=0;      last_jump=0;
   }    }
 }  }
Line 940 
Line 1130 
   Cell size;    Cell size;
 } *code_block_list=NULL, **next_code_blockp=&code_block_list;  } *code_block_list=NULL, **next_code_blockp=&code_block_list;
   
 Address append_prim(Cell p)  static Address append_prim(Cell p)
 {  {
   PrimInfo *pi = &priminfos[p];    PrimInfo *pi = &priminfos[p];
   Address old_code_here = code_here;    Address old_code_here = code_here;
   
   if (code_area+code_area_size < code_here+pi->length+pi->restlength) {    if (code_area+code_area_size < code_here+pi->length+pi->restlength+goto_len+CODE_ALIGNMENT) {
     struct code_block_list *p;      struct code_block_list *p;
     append_jump();      append_jump();
     flush_to_here();      flush_to_here();
     if (*next_code_blockp == NULL) {      if (*next_code_blockp == NULL) {
       code_here = start_flush = code_area = my_alloc(code_area_size);        code_here = start_flush = code_area = gforth_alloc(code_area_size);
       p = (struct code_block_list *)malloc(sizeof(struct code_block_list));        p = (struct code_block_list *)malloc(sizeof(struct code_block_list));
       *next_code_blockp = p;        *next_code_blockp = p;
       p->next = NULL;        p->next = NULL;
Line 989 
Line 1179 
 #endif /* !defined(NO_DYNAMIC) */  #endif /* !defined(NO_DYNAMIC) */
 }  }
   
 long dyncodesize(void)  static long dyncodesize(void)
 {  {
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   struct code_block_list *p;    struct code_block_list *p;
Line 1035 
Line 1225 
 int nbranchinfos=0;  int nbranchinfos=0;
   
 struct branchinfo {  struct branchinfo {
   Label *targetptr; /* *(bi->targetptr) is the target */    Label **targetpp; /* **(bi->targetpp) is the target */
   Cell *addressptr; /* store the target here */    Cell *addressptr; /* store the target here */
 } branchinfos[100000];  } branchinfos[100000];
   
 int ndoesexecinfos=0;  int ndoesexecinfos=0;
 struct doesexecinfo {  struct doesexecinfo {
   int branchinfo; /* fix the targetptr of branchinfos[...->branchinfo] */    int branchinfo; /* fix the targetptr of branchinfos[...->branchinfo] */
     Label *targetp; /*target for branch (because this is not in threaded code)*/
   Cell *xt; /* cfa of word whose does-code needs calling */    Cell *xt; /* cfa of word whose does-code needs calling */
 } doesexecinfos[10000];  } doesexecinfos[10000];
   
 void set_rel_target(Cell *source, Label target)  static void set_rel_target(Cell *source, Label target)
 {  {
   *source = ((Cell)target)-(((Cell)source)+4);    *source = ((Cell)target)-(((Cell)source)+4);
 }  }
   
 void register_branchinfo(Label source, Cell targetptr)  static void register_branchinfo(Label source, Cell *targetpp)
 {  {
   struct branchinfo *bi = &(branchinfos[nbranchinfos]);    struct branchinfo *bi = &(branchinfos[nbranchinfos]);
   bi->targetptr = (Label *)targetptr;    bi->targetpp = (Label **)targetpp;
   bi->addressptr = (Cell *)source;    bi->addressptr = (Cell *)source;
   nbranchinfos++;    nbranchinfos++;
 }  }
   
 Address compile_prim1arg(PrimNum p, Cell **argp)  static Address compile_prim1arg(PrimNum p, Cell **argp)
 {  {
   Address old_code_here=append_prim(p);    Address old_code_here=append_prim(p);
   
Line 1067 
Line 1258 
   return old_code_here;    return old_code_here;
 }  }
   
 Cell *compile_call2(Cell targetptr)  static Address compile_call2(Cell *targetpp, Cell **next_code_targetp)
 {  {
   Cell *next_code_target;  
   PrimInfo *pi = &priminfos[N_call2];    PrimInfo *pi = &priminfos[N_call2];
   Address old_code_here = append_prim(N_call2);    Address old_code_here = append_prim(N_call2);
   
   next_code_target = (Cell *)(old_code_here + pi->immargs[0].offset);    *next_code_targetp = (Cell *)(old_code_here + pi->immargs[0].offset);
   register_branchinfo(old_code_here + pi->immargs[1].offset, targetptr);    register_branchinfo(old_code_here + pi->immargs[1].offset, targetpp);
   return next_code_target;    return old_code_here;
 }  }
 #endif  #endif
   
Line 1087 
Line 1277 
   compile_prim1(NULL);    compile_prim1(NULL);
   for (i=0; i<ndoesexecinfos; i++) {    for (i=0; i<ndoesexecinfos; i++) {
     struct doesexecinfo *dei = &doesexecinfos[i];      struct doesexecinfo *dei = &doesexecinfos[i];
     branchinfos[dei->branchinfo].targetptr = (Label *)DOES_CODE1((dei->xt));      dei->targetp = (Label *)DOES_CODE1((dei->xt));
       branchinfos[dei->branchinfo].targetpp = &(dei->targetp);
   }    }
   ndoesexecinfos = 0;    ndoesexecinfos = 0;
   for (i=0; i<nbranchinfos; i++) {    for (i=0; i<nbranchinfos; i++) {
     struct branchinfo *bi=&branchinfos[i];      struct branchinfo *bi=&branchinfos[i];
     set_rel_target(bi->addressptr, *(bi->targetptr));      set_rel_target(bi->addressptr, **(bi->targetpp));
   }    }
   nbranchinfos = 0;    nbranchinfos = 0;
 #else  #else
Line 1101 
Line 1292 
   flush_to_here();    flush_to_here();
 }  }
   
   #if !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED))
 #ifdef NO_IP  #ifdef NO_IP
 Cell compile_prim_dyn(PrimNum p, Cell *tcp)  static Cell compile_prim_dyn(PrimNum p, Cell *tcp)
      /* compile prim #p dynamically (mod flags etc.) and return start       /* compile prim #p dynamically (mod flags etc.) and return start
         address of generated code for putting it into the threaded          address of generated code for putting it into the threaded
         code. This function is only called if all the associated          code. This function is only called if all the associated
Line 1110 
Line 1302 
 {  {
   PrimInfo *pi=&priminfos[p];    PrimInfo *pi=&priminfos[p];
   Cell *next_code_target=NULL;    Cell *next_code_target=NULL;
   Cell codeaddr = (Cell)code_here;    Address codeaddr;
     Address primstart;
   
   assert(p<npriminfos);    assert(p<npriminfos);
   if (p==N_execute || p==N_perform || p==N_lit_perform) {    if (p==N_execute || p==N_perform || p==N_lit_perform) {
     codeaddr = (Cell)compile_prim1arg(N_set_next_code, &next_code_target);      codeaddr = compile_prim1arg(N_set_next_code, &next_code_target);
   }      primstart = append_prim(p);
   if (p==N_call) {      goto other_prim;
     next_code_target = compile_call2(tcp[1]);    } else if (p==N_call) {
       codeaddr = compile_call2(tcp+1, &next_code_target);
   } else if (p==N_does_exec) {    } else if (p==N_does_exec) {
     struct doesexecinfo *dei = &doesexecinfos[ndoesexecinfos++];      struct doesexecinfo *dei = &doesexecinfos[ndoesexecinfos++];
     Cell *arg;      Cell *arg;
Line 1129 
Line 1323 
        branches */         branches */
     dei->branchinfo = nbranchinfos;      dei->branchinfo = nbranchinfos;
     dei->xt = (Cell *)(tcp[1]);      dei->xt = (Cell *)(tcp[1]);
     next_code_target = compile_call2(0);      compile_call2(0, &next_code_target);
   } else if (!is_relocatable(p)) {    } else if (!is_relocatable(p)) {
     Cell *branch_target;      Cell *branch_target;
     codeaddr = compile_prim1arg(N_set_next_code, &next_code_target);      codeaddr = compile_prim1arg(N_set_next_code, &next_code_target);
Line 1137 
Line 1331 
     set_rel_target(branch_target,vm_prims[p]);      set_rel_target(branch_target,vm_prims[p]);
   } else {    } else {
     unsigned j;      unsigned j;
     Address old_code_here = append_prim(p);  
   
       codeaddr = primstart = append_prim(p);
     other_prim:
     for (j=0; j<pi->nimmargs; j++) {      for (j=0; j<pi->nimmargs; j++) {
       struct immarg *ia = &(pi->immargs[j]);        struct immarg *ia = &(pi->immargs[j]);
       Cell argval = tcp[pi->nimmargs - j]; /* !! specific to prims */        Cell *argp = tcp + pi->nimmargs - j;
         Cell argval = *argp; /* !! specific to prims */
       if (ia->rel) { /* !! assumption: relative refs are branches */        if (ia->rel) { /* !! assumption: relative refs are branches */
         register_branchinfo(old_code_here + ia->offset, argval);          register_branchinfo(primstart + ia->offset, argp);
       } else /* plain argument */        } else /* plain argument */
         *(Cell *)(old_code_here + ia->offset) = argval;          *(Cell *)(primstart + ia->offset) = argval;
     }      }
   }    }
   if (next_code_target!=NULL)    if (next_code_target!=NULL)
     *next_code_target = (Cell)code_here;      *next_code_target = (Cell)code_here;
   return codeaddr;    return (Cell)codeaddr;
 }  }
 #else /* !defined(NO_IP) */  #else /* !defined(NO_IP) */
 Cell compile_prim_dyn(PrimNum p, Cell *tcp)  static Cell compile_prim_dyn(PrimNum p, Cell *tcp)
      /* compile prim #p dynamically (mod flags etc.) and return start       /* compile prim #p dynamically (mod flags etc.) and return start
         address of generated code for putting it into the threaded code */          address of generated code for putting it into the threaded code */
 {  {
Line 1170 
Line 1366 
     return static_prim;      return static_prim;
   }    }
   old_code_here = append_prim(p);    old_code_here = append_prim(p);
   last_jump = (priminfos[p].superend) ? 0 : p;    last_jump = p;
     if (priminfos[p].superend)
       append_jump();
   return (Cell)old_code_here;    return (Cell)old_code_here;
 #endif  /* !defined(NO_DYNAMIC) */  #endif  /* !defined(NO_DYNAMIC) */
 }  }
 #endif /* !defined(NO_IP) */  #endif /* !defined(NO_IP) */
   #endif
   
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
 int cost_codesize(int prim)  static int cost_codesize(int prim)
 {  {
   return priminfos[prim].length;    return priminfos[prim].length;
 }  }
 #endif  #endif
   
 int cost_ls(int prim)  static int cost_ls(int prim)
 {  {
   struct cost *c = super_costs+prim;    struct cost *c = super_costs+prim;
   
   return c->loads + c->stores;    return c->loads + c->stores;
 }  }
   
 int cost_lsu(int prim)  static int cost_lsu(int prim)
 {  {
   struct cost *c = super_costs+prim;    struct cost *c = super_costs+prim;
   
   return c->loads + c->stores + c->updates;    return c->loads + c->stores + c->updates;
 }  }
   
 int cost_nexts(int prim)  static int cost_nexts(int prim)
 {  {
   return 1;    return 1;
 }  }
Line 1223 
Line 1422 
   { cost_nexts,    "nexts",    0 }    { cost_nexts,    "nexts",    0 }
 };  };
   
   #ifndef NO_DYNAMIC
   void init_ss_cost(void) {
     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 */
       debugp(stderr, "--no-dynamic conflicts with --ss-min-codesize, reverting to --ss-min-nexts\n");
     }
   }
   #endif
   
 #define MAX_BB 128 /* maximum number of instructions in BB */  #define MAX_BB 128 /* maximum number of instructions in BB */
 #define INF_COST 1000000 /* infinite cost */  #define INF_COST 1000000 /* infinite cost */
 #define CANONICAL_STATE 0  #define CANONICAL_STATE 0
Line 1235 
Line 1444 
                        * or this transition (does not change state) */                         * or this transition (does not change state) */
 };  };
   
 void init_waypoints(struct waypoint ws[])  struct tpa_state { /* tree parsing automaton (like) state */
     /* labeling is back-to-front */
     struct waypoint *inst;  /* in front of instruction */
     struct waypoint *trans; /* in front of instruction and transition */
   };
   
   struct tpa_state *termstate = NULL; /* initialized in loader() */
   
   /* statistics about tree parsing (lazyburg) stuff */
   long lb_basic_blocks = 0;
   long lb_labeler_steps = 0;
   long lb_labeler_automaton = 0;
   long lb_labeler_dynprog = 0;
   long lb_newstate_equiv = 0;
   long lb_newstate_new = 0;
   long lb_applicable_base_rules = 0;
   long lb_applicable_chain_rules = 0;
   
   #if !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED))
   static void init_waypoints(struct waypoint ws[])
 {  {
   int k;    int k;
   
Line 1243 
Line 1471 
     ws[k].cost=INF_COST;      ws[k].cost=INF_COST;
 }  }
   
 void transitions(struct waypoint inst[], struct waypoint trans[])  static struct tpa_state *empty_tpa_state()
   {
     struct tpa_state *s = malloc(sizeof(struct tpa_state));
   
     s->inst  = calloc(maxstates,sizeof(struct waypoint));
     init_waypoints(s->inst);
     s->trans = calloc(maxstates,sizeof(struct waypoint));
     /* init_waypoints(s->trans);*/
     return s;
   }
   
   static void transitions(struct tpa_state *t)
 {  {
   int k;    int k;
   struct super_state *l;    struct super_state *l;
   
   for (k=0; k<maxstates; k++) {    for (k=0; k<maxstates; k++) {
     trans[k] = inst[k];      t->trans[k] = t->inst[k];
     trans[k].no_transition = 1;      t->trans[k].no_transition = 1;
   }    }
   for (l = state_transitions; l != NULL; l = l->next) {    for (l = state_transitions; l != NULL; l = l->next) {
     PrimNum s = l->super;      PrimNum s = l->super;
     int jcost;      int jcost;
     struct cost *c=super_costs+s;      struct cost *c=super_costs+s;
     struct waypoint *wi=&(trans[c->state_in]);      struct waypoint *wi=&(t->trans[c->state_in]);
     struct waypoint *wo=&(inst[c->state_out]);      struct waypoint *wo=&(t->inst[c->state_out]);
       lb_applicable_chain_rules++;
     if (wo->cost == INF_COST)      if (wo->cost == INF_COST)
       continue;        continue;
     jcost = wo->cost + ss_cost(s);      jcost = wo->cost + ss_cost(s);
Line 1271 
Line 1511 
   }    }
 }  }
   
   static struct tpa_state *make_termstate()
   {
     struct tpa_state *s = empty_tpa_state();
   
     s->inst[CANONICAL_STATE].cost = 0;
     transitions(s);
     return s;
   }
   #endif
   
   #define TPA_SIZE 16384
   
   struct tpa_entry {
     struct tpa_entry *next;
     PrimNum inst;
     struct tpa_state *state_behind;  /* note: brack-to-front labeling */
     struct tpa_state *state_infront; /* note: brack-to-front labeling */
   } *tpa_table[TPA_SIZE];
   
   #if !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED))
   static Cell hash_tpa(PrimNum p, struct tpa_state *t)
   {
     UCell it = (UCell )t;
     return (p+it+(it>>14))&(TPA_SIZE-1);
   }
   
   static struct tpa_state **lookup_tpa(PrimNum p, struct tpa_state *t2)
   {
     int hash=hash_tpa(p, t2);
     struct tpa_entry *te = tpa_table[hash];
   
     if (tpa_noautomaton) {
       static struct tpa_state *t;
       t = NULL;
       return &t;
     }
     for (; te!=NULL; te = te->next) {
       if (p == te->inst && t2 == te->state_behind)
         return &(te->state_infront);
     }
     te = (struct tpa_entry *)malloc(sizeof(struct tpa_entry));
     te->next = tpa_table[hash];
     te->inst = p;
     te->state_behind = t2;
     te->state_infront = NULL;
     tpa_table[hash] = te;
     return &(te->state_infront);
   }
   
   static void tpa_state_normalize(struct tpa_state *t)
   {
     /* normalize so cost of canonical state=0; this may result in
        negative states for some states */
     int d = t->inst[CANONICAL_STATE].cost;
     int i;
   
     for (i=0; i<maxstates; i++) {
       if (t->inst[i].cost != INF_COST)
         t->inst[i].cost -= d;
       if (t->trans[i].cost != INF_COST)
         t->trans[i].cost -= d;
     }
   }
   
   static int tpa_state_equivalent(struct tpa_state *t1, struct tpa_state *t2)
   {
     return (memcmp(t1->inst, t2->inst, maxstates*sizeof(struct waypoint)) == 0 &&
             memcmp(t1->trans,t2->trans,maxstates*sizeof(struct waypoint)) == 0);
   }
   #endif
   
   struct tpa_state_entry {
     struct tpa_state_entry *next;
     struct tpa_state *state;
   } *tpa_state_table[TPA_SIZE];
   
   #if !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED))
   static Cell hash_tpa_state(struct tpa_state *t)
   {
     int *ti = (int *)(t->inst);
     int *tt = (int *)(t->trans);
     int r=0;
     int i;
   
     for (i=0; ti+i < (int *)(t->inst+maxstates); i++)
       r += ti[i]+tt[i];
     return (r+(r>>14)+(r>>22)) & (TPA_SIZE-1);
   }
   
   static struct tpa_state *lookup_tpa_state(struct tpa_state *t)
   {
     Cell hash = hash_tpa_state(t);
     struct tpa_state_entry *te = tpa_state_table[hash];
     struct tpa_state_entry *tn;
   
     if (!tpa_noequiv) {
       for (; te!=NULL; te = te->next) {
         if (tpa_state_equivalent(t, te->state)) {
           lb_newstate_equiv++;
           free(t->inst);
           free(t->trans);
           free(t);
           return te->state;
         }
       }
       tn = (struct tpa_state_entry *)malloc(sizeof(struct tpa_state_entry));
       tn->next = te;
       tn->state = t;
       tpa_state_table[hash] = tn;
     }
     lb_newstate_new++;
     if (tpa_trace)
       fprintf(stderr, "%ld %ld lb_states\n", lb_labeler_steps, lb_newstate_new);
     return t;
   }
   
 /* use dynamic programming to find the shortest paths within the basic  /* use dynamic programming to find the shortest paths within the basic
    block origs[0..ninsts-1] and rewrite the instructions pointed to by     block origs[0..ninsts-1] and rewrite the instructions pointed to by
    instps to use it */     instps to use it */
 void optimize_rewrite(Cell *instps[], PrimNum origs[], int ninsts)  static void optimize_rewrite(Cell *instps[], PrimNum origs[], int ninsts)
 {  {
   int i,j;    int i,j;
   static struct waypoint inst[MAX_BB+1][MAX_STATE];  /* before instruction*/    struct tpa_state *ts[ninsts+1];
   static struct waypoint trans[MAX_BB+1][MAX_STATE]; /* before transition */  
   int nextdyn, nextstate, no_transition;    int nextdyn, nextstate, no_transition;
   
   init_waypoints(inst[ninsts]);    lb_basic_blocks++;
   inst[ninsts][CANONICAL_STATE].cost=0;    ts[ninsts] = termstate;
   transitions(inst[ninsts],trans[ninsts]);  #ifndef NO_DYNAMIC
     if (print_sequences) {
       for (i=0; i<ninsts; i++)
         fprintf(stderr, "%s ", prim_names[origs[i]]);
       fprintf(stderr, "\n");
     }
   #endif
   for (i=ninsts-1; i>=0; i--) {    for (i=ninsts-1; i>=0; i--) {
     init_waypoints(inst[i]);      struct tpa_state **tp = lookup_tpa(origs[i],ts[i+1]);
       struct tpa_state *t = *tp;
       lb_labeler_steps++;
       if (t) {
         ts[i] = t;
         lb_labeler_automaton++;
       }
       else {
         lb_labeler_dynprog++;
         ts[i] = empty_tpa_state();
     for (j=1; j<=max_super && i+j<=ninsts; j++) {      for (j=1; j<=max_super && i+j<=ninsts; j++) {
       struct super_state **superp = lookup_super(origs+i, j);        struct super_state **superp = lookup_super(origs+i, j);
       if (superp!=NULL) {        if (superp!=NULL) {
Line 1294 
Line 1664 
           PrimNum s = supers->super;            PrimNum s = supers->super;
           int jcost;            int jcost;
           struct cost *c=super_costs+s;            struct cost *c=super_costs+s;
           struct waypoint *wi=&(inst[i][c->state_in]);              struct waypoint *wi=&(ts[i]->inst[c->state_in]);
           struct waypoint *wo=&(trans[i+j][c->state_out]);              struct waypoint *wo=&(ts[i+j]->trans[c->state_out]);
           int no_transition = wo->no_transition;            int no_transition = wo->no_transition;
               lb_applicable_base_rules++;
           if (!(is_relocatable(s)) && !wo->relocatable) {            if (!(is_relocatable(s)) && !wo->relocatable) {
             wo=&(inst[i+j][c->state_out]);                wo=&(ts[i+j]->inst[c->state_out]);
             no_transition=1;              no_transition=1;
           }            }
           if (wo->cost == INF_COST)            if (wo->cost == INF_COST)
Line 1314 
Line 1685 
         }          }
       }        }
     }      }
     transitions(inst[i],trans[i]);        transitions(ts[i]);
         tpa_state_normalize(ts[i]);
         *tp = ts[i] = lookup_tpa_state(ts[i]);
         if (tpa_trace)
           fprintf(stderr, "%ld %ld lb_table_entries\n", lb_labeler_steps, lb_labeler_dynprog);
       }
   }    }
   /* now rewrite the instructions */    /* now rewrite the instructions */
   nextdyn=0;    nextdyn=0;
   nextstate=CANONICAL_STATE;    nextstate=CANONICAL_STATE;
   no_transition = ((!trans[0][nextstate].relocatable)    no_transition = ((!ts[0]->trans[nextstate].relocatable)
                    ||trans[0][nextstate].no_transition);                     ||ts[0]->trans[nextstate].no_transition);
   for (i=0; i<ninsts; i++) {    for (i=0; i<ninsts; i++) {
     Cell tc=0, tc2;      Cell tc=0, tc2;
     if (i==nextdyn) {      if (i==nextdyn) {
       if (!no_transition) {        if (!no_transition) {
         /* process trans */          /* process trans */
         PrimNum p = trans[i][nextstate].inst;          PrimNum p = ts[i]->trans[nextstate].inst;
         struct cost *c = super_costs+p;          struct cost *c = super_costs+p;
         assert(trans[i][nextstate].cost != INF_COST);          assert(ts[i]->trans[nextstate].cost != INF_COST);
         assert(c->state_in==nextstate);          assert(c->state_in==nextstate);
         tc = compile_prim_dyn(p,NULL);          tc = compile_prim_dyn(p,NULL);
         nextstate = c->state_out;          nextstate = c->state_out;
       }        }
       {        {
         /* process inst */          /* process inst */
         PrimNum p = inst[i][nextstate].inst;          PrimNum p = ts[i]->inst[nextstate].inst;
         struct cost *c=super_costs+p;          struct cost *c=super_costs+p;
         assert(c->state_in==nextstate);          assert(c->state_in==nextstate);
         assert(inst[i][nextstate].cost != INF_COST);          assert(ts[i]->inst[nextstate].cost != INF_COST);
 #if defined(GFORTH_DEBUGGING)  #if defined(GFORTH_DEBUGGING)
         assert(p == origs[i]);          assert(p == origs[i]);
 #endif  #endif
Line 1347 
Line 1723 
           /* !! actually what we care about is if and where            /* !! actually what we care about is if and where
            * compile_prim_dyn() puts NEXTs */             * compile_prim_dyn() puts NEXTs */
           tc=tc2;            tc=tc2;
         no_transition = inst[i][nextstate].no_transition;          no_transition = ts[i]->inst[nextstate].no_transition;
         nextstate = c->state_out;          nextstate = c->state_out;
         nextdyn += c->length;          nextdyn += c->length;
       }        }
Line 1356 
Line 1732 
       assert(0);        assert(0);
 #endif  #endif
       tc=0;        tc=0;
       /* tc= (Cell)vm_prims[inst[i][CANONICAL_STATE].inst]; */        /* tc= (Cell)vm_prims[ts[i]->inst[CANONICAL_STATE].inst]; */
     }      }
     *(instps[i]) = tc;      *(instps[i]) = tc;
   }    }
   if (!no_transition) {    if (!no_transition) {
     PrimNum p = trans[i][nextstate].inst;      PrimNum p = ts[i]->trans[nextstate].inst;
     struct cost *c = super_costs+p;      struct cost *c = super_costs+p;
     assert(c->state_in==nextstate);      assert(c->state_in==nextstate);
     assert(trans[i][nextstate].cost != INF_COST);      assert(ts[i]->trans[nextstate].cost != INF_COST);
     assert(i==nextdyn);      assert(i==nextdyn);
     (void)compile_prim_dyn(p,NULL);      (void)compile_prim_dyn(p,NULL);
     nextstate = c->state_out;      nextstate = c->state_out;
   }    }
   assert(nextstate==CANONICAL_STATE);    assert(nextstate==CANONICAL_STATE);
 }  }
   #endif
   
 /* compile *start, possibly rewriting it into a static and/or dynamic  /* compile *start, possibly rewriting it into a static and/or dynamic
    superinstruction */     superinstruction */
Line 1407 
Line 1784 
     optimize_rewrite(instps,origs,ninsts);      optimize_rewrite(instps,origs,ninsts);
     /* fprintf(stderr,"optimize_rewrite(...,%d)\n",ninsts); */      /* fprintf(stderr,"optimize_rewrite(...,%d)\n",ninsts); */
     ninsts=0;      ninsts=0;
     if (start==NULL)      if (start==NULL) {
         align_code();
       return;        return;
   }    }
     }
   prim_num = ((Xt)*start)-vm_prims;    prim_num = ((Xt)*start)-vm_prims;
   if(prim_num >= npriminfos) {    if(prim_num >= npriminfos) {
     optimize_rewrite(instps,origs,ninsts);      optimize_rewrite(instps,origs,ninsts);
Line 1424 
Line 1803 
 #endif /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */  #endif /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */
 }  }
   
 Address loader(FILE *imagefile, char* filename)  #ifndef STANDALONE
   Address gforth_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) */
 {  {
   ImageHeader header;    ImageHeader header;
Line 1452 
Line 1832 
 #endif  #endif
     ;      ;
   
   vm_prims = engine(0,0,0,0,0);    vm_prims = gforth_engine(0,0,0,0,0);
   check_prims(vm_prims);    check_prims(vm_prims);
   prepare_super_table();    prepare_super_table();
 #ifndef DOUBLY_INDIRECT  #ifndef DOUBLY_INDIRECT
Line 1463 
Line 1843 
 #else /* defined(DOUBLY_INDIRECT) */  #else /* defined(DOUBLY_INDIRECT) */
   check_sum = (UCell)vm_prims;    check_sum = (UCell)vm_prims;
 #endif /* defined(DOUBLY_INDIRECT) */  #endif /* defined(DOUBLY_INDIRECT) */
   #if !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED))
     termstate = make_termstate();
   #endif /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */
   
   do {    do {
     if(fread(magic,sizeof(Char),8,imagefile) < 8) {      if(fread(magic,sizeof(Char),8,imagefile) < 8) {
Line 1499 
Line 1882 
 #elif PAGESIZE  #elif PAGESIZE
   pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */    pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */
 #endif  #endif
   if (debug)    debugp(stderr,"pagesize=%ld\n",(unsigned long) pagesize);
     fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize);  
   
   image = dict_alloc_read(imagefile, preamblesize+header.image_size,    image = dict_alloc_read(imagefile, preamblesize+header.image_size,
                           preamblesize+dictsize, data_offset);                            preamblesize+dictsize, data_offset);
   imp=image+preamblesize;    imp=image+preamblesize;
   
   alloc_stacks((ImageHeader *)imp);    alloc_stacks((ImageHeader *)imp);
   if (clear_dictionary)    if (clear_dictionary)
     memset(imp+header.image_size, 0, dictsize-header.image_size);      memset(imp+header.image_size, 0, dictsize-header.image_size);
   if(header.base==0 || header.base  == (Address)0x100) {    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);      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, (Cell)header.base, vm_prims);      gforth_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 1544 
Line 1927 
   
   return imp;    return imp;
 }  }
   #endif
   
 /* pointer to last '/' or '\' in file, 0 if there is none. */  /* pointer to last '/' or '\' in file, 0 if there is none. */
 char *onlypath(char *filename)  static char *onlypath(char *filename)
 {  {
   return strrchr(filename, DIRSEP);    return strrchr(filename, DIRSEP);
 }  }
   
 FILE *openimage(char *fullfilename)  static FILE *openimage(char *fullfilename)
 {  {
   FILE *image_file;    FILE *image_file;
   char * expfilename = tilde_cstr(fullfilename, strlen(fullfilename), 1);    char * expfilename = tilde_cstr((Char *)fullfilename, strlen(fullfilename), 1);
   
   image_file=fopen(expfilename,"rb");    image_file=fopen(expfilename,"rb");
   if (image_file!=NULL && debug)    if (image_file!=NULL && debug)
Line 1563 
Line 1947 
 }  }
   
 /* try to open image file concat(path[0:len],imagename) */  /* try to open image file concat(path[0:len],imagename) */
 FILE *checkimage(char *path, int len, char *imagename)  static FILE *checkimage(char *path, int len, char *imagename)
 {  {
   int dirlen=len;    int dirlen=len;
   char fullfilename[dirlen+strlen(imagename)+2];    char fullfilename[dirlen+strlen((char *)imagename)+2];
   
   memcpy(fullfilename, path, dirlen);    memcpy(fullfilename, path, dirlen);
   if (fullfilename[dirlen-1]!=DIRSEP)    if (fullfilename[dirlen-1]!=DIRSEP)
Line 1575 
Line 1959 
   return openimage(fullfilename);    return openimage(fullfilename);
 }  }
   
 FILE * open_image_file(char * imagename, char * path)  static FILE * open_image_file(char * imagename, char * path)
 {  {
   FILE * image_file=NULL;    FILE * image_file=NULL;
   char *origpath=path;    char *origpath=path;
Line 1607 
Line 1991 
 }  }
 #endif  #endif
   
   #ifdef STANDALONE_ALLOC
   Address gforth_alloc(Cell size)
   {
     Address r;
     /* leave a little room (64B) for stack underflows */
     if ((r = malloc(size+64))==NULL) {
       perror(progname);
       exit(1);
     }
     r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));
     debugp(stderr, "malloc succeeds, address=$%lx\n", (long)r);
     return r;
   }
   #endif
   
 #ifdef HAS_OS  #ifdef HAS_OS
 UCell convsize(char *s, UCell elemsize)  static UCell convsize(char *s, UCell elemsize)
 /* converts s of the format [0-9]+[bekMGT]? (e.g. 25k) into the number  /* converts s of the format [0-9]+[bekMGT]? (e.g. 25k) into the number
    of bytes.  the letter at the end indicates the unit, where e stands     of bytes.  the letter at the end indicates the unit, where e stands
    for the element size. default is e */     for the element size. default is e */
Line 1651 
Line 2050 
   ss_min_nexts,    ss_min_nexts,
 };  };
   
   #ifndef STANDALONE
 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 1666 
Line 2066 
       {"return-stack-size", required_argument, NULL, 'r'},        {"return-stack-size", required_argument, NULL, 'r'},
       {"fp-stack-size", required_argument, NULL, 'f'},        {"fp-stack-size", required_argument, NULL, 'f'},
       {"locals-stack-size", required_argument, NULL, 'l'},        {"locals-stack-size", required_argument, NULL, 'l'},
         {"vm-commit", no_argument, &map_noreserve, 0},
       {"path", required_argument, NULL, 'p'},        {"path", required_argument, NULL, 'p'},
       {"version", no_argument, NULL, 'v'},        {"version", no_argument, NULL, 'v'},
       {"help", no_argument, NULL, 'h'},        {"help", no_argument, NULL, 'h'},
Line 1674 
Line 2075 
       {"no-offset-im", no_argument, &offset_image, 0},        {"no-offset-im", no_argument, &offset_image, 0},
       {"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},
         {"ignore-async-signals", no_argument, &ignore_async_signals, 1},
       {"debug", no_argument, &debug, 1},        {"debug", no_argument, &debug, 1},
         {"diag", no_argument, &diag, 1},
       {"no-super", no_argument, &no_super, 1},        {"no-super", no_argument, &no_super, 1},
       {"no-dynamic", no_argument, &no_dynamic, 1},        {"no-dynamic", no_argument, &no_dynamic, 1},
       {"dynamic", no_argument, &no_dynamic, 0},        {"dynamic", no_argument, &no_dynamic, 0},
       {"print-metrics", no_argument, &print_metrics, 1},        {"print-metrics", no_argument, &print_metrics, 1},
         {"print-sequences", no_argument, &print_sequences, 1},
       {"ss-number", required_argument, NULL, ss_number},        {"ss-number", required_argument, NULL, ss_number},
       {"ss-states", required_argument, NULL, ss_states},        {"ss-states", required_argument, NULL, ss_states},
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
Line 1688 
Line 2092 
       {"ss-min-lsu",      no_argument, NULL, ss_min_lsu},        {"ss-min-lsu",      no_argument, NULL, ss_min_lsu},
       {"ss-min-nexts",    no_argument, NULL, ss_min_nexts},        {"ss-min-nexts",    no_argument, NULL, ss_min_nexts},
       {"ss-greedy",       no_argument, &ss_greedy, 1},        {"ss-greedy",       no_argument, &ss_greedy, 1},
         {"tpa-noequiv",     no_argument, &tpa_noequiv, 1},
         {"tpa-noautomaton", no_argument, &tpa_noautomaton, 1},
         {"tpa-trace",       no_argument, &tpa_trace, 1},
       {0,0,0,0}        {0,0,0,0}
       /* no-init-file, no-rc? */        /* no-init-file, no-rc? */
     };      };
Line 1722 
Line 2129 
     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\    --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\    --diag                            Print diagnostic information during startup\n\
   --dynamic                         use dynamic native code\n\    --die-on-signal                   Exit instead of THROWing 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\
     --ignore-async-signals            Ignore instead of THROWing async. signals\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\
Line 1739 
Line 2148 
   --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\    --print-metrics                   Print some code generation metrics on exit\n\
     --print-sequences                 Print primitive sequences for optimization\n\
   -r SIZE, --return-stack-size=SIZE Specify return stack size\n\    -r SIZE, --return-stack-size=SIZE Specify return stack size\n\
   --ss-greedy                       greedy, not optimal superinst selection\n\    --ss-greedy                       Greedy, not optimal superinst selection\n\
   --ss-min-codesize                 select superinsts for smallest native code\n\    --ss-min-codesize                 Select superinsts for smallest native code\n\
   --ss-min-ls                       minimize loads and stores\n\    --ss-min-ls                       Minimize loads and stores\n\
   --ss-min-lsu                      minimize loads, stores, and pointer updates\n\    --ss-min-lsu                      Minimize loads, stores, and pointer updates\n\
   --ss-min-nexts                    minimize the number of static superinsts\n\    --ss-min-nexts                    Minimize the number of static superinsts\n\
   --ss-number=N                     use N static superinsts (default max)\n\    --ss-number=N                     Use N static superinsts (default max)\n\
   --ss-states=N                     N states for stack caching (default max)\n\    --ss-states=N                     N states for stack caching (default max)\n\
     --tpa-noequiv                     Automaton without state equivalence\n\
     --tpa-noautomaton                 Dynamic programming only\n\
     --tpa-trace                       Report new states etc.\n\
   -v, --version                     Print engine version and exit\n\    -v, --version                     Print engine version and exit\n\
     --vm-commit                       Use OS default for memory overcommit\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]);
Line 1757 
Line 2171 
   }    }
 }  }
 #endif  #endif
   #endif
   
   static void print_diag()
   {
   
   #if !defined(HAVE_GETRUSAGE) || (!defined(HAS_FFCALL) && !defined(HAS_LIBFFI))
     fprintf(stderr, "*** missing functionality ***\n"
   #ifndef HAVE_GETRUSAGE
             "    no getrusage -> CPUTIME broken\n"
   #endif
   #if !defined(HAS_FFCALL) && !defined(HAS_LIBFFI)
             "    no ffcall -> only old-style foreign function calls (no fflib.fs)\n"
   #endif
             );
   #endif
     if((relocs < nonrelocs) ||
   #if defined(BUGGY_LL_CMP) || defined(BUGGY_LL_MUL) || defined(BUGGY_LL_DIV) || defined(BUGGY_LL_ADD) || defined(BUGGY_LL_SHIFT) || defined(BUGGY_LL_D2F) || defined(BUGGY_LL_F2D)
        1
   #else
        0
   #endif
        )
       debugp(stderr, "relocs: %d:%d\n", relocs, nonrelocs);
       fprintf(stderr, "*** %sperformance problems ***\n%s",
   #if defined(BUGGY_LL_CMP) || defined(BUGGY_LL_MUL) || defined(BUGGY_LL_DIV) || defined(BUGGY_LL_ADD) || defined(BUGGY_LL_SHIFT) || defined(BUGGY_LL_D2F) || defined(BUGGY_LL_F2D) || !defined(FORCE_REG) || defined(BUGGY_LONG_LONG)
               "",
   #else
               "no ",
   #endif
   #if defined(BUGGY_LL_CMP) || defined(BUGGY_LL_MUL) || defined(BUGGY_LL_DIV) || defined(BUGGY_LL_ADD) || defined(BUGGY_LL_SHIFT) || defined(BUGGY_LL_D2F) || defined(BUGGY_LL_F2D)
               "    double-cell integer type buggy ->\n        "
   #ifdef BUGGY_LL_CMP
               "CMP, "
   #endif
   #ifdef BUGGY_LL_MUL
               "MUL, "
   #endif
   #ifdef BUGGY_LL_DIV
               "DIV, "
   #endif
   #ifdef BUGGY_LL_ADD
               "ADD, "
   #endif
   #ifdef BUGGY_LL_SHIFT
               "SHIFT, "
   #endif
   #ifdef BUGGY_LL_D2F
               "D2F, "
   #endif
   #ifdef BUGGY_LL_F2D
               "F2D, "
   #endif
               "\b\b slow\n"
   #endif
   #ifndef FORCE_REG
               "    automatic register allocation: performance degradation possible\n"
   #endif
   #if !defined(FORCE_REG) || defined(BUGGY_LONG_LONG)
               "*** Suggested remedy: try ./configure"
   #ifndef FORCE_REG
               " --enable-force-reg"
   #endif
   #ifdef BUGGY_LONG_LONG
               " --enable-force-ll"
   #endif
               "\n"
   #else
               ""
   #endif
               ,
               (relocs < nonrelocs) ? "    gcc PR 15242 -> no dynamic code generation (use gcc-2.95 instead)\n" : "");
   }
   
 #ifdef INCLUDE_IMAGE  #ifdef STANDALONE
 extern Cell image[];  Cell data_abort_pc;
 extern const char reloc_bits[];  
   void data_abort_C(void)
   {
     while(1) {
     }
   }
 #endif  #endif
   
 int main(int argc, char **argv, char **env)  int main(int argc, char **argv, char **env)
Line 1787 
Line 2278 
      the stack FP-aligned. */       the stack FP-aligned. */
 #endif  #endif
   
   #ifndef STANDALONE
   /* buffering of the user output device */    /* buffering of the user output device */
 #ifdef _IONBF  #ifdef _IONBF
   if (isatty(fileno(stdout))) {    if (isatty(fileno(stdout))) {
Line 1794 
Line 2286 
     setvbuf(stdout,NULL,_IONBF,0);      setvbuf(stdout,NULL,_IONBF,0);
   }    }
 #endif  #endif
   #else
     prep_terminal();
   #endif
   
   progname = argv[0];    progname = argv[0];
   
   #ifndef STANDALONE
 #ifdef HAS_OS  #ifdef HAS_OS
   gforth_args(argc, argv, &path, &imagename);    gforth_args(argc, argv, &path, &imagename);
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   if (no_dynamic && ss_cost == cost_codesize) {    init_ss_cost();
     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(NO_DYNAMIC) */
 #endif /* defined(HAS_OS) */  #endif /* defined(HAS_OS) */
   #endif
   
 #ifdef INCLUDE_IMAGE  #ifdef STANDALONE
   set_stack_sizes((ImageHeader *)image);    image = gforth_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 = gforth_loader(image_file, imagename);
 #endif  #endif
   gforth_header=(ImageHeader *)image; /* used in SIGSEGV handler */    gforth_header=(ImageHeader *)image; /* used in SIGSEGV handler */
   
     if (diag)
       print_diag();
   {    {
     char path2[strlen(path)+1];      char path2[strlen(path)+1];
     char *p1, *p2;      char *p1, *p2;
Line 1841 
Line 2332 
       else        else
         *p2 = *p1;          *p2 = *p1;
     *p2='\0';      *p2='\0';
     retvalue = go_forth(image, 4, environ);      retvalue = gforth_go(image, 4, environ);
 #ifdef SIGPIPE  #if defined(SIGPIPE) && !defined(STANDALONE)
     bsd_signal(SIGPIPE, SIG_IGN);      bsd_signal(SIGPIPE, SIG_IGN);
 #endif  #endif
 #ifdef VM_PROFILING  #ifdef VM_PROFILING
Line 1853 
Line 2344 
   if (print_metrics) {    if (print_metrics) {
     int i;      int i;
     fprintf(stderr, "code size = %8ld\n", dyncodesize());      fprintf(stderr, "code size = %8ld\n", dyncodesize());
   #ifndef STANDALONE
     for (i=0; i<sizeof(cost_sums)/sizeof(cost_sums[0]); i++)      for (i=0; i<sizeof(cost_sums)/sizeof(cost_sums[0]); i++)
       fprintf(stderr, "metric %8s: %8ld\n",        fprintf(stderr, "metric %8s: %8ld\n",
               cost_sums[i].metricname, cost_sums[i].sum);                cost_sums[i].metricname, cost_sums[i].sum);
   #endif
       fprintf(stderr,"lb_basic_blocks = %ld\n", lb_basic_blocks);
       fprintf(stderr,"lb_labeler_steps = %ld\n", lb_labeler_steps);
       fprintf(stderr,"lb_labeler_automaton = %ld\n", lb_labeler_automaton);
       fprintf(stderr,"lb_labeler_dynprog = %ld\n", lb_labeler_dynprog);
       fprintf(stderr,"lb_newstate_equiv = %ld\n", lb_newstate_equiv);
       fprintf(stderr,"lb_newstate_new = %ld\n", lb_newstate_new);
       fprintf(stderr,"lb_applicable_base_rules = %ld\n", lb_applicable_base_rules);
       fprintf(stderr,"lb_applicable_chain_rules = %ld\n", lb_applicable_chain_rules);
     }
     if (tpa_trace) {
       fprintf(stderr, "%ld %ld lb_states\n", lb_labeler_steps, lb_newstate_new);
       fprintf(stderr, "%ld %ld lb_table_entries\n", lb_labeler_steps, lb_labeler_dynprog);
   }    }
   return retvalue;    return retvalue;
 }  }

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help