[unix-history] / usr / contrib / apl / src / aplcvt.c

static char Sccsid[] = "aplcvt.c @(#)aplcvt.c	1.2	10/1/82 Berkeley ";
#

/*
 *	aplcvt - convert APL workspace to/from VAX format
 */

#include <stdio.h>

#define PDPMAGIC 0100554		/* PDP-11 magic number */
#define	VAXMAGIC 0100556		/* VAX magic number */

#define	DA	1			/* data type */
#define	NF	8			/* niladic function type */
#define	MF	9			/* monadic function type */
#define	DF	10			/* dyadic function type */
#define	MRANK	8			/* maximum rank */

/*
 *	The following define the internal data structures for APL
 *	on both the PDP-11 and the VAX.  Two short integers are
 *	used instead of a long integer for the VAX definitions so
 *	that the program can be compiled and run on either machine
 *	without changes.  (Otherwise, the reversal of long integers
 *	between the two machines would cause problems.)
 */

struct pdp_thread {
	double	pt_fuzz;
	short	pt_iorg;
	short	pt_rl;
	short	pt_digits;
	short	pt_width;
} pthread;
#define	PTSIZE	14		/* its real size, not the sizeof */

struct vax_thread {
	double	vt_fuzz;
	short	vt_iorg[2];
	short	vt_rl[2];
	short	vt_digits[2];
	short	vt_width[2];
} vthread;


struct pdp_item {
	char	pi_rank;
	char	pi_type;
	short	pi_size;
	short	pi_index;
	short	pi_datap;	/* really a 16-bit pointer */
	short	pi_dim[MRANK];
} pitem;

struct vax_item {
	char	vi_rank;
	char	vi_type;
	char	vi_pad[2];
	short	vi_size[2];
	short	vi_index[2];
	short	vi_datap[2];	/* really a 32-bit pointer */
	short	vi_dim[MRANK][2];	/* array of 32-bit integers */
} vitem;

union uci {
	char	cv[4];
	unsigned short s;
};

#define	eperror(x,y)	{eprintf(x); perror(y);}
char *base(), *strcpy(), *strcmp();

#ifdef vax
int makevax = 1;		/* by default, convert to VAX format */
#else
int makevax = 0;		/* by default, convert to PDP format */
#endif

char *pname;			/* holds argv[0] */
char *ifname;			/* points to input file name */
char ofname[128];		/* contains output file name */

main(argc, argv)
char **argv;
{
	register FILE *ifp, *ofp;
	register char **ap;

	/* Parse the arguments */

	pname = *argv;
	ap = argv+1;
	if (argc > 1 && *argv[1] == '-'){
		switch(argv[1][1]){
		case 'v':
		case 'p':
			makevax = (argv[1][1] == 'v');
			break;
		default:
			eprintf("unknown flag \"%s\"\n", argv[1]);
			exit(1);
		}
		ap++;
	}


	/* If there are no filename arguments, convert standard
	 * input to standard output.  However, if one of these is
	 * a tty, just exit with a syntax error message (it is highly
	 * unlikely that the user wanted input or output from/to his
	 * tty.
	 *
	 * If there are filenames, convert each one.
	 */

	if (!*ap){
		if(isatty(0) || isatty(1)){
			fprintf(stderr, "Syntax: \"%s [-v|-p] filename ...\"\n",
			    pname);
			exit(1);
		}
		ifname = "<stdin>";
		strcpy(ofname, "<stdout>");
		if (makevax ? tovax(stdin,stdout) : topdp(stdin,stdout)){
			eprintf("don't trust the output file!\n");
			exit(1);
		}
	} else
		for(; *ap; ap++){
			ifname = *ap;
			if ((ifp=fopen(ifname, "r")) == NULL){
				eperror("can't open ", ifname);
				continue;
			}
			strcat(strcpy(ofname,base(ifname)),
			    makevax ? ".vax" : ".pdp");
			if ((ofp=fopen(ofname, "w")) == NULL){
				eperror("can't create ", ofname);
				fclose(ifp);
				continue;
			}
			if (makevax ? tovax(ifp,ofp) : topdp(ifp,ofp))
				if (unlink(ofname) < 0)
					eperror("unlink ", ofname);
			fclose(ifp);
			fclose(ofp);
		}

	exit(0);
}

char *
base(s)
register char *s;
{
	static char basename[128];
	register char *p;

	/* Strip off a trailing ".pdp" or ".vax" (depending upon the
	 * direction of conversion.
	 */

	for(p=basename; *p = *s; p++,s++)
		if (*s == '.' && !strcmp(s+1, makevax ? "pdp" : "vax")){
			*p = '\0';
			break;
		}

	return(basename);
}

topdp(ifp, ofp)
FILE *ifp, *ofp;
{
	unsigned short magic;
	short nsz;
	union uci iz;
	char name[128];
	register c;
	register j;

	/* Look for proper magic number */

	if (fread(&magic, sizeof magic, 1, ifp) != 1){
		eperror("read error on ", ifname);
		return(-1);
	}

	if ((magic|1) != (VAXMAGIC|1)){
		eprintf("%s is not a VAX APL workspace\n", ifname);
		return(-1);
	}

	if (fread(&magic, sizeof magic, 1, ifp) != 1){
		eperror("read error on ", ifname);
		return(-1);
	}

	if (magic){
		eprintf("warning: %s may be corrupted\n", ifname);
		eprintf("attempting to continue\n");
	}

	magic = (magic&1) | PDPMAGIC;
	if (fwrite(&magic, sizeof magic, 1, ofp) != 1){
		eperror("write error on ", ofname);
		return(-1);
	}


	/* Convert the "thread" structure */

	if (fread(&vthread, sizeof vthread, 1, ifp) != 1){
		eperror("read error on ", ifname);
		return(-1);
	}

	pthread.pt_fuzz = vthread.vt_fuzz;
	pthread.pt_iorg = vthread.vt_iorg[0];
	pthread.pt_rl = vthread.vt_rl[0];
	pthread.pt_digits = vthread.vt_digits[0];
	pthread.pt_width = vthread.vt_width[0];

	if (fwrite(&pthread, PTSIZE, 1, ofp) != 1){
		eperror("write error on ", ofname);
		return(-1);
	}


	/* Convert each data item or function */

loop:
	if ((j=fread(&iz, sizeof(long), 1, ifp)) != 1)
		if (j <= 0)
			return(0);
		else {
			eperror("read error on ", ifname);
			return(-1);
		}
	if (fwrite(&iz, sizeof(short), 1, ofp) != 1){
		eperror("write error on ", ofname);
		return(-1);
	}

	if (fread(name, sizeof(char), (unsigned)iz.cv[1], ifp) != iz.cv[1]){
		eperror("read error on ", ifname);
		return(-1);
	}
	if (fwrite(name, sizeof(char), (unsigned)iz.cv[1], ofp) != iz.cv[1]){
		eperror("write error on ", ofname);
		return(-1);
	}

	switch(iz.cv[0]){
	default:
		eprintf("unknown item, type = %d\n", iz.cv[0]);
		eprintf("conversion aborted\n");
		return(-1);

	case NF:
	case MF:
	case DF:
		do {
			if ((c=getc(ifp)) == EOF){
				eperror("getc error on ", ifname);
				return(-1);
			}
			putc(c, ofp);
		} while (c);
		break;

	case DA:
		if (fread(&iz, sizeof(long), 1, ifp) != 1){
			eperror("read error on ", ifname);
			return(-1);
		}
		if (iz.cv[2] | iz.cv[3]){
			eprintf("item %s too large -- aborting\n", name);
			return(-1);
		}
		if (fread(&vitem, sizeof vitem - MRANK*sizeof(long),
		    1, ifp) != 1){
			eperror("read error on ", ifname);
			return(-1);
		}
		if (fread(vitem.vi_dim, sizeof(long), vitem.vi_rank, ifp)
		    != vitem.vi_rank){
			eperror("read error on ", ifname);
			return(-1);
		}
		pitem.pi_rank = vitem.vi_rank;
		pitem.pi_type = vitem.vi_type;
		pitem.pi_size = vitem.vi_size[0];
		for(j=0; j<vitem.vi_rank; j++)
			pitem.pi_dim[j] = vitem.vi_dim[j][0];
		nsz = sizeof pitem - (MRANK-pitem.pi_rank)*sizeof(short)
		    - sizeof vitem + (MRANK-vitem.vi_rank)*sizeof(long)
		    + iz.s;
		if (fwrite(&nsz, sizeof nsz, 1, ofp) != 1){
			eperror("write error on ", ofname);
			return(-1);
		}
		j = sizeof pitem - (MRANK-pitem.pi_rank)*sizeof(short);
		if (fwrite(&pitem, j, 1, ofp) != 1){
			eperror("write error on ", ofname);
			return(-1);
		}
		j = sizeof vitem - (MRANK-vitem.vi_rank)*sizeof(long);
		if (copy(ifp, ofp, iz.s-j))
			return(-1);
	}

	goto loop;	/* should be while(1) */
}

tovax(ifp, ofp)
FILE *ifp, *ofp;
{
	unsigned short magic;
	static short zero = 0;
	short nsz;
	union uci iz;
	char name[128];
	register c;
	register j;

	/* Look for proper magic number. */

	if (fread(&magic, sizeof magic, 1, ifp) != 1){
		eperror("read error on ", ifname);
		return(-1);
	}

	if ((magic|1) != (PDPMAGIC|1)){
		eprintf("%s is not a PDP-11 APL workspace\n", ifname);
		return(-1);
	}

	magic = (magic&1) | VAXMAGIC;
	if (fwrite(&magic, sizeof magic, 1, ofp) != 1
	    || fwrite(&zero, sizeof zero, 1, ofp) != 1){
		eperror("write error on ", ofname);
		return(-1);
	}


	/* Convert the "thread" structure. */

	if (fread(&pthread, PTSIZE, 1, ifp) != 1){
		eperror("read error on ", ifname);
		return(-1);
	}

	vthread.vt_fuzz = pthread.pt_fuzz;
	vthread.vt_iorg[0] = pthread.pt_iorg;
	vthread.vt_iorg[1] = 0;
	vthread.vt_rl[0] = pthread.pt_rl;
	vthread.vt_rl[1] = 0;
	vthread.vt_digits[0] = pthread.pt_digits;
	vthread.vt_digits[1] = 0;
	vthread.vt_width[0] = pthread.pt_width;
	vthread.vt_width[1] = 0;

	if (fwrite(&vthread, sizeof vthread, 1, ofp) != 1){
		eperror("write error on ", ofname);
		return(-1);
	}


	/* Convert each data item or function. */

loop:
	if ((j=fread(&iz, sizeof(short), 1, ifp)) != 1)
		if (j <= 0)
			return(0);
		else {
			eperror("read error on ", ifname);
			return(-1);
		}
	iz.cv[2] = iz.cv[3] = 0;
	if (fwrite(&iz, sizeof(long), 1, ofp) != 1){
		eperror("write error on ", ofname);
		return(-1);
	}

	if (fread(name, sizeof(char), (unsigned)iz.cv[1], ifp) != iz.cv[1]){
		eperror("read error on ", ifname);
		return(-1);
	}
	if (fwrite(name, sizeof(char), (unsigned)iz.cv[1], ofp) != iz.cv[1]){
		eperror("write error on ", ofname);
		return(-1);
	}

	switch(iz.cv[0]){
	default:
		eprintf("unknown item, type = %d\n", iz.cv[0]);
		eprintf("conversion aborted\n");
		return(-1);

	case NF:
	case MF:
	case DF:
		do {
			if ((c=getc(ifp)) == EOF){
				eperror("getc error on ", ifname);
				return(-1);
			}
			putc(c, ofp);
		} while (c);
		break;

	case DA:
		if (fread(&iz, sizeof(short), 1, ifp) != 1){
			eperror("read error on ", ifname);
			return(-1);
		}
		if (fread(&pitem, sizeof pitem - MRANK*sizeof(short),
		    1, ifp) != 1){
			eperror("read error on ", ifname);
			return(-1);
		}
		if (fread(pitem.pi_dim, sizeof(short), pitem.pi_rank, ifp)
		    != pitem.pi_rank){
			eperror("read error on ", ifname);
			return(-1);
		}
		vitem.vi_rank = pitem.pi_rank;
		vitem.vi_type = pitem.pi_type;
		vitem.vi_size[0] = pitem.pi_size;
		vitem.vi_size[1] = 0;
		for(j=0; j<pitem.pi_rank; j++){
			vitem.vi_dim[j][0] = pitem.pi_dim[j];
			vitem.vi_dim[j][1] = 0;
		}
		nsz = sizeof vitem - (MRANK-vitem.vi_rank)*sizeof(long)
		    - sizeof pitem + (MRANK-pitem.pi_rank)*sizeof(short)
		    + iz.s;
		if (fwrite(&nsz, sizeof nsz, 1, ofp) != 1
		    || fwrite(&zero, sizeof zero, 1, ofp) != 1){
			perror("write error on ", ofname);
			return(-1);
		}
		j = sizeof vitem - (MRANK-vitem.vi_rank)*sizeof(long);
		if (fwrite(&vitem, j, 1, ofp) != 1){
			eperror("write error on ", ofname);
			return(-1);
		}
		j = sizeof pitem - (MRANK-pitem.pi_rank)*sizeof(short);
		if (copy(ifp, ofp, iz.s-j))
			return(-1);
	}

	goto loop;	/* should be while(1) */
}

copy(ifp, ofp, len)
FILE *ifp, *ofp;
register len;
{
	register c;

	while(len--){
		if ((c=getc(ifp)) == EOF){
			eperror("getc error on ", ifname);
			return(-1);
		}
		putc(c, ofp);
	}
	return(0);
}

/*VARARGS 1*/
eprintf(a, b, c, d, e, f, g, h, i, j){

	fprintf(stderr, "%s: ", pname);
	fprintf(stderr, a, b, c, d, e, f, g, h, i, j);
}
Commit	Line	Data
0f4556f1 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	}