xref: /csrg-svn/usr.bin/pascal/src/pcproc.c (revision 11883)
1766Speter /* Copyright (c) 1979 Regents of the University of California */
2766Speter 
3*11883Smckusick static	char sccsid[] = "@(#)pcproc.c 1.21 04/08/83";
4766Speter 
5766Speter #include "whoami.h"
6766Speter #ifdef PC
7766Speter     /*
8766Speter      * and to the end of the file
9766Speter      */
10766Speter #include "0.h"
11766Speter #include "tree.h"
1210372Speter #include "objfmt.h"
13766Speter #include "opcode.h"
1410372Speter #include "pc.h"
1510372Speter #include "pcops.h"
1611333Speter #include "tmps.h"
17766Speter 
18766Speter /*
19*11883Smckusick  * The constant EXPOSIZE specifies the number of digits in the exponent
20*11883Smckusick  * of real numbers.
21*11883Smckusick  *
229229Smckusick  * The constant REALSPC defines the amount of forced padding preceeding
239229Smckusick  * real numbers when they are printed. If REALSPC == 0, then no padding
249229Smckusick  * is added, REALSPC == 1 adds one extra blank irregardless of the width
259229Smckusick  * specified by the user.
269229Smckusick  *
279229Smckusick  * N.B. - Values greater than one require program mods.
289229Smckusick  */
29*11883Smckusick #define EXPOSIZE	2
30*11883Smckusick #define	REALSPC		0
319229Smckusick 
329229Smckusick /*
33766Speter  * The following array is used to determine which classes may be read
34766Speter  * from textfiles. It is indexed by the return value from classify.
35766Speter  */
36766Speter #define rdops(x) rdxxxx[(x)-(TFIRST)]
37766Speter 
38766Speter int rdxxxx[] = {
39766Speter 	0,		/* -7 file types */
40766Speter 	0,		/* -6 record types */
41766Speter 	0,		/* -5 array types */
42766Speter 	O_READE,	/* -4 scalar types */
43766Speter 	0,		/* -3 pointer types */
44766Speter 	0,		/* -2 set types */
45766Speter 	0,		/* -1 string types */
46766Speter 	0,		/*  0 nil, no type */
47766Speter 	O_READE,	/*  1 boolean */
48766Speter 	O_READC,	/*  2 character */
49766Speter 	O_READ4,	/*  3 integer */
50766Speter 	O_READ8		/*  4 real */
51766Speter };
52766Speter 
53766Speter /*
54766Speter  * Proc handles procedure calls.
55766Speter  * Non-builtin procedures are "buck-passed" to func (with a flag
56766Speter  * indicating that they are actually procedures.
57766Speter  * builtin procedures are handled here.
58766Speter  */
59766Speter pcproc(r)
60766Speter 	int *r;
61766Speter {
62766Speter 	register struct nl *p;
63766Speter 	register int *alv, *al, op;
64766Speter 	struct nl *filetype, *ap;
65766Speter 	int argc, *argv, typ, fmtspec, strfmt, stkcnt, *file;
667967Smckusick 	char fmt, format[20], *strptr, *cmd;
67766Speter 	int prec, field, strnglen, fmtlen, fmtstart, pu;
68766Speter 	int *pua, *pui, *puz;
69766Speter 	int i, j, k;
70766Speter 	int itemwidth;
713833Speter 	char		*readname;
723833Speter 	struct nl	*tempnlp;
733833Speter 	long		readtype;
743833Speter 	struct tmps	soffset;
75766Speter 
76766Speter #define	CONPREC 4
77766Speter #define	VARPREC 8
78766Speter #define	CONWIDTH 1
79766Speter #define	VARWIDTH 2
80766Speter #define SKIP 16
81766Speter 
82766Speter 	/*
83766Speter 	 * Verify that the name is
84766Speter 	 * defined and is that of a
85766Speter 	 * procedure.
86766Speter 	 */
87766Speter 	p = lookup(r[2]);
88766Speter 	if (p == NIL) {
89766Speter 		rvlist(r[3]);
90766Speter 		return;
91766Speter 	}
921197Speter 	if (p->class != PROC && p->class != FPROC) {
93766Speter 		error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]);
94766Speter 		rvlist(r[3]);
95766Speter 		return;
96766Speter 	}
97766Speter 	argv = r[3];
98766Speter 
99766Speter 	/*
100766Speter 	 * Call handles user defined
101766Speter 	 * procedures and functions.
102766Speter 	 */
103766Speter 	if (bn != 0) {
104766Speter 		call(p, argv, PROC, bn);
105766Speter 		return;
106766Speter 	}
107766Speter 
108766Speter 	/*
109766Speter 	 * Call to built-in procedure.
110766Speter 	 * Count the arguments.
111766Speter 	 */
112766Speter 	argc = 0;
113766Speter 	for (al = argv; al != NIL; al = al[2])
114766Speter 		argc++;
115766Speter 
116766Speter 	/*
117766Speter 	 * Switch on the operator
118766Speter 	 * associated with the built-in
119766Speter 	 * procedure in the namelist
120766Speter 	 */
121766Speter 	op = p->value[0] &~ NSTAND;
122766Speter 	if (opt('s') && (p->value[0] & NSTAND)) {
123766Speter 		standard();
124766Speter 		error("%s is a nonstandard procedure", p->symbol);
125766Speter 	}
126766Speter 	switch (op) {
127766Speter 
128766Speter 	case O_ABORT:
129766Speter 		if (argc != 0)
130766Speter 			error("null takes no arguments");
131766Speter 		return;
132766Speter 
133766Speter 	case O_FLUSH:
134766Speter 		if (argc == 0) {
135766Speter 			putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" );
136766Speter 			putop( P2UNARY P2CALL , P2INT );
137766Speter 			putdot( filename , line );
138766Speter 			return;
139766Speter 		}
140766Speter 		if (argc != 1) {
141766Speter 			error("flush takes at most one argument");
142766Speter 			return;
143766Speter 		}
144766Speter 		putleaf( P2ICON , 0 , 0
145766Speter 			, ADDTYPE( P2FTN | P2INT , P2PTR )
146766Speter 			, "_FLUSH" );
147766Speter 		ap = stklval(argv[1], NOFLAGS);
148766Speter 		if (ap == NIL)
149766Speter 			return;
150766Speter 		if (ap->class != FILET) {
151766Speter 			error("flush's argument must be a file, not %s", nameof(ap));
152766Speter 			return;
153766Speter 		}
154766Speter 		putop( P2CALL , P2INT );
155766Speter 		putdot( filename , line );
156766Speter 		return;
157766Speter 
158766Speter 	case O_MESSAGE:
159766Speter 	case O_WRITEF:
160766Speter 	case O_WRITLN:
161766Speter 		/*
162766Speter 		 * Set up default file "output"'s type
163766Speter 		 */
164766Speter 		file = NIL;
165766Speter 		filetype = nl+T1CHAR;
166766Speter 		/*
167766Speter 		 * Determine the file implied
168766Speter 		 * for the write and generate
169766Speter 		 * code to make it the active file.
170766Speter 		 */
171766Speter 		if (op == O_MESSAGE) {
172766Speter 			/*
173766Speter 			 * For message, all that matters
174766Speter 			 * is that the filetype is
175766Speter 			 * a character file.
176766Speter 			 * Thus "output" will suit us fine.
177766Speter 			 */
178766Speter 			putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" );
179766Speter 			putop( P2UNARY P2CALL , P2INT );
180766Speter 			putdot( filename , line );
1813833Speter 			putRV( 0 , cbn , CURFILEOFFSET , NLOCAL ,
1823833Speter 				P2PTR|P2STRTY );
1833833Speter 			putLV( "__err" , 0 , 0 , NGLOBAL , P2PTR|P2STRTY );
184766Speter 			putop( P2ASSIGN , P2PTR|P2STRTY );
185766Speter 			putdot( filename , line );
186766Speter 		} else if (argv != NIL && (al = argv[1])[0] != T_WEXP) {
187766Speter 			/*
188766Speter 			 * If there is a first argument which has
189766Speter 			 * no write widths, then it is potentially
190766Speter 			 * a file name.
191766Speter 			 */
192766Speter 			codeoff();
193766Speter 			ap = stkrval(argv[1], NIL , RREQ );
194766Speter 			codeon();
195766Speter 			if (ap == NIL)
196766Speter 				argv = argv[2];
197766Speter 			if (ap != NIL && ap->class == FILET) {
198766Speter 				/*
199766Speter 				 * Got "write(f, ...", make
200766Speter 				 * f the active file, and save
201766Speter 				 * it and its type for use in
202766Speter 				 * processing the rest of the
203766Speter 				 * arguments to write.
204766Speter 				 */
2053833Speter 				putRV( 0 , cbn , CURFILEOFFSET , NLOCAL ,
2063833Speter 					P2PTR|P2STRTY );
207766Speter 				putleaf( P2ICON , 0 , 0
208766Speter 				    , ADDTYPE( P2FTN | P2INT , P2PTR )
209766Speter 				    , "_UNIT" );
210766Speter 				file = argv[1];
211766Speter 				filetype = ap->type;
212766Speter 				stklval(argv[1], NOFLAGS);
213766Speter 				putop( P2CALL , P2INT );
214766Speter 				putop( P2ASSIGN , P2PTR|P2STRTY );
215766Speter 				putdot( filename , line );
216766Speter 				/*
217766Speter 				 * Skip over the first argument
218766Speter 				 */
219766Speter 				argv = argv[2];
220766Speter 				argc--;
221766Speter 			} else {
222766Speter 				/*
223766Speter 				 * Set up for writing on
224766Speter 				 * standard output.
225766Speter 				 */
2263833Speter 				putRV( 0, cbn , CURFILEOFFSET ,
2273833Speter 					NLOCAL , P2PTR|P2STRTY );
2283833Speter 				putLV( "_output" , 0 , 0 , NGLOBAL ,
2293833Speter 					P2PTR|P2STRTY );
230766Speter 				putop( P2ASSIGN , P2PTR|P2STRTY );
231766Speter 				putdot( filename , line );
2327954Speter 				output->nl_flags |= NUSED;
233766Speter 			}
234766Speter 		} else {
2353833Speter 			putRV( 0, cbn , CURFILEOFFSET , NLOCAL ,
2363833Speter 				P2PTR|P2STRTY );
2373833Speter 			putLV( "_output" , 0 , 0 , NGLOBAL , P2PTR|P2STRTY );
238766Speter 			putop( P2ASSIGN , P2PTR|P2STRTY );
239766Speter 			putdot( filename , line );
2407954Speter 			output->nl_flags |= NUSED;
241766Speter 		}
242766Speter 		/*
243766Speter 		 * Loop and process each
244766Speter 		 * of the arguments.
245766Speter 		 */
246766Speter 		for (; argv != NIL; argv = argv[2]) {
247766Speter 			/*
248766Speter 			 * fmtspec indicates the type (CONstant or VARiable)
249766Speter 			 *	and number (none, WIDTH, and/or PRECision)
250766Speter 			 *	of the fields in the printf format for this
251766Speter 			 *	output variable.
252766Speter 			 * stkcnt is the number of longs pushed on the stack
253766Speter 			 * fmt is the format output indicator (D, E, F, O, X, S)
254766Speter 			 * fmtstart = 0 for leading blank; = 1 for no blank
255766Speter 			 */
256766Speter 			fmtspec = NIL;
257766Speter 			stkcnt = 0;
258766Speter 			fmt = 'D';
259766Speter 			fmtstart = 1;
260766Speter 			al = argv[1];
261766Speter 			if (al == NIL)
262766Speter 				continue;
263766Speter 			if (al[0] == T_WEXP)
264766Speter 				alv = al[1];
265766Speter 			else
266766Speter 				alv = al;
267766Speter 			if (alv == NIL)
268766Speter 				continue;
269766Speter 			codeoff();
270766Speter 			ap = stkrval(alv, NIL , RREQ );
271766Speter 			codeon();
272766Speter 			if (ap == NIL)
273766Speter 				continue;
274766Speter 			typ = classify(ap);
275766Speter 			if (al[0] == T_WEXP) {
276766Speter 				/*
277766Speter 				 * Handle width expressions.
278766Speter 				 * The basic game here is that width
279766Speter 				 * expressions get evaluated. If they
280766Speter 				 * are constant, the value is placed
281766Speter 				 * directly in the format string.
282766Speter 				 * Otherwise the value is pushed onto
283766Speter 				 * the stack and an indirection is
284766Speter 				 * put into the format string.
285766Speter 				 */
286766Speter 				if (al[3] == OCT)
287766Speter 					fmt = 'O';
288766Speter 				else if (al[3] == HEX)
289766Speter 					fmt = 'X';
290766Speter 				else if (al[3] != NIL) {
291766Speter 					/*
292766Speter 					 * Evaluate second format spec
293766Speter 					 */
294766Speter 					if ( constval(al[3])
295766Speter 					    && isa( con.ctype , "i" ) ) {
296766Speter 						fmtspec += CONPREC;
297766Speter 						prec = con.crval;
298766Speter 					} else {
299766Speter 						fmtspec += VARPREC;
300766Speter 					}
301766Speter 					fmt = 'f';
302766Speter 					switch ( typ ) {
303766Speter 					case TINT:
304766Speter 						if ( opt( 's' ) ) {
305766Speter 						    standard();
306766Speter 						    error("Writing %ss with two write widths is non-standard", clnames[typ]);
307766Speter 						}
308766Speter 						/* and fall through */
309766Speter 					case TDOUBLE:
310766Speter 						break;
311766Speter 					default:
312766Speter 						error("Cannot write %ss with two write widths", clnames[typ]);
313766Speter 						continue;
314766Speter 					}
315766Speter 				}
316766Speter 				/*
317766Speter 				 * Evaluate first format spec
318766Speter 				 */
319766Speter 				if (al[2] != NIL) {
320766Speter 					if ( constval(al[2])
321766Speter 					    && isa( con.ctype , "i" ) ) {
322766Speter 						fmtspec += CONWIDTH;
323766Speter 						field = con.crval;
324766Speter 					} else {
325766Speter 						fmtspec += VARWIDTH;
326766Speter 					}
327766Speter 				}
328766Speter 				if ((fmtspec & CONPREC) && prec < 0 ||
329766Speter 				    (fmtspec & CONWIDTH) && field < 0) {
330766Speter 					error("Negative widths are not allowed");
331766Speter 					continue;
332766Speter 				}
3333180Smckusic 				if ( opt('s') &&
3343180Smckusic 				    ((fmtspec & CONPREC) && prec == 0 ||
3353180Smckusic 				    (fmtspec & CONWIDTH) && field == 0)) {
3363180Smckusic 					standard();
3373180Smckusic 					error("Zero widths are non-standard");
3383180Smckusic 				}
339766Speter 			}
340766Speter 			if (filetype != nl+T1CHAR) {
341766Speter 				if (fmt == 'O' || fmt == 'X') {
342766Speter 					error("Oct/hex allowed only on text files");
343766Speter 					continue;
344766Speter 				}
345766Speter 				if (fmtspec) {
346766Speter 					error("Write widths allowed only on text files");
347766Speter 					continue;
348766Speter 				}
349766Speter 				/*
350766Speter 				 * Generalized write, i.e.
351766Speter 				 * to a non-textfile.
352766Speter 				 */
353766Speter 				putleaf( P2ICON , 0 , 0
354766Speter 				    , ADDTYPE(
355766Speter 					ADDTYPE(
356766Speter 					    ADDTYPE( p2type( filetype )
357766Speter 						    , P2PTR )
358766Speter 					    , P2FTN )
359766Speter 					, P2PTR )
360766Speter 				    , "_FNIL" );
361766Speter 				stklval(file, NOFLAGS);
362766Speter 				putop( P2CALL
363766Speter 				    , ADDTYPE( p2type( filetype ) , P2PTR ) );
364766Speter 				putop( P2UNARY P2MUL , p2type( filetype ) );
365766Speter 				/*
366766Speter 				 * file^ := ...
367766Speter 				 */
368766Speter 				switch ( classify( filetype ) ) {
369766Speter 				    case TBOOL:
370766Speter 				    case TCHAR:
371766Speter 				    case TINT:
372766Speter 				    case TSCAL:
3734589Speter 					precheck( filetype , "_RANG4"  , "_RSNG4" );
374766Speter 					    /* and fall through */
375766Speter 				    case TDOUBLE:
376766Speter 				    case TPTR:
377766Speter 					ap = rvalue( argv[1] , filetype , RREQ );
378766Speter 					break;
379766Speter 				    default:
380766Speter 					ap = rvalue( argv[1] , filetype , LREQ );
381766Speter 					break;
382766Speter 				}
383766Speter 				if (ap == NIL)
384766Speter 					continue;
385766Speter 				if (incompat(ap, filetype, argv[1])) {
386766Speter 					cerror("Type mismatch in write to non-text file");
387766Speter 					continue;
388766Speter 				}
389766Speter 				switch ( classify( filetype ) ) {
390766Speter 				    case TBOOL:
391766Speter 				    case TCHAR:
392766Speter 				    case TINT:
393766Speter 				    case TSCAL:
39410373Speter 					    postcheck(filetype, ap);
39510373Speter 					    sconv(p2type(ap), p2type(filetype));
396766Speter 						/* and fall through */
397766Speter 				    case TDOUBLE:
398766Speter 				    case TPTR:
399766Speter 					    putop( P2ASSIGN , p2type( filetype ) );
400766Speter 					    putdot( filename , line );
401766Speter 					    break;
402766Speter 				    default:
40311856Speter 					    putstrop(P2STASG,
40411856Speter 						    ADDTYPE(p2type(filetype),
40511856Speter 							    P2PTR),
40611856Speter 						    lwidth(filetype),
40711856Speter 						    align(filetype));
408766Speter 					    putdot( filename , line );
409766Speter 					    break;
410766Speter 				}
411766Speter 				/*
412766Speter 				 * put(file)
413766Speter 				 */
414766Speter 				putleaf( P2ICON , 0 , 0
415766Speter 				    , ADDTYPE( P2FTN | P2INT , P2PTR )
416766Speter 				    , "_PUT" );
4173833Speter 				putRV( 0 , cbn , CURFILEOFFSET , NLOCAL ,
4183833Speter 					P2PTR|P2STRTY );
419766Speter 				putop( P2CALL , P2INT );
420766Speter 				putdot( filename , line );
421766Speter 				continue;
422766Speter 			}
423766Speter 			/*
424766Speter 			 * Write to a textfile
425766Speter 			 *
426766Speter 			 * Evaluate the expression
427766Speter 			 * to be written.
428766Speter 			 */
429766Speter 			if (fmt == 'O' || fmt == 'X') {
430766Speter 				if (opt('s')) {
431766Speter 					standard();
432766Speter 					error("Oct and hex are non-standard");
433766Speter 				}
434766Speter 				if (typ == TSTR || typ == TDOUBLE) {
435766Speter 					error("Can't write %ss with oct/hex", clnames[typ]);
436766Speter 					continue;
437766Speter 				}
438766Speter 				if (typ == TCHAR || typ == TBOOL)
439766Speter 					typ = TINT;
440766Speter 			}
441766Speter 			/*
442766Speter 			 * If there is no format specified by the programmer,
443766Speter 			 * implement the default.
444766Speter 			 */
445766Speter 			switch (typ) {
4466540Smckusick 			case TPTR:
4476540Smckusick 				warning();
4486540Smckusick 				if (opt('s')) {
4496540Smckusick 					standard();
4506540Smckusick 				}
4516540Smckusick 				error("Writing %ss to text files is non-standard",
4526540Smckusick 				    clnames[typ]);
4536540Smckusick 				/* and fall through */
454766Speter 			case TINT:
455766Speter 				if (fmt == 'f') {
456766Speter 					typ = TDOUBLE;
457766Speter 					goto tdouble;
458766Speter 				}
459766Speter 				if (fmtspec == NIL) {
460766Speter 					if (fmt == 'D')
461766Speter 						field = 10;
462766Speter 					else if (fmt == 'X')
463766Speter 						field = 8;
464766Speter 					else if (fmt == 'O')
465766Speter 						field = 11;
466766Speter 					else
467766Speter 						panic("fmt1");
468766Speter 					fmtspec = CONWIDTH;
469766Speter 				}
470766Speter 				break;
471766Speter 			case TCHAR:
472766Speter 			     tchar:
473766Speter 				fmt = 'c';
474766Speter 				break;
475766Speter 			case TSCAL:
4761629Speter 				warning();
477766Speter 				if (opt('s')) {
478766Speter 					standard();
479766Speter 				}
4806540Smckusick 				error("Writing %ss to text files is non-standard",
4816540Smckusick 				    clnames[typ]);
482766Speter 			case TBOOL:
483766Speter 				fmt = 's';
484766Speter 				break;
485766Speter 			case TDOUBLE:
486766Speter 			     tdouble:
487766Speter 				switch (fmtspec) {
488766Speter 				case NIL:
489*11883Smckusick 					field = 14 + (5 + EXPOSIZE);
490*11883Smckusick 				        prec = field - (5 + EXPOSIZE);
4913225Smckusic 					fmt = 'e';
492766Speter 					fmtspec = CONWIDTH + CONPREC;
493766Speter 					break;
494766Speter 				case CONWIDTH:
4959229Smckusick 					field -= REALSPC;
4969229Smckusick 					if (field < 1)
497766Speter 						field = 1;
498*11883Smckusick 				        prec = field - (5 + EXPOSIZE);
499766Speter 					if (prec < 1)
500766Speter 						prec = 1;
501766Speter 					fmtspec += CONPREC;
5023225Smckusic 					fmt = 'e';
503766Speter 					break;
504766Speter 				case VARWIDTH:
505766Speter 					fmtspec += VARPREC;
5063225Smckusic 					fmt = 'e';
507766Speter 					break;
508766Speter 				case CONWIDTH + CONPREC:
509766Speter 				case CONWIDTH + VARPREC:
5109229Smckusick 					field -= REALSPC;
5119229Smckusick 					if (field < 1)
512766Speter 						field = 1;
513766Speter 				}
514766Speter 				format[0] = ' ';
5159229Smckusick 				fmtstart = 1 - REALSPC;
516766Speter 				break;
517766Speter 			case TSTR:
518766Speter 				constval( alv );
519766Speter 				switch ( classify( con.ctype ) ) {
520766Speter 				    case TCHAR:
521766Speter 					typ = TCHAR;
522766Speter 					goto tchar;
523766Speter 				    case TSTR:
524766Speter 					strptr = con.cpval;
525766Speter 					for (strnglen = 0;  *strptr++;  strnglen++) /* void */;
526766Speter 					strptr = con.cpval;
527766Speter 					break;
528766Speter 				    default:
529766Speter 					strnglen = width(ap);
530766Speter 					break;
531766Speter 				}
532766Speter 				fmt = 's';
533766Speter 				strfmt = fmtspec;
534766Speter 				if (fmtspec == NIL) {
535766Speter 					fmtspec = SKIP;
536766Speter 					break;
537766Speter 				}
538766Speter 				if (fmtspec & CONWIDTH) {
539766Speter 					if (field <= strnglen)
540766Speter 						fmtspec = SKIP;
541766Speter 					else
542766Speter 						field -= strnglen;
543766Speter 				}
544766Speter 				break;
545766Speter 			default:
546766Speter 				error("Can't write %ss to a text file", clnames[typ]);
547766Speter 				continue;
548766Speter 			}
549766Speter 			/*
550766Speter 			 * Generate the format string
551766Speter 			 */
552766Speter 			switch (fmtspec) {
553766Speter 			default:
554766Speter 				panic("fmt2");
555766Speter 			case NIL:
556766Speter 				if (fmt == 'c') {
557766Speter 					if ( opt( 't' ) ) {
558766Speter 					    putleaf( P2ICON , 0 , 0
559766Speter 						, ADDTYPE( P2FTN|P2INT , P2PTR )
560766Speter 						, "_WRITEC" );
5613833Speter 					    putRV( 0 , cbn , CURFILEOFFSET ,
5623833Speter 						    NLOCAL , P2PTR|P2STRTY );
563766Speter 					    stkrval( alv , NIL , RREQ );
564766Speter 					    putop( P2LISTOP , P2INT );
565766Speter 					} else {
566766Speter 					    putleaf( P2ICON , 0 , 0
567766Speter 						, ADDTYPE( P2FTN|P2INT , P2PTR )
568766Speter 						, "_fputc" );
569766Speter 					    stkrval( alv , NIL , RREQ );
570766Speter 					}
571766Speter 					putleaf( P2ICON , 0 , 0
572766Speter 					    , ADDTYPE( P2FTN | P2INT , P2PTR )
573766Speter 					    , "_ACTFILE" );
5743833Speter 					putRV( 0, cbn , CURFILEOFFSET ,
5753833Speter 						NLOCAL , P2PTR|P2STRTY );
576766Speter 					putop( P2CALL , P2INT );
577766Speter 					putop( P2LISTOP , P2INT );
578766Speter 					putop( P2CALL , P2INT );
579766Speter 					putdot( filename , line );
580766Speter 				} else  {
581766Speter 					sprintf(&format[1], "%%%c", fmt);
582766Speter 					goto fmtgen;
583766Speter 				}
584766Speter 			case SKIP:
585766Speter 				break;
586766Speter 			case CONWIDTH:
587766Speter 				sprintf(&format[1], "%%%1D%c", field, fmt);
588766Speter 				goto fmtgen;
589766Speter 			case VARWIDTH:
590766Speter 				sprintf(&format[1], "%%*%c", fmt);
591766Speter 				goto fmtgen;
592766Speter 			case CONWIDTH + CONPREC:
593766Speter 				sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt);
594766Speter 				goto fmtgen;
595766Speter 			case CONWIDTH + VARPREC:
596766Speter 				sprintf(&format[1], "%%%1D.*%c", field, fmt);
597766Speter 				goto fmtgen;
598766Speter 			case VARWIDTH + CONPREC:
599766Speter 				sprintf(&format[1], "%%*.%1D%c", prec, fmt);
600766Speter 				goto fmtgen;
601766Speter 			case VARWIDTH + VARPREC:
602766Speter 				sprintf(&format[1], "%%*.*%c", fmt);
603766Speter 			fmtgen:
604766Speter 				if ( opt( 't' ) ) {
605766Speter 				    putleaf( P2ICON , 0 , 0
606766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
607766Speter 					, "_WRITEF" );
6083833Speter 				    putRV( 0 , cbn , CURFILEOFFSET ,
6093833Speter 					    NLOCAL , P2PTR|P2STRTY );
610766Speter 				    putleaf( P2ICON , 0 , 0
611766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
612766Speter 					, "_ACTFILE" );
6133833Speter 				    putRV( 0 , cbn , CURFILEOFFSET ,
6143833Speter 					    NLOCAL , P2PTR|P2STRTY );
615766Speter 				    putop( P2CALL , P2INT );
616766Speter 				    putop( P2LISTOP , P2INT );
617766Speter 				} else {
618766Speter 				    putleaf( P2ICON , 0 , 0
619766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
620766Speter 					, "_fprintf" );
621766Speter 				    putleaf( P2ICON , 0 , 0
622766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
623766Speter 					, "_ACTFILE" );
6243833Speter 				    putRV( 0 , cbn , CURFILEOFFSET ,
6253833Speter 					    NLOCAL , P2PTR|P2STRTY );
626766Speter 				    putop( P2CALL , P2INT );
627766Speter 				}
628766Speter 				putCONG( &format[ fmtstart ]
629766Speter 					, strlen( &format[ fmtstart ] )
630766Speter 					, LREQ );
631766Speter 				putop( P2LISTOP , P2INT );
632766Speter 				if ( fmtspec & VARWIDTH ) {
633766Speter 					/*
634766Speter 					 * either
635766Speter 					 *	,(temp=width,MAX(temp,...)),
636766Speter 					 * or
637766Speter 					 *	, MAX( width , ... ) ,
638766Speter 					 */
639766Speter 				    if ( ( typ == TDOUBLE && al[3] == NIL )
640766Speter 					|| typ == TSTR ) {
6413225Smckusic 					soffset = sizes[cbn].curtmps;
6423833Speter 					tempnlp = tmpalloc(sizeof(long),
6433225Smckusic 						nl+T4INT, REGOK);
6443833Speter 					putRV( 0 , cbn ,
6453833Speter 					    tempnlp -> value[ NL_OFFS ] ,
6463833Speter 					    tempnlp -> extra_flags , P2INT );
647766Speter 					ap = stkrval( al[2] , NIL , RREQ );
648766Speter 					putop( P2ASSIGN , P2INT );
649766Speter 					putleaf( P2ICON , 0 , 0
650766Speter 					    , ADDTYPE( P2FTN | P2INT , P2PTR )
651766Speter 					    , "_MAX" );
6523833Speter 					putRV( 0 , cbn ,
6533833Speter 					    tempnlp -> value[ NL_OFFS ] ,
6543833Speter 					    tempnlp -> extra_flags , P2INT );
655766Speter 				    } else {
656766Speter 					if (opt('t')
657766Speter 					    || typ == TSTR || typ == TDOUBLE) {
658766Speter 					    putleaf( P2ICON , 0 , 0
659766Speter 						,ADDTYPE( P2FTN | P2INT, P2PTR )
660766Speter 						,"_MAX" );
661766Speter 					}
662766Speter 					ap = stkrval( al[2] , NIL , RREQ );
663766Speter 				    }
664766Speter 				    if (ap == NIL)
665766Speter 					    continue;
666766Speter 				    if (isnta(ap,"i")) {
667766Speter 					    error("First write width must be integer, not %s", nameof(ap));
668766Speter 					    continue;
669766Speter 				    }
670766Speter 				    switch ( typ ) {
671766Speter 				    case TDOUBLE:
6729229Smckusick 					putleaf( P2ICON , REALSPC , 0 , P2INT , 0 );
673766Speter 					putop( P2LISTOP , P2INT );
674766Speter 					putleaf( P2ICON , 1 , 0 , P2INT , 0 );
675766Speter 					putop( P2LISTOP , P2INT );
676766Speter 					putop( P2CALL , P2INT );
677766Speter 					if ( al[3] == NIL ) {
678766Speter 						/*
679766Speter 						 * finish up the comma op
680766Speter 						 */
681766Speter 					    putop( P2COMOP , P2INT );
682766Speter 					    fmtspec &= ~VARPREC;
683766Speter 					    putop( P2LISTOP , P2INT );
684766Speter 					    putleaf( P2ICON , 0 , 0
685766Speter 						, ADDTYPE( P2FTN | P2INT , P2PTR )
686766Speter 						, "_MAX" );
6873833Speter 					    putRV( 0 , cbn ,
6883833Speter 						tempnlp -> value[ NL_OFFS ] ,
6893833Speter 						tempnlp -> extra_flags ,
6903833Speter 						P2INT );
6913225Smckusic 					    tmpfree(&soffset);
692*11883Smckusick 					    putleaf( P2ICON ,
693*11883Smckusick 						5 + EXPOSIZE + REALSPC ,
694*11883Smckusick 						0 , P2INT , 0 );
695766Speter 					    putop( P2LISTOP , P2INT );
696766Speter 					    putleaf( P2ICON , 1 , 0 , P2INT , 0 );
697766Speter 					    putop( P2LISTOP , P2INT );
698766Speter 					    putop( P2CALL , P2INT );
699766Speter 					}
700766Speter 					putop( P2LISTOP , P2INT );
701766Speter 					break;
702766Speter 				    case TSTR:
703766Speter 					putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
704766Speter 					putop( P2LISTOP , P2INT );
705766Speter 					putleaf( P2ICON , 0 , 0 , P2INT , 0 );
706766Speter 					putop( P2LISTOP , P2INT );
707766Speter 					putop( P2CALL , P2INT );
708766Speter 					putop( P2COMOP , P2INT );
709766Speter 					putop( P2LISTOP , P2INT );
710766Speter 					break;
711766Speter 				    default:
712766Speter 					if (opt('t')) {
713766Speter 					    putleaf( P2ICON , 0 , 0 , P2INT , 0 );
714766Speter 					    putop( P2LISTOP , P2INT );
715766Speter 					    putleaf( P2ICON , 0 , 0 , P2INT , 0 );
716766Speter 					    putop( P2LISTOP , P2INT );
717766Speter 					    putop( P2CALL , P2INT );
718766Speter 					}
719766Speter 					putop( P2LISTOP , P2INT );
720766Speter 					break;
721766Speter 				    }
722766Speter 				}
723766Speter 				/*
724766Speter 				 * If there is a variable precision,
725766Speter 				 * evaluate it
726766Speter 				 */
727766Speter 				if (fmtspec & VARPREC) {
728766Speter 					if (opt('t')) {
729766Speter 					putleaf( P2ICON , 0 , 0
730766Speter 					    , ADDTYPE( P2FTN | P2INT , P2PTR )
731766Speter 					    , "_MAX" );
732766Speter 					}
733766Speter 					ap = stkrval( al[3] , NIL , RREQ );
734766Speter 					if (ap == NIL)
735766Speter 						continue;
736766Speter 					if (isnta(ap,"i")) {
737766Speter 						error("Second write width must be integer, not %s", nameof(ap));
738766Speter 						continue;
739766Speter 					}
740766Speter 					if (opt('t')) {
741766Speter 					    putleaf( P2ICON , 0 , 0 , P2INT , 0 );
742766Speter 					    putop( P2LISTOP , P2INT );
743766Speter 					    putleaf( P2ICON , 0 , 0 , P2INT , 0 );
744766Speter 					    putop( P2LISTOP , P2INT );
745766Speter 					    putop( P2CALL , P2INT );
746766Speter 					}
747766Speter 				 	putop( P2LISTOP , P2INT );
748766Speter 				}
749766Speter 				/*
750766Speter 				 * evaluate the thing we want printed.
751766Speter 				 */
752766Speter 				switch ( typ ) {
7536540Smckusick 				case TPTR:
754766Speter 				case TCHAR:
755766Speter 				case TINT:
756766Speter 				    stkrval( alv , NIL , RREQ );
757766Speter 				    putop( P2LISTOP , P2INT );
758766Speter 				    break;
759766Speter 				case TDOUBLE:
760766Speter 				    ap = stkrval( alv , NIL , RREQ );
76110373Speter 				    if (isnta(ap, "d")) {
76210373Speter 					sconv(p2type(ap), P2DOUBLE);
763766Speter 				    }
764766Speter 				    putop( P2LISTOP , P2INT );
765766Speter 				    break;
766766Speter 				case TSCAL:
767766Speter 				case TBOOL:
768766Speter 				    putleaf( P2ICON , 0 , 0
769766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
770766Speter 					, "_NAM" );
771766Speter 				    ap = stkrval( alv , NIL , RREQ );
772766Speter 				    sprintf( format , PREFIXFORMAT , LABELPREFIX
773766Speter 					    , listnames( ap ) );
774766Speter 				    putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR
775766Speter 					    , format );
776766Speter 				    putop( P2LISTOP , P2INT );
777766Speter 				    putop( P2CALL , P2INT );
778766Speter 				    putop( P2LISTOP , P2INT );
779766Speter 				    break;
780766Speter 				case TSTR:
781766Speter 				    putCONG( "" , 0 , LREQ );
782766Speter 				    putop( P2LISTOP , P2INT );
783766Speter 				    break;
7846540Smckusick 				default:
7856540Smckusick 				    panic("fmt3");
7866540Smckusick 				    break;
787766Speter 				}
788766Speter 				putop( P2CALL , P2INT );
789766Speter 				putdot( filename , line );
790766Speter 			}
791766Speter 			/*
792766Speter 			 * Write the string after its blank padding
793766Speter 			 */
794766Speter 			if (typ == TSTR ) {
795766Speter 				if ( opt( 't' ) ) {
796766Speter 				    putleaf( P2ICON , 0 , 0
797766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
798766Speter 					, "_WRITES" );
7993833Speter 				    putRV( 0 , cbn , CURFILEOFFSET ,
8003833Speter 					    NLOCAL , P2PTR|P2STRTY );
801766Speter 				    ap = stkrval(alv, NIL , RREQ );
802766Speter 				    putop( P2LISTOP , P2INT );
803766Speter 				} else {
804766Speter 				    putleaf( P2ICON , 0 , 0
805766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
806766Speter 					, "_fwrite" );
807766Speter 				    ap = stkrval(alv, NIL , RREQ );
808766Speter 				}
809766Speter 				if (strfmt & VARWIDTH) {
810766Speter 					    /*
811766Speter 					     *	min, inline expanded as
812766Speter 					     *	temp < len ? temp : len
813766Speter 					     */
8143833Speter 					putRV( 0 , cbn ,
8153833Speter 					    tempnlp -> value[ NL_OFFS ] ,
8163833Speter 					    tempnlp -> extra_flags , P2INT );
817766Speter 					putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
818766Speter 					putop( P2LT , P2INT );
8193833Speter 					putRV( 0 , cbn ,
8203833Speter 					    tempnlp -> value[ NL_OFFS ] ,
8213833Speter 					    tempnlp -> extra_flags , P2INT );
822766Speter 					putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
823766Speter 					putop( P2COLON , P2INT );
824766Speter 					putop( P2QUEST , P2INT );
8253225Smckusic 					tmpfree(&soffset);
826766Speter 				} else {
827766Speter 					if (   ( fmtspec & SKIP )
828766Speter 					    && ( strfmt & CONWIDTH ) ) {
829766Speter 						strnglen = field;
830766Speter 					}
831766Speter 					putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
832766Speter 				}
833766Speter 				putop( P2LISTOP , P2INT );
834766Speter 				putleaf( P2ICON , 1 , 0 , P2INT , 0 );
835766Speter 				putop( P2LISTOP , P2INT );
836766Speter 				putleaf( P2ICON , 0 , 0
837766Speter 				    , ADDTYPE( P2FTN | P2INT , P2PTR )
838766Speter 				    , "_ACTFILE" );
8393833Speter 				putRV( 0, cbn , CURFILEOFFSET , NLOCAL ,
8403833Speter 					P2PTR|P2STRTY );
841766Speter 				putop( P2CALL , P2INT );
842766Speter 				putop( P2LISTOP , P2INT );
843766Speter 				putop( P2CALL , P2INT );
844766Speter 				putdot( filename , line );
845766Speter 			}
846766Speter 		}
847766Speter 		/*
848766Speter 		 * Done with arguments.
849766Speter 		 * Handle writeln and
850766Speter 		 * insufficent number of args.
851766Speter 		 */
852766Speter 		switch (p->value[0] &~ NSTAND) {
853766Speter 			case O_WRITEF:
854766Speter 				if (argc == 0)
855766Speter 					error("Write requires an argument");
856766Speter 				break;
857766Speter 			case O_MESSAGE:
858766Speter 				if (argc == 0)
859766Speter 					error("Message requires an argument");
860766Speter 			case O_WRITLN:
861766Speter 				if (filetype != nl+T1CHAR)
862766Speter 					error("Can't 'writeln' a non text file");
863766Speter 				if ( opt( 't' ) ) {
864766Speter 				    putleaf( P2ICON , 0 , 0
865766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
866766Speter 					, "_WRITLN" );
8673833Speter 				    putRV( 0 , cbn , CURFILEOFFSET ,
8683833Speter 					    NLOCAL , P2PTR|P2STRTY );
869766Speter 				} else {
870766Speter 				    putleaf( P2ICON , 0 , 0
871766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
872766Speter 					, "_fputc" );
873766Speter 				    putleaf( P2ICON , '\n' , 0 , P2CHAR , 0 );
874766Speter 				    putleaf( P2ICON , 0 , 0
875766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
876766Speter 					, "_ACTFILE" );
8773833Speter 				    putRV( 0 , cbn , CURFILEOFFSET ,
8783833Speter 					    NLOCAL , P2PTR|P2STRTY );
879766Speter 				    putop( P2CALL , P2INT );
880766Speter 				    putop( P2LISTOP , P2INT );
881766Speter 				}
882766Speter 				putop( P2CALL , P2INT );
883766Speter 				putdot( filename , line );
884766Speter 				break;
885766Speter 		}
886766Speter 		return;
887766Speter 
888766Speter 	case O_READ4:
889766Speter 	case O_READLN:
890766Speter 		/*
891766Speter 		 * Set up default
892766Speter 		 * file "input".
893766Speter 		 */
894766Speter 		file = NIL;
895766Speter 		filetype = nl+T1CHAR;
896766Speter 		/*
897766Speter 		 * Determine the file implied
898766Speter 		 * for the read and generate
899766Speter 		 * code to make it the active file.
900766Speter 		 */
901766Speter 		if (argv != NIL) {
902766Speter 			codeoff();
903766Speter 			ap = stkrval(argv[1], NIL , RREQ );
904766Speter 			codeon();
905766Speter 			if (ap == NIL)
906766Speter 				argv = argv[2];
907766Speter 			if (ap != NIL && ap->class == FILET) {
908766Speter 				/*
909766Speter 				 * Got "read(f, ...", make
910766Speter 				 * f the active file, and save
911766Speter 				 * it and its type for use in
912766Speter 				 * processing the rest of the
913766Speter 				 * arguments to read.
914766Speter 				 */
915766Speter 				file = argv[1];
916766Speter 				filetype = ap->type;
9173833Speter 				putRV( 0, cbn , CURFILEOFFSET , NLOCAL ,
9183833Speter 					P2PTR|P2STRTY );
919766Speter 				putleaf( P2ICON , 0 , 0
920766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
921766Speter 					, "_UNIT" );
922766Speter 				stklval(argv[1], NOFLAGS);
923766Speter 				putop( P2CALL , P2INT );
924766Speter 				putop( P2ASSIGN , P2PTR|P2STRTY );
925766Speter 				putdot( filename , line );
926766Speter 				argv = argv[2];
927766Speter 				argc--;
928766Speter 			} else {
929766Speter 				/*
930766Speter 				 * Default is read from
931766Speter 				 * standard input.
932766Speter 				 */
9333833Speter 				putRV( 0, cbn , CURFILEOFFSET , NLOCAL ,
9343833Speter 					P2PTR|P2STRTY );
9353833Speter 				putLV( "_input" , 0 , 0 , NGLOBAL ,
9363833Speter 					P2PTR|P2STRTY );
937766Speter 				putop( P2ASSIGN , P2PTR|P2STRTY );
938766Speter 				putdot( filename , line );
939766Speter 				input->nl_flags |= NUSED;
940766Speter 			}
941766Speter 		} else {
9423833Speter 			putRV( 0, cbn , CURFILEOFFSET , NLOCAL ,
9433833Speter 				P2PTR|P2STRTY );
9443833Speter 			putLV( "_input" , 0 , 0 , NGLOBAL , P2PTR|P2STRTY );
945766Speter 			putop( P2ASSIGN , P2PTR|P2STRTY );
946766Speter 			putdot( filename , line );
947766Speter 			input->nl_flags |= NUSED;
948766Speter 		}
949766Speter 		/*
950766Speter 		 * Loop and process each
951766Speter 		 * of the arguments.
952766Speter 		 */
953766Speter 		for (; argv != NIL; argv = argv[2]) {
954766Speter 			/*
955766Speter 			 * Get the address of the target
956766Speter 			 * on the stack.
957766Speter 			 */
958766Speter 			al = argv[1];
959766Speter 			if (al == NIL)
960766Speter 				continue;
961766Speter 			if (al[0] != T_VAR) {
962766Speter 				error("Arguments to %s must be variables, not expressions", p->symbol);
963766Speter 				continue;
964766Speter 			}
965766Speter 			codeoff();
966766Speter 			ap = stklval(al, MOD|ASGN|NOUSE);
967766Speter 			codeon();
968766Speter 			if (ap == NIL)
969766Speter 				continue;
970766Speter 			if (filetype != nl+T1CHAR) {
971766Speter 				/*
972766Speter 				 * Generalized read, i.e.
973766Speter 				 * from a non-textfile.
974766Speter 				 */
975766Speter 				if (incompat(filetype, ap, argv[1] )) {
976766Speter 					error("Type mismatch in read from non-text file");
977766Speter 					continue;
978766Speter 				}
979766Speter 				/*
980766Speter 				 * var := file ^;
981766Speter 				 */
982766Speter 				ap = lvalue( al , MOD | ASGN | NOUSE , RREQ );
983766Speter 				if ( isa( ap , "bsci" ) ) {
984766Speter 					precheck( ap , "_RANG4" , "_RSNG4" );
985766Speter 				}
986766Speter 				putleaf( P2ICON , 0 , 0
987766Speter 				    , ADDTYPE(
988766Speter 					ADDTYPE(
989766Speter 					    ADDTYPE(
990766Speter 						p2type( filetype ) , P2PTR )
991766Speter 					    , P2FTN )
992766Speter 					, P2PTR )
993766Speter 				    , "_FNIL" );
994766Speter 				if (file != NIL)
995766Speter 					stklval(file, NOFLAGS);
996766Speter 				else /* Magic */
9973833Speter 					putRV( "_input" , 0 , 0 , NGLOBAL ,
9983833Speter 						P2PTR | P2STRTY );
99910668Speter 				putop(P2CALL, ADDTYPE(p2type(filetype), P2PTR));
1000766Speter 				switch ( classify( filetype ) ) {
1001766Speter 				    case TBOOL:
1002766Speter 				    case TCHAR:
1003766Speter 				    case TINT:
1004766Speter 				    case TSCAL:
1005766Speter 				    case TDOUBLE:
1006766Speter 				    case TPTR:
1007766Speter 					putop( P2UNARY P2MUL
1008766Speter 						, p2type( filetype ) );
1009766Speter 				}
1010766Speter 				switch ( classify( filetype ) ) {
1011766Speter 				    case TBOOL:
1012766Speter 				    case TCHAR:
1013766Speter 				    case TINT:
1014766Speter 				    case TSCAL:
101510373Speter 					    postcheck(ap, filetype);
101610373Speter 					    sconv(p2type(filetype), p2type(ap));
1017766Speter 						/* and fall through */
1018766Speter 				    case TDOUBLE:
1019766Speter 				    case TPTR:
1020766Speter 					    putop( P2ASSIGN , p2type( ap ) );
1021766Speter 					    putdot( filename , line );
1022766Speter 					    break;
1023766Speter 				    default:
102411856Speter 					    putstrop(P2STASG,
102511856Speter 						    ADDTYPE(p2type(ap), P2PTR),
102611856Speter 						    lwidth(ap),
102711856Speter 						    align(ap));
1028766Speter 					    putdot( filename , line );
1029766Speter 					    break;
1030766Speter 				}
1031766Speter 				/*
1032766Speter 				 * get(file);
1033766Speter 				 */
1034766Speter 				putleaf( P2ICON , 0 , 0
1035766Speter 					, ADDTYPE( P2FTN | P2INT , P2PTR )
1036766Speter 					, "_GET" );
10373833Speter 				putRV( 0 , cbn , CURFILEOFFSET , NLOCAL ,
10383833Speter 					P2PTR|P2STRTY );
1039766Speter 				putop( P2CALL , P2INT );
1040766Speter 				putdot( filename , line );
1041766Speter 				continue;
1042766Speter 			}
1043766Speter 			    /*
1044766Speter 			     *	if you get to here, you are reading from
1045766Speter 			     *	a text file.  only possiblities are:
1046766Speter 			     *	character, integer, real, or scalar.
1047766Speter 			     *	read( f , foo , ... ) is done as
1048766Speter 			     *	foo := read( f ) with rangechecking
1049766Speter 			     *	if appropriate.
1050766Speter 			     */
1051766Speter 			typ = classify(ap);
1052766Speter 			op = rdops(typ);
1053766Speter 			if (op == NIL) {
1054766Speter 				error("Can't read %ss from a text file", clnames[typ]);
1055766Speter 				continue;
1056766Speter 			}
1057766Speter 			    /*
1058766Speter 			     *	left hand side of foo := read( f )
1059766Speter 			     */
1060766Speter 			ap = lvalue( al , MOD|ASGN|NOUSE , RREQ );
1061766Speter 			if ( isa( ap , "bsci" ) ) {
1062766Speter 			    precheck( ap , "_RANG4" , "_RSNG4" );
1063766Speter 			}
1064766Speter 			switch ( op ) {
1065766Speter 			    case O_READC:
1066766Speter 				readname = "_READC";
1067766Speter 				readtype = P2INT;
1068766Speter 				break;
1069766Speter 			    case O_READ4:
1070766Speter 				readname = "_READ4";
1071766Speter 				readtype = P2INT;
1072766Speter 				break;
1073766Speter 			    case O_READ8:
1074766Speter 				readname = "_READ8";
1075766Speter 				readtype = P2DOUBLE;
1076766Speter 				break;
1077766Speter 			    case O_READE:
1078766Speter 				readname = "_READE";
1079766Speter 				readtype = P2INT;
1080766Speter 				break;
1081766Speter 			}
1082766Speter 			putleaf( P2ICON , 0 , 0
1083766Speter 				, ADDTYPE( P2FTN | readtype , P2PTR )
1084766Speter 				, readname );
10853833Speter 			putRV( 0 , cbn , CURFILEOFFSET , NLOCAL ,
10863833Speter 				P2PTR|P2STRTY );
1087766Speter 			if ( op == O_READE ) {
1088766Speter 				sprintf( format , PREFIXFORMAT , LABELPREFIX
1089766Speter 					, listnames( ap ) );
1090766Speter 				putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR
1091766Speter 					, format );
1092766Speter 				putop( P2LISTOP , P2INT );
10931629Speter 				warning();
1094766Speter 				if (opt('s')) {
1095766Speter 					standard();
1096766Speter 				}
10971629Speter 				error("Reading scalars from text files is non-standard");
1098766Speter 			}
1099766Speter 			putop( P2CALL , readtype );
1100766Speter 			if ( isa( ap , "bcsi" ) ) {
110110373Speter 			    postcheck(ap, readtype==P2INT?nl+T4INT:nl+TDOUBLE);
1102766Speter 			}
110310373Speter 			sconv(readtype, p2type(ap));
1104766Speter 			putop( P2ASSIGN , p2type( ap ) );
1105766Speter 			putdot( filename , line );
1106766Speter 		}
1107766Speter 		/*
1108766Speter 		 * Done with arguments.
1109766Speter 		 * Handle readln and
1110766Speter 		 * insufficient number of args.
1111766Speter 		 */
1112766Speter 		if (p->value[0] == O_READLN) {
1113766Speter 			if (filetype != nl+T1CHAR)
1114766Speter 				error("Can't 'readln' a non text file");
1115766Speter 			putleaf( P2ICON , 0 , 0
1116766Speter 				, ADDTYPE( P2FTN | P2INT , P2PTR )
1117766Speter 				, "_READLN" );
11183833Speter 			putRV( 0 , cbn , CURFILEOFFSET , NLOCAL ,
11193833Speter 				P2PTR|P2STRTY );
1120766Speter 			putop( P2CALL , P2INT );
1121766Speter 			putdot( filename , line );
1122766Speter 		} else if (argc == 0)
1123766Speter 			error("read requires an argument");
1124766Speter 		return;
1125766Speter 
1126766Speter 	case O_GET:
1127766Speter 	case O_PUT:
1128766Speter 		if (argc != 1) {
1129766Speter 			error("%s expects one argument", p->symbol);
1130766Speter 			return;
1131766Speter 		}
11323833Speter 		putRV( 0 , cbn , CURFILEOFFSET , NLOCAL , P2PTR|P2STRTY );
1133766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1134766Speter 			, "_UNIT" );
1135766Speter 		ap = stklval(argv[1], NOFLAGS);
1136766Speter 		if (ap == NIL)
1137766Speter 			return;
1138766Speter 		if (ap->class != FILET) {
1139766Speter 			error("Argument to %s must be a file, not %s", p->symbol, nameof(ap));
1140766Speter 			return;
1141766Speter 		}
1142766Speter 		putop( P2CALL , P2INT );
1143766Speter 		putop( P2ASSIGN , P2PTR|P2STRTY );
1144766Speter 		putdot( filename , line );
1145766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1146766Speter 			, op == O_GET ? "_GET" : "_PUT" );
11473833Speter 		putRV( 0 , cbn , CURFILEOFFSET , NLOCAL , P2PTR|P2STRTY );
1148766Speter 		putop( P2CALL , P2INT );
1149766Speter 		putdot( filename , line );
1150766Speter 		return;
1151766Speter 
1152766Speter 	case O_RESET:
1153766Speter 	case O_REWRITE:
1154766Speter 		if (argc == 0 || argc > 2) {
1155766Speter 			error("%s expects one or two arguments", p->symbol);
1156766Speter 			return;
1157766Speter 		}
1158766Speter 		if (opt('s') && argc == 2) {
1159766Speter 			standard();
1160766Speter 			error("Two argument forms of reset and rewrite are non-standard");
1161766Speter 		}
1162766Speter 		putleaf( P2ICON , 0 , 0 , P2INT
1163766Speter 			, op == O_RESET ? "_RESET" : "_REWRITE" );
1164766Speter 		ap = stklval(argv[1], MOD|NOUSE);
1165766Speter 		if (ap == NIL)
1166766Speter 			return;
1167766Speter 		if (ap->class != FILET) {
1168766Speter 			error("First argument to %s must be a file, not %s", p->symbol, nameof(ap));
1169766Speter 			return;
1170766Speter 		}
1171766Speter 		if (argc == 2) {
1172766Speter 			/*
1173766Speter 			 * Optional second argument
1174766Speter 			 * is a string name of a
1175766Speter 			 * UNIX (R) file to be associated.
1176766Speter 			 */
1177766Speter 			al = argv[2];
1178766Speter 			al = stkrval(al[1], NOFLAGS , RREQ );
1179766Speter 			if (al == NIL)
1180766Speter 				return;
1181766Speter 			if (classify(al) != TSTR) {
1182766Speter 				error("Second argument to %s must be a string, not %s", p->symbol, nameof(al));
1183766Speter 				return;
1184766Speter 			}
1185766Speter 			strnglen = width(al);
1186766Speter 		} else {
1187766Speter 			putleaf( P2ICON , 0 , 0 , P2INT , 0 );
1188766Speter 			strnglen = 0;
1189766Speter 		}
1190766Speter 		putop( P2LISTOP , P2INT );
1191766Speter 		putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
1192766Speter 		putop( P2LISTOP , P2INT );
1193766Speter 		putleaf( P2ICON , text(ap) ? 0: width(ap->type) , 0 , P2INT , 0 );
1194766Speter 		putop( P2LISTOP , P2INT );
1195766Speter 		putop( P2CALL , P2INT );
1196766Speter 		putdot( filename , line );
1197766Speter 		return;
1198766Speter 
1199766Speter 	case O_NEW:
1200766Speter 	case O_DISPOSE:
1201766Speter 		if (argc == 0) {
1202766Speter 			error("%s expects at least one argument", p->symbol);
1203766Speter 			return;
1204766Speter 		}
12059139Smckusick 		alv = argv[1];
12067967Smckusick 		codeoff();
12079139Smckusick 		ap = stklval(alv, op == O_NEW ? ( MOD | NOUSE ) : MOD );
12087967Smckusick 		codeon();
1209766Speter 		if (ap == NIL)
1210766Speter 			return;
1211766Speter 		if (ap->class != PTR) {
1212766Speter 			error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap));
1213766Speter 			return;
1214766Speter 		}
1215766Speter 		ap = ap->type;
1216766Speter 		if (ap == NIL)
1217766Speter 			return;
12189139Smckusick 		if (op == O_NEW)
12199139Smckusick 			cmd = "_NEW";
12209139Smckusick 		else /* op == O_DISPOSE */
12217967Smckusick 			if ((ap->nl_flags & NFILES) != 0)
12227967Smckusick 				cmd = "_DFDISPOSE";
12237967Smckusick 			else
12247967Smckusick 				cmd = "_DISPOSE";
12257967Smckusick 		putleaf( P2ICON, 0, 0, ADDTYPE( P2FTN | P2INT , P2PTR ), cmd);
12269139Smckusick 		stklval(alv, op == O_NEW ? ( MOD | NOUSE ) : MOD );
1227766Speter 		argv = argv[2];
1228766Speter 		if (argv != NIL) {
1229766Speter 			if (ap->class != RECORD) {
1230766Speter 				error("Record required when specifying variant tags");
1231766Speter 				return;
1232766Speter 			}
1233766Speter 			for (; argv != NIL; argv = argv[2]) {
1234766Speter 				if (ap->ptr[NL_VARNT] == NIL) {
1235766Speter 					error("Too many tag fields");
1236766Speter 					return;
1237766Speter 				}
1238766Speter 				if (!isconst(argv[1])) {
1239766Speter 					error("Second and successive arguments to %s must be constants", p->symbol);
1240766Speter 					return;
1241766Speter 				}
1242766Speter 				gconst(argv[1]);
1243766Speter 				if (con.ctype == NIL)
1244766Speter 					return;
1245766Speter 				if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) {
1246766Speter 					cerror("Specified tag constant type clashed with variant case selector type");
1247766Speter 					return;
1248766Speter 				}
1249766Speter 				for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain)
1250766Speter 					if (ap->range[0] == con.crval)
1251766Speter 						break;
1252766Speter 				if (ap == NIL) {
1253766Speter 					error("No variant case label value equals specified constant value");
1254766Speter 					return;
1255766Speter 				}
1256766Speter 				ap = ap->ptr[NL_VTOREC];
1257766Speter 			}
1258766Speter 		}
1259766Speter 		putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1260766Speter 		putop( P2LISTOP , P2INT );
1261766Speter 		putop( P2CALL , P2INT );
1262766Speter 		putdot( filename , line );
12639139Smckusick 		if (opt('t') && op == O_NEW) {
12649139Smckusick 		    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
12659139Smckusick 			    , "_blkclr" );
12669264Smckusick 		    stkrval(alv, NIL , RREQ );
12679139Smckusick 		    putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
12689139Smckusick 		    putop( P2LISTOP , P2INT );
12699139Smckusick 		    putop( P2CALL , P2INT );
12709139Smckusick 		    putdot( filename , line );
12719139Smckusick 		}
1272766Speter 		return;
1273766Speter 
1274766Speter 	case O_DATE:
1275766Speter 	case O_TIME:
1276766Speter 		if (argc != 1) {
1277766Speter 			error("%s expects one argument", p->symbol);
1278766Speter 			return;
1279766Speter 		}
1280766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1281766Speter 			, op == O_DATE ? "_DATE" : "_TIME" );
1282766Speter 		ap = stklval(argv[1], MOD|NOUSE);
1283766Speter 		if (ap == NIL)
1284766Speter 			return;
1285766Speter 		if (classify(ap) != TSTR || width(ap) != 10) {
1286766Speter 			error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap));
1287766Speter 			return;
1288766Speter 		}
1289766Speter 		putop( P2CALL , P2INT );
1290766Speter 		putdot( filename , line );
1291766Speter 		return;
1292766Speter 
1293766Speter 	case O_HALT:
1294766Speter 		if (argc != 0) {
1295766Speter 			error("halt takes no arguments");
1296766Speter 			return;
1297766Speter 		}
1298766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1299766Speter 			, "_HALT" );
1300766Speter 
1301766Speter 		putop( P2UNARY P2CALL , P2INT );
1302766Speter 		putdot( filename , line );
1303766Speter 		noreach = 1;
1304766Speter 		return;
1305766Speter 
1306766Speter 	case O_ARGV:
1307766Speter 		if (argc != 2) {
1308766Speter 			error("argv takes two arguments");
1309766Speter 			return;
1310766Speter 		}
1311766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1312766Speter 			, "_ARGV" );
1313766Speter 		ap = stkrval(argv[1], NIL , RREQ );
1314766Speter 		if (ap == NIL)
1315766Speter 			return;
1316766Speter 		if (isnta(ap, "i")) {
1317766Speter 			error("argv's first argument must be an integer, not %s", nameof(ap));
1318766Speter 			return;
1319766Speter 		}
1320766Speter 		al = argv[2];
1321766Speter 		ap = stklval(al[1], MOD|NOUSE);
1322766Speter 		if (ap == NIL)
1323766Speter 			return;
1324766Speter 		if (classify(ap) != TSTR) {
1325766Speter 			error("argv's second argument must be a string, not %s", nameof(ap));
1326766Speter 			return;
1327766Speter 		}
1328766Speter 		putop( P2LISTOP , P2INT );
1329766Speter 		putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1330766Speter 		putop( P2LISTOP , P2INT );
1331766Speter 		putop( P2CALL , P2INT );
1332766Speter 		putdot( filename , line );
1333766Speter 		return;
1334766Speter 
1335766Speter 	case O_STLIM:
1336766Speter 		if (argc != 1) {
1337766Speter 			error("stlimit requires one argument");
1338766Speter 			return;
1339766Speter 		}
1340766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1341766Speter 			, "_STLIM" );
1342766Speter 		ap = stkrval(argv[1], NIL , RREQ );
1343766Speter 		if (ap == NIL)
1344766Speter 			return;
1345766Speter 		if (isnta(ap, "i")) {
1346766Speter 			error("stlimit's argument must be an integer, not %s", nameof(ap));
1347766Speter 			return;
1348766Speter 		}
1349766Speter 		putop( P2CALL , P2INT );
1350766Speter 		putdot( filename , line );
1351766Speter 		return;
1352766Speter 
1353766Speter 	case O_REMOVE:
1354766Speter 		if (argc != 1) {
1355766Speter 			error("remove expects one argument");
1356766Speter 			return;
1357766Speter 		}
1358766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1359766Speter 			, "_REMOVE" );
1360766Speter 		ap = stkrval(argv[1], NOFLAGS , RREQ );
1361766Speter 		if (ap == NIL)
1362766Speter 			return;
1363766Speter 		if (classify(ap) != TSTR) {
1364766Speter 			error("remove's argument must be a string, not %s", nameof(ap));
1365766Speter 			return;
1366766Speter 		}
1367766Speter 		putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1368766Speter 		putop( P2LISTOP , P2INT );
1369766Speter 		putop( P2CALL , P2INT );
1370766Speter 		putdot( filename , line );
1371766Speter 		return;
1372766Speter 
1373766Speter 	case O_LLIMIT:
1374766Speter 		if (argc != 2) {
1375766Speter 			error("linelimit expects two arguments");
1376766Speter 			return;
1377766Speter 		}
1378766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1379766Speter 			, "_LLIMIT" );
1380766Speter 		ap = stklval(argv[1], NOFLAGS|NOUSE);
1381766Speter 		if (ap == NIL)
1382766Speter 			return;
1383766Speter 		if (!text(ap)) {
1384766Speter 			error("linelimit's first argument must be a text file, not %s", nameof(ap));
1385766Speter 			return;
1386766Speter 		}
1387766Speter 		al = argv[2];
1388766Speter 		ap = stkrval(al[1], NIL , RREQ );
1389766Speter 		if (ap == NIL)
1390766Speter 			return;
1391766Speter 		if (isnta(ap, "i")) {
1392766Speter 			error("linelimit's second argument must be an integer, not %s", nameof(ap));
1393766Speter 			return;
1394766Speter 		}
1395766Speter 		putop( P2LISTOP , P2INT );
1396766Speter 		putop( P2CALL , P2INT );
1397766Speter 		putdot( filename , line );
1398766Speter 		return;
1399766Speter 	case O_PAGE:
1400766Speter 		if (argc != 1) {
1401766Speter 			error("page expects one argument");
1402766Speter 			return;
1403766Speter 		}
14043833Speter 		putRV( 0 , cbn , CURFILEOFFSET , NLOCAL , P2PTR|P2STRTY );
1405766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1406766Speter 			, "_UNIT" );
1407766Speter 		ap = stklval(argv[1], NOFLAGS);
1408766Speter 		if (ap == NIL)
1409766Speter 			return;
1410766Speter 		if (!text(ap)) {
1411766Speter 			error("Argument to page must be a text file, not %s", nameof(ap));
1412766Speter 			return;
1413766Speter 		}
1414766Speter 		putop( P2CALL , P2INT );
1415766Speter 		putop( P2ASSIGN , P2PTR|P2STRTY );
1416766Speter 		putdot( filename , line );
1417766Speter 		if ( opt( 't' ) ) {
1418766Speter 		    putleaf( P2ICON , 0 , 0
1419766Speter 			, ADDTYPE( P2FTN | P2INT , P2PTR )
1420766Speter 			, "_PAGE" );
14213833Speter 		    putRV( 0 , cbn , CURFILEOFFSET , NLOCAL , P2PTR|P2STRTY );
1422766Speter 		} else {
1423766Speter 		    putleaf( P2ICON , 0 , 0
1424766Speter 			, ADDTYPE( P2FTN | P2INT , P2PTR )
1425766Speter 			, "_fputc" );
1426766Speter 		    putleaf( P2ICON , '\f' , 0 , P2CHAR , 0 );
1427766Speter 		    putleaf( P2ICON , 0 , 0
1428766Speter 			, ADDTYPE( P2FTN | P2INT , P2PTR )
1429766Speter 			, "_ACTFILE" );
14303833Speter 		    putRV( 0 , cbn , CURFILEOFFSET , NLOCAL , P2PTR|P2STRTY );
1431766Speter 		    putop( P2CALL , P2INT );
1432766Speter 		    putop( P2LISTOP , P2INT );
1433766Speter 		}
1434766Speter 		putop( P2CALL , P2INT );
1435766Speter 		putdot( filename , line );
1436766Speter 		return;
1437766Speter 
14387928Smckusick 	case O_ASRT:
14397928Smckusick 		if (!opt('t'))
14407928Smckusick 			return;
14417928Smckusick 		if (argc == 0 || argc > 2) {
14427928Smckusick 			error("Assert expects one or two arguments");
14437928Smckusick 			return;
14447928Smckusick 		}
14459139Smckusick 		if (argc == 2)
14469139Smckusick 			cmd = "_ASRTS";
14479139Smckusick 		else
14489139Smckusick 			cmd = "_ASRT";
14497928Smckusick 		putleaf( P2ICON , 0 , 0
14509139Smckusick 		    , ADDTYPE( P2FTN | P2INT , P2PTR ) , cmd );
14517928Smckusick 		ap = stkrval(argv[1], NIL , RREQ );
14527928Smckusick 		if (ap == NIL)
14537928Smckusick 			return;
14547928Smckusick 		if (isnta(ap, "b"))
14557928Smckusick 			error("Assert expression must be Boolean, not %ss", nameof(ap));
14567928Smckusick 		if (argc == 2) {
14577928Smckusick 			/*
14587928Smckusick 			 * Optional second argument is a string specifying
14597928Smckusick 			 * why the assertion failed.
14607928Smckusick 			 */
14617928Smckusick 			al = argv[2];
14627928Smckusick 			al = stkrval(al[1], NIL , RREQ );
14637928Smckusick 			if (al == NIL)
14647928Smckusick 				return;
14657928Smckusick 			if (classify(al) != TSTR) {
14667928Smckusick 				error("Second argument to assert must be a string, not %s", nameof(al));
14677928Smckusick 				return;
14687928Smckusick 			}
14699139Smckusick 			putop( P2LISTOP , P2INT );
14707928Smckusick 		}
14717928Smckusick 		putop( P2CALL , P2INT );
14727928Smckusick 		putdot( filename , line );
14737928Smckusick 		return;
14747928Smckusick 
1475766Speter 	case O_PACK:
1476766Speter 		if (argc != 3) {
1477766Speter 			error("pack expects three arguments");
1478766Speter 			return;
1479766Speter 		}
1480766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1481766Speter 			, "_PACK" );
1482766Speter 		pu = "pack(a,i,z)";
1483766Speter 		pua = (al = argv)[1];
1484766Speter 		pui = (al = al[2])[1];
1485766Speter 		puz = (al = al[2])[1];
1486766Speter 		goto packunp;
1487766Speter 	case O_UNPACK:
1488766Speter 		if (argc != 3) {
1489766Speter 			error("unpack expects three arguments");
1490766Speter 			return;
1491766Speter 		}
1492766Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1493766Speter 			, "_UNPACK" );
1494766Speter 		pu = "unpack(z,a,i)";
1495766Speter 		puz = (al = argv)[1];
1496766Speter 		pua = (al = al[2])[1];
1497766Speter 		pui = (al = al[2])[1];
1498766Speter packunp:
1499766Speter 		ap = stkrval((int *) pui, NLNIL , RREQ );
1500766Speter 		if (ap == NIL)
1501766Speter 			return;
1502766Speter 		ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);
1503766Speter 		if (ap == NIL)
1504766Speter 			return;
1505766Speter 		if (ap->class != ARRAY) {
1506766Speter 			error("%s requires a to be an unpacked array, not %s", pu, nameof(ap));
1507766Speter 			return;
1508766Speter 		}
1509766Speter 		putop( P2LISTOP , P2INT );
1510766Speter 		al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
1511766Speter 		if (al->class != ARRAY) {
1512766Speter 			error("%s requires z to be a packed array, not %s", pu, nameof(ap));
1513766Speter 			return;
1514766Speter 		}
1515766Speter 		if (al->type == NIL || ap->type == NIL)
1516766Speter 			return;
1517766Speter 		if (al->type != ap->type) {
1518766Speter 			error("%s requires a and z to be arrays of the same type", pu, nameof(ap));
1519766Speter 			return;
1520766Speter 		}
1521766Speter 		putop( P2LISTOP , P2INT );
1522766Speter 		k = width(al);
1523766Speter 		itemwidth = width(ap->type);
1524766Speter 		ap = ap->chain;
1525766Speter 		al = al->chain;
1526766Speter 		if (ap->chain != NIL || al->chain != NIL) {
1527766Speter 			error("%s requires a and z to be single dimension arrays", pu);
1528766Speter 			return;
1529766Speter 		}
1530766Speter 		if (ap == NIL || al == NIL)
1531766Speter 			return;
1532766Speter 		/*
1533766Speter 		 * al is the range for z i.e. u..v
1534766Speter 		 * ap is the range for a i.e. m..n
1535766Speter 		 * i will be n-m+1
1536766Speter 		 * j will be v-u+1
1537766Speter 		 */
1538766Speter 		i = ap->range[1] - ap->range[0] + 1;
1539766Speter 		j = al->range[1] - al->range[0] + 1;
1540766Speter 		if (i < j) {
1541766Speter 			error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i);
1542766Speter 			return;
1543766Speter 		}
1544766Speter 		/*
1545766Speter 		 * get n-m-(v-u) and m for the interpreter
1546766Speter 		 */
1547766Speter 		i -= j;
1548766Speter 		j = ap->range[0];
1549766Speter 		putleaf( P2ICON , itemwidth , 0 , P2INT , 0 );
1550766Speter 		putop( P2LISTOP , P2INT );
1551766Speter 		putleaf( P2ICON , j , 0 , P2INT , 0 );
1552766Speter 		putop( P2LISTOP , P2INT );
1553766Speter 		putleaf( P2ICON , i , 0 , P2INT , 0 );
1554766Speter 		putop( P2LISTOP , P2INT );
1555766Speter 		putleaf( P2ICON , k , 0 , P2INT , 0 );
1556766Speter 		putop( P2LISTOP , P2INT );
1557766Speter 		putop( P2CALL , P2INT );
1558766Speter 		putdot( filename , line );
1559766Speter 		return;
1560766Speter 	case 0:
15617928Smckusick 		error("%s is an unimplemented extension", p->symbol);
1562766Speter 		return;
1563766Speter 
1564766Speter 	default:
1565766Speter 		panic("proc case");
1566766Speter 	}
1567766Speter }
1568766Speter #endif PC
1569