![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to aplcvt.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src|
Return to aplcvt.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src |
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.