Return to main.c CVS log

Up to [gforth] / gforth

Annotation of gforth/main.c, revision 1.5

1.1       anton       1: /*
1.5     ! pazsan      2:   $Id: main.c,v 1.8 1993/11/02 13:34:38 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.1       anton      17: 
1.2       pazsan     18: #ifndef DEFAULTBIN
                     19: #      define DEFAULTBIN ""
                     20: #endif
                     21: 
1.1       anton      22: #ifdef DIRECT_THREADED
1.2       pazsan     23: #      define CA(n)    (symbols[(n)])
1.1       anton      24: #else
1.2       pazsan     25: #      define CA(n)    ((int)(symbols+(n)))
1.1       anton      26: #endif
                     27: 
                     28: /* image file format:
                     29:  *   size of image with stacks without tags (in bytes)
                     30:  *   size of image without stacks and tags (in bytes)
1.5     ! pazsan     31:  *   size of data and FP stack (in bytes)
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: {
1.5     ! pazsan     48:    int i=0, j, k, steps=(size/sizeof(Cell))/8;
        !            49:    char bits;
        !            50: /*   static char bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01};*/
        !            51:    
        !            52:    for(k=0; k<=steps; k++)
        !            53:      for(j=0, bits=bitstring[k]; j<8; j++, i++, bits<<=1)
        !            54:        if(bits & 0x80)
        !            55:          if(image[i]<0)
        !            56:            switch(image[i])
        !            57:              {
        !            58:                case CF_NIL      : image[i]=0; break;
        !            59:                case CF(DOCOL)   :
        !            60:                case CF(DOVAR)   :
        !            61:                case CF(DOCON)   :
        !            62:                case CF(DOUSER)  : MAKE_CF(image+i,symbols[CF(image[i])]); break;
        !            63:                case CF(DODOES)  : MAKE_DOES_CF(image+i,image[i+1]+((int)image));
        !            64:                                   break;
        !            65:                case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
        !            66:                default          : image[i]=(Cell)CA(CF(image[i]));
        !            67:             }
        !            68:          else
        !            69:            image[i]+=(Cell)image;
1.2       pazsan     70: 
1.5     ! pazsan     71:    CACHE_FLUSH(image,size);
1.1       anton      72: }
                     73: 
                     74: int* loader(const char* filename)
                     75: {      int header[2];
                     76:        FILE *imagefile;
                     77:        int *image;
                     78: 
                     79:        if(!(int)(imagefile=fopen(filename,"rb")))
                     80:        {
                     81:                fprintf(stderr,"Can't open image file '%s'",filename);
                     82:                exit(1);
                     83:        }
                     84: 
                     85:        fread(header,1,2*sizeof(int),imagefile);
                     86: 
                     87:        image=malloc(header[0]+((header[0]-1)/sizeof(Cell))/8+1);
                     88: 
                     89:        memset(image,0,header[0]+((header[0]-1)/sizeof(Cell))/8+1);
                     90: 
                     91:        image[0]=header[0];
                     92:        image[1]=header[1];
                     93: 
                     94:        fread(image+2,1,header[1]-2*sizeof(Cell),imagefile);
                     95:        fread(((void *)image)+header[0],1,((header[1]-1)/sizeof(Cell))/8+1,
                     96:              imagefile);
                     97:        fclose(imagefile);
                     98: 
1.4       anton      99:        relocate(image,(char *)image+header[0],header[1],engine(0,0,0,0,0));
1.1       anton     100: 
                    101:        return(image);
                    102: }
                    103: 
                    104: int go_forth(int *image, int stack, Cell *entries)
                    105: {
                    106:        Cell* rp=(Cell*)((void *)image+image[0]);
                    107:        double* fp=(double*)((void *)rp-image[2]);
1.4       anton     108:        Address lp=(Address)((void *)fp-image[2]);
                    109:        Cell* sp=(Cell*)((void *)lp-image[2]);
1.1       anton     110:        Cell* ip=(Cell*)(image[3]);
                    111: 
                    112:        for(;stack>0;stack--)
                    113:                *--sp=entries[stack-1];
                    114: 
                    115:        install_signal_handlers(); /* right place? */
                    116: 
1.4       anton     117:        return((int)engine(ip,sp,rp,fp,lp));
1.1       anton     118: }
                    119: 
                    120: int main(int argc, char **argv, char **env)
                    121: {
                    122:        char imagefile[256];
                    123:        Cell environ[3] = {(Cell)argc, (Cell)argv, (Cell)env};
                    124:        char* imagepath;
                    125: 
                    126:        if((int)(imagepath=getenv("FORTHBIN")))
                    127:        {
                    128:                strcpy(imagefile,imagepath);
                    129: 
                    130:                if(imagefile[strlen(imagefile)-1]!='/')
                    131:                        imagefile[strlen(imagefile)]='/';
                    132:        }
                    133:        else
1.2       pazsan    134:        {
                    135:                strcpy(imagefile,DEFAULTBIN);
                    136: 
                    137:                if(imagefile[0]!=0 && imagefile[strlen(imagefile)-1]!='/')
                    138:                        imagefile[strlen(imagefile)]='/';
                    139:        }
1.1       anton     140: 
                    141:        if(argc>1 && argv[1][0]=='@')
                    142:        {
                    143:                if(argv[1][1]=='/')
                    144:                        strcpy(imagefile,argv[1]+1);
                    145:                else
                    146:                        strcpy(imagefile+strlen(imagefile),argv[1]+1);
                    147: 
                    148:                environ[0]-=1;
                    149:                environ[1]+=sizeof(argv);
                    150:                argv[1]=argv[0];
                    151:        }
                    152:        else
                    153:                strcpy(imagefile+strlen(imagefile),"kernal.fi");
                    154: 
                    155:        exit(go_forth(loader(imagefile),3,environ));
                    156: }