![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to 0.h CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / pi|
Return to 0.h CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2: #define DEBUG
3: #define CHAR
4: #define STATIC
5: #define hp21mx 0
6:
7: /*
8: * pi - Pascal interpreter code translator
9: *
10: * Charles Haley, Bill Joy
11: * University of California, Berkeley (UCB)
12: * Version 1.2 November 1978
13: */
14:
15: #include <stdio.h>
16: #include <sys/types.h>
17:
18: #define bool short
19: #define TRUE 1
20: #define FALSE 0
21:
22: /*
23: * Option flags
24: *
25: * The following options are recognized in the text of the program
26: * and also on the command line:
27: *
28: * b block buffer the file output
29: *
30: * i make a listing of the procedures and functions in
31: * the following include files
32: *
33: * l make a listing of the program
34: *
35: * n place each include file on a new page with a header
36: *
37: * p disable post mortem and statement limit counting
38: *
39: * t disable run-time tests
40: *
41: * u card image mode; only first 72 chars of input count
42: *
43: * w suppress special diagnostic warnings
44: *
45: * z generate counters for an execution profile
46: */
47: #ifdef DEBUG
48: bool fulltrace, errtrace, testtrace, yyunique;
49: #endif
50:
51: /*
52: * Each option has a stack of 17 option values, with opts giving
53: * the current, top value, and optstk the value beneath it.
54: * One refers to option `l' as, e.g., opt('l') in the text for clarity.
55: */
56: char opts[26];
57: short optstk[26];
58:
59: #define opt(c) opts[c-'a']
60:
61: /*
62: * Monflg is set when we are generating
63: * a profile
64: */
65: bool monflg;
66:
67: /*
68: * NOTES ON THE DYNAMIC NATURE OF THE DATA STRUCTURES
69: *
70: * Pi uses expandable tables for
71: * its namelist (symbol table), string table
72: * hash table, and parse tree space. The following
73: * definitions specify the size of the increments
74: * for these items in fundamental units so that
75: * each uses approximately 1024 bytes.
76: */
77:
78: #define STRINC 1024 /* string space increment */
79: #define TRINC 512 /* tree space increment */
80: #define HASHINC 509 /* hash table size in words, each increment */
81: #define NLINC 56 /* namelist increment size in nl structs */
82:
83: /*
84: * The initial sizes of the structures.
85: * These should be large enough to compile
86: * an "average" sized program so as to minimize
87: * storage requests.
88: * On a small system or and 11/34 or 11/40
89: * these numbers can be trimmed to make the
90: * compiler smaller.
91: */
92: #define ITREE 2000
93: #define INL 200
94: #define IHASH 509
95:
96: /*
97: * The following limits on hash and tree tables currently
98: * allow approximately 1200 symbols and 20k words of tree
99: * space. The fundamental limit of 64k total data space
100: * should be exceeded well before these are full.
101: */
102: /*
103: * TABLE_MULITPLIER is for uniformly increasing the sizes of the tables
104: */
105: #define TABLE_MULTIPLIER 2
106: #define MAXHASH (4 * TABLE_MULTIPLIER)
107: #define MAXNL (12 * TABLE_MULTIPLIER)
108: #define MAXTREE (30 * TABLE_MULTIPLIER)
109: #define MAXDEPTH (150 * TABLE_MULTIPLIER)
110:
111: /*
112: * ERROR RELATED DEFINITIONS
113: */
114:
115: /*
116: * Exit statuses to pexit
117: *
118: * AOK
119: * ERRS Compilation errors inhibit obj productin
120: * NOSTART Errors before we ever got started
121: * DIED We ran out of memory or some such
122: */
123: #define AOK 0
124: #define ERRS 1
125: #define NOSTART 2
126: #define DIED 3
127:
128: bool Recovery;
129:
130: #define eholdnl() Eholdnl = 1
131: #define nocascade() Enocascade = 1
132:
133: bool Eholdnl, Enocascade;
134:
135:
136: /*
137: * The flag eflg is set whenever we have a hard error.
138: * The character in errpfx will precede the next error message.
139: * When cgenflg is set code generation is suppressed.
140: * This happens whenver we have an error (i.e. if eflg is set)
141: * and when we are walking the tree to determine types only.
142: */
143: bool eflg;
144: char errpfx;
145:
146: #define setpfx(x) errpfx = x
147:
148: #define standard() setpfx('s')
149: #define warning() setpfx('w')
150: #define recovered() setpfx('e')
151:
152: bool cgenflg;
153:
154:
155: /*
156: * The flag syneflg is used to suppress the diagnostics of the form
157: * E 10 a, defined in someprocedure, is neither used nor set
158: * when there were syntax errors in "someprocedure".
159: * In this case, it is likely that these warinings would be spurious.
160: */
161: bool syneflg;
162:
163: /*
164: * The compiler keeps its error messages in a file.
165: * The variable efil is the unit number on which
166: * this file is open for reading of error message text.
167: * Similarly, the file ofil is the unit of the file
168: * "obj" where we write the interpreter code.
169: */
170: short efil;
171: short ofil;
172: short obuf[518];
173:
174: #define elineoff() Enoline++
175: #define elineon() Enoline = 0
176:
177: bool Enoline;
178:
179: /*
180: * SYMBOL TABLE STRUCTURE DEFINITIONS
181: *
182: * The symbol table is henceforth referred to as the "namelist".
183: * It consists of a number of structures of the form "nl" below.
184: * These are contained in a number of segments of the symbol
185: * table which are dynamically allocated as needed.
186: * The major namelist manipulation routines are contained in the
187: * file "nl.c".
188: *
189: * The major components of a namelist entry are the "symbol", giving
190: * a pointer into the string table for the string associated with this
191: * entry and the "class" which tells which of the (currently 19)
192: * possible types of structure this is.
193: *
194: * Many of the classes use the "type" field for a pointer to the type
195: * which the entry has.
196: *
197: * Other pieces of information in more than one class include the block
198: * in which the symbol is defined, flags indicating whether the symbol
199: * has been used and whether it has been assigned to, etc.
200: *
201: * A more complete discussion of the features of the namelist is impossible
202: * here as it would be too voluminous. Refer to the "PI 1.0 Implementation
203: * Notes" for more details.
204: */
205:
206: /*
207: * The basic namelist structure.
208: * There are also two other variants, defining the real
209: * field as longs or integers given below.
210: *
211: * The array disptab defines the hash header for the symbol table.
212: * Symbols are hashed based on the low 6 bits of their pointer into
213: * the string table; see the routines in the file "lookup.c" and also "fdec.c"
214: * especially "funcend".
215: */
216: #ifdef PTREE
217: # include "pTree.h"
218: #endif
219: struct nl {
220: char *symbol;
221: char class, nl_flags;
222: struct nl *type;
223: struct nl *chain, *nl_next;
224: int *ptr[4];
225: # ifdef PTREE
226: pPointer inTree;
227: # endif
228: #ifdef PI
229: int entloc;
230: #endif
231: } *nlp, *disptab[077+1];
232:
233: extern struct nl nl[INL];
234:
235: struct {
236: char *symbol;
237: char class, nl_flags;
238: struct nl *type;
239: struct nl *chain, *nl_next;
240: double real;
241: };
242:
243: struct {
244: char *symbol;
245: char class, nl_block;
246: struct nl *type;
247: struct nl *chain, *nl_next;
248: long range[2];
249: };
250:
251: struct {
252: char *symbol;
253: char class, nl_flags;
254: struct nl *type;
255: struct nl *chain, *nl_next;
256: short value[4];
257: };
258:
259: /*
260: * NL FLAGS BITS
261: *
262: * Definitions of the usage of the bits in
263: * the nl_flags byte. Note that the low 5 bits of the
264: * byte are the "nl_block" and that some classes make use
265: * of this byte as a "width".
266: *
267: * The only non-obvious bit definition here is "NFILES"
268: * which records whether a structure contains any files.
269: * Such structures are not allowed to be dynamically allocated.
270: */
271: #define NPACKED 0200
272: #define NUSED 0100
273: #define NMOD 0040
274: #define NFORWD 0200
275: #define NFILES 0200
276:
277: /*
278: * Definition of the commonly used "value" fields.
279: * The most important ones are NL_LOC which gives the location
280: * in the code of a label or procedure, and NL_OFFS which gives
281: * the offset of a variable in its stack mark.
282: */
283: #define NL_OFFS 0
284: #define NL_LOC 1
285:
286: #define NL_FVAR 3
287:
288: #define NL_GOLEV 2
289: #define NL_GOLINE 3
290: #define NL_FORV 1
291:
292: #define NL_FLDSZ 1
293: #define NL_VARNT 2
294: #define NL_VTOREC 2
295: #define NL_TAG 3
296:
297: /*
298: * For BADUSE nl structures, NL_KINDS is a bit vector
299: * indicating the kinds of illegal usages complained about
300: * so far. For kind of bad use "kind", "1 << kind" is set.
301: * The low bit is reserved as ISUNDEF to indicate whether
302: * this identifier is totally undefined.
303: */
304: #define NL_KINDS 0
305:
306: #define ISUNDEF 1
307:
308: /*
309: * NAMELIST CLASSES
310: *
311: * The following are the namelist classes.
312: * Different classes make use of the value fields
313: * of the namelist in different ways.
314: *
315: * The namelist should be redesigned by providing
316: * a number of structure definitions with one corresponding
317: * to each namelist class, ala a variant record in Pascal.
318: */
319: #define BADUSE 0
320: #define CONST 1
321: #define TYPE 2
322: #define VAR 3
323: #define ARRAY 4
324: #define PTRFILE 5
325: #define RECORD 6
326: #define FIELD 7
327: #define PROC 8
328: #define FUNC 9
329: #define FVAR 10
330: #define REF 11
331: #define PTR 12
332: #define FILET 13
333: #define SET 14
334: #define RANGE 15
335: #define LABEL 16
336: #define WITHPTR 17
337: #define SCAL 18
338: #define STR 19
339: #define PROG 20
340: #define IMPROPER 21
341: #define VARNT 22
342:
343: /*
344: * Clnames points to an array of names for the
345: * namelist classes.
346: */
347: char **clnames;
348:
349: /*
350: * PRE-DEFINED NAMELIST OFFSETS
351: *
352: * The following are the namelist offsets for the
353: * primitive types. The ones which are negative
354: * don't actually exist, but are generated and tested
355: * internally. These definitions are sensitive to the
356: * initializations in nl.c.
357: */
358: #define TFIRST -7
359: #define TFILE -7
360: #define TREC -6
361: #define TARY -5
362: #define TSCAL -4
363: #define TPTR -3
364: #define TSET -2
365: #define TSTR -1
366: #define NIL 0
367: #define TBOOL 1
368: #define TCHAR 2
369: #define TINT 3
370: #define TDOUBLE 4
371: #define TNIL 5
372: #define T1INT 6
373: #define T2INT 7
374: #define T4INT 8
375: #define T1CHAR 9
376: #define T1BOOL 10
377: #define T8REAL 11
378: #define TLAST 11
379:
380: /*
381: * SEMANTIC DEFINITIONS
382: */
383:
384: /*
385: * NOCON and SAWCON are flags in the tree telling whether
386: * a constant set is part of an expression.
387: */
388: #define NOCON 0
389: #define SAWCON 1
390:
391: /*
392: * The variable cbn gives the current block number,
393: * the variable bn is set as a side effect of a call to
394: * lookup, and is the block number of the variable which
395: * was found.
396: */
397: short bn, cbn;
398:
399: /*
400: * The variable line is the current semantic
401: * line and is set in stat.c from the numbers
402: * embedded in statement type tree nodes.
403: */
404: short line;
405:
406: /*
407: * The size of the display
408: * which defines the maximum nesting
409: * of procedures and functions allowed.
410: * Because of the flags in the current namelist
411: * this must be no greater than 32.
412: */
413: #define DSPLYSZ 20
414:
415: /*
416: * The following structure is used
417: * to keep track of the amount of variable
418: * storage required by each block.
419: * "Max" is the high water mark, "off"
420: * the current need. Temporaries for "for"
421: * loops and "with" statements are allocated
422: * in the local variable area and these
423: * numbers are thereby changed if necessary.
424: */
425: struct om {
426: long om_off;
427: long om_max;
428: } sizes[DSPLYSZ];
429:
430: /*
431: * Structure recording information about a constant
432: * declaration. It is actually the return value from
433: * the routine "gconst", but since C doesn't support
434: * record valued functions, this is more convenient.
435: */
436: struct {
437: struct nl *ctype;
438: short cival;
439: double crval;
440: int *cpval;
441: } con;
442:
443: /*
444: * The set structure records the lower bound
445: * and upper bound with the lower bound normalized
446: * to zero when working with a set. It is set by
447: * the routine setran in var.c.
448: */
449: struct {
450: short lwrb, uprbp;
451: } set;
452:
453: /*
454: * The following flags are passed on calls to lvalue
455: * to indicate how the reference is to affect the usage
456: * information for the variable being referenced.
457: * MOD is used to set the NMOD flag in the namelist
458: * entry for the variable, ASGN permits diagnostics
459: * to be formed when a for variable is assigned to in
460: * the range of the loop.
461: */
462: #define NOMOD 0
463: #define MOD 01
464: #define ASGN 02
465: #define NOUSE 04
466:
467: double MAXINT;
468: double MININT;
469:
470: /*
471: * Variables for generation of profile information.
472: * Monflg is set when we want to generate a profile.
473: * Gocnt record the total number of goto's and
474: * cnts records the current counter for generating
475: * COUNT operators.
476: */
477: short gocnt;
478: short cnts;
479:
480: /*
481: * Most routines call "incompat" rather than asking "!compat"
482: * for historical reasons.
483: */
484: #define incompat !compat
485:
486: /*
487: * Parts records which declaration parts have been seen.
488: * The grammar allows the "const" "type" and "var"
489: * parts to be repeated and to be in any order, so that
490: * they can be detected semantically to give better
491: * error diagnostics.
492: */
493: short parts;
494:
495: #define LPRT 01
496: #define CPRT 02
497: #define TPRT 04
498: #define VPRT 08
499:
500: /*
501: * Flags for the "you used / instead of div" diagnostic
502: */
503: bool divchk;
504: bool divflg;
505:
506: short errcnt[DSPLYSZ];
507:
508: /*
509: * Forechain links those types which are
510: * ^ sometype
511: * so that they can be evaluated later, permitting
512: * circular, recursive list structures to be defined.
513: */
514: struct nl *forechain;
515:
516: /*
517: * Withlist links all the records which are currently
518: * opened scopes because of with statements.
519: */
520: struct nl *withlist;
521:
522: struct nl *intset;
523: struct nl *input, *output;
524: struct nl *program;
525:
526: /*
527: * STRUCTURED STATEMENT GOTO CHECKING
528: *
529: * The variable level keeps track of the current
530: * "structured statement level" when processing the statement
531: * body of blocks. This is used in the detection of goto's into
532: * structured statements in a block.
533: *
534: * Each label's namelist entry contains two pieces of information
535: * related to this check. The first `NL_GOLEV' either contains
536: * the level at which the label was declared, `NOTYET' if the label
537: * has not yet been declared, or `DEAD' if the label is dead, i.e.
538: * if we have exited the level in which the label was defined.
539: *
540: * When we discover a "goto" statement, if the label has not
541: * been defined yet, then we record the current level and the current line
542: * for a later error check. If the label has been already become "DEAD"
543: * then a reference to it is an error. Now the compiler maintains,
544: * for each block, a linked list of the labels headed by "gotos[bn]".
545: * When we exit a structured level, we perform the routine
546: * ungoto in stat.c. It notices labels whose definition levels have been
547: * exited and makes them be dead. For labels which have not yet been
548: * defined, ungoto will maintain NL_GOLEV as the minimum structured level
549: * since the first usage of the label. It is not hard to see that the label
550: * must eventually be declared at this level or an outer level to this
551: * one or a goto into a structured statement will exist.
552: */
553: short level;
554: struct nl *gotos[DSPLYSZ];
555:
556: #define NOTYET 10000
557: #define DEAD 10000
558:
559: /*
560: * Noreach is true when the next statement will
561: * be unreachable unless something happens along
562: * (like exiting a looping construct) to save
563: * the day.
564: */
565: bool noreach;
566:
567: /*
568: * UNDEFINED VARIABLE REFERENCE STRUCTURES
569: */
570: struct udinfo {
571: int ud_line;
572: struct udinfo *ud_next;
573: char nullch;
574: };
575:
576: /*
577: * CODE GENERATION DEFINITIONS
578: */
579:
580: /*
581: * NSTAND is or'ed onto the abstract machine opcode
582: * for non-standard built-in procedures and functions.
583: */
584: #define NSTAND 0400
585:
586: #define codeon() cgenflg++
587: #define codeoff() --cgenflg
588:
589: /*
590: * Offsets due to the structure of the runtime stack.
591: * DPOFF1 is the amount of fixed storage in each block allocated
592: * as local variables for the runtime system.
593: * DPOFF2 is the size of the block mark.
594: */
595: #if OBJ || PTREE
596: # define DPOFF1 0
597: # ifdef PDP11
598: # define DPOFF2 16
599: # endif
600: # ifdef VAX
601: # define DPOFF2 32
602: # endif
603: #endif
604: #ifdef PPC
605: /*
606: * the display for this level is saved in 0(fp)
607: * and there is no block mark
608: */
609: # define DPOFF1 ( sizeof (int *) )
610: # define DPOFF2 0
611: #endif
612:
613: /*
614: * Codeline is the last lino output in the code generator.
615: * It used to be used to suppress LINO operators but no
616: * more since we now count statements.
617: * Lc is the intepreter code location counter.
618: *
619: short codeline;
620: */
621: char *lc;
622:
623:
624: /*
625: * Routines which need types
626: * other than "integer" to be
627: * assumed by the compiler.
628: */
629: double atof();
630: long lwidth();
631: long aryconst();
632: long a8tol();
633: struct nl *lookup();
634: double atof();
635: int *tree();
636: int *hash();
637: char *alloc();
638: int *calloc();
639: char *savestr();
640: struct nl *lookup1();
641: struct nl *hdefnl();
642: struct nl *defnl();
643: struct nl *enter();
644: struct nl *nlcopy();
645: struct nl *tyrecl();
646: struct nl *tyary();
647: struct nl *fields();
648: struct nl *variants();
649: struct nl *deffld();
650: struct nl *defvnt();
651: struct nl *tyrec1();
652: struct nl *reclook();
653: struct nl *asgnop1();
654: struct nl *gtype();
655: struct nl *call();
656: struct nl *lvalue();
657: struct nl *rvalue();
658: struct nl *cset();
659:
660: /*
661: * type cast NIL to keep lint happy (which is not so bad)
662: */
663: #define NLNIL ( (struct nl *) NIL )
664:
665: /*
666: * Funny structures to use
667: * pointers in wild and wooly ways
668: */
669: struct {
670: char pchar;
671: };
672: struct {
673: short pint;
674: short pint2;
675: };
676: struct {
677: long plong;
678: };
679: struct {
680: double pdouble;
681: };
682:
683: #define OCT 1
684: #define HEX 2
685:
686: /*
687: * MAIN PROGRAM VARIABLES, MISCELLANY
688: */
689:
690: /*
691: * Variables forming a data base referencing
692: * the command line arguments with the "i" option, e.g.
693: * in "pi -i scanner.i compiler.p".
694: */
695: char **pflist;
696: short pflstc;
697: short pfcnt;
698:
699: char *filename; /* current source file name */
700: long tvec;
701: extern char *snark; /* SNARK */
702: extern char *classes[ ]; /* maps namelist classes to string names */
703:
704: #define derror error
705:
706: /*
707: * size of the px_header put on in yymain.c: magic
708: */
709: #define PX_HEAD_BYTES ( 1024 )
710:
711: /*
712: * size of the header, including the magic word (a short)
713: */
714: #define HEAD_BYTES ( PX_HEAD_BYTES + sizeof ( short ) )
715:
716: #ifdef PPC
717: /*
718: * the current function number, for [ lines
719: */
720: int ftnno;
721:
722: /*
723: * the ppc output stream
724: */
725: FILE *ppcstream;
726:
727: # ifdef DEBUG
728: /*
729: * a flag for printing ppc diagnostic stuff
730: */
731: bool ppcdebug;
732:
733: /*
734: * and the stream onto which to print it
735: */
736: FILE *ppcdstream;
737: # endif
738:
739: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.