Return to main.c CVS log

Up to [gforth] / gforth

Got direct threading to work!

    1: /*
    2:   $Id: main.c,v 1.3 1994/05/05 17:05:35 pazsan 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: 
   17: #ifndef DEFAULTBIN
   18: #	define DEFAULTBIN ""
   19: #endif
   20: 
   21: #ifdef DIRECT_THREADED
   22: #	define CA(n)	(symbols[(n)])
   23: #else
   24: #	define CA(n)	((int)(symbols+(n)))
   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,
   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
   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};
   49: 
   50: #ifdef DEBUG
   51: 	printf("Dodoes-Adresse: %08x\n",(int)symbols[DODOES]);
   52: #endif
   53: 
   54: 	for(i=0;i<size/sizeof(Cell);i++)
   55: 		if(bitstring[i >> 3] & bits[i & 7])
   56: 			if(image[i]<0)
   57: 				switch(image[i])
   58: 				{
   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]));
   74: 				}
   75: 			else
   76: 				image[i]+=(Cell)image;
   77: 
   78: 	CACHE_FLUSH(image,size);
   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
  140: 	{
  141: 		strcpy(imagefile,DEFAULTBIN);
  142: 
  143: 		if(imagefile[0]!=0 && imagefile[strlen(imagefile)-1]!='/')
  144: 			imagefile[strlen(imagefile)]='/';
  145: 	}
  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: }