Return to fasl.c CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / lisp

Annotation of 3BSD/cmd/lisp/fasl.c, revision 1.1

1.1     ! root        1: #include "global.h"
        !             2: #include "lfuncs.h"
        !             3: #include "chkrtab.h"
        !             4: #include <a.out.h>
        !             5: #define round(x,s) ((((x)-1) & ~((s)-1)) + (s))
        !             6: #define STRLIM 2048
        !             7: 
        !             8: /* this is the original fasl, which used nld to do relocation.
        !             9:  * On nov 4, it was replaced by rfasl
        !            10:  */
        !            11: 
        !            12: static lispval mkptr();
        !            13: static char stabbuf[32]="";
        !            14: static struct exec header;
        !            15: static lispval *linkaddr;
        !            16: static int fildes;
        !            17: static char *currend;
        !            18: extern char *stabf;
        !            19: extern int  fvirgin;
        !            20: static lispval currtab;
        !            21: static lispval curibase;
        !            22: lispval
        !            23: Loldfasl(){
        !            24:        register struct argent *mlbot = lbot;
        !            25:        register lispval work;
        !            26:        int totsize, readsize;
        !            27:        lispval csegment(), errorh();
        !            28:        char *sbrk(), *tfile, cbuf[512], *mytemp(), *gstab();
        !            29:        struct nament *obnp = bnp;
        !            30: 
        !            31:        snpand(2);
        !            32:        if(np - mlbot != 1 || TYPE(mlbot[0].val)!=ATOM)
        !            33:                mlbot[0].val = errorh(Vermisc,
        !            34:                                      "fasl: Incorrect .o file specification:",
        !            35:                                      nil,
        !            36:                                      TRUE,
        !            37:                                      0,
        !            38:                                      mlbot[0].val);
        !            39: 
        !            40:        /*
        !            41:         * Invoke loader.
        !            42:         */
        !            43:        currend = sbrk(0);
        !            44:        tfile = mytemp();
        !            45:        sprintf(cbuf,
        !            46:                "/usr/lib/lisp/nld -A %s -T %x -N %s -o %s",
        !            47:                gstab(),
        !            48:                currend,
        !            49:                mlbot[0].val->pname,
        !            50:                tfile);
        !            51:        /* printf(cbuf); fflush(stdout);   debugging */
        !            52:        printf("[fasl: %s]",mlbot[0].val->pname);
        !            53:        fflush(stdout);
        !            54:        if(system(cbuf)!=0) {
        !            55:                unlink(tfile);
        !            56:                return(nil);
        !            57:        }
        !            58:        putchar('\n');                  /* signal end of nld */
        !            59:        fflush(stdout);
        !            60:        if((fildes = open(tfile,0))<0)
        !            61:                return(nil);
        !            62:        if(fvirgin)
        !            63:                fvirgin = 0;
        !            64:        else
        !            65:                unlink(stabf);
        !            66:        strcpyn(stabbuf,tfile,31);
        !            67:        stabf = stabbuf;
        !            68:        /*
        !            69:         * Read a.out header to find out how much room to
        !            70:         * allocate and attempt to do so.
        !            71:         */
        !            72:        if(read(fildes,(char *)&header,sizeof(header)) <= 0) {
        !            73:                close(fildes);
        !            74:                return(nil);
        !            75:        }
        !            76:        readsize = header.a_text;
        !            77:        totsize  = readsize;
        !            78:        totsize  = round(totsize,PAGSIZ);
        !            79:        /*
        !            80:         * Fix up system indicators, typing info, etc.
        !            81:         */
        !            82:        currend = (char *)csegment(int_name,totsize/(sizeof(int)));
        !            83:        
        !            84:        if(readsize!=read(fildes,currend,readsize))
        !            85:                return(nil);
        !            86:        linkaddr = (lispval *)*(int *)currend;
        !            87:        currtab = Vreadtable->clb;
        !            88:        Vreadtable->clb = strtab;
        !            89:        curibase = ibase->clb;
        !            90:        ibase->clb = inewint(10);
        !            91:        do_linker();
        !            92:        do_binder();
        !            93:        ibase->clb=curibase;
        !            94:        Vreadtable->clb = currtab;
        !            95:        chkrtab(currtab);       /* added by jkf, shouldnt be needed */
        !            96:        return(tatom);
        !            97: }
        !            98: static char mybuff[40]; 
        !            99: char *
        !           100: mytemp()
        !           101: {
        !           102:        static seed=0, mypid = 0;
        !           103:        if(mypid==0) mypid = getpid();
        !           104:        sprintf(mybuff,"/tmp/Li%d.%d",mypid,seed++);
        !           105:        return(mybuff);
        !           106: }
        !           107: 
        !           108: static
        !           109: do_linker()
        !           110: {
        !           111:        register int *i, *end, temp;
        !           112:        char array[STRLIM];
        !           113:        extern lispval *bind_lists;
        !           114: 
        !           115:        /* first link this linkage table to the garbage
        !           116:           collector's list.  We will try to be tricky
        !           117:        so that if the garbage collector is invoked
        !           118:        by mkptr we will not cause markdp() to go off
        !           119:        the deep end.
        !           120:        */
        !           121:        *(linkaddr-1) = (lispval) bind_lists;
        !           122:        bind_lists = linkaddr;
        !           123:        i = (int *)linkaddr;
        !           124:        end = (int *)(currend + header.a_text - 7);
        !           125:        for(; i<end; i++) {
        !           126:                temp = *i;
        !           127:                *i = -1;    /* clobber to short circuit gc */
        !           128:                findstr(temp, array);
        !           129:                *i = (int)mkptr(array);
        !           130:        }
        !           131: }
        !           132: static
        !           133: do_binder()
        !           134: {
        !           135:        char array[STRLIM];
        !           136:        struct argent *onp = np;
        !           137:        int pos;
        !           138:        register lispval handy;
        !           139:        struct {lispval (*b_entry)();
        !           140:                        int b_atmlnk;
        !           141:                        int b_type;} bindage;
        !           142: 
        !           143:        snpand(0);
        !           144:        pos = lseek(fildes, (sizeof header)+header.a_text, 0);
        !           145:        while(read(fildes, &bindage, sizeof bindage)==sizeof bindage
        !           146:                        && bindage.b_atmlnk != -1) {
        !           147:                np = onp;
        !           148:                if( bindage.b_type == 99) {
        !           149:                        /* we must evaluate this form for effect */
        !           150:                        /* and must take care that setsyntax works
        !           151:                           on the proper read table */
        !           152:  
        !           153:                        findstr(bindage.b_atmlnk, array);
        !           154:                        if(ISNIL(copval(gcload,CNIL)) && loading->clb != tatom)
        !           155:                                gc(CNIL);       /*  do a gc if gc will be off  */
        !           156:                        handy = (mkptr(array));
        !           157:                        ibase->clb=curibase;
        !           158:                        Vreadtable->clb = currtab;
        !           159:                        eval(handy);
        !           160:                        Vreadtable->clb = strtab;
        !           161:                        curibase = ibase->clb;
        !           162:                        ibase->clb = inewint(10);
        !           163:                        goto out;
        !           164:                }
        !           165:                handy = newfunct();
        !           166:                protect(handy);
        !           167:                handy->entry = bindage.b_entry;
        !           168:                handy->discipline = (bindage.b_type == 0 ? lambda :
        !           169:                                                         bindage.b_type == 1 ? nlambda :
        !           170:                                                                               macro);
        !           171: 
        !           172:                findstr(bindage.b_atmlnk, array);
        !           173:                if(*array != '(')
        !           174:                        mkptr(array)->fnbnd = handy;
        !           175:                else {
        !           176:                        char *i,*j,*index();
        !           177:                        lispval prop, atom;
        !           178: 
        !           179:                        i = index(array, ':');
        !           180:                        j = index(array, ')');
        !           181:                        *i = 0;
        !           182:                        *j = 0;
        !           183:                        protect(prop = mkptr(array+1));
        !           184:                        atom = mkptr(i+1);
        !           185:                        Iputprop(atom,handy,prop);
        !           186:                }
        !           187:        out:
        !           188:                pos = lseek(fildes, pos + sizeof bindage, 0);
        !           189:        }
        !           190: }
        !           191: 
        !           192: static
        !           193: findstr(ptr,array)
        !           194: int ptr;
        !           195: char *array;
        !           196: {
        !           197:        int cnt = 0;
        !           198: 
        !           199:        lseek(fildes, sizeof header + header.a_text + ptr, 0);
        !           200:        while(cnt<STRLIM && read(fildes,&array[cnt],1)==1
        !           201:                                && array[cnt]!=0) cnt++;
        !           202:        if(cnt >= STRLIM) error("fasl string table overflow",FALSE);
        !           203: }
        !           204: 
        !           205: static lispval
        !           206: mkptr(str)
        !           207: register char *str;
        !           208: {
        !           209:        lispval work;
        !           210:        register FILE *p=stdin;
        !           211:        snpand(2);
        !           212: 
        !           213:        /* find free file descriptor */
        !           214:        for(;p->_flag&(_IOREAD|_IOWRT);p++)
        !           215:                if(p >= _iob + _NFILE)
        !           216:                        error("Too many open files to do readlist",FALSE);
        !           217:        p->_flag = _IOREAD | _IOSTRG;
        !           218:        p->_base = p->_ptr = str;
        !           219:        p->_cnt = strlen(str) + 1;
        !           220:        
        !           221:        lbot = np;
        !           222:        protect(P(p));
        !           223:        work = Lread();
        !           224:        p->_cnt = 0;
        !           225:        p->_ptr = p->_base = 0;
        !           226:        p->_file = 0;
        !           227:        p->_flag=0;
        !           228:        return(work);
        !           229: }
        !           230: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.