Annotation of gforth/main.c, revision 1.3
1.1 anton 1: /*
2: $Id: main.c,v 1.8 1993/11/02 13:34:38 anton Exp $
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"
16:
1.2 pazsan 17: #ifndef DEFAULTBIN
18: # define DEFAULTBIN ""
19: #endif
20:
1.1 anton 21: #ifdef DIRECT_THREADED
1.2 pazsan 22: # define CA(n) (symbols[(n)])
1.1 anton 23: #else
1.2 pazsan 24: # define CA(n) ((int)(symbols+(n)))
1.1 anton 25: #endif
26:
27: /* image file format:
28: * size of image with stacks without tags (in bytes)
29: * size of image without stacks and tags (in bytes)
30: * size of data and FP stack (in bytes)
31: * pointer to start of code
32: * data (size in image[1])
33: * tags (1 bit/data cell)
34: *
35: * tag==1 mean that the corresponding word is an address;
36: * If the word is >=0, the address is within the image;
37: * addresses within the image are given relative to the start of the image.
38: * If the word is =-1, the address is NIL,
1.2 pazsan 39: * If the word is between -2 and -5, it's a CFA (:, Create, Constant, User)
40: * If the word is -6, it's a DOES> CFA
41: * If the word is -7, it's a DOES JUMP
42: * If the word is <-7, it's a primitive
1.1 anton 43: */
44:
45: void relocate(int *image, char *bitstring, int size, Label symbols[])
46: {
47: int i;
48: static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};
1.2 pazsan 49:
50: #ifdef DEBUG
51: printf("Dodoes-Adresse: %08x\n",(int)symbols[DODOES]);
52: #endif
1.1 anton 53:
54: for(i=0;i<size/sizeof(Cell);i++)
55: if(bitstring[i >> 3] & bits[i & 7])
56: if(image[i]<0)
1.2 pazsan 57: switch(image[i])
1.1 anton 58: {
1.2 pazsan 59: case CF_NIL :
60: image[i]=0; break;
61: case CF(DOCOL) :
62: case CF(DOVAR) :
63: case CF(DOCON) :
64: case CF(DOUSER) :
65: MAKE_CF(image+i,symbols[CF(image[i])]); break;
66: case CF(DODOES) :
67: MAKE_DOES_CF(image+i,image[i+1]+((int)image));
68: i++; break; /* is this necessary? */
69: case CF(DOESJUMP):
70: MAKE_DOES_HANDLER(image+i);
71: break;
72: default:
73: image[i]=(Cell)CA(CF(image[i]));
1.1 anton 74: }
75: else
76: image[i]+=(Cell)image;
1.3 ! pazsan 77:
! 78: CACHE_FLUSH(image,size);
1.1 anton 79: }
80:
81: int* loader(const char* filename)
82: { int header[2];
83: FILE *imagefile;
84: int *image;
85:
86: if(!(int)(imagefile=fopen(filename,"rb")))
87: {
88: fprintf(stderr,"Can't open image file '%s'",filename);
89: exit(1);
90: }
91:
92: fread(header,1,2*sizeof(int),imagefile);
93:
94: image=malloc(header[0]+((header[0]-1)/sizeof(Cell))/8+1);
95:
96: memset(image,0,header[0]+((header[0]-1)/sizeof(Cell))/8+1);
97:
98: image[0]=header[0];
99: image[1]=header[1];
100:
101: fread(image+2,1,header[1]-2*sizeof(Cell),imagefile);
102: fread(((void *)image)+header[0],1,((header[1]-1)/sizeof(Cell))/8+1,
103: imagefile);
104: fclose(imagefile);
105:
106: relocate(image,(char *)image+header[0],header[1],engine(0,0,0,0));
107:
108: return(image);
109: }
110:
111: int go_forth(int *image, int stack, Cell *entries)
112: {
113: Cell* rp=(Cell*)((void *)image+image[0]);
114: double* fp=(double*)((void *)rp-image[2]);
115: Cell* sp=(Cell*)((void *)fp-image[2]);
116: Cell* ip=(Cell*)(image[3]);
117:
118: for(;stack>0;stack--)
119: *--sp=entries[stack-1];
120:
121: install_signal_handlers(); /* right place? */
122:
123: return((int)engine(ip,sp,rp,fp));
124: }
125:
126: int main(int argc, char **argv, char **env)
127: {
128: char imagefile[256];
129: Cell environ[3] = {(Cell)argc, (Cell)argv, (Cell)env};
130: char* imagepath;
131:
132: if((int)(imagepath=getenv("FORTHBIN")))
133: {
134: strcpy(imagefile,imagepath);
135:
136: if(imagefile[strlen(imagefile)-1]!='/')
137: imagefile[strlen(imagefile)]='/';
138: }
139: else
1.2 pazsan 140: {
141: strcpy(imagefile,DEFAULTBIN);
142:
143: if(imagefile[0]!=0 && imagefile[strlen(imagefile)-1]!='/')
144: imagefile[strlen(imagefile)]='/';
145: }
1.1 anton 146:
147: if(argc>1 && argv[1][0]=='@')
148: {
149: if(argv[1][1]=='/')
150: strcpy(imagefile,argv[1]+1);
151: else
152: strcpy(imagefile+strlen(imagefile),argv[1]+1);
153:
154: environ[0]-=1;
155: environ[1]+=sizeof(argv);
156: argv[1]=argv[0];
157: }
158: else
159: strcpy(imagefile+strlen(imagefile),"kernal.fi");
160:
161: exit(go_forth(loader(imagefile),3,environ));
162: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>