version 1.9, 1998/06/17 16:55:16
|
version 1.10, 1998/11/08 23:08:05
|
Line 113 typedef struct {
|
Line 113 typedef struct {
|
} ImageHeader; |
} ImageHeader; |
/* the image-header is created in main.fs */ |
/* the image-header is created in main.fs */ |
|
|
void relocate(Cell *image, 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; |
char bits; |
char bits; |
Line 248 Address my_alloc(Cell size)
|
Line 248 Address my_alloc(Cell size)
|
#define dict_alloc(size) my_alloc(size) |
#define dict_alloc(size) my_alloc(size) |
#endif |
#endif |
|
|
|
void set_stack_sizes(ImageHeader * header) |
|
{ |
|
if (dictsize==0) |
|
dictsize = header->dict_size; |
|
if (dsize==0) |
|
dsize = header->data_stack_size; |
|
if (rsize==0) |
|
rsize = header->return_stack_size; |
|
if (fsize==0) |
|
fsize = header->fp_stack_size; |
|
if (lsize==0) |
|
lsize = header->locals_stack_size; |
|
dictsize=maxaligned(dictsize); |
|
dsize=maxaligned(dsize); |
|
rsize=maxaligned(rsize); |
|
lsize=maxaligned(lsize); |
|
fsize=maxaligned(fsize); |
|
} |
|
|
|
void alloc_stacks(ImageHeader * header) |
|
{ |
|
header->dict_size=dictsize; |
|
header->data_stack_size=dsize; |
|
header->fp_stack_size=fsize; |
|
header->return_stack_size=rsize; |
|
header->locals_stack_size=lsize; |
|
|
|
header->data_stack_base=my_alloc(dsize); |
|
header->fp_stack_base=my_alloc(fsize); |
|
header->return_stack_base=my_alloc(rsize); |
|
header->locals_stack_base=my_alloc(lsize); |
|
} |
|
|
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 266 Address loader(FILE *imagefile, char* fi
|
Line 299 Address loader(FILE *imagefile, char* fi
|
#else /* defined(DOUBLY_INDIRECT) */ |
#else /* defined(DOUBLY_INDIRECT) */ |
check_sum = (UCell)symbols; |
check_sum = (UCell)symbols; |
#endif /* defined(DOUBLY_INDIRECT) */ |
#endif /* defined(DOUBLY_INDIRECT) */ |
|
|
do |
do { |
{ |
if(fread(magic,sizeof(Char),8,imagefile) < 8) { |
if(fread(magic,sizeof(Char),8,imagefile) < 8) { |
fprintf(stderr,"%s: image %s doesn't seem to be a Gforth (>=0.2) image.\n", |
fprintf(stderr,"%s: image %s doesn't seem to be a Gforth (>=0.2) image.\n", |
progname, filename); |
progname, filename); |
exit(1); |
exit(1); |
|
} |
|
preamblesize+=8; |
|
} |
} |
while(memcmp(magic,"Gforth1",7)); |
preamblesize+=8; |
|
} while(memcmp(magic,"Gforth1",7)); |
if (debug) { |
if (debug) { |
magic[8]='\0'; |
magic[8]='\0'; |
fprintf(stderr,"Magic found: %s\n", magic); |
fprintf(stderr,"Magic found: %s\n", magic); |
Line 302 Address loader(FILE *imagefile, char* fi
|
Line 333 Address loader(FILE *imagefile, char* fi
|
}; |
}; |
|
|
fread((void *)&header,sizeof(ImageHeader),1,imagefile); |
fread((void *)&header,sizeof(ImageHeader),1,imagefile); |
if (dictsize==0) |
|
dictsize = header.dict_size; |
set_stack_sizes(&header); |
if (dsize==0) |
|
dsize=header.data_stack_size; |
|
if (rsize==0) |
|
rsize=header.return_stack_size; |
|
if (fsize==0) |
|
fsize=header.fp_stack_size; |
|
if (lsize==0) |
|
lsize=header.locals_stack_size; |
|
dictsize=maxaligned(dictsize); |
|
dsize=maxaligned(dsize); |
|
rsize=maxaligned(rsize); |
|
lsize=maxaligned(lsize); |
|
fsize=maxaligned(fsize); |
|
|
|
#if HAVE_GETPAGESIZE |
#if HAVE_GETPAGESIZE |
pagesize=getpagesize(); /* Linux/GNU libc offers this */ |
pagesize=getpagesize(); /* Linux/GNU libc offers this */ |
Line 331 Address loader(FILE *imagefile, char* fi
|
Line 349 Address loader(FILE *imagefile, char* fi
|
image = dict_alloc(preamblesize+dictsize+data_offset)+data_offset; |
image = dict_alloc(preamblesize+dictsize+data_offset)+data_offset; |
rewind(imagefile); /* fseek(imagefile,0L,SEEK_SET); */ |
rewind(imagefile); /* fseek(imagefile,0L,SEEK_SET); */ |
if (clear_dictionary) |
if (clear_dictionary) |
memset(image,0,dictsize); |
memset(image, 0, dictsize); |
fread(image,1,preamblesize+header.image_size,imagefile); |
fread(image, 1, preamblesize+header.image_size, imagefile); |
imp=image+preamblesize; |
imp=image+preamblesize; |
if(header.base==0) { |
if(header.base==0) { |
Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1; |
Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1; |
char reloc_bits[reloc_size]; |
char reloc_bits[reloc_size]; |
fread(reloc_bits,1,reloc_size,imagefile); |
fread(reloc_bits, 1, reloc_size, imagefile); |
relocate((Cell *)imp,reloc_bits,header.image_size,symbols); |
relocate((Cell *)imp, reloc_bits, header.image_size, symbols); |
#if 0 |
#if 0 |
{ /* let's see what the relocator did */ |
{ /* let's see what the relocator did */ |
FILE *snapshot=fopen("snapshot.fi","wb"); |
FILE *snapshot=fopen("snapshot.fi","wb"); |
Line 361 Address loader(FILE *imagefile, char* fi
|
Line 379 Address loader(FILE *imagefile, char* fi
|
} |
} |
fclose(imagefile); |
fclose(imagefile); |
|
|
((ImageHeader *)imp)->dict_size=dictsize; |
alloc_stacks((ImageHeader *)imp); |
((ImageHeader *)imp)->data_stack_size=dsize; |
|
((ImageHeader *)imp)->fp_stack_size=fsize; |
|
((ImageHeader *)imp)->return_stack_size=rsize; |
|
((ImageHeader *)imp)->locals_stack_size=lsize; |
|
|
|
((ImageHeader *)imp)->data_stack_base=my_alloc(dsize); |
|
((ImageHeader *)imp)->fp_stack_base=my_alloc(fsize); |
|
((ImageHeader *)imp)->return_stack_base=my_alloc(rsize); |
|
((ImageHeader *)imp)->locals_stack_base=my_alloc(lsize); |
|
|
|
CACHE_FLUSH(imp, header.image_size); |
CACHE_FLUSH(imp, header.image_size); |
|
|
Line 448 UCell convsize(char *s, UCell elemsize)
|
Line 457 UCell convsize(char *s, UCell elemsize)
|
} |
} |
|
|
int onlypath(char *file) |
int onlypath(char *file) |
{ int i; |
{ |
|
int i; |
i=strlen(file); |
i=strlen(file); |
while (i) { if (file[i]=='\\' || file[i]=='/') break; |
while (i) { |
i--; } |
if (file[i]=='\\' || file[i]=='/') break; |
return (i); |
i--; |
|
} |
|
return i; |
} |
} |
|
|
FILE *openimage(char *fullfilename) |
FILE *openimage(char *fullfilename) |
{ FILE *image_file; |
{ |
|
FILE *image_file; |
|
|
image_file=fopen(fullfilename,"rb"); |
image_file=fopen(fullfilename,"rb"); |
if (image_file!=NULL && debug) |
if (image_file!=NULL && debug) |
fprintf(stderr, "Opened image file: %s\n", fullfilename); |
fprintf(stderr, "Opened image file: %s\n", fullfilename); |
return (image_file); |
return image_file; |
} |
} |
|
|
FILE *checkimage(char *path, int len, char *imagename) |
FILE *checkimage(char *path, int len, char *imagename) |
{ int dirlen=len; |
{ |
|
int dirlen=len; |
char fullfilename[dirlen+strlen(imagename)+2]; |
char fullfilename[dirlen+strlen(imagename)+2]; |
|
|
memcpy(fullfilename, path, dirlen); |
memcpy(fullfilename, path, dirlen); |
if (fullfilename[dirlen-1]!='/') |
if (fullfilename[dirlen-1]!='/') |
fullfilename[dirlen++]='/'; |
fullfilename[dirlen++]='/'; |
strcpy(fullfilename+dirlen,imagename); |
strcpy(fullfilename+dirlen,imagename); |
return (openimage(fullfilename)); |
return openimage(fullfilename); |
} |
} |
|
|
int main(int argc, char **argv, char **env) |
FILE * open_image_file(char * imagename, char * path) |
{ |
{ |
char *path, *path1; |
FILE * image_file=NULL; |
char *imagename="gforth.fi"; |
|
FILE *image_file; |
if(strchr(imagename, '/')==NULL) { |
int c, retvalue; |
/* first check the directory where the exe file is in !! 01may97jaw */ |
|
if (onlypath(progname)) |
#if defined(i386) && defined(ALIGNMENT_CHECK) && !defined(DIRECT_THREADED) |
image_file=checkimage(progname, onlypath(progname), imagename); |
/* turn on alignment checks on the 486. |
if (!image_file) |
* on the 386 this should have no effect. */ |
do { |
__asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;"); |
char *pend=strchr(path, PATHSEP); |
/* this is unusable with Linux' libc.4.6.27, because this library is |
if (pend==NULL) |
not alignment-clean; we would have to replace some library |
pend=path+strlen(path); |
functions (e.g., memcpy) to make it work */ |
if (strlen(path)==0) break; |
#endif |
image_file=checkimage(path, pend-path, imagename); |
|
path=pend+(*pend==PATHSEP); |
|
} while (image_file==NULL); |
|
} else { |
|
image_file=openimage(imagename); |
|
} |
|
|
/* buffering of the user output device */ |
if (!image_file) { |
if (isatty(fileno(stdout))) { |
fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n", |
fflush(stdout); |
progname, imagename, path); |
setvbuf(stdout,NULL,_IONBF,0); |
exit(1); |
} |
} |
|
|
progname = argv[0]; |
return image_file; |
if ((path1=getenv("GFORTHPATH"))==NULL) |
} |
path1 = DEFAULTPATH; |
|
|
void gforth_args(int argc, char ** argv, char ** path, char ** imagename) |
|
{ |
|
int c; |
|
|
opterr=0; |
opterr=0; |
while (1) { |
while (1) { |
int option_index=0; |
int option_index=0; |
Line 531 int main(int argc, char **argv, char **e
|
Line 555 int main(int argc, char **argv, char **e
|
break; |
break; |
} |
} |
switch (c) { |
switch (c) { |
case 'i': imagename = optarg; break; |
case 'i': *imagename = optarg; break; |
case 'm': dictsize = convsize(optarg,sizeof(Cell)); break; |
case 'm': dictsize = convsize(optarg,sizeof(Cell)); break; |
case 'd': dsize = convsize(optarg,sizeof(Cell)); break; |
case 'd': dsize = convsize(optarg,sizeof(Cell)); break; |
case 'r': rsize = convsize(optarg,sizeof(Cell)); break; |
case 'r': rsize = convsize(optarg,sizeof(Cell)); break; |
case 'f': fsize = convsize(optarg,sizeof(Float)); break; |
case 'f': fsize = convsize(optarg,sizeof(Float)); break; |
case 'l': lsize = convsize(optarg,sizeof(Cell)); break; |
case 'l': lsize = convsize(optarg,sizeof(Cell)); break; |
case 'p': path1 = optarg; break; |
case 'p': *path = optarg; break; |
case 'v': fprintf(stderr, "gforth %s\n", VERSION); exit(0); |
case 'v': fprintf(stderr, "gforth %s\n", VERSION); exit(0); |
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\ |
--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\ |
--die-on-signal exit instead of CATCHing some signals\n\ |
--die-on-signal exit instead of CATCHing some signals\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\ |
-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\ |
--no-offset-im Load image at normal position\n\ |
--no-offset-im Load image at normal position\n\ |
--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\ |
-r SIZE, --return-stack-size=SIZE Specify return stack size\n\ |
-r SIZE, --return-stack-size=SIZE Specify return stack size\n\ |
-v, --version Print version and exit\n\ |
-v, --version Print 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", |
\n\ |
argv[0]); |
Arguments of default image `gforth.fi':\n\ |
optind--; |
FILE load FILE (with `require')\n\ |
return; |
-e STRING, --evaluate STRING interpret STRING (with `EVALUATE')\n\n\ |
exit(0); |
Report bugs to <bug-gforth@gnu.ai.mit.edu>\n", |
|
argv[0]); exit(0); |
|
} |
} |
} |
} |
path=path1; |
} |
image_file=NULL; |
|
|
|
if(strchr(imagename, '/')==NULL) |
|
{ |
|
/* first check the directory where the exe file is in !! 01may97jaw */ |
|
if (onlypath(progname)) |
|
image_file=checkimage(progname, onlypath(progname), imagename); |
|
if (!image_file) |
|
do { |
|
char *pend=strchr(path, PATHSEP); |
|
if (pend==NULL) |
|
pend=path+strlen(path); |
|
if (strlen(path)==0) break; |
|
image_file=checkimage(path, pend-path, imagename); |
|
path=pend+(*pend==PATHSEP); |
|
} while (image_file==NULL); |
|
} |
|
else |
|
{ image_file=openimage(imagename); |
|
} |
|
|
|
if (!image_file) |
#ifdef INCLUDE_IMAGE |
{ fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n", |
extern Cell image[]; |
progname, imagename, path1); |
extern const char reloc_bits[]; |
exit(1); |
#endif |
|
|
|
int main(int argc, char **argv, char **env) |
|
{ |
|
char *path = getenv("GFORTHPATH") ? : DEFAULTPATH; |
|
char *imagename="gforth.fi"; |
|
FILE *image_file; |
|
#ifndef INCLUDE_IMAGE |
|
Address image; |
|
#endif |
|
int retvalue; |
|
|
|
#if defined(i386) && defined(ALIGNMENT_CHECK) && !defined(DIRECT_THREADED) |
|
/* turn on alignment checks on the 486. |
|
* 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 |
|
|
|
/* buffering of the user output device */ |
|
if (isatty(fileno(stdout))) { |
|
fflush(stdout); |
|
setvbuf(stdout,NULL,_IONBF,0); |
} |
} |
|
|
|
progname = argv[0]; |
|
|
|
gforth_args(argc, argv, &path, &imagename); |
|
|
|
#ifdef INCLUDE_IMAGE |
|
set_stack_sizes((ImageHeader *)image); |
|
relocate(image, reloc_bits, ((ImageHeader*)&image)->image_size, (Label*)engine(0, 0, 0, 0, 0)); |
|
alloc_stacks((ImageHeader *)image); |
|
#else |
|
image_file = open_image_file(imagename, path); |
|
image = loader(image_file, imagename); |
|
#endif |
|
|
{ |
{ |
char path2[strlen(path1)+1]; |
char path2[strlen(path)+1]; |
char *p1, *p2; |
char *p1, *p2; |
Cell environ[]= { |
Cell environ[]= { |
(Cell)argc-(optind-1), |
(Cell)argc-(optind-1), |
(Cell)(argv+(optind-1)), |
(Cell)(argv+(optind-1)), |
(Cell)strlen(path1), |
(Cell)strlen(path), |
(Cell)path2}; |
(Cell)path2}; |
argv[optind-1] = progname; |
argv[optind-1] = progname; |
/* |
/* |
Line 608 Report bugs to <bug-gforth@gnu.ai.mit.ed
|
Line 648 Report bugs to <bug-gforth@gnu.ai.mit.ed
|
printf("%s\n", ((char **)(environ[1]))[i]); |
printf("%s\n", ((char **)(environ[1]))[i]); |
*/ |
*/ |
/* make path OS-independent by replacing path separators with NUL */ |
/* make path OS-independent by replacing path separators with NUL */ |
for (p1=path1, p2=path2; *p1!='\0'; p1++, p2++) |
for (p1=path, p2=path2; *p1!='\0'; p1++, p2++) |
if (*p1==PATHSEP) |
if (*p1==PATHSEP) |
*p2 = '\0'; |
*p2 = '\0'; |
else |
else |
*p2 = *p1; |
*p2 = *p1; |
*p2='\0'; |
*p2='\0'; |
retvalue=go_forth(loader(image_file, imagename),4,environ); |
retvalue = go_forth(image, 4, environ); |
deprep_terminal(); |
deprep_terminal(); |
exit(retvalue); |
exit(retvalue); |
} |
} |