Return to aplcvt.c CVS log

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

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

1.1     ! root        1: static char Sccsid[] = "aplcvt.c @(#)aplcvt.c  1.2     10/1/82 Berkeley ";
        !             2: #
        !             3: 
        !             4: /*
        !             5:  *     aplcvt - convert APL workspace to/from VAX format
        !             6:  */
        !             7: 
        !             8: #include <stdio.h>
        !             9: 
        !            10: #define PDPMAGIC 0100554               /* PDP-11 magic number */
        !            11: #define        VAXMAGIC 0100556                /* VAX magic number */
        !            12: 
        !            13: #define        DA      1                       /* data type */
        !            14: #define        NF      8                       /* niladic function type */
        !            15: #define        MF      9                       /* monadic function type */
        !            16: #define        DF      10                      /* dyadic function type */
        !            17: #define        MRANK   8                       /* maximum rank */
        !            18: 
        !            19: /*
        !            20:  *     The following define the internal data structures for APL
        !            21:  *     on both the PDP-11 and the VAX.  Two short integers are
        !            22:  *     used instead of a long integer for the VAX definitions so
        !            23:  *     that the program can be compiled and run on either machine
        !            24:  *     without changes.  (Otherwise, the reversal of long integers
        !            25:  *     between the two machines would cause problems.)
        !            26:  */
        !            27: 
        !            28: struct pdp_thread {
        !            29:        double  pt_fuzz;
        !            30:        short   pt_iorg;
        !            31:        short   pt_rl;
        !            32:        short   pt_digits;
        !            33:        short   pt_width;
        !            34: } pthread;
        !            35: #define        PTSIZE  14              /* its real size, not the sizeof */
        !            36: 
        !            37: struct vax_thread {
        !            38:        double  vt_fuzz;
        !            39:        short   vt_iorg[2];
        !            40:        short   vt_rl[2];
        !            41:        short   vt_digits[2];
        !            42:        short   vt_width[2];
        !            43: } vthread;
        !            44: 
        !            45: 
        !            46: struct pdp_item {
        !            47:        char    pi_rank;
        !            48:        char    pi_type;
        !            49:        short   pi_size;
        !            50:        short   pi_index;
        !            51:        short   pi_datap;       /* really a 16-bit pointer */
        !            52:        short   pi_dim[MRANK];
        !            53: } pitem;
        !            54: 
        !            55: struct vax_item {
        !            56:        char    vi_rank;
        !            57:        char    vi_type;
        !            58:        char    vi_pad[2];
        !            59:        short   vi_size[2];
        !            60:        short   vi_index[2];
        !            61:        short   vi_datap[2];    /* really a 32-bit pointer */
        !            62:        short   vi_dim[MRANK][2];       /* array of 32-bit integers */
        !            63: } vitem;
        !            64: 
        !            65: union uci {
        !            66:        char    cv[4];
        !            67:        unsigned short s;
        !            68: };
        !            69: 
        !            70: #define        eperror(x,y)    {eprintf(x); perror(y);}
        !            71: char *base(), *strcpy(), *strcmp();
        !            72: 
        !            73: #ifdef vax
        !            74: int makevax = 1;               /* by default, convert to VAX format */
        !            75: #else
        !            76: int makevax = 0;               /* by default, convert to PDP format */
        !            77: #endif
        !            78: 
        !            79: char *pname;                   /* holds argv[0] */
        !            80: char *ifname;                  /* points to input file name */
        !            81: char ofname[128];              /* contains output file name */
        !            82: 
        !            83: main(argc, argv)
        !            84: char **argv;
        !            85: {
        !            86:        register FILE *ifp, *ofp;
        !            87:        register char **ap;
        !            88: 
        !            89:        /* Parse the arguments */
        !            90: 
        !            91:        pname = *argv;
        !            92:        ap = argv+1;
        !            93:        if (argc > 1 && *argv[1] == '-'){
        !            94:                switch(argv[1][1]){
        !            95:                case 'v':
        !            96:                case 'p':
        !            97:                        makevax = (argv[1][1] == 'v');
        !            98:                        break;
        !            99:                default:
        !           100:                        eprintf("unknown flag \"%s\"\n", argv[1]);
        !           101:                        exit(1);
        !           102:                }
        !           103:                ap++;
        !           104:        }
        !           105: 
        !           106: 
        !           107:        /* If there are no filename arguments, convert standard
        !           108:         * input to standard output.  However, if one of these is
        !           109:         * a tty, just exit with a syntax error message (it is highly
        !           110:         * unlikely that the user wanted input or output from/to his
        !           111:         * tty.
        !           112:         *
        !           113:         * If there are filenames, convert each one.
        !           114:         */
        !           115: 
        !           116:        if (!*ap){
        !           117:                if(isatty(0) || isatty(1)){
        !           118:                        fprintf(stderr, "Syntax: \"%s [-v|-p] filename ...\"\n",
        !           119:                            pname);
        !           120:                        exit(1);
        !           121:                }
        !           122:                ifname = "<stdin>";
        !           123:                strcpy(ofname, "<stdout>");
        !           124:                if (makevax ? tovax(stdin,stdout) : topdp(stdin,stdout)){
        !           125:                        eprintf("don't trust the output file!\n");
        !           126:                        exit(1);
        !           127:                }
        !           128:        } else
        !           129:                for(; *ap; ap++){
        !           130:                        ifname = *ap;
        !           131:                        if ((ifp=fopen(ifname, "r")) == NULL){
        !           132:                                eperror("can't open ", ifname);
        !           133:                                continue;
        !           134:                        }
        !           135:                        strcat(strcpy(ofname,base(ifname)),
        !           136:                            makevax ? ".vax" : ".pdp");
        !           137:                        if ((ofp=fopen(ofname, "w")) == NULL){
        !           138:                                eperror("can't create ", ofname);
        !           139:                                fclose(ifp);
        !           140:                                continue;
        !           141:                        }
        !           142:                        if (makevax ? tovax(ifp,ofp) : topdp(ifp,ofp))
        !           143:                                if (unlink(ofname) < 0)
        !           144:                                        eperror("unlink ", ofname);
        !           145:                        fclose(ifp);
        !           146:                        fclose(ofp);
        !           147:                }
        !           148: 
        !           149:        exit(0);
        !           150: }
        !           151: 
        !           152: char *
        !           153: base(s)
        !           154: register char *s;
        !           155: {
        !           156:        static char basename[128];
        !           157:        register char *p;
        !           158: 
        !           159:        /* Strip off a trailing ".pdp" or ".vax" (depending upon the
        !           160:         * direction of conversion.
        !           161:         */
        !           162: 
        !           163:        for(p=basename; *p = *s; p++,s++)
        !           164:                if (*s == '.' && !strcmp(s+1, makevax ? "pdp" : "vax")){
        !           165:                        *p = '\0';
        !           166:                        break;
        !           167:                }
        !           168: 
        !           169:        return(basename);
        !           170: }
        !           171: 
        !           172: topdp(ifp, ofp)
        !           173: FILE *ifp, *ofp;
        !           174: {
        !           175:        unsigned short magic;
        !           176:        short nsz;
        !           177:        union uci iz;
        !           178:        char name[128];
        !           179:        register c;
        !           180:        register j;
        !           181: 
        !           182:        /* Look for proper magic number */
        !           183: 
        !           184:        if (fread(&magic, sizeof magic, 1, ifp) != 1){
        !           185:                eperror("read error on ", ifname);
        !           186:                return(-1);
        !           187:        }
        !           188: 
        !           189:        if ((magic|1) != (VAXMAGIC|1)){
        !           190:                eprintf("%s is not a VAX APL workspace\n", ifname);
        !           191:                return(-1);
        !           192:        }
        !           193: 
        !           194:        if (fread(&magic, sizeof magic, 1, ifp) != 1){
        !           195:                eperror("read error on ", ifname);
        !           196:                return(-1);
        !           197:        }
        !           198: 
        !           199:        if (magic){
        !           200:                eprintf("warning: %s may be corrupted\n", ifname);
        !           201:                eprintf("attempting to continue\n");
        !           202:        }
        !           203: 
        !           204:        magic = (magic&1) | PDPMAGIC;
        !           205:        if (fwrite(&magic, sizeof magic, 1, ofp) != 1){
        !           206:                eperror("write error on ", ofname);
        !           207:                return(-1);
        !           208:        }
        !           209: 
        !           210: 
        !           211:        /* Convert the "thread" structure */
        !           212: 
        !           213:        if (fread(&vthread, sizeof vthread, 1, ifp) != 1){
        !           214:                eperror("read error on ", ifname);
        !           215:                return(-1);
        !           216:        }
        !           217: 
        !           218:        pthread.pt_fuzz = vthread.vt_fuzz;
        !           219:        pthread.pt_iorg = vthread.vt_iorg[0];
        !           220:        pthread.pt_rl = vthread.vt_rl[0];
        !           221:        pthread.pt_digits = vthread.vt_digits[0];
        !           222:        pthread.pt_width = vthread.vt_width[0];
        !           223: 
        !           224:        if (fwrite(&pthread, PTSIZE, 1, ofp) != 1){
        !           225:                eperror("write error on ", ofname);
        !           226:                return(-1);
        !           227:        }
        !           228: 
        !           229: 
        !           230:        /* Convert each data item or function */
        !           231: 
        !           232: loop:
        !           233:        if ((j=fread(&iz, sizeof(long), 1, ifp)) != 1)
        !           234:                if (j <= 0)
        !           235:                        return(0);
        !           236:                else {
        !           237:                        eperror("read error on ", ifname);
        !           238:                        return(-1);
        !           239:                }
        !           240:        if (fwrite(&iz, sizeof(short), 1, ofp) != 1){
        !           241:                eperror("write error on ", ofname);
        !           242:                return(-1);
        !           243:        }
        !           244: 
        !           245:        if (fread(name, sizeof(char), (unsigned)iz.cv[1], ifp) != iz.cv[1]){
        !           246:                eperror("read error on ", ifname);
        !           247:                return(-1);
        !           248:        }
        !           249:        if (fwrite(name, sizeof(char), (unsigned)iz.cv[1], ofp) != iz.cv[1]){
        !           250:                eperror("write error on ", ofname);
        !           251:                return(-1);
        !           252:        }
        !           253: 
        !           254:        switch(iz.cv[0]){
        !           255:        default:
        !           256:                eprintf("unknown item, type = %d\n", iz.cv[0]);
        !           257:                eprintf("conversion aborted\n");
        !           258:                return(-1);
        !           259: 
        !           260:        case NF:
        !           261:        case MF:
        !           262:        case DF:
        !           263:                do {
        !           264:                        if ((c=getc(ifp)) == EOF){
        !           265:                                eperror("getc error on ", ifname);
        !           266:                                return(-1);
        !           267:                        }
        !           268:                        putc(c, ofp);
        !           269:                } while (c);
        !           270:                break;
        !           271: 
        !           272:        case DA:
        !           273:                if (fread(&iz, sizeof(long), 1, ifp) != 1){
        !           274:                        eperror("read error on ", ifname);
        !           275:                        return(-1);
        !           276:                }
        !           277:                if (iz.cv[2] | iz.cv[3]){
        !           278:                        eprintf("item %s too large -- aborting\n", name);
        !           279:                        return(-1);
        !           280:                }
        !           281:                if (fread(&vitem, sizeof vitem - MRANK*sizeof(long),
        !           282:                    1, ifp) != 1){
        !           283:                        eperror("read error on ", ifname);
        !           284:                        return(-1);
        !           285:                }
        !           286:                if (fread(vitem.vi_dim, sizeof(long), vitem.vi_rank, ifp)
        !           287:                    != vitem.vi_rank){
        !           288:                        eperror("read error on ", ifname);
        !           289:                        return(-1);
        !           290:                }
        !           291:                pitem.pi_rank = vitem.vi_rank;
        !           292:                pitem.pi_type = vitem.vi_type;
        !           293:                pitem.pi_size = vitem.vi_size[0];
        !           294:                for(j=0; j<vitem.vi_rank; j++)
        !           295:                        pitem.pi_dim[j] = vitem.vi_dim[j][0];
        !           296:                nsz = sizeof pitem - (MRANK-pitem.pi_rank)*sizeof(short)
        !           297:                    - sizeof vitem + (MRANK-vitem.vi_rank)*sizeof(long)
        !           298:                    + iz.s;
        !           299:                if (fwrite(&nsz, sizeof nsz, 1, ofp) != 1){
        !           300:                        eperror("write error on ", ofname);
        !           301:                        return(-1);
        !           302:                }
        !           303:                j = sizeof pitem - (MRANK-pitem.pi_rank)*sizeof(short);
        !           304:                if (fwrite(&pitem, j, 1, ofp) != 1){
        !           305:                        eperror("write error on ", ofname);
        !           306:                        return(-1);
        !           307:                }
        !           308:                j = sizeof vitem - (MRANK-vitem.vi_rank)*sizeof(long);
        !           309:                if (copy(ifp, ofp, iz.s-j))
        !           310:                        return(-1);
        !           311:        }
        !           312: 
        !           313:        goto loop;      /* should be while(1) */
        !           314: }
        !           315: 
        !           316: tovax(ifp, ofp)
        !           317: FILE *ifp, *ofp;
        !           318: {
        !           319:        unsigned short magic;
        !           320:        static short zero = 0;
        !           321:        short nsz;
        !           322:        union uci iz;
        !           323:        char name[128];
        !           324:        register c;
        !           325:        register j;
        !           326: 
        !           327:        /* Look for proper magic number. */
        !           328: 
        !           329:        if (fread(&magic, sizeof magic, 1, ifp) != 1){
        !           330:                eperror("read error on ", ifname);
        !           331:                return(-1);
        !           332:        }
        !           333: 
        !           334:        if ((magic|1) != (PDPMAGIC|1)){
        !           335:                eprintf("%s is not a PDP-11 APL workspace\n", ifname);
        !           336:                return(-1);
        !           337:        }
        !           338: 
        !           339:        magic = (magic&1) | VAXMAGIC;
        !           340:        if (fwrite(&magic, sizeof magic, 1, ofp) != 1
        !           341:            || fwrite(&zero, sizeof zero, 1, ofp) != 1){
        !           342:                eperror("write error on ", ofname);
        !           343:                return(-1);
        !           344:        }
        !           345: 
        !           346: 
        !           347:        /* Convert the "thread" structure. */
        !           348: 
        !           349:        if (fread(&pthread, PTSIZE, 1, ifp) != 1){
        !           350:                eperror("read error on ", ifname);
        !           351:                return(-1);
        !           352:        }
        !           353: 
        !           354:        vthread.vt_fuzz = pthread.pt_fuzz;
        !           355:        vthread.vt_iorg[0] = pthread.pt_iorg;
        !           356:        vthread.vt_iorg[1] = 0;
        !           357:        vthread.vt_rl[0] = pthread.pt_rl;
        !           358:        vthread.vt_rl[1] = 0;
        !           359:        vthread.vt_digits[0] = pthread.pt_digits;
        !           360:        vthread.vt_digits[1] = 0;
        !           361:        vthread.vt_width[0] = pthread.pt_width;
        !           362:        vthread.vt_width[1] = 0;
        !           363: 
        !           364:        if (fwrite(&vthread, sizeof vthread, 1, ofp) != 1){
        !           365:                eperror("write error on ", ofname);
        !           366:                return(-1);
        !           367:        }
        !           368: 
        !           369: 
        !           370:        /* Convert each data item or function. */
        !           371: 
        !           372: loop:
        !           373:        if ((j=fread(&iz, sizeof(short), 1, ifp)) != 1)
        !           374:                if (j <= 0)
        !           375:                        return(0);
        !           376:                else {
        !           377:                        eperror("read error on ", ifname);
        !           378:                        return(-1);
        !           379:                }
        !           380:        iz.cv[2] = iz.cv[3] = 0;
        !           381:        if (fwrite(&iz, sizeof(long), 1, ofp) != 1){
        !           382:                eperror("write error on ", ofname);
        !           383:                return(-1);
        !           384:        }
        !           385: 
        !           386:        if (fread(name, sizeof(char), (unsigned)iz.cv[1], ifp) != iz.cv[1]){
        !           387:                eperror("read error on ", ifname);
        !           388:                return(-1);
        !           389:        }
        !           390:        if (fwrite(name, sizeof(char), (unsigned)iz.cv[1], ofp) != iz.cv[1]){
        !           391:                eperror("write error on ", ofname);
        !           392:                return(-1);
        !           393:        }
        !           394: 
        !           395:        switch(iz.cv[0]){
        !           396:        default:
        !           397:                eprintf("unknown item, type = %d\n", iz.cv[0]);
        !           398:                eprintf("conversion aborted\n");
        !           399:                return(-1);
        !           400: 
        !           401:        case NF:
        !           402:        case MF:
        !           403:        case DF:
        !           404:                do {
        !           405:                        if ((c=getc(ifp)) == EOF){
        !           406:                                eperror("getc error on ", ifname);
        !           407:                                return(-1);
        !           408:                        }
        !           409:                        putc(c, ofp);
        !           410:                } while (c);
        !           411:                break;
        !           412: 
        !           413:        case DA:
        !           414:                if (fread(&iz, sizeof(short), 1, ifp) != 1){
        !           415:                        eperror("read error on ", ifname);
        !           416:                        return(-1);
        !           417:                }
        !           418:                if (fread(&pitem, sizeof pitem - MRANK*sizeof(short),
        !           419:                    1, ifp) != 1){
        !           420:                        eperror("read error on ", ifname);
        !           421:                        return(-1);
        !           422:                }
        !           423:                if (fread(pitem.pi_dim, sizeof(short), pitem.pi_rank, ifp)
        !           424:                    != pitem.pi_rank){
        !           425:                        eperror("read error on ", ifname);
        !           426:                        return(-1);
        !           427:                }
        !           428:                vitem.vi_rank = pitem.pi_rank;
        !           429:                vitem.vi_type = pitem.pi_type;
        !           430:                vitem.vi_size[0] = pitem.pi_size;
        !           431:                vitem.vi_size[1] = 0;
        !           432:                for(j=0; j<pitem.pi_rank; j++){
        !           433:                        vitem.vi_dim[j][0] = pitem.pi_dim[j];
        !           434:                        vitem.vi_dim[j][1] = 0;
        !           435:                }
        !           436:                nsz = sizeof vitem - (MRANK-vitem.vi_rank)*sizeof(long)
        !           437:                    - sizeof pitem + (MRANK-pitem.pi_rank)*sizeof(short)
        !           438:                    + iz.s;
        !           439:                if (fwrite(&nsz, sizeof nsz, 1, ofp) != 1
        !           440:                    || fwrite(&zero, sizeof zero, 1, ofp) != 1){
        !           441:                        perror("write error on ", ofname);
        !           442:                        return(-1);
        !           443:                }
        !           444:                j = sizeof vitem - (MRANK-vitem.vi_rank)*sizeof(long);
        !           445:                if (fwrite(&vitem, j, 1, ofp) != 1){
        !           446:                        eperror("write error on ", ofname);
        !           447:                        return(-1);
        !           448:                }
        !           449:                j = sizeof pitem - (MRANK-pitem.pi_rank)*sizeof(short);
        !           450:                if (copy(ifp, ofp, iz.s-j))
        !           451:                        return(-1);
        !           452:        }
        !           453: 
        !           454:        goto loop;      /* should be while(1) */
        !           455: }
        !           456: 
        !           457: copy(ifp, ofp, len)
        !           458: FILE *ifp, *ofp;
        !           459: register len;
        !           460: {
        !           461:        register c;
        !           462: 
        !           463:        while(len--){
        !           464:                if ((c=getc(ifp)) == EOF){
        !           465:                        eperror("getc error on ", ifname);
        !           466:                        return(-1);
        !           467:                }
        !           468:                putc(c, ofp);
        !           469:        }
        !           470:        return(0);
        !           471: }
        !           472: 
        !           473: /*VARARGS 1*/
        !           474: eprintf(a, b, c, d, e, f, g, h, i, j){
        !           475: 
        !           476:        fprintf(stderr, "%s: ", pname);
        !           477:        fprintf(stderr, a, b, c, d, e, f, g, h, i, j);
        !           478: }

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