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