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 [SEPPREF,SEPFREF] THEN 7BEGIN FORMAT*****************************************************************) $  SEGMENT PROCEDURE WRITELINKERINFO(DECSTUFF:BOOLEAN); "TYPE $LITYPES = (EOFMARK,MODDULE,GLOBREF,PUBBLIC,PRIVVATE,CONNSTANT,GLOBDEF, /PUBLICDEF,CONSTDEF,EXTPROC,EXTFUNC,SSEPPROC,SSEPFUNC, /SEPPREF,SEPFREF); $OPFORMAT = (WORD, BYTE, BIG); $LIENTRY = RECORD 0LINAME: ALPHA; 0CASE LITYPE: LITYPES OF 2MODDULE NOT INMODULE THEN 1BEGIN LITYPE := CONSTDEF; 3CONSTANT := VALUES.IVAL 1END /ELSE NEEDEDBYLINKER := FALSE; (FORMALVARS, (ACTUALVARS: /BEGIN 1IF INMODULE THEN 3BEGIN 5IF PUBLIC THEN 7BEGIN LITYPE := PUBBLIC; 9NWORDS := 0 7END 5ELSE 7BEGIN LIT1ELSE 3BEGIN LITYPE := PUBLICDEF; 5BASEOFFSET := VADDR 3END /END; (FIELD: NEEDEDBYLINKER := FALSE; (PROC, (FUNC: BEGIN 1IF PFDECKIND = DECLARED THEN 3IF PFKIND = ACTUAL THEN 5IF KLASS = PROC THEN 7IF EXTURNAL THEN TBLOCK := 0; &IF BLOCKREAD(REFFILE,REFLIST^,1,CURRENTBLOCK) <> 1 THEN; $END (*GETNEXTBLOCK*) ; $ "BEGIN (*GETREFS*) $IF (NREEDEDBYLINKER := TRUE; $WITH LIREC,FCP^ DO &CASE KLASS OF (TYPES: NEEDEDBYLINKER := FALSE; (KONST: IF (IDTYPE^.SIZE = 1) AND, 2PUBBLIC, 2PRIVVATE, 2SEPPREF, 2SEPFREF: (FORMAT: OPFORMAT; ENREFS: INTEGER; ENWORDS: INTEGER);  8) DO GENWORD(0) "END (* GETREFS *) ; , "PROCEDURE GLOBALSEARCH(FCP: CTP); " VAR NEEDEDBYLINKER: BOOLEAN; " "BEGIN $N,   3IF NOT INMODULE THEN NEEDEDBYLINKER := FALSE 3ELSE 5BEGIN LITYPE := MODDULE; NWORDS := 0; FORMAT := BYTE END 1END DULE THEN &CURRENTBLOCK := REFBLK; "IF DECSTUFF THEN (*SKIP IF NO DECLARATIONPART LINKER INFO*) $BEGIN FCP := DISPLAY[GLEV].F&END (*CASE,WITH*); $IF NEEDEDBYLINKER THEN &IF SEGTABLE[SEG].SEGKIND = 2 (*SEGPROC*) THEN (WITH LIREC DO *IF (LITYPE = CONSTDEF) OR (LITYPE = PUBLICDEF) THEN ,NEEDEDBYLINKER := FALSE; $IF NEEDEDBYLINKER THEN &WITH LIREC DO (BEGIN LINAME := FCP^.NAME; *FOR LGTH := 1 TO 8 DO GENBYTE(ORD(LINAME[LGTH])); *GENWORD(ORD(LITYPE)); *CASE LITYPE OF ,MODDULE, ,PUBBLIC, ,PRIVVANAME := 'FREADREA'; NPARAMS := 2 END; ,FWRITEREAL: BEGIN LINAME := 'FWRITERE'; NPARAMS := 5 END; ,FREADDEC: BEGIN LINAME := 'FREADDEC'; NPARAMS := 3 END; ,FWRITEDEC: BEGIN LINAME := 'FWRITEDE'; NPARAMS := 10 END; ,DECOPEFS(FCP^.SEGID,1) ?ELSE @IF LITYPE IN [SEPPREF,SEPFREF] THEN BGETREFS(-FCP^.PFNAME,1) @ELSE GETREFS(FCP^.VADDR + 32,FCP^.IDTS: BEGIN LINAME := 'DECOPS '; NPARAMS := 0 END; *END; *FOR LGTH := 1 TO 8 DO GENBYTE(ORD(LINAME[LGTH])); *IF SEPPROC THEYPE^.SIZE); =END; ,CONSTDEF: BEGIN GENWORD(CONSTANT); GENWORD(0); GENWORD(0) END; ,PUBLICDEF: BEGIN GENWORD(BASEOFFSET); GENN ,BEGIN GENWORD(ORD(SEPPREF)); .GENWORD(ORD(BYTE)); FIC := IC; GENWORD(0); GENWORD(NPARAMS); .GETREFS(-PFNUMOF[I],1) ,END WORD(0); GENWORD(0) END; ,EXTPROC,EXTFUNC: BEGIN CGENWORD(PROCNUM); CGENWORD(NPARAMS); CGENWORD(ORD(RANGE)) AEND; ,SSE*ELSE ,BEGIN GENWORD(ORD(EXTPROC)); .GENWORD(PFNUMOF[I]); GENWORD(NPARAMS); GENWORD(0) ,END; *PFNUMOF[I] := 0; (END; "(* NPPROC,SSEPFUNC: BEGIN CGENWORD(PROCNUM); CGENWORD(NPARAMS); CGENWORD(ORD(RANGE)); CFOR LGTH := 1 TO 8 DO OW DO EOFMARK END-RECORD*) "FOR LGTH := 1 TO 8 DO GENBYTE(ORD(' ')); "GENWORD(ORD(EOFMARK)); GENWORD(LCMAX); "GENWORD(0);GENWEGENBYTE(ORD(LINAME[LGTH])); CIF LITYPE = SSEPPROC THEN EGENWORD(ORD(SEPPREF)) CELSE GENWORD(ORD(SEPFREF)); CGENWORD(ORD(BYTE)); CFIC := IC; GENWORD(0); GENWORD(NPARAMS); CGETREFS(-PROCNUM,1) AEND *END(*CASE*) (END(*WITH*); $IF IC >= 1024 THEN BEGIN WRITECODE(TRUE); IC := 0 END; $ $IF FCP^.LLINK <> NIL THEN GLOBALSEARCH(FCP^.LLINK); $IF FCP^.RLINK <> NIL THEN GLOBALS]'); $IF IORESULT <> 0 THEN ERROR(402) "END (* OPENREFFILE *) ; " EARCH(FCP^.RLINK) " "END (*GLOBALSEARCH*);   BEGIN (*WRITELINKERINFO*) "IC := 0; "IF CODEINSEG THEN ERROR(399); "IF INMONAME; &IF FCP <> NIL THEN GLOBALSEARCH(FCP) $END; "(*NOW DO NONRESIDENT PROCS*) "WITH LIREC DO $FOR I := SEEK TO DECOPS DO &IF PFNUMOF[I] <> 0 THEN (BEGIN *CASE I OF ,SEEK: BEGIN LINAME := 'FSEEK '; NPARAMS := 2 END; ,FREADREAL: BEGIN LITE, ,SEPPREF,SEPFREF: BEGIN ?GENWORD(ORD(FORMAT)); ?FIC := IC; GENWORD(0); ?GENWORD(NWORDS); ?IF LITYPE = MODDULE THEN GETRT PROCEDURE UNITPART(FSYS: SETOFSYS); "VAR UMARKP: TESTP;  "PROCEDURE OPENREFFILE; "BEGIN $REWRITE(REFFILE,'*SYSTEM.INFO[* := BYTE; NWORDS := NPARAMS END 5ELSE 7BEGIN PROCNUM := PFNAME; RANGE := NIL END 3END 1END (*PROC,FUNC*); & MODULE: BEGINORD(0); "WRITECODE(TRUE); "CLINKERINFO := FALSE; "IF DECSTUFF THEN DLINKERINFO := FALSE  END (*WRITELINKERINFO*);  SEGMEN-  FILE; "REPEAT $RESET(REFFILE); NREFS := 1; REFBLK := 0; $IF (SY = SEPARATESY) THEN &BEGIN SEPPROC := TRUE; (INSYMBOL; IF SYI O^ <> UNITSY THEN ERROR(24) &END $ELSE &SEPPROC := FALSE; $UNITDECLARATION(FSYS,UMARKP); $IF SEPPROC THEN SEGTABLE[SEG].SEGKI"PROCEDURE UNITDECLARATION(FSYS: SETOFSYS; VAR UMARKP:TESTP); $VAR LCP: CTP; FOUND: BOOLEAN; LLEXSTK: LEXSTKREC; "BEGIN $IF INMODULE THEN ERROR(182 (* NESTED MODULES NOT ALLOWED *)); $IF CODEINSEG THEN &BEGIN ERROR(399); SEGINX := 0; CURBYTE := 0 ENDELSE ERROR(22); $ININTERFACE := TRUE; $DECLARATIONPART(FSYS); $IF PUBLICPROCS THEN &BEGIN (ININTERFACE := FALSE; (IF SY <> IMPLESY THEN BEGIN ERROR(23); SKIP(FSYS - STATBEGSYS) END (ELSE INSYMBOL; (BLOCK(FSYS); (IF REFBLK > 0 THEN G; (DLLC := LC; (PREVLEXSTACKP := TOS &END; $SEG := NEXTSEG; $NEXTSEG := NEXTSEG + 1; $IF NEXTSEG > MAXSEG THEN ERROR(250)*IF BLOCKWRITE(REFFILE,REFLIST^,1,REFBLK) <> 1 THEN ERROR(402); (WRITELINKERINFO(TRUE); &END $ELSE &BEGIN DLINKERINFO := FA; $NEXTPROC := 1; $PUBLICPROCS := FALSE; $INMODULE := TRUE; $INSYMBOL; $IF SY <> IDENT THEN ERROR(2) $ELSE &BEGIN FOUND :LSE; (WITH SEGTABLE[SEG] DO *BEGIN CODELENG := 0; DISKADDR :=CURBLK; SEGKIND := 0 END; $ END; $SEPPROC := FALSE; (*FALSE WH= FALSE; (LCP := MODPTR; (WHILE (LCP <> NIL) AND NOT FOUND DO *IF LCP^.NAME <> ID THEN LCP := LCP^.NEXT *ELSE BEGIN FOUND :=ENEVER NOT INMODULE*) $INMODULE := FALSE; $IF SY = ENDSY THEN INSYMBOL $ELSE BEGIN ERROR(13); SKIP(FSYS) END; $IF SY <> PERI TRUE; ERROR(101) END; (IF NOT FOUND THEN *BEGIN NEW(LCP,MODULE); ,WITH LCP^ DO .BEGIN NAME := ID; IDTYPE := NIL; NEXT := MOOD THEN &IF SY = SEMICOLON THEN INSYMBOL &ELSE ERROR(14); $WITH TOS^ DO (BEGIN *TOP := DOLDTOP; *LEVEL := DOLDLEV; *CURPRDPTR; 0KLASS := MODULE; SEGID := SEG .END; ,MODPTR := LCP *END; &END; $SEGTABLE[SEG].SEGNAME := ID; $MARK(UMARKP); $NEW(REFLIST); $NEW(TOS); $TOS^ := LLEXSTK; $LEVEL := 1; $IF TOP < DISPLIMIT THEN &BEGIN TOP := TOP +1; (WITH DISPLAY[TOP] DO *BEGIN FNAME := NIL; FFILE := NIL; FLABEL := NIL; OCCUR := BLCK END; (IF LCP <> NIL THEN ENTERID(LCP) &END $ELSE ERROR(fND := 4 ELSE SEGTABLE[SEG].SEGKIND := 3; $SEGTABLE[SEG].TEXTADDR := CURBLK; $WRITETEXT; $IF SY = INTERFACESY THEN INSYMBOL $; $WITH LLEXSTK DO &BEGIN (DOLDTOP := TOP; (DOLDLEV := LEVEL; (POLDPROC := CURPROC; (SOLDPROC := NEXTPROC; (DOLDSEG := SEUNTIL NOT (SY IN [UNITSY,SEPARATESY]); "CLOSE(REFFILE)  END (*UNITPART*);   250); $INSYMBOL; $IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14) "END (*UNITDECLARATION*) ;   BEGIN (*UNITPART*) "OPENREFOC := POLDPROC; *NEXTPROC := SOLDPROC; *SEG := DOLDSEG; *LC := DLLC; (END; $TOS := TOS^.PREVLEXSTACKP; $RELEASE(UMARKP) ".  te this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from tEFILE = WORKCODE THEN (BEGIN *IF BLOCKREAD(USERINFO.WORKCODE^,SYMBUFP^,2,SYMBLK) <> 2 THEN ,USING := FALSE (END &ELSE he Institute for Information Systems. *) $(* *) $(******************************************************************) $ PROCEDURE ERROR(*ERRORNUM: INTEGER*); VAR CH: CHAR; ERRSTART: INTEGER; A: PACKED ARRAY [0..179] OF CHAR; BEGIN WITH USERINFO DO IF (ERRSYM <> SYMCURSOR) OR (ERRBLK <> SYMBLK) INCLUDING THEN (IF BLOCKREAD(INCLFILE,SYMBUFP^,2,SYMBLK) <> 2 THEN *BEGIN CLOSE(INCLFILE); INCLUDING := FALSE; ,SYMBLK := OLDSYMBLK; SYMCURSOR := OLDSYMCURSOR; ,LINESTART := OLDLINESTART *END $END; IF NOT (INCLUDING OR USING) THEN $IF BLOCKREAD(US THEN WRITELN(OUTPUT) ,ELSE .IF LIST AND (ERRORNUM <= 400) THEN 0EXIT(ERROR); ,IF LINESTART = 0 THEN .WRITE(OUTPUT,SYMBUFP^:SYMCURSOR) ,ELSE .BEGIN 0ERRSTART := SCAN(-(LINESTART-1),=CHR(EOL), DSYMBUFP^[LINESTART-2])+LINESTART-1; 0MOVELEFT(SYMBUFP^[ERRSTART],A[0],SYMCURSOR-ERRSTART); 0WRITE(OUTPUT,A:SYMCURSOR-ERRSTART) .END; ,WRITELN(OUTPUT,' <<<<'); ,WRITE(OUTPUT,'Line ',SCREENDOTS,', error ',ERRORNUM:0,':'); ,IF NOISY THEN .WRITE(OUTPUT,' (continue), (termina  (******************************************************************) $(*  CHR(27)) THEN BEGIN ERRBLK := 0; EXIT(PASCALCOMPILER) END; WRITELN(OUTPUT); IF NOISY THEN WRITE(OUTPUT,'<',SCREENDOTS:4,'>') END END (*ERROR*) ;  PROCEDURE GETNEXTPAGE; BEGIN SYMCURSOR := 0; LINESTART := 0; IF USING THEN $BEGIN &IF US(IF USEFILE = SYSLIBRARY THEN *IF BLOCKREAD(LIBRARY,SYMBUFP^,2,SYMBLK) <> 2 THEN ,USING := FALSE; &IF NOT USING THEN (BEGIN *SYMBLK := PREVSYMBLK; SYMCURSOR := PREVSYMCURSOR; *LINESTART := PREVLINESTART (END $END; "IF NOT USING THEN $BEGIN &IF THEN BEGIN ERRBLK := SYMBLK; ERRSYM := SYMCURSOR; ERRNUM := ERRORNUM; IF STUPID THEN CH := 'E' (ELSE *BEGIN ,IF NOISY) *END; IF (CH = 'E') OR (CH = 'e') THEN BEGIN ERRBLK := SYMBLK-2; EXIT(PASCALCOMPILER) END; IF (ERRORNUM > 400) OR (CH = *) $(* Copyright (c) l978 Regents of the University of California. *) $(* Permission to copy or distribute), E(dit'); ,WRITE(OUTPUT,CHR(7)); ,REPEAT READ(KEYBOARD,CH) ,UNTIL (CH = ' ') OR (CH = 'E') OR (CH = 'e') OR (CH = ALTMODE/  URSOR-LINESTART; IF LENG > 100 THEN LENG := 100; MOVELEFT(SYMBUFP^[LINESTART],A,LENG); IF A[0] = CHR(16(*DLE*)) THEN BOR+SCAN(80,<>CHR(9),SYMBUFP^[SYMCURSOR]); SYMCURSOR := SYMCURSOR+SCAN(80,<>' ',SYMBUFP^[SYMCURSOR]) END; IF DP THEN EGIN IF A[1] > ' ' THEN WRITE(LP,' ':ORD(A[1])-ORD(' ')); LENG := LENG-2; MOVELEFT(A[2],A,LENG) END; A[LENG-1] := CHR(EOL); (*JUST TO MAKE SURE*) WRITE(LP,A:LENG); "WITH USERINFO DO IF (ERRBLK = SYMBLK) AND (ERRSYM > LINESTART) THEN WRITELN(LP,'>>>>>> Error # ',ERRNUM) END (*PRINTLINE*) ;  (*$I-*) "  PROCEDURE ENTERID(*FCP: CTP*); "VAR LCP, SCAN(MAXLENG,=STOPPER,SYMBUFP^[SYMCURSOR]); STRG[0] := CHR(LENG); MOVELEFT(SYMBUFP^[SYMCURSOR],STRG[1],LENG); SYMCURSOR := SYMCURSOR+LENG+1 END (*SCANSTRING*) ; BEGIN SYMCURSOR := SYMCURSOR+1; (* POINT TO THE FIRST CH PAST "(*" *) IF SYSEARCH(LCP,LCP1,FCP^.NAME); &WHILE I = 0 DO (BEGIN ERROR(101); *IF LCP1^.RLINK = NIL THEN I := 1 *ELSE I := TREESEARCH(LCP1^MBUFP^[SYMCURSOR]='$' THEN IF SYMBUFP^[SYMCURSOR+1] <> STOPPER THEN REPEAT CH := SYMBUFP^[SYMCURSOR+1]; SW := SYMBUF.RLINK,LCP1,FCP^.NAME) (END; &IF I = 1 THEN LCP1^.RLINK := FCP ELSE LCP1^.LLINK := FCP $END; P^[SYMCURSOR+2]; DEL := SYMBUFP^[SYMCURSOR+3]; IF (SW = ',') OR (SW = STOPPER) THEN BEGIN DEL := SW; SW := '+'; "FCP^.LLINK := NIL; FCP^.RLINK := NIL  END (*ENTERID*) ;  PROCEDURE INSYMBOL; (* COMPILER VERSION 3.4 06-NOV-76 *) LABEL 1 SYMCURSOR := SYMCURSOR-1 END; CASE CH OF *'C': BEGIN 1IF LEVEL > 1 THEN ERROR(194); 1NEW(COMMENT); SCANSTRING(COMMEERINFO.WORKSYM^,SYMBUFP^,2,SYMBLK) <> 2 THEN &ERROR(401); IF SYMCURSOR = 0 THEN BEGIN &IF INMODULE THEN (IF ININTERFACE; VAR LVP: CSP; X: INTEGER; PROCEDURE CHECKEND; BEGIN (* CHECKS FOR THE END OF THE PAGE *) SCREENDOTS := SCREENDOTS+1; SY AND NOT USING THEN WRITETEXT; &IF SYMBUFP^[0] = CHR(16(*DLE*)) THEN 'SYMCURSOR := 2 $END; SYMBLK := SYMBLK+2 END (*GETNEXTPAGE*) ; (*$I+*)  PROCEDURE PRINTLINE; VAR DORLEV,STARORC: CHAR; LENG: INTEGER; A: PACKED ARRAY [0..99] OF CHAR; BEGIN STARORC := ':'; IF DP THEN DORLEV := 'D' "ELSE DORLEV := CHR((BEGSTMTLEV MOD 10) + ORD('0')); [SYMCURSOR]=CHR(0) THEN GETNEXTPAGE ELSE LINESTART := SYMCURSOR; IF SYMBUFP^[SYMCURSOR] = CHR(12(*FF*)) THEN SYMCURSOR:=SYMCURSOR+1; "IF SYMBUFP^[SYMCURSOR] = CHR(16(*DLE*)) THEN SYMCURSOR := SYMCURSOR+2 ELSE BEGIN SYMCURSOR := SYMCURSLINEINFO := LC ELSE LINEINFO := IC END; PROCEDURE COMMENTER(STOPPER: CHAR); "VAR CH,SW,DEL: CHAR; LTITLE: STRING[40];  PROCEDURE SCANSTRING(VAR STRG: STRING; MAXLENG: INTEGER); VAR LENG: INTEGER; BEGIN SYMCURSOR := SYMCURSOR+2; LENG :=LCP1: CTP; I: INTEGER;  BEGIN LCP := DISPLAY[TOP].FNAME; "IF LCP = NIL THEN DISPLAY[TOP].FNAME := FCP "ELSE $BEGIN I := TREEITELN(OUTPUT); WRITE(OUTPUT,'<',SCREENDOTS:4,'>') END END; IF LIST THEN PRINTLINE; BPTONLINE := FALSE; IF SYMBUFP^"IF BPTONLINE THEN STARORC := '*'; WRITE(LP,SCREENDOTS:6,SEG:4,CURPROC:5, STARORC,DORLEV,LINEINFO:6,' '); LENG := SYMCMCURSOR := SYMCURSOR + 1; IF NOISY THEN BEGIN WRITE(OUTPUT,'.'); IF (SCREENDOTS-STARTDOTS) MOD 50 = 0 THEN BEGIN WR0  3IF LIST THEN 5BEGIN 7SYMCURSOR := SYMCURSOR + 1; 7PRINTLINE; 7SYMCURSOR := SYMCURSOR - 1; 3 END; 3IF INCLUDING OR INMODINTEGER; DUPLE: BOOLEAN; BEGIN DUPLE := FALSE; (* INDICATES WHEN '' IS PRESENT *) TP := 0; (* INDEX INTO TEMPORARY STRINGULE AND ININTERFACE THEN 5BEGIN ERROR(406); EXIT(COMMENTER) END; OPENOLD(INCLFILE,LTITLE); IF IORESULT <> 0 THEN  BEGIN OPENOLD(INCLFILE,CONCAT(LTITLE,'.TEXT')); IF IORESULT <> 0 THEN ERROR(403) END; INCLUDING := TRUE; OLDSYMCURSOR := SYMCURSOR; OLDLINESTART := LINESTART; OLDSYMBLK := SYMBLK-2; SYMBLK := 2; GETNEXTPAGE; INSYM UNTIL SYMBUFP^[SYMCURSOR]=''''; DUPLE := TRUE; UNTIL SYMBUFP^[SYMCURSOR+1]<>''''; 1: TP := TP-1; (* ADJUST *) SY := STRINGCONST; OP := NOOP; LGTH := TP; (* GROSS *) IF TP=1 (* SINGLE CHARACTER CONSTANT *) THEN VAL.IVAL := ORD(T[1M.LST.TEXT') END ELSE BEGIN SCANSTRING(LTITLE,40); OPENNEW(LP,LTITLE); LIST := IORESULT = 0; EXIT(C]) ELSE WITH SCONST^ DO BEGIN CCLASS := STRG; SLGTH := TP; MOVELEFT(T[1],SVAL[1],TP); VAL.VALP := SCONST OMMENTER) END; 'Q': NOISY := (SW='-'); 'P': WRITE(LP,CHR(12(*FF*))); 'R': RANGECHECK := (SW='+'); 'S': NOSWAP:=(S END END(*STRING*); PROCEDURE NUMBER; VAR EXPONENT,ENDI,ENDF,ENDE,SIGN,IPART,FPART,EPART, ISUM: INTEGER; TIPE: (REALTIPEW='-'); 'T': TINY := (SW='+'); *'U': IF (SW='+') OR (SW='-') THEN 1BEGIN SYSCOMP := (SW = '-'); ,INTEGERTIPE); RSUM: REAL; NOTLONG: BOOLEAN; "K,J: INTEGER; BEGIN (* TAKES A NUMBER AND DECIDES WHETHER IT'S REAL OR3RANGECHECK := NOT SYSCOMP; 3IOCHECK := RANGECHECK; 3GOTOOK := SYSCOMP 1END /ELSE 1IF NOT USING THEN 3BEGIN SCANSTRING(SY INTEGER AND CONVERTS IT TO THE INTERNAL FORM. *) TIPE := INTEGERTIPE; ENDI := 0; ENDF := 0; ENDE := 0; SIGN := 1STEMLIB,40); 5CLOSE(LIBRARY); LIBNOTOPEN := TRUE; 5EXIT(COMMENTER) 3END END (*CASES*); SYMCURSOR := SYMCURSOR+3; UNTIL DEL <> ','; SYMCURSOR := SYMCURSOR-1; (* ADJUST *) REPEAT REPEAT SYMCURSOR := SYMCURSOR+1; WHILE SYMBUFP^[SNT^,80); EXIT(COMMENTER) /END; *'D': DEBUGGING := (SW='+'); 'G': GOTOOK := (SW='+'); 'I': IF (SW='+') OR (SW='-') THEN IYMCURSOR] = CHR(EOL) DO CHECKEND UNTIL SYMBUFP^[SYMCURSOR]=STOPPER; UNTIL (SYMBUFP^[SYMCURSOR+1]=')') OR (STOPPER='}'); SYMCURSOR := SYMCURSOR+1; END (*COMMENTER*); PROCEDURE STRING; LABEL 1; VAR T: PACKED ARRAY [1..80] OF CHAR; TP,NBLANKS,L:  *) REPEAT IF DUPLE THEN SYMCURSOR := SYMCURSOR+1; REPEAT SYMCURSOR := SYMCURSOR+1; TP := TP+1; IF SYMBUFP^[SYMCURSOR] = CHR(EOL) THEN BEGIN ERROR(202); CHECKEND; GOTO 1 END; T[TP] := SYMBUFP^[SYMCURSOR]; BOL; EXIT(INSYMBOL) END; 'L': IF (SW='+') OR (SW='-') THEN BEGIN LIST := (SW='+'); IF LIST THEN OPENNEW(LP,'*SYSTERSOR := SYMCURSOR+1 UNTIL (SYMBUFP^[SYMCURSOR]<'0') OR (SYMBUFP^[SYMCURSOR]>'9'); OCHECK := (SW='+') ELSE BEGIN SCANSTRING(LTITLE,40); IF STOPPER = '*' THEN SYMCURSOR := SYMCURSOR+1; ; "NOTLONG := TRUE; EPART := 9999; (* OUT OF REACH *) IPART := SYMCURSOR; (* INTEGER PART STARTS HERE *) REPEAT SYMCU1  F ENDI - IPART >= MAXDEC THEN .BEGIN ERROR(203); IPART := ENDI; K := ENDI END; ,NEW(LVP,LONG); ,WITH LVP^ DO .BEGIN CCLASS :'e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z': IDSEARCH(SYMCURSOR,SYMBUFP^); (* SYMCURSOR NOW POINTS AT FIRST CHARACTER PAST INTEGER PART *) ENDI := SYMCURSOR-1; (* MARK THE END OF IPART *) IF SYMBUFP^[SYMCURSOR]='.' THEN IF SYMBUFP^[SYMCURSOR+1]<>'.' (* WATCH OUT FOR '..' *) THEN BEGIN TIPE := REALTIPE;  SYMCURSOR := SYMCURSOR+1; FPART := SYMCURSOR; (* BEGINNING OF FPART *) WHILE (SYMBUFP^[SYMCURSOR] >= '0') AND  := J; 0IF J > 0 THEN 2BEGIN LLENG := LLENG + 1; 4LONGVAL[LLENG] := ISUM 2END; .END; ,SY := LONGCONST; OP := NOOP; ,LGTH := ENDI - IPART + 1; ,VAL.VALP := LVP *END; $END (*TIPE = INTEGERTIPE*) "ELSE $BEGIN (* REAL NUMBER HERE *) &RSUM :OR-1; END; IF SYMBUFP^[SYMCURSOR]='E' THEN BEGIN TIPE := REALTIPE; SYMCURSOR := SYMCURSOR+1; IF SYMBUFP^[SYMCU= 0; &FOR J := IPART TO ENDI DO (BEGIN *RSUM := RSUM*10+(ORD(SYMBUFP^[J])-ORD('0')); (END; &FOR J := ENDF DOWNTO FPART DO RSOR]='-' THEN BEGIN SYMCURSOR := SYMCURSOR+1; SIGN := -1; END ELSE IF SYMBUFP^[SYMCURSOR]='+(RSUM := RSUM+(ORD(SYMBUFP^[J])-ORD('0'))/PWROFTEN(J-FPART+1); &EXPONENT := 0; &FOR J := EPART TO ENDE DO (EXPONENT := EXPONE' THEN SYMCURSOR := SYMCURSOR+1; EPART := SYMCURSOR; (* BEGINNING OF EXPONENT *) WHILE (SYMBUFP^[SYMCURSOR]>='0') ANDNT*10+ORD(SYMBUFP^[J])-ORD('0'); &IF SIGN=-1 THEN (RSUM := RSUM/PWROFTEN(EXPONENT) &ELSE (RSUM := RSUM*PWROFTEN(EXPONENT);  (SYMBUFP^[SYMCURSOR]<='9') DO SYMCURSOR := SYMCURSOR+1; ENDE := SYMCURSOR-1; &SY := REALCONST; OP := NOOP; &NEW(LVP,REEL); &LVP^.CCLASS := REEL; &LVP^.RVAL := RSUM; &VAL.VALP := LVP; $END; SYMCURSO IF ENDEMAXINT DIV 10) OR ((ISUM=MAXINT DIV 10) AND 6(ORD(SYMBUFP^[J]) - ORD('0') > MAXINT MOD 10)) THEN .BEGIN NOTLONG := FALSE; K := J; J := ENDI END *ELSE ISUM := ISUM*10+(ORD(SYMBUF '''':STRING; '0','1','2','3','4','5','6','7','8','9': NUMBER;  'A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 'a','b','c','d',= LONG; J := 4; LLENG := 0; 0WHILE K <= ENDI DO 2BEGIN 4IF J = 4 THEN 6BEGIN LLENG := LLENG + 1; 8LONGVAL[LLENG] := ISUM; 8ISUM := 0; 8J := 0 6END; 4ISUM := ISUM * 10 + ORD(SYMBUFP^[K])-ORD('0'); , K := K + 1; J := J + 1 2END; , LLAST(SYMBUFP^[SYMCURSOR] <= '9') DO SYMCURSOR := SYMCURSOR+1; IF SYMCURSOR = FPART THEN ERROR(201); ENDF := SYMCURSTLEV; GETSTMTLEV := FALSE END; "OP := NOOP; 1: SY := OTHERSY; (* IF NO CASES EXERCISED BLOW UP *) CASE SYMBUFP^[SYMCURSOR] OFP^[J])-ORD('0')); (END; (IF NOTLONG THEN *BEGIN ,SY := INTCONST; OP := NOOP; ,VAL.IVAL := ISUM; *END (ELSE *BEGIN ,IR := SYMCURSOR-1; (* ADJUST FOR POSTERITY *) END (*NUMBER*) ; BEGIN (* INSYMBOL *) IF GETSTMTLEV THEN BEGIN BEGSTMTLEV := STM2  SOR+1 END END; END; '=': BEGIN SY := RELOP; OP := EQOP END; '>': BEGIN SY := RELOP; IF SYMBUFP^[SYMCURSOR+1]= (* COPYRIGHT (C) 1978, REGENTS OF THE *) "(* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) " "PROCEDURE SEARC'=' THEN BEGIN OP := GEOP; SYMCURSOR := SYMCURSOR+1; END ELSE OP := GTOP; END END (* CASE SYMBUFP^[SYMCURSOR] OF *); IF SY=OTHERSY THEN IF SYMBUFP^[SYMCURSOR] = CHR(EOL) THEN BEGIN CHECKEND; GETSTMTLEV := TRUE; GOTO 1 END ELSE ERROR(400); SYMCURSOR := SYMCURSOR+1; (* NEXT CALL TALKS ABOUT NEXT TOKEN *) END (*INSYMBO1; VAR LCP: CTP; BEGIN FOR DISX := TOP DOWNTO 0 DO BEGIN LCP := DISPLAY[DISX].FNAME; IF LCP <> NIL THEN IF TREESL*) ; " SOR := SYMCURSOR+1; COMMENTER('*'); SYMCURSOR := SYMCURSOR+1; GOTO 1; (* GET ANOTHER TOKEN *) END ELSE SY O^:= LPARENT; END; ')': SY := RPARENT; ',': SY := COMMA; ' ',' ': BEGIN SYMCURSOR := SYMCURSOR+1; GOTO 1; END; '.': BEGIN IF SYMBUFP^[SYMCURSOR+1]='.' THEN BEGIN SYMCURSOR := SYMCURSOR+1; SY := COLON END ELSE SY := PERIOD; END; ':': IF SYMBUFP^[SYMCURSOR+1]='=' THEN BEGIN SYMCURSOR := SYMCURSOR+1; SY := BECOMES; END ELSE SY := COLON; ';': SY := SEMICOLON; '^': SY := ARROW; '[': SY := LBRACK;  ']': SY := RBRACK; '*': BEGIN SY := MULOP; OP := MUL END; '+': BEGIN SY := ADDOP; OP := PLUS END; '-': BEGIN SY := ADDOP; OP := MINUS END; '/': BEGIN SY := MULOP; OP := RDIV END; '<': BEGIN SY := RELOP; OP := LTOP; CASE SYMBUFP^[SYMCURSORHSECTION(*FCP: CTP; VAR FCP1: CTP*); BEGIN IF FCP <> NIL THEN IF TREESEARCH(FCP,FCP1,ID) = 0 THEN (*NADA*) ELSE FCP1 := NIL ELSE FCP1 := NIL END (*SEARCHSECTION*) ; PROCEDURE SEARCHID(*FIDCLS: SETOFIDS; VAR FCP: CTP*); LABEL  (* MAGIC PROC *) '{': BEGIN COMMENTER('}'); GOTO 1 END; '(': BEGIN IF SYMBUFP^[SYMCURSOR+1]='*' THEN BEGIN SYMCUR+1] OF '>': BEGIN OP := NEOP; SYMCURSOR := SYMCURSOR+1 END; '=': BEGIN OP := LEOP; SYMCURSOR := SYMCUR3   IF FSP^.FCONST <> NIL THEN FMAX := FSP^.FCONST^.VALUES.IVAL ELSE FMAX := 0 END END (*GETBOUNDS*) ; PROCEDTHEN IF LSP = INTPTR THEN BEGIN IF SIGN = NEG THEN FVALU.IVAL := -FVALU.IVAL END ELSE URE SKIP(*FSYS: SETOFSYS*); BEGIN WHILE NOT(SY IN FSYS) DO INSYMBOL END (*SKIP*) ; FUNCTION PAOFCHAR(*FSP: STP): BOOLEAN*); BEGIN PAOFCHAR := FALSE; IF FSP <> NIL THEN IF FSP^.FORM = ARRAYS THEN PAOFCHAR := FSP^.AISPACKD AND (FSP^.AELTYPE = CHARPTR) END (*PAOFCHAR*) ; FUNCTION STRGTYPE(*FSP: STP) : BOOLEAN*); BEGIN STRGTYPE := FALSE; IF PAOFCHAR(FSP) GN = NEG THEN LVP^.CCLASS := LONG; >LVP^.LONGVAL[1] := - FVALU.VALP^.LONGVAL[1]; >FVALU.VALP := LVP  NONE  IF LSP = REALPTR THEN BEGIN IF SIGN = NEG THEN BEGIN NEW(LVP,REEL); LVP^.CCLASS := REEL; LVP^.RVAL := -FVALU.VALP^.RVAL; FVALU.VALP := LVP; END 6END 4ELSE 6IF COMPTYPES(LSP,LONGINTPTR) THEN 8BEGIN :IF SITHEN STRGTYPE := FSP^.AISSTRNG END (*STRGTYPE*) ; FUNCTION DECSIZE(*I: INTEGER): INTEGER*); "BEGIN DECSIZE := (TRUNC(I*3.3VAL.VALP^; VAL.VALP := LVP END; FVALU := VAL; INSYMBOL END ELSE BEGIN SIGN := NONE; IF (SY = ADDOGE THEN BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END ELSE BEGIN FMIN := 0; IF FSP = CHARPTR THEN FMAX := 255 ELSE  BEGIN NEW(LSP,ARRAYS,TRUE,TRUE); LSP^ := STRGPTR^; LSP^.MAXLENG := LGTH; LSP^.INXTYPE := NIL; NEW(LVP); LVP^ := 4  1,FSP2: STP) : BOOLEAN*); VAR NXT1,NXT2: CTP; COMP: BOOLEAN; LTESTP1,LTESTP2 : TESTP; BEGIN IF FSP1 = FSP2 THEN MPTYPES(NXT1^.IDTYPE,NXT2^.IDTYPE); NXT1 := NXT1^.NEXT; NXT2 := NXT2^.NEXT END; COMPTYPES := COMP AND (NXT1 = NIL) ACOMPTYPES := TRUE ELSE IF (FSP1 = NIL) OR (FSP2 = NIL) THEN COMPTYPES := TRUE ELSE IF FSP1^.FORM = FSP2^.FORM THEN CASE FSP1^.FORM OF SCALAR: COMPTYPES := FALSE; SUBRANGE: COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,  FSP2^.RANGETYPE); POINTER: BEGIN COMP := FALSE; LTESTP1 := GLOBTESTP; LTESTP2 := GLOBTESTP; WHILE  SUBRANGE THEN COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2) ELSE IF FSP2^.FORM = SUBRANGE THEN COMPTYPES := COMPTYPES(FSP1,FSP2^.RANGETYPE) ELSE COMPTYPES := FALSE END (*COMPTYPES*) ; " "PROCEDURE GENBYTE(*FBYTE: INTEGER*); RUE; LTESTP1 := LASTTESTP END; IF NOT COMP THEN BEGIN NEW(LTESTP1); WITH LTESTP1^ DO BEGIN ELT1  BEGIN CODEP^[IC] := CHR(FBYTE); IC := IC+1 END (*GENBYTE*) ; PROCEDURE GENWORD(*FWORD: INTEGER*); BEGIN IF ODD(:= FSP1^.ELTYPE; ELT2 := FSP2^.ELTYPE; LASTTESTP := GLOBTESTP END; GLOBTESTP := LTESTP1; IC) THEN IC := IC + 1; MOVELEFT(FWORD,CODEP^[IC],2); IC := IC + 2 END (*GENWORD*) ; PROCEDURE WRITETEXT; "BEGIN $MO COMP := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE) END; COMPTYPES := COMP; GLOBTESTP := LTESTP2 END; LONGINT:VELEFT(SYMBUFP^[SYMCURSOR],CODEP^[0],1024); $IF USERINFO.ERRNUM = 0 THEN &IF BLOCKWRITE(USERINFO.WORKCODE^,CODEP^[0],2,CURBLK) COMPTYPES := TRUE; ,POWER: COMPTYPES := COMPTYPES(FSP1^.ELSET,FSP2^.ELSET); ARRAYS: BEGIN COMP := COMPTYP <> 2 THEN (ERROR(402); $CURBLK := CURBLK + 2 "END (*WRITETEXT*) ; " PROCEDURE WRITECODE(*FORCEBUF: BOOLEAN*); VAR CODES(FSP1^.AELTYPE,FSP2^.AELTYPE) AND (FSP1^.AISPACKD = FSP2^.AISPACKD); IF COMP AND FSP1^.AISPACKD THEN COMP := (FSP1^ BEGIN 6IF SIGN = NEG THEN 8BEGIN VAL.VALP^.LONGVAL[1] := - VAL.VALP^.LONGVAL[1]; :NEW(LSP,LONGINT); :LSP^.SIZE := DECSIZE(LGTH); :LSP^.FORM := LONGINT; :FVALU := VAL; :INSYMBOL 8END 4END 2ELSE 4BEGIN ERROR(106); SKIP(FSYS) END END; ND NOT STRGTYPE(FSP1) THEN COMP := (FSP1^.SIZE = FSP2^.SIZE); COMPTYPES := COMP; END; RECORDS: BEGIN NXT1 := FSP1^.FSTFLD; NXT2 := FSP2^.FSTFLD; COMP := TRUE; WHILE (NXT1 <> NIL) AND (NXT2 <> NIL) AND COMP DO BEGIN COMP:=COND (NXT2 = NIL) AND (FSP1^.RECVAR = NIL) AND (FSP2^.RECVAR = NIL) END; FILES:  COMPTYPES := COMPTYPES(FSP1^.FILTYPE,FSP2^.FILTYPE) END (*CASE*) ELSE (*FSP1^.FORM <> FSP2^.FORM*) IF FSP1^.FORM =LTESTP1 <> NIL DO WITH LTESTP1^ DO BEGIN IF (ELT1 = FSP1^.ELTYPE) AND (ELT2 = FSP2^.ELTYPE) THEN COMP := T.ELSPERWD = FSP2^.ELSPERWD) AND (FSP1^.ELWIDTH = FSP2^.ELWIDTH) AND (FSP1^.AISSTRNG = FSP2^.AISSTRNG); IF COMP A IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS) END END; FSP := LSP END (*CONSTANT*) ; FUNCTION COMPTYPES(*FSPEINX,LIC,I: INTEGER; BEGIN CODEINX := 0; LIC := IC; REPEAT I := 512-CURBYTE; IF I > LIC THEN I := LIC; 5   MOVELEFT(CODEP^[CODEINX],DISKBUF[CURBYTE],I); CODEINX := CODEINX+I; CURBYTE := CURBYTE+I; IF (CURBYTE =    EKCommand: E(dit, R(un, F(ile, C(ompile, X(ecute, D(ebug, I(nit, H(alt [I.4a]P')%$x512) OR FORCEBUF THEN BEGIN IF USERINFO.ERRNUM = 0 THEN IF BLOCKWRITE(USERINFO.WORKCODE^,DISKBUF,1,CURBLK) <> 1 THEN  ERROR(402); CURBLK := CURBLK+1; CURBYTE := 0 END; LIC := LIC-I UNTIL LIC = 0; END (*WRITECODE*) ; "PROCEDURE FINISHSEG; VAR I: INTEGER; BEGIN IC := 0; FOR I := NEXTPROC-1 DOWNTO 1 DO &IF PROCTABLE[I] = 0 THEN (GENWORD(0  PROCEDURE BLOCK(*FSYS: SETOFSYS*);  LABEL 1;  VAR BFSYFOUND: BOOLEAN;  "PROCEDURE FINDFORW(FCP: CTP); $BEGIN &IF FCP <> NIL THEN (WITH FCP^ DO *BEGIN ,IF KLASS IN [PROC,FUNC] THEN .IF PFDECKIND = DECLARED THEN 0IF PFKIND = ACTUAL THEN 2IF WRITECODE(TRUE); SEGINX := 0; CODEINSEG := FALSE END (*FINISHSEG*) ;  FORWDECL THEN 4BEGIN 6USERINFO.ERRNUM := 117; WRITELN(OUTPUT); 6WRITE(OUTPUT,NAME,' undefined') 4END; ,FINDFORW(RLINK); FINDFORW(LLINK) *END $END (*FINDFORW*) ; " BEGIN (*BLOCK*) IF (NOSWAP) AND (STARTINGUP) THEN 'BEGIN )BODYPART(FSYS,NIL); )EXIT(BLOCK); 'END; %IF (SY IN [UNITSY,SEPARATESY]) AND (NOT INMODULE) THEN 'BEGIN )UNITPART(FSYS + [UNITSY,INTERFACESY,M A B h h O^IMPLESY,ENDSY]); )IF SY = PERIOD THEN EXIT(BLOCK) % END; %NEWBLOCK:=TRUE; %REPEAT 'IF NOT NEWBLOCK THEN )BEGIN +DP := FAf/ELSE IF (SY = BEGINSY) THEN 1BEGIN ERROR(13); FINISHSEG; EXIT(BLOCK) END; +IF SY = BEGINSY THEN INSYMBOL ELSE ERROR(17); +REPEAT -BODYPART(FSYS + [CASESY] - [ENDSY], TOS^.DFPROCP); -BFSYFOUND := (SY = TOS^.BFSY) OR (INMODULE AND (SY = ENDSY)); -IF쓡*SYSTEM.EDITORˡ% Restarting... U not allowedV Running...:Rád4@45$N<) &ELSE & GENWORD(SEGINX+IC-PROCTABLE[I]); GENBYTE(SEG); GENBYTE(NEXTPROC-1); SEGTABLE[SEG].CODELENG := SEGINX+IC;  -IF TOS^.PREVLEXSTACKP^.DFPROCP = OUTERBLOCK THEN /IF (SY = ENDSY) THEN 1BEGIN FINISHSEG; EXIT(BLOCK) END  .á .CODE:98:9LSE; STMTLEV := 0; IC := 0; LINEINFO := 0; +IF (NOT SYSCOMP) OR (LEVEL>1) THEN FINDFORW(DISPLAY[TOP].FNAME); +IF INMODULE THEN6   )END 'ELSE )BEGIN DECLARATIONPART(FSYS); +IF LEVEL = 0 THEN -IF SY IN [UNITSY,SEPARATESY] THEN /BEGIN 1UNITPART(FSYS ); "CURBLK := 0; CURBYTE := 0; WRITECODE(TRUE) END (* PASCALCOMPILER *) ;  BEGIN (* SYSTEM *)  END. + [UNITSY,INTERFACESY,IMPLESY,ENDSY]); 1IF SY IN [PROCSY,FUNCSY,PROGSY] THEN DECLARATIONPART(FSYS) /END % END; %UNTIL TOS = NIL; ! FINISHSEG; !END (*BLOCK*) ;   BEGIN (* PASCALCOMPILER *) "COMPINIT; "TIME(LGTH,LOWTIME); "BLOCK(BLOCKBEGSY NOT BFSYFOUND THEN /BEGIN 1IF TOS^.BFSY = SEMICOLON THEN 3ERROR(14) (*SEMICOLON EXPECTED*) 1ELSE ERROR(6); (* PERIOD EXS+STATBEGSYS-[CASESY]); "IF SY <> PERIOD THEN ERROR(21); "IF LIST THEN BEGIN SCREENDOTS := SCREENDOTS+1;  SYMBUFP^[SYMCURSOR] := CHR(EOL); SYMCURSOR := SYMCURSOR+1; PRINTLINE END; "USERINFO.ERRBLK := 0; TIME(LR (SY IN BLOCKBEGSYS); +IF NOT BFSYFOUND THEN -BEGIN /IF TOS^.BFSY = SEMICOLON THEN ERROR(14) /ELSE ERROR(6); (*PERIOD EXPECGTH,STARTDOTS); LOWTIME := STARTDOTS-LOWTIME; UNITWRITE(3,IC,7); IF DLINKERINFO OR CLINKERINFO THEN $BEGIN SEGTABLE[SEG].SETED*) /DECLARATIONPART(FSYS); -END +ELSE -BEGIN /IF SY = SEMICOLON THEN INSYMBOL; /IF (NOT(SY IN [BEGINSY,PROCSY,FUNCSY,PRGKIND := 1; &WRITELINKERINFO(TRUE) $END; "CLOSE(LP,LOCK); IF NOISY THEN WRITELN(OUTPUT); WRITE(OUTPUT,SCREENDOTS,' lines'OGSY])) AND 2(TOS^.BFSY = SEMICOLON) THEN 1IF NOT (INMODULE AND (SY = ENDSY)) THEN 3BEGIN 5ERROR(6); SKIP(FSYS); 5DECLARATI); IF LOWTIME > 0 THEN WRITE(OUTPUT,', ',(LOWTIME+30) DIV 60,' secs, ', ROUND((3600/LOWTIME)*SCREENDOTS),' lines/min'); ONPART(FSYS); 3END 1ELSE GOTO 1 /ELSE )1: BEGIN 3WITH TOS^ DO 5BEGIN 7IF DFPROCP <> NIL THEN  IF NOISY THEN $BEGIN &WRITELN(OUTPUT); &WRITE(OUTPUT,'Smallest available space = ',SMALLESTSPACE,' words'); $END; "IC := 09DFPROCP^.INSCOPE:=FALSE; 7IF ISSEGMENT THEN 9BEGIN ;IF CODEINSEG THEN FINISHSEG; ;IF DLINKERINFO AND (LEVEL = 1) THEN =BEGIN SEGTABLE[SEG].SEGKIND := 2; ?WRITELINKERINFO(TRUE) =END ;ELSE =IF CLINKERINFO THEN ?BEGIN SEGTABLE[SEG].SEGKIND := 2; AWRITELINKERINFO(FALSE) ?END; ;NEXTPROC:=SOLDPROC; ;SEG:=DOLDSEG; 9END; 7LEVEL:=DOLDLEV; 7TOP:=DOLDTOP; 7LC:=DLLC; 7CURPD(SEGTABLE[SEG].SEGKIND); "FOR SEG := 0 TO MAXSEG DO GENWORD(SEGTABLE[SEG].TEXTADDR); "FOR LGTH := 1 TO 80 DO $IF COMMENT <> NIL THEN GENBYTE(ORD(COMMENT^[LGTH])) ELSE GENBYTE(0); "FOR LGTH := 1 TO 256 - 8*(MAXSEG + 1) - 40 DO GENWORD(0PECTED *) 1SKIP(FSYS + [TOS^.BFSY]); 1BFSYFOUND := (SY = TOS^.BFSY) OR (INMODULE AND (SY = ENDSY)) -END +UNTIL (BFSYFOUND) OMAXSEG DO WITH SEGTABLE[SEG] DO FOR LGTH := 1 TO 8 DO GENBYTE(ORD(SEGNAME[LGTH])); "FOR SEG := 0 TO MAXSEG DO GENWORROC:=POLDPROC; 5END; 3RELEASE(TOS^.DMARKP); 3TOS:=TOS^.PREVLEXSTACKP; 3NEWBLOCK:=(SY IN [PROCSY,FUNCSY,PROGSY]); 1END -END; "FOR SEG := 0 TO MAXSEG DO WITH SEGTABLE[SEG] DO BEGIN GENWORD(DISKADDR); GENWORD(CODELENG) END; FOR SEG := 0 TO 7   @#<PASCALSYUSERPROGFILEHANDDEBUGGERPRINTERRINITIALIGETCMD @k YALOE.CODEh MAKECOMP.TEXTXT MAKECOMP.CODEDE YADE.WRK.INFOZ,á)6!E *STK OFLOW*PEE*<>Já[Í: to continue) & XÍ ˫fn(ުP *@#ٕš ګ۫ š۫ ګ,.   ȡQɫ  ȡ .22ȡ7233 ȡ 23aħ3zȄ 23aA22š*á ?:22ȡá;2á!2ȡ5252š[22š2222ȡ2š5252á4x4]11á4^1šX42233y 3042221ç42ç1Ä2*áɡ 럚肚Z ū  < áš < c@B B Ä $ B B >Ä!}áë ÄȄĄMȄqf /  !š Í 7ÄT ǐɄ96ń}ȡD ōɍ ō ȍ dč "쓡ë  쓡66! á } 횧 :˄˥ ! 8 ,} Ä{  , Ą:쓡"á ń á   uš  gá -Ä+  ɡ" 8"ë á 쓡 $Ꟛšr#á M    á +>ˡ88s ˄ 8sB$$>:&ˡ,ˡ sš sT%>ˡ.ˡ sš sJ&$>&:!E:E Eˡ EEJ'Jɡ š˄  `" R (  d˯7 H ȡ   0 H" ġ    .ȡ? ȡ  ġ  á ġMáš3 삫 d #( - Íá444ńi55P.TEXTF.CODE4.INFO".GRAF.FOTOˡ!  ,ȫ, 넡, } ,Í1}šɡš  P&:*:azȄaA:)ń@ 񂾲y 񂾂0 ń Ȅ! }ÍV}M 9  /"ˡ ( ! 767l 9S328˄ Vá " *áá0 šá  d</ dÍÍˡ 퓄 Ä퓡  dÄÍ" ˄"ɡ  dá dá C#C˄ C    á&á } -/18 Ȅ.ń0á š肂蕿BšT뾕ȡ4 š킥뾞<X h6!áá#Q삫Ú< š ^ "á50.*6* p 8>8`(Tp&Z*Ft`p^:p 6 ^/ ɚ j š "ˡ8ENo user program linked inP8E8:98:9ˡ á uá%!Ȅ 隹Já-Ä  >   EKCommand: E(dit, R(un, F(ile, C(ompile, X(ecute, D(ebug, I(nit, H(alt [I.4a]P')%$x   "ˡ  8 쓡*SYSTEM.EDITORˡ% Restarting... U not  Q š *š  4V j ɡ 逫-á-32768 Rġ?n00ń0ˡ nɡa Mȡ龫š 龕龫!낾   EKCommand: E(dit, R(un, F(ile, C(ompile, X(ecute, D(ebug, I(nit, H(alt [I.4a]P')%$x  2 d?š !삾 0 á3á+   T p꾂ȡ龞꾂(ń꾂Ȅ4š뾂á뾞뾂NPń /šá.Ą ɡ 낫š땫Ě8ENo debugger linked inP8E4:98:9g>@ << á6铡,B BBallowedV Running...:Rád4@4=,<:  *SYSTEM.MISCINFOP+"á,+ ́ʁ>+>ʁJ+J ++gn  ȡ,}ؤۦۢCurrent date is C -C-C System re-initialize0ۢ ؞&}CONSOLE}SYSTERM???}?á';??쓡*SYSTEM.EDITORˡ% Restarting... U not allowedV Running...:Rád4@4=,<ǀ"áʅʅūʅ  ʅ  ̆%ʆ%ȡ   ̆%ʆ%ȡƂ  }GRAPHIC :.8ǀ ?̆%ʆ%ȡƄؤ8ؤ ƅ )FJJ "rflow(Integer overflow(Divide by zero(NIL pointer reference(Program interrupted by user(Syste77::9988:9  6m IO error( unknown cause( parity (CRC)(illegal unit #(illegal IO request(data-com timeout(    -&.???&š&:&(*SYSvol went off-line(file lost in dir( bad file name(no room on vol( vol not found(file not foTEM.WRK.TEXT(   & & š&:(*SYSTEM.WRK.CODund( dup dir entry(jfile already open(Q file not open(<bad input format($F4 wE(&X:: #P7 :dM: IO error: (Unimplemented instruction(Floating point error(rString overflow([Programmed HALT(DProgrammed break-point(& fE0lWBS#  , P#  , I#  |Dj, vol not found(file not foSep Oct Nov Dec ?????????6!:%$ )8P Welcome ?, toU.C.S.D. Pascal System I.4ad!  FebMarAprMayJunJulAug ٟá'C &"á}PRINTER&"á}REMOTEƅ*SYSTEM.CHARSET(ƅʅUnknown run-time error(Value range error(No proc in seg-table(Exit from uncalled proc(Stack ove6ë???JanFebMarAprMayJunJulAug +ƁW`DsDsD nn ndnn'ýʁʁʁ9CONSOLE:(:9SYSTERM:(8:98;   EKCommand: E(dit, R(un, F(ile, C(ompile, X(ecute, D(ebug, I(nit, H(alt [I.4a]P')%$x쓡e}8ڡ0ˡ$ No dir on  :" : not block unit  : not *SYSTEM.EDITORˡ% Restarting... U not allowedV Running...:Rá RáEHá63CX, #%"$(*m ? 8:9  P'*SYSTEM.WRK.CODEP񓍡,*SYSTEM.LST.TEXTP  .&ءNew workfile createdGetťȄ .&ڪP--ˡ>-áIllegal file nameNo file Oˡ not cod Oct Nov Dec ?????????  &SYSTEM.WRK.TEXT SYSe{/@"ˡ Bad block #0R.P.PȡB.. č/O`.Q/.RQQRQR.TEM.WRK.CODE  D ؕɄ?Í( `&. W *SYSTEM.COMPILER:&( "ˡLost wParity (CRC) errorBad unit numberBad IO operation Timeout errorVol went off-liorkfile!*SYSTEM.SWAPDISK(7*SYSTEM.WRK.CODE[*]("ˡCode open error!D  neFile lost in dir Bad file nameNo room on volNo such vol on-linehFile not   Compiling...ث No workfileB * 7:& š: š&%*SYSTEM.EDITOR~&ǀW% Running...:áExecute: what file?  Nb'bN !'A :-"ݪܪ:''3(((<( what volE(:š.ť ; Bad vol name  šmon-line:'r  @X Workfile is .š . not named񄓡 (not saved) No workfile 񄓡8Throw away current workfile? )Yˡؓ'*SYSTEM.WRK.TEXT???JanFebMarAprMayJunJulAug SepbáF: what file? b&bš}b,b bɡNb'bš9.á .CODE:98:9  foundO Dup dir entry7 Filer error!! @% ~bK5# lڪAN' <  2. Must save on system disk for nowN*SYSTEM.WRK.TEXT'N8 d&..TEXT"Output file fullń-Put in  :(:&!Lost workfile! Y*..CODEPOld code removed, Text  and N*SYSTEM.WRK.CODE'N8 d..CODELost workfile! Code  file saved  ChangeꥀAءbbšbáp xPrefix titles by š š;  Prefix is ;:bض%Í1ؓ$(% :TٕڶšڸšAޡ9 exists...remove it? )YáޓK: changed to ڂ4< UNUSED >    ^Dir listing of  dšNonsenseޡVol already on-line~} 2  ȡ٤  ۂ  šD  -- ! : changed to  : ءbbšbá (02  ءá    ILLEGALPpBad diskPvCodefilePfTextfilePVInfo.TEXT A:&A &.CODE^" RemoveN"襀Ä% :  ȡU آ A:A Text  and Code .No  file loaded%.Illegal workfile name,  J!Workfile already savedNo workfile to save?..ؓ2Save as 㧀ÄUò}ńB Risk dir of  : ? )Yˡ !觀Äš"Ä^Rڡ.Put in :(" * transferred to  : !òCń!C"ۡbbšbár(*,.-L MakeEN"3򕫀"A made"To襀ń. Á$Ɓ$ Ɓ$:Ɓ$Ɓ$A襀ńáNonsensebáB Transfer楀N"襀"ToN" .? )Yء!Save as ..ò.ō'.Illegal workfile name?? )XáTYˡ" )"A removedbš=  B  %Volumes on-line: ȡ}}پšh ٲ? * C  ?á CBad date6}%Examine blocks on4ٲ; P  #   :% Bad blocks scan of}́ʁȡKˡ2Block   is bad  bad blockss Zero dir ofˡ5Destroy  : ? )YˡDuplicate dir? )Y ʂʂ ʂ ١,Try to fix them? )Yˡ̂ʂȡBlock  ƁƁƁ"á "Ɓ  may be ok& is badɡ blocksNew vol name? P&á:á åō:Í Bad vol namešɡá/Block   is still badFBlocks   thru    C  : correct? )YˡBˡ Write error: zare still bad Mark them١ (may remove files!)? )Yˡ١1 ȡ$ؤ ̂ʂeroed š ړڥÍ' 6%E/Date set: <1..31>-<ʂĄ" Má    C BAD.xxxxx.BAD̂ʂġ$ ڕ߲nڤ0߲nڤJAN..DEC>-<00..99> OR P'Cá No current dateT Today is C -C ؤ ɡ #  marked>sn,.%Crunch-C   New date? P&yܡ 0 ܓōɍN ' ȡ=؂áazȄ aAAZȄfilePFDatafileP6GraffileP&FotofilePxj\N@2$   AaN؂ݿ ťۤNáyܡ 0ܓšC dCۻCڻ New date is C -C-Block number-range?   0  ɡހɡ  ɡ)Risk the dir? )Yˡ ̂ʂȡؤ ̂ʂʂĄbٓ%File(s) endangered:ʂ   # of blocks:! (floppy=494, RK05=4800)?  &ɡ Bad #ȡؤ  ńMoving  SYSTEM.PASCAL ? ޕšš  files,   blocks used,   unusedء,,   in largest area Are you sure:. you want to crunch  :? )Yˡ:  >   پعE٢J٢=٢.٢!٢ MB7*x ꂾ ꂾ 짃áܕ܂ܕ܂  肾 ނނ݂ ȡd܂"ˡERead error, rel  , abs  ނނ݂ ȡd܂"ˡEWrite error, rel ٕ , abs  ݂áٚڂ  : crunchedߡ Please re-boot:Vaye& Please press to continue. áRۂ8ۂáۂ ۂ á ܕR`ۥ  ۂ  ۂڞڂ ˡ bG | xtoje a ]Y UQMIEA=9BZ25> X!Q9ZG  !Uقčy^ 肾 á ܂ ܂áŧؓOlK(Gp?0GQáF $  & P$8`J" Z"r"2 ݂áɍš  ٚáء  e  ݂ ݂ɡ ݂ ݂  \z f+ EDITOR ەݕ ; Z-š 0ۍ INITIALIOUT COPYFILEENVIRONMPUTSYNTAEDITCOREN bx$Xl~l6jXlRepeatfactor > 10,000 \ 낾 á 킫8ڕ $lڪP--ˡ>-áIllegal file nameNo file Oˡ not code{/@"ˡ Bad block #0R.P.PȡB..č/O`.Q/.RQQRQɡ š    ڶ>˄KڶPá4ڶZjڡ?١ 1ۥ č%`ȡ3Fڤá ZڤġZڤZڤ؂ ħɄ ؂ Tfګꂾ ء8FP    ￥FP(  ٪P&áERROR: á;EIFiler: G(et, S(ave, W(hat, N(ew, L(dir, R(em, C(hng, T(rans, D(ate, Q(uitP')EP á%'x ڂ ٕ ݞ݂ ˡ !UPá#ڶNáڶNá ڤjڳ * >پˡjKThere is no room to copy the deletion. Do you wish to delete anyway? (y/n)P Yá*ڕ񧁠?  Xxġۂoەoەە "ȡTFܤåZܤĄZܤȄ-á Fܤ n   CC9tتP:,,š,*á.:.&-FܤZܤZܤە.j %á   ۂ ۂɡ-%ߡRan out of disk roomߓÍɡɄ ڕڕڂ ȡ*FޤáZޤZޤڕ ڕ  á ۂ ۂɡ-%ߡˡReading Page Zero / /ȡ"F F   ˡWriting Page ZeroRan out of disk roomߓ𧁡ńɄ٫  š6ꕞ߂ŧȍ0 á܂  ۂ܂ߞ á<肾á /ꂾ ꂾÍꕚꕫ H#ƁƂƁƂ   šá ߂  á߂߂܂܂܂  nHr ٪P á  á :ƁƁYB*>XvH f * D 2< 6f what marker? -P,-V,Vȡ-,-, ,,-- -- ~*B J%ڕ ڕ  á ۂ ۂɡ-%ߡ E Bad disk transfer. $ۓKá$oˡ$"oRan out of disk roomߓ𧁡ńɄ٫  š6ꕞˡ$ۓf"çȄçĄۓKá$oˡ$"oˡ$ۓr!šáǸ ބv!ޡjo o܂ٞȡ/FݤáFZݤZݤ܂ق.ܫڂǸ ބ|!ޡpo oٕ٤ؚٳ قؚ. ؾ ȡض ض    .TEXTؾؾĄ ؾP.TEXTUPP.BACKUPVˡc ~^򫃂  -- d-.8.:hڲ5$55&Ɓ3"ˡCan't open backup file! ڧɡ#Not enough room for backup!  Copying to ڧ 肾á肾  肾-á á@肾  Ä á  á :ƁƁYB*>XvH f * D 2< 6fٕٞȡ1FݤáFݤZݤZݤ܂.ܕۂ镫ܑ۫۞kꕚꕫ H#ƁƂƁƂ   šá@  ent. File? ( for no file ) P P á *SYSTEM.WRK.TEXTP   "ˡˡˡ"ˡ܂܂á̂2ʂ2ȡ,FۤġFۤFۤP"ˡSystem volume not on line5ˡ File system terminal error?&SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE*SYSTEM.WRK.TEXTI Not present. File? P"á𥁤  Í >ĴGʂGʂGʂG Improper marker specification. 0肶肶##@Marker exceeds file bounds. :蕕,[á$ ʂGȡܤA09̂GʂGȡܤA    oV F P3Qo9l(H0  Щ  Щ]ɍٲˍ.ڕ.P..P,á?&SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE*SYSTEM.WRK.TEXTI ؕ     ۂە ..ȡۂۂ ."ˡBad input file.ˡ@ˡRan out of room."ˡOn backup file.ققNot present. File? P"á𥁤  Í >ĴGʂGʂGʂG áîګ ^>Edit:ReadingتP:,,š,*á.:.&--- d-.8.:?h ؚˡ Reading file.h  ABCDFIJLM N P Q R SVXZ,>.+-?/=<>á(PNPNV   09̂GʂGȡ *    Ʉ?Í ɡ >Eáyšb"á<-Backup file not present (tried to remove it).Writing Cáš LPAGE+1>RPAGE*򥁤ˡThe workfile, , is   blocks long.š&The backup file is Writing out the filerM`X^ ʂGʂG ʂG :̂GʂGȡܤܚAẐGʂGȡܤAaẑGle not updated)1 R(eturn to the editor without doing anything $ RáEdit:T ̂GƂGƂG:ƂG&ƂGP "ˡWorkfile lost.4No workfile is pres F>Quit:PF# U(pdate the workfile and leave% E(xit (but workfiA   ĶɄ , ک߶ߤ . ڳ@?T or Fȡ TáTrue  Marker not there. ٲgߤزSߤá h  x   з   з T=ˡ з     з     Ƃ=ƃi& Copy: From what file[marker,marker]? P ƂPƂá Ƃ=Ƃ# Copy: File not present. Filename? PT-RL?  "$&(*,.C2468:<>mBFHJlNSet tabs:  C(ol# {N(o R(ight L(eft D(ecimal stop} ȡHn(--L#"ˡ Disk Error.Ƃ=Ƃ=ePXr*l$  з  RD/'Column #   P a з T=ˡ з     з     Ƃ=ƃiCá   ?á ؕ -á ؂ á$ & Copy: From what file[marker,marker]? P ƂPƂá Ƃ=Ƃ# Copy: File not present. Filename? P A(uto indent ~ F(illing  L(eft margin   R(ight mar"á CopyP  Ⓞ ڕɄ čⓄ% Ʉ gin   P(ara margin   C(ommand ch  S(et بáNONE Ä ChristmasÄ New Years Ä Hal.ȡ ۂ ۂ ..ȡۂۂ .TEXT˲ȍ.˄"..P..TEXTU.P.á ȡIٕڂġ%Buffer overflow. SeptemberPNOctoberP?NovemberP/DecemberP wmcWH;-  ,  l !#BcT  ȡ,ءTrueFalseFalse Y  # ڳɡ ڂ0   ع7-n{nnnan"á CopyP  Ⓞ ڕɄ čⓄ% Ʉ loweenJanuaryPFebruaryPMarchPAprilPMayPJunePyJulyPmAugustP_  قڞڂV= ˸ "ˡ$Bad disk transfer .  tabstops  T(oken def   bytes used,   available.B   There are   pages in the left stack, and   pages in the right stack. You . Type  á   Ƃ #%do7  + Environme have   pages of room, and at most   pages worth in the buffer.  Patterns:1 = 'ǀ'- , = '[ǀ'š Markers: ȡ Ft, E(nd of the file. P  اdاˡ Fá  cBá  TSá#š ,Eá'ɡ اˡ =g $! Copy:  Created ; Last updated  (Revision  ).o7  + EnvironmeB(uffer F(rom file P  DBá𧁡駁 ŧĄ Invalid copy.駁ġnt: {options} to leaveP    J Not option ~No room见ħɄ肧 肧駁见#见#  z dT >  Fá< LeapingFȡ-ťF˄0AT(@ p"P<   "TrxV|"d    /ɥF˄ 2a Jump to з ٧ Created ; Last updated  (Revision  ).o7  + EnvironmeSyntax Error #P  . Type >Ƃ ƃ7Ƃ *SYSTEM.SYNTAX"ˡ mȡ- ȡ ǜȡ ȡ Ƃ ˡ á d d   0 0 0Má اˡا$ h ~Inappropriate environmentP  áȡEaق) ٤ áá><&% Banish: To the L(eft or Right P  ااˡ Lá Rá اˡ ` J Next: F(orwards, B(ackwards in the file; S(tará  !Fȡ <>˶Ä   $ JUMP: B(eginning E(nd M(arker P  Bá)Eá0 : ق  قؕ؞ق ق ق   قÍ قáI ؕDؕ ٤ ٤  Not there.VF٤ˡ F٤ˡMarker all messed up. Z٤ C  ڶȡ5No insertion to back over.   mڶġb4Please finish up the insertion    háOȡ% ˡܡ    á ڶ šBuffer Overflow!!!!  á( nɄض 肶 BV ~!ꂾ á ^áEMarker overflow. Which one to replace? (Type in the letter or ) P AJ Íɡf ġꕞ$핂ꕞ 삿^á"4E r Set: E(nvironment M(arker P  EáMá اˡا ! á.!~ō?   H~o< eXchange: TEXT { a char} [ escapes; accepts]P           á   ǀd ؂ȡ ؂ġ  ؂á5š.؂肾] áP肾 ˄;?š!  ؂  P  ɡ          š   ˡ؂肾á٫؞ǀ 6蕀PšqL WARNING! You aZ-    ٕاġ-á- ؕ  ؕ قre about to zap more than 80 chars, do you wish to zap? (y/n)P  Yˡ   E š 蕞 蕕ɡ!No room to insert.  j~˄'  肫肶ˡPšǀ3á ǀ }á$ȡ  á ĄÄ˄Ąۄy á áث4*   Ʉګ ڂ ڂ٥ č9h  ^ġ)š !(šsSet з Pȡ٤ ؤZؤ蚥FؤاáHu H Insert: Text { a char, a line} [ accepts, escapes]P  肶~Ä  Í  ؞ق ~٫ګ    U ؂ \  D  ()؂ɡ낾Ä؂ išꕞ/dšBuffer overf šٮ! ݮ./    @ Delete: < > { to low* ꕞˡꕫ؂ +  K Adjust: L(just R(just C(enter { to leave}P  á  á   0á<>  ȧd' Tá+átÄ S ٕ܄ɡ ق蕞 قٕٕ  ث ٕ٫ ö ݓ0á0 á*- á á +- áڕ+ڕ앧+ ˡá۫k *  ö oD1 12 Lá 1Vá 1 Tá  ) <öÍ   ˄ "ńȡv >á&%>á* nɄnń۶ >á&%}    ɡ"Tb# Ȅ5 ɡ5S ,  M(<)8<á()+ $ .,20. 46ášĶ "      $ńD%l&h<á%&[#W$S'NšToo many'0,, $* IGb`& Of Í 9 肾 á    ɡ"it% Ʉ: á šĶ "   &<áTń1肾 á 肫ġ  ø ɡ"zɄ2 O Z.ȡˡˡȡ ȡ 4` x! š ɡ/ńdelete, to abort}P   á   vK%e&a<á%&T#P$L'Gá<>",13B@[YH_ٕ /˄ J ܹ-+1ڕ+$ڕ앧+ 4-"á+wá +e!P  /-ȡGڂ á-ń ۂڂɡáĸ š#Ķ Í "    '}á1áá  Cá1á  á  E  á   5  Y}w 7ǀ ڶr š  @Yá@FindingP>á    Mٓ0ń&ۡ á 9ض     á   5  Y}w 8   á Z: Ʉ öɄ   Ʉ á    l  ~|xtplh HD[ ˡ>  t ǀ  š 5 á~Aáoj  ˄ ȍ* J \j0\| : @T&< !z!`"##>$%x'&&6(&(h)*6+z|><]L Edit: A(djs  á ȥ  Ä> R9.۪PڪP.P [t C(py D(lete F(ind I(nsrt J(mp R(place Q(uit X(chng Z(ap [L.2]P  zá  á / ]: ء# áL(it T(okv<}  Replace MOVECODEMOVECODEMOVECODEHERE LINKER VAR1 VAR2 A B r  O^' aborts, 'R' replaces, ' ' doesn't<á Rr˄ šZš8 1 VTÍLÍ2SsÍV^32L'Invalid delimiter. 1á+ۂ ń  ۂčġ-Your pattern is too long Å 4۶ۂۂÄ۶%05  á.sub> =><123ʀ 4 á12̀3ʀ [4ç ç ȧل9١ ߂ á=<á  >çɄ<çńۡY`4End of Buffer encountered. Get more from disk? (Y/N)PPattern not in the fileNo old pattern.  3kjqs$<]L Edit: A(djst C(py D(lete F(ind I(nsrt J(mp R(place Q(uit X(chng Z(ap [L.2]P  zá  á@ ;     á:;>á87y  e á:;   6駁见 D=̀̀  á Find =><& Replace V(fy <66ǀ ٶr ġ   ض á 9 ؂    Buffer full. Aborting Replace 蕞ɡ蕞[ˡ F  "WRITELN('i.e. SYSTEM.PASCAL, or enough room (60 blocks) to re-create it,'); "WRITELN('it will terminate with the cryptic messNGTH(TITLE) = 0 THEN EXIT(PROGRAM); $OPENOLD(INFILE,TITLE);  IF IORESULT <> 0 THEN &OPENOLD(INFILE,CONCAT(TITLE,'.CODE')); "UNTIL IORESULT = 0; "OPENOLD(SOURCE,'SYSTEM.PASCAL');  IF IORESULT <> 0 THEN ERROR; "{$I+} "{read in SYSTEM.PASCALs se PROGRAM BINDER;  CONST  MAXSEG = 15;   TYPE "SEGNUM = 0..MAXSEG; "SEGTBLP = ^SEGTBL; "SEGTBL = RECORD -SEGDESC: ARRgtable} "{read in SYSTEM.PASCALs segment 0} "{read in named files segtable} "{read in named files segment 1}  IF BLOCKREADAY[SEGNUM] OF 8RECORD :DISKADDR: INTEGER; :CODELENG: INTEGER 8END {SEGDESC}; -SEGNAME: ARRAY[SEGNUM] OF 8PACKED ARRAY[0..7(SOURCE,TABLE^,1,0) <> 1 THEN ERROR; "WITH TABLE^.SEGDESC[0] DO " BEGIN &ZEROBYTES := CODELENG; &BLOCKS := (CODELENG + 511)] OF CHAR; -STUFF: PACKED ARRAY[0..319] OF CHAR +END {SEGTBL}; +  BUFFER = PACKED RECORD CASE INTEGER OF )1: ( BYTES: PA DIV 512; &IF BLOCKREAD(SOURCE,ZEROBUF^,BLOCKS,DISKADDR) <> BLOCKS THEN ERROR;  END; CKED ARRAY[0..10239] OF 0..255); 2: ( WORDS: ARRAY[0..5119] OF INTEGER) #END {BUFFERS};  VAR  CCH: CHAR; "ZEROBYT"IF BLOCKREAD(INFILE,TABLE^,1,0) <> 1 THEN ERROR; "WITH TABLE^.SEGDESC[USERSEG] DO $BEGIN &USERBYTES := CODELENG; &BLOCKS :ES,USERBYTES: INTEGER; "TABLE: SEGTBLP; ZEROBUF,USERBUF: ^BUFFER; "HEAPPTR: ^INTEGER; "SOURCE,INFILE: FILE;   PROCEDURE ERROR;  BEGIN "WRITELN(' ERROR '); "EXIT(PROGRAM);  END;   PROCEDURE GETFILE;  {$I-}  CONST "USERSEG = 0;  VAR "BLOCKS: INTEGER; "TITLE: STRING;  BEGIN "WRITELN; "WRITELN('This program modifies the SYSTEM.PASCAL of your default prefix'); EROBUF^, and &point LINKER at it.}  VAR "CODESIZE,CODEAT,ENTERIC,CODEBASE: INTEGER;  INPPOINT: INTEGER;  BEGIN "{set inp"WRITELN('disk. If any of the files it expects to be around are missing,'); age "ERROR"'); "writeln; "writeln('You also need to execute the program SETUP to get the system to'); "writeln('work intelligently with your terminal.'); "WRITELN; "REPEAT $WRITE(' File with GOTOXY(X,Y: INTEGER) procedure:'); $READLN(TITLE); $IF LEROCEDURE MOVECODE;  CONST $INPNUM = 2; $OUTPNUM = 29; "{Move procedure #2 from buffer USERBUF^ to &procedure #29 buffer Z= (CODELENG + 511) DIV 512; &IF BLOCKREAD(INFILE,USERBUF^,BLOCKS,DISKADDR) <> BLOCKS THEN ERROR; $END;  END {GETFILE};   PG  PROCEDURE LINK0; $BEGIN &WITH INTBL^,SEGDESC[0] DO (BEGIN ,NBLOCKS := (ZEROBYTES + 511) DIV 512; ITELN(' Moving procedures around '); "MOVECODE;  RELEASE(HEAPPTR); "USERBUF := NIL; "TABLE := NIL; "CLOSE(INFILE); "WRIT,IF BLOCKWRITE(CODE,ZEROBUF^,NBLOCKS,OUTBLOCK) <> NBLOCKS THEN .ERROR ,ELSE .BEGIN 0CODETABLE^.SEGNAME[0] := 'PASCALSY'; 0point to location of proc offset in source} "INPPOINT := (INPNUM*2+2); "{set codebase to where proc 'starts' in source} "CODEBASE := USERBUF^.WORDS[(USERBYTES DIV 2) -(INPNUM+1)]; "{get enteric from source} "ENTERIC := USERBUF^.WORDS[(USERBYTES-CODEBABLOCK := OUTBLOCK + NBLOCKS .END (END; $END; " "PROCEDURE LINKIT; $BEGIN &WITH INTBL^,SEGDESC[SEG] DO (BEGIN *NBLOCKS := (CODELENG+511) DIV 512; *IF BLOCKREAD(INFILE,BUF^,NBLOCKS,DISKADDR) <> NBLOCKS THEN ,ERROR *ELSE ,IF BLOCKWRITE(CODE,BUF^, lex level to zero} "USERBUF^.BYTES[USERBYTES-CODEBASE-(INPPOINT-1)] := 0; NBLOCKS,OUTBLOCK) <> NBLOCKS THEN .ERROR ,ELSE .BEGIN 0CODETABLE^.SEGNAME[SEG] := SEGNAME[SEG]; 0CODETABLE^.SEGDESC[SEG].CO"{number of bytes of code is enteric + 4 more bytes} "CODESIZE := ENTERIC + 4; "{code is located at ... } "CODEAT := USERBYTDELENG := CODELENG; 0CODETABLE^.SEGDESC[SEG].DISKADDR := OUTBLOCK; 0LENCODE := LENCODE + NBLOCKS; 0OUTBLOCK := OUTBLOCK + NBLES - CODEBASE - CODESIZE - INPNUM*2; "{make room for the code coming in} "MOVERIGHT(ZEROBUF^.BYTES[0],ZEROBUF^.BYTES[CODESIZE]OCKS .END (END; $END; $  BEGIN "IF LENGTH(NTITLE)>0 THEN $IF BLOCKREAD(INFILE,INTBL^,1,0) = 1 THEN $ELSE &ERROR; $LINK,ZEROBYTES); "{put the frigging code in} "MOVELEFT(USERBUF^.BYTES[CODEAT],ZEROBUF^.BYTES[0],CODESIZE);  {make a note of the0; $FOR SEG := 1 TO 15 DO &IF (INTBL^.SEGDESC[SEG].CODELENG > 0) THEN LINKIT; "CLOSE(INFILE)  END {LINKCODE} ;   BEGIN  fact that you have stretched the segment} "ZEROBYTES := ZEROBYTES + CODESIZE; "{point the appropriate word at the appropriate byte} "ZEROBUF^.WORDS[(ZEROBYTES DIV 2)-(OUTPNUM+1)] := OZEROBYTES - CODESIZE-(OUTPNUM*2);  END;  $  PROCEDURE LINKER(NTITLE,TITLE: STRING);   CONST "WINDOW = 2; "MARKCODE = 15; "MARKIN = 5; "   VAR LENCODE,NBLOCKS,RSLT,OUTBLOCK: INTEGER;ENOLD(INFILE,NTITLE); "LINKCODE; "IF BLOCKWRITE(CODE,CODETABLE^,1,0) = 1 THEN CLOSE(CODE,LOCK) "ELSE $WRITELN(OUTPUT,'Code file write error ')  END;   BEGIN "NEW(ZEROBUF); "MARK(HEAPPTR); "NEW(TABLE); "NEW(USERBUF); "GETFILE;  WRITELN; "WRELN; "WRITELN(' Calling system linker to create new SYSTEM.PASCAL'); "LINKER('SYSTEM.PASCAL','SYSTEM.PASCAL[60]');  END {BINDCODETABLE^.SEGDESC[0].CODELENG := ZEROBYTES; 0CODETABLE^.SEGDESC[0].DISKADDR := OUTBLOCK; 0LENCODE := LENCODE + NBLOCKS; 0OUTSE-INPPOINT) DIV 2 -1]; "{set procedure to appropriate number} "USERBUF^.BYTES[USERBYTES-CODEBASE-INPPOINT] := OUTPNUM; "{set := 0 TO MAXSEG DO &BEGIN SEGNAME[SEG] := ' '; (SEGDESC[SEG].CODELENG := 0; (SEGDESC[SEG].DISKADDR := 0 &END;  OP $INTBL,BUF: SEGTBLP; $SEG: SEGNUM; $CODETABLE: SEGTBLP; $CODE: FILE;   PROCEDURE LINKCODE; "VAR NBLOCKS: INTEGER;  ""LENCODE := 0; "NEW(CODETABLE); "NEW(INTBL); "OPENNEW(CODE,TITLE); "OUTBLOCK := 1; NEW(BUF); "WITH CODETABLE^ DO $FOR SEGH  6IF SEGDICT.SEGNAME[SEGINDEX] = LNAME THEN FOUND := TRUE 2 ELSE SEGINDEX := SEGINDEX + 1 2ELSE 4IF SEGDICT.SEGNAME[SEGINDE (* SWAPPING PASCAL COMPILER INCLUDE FILES *)  (*$C COPYRIGHT (C) 1978 REGENTS UCSD I.5.4*)  (*$T+*) (*$S+*)  (*$I COMPGLBLS.TEXT*)  (*$I INITDUMMY.TEXT*)  (*$I DECPART.A.TEXT*)  (*$I DECPART.B.TEXT*)  (*$I DECPART.C.TEXT*)  (*$I BODYDUMMY.TEXT*)  :BEGIN SEG := NEXTSEG;  MAXSEG THEN ERROR(250) :END; 8WITH SEGTABLE[SEG] DO :BEGIN DISKADDR := 0; CODELENG := 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 X] = ID THEN FOUND := TRUE 4ELSE SEGINDEX := SEGINDEX + 1; 0IF FOUND THEN 1 BEGIN USEFILE := SYSLIBRARY; 4BEGADDR := SEGDICT.TEXTADDR[SEGINDEX]; 4LSEPPROC := SEGDICT.SEGKIND[SEGINDEX] = 4; 4IF NOT LSEPPROC THEN 6BEGIN 8IF MAGIC THEN SEG := 6 8ELSE (*$I UNITDUMMY.TEXT*)  (*$I PROCS.A.TEXT*)  (*$I PROCS.B.TEXT*)  (*$I BLOCK.TEXT*)   *BEGIN FOUND := TRUE; ,IF LIBNOTOPEN THEN .BEGIN RESET(LIBRARY,SYSTEMLIB); 0IF IORESULT <> 0 THEN BEGIN ERROR(187); FOUND :=I  ENT) THEN ERROR(2) (ELSE *IF USING THEN ,BEGIN LCP := USINGLIST; .WHILE LCP <> NIL DO 0IF LCP^.NAME = ID THEN GOTO 1 0ELSENST THEN WITH DISPLAY[TOP] DO BEGIN LLP := FLABEL; REDEF := FALSE; WHILE (LLP <> NIL) AND NOT REDEF DO IF LLP^. LCP := LCP^.NEXT; .ERROR(188)(*UNIT MUST BE PREDECLARED IN MAIN PROG*); *1: ,END *ELSE ,BEGIN .IF MAGIC THEN 0BEGIN LNAME := 'TURTLE '; 2LSY := SY; LOP := OP; LID := ID 0END .ELSE 0BEGIN LNAME := ID; 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+[COMMA,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 ELSE SEGID := SEG 4ENDLSE ERROR(14) END (* LABELDECLARATION *) ; PROCEDURE CONSTDECLARATION; VAR LCP: CTP; LSP: STP; LVALU: VALU; ; 2ENTERID(LCP); 2USINGLIST := LCP; 2PUBLICPROCS := FALSE; 2DECLARATIONPART(FSYS + [ENDSY]); 2IF NOT PUBLICPROCS THEN LCP^. BEGIN &IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,KONST); WSEGID := -1; (*NO SEG*) 2SYMBLK := 9999; (*FORCE RETURN TO SOURCEFILE*) 2GETNEXTPAGE 0END; .IF NOT LSEPPROC THEN 0WITH LLEXITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := NIL; KLASS := KONST END; INSYMBOL; IF (SY = RELOP) A 1 THEN ERROR(189); &IF INMODULE AND NOT ININTERFACE THEN ERR&IF NOT USING THEN & BEGIN *IF INMODULE THEN USINGLIST := NIL; *CLOSE(LIBRARY,LOCK); *LIBNOTOPEN := TRUE (END $END (*USESDECLARATION*) ; 2 PROCEDURE LABELDECLARATION; VAR LLP: LABELP; REDEF: BOOLEAN; BEGIN REPEAT IF SY = INTCOLABVAL <> VAL.IVAL THEN LLP := LLP^.NEXTLAB ELSE BEGIN REDEF := TRUE; ERROR(166) END; IF NOT REDEF THEN BEGIN NEW(LLP); WITH LLP^ DO BEGIN LABVAL := VAL.IVAL; CODELBP := NIL; NEXTLAB := FLABEL END; FLABEL := LLP 0BEGIN DOLDSEG := SEG; SOLDPROC := NEXTPROC END; .GETTEXT(FOUND); .IF FOUND THEN 0BEGIN 2NEW(LCP,MODULE); 2WITH LCP^ DO 4IF NOT MAGIC THEN (IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14) &ELSE BEGIN SY := LSY; OP := LOP; ID := LID END; OR(192); &IF NOT MAGIC THEN DLINKERINFO := TRUE; &IF NOT USING THEN USINGLIST := NIL; &REPEAT (IF (NOT MAGIC) AND (SY <> ID,TEST := SY <> COMMA; ,IF TEST THEN .IF SY <> SEMICOLON THEN ERROR(20) .ELSE ,ELSE INSYMBOL *END &UNTIL TEST OR MAGIC; &J   SKIP(FSYS + [IDENT]) END END ELSE ,IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14) END END (*CONSTDECLARATION INSYMBOL; END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN BEGIN ERROR(6); SKIP(FSY*) ; PROCEDURE TYPEDECLARATION; VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,TYPES); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END; INSYMBOL; IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);  BEGIN IDTYPE := LSP; VADDR := LC; LC := LC + LSIZE; NXT := NEXT; IF NEXT = NIL THEN IF LSP <> NIL THEN IF LSP^.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,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,ACTUAND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16); CONSTANT(FSYS + [SEMICOLON],LSP,LVALU); ENTERID(LCP); LCP^.IDTYPE := LSP; LVARS,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; S+[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  TYP(FSYS + [SEMICOLON],LSP,LSIZE); ENTERID(LCP); LCP^.IDTYPE := LSP; LCP1 := FWPTR; WHILE LCP1 <> NIL DO BEGLCP^.VALUES := LVALU; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6);K  2LPARENT,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^ D>') END; WITH DISPLAY[0] DO BEGIN FNAME := NIL; FFILE := NIL; FLABEL := NIL; OCCUR := BLCK END; SMALLESTSPACE:=MEMAVAIL; "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; 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 := [LPARENT] + CONSTBEGSYS; TYPEBEGSYS := [ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY] + SIMPTYPEBEGSYS; TYPEDELS := [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); INSYMBOL; &IF SY = LPARENT THEN (BEGIN *REPEAT INSYMBOL *UNTIL SY IN [RPARENT,SEMICOLON]+BLOCKBEGSYS; *IF SY = RPARENT THECTUALVARS] "END (*INITSETS*) ; BEGIN (*COMPINIT*) INITSCALARS; INITSETS; LEVEL := 0; TOP := 0; IF NOISY THEN BEGIN  FOR IC := 1 TO 7 DO WRITELN(OUTPUT); WRITELN(OUTPUT,'PASCAL Compiler [I.5] (Unit Compiler)'); &WRITE(OUTPUT,'< 0 END END; "IF SY = PROGSY THEN $BEGIN INSYMBOL; &IF SY = IDENT THEN (BEGIN SEGTABLE[SEG].SEGNAME := ID; *IF OUTERBLOCK  SELECTSYS := [ARROW,PERIOD,LBRACK]; FACBEGSYS := [INTCONST,REALCONST,LONGCONST,STRINGCONST,IDENT, = DECLARED; PFLEV := 0; PFNAME := 1; PFSEG := SEG; PFKIND := ACTUAL; FORWDECL := FALSE; EXTURNAL := FALSE; *INSCOPE := TRUE L   into input var and check for overflow*) .FOR I := L-1 DOWNTO 0 DO D[I] := DX.WD[I+DECSIZE-L]; .NEG := D[0] < 0; .FOR I := DEuterblock*)  BEGIN END.  =LEVEL; &DOLDTOP:=TOP; &POLDPROC:=CURPROC; &ISSEGMENT:=FALSE; &DMARKP:=MARKP; $END;  END (*COMPINIT*) ; ITESTRING( F, S, W ); "END; (*procedure write_real *) " "PROCEDURE FWRITEDEC(*VAR F: FIB; D: DECMAX; RLENG: INTEGER*); "VAR S: STRING[38]; I: INTEGER; "BEGIN $STR(D,S); $FWRITESTRING(F,S,RLENG) "END (*FWRITEDEC*) ; " "PROCEDURE FREADDEC(*VAR F:FIB; VAR D: TRICKARRAY; L: INTEGER*); $LABEL 1; $CONST DECSIZE = 8; (*MAX SIZE OF LONG INTEGER IN WORDS*) $VAR DX: RECORD CASE BOOLEAN OF .FALSE:( D: DECMAX ); .TRUE: ( WD: TRICKARRAY ) ,END; (CH: CHAR; (NEG,DVALID: BOOLEAN; I: INTEGER; "BEGIN This backup made Sep. 24, 1978.  It is the student release version.  -'; FGET(F); CH := FWINDOW^[0] END; *WHILE (CH IN DIGITS) AND NOT FEOF DO ,BEGIN DVALID := TRUE; .DX.D := DX.D*10 + ORD(CH) - ORD('0'); .FGET(F); CH := FWINDOW^[0] ,END; *IF DVALID OR FEOF THEN ,BEGIN .IF NEG THEN DX.D := -DX.D; .(*Transfer resultCSIZE-L-1 DOWNTO 0 DO 0IF ((NOT NEG) AND (DX.WD[I] <> 0)) 2OR (NEG AND (DX.WD[I] <> -1)) THEN DVALID := FALSE ,END; *IF NOT (DVALID OR FEOF) THEN SYSCOM^.IORSLT := IBADFORMAT (END; "1: "END(*FREADDEC*) ;  END { PASCALIO } ;   (*Dummy level 0 oO (*MAKE LEXSTKREC FOR OUTERBLOCK*) $BEGIN &PREVLEXSTACKP:=NIL; &BFSY:=PERIOD; &DFPROCP:=OUTERBLOCK; &DLLC:=LC; &DOLDLEV:') AND NOT FEOF DO FGET(F); *IF FEOF THEN GOTO 1; *CH := FWINDOW^[0]; *IF (CH = '+') OR (CH = '-') THEN ,BEGIN NEG := CH = '$WITH F DO (BEGIN *DX.D := 0; NEG := FALSE; DVALID := FALSE; *IF FSTATE = FNEEDCHAR THEN FGET(F); *WHILE (FWINDOW^[0] = '