[gforth] / gforth / engine / main.c  

gforth: gforth/engine/main.c

Diff for /gforth/engine/main.c between version 1.10 and 1.11

version 1.10, Sun Nov 8 23:08:05 1998 UTC version 1.11, Sun Nov 22 23:18:11 1998 UTC
Line 32 
Line 32 
 #include <fcntl.h>  #include <fcntl.h>
 #include <assert.h>  #include <assert.h>
 #include <stdlib.h>  #include <stdlib.h>
   #ifndef STANDALONE
 #if HAVE_SYS_MMAN_H  #if HAVE_SYS_MMAN_H
 #include <sys/mman.h>  #include <sys/mman.h>
 #endif  #endif
   #endif
 #include "forth.h"  #include "forth.h"
 #include "io.h"  #include "io.h"
 #include "getopt.h"  #include "getopt.h"
   #ifdef STANDALONE
   #include <systypes.h>
   #endif
   
 #define PRIM_VERSION 1  #define PRIM_VERSION 1
 /* increment this whenever the primitives change in an incompatible way */  /* increment this whenever the primitives change in an incompatible way */
Line 116 
Line 121 
 void relocate(Cell *image, const char *bitstring, int size, Label symbols[])  void relocate(Cell *image, const char *bitstring, int size, Label symbols[])
 {  {
   int i=0, j, k, steps=(size/sizeof(Cell))/8;    int i=0, j, k, steps=(size/sizeof(Cell))/8;
     Cell token;
   char bits;    char bits;
 /*   static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/  /*   static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/
   
Line 126 
Line 132 
       /*      fprintf(stderr,"relocate: image[%d]\n", i);*/        /*      fprintf(stderr,"relocate: image[%d]\n", i);*/
       if(bits & 0x80) {        if(bits & 0x80) {
         /* fprintf(stderr,"relocate: image[%d]=%d\n", i, image[i]);*/          /* fprintf(stderr,"relocate: image[%d]=%d\n", i, image[i]);*/
         if(image[i]<0)          if((token=image[i])<0)
           switch(image[i])            switch(token)
             {              {
             case CF_NIL      : image[i]=0; break;              case CF_NIL      : image[i]=0; break;
 #if !defined(DOUBLY_INDIRECT)  #if !defined(DOUBLY_INDIRECT)
Line 136 
Line 142 
             case CF(DOCON)   :              case CF(DOCON)   :
             case CF(DOUSER)  :              case CF(DOUSER)  :
             case CF(DODEFER) :              case CF(DODEFER) :
             case CF(DOFIELD) : MAKE_CF(image+i,symbols[CF(image[i])]); break;              case CF(DOFIELD) : MAKE_CF(image+i,symbols[CF(token)]); break;
             case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;              case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
 #endif /* !defined(DOUBLY_INDIRECT) */  #endif /* !defined(DOUBLY_INDIRECT) */
             case CF(DODOES)  :              case CF(DODOES)  :
Line 145 
Line 151 
             default          :              default          :
 /*            printf("Code field generation image[%x]:=CA(%x)\n",  /*            printf("Code field generation image[%x]:=CA(%x)\n",
                      i, CF(image[i])); */                       i, CF(image[i])); */
               image[i]=(Cell)CA(CF(image[i]));                image[i]=(Cell)CA(CF(token));
             }              }
         else          else
           image[i]+=(Cell)image;            image[i]+=(Cell)image;
Line 281 
Line 287 
   header->locals_stack_base=my_alloc(lsize);    header->locals_stack_base=my_alloc(lsize);
 }  }
   
   int go_forth(Address image, int stack, Cell *entries)
   {
     Cell *sp=(Cell*)(((ImageHeader *)image)->data_stack_base + dsize);
     Float *fp=(Float *)(((ImageHeader *)image)->fp_stack_base + fsize);
     Cell *rp=(Cell *)(((ImageHeader *)image)->return_stack_base + rsize);
     Address lp=((ImageHeader *)image)->locals_stack_base + lsize;
     Xt *ip=(Xt *)(((ImageHeader *)image)->boot_entry);
     int throw_code;
   
     /* ensure that the cached elements (if any) are accessible */
     IF_TOS(sp--);
     IF_FTOS(fp--);
   
     for(;stack>0;stack--)
       *--sp=entries[stack-1];
   
   #if !defined(MSDOS) && !defined(_WIN32) && !defined(__EMX__)
     get_winsize();
   #endif
   
     install_signal_handlers(); /* right place? */
   
     if ((throw_code=setjmp(throw_jmp_buf))) {
       static Cell signal_data_stack[8];
       static Cell signal_return_stack[8];
       static Float signal_fp_stack[1];
   
       signal_data_stack[7]=throw_code;
   
       return((int)engine(((ImageHeader *)image)->throw_entry,signal_data_stack+7,
                          signal_return_stack+8,signal_fp_stack,0));
     }
   
     return((int)engine(ip,sp,rp,fp,lp));
   }
   
   #ifndef INCLUDE_IMAGE
 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 386 
Line 429 
   return imp;    return imp;
 }  }
   
 int go_forth(Address image, int stack, Cell *entries)  
 {  
   Cell *sp=(Cell*)(((ImageHeader *)image)->data_stack_base + dsize);  
   Float *fp=(Float *)(((ImageHeader *)image)->fp_stack_base + fsize);  
   Cell *rp=(Cell *)(((ImageHeader *)image)->return_stack_base + rsize);  
   Address lp=((ImageHeader *)image)->locals_stack_base + lsize;  
   Xt *ip=(Xt *)(((ImageHeader *)image)->boot_entry);  
   int throw_code;  
   
   /* ensure that the cached elements (if any) are accessible */  
   IF_TOS(sp--);  
   IF_FTOS(fp--);  
   
   for(;stack>0;stack--)  
     *--sp=entries[stack-1];  
   
 #if !defined(MSDOS) && !defined(_WIN32) && !defined(__EMX__)  
   get_winsize();  
 #endif  
   
   install_signal_handlers(); /* right place? */  
   
   if ((throw_code=setjmp(throw_jmp_buf))) {  
     static Cell signal_data_stack[8];  
     static Cell signal_return_stack[8];  
     static Float signal_fp_stack[1];  
   
     signal_data_stack[7]=throw_code;  
   
     return((int)engine(((ImageHeader *)image)->throw_entry,signal_data_stack+7,  
                        signal_return_stack+8,signal_fp_stack,0));  
   }  
   
   return((int)engine(ip,sp,rp,fp,lp));  
 }  
   
 UCell convsize(char *s, UCell elemsize)  
 /* converts s of the format [0-9]+[bekMGT]? (e.g. 25k) into the number  
    of bytes.  the letter at the end indicates the unit, where e stands  
    for the element size. default is e */  
 {  
   char *endp;  
   UCell n,m;  
   
   m = elemsize;  
   n = strtoul(s,&endp,0);  
   if (endp!=NULL) {  
     if (strcmp(endp,"b")==0)  
       m=1;  
     else if (strcmp(endp,"k")==0)  
       m=1024;  
     else if (strcmp(endp,"M")==0)  
       m=1024*1024;  
     else if (strcmp(endp,"G")==0)  
       m=1024*1024*1024;  
     else if (strcmp(endp,"T")==0) {  
 #if (SIZEOF_CHAR_P > 4)  
       m=1024*1024*1024*1024;  
 #else  
       fprintf(stderr,"%s: size specification \"%s\" too large for this machine\n", progname, endp);  
       exit(1);  
 #endif  
     } else if (strcmp(endp,"e")!=0 && strcmp(endp,"")!=0) {  
       fprintf(stderr,"%s: cannot grok size specification %s: invalid unit \"%s\"\n", progname, s, endp);  
       exit(1);  
     }  
   }  
   return n*m;  
 }  
   
 int onlypath(char *file)  int onlypath(char *file)
 {  {
   int i;    int i;
Line 518 
Line 491 
   
   return image_file;    return image_file;
 }  }
   #endif
   
   #ifdef HAS_OS
   UCell convsize(char *s, UCell elemsize)
   /* converts s of the format [0-9]+[bekMGT]? (e.g. 25k) into the number
      of bytes.  the letter at the end indicates the unit, where e stands
      for the element size. default is e */
   {
     char *endp;
     UCell n,m;
   
     m = elemsize;
     n = strtoul(s,&endp,0);
     if (endp!=NULL) {
       if (strcmp(endp,"b")==0)
         m=1;
       else if (strcmp(endp,"k")==0)
         m=1024;
       else if (strcmp(endp,"M")==0)
         m=1024*1024;
       else if (strcmp(endp,"G")==0)
         m=1024*1024*1024;
       else if (strcmp(endp,"T")==0) {
   #if (SIZEOF_CHAR_P > 4)
         m=1024*1024*1024*1024;
   #else
         fprintf(stderr,"%s: size specification \"%s\" too large for this machine\n", progname, endp);
         exit(1);
   #endif
       } else if (strcmp(endp,"e")!=0 && strcmp(endp,"")!=0) {
         fprintf(stderr,"%s: cannot grok size specification %s: invalid unit \"%s\"\n", progname, s, endp);
         exit(1);
       }
     }
     return n*m;
   }
   
 void gforth_args(int argc, char ** argv, char ** path, char ** imagename)  void gforth_args(int argc, char ** argv, char ** path, char ** imagename)
 {  {
Line 589 
Line 598 
     }      }
   }    }
 }  }
   #endif
   
 #ifdef INCLUDE_IMAGE  #ifdef INCLUDE_IMAGE
 extern Cell image[];  extern Cell image[];
Line 616 
Line 626 
 #endif  #endif
   
   /* buffering of the user output device */    /* buffering of the user output device */
   #ifdef _IONBF
   if (isatty(fileno(stdout))) {    if (isatty(fileno(stdout))) {
     fflush(stdout);      fflush(stdout);
     setvbuf(stdout,NULL,_IONBF,0);      setvbuf(stdout,NULL,_IONBF,0);
   }    }
   #endif
   
   progname = argv[0];    progname = argv[0];
   
   #ifdef HAS_OS
   gforth_args(argc, argv, &path, &imagename);    gforth_args(argc, argv, &path, &imagename);
   #endif
   
 #ifdef INCLUDE_IMAGE  #ifdef INCLUDE_IMAGE
   set_stack_sizes((ImageHeader *)image);    set_stack_sizes((ImageHeader *)image);


Generate output suitable for use with a patch program
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help