[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.110 and 1.125

version 1.110, Wed May 14 09:25:10 2003 UTC version 1.125, Thu Oct 16 18:48:03 2003 UTC
Line 47 
Line 47 
 #include <systypes.h>  #include <systypes.h>
 #endif  #endif
   
   typedef enum prim_num {
   /* definitions of N_execute etc. */
   #include "prim_num.i"
     N_START_SUPER
   } PrimNum;
   
 /* global variables for engine.c  /* 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. */
Line 54 
Line 60 
 Float *FP;  Float *FP;
 Address UP=NULL;  Address UP=NULL;
   
   #ifdef HAS_FFCALL
   Cell *RP;
   Address LP;
   
   #include <callback.h>
   
   va_alist clist;
   
   void engine_callback(Xt* fcall, void * alist)
   {
     clist = (va_alist)alist;
     engine(fcall, SP, RP, FP, LP);
   }
   #endif
   
 #ifdef GFORTH_DEBUGGING  #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
Line 133 
Line 154 
                                              dynamically */                                               dynamically */
 static int print_metrics=0; /* if true, print metrics on exit */  static int print_metrics=0; /* if true, print metrics on exit */
 static int static_super_number = 10000000; /* number of ss used if available */  static int static_super_number = 10000000; /* number of ss used if available */
   #define MAX_STATE 4 /* maximum number of states */
   static int maxstates = MAX_STATE; /* number of states for stack caching */
 static int ss_greedy = 0; /* if true: use greedy, not optimal ss selection */  static int ss_greedy = 0; /* if true: use greedy, not optimal ss selection */
   
 #ifdef HAS_DEBUG  #ifdef HAS_DEBUG
Line 148 
Line 171 
 Label *xts; /* same content as vm_prims, but should only be used for xts */  Label *xts; /* same content as vm_prims, but should only be used for xts */
 #endif  #endif
   
   #ifndef NO_DYNAMIC
   #define MAX_IMMARGS 2
   
   typedef struct {
     Label start; /* NULL if not relocatable */
     Cell length; /* only includes the jump iff superend is true*/
     Cell restlength; /* length of the rest (i.e., the jump or (on superend) 0) */
     char superend; /* true if primitive ends superinstruction, i.e.,
                        unconditional branch, execute, etc. */
     Cell nimmargs;
     struct immarg {
       Cell offset; /* offset of immarg within prim */
       char rel;    /* true if immarg is relative */
     } immargs[MAX_IMMARGS];
   } PrimInfo;
   
   PrimInfo *priminfos;
   PrimInfo **decomp_prims;
   
   static int is_relocatable(int p)
   {
     return !no_dynamic && priminfos[p].start != NULL;
   }
   #else /* defined(NO_DYNAMIC) */
   static int is_relocatable(int p)
   {
     return 0;
   }
   #endif /* defined(NO_DYNAMIC) */
   
 #ifdef MEMCMP_AS_SUBROUTINE  #ifdef MEMCMP_AS_SUBROUTINE
 int gforth_memcmp(const char * s1, const char * s2, size_t n)  int gforth_memcmp(const char * s1, const char * s2, size_t n)
 {  {
Line 155 
Line 208 
 }  }
 #endif  #endif
   
   static Cell max(Cell a, Cell b)
   {
     return a>b?a:b;
   }
   
   static Cell min(Cell a, Cell b)
   {
     return a<b?a:b;
   }
   
 /* image file format:  /* image file format:
  *  "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n")   *  "#! binary-path -i\n" (e.g., "#! /usr/local/bin/gforth-0.4.0 -i\n")
  *   padding to a multiple of 8   *   padding to a multiple of 8
Line 186 
Line 249 
  * bits 8..0 of a primitive token index into the group   * bits 8..0 of a primitive token index into the group
  */   */
   
 static Cell groups[32] = {  Cell groups[32] = {
   0,    0,
     0
 #undef GROUP  #undef GROUP
 #define GROUP(x, n) DOESJUMP+1+n,  #undef GROUPADD
   #define GROUPADD(n) +n
   #define GROUP(x, n) , 0
 #include "prim_grp.i"  #include "prim_grp.i"
 #undef GROUP  #undef GROUP
   #undef GROUPADD
 #define GROUP(x, n)  #define GROUP(x, n)
   #define GROUPADD(n)
 };  };
   
 void relocate(Cell *image, const char *bitstring,  unsigned char *branch_targets(Cell *image, const unsigned char *bitstring,
                                 int size, Cell base)
        /* produce a bitmask marking all the branch targets */
   {
     int i=0, j, k, steps=(size/sizeof(Cell))/RELINFOBITS;
     Cell token;
     unsigned char bits;
     unsigned char *result=malloc(steps+1);
   
     memset(result, 0, steps+1);
     for(k=0; k<=steps; k++) {
       for(j=0, bits=bitstring[k]; j<RELINFOBITS; j++, i++, bits<<=1) {
         if((i < size) && (bits & (1U << (RELINFOBITS-1)))) {
           token=image[i];
           if (token>=base) { /* relocatable address */
             UCell bitnum=(token-base)/sizeof(Cell);
             result[bitnum/RELINFOBITS] |= 1U << ((~bitnum)&(RELINFOBITS-1));
           }
         }
       }
     }
     return result;
   }
   
   void relocate(Cell *image, const unsigned char *bitstring,
               int size, Cell base, Label symbols[])                int size, Cell base, Label symbols[])
 {  {
   int i=0, j, k, steps=(size/sizeof(Cell))/RELINFOBITS;    int i=0, j, k, steps=(size/sizeof(Cell))/RELINFOBITS;
Line 207 
Line 299 
    * the one in the image     * the one in the image
    */     */
   Cell *start = (Cell * ) (((void *) image) - ((void *) base));    Cell *start = (Cell * ) (((void *) image) - ((void *) base));
     unsigned char *targets = branch_targets(image, bitstring, size, base);
   
   /* group index into table */    /* group index into table */
     if(groups[31]==0) {
       int groupsum=0;
       for(i=0; i<32; i++) {
         groupsum += groups[i];
         groups[i] = groupsum;
         /* printf("group[%d]=%d\n",i,groupsum); */
       }
       i=0;
     }
   
 /* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */  /* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */
   
   for (max_symbols=DOESJUMP+1; symbols[max_symbols]!=0; max_symbols++)    for (max_symbols=0; symbols[max_symbols]!=0; max_symbols++)
     ;      ;
   max_symbols--;    max_symbols--;
   size/=sizeof(Cell);    size/=sizeof(Cell);
Line 246 
Line 348 
               if (CF((token | 0x4000))<max_symbols) {                if (CF((token | 0x4000))<max_symbols) {
                 image[i]=(Cell)CFA(CF(token));                  image[i]=(Cell)CFA(CF(token));
 #ifdef DIRECT_THREADED  #ifdef DIRECT_THREADED
                 if ((token & 0x4000) == 0) /* threade code, no CFA */                  if ((token & 0x4000) == 0) { /* threade code, no CFA */
                     if (targets[k] & (1U<<(RELINFOBITS-1-j)))
                       compile_prim1(0);
                   compile_prim1(&image[i]);                    compile_prim1(&image[i]);
                   }
 #endif  #endif
               } else                } else
                 fprintf(stderr,"Primitive %ld used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n",(long)CF(token),(long)&image[i],PACKAGE_VERSION);                  fprintf(stderr,"Primitive %ld used in this image at $%lx (offset $%x) is not implemented by this\n engine (%s); executing this code will crash.\n",(long)CF(token),(long)&image[i], i, PACKAGE_VERSION);
             }              }
           } else {            } else {
             int tok = -token & 0x1FF;              int tok = -token & 0x1FF;
Line 261 
Line 366 
               image[i]=(Cell)CFA((groups[group]+tok));                image[i]=(Cell)CFA((groups[group]+tok));
 #endif  #endif
 #ifdef DIRECT_THREADED  #ifdef DIRECT_THREADED
               if ((token & 0x4000) == 0) /* threade code, no CFA */                if ((token & 0x4000) == 0) { /* threade code, no CFA */
                   if (targets[k] & (1U<<(RELINFOBITS-1-j)))
                     compile_prim1(0);
                 compile_prim1(&image[i]);                  compile_prim1(&image[i]);
                 }
 #endif  #endif
             } else              } else
               fprintf(stderr,"Primitive %lx, %d of group %d used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n", (long)-token, tok, group, (long)&image[i],PACKAGE_VERSION);                fprintf(stderr,"Primitive %lx, %d of group %d used in this image at $%lx (offset $%x) is not implemented by this\n engine (%s); executing this code will crash.\n", (long)-token, tok, group, (long)&image[i],i,PACKAGE_VERSION);
           }            }
         } else {          } else {
           /* if base is > 0: 0 is a null reference so don't adjust*/            /* if base is > 0: 0 is a null reference so don't adjust*/
Line 276 
Line 384 
       }        }
     }      }
   }    }
     free(targets);
   finish_code();    finish_code();
   ((ImageHeader*)(image))->base = (Address) image;    ((ImageHeader*)(image))->base = (Address) image;
 }  }
Line 383 
Line 492 
   Address r;    Address r;
   
   r=alloc_mmap(size);    r=alloc_mmap(size);
   if (r!=MAP_FAILED)    if (r!=(Address)MAP_FAILED)
     return r;      return r;
 #endif /* HAVE_MMAP */  #endif /* HAVE_MMAP */
   /* use malloc as fallback */    /* use malloc as fallback */
Line 403 
Line 512 
     after_alloc(image,dictsize);      after_alloc(image,dictsize);
   }    }
 #endif /* defined(HAVE_MMAP) */  #endif /* defined(HAVE_MMAP) */
   if (image == MAP_FAILED) {    if (image == (Address)MAP_FAILED) {
     image = my_alloc(dictsize+offset)+offset;      image = my_alloc(dictsize+offset)+offset;
     rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */      rewind(file);  /* fseek(imagefile,0L,SEEK_SET); */
     fread(image, 1, imagesize, file);      fread(image, 1, imagesize, file);
Line 524 
Line 633 
   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) */
     unsigned char state_in;    /* state on entry */
     unsigned char state_out;   /* state on exit */
   short offset;      /* offset into super2 table */    short offset;      /* offset into super2 table */
   char length;      /* number of components */    unsigned char length;      /* number of components */
 };  };
   
 short super2[] = {  PrimNum super2[] = {
 #include "super2.i"  #include "super2.i"
 };  };
   
Line 536 
Line 648 
 #include "costs.i"  #include "costs.i"
 };  };
   
   struct super_state {
     struct super_state *next;
     PrimNum super;
   };
   
 #define HASH_SIZE 256  #define HASH_SIZE 256
   
 struct super_table_entry {  struct super_table_entry {
   struct super_table_entry *next;    struct super_table_entry *next;
   short *start;    PrimNum *start;
   short length;    short length;
   short super;    struct super_state *ss_list; /* list of supers */
 } *super_table[HASH_SIZE];  } *super_table[HASH_SIZE];
 int max_super=2;  int max_super=2;
   
 int hash_super(short *start, int length)  struct super_state *state_transitions=NULL;
   
   int hash_super(PrimNum *start, int length)
 {  {
   int i, r;    int i, r;
   
Line 557 
Line 676 
   return r & (HASH_SIZE-1);    return r & (HASH_SIZE-1);
 }  }
   
 int lookup_super(short *start, int length)  struct super_state **lookup_super(PrimNum *start, int length)
 {  {
   int hash=hash_super(start,length);    int hash=hash_super(start,length);
   struct super_table_entry *p = super_table[hash];    struct super_table_entry *p = super_table[hash];
   
   assert(length >= 2);    /* assert(length >= 2); */
   for (; p!=NULL; p = p->next) {    for (; p!=NULL; p = p->next) {
     if (length == p->length &&      if (length == p->length &&
         memcmp((char *)p->start, (char *)start, length*sizeof(short))==0)          memcmp((char *)p->start, (char *)start, length*sizeof(PrimNum))==0)
       return p->super;        return &(p->ss_list);
   }    }
   return -1;    return NULL;
 }  }
   
 void prepare_super_table()  void prepare_super_table()
Line 578 
Line 697 
   
   for (i=0; i<sizeof(super_costs)/sizeof(super_costs[0]); i++) {    for (i=0; i<sizeof(super_costs)/sizeof(super_costs[0]); i++) {
     struct cost *c = &super_costs[i];      struct cost *c = &super_costs[i];
     if (c->length > 1 && nsupers < static_super_number) {      if ((c->length < 2 || nsupers < static_super_number) &&
           c->state_in < maxstates && c->state_out < maxstates) {
         struct super_state **ss_listp= lookup_super(super2+c->offset, c->length);
         struct super_state *ss = malloc(sizeof(struct super_state));
         ss->super= i;
         if (c->offset==N_noop && i != N_noop) {
           if (is_relocatable(i)) {
             ss->next = state_transitions;
             state_transitions = ss;
           }
         } else if (ss_listp != NULL) {
           ss->next = *ss_listp;
           *ss_listp = ss;
         } else {
       int hash = hash_super(super2+c->offset, c->length);        int hash = hash_super(super2+c->offset, c->length);
       struct super_table_entry **p = &super_table[hash];        struct super_table_entry **p = &super_table[hash];
       struct super_table_entry *e = malloc(sizeof(struct super_table_entry));        struct super_table_entry *e = malloc(sizeof(struct super_table_entry));
           ss->next = NULL;
       e->next = *p;        e->next = *p;
       e->start = super2 + c->offset;        e->start = super2 + c->offset;
       e->length = c->length;        e->length = c->length;
       e->super = i;          e->ss_list = ss;
       *p = e;        *p = e;
         }
       if (c->length > max_super)        if (c->length > max_super)
         max_super = c->length;          max_super = c->length;
         if (c->length >= 2)
       nsupers++;        nsupers++;
     }      }
   }    }
Line 598 
Line 733 
   
 /* dynamic replication/superinstruction stuff */  /* dynamic replication/superinstruction stuff */
   
 #define MAX_IMMARGS 2  
   
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
 typedef struct {  
   Label start;  
   Cell length; /* only includes the jump iff superend is true*/  
   Cell restlength; /* length of the rest (i.e., the jump or (on superend) 0) */  
   char superend; /* true if primitive ends superinstruction, i.e.,  
                      unconditional branch, execute, etc. */  
   Cell nimmargs;  
   struct immarg {  
     Cell offset; /* offset of immarg within prim */  
     char rel;    /* true if immarg is relative */  
   } immargs[MAX_IMMARGS];  
 } PrimInfo;  
   
 PrimInfo *priminfos;  
 PrimInfo **decomp_prims;  
   
 int compare_priminfo_length(const void *_a, const void *_b)  int compare_priminfo_length(const void *_a, const void *_b)
 {  {
   PrimInfo **a = (PrimInfo **)_a;    PrimInfo **a = (PrimInfo **)_a;
Line 629 
Line 746 
           of (char) and @ instead of >code-address */            of (char) and @ instead of >code-address */
     return (*b)->start - (*a)->start;      return (*b)->start - (*a)->start;
 }  }
   #endif /* !defined(NO_DYNAMIC) */
   
 static char superend[]={  static char MAYBE_UNUSED superend[]={
 #include "prim_superend.i"  #include "prim_superend.i"
 };  };
 #endif /* !defined(NO_DYNAMIC) */  
   
 Cell npriminfos=0;  Cell npriminfos=0;
   
   int compare_labels(const void *pa, const void *pb)
   {
     Label a = *(Label *)pa;
     Label b = *(Label *)pb;
     return a-b;
   }
   
   Label bsearch_next(Label key, Label *a, UCell n)
        /* a is sorted; return the label >=key that is the closest in a;
           return NULL if there is no label in a >=key */
   {
     int mid = (n-1)/2;
     if (n<1)
       return NULL;
     if (n == 1) {
       if (a[0] < key)
         return NULL;
       else
         return a[0];
     }
     if (a[mid] < key)
       return bsearch_next(key, a+mid+1, n-mid-1);
     else
       return bsearch_next(key, a, mid+1);
   }
   
 void check_prims(Label symbols1[])  void check_prims(Label symbols1[])
 {  {
   int i;    int i;
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   Label *symbols2, *symbols3, *ends1;    Label *symbols2, *symbols3, *ends1, *ends1j, *ends1jsorted;
     int nends1j;
 #endif  #endif
   
   if (debug)    if (debug)
Line 652 
Line 796 
 #define str(s) #s  #define str(s) #s
   fprintf(stderr, "Compiled with gcc-" xstr(__GNUC__) "." xstr(__GNUC_MINOR__) "\n");    fprintf(stderr, "Compiled with gcc-" xstr(__GNUC__) "." xstr(__GNUC_MINOR__) "\n");
 #endif  #endif
   for (i=DOESJUMP+1; symbols1[i+1]!=0; i++)    for (i=0; symbols1[i]!=0; i++)
     ;      ;
   npriminfos = i;    npriminfos = i;
   
Line 665 
Line 809 
 #else  #else
   symbols3=symbols1;    symbols3=symbols1;
 #endif  #endif
   ends1 = symbols1+i+1-DOESJUMP;    ends1 = symbols1+i+1;
     ends1j =   ends1+i;
     nends1j = i+1;
     ends1jsorted = (Label *)alloca(nends1j*sizeof(Label));
     memcpy(ends1jsorted,ends1j,nends1j*sizeof(Label));
     qsort(ends1jsorted, nends1j, sizeof(Label), compare_labels);
   
   priminfos = calloc(i,sizeof(PrimInfo));    priminfos = calloc(i,sizeof(PrimInfo));
   for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) {    for (i=0; symbols1[i]!=0; i++) {
     int prim_len = ends1[i]-symbols1[i];      int prim_len = ends1[i]-symbols1[i];
     PrimInfo *pi=&priminfos[i];      PrimInfo *pi=&priminfos[i];
     int j=0;      int j=0;
     char *s1 = (char *)symbols1[i];      char *s1 = (char *)symbols1[i];
     char *s2 = (char *)symbols2[i];      char *s2 = (char *)symbols2[i];
     char *s3 = (char *)symbols3[i];      char *s3 = (char *)symbols3[i];
       Label endlabel = bsearch_next(symbols1[i]+1,ends1jsorted,nends1j);
   
     pi->start = s1;      pi->start = s1;
     pi->superend = superend[i-DOESJUMP-1]|no_super;      pi->superend = superend[i]|no_super;
     if (pi->superend)      if (pi->superend)
       pi->length = symbols1[i+1]-symbols1[i];        pi->length = endlabel-symbols1[i];
     else      else
       pi->length = prim_len;        pi->length = prim_len;
     pi->restlength = symbols1[i+1] - symbols1[i] - pi->length;      pi->restlength = endlabel - symbols1[i] - pi->length;
     pi->nimmargs = 0;      pi->nimmargs = 0;
     if (debug)      if (debug)
       fprintf(stderr, "Prim %3d @ %p %p %p, length=%3ld restlength=%2ld superend=%1d",        fprintf(stderr, "Prim %3d @ %p %p %p, length=%3ld restlength=%2ld superend=%1d",
               i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength), pi->superend);                i, s1, s2, s3, (long)(pi->length), (long)(pi->restlength), pi->superend);
       if (endlabel == NULL) {
         pi->start = NULL; /* not relocatable */
         if (pi->length<0) pi->length=100;
         if (debug)
           fprintf(stderr,"\n   non_reloc: no J label > start found\n");
         continue;
       }
       if (ends1[i] > endlabel && !pi->superend) {
         pi->start = NULL; /* not relocatable */
         pi->length = endlabel-symbols1[i];
         if (debug)
           fprintf(stderr,"\n   non_reloc: there is a J label before the K label (restlength<0)\n");
         continue;
       }
       if (ends1[i] < pi->start && !pi->superend) {
         pi->start = NULL; /* not relocatable */
         pi->length = endlabel-symbols1[i];
         if (debug)
           fprintf(stderr,"\n   non_reloc: K label before I label (length<0)\n");
         continue;
       }
     assert(prim_len>=0);      assert(prim_len>=0);
       assert(pi->restlength >=0);
     while (j<(pi->length+pi->restlength)) {      while (j<(pi->length+pi->restlength)) {
       if (s1[j]==s3[j]) {        if (s1[j]==s3[j]) {
         if (s1[j] != s2[j]) {          if (s1[j] != s2[j]) {
Line 850 
Line 1023 
   for (i=npriminfos-1; i>DOESJUMP; i--) {    for (i=npriminfos-1; i>DOESJUMP; 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 pi->start;        return vm_prims[super2[super_costs[pi-priminfos].offset]];
       /* return pi->start;*/
   }    }
   return code;    return code;
 #endif /* !defined(NO_DYNAMIC) */  #endif /* !defined(NO_DYNAMIC) */
Line 870 
Line 1044 
   Cell *xt; /* cfa of word whose does-code needs calling */    Cell *xt; /* cfa of word whose does-code needs calling */
 } doesexecinfos[10000];  } doesexecinfos[10000];
   
 /* definitions of N_execute etc. */  
 #include "prim_num.i"  
   
 void set_rel_target(Cell *source, Label target)  void set_rel_target(Cell *source, Label target)
 {  {
   *source = ((Cell)target)-(((Cell)source)+4);    *source = ((Cell)target)-(((Cell)source)+4);
Line 958 
Line 1129 
       dei->branchinfo = nbranchinfos;        dei->branchinfo = nbranchinfos;
       dei->xt = (Cell *)(last_start[1]);        dei->xt = (Cell *)(last_start[1]);
       next_code_target = compile_call2(NULL);        next_code_target = compile_call2(NULL);
     } else if (pi->start == NULL) { /* non-reloc */      } else if (!is_relocatable(i)) {
       next_code_target = compile_prim1arg(N_set_next_code);        next_code_target = compile_prim1arg(N_set_next_code);
       set_rel_target(compile_prim1arg(N_abranch),*(Xt)last_prim);        set_rel_target(compile_prim1arg(N_abranch),*(Xt)last_prim);
     } else {      } else {
Line 994 
Line 1165 
     *start = (Cell)prim;      *start = (Cell)prim;
     return;      return;
   }    }
   if (i>=npriminfos || priminfos[i].start == 0) { /* not a relocatable prim */    if (i>=npriminfos || !is_relocatable(i)) {
     append_jump();      append_jump();
     *start = (Cell)prim;      *start = (Cell)prim;
     return;      return;
   }    }
   assert(priminfos[i].start = prim);  
 #ifdef ALIGN_CODE  #ifdef ALIGN_CODE
   /*  ALIGN_CODE;*/    /*  ALIGN_CODE;*/
 #endif  #endif
Line 1021 
Line 1191 
   
 Cell compile_prim_dyn(unsigned p)  Cell compile_prim_dyn(unsigned p)
 {  {
   Cell static_prim = (Cell)vm_prims[p+DOESJUMP+1];    Cell static_prim = (Cell)vm_prims[p];
 #if defined(NO_DYNAMIC)  #if defined(NO_DYNAMIC)
   return static_prim;    return static_prim;
 #else /* !defined(NO_DYNAMIC) */  #else /* !defined(NO_DYNAMIC) */
Line 1029 
Line 1199 
   
   if (no_dynamic)    if (no_dynamic)
     return static_prim;      return static_prim;
   p += DOESJUMP+1;    if (p>=npriminfos || !is_relocatable(p)) {
   if (p>=npriminfos || priminfos[p].start == 0) { /* not a relocatable prim */  
     append_jump();      append_jump();
     return static_prim;      return static_prim;
   }    }
Line 1043 
Line 1212 
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
 int cost_codesize(int prim)  int cost_codesize(int prim)
 {  {
   return priminfos[prim+DOESJUMP+1].length;    return priminfos[prim].length;
 }  }
 #endif  #endif
   
Line 1088 
Line 1257 
 };  };
   
 #define MAX_BB 128 /* maximum number of instructions in BB */  #define MAX_BB 128 /* maximum number of instructions in BB */
   #define INF_COST 1000000 /* infinite cost */
   #define CANONICAL_STATE 0
   
 /* use dynamic programming to find the shortest paths within the basic  struct waypoint {
    block origs[0..ninsts-1]; optimals[i] contains the superinstruction    int cost;     /* the cost from here to the end */
    on the shortest path to the end of the BB */    PrimNum inst; /* the inst used from here to the next waypoint */
 void optimize_bb(short origs[], short optimals[], int ninsts)    char relocatable; /* the last non-transition was relocatable */
     char no_transition; /* don't use the next transition (relocatability)
                          * or this transition (does not change state) */
   };
   
   void init_waypoints(struct waypoint ws[])
 {  {
   int i,j, mincost;    int k;
   static int costs[MAX_BB+1];  
   
   assert(ninsts<MAX_BB);    for (k=0; k<maxstates; k++)
   costs[ninsts]=0;      ws[k].cost=INF_COST;
   }
   
   void transitions(struct waypoint inst[], struct waypoint trans[])
   {
     int k;
     struct super_state *l;
   
     for (k=0; k<maxstates; k++) {
       trans[k] = inst[k];
       trans[k].no_transition = 1;
     }
     for (l = state_transitions; l != NULL; l = l->next) {
       PrimNum s = l->super;
       int jcost;
       struct cost *c=super_costs+s;
       struct waypoint *wi=&(trans[c->state_in]);
       struct waypoint *wo=&(inst[c->state_out]);
       if (wo->cost == INF_COST)
         continue;
       jcost = wo->cost + ss_cost(s);
       if (jcost <= wi->cost) {
         wi->cost = jcost;
         wi->inst = s;
         wi->relocatable = wo->relocatable;
         wi->no_transition = 0;
         /* if (ss_greedy) wi->cost = wo->cost ? */
       }
     }
   }
   
   /* use dynamic programming to find the shortest paths within the basic
      block origs[0..ninsts-1] and rewrite the instructions pointed to by
      instps to use it */
   void optimize_rewrite(Cell *instps[], PrimNum origs[], int ninsts)
   {
     int i,j;
     static struct waypoint inst[MAX_BB+1][MAX_STATE];  /* before instruction*/
     static struct waypoint trans[MAX_BB+1][MAX_STATE]; /* before transition */
     int nextdyn, nextstate, no_transition;
   
     init_waypoints(inst[ninsts]);
     inst[ninsts][CANONICAL_STATE].cost=0;
     transitions(inst[ninsts],trans[ninsts]);
   for (i=ninsts-1; i>=0; i--) {    for (i=ninsts-1; i>=0; i--) {
     optimals[i] = origs[i];      init_waypoints(inst[i]);
     costs[i] = mincost = costs[i+1] + ss_cost(optimals[i]);      for (j=1; j<=max_super && i+j<=ninsts; j++) {
     for (j=2; j<=max_super && i+j<=ninsts ; j++) {        struct super_state **superp = lookup_super(origs+i, j);
       int super, jcost;        if (superp!=NULL) {
           struct super_state *supers = *superp;
       super = lookup_super(origs+i,j);          for (; supers!=NULL; supers = supers->next) {
       if (super >= 0) {            PrimNum s = supers->super;
         jcost = costs[i+j] + ss_cost(super);            int jcost;
         if (jcost <= mincost) {            struct cost *c=super_costs+s;
           optimals[i] = super;            struct waypoint *wi=&(inst[i][c->state_in]);
           mincost = jcost;            struct waypoint *wo=&(trans[i+j][c->state_out]);
           if (!ss_greedy)            int no_transition = wo->no_transition;
             costs[i] = jcost;            if (!(is_relocatable(s)) && !wo->relocatable) {
               wo=&(inst[i+j][c->state_out]);
               no_transition=1;
             }
             if (wo->cost == INF_COST)
               continue;
             jcost = wo->cost + ss_cost(s);
             if (jcost <= wi->cost) {
               wi->cost = jcost;
               wi->inst = s;
               wi->relocatable = is_relocatable(s);
               wi->no_transition = no_transition;
               /* if (ss_greedy) wi->cost = wo->cost ? */
             }
           }
         }
       }
       transitions(inst[i],trans[i]);
     }
     /* now rewrite the instructions */
     nextdyn=0;
     nextstate=CANONICAL_STATE;
     no_transition = ((!trans[0][nextstate].relocatable)
                      ||trans[0][nextstate].no_transition);
     for (i=0; i<ninsts; i++) {
       Cell tc=0, tc2;
       if (i==nextdyn) {
         if (!no_transition) {
           /* process trans */
           PrimNum p = trans[i][nextstate].inst;
           struct cost *c = super_costs+p;
           assert(trans[i][nextstate].cost != INF_COST);
           assert(c->state_in==nextstate);
           tc = compile_prim_dyn(p);
           nextstate = c->state_out;
         }
         {
           /* process inst */
           PrimNum p = inst[i][nextstate].inst;
           struct cost *c=super_costs+p;
           assert(c->state_in==nextstate);
           assert(inst[i][nextstate].cost != INF_COST);
   #if defined(GFORTH_DEBUGGING)
           assert(p == origs[i]);
   #endif
           tc2 = compile_prim_dyn(p);
           if (no_transition || !is_relocatable(p))
             /* !! actually what we care about is if and where
              * compile_prim_dyn() puts NEXTs */
             tc=tc2;
           no_transition = inst[i][nextstate].no_transition;
           nextstate = c->state_out;
           nextdyn += c->length;
         }          }
       } else {
   #if defined(GFORTH_DEBUGGING)
         assert(0);
   #endif
         tc=0;
         /* tc= (Cell)vm_prims[inst[i][CANONICAL_STATE].inst]; */
       }        }
       *(instps[i]) = tc;
     }      }
     if (!no_transition) {
       PrimNum p = trans[i][nextstate].inst;
       struct cost *c = super_costs+p;
       assert(c->state_in==nextstate);
       assert(trans[i][nextstate].cost != INF_COST);
       assert(i==nextdyn);
       (void)compile_prim_dyn(p);
       nextstate = c->state_out;
   }    }
     assert(nextstate==CANONICAL_STATE);
 }  }
   
 /* rewrite the instructions pointed to by instps to use the  /* rewrite the instructions pointed to by instps to use the
    superinstructions in optimals */     superinstructions in optimals */
 void rewrite_bb(Cell *instps[], short *optimals, int ninsts)  static void rewrite_bb(Cell *instps[], PrimNum *optimals, int ninsts)
 {  {
   int i,j, nextdyn;    int i,j, nextdyn;
   Cell inst;    Cell inst;
Line 1133 
Line 1419 
       for (j=0; j<sizeof(cost_sums)/sizeof(cost_sums[0]); j++)        for (j=0; j<sizeof(cost_sums)/sizeof(cost_sums[0]); j++)
         cost_sums[j].sum += cost_sums[j].costfunc(optimals[i]);          cost_sums[j].sum += cost_sums[j].costfunc(optimals[i]);
     } else { /* compile statically */      } else { /* compile statically */
       inst = (Cell)vm_prims[optimals[i]+DOESJUMP+1];        inst = (Cell)vm_prims[optimals[i]];
     }      }
     *(instps[i]) = inst;      *(instps[i]) = inst;
   }    }
Line 1144 
Line 1430 
 void compile_prim1(Cell *start)  void compile_prim1(Cell *start)
 {  {
 #if defined(DOUBLY_INDIRECT)  #if defined(DOUBLY_INDIRECT)
   Label prim=(Label)*start;    Label prim;
   
     if (start==NULL)
       return;
     prim = (Label)*start;
   if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) {    if (prim<((Label)(xts+DOESJUMP)) || 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;
Line 1155 
Line 1445 
   }    }
 #elif defined(INDIRECT_THREADED)  #elif defined(INDIRECT_THREADED)
   return;    return;
 #else /* defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED) */  #else /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */
   static Cell *instps[MAX_BB];    static Cell *instps[MAX_BB];
   static short origs[MAX_BB];    static PrimNum origs[MAX_BB];
   static short optimals[MAX_BB];  
   static int ninsts=0;    static int ninsts=0;
   unsigned prim_num;    PrimNum prim_num;
   
   if (start==NULL)    if (start==NULL)
     goto end_bb;      goto end_bb;
Line 1169 
Line 1458 
     goto end_bb;      goto end_bb;
   assert(ninsts<MAX_BB);    assert(ninsts<MAX_BB);
   instps[ninsts] = start;    instps[ninsts] = start;
   origs[ninsts] = prim_num-DOESJUMP-1;    origs[ninsts] = prim_num;
   ninsts++;    ninsts++;
   if (ninsts >= MAX_BB || superend[prim_num-DOESJUMP-1]) {    if (ninsts >= MAX_BB || superend[prim_num]) {
   end_bb:    end_bb:
     optimize_bb(origs,optimals,ninsts);      optimize_rewrite(instps,origs,ninsts);
     rewrite_bb(instps,optimals,ninsts);  
     ninsts=0;      ninsts=0;
   }    }
 #endif /* defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED) */  #endif /* !(defined(DOUBLY_INDIRECT) || defined(INDIRECT_THREADED)) */
 }  }
   
 #if defined(PRINT_SUPER_LENGTHS) && !defined(NO_DYNAMIC)  
 Cell prim_length(Cell prim)  
 {  
   return priminfos[prim+DOESJUMP+1].length;  
 }  
 #endif  
   
 Address loader(FILE *imagefile, char* filename)  Address loader(FILE *imagefile, char* filename)
 /* returns the address of the image proper (after the preamble) */  /* returns the address of the image proper (after the preamble) */
 {  {
Line 1407 
Line 1688 
   
 enum {  enum {
   ss_number = 256,    ss_number = 256,
     ss_states,
   ss_min_codesize,    ss_min_codesize,
   ss_min_ls,    ss_min_ls,
   ss_min_lsu,    ss_min_lsu,
Line 1442 
Line 1724 
       {"dynamic", no_argument, &no_dynamic, 0},        {"dynamic", no_argument, &no_dynamic, 0},
       {"print-metrics", no_argument, &print_metrics, 1},        {"print-metrics", no_argument, &print_metrics, 1},
       {"ss-number", required_argument, NULL, ss_number},        {"ss-number", required_argument, NULL, ss_number},
         {"ss-states", required_argument, NULL, ss_states},
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
       {"ss-min-codesize", no_argument, NULL, ss_min_codesize},        {"ss-min-codesize", no_argument, NULL, ss_min_codesize},
 #endif  #endif
Line 1473 
Line 1756 
     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 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;
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
     case ss_min_codesize: ss_cost = cost_codesize; break;      case ss_min_codesize: ss_cost = cost_codesize; break;
 #endif  #endif
Line 1500 
Line 1784 
   -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\
   -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\
   -v, --version                     Print engine version and exit\n\    -v, --version                     Print engine version and exit\n\
 SIZE arguments consist of an integer followed by a unit. The unit can be\n\  SIZE arguments consist of an integer followed by a unit. The unit can be\n\
   `b' (byte), `e' (element; default), `k' (KB), `M' (MB), `G' (GB) or `T' (TB).\n",    `b' (byte), `e' (element; default), `k' (KB), `M' (MB), `G' (GB) or `T' (TB).\n",
Line 1560 
Line 1845 
   gforth_args(argc, argv, &path, &imagename);    gforth_args(argc, argv, &path, &imagename);
 #ifndef NO_DYNAMIC  #ifndef NO_DYNAMIC
   if (no_dynamic && ss_cost == cost_codesize) {    if (no_dynamic && ss_cost == cost_codesize) {
     ss_cost = cost_lsu;      ss_cost = cost_nexts;
     cost_sums[0] = cost_sums[1];      cost_sums[0] = cost_sums[1]; /* don't use cost_codesize for print-metrics */
     if (debug)      if (debug)
       fprintf(stderr, "--no-dynamic conflicts with --ss-min-codesize, reverting to --ss-min-lsu\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) */

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help