Return to ffasl.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / franz

Annotation of 43BSDTahoe/ucb/lisp/franz/ffasl.c, revision 1.1

1.1     ! root        1: #ifndef lint
        !             2: static char *rcsid =
        !             3:    "$Header: ffasl.c,v 1.11 87/12/14 18:48:06 sklower Exp $";
        !             4: #endif
        !             5: 
        !             6: /*                                     -[Mon Mar 21 19:37:21 1983 by jkf]-
        !             7:  *     ffasl.c                         $Locker:  $
        !             8:  * dynamically load C code
        !             9:  *
        !            10:  * (c) copyright 1982, Regents of the University of California
        !            11:  */
        !            12: 
        !            13: 
        !            14: #include "global.h"
        !            15: #include <sys/types.h>
        !            16: #include <sys/stat.h>
        !            17: #include <aout.h>
        !            18: #define round(x,s) ((((x)-1) & ~((s)-1)) + (s))
        !            19: 
        !            20: char *stabf = 0, *strcpy(), *Ilibdir();
        !            21: extern int fvirgin;
        !            22: static seed=0, mypid = 0;
        !            23: static char myname[100];
        !            24: lispval verify();
        !            25: 
        !            26: /* dispget - get discipline of function
        !            27:  * this is used to handle the tricky defaulting of the discipline
        !            28:  * field of such functions as cfasl and getaddress.
        !            29:  * dispget is given the value supplied by the caller,
        !            30:  *     the error message to print if something goes wrong,
        !            31:  *     the default to use if nil was supplied.
        !            32:  * the discipline can be an atom or string.  If an atom it is supplied
        !            33:  * it must be lambda, nlambda or macro.  Otherwise the atoms pname
        !            34:  * is used.
        !            35:  */
        !            36: 
        !            37: lispval 
        !            38: dispget(given,messg,defult)
        !            39: lispval given,defult;
        !            40: char *messg;
        !            41: {
        !            42:        int typ;
        !            43: 
        !            44:        while(TRUE)
        !            45:        {
        !            46:                if(given == nil) 
        !            47:                   return(defult);
        !            48:                if((typ=TYPE(given)) == ATOM)
        !            49:                {  if(given == lambda ||
        !            50:                      given == nlambda ||
        !            51:                      given == macro) return(given);
        !            52:                   else return((lispval) given->a.pname);
        !            53:                } else if(typ == STRNG) return(given);
        !            54: 
        !            55:                given = errorh1(Vermisc,messg,nil,TRUE,0,given);
        !            56:        }
        !            57: }
        !            58: 
        !            59: lispval
        !            60: Lcfasl(){
        !            61:        register struct argent *mlbot = lbot;
        !            62:        register lispval work;
        !            63:        register int fildes, totsize;
        !            64:        int readsize;
        !            65:        lispval csegment();
        !            66:        char *sbrk(), *currend, *tfile, cbuf[6000], *mytemp(), *gstab();
        !            67:        char ostabf[128];
        !            68:        struct exec header;
        !            69:        char *largs;
        !            70:        Savestack(4);
        !            71: 
        !            72:        switch(np-lbot) {
        !            73:           case 3: protect(nil);        /* no discipline given */
        !            74:           case 4: protect(nil);        /* no library given  */
        !            75:        }
        !            76:        chkarg(5,"cfasl");
        !            77:        mlbot[0].val = verify(mlbot[0].val,"Incorrect .o file specification");
        !            78:        mlbot[1].val = verify(mlbot[1].val,"Incorrect entry specification for cfasl");
        !            79:        mlbot[3].val = dispget(mlbot[3].val,"Incorrect discipline specification for cfasl",(lispval)Vsubrou->a.pname);
        !            80:        while(TYPE(mlbot[2].val)!= ATOM) 
        !            81:        mlbot[2].val = errorh1(Vermisc,"Bad associated atom name for fasl",
        !            82:                                                 nil,TRUE,0,mlbot[2].val);
        !            83:        work = mlbot[4].val;
        !            84:        if(work==nil)
        !            85:                largs = 0;
        !            86:        else 
        !            87:                largs = (char *) verify(work,"Bad loader flags");
        !            88: 
        !            89:        /*
        !            90:         * Invoke loader.
        !            91:         */
        !            92:        strcpy(ostabf,gstab());
        !            93:        currend = sbrk(0);
        !            94: #if (!os_vms) | EUNICE_UNIX_OBJECT_FILE_CFASL
        !            95:                        /*** UNIX cfasl code ***/
        !            96:        tfile = mytemp();
        !            97:        sprintf(cbuf,
        !            98:                "%s/nld -N -x -A %s -T %x %s -e %s -o %s %s -lc",
        !            99:                Ilibdir(),
        !           100:                ostabf,
        !           101:                currend,
        !           102:                mlbot[0].val,
        !           103:                mlbot[1].val,
        !           104:                tfile,
        !           105:                largs);
        !           106:        /* if nil don't print cfasl/nld message */
        !           107:        if ( Vldprt->a.clb != nil ) {
        !           108:                printf(cbuf);
        !           109:                putchar('\n'); fflush(stdout);
        !           110:        }
        !           111:        if(system(cbuf)!=0) {
        !           112:                unlink(tfile);
        !           113:                ungstab();
        !           114:                fprintf(stderr,"Ld returns error status\n");
        !           115:                Restorestack();
        !           116:                return(nil);
        !           117:        }
        !           118:        if(fvirgin)
        !           119:                fvirgin = 0;
        !           120:        else
        !           121:                unlink(ostabf);
        !           122:        stabf = tfile;
        !           123:        if((fildes = open(tfile,0))<0) {
        !           124:                fprintf(stderr,"Couldn't open temporary file: %s\n",tfile);
        !           125:                Restorestack();
        !           126:                return(nil);
        !           127:        }
        !           128:        /*
        !           129:         * Read a.out header to find out how much room to
        !           130:         * allocate and attempt to do so.
        !           131:         */
        !           132:        if(read(fildes,(char *)&header,sizeof(header)) <= 0) {
        !           133:                close(fildes);
        !           134:                Restorestack();
        !           135:                return(nil);
        !           136:        }
        !           137:        readsize = round(header.a_text,4) + round(header.a_data,4);
        !           138:        totsize  = readsize + header.a_bss;
        !           139:        totsize  = round(totsize,512);
        !           140:        /*
        !           141:         * Fix up system indicators, typing info, etc.
        !           142:         */
        !           143:        currend = (char *)csegment(OTHER,totsize,FALSE);
        !           144:        
        !           145:        if(readsize!=read(fildes,currend,readsize))
        !           146:                {close(fildes);Restorestack(); return(nil);}
        !           147:        work = newfunct();
        !           148:        work->bcd.start = (lispval (*)())header.a_entry;
        !           149:        work->bcd.discipline = mlbot[3].val;
        !           150:        close(fildes);
        !           151:        Restorestack();
        !           152:        return(mlbot[2].val->a.fnbnd = work);
        !           153: #else
        !           154:                        /*** VMS cfasl code ***/
        !           155:        {
        !           156:          int pid = getpid() & 0xffff;  /* Our process ID number */
        !           157:          char objfil[100];             /* Absolute object file name */
        !           158:          char symfil[100];             /* Old symbol table file */
        !           159:          char filename[100];           /* Random filename buffer */
        !           160:          int strlen();                 /* String length function */
        !           161:          int cvt_unix_to_vms();        /* Convert UNIX to VMS filename */
        !           162:          lispval Lgetaddress(),matom();
        !           163:          struct stat stbuf;
        !           164: 
        !           165:          if (largs == 0) largs = " ";
        !           166:          sprintf(objfil,"tmp:cfasl%d.tmp",pid);
        !           167:          symfil[cvt_unix_to_vms(ostabf,symfil)] = 0;
        !           168:          sprintf(cbuf,                                 /* Create link cmd. */
        !           169:                "$ link/exe=%s/nom/syst=%%X%x/sym=tmp:sym%d.new %s,%s%s",
        !           170:                objfil,
        !           171:                currend,
        !           172:                pid,
        !           173:                mlbot[0].val,
        !           174:                symfil,
        !           175:                largs);
        !           176:          printf(                                       /* Echo link cmd. */
        !           177:                "$ link/exe=%s/nomap/system=%%X%x/symbol_table=tmp:sym%d.new %s,%s%s\n",
        !           178:                objfil,
        !           179:                currend,
        !           180:                pid,
        !           181:                mlbot[0].val,
        !           182:                symfil,
        !           183:                largs);
        !           184:          fflush(stdout);
        !           185:          vms_system(cbuf,0);
        !           186: 
        !           187:          if ((fildes = open(objfil,0)) < 0) /* Open abs file */
        !           188:                {Restorestack(); return(nil);}
        !           189:          fstat(fildes,&stbuf);                         /* Get its size */
        !           190:          readsize=stbuf.st_size;
        !           191:          currend = (char *)csegment(OTHER,readsize,FALSE);
        !           192:          readsize = read(fildes,currend,10000000);
        !           193:          close(fildes);
        !           194:          /*
        !           195:           * Delete the absolute object file
        !           196:           */
        !           197:          unlink(objfil);
        !           198:          /*
        !           199:           * Delete the old symbol table (if temporary)
        !           200:           */
        !           201:          sprintf(filename,"tmp:sym%d.stb",pid);
        !           202:          unlink(filename);
        !           203:          /*
        !           204:           * Rename the new symbol table so it is now the old symbol table
        !           205:           */
        !           206:          sprintf(symfil,"tmp:sym%d.new",pid);
        !           207:          link(symfil,filename);
        !           208:          unlink(symfil);
        !           209:          sprintf(myname,"tmp:sym%d.stb",pid);
        !           210:          stabf = myname;
        !           211:          /*
        !           212:           * Return  Lgetaddress(entry,function_name,discipline)
        !           213:           */
        !           214:          {
        !           215:             struct argent *oldlbot, *oldnp;
        !           216:             lispval result;
        !           217: 
        !           218:             oldlbot = lbot;
        !           219:             oldnp = np;
        !           220:             lbot = np;
        !           221:             np++->val = matom(mlbot[1].val);
        !           222:             np++->val = mlbot[2].val;
        !           223:             np++->val = matom(mlbot[3].val);
        !           224:             result = Lgetaddress();
        !           225:             lbot = oldlbot;
        !           226:             np = oldnp;
        !           227:             return(result);
        !           228:          }
        !           229:        }
        !           230: #endif
        !           231: }
        !           232: #ifdef os_vms
        !           233: #define M 4
        !           234: #else
        !           235: #define M 1
        !           236: #endif
        !           237: #define oktox(n) \
        !           238:        (0==stat(n,&stbuf)&&(stbuf.st_mode&S_IFMT)==S_IFREG&&0==access(n,M))
        !           239: char *
        !           240: gstab()
        !           241: {
        !           242:        register char *cp, *cp2; char *getenv();
        !           243:        struct stat stbuf;
        !           244:        extern char **Xargv;
        !           245: 
        !           246:        if(stabf==0) {
        !           247:                cp = getenv("PATH");
        !           248:                if(cp==0)
        !           249:                        cp=":/usr/ucb:/bin:/usr/bin";
        !           250:                if(*cp==':'||*Xargv[0]=='/') {
        !           251:                        cp++;
        !           252:                        if(oktox(Xargv[0])) {
        !           253:                                strcpy(myname,Xargv[0]);
        !           254:                                return(stabf = myname);
        !           255:                        }
        !           256: #ifdef os_vms
        !           257:                        /*
        !           258:                         *      Try Xargv[0] with ".stb" concatenated
        !           259:                         */
        !           260:                        strcpy(myname,Xargv[0]);
        !           261:                        strcat(myname,".stb");
        !           262:                        if (oktox(myname)) return(stabf = myname);
        !           263:                        /*
        !           264:                         *      Try Xargv[0] with ".exe" concatenated
        !           265:                         */
        !           266:                        strcpy(myname,Xargv[0]);
        !           267:                        strcat(myname,".exe");
        !           268:                        if (oktox(myname)) return(stabf = myname);
        !           269: #endif
        !           270:                }
        !           271:                for(;*cp;) {
        !           272: 
        !           273:                        /* copy over current directory
        !           274:                           and then append argv[0] */
        !           275: 
        !           276:                        for(cp2=myname;(*cp)!=0 && (*cp)!=':';)
        !           277:                                *cp2++ = *cp++;
        !           278:                        *cp2++ = '/';
        !           279:                        strcpy(cp2,Xargv[0]);
        !           280:                        if(*cp) cp++;
        !           281: #ifndef        os_vms
        !           282:                        if(!oktox(myname)) continue;
        !           283: #else
        !           284:                        /*
        !           285:                         *      Also try ".stb" and ".exe" in VMS
        !           286:                         */
        !           287:                        if(!oktox(myname)) {
        !           288:                                char *end_of_name;
        !           289:                                end_of_name = cp2 + strlen(cp2);
        !           290:                                strcat(cp2,".stb");
        !           291:                                if(!oktox(myname)) {
        !           292:                                        /*
        !           293:                                         *      Try ".exe"
        !           294:                                         */
        !           295:                                        *end_of_name = 0;   /* Kill ".stb" */
        !           296:                                        strcat(cp2,".exe");
        !           297:                                        if (!oktox(myname)) continue;
        !           298:                                }
        !           299:                        }
        !           300: #endif
        !           301:                        return(stabf = myname);
        !           302:                }
        !           303:                /* one last try for dual systems */
        !           304:                strcpy(myname,Xargv[0]);
        !           305:                if(oktox(myname)) return(stabf = myname);
        !           306:                error("Could not find which file is being executed.",FALSE);
        !           307:                /* NOTREACHED */
        !           308:        } else return (stabf);
        !           309: }
        !           310: static char mybuff[40]; 
        !           311: char *
        !           312: mytemp()
        !           313: {
        !           314:        /*if(mypid==0) mypid = (getpid() & 0xffff);
        !           315:          fails if you do a dumplisp after doing a
        !           316:          cfasl */
        !           317:        sprintf(mybuff,"/tmp/Li%d.%d",(getpid() & 0xffff),seed++);
        !           318:        return(mybuff);
        !           319: }
        !           320: ungstab()
        !           321: {
        !           322:        seed--;
        !           323:        sprintf(mybuff,"/tmp/Li%d.%d",(getpid() & 0xffff),seed-1);
        !           324:        if(seed==0) {
        !           325:                stabf = 0;
        !           326:                fvirgin = 1;
        !           327:        }
        !           328: }
        !           329: lispval
        !           330: verify(in,error)
        !           331: register lispval in;
        !           332: char *error;
        !           333: {
        !           334:        for(EVER) {
        !           335:                switch(TYPE(in)) {
        !           336:                case STRNG:
        !           337:                        return(in);
        !           338:                case ATOM:
        !           339:                        return((lispval)in->a.pname);
        !           340:                }
        !           341:                in = errorh1(Vermisc,error,nil,TRUE,0,in);
        !           342:        }
        !           343: }
        !           344: 
        !           345: 
        !           346: /* extern      int fvirgin; */
        !           347:                        /* declared in ffasl.c tells if this is original
        !           348:                         *      lisp symbol table.
        !           349:                         * if fvirgin is 1 then we must copy the symbol
        !           350:                         *      table, else we can overwrite it, since
        !           351:                         *      it is a temporary file which only
        !           352:                         *      one user could be using(was not created
        !           353:                         *      as an original lisp or by a (dumplisp)
        !           354:                         *      or a (savelisp)).
        !           355:                         */
        !           356: 
        !           357: /* copy a block of data from one file to another of size size */
        !           358: copyblock(f1,f2,size)
        !           359: FILE *f1, *f2;
        !           360: long size;
        !           361: {
        !           362:        char block[BUFSIZ];
        !           363: 
        !           364:            while ( size > BUFSIZ ) {
        !           365:                size -= BUFSIZ;
        !           366:                fread(block,BUFSIZ,1,f1);
        !           367:                fwrite(block,BUFSIZ,1,f2);
        !           368:            }
        !           369:            if (size > 0 ) {
        !           370:                fread(block,(int)size,1,f1);
        !           371:                fwrite(block,(int)size,1,f2);
        !           372:            }
        !           373: }
        !           374: 
        !           375: /* removeaddress --
        !           376:  *
        !           377:  * (removeaddress '|_entry1| '|_entry2| ...)
        !           378:  *
        !           379:  *     removes the given entry points from the run time symbol table,
        !           380:  *             so that later cfasl'd files can have these label names.
        !           381:  *
        !           382:  */
        !           383: 
        !           384: lispval
        !           385: Lrmadd(){
        !           386:        register struct argent *mlbot = lbot;
        !           387:        register struct nlist *q; 
        !           388:        register int i;
        !           389:        int numberofargs, strsize;
        !           390:        char *gstab();
        !           391:        char ostabf[128];
        !           392:        char *nstabf,*mytemp();
        !           393:        char *strtbl,*alloca();
        !           394:        int i2, n, m, nargleft, savem;
        !           395:        FILE *f, *fa;
        !           396:        FILE *fnew;
        !           397:        off_t savesymadd,symadd;                /* symbol address */
        !           398:        struct exec buf;
        !           399:        struct nlist nlbuf[BUFSIZ/sizeof (struct nlist)];
        !           400:        int maxlen;
        !           401:        int change;
        !           402:        Keepxs();
        !           403: 
        !           404:        numberofargs = (np - lbot);
        !           405:        nargleft = numberofargs;
        !           406:        maxlen = 0;
        !           407:        for ( i=0; i<numberofargs; i++,mlbot ++) {
        !           408:                mlbot->val = verify(mlbot->val,"Incorrect entry specification.");
        !           409:                n = strlen((char *)mlbot->val);
        !           410:                if (n > maxlen)
        !           411:                        maxlen = n;
        !           412:        }
        !           413:        /* 
        !           414:         *  Must not disturb object file if it an original file which
        !           415:         *      other users can execute(signified by the variable fvirgin).
        !           416:         *      so the entire symbol table is copied to a new file.
        !           417:         */
        !           418:        if (fvirgin) {
        !           419:                strncpy(ostabf,gstab(),128);
        !           420:                nstabf = mytemp();
        !           421:                /*
        !           422:                 * copy over symbol table into a temporary file first
        !           423:                 *
        !           424:                 */
        !           425:                f = fopen(ostabf, "r");
        !           426:                fnew = fopen(nstabf, "w");
        !           427:                if (( f == NULL ) || (fnew == NULL)) {Freexs(); return( nil );}
        !           428:                /* read exec header on file */
        !           429: #ifndef        os_vms
        !           430:                fread((char *)&buf, sizeof buf, 1, f);
        !           431: #else  os_vms
        !           432:                /*
        !           433:                 *      Under VMS/EUNICE we have to try the 1st 512 byte
        !           434:                 *      block and the 2nd 512 byte block (there may be
        !           435:                 *      a VMS header in the 1st 512 bytes).
        !           436:                 */
        !           437:                get_aout_header(fileno(f),&buf);
        !           438: #endif os_vms
        !           439: 
        !           440:                /* Is this a legitimate a.out file? */
        !           441:                if (N_BADMAG(buf)) {
        !           442:                        unlink(nstabf);
        !           443:                        ungstab();
        !           444:                        fclose(f);
        !           445:                        fclose(fnew);
        !           446:                        errorh1(Vermisc,"Removeaddress: Bad file",nil,FALSE,0,inewstr(ostabf));
        !           447:                        {Freexs(); return(nil);}
        !           448:                }
        !           449:                /* set pointer on read file to symbol table */
        !           450:                /* must be done before the structure buf is reassigned 
        !           451:                 * so that it will be accurate for the read file 
        !           452:                 */
        !           453:                fseek(f,(long)N_SYMOFF(buf),0);
        !           454:                /* reset up exec header structure for new file */
        !           455:                buf.a_magic = OMAGIC;
        !           456:                buf.a_text = 0;
        !           457:                buf.a_data = 0;
        !           458:                buf.a_bss = 0;
        !           459:                buf.a_entry = 0;
        !           460:                buf.a_trsize = 0;
        !           461:                buf.a_drsize = 0;
        !           462:                fwrite((char *)&buf,
        !           463:                       sizeof buf,1,fnew);      /* write out exec header */
        !           464:                copyblock(f,fnew,(long)buf.a_syms); /* copy symbol table */
        !           465: #if ! (os_unisoft | os_unix_ts)
        !           466:                fread((char *)&strsize,
        !           467:                      sizeof (int),1,f);        /* find size of string table */
        !           468:                fwrite((char *)&strsize,
        !           469:                      sizeof (int),1,fnew);     /* find size of string table */
        !           470:                strsize -= 4;
        !           471:                strtbl = alloca(strsize);
        !           472:                fread(strtbl,strsize,1,f);      /* read and save string table*/
        !           473:                fwrite(strtbl,strsize,1,fnew);  /* copy out string table     */
        !           474: #endif
        !           475:                fclose(f);fclose(fnew);
        !           476:        } else {
        !           477:                nstabf = gstab();
        !           478:        }
        !           479: 
        !           480:        /*
        !           481:         * now unset the external bits it the entry points specified.
        !           482:         */
        !           483:        f = fopen(nstabf, "r");
        !           484:        fa = fopen(nstabf, "a");
        !           485:        if (( f == NULL ) || (fa == NULL)) {
        !           486:                unlink(nstabf);
        !           487:                ungstab();
        !           488:                if (f != NULL ) fclose(f);
        !           489:                if (fa != NULL ) fclose(fa);
        !           490:                return ( nil );
        !           491:        }
        !           492: 
        !           493:        /* read exec header on file */
        !           494: #ifndef        os_vms
        !           495:        fread((char *)&buf, sizeof buf, 1, f);
        !           496: #else  os_vms
        !           497:        /*
        !           498:         *      Under VMS/EUNICE we have to try the 1st 512 byte
        !           499:         *      block and the 2nd 512 byte block (there may be
        !           500:         *      a VMS header in the 1st 512 bytes).
        !           501:         */
        !           502:        get_aout_header(fileno(f),&buf);
        !           503: #endif os_vms
        !           504: 
        !           505:        /* Is this a legitimate a.out file? */
        !           506:        if (N_BADMAG(buf)) {
        !           507:                if (fvirgin) {
        !           508:                        unlink(nstabf);
        !           509:                        ungstab();
        !           510:                }
        !           511:                fclose(f);
        !           512:                fclose(fa);
        !           513:                errorh1(Vermisc,"Removeaddress: Bad file",nil,FALSE,0,inewstr(ostabf));
        !           514:                {Freexs(); return(nil);}
        !           515:        } else {
        !           516:                symadd = N_SYMOFF(buf);
        !           517: #if ! (os_unisoft | os_unix_ts)
        !           518:                /*
        !           519:                 * read in string table if not done during copying
        !           520:                 */
        !           521:                if (fvirgin==0){
        !           522:                        fseek(f,(long)N_STROFF(buf),0);
        !           523:                        fread((char *)&strsize,sizeof (int),1,f);
        !           524:                        strsize -= 4;
        !           525:                        strtbl = alloca(strsize);
        !           526:                        fread(strtbl,strsize,1,f);
        !           527:                }
        !           528: #endif
        !           529:                n = buf.a_syms;
        !           530:                fseek(f, (long)symadd, 0);
        !           531:                while (n) {
        !           532:                        m = sizeof (nlbuf);
        !           533:                        if (n < m)
        !           534:                                m = n;
        !           535: 
        !           536:                        /* read next block of symbols from a.out file */
        !           537:                        fread((char *)nlbuf, m, 1, f);
        !           538:                        savem = m;
        !           539:                        savesymadd = symadd;
        !           540:                        symadd += m;
        !           541:                        n -= m;
        !           542:                        change = 0;
        !           543: 
        !           544:                /* compare block of symbols against list of entry point
        !           545:                 *      names given, if a match occurs, clear the N_EXT bit
        !           546:                 *      for that given symbol and signal a change.
        !           547:                 */
        !           548:                        for (q = nlbuf; (m -= sizeof(struct nlist)) >= 0; q++) {
        !           549: 
        !           550:               /* make sure it is external */
        !           551:                                if (
        !           552:                                    (q->n_type & N_EXT)==0
        !           553: #if ! (os_unix_ts | os_unisoft)
        !           554:                                    || q->n_un.n_strx == 0 || q->n_type & N_STAB
        !           555: #endif
        !           556:                                   )    continue;
        !           557:                        for (mlbot=lbot,i2 = 0;i2<numberofargs;i2++,mlbot++) {
        !           558: #if ! (os_unix_ts | os_unisoft)
        !           559:                                if(strcmp((char *)mlbot->val,
        !           560:                                          strtbl+q->n_un.n_strx-4)!=0)
        !           561:                                                continue;
        !           562: #else
        !           563:                                if(strncmp((char *)mlbot->val,
        !           564:                                           q->n_name,8)!=0)
        !           565:                                                continue;
        !           566: #endif
        !           567:                                change = 1;
        !           568:                                q->n_type &= ~N_EXT;
        !           569:                                break;
        !           570:                        }
        !           571:                }
        !           572:                if ( change ) {
        !           573:                        fseek(fa,(long)savesymadd,0);
        !           574:                        fwrite((char *)nlbuf, savem, 1, fa);
        !           575:                        if (--nargleft == 0)
        !           576:                                goto alldone;
        !           577:                }
        !           578:                }
        !           579:        }
        !           580: alldone:
        !           581:        fclose(f);
        !           582:        fclose(fa);
        !           583:        if(fvirgin)
        !           584:                fvirgin = 0;
        !           585:        stabf = nstabf;
        !           586:        {Freexs(); return(tatom);}
        !           587: }
        !           588: char *
        !           589: Ilibdir()
        !           590: {
        !           591:        register lispval handy;
        !           592: tryagain:
        !           593:        handy = Vlibdir->a.clb;
        !           594:        switch(TYPE(handy)) {
        !           595:        case ATOM:
        !           596:                handy = (lispval) handy->a.pname;
        !           597:        case STRNG:
        !           598:                break;
        !           599:        default:
        !           600:                (void) error(
        !           601: "cfasl or load: lisp-library-directory not bound to string or atom",
        !           602:                                TRUE);
        !           603:                goto tryagain;
        !           604:        }
        !           605:        return((char *) handy);
        !           606: }

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