![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to pcproc.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / pi|
Return to pcproc.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)pcproc.c 1.3 10/28/80";
4:
5: #include "whoami.h"
6: #ifdef PC
7: /*
8: * and to the end of the file
9: */
10: #include "0.h"
11: #include "tree.h"
12: #include "opcode.h"
13: #include "pc.h"
14: #include "pcops.h"
15:
16: /*
17: * The following array is used to determine which classes may be read
18: * from textfiles. It is indexed by the return value from classify.
19: */
20: #define rdops(x) rdxxxx[(x)-(TFIRST)]
21:
22: int rdxxxx[] = {
23: 0, /* -7 file types */
24: 0, /* -6 record types */
25: 0, /* -5 array types */
26: O_READE, /* -4 scalar types */
27: 0, /* -3 pointer types */
28: 0, /* -2 set types */
29: 0, /* -1 string types */
30: 0, /* 0 nil, no type */
31: O_READE, /* 1 boolean */
32: O_READC, /* 2 character */
33: O_READ4, /* 3 integer */
34: O_READ8 /* 4 real */
35: };
36:
37: /*
38: * Proc handles procedure calls.
39: * Non-builtin procedures are "buck-passed" to func (with a flag
40: * indicating that they are actually procedures.
41: * builtin procedures are handled here.
42: */
43: pcproc(r)
44: int *r;
45: {
46: register struct nl *p;
47: register int *alv, *al, op;
48: struct nl *filetype, *ap;
49: int argc, *argv, typ, fmtspec, strfmt, stkcnt, *file;
50: char fmt, format[20], *strptr;
51: int prec, field, strnglen, fmtlen, fmtstart, pu;
52: int *pua, *pui, *puz;
53: int i, j, k;
54: int itemwidth;
55: char *readname;
56: long tempoff;
57: long readtype;
58:
59: #define CONPREC 4
60: #define VARPREC 8
61: #define CONWIDTH 1
62: #define VARWIDTH 2
63: #define SKIP 16
64:
65: /*
66: * Verify that the name is
67: * defined and is that of a
68: * procedure.
69: */
70: p = lookup(r[2]);
71: if (p == NIL) {
72: rvlist(r[3]);
73: return;
74: }
75: if (p->class != PROC && p->class != FPROC) {
76: error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]);
77: rvlist(r[3]);
78: return;
79: }
80: argv = r[3];
81:
82: /*
83: * Call handles user defined
84: * procedures and functions.
85: */
86: if (bn != 0) {
87: call(p, argv, PROC, bn);
88: return;
89: }
90:
91: /*
92: * Call to built-in procedure.
93: * Count the arguments.
94: */
95: argc = 0;
96: for (al = argv; al != NIL; al = al[2])
97: argc++;
98:
99: /*
100: * Switch on the operator
101: * associated with the built-in
102: * procedure in the namelist
103: */
104: op = p->value[0] &~ NSTAND;
105: if (opt('s') && (p->value[0] & NSTAND)) {
106: standard();
107: error("%s is a nonstandard procedure", p->symbol);
108: }
109: switch (op) {
110:
111: case O_ABORT:
112: if (argc != 0)
113: error("null takes no arguments");
114: return;
115:
116: case O_FLUSH:
117: if (argc == 0) {
118: putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" );
119: putop( P2UNARY P2CALL , P2INT );
120: putdot( filename , line );
121: return;
122: }
123: if (argc != 1) {
124: error("flush takes at most one argument");
125: return;
126: }
127: putleaf( P2ICON , 0 , 0
128: , ADDTYPE( P2FTN | P2INT , P2PTR )
129: , "_FLUSH" );
130: ap = stklval(argv[1], NOFLAGS);
131: if (ap == NIL)
132: return;
133: if (ap->class != FILET) {
134: error("flush's argument must be a file, not %s", nameof(ap));
135: return;
136: }
137: putop( P2CALL , P2INT );
138: putdot( filename , line );
139: return;
140:
141: case O_MESSAGE:
142: case O_WRITEF:
143: case O_WRITLN:
144: /*
145: * Set up default file "output"'s type
146: */
147: file = NIL;
148: filetype = nl+T1CHAR;
149: /*
150: * Determine the file implied
151: * for the write and generate
152: * code to make it the active file.
153: */
154: if (op == O_MESSAGE) {
155: /*
156: * For message, all that matters
157: * is that the filetype is
158: * a character file.
159: * Thus "output" will suit us fine.
160: */
161: putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" );
162: putop( P2UNARY P2CALL , P2INT );
163: putdot( filename , line );
164: putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
165: putLV( "__err" , 0 , 0 , P2PTR|P2STRTY );
166: putop( P2ASSIGN , P2PTR|P2STRTY );
167: putdot( filename , line );
168: } else if (argv != NIL && (al = argv[1])[0] != T_WEXP) {
169: /*
170: * If there is a first argument which has
171: * no write widths, then it is potentially
172: * a file name.
173: */
174: codeoff();
175: ap = stkrval(argv[1], NIL , RREQ );
176: codeon();
177: if (ap == NIL)
178: argv = argv[2];
179: if (ap != NIL && ap->class == FILET) {
180: /*
181: * Got "write(f, ...", make
182: * f the active file, and save
183: * it and its type for use in
184: * processing the rest of the
185: * arguments to write.
186: */
187: putRV( 0 , cbn , CURFILEOFFSET
188: , P2PTR|P2STRTY );
189: putleaf( P2ICON , 0 , 0
190: , ADDTYPE( P2FTN | P2INT , P2PTR )
191: , "_UNIT" );
192: file = argv[1];
193: filetype = ap->type;
194: stklval(argv[1], NOFLAGS);
195: putop( P2CALL , P2INT );
196: putop( P2ASSIGN , P2PTR|P2STRTY );
197: putdot( filename , line );
198: /*
199: * Skip over the first argument
200: */
201: argv = argv[2];
202: argc--;
203: } else {
204: /*
205: * Set up for writing on
206: * standard output.
207: */
208: putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
209: putLV( "_output" , 0 , 0 , P2PTR|P2STRTY );
210: putop( P2ASSIGN , P2PTR|P2STRTY );
211: putdot( filename , line );
212: }
213: } else {
214: putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
215: putLV( "_output" , 0 , 0 , P2PTR|P2STRTY );
216: putop( P2ASSIGN , P2PTR|P2STRTY );
217: putdot( filename , line );
218: }
219: /*
220: * Loop and process each
221: * of the arguments.
222: */
223: for (; argv != NIL; argv = argv[2]) {
224: /*
225: * fmtspec indicates the type (CONstant or VARiable)
226: * and number (none, WIDTH, and/or PRECision)
227: * of the fields in the printf format for this
228: * output variable.
229: * stkcnt is the number of longs pushed on the stack
230: * fmt is the format output indicator (D, E, F, O, X, S)
231: * fmtstart = 0 for leading blank; = 1 for no blank
232: */
233: fmtspec = NIL;
234: stkcnt = 0;
235: fmt = 'D';
236: fmtstart = 1;
237: al = argv[1];
238: if (al == NIL)
239: continue;
240: if (al[0] == T_WEXP)
241: alv = al[1];
242: else
243: alv = al;
244: if (alv == NIL)
245: continue;
246: codeoff();
247: ap = stkrval(alv, NIL , RREQ );
248: codeon();
249: if (ap == NIL)
250: continue;
251: typ = classify(ap);
252: if (al[0] == T_WEXP) {
253: /*
254: * Handle width expressions.
255: * The basic game here is that width
256: * expressions get evaluated. If they
257: * are constant, the value is placed
258: * directly in the format string.
259: * Otherwise the value is pushed onto
260: * the stack and an indirection is
261: * put into the format string.
262: */
263: if (al[3] == OCT)
264: fmt = 'O';
265: else if (al[3] == HEX)
266: fmt = 'X';
267: else if (al[3] != NIL) {
268: /*
269: * Evaluate second format spec
270: */
271: if ( constval(al[3])
272: && isa( con.ctype , "i" ) ) {
273: fmtspec += CONPREC;
274: prec = con.crval;
275: } else {
276: fmtspec += VARPREC;
277: }
278: fmt = 'f';
279: switch ( typ ) {
280: case TINT:
281: if ( opt( 's' ) ) {
282: standard();
283: error("Writing %ss with two write widths is non-standard", clnames[typ]);
284: }
285: /* and fall through */
286: case TDOUBLE:
287: break;
288: default:
289: error("Cannot write %ss with two write widths", clnames[typ]);
290: continue;
291: }
292: }
293: /*
294: * Evaluate first format spec
295: */
296: if (al[2] != NIL) {
297: if ( constval(al[2])
298: && isa( con.ctype , "i" ) ) {
299: fmtspec += CONWIDTH;
300: field = con.crval;
301: } else {
302: fmtspec += VARWIDTH;
303: }
304: }
305: if ((fmtspec & CONPREC) && prec < 0 ||
306: (fmtspec & CONWIDTH) && field < 0) {
307: error("Negative widths are not allowed");
308: continue;
309: }
310: }
311: if (filetype != nl+T1CHAR) {
312: if (fmt == 'O' || fmt == 'X') {
313: error("Oct/hex allowed only on text files");
314: continue;
315: }
316: if (fmtspec) {
317: error("Write widths allowed only on text files");
318: continue;
319: }
320: /*
321: * Generalized write, i.e.
322: * to a non-textfile.
323: */
324: putleaf( P2ICON , 0 , 0
325: , ADDTYPE(
326: ADDTYPE(
327: ADDTYPE( p2type( filetype )
328: , P2PTR )
329: , P2FTN )
330: , P2PTR )
331: , "_FNIL" );
332: stklval(file, NOFLAGS);
333: putop( P2CALL
334: , ADDTYPE( p2type( filetype ) , P2PTR ) );
335: putop( P2UNARY P2MUL , p2type( filetype ) );
336: /*
337: * file^ := ...
338: */
339: switch ( classify( filetype ) ) {
340: case TBOOL:
341: case TCHAR:
342: case TINT:
343: case TSCAL:
344: precheck( filetype , "_RANG4" , "_RSGN4" );
345: /* and fall through */
346: case TDOUBLE:
347: case TPTR:
348: ap = rvalue( argv[1] , filetype , RREQ );
349: break;
350: default:
351: ap = rvalue( argv[1] , filetype , LREQ );
352: break;
353: }
354: if (ap == NIL)
355: continue;
356: if (incompat(ap, filetype, argv[1])) {
357: cerror("Type mismatch in write to non-text file");
358: continue;
359: }
360: switch ( classify( filetype ) ) {
361: case TBOOL:
362: case TCHAR:
363: case TINT:
364: case TSCAL:
365: postcheck( filetype );
366: /* and fall through */
367: case TDOUBLE:
368: case TPTR:
369: putop( P2ASSIGN , p2type( filetype ) );
370: putdot( filename , line );
371: break;
372: default:
373: putstrop( P2STASG
374: , p2type( filetype )
375: , lwidth( filetype )
376: , align( filetype ) );
377: putdot( filename , line );
378: break;
379: }
380: /*
381: * put(file)
382: */
383: putleaf( P2ICON , 0 , 0
384: , ADDTYPE( P2FTN | P2INT , P2PTR )
385: , "_PUT" );
386: putRV( 0 , cbn , CURFILEOFFSET
387: , P2PTR|P2STRTY );
388: putop( P2CALL , P2INT );
389: putdot( filename , line );
390: continue;
391: }
392: /*
393: * Write to a textfile
394: *
395: * Evaluate the expression
396: * to be written.
397: */
398: if (fmt == 'O' || fmt == 'X') {
399: if (opt('s')) {
400: standard();
401: error("Oct and hex are non-standard");
402: }
403: if (typ == TSTR || typ == TDOUBLE) {
404: error("Can't write %ss with oct/hex", clnames[typ]);
405: continue;
406: }
407: if (typ == TCHAR || typ == TBOOL)
408: typ = TINT;
409: }
410: /*
411: * If there is no format specified by the programmer,
412: * implement the default.
413: */
414: switch (typ) {
415: case TINT:
416: if (fmt == 'f') {
417: typ = TDOUBLE;
418: goto tdouble;
419: }
420: if (fmtspec == NIL) {
421: if (fmt == 'D')
422: field = 10;
423: else if (fmt == 'X')
424: field = 8;
425: else if (fmt == 'O')
426: field = 11;
427: else
428: panic("fmt1");
429: fmtspec = CONWIDTH;
430: }
431: break;
432: case TCHAR:
433: tchar:
434: fmt = 'c';
435: break;
436: case TSCAL:
437: warning();
438: if (opt('s')) {
439: standard();
440: }
441: error("Writing scalars to text files is non-standard");
442: case TBOOL:
443: fmt = 's';
444: break;
445: case TDOUBLE:
446: tdouble:
447: switch (fmtspec) {
448: case NIL:
449: field = 21;
450: prec = 14;
451: fmt = 'E';
452: fmtspec = CONWIDTH + CONPREC;
453: break;
454: case CONWIDTH:
455: if (--field < 1)
456: field = 1;
457: prec = field - 7;
458: if (prec < 1)
459: prec = 1;
460: fmtspec += CONPREC;
461: fmt = 'E';
462: break;
463: case VARWIDTH:
464: fmtspec += VARPREC;
465: fmt = 'E';
466: break;
467: case CONWIDTH + CONPREC:
468: case CONWIDTH + VARPREC:
469: if (--field < 1)
470: field = 1;
471: }
472: format[0] = ' ';
473: fmtstart = 0;
474: break;
475: case TSTR:
476: constval( alv );
477: switch ( classify( con.ctype ) ) {
478: case TCHAR:
479: typ = TCHAR;
480: goto tchar;
481: case TSTR:
482: strptr = con.cpval;
483: for (strnglen = 0; *strptr++; strnglen++) /* void */;
484: strptr = con.cpval;
485: break;
486: default:
487: strnglen = width(ap);
488: break;
489: }
490: fmt = 's';
491: strfmt = fmtspec;
492: if (fmtspec == NIL) {
493: fmtspec = SKIP;
494: break;
495: }
496: if (fmtspec & CONWIDTH) {
497: if (field <= strnglen)
498: fmtspec = SKIP;
499: else
500: field -= strnglen;
501: }
502: break;
503: default:
504: error("Can't write %ss to a text file", clnames[typ]);
505: continue;
506: }
507: /*
508: * Generate the format string
509: */
510: switch (fmtspec) {
511: default:
512: panic("fmt2");
513: case NIL:
514: if (fmt == 'c') {
515: if ( opt( 't' ) ) {
516: putleaf( P2ICON , 0 , 0
517: , ADDTYPE( P2FTN|P2INT , P2PTR )
518: , "_WRITEC" );
519: putRV( 0 , cbn , CURFILEOFFSET
520: , P2PTR|P2STRTY );
521: stkrval( alv , NIL , RREQ );
522: putop( P2LISTOP , P2INT );
523: } else {
524: putleaf( P2ICON , 0 , 0
525: , ADDTYPE( P2FTN|P2INT , P2PTR )
526: , "_fputc" );
527: stkrval( alv , NIL , RREQ );
528: }
529: putleaf( P2ICON , 0 , 0
530: , ADDTYPE( P2FTN | P2INT , P2PTR )
531: , "_ACTFILE" );
532: putRV( 0, cbn , CURFILEOFFSET
533: , P2PTR|P2STRTY );
534: putop( P2CALL , P2INT );
535: putop( P2LISTOP , P2INT );
536: putop( P2CALL , P2INT );
537: putdot( filename , line );
538: } else {
539: sprintf(&format[1], "%%%c", fmt);
540: goto fmtgen;
541: }
542: case SKIP:
543: break;
544: case CONWIDTH:
545: sprintf(&format[1], "%%%1D%c", field, fmt);
546: goto fmtgen;
547: case VARWIDTH:
548: sprintf(&format[1], "%%*%c", fmt);
549: goto fmtgen;
550: case CONWIDTH + CONPREC:
551: sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt);
552: goto fmtgen;
553: case CONWIDTH + VARPREC:
554: sprintf(&format[1], "%%%1D.*%c", field, fmt);
555: goto fmtgen;
556: case VARWIDTH + CONPREC:
557: sprintf(&format[1], "%%*.%1D%c", prec, fmt);
558: goto fmtgen;
559: case VARWIDTH + VARPREC:
560: sprintf(&format[1], "%%*.*%c", fmt);
561: fmtgen:
562: if ( opt( 't' ) ) {
563: putleaf( P2ICON , 0 , 0
564: , ADDTYPE( P2FTN | P2INT , P2PTR )
565: , "_WRITEF" );
566: putRV( 0 , cbn , CURFILEOFFSET
567: , P2PTR|P2STRTY );
568: putleaf( P2ICON , 0 , 0
569: , ADDTYPE( P2FTN | P2INT , P2PTR )
570: , "_ACTFILE" );
571: putRV( 0 , cbn , CURFILEOFFSET
572: , P2PTR|P2STRTY );
573: putop( P2CALL , P2INT );
574: putop( P2LISTOP , P2INT );
575: } else {
576: putleaf( P2ICON , 0 , 0
577: , ADDTYPE( P2FTN | P2INT , P2PTR )
578: , "_fprintf" );
579: putleaf( P2ICON , 0 , 0
580: , ADDTYPE( P2FTN | P2INT , P2PTR )
581: , "_ACTFILE" );
582: putRV( 0 , cbn , CURFILEOFFSET
583: , P2PTR|P2STRTY );
584: putop( P2CALL , P2INT );
585: }
586: putCONG( &format[ fmtstart ]
587: , strlen( &format[ fmtstart ] )
588: , LREQ );
589: putop( P2LISTOP , P2INT );
590: if ( fmtspec & VARWIDTH ) {
591: /*
592: * either
593: * ,(temp=width,MAX(temp,...)),
594: * or
595: * , MAX( width , ... ) ,
596: */
597: if ( ( typ == TDOUBLE && al[3] == NIL )
598: || typ == TSTR ) {
599: sizes[ cbn ].om_off -= sizeof( int );
600: tempoff = sizes[ cbn ].om_off;
601: putlbracket( ftnno , -tempoff );
602: if ( tempoff < sizes[ cbn ].om_max ) {
603: sizes[ cbn ].om_max = tempoff;
604: }
605: putRV( 0 , cbn , tempoff , P2INT );
606: ap = stkrval( al[2] , NIL , RREQ );
607: putop( P2ASSIGN , P2INT );
608: putleaf( P2ICON , 0 , 0
609: , ADDTYPE( P2FTN | P2INT , P2PTR )
610: , "_MAX" );
611: putRV( 0 , cbn , tempoff , P2INT );
612: } else {
613: if (opt('t')
614: || typ == TSTR || typ == TDOUBLE) {
615: putleaf( P2ICON , 0 , 0
616: ,ADDTYPE( P2FTN | P2INT, P2PTR )
617: ,"_MAX" );
618: }
619: ap = stkrval( al[2] , NIL , RREQ );
620: }
621: if (ap == NIL)
622: continue;
623: if (isnta(ap,"i")) {
624: error("First write width must be integer, not %s", nameof(ap));
625: continue;
626: }
627: switch ( typ ) {
628: case TDOUBLE:
629: putleaf( P2ICON , 1 , 0 , P2INT , 0 );
630: putop( P2LISTOP , P2INT );
631: putleaf( P2ICON , 1 , 0 , P2INT , 0 );
632: putop( P2LISTOP , P2INT );
633: putop( P2CALL , P2INT );
634: if ( al[3] == NIL ) {
635: /*
636: * finish up the comma op
637: */
638: putop( P2COMOP , P2INT );
639: fmtspec &= ~VARPREC;
640: putop( P2LISTOP , P2INT );
641: putleaf( P2ICON , 0 , 0
642: , ADDTYPE( P2FTN | P2INT , P2PTR )
643: , "_MAX" );
644: putRV( 0 , cbn , tempoff , P2INT );
645: sizes[ cbn ].om_off += sizeof( int );
646: putleaf( P2ICON , 8 , 0 , P2INT , 0 );
647: putop( P2LISTOP , P2INT );
648: putleaf( P2ICON , 1 , 0 , P2INT , 0 );
649: putop( P2LISTOP , P2INT );
650: putop( P2CALL , P2INT );
651: }
652: putop( P2LISTOP , P2INT );
653: break;
654: case TSTR:
655: putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
656: putop( P2LISTOP , P2INT );
657: putleaf( P2ICON , 0 , 0 , P2INT , 0 );
658: putop( P2LISTOP , P2INT );
659: putop( P2CALL , P2INT );
660: putop( P2COMOP , P2INT );
661: putop( P2LISTOP , P2INT );
662: break;
663: default:
664: if (opt('t')) {
665: putleaf( P2ICON , 0 , 0 , P2INT , 0 );
666: putop( P2LISTOP , P2INT );
667: putleaf( P2ICON , 0 , 0 , P2INT , 0 );
668: putop( P2LISTOP , P2INT );
669: putop( P2CALL , P2INT );
670: }
671: putop( P2LISTOP , P2INT );
672: break;
673: }
674: }
675: /*
676: * If there is a variable precision,
677: * evaluate it
678: */
679: if (fmtspec & VARPREC) {
680: if (opt('t')) {
681: putleaf( P2ICON , 0 , 0
682: , ADDTYPE( P2FTN | P2INT , P2PTR )
683: , "_MAX" );
684: }
685: ap = stkrval( al[3] , NIL , RREQ );
686: if (ap == NIL)
687: continue;
688: if (isnta(ap,"i")) {
689: error("Second write width must be integer, not %s", nameof(ap));
690: continue;
691: }
692: if (opt('t')) {
693: putleaf( P2ICON , 0 , 0 , P2INT , 0 );
694: putop( P2LISTOP , P2INT );
695: putleaf( P2ICON , 0 , 0 , P2INT , 0 );
696: putop( P2LISTOP , P2INT );
697: putop( P2CALL , P2INT );
698: }
699: putop( P2LISTOP , P2INT );
700: }
701: /*
702: * evaluate the thing we want printed.
703: */
704: switch ( typ ) {
705: case TCHAR:
706: case TINT:
707: stkrval( alv , NIL , RREQ );
708: putop( P2LISTOP , P2INT );
709: break;
710: case TDOUBLE:
711: ap = stkrval( alv , NIL , RREQ );
712: if ( isnta( ap , "d" ) ) {
713: putop( P2SCONV , P2DOUBLE );
714: }
715: putop( P2LISTOP , P2INT );
716: break;
717: case TSCAL:
718: case TBOOL:
719: putleaf( P2ICON , 0 , 0
720: , ADDTYPE( P2FTN | P2INT , P2PTR )
721: , "_NAM" );
722: ap = stkrval( alv , NIL , RREQ );
723: sprintf( format , PREFIXFORMAT , LABELPREFIX
724: , listnames( ap ) );
725: putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR
726: , format );
727: putop( P2LISTOP , P2INT );
728: putop( P2CALL , P2INT );
729: putop( P2LISTOP , P2INT );
730: break;
731: case TSTR:
732: putCONG( "" , 0 , LREQ );
733: putop( P2LISTOP , P2INT );
734: break;
735: }
736: putop( P2CALL , P2INT );
737: putdot( filename , line );
738: }
739: /*
740: * Write the string after its blank padding
741: */
742: if (typ == TSTR ) {
743: if ( opt( 't' ) ) {
744: putleaf( P2ICON , 0 , 0
745: , ADDTYPE( P2FTN | P2INT , P2PTR )
746: , "_WRITES" );
747: putRV( 0 , cbn , CURFILEOFFSET
748: , P2PTR|P2STRTY );
749: ap = stkrval(alv, NIL , RREQ );
750: putop( P2LISTOP , P2INT );
751: } else {
752: putleaf( P2ICON , 0 , 0
753: , ADDTYPE( P2FTN | P2INT , P2PTR )
754: , "_fwrite" );
755: ap = stkrval(alv, NIL , RREQ );
756: }
757: if (strfmt & VARWIDTH) {
758: /*
759: * min, inline expanded as
760: * temp < len ? temp : len
761: */
762: putRV( 0 , cbn , tempoff , P2INT );
763: putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
764: putop( P2LT , P2INT );
765: putRV( 0 , cbn , tempoff , P2INT );
766: putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
767: putop( P2COLON , P2INT );
768: putop( P2QUEST , P2INT );
769: } else {
770: if ( ( fmtspec & SKIP )
771: && ( strfmt & CONWIDTH ) ) {
772: strnglen = field;
773: }
774: putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
775: }
776: putop( P2LISTOP , P2INT );
777: putleaf( P2ICON , 1 , 0 , P2INT , 0 );
778: putop( P2LISTOP , P2INT );
779: putleaf( P2ICON , 0 , 0
780: , ADDTYPE( P2FTN | P2INT , P2PTR )
781: , "_ACTFILE" );
782: putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
783: putop( P2CALL , P2INT );
784: putop( P2LISTOP , P2INT );
785: putop( P2CALL , P2INT );
786: putdot( filename , line );
787: }
788: }
789: /*
790: * Done with arguments.
791: * Handle writeln and
792: * insufficent number of args.
793: */
794: switch (p->value[0] &~ NSTAND) {
795: case O_WRITEF:
796: if (argc == 0)
797: error("Write requires an argument");
798: break;
799: case O_MESSAGE:
800: if (argc == 0)
801: error("Message requires an argument");
802: case O_WRITLN:
803: if (filetype != nl+T1CHAR)
804: error("Can't 'writeln' a non text file");
805: if ( opt( 't' ) ) {
806: putleaf( P2ICON , 0 , 0
807: , ADDTYPE( P2FTN | P2INT , P2PTR )
808: , "_WRITLN" );
809: putRV( 0 , cbn , CURFILEOFFSET
810: , P2PTR|P2STRTY );
811: } else {
812: putleaf( P2ICON , 0 , 0
813: , ADDTYPE( P2FTN | P2INT , P2PTR )
814: , "_fputc" );
815: putleaf( P2ICON , '\n' , 0 , P2CHAR , 0 );
816: putleaf( P2ICON , 0 , 0
817: , ADDTYPE( P2FTN | P2INT , P2PTR )
818: , "_ACTFILE" );
819: putRV( 0 , cbn , CURFILEOFFSET
820: , P2PTR|P2STRTY );
821: putop( P2CALL , P2INT );
822: putop( P2LISTOP , P2INT );
823: }
824: putop( P2CALL , P2INT );
825: putdot( filename , line );
826: break;
827: }
828: return;
829:
830: case O_READ4:
831: case O_READLN:
832: /*
833: * Set up default
834: * file "input".
835: */
836: file = NIL;
837: filetype = nl+T1CHAR;
838: /*
839: * Determine the file implied
840: * for the read and generate
841: * code to make it the active file.
842: */
843: if (argv != NIL) {
844: codeoff();
845: ap = stkrval(argv[1], NIL , RREQ );
846: codeon();
847: if (ap == NIL)
848: argv = argv[2];
849: if (ap != NIL && ap->class == FILET) {
850: /*
851: * Got "read(f, ...", make
852: * f the active file, and save
853: * it and its type for use in
854: * processing the rest of the
855: * arguments to read.
856: */
857: file = argv[1];
858: filetype = ap->type;
859: putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
860: putleaf( P2ICON , 0 , 0
861: , ADDTYPE( P2FTN | P2INT , P2PTR )
862: , "_UNIT" );
863: stklval(argv[1], NOFLAGS);
864: putop( P2CALL , P2INT );
865: putop( P2ASSIGN , P2PTR|P2STRTY );
866: putdot( filename , line );
867: argv = argv[2];
868: argc--;
869: } else {
870: /*
871: * Default is read from
872: * standard input.
873: */
874: putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
875: putLV( "_input" , 0 , 0 , P2PTR|P2STRTY );
876: putop( P2ASSIGN , P2PTR|P2STRTY );
877: putdot( filename , line );
878: input->nl_flags |= NUSED;
879: }
880: } else {
881: putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
882: putLV( "_input" , 0 , 0 , P2PTR|P2STRTY );
883: putop( P2ASSIGN , P2PTR|P2STRTY );
884: putdot( filename , line );
885: input->nl_flags |= NUSED;
886: }
887: /*
888: * Loop and process each
889: * of the arguments.
890: */
891: for (; argv != NIL; argv = argv[2]) {
892: /*
893: * Get the address of the target
894: * on the stack.
895: */
896: al = argv[1];
897: if (al == NIL)
898: continue;
899: if (al[0] != T_VAR) {
900: error("Arguments to %s must be variables, not expressions", p->symbol);
901: continue;
902: }
903: codeoff();
904: ap = stklval(al, MOD|ASGN|NOUSE);
905: codeon();
906: if (ap == NIL)
907: continue;
908: if (filetype != nl+T1CHAR) {
909: /*
910: * Generalized read, i.e.
911: * from a non-textfile.
912: */
913: if (incompat(filetype, ap, argv[1] )) {
914: error("Type mismatch in read from non-text file");
915: continue;
916: }
917: /*
918: * var := file ^;
919: */
920: ap = lvalue( al , MOD | ASGN | NOUSE , RREQ );
921: if ( isa( ap , "bsci" ) ) {
922: precheck( ap , "_RANG4" , "_RSNG4" );
923: }
924: putleaf( P2ICON , 0 , 0
925: , ADDTYPE(
926: ADDTYPE(
927: ADDTYPE(
928: p2type( filetype ) , P2PTR )
929: , P2FTN )
930: , P2PTR )
931: , "_FNIL" );
932: if (file != NIL)
933: stklval(file, NOFLAGS);
934: else /* Magic */
935: putRV( "_input" , 0 , 0
936: , P2PTR | P2STRTY );
937: putop( P2CALL , P2INT );
938: switch ( classify( filetype ) ) {
939: case TBOOL:
940: case TCHAR:
941: case TINT:
942: case TSCAL:
943: case TDOUBLE:
944: case TPTR:
945: putop( P2UNARY P2MUL
946: , p2type( filetype ) );
947: }
948: switch ( classify( filetype ) ) {
949: case TBOOL:
950: case TCHAR:
951: case TINT:
952: case TSCAL:
953: postcheck( ap );
954: /* and fall through */
955: case TDOUBLE:
956: case TPTR:
957: putop( P2ASSIGN , p2type( ap ) );
958: putdot( filename , line );
959: break;
960: default:
961: putstrop( P2STASG
962: , p2type( ap )
963: , lwidth( ap )
964: , align( ap ) );
965: putdot( filename , line );
966: break;
967: }
968: /*
969: * get(file);
970: */
971: putleaf( P2ICON , 0 , 0
972: , ADDTYPE( P2FTN | P2INT , P2PTR )
973: , "_GET" );
974: putRV( 0 , cbn , CURFILEOFFSET
975: , P2PTR|P2STRTY );
976: putop( P2CALL , P2INT );
977: putdot( filename , line );
978: continue;
979: }
980: /*
981: * if you get to here, you are reading from
982: * a text file. only possiblities are:
983: * character, integer, real, or scalar.
984: * read( f , foo , ... ) is done as
985: * foo := read( f ) with rangechecking
986: * if appropriate.
987: */
988: typ = classify(ap);
989: op = rdops(typ);
990: if (op == NIL) {
991: error("Can't read %ss from a text file", clnames[typ]);
992: continue;
993: }
994: /*
995: * left hand side of foo := read( f )
996: */
997: ap = lvalue( al , MOD|ASGN|NOUSE , RREQ );
998: if ( isa( ap , "bsci" ) ) {
999: precheck( ap , "_RANG4" , "_RSNG4" );
1000: }
1001: switch ( op ) {
1002: case O_READC:
1003: readname = "_READC";
1004: readtype = P2INT;
1005: break;
1006: case O_READ4:
1007: readname = "_READ4";
1008: readtype = P2INT;
1009: break;
1010: case O_READ8:
1011: readname = "_READ8";
1012: readtype = P2DOUBLE;
1013: break;
1014: case O_READE:
1015: readname = "_READE";
1016: readtype = P2INT;
1017: break;
1018: }
1019: putleaf( P2ICON , 0 , 0
1020: , ADDTYPE( P2FTN | readtype , P2PTR )
1021: , readname );
1022: putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1023: if ( op == O_READE ) {
1024: sprintf( format , PREFIXFORMAT , LABELPREFIX
1025: , listnames( ap ) );
1026: putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR
1027: , format );
1028: putop( P2LISTOP , P2INT );
1029: warning();
1030: if (opt('s')) {
1031: standard();
1032: }
1033: error("Reading scalars from text files is non-standard");
1034: }
1035: putop( P2CALL , readtype );
1036: if ( isa( ap , "bcsi" ) ) {
1037: postcheck( ap );
1038: }
1039: putop( P2ASSIGN , p2type( ap ) );
1040: putdot( filename , line );
1041: }
1042: /*
1043: * Done with arguments.
1044: * Handle readln and
1045: * insufficient number of args.
1046: */
1047: if (p->value[0] == O_READLN) {
1048: if (filetype != nl+T1CHAR)
1049: error("Can't 'readln' a non text file");
1050: putleaf( P2ICON , 0 , 0
1051: , ADDTYPE( P2FTN | P2INT , P2PTR )
1052: , "_READLN" );
1053: putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1054: putop( P2CALL , P2INT );
1055: putdot( filename , line );
1056: } else if (argc == 0)
1057: error("read requires an argument");
1058: return;
1059:
1060: case O_GET:
1061: case O_PUT:
1062: if (argc != 1) {
1063: error("%s expects one argument", p->symbol);
1064: return;
1065: }
1066: putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1067: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1068: , "_UNIT" );
1069: ap = stklval(argv[1], NOFLAGS);
1070: if (ap == NIL)
1071: return;
1072: if (ap->class != FILET) {
1073: error("Argument to %s must be a file, not %s", p->symbol, nameof(ap));
1074: return;
1075: }
1076: putop( P2CALL , P2INT );
1077: putop( P2ASSIGN , P2PTR|P2STRTY );
1078: putdot( filename , line );
1079: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1080: , op == O_GET ? "_GET" : "_PUT" );
1081: putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1082: putop( P2CALL , P2INT );
1083: putdot( filename , line );
1084: return;
1085:
1086: case O_RESET:
1087: case O_REWRITE:
1088: if (argc == 0 || argc > 2) {
1089: error("%s expects one or two arguments", p->symbol);
1090: return;
1091: }
1092: if (opt('s') && argc == 2) {
1093: standard();
1094: error("Two argument forms of reset and rewrite are non-standard");
1095: }
1096: putleaf( P2ICON , 0 , 0 , P2INT
1097: , op == O_RESET ? "_RESET" : "_REWRITE" );
1098: ap = stklval(argv[1], MOD|NOUSE);
1099: if (ap == NIL)
1100: return;
1101: if (ap->class != FILET) {
1102: error("First argument to %s must be a file, not %s", p->symbol, nameof(ap));
1103: return;
1104: }
1105: if (argc == 2) {
1106: /*
1107: * Optional second argument
1108: * is a string name of a
1109: * UNIX (R) file to be associated.
1110: */
1111: al = argv[2];
1112: al = stkrval(al[1], NOFLAGS , RREQ );
1113: if (al == NIL)
1114: return;
1115: if (classify(al) != TSTR) {
1116: error("Second argument to %s must be a string, not %s", p->symbol, nameof(al));
1117: return;
1118: }
1119: strnglen = width(al);
1120: } else {
1121: putleaf( P2ICON , 0 , 0 , P2INT , 0 );
1122: strnglen = 0;
1123: }
1124: putop( P2LISTOP , P2INT );
1125: putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
1126: putop( P2LISTOP , P2INT );
1127: putleaf( P2ICON , text(ap) ? 0: width(ap->type) , 0 , P2INT , 0 );
1128: putop( P2LISTOP , P2INT );
1129: putop( P2CALL , P2INT );
1130: putdot( filename , line );
1131: return;
1132:
1133: case O_NEW:
1134: case O_DISPOSE:
1135: if (argc == 0) {
1136: error("%s expects at least one argument", p->symbol);
1137: return;
1138: }
1139: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1140: , op == O_DISPOSE ? "_DISPOSE" :
1141: opt('t') ? "_NEWZ" : "_NEW" );
1142: ap = stklval(argv[1], op == O_NEW ? ( MOD | NOUSE ) : MOD );
1143: if (ap == NIL)
1144: return;
1145: if (ap->class != PTR) {
1146: error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap));
1147: return;
1148: }
1149: ap = ap->type;
1150: if (ap == NIL)
1151: return;
1152: argv = argv[2];
1153: if (argv != NIL) {
1154: if (ap->class != RECORD) {
1155: error("Record required when specifying variant tags");
1156: return;
1157: }
1158: for (; argv != NIL; argv = argv[2]) {
1159: if (ap->ptr[NL_VARNT] == NIL) {
1160: error("Too many tag fields");
1161: return;
1162: }
1163: if (!isconst(argv[1])) {
1164: error("Second and successive arguments to %s must be constants", p->symbol);
1165: return;
1166: }
1167: gconst(argv[1]);
1168: if (con.ctype == NIL)
1169: return;
1170: if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) {
1171: cerror("Specified tag constant type clashed with variant case selector type");
1172: return;
1173: }
1174: for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain)
1175: if (ap->range[0] == con.crval)
1176: break;
1177: if (ap == NIL) {
1178: error("No variant case label value equals specified constant value");
1179: return;
1180: }
1181: ap = ap->ptr[NL_VTOREC];
1182: }
1183: }
1184: putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1185: putop( P2LISTOP , P2INT );
1186: putop( P2CALL , P2INT );
1187: putdot( filename , line );
1188: return;
1189:
1190: case O_DATE:
1191: case O_TIME:
1192: if (argc != 1) {
1193: error("%s expects one argument", p->symbol);
1194: return;
1195: }
1196: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1197: , op == O_DATE ? "_DATE" : "_TIME" );
1198: ap = stklval(argv[1], MOD|NOUSE);
1199: if (ap == NIL)
1200: return;
1201: if (classify(ap) != TSTR || width(ap) != 10) {
1202: error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap));
1203: return;
1204: }
1205: putop( P2CALL , P2INT );
1206: putdot( filename , line );
1207: return;
1208:
1209: case O_HALT:
1210: if (argc != 0) {
1211: error("halt takes no arguments");
1212: return;
1213: }
1214: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1215: , "_HALT" );
1216:
1217: putop( P2UNARY P2CALL , P2INT );
1218: putdot( filename , line );
1219: noreach = 1;
1220: return;
1221:
1222: case O_ARGV:
1223: if (argc != 2) {
1224: error("argv takes two arguments");
1225: return;
1226: }
1227: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1228: , "_ARGV" );
1229: ap = stkrval(argv[1], NIL , RREQ );
1230: if (ap == NIL)
1231: return;
1232: if (isnta(ap, "i")) {
1233: error("argv's first argument must be an integer, not %s", nameof(ap));
1234: return;
1235: }
1236: al = argv[2];
1237: ap = stklval(al[1], MOD|NOUSE);
1238: if (ap == NIL)
1239: return;
1240: if (classify(ap) != TSTR) {
1241: error("argv's second argument must be a string, not %s", nameof(ap));
1242: return;
1243: }
1244: putop( P2LISTOP , P2INT );
1245: putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1246: putop( P2LISTOP , P2INT );
1247: putop( P2CALL , P2INT );
1248: putdot( filename , line );
1249: return;
1250:
1251: case O_STLIM:
1252: if (argc != 1) {
1253: error("stlimit requires one argument");
1254: return;
1255: }
1256: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1257: , "_STLIM" );
1258: ap = stkrval(argv[1], NIL , RREQ );
1259: if (ap == NIL)
1260: return;
1261: if (isnta(ap, "i")) {
1262: error("stlimit's argument must be an integer, not %s", nameof(ap));
1263: return;
1264: }
1265: putop( P2CALL , P2INT );
1266: putdot( filename , line );
1267: return;
1268:
1269: case O_REMOVE:
1270: if (argc != 1) {
1271: error("remove expects one argument");
1272: return;
1273: }
1274: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1275: , "_REMOVE" );
1276: ap = stkrval(argv[1], NOFLAGS , RREQ );
1277: if (ap == NIL)
1278: return;
1279: if (classify(ap) != TSTR) {
1280: error("remove's argument must be a string, not %s", nameof(ap));
1281: return;
1282: }
1283: putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1284: putop( P2LISTOP , P2INT );
1285: putop( P2CALL , P2INT );
1286: putdot( filename , line );
1287: return;
1288:
1289: case O_LLIMIT:
1290: if (argc != 2) {
1291: error("linelimit expects two arguments");
1292: return;
1293: }
1294: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1295: , "_LLIMIT" );
1296: ap = stklval(argv[1], NOFLAGS|NOUSE);
1297: if (ap == NIL)
1298: return;
1299: if (!text(ap)) {
1300: error("linelimit's first argument must be a text file, not %s", nameof(ap));
1301: return;
1302: }
1303: al = argv[2];
1304: ap = stkrval(al[1], NIL , RREQ );
1305: if (ap == NIL)
1306: return;
1307: if (isnta(ap, "i")) {
1308: error("linelimit's second argument must be an integer, not %s", nameof(ap));
1309: return;
1310: }
1311: putop( P2LISTOP , P2INT );
1312: putop( P2CALL , P2INT );
1313: putdot( filename , line );
1314: return;
1315: case O_PAGE:
1316: if (argc != 1) {
1317: error("page expects one argument");
1318: return;
1319: }
1320: putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1321: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1322: , "_UNIT" );
1323: ap = stklval(argv[1], NOFLAGS);
1324: if (ap == NIL)
1325: return;
1326: if (!text(ap)) {
1327: error("Argument to page must be a text file, not %s", nameof(ap));
1328: return;
1329: }
1330: putop( P2CALL , P2INT );
1331: putop( P2ASSIGN , P2PTR|P2STRTY );
1332: putdot( filename , line );
1333: if ( opt( 't' ) ) {
1334: putleaf( P2ICON , 0 , 0
1335: , ADDTYPE( P2FTN | P2INT , P2PTR )
1336: , "_PAGE" );
1337: putRV( 0 , cbn , CURFILEOFFSET
1338: , P2PTR|P2STRTY );
1339: } else {
1340: putleaf( P2ICON , 0 , 0
1341: , ADDTYPE( P2FTN | P2INT , P2PTR )
1342: , "_fputc" );
1343: putleaf( P2ICON , '\f' , 0 , P2CHAR , 0 );
1344: putleaf( P2ICON , 0 , 0
1345: , ADDTYPE( P2FTN | P2INT , P2PTR )
1346: , "_ACTFILE" );
1347: putRV( 0 , cbn , CURFILEOFFSET
1348: , P2PTR|P2STRTY );
1349: putop( P2CALL , P2INT );
1350: putop( P2LISTOP , P2INT );
1351: }
1352: putop( P2CALL , P2INT );
1353: putdot( filename , line );
1354: return;
1355:
1356: case O_PACK:
1357: if (argc != 3) {
1358: error("pack expects three arguments");
1359: return;
1360: }
1361: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1362: , "_PACK" );
1363: pu = "pack(a,i,z)";
1364: pua = (al = argv)[1];
1365: pui = (al = al[2])[1];
1366: puz = (al = al[2])[1];
1367: goto packunp;
1368: case O_UNPACK:
1369: if (argc != 3) {
1370: error("unpack expects three arguments");
1371: return;
1372: }
1373: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1374: , "_UNPACK" );
1375: pu = "unpack(z,a,i)";
1376: puz = (al = argv)[1];
1377: pua = (al = al[2])[1];
1378: pui = (al = al[2])[1];
1379: packunp:
1380: ap = stkrval((int *) pui, NLNIL , RREQ );
1381: if (ap == NIL)
1382: return;
1383: ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);
1384: if (ap == NIL)
1385: return;
1386: if (ap->class != ARRAY) {
1387: error("%s requires a to be an unpacked array, not %s", pu, nameof(ap));
1388: return;
1389: }
1390: putop( P2LISTOP , P2INT );
1391: al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
1392: if (al->class != ARRAY) {
1393: error("%s requires z to be a packed array, not %s", pu, nameof(ap));
1394: return;
1395: }
1396: if (al->type == NIL || ap->type == NIL)
1397: return;
1398: if (al->type != ap->type) {
1399: error("%s requires a and z to be arrays of the same type", pu, nameof(ap));
1400: return;
1401: }
1402: putop( P2LISTOP , P2INT );
1403: k = width(al);
1404: itemwidth = width(ap->type);
1405: ap = ap->chain;
1406: al = al->chain;
1407: if (ap->chain != NIL || al->chain != NIL) {
1408: error("%s requires a and z to be single dimension arrays", pu);
1409: return;
1410: }
1411: if (ap == NIL || al == NIL)
1412: return;
1413: /*
1414: * al is the range for z i.e. u..v
1415: * ap is the range for a i.e. m..n
1416: * i will be n-m+1
1417: * j will be v-u+1
1418: */
1419: i = ap->range[1] - ap->range[0] + 1;
1420: j = al->range[1] - al->range[0] + 1;
1421: if (i < j) {
1422: error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i);
1423: return;
1424: }
1425: /*
1426: * get n-m-(v-u) and m for the interpreter
1427: */
1428: i -= j;
1429: j = ap->range[0];
1430: putleaf( P2ICON , itemwidth , 0 , P2INT , 0 );
1431: putop( P2LISTOP , P2INT );
1432: putleaf( P2ICON , j , 0 , P2INT , 0 );
1433: putop( P2LISTOP , P2INT );
1434: putleaf( P2ICON , i , 0 , P2INT , 0 );
1435: putop( P2LISTOP , P2INT );
1436: putleaf( P2ICON , k , 0 , P2INT , 0 );
1437: putop( P2LISTOP , P2INT );
1438: putop( P2CALL , P2INT );
1439: putdot( filename , line );
1440: return;
1441: case 0:
1442: error("%s is an unimplemented 6400 extension", p->symbol);
1443: return;
1444:
1445: default:
1446: panic("proc case");
1447: }
1448: }
1449: #endif PC
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.