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