![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to nl.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / pi|
Return to nl.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)nl.c 1.2 10/2/80";
4:
5: #include "whoami.h"
6: #include "0.h"
7: #include "opcode.h"
8: #include "objfmt.h"
9:
10: /*
11: * NAMELIST SEGMENT DEFINITIONS
12: */
13: struct nls {
14: struct nl *nls_low;
15: struct nl *nls_high;
16: } ntab[MAXNL], *nlact;
17:
18: struct nl nl[INL];
19: struct nl *nlp = nl;
20: struct nls *nlact = ntab;
21:
22: /*
23: * all these strings must be places where people can find them
24: * since lookup only looks at the string pointer, not the chars.
25: * see, for example, pTreeInit.
26: */
27:
28: /*
29: * built in constants
30: */
31: char *in_consts[] = {
32: "true" ,
33: "false" ,
34: "TRUE",
35: "FALSE",
36: "minint" ,
37: "maxint" ,
38: "minchar" ,
39: "maxchar" ,
40: "bell" ,
41: "tab" ,
42: 0
43: };
44:
45: /*
46: * built in simple types
47: */
48: char *in_types[] =
49: {
50: "boolean",
51: "char",
52: "integer",
53: "real",
54: "_nil", /* dummy name */
55: 0
56: };
57:
58: int in_rclasses[] =
59: {
60: TINT ,
61: TINT ,
62: TINT ,
63: TCHAR ,
64: TBOOL ,
65: TDOUBLE ,
66: 0
67: };
68:
69: long in_ranges[] =
70: {
71: -128L , 128L ,
72: -32768L , 32767L ,
73: -2147483648L , 2147483647L ,
74: 0L , 127L ,
75: 0L , 1L ,
76: 0L , 0L /* fake for reals */
77: };
78:
79: /*
80: * built in constructed types
81: */
82: char *in_ctypes[] = {
83: "Boolean" ,
84: "intset" ,
85: "alfa" ,
86: "text" ,
87: 0
88: };
89:
90: /*
91: * built in variables
92: */
93: char *in_vars[] = {
94: "input" ,
95: "output" ,
96: 0
97: };
98:
99: /*
100: * built in functions
101: */
102: char *in_funcs[] =
103: {
104: "abs" ,
105: "arctan" ,
106: "card" ,
107: "chr" ,
108: "clock" ,
109: "cos" ,
110: "eof" ,
111: "eoln" ,
112: "eos" ,
113: "exp" ,
114: "expo" ,
115: "ln" ,
116: "odd" ,
117: "ord" ,
118: "pred" ,
119: "round" ,
120: "sin" ,
121: "sqr" ,
122: "sqrt" ,
123: "succ" ,
124: "trunc" ,
125: "undefined" ,
126: /*
127: * Extensions
128: */
129: "argc" ,
130: "random" ,
131: "seed" ,
132: "wallclock" ,
133: "sysclock" ,
134: 0
135: };
136:
137: /*
138: * Built-in procedures
139: */
140: char *in_procs[] =
141: {
142: "date" ,
143: "dispose" ,
144: "flush" ,
145: "get" ,
146: "getseg" ,
147: "halt" ,
148: "linelimit" ,
149: "message" ,
150: "new" ,
151: "pack" ,
152: "page" ,
153: "put" ,
154: "putseg" ,
155: "read" ,
156: "readln" ,
157: "remove" ,
158: "reset" ,
159: "rewrite" ,
160: "time" ,
161: "unpack" ,
162: "write" ,
163: "writeln" ,
164: /*
165: * Extensions
166: */
167: "argv" ,
168: "null" ,
169: "stlimit" ,
170: 0
171: };
172:
173: #ifndef PI0
174: /*
175: * and their opcodes
176: */
177: int in_fops[] =
178: {
179: O_ABS2,
180: O_ATAN,
181: O_CARD|NSTAND,
182: O_CHR2,
183: O_CLCK|NSTAND,
184: O_COS,
185: O_EOF,
186: O_EOLN,
187: 0,
188: O_EXP,
189: O_EXPO|NSTAND,
190: O_LN,
191: O_ODD2,
192: O_ORD2,
193: O_PRED2,
194: O_ROUND,
195: O_SIN,
196: O_SQR2,
197: O_SQRT,
198: O_SUCC2,
199: O_TRUNC,
200: O_UNDEF|NSTAND,
201: /*
202: * Extensions
203: */
204: O_ARGC|NSTAND,
205: O_RANDOM|NSTAND,
206: O_SEED|NSTAND,
207: O_WCLCK|NSTAND,
208: O_SCLCK|NSTAND
209: };
210:
211: /*
212: * Built-in procedures
213: */
214: int in_pops[] =
215: {
216: O_DATE|NSTAND,
217: O_DISPOSE,
218: O_FLUSH|NSTAND,
219: O_GET,
220: 0,
221: O_HALT|NSTAND,
222: O_LLIMIT|NSTAND,
223: O_MESSAGE|NSTAND,
224: O_NEW,
225: O_PACK,
226: O_PAGE,
227: O_PUT,
228: 0,
229: O_READ4,
230: O_READLN,
231: O_REMOVE|NSTAND,
232: O_RESET,
233: O_REWRITE,
234: O_TIME|NSTAND,
235: O_UNPACK,
236: O_WRITEF,
237: O_WRITLN,
238: /*
239: * Extensions
240: */
241: O_ARGV|NSTAND,
242: O_ABORT|NSTAND,
243: O_STLIM|NSTAND
244: };
245: #endif
246:
247: /*
248: * Initnl initializes the first namelist segment and then
249: * initializes the name list for block 0.
250: */
251: initnl()
252: {
253: register char **cp;
254: register struct nl *np;
255: struct nl *fp;
256: int *ip;
257: long *lp;
258:
259: #ifdef DEBUG
260: if ( hp21mx )
261: {
262: MININT = -32768.;
263: MAXINT = 32767.;
264: #ifndef PI0
265: genmx();
266: #endif
267: }
268: #endif
269: ntab[0].nls_low = nl;
270: ntab[0].nls_high = &nl[INL];
271: defnl ( 0 , 0 , 0 , 0 );
272:
273: /*
274: * Types
275: */
276: for ( cp = in_types ; *cp != 0 ; cp ++ )
277: hdefnl ( *cp , TYPE , nlp , 0 );
278:
279: /*
280: * Ranges
281: */
282: lp = in_ranges;
283: for ( ip = in_rclasses ; *ip != 0 ; ip ++ )
284: {
285: np = defnl ( 0 , RANGE , nl+(*ip) , 0 );
286: nl[*ip].type = np;
287: np -> range[0] = *lp ++ ;
288: np -> range[1] = *lp ++ ;
289:
290: };
291:
292: /*
293: * built in constructed types
294: */
295:
296: cp = in_ctypes;
297: /*
298: * Boolean = boolean;
299: */
300: hdefnl ( *cp++ , TYPE , nl+T1BOOL , 0 );
301:
302: /*
303: * intset = set of 0 .. 127;
304: */
305: intset = *cp++;
306: hdefnl( intset , TYPE , nlp+1 , 0 );
307: defnl ( 0 , SET , nlp+1 , 0 );
308: np = defnl ( 0 , RANGE , nl+TINT , 0 );
309: np -> range[0] = 0L;
310: np -> range[1] = 127L;
311:
312: /*
313: * alfa = array [ 1 .. 10 ] of char;
314: */
315: np = defnl ( 0 , RANGE , nl+TINT , 0 );
316: np -> range[0] = 1L;
317: np -> range[1] = 10L;
318: defnl ( 0 , ARRAY , nl+T1CHAR , 1 ) -> chain = np;
319: hdefnl ( *cp++ , TYPE , nlp-1 , 0 );
320:
321: /*
322: * text = file of char;
323: */
324: hdefnl ( *cp++ , TYPE , nlp+1 , 0 );
325: np = defnl ( 0 , FILET , nl+T1CHAR , 0 );
326: np -> nl_flags |= NFILES;
327:
328: /*
329: * input,output : text;
330: */
331: cp = in_vars;
332: # ifndef PI0
333: input = hdefnl ( *cp++ , VAR , np , INPUT_OFF );
334: output = hdefnl ( *cp++ , VAR , np , OUTPUT_OFF );
335: # else
336: input = hdefnl ( *cp++ , VAR , np , 0 );
337: output = hdefnl ( *cp++ , VAR , np , 0 );
338: # endif
339:
340: /*
341: * built in constants
342: */
343: cp = in_consts;
344: np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 );
345: fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 );
346: (nl + TBOOL)->chain = fp;
347: fp->chain = np;
348: np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 );
349: fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 );
350: fp->chain = np;
351: if (opt('s'))
352: (nl + TBOOL)->chain = fp;
353: hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MININT;
354: hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MAXINT;
355: hdefnl ( *cp++ , CONST , nl + T1CHAR , 0 );
356: hdefnl ( *cp++ , CONST , nl + T1CHAR , 127 );
357: hdefnl ( *cp++ , CONST , nl + T1CHAR , '\007' );
358: hdefnl ( *cp++ , CONST , nl + T1CHAR , '\t' );
359:
360: /*
361: * Built-in functions and procedures
362: */
363: #ifndef PI0
364: ip = in_fops;
365: for ( cp = in_funcs ; *cp != 0 ; cp ++ )
366: hdefnl ( *cp , FUNC , 0 , * ip ++ );
367: ip = in_pops;
368: for ( cp = in_procs ; *cp != 0 ; cp ++ )
369: hdefnl ( *cp , PROC , 0 , * ip ++ );
370: #else
371: for ( cp = in_funcs ; *cp != 0 ; cp ++ )
372: hdefnl ( *cp , FUNC , 0 , 0 );
373: for ( cp = in_procs ; *cp != 0 , cp ++ )
374: hdefnl ( *cp , PROC , 0 , 0 );
375: #endif
376: # ifdef PTREE
377: pTreeInit();
378: # endif
379: }
380:
381: struct nl *
382: hdefnl(sym, cls, typ, val)
383: {
384: register struct nl *p;
385:
386: #ifndef PI1
387: if (sym)
388: hash(sym, 0);
389: #endif
390: p = defnl(sym, cls, typ, val);
391: if (sym)
392: enter(p);
393: return (p);
394: }
395:
396: /*
397: * Free up the name list segments
398: * at the end of a statement/proc/func
399: * All segments are freed down to the one in which
400: * p points.
401: */
402: nlfree(p)
403: struct nl *p;
404: {
405:
406: nlp = p;
407: while (nlact->nls_low > nlp || nlact->nls_high < nlp) {
408: free(nlact->nls_low);
409: nlact->nls_low = NIL;
410: nlact->nls_high = NIL;
411: --nlact;
412: if (nlact < &ntab[0])
413: panic("nlfree");
414: }
415: }
416:
417:
418: char *VARIABLE = "variable";
419:
420: char *classes[ ] = {
421: "undefined",
422: "constant",
423: "type",
424: "variable", /* VARIABLE */
425: "array",
426: "pointer or file",
427: "record",
428: "field",
429: "procedure",
430: "function",
431: "variable", /* VARIABLE */
432: "variable", /* VARIABLE */
433: "pointer",
434: "file",
435: "set",
436: "subrange",
437: "label",
438: "withptr",
439: "scalar",
440: "string",
441: "program",
442: "improper",
443: "variant",
444: "formal procedure",
445: "formal function"
446: };
447:
448: char *snark = "SNARK";
449:
450: #ifdef PI
451: #ifdef DEBUG
452: char *ctext[] =
453: {
454: "BADUSE",
455: "CONST",
456: "TYPE",
457: "VAR",
458: "ARRAY",
459: "PTRFILE",
460: "RECORD",
461: "FIELD",
462: "PROC",
463: "FUNC",
464: "FVAR",
465: "REF",
466: "PTR",
467: "FILET",
468: "SET",
469: "RANGE",
470: "LABEL",
471: "WITHPTR",
472: "SCAL",
473: "STR",
474: "PROG",
475: "IMPROPER",
476: "VARNT",
477: "FPROC",
478: "FFUNC"
479: };
480:
481: char *stars = "\t***";
482:
483: /*
484: * Dump the namelist from the
485: * current nlp down to 'to'.
486: * All the namelist is dumped if
487: * to is NIL.
488: */
489: dumpnl(to, rout)
490: struct nl *to;
491: {
492: register struct nl *p;
493: register int j;
494: struct nls *nlsp;
495: int i, v, head;
496:
497: if (opt('y') == 0)
498: return;
499: if (to != NIL)
500: printf("\n\"%s\" Block=%d\n", rout, cbn);
501: nlsp = nlact;
502: head = NIL;
503: for (p = nlp; p != to;) {
504: if (p == nlsp->nls_low) {
505: if (nlsp == &ntab[0])
506: break;
507: nlsp--;
508: p = nlsp->nls_high;
509: }
510: p--;
511: if (head == NIL) {
512: printf("\tName\tClass Bn+Flags\tType\tVal\tChn\n");
513: head++;
514: }
515: printf("%3d:", nloff(p));
516: if (p->symbol)
517: printf("\t%.7s", p->symbol);
518: else
519: printf(stars);
520: if (p->class)
521: printf("\t%s", ctext[p->class]);
522: else
523: printf(stars);
524: if (p->nl_flags) {
525: pchr('\t');
526: if (p->nl_flags & 037)
527: printf("%d ", p->nl_flags & 037);
528: #ifndef PI0
529: if (p->nl_flags & NMOD)
530: pchr('M');
531: if (p->nl_flags & NUSED)
532: pchr('U');
533: #endif
534: if (p->nl_flags & NFILES)
535: pchr('F');
536: } else
537: printf(stars);
538: if (p->type)
539: printf("\t[%d]", nloff(p->type));
540: else
541: printf(stars);
542: v = p->value[0];
543: switch (p->class) {
544: case TYPE:
545: break;
546: case VARNT:
547: goto con;
548: case CONST:
549: switch (nloff(p->type)) {
550: default:
551: printf("\t%d", v);
552: break;
553: case TDOUBLE:
554: printf("\t%f", p->real);
555: break;
556: case TINT:
557: case T4INT:
558: con:
559: printf("\t%ld", p->range[0]);
560: break;
561: case TSTR:
562: printf("\t'%s'", p->ptr[0]);
563: break;
564: }
565: break;
566: case VAR:
567: case REF:
568: case WITHPTR:
569: case FFUNC:
570: case FPROC:
571: printf("\t%d,%d", cbn, v);
572: break;
573: case SCAL:
574: case RANGE:
575: printf("\t%ld..%ld", p->range[0], p->range[1]);
576: break;
577: case RECORD:
578: printf("\t%d(%d)", v, p->value[NL_FLDSZ]);
579: break;
580: case FIELD:
581: printf("\t%d", v);
582: break;
583: case STR:
584: printf("\t|%d|", p->value[0]);
585: break;
586: case FVAR:
587: case FUNC:
588: case PROC:
589: case PROG:
590: if (cbn == 0) {
591: printf("\t<%o>", p->value[0] & 0377);
592: #ifndef PI0
593: if (p->value[0] & NSTAND)
594: printf("\tNSTAND");
595: #endif
596: break;
597: }
598: v = p->value[1];
599: default:
600: casedef:
601: if (v)
602: printf("\t<%d>", v);
603: else
604: printf(stars);
605: }
606: if (p->chain)
607: printf("\t[%d]", nloff(p->chain));
608: switch (p->class) {
609: case RECORD:
610: if (p->ptr[NL_VARNT])
611: printf("\tVARNT=[%d]", nloff(p->ptr[NL_VARNT]));
612: if (p->ptr[NL_TAG])
613: printf(" TAG=[%d]", nloff(p->ptr[NL_TAG]));
614: break;
615: case VARNT:
616: printf("\tVTOREC=[%d]", nloff(p->ptr[NL_VTOREC]));
617: break;
618: }
619: # ifdef PTREE
620: pchr( '\t' );
621: pPrintPointer( stdout , "%s" , p -> inTree );
622: # endif
623: pchr('\n');
624: }
625: if (head == 0)
626: printf("\tNo entries\n");
627: }
628: #endif
629:
630:
631: /*
632: * Define a new name list entry
633: * with initial symbol, class, type
634: * and value[0] as given. A new name
635: * list segment is allocated to hold
636: * the next name list slot if necessary.
637: */
638: struct nl *
639: defnl(sym, cls, typ, val)
640: char *sym;
641: int cls;
642: struct nl *typ;
643: int val;
644: {
645: register struct nl *p;
646: register int *q, i;
647: char *cp;
648:
649: p = nlp;
650:
651: /*
652: * Zero out this entry
653: */
654: q = p;
655: i = (sizeof *p)/(sizeof (int));
656: do
657: *q++ = 0;
658: while (--i);
659:
660: /*
661: * Insert the values
662: */
663: p->symbol = sym;
664: p->class = cls;
665: p->type = typ;
666: p->nl_block = cbn;
667: p->value[0] = val;
668:
669: /*
670: * Insure that the next namelist
671: * entry actually exists. This is
672: * really not needed here, it would
673: * suffice to do it at entry if we
674: * need the slot. It is done this
675: * way because, historically, nlp
676: * always pointed at the next namelist
677: * slot.
678: */
679: nlp++;
680: if (nlp >= nlact->nls_high) {
681: i = NLINC;
682: cp = malloc(NLINC * sizeof *nlp);
683: if (cp == -1) {
684: i = NLINC / 2;
685: cp = malloc((NLINC / 2) * sizeof *nlp);
686: }
687: if (cp == -1) {
688: error("Ran out of memory (defnl)");
689: pexit(DIED);
690: }
691: nlact++;
692: if (nlact >= &ntab[MAXNL]) {
693: error("Ran out of name list tables");
694: pexit(DIED);
695: }
696: nlp = cp;
697: nlact->nls_low = nlp;
698: nlact->nls_high = nlact->nls_low + i;
699: }
700: return (p);
701: }
702:
703: /*
704: * Make a duplicate of the argument
705: * namelist entry for, e.g., type
706: * declarations of the form 'type a = b'
707: * and array indicies.
708: */
709: struct nl *
710: nlcopy(p)
711: struct nl *p;
712: {
713: register int *p1, *p2, i;
714:
715: p1 = p;
716: p = p2 = defnl(0, 0, 0, 0);
717: i = (sizeof *p)/(sizeof (int));
718: do
719: *p2++ = *p1++;
720: while (--i);
721: p->chain = NIL;
722: return (p);
723: }
724:
725: /*
726: * Compute a namelist offset
727: */
728: nloff(p)
729: struct nl *p;
730: {
731:
732: return (p - nl);
733: }
734:
735: /*
736: * Enter a symbol into the block
737: * symbol table. Symbols are hashed
738: * 64 ways based on low 6 bits of the
739: * character pointer into the string
740: * table.
741: */
742: struct nl *
743: enter(np)
744: struct nl *np;
745: {
746: register struct nl *rp, *hp;
747: register struct nl *p;
748: int i;
749:
750: rp = np;
751: if (rp == NIL)
752: return (NIL);
753: #ifndef PI1
754: if (cbn > 0)
755: if (rp->symbol == input->symbol || rp->symbol == output->symbol)
756: error("Pre-defined files input and output must not be redefined");
757: #endif
758: i = rp->symbol;
759: i &= 077;
760: hp = disptab[i];
761: if (rp->class != BADUSE && rp->class != FIELD)
762: for (p = hp; p != NIL && (p->nl_block & 037) == cbn; p = p->nl_next)
763: if (p->symbol == rp->symbol && p->class != BADUSE && p->class != FIELD) {
764: #ifndef PI1
765: error("%s is already defined in this block", rp->symbol);
766: #endif
767: break;
768:
769: }
770: rp->nl_next = hp;
771: disptab[i] = rp;
772: return (rp);
773: }
774: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.