Return to a1.c CVS log

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

Annotation of 40BSD/cmd/apl/a1.c, revision 1.1

1.1     ! root        1: #include "apl.h"
        !             2: 
        !             3: char   *continu = "continue";
        !             4: 
        !             5: execute(s)
        !             6: char *s;
        !             7: {
        !             8:        register i;
        !             9:        register data *dp;
        !            10:        register struct item *p;
        !            11:        struct item *p1;
        !            12:        int j;
        !            13:        data (*f)(), d;
        !            14: 
        !            15: #ifdef SOMED
        !            16:        if(debug)
        !            17:                dump(s);
        !            18: #endif
        !            19: 
        !            20: loop:
        !            21:        i = *s++;
        !            22: #ifdef FULLD
        !            23:        if(debug) {
        !            24:            extern char *opname[];
        !            25:                if(i==-1)
        !            26:                        aprintf("exec eof\n");
        !            27:                else if(0<=i&&i<103) {
        !            28:                        aprintf("exec "); aprintf(opname[i]); aputchar('\n');
        !            29:                   } else
        !            30:                        aprintf("exec %d\n",i);
        !            31:        }
        !            32: #endif
        !            33: #ifdef SHORTD
        !            34:        if(debug)
        !            35:                aprintf("exec %d\n", i);
        !            36: #endif
        !            37:        switch(i) {
        !            38: 
        !            39:        default:
        !            40:                error("exec B");
        !            41: 
        !            42:        case EOF:
        !            43:                return;
        !            44: 
        !            45:        case EOL:
        !            46:                pop();
        !            47:                goto loop;
        !            48: 
        !            49:        case COMNT:
        !            50:                push(newdat(DA,1,0));
        !            51:                goto loop;
        !            52: 
        !            53:        case ADD:
        !            54:        case SUB:
        !            55:        case MUL:
        !            56:        case DIV:
        !            57:        case MOD:
        !            58:        case MIN:
        !            59:        case MAX:
        !            60:        case PWR:
        !            61:        case LOG:
        !            62:        case CIR:
        !            63:        case COMB:
        !            64:        case AND:
        !            65:        case OR:
        !            66:        case NAND:
        !            67:        case NOR:
        !            68:        case LT:
        !            69:        case LE:
        !            70:        case EQ:
        !            71:        case GE:
        !            72:        case GT:
        !            73:        case NE:
        !            74:                f = exop[i];
        !            75:                p = fetch2();
        !            76:                p1 = sp[-2];
        !            77:                if(p->type!=DA||p1->type!=DA) {
        !            78:                        if(p->type==CH&&p1->type==CH) {
        !            79:                                charfun(i, p, p1);
        !            80:                                goto loop;
        !            81:                        } else
        !            82:                                error("dyadic T E");
        !            83:                }
        !            84:                if(!p->rank||p->rank==1&&p->size==1) {
        !            85:                        d = p->datap[0];
        !            86:                        pop();
        !            87:                        p = p1;
        !            88:                        dp = p->datap;
        !            89:                        for(i=0; i<p->size; i++) {
        !            90:                                *dp = (*f)(d, *dp);
        !            91:                                dp++;
        !            92:                        }
        !            93:                        goto loop;
        !            94:                }
        !            95:                if(!p1->rank||p1->rank==1&&p1->size==1) {
        !            96:                        sp--;
        !            97:                        d = p1->datap[0];
        !            98:                        pop();
        !            99:                        push(p);
        !           100:                        dp = p->datap;
        !           101:                        for(i=0; i<p->size; i++) {
        !           102:                                *dp = (*f)(*dp, d);
        !           103:                                dp++;
        !           104:                        }
        !           105:                        goto loop;
        !           106:                }
        !           107:                if(p1->rank != p->rank)
        !           108:                        error("dyadic C E");
        !           109:                for(i=0; i<p->rank; i++)
        !           110:                        if(p->dim[i] != p1->dim[i])
        !           111:                                error("dyadic C E");
        !           112:                dp = p1->datap;
        !           113:                for(i=0; i<p->size; i++) {
        !           114:                        *dp = (*f)(p->datap[i], *dp);
        !           115:                        dp++;
        !           116:                }
        !           117:                pop();
        !           118:                goto loop;
        !           119: 
        !           120: 
        !           121: 
        !           122:        case PLUS:
        !           123:        case MINUS:
        !           124:        case SGN:
        !           125:        case RECIP:
        !           126:        case ABS:
        !           127:        case FLOOR:
        !           128:        case CEIL:
        !           129:        case EXP:
        !           130:        case LOGE:
        !           131:        case PI:
        !           132:        case RAND:
        !           133:        case FAC:
        !           134:        case NOT:
        !           135:                f = exop[i];
        !           136:                p = fetch1();
        !           137:                if(p->type != DA)
        !           138:                        error("monadic T E");
        !           139:                dp = p->datap;
        !           140:                for(i=0; i<p->size; i++) {
        !           141:                        *dp = (*f)(*dp);
        !           142:                        dp++;
        !           143:                }
        !           144:                goto loop;
        !           145: 
        !           146:        case MEPS:      /*      execute         */
        !           147:        case MENC:      /*      monadic encode  */
        !           148:        case DRHO:
        !           149:        case DIOT:
        !           150:        case EPS:
        !           151:        case REP:
        !           152:        case BASE:
        !           153:        case DEAL:
        !           154:        case DTRN:
        !           155:        case CAT:
        !           156:        case CATK:
        !           157:        case TAKE:
        !           158:        case DROP:
        !           159:        case DDOM:
        !           160:        case MDOM:
        !           161:        case GDU:
        !           162:        case GDUK:
        !           163:        case GDD:
        !           164:        case GDDK:
        !           165:        case COM:
        !           166:        case COM0:
        !           167:        case COMK:
        !           168:        case EXD:
        !           169:        case EXD0:
        !           170:        case EXDK:
        !           171:        case ROT:
        !           172:        case ROT0:
        !           173:        case ROTK:
        !           174:        case MRHO:
        !           175:        case MTRN:
        !           176:        case RAV:
        !           177:        case RAVK:
        !           178:        case RED:
        !           179:        case RED0:
        !           180:        case REDK:
        !           181:        case SCAN:
        !           182:        case SCANK:
        !           183:        case SCAN0:
        !           184:        case REV:
        !           185:        case REV0:
        !           186:        case REVK:
        !           187:        case ASGN:
        !           188:        case INDEX:
        !           189:        case ELID:
        !           190:        case IPROD:
        !           191:        case OPROD:
        !           192:        case IMMED:
        !           193:        case HPRINT:
        !           194:        case PRINT:
        !           195:        case MIOT:
        !           196:        case MIBM:
        !           197:        case DIBM:
        !           198:        case BRAN0:
        !           199:        case BRAN:
        !           200:        case FUN:
        !           201:        case ARG1:
        !           202:        case ARG2:
        !           203:        case AUTO:
        !           204:        case REST:
        !           205:                pcp = s;
        !           206:                (*exop[i])();
        !           207:                s = pcp;
        !           208:                goto loop;
        !           209: 
        !           210:        case NAME:
        !           211:                s += copy(IN, s, sp, 1);
        !           212:                sp++;
        !           213:                if(sp>staktop)
        !           214:                        newstak();
        !           215:                goto loop;
        !           216: 
        !           217:        case QUOT:
        !           218:                j = CH;
        !           219:                goto con;
        !           220: 
        !           221:        case CONST:
        !           222:                j = DA;
        !           223: 
        !           224:        con:
        !           225:                i = *s++;
        !           226:                p = newdat(j, i==1?0:1, i);
        !           227:                s += copy(j, s, p->datap, i);
        !           228:                push(p);
        !           229:                goto loop;
        !           230: 
        !           231:        case QUAD:
        !           232:                push(newdat(QD,0,0));
        !           233:                goto loop;
        !           234: 
        !           235:        case QQUAD:
        !           236:                push(newdat(QQ,0,0));
        !           237:                goto loop;
        !           238: 
        !           239:        case CQUAD:
        !           240:                push(newdat(QC,0,0));
        !           241:                goto loop;
        !           242:        }
        !           243: }
        !           244: 
        !           245: static int comop;
        !           246: 
        !           247: charfun(op, p, p1)
        !           248: struct item *p, *p1;
        !           249: {
        !           250: register char c, *cxi;
        !           251: register double *dxi;
        !           252:         int i;
        !           253: 
        !           254:        comop = op;
        !           255:        switch(op) {
        !           256:           default:
        !           257:                error("Y D E");
        !           258:           case LT:
        !           259:           case LE:
        !           260:           case EQ:
        !           261:           case GE:
        !           262:           case GT:
        !           263:           case NE:
        !           264:                /* OK */;
        !           265:        }
        !           266:        if(!p->rank) {
        !           267:                c = *((char*)(p->datap));
        !           268:                cxi = (char*)(p1->datap);
        !           269:                push(newdat(DA,p1->rank,p1->size));
        !           270:                copy(IN, p1->dim, sp[-1]->dim, p1->rank);
        !           271:                dxi = sp[-1]->datap;
        !           272:                for(i=0; i<p1->size; i++)
        !           273:                        *dxi++ = (double)charcom(c,*cxi++);
        !           274:                goto done;
        !           275:        }
        !           276:        if(!p1->rank) {
        !           277:                c = ((char*)(p1->datap))[0];
        !           278:                cxi = (char*)(p->datap);
        !           279:                push(newdat(DA,p->rank,p->size));
        !           280:                copy(IN, p->dim, sp[-1]->dim, p->rank);
        !           281:                dxi = sp[-1]->datap;
        !           282:                for(i=0; i<p->size; i++)
        !           283:                        *dxi++ = (double)charcom(*cxi++,c);
        !           284:                goto done;
        !           285:        }
        !           286:        if(p1->rank != p->rank)
        !           287:                error("dyadic Y C E");
        !           288:        for(i=0; i<p->rank; i++)
        !           289:                if(p->dim[i]!=p1->dim[i])
        !           290:                        error("dyadic Y C E");
        !           291:        cxi = (char*)(p1->datap);
        !           292:        push(newdat(DA,p->rank,p->size));
        !           293:        copy(IN, p->dim, sp[-1]->dim, p->rank);
        !           294:        dxi = sp[-1]->datap;
        !           295:        for(i=0; i<p->size; i++)
        !           296:                *dxi++ = (double)charcom(((char*)(p->datap))[i],*cxi++);
        !           297: done:  dealloc(sp[-2]);
        !           298:        dealloc(sp[-3]);
        !           299:        sp[-3] = sp[-1];
        !           300:        sp -= 2;
        !           301:        return;
        !           302: }
        !           303: 
        !           304: charcom(c1, c2)
        !           305: register char c1, c2;
        !           306: {
        !           307:        switch(comop) {
        !           308:           case LE:
        !           309:                return c1<=c2;
        !           310:           case LT:
        !           311:                return c1<c2;
        !           312:           case EQ:
        !           313:                return c1==c2;
        !           314:           case NE:
        !           315:                return c1!=c2;
        !           316:           case GT:
        !           317:                return c1>c2;
        !           318:           case GE:
        !           319:                return c1>=c2;
        !           320:        }
        !           321:        error("Y B");           /*  "Cannot happen"  */
        !           322: }
        !           323: 
        !           324: int    ex_add(),       ex_plus(),      ex_sub(),       ex_minus(),
        !           325:        ex_mul(),       ex_sgn(),       ex_div(),       ex_recip(),
        !           326:        ex_mod(),       ex_abs(),       ex_min(),       ex_floor(),
        !           327:        ex_max(),       ex_ceil(),      ex_pwr(),       ex_exp(),
        !           328:        ex_log(),       ex_loge(),      ex_cir(),       ex_pi(),
        !           329:        ex_comb(),      ex_fac(),       ex_deal(),      ex_rand(),
        !           330:        ex_drho(),      ex_mrho(),      ex_diot(),      ex_miot(),
        !           331:        ex_rot0(),      ex_rev0(),      ex_dtrn(),      ex_mtrn(),
        !           332:        ex_dibm(),      ex_mibm(),      ex_gdu(),       ex_gduk(),
        !           333:        ex_gdd(),       ex_gddk(),      ex_exd(),       ex_scan(),
        !           334:        ex_exdk(),      ex_scnk(),      ex_iprod(),     ex_oprod(),
        !           335:        ex_br0(),       ex_br(),        ex_ddom(),      ex_mdom(),
        !           336:        ex_com(),       ex_red(),       ex_comk(),      ex_redk(),
        !           337:        ex_rot(),       ex_rev(),       ex_rotk(),      ex_revk(),
        !           338:        ex_cat(),       ex_rav(),       ex_catk(),      ex_ravk(),
        !           339:        ex_print(),     ex_elid(),      ex_index(),     ex_hprint(),
        !           340:        ex_lt(),        ex_le(),        ex_gt(),        ex_ge(),
        !           341:        ex_eq(),        ex_ne(),        ex_and(),       ex_or(),
        !           342:        ex_nand(),      ex_nor(),       ex_not(),       ex_eps(),
        !           343:        ex_meps(),      ex_rep(),       ex_take(),      ex_drop(),
        !           344:        ex_exd0(),      ex_asgn(),      ex_immed(),     ex_fun(),
        !           345:        ex_arg1(),      ex_arg2(),      ex_auto(),      ex_rest(),
        !           346:        ex_com0(),      ex_red0(),      ex_exd0(),      ex_scn0(),
        !           347:        ex_base(),      ex_menc();
        !           348: 
        !           349: int (*exop[])() =
        !           350: {
        !           351:        0,              /* 0 */
        !           352:        ex_add,         /* 1 */
        !           353:        ex_plus,        /* 2 */
        !           354:        ex_sub,         /* 3 */
        !           355:        ex_minus,       /* 4 */
        !           356:        ex_mul,         /* 5 */
        !           357:        ex_sgn,         /* 6 */
        !           358:        ex_div,         /* 7 */
        !           359:        ex_recip,       /* 8 */
        !           360:        ex_mod,         /* 9 */
        !           361:        ex_abs,         /* 10 */
        !           362:        ex_min,         /* 11 */
        !           363:        ex_floor,       /* 12 */
        !           364:        ex_max,         /* 13 */
        !           365:        ex_ceil,        /* 14 */
        !           366:        ex_pwr,         /* 15 */
        !           367:        ex_exp,         /* 16 */
        !           368:        ex_log,         /* 17 */
        !           369:        ex_loge,        /* 18 */
        !           370:        ex_cir,         /* 19 */
        !           371:        ex_pi,          /* 20 */
        !           372:        ex_comb,        /* 21 */
        !           373:        ex_fac,         /* 22 */
        !           374:        ex_deal,        /* 23 */
        !           375:        ex_rand,        /* 24 */
        !           376:        ex_drho,        /* 25 */
        !           377:        ex_mrho,        /* 26 */
        !           378:        ex_diot,        /* 27 */
        !           379:        ex_miot,        /* 28 */
        !           380:        ex_rot0,        /* 29 */
        !           381:        ex_rev0,        /* 30 */
        !           382:        ex_dtrn,        /* 31 */
        !           383:        ex_mtrn,        /* 32 */
        !           384:        ex_dibm,        /* 33 */
        !           385:        ex_mibm,        /* 34 */
        !           386:        ex_gdu,         /* 35 */
        !           387:        ex_gduk,        /* 36 */
        !           388:        ex_gdd,         /* 37 */
        !           389:        ex_gddk,        /* 38 */
        !           390:        ex_exd,         /* 39 */
        !           391:        ex_scan,        /* 40 */
        !           392:        ex_exdk,        /* 41 */
        !           393:        ex_scnk,        /* 42 */
        !           394:        ex_iprod,       /* 43 */
        !           395:        ex_oprod,       /* 44 */
        !           396:        0,              /* 45 */
        !           397:        0,              /* 46 */
        !           398:        ex_br0,         /* 47 */
        !           399:        ex_br,          /* 48 */
        !           400:        ex_ddom,        /* 49 */
        !           401:        ex_mdom,        /* 50 */
        !           402:        ex_com,         /* 51 */
        !           403:        ex_red,         /* 52 */
        !           404:        ex_comk,        /* 53 */
        !           405:        ex_redk,        /* 54 */
        !           406:        ex_rot,         /* 55 */
        !           407:        ex_rev,         /* 56 */
        !           408:        ex_rotk,        /* 57 */
        !           409:        ex_revk,        /* 58 */
        !           410:        ex_cat,         /* 59 */
        !           411:        ex_rav,         /* 60 */
        !           412:        ex_catk,        /* 61 */
        !           413:        ex_ravk,        /* 62 */
        !           414:        ex_print,       /* 63 */
        !           415:        0,              /* 64 */
        !           416:        ex_elid,        /* 65 */
        !           417:        0,              /* 66 */
        !           418:        0,              /* 67 */
        !           419:        ex_index,       /* 68 */
        !           420:        ex_hprint,      /* 69 */
        !           421:        0,              /* 70 */
        !           422:        ex_lt,          /* 71 */
        !           423:        ex_le,          /* 72 */
        !           424:        ex_gt,          /* 73 */
        !           425:        ex_ge,          /* 74 */
        !           426:        ex_eq,          /* 75 */
        !           427:        ex_ne,          /* 76 */
        !           428:        ex_and,         /* 77 */
        !           429:        ex_or,          /* 78 */
        !           430:        ex_nand,        /* 79 */
        !           431:        ex_nor,         /* 80 */
        !           432:        ex_not,         /* 81 */
        !           433:        ex_eps,         /* 82 */
        !           434:        ex_meps,        /* 83 */
        !           435:        ex_rep,         /* 84 */
        !           436:        ex_take,        /* 85 */
        !           437:        ex_drop,        /* 86 */
        !           438:        ex_exd0,        /* 87 */
        !           439:        ex_asgn,        /* 88 */
        !           440:        ex_immed,       /* 89 */
        !           441:        0,              /* 90 */
        !           442:        0,              /* 91 */
        !           443:        ex_fun,         /* 92 */
        !           444:        ex_arg1,        /* 93 */
        !           445:        ex_arg2,        /* 94 */
        !           446:        ex_auto,        /* 95 */
        !           447:        ex_rest,        /* 96 */
        !           448:        ex_com0,        /* 97 */
        !           449:        ex_red0,        /* 98 */
        !           450:        ex_exd0,        /* 99 */
        !           451:        ex_scn0,        /*100 */
        !           452:        ex_base,        /*101 */
        !           453:        ex_menc,        /*102 */        /*      monadic encod   */
        !           454: };

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