Return to ffasl.c CVS log

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

Annotation of 40BSD/cmd/lisp/ffasl.c, revision 1.1

1.1     ! root        1: static char *sccsid = "@(#)ffasl.c     34.3 10/23/80";
        !             2: 
        !             3: #include "global.h"
        !             4: #include <sys/types.h>
        !             5: #include <pagsiz.h>
        !             6: #include <sys/stat.h>
        !             7: #include "naout.h"
        !             8: #define round(x,s) ((((x)-1) & ~((s)-1)) + (s))
        !             9: 
        !            10: char *stabf = 0;
        !            11: int fvirgin = 1;
        !            12: static seed=0, mypid = 0;
        !            13: lispval verify();
        !            14: 
        !            15: /* dispget - get discipline of function
        !            16:  * this is used to handle the tricky defaulting of the discipline
        !            17:  * field of such functions as cfasl and getaddress.
        !            18:  * dispget is given the value supplied by the caller,
        !            19:  *     the error message to print if something goes wrong,
        !            20:  *     the default to use if nil was supplied.
        !            21:  * the discipline can be an atom or string.  If an atom it is supplied
        !            22:  * it must be lambda, nlambda or macro.  Otherwise the atoms pname
        !            23:  * is used.
        !            24:  */
        !            25: 
        !            26: lispval 
        !            27: dispget(given,messg,defult)
        !            28: lispval given,defult;
        !            29: char *messg;
        !            30: {
        !            31:        int typ;
        !            32: 
        !            33:        while(TRUE)
        !            34:        {
        !            35:                if(given == nil) 
        !            36:                   return(defult);
        !            37:                if((typ=TYPE(given)) == ATOM)
        !            38:                {  if(given == lambda ||
        !            39:                      given == nlambda ||
        !            40:                      given == macro) return(given);
        !            41:                   else return((lispval) given->a.pname);
        !            42:                } else if(typ == STRNG) return(given);
        !            43: 
        !            44:                given = errorh(Vermisc,messg,nil,TRUE,0,given);
        !            45:        }
        !            46: }
        !            47: 
        !            48: lispval
        !            49: Lcfasl(){
        !            50:        register struct argent *mlbot = lbot;
        !            51:        register lispval work;
        !            52:        register int fildes, totsize;
        !            53:        int readsize;
        !            54:        register struct argent *lbot, *np;
        !            55:        lispval csegment();
        !            56:        char *sbrk(), *currend, *tfile, cbuf[6000], *mytemp(), *gstab();
        !            57:        char ostabf[128];
        !            58:        struct exec header;
        !            59:        char *largs;
        !            60:        snpand(4);
        !            61: 
        !            62:        switch(np-lbot) {
        !            63:           case 3: protect(nil);        /* no discipline given */
        !            64:           case 4: protect(nil);        /* no library given  */
        !            65:        }
        !            66:        chkarg(5,"cfasl");
        !            67:        mlbot[0].val = verify(mlbot[0].val,"Incorrect .o file specification");
        !            68:        mlbot[1].val = verify(mlbot[1].val,"Incorrect entry specification for cfasl");
        !            69:        mlbot[3].val = dispget(mlbot[3].val,"Incorrect discipline specification for cfasl",Vsubrou->a.pname);
        !            70:        while(TYPE(mlbot[2].val)!= ATOM) 
        !            71:        mlbot[2].val = errorh(Vermisc,"Bad associated atom name for fasl",
        !            72:                                                 nil,TRUE,0,mlbot[2].val);
        !            73:        work = mlbot[4].val;
        !            74:        if(work==nil)
        !            75:                largs = 0;
        !            76:        else 
        !            77:                largs = (char *) verify(work,"Bad loader flags");
        !            78: 
        !            79:        /*
        !            80:         * Invoke loader.
        !            81:         */
        !            82:        strcpy(ostabf,gstab());
        !            83:        currend = sbrk(0);
        !            84:        tfile = mytemp();
        !            85:        sprintf(cbuf,
        !            86:                "/usr/lib/lisp/nld -N -A %s -T %x %s -e %s -o %s %s -lc",
        !            87:                ostabf,
        !            88:                currend,
        !            89:                mlbot[0].val,
        !            90:                mlbot[1].val,
        !            91:                tfile,
        !            92:                largs);
        !            93:        printf(cbuf); fflush(stdout);
        !            94:        if(system(cbuf)!=0) {
        !            95:                unlink(tfile);
        !            96:                ungstab();
        !            97:                fprintf(stderr,"Ld returns error status\n");
        !            98:                return(nil);
        !            99:        }
        !           100:        putchar('\n'); fflush(stdout);
        !           101:        if(fvirgin)
        !           102:                fvirgin = 0;
        !           103:        else
        !           104:                unlink(ostabf);
        !           105:        stabf = tfile;
        !           106:        if((fildes = open(tfile,0))<0) {
        !           107:                fprintf(stderr,"Couldn't open temporary file: %s\n",tfile);
        !           108:                return(nil);
        !           109:        }
        !           110:        /*
        !           111:         * Read a.out header to find out how much room to
        !           112:         * allocate and attempt to do so.
        !           113:         */
        !           114:        if(read(fildes,(char *)&header,sizeof(header)) <= 0) {
        !           115:                close(fildes);
        !           116:                return(nil);
        !           117:        }
        !           118:        readsize = round(header.a_text,4) + round(header.a_data,4);
        !           119:        totsize  = readsize + header.a_bss;
        !           120:        totsize  = round(totsize,512);
        !           121:        /*
        !           122:         * Fix up system indicators, typing info, etc.
        !           123:         */
        !           124:        currend = (char *)csegment(str_name,totsize,FALSE);
        !           125:        
        !           126:        if(readsize!=read(fildes,currend,readsize))
        !           127:                return(nil);
        !           128:        work = newfunct();
        !           129:        work->bcd.entry = (lispval (*)())header.a_entry;
        !           130:        work->bcd.discipline = mlbot[3].val;
        !           131:        return(mlbot[2].val->a.fnbnd = work);
        !           132: }
        !           133: static char myname[100];
        !           134: char *
        !           135: gstab()
        !           136: {
        !           137:        register char *cp, *cp2; char *getenv();
        !           138:        struct stat stbuf;
        !           139:        extern char **Xargv;
        !           140: 
        !           141:        if(stabf==0) {
        !           142:                cp = getenv("PATH");
        !           143:                if(cp==0)
        !           144:                        cp=":/usr/ucb:/bin:/usr/bin";
        !           145:                if(*cp==':'||*Xargv[0]=='/') {
        !           146:                        cp++;
        !           147:                        if(stat(Xargv[0],&stbuf)==0) {
        !           148:                                strcpy(myname,Xargv[0]);
        !           149:                                return(stabf = myname);
        !           150:                        }
        !           151:                }
        !           152:                for(;*cp;) {
        !           153: 
        !           154:                        /* copy over current directory
        !           155:                           and then append argv[0] */
        !           156: 
        !           157:                        for(cp2=myname;(*cp)!=0 && (*cp)!=':';)
        !           158:                                *cp2++ = *cp++;
        !           159:                        *cp2++ = '/';
        !           160:                        strcpy(cp2,Xargv[0]);
        !           161:                        if(*cp) cp++;
        !           162:                        if(0!=stat(myname,&stbuf)) continue;
        !           163:                        return(stabf = myname);
        !           164:                }
        !           165:                error("Could not find which file is being executed.",FALSE);
        !           166:        } else return (stabf);
        !           167: }
        !           168: 
        !           169: static char mybuff[40]; 
        !           170: char *
        !           171: mytemp()
        !           172: {
        !           173:        if(mypid==0) mypid = getpid();
        !           174:        sprintf(mybuff,"/tmp/Li%d.%d",mypid,seed++);
        !           175:        return(mybuff);
        !           176: }
        !           177: ungstab()
        !           178: {
        !           179:        seed--;
        !           180:        sprintf(mybuff,"/tmp/Li%d.%d",mypid,seed-1);
        !           181:        if(seed==0) {
        !           182:                stabf = 0;
        !           183:                fvirgin = 1;
        !           184:        }
        !           185: }
        !           186: lispval
        !           187: verify(in,error)
        !           188: register lispval in;
        !           189: char *error;
        !           190: {
        !           191:        for(EVER) {
        !           192:                switch(TYPE(in)) {
        !           193:                case STRNG:
        !           194:                        return(in);
        !           195:                case ATOM:
        !           196:                        return((lispval)in->a.pname);
        !           197:                }
        !           198:                in = errorh(Vermisc,error,nil,TRUE,0,in);
        !           199:        }
        !           200: }

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