[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.186 and 1.244

version 1.186, Sun Jul 1 15:42:17 2007 UTC version 1.244, Sat Mar 17 22:18:59 2012 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,2004,2005,2006 Free Software Foundation, Inc.    Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010,2011 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
   Gforth is free software; you can redistribute it and/or    Gforth is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License    modify it under the terms of the GNU General Public License
   as published by the Free Software Foundation; either version 2    as published by the Free Software Foundation, either version 3
   of the License, or (at your option) any later version.    of the License, or (at your option) any later version.
   
   This program is distributed in the hope that it will be useful,    This program is distributed in the hope that it will be useful,
Line 16 
Line 16 
   GNU General Public License for more details.    GNU General Public License for more details.
   
   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, see http://www.gnu.org/licenses/.
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.  
 */  */
   
 #include "config.h"  #include "config.h"
Line 29 
Line 28 
 #include <string.h>  #include <string.h>
 #include <math.h>  #include <math.h>
 #include <sys/types.h>  #include <sys/types.h>
   #ifdef HAVE_ALLOCA_H
   #include <alloca.h>
   #endif
 #ifndef STANDALONE  #ifndef STANDALONE
 #include <sys/stat.h>  #include <sys/stat.h>
 #endif  #endif
Line 36 
Line 38 
 #include <assert.h>  #include <assert.h>
 #include <stdlib.h>  #include <stdlib.h>
 #include <signal.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>
Line 43 
Line 46 
 #endif  #endif
 #include "io.h"  #include "io.h"
 #include "getopt.h"  #include "getopt.h"
 #ifdef STANDALONE  #ifndef STANDALONE
 /* #include <systypes.h> */  #include <locale.h>
 #endif  #endif
   
   /* output rules etc. for burg with --debug and --print-sequences */
   /* #define BURG_FORMAT*/
   
 typedef enum prim_num {  typedef enum prim_num {
 /* definitions of N_execute etc. */  /* definitions of N_execute etc. */
 #include PRIM_NUM_I  #include PRIM_NUM_I
Line 56 
Line 62 
 /* 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 *gforth_SP;  __thread Cell *gforth_SP;
 Float *gforth_FP;  __thread Float *gforth_FP;
 Address gforth_UP=NULL;  __thread Address gforth_UP=NULL;
   __thread Cell *gforth_RP;
   __thread Address gforth_LP;
   
 #ifdef HAS_FFCALL  #ifdef HAS_FFCALL
 Cell *gforth_RP;  
 Address gforth_LP;  
   
 #include <callback.h>  #include <callback.h>
   
 va_alist gforth_clist;  __thread va_alist gforth_clist;
   
 void gforth_callback(Xt* fcall, void * alist)  void gforth_callback(Xt* fcall, void * alist)
 {  {
Line 79 
Line 85 
   
   gforth_clist = (va_alist)alist;    gforth_clist = (va_alist)alist;
   
   gforth_engine(fcall, sp, rp, fp, lp);    gforth_engine(fcall, sp, rp, fp, lp sr_call);
   
   /* 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 */    /* restore global variables */
   gforth_RP = rp;    gforth_RP = rp;
Line 119 
Line 93 
   gforth_FP = fp;    gforth_FP = fp;
   gforth_LP = lp;    gforth_LP = lp;
   gforth_clist = clist;    gforth_clist = clist;
   gforth_ritem = ritem;  
 }  }
 #endif  #endif
   
Line 127 
Line 100 
 /* define some VM registers as global variables, so they survive exceptions;  /* define some VM registers as global variables, so they survive exceptions;
    global register variables are not up to the task (according to the     global register variables are not up to the task (according to the
    GNU C manual) */     GNU C manual) */
 Xt *saved_ip;  #if defined(GLOBALS_NONRELOC)
 Cell *rp;  saved_regs saved_regs_v;
 #endif  __thread saved_regs *saved_regs_p = &saved_regs_v;
   #else /* !defined(GLOBALS_NONRELOC) */
   __thread Xt *saved_ip;
   __thread Cell *rp;
   #endif /* !defined(GLOBALS_NONRELOC) */
   #endif /* !defined(GFORTH_DEBUGGING) */
   
 #ifdef NO_IP  #ifdef NO_IP
 Label next_code;  Label next_code;
Line 201 
Line 179 
 #define CODE_BLOCK_SIZE (512*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; /* does for code-area what HERE does for the dictionary */
                                            does for the dictionary */  
 Address start_flush=NULL; /* start of unflushed code */  Address start_flush=NULL; /* start of unflushed code */
 Cell last_jump=0; /* if the last prim was compiled without jump, this  Cell last_jump=0; /* if the last prim was compiled without jump, this
                      is it's number, otherwise this contains 0 */                       is it's number, otherwise this contains 0 */
Line 211 
Line 188 
 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 = 0; /* number of ss used if available */  static int static_super_number = 10000; /* number of ss used if available */
                                     /* disabled because of tpa */  
 #define MAX_STATE 9 /* maximum number of states */  #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 */
Line 220 
Line 196 
 static int tpa_noequiv = 0;     /* if true: no state equivalence checking */  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_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 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 relocs = 0;
 static int nonrelocs = 0;  static int nonrelocs = 0;
   
 #ifdef HAS_DEBUG  #ifdef HAS_DEBUG
 int debug=0;  int debug=0;
 # define debugp(x...) if (debug) fprintf(x);  # define debugp(x...) do { if (debug) fprintf(x); } while (0)
 #else  #else
 # define perror(x...)  # define perror(x...)
 # define fprintf(x...)  # define fprintf(x...)
Line 283 
Line 260 
 {  {
   return memcmp(s1, s2, n);    return memcmp(s1, s2, n);
 }  }
   
   Char *gforth_memmove(Char * dest, const Char* src, Cell n)
   {
     return memmove(dest, src, n);
   }
   
   Char *gforth_memset(Char * s, Cell c, UCell n)
   {
     return memset(s, c, n);
   }
   
   Char *gforth_memcpy(Char * dest, const Char* src, Cell n)
   {
     return memcpy(dest, src, n);
   }
 #endif  #endif
   
 static Cell max(Cell a, Cell b)  static Cell max(Cell a, Cell b)
Line 299 
Line 291 
 /* 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: "Gforth3x" means format 0.6,   *   magic: "Gforth4x" means format 0.8,
  *              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 318 
Line 310 
  * If the word =-1 (CF_NIL), the address is NIL,   * If the word =-1 (CF_NIL), the address is NIL,
  * If the word is <CF_NIL and >CF(DODOES), it's a CFA (:, Create, ...)   * If the word is <CF_NIL and >CF(DODOES), it's a CFA (:, Create, ...)
  * 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>,   * !! ABI-CODE and ;ABI-CODE
  *                                      possibly containing a jump to dodoes)   * If the word is <CF(DOER_MAX) and bit 14 is set, it's the xt of 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(DOER_MAX) and bit 14 is clear,
  * If the word is <CF(DOESJUMP) and bit 14 is clear,  
  *                                        it's the threaded code of a primitive   *                                        it's the threaded code of a primitive
  * bits 13..9 of a primitive token state which group the primitive belongs to,   * 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   * bits 8..0 of a primitive token index into the group
Line 414 
Line 405 
             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) :
             case CF(DOESJUMP): image[i]=0; break;  
 #endif /* !defined(DOUBLY_INDIRECT) */  
             case CF(DODOES)  :              case CF(DODOES)  :
               MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)start)));              case CF(DOABICODE) :
               break;              case CF(DOSEMIABICODE):
                 MAKE_CF(image+i,symbols[CF(token)]); break;
   #endif /* !defined(DOUBLY_INDIRECT) */
             default          : /* backward compatibility */              default          : /* backward compatibility */
 /*            printf("Code field generation image[%x]:=CFA(%x)\n",  /*            printf("Code field generation image[%x]:=CFA(%x)\n",
                      i, CF(image[i])); */                       i, CF(image[i])); */
Line 475 
Line 467 
   UCell r=PRIM_VERSION;    UCell r=PRIM_VERSION;
   Cell i;    Cell i;
   
   for (i=DOCOL; i<=DOESJUMP; i++) {    for (i=DOCOL; i<=DOER_MAX; i++) {
     r ^= (UCell)(symbols[i]);      r ^= (UCell)(symbols[i]);
     r = (r << 5) | (r >> (8*sizeof(Cell)-5));      r = (r << 5) | (r >> (8*sizeof(Cell)-5));
   }    }
Line 508 
Line 500 
   return r;    return r;
 }  }
   
 static Address next_address=0;  static void *next_address=0;
 static void after_alloc(Address r, Cell size)  static void after_alloc(Address r, Cell size)
 {  {
   if (r != (Address)-1) {    if (r != (Address)-1) {
Line 532 
Line 524 
 #ifndef MAP_PRIVATE  #ifndef MAP_PRIVATE
 # define MAP_PRIVATE 0  # define MAP_PRIVATE 0
 #endif  #endif
   #ifndef PROT_NONE
   # define PROT_NONE 0
   #endif
 #if !defined(MAP_ANON) && defined(MAP_ANONYMOUS)  #if !defined(MAP_ANON) && defined(MAP_ANONYMOUS)
 # define MAP_ANON MAP_ANONYMOUS  # define MAP_ANON MAP_ANONYMOUS
 #endif  #endif
Line 539 
Line 534 
 #if defined(HAVE_MMAP)  #if defined(HAVE_MMAP)
 static Address alloc_mmap(Cell size)  static Address alloc_mmap(Cell size)
 {  {
   Address r;    void *r;
   
 #if defined(MAP_ANON)  #if defined(MAP_ANON)
   debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size);    debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size);
Line 564 
Line 559 
   return r;    return r;
 }  }
   
 static void page_noaccess(Address a)  static void page_noaccess(void *a)
 {  {
   /* try mprotect first; with munmap the page might be allocated later */    /* try mprotect first; with munmap the page might be allocated later */
   debugp(stderr, "try mprotect(%p,%ld,PROT_NONE); ", a, (long)pagesize);    debugp(stderr, "try mprotect(%p,$%lx,PROT_NONE); ", a, (long)pagesize);
   if (mprotect(a, pagesize, PROT_NONE)==0) {    if (mprotect(a, pagesize, PROT_NONE)==0) {
     debugp(stderr, "ok\n");      debugp(stderr, "ok\n");
     return;      return;
   }    }
   debugp(stderr, "failed: %s\n", strerror(errno));    debugp(stderr, "failed: %s\n", strerror(errno));
   debugp(stderr, "try munmap(%p,%ld); ", a, (long)pagesize);    debugp(stderr, "try munmap(%p,$%lx); ", a, (long)pagesize);
   if (munmap(a,pagesize)==0) {    if (munmap(a,pagesize)==0) {
     debugp(stderr, "ok\n");      debugp(stderr, "ok\n");
     return;      return;
Line 600 
Line 595 
   return verbose_malloc(size);    return verbose_malloc(size);
 }  }
   
 static Address dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)  static void *dict_alloc_read(FILE *file, Cell imagesize, Cell dictsize, Cell offset)
 {  {
   Address image = MAP_FAILED;    void *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 (image != (Address)MAP_FAILED) {      if (image != (void *)MAP_FAILED) {
       Address image1;        void *image1;
       debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);        debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);
       image1 = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE|map_noreserve, fileno(file), 0);        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);        after_alloc(image1,dictsize);
       if (image1 == (Address)MAP_FAILED)        if (image1 == (void *)MAP_FAILED)
         goto read_image;          goto read_image;
     }      }
   }    }
 #endif /* defined(HAVE_MMAP) */  #endif /* defined(HAVE_MMAP) */
   if (image == (Address)MAP_FAILED) {    if (image == (void *)MAP_FAILED) {
     image = gforth_alloc(dictsize+offset)+offset;      image = gforth_alloc(dictsize+offset)+offset;
   read_image:    read_image:
     rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */      rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */
Line 678 
Line 673 
     size_t p = pagesize;      size_t p = pagesize;
     size_t totalsize =      size_t totalsize =
       wholepage(dsize)+wholepage(fsize)+wholepage(rsize)+wholepage(lsize)+5*p;        wholepage(dsize)+wholepage(fsize)+wholepage(rsize)+wholepage(lsize)+5*p;
     Address a = alloc_mmap(totalsize);      void *a = alloc_mmap(totalsize);
     if (a != (Address)MAP_FAILED) {      if (a != (void *)MAP_FAILED) {
       page_noaccess(a); a+=p; h->  data_stack_base=a; a+=wholepage(dsize);        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->    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->return_stack_base=a; a+=wholepage(rsize);
Line 702 
Line 697 
 #endif  #endif
   
 #warning You can ignore the warnings about clobbered variables in gforth_go  #warning You can ignore the warnings about clobbered variables in gforth_go
 int gforth_go(Address image, int stack, Cell *entries)  int gforth_go(void *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 720 
Line 715 
   /* ensure that the cached elements (if any) are accessible */    /* ensure that the cached elements (if any) are accessible */
 #if !(defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING))  #if !(defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING))
   sp0 -= 8; /* make stuff below bottom accessible for stack caching */    sp0 -= 8; /* make stuff below bottom accessible for stack caching */
     fp0--;
 #endif  #endif
   IF_fpTOS(fp0--);  
   
   for(;stack>0;stack--)    for(;stack>0;stack--)
     *--sp0=entries[stack-1];      *--sp0=entries[stack-1];
Line 755 
Line 750 
     /* fprintf(stderr, "rp=$%x\n",rp0);*/      /* fprintf(stderr, "rp=$%x\n",rp0);*/
   
     return((int)(Cell)gforth_engine(image_header->throw_entry, signal_data_stack+15,      return((int)(Cell)gforth_engine(image_header->throw_entry, signal_data_stack+15,
                        rp0, signal_fp_stack, 0));                         rp0, signal_fp_stack, 0 sr_call));
   }    }
 #endif  #endif
   
   return((int)(Cell)gforth_engine(ip0,sp0,rp0,fp0,lp0));    return((int)(Cell)gforth_engine(ip0,sp0,rp0,fp0,lp0 sr_call));
 }  }
   
 #if !defined(INCLUDE_IMAGE) && !defined(STANDALONE)  #if !defined(INCLUDE_IMAGE) && !defined(STANDALONE)
Line 877 
Line 872 
     }      }
   }    }
   debugp(stderr, "Using %d static superinsts\n", nsupers);    debugp(stderr, "Using %d static superinsts\n", nsupers);
     if (nsupers>0 && !tpa_noautomaton && !tpa_noequiv) {
       /* Currently these two things don't work together; see Section 3.2
          of <http://www.complang.tuwien.ac.at/papers/ertl+06pldi.ps.gz>,
          in particular Footnote 6 for the reason; hmm, we should be able
          to use an automaton without state equivalence, but that costs
          significant space so we only do it if the user explicitly
          disables state equivalence. */
       debugp(stderr, "Disabling tpa-automaton, because nsupers>0 and state equivalence is enabled.\n");
       tpa_noautomaton = 1;
     }
 }  }
   
 /* dynamic replication/superinstruction stuff */  /* dynamic replication/superinstruction stuff */
Line 956 
Line 961 
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   if (no_dynamic)    if (no_dynamic)
     return;      return;
   symbols2=gforth_engine2(0,0,0,0,0);    symbols2=gforth_engine2(0,0,0,0,0 sr_call);
 #if NO_IP  #if NO_IP
   symbols3=gforth_engine3(0,0,0,0,0);    symbols3=gforth_engine3(0,0,0,0,0 sr_call);
 #else  #else
   symbols3=symbols1;    symbols3=symbols1;
 #endif  #endif
Line 973 
Line 978 
   /* check whether the "goto *" is relocatable */    /* check whether the "goto *" is relocatable */
   goto_len = goto_p[1]-goto_p[0];    goto_len = goto_p[1]-goto_p[0];
   debugp(stderr, "goto * %p %p len=%ld\n",    debugp(stderr, "goto * %p %p len=%ld\n",
          goto_p[0],symbols2[goto_p-symbols1],goto_len);           goto_p[0],symbols2[goto_p-symbols1],(long)goto_len);
   if (memcmp(goto_p[0],symbols2[goto_p-symbols1],goto_len)!=0) { /* unequal */    if (memcmp(goto_p[0],symbols2[goto_p-symbols1],goto_len)!=0) { /* unequal */
     no_dynamic=1;      no_dynamic=1;
     debugp(stderr,"  not relocatable, disabling dynamic code generation\n");      debugp(stderr,"  not relocatable, disabling dynamic code generation\n");
Line 999 
Line 1004 
     pi->restlength = endlabel - symbols1[i] - pi->length;      pi->restlength = endlabel - symbols1[i] - pi->length;
     pi->nimmargs = 0;      pi->nimmargs = 0;
     relocs++;      relocs++;
   #if defined(BURG_FORMAT)
       { /* output as burg-style rules */
         int p=super_costs[i].offset;
         if (p==N_noop)
           debugp(stderr, "S%d: S%d = %d (%d);", sc->state_in, sc->state_out, i+1, pi->length);
         else
           debugp(stderr, "S%d: op%d(S%d) = %d (%d);", sc->state_in, p, sc->state_out, i+1, pi->length);
       }
   #else
     debugp(stderr, "%-15s %d-%d %4d %p %p %p len=%3ld rest=%2ld send=%1d",      debugp(stderr, "%-15s %d-%d %4d %p %p %p len=%3ld rest=%2ld send=%1d",
            prim_names[i], sc->state_in, sc->state_out,             prim_names[i], sc->state_in, sc->state_out,
            i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength),             i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength),
            pi->superend);             pi->superend);
   #endif
     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;
   #ifndef BURG_FORMAT
       debugp(stderr,"\n   non_reloc: no J label > start found\n");        debugp(stderr,"\n   non_reloc: no J label > start found\n");
   #endif
       relocs--;        relocs--;
       nonrelocs++;        nonrelocs++;
       continue;        continue;
Line 1014 
Line 1031 
     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];
   #ifndef BURG_FORMAT
       debugp(stderr,"\n   non_reloc: there is a J label before the K label (restlength<0)\n");        debugp(stderr,"\n   non_reloc: there is a J label before the K label (restlength<0)\n");
   #endif
       relocs--;        relocs--;
       nonrelocs++;        nonrelocs++;
       continue;        continue;
Line 1022 
Line 1041 
     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];
   #ifndef BURG_FORMAT
       debugp(stderr,"\n   non_reloc: K label before I label (length<0)\n");        debugp(stderr,"\n   non_reloc: K label before I label (length<0)\n");
   #endif
         relocs--;
         nonrelocs++;
         continue;
       }
       if (CHECK_PRIM(s1, prim_len)) {
   #ifndef BURG_FORMAT
         debugp(stderr,"\n   non_reloc: architecture specific check failed\n");
   #endif
         pi->start = NULL; /* not relocatable */
       relocs--;        relocs--;
       nonrelocs++;        nonrelocs++;
       continue;        continue;
Line 1033 
Line 1063 
       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 */
   #ifndef BURG_FORMAT
           debugp(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);            debugp(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);
   #endif
           /* assert(j<prim_len); */            /* assert(j<prim_len); */
           relocs--;            relocs--;
           nonrelocs++;            nonrelocs++;
Line 1049 
Line 1081 
           ia->rel=0;            ia->rel=0;
           debugp(stderr,"\n   absolute immarg: offset %3d",j);            debugp(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[DOER_MAX+1]) {
           ia->rel=1;            ia->rel=1;
           debugp(stderr,"\n   relative immarg: offset %3d",j);            debugp(stderr,"\n   relative immarg: offset %3d",j);
         } else {          } else {
           pi->start = NULL; /* not relocatable */            pi->start = NULL; /* not relocatable */
   #ifndef BURG_FORMAT
           debugp(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);            debugp(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);
   #endif
           /* assert(j<prim_len);*/            /* assert(j<prim_len);*/
           relocs--;            relocs--;
           nonrelocs++;            nonrelocs++;
Line 1066 
Line 1100 
     debugp(stderr,"\n");      debugp(stderr,"\n");
   }    }
   decomp_prims = calloc(i,sizeof(PrimInfo *));    decomp_prims = calloc(i,sizeof(PrimInfo *));
   for (i=DOESJUMP+1; i<npriminfos; i++)    for (i=DOER_MAX+1; i<npriminfos; i++)
     decomp_prims[i] = &(priminfos[i]);      decomp_prims[i] = &(priminfos[i]);
   qsort(decomp_prims+DOESJUMP+1, npriminfos-DOESJUMP-1, sizeof(PrimInfo *),    qsort(decomp_prims+DOER_MAX+1, npriminfos-DOER_MAX-1, sizeof(PrimInfo *),
         compare_priminfo_length);          compare_priminfo_length);
 #endif  #endif
 }  }
Line 1077 
Line 1111 
 {  {
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   if (start_flush)    if (start_flush)
     FLUSH_ICACHE(start_flush, code_here-start_flush);      FLUSH_ICACHE((caddr_t)start_flush, code_here-start_flush);
   start_flush=code_here;    start_flush=code_here;
 #endif  #endif
 }  }
   
 static void align_code(void)  static void MAYBE_UNUSED align_code(void)
      /* align code_here on some platforms */       /* align code_here on some platforms */
 {  {
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
Line 1128 
Line 1162 
   Cell size;    Cell size;
 } *code_block_list=NULL, **next_code_blockp=&code_block_list;  } *code_block_list=NULL, **next_code_blockp=&code_block_list;
   
 static Address append_prim(Cell p)  static void reserve_code_space(UCell size)
 {  {
   PrimInfo *pi = &priminfos[p];    if (code_area+code_area_size < code_here+size) {
   Address old_code_here = code_here;  
   
   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();
       debugp(stderr,"Did not use %ld bytes in code block\n",
              (long)(code_area+code_area_size-code_here));
     flush_to_here();      flush_to_here();
     if (*next_code_blockp == NULL) {      if (*next_code_blockp == NULL) {
       code_here = start_flush = code_area = gforth_alloc(code_area_size);        code_here = start_flush = code_area = gforth_alloc(code_area_size);
Line 1148 
Line 1181 
       p = *next_code_blockp;        p = *next_code_blockp;
       code_here = start_flush = code_area = p->block;        code_here = start_flush = code_area = p->block;
     }      }
     old_code_here = code_here;  
     next_code_blockp = &(p->next);      next_code_blockp = &(p->next);
   }    }
   }
   
   static Address append_prim(Cell p)
   {
     PrimInfo *pi = &priminfos[p];
     Address old_code_here;
     reserve_code_space(pi->length+pi->restlength+goto_len+CODE_ALIGNMENT-1);
   memcpy(code_here, pi->start, pi->length);    memcpy(code_here, pi->start, pi->length);
     old_code_here = code_here;
   code_here += pi->length;    code_here += pi->length;
   return old_code_here;    return old_code_here;
 }  }
   
   static void reserve_code_super(PrimNum origs[], int ninsts)
   {
     int i;
     UCell size = CODE_ALIGNMENT-1; /* alignment may happen first */
     if (no_dynamic)
       return;
     /* use size of the original primitives as an upper bound for the
        size of the superinstruction.  !! This is only safe if we
        optimize for code size (the default) */
     for (i=0; i<ninsts; i++) {
       PrimNum p = origs[i];
       PrimInfo *pi = &priminfos[p];
       if (is_relocatable(p))
         size += pi->length;
       else
         if (i>0)
           size += priminfos[origs[i-1]].restlength+goto_len+CODE_ALIGNMENT-1;
     }
     size += priminfos[origs[i-1]].restlength+goto_len;
     reserve_code_space(size);
   }
 #endif  #endif
   
 int forget_dyncode(Address code)  int forget_dyncode(Address code)
Line 1209 
Line 1271 
       break;        break;
   }    }
   /* reverse order because NOOP might match other prims */    /* reverse order because NOOP might match other prims */
   for (i=npriminfos-1; i>DOESJUMP; i--) {    for (i=npriminfos-1; i>DOER_MAX; i--) {
     PrimInfo *pi=decomp_prims[i];      PrimInfo *pi=decomp_prims[i];
     if (pi->start==code || (pi->start && memcmp(code,pi->start,pi->length)==0))      if (pi->start==code || (pi->start && memcmp(code,pi->start,pi->length)==0))
       return vm_prims[super2[super_costs[pi-priminfos].offset]];        return vm_prims[super2[super_costs[pi-priminfos].offset]];
Line 1561 
Line 1623 
 static void tpa_state_normalize(struct tpa_state *t)  static void tpa_state_normalize(struct tpa_state *t)
 {  {
   /* normalize so cost of canonical state=0; this may result in    /* normalize so cost of canonical state=0; this may result in
      negative states for some states */       negative costs for some states */
   int d = t->inst[CANONICAL_STATE].cost;    int d = t->inst[CANONICAL_STATE].cost;
   int i;    int i;
   
Line 1633 
Line 1695 
   int i,j;    int i,j;
   struct tpa_state *ts[ninsts+1];    struct tpa_state *ts[ninsts+1];
   int nextdyn, nextstate, no_transition;    int nextdyn, nextstate, no_transition;
     Address old_code_area;
   
   lb_basic_blocks++;    lb_basic_blocks++;
   ts[ninsts] = termstate;    ts[ninsts] = termstate;
   #ifndef NO_DYNAMIC
     if (print_sequences) {
       for (i=0; i<ninsts; i++)
   #if defined(BURG_FORMAT)
         fprintf(stderr, "op%d ", super_costs[origs[i]].offset);
   #else
         fprintf(stderr, "%s ", prim_names[origs[i]]);
   #endif
       fprintf(stderr, "\n");
     }
   #endif
   for (i=ninsts-1; i>=0; i--) {    for (i=ninsts-1; i>=0; i--) {
     struct tpa_state **tp = lookup_tpa(origs[i],ts[i+1]);      struct tpa_state **tp = lookup_tpa(origs[i],ts[i+1]);
     struct tpa_state *t = *tp;      struct tpa_state *t = *tp;
Line 1684 
Line 1758 
     }      }
   }    }
   /* now rewrite the instructions */    /* now rewrite the instructions */
     reserve_code_super(origs,ninsts);
     old_code_area = code_area;
   nextdyn=0;    nextdyn=0;
   nextstate=CANONICAL_STATE;    nextstate=CANONICAL_STATE;
   no_transition = ((!ts[0]->trans[nextstate].relocatable)    no_transition = ((!ts[0]->trans[nextstate].relocatable)
Line 1737 
Line 1813 
     nextstate = c->state_out;      nextstate = c->state_out;
   }    }
   assert(nextstate==CANONICAL_STATE);    assert(nextstate==CANONICAL_STATE);
     assert(code_area==old_code_area); /* does reserve_code_super() work? */
 }  }
 #endif  #endif
   
Line 1750 
Line 1827 
   if (start==NULL)    if (start==NULL)
     return;      return;
   prim = (Label)*start;    prim = (Label)*start;
   if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) {    if (prim<((Label)(xts+DOER_MAX)) || prim>((Label)(xts+npriminfos))) {
     fprintf(stderr,"compile_prim encountered xt %p\n", prim);      fprintf(stderr,"compile_prim encountered xt %p\n", prim);
     *start=(Cell)prim;      *start=(Cell)prim;
     return;      return;
Line 1761 
Line 1838 
 #elif defined(INDIRECT_THREADED)  #elif defined(INDIRECT_THREADED)
   return;    return;
 #else /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */  #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 Cell *instps[MAX_BB];
   static PrimNum origs[MAX_BB];    static PrimNum origs[MAX_BB];
   static int ninsts=0;    static int ninsts=0;
Line 1782 
Line 1856 
   }    }
   prim_num = ((Xt)*start)-vm_prims;    prim_num = ((Xt)*start)-vm_prims;
   if(prim_num >= npriminfos) {    if(prim_num >= npriminfos) {
       /* code word */
     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;
       append_jump();
       *start = *(Cell *)*start;
     return;      return;
   }    }
   assert(ninsts<MAX_BB);    assert(ninsts<MAX_BB);
Line 1823 
Line 1900 
 #endif  #endif
     ;      ;
   
   vm_prims = gforth_engine(0,0,0,0,0);    vm_prims = gforth_engine(0,0,0,0,0 sr_call);
   check_prims(vm_prims);    check_prims(vm_prims);
   prepare_super_table();    prepare_super_table();
 #ifndef DOUBLY_INDIRECT  #ifndef DOUBLY_INDIRECT
Line 1840 
Line 1917 
   
   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.6) image.\n",        fprintf(stderr,"%s: image %s doesn't seem to be a Gforth (>=0.8) image.\n",
               progname, filename);                progname, filename);
       exit(1);        exit(1);
     }      }
     preamblesize+=8;      preamblesize+=8;
   } while(memcmp(magic,"Gforth3",7));    } while(memcmp(magic,"Gforth4",7));
   magic7 = magic[7];    magic7 = magic[7];
   if (debug) {    if (debug) {
     magic[7]='\0';      magic[7]='\0';
Line 1876 
Line 1953 
   debugp(stderr,"pagesize=%ld\n",(unsigned long) pagesize);    debugp(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);                            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-preamblesize);
   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];
Line 1929 
Line 2006 
 static FILE *openimage(char *fullfilename)  static FILE *openimage(char *fullfilename)
 {  {
   FILE *image_file;    FILE *image_file;
   char * expfilename = tilde_cstr((Char *)fullfilename, strlen(fullfilename), 1);    char * expfilename = tilde_cstr((Char *)fullfilename, strlen(fullfilename));
   
   image_file=fopen(expfilename,"rb");    image_file=fopen(expfilename,"rb");
   if (image_file!=NULL && debug)    if (image_file!=NULL && debug)
     fprintf(stderr, "Opened image file: %s\n", expfilename);      fprintf(stderr, "Opened image file: %s\n", expfilename);
     free(expfilename);
   return image_file;    return image_file;
 }  }
   
Line 2039 
Line 2117 
   ss_min_ls,    ss_min_ls,
   ss_min_lsu,    ss_min_lsu,
   ss_min_nexts,    ss_min_nexts,
     opt_code_block_size,
 };  };
   
 #ifndef STANDALONE  #ifndef STANDALONE
Line 2065 
Line 2144 
       {"offset-image", no_argument, &offset_image, 1},        {"offset-image", no_argument, &offset_image, 1},
       {"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},  
       {"ignore-async-signals", no_argument, &ignore_async_signals, 1},  
       {"debug", no_argument, &debug, 1},        {"debug", no_argument, &debug, 1},
       {"diag", no_argument, &diag, 1},        {"diag", no_argument, &diag, 1},
         {"die-on-signal", no_argument, &die_on_signal, 1},
         {"ignore-async-signals", no_argument, &ignore_async_signals, 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},
         {"code-block-size", required_argument, NULL, opt_code_block_size},
       {"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 2108 
Line 2189 
     case 's': die_on_signal = 1; break;      case 's': die_on_signal = 1; break;
     case 'x': debug = 1; break;      case 'x': debug = 1; break;
     case 'v': fputs(PACKAGE_STRING"\n", stderr); exit(0);      case 'v': fputs(PACKAGE_STRING"\n", stderr); exit(0);
       case opt_code_block_size: code_area_size = atoi(optarg); break;
     case ss_number: static_super_number = atoi(optarg); break;      case ss_number: static_super_number = atoi(optarg); break;
     case ss_states: maxstates = max(min(atoi(optarg),MAX_STATE),1); break;      case ss_states: maxstates = max(min(atoi(optarg),MAX_STATE),1); break;
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
Line 2121 
Line 2203 
 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\
     --code-block-size=SIZE            size of native code blocks [512KB]\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\
   --diag                            Print diagnostic information during startup\n\    --diag                            Print diagnostic information during startup\n\
Line 2138 
Line 2221 
   --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\
Line 2165 
Line 2249 
 static void print_diag()  static void print_diag()
 {  {
   
 #if !defined(HAVE_GETRUSAGE) || (!defined(HAS_FFCALL) && !defined(HAS_LIBFFI))  #if !defined(HAVE_GETRUSAGE)
   fprintf(stderr, "*** missing functionality ***\n"    fprintf(stderr, "*** missing functionality ***\n"
 #ifndef HAVE_GETRUSAGE  #ifndef HAVE_GETRUSAGE
           "    no getrusage -> CPUTIME broken\n"            "    no getrusage -> CPUTIME broken\n"
 #endif  #endif
 #if !defined(HAS_FFCALL) && !defined(HAS_LIBFFI)  
           "    no ffcall -> only old-style foreign function calls (no fflib.fs)\n"  
 #endif  
           );            );
 #endif  #endif
   if((relocs < nonrelocs) ||    if((relocs < nonrelocs) ||
Line 2183 
Line 2264 
 #endif  #endif
      )       )
     debugp(stderr, "relocs: %d:%d\n", relocs, nonrelocs);      debugp(stderr, "relocs: %d:%d\n", relocs, nonrelocs);
     fprintf(stderr, "*** %sperformance problems ***\n%s",      fprintf(stderr, "*** %sperformance problems ***\n%s%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)  #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(FORCE_REG_UNNECESSARY)) || defined(BUGGY_LONG_LONG)
             "",              "",
 #else  #else
             "no ",              "no ",
Line 2192 
Line 2273 
 #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)  #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        "              "    double-cell integer type buggy ->\n        "
 #ifdef BUGGY_LL_CMP  #ifdef BUGGY_LL_CMP
             "CMP, "              "double comparisons, "
 #endif  #endif
 #ifdef BUGGY_LL_MUL  #ifdef BUGGY_LL_MUL
             "MUL, "              "*/MOD */ M* UM* "
 #endif  #endif
 #ifdef BUGGY_LL_DIV  #ifdef BUGGY_LL_DIV
             "DIV, "              /* currently nothing is affected */
 #endif  #endif
 #ifdef BUGGY_LL_ADD  #ifdef BUGGY_LL_ADD
             "ADD, "              "M+ D+ D- DNEGATE "
 #endif  #endif
 #ifdef BUGGY_LL_SHIFT  #ifdef BUGGY_LL_SHIFT
             "SHIFT, "              "D2/ "
 #endif  #endif
 #ifdef BUGGY_LL_D2F  #ifdef BUGGY_LL_D2F
             "D2F, "              "D>F "
 #endif  #endif
 #ifdef BUGGY_LL_F2D  #ifdef BUGGY_LL_F2D
             "F2D, "              "F>D "
 #endif  #endif
             "\b\b slow\n"              "\b\b slow\n"
 #endif  #endif
 #ifndef FORCE_REG  #if !(defined(FORCE_REG) || defined(FORCE_REG_UNNECESSARY))
             "    automatic register allocation: performance degradation possible\n"              "    automatic register allocation: performance degradation possible\n"
 #endif  #endif
 #if !defined(FORCE_REG) || defined(BUGGY_LONG_LONG)              "",
             "*** Suggested remedy: try ./configure"              (relocs < nonrelocs) ? "no dynamic code generation (--debug for details) -> factor 2 slowdown\n" : "");
 #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 STANDALONE  #ifdef STANDALONE
Line 2243 
Line 2312 
 }  }
 #endif  #endif
   
   void* gforth_pointers(Cell n)
   {
     switch(n) {
     case 0: return (void*)&gforth_SP;
     case 1: return (void*)&gforth_FP;
     case 2: return (void*)&gforth_LP;
     case 3: return (void*)&gforth_RP;
     case 4: return (void*)&gforth_UP;
     case 5: return (void*)&gforth_engine;
   #ifdef HAS_FILE
     case 6: return (void*)&cstr;
     case 7: return (void*)&tilde_cstr;
   #endif
     case 8: return (void*)&throw_jmp_buf;
     default: return NULL;
     }
   }
   
 int main(int argc, char **argv, char **env)  int main(int argc, char **argv, char **env)
 {  {
 #ifdef HAS_OS  #ifdef HAS_OS
Line 2256 
Line 2343 
   Address image;    Address image;
 #endif  #endif
   int retvalue;    int retvalue;
   #if 0 && defined(__i386)
     /* disabled because the drawbacks may be worse than the benefits */
     /* set 387 precision control to use 53-bit mantissae to avoid most
        cases of double rounding */
     short fpu_control = 0x027f ;
     asm("fldcw %0" : : "m"(fpu_control));
   #endif /* defined(__i386) */
   
 #if defined(i386) && defined(ALIGNMENT_CHECK)  #ifdef MACOSX_DEPLOYMENT_TARGET
   /* turn on alignment checks on the 486.    setenv("MACOSX_DEPLOYMENT_TARGET", MACOSX_DEPLOYMENT_TARGET, 0);
    * on the 386 this should have no effect. */  #endif
   __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");  #ifdef LTDL_LIBRARY_PATH
   /* this is unusable with Linux' libc.4.6.27, because this library is    setenv("LTDL_LIBRARY_PATH", LTDL_LIBRARY_PATH, 0);
      not alignment-clean; we would have to replace some library  
      functions (e.g., memcpy) to make it work. Also GCC doesn't try to keep  
      the stack FP-aligned. */  
 #endif  #endif
   
 #ifndef STANDALONE  #ifndef STANDALONE
   /* buffering of the user output device */    /* buffering of the user output device */
 #ifdef _IONBF  #ifdef _IONBF
Line 2275 
Line 2365 
     setvbuf(stdout,NULL,_IONBF,0);      setvbuf(stdout,NULL,_IONBF,0);
   }    }
 #endif  #endif
     setlocale(LC_ALL, "");
     setlocale(LC_NUMERIC, "C");
 #else  #else
   prep_terminal();    prep_terminal();
 #endif  #endif
Line 2282 
Line 2374 
   progname = argv[0];    progname = argv[0];
   
 #ifndef STANDALONE  #ifndef STANDALONE
   #ifdef HAVE_LIBLTDL
     if (lt_dlinit()!=0) {
       fprintf(stderr,"%s: lt_dlinit failed", progname);
       exit(1);
     }
   #endif
   
 #ifdef HAS_OS  #ifdef HAS_OS
   gforth_args(argc, argv, &path, &imagename);    gforth_args(argc, argv, &path, &imagename);
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
Line 2289 
Line 2388 
 #endif /* !defined(NO_DYNAMIC) */  #endif /* !defined(NO_DYNAMIC) */
 #endif /* defined(HAS_OS) */  #endif /* defined(HAS_OS) */
 #endif  #endif
     code_here = ((void *)0)+code_area_size;
 #ifdef STANDALONE  #ifdef STANDALONE
   image = gforth_engine(0, 0, 0, 0, 0);    image = gforth_engine(0, 0, 0, 0, 0 sr_call);
   alloc_stacks((ImageHeader *)image);    alloc_stacks((ImageHeader *)image);
 #else  #else
   image_file = open_image_file(imagename, path);    image_file = open_image_file(imagename, path);
Line 2329 
Line 2428 
     vm_print_profile(stderr);      vm_print_profile(stderr);
 #endif  #endif
     deprep_terminal();      deprep_terminal();
   #ifndef STANDALONE
   #ifdef HAVE_LIBLTDL
       if (lt_dlexit()!=0)
         fprintf(stderr,"%s: lt_dlexit failed", progname);
   #endif
   #endif
   }    }
   if (print_metrics) {    if (print_metrics) {
     int i;      int i;

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help