[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.177 and 1.224

version 1.177, Sat Mar 31 21:43:18 2007 UTC version 1.224, Mon Jul 6 18:46:03 2009 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 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 47 
Line 50 
 /* #include <systypes.h> */  /* #include <systypes.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 59 
Line 65 
 Cell *gforth_SP;  Cell *gforth_SP;
 Float *gforth_FP;  Float *gforth_FP;
 Address gforth_UP=NULL;  Address gforth_UP=NULL;
   
 #ifdef HAS_FFCALL  
 Cell *gforth_RP;  Cell *gforth_RP;
 Address gforth_LP;  Address gforth_LP;
   
   #ifndef HAS_LINKBACK
   void * gforth_pointers[] = {
     (void*)&gforth_SP,
     (void*)&gforth_FP,
     (void*)&gforth_LP,
     (void*)&gforth_RP,
     (void*)&gforth_UP,
     (void*)gforth_engine,
     (void*)cstr,
     (void*)tilde_cstr };
   #endif
   
   #ifdef HAS_FFCALL
   
 #include <callback.h>  #include <callback.h>
   
 va_alist gforth_clist;  va_alist gforth_clist;
Line 79 
Line 97 
   
   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 */    /* restore global variables */
   gforth_RP = rp;    gforth_RP = rp;
Line 90 
Line 108 
 }  }
 #endif  #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  
   
 #ifdef GFORTH_DEBUGGING  #ifdef GFORTH_DEBUGGING
 /* 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) */
   #if defined(GLOBALS_NONRELOC)
   saved_regs saved_regs_v;
   saved_regs *saved_regs_p = &saved_regs_v;
   #else /* !defined(GLOBALS_NONRELOC) */
 Xt *saved_ip;  Xt *saved_ip;
 Cell *rp;  Cell *rp;
 #endif  #endif /* !defined(GLOBALS_NONRELOC) */
   #endif /* !defined(GFORTH_DEBUGGING) */
   
 #ifdef NO_IP  #ifdef NO_IP
 Label next_code;  Label next_code;
Line 188 
Line 178 
 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 (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 202 
Line 200 
 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 211 
Line 208 
 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 230 
Line 228 
 #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 401 
Line 403 
             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 495 
Line 498 
   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 519 
Line 522 
 #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 526 
Line 532 
 #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);
   r = mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0);    r = mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE|map_noreserve, -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 544 
Line 550 
               strerror(errno));                strerror(errno));
   } else {    } else {
     debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size);      debugp(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, dev_zero, 0);      r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE|map_noreserve, 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)  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 587 
Line 593 
   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, 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 633 
Line 639 
   fsize=maxaligned(fsize);    fsize=maxaligned(fsize);
 }  }
   
   #ifdef STANDALONE
   void alloc_stacks(ImageHeader * h)
   {
   #define SSTACKSIZE 0x200
     static Cell dstack[SSTACKSIZE+1];
     static Cell rstack[SSTACKSIZE+1];
   
     h->dict_size=dictsize;
     h->data_stack_size=dsize;
     h->fp_stack_size=fsize;
     h->return_stack_size=rsize;
     h->locals_stack_size=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)  void alloc_stacks(ImageHeader * h)
 {  {
   h->dict_size=dictsize;    h->dict_size=dictsize;
Line 646 
Line 671 
     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 667 
Line 692 
   h->return_stack_base=gforth_alloc(rsize);    h->return_stack_base=gforth_alloc(rsize);
   h->locals_stack_base=gforth_alloc(lsize);    h->locals_stack_base=gforth_alloc(lsize);
 }  }
   #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 687 
Line 713 
   /* 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 722 
Line 748 
     /* 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 844 
Line 870 
     }      }
   }    }
   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 923 
Line 959 
 #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 940 
Line 976 
   /* 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 966 
Line 1002 
     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 981 
Line 1029 
     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 989 
Line 1039 
     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--;        relocs--;
       nonrelocs++;        nonrelocs++;
       continue;        continue;
Line 1000 
Line 1052 
       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 1021 
Line 1075 
           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 1044 
Line 1100 
 {  {
 #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 MAYBE_UNUSED 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
 static void append_jump(void)  static void append_jump(void)
 {  {
Line 1059 
Line 1133 
     code_here += pi->restlength;      code_here += pi->restlength;
     memcpy(code_here, goto_start, goto_len);      memcpy(code_here, goto_start, goto_len);
     code_here += goto_len;      code_here += goto_len;
       align_code();
     last_jump=0;      last_jump=0;
   }    }
 }  }
Line 1076 
Line 1151 
   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) {  
     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 1096 
Line 1170 
       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 1509 
Line 1612 
 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 1581 
Line 1684 
   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 1632 
Line 1747 
     }      }
   }    }
   /* 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 1685 
Line 1802 
     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 1723 
Line 1841 
     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 1769 
Line 1889 
 #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 1822 
Line 1942 
   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);
Line 1927 
Line 2048 
 }  }
 #endif  #endif
   
 #ifdef STANDALONE  #ifdef STANDALONE_ALLOC
 Address gforth_alloc(Cell size)  Address gforth_alloc(Cell size)
 {  {
   Address r;    Address r;
Line 1984 
Line 2105 
   ss_min_ls,    ss_min_ls,
   ss_min_lsu,    ss_min_lsu,
   ss_min_nexts,    ss_min_nexts,
     opt_code_block_size,
 };  };
   
   #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 2001 
Line 2124 
       {"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 2008 
Line 2132 
       {"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 2051 
Line 2177 
     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 2062 
Line 2189 
     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\
     --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\
   --die-on-signal                   exit instead of THROWing some signals\n\    --die-on-signal                   Exit instead of THROWing some signals\n\
   --dynamic                         use dynamic native code\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\    --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 2081 
Line 2209 
   --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-noequiv                     Automaton without state equivalence\n\
   --tpa-noautomaton                 dynamic programming only\n\    --tpa-noautomaton                 Dynamic programming only\n\
   --tpa-trace                       report new states etc.\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 2102 
Line 2232 
   }    }
 }  }
 #endif  #endif
   #endif
   
 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 2124 
Line 2252 
 #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 2133 
Line 2261 
 #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 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 2192 
Line 2313 
   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. */  
   __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");  
   /* this is unusable with Linux' libc.4.6.27, because this library is  
      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
   #ifdef LTDL_LIBRARY_PATH
     setenv("LTDL_LIBRARY_PATH", LTDL_LIBRARY_PATH, 0);
   #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 2210 
Line 2335 
     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 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
   init_ss_cost();    init_ss_cost();
 #endif /* !defined(NO_DYNAMIC) */  #endif /* !defined(NO_DYNAMIC) */
 #endif /* defined(HAS_OS) */  #endif /* defined(HAS_OS) */
   #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 2252 
Line 2389 
         *p2 = *p1;          *p2 = *p1;
     *p2='\0';      *p2='\0';
     retvalue = gforth_go(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
     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.177  
changed lines
  Added in v.1.224
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help