version 1.9, 1994/08/25 15:25:30
|
version 1.10, 1994/09/05 17:36:22
|
Line 14
|
Line 14
|
#include <stdlib.h> |
#include <stdlib.h> |
#include "forth.h" |
#include "forth.h" |
#include "io.h" |
#include "io.h" |
|
#include "getopt.h" |
Xt *throw_ip; |
|
|
|
|
|
#ifndef DEFAULTBIN |
#ifndef DEFAULTBIN |
# define DEFAULTBIN "" |
# define DEFAULTBIN "" |
#endif |
#endif |
|
|
|
#ifndef DEFAULTPATH |
|
# define DEFAULTPATH "/usr/local/lib/gforth:." |
|
#endif |
|
|
#ifdef DIRECT_THREADED |
#ifdef DIRECT_THREADED |
# define CA(n) (symbols[(n)]) |
# define CA(n) (symbols[(n)]) |
#else |
#else |
# define CA(n) ((int)(symbols+(n))) |
# define CA(n) ((int)(symbols+(n))) |
#endif |
#endif |
|
|
|
#define maxaligned(n) ((((Cell)n)+sizeof(Float)-1)&-sizeof(Float)) |
|
|
|
static int dictsize=0; |
|
static int dsize=0; |
|
static int rsize=0; |
|
static int fsize=0; |
|
static int lsize=0; |
|
char *progname; |
|
|
|
|
/* image file format: |
/* image file format: |
* size of image with stacks without tags (in bytes) |
* size of image with stacks without tags (in bytes) |
* size of image without stacks and tags (in bytes) |
* size of image without stacks and tags (in bytes) |
Line 47 Xt *throw_ip;
|
Line 59 Xt *throw_ip;
|
* If the word is <-7, it's a primitive |
* If the word is <-7, it's a primitive |
*/ |
*/ |
|
|
void relocate(int *image, char *bitstring, int size, Label symbols[]) |
void relocate(Cell *image, 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 77 void relocate(int *image, char *bitstrin
|
Line 89 void relocate(int *image, char *bitstrin
|
CACHE_FLUSH(image,size); |
CACHE_FLUSH(image,size); |
} |
} |
|
|
int* loader(const char* filename) |
Cell *loader(FILE *imagefile) |
{ int header[2]; |
{ |
FILE *imagefile; |
Cell header[3]; |
int *image; |
Cell *image; |
|
int wholesize; |
if(!(int)(imagefile=fopen(filename,"rb"))) |
int imagesize; /* everything needed by the image */ |
{ |
|
fprintf(stderr,"Can't open image file '%s'",filename); |
fread(header,1,3*sizeof(Cell),imagefile); |
exit(1); |
if (dictsize==0) |
} |
dictsize = header[0]; |
|
if (dsize==0) |
fread(header,1,2*sizeof(int),imagefile); |
dsize=header[2]; |
|
if (rsize==0) |
image=malloc(header[0]+((header[0]-1)/sizeof(Cell))/8+1); |
rsize=header[2]; |
|
if (fsize==0) |
memset(image,0,header[0]+((header[0]-1)/sizeof(Cell))/8+1); |
fsize=header[2]; |
|
if (lsize==0) |
|
lsize=header[2]; |
|
dictsize=maxaligned(dictsize); |
|
dsize=maxaligned(dsize); |
|
rsize=maxaligned(rsize); |
|
lsize=maxaligned(lsize); |
|
fsize=maxaligned(fsize); |
|
|
|
wholesize = dictsize+dsize+rsize+fsize+lsize; |
|
imagesize = header[1]+((header[1]-1)/sizeof(Cell))/8+1; |
|
image=malloc(wholesize>imagesize?wholesize:imagesize); |
|
memset(image,0,wholesize); /* why? - anton */ |
image[0]=header[0]; |
image[0]=header[0]; |
image[1]=header[1]; |
image[1]=header[1]; |
|
image[2]=header[2]; |
|
|
fread(image+2,1,header[1]-2*sizeof(Cell),imagefile); |
fread(image+3,1,header[1]-3*sizeof(Cell),imagefile); |
fread(((void *)image)+header[0],1,((header[1]-1)/sizeof(Cell))/8+1, |
fread(((void *)image)+header[1],1,((header[1]-1)/sizeof(Cell))/8+1, |
imagefile); |
imagefile); |
fclose(imagefile); |
fclose(imagefile); |
|
|
relocate(image,(char *)image+header[0],header[1],engine(0,0,0,0,0)); |
relocate(image,(char *)image+header[1],header[1],engine(0,0,0,0,0)); |
|
|
return(image); |
return(image); |
} |
} |
|
|
int go_forth(int *image, int stack, Cell *entries) |
int go_forth(Cell *image, int stack, Cell *entries) |
{ |
{ |
Cell* rp=(Cell*)((void *)image+image[0]); |
Cell *sp=(Cell*)((void *)image+dictsize+dsize); |
double* fp=(double*)((void *)rp-image[2]); |
Address lp=(Address)((void *)sp+lsize); |
Address lp=(Address)((void *)fp-image[2]); |
Float *fp=(Float *)((void *)lp+fsize); |
Cell* sp=(Cell*)((void *)lp-image[2]); |
Cell *rp=(Cell*)((void *)fp+rsize); |
Cell* ip=(Cell*)(image[3]); |
Xt *ip=(Xt *)(image[3]); |
int throw_code; |
int throw_code; |
|
|
throw_ip = (Xt *)(image[4]); |
|
for(;stack>0;stack--) |
for(;stack>0;stack--) |
*--sp=entries[stack-1]; |
*--sp=entries[stack-1]; |
|
|
Line 128 int go_forth(int *image, int stack, Cell
|
Line 151 int go_forth(int *image, int stack, Cell
|
|
|
signal_data_stack[7]=throw_code; |
signal_data_stack[7]=throw_code; |
|
|
return((int)engine(image[4],signal_data_stack+7, |
return((int)engine((Xt *)image[4],signal_data_stack+7, |
signal_return_stack+8,0,0)); |
signal_return_stack+8,0,0)); |
} |
} |
|
|
return((int)engine(ip,sp,rp,fp,lp)); |
return((int)engine(ip,sp,rp,fp,lp)); |
} |
} |
|
|
int main(int argc, char **argv, char **env) |
int convsize(char *s, int elemsize) |
|
/* converts s of the format #+u (e.g. 25k) into the number of bytes. |
|
the unit u can be one of bekM, where e stands for the element |
|
size. default is e */ |
{ |
{ |
char imagefile[256]; |
char *endp; |
Cell environ[3] = {(Cell)argc, (Cell)argv, (Cell)env}; |
int n,m; |
char* imagepath; |
|
|
|
|
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,"e")!=0) { |
|
fprintf(stderr,"%s: cannot grok size specification %s\n", progname, s); |
|
exit(1); |
|
} |
|
} |
|
return n*m; |
|
} |
|
|
|
int main(int argc, char **argv, char **env) |
|
{ |
|
char *path, *path1; |
|
char *imagename="gforth.fi"; |
|
FILE *image_file; |
|
int c; |
|
|
#if defined(i386) && defined(ALIGNMENT_CHECK) |
#if defined(i386) && defined(ALIGNMENT_CHECK) |
/* turn on alignment checks on the 486. |
/* turn on alignment checks on the 486. |
* on the 386 this should have no effect. */ |
* on the 386 this should have no effect. */ |
__asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;"); |
__asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;"); |
#endif |
#endif |
if((int)(imagepath=getenv("FORTHBIN"))) |
|
{ |
|
strcpy(imagefile,imagepath); |
|
|
|
if(imagefile[strlen(imagefile)-1]!='/') |
|
imagefile[strlen(imagefile)]='/'; |
|
} |
|
else |
|
{ |
|
strcpy(imagefile,DEFAULTBIN); |
|
|
|
if(imagefile[0]!=0 && imagefile[strlen(imagefile)-1]!='/') |
progname = argv[0]; |
imagefile[strlen(imagefile)]='/'; |
if ((path=getenv("GFORTHPATH"))==NULL) |
|
path = strcpy(malloc(strlen(DEFAULTPATH)+1),DEFAULTPATH); |
|
opterr=0; |
|
while (1) { |
|
int option_index=0; |
|
static struct option opts[] = { |
|
{"image-file", required_argument, NULL, 'i'}, |
|
{"dictionary-size", required_argument, NULL, 'm'}, |
|
{"data-stack-size", required_argument, NULL, 'd'}, |
|
{"return-stack-size", required_argument, NULL, 'r'}, |
|
{"fp-stack-size", required_argument, NULL, 'f'}, |
|
{"locals-stack-size", required_argument, NULL, 'l'}, |
|
{"path", required_argument, NULL, 'p'}, |
|
{0,0,0,0} |
|
/* no-init-file, no-rc? */ |
|
}; |
|
|
|
c = getopt_long(argc, argv, "+drfl", opts, &option_index); |
|
if (c==EOF) |
|
break; |
|
if (c=='?') { |
|
optind--; |
|
break; |
|
} |
|
switch (c) { |
|
case 'i': imagename = optarg; break; |
|
case 'm': dictsize = convsize(optarg,sizeof(Cell)); break; |
|
case 'd': dsize = convsize(optarg,sizeof(Cell)); break; |
|
case 'r': rsize = convsize(optarg,sizeof(Cell)); break; |
|
case 'f': fsize = convsize(optarg,sizeof(Float)); break; |
|
case 'l': lsize = convsize(optarg,sizeof(Cell)); break; |
|
case 'p': path = optarg; break; |
|
} |
} |
} |
|
path1=path; |
|
do { |
|
char *pend=strchr(path, ':'); |
|
if (pend==NULL) |
|
pend=path+strlen(path); |
|
if (strlen(path)==0) { |
|
fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n", progname, imagename, path1); |
|
exit(1); |
|
} |
|
{ |
|
int dirlen=pend-path; |
|
char fullfilename[dirlen+strlen(imagename)+2]; |
|
memcpy(fullfilename, path, dirlen); |
|
if (fullfilename[dirlen-1]!='/') |
|
fullfilename[dirlen++]='/'; |
|
strcpy(fullfilename+dirlen,imagename); |
|
image_file=fopen(fullfilename,"rb"); |
|
} |
|
path=pend+(*pend==':'); |
|
} while (image_file==NULL); |
|
|
if(argc>1 && argv[1][0]=='@') |
|
{ |
{ |
if(argv[1][1]=='/') |
Cell environ[]= {(Cell)argc-(optind-1), (Cell)(argv+(optind-1)), (Cell)path1}; |
strcpy(imagefile,argv[1]+1); |
argv[optind-1] = progname; |
else |
/* |
strcpy(imagefile+strlen(imagefile),argv[1]+1); |
for (i=0; i<environ[0]; i++) |
|
printf("%s\n", ((char **)(environ[1]))[i]); |
environ[0]-=1; |
*/ |
environ[1]+=sizeof(argv); |
exit(go_forth(loader(image_file),3, environ)); |
argv[1]=argv[0]; |
|
} |
} |
else |
|
strcpy(imagefile+strlen(imagefile),"kernal.fi"); |
|
|
|
exit(go_forth(loader(imagefile),3,environ)); |
|
} |
} |