Return to a0.c CVS log

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

Annotation of 3BSD/cmd/apl/a0.c, revision 1.1

1.1     ! root        1: #include "apl.h"
        !             2: /*#include "/usr/sys/tty.h"    /* pick up TECO-mode bit */
        !             3: #define APLMOD 01000
        !             4: short TERMtype = 0 ; /* for now ( very stupid variable) */
        !             5: 
        !             6: short  chartab[];
        !             7: char   partab[1];
        !             8: 
        !             9: int    ifile = 0,
        !            10:        ofile = 1;
        !            11: 
        !            12: data   zero    =  0.0;
        !            13: data   one     =  1.0;
        !            14: data   pi      =  3.141592653589793238462643383;
        !            15: data   maxexp  = 88.0;
        !            16: 
        !            17: struct env thread = {
        !            18:        1.0e-13,   1,
        !            19:        9,        72
        !            20: };
        !            21: 
        !            22: main(ac,av)
        !            23: char  **av;
        !            24: {
        !            25:        register a, c;
        !            26:        int fflag;
        !            27:        int intr();
        !            28:        int floatover();
        !            29:        extern headline[];
        !            30: 
        !            31:        memstart = sbrk(0);
        !            32: 
        !            33:        Reset();
        !            34:        signal(8,floatover);
        !            35:        if(--ac&&*av[1]=='-')
        !            36:                ++echoflg;
        !            37:        time(stime);
        !            38:        setterm(1);                             /* turn off APL mode */
        !            39:        aprintf(headline);
        !            40:        
        !            41:        if(ttyname(0) == 'x')
        !            42:                echoflg++;
        !            43: 
        !            44:        a = "apl_ws";
        !            45:        while((wfile = open(a, 2)) < 0) {
        !            46:                c = creat(a, 0666);
        !            47:                if(c < 0) {
        !            48:                        aprintf("cannot create apl_ws");
        !            49:                        exit(0);
        !            50:                }
        !            51:                close(c);
        !            52:        }
        !            53: 
        !            54:        fflag = 1;
        !            55: 
        !            56:        sp = stack;
        !            57:        signal(2, intr);
        !            58:        setexit();
        !            59: 
        !            60:        if(fflag) {
        !            61:                fflag =0;
        !            62:                if((a=open("continue",0)) < 0) {
        !            63:                        aprintf("clear ws\n");
        !            64:                        goto loop;
        !            65:                }
        !            66:                wsload(a);
        !            67:                aprintf(" continue\n");
        !            68:        }
        !            69: 
        !            70: loop:
        !            71:        while(sp > stack)
        !            72:                pop();
        !            73:        Reset();
        !            74:        signal(8,floatover);
        !            75:        if(intflg)
        !            76:                error("I");
        !            77:                if(!ifile&&ofile==1)
        !            78:                aputchar('\t');
        !            79:        a = rline(8);
        !            80:        if(a==0) {
        !            81:                if(ifile) {
        !            82:                        ifile = 0;
        !            83:                        goto loop;
        !            84:                }
        !            85:                ctrld();
        !            86:        }
        !            87:        c = compile(a, 0);
        !            88:        afree(a);
        !            89:        if(c == 0)
        !            90:                goto loop;
        !            91:        execute(c);
        !            92:        afree(c);
        !            93:        goto loop;
        !            94: }
        !            95: 
        !            96: /* this procedure is for trapping floating point exceptions, and        */
        !            97: /* then reset the program.  added june 1979                            */
        !            98: 
        !            99: floatover() {
        !           100:        printf("\t\nerror -- floating point exception\n");
        !           101:        signal(8,floatover);
        !           102:        reset();
        !           103: };
        !           104: 
        !           105: 
        !           106: 
        !           107: setterm(toggle) 
        !           108: {      TERMtype = toggle;
        !           109:        aplmod(toggle + 1);
        !           110: }
        !           111: 
        !           112: 
        !           113: nargs()
        !           114: {
        !           115:        return 1;
        !           116: }
        !           117: 
        !           118: Reset()
        !           119: {
        !           120:        afree(stack);
        !           121:        cs_size = STKS;
        !           122:        stack = alloc(sizeof(sp)*STKS); /* Set up internal stack */
        !           123:        sp = stack;
        !           124:        staktop = &stack[STKS-1];
        !           125: }
        !           126: 
        !           127: intr()
        !           128: {
        !           129: 
        !           130:        intflg = 1;
        !           131:        signal(2, intr);
        !           132:        lseek(0, 0, 2);
        !           133: }
        !           134: 
        !           135: rline(s)
        !           136: {
        !           137:        int rlcmp();
        !           138:        char line[CANBS];
        !           139:        register char *p;
        !           140:        register c, col;
        !           141:        char *cp;
        !           142:        char *dp;
        !           143:        short  i;
        !           144:        int     j;
        !           145: 
        !           146:        column = 0;
        !           147:        col = s;
        !           148:        p = line;
        !           149: loop:
        !           150:        c = agetchar();
        !           151:        if(intflg)
        !           152:                error("I");
        !           153:        switch(c) {
        !           154: 
        !           155:        case '\0':
        !           156:        case -1:
        !           157:                return(0);
        !           158: 
        !           159:        case '\b':
        !           160:                if(col)
        !           161:                        col--;
        !           162:                goto loop;
        !           163: 
        !           164:        case '\t':
        !           165:                col = (col+8) & ~7;
        !           166:                goto loop;
        !           167: 
        !           168:        case ' ':
        !           169:        case 016:       /* cursor right */
        !           170:                col++;
        !           171:                goto loop;
        !           172: 
        !           173:        case '\r':
        !           174:                col = 0;
        !           175:                goto loop;
        !           176: 
        !           177:        default:
        !           178:                *p++ = col;
        !           179:                *p++ = c & 0177;
        !           180:                col++;
        !           181:                goto loop;
        !           182: 
        !           183:        case 033:       /* escape - APL line feed */
        !           184:                for(cp=dp=line; cp<p; cp+= 2)
        !           185:                        if(*cp < col) {
        !           186:                                *dp++ = *cp;
        !           187:                                *dp++ = cp[1];
        !           188:                        }
        !           189:                p = dp;
        !           190:                aputchar('\n');
        !           191:                putto(col);
        !           192:                aputchar(')');
        !           193:                aputchar('\n');
        !           194:                putto(col);
        !           195:                column=0;
        !           196:                goto loop;
        !           197: 
        !           198:        case '\n':
        !           199:                ;
        !           200:        }
        !           201:        qsort(line, (p-line)/2, 2, rlcmp);
        !           202:        c = p[-2];
        !           203:        if(p == line)
        !           204:                c = 1;  /* check for blank line */
        !           205:        *p = -1;
        !           206:        c = alloc((int)(c+3));
        !           207:        col = -1;
        !           208:        cp = c - 1;
        !           209:        for(p=line; p[0] != -1; p+=2) {
        !           210:                while(++col != p[0])
        !           211:                        *++cp = ' ';
        !           212:                *++cp = p[1];
        !           213:                while(p[2] == col) {
        !           214:                        if(p[3] != *cp) {
        !           215:                                i = *cp ;
        !           216:                                *cp = p[3];
        !           217:                                break;
        !           218:                        }
        !           219:                        p += 2;
        !           220:                }
        !           221:                if(p[2] != col) continue;
        !           222:                while(p[2] == col) {
        !           223:                        if(p[3] != *cp)
        !           224:                                goto yuck;
        !           225:                        p += 2;
        !           226:                }
        !           227:                i |= *cp << 8;
        !           228:                for (j=41;j>=0;j--) 
        !           229:                        if ((i.c[0] == chartab[j].a1) && ( i.c[1]==chartab[j].a2)) {
        !           230:                                *cp = j | 0200;
        !           231:                                j = 0;
        !           232:                                break;
        !           233:                        }
        !           234:                if(j) {
        !           235: yuck:
        !           236:                        *cp = '\n';
        !           237:                        pline(c,++col);
        !           238:                        error("Y E");
        !           239:                }
        !           240:        }
        !           241:        *++cp = '\n';
        !           242:        return(c);
        !           243: }
        !           244: 
        !           245: rlcmp(a, b)
        !           246: char *a, *b;
        !           247: {
        !           248:        register c;
        !           249: 
        !           250:        if(c = a[0] - b[0])
        !           251:                return(c);
        !           252:        return(a[1] - b[1]);
        !           253: }
        !           254: 
        !           255: pline(str, loc)
        !           256: char *str;
        !           257: {
        !           258:        register c, l, col;
        !           259: 
        !           260:        col = 0;
        !           261:        l = 0;
        !           262:        do {
        !           263:                c = *str++;
        !           264:                l++;
        !           265:                if(l == loc)
        !           266:                        col = column;
        !           267:                aputchar(c);
        !           268:        } while(c != '\n');
        !           269:        if(col) {
        !           270:                putto(col);
        !           271:                if (TERMtype == 0)aputchar(')');
        !           272:                else aputchar('^');
        !           273:                aputchar('\n');
        !           274:        }
        !           275: }
        !           276: 
        !           277: putto(col)
        !           278: {
        !           279:        while(col > column+8)
        !           280:                aputchar('\t');
        !           281:        while(col > column)
        !           282:                aputchar(' ');
        !           283: }
        !           284: 
        !           285: term()
        !           286: {
        !           287: 
        !           288:        unlink("apl_ws");
        !           289:        aputchar('\n');
        !           290:        aplmod(0);      /*turn off APL mode */
        !           291:        exit(0);
        !           292: }
        !           293: 
        !           294: fix(d)
        !           295: data d;
        !           296: {
        !           297:        register i;
        !           298: 
        !           299:        i = floor(d+0.5);
        !           300:        return(i);
        !           301: }
        !           302: 
        !           303: xeq_mark()
        !           304: {
        !           305:        if(now_xeq.name) {
        !           306:                aprintf(now_xeq.name);
        !           307:                aprintf(" ;%d'\n", now_xeq.line);
        !           308:        }
        !           309:        now_xeq.name = now_xeq.line = 0;
        !           310: }
        !           311: 
        !           312: error(s)
        !           313: char *s;
        !           314: {
        !           315:        register c;
        !           316:        register char *cp;
        !           317: 
        !           318:        intflg = 0;
        !           319:        if(ifile)
        !           320:                close(ifile);
        !           321:        if(ofile&&ofile!=1)
        !           322:                close(ofile);
        !           323:        ifile = 0;
        !           324:        ofile = 1;
        !           325:        xeq_mark();
        !           326:        cp = s;
        !           327:        while(c = *cp++) {
        !           328:                if(c >= 'A' && c <= 'Z') {
        !           329:                        switch(c) {
        !           330: 
        !           331:                        case 'L':
        !           332:                                c = "length";
        !           333:                                break;
        !           334:                        case 'I':
        !           335:                                c = "\ninterrupt";
        !           336:                                break;
        !           337: 
        !           338:                        case 'C':
        !           339:                                c = "conformability";
        !           340:                                break;
        !           341: 
        !           342:                        case 'S':
        !           343:                                c = "syntax";
        !           344:                                break;
        !           345: 
        !           346:                        case 'R':
        !           347:                                c = "rank";
        !           348:                                break;
        !           349: 
        !           350:                        case 'X':
        !           351:                                c = "index";
        !           352:                                break;
        !           353: 
        !           354:                        case 'Y':
        !           355:                                c = "character";
        !           356:                                break;
        !           357: 
        !           358:                        case 'M':
        !           359:                                c = "memory";
        !           360:                                break;
        !           361: 
        !           362:                        case 'D':
        !           363:                                c = "domain";
        !           364:                                break;
        !           365: 
        !           366:                        case 'T':
        !           367:                                c = "type";
        !           368:                                break;
        !           369: 
        !           370:                        case 'E':
        !           371:                                c = "error";
        !           372:                                break;
        !           373: 
        !           374:                        case 'B':
        !           375:                        default:
        !           376:                                c = "botch";
        !           377:                        }
        !           378:                        aprintf(c);
        !           379:                        continue;
        !           380:                }
        !           381:                aputchar(c);
        !           382:        }
        !           383:        aputchar('\n');
        !           384:        reset();
        !           385: };
        !           386: 
        !           387: /* procedure to catch control d and prevent it from logging out the user*/
        !           388: 
        !           389: ctrld(){
        !           390:        aprintf("\nto exit type \"off\nto exit and save workspace type \"continue\n");
        !           391:        reset();
        !           392: }
        !           393: 
        !           394: aprintf(f, a)
        !           395: char *f;
        !           396: {
        !           397:        register char *s;
        !           398:        register *p;
        !           399: 
        !           400:        s = f;
        !           401:        p = &a;
        !           402:        while(*s) {
        !           403:                if(s[0] == '%' && s[1] == 'd') {
        !           404:                        putn(*p++);
        !           405:                        s += 2;
        !           406:                        continue;
        !           407:                }
        !           408:                aputchar(*s++);
        !           409:        }
        !           410: }  
        !           411: 
        !           412: putn(n)
        !           413: {
        !           414:        register a;
        !           415: 
        !           416:        if(n < 0) {
        !           417:                n = -n;
        !           418:                if(n < 0) {
        !           419:                        aprintf("2147483648");
        !           420:                        return;
        !           421:                }
        !           422:                aputchar('@');  /* apl minus sign */
        !           423:        }
        !           424:        if(a=n/10)
        !           425:                putn(a);
        !           426:        aputchar(n%10 + '0');
        !           427: }
        !           428: agetchar()
        !           429: {
        !           430:        int c;
        !           431: 
        !           432:        c = 0;
        !           433:        read(ifile, &c, 1);
        !           434:        if(echoflg)
        !           435:                write(1, &c, 1);
        !           436:        return(c);
        !           437: }
        !           438: 
        !           439: aputchar(c)
        !           440: register c;
        !           441: {
        !           442:        register i;
        !           443:        unsigned char c2;
        !           444:        extern unsigned char changeoutput[];
        !           445: 
        !           446:        if(TERMtype == 1)               /* ascii terminal */
        !           447:                c = changeoutput [ (0377 & c) ];
        !           448: 
        !           449: 
        !           450:        switch(c) {
        !           451: 
        !           452:        case '\0':
        !           453:                return;
        !           454: 
        !           455:        case '\b':
        !           456:                if(column)
        !           457:                        column--;
        !           458:                break;
        !           459: 
        !           460:        case '\t':
        !           461:                column = (column+8) & ~7;
        !           462:                break;
        !           463: 
        !           464:        case '\r':
        !           465:        case '\n':
        !           466:                column = 0;
        !           467:                break;
        !           468: 
        !           469:        default:
        !           470:                column++;
        !           471:        }
        !           472:        /* for encode numbers */  
        !           473:        if(mencflg) {
        !           474:                if(c != '\n') {
        !           475:                        mencflg = 1;
        !           476:                        *mencptr++ = c;
        !           477:                }
        !           478:                else
        !           479:                        if(mencflg > 1)
        !           480:                                mencptr += rowsz;
        !           481:                        else
        !           482:                                mencflg = 2;
        !           483:                return;
        !           484:        }
        !           485:        if(intflg == 0) {
        !           486:                if(c & 0200) {
        !           487:                        i = chartab[c & 0177];
        !           488:                        aputchar(i>>8);
        !           489:                        c = i & 0177;
        !           490:                        aputchar('\b');
        !           491:                }
        !           492:                c2 = c;
        !           493:                write(ofile, &c2, 1);
        !           494:        }
        !           495: } 
        !           496: 
        !           497: fuzz(d1, d2)
        !           498: data d1, d2;
        !           499: {
        !           500:        double f1, f2;
        !           501: 
        !           502:        f1 = d1;
        !           503:        if(f1 < 0.)
        !           504:                f1 = -f1;
        !           505:        f2 = d2;
        !           506:        if(f2 < 0.)
        !           507:                f2 = -f2;
        !           508:        if(f2 > f1)
        !           509:                f1 = f2;
        !           510:        f1 *= thread.fuzz;
        !           511:        if(d1 > d2) {
        !           512:                if(d2+f1 >= d1)
        !           513:                        return(0);
        !           514:                return(1);
        !           515:        }
        !           516:        if(d1+f1 >= d2)
        !           517:                return(0);
        !           518:        return(-1);
        !           519: }
        !           520: 
        !           521: pop()
        !           522: {
        !           523:        dealloc(*--sp);
        !           524: }
        !           525: 
        !           526: erase(np)
        !           527: struct nlist *np;
        !           528: {
        !           529:        register *p;
        !           530: 
        !           531:        p = np->itemp;
        !           532:        if(p) {
        !           533:                switch(np->use) {
        !           534:                case NF:
        !           535:                case MF:
        !           536:                case DF:
        !           537:                        for(; *p>0; (*p)--)
        !           538:                                afree(p[*p]);
        !           539: 
        !           540:                }
        !           541:                afree(p);
        !           542:                np->itemp = 0;
        !           543:        }
        !           544:        np->use = 0;
        !           545: }
        !           546: 
        !           547: dealloc(p)
        !           548: struct item *p;
        !           549: {
        !           550: 
        !           551:        switch(p->type) {
        !           552: 
        !           553:        case DA:
        !           554:        case CH:
        !           555:        case QQ:
        !           556:        case QD:
        !           557:        case QC:
        !           558:        case EL:
        !           559:                afree(p);
        !           560:        }
        !           561: }
        !           562: 
        !           563: newdat(type, rank, size)
        !           564: {
        !           565:        register i;
        !           566:        register struct item *p;
        !           567: 
        !           568:        if(rank > MRANK)
        !           569:                error("R E");
        !           570:        i = sizeof *p + rank * SINT;
        !           571:        if(type == DA)
        !           572:                i += size * SDAT; else
        !           573:        if(type == CH)
        !           574:                i += size;
        !           575:        p = alloc(i);
        !           576:        p->rank = rank;
        !           577:        p->type = type;
        !           578:        p->size = size;
        !           579:        p->index = 0;
        !           580:        if(rank == 1)
        !           581:                p->dim[0] = size;
        !           582:        p->datap = &p->dim[rank];
        !           583:        return(p);
        !           584: }
        !           585: 
        !           586: copy(type, from, to, size)
        !           587: char *from, *to;
        !           588: {
        !           589:        register i;
        !           590:        register char *a, *b;
        !           591:        int s;
        !           592:        
        !           593: 
        !           594: 
        !           595:        if((i = size) == 0)
        !           596:                return(0);
        !           597:        a = from;
        !           598:        b = to;
        !           599:        if(type == DA)
        !           600:                i *= SDAT; else
        !           601:        if(type == IN)
        !           602:                i *= SINT;
        !           603:        s = i;
        !           604:        do
        !           605:                *b++ = *a++;
        !           606:        while(--i);
        !           607:        return(s);
        !           608: }
        !           609: 
        !           610: fetch1()
        !           611: {
        !           612:        return sp[-1] = fetch(sp[-1]);
        !           613: }
        !           614: 
        !           615: fetch2()
        !           616: {
        !           617:        sp[-2] = fetch(sp[-2]);
        !           618:        return sp[-1] = fetch(sp[-1]);
        !           619: }
        !           620: 
        !           621: fetch(ip)
        !           622: struct item *ip;
        !           623: {
        !           624:        register struct item *p, *q;
        !           625:        char *ubset;
        !           626:        register i;
        !           627:        int c;
        !           628: 
        !           629:        p = ip;
        !           630: 
        !           631: loop:
        !           632:        switch(p->type) {
        !           633: 
        !           634:        case QQ:
        !           635:                afree(p);
        !           636:                c = rline(0);
        !           637:                if(c == 0)
        !           638:                        error("eof");
        !           639:                for(i=0; c->c[i] != '\n'; i++)
        !           640:                        continue;
        !           641:                p = newdat(CH, 1, i);
        !           642:                copy(CH, c, p->datap, i);
        !           643:                goto loop;
        !           644: 
        !           645:        case QD:
        !           646:        case QC:
        !           647:                if(!ifile&&ofile==1)
        !           648:                        aprintf("L>\n\t");
        !           649:                i = rline(8);
        !           650:                if(i == 0)
        !           651:                        error("eof");
        !           652:                c = compile(i, 1);
        !           653:                afree(i);
        !           654:                if(c == 0)
        !           655:                        goto loop;
        !           656:                i = pcp;
        !           657:                execute(c);
        !           658:                pcp = i;
        !           659:                afree(c);
        !           660:                afree(p);
        !           661:                p = *--sp;
        !           662:                goto loop;
        !           663: 
        !           664:        case DA:
        !           665:        case CH:
        !           666:                p->index = 0;
        !           667:                return(p);
        !           668: 
        !           669:        case LV:
        !           670:                if(p->use != DA) {
        !           671:                        ubset = ip->namep;
        !           672:                        xeq_mark();
        !           673:                        while(*ubset)
        !           674:                                aputchar(*ubset++);
        !           675:                        error("> used before set\n");
        !           676:                }
        !           677:                p = p->itemp;
        !           678:                q = newdat(p->type, p->rank, p->size);
        !           679:                copy(IN, p->dim, q->dim, p->rank);
        !           680:                copy(p->type, p->datap, q->datap, p->size);
        !           681:                return(q);
        !           682: 
        !           683:        default:
        !           684:                error("fetch B");
        !           685:        }
        !           686: }
        !           687: 
        !           688: topfix()
        !           689: {
        !           690:        register struct item *p;
        !           691:        register i;
        !           692: 
        !           693:        p = fetch1();
        !           694:        if(p->type != DA || p->size != 1)
        !           695:                error("topval C");
        !           696:        i = fix(p->datap[0]);
        !           697:        pop();
        !           698:        return(i);
        !           699: }
        !           700: 
        !           701: bidx(ip)
        !           702: struct item *ip;
        !           703: {
        !           704:        register struct item *p;
        !           705: 
        !           706:        p = ip;
        !           707:        idx.type = p->type;
        !           708:        idx.rank = p->rank;
        !           709:        copy(IN, p->dim, idx.dim, idx.rank);
        !           710:        size();
        !           711: }
        !           712: 
        !           713: size()
        !           714: {
        !           715:        register i, s;
        !           716: 
        !           717:        s = 1;
        !           718:        for(i=idx.rank-1; i>=0; i--) {
        !           719:                idx.del[i] = s;
        !           720:                s *= idx.dim[i];
        !           721:        }
        !           722:        idx.size = s;
        !           723:        return(s);
        !           724: }
        !           725: 
        !           726: colapse(k)
        !           727: {
        !           728:        register i;
        !           729: 
        !           730:        if(k < 0 || k >= idx.rank)
        !           731:                error("collapse X");
        !           732:        idx.dimk = idx.dim[k];
        !           733:        idx.delk = idx.del[k];
        !           734:        for(i=k; i<idx.rank; i++) {
        !           735:                idx.del[i] = idx.del[i+1];
        !           736:                idx.dim[i] = idx.dim[i+1];
        !           737:        }
        !           738:        idx.size /= idx.dimk;
        !           739:        idx.rank--;
        !           740: }
        !           741: 
        !           742: forloop(co, arg)
        !           743: int (*co)();
        !           744: {
        !           745:        register i;
        !           746: 
        !           747:        if(idx.rank == 0) {
        !           748:                (*co)(arg);
        !           749:                return;
        !           750:        }
        !           751:        for(i=0;;) {
        !           752:                while(i < idx.rank)
        !           753:                        idx.idx[i++] = 0;
        !           754:                (*co)(arg);
        !           755:                while(++idx.idx[i-1] >= idx.dim[i-1])
        !           756:                        if(--i <= 0)
        !           757:                                return;
        !           758:        }
        !           759: }
        !           760: 
        !           761: access()
        !           762: {
        !           763:        register i, n;
        !           764: 
        !           765:        n = 0;
        !           766:        for(i=0; i<idx.rank; i++)
        !           767:                n += idx.idx[i] * idx.del[i];
        !           768:        return(n);
        !           769: }
        !           770: 
        !           771: data
        !           772: getdat(ip)
        !           773: struct item *ip;
        !           774: {
        !           775:        register struct item *p;
        !           776:        register i;
        !           777:        data d;
        !           778: 
        !           779:        p = ip;
        !           780:        i = p->index;
        !           781:        while(i >= p->size) {
        !           782:                if(i == 0)
        !           783:                        error("getdat B");
        !           784:                i -= p->size;
        !           785:        }
        !           786:        if(p->type == DA) {
        !           787:                d = p->datap[i];
        !           788:        } else
        !           789:        if(p->type == CH) {
        !           790:                d = p->datap->c[i];
        !           791:        } else
        !           792:                error("getdat B");
        !           793:        i++;
        !           794:        p->index = i;
        !           795:        return(d);
        !           796: }
        !           797: 
        !           798: putdat(ip, d)
        !           799: data d;
        !           800: struct item *ip;
        !           801: {
        !           802:        register struct item *p;
        !           803:        register i;
        !           804: 
        !           805:        p = ip;
        !           806:        i = p->index;
        !           807:        if(i >= p->size)
        !           808:                error("putdat B");
        !           809:        if(p->type == DA) {
        !           810:                p->datap[i] = d;
        !           811:        } else
        !           812:        if(p->type == CH) {
        !           813:                p->datap->c[i] = d;
        !           814:        } else
        !           815:                error("putdat B");
        !           816:        i++;
        !           817:        p->index = i;
        !           818: }
        !           819: 
        !           820: aplmod(xyz)
        !           821: {
        !           822: static firstvisit=0;
        !           823: static short  old[3], new[3];
        !           824: static short  diff;
        !           825:        if(xyz> 0) {
        !           826:                if (firstvisit == 0){
        !           827:                        if(gtty(0,old)<0) {
        !           828:                                diff = 0;
        !           829:                                return;
        !           830:                        }
        !           831:                        diff = 1;
        !           832:                }
        !           833:                if (diff == 1) {
        !           834:                        gtty(0, new);
        !           835:                        if (xyz == 1)new[1] = 'W'|'A'<<8; /* apl terminal */
        !           836:                        else new[1] = ''|'@'<<8;  /* ascii terminal */
        !           837:                        stty(0, new);
        !           838:                        if (firstvisit)
        !           839:                        if (xyz == 1)aprintf("erase%KWK kill%KAK\n\n");
        !           840:                        else aprintf("erase ^H kill @\n\n");
        !           841:                }
        !           842:                firstvisit++;
        !           843:        } else {
        !           844:                if(diff)
        !           845:                        stty(0, old);
        !           846:        } 
        !           847: }

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