projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Implement formal functions and procedures
[unix-history] / usr / src / usr.bin / pascal / src / pcproc.c
CommitLineData
076fd8d4
PK		 1/* Copyright (c) 1979 Regents of the University of California */
2
c4e911b6 3static char sccsid[] = "@(#)pcproc.c 1.2 %G%";
076fd8d4
PK		 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
22int 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\f
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 */
43pcproc(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 }
c4e911b6 75 if (p->class != PROC && p->class != FPROC) {
076fd8d4
PK		 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 if (opt('s')) {
438 standard();
439 error("Writing scalars to text files is non-standard");
440 }
441 case TBOOL:
442 fmt = 's';
443 break;
444 case TDOUBLE:
445 tdouble:
446 switch (fmtspec) {
447 case NIL:
448 field = 21;
449 prec = 14;
450 fmt = 'E';
451 fmtspec = CONWIDTH + CONPREC;
452 break;
453 case CONWIDTH:
454 if (--field < 1)
455 field = 1;
456 prec = field - 7;
457 if (prec < 1)
458 prec = 1;
459 fmtspec += CONPREC;
460 fmt = 'E';
461 break;
462 case VARWIDTH:
463 fmtspec += VARPREC;
464 fmt = 'E';
465 break;
466 case CONWIDTH + CONPREC:
467 case CONWIDTH + VARPREC:
468 if (--field < 1)
469 field = 1;
470 }
471 format[0] = ' ';
472 fmtstart = 0;
473 break;
474 case TSTR:
475 constval( alv );
476 switch ( classify( con.ctype ) ) {
477 case TCHAR:
478 typ = TCHAR;
479 goto tchar;
480 case TSTR:
481 strptr = con.cpval;
482 for (strnglen = 0; *strptr++; strnglen++) /* void */;
483 strptr = con.cpval;
484 break;
485 default:
486 strnglen = width(ap);
487 break;
488 }
489 fmt = 's';
490 strfmt = fmtspec;
491 if (fmtspec == NIL) {
492 fmtspec = SKIP;
493 break;
494 }
495 if (fmtspec & CONWIDTH) {
496 if (field <= strnglen)
497 fmtspec = SKIP;
498 else
499 field -= strnglen;
500 }
501 break;
502 default:
503 error("Can't write %ss to a text file", clnames[typ]);
504 continue;
505 }
506 /*
507 * Generate the format string
508 */
509 switch (fmtspec) {
510 default:
511 panic("fmt2");
512 case NIL:
513 if (fmt == 'c') {
514 if ( opt( 't' ) ) {
515 putleaf( P2ICON , 0 , 0
516 , ADDTYPE( P2FTN|P2INT , P2PTR )
517 , "_WRITEC" );
518 putRV( 0 , cbn , CURFILEOFFSET
519 , P2PTR|P2STRTY );
520 stkrval( alv , NIL , RREQ );
521 putop( P2LISTOP , P2INT );
522 } else {
523 putleaf( P2ICON , 0 , 0
524 , ADDTYPE( P2FTN|P2INT , P2PTR )
525 , "_fputc" );
526 stkrval( alv , NIL , RREQ );
527 }
528 putleaf( P2ICON , 0 , 0
529 , ADDTYPE( P2FTN | P2INT , P2PTR )
530 , "_ACTFILE" );
531 putRV( 0, cbn , CURFILEOFFSET
532 , P2PTR|P2STRTY );
533 putop( P2CALL , P2INT );
534 putop( P2LISTOP , P2INT );
535 putop( P2CALL , P2INT );
536 putdot( filename , line );
537 } else {
538 sprintf(&format[1], "%%%c", fmt);
539 goto fmtgen;
540 }
541 case SKIP:
542 break;
543 case CONWIDTH:
544 sprintf(&format[1], "%%%1D%c", field, fmt);
545 goto fmtgen;
546 case VARWIDTH:
547 sprintf(&format[1], "%%*%c", fmt);
548 goto fmtgen;
549 case CONWIDTH + CONPREC:
550 sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt);
551 goto fmtgen;
552 case CONWIDTH + VARPREC:
553 sprintf(&format[1], "%%%1D.*%c", field, fmt);
554 goto fmtgen;
555 case VARWIDTH + CONPREC:
556 sprintf(&format[1], "%%*.%1D%c", prec, fmt);
557 goto fmtgen;
558 case VARWIDTH + VARPREC:
559 sprintf(&format[1], "%%*.*%c", fmt);
560 fmtgen:
561 if ( opt( 't' ) ) {
562 putleaf( P2ICON , 0 , 0
563 , ADDTYPE( P2FTN | P2INT , P2PTR )
564 , "_WRITEF" );
565 putRV( 0 , cbn , CURFILEOFFSET
566 , P2PTR|P2STRTY );
567 putleaf( P2ICON , 0 , 0
568 , ADDTYPE( P2FTN | P2INT , P2PTR )
569 , "_ACTFILE" );
570 putRV( 0 , cbn , CURFILEOFFSET
571 , P2PTR|P2STRTY );
572 putop( P2CALL , P2INT );
573 putop( P2LISTOP , P2INT );
574 } else {
575 putleaf( P2ICON , 0 , 0
576 , ADDTYPE( P2FTN | P2INT , P2PTR )
577 , "_fprintf" );
578 putleaf( P2ICON , 0 , 0
579 , ADDTYPE( P2FTN | P2INT , P2PTR )
580 , "_ACTFILE" );
581 putRV( 0 , cbn , CURFILEOFFSET
582 , P2PTR|P2STRTY );
583 putop( P2CALL , P2INT );
584 }
585 putCONG( &format[ fmtstart ]
586 , strlen( &format[ fmtstart ] )
587 , LREQ );
588 putop( P2LISTOP , P2INT );
589 if ( fmtspec & VARWIDTH ) {
590 /*
591 * either
592 * ,(temp=width,MAX(temp,...)),
593 * or
594 * , MAX( width , ... ) ,
595 */
596 if ( ( typ == TDOUBLE && al[3] == NIL )
597 || typ == TSTR ) {
598 sizes[ cbn ].om_off -= sizeof( int );
599 tempoff = sizes[ cbn ].om_off;
600 putlbracket( ftnno , -tempoff );
601 if ( tempoff < sizes[ cbn ].om_max ) {
602 sizes[ cbn ].om_max = tempoff;
603 }
604 putRV( 0 , cbn , tempoff , P2INT );
605 ap = stkrval( al[2] , NIL , RREQ );
606 putop( P2ASSIGN , P2INT );
607 putleaf( P2ICON , 0 , 0
608 , ADDTYPE( P2FTN | P2INT , P2PTR )
609 , "_MAX" );
610 putRV( 0 , cbn , tempoff , P2INT );
611 } else {
612 if (opt('t')
613 || typ == TSTR || typ == TDOUBLE) {
614 putleaf( P2ICON , 0 , 0
615 ,ADDTYPE( P2FTN | P2INT, P2PTR )
616 ,"_MAX" );
617 }
618 ap = stkrval( al[2] , NIL , RREQ );
619 }
620 if (ap == NIL)
621 continue;
622 if (isnta(ap,"i")) {
623 error("First write width must be integer, not %s", nameof(ap));
624 continue;
625 }
626 switch ( typ ) {
627 case TDOUBLE:
628 putleaf( P2ICON , 1 , 0 , P2INT , 0 );
629 putop( P2LISTOP , P2INT );
630 putleaf( P2ICON , 1 , 0 , P2INT , 0 );
631 putop( P2LISTOP , P2INT );
632 putop( P2CALL , P2INT );
633 if ( al[3] == NIL ) {
634 /*
635 * finish up the comma op
636 */
637 putop( P2COMOP , P2INT );
638 fmtspec &= ~VARPREC;
639 putop( P2LISTOP , P2INT );
640 putleaf( P2ICON , 0 , 0
641 , ADDTYPE( P2FTN | P2INT , P2PTR )
642 , "_MAX" );
643 putRV( 0 , cbn , tempoff , P2INT );
644 sizes[ cbn ].om_off += sizeof( int );
645 putleaf( P2ICON , 8 , 0 , P2INT , 0 );
646 putop( P2LISTOP , P2INT );
647 putleaf( P2ICON , 1 , 0 , P2INT , 0 );
648 putop( P2LISTOP , P2INT );
649 putop( P2CALL , P2INT );
650 }
651 putop( P2LISTOP , P2INT );
652 break;
653 case TSTR:
654 putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
655 putop( P2LISTOP , P2INT );
656 putleaf( P2ICON , 0 , 0 , P2INT , 0 );
657 putop( P2LISTOP , P2INT );
658 putop( P2CALL , P2INT );
659 putop( P2COMOP , P2INT );
660 putop( P2LISTOP , P2INT );
661 break;
662 default:
663 if (opt('t')) {
664 putleaf( P2ICON , 0 , 0 , P2INT , 0 );
665 putop( P2LISTOP , P2INT );
666 putleaf( P2ICON , 0 , 0 , P2INT , 0 );
667 putop( P2LISTOP , P2INT );
668 putop( P2CALL , P2INT );
669 }
670 putop( P2LISTOP , P2INT );
671 break;
672 }
673 }
674 /*
675 * If there is a variable precision,
676 * evaluate it
677 */
678 if (fmtspec & VARPREC) {
679 if (opt('t')) {
680 putleaf( P2ICON , 0 , 0
681 , ADDTYPE( P2FTN | P2INT , P2PTR )
682 , "_MAX" );
683 }
684 ap = stkrval( al[3] , NIL , RREQ );
685 if (ap == NIL)
686 continue;
687 if (isnta(ap,"i")) {
688 error("Second write width must be integer, not %s", nameof(ap));
689 continue;
690 }
691 if (opt('t')) {
692 putleaf( P2ICON , 0 , 0 , P2INT , 0 );
693 putop( P2LISTOP , P2INT );
694 putleaf( P2ICON , 0 , 0 , P2INT , 0 );
695 putop( P2LISTOP , P2INT );
696 putop( P2CALL , P2INT );
697 }
698 putop( P2LISTOP , P2INT );
699 }
700 /*
701 * evaluate the thing we want printed.
702 */
703 switch ( typ ) {
704 case TCHAR:
705 case TINT:
706 stkrval( alv , NIL , RREQ );
707 putop( P2LISTOP , P2INT );
708 break;
709 case TDOUBLE:
710 ap = stkrval( alv , NIL , RREQ );
711 if ( isnta( ap , "d" ) ) {
712 putop( P2SCONV , P2DOUBLE );
713 }
714 putop( P2LISTOP , P2INT );
715 break;
716 case TSCAL:
717 case TBOOL:
718 putleaf( P2ICON , 0 , 0
719 , ADDTYPE( P2FTN | P2INT , P2PTR )
720 , "_NAM" );
721 ap = stkrval( alv , NIL , RREQ );
722 sprintf( format , PREFIXFORMAT , LABELPREFIX
723 , listnames( ap ) );
724 putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR
725 , format );
726 putop( P2LISTOP , P2INT );
727 putop( P2CALL , P2INT );
728 putop( P2LISTOP , P2INT );
729 break;
730 case TSTR:
731 putCONG( "" , 0 , LREQ );
732 putop( P2LISTOP , P2INT );
733 break;
734 }
735 putop( P2CALL , P2INT );
736 putdot( filename , line );
737 }
738 /*
739 * Write the string after its blank padding
740 */
741 if (typ == TSTR ) {
742 if ( opt( 't' ) ) {
743 putleaf( P2ICON , 0 , 0
744 , ADDTYPE( P2FTN | P2INT , P2PTR )
745 , "_WRITES" );
746 putRV( 0 , cbn , CURFILEOFFSET
747 , P2PTR|P2STRTY );
748 ap = stkrval(alv, NIL , RREQ );
749 putop( P2LISTOP , P2INT );
750 } else {
751 putleaf( P2ICON , 0 , 0
752 , ADDTYPE( P2FTN | P2INT , P2PTR )
753 , "_fwrite" );
754 ap = stkrval(alv, NIL , RREQ );
755 }
756 if (strfmt & VARWIDTH) {
757 /*
758 * min, inline expanded as
759 * temp < len ? temp : len
760 */
761 putRV( 0 , cbn , tempoff , P2INT );
762 putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
763 putop( P2LT , P2INT );
764 putRV( 0 , cbn , tempoff , P2INT );
765 putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
766 putop( P2COLON , P2INT );
767 putop( P2QUEST , P2INT );
768 } else {
769 if ( ( fmtspec & SKIP )
770 && ( strfmt & CONWIDTH ) ) {
771 strnglen = field;
772 }
773 putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
774 }
775 putop( P2LISTOP , P2INT );
776 putleaf( P2ICON , 1 , 0 , P2INT , 0 );
777 putop( P2LISTOP , P2INT );
778 putleaf( P2ICON , 0 , 0
779 , ADDTYPE( P2FTN | P2INT , P2PTR )
780 , "_ACTFILE" );
781 putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
782 putop( P2CALL , P2INT );
783 putop( P2LISTOP , P2INT );
784 putop( P2CALL , P2INT );
785 putdot( filename , line );
786 }
787 }
788 /*
789 * Done with arguments.
790 * Handle writeln and
791 * insufficent number of args.
792 */
793 switch (p->value[0] &~ NSTAND) {
794 case O_WRITEF:
795 if (argc == 0)
796 error("Write requires an argument");
797 break;
798 case O_MESSAGE:
799 if (argc == 0)
800 error("Message requires an argument");
801 case O_WRITLN:
802 if (filetype != nl+T1CHAR)
803 error("Can't 'writeln' a non text file");
804 if ( opt( 't' ) ) {
805 putleaf( P2ICON , 0 , 0
806 , ADDTYPE( P2FTN | P2INT , P2PTR )
807 , "_WRITLN" );
808 putRV( 0 , cbn , CURFILEOFFSET
809 , P2PTR|P2STRTY );
810 } else {
811 putleaf( P2ICON , 0 , 0
812 , ADDTYPE( P2FTN | P2INT , P2PTR )
813 , "_fputc" );
814 putleaf( P2ICON , '\n' , 0 , P2CHAR , 0 );
815 putleaf( P2ICON , 0 , 0
816 , ADDTYPE( P2FTN | P2INT , P2PTR )
817 , "_ACTFILE" );
818 putRV( 0 , cbn , CURFILEOFFSET
819 , P2PTR|P2STRTY );
820 putop( P2CALL , P2INT );
821 putop( P2LISTOP , P2INT );
822 }
823 putop( P2CALL , P2INT );
824 putdot( filename , line );
825 break;
826 }
827 return;
828
829 case O_READ4:
830 case O_READLN:
831 /*
832 * Set up default
833 * file "input".
834 */
835 file = NIL;
836 filetype = nl+T1CHAR;
837 /*
838 * Determine the file implied
839 * for the read and generate
840 * code to make it the active file.
841 */
842 if (argv != NIL) {
843 codeoff();
844 ap = stkrval(argv[1], NIL , RREQ );
845 codeon();
846 if (ap == NIL)
847 argv = argv[2];
848 if (ap != NIL && ap->class == FILET) {
849 /*
850 * Got "read(f, ...", make
851 * f the active file, and save
852 * it and its type for use in
853 * processing the rest of the
854 * arguments to read.
855 */
856 file = argv[1];
857 filetype = ap->type;
858 putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
859 putleaf( P2ICON , 0 , 0
860 , ADDTYPE( P2FTN | P2INT , P2PTR )
861 , "_UNIT" );
862 stklval(argv[1], NOFLAGS);
863 putop( P2CALL , P2INT );
864 putop( P2ASSIGN , P2PTR|P2STRTY );
865 putdot( filename , line );
866 argv = argv[2];
867 argc--;
868 } else {
869 /*
870 * Default is read from
871 * standard input.
872 */
873 putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
874 putLV( "_input" , 0 , 0 , P2PTR|P2STRTY );
875 putop( P2ASSIGN , P2PTR|P2STRTY );
876 putdot( filename , line );
877 input->nl_flags |= NUSED;
878 }
879 } else {
880 putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
881 putLV( "_input" , 0 , 0 , P2PTR|P2STRTY );
882 putop( P2ASSIGN , P2PTR|P2STRTY );
883 putdot( filename , line );
884 input->nl_flags |= NUSED;
885 }
886 /*
887 * Loop and process each
888 * of the arguments.
889 */
890 for (; argv != NIL; argv = argv[2]) {
891 /*
892 * Get the address of the target
893 * on the stack.
894 */
895 al = argv[1];
896 if (al == NIL)
897 continue;
898 if (al[0] != T_VAR) {
899 error("Arguments to %s must be variables, not expressions", p->symbol);
900 continue;
901 }
902 codeoff();
903 ap = stklval(al, MOD|ASGN|NOUSE);
904 codeon();
905 if (ap == NIL)
906 continue;
907 if (filetype != nl+T1CHAR) {
908 /*
909 * Generalized read, i.e.
910 * from a non-textfile.
911 */
912 if (incompat(filetype, ap, argv[1] )) {
913 error("Type mismatch in read from non-text file");
914 continue;
915 }
916 /*
917 * var := file ^;
918 */
919 ap = lvalue( al , MOD | ASGN | NOUSE , RREQ );
920 if ( isa( ap , "bsci" ) ) {
921 precheck( ap , "_RANG4" , "_RSNG4" );
922 }
923 putleaf( P2ICON , 0 , 0
924 , ADDTYPE(
925 ADDTYPE(
926 ADDTYPE(
927 p2type( filetype ) , P2PTR )
928 , P2FTN )
929 , P2PTR )
930 , "_FNIL" );
931 if (file != NIL)
932 stklval(file, NOFLAGS);
933 else /* Magic */
934 putRV( "_input" , 0 , 0
935 , P2PTR | P2STRTY );
936 putop( P2CALL , P2INT );
937 switch ( classify( filetype ) ) {
938 case TBOOL:
939 case TCHAR:
940 case TINT:
941 case TSCAL:
942 case TDOUBLE:
943 case TPTR:
944 putop( P2UNARY P2MUL
945 , p2type( filetype ) );
946 }
947 switch ( classify( filetype ) ) {
948 case TBOOL:
949 case TCHAR:
950 case TINT:
951 case TSCAL:
952 postcheck( ap );
953 /* and fall through */
954 case TDOUBLE:
955 case TPTR:
956 putop( P2ASSIGN , p2type( ap ) );
957 putdot( filename , line );
958 break;
959 default:
960 putstrop( P2STASG
961 , p2type( ap )
962 , lwidth( ap )
963 , align( ap ) );
964 putdot( filename , line );
965 break;
966 }
967 /*
968 * get(file);
969 */
970 putleaf( P2ICON , 0 , 0
971 , ADDTYPE( P2FTN | P2INT , P2PTR )
972 , "_GET" );
973 putRV( 0 , cbn , CURFILEOFFSET
974 , P2PTR|P2STRTY );
975 putop( P2CALL , P2INT );
976 putdot( filename , line );
977 continue;
978 }
979 /*
980 * if you get to here, you are reading from
981 * a text file. only possiblities are:
982 * character, integer, real, or scalar.
983 * read( f , foo , ... ) is done as
984 * foo := read( f ) with rangechecking
985 * if appropriate.
986 */
987 typ = classify(ap);
988 op = rdops(typ);
989 if (op == NIL) {
990 error("Can't read %ss from a text file", clnames[typ]);
991 continue;
992 }
993 /*
994 * left hand side of foo := read( f )
995 */
996 ap = lvalue( al , MOD|ASGN|NOUSE , RREQ );
997 if ( isa( ap , "bsci" ) ) {
998 precheck( ap , "_RANG4" , "_RSNG4" );
999 }
1000 switch ( op ) {
1001 case O_READC:
1002 readname = "_READC";
1003 readtype = P2INT;
1004 break;
1005 case O_READ4:
1006 readname = "_READ4";
1007 readtype = P2INT;
1008 break;
1009 case O_READ8:
1010 readname = "_READ8";
1011 readtype = P2DOUBLE;
1012 break;
1013 case O_READE:
1014 readname = "_READE";
1015 readtype = P2INT;
1016 break;
1017 }
1018 putleaf( P2ICON , 0 , 0
1019 , ADDTYPE( P2FTN | readtype , P2PTR )
1020 , readname );
1021 putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1022 if ( op == O_READE ) {
1023 sprintf( format , PREFIXFORMAT , LABELPREFIX
1024 , listnames( ap ) );
1025 putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR
1026 , format );
1027 putop( P2LISTOP , P2INT );
1028 if (opt('s')) {
1029 standard();
1030 error("Reading of enumerated types is non-standard");
1031 }
1032 }
1033 putop( P2CALL , readtype );
1034 if ( isa( ap , "bcsi" ) ) {
1035 postcheck( ap );
1036 }
1037 putop( P2ASSIGN , p2type( ap ) );
1038 putdot( filename , line );
1039 }
1040 /*
1041 * Done with arguments.
1042 * Handle readln and
1043 * insufficient number of args.
1044 */
1045 if (p->value[0] == O_READLN) {
1046 if (filetype != nl+T1CHAR)
1047 error("Can't 'readln' a non text file");
1048 putleaf( P2ICON , 0 , 0
1049 , ADDTYPE( P2FTN | P2INT , P2PTR )
1050 , "_READLN" );
1051 putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1052 putop( P2CALL , P2INT );
1053 putdot( filename , line );
1054 } else if (argc == 0)
1055 error("read requires an argument");
1056 return;
1057
1058 case O_GET:
1059 case O_PUT:
1060 if (argc != 1) {
1061 error("%s expects one argument", p->symbol);
1062 return;
1063 }
1064 putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1065 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1066 , "_UNIT" );
1067 ap = stklval(argv[1], NOFLAGS);
1068 if (ap == NIL)
1069 return;
1070 if (ap->class != FILET) {
1071 error("Argument to %s must be a file, not %s", p->symbol, nameof(ap));
1072 return;
1073 }
1074 putop( P2CALL , P2INT );
1075 putop( P2ASSIGN , P2PTR|P2STRTY );
1076 putdot( filename , line );
1077 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1078 , op == O_GET ? "_GET" : "_PUT" );
1079 putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1080 putop( P2CALL , P2INT );
1081 putdot( filename , line );
1082 return;
1083
1084 case O_RESET:
1085 case O_REWRITE:
1086 if (argc == 0 || argc > 2) {
1087 error("%s expects one or two arguments", p->symbol);
1088 return;
1089 }
1090 if (opt('s') && argc == 2) {
1091 standard();
1092 error("Two argument forms of reset and rewrite are non-standard");
1093 }
1094 putleaf( P2ICON , 0 , 0 , P2INT
1095 , op == O_RESET ? "_RESET" : "_REWRITE" );
1096 ap = stklval(argv[1], MOD|NOUSE);
1097 if (ap == NIL)
1098 return;
1099 if (ap->class != FILET) {
1100 error("First argument to %s must be a file, not %s", p->symbol, nameof(ap));
1101 return;
1102 }
1103 if (argc == 2) {
1104 /*
1105 * Optional second argument
1106 * is a string name of a
1107 * UNIX (R) file to be associated.
1108 */
1109 al = argv[2];
1110 al = stkrval(al[1], NOFLAGS , RREQ );
1111 if (al == NIL)
1112 return;
1113 if (classify(al) != TSTR) {
1114 error("Second argument to %s must be a string, not %s", p->symbol, nameof(al));
1115 return;
1116 }
1117 strnglen = width(al);
1118 } else {
1119 putleaf( P2ICON , 0 , 0 , P2INT , 0 );
1120 strnglen = 0;
1121 }
1122 putop( P2LISTOP , P2INT );
1123 putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
1124 putop( P2LISTOP , P2INT );
1125 putleaf( P2ICON , text(ap) ? 0: width(ap->type) , 0 , P2INT , 0 );
1126 putop( P2LISTOP , P2INT );
1127 putop( P2CALL , P2INT );
1128 putdot( filename , line );
1129 return;
1130
1131 case O_NEW:
1132 case O_DISPOSE:
1133 if (argc == 0) {
1134 error("%s expects at least one argument", p->symbol);
1135 return;
1136 }
1137 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1138 , op == O_DISPOSE ? "_DISPOSE" :
1139 opt('t') ? "_NEWZ" : "_NEW" );
1140 ap = stklval(argv[1], op == O_NEW ? ( MOD | NOUSE ) : MOD );
1141 if (ap == NIL)
1142 return;
1143 if (ap->class != PTR) {
1144 error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap));
1145 return;
1146 }
1147 ap = ap->type;
1148 if (ap == NIL)
1149 return;
1150 argv = argv[2];
1151 if (argv != NIL) {
1152 if (ap->class != RECORD) {
1153 error("Record required when specifying variant tags");
1154 return;
1155 }
1156 for (; argv != NIL; argv = argv[2]) {
1157 if (ap->ptr[NL_VARNT] == NIL) {
1158 error("Too many tag fields");
1159 return;
1160 }
1161 if (!isconst(argv[1])) {
1162 error("Second and successive arguments to %s must be constants", p->symbol);
1163 return;
1164 }
1165 gconst(argv[1]);
1166 if (con.ctype == NIL)
1167 return;
1168 if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) {
1169 cerror("Specified tag constant type clashed with variant case selector type");
1170 return;
1171 }
1172 for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain)
1173 if (ap->range[0] == con.crval)
1174 break;
1175 if (ap == NIL) {
1176 error("No variant case label value equals specified constant value");
1177 return;
1178 }
1179 ap = ap->ptr[NL_VTOREC];
1180 }
1181 }
1182 putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1183 putop( P2LISTOP , P2INT );
1184 putop( P2CALL , P2INT );
1185 putdot( filename , line );
1186 return;
1187
1188 case O_DATE:
1189 case O_TIME:
1190 if (argc != 1) {
1191 error("%s expects one argument", p->symbol);
1192 return;
1193 }
1194 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1195 , op == O_DATE ? "_DATE" : "_TIME" );
1196 ap = stklval(argv[1], MOD|NOUSE);
1197 if (ap == NIL)
1198 return;
1199 if (classify(ap) != TSTR || width(ap) != 10) {
1200 error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap));
1201 return;
1202 }
1203 putop( P2CALL , P2INT );
1204 putdot( filename , line );
1205 return;
1206
1207 case O_HALT:
1208 if (argc != 0) {
1209 error("halt takes no arguments");
1210 return;
1211 }
1212 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1213 , "_HALT" );
1214
1215 putop( P2UNARY P2CALL , P2INT );
1216 putdot( filename , line );
1217 noreach = 1;
1218 return;
1219
1220 case O_ARGV:
1221 if (argc != 2) {
1222 error("argv takes two arguments");
1223 return;
1224 }
1225 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1226 , "_ARGV" );
1227 ap = stkrval(argv[1], NIL , RREQ );
1228 if (ap == NIL)
1229 return;
1230 if (isnta(ap, "i")) {
1231 error("argv's first argument must be an integer, not %s", nameof(ap));
1232 return;
1233 }
1234 al = argv[2];
1235 ap = stklval(al[1], MOD|NOUSE);
1236 if (ap == NIL)
1237 return;
1238 if (classify(ap) != TSTR) {
1239 error("argv's second argument must be a string, not %s", nameof(ap));
1240 return;
1241 }
1242 putop( P2LISTOP , P2INT );
1243 putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1244 putop( P2LISTOP , P2INT );
1245 putop( P2CALL , P2INT );
1246 putdot( filename , line );
1247 return;
1248
1249 case O_STLIM:
1250 if (argc != 1) {
1251 error("stlimit requires one argument");
1252 return;
1253 }
1254 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1255 , "_STLIM" );
1256 ap = stkrval(argv[1], NIL , RREQ );
1257 if (ap == NIL)
1258 return;
1259 if (isnta(ap, "i")) {
1260 error("stlimit's argument must be an integer, not %s", nameof(ap));
1261 return;
1262 }
1263 putop( P2CALL , P2INT );
1264 putdot( filename , line );
1265 return;
1266
1267 case O_REMOVE:
1268 if (argc != 1) {
1269 error("remove expects one argument");
1270 return;
1271 }
1272 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1273 , "_REMOVE" );
1274 ap = stkrval(argv[1], NOFLAGS , RREQ );
1275 if (ap == NIL)
1276 return;
1277 if (classify(ap) != TSTR) {
1278 error("remove's argument must be a string, not %s", nameof(ap));
1279 return;
1280 }
1281 putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
1282 putop( P2LISTOP , P2INT );
1283 putop( P2CALL , P2INT );
1284 putdot( filename , line );
1285 return;
1286
1287 case O_LLIMIT:
1288 if (argc != 2) {
1289 error("linelimit expects two arguments");
1290 return;
1291 }
1292 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1293 , "_LLIMIT" );
1294 ap = stklval(argv[1], NOFLAGS|NOUSE);
1295 if (ap == NIL)
1296 return;
1297 if (!text(ap)) {
1298 error("linelimit's first argument must be a text file, not %s", nameof(ap));
1299 return;
1300 }
1301 al = argv[2];
1302 ap = stkrval(al[1], NIL , RREQ );
1303 if (ap == NIL)
1304 return;
1305 if (isnta(ap, "i")) {
1306 error("linelimit's second argument must be an integer, not %s", nameof(ap));
1307 return;
1308 }
1309 putop( P2LISTOP , P2INT );
1310 putop( P2CALL , P2INT );
1311 putdot( filename , line );
1312 return;
1313 case O_PAGE:
1314 if (argc != 1) {
1315 error("page expects one argument");
1316 return;
1317 }
1318 putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
1319 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1320 , "_UNIT" );
1321 ap = stklval(argv[1], NOFLAGS);
1322 if (ap == NIL)
1323 return;
1324 if (!text(ap)) {
1325 error("Argument to page must be a text file, not %s", nameof(ap));
1326 return;
1327 }
1328 putop( P2CALL , P2INT );
1329 putop( P2ASSIGN , P2PTR|P2STRTY );
1330 putdot( filename , line );
1331 if ( opt( 't' ) ) {
1332 putleaf( P2ICON , 0 , 0
1333 , ADDTYPE( P2FTN | P2INT , P2PTR )
1334 , "_PAGE" );
1335 putRV( 0 , cbn , CURFILEOFFSET
1336 , P2PTR|P2STRTY );
1337 } else {
1338 putleaf( P2ICON , 0 , 0
1339 , ADDTYPE( P2FTN | P2INT , P2PTR )
1340 , "_fputc" );
1341 putleaf( P2ICON , '\f' , 0 , P2CHAR , 0 );
1342 putleaf( P2ICON , 0 , 0
1343 , ADDTYPE( P2FTN | P2INT , P2PTR )
1344 , "_ACTFILE" );
1345 putRV( 0 , cbn , CURFILEOFFSET
1346 , P2PTR|P2STRTY );
1347 putop( P2CALL , P2INT );
1348 putop( P2LISTOP , P2INT );
1349 }
1350 putop( P2CALL , P2INT );
1351 putdot( filename , line );
1352 return;
1353
1354 case O_PACK:
1355 if (argc != 3) {
1356 error("pack expects three arguments");
1357 return;
1358 }
1359 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1360 , "_PACK" );
1361 pu = "pack(a,i,z)";
1362 pua = (al = argv)[1];
1363 pui = (al = al[2])[1];
1364 puz = (al = al[2])[1];
1365 goto packunp;
1366 case O_UNPACK:
1367 if (argc != 3) {
1368 error("unpack expects three arguments");
1369 return;
1370 }
1371 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
1372 , "_UNPACK" );
1373 pu = "unpack(z,a,i)";
1374 puz = (al = argv)[1];
1375 pua = (al = al[2])[1];
1376 pui = (al = al[2])[1];
1377packunp:
1378 ap = stkrval((int *) pui, NLNIL , RREQ );
1379 if (ap == NIL)
1380 return;
1381 ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);
1382 if (ap == NIL)
1383 return;
1384 if (ap->class != ARRAY) {
1385 error("%s requires a to be an unpacked array, not %s", pu, nameof(ap));
1386 return;
1387 }
1388 putop( P2LISTOP , P2INT );
1389 al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
1390 if (al->class != ARRAY) {
1391 error("%s requires z to be a packed array, not %s", pu, nameof(ap));
1392 return;
1393 }
1394 if (al->type == NIL || ap->type == NIL)
1395 return;
1396 if (al->type != ap->type) {
1397 error("%s requires a and z to be arrays of the same type", pu, nameof(ap));
1398 return;
1399 }
1400 putop( P2LISTOP , P2INT );
1401 k = width(al);
1402 itemwidth = width(ap->type);
1403 ap = ap->chain;
1404 al = al->chain;
1405 if (ap->chain != NIL || al->chain != NIL) {
1406 error("%s requires a and z to be single dimension arrays", pu);
1407 return;
1408 }
1409 if (ap == NIL || al == NIL)
1410 return;
1411 /*
1412 * al is the range for z i.e. u..v
1413 * ap is the range for a i.e. m..n
1414 * i will be n-m+1
1415 * j will be v-u+1
1416 */
1417 i = ap->range[1] - ap->range[0] + 1;
1418 j = al->range[1] - al->range[0] + 1;
1419 if (i < j) {
1420 error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i);
1421 return;
1422 }
1423 /*
1424 * get n-m-(v-u) and m for the interpreter
1425 */
1426 i -= j;
1427 j = ap->range[0];
1428 putleaf( P2ICON , itemwidth , 0 , P2INT , 0 );
1429 putop( P2LISTOP , P2INT );
1430 putleaf( P2ICON , j , 0 , P2INT , 0 );
1431 putop( P2LISTOP , P2INT );
1432 putleaf( P2ICON , i , 0 , P2INT , 0 );
1433 putop( P2LISTOP , P2INT );
1434 putleaf( P2ICON , k , 0 , P2INT , 0 );
1435 putop( P2LISTOP , P2INT );
1436 putop( P2CALL , P2INT );
1437 putdot( filename , line );
1438 return;
1439 case 0:
1440 error("%s is an unimplemented 6400 extension", p->symbol);
1441 return;
1442
1443 default:
1444 panic("proc case");
1445 }
1446}
1447#endif PC
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.