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