Return to main.c CVS log

Up to [gforth] / gforth

Annotation of gforth/main.c, revision 1.4

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