xref: /original-bsd/usr.bin/pascal/src/0.h (revision 9c59a687)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 /* static char sccsid[] = "@(#)0.h 1.14 03/29/82"; */
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 #define	continuation()	setpfx(' ')
166 
167 int	cgenflg;
168 
169 
170 /*
171  * The flag syneflg is used to suppress the diagnostics of the form
172  *	E 10 a, defined in someprocedure, is neither used nor set
173  * when there were syntax errors in "someprocedure".
174  * In this case, it is likely that these warinings would be spurious.
175  */
176 bool	syneflg;
177 
178 /*
179  * The compiler keeps its error messages in a file.
180  * The variable efil is the unit number on which
181  * this file is open for reading of error message text.
182  * Similarly, the file ofil is the unit of the file
183  * "obj" where we write the interpreter code.
184  */
185 short	efil;
186 short	ofil;
187 short	obuf[518];
188 
189 bool	Enoline;
190 #define	elineoff()	Enoline = TRUE
191 #define	elineon()	Enoline = FALSE
192 
193 
194 /*
195  * SYMBOL TABLE STRUCTURE DEFINITIONS
196  *
197  * The symbol table is henceforth referred to as the "namelist".
198  * It consists of a number of structures of the form "nl" below.
199  * These are contained in a number of segments of the symbol
200  * table which are dynamically allocated as needed.
201  * The major namelist manipulation routines are contained in the
202  * file "nl.c".
203  *
204  * The major components of a namelist entry are the "symbol", giving
205  * a pointer into the string table for the string associated with this
206  * entry and the "class" which tells which of the (currently 19)
207  * possible types of structure this is.
208  *
209  * Many of the classes use the "type" field for a pointer to the type
210  * which the entry has.
211  *
212  * Other pieces of information in more than one class include the block
213  * in which the symbol is defined, flags indicating whether the symbol
214  * has been used and whether it has been assigned to, etc.
215  *
216  * A more complete discussion of the features of the namelist is impossible
217  * here as it would be too voluminous.  Refer to the "PI 1.0 Implementation
218  * Notes" for more details.
219  */
220 
221 /*
222  * The basic namelist structure.
223  * There are also two other variants, defining the real
224  * field as longs or integers given below.
225  *
226  * The array disptab defines the hash header for the symbol table.
227  * Symbols are hashed based on the low 6 bits of their pointer into
228  * the string table; see the routines in the file "lookup.c" and also "fdec.c"
229  * especially "funcend".
230  */
231 extern struct	nl *Fp;
232 extern int	pnumcnt;
233 
234 #ifdef PTREE
235 #   include	"pTree.h"
236 #endif PTREE
237 struct	nl {
238 	char	*symbol;
239 	char	class, nl_flags;
240 #ifdef PC
241 	char	extra_flags;	/* for where things are */
242 #endif PC
243 	struct	nl *type;
244 	struct	nl *chain, *nl_next;
245 	int	value[5];
246 #	ifdef PTREE
247 	    pPointer	inTree;
248 #	endif PTREE
249 } *nlp, *disptab[077+1];
250 
251 extern struct nl nl[INL];
252 
253 struct {
254 	char	*symbol;
255 	char	class, nl_flags;
256 #ifdef PC
257 	char	extra_flags;
258 #endif
259 	struct	nl *type;
260 	struct	nl *chain, *nl_next;
261 	double	real;
262 };
263 
264 struct {
265 	char	*symbol;
266 	char	class, nl_block;
267 #ifdef PC
268 	char	extra_flags;
269 #endif
270 	struct	nl *type;
271 	struct	nl *chain, *nl_next;
272 	long	range[2];
273 };
274 
275 struct {
276 	char	*symbol;
277 	char	class, nl_flags;
278 #ifdef PC
279 	char	extra_flags;
280 #endif
281 	struct	nl *type;
282 	struct	nl *chain, *nl_next;
283 	int	*ptr[4];
284 #ifdef PI
285 	int	entloc;
286 #endif PI
287 };
288 
289 /*
290  * NL FLAGS BITS
291  *
292  * Definitions of the usage of the bits in
293  * the nl_flags byte. Note that the low 5 bits of the
294  * byte are the "nl_block" and that some classes make use
295  * of this byte as a "width".
296  *
297  * The only non-obvious bit definition here is "NFILES"
298  * which records whether a structure contains any files.
299  * Such structures are not allowed to be dynamically allocated.
300  */
301 
302 #define	BLOCKNO( flag )	( flag & 037 )
303 #define NLFLAGS( flag ) ( flag &~ 037 )
304 
305 #define	NUSED	0100
306 #define	NMOD	0040
307 #define	NFORWD	0200
308 #define	NFILES	0200
309 #ifdef PC
310 #define NEXTERN 0001	/* flag used to mark external funcs and procs */
311 #define	NLOCAL	0002	/* variable is a local */
312 #define	NPARAM	0004	/* variable is a parameter */
313 #define	NGLOBAL	0010	/* variable is a global */
314 #define	NREGVAR	0020	/* or'ed in if variable is in a register */
315 #endif PC
316 
317 /*
318  * used to mark value[ NL_FORV ] for loop variables
319  */
320 #define	FORVAR		1
321 
322 /*
323  * Definition of the commonly used "value" fields.
324  * The most important one is NL_OFFS which gives
325  * the offset of a variable in its stack mark.
326  */
327 #define NL_OFFS	0
328 
329 #define	NL_CNTR	1
330 #define NL_NLSTRT 2
331 #define	NL_LINENO 3
332 #define	NL_FVAR	3
333 #define	NL_FCHAIN 4
334 
335 #define NL_GOLEV 2
336 #define NL_GOLINE 3
337 #define NL_FORV 1
338 
339 #define	NL_FLDSZ 1
340 #define	NL_VARNT 2
341 #define	NL_VTOREC 2
342 #define	NL_TAG	3
343 
344 #define	NL_ELABEL	4
345 
346 /*
347  * For BADUSE nl structures, NL_KINDS is a bit vector
348  * indicating the kinds of illegal usages complained about
349  * so far.  For kind of bad use "kind", "1 << kind" is set.
350  * The low bit is reserved as ISUNDEF to indicate whether
351  * this identifier is totally undefined.
352  */
353 #define	NL_KINDS	0
354 
355 #define	ISUNDEF		1
356 
357     /*
358      *	variables come in three flavors: globals, parameters, locals;
359      *	they can also hide in registers, but that's a different flag
360      */
361 #define PARAMVAR	1
362 #define LOCALVAR	2
363 #define	GLOBALVAR	3
364 
365 /*
366  * NAMELIST CLASSES
367  *
368  * The following are the namelist classes.
369  * Different classes make use of the value fields
370  * of the namelist in different ways.
371  *
372  * The namelist should be redesigned by providing
373  * a number of structure definitions with one corresponding
374  * to each namelist class, ala a variant record in Pascal.
375  */
376 #define	BADUSE	0
377 #define	CONST	1
378 #define	TYPE	2
379 #define	VAR	3
380 #define	ARRAY	4
381 #define	PTRFILE	5
382 #define	RECORD	6
383 #define	FIELD	7
384 #define	PROC	8
385 #define	FUNC	9
386 #define	FVAR	10
387 #define	REF	11
388 #define	PTR	12
389 #define	FILET	13
390 #define	SET	14
391 #define	RANGE	15
392 #define	LABEL	16
393 #define	WITHPTR 17
394 #define	SCAL	18
395 #define	STR	19
396 #define	PROG	20
397 #define	IMPROPER 21
398 #define	VARNT	22
399 #define	FPROC	23
400 #define	FFUNC	24
401 
402 /*
403  * Clnames points to an array of names for the
404  * namelist classes.
405  */
406 char	**clnames;
407 
408 /*
409  * PRE-DEFINED NAMELIST OFFSETS
410  *
411  * The following are the namelist offsets for the
412  * primitive types. The ones which are negative
413  * don't actually exist, but are generated and tested
414  * internally. These definitions are sensitive to the
415  * initializations in nl.c.
416  */
417 #define	TFIRST -7
418 #define	TFILE  -7
419 #define	TREC   -6
420 #define	TARY   -5
421 #define	TSCAL  -4
422 #define	TPTR   -3
423 #define	TSET   -2
424 #define	TSTR   -1
425 #define	NIL	0
426 #define	TBOOL	1
427 #define	TCHAR	2
428 #define	TINT	3
429 #define	TDOUBLE	4
430 #define	TNIL	5
431 #define	T1INT	6
432 #define	T2INT	7
433 #define	T4INT	8
434 #define	T1CHAR	9
435 #define	T1BOOL	10
436 #define	T8REAL	11
437 #define TLAST	11
438 
439 /*
440  * SEMANTIC DEFINITIONS
441  */
442 
443 /*
444  * NOCON and SAWCON are flags in the tree telling whether
445  * a constant set is part of an expression.
446  *	these are no longer used,
447  *	since we now do constant sets at compile time.
448  */
449 #define NOCON	0
450 #define SAWCON	1
451 
452 /*
453  * The variable cbn gives the current block number,
454  * the variable bn is set as a side effect of a call to
455  * lookup, and is the block number of the variable which
456  * was found.
457  */
458 short	bn, cbn;
459 
460 /*
461  * The variable line is the current semantic
462  * line and is set in stat.c from the numbers
463  * embedded in statement type tree nodes.
464  */
465 short	line;
466 
467 /*
468  * The size of the display
469  * which defines the maximum nesting
470  * of procedures and functions allowed.
471  * Because of the flags in the current namelist
472  * this must be no greater than 32.
473  */
474 #define	DSPLYSZ 20
475 
476     /*
477      *	the display is made up of saved AP's and FP's.
478      *	FP's are used to find locals, and AP's are used to find parameters.
479      *	FP and AP are untyped pointers, but are used throughout as (char *).
480      *	the display is used by adding AP_OFFSET or FP_OFFSET to the
481      *	address of the approriate display entry.
482      */
483 struct dispsave {
484     char	*savedAP;
485     char	*savedFP;
486 } display[ DSPLYSZ ];
487 
488 #define	AP_OFFSET	( 0 )
489 #define FP_OFFSET	( sizeof(char *) )
490 
491     /*
492      *	formal routine structure:
493      */
494 struct formalrtn {
495 	long		(*fentryaddr)();	/* formal entry point */
496 	long		fbn;			/* block number of function */
497 	struct dispsave	fdisp[ DSPLYSZ ];	/* saved at first passing */
498 } frtn;
499 
500 #define	FENTRYOFFSET	0
501 #define FBNOFFSET	( FENTRYOFFSET + sizeof frtn.fentryaddr )
502 #define	FDISPOFFSET	( FBNOFFSET + sizeof frtn.fbn )
503 
504 /*
505  * The following structure is used
506  * to keep track of the amount of variable
507  * storage required by each block.
508  * "Max" is the high water mark, "off"
509  * the current need. Temporaries for "for"
510  * loops and "with" statements are allocated
511  * in the local variable area and these
512  * numbers are thereby changed if necessary.
513  */
514 struct om {
515 	long	om_max;
516 	long	reg_max;
517 	struct tmps {
518 		long	om_off;
519 		long	reg_off;
520 	} curtmps;
521 } sizes[DSPLYSZ];
522 #define NOREG 0
523 #define REGOK 1
524 
525     /*
526      *	the following structure records whether a level declares
527      *	any variables which are (or contain) files.
528      *	this so that the runtime routines for file cleanup can be invoked.
529      */
530 bool	dfiles[ DSPLYSZ ];
531 
532 /*
533  * Structure recording information about a constant
534  * declaration.  It is actually the return value from
535  * the routine "gconst", but since C doesn't support
536  * record valued functions, this is more convenient.
537  */
538 struct {
539 	struct nl	*ctype;
540 	short		cival;
541 	double		crval;
542 	int		*cpval;
543 } con;
544 
545 /*
546  * The set structure records the lower bound
547  * and upper bound with the lower bound normalized
548  * to zero when working with a set. It is set by
549  * the routine setran in var.c.
550  */
551 struct {
552 	short	lwrb, uprbp;
553 } set;
554 
555     /*
556      *	structures of this kind are filled in by precset and used by postcset
557      *	to indicate things about constant sets.
558      */
559 struct csetstr {
560     struct nl	*csettype;
561     long	paircnt;
562     long	singcnt;
563     bool	comptime;
564 };
565 /*
566  * The following flags are passed on calls to lvalue
567  * to indicate how the reference is to affect the usage
568  * information for the variable being referenced.
569  * MOD is used to set the NMOD flag in the namelist
570  * entry for the variable, ASGN permits diagnostics
571  * to be formed when a for variable is assigned to in
572  * the range of the loop.
573  */
574 #define	NOFLAGS	0
575 #define	MOD	01
576 #define	ASGN	02
577 #define	NOUSE	04
578 
579     /*
580      *	the following flags are passed to lvalue and rvalue
581      *	to tell them whether an lvalue or rvalue is required.
582      *	the semantics checking is done according to the function called,
583      *	but for pc, lvalue may put out an rvalue by indirecting afterwards,
584      *	and rvalue may stop short of putting out the indirection.
585      */
586 #define	LREQ	01
587 #define	RREQ	02
588 
589 double	MAXINT;
590 double	MININT;
591 
592 /*
593  * Variables for generation of profile information.
594  * Monflg is set when we want to generate a profile.
595  * Gocnt record the total number of goto's and
596  * cnts records the current counter for generating
597  * COUNT operators.
598  */
599 short	gocnt;
600 short	cnts;
601 
602 /*
603  * Most routines call "incompat" rather than asking "!compat"
604  * for historical reasons.
605  */
606 #define incompat 	!compat
607 
608 /*
609  * Parts records which declaration parts have been seen.
610  * The grammar allows the "label" "const" "type" "var" and routine
611  * parts to be repeated and to be in any order, so that
612  * they can be detected semantically to give better
613  * error diagnostics.
614  */
615 int	parts[ DSPLYSZ ];
616 
617 #define	LPRT	1
618 #define	CPRT	2
619 #define	TPRT	4
620 #define	VPRT	8
621 #define	RPRT	16
622 
623 /*
624  * Flags for the "you used / instead of div" diagnostic
625  */
626 bool	divchk;
627 bool	divflg;
628 
629 bool	errcnt[DSPLYSZ];
630 
631 /*
632  * Forechain links those types which are
633  *	^ sometype
634  * so that they can be evaluated later, permitting
635  * circular, recursive list structures to be defined.
636  */
637 struct	nl *forechain;
638 
639 /*
640  * Withlist links all the records which are currently
641  * opened scopes because of with statements.
642  */
643 struct	nl *withlist;
644 
645 struct	nl *intset;
646 struct	nl *input, *output;
647 struct	nl *program;
648 
649 /* progseen flag used by PC to determine if
650  * a routine segment is being compiled (and
651  * therefore no program statement seen)
652  */
653 bool	progseen;
654 
655 
656 /*
657  * STRUCTURED STATEMENT GOTO CHECKING
658  *
659  * The variable level keeps track of the current
660  * "structured statement level" when processing the statement
661  * body of blocks.  This is used in the detection of goto's into
662  * structured statements in a block.
663  *
664  * Each label's namelist entry contains two pieces of information
665  * related to this check. The first `NL_GOLEV' either contains
666  * the level at which the label was declared, `NOTYET' if the label
667  * has not yet been declared, or `DEAD' if the label is dead, i.e.
668  * if we have exited the level in which the label was defined.
669  *
670  * When we discover a "goto" statement, if the label has not
671  * been defined yet, then we record the current level and the current line
672  * for a later error check.  If the label has been already become "DEAD"
673  * then a reference to it is an error.  Now the compiler maintains,
674  * for each block, a linked list of the labels headed by "gotos[bn]".
675  * When we exit a structured level, we perform the routine
676  * ungoto in stat.c. It notices labels whose definition levels have been
677  * exited and makes them be dead. For labels which have not yet been
678  * defined, ungoto will maintain NL_GOLEV as the minimum structured level
679  * since the first usage of the label. It is not hard to see that the label
680  * must eventually be declared at this level or an outer level to this
681  * one or a goto into a structured statement will exist.
682  */
683 short	level;
684 struct	nl *gotos[DSPLYSZ];
685 
686 #define	NOTYET	10000
687 #define	DEAD	10000
688 
689 /*
690  * Noreach is true when the next statement will
691  * be unreachable unless something happens along
692  * (like exiting a looping construct) to save
693  * the day.
694  */
695 bool	noreach;
696 
697 /*
698  * UNDEFINED VARIABLE REFERENCE STRUCTURES
699  */
700 struct	udinfo {
701 	int	ud_line;
702 	struct	udinfo *ud_next;
703 	char	nullch;
704 };
705 
706 /*
707  * CODE GENERATION DEFINITIONS
708  */
709 
710 /*
711  * NSTAND is or'ed onto the abstract machine opcode
712  * for non-standard built-in procedures and functions.
713  */
714 #define	NSTAND	0400
715 
716 #define	codeon()	cgenflg++
717 #define	codeoff()	--cgenflg
718 #define	CGENNING	( cgenflg >= 0 )
719 
720 /*
721  * Codeline is the last lino output in the code generator.
722  * It used to be used to suppress LINO operators but no
723  * more since we now count statements.
724  * Lc is the intepreter code location counter.
725  *
726 short	codeline;
727  */
728 char	*lc;
729 
730 
731 /*
732  * Routines which need types
733  * other than "integer" to be
734  * assumed by the compiler.
735  */
736 double		atof();
737 long		lwidth();
738 long		leven();
739 long		aryconst();
740 long		a8tol();
741 long		roundup();
742 struct nl 	*tmpalloc();
743 struct nl 	*lookup();
744 double		atof();
745 int		*tree();
746 int		*hash();
747 char		*alloc();
748 int		*calloc();
749 char		*savestr();
750 char		*parnam();
751 bool		fcompat();
752 struct nl	*lookup1();
753 struct nl	*hdefnl();
754 struct nl	*defnl();
755 struct nl	*enter();
756 struct nl	*nlcopy();
757 struct nl	*tyrecl();
758 struct nl	*tyary();
759 struct nl	*fields();
760 struct nl	*variants();
761 struct nl	*deffld();
762 struct nl	*defvnt();
763 struct nl	*tyrec1();
764 struct nl	*reclook();
765 struct nl	*asgnop1();
766 struct nl	*gtype();
767 struct nl	*call();
768 struct nl	*lvalue();
769 struct nl	*rvalue();
770 struct nl	*cset();
771 
772 /*
773  * type cast NIL to keep lint happy (which is not so bad)
774  */
775 #define		NLNIL	( (struct nl *) NIL )
776 
777 /*
778  * Funny structures to use
779  * pointers in wild and wooly ways
780  */
781 struct {
782 	char	pchar;
783 };
784 struct {
785 	short	pint;
786 	short	pint2;
787 };
788 struct {
789 	long	plong;
790 };
791 struct {
792 	double	pdouble;
793 };
794 
795 #define	OCT	1
796 #define	HEX	2
797 
798 /*
799  * MAIN PROGRAM VARIABLES, MISCELLANY
800  */
801 
802 /*
803  * Variables forming a data base referencing
804  * the command line arguments with the "i" option, e.g.
805  * in "pi -i scanner.i compiler.p".
806  */
807 char	**pflist;
808 short	pflstc;
809 short	pfcnt;
810 
811 char	*filename;		/* current source file name */
812 long	tvec;
813 extern char	*snark;		/* SNARK */
814 extern char	*classes[ ];	/* maps namelist classes to string names */
815 
816 #define	derror error
817 
818 #ifdef	PC
819 
820     /*
821      *	the current function number, for [ lines
822      */
823     int	ftnno;
824 
825     /*
826      *	the pc output stream
827      */
828     FILE *pcstream;
829 
830 #endif PC
831