Return to ffasl.c CVS log

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

Annotation of 3BSD/cmd/lisp/ffasl.c, revision 1.1.1.1

1.1       root        1: #include "global.h"
                      2: #include <a.out.h>
                      3: #define round(x,s) ((((x)-1) & ~((s)-1)) + (s))
                      4: 
                      5: char *stabf = 0;
                      6: int fvirgin = 1;
                      7: 
                      8: lispval
                      9: Lffasl(){
                     10:        register struct argent *mlbot = lbot;
                     11:        register lispval work;
                     12:        int fildes, totsize, readsize;
                     13:        lispval csegment();
                     14:        char *sbrk(), *currend, *tfile, cbuf[512], *mytemp(), *gstab();
                     15:        struct exec header;
                     16:        snpand(2);
                     17: 
                     18:        if(np - mlbot != 3 || TYPE(mlbot[1].val)!=ATOM)
                     19:                mlbot[1].val = error("Incorrect .o file specification",TRUE);
                     20:        if(np - mlbot != 3 || TYPE(mlbot[2].val)!=ATOM)
                     21:                mlbot[2].val = error("Incorrect entry specification for fasl"
                     22:                                        ,TRUE);
                     23:        if(np - mlbot != 3 || TYPE(mlbot[3].val)!=ATOM || mlbot[3].val==nil)
                     24:                mlbot[3].val = error( "Bad associated atom name for fasl",TRUE);
                     25: 
                     26:        /*
                     27:         * Invoke loader.
                     28:         */
                     29:        currend = sbrk(0);
                     30:        tfile = mytemp();
                     31:        sprintf(cbuf,
                     32:                "nld -A %s -T %x -N %s -e %s -o %s",
                     33:                gstab(),
                     34:                currend,
                     35:                mlbot[1].val->pname,
                     36:                mlbot[2].val->pname,
                     37:                tfile);
                     38:        printf(cbuf); fflush(stdout);
                     39:        if(system(cbuf)!=0) {
                     40:                unlink(tfile);
                     41:                return(nil);
                     42:        }
                     43:        if(fvirgin)
                     44:                fvirgin = 0;
                     45:        else
                     46:                unlink(stabf);
                     47:        stabf = tfile;
                     48:        if((fildes = open(tfile,0))<0)
                     49:                return(nil);
                     50:        /*
                     51:         * Read a.out header to find out how much room to
                     52:         * allocate and attempt to do so.
                     53:         */
                     54:        if(read(fildes,(char *)&header,sizeof(header)) <= 0) {
                     55:                close(fildes);
                     56:                return(nil);
                     57:        }
                     58:        readsize = header.a_text + header.a_data;
                     59:        totsize  = readsize + header.a_bss;
                     60:        totsize  = round(totsize,512);
                     61:        /*
                     62:         * Fix up system indicators, typing info, etc.
                     63:         */
                     64:        currend = (char *)csegment(int_name,totsize/4);
                     65:        
                     66:        if(readsize!=read(fildes,currend,readsize))
                     67:                return(nil);
                     68:        work = newfunct();
                     69:        work->entry = (lispval (*)())header.a_entry;
                     70:        work->discipline = lambda;
                     71:        return(mlbot[3].val->fnbnd = work);
                     72: }
                     73: #include "types.h"
                     74: #include <sys/stat.h>
                     75: static char myname[100];
                     76: char *
                     77: gstab()
                     78: {
                     79:        register char *cp, *cp2; char *getenv();
                     80:        struct stat stbuf;
                     81:        extern char **Xargv;
                     82: 
                     83:        if(stabf==0) {
                     84:                cp = getenv("PATH");
                     85:                if(cp==0)
                     86:                        cp=":/usr/ucb:/bin:/usr/bin";
                     87:                if(*cp==':') {
                     88:                        cp++;
                     89:                        if(stat(Xargv[0],&stbuf)==0) {
                     90:                                strcpy(myname,Xargv[0]);
                     91:                                return(stabf = myname);
                     92:                        }
                     93:                }
                     94:                for(;*cp;) {
                     95: 
                     96:                        /* copy over current directory
                     97:                           and then append argv[0] */
                     98: 
                     99:                        for(cp2=myname;(*cp)!=0 && (*cp)!=':';)
                    100:                                *cp2++ = *cp++;
                    101:                        *cp2++ = '/';
                    102:                        strcpy(cp2,Xargv[0]);
                    103:                        if(*cp) cp++;
                    104:                        if(0!=stat(myname,&stbuf)) continue;
                    105:                        return(stabf = myname);
                    106:                }
                    107:                error("Could not find which file is being executed.",FALSE);
                    108:        } else return (stabf);
                    109: }

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