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