[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.139 and 1.145

version 1.139, Tue Jan 20 19:07:41 2004 UTC version 1.145, Sat Jan 22 16:39:59 2005 UTC
Line 1 
Line 1 
 /* command line interpretation, image loading etc. for Gforth  /* command line interpretation, image loading etc. for Gforth
   
   
   Copyright (C) 1995,1996,1997,1998,2000,2003 Free Software Foundation, Inc.    Copyright (C) 1995,1996,1997,1998,2000,2003,2004 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
Line 70 
Line 70 
   
 void engine_callback(Xt* fcall, void * alist)  void engine_callback(Xt* fcall, void * alist)
 {  {
     /* save global valiables */
     Cell *rp = RP;
     Cell *sp = SP;
     Float *fp = FP;
     Address lp = LP;
   
   clist = (va_alist)alist;    clist = (va_alist)alist;
   engine(fcall, SP, RP, FP, LP);  
     engine(fcall, sp, rp, fp, lp);
   
     /* restore global variables */
     RP = rp;
     SP = sp;
     FP = fp;
     LP = lp;
 }  }
 #endif  #endif
   
Line 157 
Line 170 
 #define MAX_STATE 4 /* maximum number of states */  #define MAX_STATE 4 /* maximum number of states */
 static int maxstates = MAX_STATE; /* number of states for stack caching */  static int maxstates = MAX_STATE; /* number of states for stack caching */
 static int ss_greedy = 0; /* if true: use greedy, not optimal ss selection */  static int ss_greedy = 0; /* if true: use greedy, not optimal ss selection */
   static int diag = 0; /* if true: print diagnostic informations */
   static int relocs = 0;
   static int nonrelocs = 0;
   
 #ifdef HAS_DEBUG  #ifdef HAS_DEBUG
 int debug=0;  int debug=0;
   # define debugp(x...) if (debug) fprintf(x);
 #else  #else
 # define perror(x...)  # define perror(x...)
 # define fprintf(x...)  # define fprintf(x...)
   # define debugp(x...)
 #endif  #endif
   
 ImageHeader *gforth_header;  ImageHeader *gforth_header;
Line 427 
Line 445 
     exit(1);      exit(1);
   }    }
   r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));    r = (Address)((((Cell)r)+(sizeof(Float)-1))&(-sizeof(Float)));
   if (debug)    debugp(stderr, "malloc succeeds, address=$%lx\n", (long)r);
     fprintf(stderr, "malloc succeeds, address=$%lx\n", (long)r);  
   return r;    return r;
 }  }
   
Line 436 
Line 453 
 void after_alloc(Address r, Cell size)  void after_alloc(Address r, Cell size)
 {  {
   if (r != (Address)-1) {    if (r != (Address)-1) {
     if (debug)      debugp(stderr, "success, address=$%lx\n", (long) r);
       fprintf(stderr, "success, address=$%lx\n", (long) r);  
     if (pagesize != 1)      if (pagesize != 1)
       next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */        next_address = (Address)(((((Cell)r)+size-1)&-pagesize)+2*pagesize); /* leave one page unmapped */
   } else {    } else {
     if (debug)      debugp(stderr, "failed: %s\n", strerror(errno));
       fprintf(stderr, "failed: %s\n", strerror(errno));  
   }    }
 }  }
   
Line 465 
Line 480 
   Address r;    Address r;
   
 #if defined(MAP_ANON)  #if defined(MAP_ANON)
   if (debug)    debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size);
     fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_ANON, ...); ", (long)next_address, (long)size);  
   r = mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0);    r = mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0);
 #else /* !defined(MAP_ANON) */  #else /* !defined(MAP_ANON) */
   /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are    /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are
Line 477 
Line 491 
     dev_zero = open("/dev/zero", O_RDONLY);      dev_zero = open("/dev/zero", O_RDONLY);
   if (dev_zero == -1) {    if (dev_zero == -1) {
     r = MAP_FAILED;      r = MAP_FAILED;
     if (debug)      debugp(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ",
       fprintf(stderr, "open(\"/dev/zero\"...) failed (%s), no mmap; ",  
               strerror(errno));                strerror(errno));
   } else {    } else {
     if (debug)      debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size);
       fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FILE, dev_zero, ...); ", (long)next_address, (long)size);  
     r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0);      r=mmap(next_address, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0);
   }    }
 #endif /* !defined(MAP_ANON) */  #endif /* !defined(MAP_ANON) */
Line 511 
Line 523 
 #if defined(HAVE_MMAP)  #if defined(HAVE_MMAP)
   if (offset==0) {    if (offset==0) {
     image=alloc_mmap(dictsize);      image=alloc_mmap(dictsize);
     if (debug)      debugp(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);
       fprintf(stderr,"try mmap($%lx, $%lx, ..., MAP_FIXED|MAP_FILE, imagefile, 0); ", (long)image, (long)imagesize);  
     image = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE, fileno(file), 0);      image = mmap(image, imagesize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FIXED|MAP_FILE|MAP_PRIVATE, fileno(file), 0);
     after_alloc(image,dictsize);      after_alloc(image,dictsize);
   }    }
Line 594 
Line 605 
     signal_data_stack[7]=throw_code;      signal_data_stack[7]=throw_code;
   
 #ifdef GFORTH_DEBUGGING  #ifdef GFORTH_DEBUGGING
     if (debug)      debugp(stderr,"\ncaught signal, throwing exception %d, ip=%p rp=%p\n",
       fprintf(stderr,"\ncaught signal, throwing exception %d, ip=%p rp=%p\n",  
               throw_code, saved_ip, rp);                throw_code, saved_ip, rp);
     if (rp <= orig_rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {      if (rp <= orig_rp0 && rp > (Cell *)(image_header->return_stack_base+5)) {
       /* no rstack overflow or underflow */        /* no rstack overflow or underflow */
Line 605 
Line 615 
     else /* I love non-syntactic ifdefs :-) */      else /* I love non-syntactic ifdefs :-) */
       rp0 = signal_return_stack+8;        rp0 = signal_return_stack+8;
 #else  /* !defined(GFORTH_DEBUGGING) */  #else  /* !defined(GFORTH_DEBUGGING) */
     if (debug)      debugp(stderr,"\ncaught signal, throwing exception %d\n", throw_code);
       fprintf(stderr,"\ncaught signal, throwing exception %d\n", throw_code);  
       rp0 = signal_return_stack+8;        rp0 = signal_return_stack+8;
 #endif /* !defined(GFORTH_DEBUGGING) */  #endif /* !defined(GFORTH_DEBUGGING) */
     /* fprintf(stderr, "rp=$%x\n",rp0);*/      /* fprintf(stderr, "rp=$%x\n",rp0);*/
Line 634 
Line 643 
   
 /* static superinstruction stuff */  /* static superinstruction stuff */
   
 struct cost {  struct cost { /* super_info might be a more accurate name */
   char loads;       /* number of stack loads */    char loads;       /* number of stack loads */
   char stores;      /* number of stack stores */    char stores;      /* number of stack stores */
   char updates;     /* number of stack pointer updates */    char updates;     /* number of stack pointer updates */
   char branch;      /* is it a branch (SET_IP) */    char branch;      /* is it a branch (SET_IP) */
   unsigned char state_in;    /* state on entry */    unsigned char state_in;    /* state on entry */
   unsigned char state_out;   /* state on exit */    unsigned char state_out;   /* state on exit */
     unsigned char imm_ops;     /* number of immediate operands */
   short offset;     /* offset into super2 table */    short offset;     /* offset into super2 table */
   unsigned char length;      /* number of components */    unsigned char length;      /* number of components */
 };  };
Line 732 
Line 742 
         nsupers++;          nsupers++;
     }      }
   }    }
   if (debug)    debugp(stderr, "Using %d static superinsts\n", nsupers);
     fprintf(stderr, "Using %d static superinsts\n", nsupers);  
 }  }
   
 /* dynamic replication/superinstruction stuff */  /* dynamic replication/superinstruction stuff */
Line 839 
Line 848 
       pi->length = prim_len;        pi->length = prim_len;
     pi->restlength = endlabel - symbols1[i] - pi->length;      pi->restlength = endlabel - symbols1[i] - pi->length;
     pi->nimmargs = 0;      pi->nimmargs = 0;
     if (debug)      relocs++;
       fprintf(stderr, "%-15s %3d %p %p %p len=%3ld restlen=%2ld s-end=%1d",      debugp(stderr, "%-15s %3d %p %p %p len=%3ld restlen=%2ld s-end=%1d",
               prim_names[i], i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength), pi->superend);                prim_names[i], i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength), pi->superend);
     if (endlabel == NULL) {      if (endlabel == NULL) {
       pi->start = NULL; /* not relocatable */        pi->start = NULL; /* not relocatable */
       if (pi->length<0) pi->length=100;        if (pi->length<0) pi->length=100;
       if (debug)        debugp(stderr,"\n   non_reloc: no J label > start found\n");
         fprintf(stderr,"\n   non_reloc: no J label > start found\n");        relocs--;
         nonrelocs++;
       continue;        continue;
     }      }
     if (ends1[i] > endlabel && !pi->superend) {      if (ends1[i] > endlabel && !pi->superend) {
       pi->start = NULL; /* not relocatable */        pi->start = NULL; /* not relocatable */
       pi->length = endlabel-symbols1[i];        pi->length = endlabel-symbols1[i];
       if (debug)        debugp(stderr,"\n   non_reloc: there is a J label before the K label (restlength<0)\n");
         fprintf(stderr,"\n   non_reloc: there is a J label before the K label (restlength<0)\n");        relocs--;
         nonrelocs++;
       continue;        continue;
     }      }
     if (ends1[i] < pi->start && !pi->superend) {      if (ends1[i] < pi->start && !pi->superend) {
       pi->start = NULL; /* not relocatable */        pi->start = NULL; /* not relocatable */
       pi->length = endlabel-symbols1[i];        pi->length = endlabel-symbols1[i];
       if (debug)        debugp(stderr,"\n   non_reloc: K label before I label (length<0)\n");
         fprintf(stderr,"\n   non_reloc: K label before I label (length<0)\n");        relocs--;
         nonrelocs++;
       continue;        continue;
     }      }
     assert(pi->length>=0);      assert(pi->length>=0);
Line 869 
Line 881 
       if (s1[j]==s3[j]) {        if (s1[j]==s3[j]) {
         if (s1[j] != s2[j]) {          if (s1[j] != s2[j]) {
           pi->start = NULL; /* not relocatable */            pi->start = NULL; /* not relocatable */
           if (debug)            debugp(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);
             fprintf(stderr,"\n   non_reloc: engine1!=engine2 offset %3d",j);  
           /* assert(j<prim_len); */            /* assert(j<prim_len); */
             relocs--;
             nonrelocs++;
           break;            break;
         }          }
         j++;          j++;
Line 882 
Line 895 
         ia->offset=j;          ia->offset=j;
         if ((~*(Cell *)&(s1[j]))==*(Cell *)&(s3[j])) {          if ((~*(Cell *)&(s1[j]))==*(Cell *)&(s3[j])) {
           ia->rel=0;            ia->rel=0;
           if (debug)            debugp(stderr,"\n   absolute immarg: offset %3d",j);
             fprintf(stderr,"\n   absolute immarg: offset %3d",j);  
         } else if ((&(s1[j]))+(*(Cell *)&(s1[j]))+4 ==          } else if ((&(s1[j]))+(*(Cell *)&(s1[j]))+4 ==
                    symbols1[DOESJUMP+1]) {                     symbols1[DOESJUMP+1]) {
           ia->rel=1;            ia->rel=1;
           if (debug)            debugp(stderr,"\n   relative immarg: offset %3d",j);
             fprintf(stderr,"\n   relative immarg: offset %3d",j);  
         } else {          } else {
           pi->start = NULL; /* not relocatable */            pi->start = NULL; /* not relocatable */
           if (debug)            debugp(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);
             fprintf(stderr,"\n   non_reloc: engine1!=engine3 offset %3d",j);  
           /* assert(j<prim_len);*/            /* assert(j<prim_len);*/
             relocs--;
             nonrelocs++;
           break;            break;
         }          }
         j+=4;          j+=4;
       }        }
     }      }
     if (debug)      debugp(stderr,"\n");
       fprintf(stderr,"\n");  
   }    }
   decomp_prims = calloc(i,sizeof(PrimInfo *));    decomp_prims = calloc(i,sizeof(PrimInfo *));
   for (i=DOESJUMP+1; i<npriminfos; i++)    for (i=DOESJUMP+1; i<npriminfos; i++)
Line 1508 
Line 1519 
 #elif PAGESIZE  #elif PAGESIZE
   pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */    pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */
 #endif  #endif
   if (debug)    debugp(stderr,"pagesize=%ld\n",(unsigned long) pagesize);
     fprintf(stderr,"pagesize=%ld\n",(unsigned long) pagesize);  
   
   image = dict_alloc_read(imagefile, preamblesize+header.image_size,    image = dict_alloc_read(imagefile, preamblesize+header.image_size,
                           preamblesize+dictsize, data_offset);                            preamblesize+dictsize, data_offset);
Line 1684 
Line 1694 
       {"clear-dictionary", no_argument, &clear_dictionary, 1},        {"clear-dictionary", no_argument, &clear_dictionary, 1},
       {"die-on-signal", no_argument, &die_on_signal, 1},        {"die-on-signal", no_argument, &die_on_signal, 1},
       {"debug", no_argument, &debug, 1},        {"debug", no_argument, &debug, 1},
         {"diag", no_argument, &diag, 1},
       {"no-super", no_argument, &no_super, 1},        {"no-super", no_argument, &no_super, 1},
       {"no-dynamic", no_argument, &no_dynamic, 1},        {"no-dynamic", no_argument, &no_dynamic, 1},
       {"dynamic", no_argument, &no_dynamic, 0},        {"dynamic", no_argument, &no_dynamic, 0},
Line 1735 
Line 1746 
   --clear-dictionary                Initialize the dictionary with 0 bytes\n\    --clear-dictionary                Initialize the dictionary with 0 bytes\n\
   -d SIZE, --data-stack-size=SIZE   Specify data stack size\n\    -d SIZE, --data-stack-size=SIZE   Specify data stack size\n\
   --debug                           Print debugging information during startup\n\    --debug                           Print debugging information during startup\n\
     --diag                            Print diagnostic information during startup\n\
   --die-on-signal                   exit instead of CATCHing some signals\n\    --die-on-signal                   exit instead of CATCHing some signals\n\
   --dynamic                         use dynamic native code\n\    --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\
Line 1767 
Line 1779 
 }  }
 #endif  #endif
   
   void print_diag()
   {
   
   #if !defined(HAVE_GETRUSAGE) || !defined(HAS_FFCALL)
     fprintf(stderr, "*** missing functionality ***\n"
   #ifndef HAVE_GETRUSAGE
             "    no getrusage -> CPUTIME broken\n"
   #endif
   #ifndef HAS_FFCALL
             "    no ffcall -> only old-style foreign function calls (no fflib.fs)\n"
   #endif
             );
   #endif
     if((relocs < nonrelocs) ||
   #if defined(BUGGY_LL_CMP) || defined(BUGGY_LL_MUL) || defined(BUGGY_LL_DIV) || defined(BUGGY_LL_ADD) || defined(BUGGY_LL_SHIFT) || defined(BUGGY_LL_D2F) || defined(BUGGY_LL_F2D)
        1
   #else
        0
   #endif
        )
       debugp(stderr, "relocs: %d:%d\n", relocs, nonrelocs);
       fprintf(stderr, "*** performance problems ***\n%s"
   #if defined(BUGGY_LL_CMP) || defined(BUGGY_LL_MUL) || defined(BUGGY_LL_DIV) || defined(BUGGY_LL_ADD) || defined(BUGGY_LL_SHIFT) || defined(BUGGY_LL_D2F) || defined(BUGGY_LL_F2D)
               "    double-cell integer type buggy ->\n        "
   #ifdef BUGGY_LL_CMP
               "CMP, "
   #endif
   #ifdef BUGGY_LL_MUL
               "MUL, "
   #endif
   #ifdef BUGGY_LL_DIV
               "DIV, "
   #endif
   #ifdef BUGGY_LL_ADD
               "ADD, "
   #endif
   #ifdef BUGGY_LL_SHIFT
               "SHIFT, "
   #endif
   #ifdef BUGGY_LL_D2F
               "D2F, "
   #endif
   #ifdef BUGGY_LL_F2D
               "F2D, "
   #endif
               "\b\b slow\n"
   #endif
   #ifndef FORCE_REG
               "    automatic register allocation: performance degradation possible\n"
   #endif
   #if !defined(FORCE_REG) || defined(BUGGY_LONG_LONG)
               "*** Suggested remedy: try ./configure"
   #ifndef FORCE_REG
               " --enable-force-reg"
   #endif
   #ifdef BUGGY_LONG_LONG
               " --enable-force-ll"
   #endif
               "\n"
   #endif
               ,
               (relocs < nonrelocs) ? "    gcc PR 15242 -> no dynamic code generation (use gcc-2.95 instead)\n" : "");
   }
   
 #ifdef INCLUDE_IMAGE  #ifdef INCLUDE_IMAGE
 extern Cell image[];  extern Cell image[];
 extern const char reloc_bits[];  extern const char reloc_bits[];
Line 1812 
Line 1888 
   if (no_dynamic && ss_cost == cost_codesize) {    if (no_dynamic && ss_cost == cost_codesize) {
     ss_cost = cost_nexts;      ss_cost = cost_nexts;
     cost_sums[0] = cost_sums[1]; /* don't use cost_codesize for print-metrics */      cost_sums[0] = cost_sums[1]; /* don't use cost_codesize for print-metrics */
     if (debug)      debugp(stderr, "--no-dynamic conflicts with --ss-min-codesize, reverting to --ss-min-nexts\n");
       fprintf(stderr, "--no-dynamic conflicts with --ss-min-codesize, reverting to --ss-min-nexts\n");  
   }    }
 #endif /* !defined(NO_DYNAMIC) */  #endif /* !defined(NO_DYNAMIC) */
 #endif /* defined(HAS_OS) */  #endif /* defined(HAS_OS) */
Line 1830 
Line 1905 
 #endif  #endif
   gforth_header=(ImageHeader *)image; /* used in SIGSEGV handler */    gforth_header=(ImageHeader *)image; /* used in SIGSEGV handler */
   
     if (diag)
       print_diag();
   {    {
     char path2[strlen(path)+1];      char path2[strlen(path)+1];
     char *p1, *p2;      char *p1, *p2;

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help