2.9BSD - /usr/src/ucb/pascal/pi/0.h

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

Defined variables

Defined struct's

Defined macros

Usage of this include