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