IMD 1.16: 6/09/2007 10:09:29 comp compiler   &lŗkm HBf     &  %C e U7F ?IO ERROR WHILE BOOTING? 7$ ?NOT ENOUGH CORE TO BOOT?   e   ևߕ vߕ 7| SYSTEM.PASCAL? w7b SYSTEM.INTERP? @Aw  `! mG~d!~  ^\F C& J&  0  EN  ~ W.TEXThA CHEDIT.TEXTh"SYSTEM.WRK.CODE MAN.TRITONh)d SURFACE.TEXThd _~U@pe5w E ŋw Ŋw C! @ D~̋   wTwDԤ eeW 7 ?YOU DON'T HAVE A  ߋt_v @ @  B  aBE B<V  wN E   U f  &7 V!  eN @@ >ZE L4U@ 7`6 BE 2B @ w`& COMPALCƿZ COMPGLBLS.TEXTn : COMPINIT.TEXT:ZDECPART.A.TEXTnZnDECPART.B.TEXTmnDECPART.C.TEXTlzBODYPART.A.TEXTYBODYPART.B.TEXTBODYPART.C.TEXTBODYPART.D.TEXTIBODYPART.E.TEXT$ UNITPART.TEXTl$B PROCS.A.TEXTnɝBT PROCS.B.TEXTnT` BLOCK.TEXTnɝ`d COMPILER.TEXTmʝd SMALL.PASCALn'L2.CODEl BINDER.TEXT*O^mf  *) (* *) (* RELEASE LEVEL: I.3 AUGUST, 1977 *) (* IDEC = 36; DEFSTRGLGTH = 80; LCAFTERMARKSTACK = 1; REFSPERBLK = 128; EOL = 13; MAXCURSOR = 1023; MAXCODE = 1299; .4 JANUARY, 1978 *) (* I.5 SEPTEMBER, 1978 *)  (* *) (* INSTITUTE FOR INFORMATION SYSTEMS  MAXJTAB = 24; MAXSEG = 15; MAXPROCNUM = 149; TYPE 1(*BASIC SYMBOLS, MUST MATCH ORDER IN IDSEARCH*) SYMBOL = (IDENT,CO *) (* UC SAN DIEGO, LA JOLLA, CA 92093 *) (* *) (* KENNETH L. BMMA,COLON,SEMICOLON,LPARENT,RPARENT,DOSY,TOSY, DOWNTOSY,ENDSY,UNTILSY,OFSY,THENSY,ELSESY,BECOMES,LBRACK, RBRACK,ARROW,PERIODOWLES, DIRECTOR *) (* *) (* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) (*  *) (************************************************)  TYPE PHYLE = FILE;  INFOREC = RECORD ,WORKSYM,WORKCODE: ^PHYLE; ,ERRSYM,ERRBLK,ERRNUM: INTEGER; ,SLOWTERM,STUPID: BOOLEAN; ,ALTMODE: CHAR *END; SEGMENT PROCEDURE USERPROGRAM; "SEGMENT PROCEDURE FILEHANDLER; "BEGIN END; "SEGMENT PROCEDURE DEBUGGER; "BEGIN END; "SEGMENT PROCEDURE PRINTERROR; "BEGIN END; " "SEGMENT PROCEDURE INITIALIZE; "BEGIN END; " "SEGMENT PROCEDURE GETCMD; "BEGIN END; " "SEGMENT PROCEDURE NOTUSED1; (*$U-*) PROGRAM PASCALSYSTEM; (* VERSION I.5 (Unit Compiler) 9-01-78 *) (************************************************) ("BEGIN END; " "SEGMENT PROCEDURE NOTUSED2; "BEGIN END; " "SEGMENT PROCEDURE NOTUSED3; "BEGIN END; " BEGIN END; (* USERPRO* *) (* UCSD PASCAL COMPILER *) (* GRAM *)   SEGMENT PROCEDURE PASCALCOMPILER(VAR USERINFO: INFOREC); CONST DISPLIMIT = 12; MAXLEVEL = 8; MAXADDR = 28000;  *) (* BASED ON ZURICH P2 PORTABLE *) (* COMPILER, EXTENSIVLY *) (* INTSIZE = 1; REALSIZE = 2; BITSPERWD = 16; CHARSIZE = 1; BOOLSIZE = 1; PTRSIZE = 1;  MODIFIED BY ROGER T. SUMNER *) (* SHAWN FANNING AND ALBERT A. HOFFMAN *)  (* 1976..1978  FILESIZE = 300; NILFILESIZE = 40; BITSPERCHR = 8; CHRSPERWD = 2; STRINGSIZE = 0; STRGLGTH = 255; MAXINT = 32767; MAX ST COMPLETELY OVERLAP FOLLOWING FIELDS*) 9REEL: (RVAL: REAL); PSET: (PVAL: SET OF 0..127); STRG: (SLGTH: 0..STRGLGTH;  IDTYPE: STP; NEXT: CTP; CASE KLASS: IDCLASS OF KONST: (VALUES: VALU); 0FORMALVARS, 0ACTUALVARS: (VLEV: LEVRAN SVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR) END; VALU = RECORD CASE BOOLEAN OF TRUE: (IVAL: INTEGER); GE; =VADDR: ADDRRANGE; =CASE BOOLEAN OF ?TRUE: (PUBLIC: BOOLEAN)); FIELD: (FLDADDR: ADDRRANGE; CASE FISPACKD:  FALSE: (VALP: CSP) END; (*DATA STRUCTURES*) BITRANGE = 0..BITSPERWD; OPRANGE = 0..80; CURSRANGE = 0BOOLEAN OF TRUE: (FLDRBIT,FLDWIDTH: BITRANGE)); PROC, FUNC: (CASE PFDECKIND: DECLKIND OF SPECI..MAXCURSOR; PROCRANGE = 0..MAXPROCNUM; LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR; JTABRANGE = 0..MAXJTAB; SEGRANAL: (KEY: INTEGER); STANDARD: (CSPNUM: INTEGER); DECLARED: (PFLEV: LEVRANGE; PFNAME: PROCRANGE; PGE = 0..MAXSEG; DISPRANGE = 0..DISPLIMIT; STRUCTFORM = (SCALAR,SUBRANGE,POINTER,LONGINT,POWER,ARRAYS, FSEG: SEGRANGE; CASE PFKIND: IDKIND OF JACTUAL: (LOCALLC: ADDRRANGE; SFORWDECL: BOOLEAN; SEXTURNAL: BOOLEAN; SINSCOPE: RECORDS,FILES,TAGFLD,VARIANT); DECLKIND = (STANDARD,DECLARED,SPECIAL); STP = ^ STRUCTURE; CTP = ^ IDENTIFIER;  BOOLEAN; SCASE BOOLEAN OF TTRUE: (IMPORTED:BOOLEAN)))); 3MODULE: (SEGID: INTEGER) 3END; WHERE = (BLCK,CREC,VREC,REC),BEGINSY,IFSY,CASESY,REPEATSY,WHILESY, FORSY,WITHSY,GOTOSY,LABELSY,CONSTSY,TYPESY,VARSY,PROCSY, 0FUNCSY,PROGSY,FORWARDSY,INTC STRUCTURE = RECORD SIZE: ADDRRANGE; CASE FORM: STRUCTFORM OF SCALAR: (CASE SCALKIND: DECLKIND OF DONST,REALCONST,STRINGCONST, 0NOTSY,MULOP,ADDOP,RELOP,SETSY,PACKEDSY,ARRAYSY,RECORDSY, 0FILESY,OTHERSY,LONGCONST,USESSY,UNITSY,ECLARED: (FCONST: CTP)); SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU); POINTER: (ELTYPE: STP); 5POWER: (ELSET: SINTERFACESY,IMPLESY, 0EXTERNALSY,SEPARATESY); OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP, GEOP,GTTP); ARRAYS: (AELTYPE,INXTYPE: STP; CASE AISPACKD:BOOLEAN OF TRUE: (ELSPERWD,ELWIDTH: BITRANGE; CASE AIOP,NEOP,EQOP,INOP,NOOP); SETOFSYS = SET OF SYMBOL; SSTRNG: BOOLEAN OF TRUE:(MAXLENG: 1..STRGLGTH))); RECORDS: (FSTFLD: CTP; RECVAR: STP); FILES: (FILTYPE: NONRESIDENT = (SEEK,FREADREAL,FWRITEREAL,FREADDEC,FWRITEDEC,DECOPS); %NONRESPFLIST = ARRAY[NONRESIDENT] OF INTEGER;   STP); TAGFLD: (TAGFIELDP: CTP; FSTVAR: STP); VARIANT: (NXTVAR,SUBVAR: STP; VARVAL: VALU) END; N(*CONSTANTS*) CSTCLASS = (REEL,PSET,STRG,TRIX,LONG); CSP = ^ CONSTREC; CONSTREC = RECORD CASE CCLASS: CSTCLASS O (*NAMES*) %IDCLASS = (TYPES,KONST,FORMALVARS,ACTUALVARS,FIELD, 0PROC,FUNC,MODULE); SETOFIDS = SET OF IDCLASS; IDKINF 9LONG: (LLENG,LLAST: INTEGER; @LONGVAL: ARRAY[1..9] OF INTEGER); TRIX: (CSTVAL: ARRAY [1..8] OF INTEGER); (*MUD = (ACTUAL,FORMAL); %ALPHA = PACKED ARRAY [1..8] OF CHAR; %IDENTIFIER = RECORD NAME: ALPHA; LLINK, RLINK: CTP;   CODELABEL = RECORD CASE DEFINED: BOOLEAN OF FALSE: (REFLIST: ADDRRANGE); TRUE: (OCCURIC: ADDRRANGE; JTABI (*LAST IDENTIFIER FOUND*) LGTH: INTEGER; (*LENGTH OF LAST STRING CONSTANT IN CHARS NX: JTABRANGE) END; LABELP = ^ USERLABEL; USERLABEL = RECORD LABVAL: INTEGER; NEXTLAB: LABELP; CODEFOR LEN OF LAST LONG INTEGER CONSTANT F IN DIGITS*) $VAL: VALU; (*VALUE OF LAST CONSTANT*) $DISX: DISPRLBP: LBP END; REFARRAY = ARRAY[1..REFSPERBLK] OF 2RECORD 4KEY,OFFSET: INTEGER 2END; 2 %CODEARRAY = PACKED ARRAY [0ANGE; (*LEVEL OF LAST ID SEARCHED*) $LCMAX: ADDRRANGE; (*TEMPORARIES LOCATION COUNTER*) ..MAXCODE] OF CHAR; SYMBUFARRAY = PACKED ARRAY [CURSRANGE] OF CHAR; %UNITFILE = (WORKCODE,SYSLIBRARY); % %LEXSTKRE(*SWITCHES:*) PRTERR,GOTOOK,RANGECHECK,DEBUGGING, $NOISY,CODEINSEG,IOCHECK,BPTONLINE, $CLINKERINFO,DLINKERINFO,LIST,TINY,C = RECORD 3DOLDTOP: DISPRANGE; 3DOLDLEV: 0..MAXLEVEL; 3POLDPROC,SOLDPROC: PROCRANGE; 3DOLDSEG: SEGRANGE; 3DLLC: ADDRRANGE;LSEPPROC, $DP,INCLUDING,USING,NOSWAP,SEPPROC, $STARTINGUP,INMODULE,ININTERFACE, $LIBNOTOPEN,SYSCOMP,PUBLICPROCS,GETSTMTLEV: B 3BFSY: SYMBOL; 3DFPROCP: CTP; 3DMARKP: ^INTEGER; 3ISSEGMENT: BOOLEAN; 3PREVLEXSTACKP: ^LEXSTKREC 1END; 1  OOLEAN; (*POINTERS:*) (*INTPTR,*)REALPTR,LONGINTPTR, CHARPTR,BOOLPTR, TEXTPTR,NILPTR, INTRACTVPTR,STRGP(*--------------------------------------------------------------------*) VAR CODEP: ^ CODEARRAY; (*CODE BUFFERTR: STP; (*POINTERS TO STANDARD IDS*) UTYPPTR,UCSTPTR,UVARPTR, UFLDPTR,UPRCPTR,UFCTPTR, (*POINTERS TO UNDE UNTIL WRITEOUT*) SYMBUFP: ^ SYMBUFARRAY; (*SYMBOLIC BUFFER...ASCII OR CODED*) GATTR: ATTR; CLARED IDS*) MODPTR,INPUTPTR,OUTPUTPTR, OUTERBLOCK,FWPTR,USINGLIST: CTP; $GLOBTESTP: TESTP; (*LAST TESTP(*DESCRIBES CURRENT EXPRESSION*) TOP: DISPRANGE; (*TOP OF DISPLAY*)  LC,IC: ADDRRANGE; (OINTER*) LEVEL: LEVRANGE; (*CURRENT STATIC LEVEL*) ; (*EXPRESSIONS*) ATTRKIND = (CST,VARBL,EXPR); VACCESS = (DRCT,INDRCT,PACKD,MULTI,BYTE); ATTR = RECO*LOCATION AND INSTRUCT COUNTERS*)  TEST: BOOLEAN; $INTPTR: STP; (*POINTER TO STANDARD INTEGER TYPE*) $RD TYPTR: STP; CASE KIND: ATTRKIND OF CST: (CVAL: VALU); VARBL: (CASE ACCESS: VACCESS OF SEG: SEGRANGE; (*CURRENT SEGMENT NO.*) D(*SCANNER GLOBALS...NEXT FOUR VARS*) (*MUST BE IN THIS ORDER F DRCT: (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE); INDRCT: (IDPLMT: ADDRRANGE)) END; TESTP = ^ TESTPOINTER; OR IDSEARCH*) SYMCURSOR: CURSRANGE; (*CURRENT SCANNING INDEX IN SYMBUFP^*) SY: SYMBOL; (*S TESTPOINTER = RECORD ELT1,ELT2 : STP; LASTTESTP : TESTP END; (*LABELS*) LBP = ^ CODELABEL; YMBOL FOUND BY INSYMBOL*) OP: OPERATOR; (*CLASSIFICATION OF LAST SYMBOL*) ID: ALPHA;  $TOS: ^LEXSTKREC; (*TOP OF LEX STACK*) $GLEV: DISPRANGE; (*GLOBAL LEVEL OF DISPLAY*) $NEWBLOCK:   PROCEDURE ERROR(ERRORNUM: INTEGER); "FORWARD;  PROCEDURE GETNEXTPAGE; "FORWARD;  PROCEDURE PRINTLINE; "FORWARD;  PROCEDBOOLEAN; (*INDICATES NEED TO PUSH LEX STACK*) $ NEXTSEG: SEGRANGE; (*NEXT SEGMENT #*) SEGINX:URE ENTERID(FCP: CTP); "FORWARD;  PROCEDURE INSYMBOL; "FORWARD; "  INTEGER; (*CURRENT INDEX IN SEGMENT*) SCONST: CSP; (*INSYMBOL STRING RESULTS*) LOWTI (* FORWARD DECLARED PROCEDURES USED IN BOTH DECLARATIONPART AND BODYPART *)   PROCEDURE SEARCHSECTION(FCP:CTP; VAR FCP1: CTME,LINEINFO,SCREENDOTS,STARTDOTS,SYMBLK,SMALLESTSPACE: INTEGER; LINESTART: CURSRANGE; CURPROC,NEXTPROC: PROCRANGE; P); "FORWARD;  PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP); "FORWARD;  PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: I(*PROCEDURE NUMBER ASSIGNMENT*) CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS, $BLOCKBEGSYS,SELECTSYS,FACBEGSYS,STATBEGSYS,TYPEDELNTEGER); "FORWARD;  PROCEDURE SKIP(FSYS: SETOFSYS); "FORWARD;  FUNCTION PAOFCHAR(FSP: STP): BOOLEAN; "FORWARD;  FUNCTION SS: SETOFSYS; VARS: SETOFIDS;  DISPLAY: ARRAY [DISPRANGE] OF RECORD FNAME: CTP; CASE OCCUR: WHERE OF BLTRGTYPE(FSP: STP): BOOLEAN; "FORWARD;  FUNCTION DECSIZE(I: INTEGER): INTEGER; "FORWARD;  PROCEDURE CONSTANT(FSYS: SETOFSYS; CK: (FFILE: CTP; FLABEL: LABELP); CREC: (CLEV: LEVRANGE; CDSPL: ADDRRANGE); VREC: (VDSPL: ADDRRANGE) END; VAR FSP: STP; VAR FVALU: VALU); "FORWARD;  FUNCTION COMPTYPES(FSP1,FSP2: STP): BOOLEAN; "FORWARD;  PROCEDURE GENBYTE(FBYTE:  PFNUMOF: NONRESPFLIST; $ $PROCTABLE: ARRAY [PROCRANGE] OF INTEGER; SEGTABLE: ARRAY [SEGRANGE] OF RECORD DISKADDINTEGER); "FORWARD;  PROCEDURE GENWORD(FWORD: INTEGER); "FORWARD;  PROCEDURE WRITETEXT; "FORWARD;  PROCEDURE WRITECODE(FORR,CODELENG: INTEGER; SEGNAME: ALPHA; 2SEGKIND, 2TEXTADDR: INTEGER END (*SEGTABLE*) ; COMMENT: ^STRING; $SYSTEMLIB:CEBUF: BOOLEAN); "FORWARD;  PROCEDURE BLOCK(FSYS: SETOFSYS); "FORWARD; "  STRING[40]; $NEXTJTAB: JTABRANGE; $JTAB: ARRAY [JTABRANGE] OF INTEGER; $ $REFFILE: FILE; $NREFS,REFBLK: INTEGER; $REFLIST: ^REFARRAY; $OLDSYMBLK,PREVSYMBLK: INTEGER; $OLDSYMCURSOR,OLDLINESTART,PREVSYMCURSOR,PREVLINESTART: CURSRANGE; $USEFILE: UNIO^TFILE; $INCLFILE,LIBRARY: FILE; $LP: TEXT; $ $CURBYTE, CURBLK: INTEGER; $DISKBUF: PACKED ARRAY [0..511] OF CHAR; $  (*--- BEGSTMTLEV,STMTLEV: INTEGER; (*CURRENT STATEMENT NESTING LEVEL*) $MARKP: ^INTEGER; (*FOR MARKING HEAP*) -----------------------------------------------------------------*)   (* FORWARD DECLARED PROCEDURES NEEDED BY COMPINIT *)   R; SCALKIND := DECLARED END; NEW(NILPTR,POINTER); WITH NILPTR^ DO BEGIN SIZE := PTRSIZE; FORM := POINTER; ELTYPE :N NAME := 'INTERACT'; IDTYPE := INTRACTVPTR; KLASS := TYPES END; ENTERID(CP); NEW(INPUTPTR,FORMALVARS,FALSE); WITH I= NIL END; NEW(TEXTPTR,FILES); WITH TEXTPTR^ DO BEGIN SIZE := FILESIZE+CHARSIZE; FORM := FILES; FILTYPE := CHARPTRNPUTPTR^ DO BEGIN NAME := 'INPUT '; IDTYPE := TEXTPTR; KLASS := FORMALVARS; VLEV := 0; VADDR := 2 END; ENTERI END; NEW(INTRACTVPTR,FILES); WITH INTRACTVPTR^ DO  BEGIN SIZE := FILESIZE+CHARSIZE; FORM := FILES; FILTYPE := CHARPTR END; NEW(STRGPTR,ARRAYS,TRUE,TRUE); WITH STRGPTR^ DO BEGIN FORM := ARRAYS; SIZE := (DEFSTRGLGTH + CHRSPERWD) DIV CHRSPERWD; AISPACKD := TRUE; AISSTRNG := TRUE; INXTYPE := INTPTR; ELWIDTH := BITSPERCHR; ELSPERWD := CHRSPERWD; AELTYPE := CHARPTR; MAXLENG := DEFSTRGLGTH; END END (*ENTSTDTYPES*) ; PROCEDURE ENTSTDNAMES; VAR CP,CP1: CTP; I: INTEGER; BEGIN NEW(CP,TYPES); WITH CP^ DO BEGIN NAME := 'INTEGER '; IDTYPE := INTPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES); WITH CP^ DO BEGIN NAME := 'RE  SEGMENT PROCEDURE COMPINIT; " "PROCEDURE ENTSTDTYPES; BEGIN NEW(INTPTR,SCALAR,STANDARD); WITH INTPTR^ DO AL '; IDTYPE := REALPTR; KLASS := TYPES END; ENTERID(CP); $NEW(CP,TYPES); WITH CP^ DO BEGIN NAME := 'CHAR 'BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := STANDARD END; NEW(REALPTR,SCALAR,STANDARD); WITH REALPTR^ DO BE; IDTYPE := CHARPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES); WITH CP^ DO BEGIN NAME := 'BOOLEAN '; IDTGIN SIZE := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END; NEW(LONGINTPTR,LONGINT); $WITH LONGINTPTR^ DO &BEGIN SIZE YPE := BOOLPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES); WITH CP^ DO := INTSIZE; FORM := LONGINT END; $NEW(CHARPTR,SCALAR,STANDARD); WITH CHARPTR^ DO BEGIN SIZE := CHARSIZE; FORM := SCAL BEGIN NAME := 'STRING '; IDTYPE := STRGPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES); WITH CP^ DO AR; SCALKIND := STANDARD END; NEW(BOOLPTR,SCALAR,DECLARED); WITH BOOLPTR^ DO BEGIN SIZE := BOOLSIZE; FORM := SCALA BEGIN NAME := 'TEXT '; IDTYPE := TEXTPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES); WITH CP^ DO BEGI TSTDNAMES*) ; PROCEDURE ENTUNDECL; BEGIN NEW(UTYPPTR,TYPES); WITH UTYPPTR^ DO BEGIN NAME := ' '; IDTYP'NEW '; NA[13] := 'UNITREAD'; NA[14] := 'UNITWRIT'; NA[15] := 'CONCAT '; NA[16] := 'LENGTH '; NA[17] := 'INSERT 'E := NIL; KLASS := TYPES END; NEW(UCSTPTR,KONST); WITH UCSTPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; NEXT :; NA[18] := 'DELETE '; NA[19] := 'COPY '; NA[20] := 'POS '; NA[21] := 'MOVELEFT'; NA[22] := 'MOVERIGH'; NA[23] := NIL; VALUES.IVAL := 0; KLASS := KONST END; NEW(UVARPTR,ACTUALVARS,FALSE); WITH UVARPTR^ DO BEGIN NAME := = 'EXIT '; NA[24] := 'IDSEARCH'; NA[25] := 'TREESEAR'; NA[26] := 'TIME '; NA[27] := 'FILLCHAR'; NA[28] := 'OPENNEW' '; IDTYPE := NIL; NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := ACTUALVARS END; NEW(UFLDPTR,FIELD);  '; NA[29] := 'OPENOLD '; NA[30] := 'REWRITE '; NA[31] := 'CLOSE '; NA[32] := 'SEEK '; NA[33] := 'RESET '; NA[34] WITH UFLDPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0; KLASS := FIELD END; NE := 'GET '; NA[35] := 'PUT '; NA[36] := 'SCAN '; NA[37] := 'BLOCKREA'; NA[38] := 'BLOCKWRI'; NA[39] := 'TRUNC 'D(INPUTPTR); NEW(OUTPUTPTR,FORMALVARS,FALSE); WITH OUTPUTPTR^ DO BEGIN NAME := 'OUTPUT '; IDTYPE := TEXTPTR; KLASW(UPRCPTR,PROC,DECLARED,ACTUAL,FALSE); WITH UPRCPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; FORWDECL := FALSE; NS := FORMALVARS; (VLEV := 0; VADDR := 3 END; ENTERID(OUTPUTPTR); NEW(CP,FORMALVARS,FALSE); WITH CP^ DO EXT := NIL; INSCOPE := FALSE; LOCALLC := 0; EXTURNAL := FALSE; PFLEV := 0; PFNAME := 0; PFSEG := 0; KLASS := PROC; PFDECKIND :BEGIN NAME := 'KEYBOARD'; IDTYPE := TEXTPTR; KLASS := FORMALVARS; VLEV := 0; VADDR := 4 END; ENTERID(CP); CP1 := = DECLARED; PFKIND := ACTUAL END; NEW(UFCTPTR,FUNC,DECLARED,ACTUAL,FALSE); WITH UFCTPTR^ DO BEGIN NAME := ' NIL; FOR I := 0 TO 1 DO BEGIN NEW(CP,KONST); WITH CP^ DO BEGIN IDTYPE := BOOLPTR;  '; IDTYPE := NIL; NEXT := NIL; FORWDECL := FALSE; EXTURNAL := FALSE; INSCOPE := FALSE; LOCALLC := 0; PFLEV := 0; PFNAME IF I = 0 THEN NAME := 'FALSE ' ELSE NAME := 'TRUE '; NEXT := CP1; VALUES.IVAL := I; KLASS := KONST END;  := 0; PFSEG := 0; KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL END END (*ENTUNDECL*) ; PROCEDURE ENTSPCPRENTERID(CP); CP1 := CP END; BOOLPTR^.FCONST := CP; NEW(CP,KONST); WITH CP^ DO BEGIN NAME := 'NIL '; OCS; LABEL 1; VAR LCP: CTP; I: INTEGER; ISFUNC: BOOLEAN; NA: ARRAY [1..43] OF ALPHA; BEGIN NA[ 1] := 'READ '; IDTYPE := NILPTR; NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST END; ENTERID(CP); NEW(CP,KONST); WITH CP^ DO NA[ 2] := 'READLN '; NA[ 3] := 'WRITE '; NA[ 4] := 'WRITELN '; NA[ 5] := 'EOF '; NA[ 6] := 'EOLN ';  BEGIN NAME := 'MAXINT '; IDTYPE := INTPTR; KLASS := KONST; VALUES.IVAL := MAXINT END; ENTERID(CP); "END (*EN NA[ 7] := 'PRED '; NA[ 8] := 'SUCC '; NA[ 9] := 'ORD '; NA[10] := 'SQR '; NA[11] := 'ABS '; NA[12] :=  CP,PARAM: CTP; LSP,FTYPE: STP; I: INTEGER; ISPROC: BOOLEAN; NA: ARRAY [1..19] OF ALPHA; BEGIN NA[ 1] := 'ODD '; NA[ 2 BEGIN NAME := NA[I]; PFDECKIND := STANDARD; CSPNUM := I + 20; IF ISPROC THEN KLASS := PROC ELSE KLASS := FUNC; IF P] := 'CHR '; NA[ 3] := 'MEMAVAIL'; NA[ 4] := 'ROUND '; NA[ 5] := 'SIN '; NA[ 6] := 'COS '; NA[ 7] := 'LOG ARAM <> NIL THEN PARAM^.NEXT := NIL; IDTYPE := FTYPE; NEXT := PARAM END; ENTERID(LCP) END END (*ENTSTDPROCS*) '; NA[ 8] := 'ATAN '; NA[ 9] := 'LN '; NA[10] := 'EXP '; NA[11] := 'SQRT '; NA[12] := 'MARK '; NA[ ; PROCEDURE INITSCALARS; #VAR I: NONRESIDENT; "BEGIN $FWPTR := NIL; MODPTR := NIL; GLOBTESTP := NIL; LINESTART := 0; 13] := 'RELEASE '; NA[14] := 'IORESULT'; NA[15] := 'UNITBUSY'; NA[16] := 'PWROFTEN'; NA[17] := 'UNITWAIT'; NA[18] := 'UNITCLLINEINFO := LCAFTERMARKSTACK; LIST := FALSE; SYMBLK := 2; SCREENDOTS := 0; STARTDOTS := 0; FOR SEG := 0 TO MAXSEG DO EA'; NA[19] := 'HALT '; FOR I := 1 TO 19 DO BEGIN ISPROC := I IN [12,13,17,18,19]; CASE I OF  WITH SEGTABLE[SEG] DO BEGIN DISKADDR := 0; CODELENG := 0; SEGNAME := ' '; *SEGKIND := 0; TEXTADDR := 0 (END; US 1: BEGIN FTYPE := BOOLPTR; NEW(PARAM,ACTUALVARS,FALSE); 0WITH PARAM^ DO 2BEGIN IDTYPE := INTPTR; KLASS := ACTUALVARS END INGLIST := NIL; $IF USERINFO.STUPID THEN SYSTEMLIB := '*SYSTEM.PASCAL' $ELSE SYSTEMLIB := '*SYSTEM.LIBRARY'; $LC := LCAFTERMA END; 2: FTYPE := CHARPTR; *3: BEGIN FTYPE := INTPTR; PARAM := NIL END; *4: BEGIN FTYPE := INTPTR; NEW(PARAM,ACTUALRKSTACK; IOCHECK := TRUE; DP := TRUE; SEGINX := 0; NEXTJTAB := 1; NEXTPROC := 2; CURPROC := 1; NEW(SCONST); NEW(SYMBUFP)VARS,FALSE); 0WITH PARAM^ DO BEGIN IDTYPE := REALPTR; KLASS := ACTUALVARS END .END; *5: FTYPE := REALPTR; 12: BEGIN FTYPE; NEW(CODEP); $CLINKERINFO := FALSE; DLINKERINFO := FALSE; ; NA[40] := 'PAGE '; NA[41] := 'SIZEOF '; NA[42] := 'STR '; NA[43] := 'GOTOXY '; $FOR I := 1 TO 43 DO BE := NIL; NEW(PARAM,FORMALVARS,FALSE); NEW(LSP,POINTER); 0WITH LSP^ DO 2BEGIN SIZE := PTRSIZE; FORM := POINTER; ELTYPE := NIL EGIN IF TINY THEN ,IF I IN [2,7,8,10,13,17,18,19,20,32,34,35,40,42,43] THEN .GOTO 1; ND; 0WITH PARAM^ DO BEGIN IDTYPE := LSP; KLASS := FORMALVARS END END; 14: BEGIN FTYPE := INTPTR; PARAM := NIL END; (ISFUNC := I IN [5,6,7,8,9,10,11,15,16,19,20,25,36,37,38,39,41]; (IF ISFUNC THEN NEW(LCP,FUNC,SPECIAL) ELSE NEW(LCP,PROC,SPEC15: BEGIN FTYPE := BOOLPTR; NEW(PARAM,ACTUALVARS,FALSE); WITH PARAM^ DO BEGIN IDTYPE := INTPTR; KLASS := ACTUALVARS ENIAL); WITH LCP^ DO BEGIN NAME := NA[I]; NEXT := NIL; IDTYPE := NIL; IF ISFUNC THEN KLASS := FUNC ELSE KLASS := PROC; D; END; 16: FTYPE := REALPTR; 17: FTYPE := NIL; 19: BEGIN FTYPE := NIL; PARAM := NIL END END (*PARAM AND TYPE C PFDECKIND := SPECIAL; KEY := I END; ENTERID(LCP);  1: END END (*ENTSPCPROCS*) ; PROCEDURE ENTSTDPROCS; $VAR LASES*) ; IF ISPROC THEN NEW(LCP,PROC,STANDARD) ELSE NEW(LCP,FUNC,STANDARD); WITH LCP^ DO  ECK := TRUE; SYSCOMP := FALSE; TINY := FALSE; CODEINSEG := FALSE; PRTERR := TRUE; INCLUDING := FALSE; USING := FALSE; FO LC := LC+2; GLEV := 3; (*KEEP STACK STRAIGHT FOR NOW*) NEW(OUTERBLOCK,PROC,DECLARED,ACTUAL,FALSE); R I := SEEK TO DECOPS DO PFNUMOF[I] := 0; $COMMENT := NIL; LIBNOTOPEN := TRUE; $GETSTMTLEV := TRUE; BEGSTMTLEV := 0 "END (*IN WITH OUTERBLOCK^ DO BEGIN NEXT := NIL; LOCALLC := LC; NAME := 'PROGRAM '; IDTYPE := NIL; KLASS := PROC; PFDECKIND :ITSCALARS*) ; PROCEDURE INITSETS; BEGIN CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT]; SIMPTYPEBEGSYS= DECLARED; PFLEV := 0; PFNAME := 1; PFSEG := SEG; PFKIND := ACTUAL; FORWDECL := FALSE; EXTURNAL := FALSE; *INSCOPE := TRUE  := [LPARENT] + CONSTBEGSYS; TYPEBEGSYS := [ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY] + SIMPTYPEBEGSYS; TYPEDELS END END; "IF SY = PROGSY THEN $BEGIN INSYMBOL; &IF SY = IDENT THEN (BEGIN SEGTABLE[SEG].SEGNAME := ID; *IF OUTERBLOCK  := [ARRAYSY,RECORDSY,SETSY,FILESY]; $BLOCKBEGSYS := [USESSY,LABELSY,CONSTSY,TYPESY,VARSY, 4PROCSY,FUNCSY,PROGSY,BEGINSY]; <> NIL THEN ,BEGIN .OUTERBLOCK^.NAME := ID; .ENTERID(OUTERBLOCK) (*ALLOWS EXIT ON PROGRAM NAME*) ,END (END &ELSE ERROR(2); SELECTSYS := [ARROW,PERIOD,LBRACK]; FACBEGSYS := [INTCONST,REALCONST,LONGCONST,STRINGCONST,IDENT,  INSYMBOL; &IF SY = LPARENT THEN (BEGIN *REPEAT INSYMBOL *UNTIL SY IN [RPARENT,SEMICOLON]+BLOCKBEGSYS; *IF SY = RPARENT THE2LPARENT,LBRACK,NOTSY]; STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY,CASESY]; VARS := [FORMALVARS,AN INSYMBOL ELSE ERROR(4) (END; &IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14) $END; "MARK(MARKP); "NEW(TOS); "WITH TOS^ DCTUALVARS] "END (*INITSETS*) ; BEGIN (*COMPINIT*) INITSCALARS; INITSETS; LEVEL := 0; TOP := 0; IF NOISY THEN BEGIN O (*MAKE LEXSTKREC FOR OUTERBLOCK*) $BEGIN &PREVLEXSTACKP:=NIL; &BFSY:=PERIOD; &DFPROCP:=OUTERBLOCK; &DLLC:=LC; &DOLDLEV: FOR IC := 1 TO 7 DO WRITELN(OUTPUT); WRITELN(OUTPUT,'PASCAL Compiler [I.5] (Unit Compiler)'); &WRITE(OUTPUT,'< 0=LEVEL; &DOLDTOP:=TOP; &POLDPROC:=CURPROC; &ISSEGMENT:=FALSE; &DMARKP:=MARKP; $END;  END (*COMPINIT*) ; >') END; WITH DISPLAY[0] DO BEGIN FNAME := NIL; FFILE := NIL; FLABEL := NIL; OCCUR := BLCK END; SMALLESTSPACE:=MEMAVO^AIL; "GETNEXTPAGE; INSYMBOL; ENTSTDTYPES; ENTSTDNAMES; ENTUNDECL; ENTSPCPROCS; ENTSTDPROCS; IF SYSCOMP THEN Bɜ SEG := 1; NEXTSEG := 10; CURBLK := 1; CURBYTE := 0; LSEPPROC := FALSE; STARTINGUP := TRUE; NOISY := NOT USERINFO.SLOWTEREGIN OUTERBLOCK := NIL; SEG := 0; NEXTSEG := 1; &GLEV :=1; BLOCKBEGSYS := BLOCKBEGSYS + [UNITSY,SEPARATESY] $END ELSE BEM; SEPPROC := FALSE; NOSWAP := TRUE; DEBUGGING := FALSE; BPTONLINE := FALSE; INMODULE := FALSE; GOTOOK := FALSE; RANGECHGIN TOP := 1; LEVEL := 1; WITH DISPLAY[1] DO BEGIN FNAME := NIL; FFILE := NIL; FLABEL := NIL; OCCUR := BLCK END;  Y IN SIMPTYPEBEGSYS THEN BEGIN IF SY = LPARENT THEN BEGIN TTOP := TOP; WHILE DISPLAY[TOP].OCCUR <> BLCK DO TOP : BEGIN ERROR(203); LVALU.IVAL := DEFSTRGLGTH END; IF LVALU.IVAL <> DEFSTRGLGTH THEN BEGIN NEW(LSP,ARRAYS= TOP - 1; NEW(LSP,SCALAR,DECLARED); WITH LSP^ DO BEGIN SIZE := INTSIZE; FORM := SCALAR;  SCALKIND := DECLARED END; LCP1 := NIL; LCNT := 0; REPEAT INSYMBOL; IF SY = IDENT THEN BEGIN NEW(LCP,KONST); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := LSP; NEXT := LCP1; VALUES.IVAL := LCNT; KLASS := KONST END; ENTERID(LCP); LCNT := LCNT + 1; LCP1 := LCP; INSYMBOL END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END UNTIL SY <> COMMA; LSP^.FCONST := LCP1; TOP := TTOP; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END ELSE BEGIN IF SY = IDENT THEN BEGIN SEARC (* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *)  SEGMENT PROCEDURE DECLARATIONPART(FHID([TYPES,KONST],LCP); INSYMBOL; IF LCP^.KLASS = KONST THEN BEGIN NEW(LSP,SUBRANGE); WITH LSP^, LCP^ DO SYS: SETOFSYS);  VAR LSY: SYMBOL; $NOTDONE: BOOLEAN; $DUMMYVAR: ARRAY[0..0] OF INTEGER; (*FOR PRETTY DISPLAY OF STACK AND HEA BEGIN RANGETYPE := IDTYPE; FORM := SUBRANGE; IF STRGTYPE(RANGETYPE) THEN BEGIN ERROR(148); RANGETYPE := NIL END; P *)  PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: STP; VAR FSIZE: ADDRRANGE); VAR LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: MIN := VALUES; SIZE := INTSIZE END; IF SY = COLON THEN INSYMBOL ELSE ERROR(5);  CTP; LSIZE,DISPL: ADDRRANGE; LMIN,LMAX: INTEGER; PACKING: BOOLEAN; NEXTBIT,NUMBITS: BITRANGE; PROCEDURE SIMPLETYPE(FSYS: CONSTANT(FSYS,LSP1,LVALU); LSP^.MAX := LVALU; IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107) END ELSETOFSYS; VAR FSP:STP; VAR FSIZE:ADDRRANGE); VAR LSP,LSP1: STP; LCP,LCP1: CTP; TTOP: DISPRANGE; LCNT: INTEGER; LVALU: VSE BEGIN LSP := LCP^.IDTYPE; IF (LSP = STRGPTR) AND (SY = LBRACK) THEN BEGIN INSYMBOL; CONSTANT(FSYS + [RBALU; BEGIN FSIZE := 1; IF NOT (SY IN SIMPTYPEBEGSYS) THEN BEGIN ERROR(1); SKIP(FSYS + SIMPTYPEBEGSYS) END; IF SRACK],LSP1,LVALU); IF LSP1 = INTPTR THEN BEGIN IF (LVALU.IVAL <= 0) OR (LVALU.IVAL > STRGLGTH) THEN  := LVALU; IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107) END; IF LSP <> NIL THEN WITH LSP^ DO IF FORM = SUBRANGE TSPERWD THEN BEGIN DISPL := DISPL + 1; NEXTBIT := 0; ONBOUND := TRUE END; FLDADDR := DISPL; FISPACKD := TRUE; FLDHEN IF RANGETYPE <> NIL THEN IF RANGETYPE = REALPTR THEN ERROR(399) ELSE IF MIN.IVAL > MAX.IVAL THEN WIDTH := NUMBITS; FLDRBIT := NEXTBIT; NEXTBIT := NEXTBIT + NUMBITS END ELSE BEGIN DISPL := DISPL + ORD(NEXTB BEGIN ERROR(102); MAX.IVAL := MIN.IVAL END END; FSP := LSP; IF NOT (SY IN FSYS) THEN IT > 0); NEXTBIT := 0; ONBOUND := TRUE; FISPACKD := FALSE; FLDADDR := DISPL; IF IDTYPE <> NIL THEN DISPL  BEGIN ERROR(6); SKIP(FSYS) END END ELSE FSP := NIL END (*SIMPLETYPE*) ; FUNCTION PACKABLE(FSP: STP): BOOLEAN; := DISPL + IDTYPE^.SIZE END; IF ONBOUND AND (LAST <> NIL) THEN WITH LAST^ DO IF FISPACKD THEN IF FLDRBIT = ,TRUE,TRUE); LSP^ := STRGPTR^; WITH LSP^,LVALU DO BEGIN MAXLENG := IVAL; SIZE := (IVAL+CHRSPERWD)  VAR LMIN,LMAX: INTEGER; BEGIN PACKABLE := FALSE; IF (FSP <> NIL) AND PACKING THEN WITH FSP^ DO CASE FORM OF DIV CHRSPERWD END END END ELSE ERROR(15); IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12) END 6ELSE SUBRANGE, SCALAR: IF (FSP <> INTPTR) AND (FSP <> REALPTR) THEN BEGIN GETBOUNDS(FSP,LMIN,LMAX); IF LMIN > 8IF LSP = INTPTR THEN :IF SY = LBRACK THEN NEW(LSP,LONGINT); >LSP^ := LONGINTPTR^; >CONSTANT(FSYS + [RB= 0 THEN BEGIN PACKABLE := TRUE; NUMBITS := 1; LMIN := 1; WHILE LMIN < LMAX DO BEGIN LMIN := LMIRACK],LSP1,LVALU); >IF LSP1 = INTPTR THEN @IF (LVALU.IVAL <= 0) OR C(LVALU.IVAL > MAXDEC) THEN ERROR(203) @ELSE N + 1; LMIN := LMIN + LMIN - 1; NUMBITS := NUMBITS + 1 END END END; POWER: IF PACKABLEBLSP^.SIZE := DECSIZE(LVALU.IVAL) >ELSE ERROR(15); >IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12); IF INMODULE THEN @IF NOT ININTERFACE THEN @ ERROR(191); (*NO PRIVATE FILES*) IF LSP <> NIL THEN FSIZE:= TRUE; NUMBITS := LMAX END END END (* CASES *); END (*PACKABLE*) ; PROCEDURE FIELDLIST(FSYS := LSP^.SIZE END END (*SY = IDENT*) ELSE BEGIN NEW(LSP,SUBRANGE); LSP^.FORM := SUBRANGE; CONSTANT(FSYS + [: SETOFSYS; VAR FRECVAR: STP); VAR LCP,LCP1,NXT,NXT1,LAST: CTP; LSP,LSP1,LSP2,LSP3,LSP4: STP; COLON],LSP1,LVALU); IF STRGTYPE(LSP1) THEN BEGIN ERROR(148); LSP1 := NIL END; WITH LSP^ DO BEGIN RANGETYPE:= MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU; MAXBIT,MINBIT: BITRANGE; PROCEDURE ALLOCATE(FCP: CTP); VAR ONBOUND:LSP1; MIN:=LVALU; SIZE:=INTSIZE END; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); CONSTANT(FSYS,LSP1,LVALU); LSP^.MAX  BOOLEAN; BEGIN ONBOUND := FALSE; WITH FCP^ DO IF PACKABLE(IDTYPE) THEN BEGIN IF (NUMBITS + NEXTBIT) > BIT  OL ELSE ERROR(5) END; IF SY = IDENT THEN BEGIN SEARCHID([TYPES],LCP1); LSP1 := LCP1^.IDTYPE; IF LSP1 <> N LSP3 := LSP4 END; IF SY = RPARENT THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [SEMICOLON]) THEN BEGIN EIL THEN BEGIN IF LSP1^.FORM <= SUBRANGE THEN BEGIN IF COMPTYPES(REALPTR,LSP1) THEN ERROR(109); LCP^.IDTYRROR(6); SKIP(FSYS + [SEMICOLON]) END END ELSE ERROR(4); TEST := SY <> SEMICOLON; IF NOT TEST THEN BEGIN INSYPE := LSP1; LSP^.TAGFIELDP := LCP; IF GOTTAGNAME THEN ALLOCATE(LCP) END ELSE ERROR(110) END; INSYMBOL MBOL; DISPL := MINSIZE; NEXTBIT := MINBIT END UNTIL (TEST) OR (SY = ENDSY); (* <<<< SMF 2-28-78 *) DISPL := MAXSIZ END ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END END E; NEXTBIT := MAXBIT; LSP^.FSTVAR := LSP1 END (*VARIANTLIST*) ; BEGIN (*FIELDLIST*) NXT1 := NIL; LSP := NIL; L ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END; LSP^.SIZE := DISPL + ORD(NEXTBIT > 0); IF SY = OFSY THEN INSYMBOL ELSE AST := NIL; IF NOT (SY IN [IDENT,CASESY]) THEN BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END; WHILE SY = IDENT DERROR(8); LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL; MINBIT := NEXTBIT; MAXBIT := NEXTBIT; REPEAT LSP2 := NIL; REPEAO BEGIN NXT := NXT1; REPEAT IF SY = IDENT THEN BEGIN IF PACKING THEN NEW(LCP,FIELD,TRUE) ELSE NEW(LCP,FIELD,T CONSTANT(FSYS + [COMMA,COLON,LPARENT],LSP3,LVALU); IF LSP^.TAGFIELDP <> NIL THEN IF NOT COMPTYPES(LSP^.TAGFIELDP^.FALSE); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := NXT; KLASS := FIELD; FISPACKD := FALSE END; 0 THEN FISPACKD := FALSE ELSE IF (FLDWIDTH <= 8) AND (FLDRBIT <= 8) THEN BEGIN FLDWIDTH := 8; FLDRBIT := 8 END IDTYPE,LSP3) THEN ERROR(111); NEW(LSP3,VARIANT); WITH LSP3^ DO BEGIN NXTVAR := LSP1; SUBVAR := LSP2; VARVAL END (*ALLOCATE*) ; PROCEDURE VARIANTLIST; VAR GOTTAGNAME: BOOLEAN; BEGIN NEW(LSP,TAGFLD); WITH LSP^ DO  := LVALU; FORM := VARIANT END; LSP1 := LSP3; LSP2 := LSP3; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL BEGIN TAGFIELDP := NIL; FSTVAR := NIL; FORM := TAGFLD END; FRECVAR := LSP; INSYMBOL; IF SY = IDENT THEN BEGIN IF P UNTIL TEST; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9); IF SY = RPARENTACKING THEN NEW(LCP,FIELD,TRUE) ELSE NEW(LCP,FIELD,FALSE); WITH LCP^ DO BEGIN IDTYPE := NIL; KLASS:=FIELD; NE THEN LSP2 := NIL ELSE FIELDLIST(FSYS + [RPARENT,SEMICOLON],LSP2); IF DISPL > MAXSIZE THEN BEGIN MAXSIZE := DISPXT := NIL; FISPACKD := FALSE END; GOTTAGNAME := FALSE; PRTERR := FALSE; SEARCHID([TYPES],LCP1); PRTERR := TRUE;L; MAXBIT := NEXTBIT END ELSE IF (DISPL = MAXSIZE) AND (NEXTBIT > MAXBIT) THEN MAXBIT := NEXTBIT;  IF LCP1 = NIL THEN BEGIN GOTTAGNAME := TRUE; LCP^.NAME := ID; ENTERID(LCP); INSYMBOL; IF SY = COLON THEN INSYMB WHILE LSP3 <> NIL DO BEGIN LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2; LSP3^.SIZE := DISPL + ORD(NEXTBIT > 0);  RM = FILES THEN ERROR(108); WHILE NXT <> NXT1 DO WITH NXT^ DO BEGIN IDTYPE := LSP; ALLOCATE(NXT); IF NEXT = NXT IF NOT (SY IN TYPEDELS) THEN BEGIN ERROR(10); SKIP(FSYS + TYPEDELS) END END; (*ARRAY*) IF SY = ARRAYSY THEN BE1 THEN LAST := NXT; NXT := NEXT END; NXT1 := LCP; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IGIN INSYMBOL; IF SY = LBRACK THEN INSYMBOL ELSE ERROR(11); LSP1 := NIL; REPEAT IF PACKING THEN NEW(LSP,ARRAYS,N [IDENT,ENDSY,CASESY]) THEN (* <<<< SMF 2-28-78 *) BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END END END (*WHILE*); TRUE,FALSE) ELSE NEW(LSP,ARRAYS,FALSE); WITH LSP^ DO BEGIN AELTYPE := LSP1; INXTYPE := NIL; IF PACKING TH NXT := NIL; WHILE NXT1 <> NIL DO WITH NXT1^ DO BEGIN LCP := NEXT; NEXT := NXT; NXT := NXT1; NXT1 := LCP END; EN AISSTRNG := FALSE; AISPACKD := FALSE; FORM := ARRAYS END; LSP1 := LSP; SIMPLETYPE(FSYS + [COMMA,RBRAC IF SY = CASESY THEN VARIANTLIST ELSE FRECVAR := NIL END (*FIELDLIST*) ; PROCEDURE POINTERTYPE; K,OFSY],LSP2,LSIZE); LSP1^.SIZE := LSIZE; IF LSP2 <> NIL THEN IF LSP2^.FORM <= SUBRANGE THEN BEGIN I BEGIN NEW(LSP,POINTER); FSP := LSP; WITH LSP^ DO BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM := POINTER END; INSF LSP2 = REALPTR THEN BEGIN ERROR(109); LSP2 := NIL END ELSE IF LSP2 = INTPTR THEN BEGIN ERROR(149);YMBOL; IF SY = IDENT THEN BEGIN PRTERR := FALSE; SEARCHID([TYPES],LCP); PRTERR := TRUE; IF LCP = NIL THEN (*FORWA LSP2 := NIL END; LSP^.INXTYPE := LSP2 END ELSE BEGIN ERROR(113); LSP2 := NIL END; TEST := SY <> COMMA; RD REFERENCED TYPE ID*) BEGIN NEW(LCP,TYPES); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := LSP; NEXT := FWPTR; KLA IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12); SS := TYPES END; FWPTR := LCP END ELSE BEGIN IF LCP^.IDTYPE <> NIL THEN IF (LCP^.IDTYPE^.FORM <>  IF SY = OFSY THEN INSYMBOL ELSE ERROR(8); TYP(FSYS,LSP,LSIZE); IF LSP <> NIL THEN IF LSP^.FORM = FILES THEN ERFILES) OR SYSCOMP THEN LSP^.ELTYPE := LCP^.IDTYPE ELSE ERROR(108) END; INSYMBOL; END ELSE ERROR(2) END ROR(108); IF PACKABLE(LSP) THEN IF NUMBITS + NUMBITS <= BITSPERWD THEN WITH LSP1^ DO BEGIN AISPACKD := TRUE NXT := LCP; ENTERID(LCP); INSYMBOL END ELSE ERROR(2); IF NOT (SY IN [COMMA,COLON]) THEN BEGIN ERRO(*POINTERTYPE*) ; BEGIN (*TYP*) PACKING := FALSE; IF NOT (SY IN TYPEBEGSYS) THEN BEGIN ERROR(10); SKIP(FSYS + R(6); SKIP(FSYS + [COMMA,COLON,SEMICOLON,CASESY]) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; TYPEBEGSYS) END; IF SY IN TYPEBEGSYS THEN BEGIN IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,FSP,FSIZE) ELSE (*^*) IF SY = COLON THEN INSYMBOL ELSE ERROR(5); TYP(FSYS + [CASESY,SEMICOLON],LSP,LSIZE); IF LSP <> NIL THEN IF LSP^.FO IF SY = ARROW THEN POINTERTYPE ELSE BEGIN IF SY = PACKEDSY THEN BEGIN INSYMBOL; PACKING := TRUE;  ; ELSPERWD := BITSPERWD DIV NUMBITS; ELWIDTH := NUMBITS END; REPEAT WITH LSP1^ DO BEGIN LSP2 := AX); SIZE := (LMAX + BITSPERWD) DIV BITSPERWD; IF SIZE > 255 THEN BEGIN ERROR(169); SIZE := 1 END ELTYPE; AELTYPE := LSP; IF INXTYPE <> NIL THEN BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX); IF AISPACKD THEN LSIZ END ELSE SIZE := 0 END END ELSE (*FILE*) IF SY = FILESY THEN BEGIN 8IF INMODULE THEE := (LMAX-LMIN+ELSPERWD) DIV ELSPERWD ELSE LSIZE := LSIZE*(LMAX - LMIN + 1); IF LSIZE <= 0 THEN N :IF NOT ININTERFACE THEN  NIL THEN LSP^.SIZE := FILESIZE + LSP1^.SIZE ELSE LSP^.SIZE := NILFILESIZE END; FSMIT THEN BEGIN TOP := TOP + 1; WITH DISPLAY[TOP] DO BEGIN FNAME := NIL; OCCUR := REC END END P := LSP END; IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS) END END ELSE FSP := NIL; IF FSP = NIL T ELSE ERROR(250); DISPL := 0; NEXTBIT := 0; FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1); DISPL := DISPL + ORHEN FSIZE := 1 ELSE FSIZE := FSP^.SIZE END (*TYP*) ; D(NEXTBIT > 0); NEW(LSP,RECORDS); WITH LSP^ DO BEGIN FSTFLD := DISPLAY[TOP].FNAME; RECVAR := LSP1; SIZE := DISPL; FORM := RECORDS END; TOP := OLDTOP; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13) END ELSE (*SET*) IF SY = SETSY THEN BEGIN INSYMBOL; IF SY = OFSY THEN INSYMBOL ELSE ERROR(8); SIMPLETYPE(FSO^YS,LSP1,LSIZE); IF LSP1 <> NIL THEN IF (LSP1^.FORM > SUBRANGE) OR (LSP1 = INTPTR) OR (LSP1 = REALPTR) THEN BEGIN ERROR(115); LSP1 := NIL END ELSE IF LSP1 = REALPTR THEN BEGIN ERROR(114); LSP1 := NIL END; NEW(LSP,POWER); WITH LSP^ DO BEGIN ELSET := LSP1; FORM := POWER; IF LSP1 <> NIL THEN BEGIN GETBOUNDS(LSP1,LMIN,LMA ND := TRUE ELSE LCP := LCP^.NEXT; (IF FOUND THEN *BEGIN ,LSEPPROC := SEGTABLE[LCP^.SEGID].SEGKIND = 4; ,IF NOT LSEPPROC THEND &END (*GETTEXT*) ; - $BEGIN (*USESDECLARATION*) &IF LEVEL <> 1 THEN ERROR(189); &IF INMODULE AND NOT ININTERFACE THEN ERR .BEGIN SEG := LCP^.SEGID; NEXTPROC := 1 END; ,BEGADDR := SEGTABLE[LCP^.SEGID].TEXTADDR; ,USEFILE := WORKCODE; *END (ELSE OR(192); &IF NOT MAGIC THEN DLINKERINFO := TRUE; &IF NOT USING THEN USINGLIST := NIL; &REPEAT (IF (NOT MAGIC) AND (SY <> ID*BEGIN FOUND := TRUE; ,IF LIBNOTOPEN THEN .BEGIN RESET(LIBRARY,SYSTEMLIB); 0IF IORESULT <> 0 THEN BEGIN ERROR(187); FOUND :=ENT) THEN ERROR(2) (ELSE *IF USING THEN ,BEGIN LCP := USINGLIST; .WHILE LCP <> NIL DO 0IF LCP^.NAME = ID THEN GOTO 1 0ELSE FALSE END 0ELSE 2IF BLOCKREAD(LIBRARY,SEGDICT,1,0) <> 1 THEN 4BEGIN ERROR(187); FOUND := FALSE END; .END; ,IF FOUND THEN .BEGIN LIBNOTOPEN := FALSE; 0SEGINDEX := 0; FOUND := FALSE; 0WHILE (SEGINDEX <= MAXSEG) AND (NOT FOUND) DO 0 IF MAGIC THEN 6IF SEGDICT.SEGNAME[SEGINDEX] = LNAME THEN FOUND := TRUE 2 ELSE SEGINDEX := SEGINDEX + 1 2ELSE 4IF SEGDICT.SEGNAME[SEGINDEX] = ID THEN FOUND := TRUE 4ELSE SEGINDEX := SEGINDEX + 1; 0IF FOUND THEN 1 BEGIN USEFILE := SYSLIBRARY; 4BEGADDR := SEGDICT (* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) $PROCEDURE USESDECLARATION(MAGIC: BO.TEXTADDR[SEGINDEX]; 4LSEPPROC := SEGDICT.SEGKIND[SEGINDEX] = 4; 4IF NOT LSEPPROC THEN 6BEGIN 8IF MAGIC THEN SEG := 6 8ELSEOLEAN); &LABEL 1; &TYPE DCREC = RECORD 5DISKADDR: INTEGER; 5CODELENG: INTEGER 3END; &VAR SEGDICT: RECORD 7DANDC: ARRAY[SE :BEGIN SEG := NEXTSEG;  MAXSEG THEN ERROR(250) :END; 8WITH SEGTABLE[SEG] DO :BEGIN GRANGE] OF DCREC; 7SEGNAME: ARRAY[SEGRANGE] OF ALPHA; ( SEGKIND: ARRAY[SEGRANGE] OF INTEGER; 5 TEXTADDR: ARRAYDISKADDR := 0; CODELENG := 0;  NIL) AND NOT FOUND DO *IF LCP^.NAME = ID THEN FOUCURSOR := SYMCURSOR; ,PREVLINESTART := LINESTART; ,PREVSYMBLK := SYMBLK - 2; ,SYMBLK := BEGADDR; GETNEXTPAGE; ,INSYMBOL *EN H LLEXSTK DO 2BEGIN SEG := DOLDSEG; 4NEXTPROC := SOLDPROC 2END; .LSEPPROC := FALSE; ,END; (IF NOT MAGIC THEN *BEGIN INSYMND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16); CONSTANT(FSYS + [SEMICOLON],LSP,LVALU); ENTERID(LCP); LCP^.IDTYPE := LSP; BOL; ,TEST := SY <> COMMA; ,IF TEST THEN .IF SY <> SEMICOLON THEN ERROR(20) .ELSE ,ELSE INSYMBOL *END &UNTIL TEST OR MAGLCP^.VALUES := LVALU; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6);IC; &IF NOT MAGIC THEN (IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14) &ELSE BEGIN SY := LSY; OP := LOP; ID := LID END;  SKIP(FSYS + [IDENT]) END END ELSE ,IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14) END END (*CONSTDECLARATION&IF NOT USING THEN & BEGIN *IF INMODULE THEN USINGLIST := NIL; *CLOSE(LIBRARY,LOCK); *LIBNOTOPEN := TRUE (END $END (*USE*) ; PROCEDURE TYPEDECLARATION; VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN IF SY <> IDENT SDECLARATION*) ; 2 PROCEDURE LABELDECLARATION; VAR LLP: LABELP; REDEF: BOOLEAN; BEGIN REPEAT IF SY = INTCOTHEN BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,TYPES); WITH LCP^ DO BEGIN NAMENST THEN WITH DISPLAY[TOP] DO BEGIN LLP := FLABEL; REDEF := FALSE; WHILE (LLP <> NIL) AND NOT REDEF DO IF LLP^. := ID; IDTYPE := NIL; KLASS := TYPES END; INSYMBOL; IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);  LCP := LCP^.NEXT; .ERROR(188)(*UNIT MUST BE PREDECLARED IN MAIN PROG*); *1: ,END *ELSE ,BEGIN .IF MAGIC THEN 0BEGIN LNAMLABVAL <> VAL.IVAL THEN LLP := LLP^.NEXTLAB ELSE BEGIN REDEF := TRUE; ERROR(166) END; IF NOT REDEF THEN BEGIN NEWE := 'TURTLE '; 2LSY := SY; LOP := OP; LID := ID 0END .ELSE 0BEGIN LNAME := ID; (LLP); WITH LLP^ DO BEGIN LABVAL := VAL.IVAL; CODELBP := NIL; NEXTLAB := FLABEL END; FLABEL := LLP 2WRITELN(OUTPUT); WRITELN(OUTPUT,ID,' [',MEMAVAIL:5,' words]'); 2WRITE(OUTPUT,'<',SCREENDOTS:4,'>') 0END; .WITH LLEXSTK DO  END; INSYMBOL END ELSE ERROR(15); IF NOT ( SY IN FSYS + [COMMA, SEMICOLON] ) THEN BEGIN ERROR(6); SKIP(FSYS+[C0BEGIN DOLDSEG := SEG; SOLDPROC := NEXTPROC END; .GETTEXT(FOUND); .IF FOUND THEN 0BEGIN 2NEW(LCP,MODULE); 2WITH LCP^ DO 4OMMA,SEMICOLON]) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = SEMICOLON THEN INSYMBOL EBEGIN NAME := LNAME; NEXT := USINGLIST; 6IDTYPE := NIL; KLASS := MODULE; 6IF LSEPPROC THEN SEGID := -1 (*NO SEG*) ELSE SEGID :LSE ERROR(14) END (* LABELDECLARATION *) ; PROCEDURE CONSTDECLARATION; VAR LCP: CTP; LSP: STP; LVALU: VALU; = SEG 4END; 2ENTERID(LCP); 2USINGLIST := LCP; 2DECLARATIONPART(FSYS + [ENDSY]); 2IF NEXTPROC=1 (*NO PROCS DECLARED*) THEN  BEGIN &IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,KONST); W4LCP^.SEGID := -1; (*NO SEG*) 2SYMBLK := 9999; (*FORCE RETURN TO SOURCEFILE*) 2GETNEXTPAGE 0END; .IF NOT LSEPPROC THEN 0WITITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := NIL; KLASS := KONST END; INSYMBOL; IF (SY = RELOP) A ,IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14) END; IF FWPTR <> NIL THEN BEGIN ERROR(117); FWPTR := NIL END ENARATION*) ; D (*TYPEDECLARATION*) ; PROCEDURE VARDECLARATION; VAR LCP,NXT,IDLIST: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN NXT := NIL; REPEAT REPEAT IF SY = IDENT THEN BEGIN .IF INMODULE THEN NEW(LCP,ACTUALVARS,TRUE) .ELSE NEW(LCP,ACTUALVARS,FALSE); WITH LCP^ DO BEGIN NAME := ID; NEXT := NXT; KLASS := ACTUALVARS; 1IDTYPE := NIL; VLEV := LEVEL; / IF INMODULE THEN 3IF ININTERFACE THEN PUBLIC := TRUE 3ELSE PUBLIC := FALSE /END; ENTERID(LCP); NXT := LCP;  INSYMBOL; END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN BEGIN ERROR(6); SKIP(FSYS+[COMMA,COLON,SEMICOLON]+TYPEDELS) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); IDLIST := NXT; TYP(FSYS + [SEMICOLON] + TYPEDELS,LSP,LSIZE); WHILE NXT <> NIL DO WITH NXT^ DO O^ BEGIN IDTYPE := LSP; VADDR := LC; LC := LC + LSIZE; NXT := NEXT; IF NEXT = NIL THEN IF LSP <> NIL THEN IF L TYP(FSYS + [SEMICOLON],LSP,LSIZE); ENTERID(LCP); LCP^.IDTYPE := LSP; LCP1 := FWPTR; WHILE LCP1 <> NIL DO BEGSP^.FORM = FILES THEN BEGIN (*PUT IDLIST INTO LOCAL FILE LIST*) NEXT := DISPLAY[TOP].FFILE; DISPLAY[TOP].FFILE := IN IF LCP1^.NAME = LCP^.NAME THEN BEGIN LCP1^.IDTYPE^.ELTYPE := LCP^.IDTYPE; IF LCP1 <> FWPTR THEN LCP2^.IDLIST END END; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERRNEXT := LCP1^.NEXT ELSE FWPTR := LCP1^.NEXT; END; LCP2 := LCP1; LCP1 := LCP1^.NEXT END; IF SY = SEMICOLON TOR(6); SKIP(FSYS + [IDENT]) END END ELSE ,IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14) HEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE  UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS); $IF FWPTR <> NIL THEN BEGIN ERROR(117); FWPTR := NIL END END (*VARDECL  WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP2; IF LKIND = FORMAL THEN KLASS := FORMALVARS :ELSE KLASS := ACTUALVARS; VLEV := LEVEL END; ENTERID(LCP); LCP2 := LCP; COUNT := COUNT + 1; INSYMBOL END; IF NOT (SY IN FSYS + [COMMA,SEMICOLON,COLON]) THEN BEGIN ERROR(7); SKIP(FSYS + [COMMA,SEMICOLON,RPARENT,COLON]) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; LSP := NIL; 0IF SY = COLON THEN BEGIN INSYMBOL; IF SY = IDENT THEN BEGIN SEARCHID([TYPES],LCP); INSYMBOL; 8LSP := LCP^.IDTYPE; LEN := PTRSI (* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) PROCEDURE PROCDECLARATION(FSY: SYZE; IF LSP <> NIL THEN IF LKIND = ACTUAL THEN IF LSP^.FORM = FILES THEN ERROR(121) ELSE IF LSP^.FMBOL; SEGDEC: BOOLEAN); VAR LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP; EXTONLY,FORW: BOOLEAN; LCM: ADDRRANGE; ORM <= POWER THEN LEN := LSP^.SIZE; LC := LC + COUNT * LEN END ELSE ERROR(2) END ELSE 2IF LKIND = FORMAL LLEXSTK: LEXSTKREC; " PROCEDURE PARAMETERLIST(FSY: SETOFSYS; VAR FPAR: CTP; FCP: CTP); VAR LCP,LCP1,LCP2,LCP3: CTP; LS THEN 4EXTONLY := TRUE 2ELSE ERROR(5); 0IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN P: STP; LKIND: IDKIND; LLC,LEN : ADDRRANGE; COUNT : INTEGER; BEGIN LCP1 := NIL; LLC := LC; IF NOT (SY IN FSY + [LPAREN2BEGIN ERROR(7); SKIP(FSYS + [SEMICOLON,RPARENT]) END; 0LCP3 := LCP2; LCP := NIL; 0WHILE LCP2 <> NIL DO 2BEGIN LCP := LCP2; T]) THEN BEGIN ERROR(7); SKIP(FSYS + FSY + [LPARENT]) END; IF SY = LPARENT THEN BEGIN IF FORW THEN ERROR(119); INSYM4WITH LCP2^ DO 6BEGIN IDTYPE := LSP; 8LCP2 := NEXT 6END 2END; 0IF LCP <> NIL THEN 2BEGIN LCP^.NEXT := LCP1; LCP1 := LCP3 BOL; IF NOT (SY IN [IDENT,VARSY]) THEN BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END; WHILE SY IN [IDENT,VAREND; 0IF SY = SEMICOLON THEN 2BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT,VARSY]) THEN BEGIN ERROR(7); SKIP(FSYSSY] DO BEGIN IF SY = VARSY THEN BEGIN LKIND := FORMAL; INSYMBOL END ELSE LKIND := ACTUAL; LCP2 := NIL; COUNT  + [IDENT,RPARENT]) END END END (*WHILE*) ; IF SY = RPARENT THEN BEGIN INSYMBOL; IF NOT (SY IN FSY + FS:= 0; REPEAT IF SY <> IDENT THEN ERROR(2) ELSE BEGIN 6NEW(LCP,FORMALVARS,FALSE); (*MAY BE ACTUAL(SAME SIZE)*)   = ACTUAL) 2ELSE 4IF LCP^.KLASS = FUNC THEN 6FORW := LCP^.FORWDECL AND (FSY = FUNCSY) >AND (LCP^.PFKIND = ACTUAL)  INSYMBOL END ELSE BEGIN ERROR(2); LCP := UPRCPTR END; WITH LLEXSTK DO (BEGIN DOLDLEV:=LEVEL; *DOLDTOP:=TOP; 4ELSE FORW := FALSE; 2IF NOT FORW THEN ERROR(160) 0END .ELSE FORW := FALSE ,END; IF NOT FORW THEN BEGIN IF F*POLDPROC:=CURPROC; & DFPROCP:=LCP; (END; &CURPROC := LCP^.PFNAME; IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL + 1 ELSYS) THEN BEGIN ERROR(6); SKIP(FSY + FSYS) END END ELSE ERROR(4); FCP^.LOCALLC := LC; LCP3 := NIL; WHILSY = PROCSY THEN 0IF INMODULE THEN NEW(LCP,PROC,DECLARED,ACTUAL,TRUE) ELSE NEW(LCP,PROC,DECLARED,ACTUAL,FALSE) E LCP1 <> NIL DO WITH LCP1^ DO BEGIN LCP2 := NEXT; NEXT := LCP3; IF (IDTYPE <> NIL) THEN 4IF KLASS = FORMALVARS THELSE 0IF INMODULE THEN NEW(LCP,FUNC,DECLARED,ACTUAL,TRUE) ELSE NEW(LCP,FUNC,DECLARED,ACTUAL,FALSE); WITH LCP^ DEN 6BEGIN VADDR := LLC; LLC := LLC + PTRSIZE END 4ELSE 6IF KLASS = ACTUALVARS THEN 8IF (IDTYPE^.FORM <= POWER) THEN :BEGIN O BEGIN NAME := ID; IDTYPE := NIL; LOCALLC := LC; PFDECKIND := DECLARED; PFKIND := ACTUAL; INSCOPE := FALSE; PFLEV := VADDR := LLC; LLC := LLC + IDTYPE^.SIZE END 8ELSE :BEGIN VADDR := LC;  MAXSEG THEN ERROR(250); 6NEXTSEG := NEXTSEG+1; EGIN (*PROCDECLARATION*) &IF SEGDEC THEN (* SEGMENT DECLARATION *) (BEGIN *IF CODEINSEG THEN ,BEGIN ERROR(399); SEGINX:=0;  SEGTABLE[SEG].SEGNAME := ID 4END; 2IF NEXTPROC = MAXPROCNUM THEN ERROR(251) ELSE NEXTPROC := NEXTPROC + 1; IF FCURBYTE:=0; END; *WITH LLEXSTK DO ,BEGIN .DOLDSEG:=SEG; .SEG:=NEXTSEG; .SOLDPROC:=NEXTPROC; ,END; *NEXTPROC:=1; *LSY:=SYSY = PROCSY THEN KLASS := PROC ELSE KLASS := FUNC END; ENTERID(LCP) END ELSE ; *IF SY IN [PROCSY,FUNCSY] THEN INSYMBOL *ELSE BEGIN ERROR(399); LSY:=PROCSY END; *FSY:=LSY; (END; &LLEXSTK.DLLC := LC; LC BEGIN LCP1 := LCP^.NEXT; WHILE LCP1 <> NIL DO BEGIN WITH LCP1^ DO 4IF IDTYPE = NIL THEN 6EXTONLY := TRUE 4E := LCAFTERMARKSTACK; IF FSY = FUNCSY THEN LC := LC + REALSIZE; LINEINFO := LC; DP := TRUE; EXTONLY := FALSE; LSE 6IF KLASS = FORMALVARS THEN 8BEGIN LCM := VADDR + PTRSIZE; IF LCM > LC THEN LC := LCM END 2 ELSE 8IF KLAIF SY = IDENT THEN BEGIN *IF USING OR INMODULE AND ININTERFACE THEN FORW := FALSE *ELSE ,BEGIN SEARCHSECTION(DISPLAY[TOP].FNSS = ACTUALVARS THEN :BEGIN  LC THEN LC := LCM :END; LCP1 := LCP1^.NEXT END; AME,LCP); .IF LCP <> NIL THEN 0BEGIN 2IF LCP^.KLASS = PROC THEN 4FORW := LCP^.FORWDECL AND (FSY = PROCSY)  LCP^.PFSEG THEN BEGIN SEG := LCP^.PFSEG; NEXTPROC := 2; IF NOT SEGDEC THEN ERROR(399) END END;  SING) AND (LSEPPROC)) THEN (BEGIN *IF LEVEL <> 2 THEN ,ERROR(183) (*EXTERNAL PROCS MUST BE IN OUTERMOST BLOCK*); *IF INMODULTHEN &BEGIN (STARTINGUP:=FALSE; (* ALL SEGMENTS ARE IN BY THIS TIME *) (BLOCK(FSYS); (EXIT(DECLARATIONPART); &END; $IF NOIE THEN ,IF ININTERFACE AND NOT USING THEN .ERROR(184); (*NO EXTERNAL DECL IN INTERFACE*) *IF SEGDEC THEN ERROR(399); SY THEN $ UNITWRITE(3,DUMMYVAR[-1600],35); (*ADJUST DISPLAY OF STACK AND HEAP*) $REPEAT &NOTDONE:=FALSE; &IF USERINFO.STUPI*WITH LCP^ DO ,BEGIN EXTURNAL := TRUE; FORWDECL := FALSE; .WRITELN(OUTPUT); WRITELN(OUTPUT,NAME,' [',MEMAVAIL:5,' words]'); D THEN (IF NOT CODEINSEG THEN *IF (LEVEL = 1) AND (NEXTSEG = 10) THEN ,IF NOT(INMODULE OR USING) THEN USESDECLARATION(TRUE); .WRITE(OUTPUT,'<',SCREENDOTS:4,'>') ,END; *PROCTABLE[CURPROC] := 0; *DLINKERINFO := TRUE; *IF SY = EXTERNALSY THEN ,BEGIN I,(*To get turtle graphics*) &IF SY = USESSY THEN (BEGIN INSYMBOL; USESDECLARATION(FALSE) END; &IF SY = LABELSY THEN (BEGIN NSYMBOL; .IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14); .IF NOT (SY IN FSYS) THEN 0BEGIN ERROR(6); SKIP(FSYS) END ( END*IF INMODULE AND ININTERFACE THEN ,BEGIN ERROR(186); SKIP(FSYS - [LABELSY]) END *ELSE INSYMBOL; LABELDECLARATION END; E ERROR(251); IF TOP < DISPLIMIT THEN BEGIN TOP := TOP + 1; WITH DISPLAY[TOP] DO BEGIN IF FORW THEN FNAME  (END &ELSE (IF USING THEN *BEGIN LCP^.FORWDECL := FALSE; *END (ELSE *IF (SY = FORWARDSY) OR INMODULE AND ININTERFACE THE:= LCP^.NEXT ELSE FNAME := NIL; FLABEL := NIL; FFILE := NIL; OCCUR := BLCK END END ELSE ERROR(250); N ,BEGIN .IF FORW THEN ERROR(161) .ELSE LCP^.FORWDECL := TRUE; .IF SY = FORWARDSY THEN 0BEGIN INSYMBOL; 2IF SY = SEMICOLO IF FSY = PROCSY THEN BEGIN PARAMETERLIST([SEMICOLON],LCP1,LCP); IF NOT FORW THEN LCP^.NEXT := LCP1 END ELSE BEN THEN INSYMBOL ELSE ERROR(14) 0END; .IF NOT (SY IN FSYS) THEN 0BEGIN ERROR(6); SKIP(FSYS) END ,END *ELSE ,BEGIN .IF EXTGIN PARAMETERLIST([SEMICOLON,COLON],LCP1,LCP); IF NOT FORW THEN LCP^.NEXT := LCP1; IF SY = COLON THEN BEGIN INSYMBOL;ONLY THEN 0ERROR(7); .NEWBLOCK:=TRUE; .NOTDONE:=TRUE; .WITH LLEXSTK DO 0BEGIN 2MARK(DMARKP); 2WITH LCP^ DO 4BEGIN FORWD IF SY = IDENT THEN BEGIN IF FORW THEN ERROR(122); SEARCHID([TYPES],LCP1); LSP := LCP1^.IDTYPE; LCP^.IDTYPEECL := FALSE; INSCOPE := TRUE; 6EXTURNAL := FALSE END; 2BFSY:=SEMICOLON; 2ISSEGMENT:=SEGDEC; 2PREVLEXSTACKP:=TOS; 1END;  := LSP; IF LSP <> NIL THEN IF NOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER]) THEN BEGIN ERROR(120); LCP^.IDTYPE.NEW(TOS); .TOS^:=LLEXSTK; .EXIT(PROCDECLARATION); ,END; &WITH LLEXSTK DO (* FORWARD OR EXTERNAL DECLARATION, SO RESTORE S := NIL END; INSYMBOL END ELSE BEGIN ERROR(2); SKIP(FSYS + [SEMICOLON]) END END ELSE IF NOT FORW THEN TATE *) (BEGIN *LEVEL:=DOLDLEV; *TOP:=DOLDTOP; *LC:=DLLC; *CURPROC:=POLDPROC; *IF SEGDEC THEN ,BEGIN .NEXTPROC:=SOLDERROR(123) END; IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14); &LCP^.EXTURNAL := FALSE; &IF (SY = EXTERNALSY) )OR ((UPROC; .SEG:=DOLDSEG; ,END; (END; %END; (* PROCDECLARATION *) % BEGIN (*DECLARATIONPART*) $IF (NOSWAP) AND (STARTINGUP)  ) THEN 'IF NOT ((USING OR INMODULE) AND (SY IN [IMPLESY,ENDSY])) *AND NOT( SY IN [SEPARATESY,UNITSY]) THEN )IF (NOT (INCLUDING OR NOTDONE)) ,OR ,NOT(SY IN BLOCKBEGSYS) THEN +BEGIN ERROR(18); SKIP(FSYS - [UNITSY,INTERFACESY]); END; $UNTIL (SY IN (STATBEGSYS + [SEPARATESY,UNITSY,IMPLESY,ENDSY])); $NEWBLOCK:=FALSE; "END (*DECLARATIONPART*) ;  $UNTIL (SY IN (STATBEGSYS + [UNITSY,IMPLESY,ENDSY])); $NEWBLOCK:=FALSE; "END (*DECLARATIONPART*) ;   (* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *)  SEGMENT PROCEDURE BODYPART(FSYS: SETOFSYS; FPROCP: CTP); "PROCEDURE LINKERREF(KLASS: IDCLASS; ID,ADDR: INTEGER); "BEGIN " IF NREFS > REFSPERBLK THEN (*WRITE&IF SY = CONSTSY THEN (BEGIN INSYMBOL; CONSTDECLARATION END; &IF SY = TYPESY THEN (BEGIN INSYMBOL; TYPEDECLARATION END; &IF SY = VARSY THEN (BEGIN INSYMBOL; VARDECLARATION END; &IF LEVEL = 1 THEN GLEV := TOP; &IF SY IN [PROCSY,FUNCSY,PROGSY] THEN (BEGIN *IF INMODULE THEN ,IF ININTERFACE AND NOT USING THEN PUBLICPROCS := TRUE; *REPEAT ,LSY := SY; INSYMBOL; ,IF LSY = PROGSY THEN .IF INMODULE THEN 0BEGIN ERROR(185 (*SEG DEC NOT ALLOWED IN UNIT*)); 2PROCDECLARATION(PROCSY,FALSE) 0END .ELSE PRO^OCDECLARATION(LSY,TRUE) ,ELSE PROCDECLARATION(LSY,FALSE); *UNTIL NOT (SY IN [PROCSY,FUNCSY,PROGSY]) (END; &IF (SY <> BEGINSYf &END; $NREFS := NREFS + 1 "END (*LINKERREF*) ; ! "PROCEDURE GENLDC(IVAL: INTEGER); "BEGIN IF (IVAL >= 0) AND (IVAL <= 1ENBYTE(0) END (ELSE *IF ((FOP = 74(*LDL*)) OR (FOP = 39(*LDO*))) .AND (FP2 <= 16) THEN ,BEGIN IC := IC-1; .IF FOP = 39(*LDO27) THEN GENBYTE(IVAL) ELSE BEGIN GENBYTE(51(*LDC*)+148); MOVELEFT(IVAL,CODEP^[IC],2); IC := IC+2 END END (**) THEN GENBYTE(231+FP2) .ELSE GENBYTE(215+FP2) ,END *ELSE ,IF (FOP = 35(*IND*)) AND (FP2 <= 7) THEN .BEGIN IC := IC-1; GENGENLDC*) ; "PROCEDURE GENBIG(IVAL: INTEGER); VAR LOWORDER: CHAR; BEGIN IF IVAL <= 127 THEN GENBYTE(IVAL) ELSE BYTE(248+FP2) END ,ELSE .GENBIG(FP2) "END (*GEN1*) ;  PROCEDURE GEN2(FOP: OPRANGE; FP1,FP2: INTEGER); BEGIN IF (FOP BEGIN MOVELEFT(IVAL,CODEP^[IC],2); LOWORDER := CODEP^[IC]; CODEP^[IC] := CHR(ORD(CODEP^[IC+1])+128);  = 64(*IXP*)) OR (FOP = 77(*CXP*)) THEN BEGIN GENBYTE(FOP+128); GENBYTE(FP1); GENBYTE(FP2); END ELSE IF FO CODEP^[IC+1] := LOWORDER; IC := IC+2 END END (*GENBIG*) ; PROCEDURE GEN0(FOP: OPRANGE); VAR I: INTEGER; BEGIN P IN [47(*EQU*),48(*GEQ*),49(*GRT*), 52(*LEQ*),53(*LES*),55(*NEQ*)] THEN IF FP1 = 0 THEN GEN0(FOP+20) ELSE BEGIN GEN1(FO GENBYTE(FOP+128); IF FOP = 38(*LCA*) THEN WITH GATTR.CVAL.VALP^ DO BEGIN GENBYTE(SLGTH); FOR I := 1 TO SLGTH DP,FP1+FP1); IF FP1 > 4 THEN GENBIG(FP2) END ELSE BEGIN (*LDA,LOD,STR*) IF FP1 = 0 THEN GEN1(FOP+20,FP2) ELSO GENBYTE(ORD(SVAL[I])) END END (*GEN0*) ; PROCEDURE GEN1(FOP: OPRANGE; FP2: INTEGER); LABEL 1; VAR I,J: INTEGER; E BEGIN GENBYTE(FOP+128); GENBYTE(FP1); GENBIG(FP2) END END; END (*GEN2*) ;  BEGIN GENBYTE(FOP+128); IF FOP = 51(*LDC*) THEN BEGIN IF FP2 = 2 THEN I := REALSIZE ELSE BEGIN I := 8; "PROCEDURE GENNR(EXTPROC: NONRESIDENT); " #PROCEDURE ASSIGN(EXTPROC: NONRESIDENT); #BEGIN %PROCTABLE[NEXTPROC] := 0; %PFNU WHILE I > 0 DO IF GATTR.CVAL.VALP^.CSTVAL[I] <> 0 THEN GOTO 1 ELSE I := I - 1; 1: END; GATTR.TYPTR^.SIZE MOF[EXTPROC] := NEXTPROC; NEXTPROC := NEXTPROC + 1; %IF NEXTPROC > MAXPROCNUM THEN ERROR(193);(*NOT ENOUGH ROOM FOR THIS*) %CL:= I; IF I > 1 THEN BEGIN GENBYTE(I); FOR J := I DOWNTO 1 DO GENWORD(GATTR.CVAL.VALP^.CSTVAL[J]) END ELSE BEGIN INKERINFO := TRUE (*OPERATION*) #END (*ASSIGN*) ; & "BEGIN (*GENNR*) $IF PFNUMOF[EXTPROC] =IC := IC - 1; IF I = 1 THEN GENLDC(GATTR.CVAL.VALP^.CSTVAL[1]) END END ELSE IF FOP IN [30(*CSP*),32(*ADJ 0 THEN ASSIGN(EXTPROC); " IF SEPPROC THEN &BEGIN (GEN1(79(*CGP*),0); LINKERREF(PROC,-PFNUMOF[EXTPROC],IC-1) $ END $ELSE  BUFFER*) &BEGIN (IF BLOCKWRITE(REFFILE,REFLIST^,1,REFBLK) <> 1 THEN ERROR(402); (REFBLK := REFBLK + 1; (NREFS := 1 &END; *),45(*RNP*), 46(*CIP*),60(*LDM*),61(*STM*), 65(*RBP*),66(*CBP*),78(*CLP*), 42(*SAS*),79(*CGP*)] THEN GENBYTE(FP2) $WITH REFLIST^[NREFS] DO &BEGIN (IF KLASS IN VARS THEN KEY := ID + 32 (ELSE (*PROC*) KEY := ID; & OFFSET := SEGINX + ADDR  ELSE (IF INMODULE AND (FOP IN [37(*LAO*),39(*LDO*),43(*SRO*)]) THEN *BEGIN LINKERREF(ACTUALVARS,FP2,IC); GENBYTE(128); G "BEGIN WITH GATTR DO IF TYPTR <> NIL THEN BEGIN CASE KIND OF CST: IF TYPTR^.FORM = LONGINT THEN 5WITH GATROR(400); VARBL: CASE ACCESS OF DRCT: IF VLEVEL = 1 THEN GEN1(37(*LAO*),DPLMT) ELSE GEN2(50(*LDA*),LEVEL-V&GEN1(79(*CGP*),PFNUMOF[EXTPROC]); "END (*GENNR*) ; $ PROCEDURE GENJMP(FOP: OPRANGE; FLBP: LBP); VAR DISP: INTEGER; BTR.CVAL.VALP^ DO 7BEGIN 9M := 10000; 9GENLDC(LONGVAL[1]); GENLDC(1); 9FOR J := 2 TO LLENG DO ;BEGIN =IF J = LLENG THEN M EGIN WITH FLBP^ DO IF DEFINED THEN BEGIN GENBYTE(FOP+128); DISP := OCCURIC-IC-1; IF (DISP >= 0) AND (DISP <=:= TRUNC(PWROFTEN(LLAST)); =GENLDC(M); GENLDC(1); =GENLDC(8(*DMP*)); GENNR(DECOPS); =GENLDC(LONGVAL[J]); GENLDC(1); =GENLDC( 127) THEN GENBYTE(DISP) ELSE BEGIN IF JTABINX = 0 THEN BEGIN JTABINX := NEXTJTAB; IF NEXTJTAB = MAXJTAB TH2(*DAD*)); GENNR(DECOPS) ;END 7END 3ELSE 5IF (TYPTR^.FORM = SCALAR) AND (TYPTR <> REALPTR) THEN 7GENLDC(CVAL.IVAL) 5ELSE EN ERROR(253) ELSE NEXTJTAB := NEXTJTAB + 1; JTAB[JTABINX] := OCCURIC END; DISP := -JTABINX; 7IF TYPTR = NILPTR THEN GEN0(31(*LDCN*)) 7ELSE 9IF TYPTR = REALPTR THEN GEN1(51(*LDC*),2) 9ELSE GEN1(51(*LDC*),5); VARBL GENBYTE(248-JTABINX-JTABINX) END; END ELSE BEGIN MOVELEFT(REFLIST,CODEP^[IC],2); IF FOP = 57(*UJP*) THEN : CASE ACCESS OF DRCT: IF VLEVEL = 1 THEN GEN1(39(*LDO*),DPLMT) ELSE GEN2(54(*LOD*),LEVEL-VLEVEL,DPLMT); DISP := IC + 4096 ELSE DISP := IC; REFLIST := DISP; IC := IC+2 END; END (*GENJMP*) ; PROCEDURE LOAD; FORWARD; PRO INDRCT: GEN1(35(*IND*),IDPLMT); PACKD: GEN0(58(*LDP*)); MULTI: GEN1(60(*LDM*),TYPTR^.SIZE); BYTE: GEN0CEDURE GENFJP(FLBP: LBP); BEGIN LOAD; IF GATTR.TYPTR <> BOOLPTR THEN ERROR(135); GENJMP(33(*FJP*),FLBP) END (*GENFJP(62(*LDB*)) END; EXPR: END; WITH TYPTR^ DO ,IF ((FORM = POWER) OR /(FORM = LONGINT) AND (KIND <> CST)) *) ; PROCEDURE GENLABEL(VAR FLBP: LBP); BEGIN NEW(FLBP); WITH FLBP^ DO BEGIN DEFINED := FALSE; REFLIST := MAXADDR/AND (KIND <> EXPR) THEN GENLDC(TYPTR^.SIZE); KIND := EXPR END END (*LOAD*) ; PROCEDURE STORE(VAR FATTR: ATTR); BEGI END END (*GENLABEL*) ; PROCEDURE PUTLABEL(FLBP: LBP); VAR LREF: INTEGER; LOP: OPRANGE; BEGIN WITH FLBP^ DO N WITH FATTR DO IF TYPTR <> NIL THEN CASE ACCESS OF DRCT: IF VLEVEL = 1 THEN GEN1(43(*SRO*),DPLMT) ELSE GEN2 BEGIN LREF := REFLIST; DEFINED := TRUE; OCCURIC := IC; JTABINX := 0; WHILE LREF < MAXADDR DO BEGIN IF LREF >= 4096 TH(56(*STR*),LEVEL-VLEVEL,DPLMT); INDRCT: IF IDPLMT <> 0 THEN ERROR(400) ELSE GEN0(26(*STO*)); PACKD: GEN0(59(*STP*)); EN BEGIN LREF := LREF - 4096; LOP := 57(*UJP*) END ELSE LOP := 33(*FJP*); IC := LREF; MOVELEFT(CODEP^[IC], MULTI: GEN1(61(*STM*),TYPTR^.SIZE); BYTE: GEN0(63(*STB*)) END END (*STORE*) ; PROCEDURE LOADADDRESS; BEGIN LREF,2); GENJMP(LOP,FLBP) END; IC := OCCURIC END END (*PUTLABEL*) ; PROCEDURE LOAD; VAR J,M: INTEGER; WITH GATTR DO IF TYPTR <> NIL THEN BEGIN CASE KIND OF CST: IF STRGTYPE(TYPTR) THEN GEN0(38(*LCA*)) ELSE ER  AND (FLDWIDTH = 8) THEN BEGIN ACCESS := BYTE; IF FLDRBIT = 8 THEN GEN1(34(*INC*),1) END ELSE  ACCESS := INDRCT; IDPLMT := 0; IF TYPTR <> NIL THEN IF AISPACKD THEN IF ELWIDTH = 8 THEN BEGIN ACCESS  BEGIN ACCESS := PACKD; GENLDC(FLDWIDTH); GENLDC(FLDRBIT) END END END; FUNC: IF PFDECKIND <> := BYTE; IF STRGTYPE(LATTR.TYPTR) AND RANGECHECK THEN GEN0(27(*IXS*)) ELSE GEN0(2(*ADI*)) END ELSEDECLARED THEN ERROR(150) ELSE IF NOT INSCOPE THEN ERROR(103) ELSE BEGIN ACCESS := DRCT; VLEVEL := PFLEV + BEGIN ACCESS := PACKD; GEN2(64(*IXP*),ELSPERWD,ELWIDTH) END ELSE BEGIN GEN1(36(*IXA*),TYPTR^. 1; DPLMT := LCAFTERMARKSTACK END END (*CASE*); IF TYPTR <> NIL THEN IF (TYPTR^.FORM <= POWER) AND (TYPTR^.SIZE); IF (TYPTR^.FORM <= POWER) AND (TYPTR^.SIZE > PTRSIZE) THEN ACCESS := MULTI END END LEVEL,DPLMT); INDRCT: IF IDPLMT <> 0 THEN GEN1(34(*INC*),IDPLMT+IDPLMT); PACKD: ERROR(103) END END; KISIZE > PTRSIZE) THEN BEGIN LOADADDRESS; ACCESS := MULTI END END (*WITH*); IF NOT (SY IN SELECTSYS + FSYS) THEN ND := VARBL; ACCESS := INDRCT; IDPLMT := 0 END END (*LOADADDRESS*) ; PROCEDURE EXPRESSION(FSYS: SETOFSYS); FORWARD;  BEGIN ERROR(59); SKIP(SELECTSYS + FSYS) END; WHILE SY IN SELECTSYS DO BEGIN (*[*) IF SY = LBRACK THEN BEGIN  PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP); VAR LATTR: ATTR; LCP: CTP; LMIN,LMAX: INTEGER; BEGIN WITH FCP^, GATTR  REPEAT LATTR := GATTR; WITH LATTR DO IF TYPTR <> NIL THEN IF TYPTR^.FORM <> ARRAYS THEN BEGIN ERROR(138);DO BEGIN TYPTR := IDTYPE; KIND := VARBL; CASE KLASS OF *ACTUALVARS: ,BEGIN VLEVEL := VLEV; DPLMT := VADDR; ACCESS := DR TYPTR := NIL END; LOADADDRESS; INSYMBOL; EXPRESSION(FSYS + [COMMA,RBRACK]); LOAD; IF GATTR.TYPTR <>CT; .IF INMODULE THEN 0IF TYPTR <> NIL THEN 2IF (VLEV = 1) AND (TYPTR^.FORM = RECORDS) THEN LOADADDRESS ,END; *FORMALVARS:  NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(113); IF LATTR.TYPTR <> NIL THEN WITH LATTR.TYPTR^ DO BEGIN ,BEGIN .IF VLEV = 1 THEN GEN1(39(*LDO*),VADDR) .ELSE GEN2(54(*LOD*),LEVEL-VLEV,VADDR); .ACCESS := INDRCT; IDPLMT := 0 ,END; IF COMPTYPES(INXTYPE,GATTR.TYPTR) THEN BEGIN IF (INXTYPE <> NIL) AND NOT STRGTYPE(LATTR.TYPTR) THEN  FIELD: WITH DISPLAY[DISX] DO BEGIN IF OCCUR = CREC THEN BEGIN ACCESS := DRCT; VLEVEL := CLEV; DPLMT  BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX); IF RANGECHECK THEN BEGIN GENLDC(LMIN); GENLDC(LMAX); GEN0(8(*CHK*)) := CDSPL + FLDADDR END ELSE BEGIN IF LEVEL = 1 THEN GEN1(39(*LDO*),VDSPL) ELSE GEN2(54(*LOD*),0,VDSPL); A END; IF LMIN <> 0 THEN BEGIN GENLDC(ABS(LMIN)); IF LMIN > 0 THEN GEN0(21(*SBI*)) ELSE GEN0(2(*ADI*CCESS := INDRCT; IDPLMT := FLDADDR END; IF FISPACKD THEN BEGIN LOADADDRESS; IF ((FLDRBIT = 0) OR (FLDRBIT = 8)) )) END END END ELSE ERROR(139); WITH GATTR DO BEGIN TYPTR := AELTYPE; KIND := VARBL;  RBIT = 0) OR (FLDRBIT = 8)) AND (FLDWIDTH = 8) THEN BEGIN ACCESS := BYTE; IF FLDRBIT = 8 THEN GEN1(34(*INC*),1) END ELSE BEGIN ACCESS := PACKD; GENLDC(FLDWIDTH); GENLDC(FLDRBIT) END  END; IF TYPTR <> NIL THEN IF (TYPTR^.FORM <= POWER) AND (TYPTR^.SIZE > PTRSIZE) THEN BEGIN LOADADDRESS; ACCESS := MULTI END END END; INSYMBOL END (*SY = IDENT*) ELSE ERROR(2) END (*WITH GATTR*) END (*IF SY = PERIOD*) ELSE (*^*) BEGIN IF GATTR.TYPTR <> NIL THEN WITH GATTR,TYPTR^ DO IF (FORM = POINTER) OR (FORM = FILES) THEN BEGIN LOAD; KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0; IF FORM = POINT (* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) PROCEDURE CALL(FSYS: SETOFSYS; FCP:ER THEN TYPTR := ELTYPE ELSE BEGIN TYPTR := FILTYPE; IF TYPTR = NIL THEN ERROR(399) END; IF TYPTR <>  CTP); VAR LKEY: 1..43; WASLPARENT: BOOLEAN; PROCEDURE VARIABLE(FSYS: SETOFSYS); VAR LCP: CTP; BEGIN IF END UNTIL SY <> COMMA; IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12) END (*IF SY = LBRACK*) ELSE (*.*) IF SYNIL THEN IF (TYPTR^.FORM <= POWER) AND (TYPTR^.SIZE > PTRSIZE) THEN ACCESS := MULTI END ELSE ERROR(141);  = PERIOD THEN BEGIN WITH GATTR DO BEGIN IF TYPTR <> NIL THEN IF TYPTR^.FORM <> RECORDS THEN BEG INSYMBOL END; IF NOT (SY IN FSYS + SELECTSYS) THEN BEGIN ERROR(6); SKIP(FSYS + SELECTSYS) END END (*WHILE*IN ERROR(140); TYPTR := NIL END; INSYMBOL; IF SY = IDENT THEN BEGIN IF TYPTR <> NIL THEN BEGIN SEARCHSE) END (*SELECTOR*) ; CTION(TYPTR^.FSTFLD,LCP); IF LCP = NIL THEN BEGIN ERROR(152); TYPTR := NIL END ELSE WITH LCP^ DO O^ BEGIN TYPTR := IDTYPE; CASE ACCESS OF DRCT: DPLMT := DPLMT + FLDADDR; INDRCT: IDPLMT := IDPLMT + FLDADDR;  MULTI,BYTE, PACKD: ERROR(400) END (*CASE ACCESS*); IF FISPACKD THEN BEGIN LOADADDRESS; IF ((FLD  BEGIN IF MUSTBEVAR THEN ERROR(154); IF KIND = CST THEN BEGIN IF TYPTR = CHARPTR THEN BEGIN " &PROCEDURE MOVE; &BEGIN VARIABLE(FSYS + [COMMA]); LOADADDRESS; (IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); (IF LKEY = 27 WITH SCONST^ DO BEGIN CCLASS := STRG; SLGTH := 1; SVAL[1] := CHR(CVAL.IVAL) END; CVAL.VALP := SCONST; THEN *BEGIN EXPRESSION(FSYS + [COMMA]); LOAD END (ELSE *BEGIN VARIABLE(FSYS + [COMMA]); LOADADDRESS END; (IF SY = COMMA THEN NEW(TYPTR,ARRAYS,TRUE,TRUE); TYPTR^ := STRGPTR^; TYPTR^.MAXLENG := 1 END; LOADADDRESS END  INSYMBOL ELSE ERROR(20); (EXPRESSION(FSYS + [RPARENT]); LOAD; (IF LKEY = 27 THEN GEN1(30(*CSP*),10(*FLC*)) (ELSE *IF LKEY = END ELSE BEGIN IF GATTR.TYPTR <> NIL THEN ERROR(125); GATTR.TYPTR := STRGPTR END END (*STRGVAR*) ;  21 THEN GEN1(30(*CSP*),2(*MVL*)) *ELSE GEN1(30(*CSP*),3(*MVR*)) &END (*MOVE*) ; " &PROCEDURE EXIT; (VAR LCP: CTP; &BEGIN  PROCEDURE ROUTINE(LKEY: INTEGER); $ &PROCEDURE NEWSTMT; (LABEL 1; (VAR LSP,LSP1: STP; VARTS,LMIN,LMAX: INTEGER; ,LSIZE,LS(IF SY = IDENT THEN *BEGIN SEARCHID([PROC,FUNC],LCP); INSYMBOL END (ELSE *IF (SY = PROGSY) THEN ,BEGIN LCP := OUTERBLOCK; IZ: ADDRRANGE; LVAL: VALU; &BEGIN VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS; (LSP := NIL; VARTS := 0; LSIZE := 0; (IF GATTNSYMBOL END *ELSE LCP := NIL; (IF LCP <> NIL THEN *IF LCP^.PFDECKIND = DECLARED THEN R.TYPTR <> NIL THEN *WITH GATTR.TYPTR^ DO ,IF FORM = POINTER THEN .BEGIN 0IF ELTYPE <> NIL THEN 2WITH ELTYPE^ DO 4BEGIN LS,BEGIN GENLDC(LCP^.PFSEG); GENLDC(LCP^.PFNAME); .IF INMODULE THEN 0BEGIN LINKERREF(PROC,LCP^.PFSEG,IC-2); 2IF SEPPROC THEN LIZE := SIZE; 6IF FORM = RECORDS THEN LSP := RECVAR 4END .END ,ELSE ERROR(116); (WHILE SY = COMMA DO *BEGIN INSYMBOL; ,CONINKERREF(PROC,-LCP^.PFNAME,IC-1); 0END ,END *ELSE ERROR(125) (ELSE ERROR(125); (GEN1(30(*CSP*),4(*XIT*)) &END (*EXIT*) ; STANT(FSYS + [COMMA,RPARENT],LSP1,LVAL); ,VARTS := VARTS + 1; ,IF LSP = NIL THEN ERROR(158) ,ELSE .IF LSP^.FORM <> TAGFLD TH" &PROCEDURE UNITIO; &BEGIN (IF GATTR.TYPTR <> INTPTR THEN ERROR(125); (IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); (VARIABEN ERROR(162) .ELSE 0IF LSP^.TAGFIELDP <> NIL THEN 2IF STRGTYPE(LSP1) OR (LSP1 = REALPTR) THEN ERROR(159) 2ELSE 4IF COMPTYPLE(FSYS + [COMMA]); LOADADDRESS; (IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); (EXPRESSION(FSYS + [COMMA,RPARENT]); LOAD; (IF  SY = IDENT THEN BEGIN SEARCHID(VARS+[FIELD],LCP); INSYMBOL END ELSE BEGIN ERROR(2); LCP := UVARPTR END; SELECTOR(FES(LSP^.TAGFIELDP^.IDTYPE,LSP1) THEN 6BEGIN 8LSP1 := LSP^.FSTVAR; 8WHILE LSP1 <> NIL DO :WITH LSP1^ DO SYS,LCP) END (*VARIABLE*) ; PROCEDURE STRGVAR(FSYS: SETOFSYS; MUSTBEVAR: BOOLEAN); BEGIN EXPRESSION(FSYS); WIBEGIN LSIZE := SIZE; LSP := SUBVAR; @GOTO 1 >END  INTPTR THEN ERROR(125); (IF SY = COMMA THEN *BEGIN INSYMBOL; ,IF SY = COMMA THEN GENLDC(0) ,ELSE .BEGIN 0EXS + [COMMA]); LOAD; (IF GATTR.TYPTR <> NIL THEN *IF GATTR.TYPTR <> INTPTR THEN ERROR(125); (IF SY = COMMA THEN INSYMBOL ELSE PRESSION(FSYS + [COMMA,RPARENT]); LOAD; 0IF GATTR.TYPTR <> INTPTR THEN ERROR(125) .END *END (ELSE GENLDC(0); (IF SY = COMMAERROR(20); (EXPRESSION(FSYS + [RPARENT]); LOAD; (IF GATTR.TYPTR <> NIL THEN *IF GATTR.TYPTR <> INTPTR THEN ERROR(125); (IF L THEN *BEGIN INSYMBOL; ,EXPRESSION(FSYS + [RPARENT]); LOAD; ,IF GATTR.TYPTR <> INTPTR THEN ERROR(125) *END (ELSE GENLDC(0);KEY = 19 THEN *BEGIN ,GEN2(77(*CXP*),0(*SYS*),25(*SCOPY*)); ,GEN2(50(*LDA*),0,LLC); ,IF LSP^.MAXLENG < STRGLGTH THEN .LC := (IF LKEY = 13 THEN GEN1(30(*CSP*),5(*URD*)) (ELSE GEN1(30(*CSP*),6(*UWT*)) &END (*UNITIO*); " &PROCEDURE CONCAT;  LLC + (LSP^.MAXLENG DIV CHRSPERWD) + 1; ,IF LC > LCMAX THEN LCMAX := LC; ,LC := LLC; GATTR.TYPTR := LSP *END (ELSE *IF LKE(VAR LLC: ADDRRANGE; TEMPLGTH: INTEGER; &BEGIN TEMPLGTH := 0; (LLC := LC; LC := LC + (STRGLGTH DIV CHRSPERWD) + 1; (GENLDC(0Y = 43 THEN ,GEN2(77(*CXP*),0(*SYS*),29(*GOTOXY*)) *ELSE GEN2(77(*CXP*),0(*SYS*),26(*SDELETE*)) &END (*COPYDELETE*) ; " &PR); GEN2(56(*STR*),0,LLC); (GEN2(50(*LDA*),0,LLC); (REPEAT *STRGVAR(FSYS + [COMMA,RPARENT],FALSE); *TEMPLGTH := TEMPLGTH + GAOCEDURE STR; &BEGIN (WITH GATTR DO *BEGIN ,IF COMPTYPES(LONGINTPTR,TYPTR) THEN ,ELSE IF TYPTR = INTPTR THEN 3BEGIN GENLDCTTR.TYPTR^.MAXLENG; *IF TEMPLGTH < STRGLGTH THEN GENLDC(TEMPLGTH) *ELSE GENLDC(STRGLGTH); *GEN2(77(*CXP*),0(*SYS*),23(*SCONCA(1); TYPTR := LONGINTPTR END 1ELSE ERROR(125); ,IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); T*)); *GEN2(50(*LDA*),0,LLC); *TEST := SY <> COMMA; *IF NOT TEST THEN INSYMBOL (UNTIL TEST; (IF TEMPLGTH < STRGLGTH THEN *,STRGVAR(FSYS + [RPARENT], TRUE); ,IF STRGTYPE(TYPTR) THEN .BEGIN GENLDC(TYPTR^.MAXLENG); GENLDC(12(*DSTR*)); 0GENNR(DECOPS)LC := LLC + (TEMPLGTH DIV CHRSPERWD) + 1 (ELSE TEMPLGTH := STRGLGTH; (IF LC > LCMAX THEN LCMAX := LC; (LC := LLC; (WITH GATT .END ,ELSE ERROR(116); *END &END (*STR*); ( &PROCEDURE CLOSE; &BEGIN (VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS; (R DO *BEGIN NEW(TYPTR,ARRAYS,TRUE,TRUE); ,TYPTR^ := STRGPTR^; ,TYPTR^.MAXLENG := TEMPLGTH *END &END (*CONCAT*) ; " &PROCEIF GATTR.TYPTR <> NIL THEN *IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125); (IF SY = COMMA THEN *BEGIN INSYMBOL; ,IF SY = IDEDURE COPYDELETE; (VAR LLC: ADDRRANGE; LSP: STP; &BEGIN (IF LKEY = 19 THEN *BEGIN LLC := LC; ,LC := LC + (STRGLGTH DIV CHRSPNT THEN -BEGIN .IF ID = 'NORMAL ' THEN GENLDC(0) .ELSE 0IF ID = 'LOCK ' THEN GENLDC(1) 0ELSE 2IF ID = 'PURGE ' THEN ERWD) + 1; *END; (IF LKEY <> 43 THEN *BEGIN ,STRGVAR(FSYS + [COMMA], LKEY = 18); ,IF LKEY = 19 THEN GENLDC(2) 2ELSE 4IF ID = 'CRUNCH ' THEN GENLDC(3) 4ELSE ERROR(2); .INSYMBOL -END ,ELSE ERROR(2) *END (ELSE GENLDC(0); .BEGIN LSP := GATTR.TYPTR; 0GEN2(50(*LDA*),0,LLC) .END; ,IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); *END; (EXPRESSION(FSY(GEN2(77(*CXP*),0(*SYS*),6(*FCLOSE*)); (IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*)) &END (*CLOSE*) ; " &PROCEDURE GETPUTETC; & ,EXPRESSION(FSYS + [RPARENT]); LOAD *END (ELSE GENLDC(0); (GEN1(30(*CSP*),11(*SCN*)); (GATTR.TYPTR := INTPTR &END (*SCAN*) ; " &PROCEDURE BLOCKIO; &BEGIN (VARIABLE(FSYS + [COMMA]); LOADADDRESS; (IF GATTR.TYPTR <> NIL THEN *IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125) *ELSE ,IF GATTR.TYPTR^.FILTYPE <> NIL THEN ERROR(399); (IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); BEGIN (VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS; (IF GATTR.TYPTR <> NIL THEN *IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(1(VARIABLE(FSYS + [COMMA]); LOADADDRESS; (IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); (EXPRESSION(FSYS + [COMMA,RPARENT]); LOA25) *ELSE ,IF GATTR.TYPTR^.FILTYPE = NIL THEN ERROR(399); (CASE LKEY OF *32: BEGIN 2IF SY = COMMA THEN 4BEGIN D; (IF GATTR.TYPTR <> INTPTR THEN ERROR(125); (IF SY = COMMA THEN *BEGIN INSYMBOL; ,EXPRESSION(FSYS + [RPARENT]); LOAD; ,IF6INSYMBOL; EXPRESSION(FSYS + [RPARENT]); LOAD; 6IF GATTR.TYPTR <> INTPTR THEN ERROR(125) 4END 2ELSE ERROR(125); 2GENNR(SEEK GATTR.TYPTR <> INTPTR THEN ERROR(125) *END (ELSE GENLDC(-1); (IF LKEY = 37 THEN GENLDC(1) ELSE GENLDC(0); (GENLDC(0); GENLD) /END; *34: GEN2(77(*CXP*),0(*SYS*),7(*FGET*)); *35: GEN2(77(*CXP*),0(*SYS*),8(*FPUT*)); *40: BEGIN 2IF GATTR.TYPTR <> C(0); (GEN2(77(*CXP*),0(*SYS*),28(*BLOCKIO*)); (IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*)); (GATTR.TYPTR := INTPTR &END (*BLOCNIL THEN 4IF GATTR.TYPTR^.FILTYPE <> CHARPTR THEN ERROR(399); 2GENLDC(12); GENLDC(0); 2GEN2(77(*CXP*),0(*SYS*),17(*WRC*)) /EKIO*) ; " &PROCEDURE SIZEOF; (VAR LCP: CTP; &BEGIN (IF SY = IDENT THEN ND (END (*CASE*) ; (IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*)) &END (*GETPUTETC*) ; " &PROCEDURE SCAN; &BEGIN (IF GATTR.TYP*BEGIN SEARCHID(VARS + [TYPES,FIELD],LCP); INSYMBOL; ,IF LCP^.IDTYPE <> NIL THEN .GENLDC(LCP^.IDTYPE^.SIZE*CHRSPERWD) *END; TR <> NIL THEN *IF GATTR.TYPTR <> INTPTR THEN ERROR(125); (IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); (IF SY = RELOP THEN *(GATTR.TYPTR := INTPTR &END (*SIZEOF*) ; " "BEGIN (*ROUTINE*) $CASE LKEY OF &12: NEWSTMT; &13,14: UNITIO; &15: BEGIN ,IF OP = EQOP THEN GENLDC(0) ,ELSE .IF OP = NEOP THEN GENLDC(1) .ELSE ERROR(125); ,INSYMBOL *END (ELSE ERROR(125);  CONCAT; &18,19,43:COPYDELETE; &21,22,27:MOVE; &23: EXIT; &31: CLOSE; &32,34, &35,40: GETPUTETC; &36: (EXPRESSION(FSYS + [COMMA]); LOAD; (IF GATTR.TYPTR <> NIL THEN *IF GATTR.TYPTR <> CHARPTR THEN ERROR(125); (IF SY = COMMA THSCAN; &37,38: BLOCKIO; &41: SIZEOF; &42: STR $END (*CASES*) "END (*ROUTINE*) ; & EN INSYMBOL ELSE ERROR(20); (VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS; (IF SY = COMMA THEN *BEGIN INSYMBOL;  (*FRDS*)) 8END 6ELSE ERROR(125); IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*)); TEST := SY <> COMMA; IF NOT TEST THE (* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) PROCEDURE LOADIDADDR(FCP: CTP); N INSYMBOL UNTIL TEST END; IF LKEY = 2 THEN BEGIN LOADIDADDR(FILEPTR); GEN2(77(*CXP*),0(*SYS*),21(*FRLN*)); IF  BEGIN WITH FCP^ DO IF KLASS = ACTUALVARS THEN IF VLEV = 1 THEN GEN1(37(*LAO*),VADDR) ELSE GEN2(50(*LDA*),LEVEL-IOCHECK THEN GEN1(30(*CSP*),0(*IOC*)) END END (*READ*) ; PROCEDURE WRITE; VAR LSP: STP; DEFAULT: BOOLEAN; FILVLEV,VADDR) ELSE (*FORMALVARS*) IF VLEV = 1 THEN GEN1(39(*LDO*),VADDR) ELSE GEN2(54(*LOD*),LEVEL-VLEV,VADDR) EEPTR,LCP: CTP; LEN,LMIN,LMAX: INTEGER; BEGIN FILEPTR := OUTPUTPTR; IF (SY = IDENT) AND WASLPARENT THEN ND (*LOADIDADDR*) ; PROCEDURE READ; VAR FILEPTR,LCP: CTP; BEGIN FILEPTR := INPUTPTR; IF (SY = IDENT) AND WA BEGIN SEARCHID(VARS + [FIELD,KONST,FUNC],LCP); IF LCP^.IDTYPE <> NIL THEN IF LCP^.IDTYPE^.FORM = FILES THEN IF LSLPARENT THEN BEGIN SEARCHID(VARS+[FIELD],LCP); IF LCP^.IDTYPE <> NIL THEN IF LCP^.IDTYPE^.FORM = FILES THEN IF CP^.IDTYPE^.FILTYPE = CHARPTR THEN BEGIN INSYMBOL; FILEPTR := LCP; IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20); IF SO^LCP^.IDTYPE^.FILTYPE = CHARPTR THEN BEGIN INSYMBOL; FILEPTR := LCP; IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20); IF ɜSY = COMMA THEN INSYMBOL END END ELSE IF WASLPARENT THEN ERROR(2); IF WASLPARENT AND (SY <> RPARENT) THEN BEGIN REPEAT LOADIDADDR(FILEPTR); VARIABLE(FSYS + [COMMA,RPARENT]); IF GATTR.ACCESS = BYTE THEN ERROR(103);  LOADADDRESS; IF GATTR.TYPTR <> NIL THEN IF COMPTYPES(INTPTR,GATTR.TYPTR) THEN GEN2(77(*CXP*),0(*SYS*),12(*FRDI*)) ELSE IF COMPTYPES(REALPTR,GATTR.TYPTR) THEN GENNR(FREADREAL) 0ELSE IF COMPTYPES(LONGINTPTR,GATTR.TYPTR) THEN 4BEGIN GENLDC(GATTR.TYPTR^.SIZE); 4 GENNR(FREADDEC) 4END 2ELSE 4IF COMPTYPES(CHARPTR,GATTR.TYPTR) THEN 6GEN2(77(*CXP*),0(*SYS*),16(*FRDC*)) 4ELSE 6IF STRGTYPE(GATTR.TYPTR) THEN 8BEGIN GENLDC(GATTR.TYPTR^.MAXLENG); :GEN2(77(*CXP*),0(*SYS*),18 <> NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(20); LOAD; DEFAULT := FALSE END ELSE DEFAULT := TRUE; IF CTUAL THEN ERROR(400) END; IF SY = LPARENT THEN BEGIN REPEAT IF NXT = NIL THEN ERROR(126); INSYMBOL; ELSP = INTPTR THEN BEGIN IF DEFAULT THEN GENLDC(0); GEN2(77(*CXP*),0(*SYS*),13(*FWRI*)) END ELSE XPRESSION(FSYS + [COMMA,RPARENT]); IF (GATTR.TYPTR <> NIL) AND (NXT <> NIL) THEN BEGIN LSP := NXT^.IDTYPE; IF (NXT IF LSP = REALPTR THEN BEGIN IF DEFAULT THEN GENLDC(0); IF SY = COLON THEN BEGIN INSYMBOL; EXPRESSION(^.KLASS = FORMALVARS) OR (LSP <> NIL) THEN BEGIN IF NXT^.KLASS = ACTUALVARS THEN IF GATTR.TYPTR^.FORM <= POWERFSYS + [COMMA,RPARENT]); LOAD; IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(125) END ELSE THEN BEGIN LB := (GATTR.TYPTR = CHARPTR) AND (GATTR.KIND = CST); LOAD; IF LSP^.FORM = POWER THEN GE GENLDC(0); GENNR(FWRITEREAL) 0END ELSE IF COMPTYPES(LSP,LONGINTPTR) THEN 2BEGIN IF DEFAULT THEN GENLDC(0); GENNRN1(32(*ADJ*),LSP^.SIZE) ELSE IF LSP^.FORM = LONGINT THEN IF GATTR.TYPTR = INTPTR THEN (FWRITEDEC) END 0ELSE 2IF LSP = CHARPTR THEN 4BEGIN IF DEFAULT THEN GENLDC(0); 6GEN2(77(*CXP*),0(*SYS*),17(*FWRC*)) 4END 2@BEGIN GENLDC(INTSIZE); BGATTR.TYPTR := LONGINTPTR @END; >GENLDC(LSP^.SIZE); >GENLDC(0(*DAJ*)); >GENNR(DECOPS)  NIL THEN  RPARENT) THEN BEGIN REPEAT LOADIDADDR(FILEPTR); EXPROCHECK THEN GEN1(30(*CSP*),0(*IOC*)); TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; END; ESSION(FSYS + [COMMA,COLON,RPARENT]); LSP := GATTR.TYPTR; IF LSP <> NIL THEN .WITH LSP^ DO 0BEGIN 2IF FORM > LONGIN IF LKEY = 4 THEN (*WRITELN*) BEGIN LOADIDADDR(FILEPTR); GEN2(77(*CXP*),0(*SYS*),22(*FWLN*)); IF IOCHECK THEN GEN1(3T THEN LOADADDRESS 2ELSE 4BEGIN LOAD; 6IF FORM = LONGINT THEN 8BEGIN GENLDC(DECSIZE(MAXDEC)); GENLDC(0(*DAJ*)); :GENNR(DECO0(*CSP*),0(*IOC*)) END END (*WRITE*) ; PROCEDURE CALLNONSPECIAL; LABEL 1; &VAR NXT,LCP: CTP; LSP: STP; LB: BOOLPS) 8END 4END 0END; ,IF SY = COLON THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]); IF GATTR.TYPTR EAN; LMIN,LMAX: INTEGER; BEGIN WITH FCP^ DO BEGIN NXT := NEXT; IF PFDECKIND = DECLARED THEN IF PFKIND <> A F LB AND PAOFCHAR(LSP) THEN IF NOT LSP^.AISSTRNG THEN BEGIN GEN0(80(*S1P*)); IF LSP^.INXTYPE <> NIL THEN EM WILL BE CSP 23 IN II.0 *) *ELSE ,IF (CSPNUM <> 21) AND (CSPNUM <> 22) THEN .GEN1(30(*CSP*),CSPNUM); GATTR.TYPTR :=  BEGIN GETBOUNDS(LSP^.INXTYPE,LMIN,LMAX); IF LMAX-LMIN+1 <> GATTR.TYPTR^.MAXLENG THEN ERROR(142); FCP^.IDTYPE END (*CALLNONSPECIAL*) ; BEGIN (*CALL*) IF FCP^.PFDECKIND = SPECIAL THEN BEGIN WASLPARENT := TRUE; END; GATTR.TYPTR := LSP END END ELSE (*KLASS = FORMALVARS*) IF GATTR.KIND = VARBL THEN BEGIN LKEY := FCP^.KEY; IF SY = LPARENT THEN INSYMBOL ELSE IF LKEY IN [2,4,5,6] THEN WASLPARENT := FALSE ELSE ERROR(9); IF LK IF GATTR.ACCESS = BYTE THEN ERROR(103); LOADADDRESS; IF LSP <> NIL THEN EY IN [7,8,9,10,11,13,14,25,36,39,42] THEN BEGIN EXPRESSION(FSYS + [COMMA,RPARENT]); LOAD END; IF LKEY IN [12,13,14,15,18,19IF GATTR.TYPTR^.SIZE <> BLSP^.SIZE THEN ERROR(142) END ELSE ERROR(154); IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN,21,22,23,27,31,32,34,35,36,37,38, 440,41,42,43] THEN ROUTINE(LKEY) (ELSE *CASE LKEY OF -1,2: READ; -3,4: WRITE; -5,6: BEG ERROR(142) END END; IF NXT <> NIL THEN NXT := NXT^.NEXT UNTIL SY <> COMMA; IF SY = RPARENT THEN INSYMBOL IN (*EOF & EOLN*) 4IF WASLPARENT THEN 6BEGIN VARIABLE(FSYS + [RPARENT]); LOADADDRESS; 8IF GATTR.TYPTR <> NIL THEN ELSE ERROR(4) END (*LPARENT*) ; IF NXT <> NIL THEN ERROR(126); WITH FCP^ DO IF PFDECKIND = DECLARED THEN BEGIN :IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125) :ELSE  CHARPTR) AND @(LKEY = 6) THEN ERROR(399)  IF KLASS = FUNC THEN BEGIN GENLDC(0); GENLDC(0) END; ,IF INMODULE THEN .IF SEPPROC THEN 0IF (PFSEG = SEG) AND (PF6END 4ELSE 6LOADIDADDR(INPUTPTR); 4GENLDC(0); GENLDC(0); 4IF LKEY = 5 THEN GEN2(77(*CXP*),0(*SYS*),10(*FEOF*)) 4ELSE GEN2(7LEV = 1) THEN 2BEGIN GEN1(79(*CGP*),0); LINKERREF(PROC,-PFNAME,IC-1) END 0ELSE 2IF PFLEV = 0 THEN GEN2(77(*CXP*),PFSEG,PFNAME7(*CXP*),0(*SYS*),11(*FEOLN*)); 4GATTR.TYPTR := BOOLPTR 2END (*EOF*) ; -7,8: BEGIN GENLDC(1); (*PREDSUCC*) 4IF GATTR.TYPTR <) 2ELSE ERROR(405) (*CALL NOT ALLOWED IN SEP PROC*) .ELSE 0IF IMPORTED THEN 2BEGIN GEN2(77(*CXP*),0,PFNAME); LINKERREF(PROC,> NIL THEN 6IF GATTR.TYPTR^.FORM = SCALAR THEN 8IF LKEY = 8 THEN GEN0(2(*ADI*)) 8ELSE GEN0(21(*SBI*)) 6ELSE ERROR(115) 2ENDPFSEG,IC-2) END , ELSE GOTO 1 ,ELSE '1: IF PFSEG <> SEG THEN 0GEN2(77(*CXP*),PFSEG,PFNAME) .ELSE  (*PREDSUCC*) ; /9: BEGIN (*ORD*) 4IF GATTR.TYPTR <> NIL THEN 6IF GATTR.TYPTR^.FORM >= POWER THEN ERROR(125); 4GATTR.TYPTR :0IF PFLEV = 0 THEN GEN1(66(*CBP*),PFNAME) 0ELSE 2IF PFLEV = LEVEL THEN GEN1(78(*CLP*),PFNAME) 2ELSE 4IF PFLEV = 1 THEN GEN1= INTPTR 2END (*ORD*) ; .10: BEGIN (*SQR*) 4IF GATTR.TYPTR <> NIL THEN 4IF GATTR.TYPTR = INTPTR THEN GEN0(24(*SQI*)) 4ELSE  END ELSE (*FORM > POWER*) BEGIN LB := STRGTYPE(GATTR.TYPTR) AND (GATTR.KIND = CST); LOADADDRESS; I(79(*CGP*),PFNAME) 4ELSE GEN1(46(*CIP*),PFNAME) END ELSE IF CSPNUM = 23 THEN GEN1(30,40) (* TEMP I.5 TRANSLATION -- NM  BLE(FSYS + [COMMA]); LOADADDRESS; 4IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 4VARIABLE(FSYS + [RPARENT]); LOADADDRESS; 4GAT END (*CALL*) ; TR.TYPTR := INTPTR; 4GEN1(30(*CSP*),8(*TRS*)) 2END (*TREESEARCH*) ; .26: BEGIN (*TIME*) 4VARIABLE(FSYS + [COMMA]); LOADADDRE6IF GATTR.TYPTR = REALPTR THEN GEN0(25(*SQR*)) 6ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END 2END (*SQR*) ; .11: BEGIN (SS; 4IF GATTR.TYPTR <> NIL THEN 6IF GATTR.TYPTR <> INTPTR THEN ERROR(125); 4IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 4VAR*ABS*) 4IF GATTR.TYPTR <> NIL THEN 6IF GATTR.TYPTR = INTPTR THEN GEN0(0(*ABI*)) 6ELSE IABLE(FSYS + [RPARENT]); LOADADDRESS; 4IF GATTR.TYPTR <> NIL THEN 6IF GATTR.TYPTR <> INTPTR THEN ERROR(125); 4GEN1(30(*CSP*),8IF GATTR.TYPTR = REALPTR THEN GEN0(1(*ABR*)) 8ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END 2END (*ABS*) ; .16: BEGIN (*9(*TIM*)) 2END (*TIME*) ; %33,28,29,30: BEGIN (*OPEN,RESET,REWRITE*) 4VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS; 4IF GATLENGTH*) 4STRGVAR(FSYS + [RPARENT],FALSE); 4GEN0(62(*LDB*)); GATTR.TYPTR := INTPTR 2END (*LENGTH*) ; .17: BEGIN (*INSERT*) TR.TYPTR <> NIL THEN 6IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125); 4IF SY <> COMMA THEN 6IF LKEY = 33 THEN 8GEN2(77(*CXP*)4STRGVAR(FSYS + [COMMA],FALSE); 4IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 4STRGVAR(FSYS + [COMMA],TRUE); 4GENLDC(GATTR.TYP,0(*SYS*),4(*FRESET*)) 6ELSE ERROR(20) 4ELSE 6BEGIN INSYMBOL; 8STRGVAR(FSYS + [RPARENT],FALSE); TR^.MAXLENG); 4IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 4EXPRESSION(FSYS + [RPARENT]); LOAD; 4IF GATTR.TYPTR <> NIL THEN 8IF (LKEY = 28) OR (LKEY = 30) THEN :GENLDC(0) 8ELSE GENLDC(1); 8GENLDC(0); GEN2(77(*CXP*),0(*SYS*),5(*FOPEN*)) 6END; 4IF 6IF GATTR.TYPTR <> INTPTR THEN ERROR(125); 4GEN2(77(*CXP*),0(*SYS*),24(*SINSERT*)) 2END (*INSERT*) ; .20: BEGIN (*POS*) 4STRIOCHECK THEN GEN1(30(*CSP*),0(*IOC*)) 2END (*OPEN*) ; .39: BEGIN (*TRUNC*) 4IF GATTR.TYPTR = INTPTR THEN 6BEGIN GEN0(10(*FLTGVAR(FSYS + [COMMA],FALSE); 4IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 4STRGVAR(FSYS + [RPARENT],FALSE); 4GENLDC(0); GENLDC*)); 8GATTR.TYPTR := REALPTR 6END; 4IF GATTR.TYPTR <> NIL THEN 6IF GATTR.TYPTR = REALPTR THEN 8GEN1(30(*CSP*),23(*TRUNC*)) (0); 4GEN2(77(*CXP*),0(*SYS*),27(*SPOS*)); 4GATTR.TYPTR := INTPTR 2END (*POS*) ; .24: BEGIN (*IDSEARCH*) 4VARIABLE(FSYS + [(*** TEMPORARY -- JTRUNC WILL BE CSP 14 IN II.0 ***) 6ELSE 8IF GATTR.TYPTR^.FORM = LONGINT THEN :BEGIN  NIL THEN WITH GATTR,TYPTR^ DO IF FORM = SUBRANGE THEN TYPTR := RANGETYPE END; (*CST*) INTCONST: BEGIN WITH GATTR DO  REALPTR END; *IF FSP = INTPTR THEN ,BEGIN GEN0(9(*FLO*)); FSP := REALPTR END (END $END (*FLOATIT*) ; PROCEDURE STRETCHAL,LIC,LOP: INTEGER; CSTPART: SET OF 0..127; BEGIN IF NOT (SY IN FACBEGSYS) THEN BEGIN ERROR(58); SKIP(FSYS + FAPERATOR; PROCEDURE FACTOR(FSYS: SETOFSYS); VAR LCP: CTP; LVP: CSP; VARPART,ALLCONST: BOOLEAN; LSP: STP; HIGHVAL,LOWV"  (FSYS); 6IF (KIND = CST) AND (TYPTR = BOOLPTR) THEN 8CVAL.IVAL := ORD(NOT ODD(CVAL.IVAL)) 6ELSE LSE BEGIN GEN0(LOP); IF VARPART THEN GEN0(28(*UNI*)) ELSE VARPART := TRUE END; LSP^.EL6BEGIN LOAD; GEN0(19(*NOT*)); 8IF TYPTR <> NIL THEN :IF TYPTR <> BOOLPTR THEN  [ ] THEN BEGIN SCONST^.PVAL := CSTPART; SCONST^.CCLASS := PSET; GATTR.CVAL.VALP := SCONST;  GATTR.KIND := CST; LOAD; GEN0(28(*UNI*)) END; GATTR.KIND := EXPR END ELSE BEGIN SR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN BEGIN ERROR(136); GATTR.TYPTR := NIL END ELSE CONST^.PVAL := CSTPART; SCONST^.CCLASS := PSET; GATTR.CVAL.VALP := SCONST; GATTR.KIND := CST END END  IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR) THEN BEGIN ALLCONST := FALSE; LOP := 23(*SGS*); IF (GATTR.KIND = CST) AND  END (*CASE*) ; IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS + FACBEGSYS) END END (*WHILE*) END (*FACTOR*)  (GATTR.CVAL.IVAL <= 127) THEN BEGIN ALLCONST := TRUE; LOWVAL := GATTR.CVAL.IVAL; HIGHVAL := ; BEGIN (*TERM*) FACTOR(FSYS + [MULOP]); WHILE SY = MULOP DO BEGIN LOAD; LATTR := GATTR; LOP := OP; INSYMBOL; FEGIN WITH GATTR DO BEGIN IF LGTH = 1 THEN TYPTR := CHARPTR ELSE BEGIN NEW(LSP,ARRAYS,TRUE,TRUE); LOWVAL END; LIC := IC; LOAD; IF SY = COLON THEN BEGIN INSYMBOL; LOP := 20(*SRS*);  LSP^ := STRGPTR^; LSP^.MAXLENG := LGTH; TYPTR := LSP END; KIND := CST; CVAL := VAL END; INSYMBOL END; 0LONGCONST: 2BEGIN 4WITH GATTR DO 6BEGIN NEW(LSP,LONGINT); 8LSP^ := LONGINTPTR^; 8LSP^.SIZE := DECSIZE(LGTH); 6 TYPTR := LSP; KIND := CST; CVAL := VAL 6END; 4INSYMBOL 2END; (*(*) LPARENT: BEGIN INSYMBOL; EXPRESSION(FSYS + [ HIGHVAL := GATTR.CVAL.IVAL ELSE BEGIN LOAD; ALLCONST := FALSE END ELSE LOAD END; IF ALLCONST THEN BEGIN IC := LIC; (*FORGET FIRST CONST*) CSTPART := CSTPART + [LOWVAL..HIGHVAL] END ESET := GATTR.TYPTR; GATTR.TYPTR := LSP END ELSE ERROR(137); TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12) END; IF VARPART THEN BEGIN IF CSTIND := CST END; INSYMBOL END ELSE BEGIN REPEAT EXPRESSION(FSYS + [COMMA,RBRACK,COLON]); IF GATT(137); GATTR.TYPTR:=NIL END; IF ALLCONST THEN IF (GATTR.KIND = CST) AND (GATTR.CVAL.IVAL <= 127) THEN RPARENT]); IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END; (*NOT*) NOTSY: WITH GATTR DO 4BEGIN INSYMBOL; FACTOR EXPRESSION(FSYS + [COMMA,RBRACK]); IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR) THEN ELSE BEGIN ERROR#  PI*)) 8ELSE IF (LATTR.TYPTR = REALPTR) AND (GATTR.TYPTR = REALPTR) THEN GEN0(16(*MPR*)) ELSE BEGIN GENLDC(8(*DMP*)); GENNR(DECOPS) END IF (LATTR.TYPTR^.FORM = POWER) BAND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN @GEN0(12(*INT*)) >ELSE BEGIN ERROR(134); GATTR.TYPTR:=NIL END 6END; (*/*) RDIV: BEGIN FLOATIT(LATTR.TYPTR,TRUE); 8IF (LATTR.TYPTR = REALPTR) AND ;(GATTR.TYPTR = R INTPTR)AND(GATTR.TYPTR = INTPTR) THEN 4GEN0(2(*ADI*)) 2ELSE 4IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR) THEN 6GEN0(3(*ADR*)) 4ELSE 6IF (GATTR.TYPTR^.FORM = LONGINT) AND 9(LATTR.TYPTR^.FORM = LONGINT) THEN ); 8IF (LATTR.TYPTR = INTPTR) AND ;(GATTR.TYPTR = INTPTR) THEN GEN0(6(*DVI*)) 8ELSE :IF (LATTR.TYPTR^.FORM = LONGINT) AND =8BEGIN GENLDC(2(*DAD*)); GENNR(DECOPS) END 6ELSE 8IF (LATTR.TYPTR^.FORM = POWER) ;AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THE(GATTR.TYPTR^.FORM = LONGINT) THEN  NIL) AND (GATTR.TYPTR <> NIL) THEN CASE LOP OF (***) MUL: BE BEGIN SIGNED := OP = MINUS; INSYMBOL END; TERM(FSYS + [ADDOP]); IF SIGNED THEN BEGIN LOAD; IF GATTR.TYPTR = INTPTR THEN GEN0(17(*NGI*)) ELSE IF GATTR.TYPTR = REALPTR THEN GEN0(18(*NGR*)) ELSE .IF GATTR.TYPTR^.FORM = LONGINT TO BEGIN LOAD; LATTR := GATTR; LOP := OP; INSYMBOL; TERM(FSYS + [ADDOP]); LOAD; IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN CASE LOP OF (*+*) PLUS: BEGIN FLOATIT(LATTR.TYPTR,FALSE); STRETCHIT(LATTR.TYPTR); 2IF (LATTR.TYPTR =EALPTR) THEN GEN0(7(*DVR*)) 8ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END 6END; &(*DIV*) IDIV: BEGIN STRETCHIT(LATTR.TYPTRPTR,GATTR.TYPTR) THEN :GEN0(5(*DIF*)) 8ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END 0END; (*OR*) OROP: IF (LATTR.TYGIN FLOATIT(LATTR.TYPTR,FALSE); STRETCHIT(LATTR.TYPTR); 8IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR) :THEN GEN0(15(*MORM = LONGINT) THEN 8BEGIN GENLDC(4(*DSB*)); GENNR(DECOPS) END 6ELSE 8IF (LATTR.TYPTR^.FORM = POWER)  NIL THEN BEGTRGTYPE(GATTR.TYPTR)) OR (GSTRING AND STRGTYPE(LATTR.TYPTR)) THEN GOTO 1; IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN  BEGIN LSIZE := LATTR.TYPTR^.SIZE; (*INVALID FOR LONG INTEGERS*) CASE LATTR.TYPTR^.FORM OF SCALAR: IF LATTR.TYND (*MAKEPA*) ; BEGIN (*EXPRESSION*) SIMPLEEXPRESSION(FSYS + [RELOP]); IF SY = RELOP THEN BEGIN LSTRING := (GAPTR = REALPTR THEN TYPIND := 1 ELSE IF LATTR.TYPTR = BOOLPTR THEN TYPIND := 3 ELSE TYPIND := 0; POINTER: TTR.KIND = CST) AND (STRGTYPE(GATTR.TYPTR) OR (GATTR.TYPTR = CHARPTR)); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= BEGIN IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131); TYPIND := 0 END; LONGINT: TYPIND := 7; 4POWE POWER THEN LOAD ELSE LOADADDRESS; LATTR := GATTR; LOP := OP; INSYMBOL; SIMPLEEXPRESSION(FSYS); GSTRING := (GATTR.KIND = CR: BEGIN IF LOP IN [LTOP,GTOP] THEN ERROR(132); TYPIND := 4 END; ARRAYS: BEGIN TYPIND := ST) AND (STRGTYPE(GATTR.TYPTR) OR (GATTR.TYPTR = CHARPTR)); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= POWER THEN 6; IF PAOFCHAR(LATTR.TYPTR) THEN IF LATTR.TYPTR^.AISSTRNG THEN 1: TYPIND := 2 ELSE BEGIN TYPIND := 5; LOAD ELSE LOADADDRESS; IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN IF LOP = INOP THEN IF GATTR.TYPTR^.FORM = POWER THEN IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR^.ELSET) THEN GEN0(11(*INN*))  ELSE BEGIN ERROR(129); GATTR.TYPTR := NIL END ELSE BEGIN ERROR(130); GATTR.TYPTR := NIL END ELSE BEGIN  IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131); TYPIND := 6 END; FILES: BEGIN ERROR(133); TYPIND := 0 END END; IF TYPIND = 7 THEN 4BEGIN GENLDC(ORD(LOP)); GENLDC(16(*DCMP*)); 6GENNR(DECOPS) 4END 2ELSE 4CASE LOP OFTR,GATTR.TYPTR) END END ELSE IF GSTRING THEN BEGIN IF PAOFCHAR(LATTR.TYPTR) THEN IF NOT LATTR.TYPTR^.AISSTRNG THEN BEGIN GEN0(80(*S1P*)); MAKEPA(GATTR.TYPTR,LATTR.TYPTR) END; END; IF (LSTRING AND SIN GETBOUNDS(PAFSP^.INXTYPE,LMIN,LMAX); IF LMAX-LMIN+1 <> STRGFSP^.MAXLENG THEN ERROR(129) END; STRGFSP := PAFSP EIN + 1 END END ELSE IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131) END; RECORDS: BEGIN IF LATTR.TYPTR <> GATTR.TYPTR THEN BEGIN FLOATIT(LATTR.TYPTR,FALSE); STRETCHIT(LATTR.TYPTR) END; IF LSTRING THEN BE IF LATTR.TYPTR^.INXTYPE <> NIL THEN BEGIN GETBOUNDS(LATTR.TYPTR^.INXTYPE,LMIN,LMAX); LSIZE := LMAX - LM%  ^.FORM <= POWER THEN LOAD ELSE LOADADDRESS; IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN BEGIN IF G= LONGINTPTR 4END; 2IF GATTR.TYPTR^.FORM <> LONGINT THEN 4BEGIN ERROR(129); GATTR.TYPTR := LONGINTPTR END 0END; .IF PAONLEF ELSE ERROR(129) END; GATTR.TYPTR := BOOLPTR; GATTR.KIND := EXPR END (*SY = RELOP*) END (*EXPRESSION*) ;  (* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) PROCEDURE STATEMENT(FSYS: SETOFSYS); LABEL 1; VAR LCP: CTP; TTOP: DISPRANGE; LLP: LABELP; HEAP: ^INTEGER; PROCEDURE ASSIGNMENT(FCP: CTP); VAR LATHEN LOADADDRESS; PAONLEFT := PAOFCHAR(GATTR.TYPTR); LATTR := GATTR; INSYMBOL; EXPRESSION(FSYS); IF GATTR.KIND = CST THEN CSTRING := (GATTR.TYPTR = CHARPTR) OR STRGTYPE(GATTR.TYPTR); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTRATTR.TYPTR = INTPTR THEN IF COMPTYPES(REALPTR,LATTR.TYPTR) THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END;  IF COMPTYPES(LONGINTPTR,LATTR.TYPTR) THEN 0BEGIN 2IF GATTR.TYPTR = INTPTR THEN 4BEGIN GENLDC(INTSIZE); 6GATTR.TYPTR :6GEOP: GEN2(48(*GEQ*),TYPIND,LSIZE); 6NEOP: GEN2(55(*NEQ*),TYPIND,LSIZE); 6EQOP: GEN2(47(*EQU*),TYPIND,LSIZE) 4END END BEGIN LMAX := 0; CSTRING := FALSE; IF GATTR.TYPTR <> NIL THEN IF (GATTR.ACCESS = INDRCT) OR (GATTR.TYPTR^.FORM > POWER) O^TTR: ATTR; CSTRING,PAONLEFT: BOOLEAN; LMIN,LMAX: INTEGER; BEGIN SELECTOR(FSYS + [BECOMES],FCP); IF SY = BECOMES THEN &   POWER: BEGIN GEN1(32(*ADJ*),LATTR.TYPTR^.SIZE); STORE(LATTR) END; SCALAR, POINTER: STOR CST) THEN (IF (GATTR.TYPTR = BOOLPTR) THEN *BEGIN CONDCOMPILE := TRUE; ,NOTHENCLAUSE := NOT ODD(GATTR.CVAL.IVAL); ,LIC := IE(LATTR); 2LONGINT: BEGIN >GENLDC(LATTR.TYPTR^.SIZE); >GENLDC(0(*DAJ*)); >GENNR(DECOPS); >STORE(LATTR)  BLCK DO TTOP := TTOP - 1; LLP := DISPLAY[TTOP]. TYPE CIP = ^CASEINFO; CASEINFO = RECORD NEXT: CIP; CSSTART: INTEGER; CSLAB: INTEGER END; VAR LST THEN IF LATTR.TYPTR^.AISSTRNG THEN IF CSTRING AND (GATTR.TYPTR = CHARPTR) THEN GATTR.TYPTR := STRGPTR ELSE EFLABEL; WHILE (LLP <> NIL) AND NOT FOUND DO WITH LLP^ DO IF LABVAL = VAL.IVAL THEN BEGIN FOUND := TRUE; LSE IF LATTR.TYPTR^.INXTYPE <> NIL THEN BEGIN GETBOUNDS(LATTR.TYPTR^.INXTYPE,LMIN,LMAX); LMAX := LMAX - LMIN + GENJMP(57(*UJP*),CODELBP) END ELSE LLP := NEXTLAB; IF NOT FOUND THEN ERROR(167); INSYMBOL END ELSE ERR 1; IF CSTRING AND (GATTR.TYPTR <> CHARPTR) THEN BEGIN GEN0(80(*S1P*)); IF LMAX <> GATTR.TYPTR^.MAXLENG THEN ERROR(129); GATTR.TYPTR := LATTR.TYPTR END END ELSE GATTR.TYPTR := LATTR.TYPTR; IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN CASE LATTR.TYPTR^.FORM OF SUBRANGE: BEGIN IF RANGECHECK THEN BEGIN GENLDC(LATTR.TYPTR^Y THEN INSYMBOL ELSE ERROR(13) END (*COMPOUNDSTATEMENET*) ; PROCEDURE IFSTATEMENT; VAR LCIX1,LCIX2: LBP; LIC: INTEGER; CONDCOMPILE,NOTHENCLAUSE: BOOLEAN; BEGIN &CONDCOMPILE := FALSE; &EXPRESSION(FSYS + [THENSY]); IF (GATTR.KIND =C *END; &IF NOT CONDCOMPILE THEN & BEGIN GENLABEL(LCIX1); GENFJP(LCIX1) END; IF SY = THENSY THEN INSYMBOL ELSE ERROR(52); STATEMENT(FSYS + [ELSESY]); IF CONDCOMPILE THEN (IF NOTHENCLAUSE THEN IC := LIC (ELSE LIC := IC; END ELSE ERROR(129) END END (*SY = BECOMES*) ELSE ERROR(51) END (*ASSIGNMENT*) ; PROCEDURE GOTOSTATEENDSY]) UNTIL NOT (SY IN STATBEGSYS); TEST := SY <> SEMICOLON; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = ENDS.MIN.IVAL); GENLDC(LATTR.TYPTR^.MAX.IVAL); GEN0(8(*CHK*)) END; STORE(LATTR) END; OR(15) END (*GOTOSTATEMENT*) ; PROCEDURE COMPOUNDSTATEMENT; BEGIN REPEAT REPEAT STATEMENT(FSYS + [SEMICOLON,'  OR(8); FSTPTR := NIL; GENLABEL(LADDR); REPEAT LPT3 := NIL; REPEAT CONSTANT(FSYS + [COMMA,COLON],LSP1,LVAL); TATEMENT*) ; PROCEDURE REPEATSTATEMENT; VAR LADDR: LBP; BEGIN GENLABEL(LADDR); PUTLABEL(LADDR); REPEAT REP IF LSP <> NIL THEN IF COMPTYPES(LSP,LSP1) THEN BEGIN LPT1 := FSTPTR; LPT2 := NIL; WHILE LPT1 <> NIL DO WITH LPT1^ DO BEGIN IF CSLAB <= LVAL.IVAL THEN BEGIN IF CSLAB = LVAL.IVAL THEN ERROR(156); GOTO 1 END;  LPT2 := LPT1; LPT1 := NEXT END; 1: NEW(LPT3); WITH LPT3^ DO BEGIN NEXT := LPT1; CSLAB := LVAL.IVAL;REPEATSTATEMENT*) ; PROCEDURE WHILESTATEMENT; VAR LADDR, LCIX: LBP; BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);  EXPRESSION(FSYS + [DOSY]); GENLABEL(LCIX); GENFJP(LCIX); IF SY = DOSY THEN INSYMBOL ELSE ERROR(54); STATEMENT(TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); REPEAT STATEMENT(FSYFSYS); GENJMP(57(*UJP*),LADDR); PUTLABEL(LCIX) END (*WHILESTATEMENT*) ; PROCEDURE FORSTATEMENT; VAR LATTR: ATTR; S + [SEMICOLON]) UNTIL NOT (SY IN STATBEGSYS); IF LPT3 <> NIL THEN GENJMP(57(*UJP*),LADDR); TEST := SY <> SEMICOLON; IF NLSP: STP; LSY: SYMBOL; LCIX, LADDR: LBP; BEGIN IF SY = IDENT THEN BEGIN SEARCHID(VARS,LCP); WITH LCP^, LATTR DOT TEST THEN INSYMBOL UNTIL TEST OR (SY = ENDSY); PUTLABEL(LCIX); IF FSTPTR <> NIL THEN BEGIN LMAX := FSTPTR^O BEGIN TYPTR := IDTYPE; KIND := VARBL; IF KLASS = ACTUALVARS THEN BEGIN ACCESS := DRCT; VLEVEL := VLEV; DPLMT.CSLAB; LPT1 := FSTPTR; FSTPTR := NIL; REPEAT LPT2 := LPT1^.NEXT; LPT1^.NEXT := FSTPTR;  := VADDR END ELSE BEGIN ERROR(155); TYPTR := NIL END END; IF LATTR.TYPTR <> NIL THEN IF (LATTR.TYPTR^.FOR FSTPTR := LPT1; LPT1 := LPT2 UNTIL LPT1 = NIL; LMIN := FSTPTR^.CSLAB; GEN0(44(*XJP*)); GENWORD(LMIN); GP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3: CIP; LVAL: VALU; LADDR, LCIX: LBP; NULSTMT, LMIN, LMAX: INTEGER; BEGIN EXPRESSION(FSYS + [OFSY,COMMA,COLON]); LOAD; GENLABEL(LCIX); GENJMP(57(*UJP*),LCIX); LSP := GATTR.TYPTR; IF LSP <> NIL THEN > LMIN DO BEGIN GENWORD(IC-NULSTMT); LMIN := LMIN + 1 END; GENWORD(IC-CSSTART); FSTPTR := NEXT; LMIN := LMIN + 1 END UNTIL FSTPTR = NIL; PUTLABEL(LADDR) END; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13) END (*CASESEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY]) UNTIL NOT (SY IN STATBEGSYS); TEST := SY <> SEMICOLON; IF NOT TEST THEN INSYMBOL  UNTIL TEST; IF SY = UNTILSY THEN BEGIN INSYMBOL; EXPRESSION(FSYS); GENFJP(LADDR) END ELSE ERROR(53) END (* CSSTART := IC END; IF LPT2 = NIL THEN FSTPTR := LPT3 ELSE LPT2^.NEXT := LPT3 END ELSE ERROR(147); ENWORD(LMAX); NULSTMT := IC; GENJMP(57(*UJP*),LADDR); REPEAT WITH FSTPTR^ DO BEGIN WHILE CSLAB  IF (LSP^.FORM <> SCALAR) OR (LSP = REALPTR) THEN BEGIN ERROR(144); LSP := NIL END; IF SY = OFSY THEN INSYMBOL ELSE ERRM > SUBRANGE) OR COMPTYPES(REALPTR,LATTR.TYPTR) THEN BEGIN ERROR(143); LATTR.TYPTR := NIL END; INSYMBOL END (   ELSE BEGIN ERROR(2); SKIP(FSYS + [BECOMES,TOSY,DOWNTOSY,DOSY]) END; IF SY = BECOMES THEN BEGIN INSYMBOL; EXPRESSIOBI*)); STORE(LATTR); GENJMP(57(*UJP*),LADDR); PUTLABEL(LCIX); LC := LC - INTSIZE END (*FORSTATEMENT*) ; PRN(FSYS + [TOSY,DOWNTOSY,DOSY]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(144) ELSE  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN BEGIN LOAD; IF LATTR.TYPTR <> NIL THEN IF (LATTR.TYPTR^.FORM = SUBRANGE) AND RANGECHECK THEN BEGIN GENLDC(LATTR.TYPTR^.MIN.IVAL); GENLDC(LATTR.TYPTR^.MAX.IVAL); GEN0(8(*CHK*))],LCP); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = RECORDS THEN IF TOP < DISPLIMIT THEN BEGIN TOP := TOP + 1; LCNT1 := LCNT1 + 1; WITH DISPLAY[TOP] DO BEGIN FNAME := GATTR.TYPTR^.FSTFLD END; IF GATTR.ACCESS = DRCT THEN  GENLABEL(LADDR); IF SY IN [TOSY,DOWNTOSY] THEN BEGIN LSY := SY; INSYMBOL; EXPRESSION(FSYS + [DOSY]); IF GATTR.TYP WITH DISPLAY[TOP] DO BEGIN OCCUR := CREC; CLEV := GATTR.VLEVEL; CDSPL := GATTR.DPLMT END ELSE BEGITR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(144) ELSE IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN N LOADADDRESS; GEN2(56(*STR*),0,LC); WITH DISPLAY[TOP] DO BEGIN OCCUR := VREC; VDSPL := LC END; LC := LC + P BEGIN LOAD; IF LATTR.TYPTR <> NIL THEN IF (LATTR.TYPTR^.FORM = SUBRANGE) AND RANGECHECK THEN BEGIN GENLDC(TRSIZE; LCNT2 := LCNT2 + PTRSIZE; IF LC > LCMAX THEN LCMAX := LC END END ELSE ERROR(250) ELSE ERROR(140LATTR.TYPTR^.MIN.IVAL); GENLDC(LATTR.TYPTR^.MAX.IVAL); GEN0(8(*CHK*)) END; GEN2(56(*STR*),0,LC); PUTLABEL(LADD); TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = DOSY THEN INSYMBOL ELSE ERROR(54); STAR); GATTR := LATTR; LOAD; GEN2(54(*LOD*),0,LC); LC := LC + INTSIZE; IF LC > LCMAX THEN LCMAX := LC;  IF LSY = TOSY THEN GEN2(52(*LEQ*),0,INTSIZE) ELSE GEN2(48(*GEQ*),0,INTSIZE); END ELSE ERROR(145) END ELSE BEGIN ERROR(55); SKIP(FSYS + [DOSY]) END; GENLABEL(LCIX); GENJMP(33(*FJP*),LCIX); IF SY = DOSY THEN INSYMBOL ELSE = DISPLAY[TTOP].FLABEL; WHILE LLP <> NIL DO WITH LLP^ DO IF LABVAL = VAL.IVAL THEN BEGIN IF CODELBP^.DEFINED THEN ERROR(165); PUTLABEL(CODELBP); GOTO 1 END ELSE LLP := NEXTLAB; ERROR(167); 1: INSYMBOL; OCEDURE WITHSTATEMENT; VAR LCP: CTP; LCNT1,LCNT2: DISPRANGE; BEGIN LCNT1 := 0; LCNT2 := 0; REPEAT IF SY = IDENT THEN BEGIN SEARCHID(VARS + [FIELD],LCP); INSYMBOL END ELSE BEGIN ERROR(2); LCP := UVARPTR END; SELECTOR(FSYS + [COMMA,DOSY END; STORE(LATTR) END ELSE ERROR(145) END ELSE BEGIN ERROR(51); SKIP(FSYS + [TOSY,DOWNTOSY,DOSY]) END; LEV + 1; $IF SY = INTCONST THEN (*LABEL*) BEGIN TTOP := TOP; WHILE DISPLAY[TTOP].OCCUR <> BLCK DO TTOP := TTOP-1; LLP :ERROR(54); STATEMENT(FSYS); GATTR := LATTR; LOAD; GENLDC(1); IF LSY = TOSY THEN GEN0(2(*ADI*)) ELSE GEN0(21(*STEMENT(FSYS); TOP := TOP - LCNT1; LC := LC - LCNT2; END (*WITHSTATEMENT*) ; BEGIN (*STATEMENT*) STMTLEV := STMT)  ; (*FOR PRETTY DISPLAY OF STACK AND HEAP*) &  BEGIN "IF (NOSWAP) AND (STARTINGUP) THEN $BEGIN &DECLARATIONPART(FSYS); (* B*),6(*TURTLE*),1(*INIT*)) &END; "LCP := DISPLAY[TOP].FFILE; "WHILE LCP <> NIL DO $WITH LCP^,IDTYPE^ DO &BEGIN RING IN DECLARATIONPART *) &EXIT(BODYPART); $END; "NEXTJTAB := 1; "IF NOISY THEN $BEGIN WRITELN(OUTPUT); &IF NOT NOSWAP THEN (*MUST ADJUST DISPLAY OF STACK AND HEAP*) (UNITWRITE(3,DUMMYVAR[-1600],35); &DUMMYVAR[0]:=MEMAVAIL; &IF DUMMYVAR[0] < SMA IF SY = COLON THEN INSYMBOL ELSE ERROR(5) END; IF DEBUGGING THEN BEGIN GEN1(85(*BPT*),SCREENDOTS+1); BPTONLINE LLESTSPACE THEN SMALLESTSPACE:=DUMMYVAR[0]; &IF FPROCP <> NIL THEN *WRITELN(OUTPUT,FPROCP^.NAME,' [',DUMMYVAR[0]:5,' words]'); &WRITE(OUTPUT,'<',SCREENDOTS:4,'>') $END; "IF FPROCP <> NIL THEN $BEGIN &LLC1 := FPROCP^.LOCALLC; LCP := FPROCP^.NEXT; &W BEGIN MARK(HEAP); (*FOR LABEL CLEANUP*) CASE SY OF IDENT: BEGIN SEARCHID(VARS + [FIELD,FUNC,PROC],LCP); INHILE LCP <> NIL DO (WITH LCP^ DO *BEGIN .IF IDTYPE <> NIL THEN 0IF (KLASS = ACTUALVARS) THEN SYMBOL; IF LCP^.KLASS = PROC THEN CALL(FSYS,LCP) ELSE ASSIGNMENT(LCP) END; BEGINSY: BEGIN INSYMBOL; CO2IF (IDTYPE^.FORM > POWER) THEN 4BEGIN LLC1 := LLC1 - PTRSIZE; 6GEN2(50(*LDA*),0,VADDR); 6GEN2(54(*LOD*),0,LLC1); 6IF PAOFCMPOUNDSTATEMENT END; GOTOSY: BEGIN INSYMBOL; GOTOSTATEMENT END; IFSY: BEGIN INSYMBOL; IFSTATEMENT END; CASESY: HAR(IDTYPE) THEN 8WITH IDTYPE^ DO :IF AISSTRNG THEN GEN1(42(*SAS*),MAXLENG) :ELSE  NIL THEN >BEGIN GETBOUNDS(BEGIN INSYMBOL; CASESTATEMENT END; WHILESY: BEGIN INSYMBOL; WHILESTATEMENT END; REPEATSY: BEGIN INSYMBOL; REPEATSTATEMENTINXTYPE,LMIN,LMAX); @GEN1(41(*MVB*),LMAX - LMIN + 1) >END  MAXCODE THEN BEGIN ERROR(253); IC := 0 END; IF NOT (SY IN [SEMICOLON,ENDSY,ELSESY,UNTILSY]) THEN  BEGIN ERROR(6); SKIP(FSYS) END END; $STMTLEV := STMTLEV - 1 END (*STATEMENT*) ;  PROCEDURE BODY;  VAR LLC1,EXITICD; "IF NOT INMODULE THEN $IF LEVEL = 1 THEN &BEGIN LCP := USINGLIST; (WHILE LCP <> NIL DO *BEGIN ,IF LCP^.SEGID >= 0 THEN .BEGIN GENLDC(LCP^.SEGID); GEN1(30(*CSP*),21(*GETSEG*)) END; ,LCP := LCP^.NEXT *END; (IF USERINFO.STUPID THEN ,GEN2(77(*CXP(GEN2(50(*LDA*),0,VADDR); (GEN2(50(*LDA*),0,VADDR+FILESIZE); (IF FILTYPE = NIL THEN GENLDC(-1) (ELSE *IF IDTYPE = INTRACTVPTR THEN GENLDC(0) *ELSE ,IF FILTYPE = CHARPTR THEN GENLDC(-2) ,ELSE GENLDC(FILTYPE^.SIZE); (GEN2(77(*CXP*),0(*SYS*),3(*FINIT:= TRUE END; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS) END; IF SY IN STATBEGSYS + [IDENT] THENS; "LCMAX := LC; "LLP := DISPLAY[TOP].FLABEL; "WHILE LLP <> NIL DO $BEGIN GENLABEL(LLP^.CODELBP); &LLP := LLP^.NEXTLAB $EN: ADDRRANGE; LCP: CTP; LOP: OPRANGE; %LLP: LABELP; LMIN,LMAX: INTEGER; JTINX: JTABRANGE; %DUMMYVAR: ARRAY[0..0] OF INTEGER - IDTYPE^.SIZE 0ELSE 2IF KLASS = FORMALVARS THEN LLC1 := LLC1 - PTRSIZE; ,LCP := NEXT *END; $END; "STARTDOTS := SCREENDOT*  ,FPROCP^.IDTYPE^.SIZE) $END; "LLP := DISPLAY[TOP].FLABEL; (* CHECK UNDEFINED LABELS *) "WHILE LLP <> NIL DO $WITH LLP^,CODELBP^ DO &BEGIN (IF NOT DEFINED THEN *IF REFLIST <> MAXADDR THEN ERROR(168); (LLP := NEXTLAB &END; "JTINX := NEXTJTAB - 1; "IF ODD(IC) THEN IC := IC + 1; "WHILE JTINX > 0 DO $BEGIN GENWORD(IC-JTAB[JTINX]); JTINX := JTINX-1 END; "IF FPROCP = NIL THEN $BEGIN GENWORD((LCMAX-LCAFTERMARKSTACK)*2); GENWORD(0) END "ELSE $WITH FPROCP^ DO &BEGIN GENWORD((LCMAX-LOCALLC)*2); (GE *) $(* Copyright (c) l978 Regents of the University of California. *) $(* Permission to copy or distribute this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained froEINSEG THEN $BEGIN CODEINSEG := TRUE; &SEGTABLE[SEG].DISKADDR := CURBLK $END; "WRITECODE(FALSE); "SEGINX := SEGINX + IC; "m the Institute for Information Systems. *) $(* *) $(**)); (LCP := NEXT &END; "IF (LEVEL = 1) AND NOT SYSCOMP THEN $GEN1(85(*BPT*),SCREENDOTS+1); "REPEAT $REPEAT STATEMENT(FSYSPROCTABLE[CURPROC] := SEGINX - 2  END (*BODY*) ;   BEGIN (*BODYPART*) "BODY  END ;    + [SEMICOLON,ENDSY]) $UNTIL NOT (SY IN STATBEGSYS); $TEST := SY <> SEMICOLON; $IF NOT TEST THEN INSYMBOL "UNTIL TEST; "IF O^SY = ENDSY THEN INSYMBOL ELSE ERROR(13); "EXITIC := IC; "LCP := DISPLAY[TOP].FFILE; "WHILE LCP <> NIL DO $WITH LCP^ DO &BEGIN (GEN2(50(*LDA*),0,VADDR); (GENLDC(0); GEN2(77(*CXP*),0(*SYS*),6(*FCLOSE*)); (LCP := NEXT &END; "IF NOT INMODULE THEN $IF LEVEL = 1 THEN &BEGIN (LCP := USINGLIST; (WHILE LCP <> NIL DO *BEGIN ,IF LCP^.SEGID >= 0 THEN .BEGIN GENLDC(LCP^.SEGID); GEN1(30(*CSP*),22(*RELSEG*)) END; ,LCP := LCP^.NEXT *END &END; "IF FPROCP = NIL THEN GEN0(86(*XIT*)) "ELSE $BEGIN  $ $(******************************************************************) $(* NWORD((LOCALLC-LCAFTERMARKSTACK)*2) &END; "GENWORD(IC-EXITIC); GENWORD(IC); "GENBYTE(CURPROC); GENBYTE(LEVEL-1); "IF NOT COD&IF FPROCP^.PFLEV = 0 THEN LOP := 65(*RBP*) &ELSE LOP := 45(*RNP*); &IF FPROCP^.IDTYPE = NIL THEN GEN1(LOP,0) &ELSE GEN1(LOP+  2CONSTDEF: (CONSTANT: INTEGER); 2PUBLICDEF: (BASEOFFSET: INTEGER); 2EXTPROC,EXTFUNC, 2SSEPPROC,SSEPFUNC:(PROCYPE := PRIVVATE; 9IF KLASS = FORMALVARS THEN ;NWORDS := PTRSIZE 9ELSE ;NWORDS := IDTYPE^.SIZE 7END; 5FORMAT := BIG 3END NUM: INTEGER; ENPARAMS: INTEGER; ERANGE: ^INTEGER) .END; " "VAR FCP,LCP: CTP; CURRENTBLOCK: INTEGER; I: NONRESIDENT; &EXTNAME: ALPHA; FIC: ADDRRANGE; &LIREC: LIENTRY; " "PROCEDURE GETREFS(ID,LENGTH: INTEGER); $VAR LIC: ADDRRANGE; J,MAX,BLOCKCOUNT,COUNT: INTEGER; $ $PROCEDURE GETNEXTBLOCK; $BEGIN &CURRENTBLOCK := CURRENTBLOCK + 1; &IF CURRENTBLOCK > REFBLK THEN CURREN9IF SEPPROC THEN LITYPE := SEPPREF 9ELSE LITYPE := EXTPROC 7ELSE 9IF SEPPROC THEN ;LITYPE := SSEPPROC 9ELSE NEEDEDBYLINKER := FALSE 5ELSE (*KLASS = FUNC*) 7IF EXTURNAL THEN 9IF SEPPROC THEN LITYPE := SEPFREF 9ELSE LITYPE := EXTFUNC 7ELSE 9IF SEEFS = 1) AND (REFBLK = 0) THEN EXIT(GETREFS); $COUNT := 0; $FOR BLOCKCOUNT := 0 TO REFBLK DO &BEGIN (IF CURRENTBLOCK < REFBPPROC THEN ;LITYPE := SSEPFUNC 9ELSE NEEDEDBYLINKER := FALSE 3ELSE NEEDEDBYLINKER := FALSE 1ELSE NEEDEDBYLINKER := FALSE; 1LK THEN MAX := REFSPERBLK ELSE MAX := NREFS-1; (FOR J := 1 TO MAX DO *IF ID = REFLIST^[J].KEY THEN ,BEGIN GENWORD(REFLIST^[J]IF NEEDEDBYLINKER THEN 3BEGIN 5LCP := NEXT; NPARAMS := 0; 5WHILE LCP <> NIL DO 7BEGIN 9WITH LCP^ DO ;IF KLASS = FORMALVARS.OFFSET); COUNT := COUNT + 1 END; (IF BLOCKCOUNT < REFBLK THEN GETNEXTBLOCK; &END;  THEN =NPARAMS := NPARAMS + PTRSIZE ;ELSE =IF KLASS = ACTUALVARS THEN ?IF IDTYPE^.FORM <= POWER THEN ANPARAMS := NPARAMS + $LIC := IC; IC := FIC; GENWORD(COUNT); IC := LIC; $(*NOW FILL REST OF 8-WORD RECORD*) $FOR J := 1 TO ((8 - (COUNT MOD 8)) MODIDTYPE^.SIZE ?ELSE NPARAMS := NPARAMS + PTRSIZE; 9LCP := LCP^.NEXT 7END; 5IF LITYPE IN [SE