Annotation of gforth/main.c, revision 1.11
1.1 anton 1: /*
1.11 ! anton 2: $Id: main.c,v 1.10 1994/09/05 17:36:22 anton Exp $
1.1 anton 3: Copyright 1993 by the ANSI figForth Development Group
4: */
5:
6: #include <ctype.h>
7: #include <stdio.h>
8: #include <string.h>
9: #include <math.h>
10: #include <sys/types.h>
11: #include <sys/stat.h>
12: #include <fcntl.h>
13: #include <assert.h>
14: #include <stdlib.h>
15: #include "forth.h"
1.5 pazsan 16: #include "io.h"
1.10 anton 17: #include "getopt.h"
1.2 pazsan 18:
1.10 anton 19: #ifndef DEFAULTPATH
20: # define DEFAULTPATH "/usr/local/lib/gforth:."
21: #endif
22:
1.1 anton 23: #ifdef DIRECT_THREADED
1.2 pazsan 24: # define CA(n) (symbols[(n)])
1.1 anton 25: #else
1.2 pazsan 26: # define CA(n) ((int)(symbols+(n)))
1.1 anton 27: #endif
28:
1.10 anton 29: #define maxaligned(n) ((((Cell)n)+sizeof(Float)-1)&-sizeof(Float))
30:
31: static int dictsize=0;
32: static int dsize=0;
33: static int rsize=0;
34: static int fsize=0;
35: static int lsize=0;
36: char *progname;
37:
38:
1.1 anton 39: /* image file format:
40: * size of image with stacks without tags (in bytes)
41: * size of image without stacks and tags (in bytes)
1.5 pazsan 42: * size of data and FP stack (in bytes)
1.1 anton 43: * pointer to start of code
1.7 anton 44: * pointer into throw (for signal handling)
1.1 anton 45: * data (size in image[1])
46: * tags (1 bit/data cell)
47: *
48: * tag==1 mean that the corresponding word is an address;
49: * If the word is >=0, the address is within the image;
50: * addresses within the image are given relative to the start of the image.
51: * If the word is =-1, the address is NIL,
1.2 pazsan 52: * If the word is between -2 and -5, it's a CFA (:, Create, Constant, User)
53: * If the word is -6, it's a DOES> CFA
54: * If the word is -7, it's a DOES JUMP
55: * If the word is <-7, it's a primitive
1.1 anton 56: */
57:
1.10 anton 58: void relocate(Cell *image, char *bitstring, int size, Label symbols[])
1.1 anton 59: {
1.5 pazsan 60: int i=0, j, k, steps=(size/sizeof(Cell))/8;
61: char bits;
62: /* static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/
63:
64: for(k=0; k<=steps; k++)
65: for(j=0, bits=bitstring[k]; j<8; j++, i++, bits<<=1)
66: if(bits & 0x80)
67: if(image[i]<0)
68: switch(image[i])
69: {
70: case CF_NIL : image[i]=0; break;
71: case CF(DOCOL) :
72: case CF(DOVAR) :
73: case CF(DOCON) :
1.9 anton 74: case CF(DOUSER) :
75: case CF(DODEFER) :
76: MAKE_CF(image+i,symbols[CF(image[i])]); break;
1.5 pazsan 77: case CF(DODOES) : MAKE_DOES_CF(image+i,image[i+1]+((int)image));
78: break;
79: case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
80: default : image[i]=(Cell)CA(CF(image[i]));
81: }
82: else
83: image[i]+=(Cell)image;
1.2 pazsan 84:
1.5 pazsan 85: CACHE_FLUSH(image,size);
1.1 anton 86: }
87:
1.10 anton 88: Cell *loader(FILE *imagefile)
89: {
90: Cell header[3];
91: Cell *image;
92: int wholesize;
93: int imagesize; /* everything needed by the image */
94:
95: fread(header,1,3*sizeof(Cell),imagefile);
96: if (dictsize==0)
97: dictsize = header[0];
98: if (dsize==0)
99: dsize=header[2];
100: if (rsize==0)
101: rsize=header[2];
102: if (fsize==0)
103: fsize=header[2];
104: if (lsize==0)
105: lsize=header[2];
106: dictsize=maxaligned(dictsize);
107: dsize=maxaligned(dsize);
108: rsize=maxaligned(rsize);
109: lsize=maxaligned(lsize);
110: fsize=maxaligned(fsize);
111:
112: wholesize = dictsize+dsize+rsize+fsize+lsize;
113: imagesize = header[1]+((header[1]-1)/sizeof(Cell))/8+1;
114: image=malloc(wholesize>imagesize?wholesize:imagesize);
115: memset(image,0,wholesize); /* why? - anton */
1.1 anton 116: image[0]=header[0];
117: image[1]=header[1];
1.10 anton 118: image[2]=header[2];
1.1 anton 119:
1.10 anton 120: fread(image+3,1,header[1]-3*sizeof(Cell),imagefile);
121: fread(((void *)image)+header[1],1,((header[1]-1)/sizeof(Cell))/8+1,
1.1 anton 122: imagefile);
123: fclose(imagefile);
124:
1.10 anton 125: relocate(image,(char *)image+header[1],header[1],engine(0,0,0,0,0));
1.1 anton 126:
127: return(image);
128: }
129:
1.10 anton 130: int go_forth(Cell *image, int stack, Cell *entries)
1.1 anton 131: {
1.10 anton 132: Cell *sp=(Cell*)((void *)image+dictsize+dsize);
133: Address lp=(Address)((void *)sp+lsize);
134: Float *fp=(Float *)((void *)lp+fsize);
135: Cell *rp=(Cell*)((void *)fp+rsize);
136: Xt *ip=(Xt *)(image[3]);
1.8 pazsan 137: int throw_code;
1.10 anton 138:
1.1 anton 139: for(;stack>0;stack--)
140: *--sp=entries[stack-1];
141:
142: install_signal_handlers(); /* right place? */
1.8 pazsan 143:
144: if ((throw_code=setjmp(throw_jmp_buf))) {
145: static Cell signal_data_stack[8];
146: static Cell signal_return_stack[8];
147:
148: signal_data_stack[7]=throw_code;
149:
1.10 anton 150: return((int)engine((Xt *)image[4],signal_data_stack+7,
151: signal_return_stack+8,0,0));
1.8 pazsan 152: }
1.1 anton 153:
1.4 anton 154: return((int)engine(ip,sp,rp,fp,lp));
1.1 anton 155: }
156:
1.10 anton 157: int convsize(char *s, int elemsize)
158: /* converts s of the format #+u (e.g. 25k) into the number of bytes.
159: the unit u can be one of bekM, where e stands for the element
160: size. default is e */
161: {
162: char *endp;
163: int n,m;
164:
165: m = elemsize;
166: n = strtoul(s,&endp,0);
167: if (endp!=NULL) {
168: if (strcmp(endp,"b")==0)
169: m=1;
170: else if (strcmp(endp,"k")==0)
171: m=1024;
172: else if (strcmp(endp,"M")==0)
173: m=1024*1024;
174: else if (strcmp(endp,"e")!=0) {
175: fprintf(stderr,"%s: cannot grok size specification %s\n", progname, s);
176: exit(1);
177: }
178: }
179: return n*m;
180: }
181:
1.1 anton 182: int main(int argc, char **argv, char **env)
183: {
1.10 anton 184: char *path, *path1;
185: char *imagename="gforth.fi";
186: FILE *image_file;
187: int c;
188:
1.6 anton 189: #if defined(i386) && defined(ALIGNMENT_CHECK)
190: /* turn on alignment checks on the 486.
191: * on the 386 this should have no effect. */
192: __asm__("pushfl; popl %eax; orl $0x40000, %eax; pushl %eax; popfl;");
193: #endif
1.2 pazsan 194:
1.10 anton 195: progname = argv[0];
196: if ((path=getenv("GFORTHPATH"))==NULL)
197: path = strcpy(malloc(strlen(DEFAULTPATH)+1),DEFAULTPATH);
198: opterr=0;
199: while (1) {
200: int option_index=0;
201: static struct option opts[] = {
202: {"image-file", required_argument, NULL, 'i'},
203: {"dictionary-size", required_argument, NULL, 'm'},
204: {"data-stack-size", required_argument, NULL, 'd'},
205: {"return-stack-size", required_argument, NULL, 'r'},
206: {"fp-stack-size", required_argument, NULL, 'f'},
207: {"locals-stack-size", required_argument, NULL, 'l'},
208: {"path", required_argument, NULL, 'p'},
209: {0,0,0,0}
210: /* no-init-file, no-rc? */
211: };
212:
213: c = getopt_long(argc, argv, "+drfl", opts, &option_index);
214: if (c==EOF)
215: break;
216: if (c=='?') {
217: optind--;
218: break;
219: }
220: switch (c) {
221: case 'i': imagename = optarg; break;
222: case 'm': dictsize = convsize(optarg,sizeof(Cell)); break;
223: case 'd': dsize = convsize(optarg,sizeof(Cell)); break;
224: case 'r': rsize = convsize(optarg,sizeof(Cell)); break;
225: case 'f': fsize = convsize(optarg,sizeof(Float)); break;
226: case 'l': lsize = convsize(optarg,sizeof(Cell)); break;
227: case 'p': path = optarg; break;
228: }
1.2 pazsan 229: }
1.10 anton 230: path1=path;
231: do {
232: char *pend=strchr(path, ':');
233: if (pend==NULL)
234: pend=path+strlen(path);
235: if (strlen(path)==0) {
236: fprintf(stderr,"%s: cannot open image file %s in path %s for reading\n", progname, imagename, path1);
237: exit(1);
238: }
239: {
240: int dirlen=pend-path;
241: char fullfilename[dirlen+strlen(imagename)+2];
242: memcpy(fullfilename, path, dirlen);
243: if (fullfilename[dirlen-1]!='/')
244: fullfilename[dirlen++]='/';
245: strcpy(fullfilename+dirlen,imagename);
246: image_file=fopen(fullfilename,"rb");
247: }
248: path=pend+(*pend==':');
249: } while (image_file==NULL);
1.1 anton 250:
251: {
1.10 anton 252: Cell environ[]= {(Cell)argc-(optind-1), (Cell)(argv+(optind-1)), (Cell)path1};
253: argv[optind-1] = progname;
254: /*
255: for (i=0; i<environ[0]; i++)
256: printf("%s\n", ((char **)(environ[1]))[i]);
257: */
258: exit(go_forth(loader(image_file),3, environ));
1.1 anton 259: }
260: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to main.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth