Return to ai.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src

Annotation of 43BSD/contrib/apl/src/ai.c, revision 1.1

1.1     ! root        1: static char Sccsid[] = "ai.c @(#)ai.c  1.2     10/1/82 Berkeley ";
        !             2: #include <signal.h>
        !             3: #include "apl.h"
        !             4: 
        !             5: char *bad_fn  = "apl.badfn";
        !             6: int prolgerr;          /* Flag -- set if bad fetch in prologue */
        !             7: 
        !             8: /*
        !             9:  * funedit -- edit a file and read it in.
        !            10:  *
        !            11:  * If the arg to funedit is non-zero, it is used as a 
        !            12:  * pointer to the file name to be used.  If it is zero,
        !            13:  * the namep of the function is used for the file name.
        !            14:  */
        !            15: funedit(fname, editor)
        !            16: char *fname;
        !            17: {
        !            18:        register struct item *p;
        !            19:        register f, (*a)();
        !            20:        char *c;
        !            21:        extern edmagic;
        !            22: 
        !            23:        p = sp[-1];
        !            24:        if(p->type != LV)
        !            25:                error("fed B");
        !            26:        sichk(p);
        !            27:        if(fname == 0)
        !            28:                fname = ((struct nlist *)p)->namep;
        !            29:        a = signal(SIGINT, SIG_IGN);
        !            30:        f = FORKF(1);
        !            31:        if(f == 0) {
        !            32:                for(f=3; f<7; f++)
        !            33:                        close(f);
        !            34:                c = (editor == DEL ? "/usr/bin/apldel" : "/usr/local/xed");
        !            35:                execl(c+9, c+9, fname, "-f", apl_term ? "-A":"-a", "-p", edmagic ? "-r":0, 0);
        !            36:                execl(c+4, c+9, fname, "-f", apl_term ? "-A":"-a", "-p", edmagic ? "-r":0, 0);
        !            37:                execl(c, c+9, fname, "-f", apl_term ? "-A":"-a", "-p", edmagic ? "-r":0, 0);
        !            38:                printf("cannot find the editor!\n");
        !            39:                exit(1);
        !            40:        }
        !            41:        if(f == -1)
        !            42:                error("try again");
        !            43:        while(wait(0) != f)
        !            44:                ;
        !            45:        signal(SIGINT, a);
        !            46: 
        !            47:        /* Read function into workspace.  If "funread" (which calls
        !            48:         * "fundef") returns 0, an error occurred in processing the
        !            49:         * header (line 0).  If this happened with "editf" or "del",
        !            50:         * save the bad function in the file "bad_fn".
        !            51:         */
        !            52: 
        !            53:        if (funread(fname) == 0 && fname == scr_file){
        !            54:                unlink(bad_fn);
        !            55:                if (badfnsv(fname))
        !            56:                        printf("function saved in %s\n", bad_fn);
        !            57:        }
        !            58: }
        !            59: 
        !            60: 
        !            61: funread(fname)
        !            62: char *fname;
        !            63: {
        !            64:        register struct item *p;
        !            65:        register f, pid;
        !            66: 
        !            67:        p = sp[-1];
        !            68:        sp--;
        !            69:        if(p->type != LV)
        !            70:                error("fnl B");
        !            71:        if(fname == 0)
        !            72:                fname = ((struct nlist *)p)->namep;
        !            73:        f = opn(fname, 0);
        !            74:        return(fundef(f));
        !            75: }
        !            76: 
        !            77: funwrite(fname)
        !            78: char *fname;
        !            79: {
        !            80:        register struct nlist *n;
        !            81:        register i, cnt;
        !            82:        int fd1, fd2;
        !            83:        char buf[512];
        !            84: 
        !            85:        n = (struct nlist *)sp[-1];
        !            86:        sp--;
        !            87:        if(n->type != LV)
        !            88:                error("fnwrite B");
        !            89:        if(fname ==0)
        !            90:                fname = n->namep;
        !            91:        fd1 = opn(fname, 0644);
        !            92:        switch(n->use){
        !            93:        default:
        !            94:                CLOSEF(fd1);
        !            95:                error("fnwrite T");
        !            96: 
        !            97:        case 0:                 /* undefined fn */
        !            98:                printf("\t[new fn]\n");
        !            99:                break;          /* empty file already created -- do nothing */
        !           100: 
        !           101:        case NF:
        !           102:        case MF:
        !           103:        case DF:
        !           104:                fd2 = DUPF(wfile);
        !           105:                SEEKF(fd2, (long)n->label, 0);
        !           106:                do {
        !           107:                        cnt = READF(fd2, buf, 512);
        !           108:                        if(cnt <= 0)
        !           109:                                error("fnwrite eof");
        !           110:                        for(i=0; i<cnt; i++)
        !           111:                                if(buf[i] == 0)
        !           112:                                        break;
        !           113:                        WRITEF(fd1, buf, i);
        !           114:                } while(i == 512);
        !           115:                CLOSEF(fd2);
        !           116:                break;
        !           117:        }
        !           118:        CLOSEF(fd1);
        !           119: }
        !           120: 
        !           121: fundef(f)
        !           122: {
        !           123:        register a, c;
        !           124:        struct nlist *np;
        !           125:        char b[512];
        !           126: 
        !           127:        ifile = f;
        !           128:        a = rline(0);
        !           129:        if(a == 0)
        !           130:                error("fnd eof");
        !           131:        c = compile(a, 2);
        !           132:        free(a);
        !           133:        if(c == 0)
        !           134:                goto out;
        !           135:        copy(IN, c+1, &np, 1);
        !           136:        sichk(np);
        !           137:        erase(np);
        !           138:        np->use = ((struct chrstrct *)c)->c[0];
        !           139:        np->label = SEEKF(wfile, 0L, 2);
        !           140:        SEEKF(ifile, 0L, 0);
        !           141:        while((a=READF(ifile, b, 512)) > 0)
        !           142:                WRITEF(wfile, b, a);
        !           143:        WRITEF(wfile, "", 1);
        !           144: out:
        !           145:        CLOSEF(ifile);
        !           146:        ifile = 0;
        !           147:        return(c);
        !           148: }
        !           149: 
        !           150: data lnumb;
        !           151: char *labcpp,*labcpe;
        !           152: 
        !           153: funcomp(np)
        !           154: struct nlist *np;
        !           155: {
        !           156:        register char *a, *c;
        !           157:        register  *p;
        !           158:        int i, err, size;
        !           159:        char labp[MAXLAB*20], labe[MAXLAB*4];
        !           160: 
        !           161:        ifile = DUPF(wfile);
        !           162:        SEEKF(ifile, (long)np->label, 0);
        !           163:        size = 0;
        !           164:        err = 0;
        !           165: 
        !           166:        labgen = 0;
        !           167: pass1:
        !           168:        a = rline(0);
        !           169:        if(a == 0) {
        !           170:                if(err)
        !           171:                        goto out;
        !           172:                p = (int *)alloc((size+2)*SINT);
        !           173:                *p = size;
        !           174:                size = 0;
        !           175:                SEEKF(ifile, (long)np->label, 0);
        !           176:                err++;
        !           177:                labcpp = labp;
        !           178:                labcpe = labe;
        !           179:                labgen = 1;
        !           180:                goto pass2;
        !           181:        }
        !           182:        c = compile(a, size==0? 3: 5);
        !           183:        size++;
        !           184:        free(a);
        !           185:        if(c == 0) {
        !           186:                err++;
        !           187:                goto pass1;
        !           188:        }
        !           189:        free(c);
        !           190:        goto pass1;
        !           191: 
        !           192: pass2:
        !           193:        a = rline(0);
        !           194:        if(a == 0)
        !           195:                goto pass3;
        !           196:        lnumb = size;
        !           197:        c = compile(a, size==0? 3: 5);
        !           198:        size++;
        !           199:        free(a);
        !           200:        if(c == 0)
        !           201:                goto out;
        !           202:        p[size] = c;
        !           203:        goto pass2;
        !           204: 
        !           205: pass3:
        !           206:        labgen = 0;
        !           207:        SEEKF(ifile, (long)np->label, 0);
        !           208:        a = rline(0);
        !           209:        if(a == 0){
        !           210:                err++;
        !           211:                goto out;
        !           212:        }
        !           213:        c = compile(a, 4);
        !           214:        free(a);
        !           215:        if(c == 0)
        !           216:                goto out;
        !           217:        if(labcpp != labp){
        !           218:                reverse(labe);
        !           219:                p[size+1] = catcode(labe, c);
        !           220:                free(c);
        !           221:                /*
        !           222:                /*              *** KLUDGE ***
        !           223:                /*
        !           224:                /* due to the "line-at-a-time" nature of the parser,
        !           225:                /* we have to screw around with the compiled strings.
        !           226:                /*
        !           227:                /* At this point, we have:
        !           228:                /*
        !           229:                /* fn-prologue (p[1]):          <AUTOs and ARGs>, ELID, EOF
        !           230:                /* label-prologue (labp):       <AUTOs and LABELs>, EOF
        !           231:                /* 
        !           232:                /* and we want to produce:
        !           233:                /* 
        !           234:                /* fn-prologue (p[1]):  <AUTOs and ARGs>,<AUTOs and LABELs>,  ELID, EOF.
        !           235:                 */
        !           236:                a = csize(p[1]) - 1;
        !           237:                c = csize(labp) - 1;
        !           238:                /*
        !           239:                 * if there is an ELID at the end of the fn-prologue,
        !           240:                 * move it to  the end of the label-prologue.
        !           241:                 */
        !           242:                if (p[1]->c[(int)a-1] == ELID){
        !           243:                        p[1]->c[(int)a-1] = EOF;
        !           244:                        labp[(int)c] = ELID;
        !           245:                        labp[(int)c+1] = EOF;
        !           246:                } else
        !           247:                        error("elid B");
        !           248:                /* *** END KLUDGE *** */
        !           249:                a = p[1];
        !           250:                p[1] = catcode(a,labp);
        !           251:                free(a);
        !           252:        } else
        !           253:                p[size+1] = c;
        !           254:        if(debug) {
        !           255:                dump(p[1], 1);
        !           256:                dump(p[size+1], 1);
        !           257:        }
        !           258:        np->itemp = (struct item *)p;
        !           259:        err = 0;
        !           260: 
        !           261: out:
        !           262:        CLOSEF(ifile);
        !           263:        ifile = 0;
        !           264:        if(err)
        !           265:                error("syntax");
        !           266: }
        !           267: 
        !           268: ex_fun()
        !           269: {
        !           270:        struct nlist *np;
        !           271:        register *p, s;
        !           272:        struct si si;
        !           273: 
        !           274:        pcp += copy(IN, pcp, &np, 1);
        !           275:        if (np->use < NF || np->use > DF) {
        !           276:                printf("%s: ", np->namep);
        !           277:                error("not a fn");
        !           278:        }
        !           279:        if(np->itemp == 0)
        !           280:                funcomp(np);
        !           281:        p = (int *)np->itemp;
        !           282:        /* setup new state indicator */
        !           283:        si.sip = gsip;
        !           284:        gsip = &si;
        !           285:        si.np = np;
        !           286:        si.oldsp = 0;           /* we can add a more complicated version, later */
        !           287:        si.oldpcp = pcp;
        !           288:        si.funlc = 0;
        !           289:        si.suspended = 0;
        !           290:        prolgerr = 0;           /* Reset error flag */
        !           291:        s = *p;
        !           292:        checksp();
        !           293:        if(funtrace)
        !           294:                printf("\ntrace: fn %s entered: ", np->namep);
        !           295:        if (setjmp(si.env))
        !           296:                goto reenter;
        !           297:        while(1){
        !           298:                si.funlc++;
        !           299:                if(funtrace)
        !           300:                        printf("\ntrace: fn %s[%d]: ", np->namep, si.funlc-1);
        !           301:                execute(p[si.funlc]);
        !           302:                if(si.funlc == 1){
        !           303:                        si.oldsp = sp;
        !           304:                        if (prolgerr)
        !           305:                                error("");
        !           306:                }
        !           307:                if(intflg)
        !           308:                        error("I");
        !           309:        reenter:
        !           310:                if(si.funlc <= 0 || si.funlc >= s) {
        !           311:                        si.funlc = 1;   /* for pretty traceback */
        !           312:                        if(funtrace)
        !           313:                                printf("\ntrace: fn %s exits ", np->namep);
        !           314:                        execute(p[s+1]);
        !           315:                        /* restore state indicator to previous state */
        !           316:                        gsip = si.sip;
        !           317:                        pcp = si.oldpcp;
        !           318:                        return;
        !           319:                }
        !           320:                pop();
        !           321:        }
        !           322: }
        !           323: 
        !           324: ex_arg1()
        !           325: {
        !           326:        register struct item *p;
        !           327:        struct nlist *np;
        !           328: 
        !           329:        pcp += copy(IN, pcp, &np, 1);
        !           330:        p = fetch1();
        !           331:        sp[-1] = np->itemp;
        !           332:        np->itemp = p;
        !           333:        np->use = DA;
        !           334: }
        !           335: 
        !           336: ex_arg2()
        !           337: {
        !           338:        register struct item *p1, *p2;
        !           339:        struct nlist *np1, *np2;
        !           340: 
        !           341:        pcp += copy(IN, pcp, &np2, 1);  /* get first argument's name */
        !           342:        pcp++;                          /* skip over ARG1 */
        !           343:        pcp += copy(IN, pcp, &np1, 1);  /* get second arg's name */
        !           344:        p1 = fetch1();                  /* get first expr to be bound to arg */
        !           345:        p2 = fetch(sp[-2]);             /* get second one */
        !           346:        sp[-1] = np1->itemp;            /* save old value of name on stack */
        !           347:        sp[-2] = np2->itemp;            /* save second */
        !           348:        np1->itemp = p1;                /* new arg1 binding */
        !           349:        np2->itemp = p2;                /* ditto arg2 */
        !           350:        np1->use = DA;                  /* release safety catch */
        !           351:        np2->use = DA;
        !           352: }
        !           353: 
        !           354: ex_auto()
        !           355: {
        !           356:        struct nlist *np;
        !           357: 
        !           358:        pcp += copy(IN, pcp, &np, 1);
        !           359:        checksp();
        !           360:        *sp++ = np->itemp;
        !           361:        np->itemp = 0;
        !           362:        np->use = 0;
        !           363: }
        !           364: 
        !           365: ex_rest()
        !           366: {
        !           367:        register struct item *p;
        !           368:        struct nlist *np;
        !           369: 
        !           370:        p = sp[-1];
        !           371:        /*
        !           372:         * the following is commented out because
        !           373:         * of an obscure bug in the parser, which is
        !           374:         * too difficult to correct right now.
        !           375:         * the bug is related to the way the
        !           376:         * "fn epilog" is compiled.  To accomodate labels,
        !           377:         * it was kludged up to have the label restoration
        !           378:         * code added after the entire fn was parsed.  A problem
        !           379:         * is that the generated code is like:
        !           380:         *
        !           381:         * "rest-lab1 rest-lab2 eol rval-result rest-arg1 ..."
        !           382:         *
        !           383:         * the "eol rval-result" pops off the previous result, and
        !           384:         * puts a "fetched" version of the returned value (result)
        !           385:         * onto the stack.  The bug is that the "eol rval." should
        !           386:         * be output at the beginning of the fn epilog.
        !           387:         * The following two lines used to be a simple
        !           388:         * "p = fetch(p)", which is used to disallow
        !           389:         * a fn to return a LV, (by fetching it, it gets
        !           390:         * converted to a RVAL.)  Since we later added
        !           391:         * code which returned stuff which could not be
        !           392:         * fetched (the DU, dummy datum, for example),
        !           393:         * this thing had to be eliminated.  An earlier
        !           394:         * version only fetched LV's, but that was eliminated
        !           395:         * by adding the "RVAL" operator.  The test below
        !           396:         * was made a botch, because no LV's should ever be
        !           397:         * passed back.  However, for this to be true, the
        !           398:         * "eol" should be executed first, so that any possible
        !           399:         * LV's left around by the last line executed are
        !           400:         * discarded.  Since we have some "rest"s in the epilog
        !           401:         * before the eol, the following test fails.
        !           402:         * I can't think of why it won't work properly as it
        !           403:         * is, but if I had the time, I'd fix it properly.
        !           404:         *      --jjb
        !           405:         */
        !           406: /*     if(p->type == LV)
        !           407:                error("rest B");        */
        !           408:        pcp += copy(IN, pcp, &np, 1);
        !           409:        erase(np);
        !           410:        np->itemp = sp[-2];
        !           411:        np->use = 0;
        !           412:        if(np->itemp)
        !           413:                np->use = DA;
        !           414:        sp--;
        !           415:        sp[-1] = p;
        !           416: }
        !           417: 
        !           418: ex_br0()
        !           419: {
        !           420: 
        !           421:        gsip->funlc = 0;
        !           422:        ex_elid();
        !           423: }
        !           424: 
        !           425: ex_br()
        !           426: {
        !           427:        register struct item *p;
        !           428: 
        !           429:        p = fetch1();
        !           430:        if(p->size == 0)
        !           431:                return;
        !           432:        gsip->funlc = fix(getdat(p));
        !           433: }
        !           434: /*
        !           435:  * immediate niladic branch -- reset SI
        !           436:  */
        !           437: ex_ibr0()
        !           438: {
        !           439:        register struct si *s;
        !           440:        register *p;
        !           441: 
        !           442:        s = gsip;
        !           443:        if(s == 0)
        !           444:                error("no suspended fn");
        !           445:        if(s->suspended == 0)
        !           446:                error("imm } B1");
        !           447:        gsip->suspended = 0;
        !           448:        while((s = gsip) && s->suspended == 0){
        !           449:                if(s->oldsp == 0 || sp < s->oldsp)
        !           450:                        error("imm } B2");
        !           451:                while(sp > s->oldsp){
        !           452:                        pop();
        !           453:                }
        !           454:                pop();          /* pop off possibly bad previous result */
        !           455:                ex_nilret();    /* and stick on some dummy datum */
        !           456:                p = (int *)s->np->itemp;
        !           457:                execute(p[*p + 1]);
        !           458:                gsip = s->sip;
        !           459:        }
        !           460:        if(gsip == 0)
        !           461:                while(sp > stack)
        !           462:                        pop();
        !           463: }
        !           464: 
        !           465: /*
        !           466:  * monadic immediate branch -- resume fn at specific line
        !           467:  */
        !           468: 
        !           469: ex_ibr()
        !           470: {
        !           471:        register struct si *s;
        !           472:        if((s = gsip) == 0)
        !           473:                error("no suspended fn");
        !           474:        ex_br();
        !           475:        if(s->oldsp == 0 || sp < s->oldsp)
        !           476:                error("imm }n B");
        !           477:        while(sp > s->oldsp){
        !           478:                pop();
        !           479:        }
        !           480:        pop();          /* pop off possibly bad previous result */
        !           481:        ex_nilret();    /* and stick on some dummy datum */
        !           482:        longjmp(s->env);        /* warp out */
        !           483: }
        !           484: 
        !           485: ex_fdef()
        !           486: {
        !           487:        register struct item *p;
        !           488:        register char *p1, *p2;
        !           489:        struct nlist *np;
        !           490:        char b[512];
        !           491:        int i, dim0, dim1;
        !           492: 
        !           493:        p = fetch1();
        !           494:        if((p->rank != 2 && p->rank != 1) || p->type != CH)
        !           495:                error("Lfx D");
        !           496: 
        !           497: 
        !           498:        /* The following code has been commented out as a
        !           499:         * test of slight modifications to the compiler.
        !           500:         * Before this change, it was impossible to use "Lfx"
        !           501:         * from inside an APL function, for it might damage
        !           502:         * an existing function by the same name.  The compiler
        !           503:         * now checks when processing function headers to see
        !           504:         * if the function is suspended by calling "sichk", which
        !           505:         * will generate an error if so.  Hopefully this will now
        !           506:         * allow "Lfx" to be used freely without disastrous side-
        !           507:         * effects.
        !           508:         */
        !           509: 
        !           510: /*     if(gsip)
        !           511:                error("si damage -- type ')reset'");    */
        !           512: 
        !           513:        dim0 = p->dim[0];
        !           514:        dim1 = p->dim[1];
        !           515:        if(p->rank == 1)
        !           516:                dim1 = dim0;
        !           517:        copy(CH, p->datap, b, dim1);
        !           518:        b[dim1] = '\n';
        !           519: 
        !           520:        p2 = compile(b, 2);
        !           521:        if(p2 != 0){
        !           522:                copy(IN, p2+1, &np, 1);
        !           523:                erase(np);
        !           524:                np->use = *p2;
        !           525:                free(p2);
        !           526:        
        !           527:                np->label = SEEKF(wfile, 0L, 2);
        !           528:                fappend(wfile, p);
        !           529:                WRITEF(wfile,"",1);
        !           530:        }
        !           531:        pop();
        !           532:        *sp++ = newdat(DA, 1, 0);
        !           533: }
        !           534: 
        !           535: ex_nilret()
        !           536: {
        !           537:        checksp();
        !           538:        *sp++ = newdat(DU,0,0); /* put looser onto stack */
        !           539:                                /* (should be discarded) */
        !           540: }
        !           541: 
        !           542: reverse(s)
        !           543: char *s;
        !           544: {
        !           545:        register char *p, *q;
        !           546:        register char c;
        !           547:        int j;
        !           548: 
        !           549: #define EXCH(a,b)      {c=a;a=b;b=c;}
        !           550: 
        !           551:        p = q = s;
        !           552:        while(*p != EOF)
        !           553:                p++;
        !           554:        p -= 1+sizeof(char *);
        !           555:        while(q < p){
        !           556:                for(j=0; j<1+sizeof (char *); j++)
        !           557:                        EXCH(p[j], q[j]);
        !           558:                q += j;
        !           559:                p -= j;
        !           560:        }
        !           561: }
        !           562: 
        !           563: /*
        !           564:  * produce trace back info
        !           565:  */
        !           566: char *atfrom[] = {"at\t", "from\t", "", ""};
        !           567: tback(flag)
        !           568: {
        !           569:        register struct si *p;
        !           570:        register i;
        !           571: 
        !           572:        p = gsip;
        !           573:        i = 0;
        !           574:        if(flag)
        !           575:                i = 2;
        !           576:        while(p){
        !           577:                if(flag==0 && p->suspended)
        !           578:                        return;
        !           579:                if (p->funlc != 1 || i){        /* skip if at line 0 */
        !           580:                        printf("%s%s[%d]%s\n",
        !           581:                                atfrom[i],
        !           582:                                p->np->namep,
        !           583:                                p->funlc - 1,
        !           584:                                (p->suspended ? "   *" : "")
        !           585:                        );
        !           586:                        i |= 1;
        !           587:                }
        !           588:                p = p->sip;
        !           589:        }
        !           590: }
        !           591: 
        !           592: sichk(n)
        !           593: struct nlist *n;
        !           594: {
        !           595:        register struct si *p;
        !           596: 
        !           597:        p = gsip;
        !           598:        while(p){
        !           599:                if(n == p->np)
        !           600:                        error("si damage -- type ')reset'");
        !           601:                p = p->sip;
        !           602:        }
        !           603: }
        !           604: ex_shell(){
        !           605: 
        !           606:        /* If the environment variable SHELL is defined, attempt to
        !           607:         * execute that shell.  If not, or if that exec fails, attempt
        !           608:         * to execute the standard shell, /bin/sh
        !           609:         */
        !           610: 
        !           611:        int (*addr)(), (*addr2)();
        !           612:        char *getenv();
        !           613:        register char *sh;
        !           614:        register i;
        !           615: 
        !           616:        addr = signal(SIGINT, SIG_IGN);
        !           617:        addr2 = signal(SIGQUIT, SIG_IGN);
        !           618:        i = FORKF(1);
        !           619:        if (i == 0){
        !           620:                for(i=3; i<20; i++) close(i);
        !           621:                signal(SIGINT, SIG_DFL);
        !           622:                signal(SIGQUIT, SIG_DFL);
        !           623:                if (sh=getenv("SHELL"))
        !           624:                        execl(sh, sh, 0);
        !           625:                execl("/bin/sh", "sh", 0);
        !           626:                printf("no shell!\n");
        !           627:                exit(1);
        !           628:        }
        !           629:        if (i == -1) error("try again");
        !           630:        while(wait(0) != i);
        !           631:        signal(SIGINT, addr);
        !           632:        signal(SIGQUIT, addr2);
        !           633: }
        !           634: badfnsv(fname)
        !           635: char *fname;
        !           636: {
        !           637: 
        !           638:        /* This routine saves the contents of "fname" in the file
        !           639:         * named in "bad_fn".  It is called by "funedit" if the
        !           640:         * header of a function just read in is messed up (thus,
        !           641:         * the entire file is not lost).  Returns 1 if successful,
        !           642:         * 0 if not.
        !           643:         */
        !           644: 
        !           645:        register fd1, fd2, len;
        !           646:        char buf[512];
        !           647: 
        !           648:        if ((fd1=OPENF(fname, 0)) < 0 || (fd2=CREATF(bad_fn, 0644)) < 0)
        !           649:                return(0);
        !           650:        while((len=READF(fd1, buf, 512)) > 0)
        !           651:                WRITEF(fd2, buf, len);
        !           652:        CLOSEF(fd1);
        !           653:        CLOSEF(fd2);
        !           654:        return(1);
        !           655: }

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