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>