2.11BSD#431 - /usr/src/new/OLD/apl/src/aplcvt.c

   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: }

Defined functions

Defined variables

Defined struct's

Defined union's

Defined macros