%RANGECHECKS=NO
%CHARCODE=EBCDIC
%DIAGLINEMAP=NO
%DIAGNAMETABLE=NO
(*
 ***********************************************************************
 *                                                                     *
 *  GLASGOW UNIVERSITY PASCAL DIAGNOSTICS PACKAGE                      *
 *                                            VERSION : APRIL 1980     *
 *                                                                     *
 *  AUTHOR:        D.A. WATT                                           *
 *                 COMPUTING SCIENCE DEPARTMENT                        *
 *                 UNIVERSITY OF GLASGOW                               *
 *                                                                     *
 *  ADAPTED FOR                                                        *
 *  2900 OPEH:     W. FINDLAY                                          *
 *                 COMPUTING SCIENCE DEPARTMENT                        *
 *                 UNIVERSITY OF GLASGOW                               *
 *                                                                     *
 ***********************************************************************
 
 
 
 
(1)  FUNCTIONS OF THE DIAGNOSTICS PACKAGE
     ========= == === =========== =======
 
 
      THIS PACKAGE IS INTENDED TO RUN AFTER EXECUTION OF A PASCAL
PROGRAM COMPILED BY THE ICL 2900 PASCAL COMPILER.  IT IS CAPABLE OF
PRODUCING ANY OR ALL OF THE FOLLOWING DIAGNOSTIC AIDS.
 
(A)   A "SYMBOLIC DUMP", DISPLAYING, FOR EACH BLOCK PRESENTED TO IT
BY THE OPEH (OBJECT-PROGRAM ERROR HANDLER) PACKAGE, THE VALUES OF ALL
LOCAL VARIABLES AND VALUE PARAMETERS.  AS FAR AS POSSIBLE, ALL SUCH
VALUES ARE DISPLAYED IN SOURCE-LANGUAGE FORMAT, AUGMENTED BY SUITABLE
NOTATION FOR ARRAY-, FILE- AND RECORD-VALUES.  A POINTER-VALUE IS
DISPLAYED AS AN OBJECT-PROGRAM ADDRESS PRECEDED BY '@'.  DATA STORED
IN THE HEAP IS NOT DISPLAYED.
 
(B)   AN "EXECUTION PROFILE" (OR FLOW SUMMARY), I.E. AN EDITED AND
FORMATTED COPY OF THE SOURCE TEXT DISPLAYING THE FREQUENCY OF
EXECUTION OF EACH FLOW-UNIT (Q.V.).
 
(C)   A "RETROSPECTIVE TRACE", I.E. A LIST OF THE LAST FEW FLOW-UNITS
EXECUTED UP TO THE MOMENT OF TERMINATION OF THE OBJECT-PROGRAM.  EACH
TRACED FLOW-UNIT IS DISPLAYED IN SOURCE-LANGUAGE FORM, IF POSSIBLE,
AND IS ACCOMPANIED BY A COUNT N, INDICATING THAT THIS WAS THE N-TH
EXECUTION OF THIS PARTICULAR FLOW-UNIT.
 
(D)   A "FORWARD TRACE", I.E. A LIST OF ALL FLOW-UNITS EXECUTED, WITH
THE EXCEPTION OF THOSE EXECUTED WHILE TRACING WAS TEMPORARILY SWITCHED
OFF.  THE N-TH EXECUTION OF A FLOW-UNIT IS TRACED IF AND ONLY IF:
 
            TRACEMIN <= N <= TRACEMAX.
 
   EACH TRACED FLOW-UNIT IS DISPLAYED IN SOURCE-LANGUAGE FORM, IF
POSSIBLE, AND IS ACCOMPANIED BY ITS COUNT, AS IN (C).
 
      THE INFORMATION REQUIRED TO PRODUCE THE ABOVE IS OBTAINED PARTLY
FROM THE COMPILER (2) AND PARTLY FROM OPEH (3).
%NEWPAGE
(2)  THE COMPILER-DIAGNOSTICS INTERFACE
     === ======== =========== =========
 
 
      THE COMPILER INSERTS A "FLOW-POINT" IMMEDIATELY BEFORE EACH
SOURCE-PROGRAM STATEMENT (WHETHER SIMPLE OR STRUCTURED), AND ALSO
BEFORE EACH WHILE-CLAUSE AND UNTIL-CLAUSE.  THESE FLOW-POINTS DIVIDE
(THE EXECUTABLE PARTS OF) THE SOURCE-PROGRAM, AND THE CORRESPONDING
OBJECT-PROGRAM, INTO SECTIONS CALLED "FLOW-UNITS", IN SUCH A WAY THAT
EACH OBJECT-PROGRAM FLOW-UNIT IS A STRAIGHT-LINE CODE SEQUENCE.  EACH
FLOW-POINT IS ASSOCIATED WITH THE FLOW-UNIT DELIMITED BY IT AND BY THE
FOLLOWING FLOW-POINT.
 
      IF ANY FORM OF FLOW ANALYSIS IS REQUIRED, THE COMPILER WILL, IN
GENERAL, GENERATE CODE AT EACH FLOW-POINT TO COUNT HOW OFTEN CONTROL
PASSES THROUGH THAT FLOW-POINT.
   IF ONLY PROFILING IS REQUIRED (I.E. NO TRACING), HOWEVER,
THE COMPILER IS AT LIBERTY TO SUPPRESS GENERATION OF CODE AT
ANY FLOW-POINT WHOSE COUNT IS GUARANTEED TO BE THE SAME AS SOME OTHER
FLOW-POINT.  (E.G. FLOW-POINTS PRECEDING COMPONENT STATEMENTS OF A
COMPOUND-STATEMENT WILL ALWAYS HAVE THE SAME COUNT, PROVIDED EACH
STATEMENT HAS A SINGLE ENTRY AND A SINGLE EXIT.)
 
      INFORMATION REQUIRED BY THE DIAGNOSTICS PACKAGE IS WRITTEN BY
THE COMPILER TO THE FOLLOWING THREE "FILES", WHICH ON THE ICL 2900 ARE
ACTUALLY IMPLEMENTED AS VIRTUAL STORE AREAS OF THE OBJECT-PROGRAM AND
ACCESSED BY MEANS OF EXTERNALLY-DEFINED INTERFACE PROCEDURES.
%NEWPAGE
(2.1) THE "OBJECTS FILE"
 
      THIS IS A SERIAL FILE, WRITTEN ONLY IF A SYMBOLIC DUMP IS
REQUIRED.  IT CONTAINS DESCRIPTIONS OF ALL SOURCE-PROGRAM "OBJECTS"
RELEVANT TO THE FORMATTING OF THE SYMBOLIC DUMP, NAMELY TYPES,
VARIABLES (INCLUDING PARAMETERS), FIELDS, ENUMERATION CONSTANTS, AND
BLOCKS.
 
      EACH OBJECT IS DESCRIBED, IN BOTH THE COMPILER AND THE DIAGNOSTICS
PACKAGE, BY A RECORD OF TYPE 'OBJECTDESCR'.
 
 
(2.2) THE "TOKENS FILE"
 
      THIS IS A SERIAL FILE, WRITTEN ONLY IF SOME FORM OF FLOW ANALYSIS
IS REQUIRED.  IT CONTAINS A LEXICALLY-ANALYSED REPRESENTATION OF THE
SOURCE-PROGRAM, STRIPPED OF CERTAIN PARTS, NAMELY LABEL-, CONSTANT-,
TYPE-, VARIABLE- AND FORMAL-PARAMETER-PARTS, WHICH ARE IRRELEVANT TO
FLOW ANALYSIS.  HERE IS THE SYNTAX OF WHAT REMAINS:-
 
 
    <PROGRAM> ->    <PROGRAM-HEADING>  <BLOCK>
 
    <BLOCK> ->    ( <PROCEDURE-OR-FUNCTION-HEADING>  <BLOCK> )*  <BODY>
 
    <PROGRAM-HEADING> ->    PROGRAM  <IDENTIFIER>
                         /  <EMPTY>
 
    <PROCEDURE-OR-FUNCTION-HEADING> ->    PROCEDURE  <IDENTIFIER>
                                       /  FUNCTION   <IDENTIFIER>
 
 
      THE FILE CONTAINS THREE KINDS OF TOKENS:  (1) "SYMBOL-TOKENS",
CORRESPONDING TO SYMBOLS IN THE SOURCE-PROGRAM;  (2) "FLOW-TOKENS",
CORRESPONDING TO FLOW-POINTS;  AND (3) "BREAK-TOKENS", WHICH IMMEDIATELY
PRECEDE PROCEDURE-OR-FUNCTION-HEADINGS, BLOCK-BEGINS, STATEMENT-
LABELS, AND CASE-LABEL-LISTS, AND WHICH ARE USED ONLY TO FACILITATE
THE FORMATTING OF THE PROFILE AND TRACES.
 
      EACH FLOW-TOKEN CONTAINS THE OBJECT-PROGRAM ADDRESS OF THE
CORRESPONDING FLOW-POINT, PLUS AN INDICATION OF WHETHER CODE WAS
ACTUALLY GENERATED AT THAT FLOW-POINT OR NOT.  IF SO, THE FLOW-TOKEN
ALSO CONTAINS THE ADDRESS OF THE COUNTER FOR THAT FLOW-POINT.
 
      EACH TOKEN IS DESCRIBED, IN BOTH THE COMPILER AND THE DIAGNOSTICS
PROGRAM, BY A RECORD OF TYPE 'TOKENREC'.
 
 
(2.3) THE "MAP FILE"
 
      THIS IS A SERIAL FILE OF BYTES, WRITTEN ONLY IF PROGRAM-COUNTER/
SOURCE-LINE MAPPING IS REQUIRED.   THE FILE CONTAINS ONE OR MORE BYTES
FOR EACH SIGNIFICANT LINE OF SOURCE TEXT (I.E. EACH LINE THAT GENERATES
OBJECT CODE).  IT ALSO CONTAINS ENTRIES THAT LOCATE AND IDENTIFY THE
START OF THE BODY OF EACH BLOCK.  DATA COMPRESSION TECHNIQUES ARE USED
TO MINIMIZE THE SIZE OF THIS FILE.
%NEWPAGE
(3)   OPEH-DIAGNOSTICS INTERFACE
      ==== =========== =========
 
 
      INFORMATION REQUIRED BY THE DIAGNOSTICS PACKAGE IS PROVIDED BY
EXTERNALLY-DEFINED INTERFACE PROCEDURES.  IT FALLS INTO THE FOLLOWING
CATEGORIES:
 
 
(3.1) CONTROL INFORMATION
 
      THIS IS PROVIDED IN PARAMETERS AND INCLUDES:
 
 *  THE BOOLEANS PROFILEREQD, RETROREQD AND TRACEREQD;
 
 *  THE BOOLEANS LINEMAPAVAILABLE AND OBJECTSAVAILABLE;
 
 *  THE RUN-TIME CHARACTER CODE AND ITS CONVERSION TABLE;
 
 *  THE VIRTUAL ADDRESSES STACKFRAMEORIGIN, GLOBALORIGIN, HEAPORIGIN,
    AND HEAPLIMIT, AND THE SIZE OF THE STACK FRAME, IN WORDS;
 
 *  THE MODULE-RELATIVE OFFSET OF THE CURRENT ORDER, AND WHETHER
    THE PROGRAM TERMINATED NORMALLY, OR IN ERROR;
 
 *  THE INTEGER ARRAYSIZE;
 
 
(3.2) THE FORWARD TRACE
 
      THE FORWARD TRACE CONSISTS OF A LIST OF 2-WORD TRACE RECORDS.
NORMALLY THE SECOND WORD OF EACH TRACE RECORD IS THE ADDRESS OF THE
FLOW-POINT BEING TRACED, AND THE FIRST WORD IS ITS COUNT N, INDICATING
THAT THIS WAS THE N-TH TIME CONTROL HAD PASSED THROUGH THIS FLOW-POINT.
HOWEVER, CERTAIN VALUE(S) OF THE FIRST WORD HAVE SPECIAL SIGNIFICANCE:-
 
 *  -1 INDICATES TRACING SUSPENDED BY COUNT AT THIS FLOW-POINT.
 
 
(3.3) THE RETROSPECTIVE TRACE
 
      THE RETROSPECTIVE TRACE IS HELD IN A CYCLIC BUFFER.  IT CONSISTS
OF 2-WORD RECORDS, IN EACH OF WHICH THE SECOND WORD IS THE ADDRESS OF A
FLOW-POINT AND THE FIRST WORD IS ITS COUNT.
 
 
 *)
%TITLE 'GLOBAL DECLARATIONS'
PROGRAM ICL9LPPMPACKAGE;
 
CONST
 
   BLANKALFA = '                                ';
   BLANK = ' ';
   QUOTECHAR = '''';
 
   (* MACHINE CONSTANTS *)
 
   MINORDINAL = -MAXINT;
   BITSPERWORD = 32;  BITSPERWORDLESS1 = 31;
   MAXINTFORBYTE = 255;  BYTESHIFT = 256;  BITSPERBYTE = 8;
   BYTESPERWORD  = 4;  BYTESPERWORDLESS1 = 3;
   BYTESPERORDER = 2;
   MAXORDERNUMBER = 131069;
   BYTESPERSEGMENT = 524288;
   WORDSPERSEGMENT = 131072;
      (*  - THESE LAST 2 NOW GIVE THE NOS. OF BYTES & WORDS    *)
      (*  IN 2 SEGMENTS, AS THE EDINBURGH INTERFACE PERMITS    *)
      (*  VIRTUAL STORAGE AREAS TO BE TWO SEGMENTS LONG.       *)
 
   (* COMPILER CONSTANTS *)
 
   INTSIGMAX = 10;
   ALFALENGTH = 32;
   WORDSPERREAL = 2;
   NILVALUE = 0;
   NILSERIAL = 0;
 
   (* FIELDS WITHIN FILE HOUSE-KEEPING RECORDS (HKR) *)
   BUFFERWORDOFFSET = 0;
   CURSORWORDOFFSET = 4;
   EOLNWORDOFFSET = 8;
   EOFWORDOFFSET = 12;
   FIBSTARTWORDOFFSET = 20;
   TEXTENDWORDOFFSET = 28;
 
   (* FIELDS WITHIN FILE INFORMATION BLOCK (FIB) *)
   MODEWORDOFFSET = 12;
   RECORDNOWORDOFFSET = 16;
   TEXTBUFFEROFFSET = 60;
   PAGEFLAGOFFSET = 228;
 
   (* FILE MODES *)
   UNDEFINEDFILE = 0;
   INSPECTION = 1;
   GENERATION = 2;
   CORRUPTFILE = 3;
 
 
   (* CONSTANTS USED BY THE DIAGNOSTICS PACKAGE *)
 
   MAXSERIAL = 3000;
   MAXCOLUMN = 120; INDENTUNIT = 2;
   MAXDENOTATIONLENGTH = 32;   (* MAXDENOTATIONLENGTH >= ALFALENGTH,
                                  MAXDENOTATIONLENGTH >= INTSIGMAX+1,
                                  MAXDENOTATIONLENGTH >=
                                                LONGEST KEYWORD *)
%NEWPAGE
TYPE
 
   (* MACHINE TYPES *)
 
   BYTE = 0..MAXINTFORBYTE;
   WORD = INTEGER;
   VIRTUALADDRESS = INTEGER;
   WORDNUMBER = 0..WORDSPERSEGMENT;
   BYTENUMBER = 0..BYTESPERSEGMENT;
   ORDERNUMBER = 0..MAXORDERNUMBER;
 
   (* COMPILER TYPES *)
 
   CHARCODETYPE = (CCEBCDIC, CCISO, CCICL1900, CCINVALID);
 
   SYMBOLTYPE = (IDENT,INTCONST,REALCONST,CHARCONST,STRINGCONST,NOTSY,
                 MULOP,ADDOP,RELOP,LEFTPARENT,RIGHTPARENT,
                 LEFTBRACKET,RIGHTBRACKET,
                 COMMA,SEMICOLON,PERIOD,DOTDOT,ARROW,COLON,BECOMES,
                 LABELSY,CONSTSY,TYPESY,VARSY,FUNCSY,PROCSY,SETSY,
                 PACKEDSY,ARRAYSY,RECORDSY,FILESY,
                 BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY,
                 GOTOSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY,
                 THENSY,PROGRAMSY,VALUESY,QUOTE,DIGIT,OTHERSY);
 
   OPTYPE     = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,
                 LTOP,LEOP,GEOP,GTOP,NEOP,EQOP,INOP,NOTOP);
 
   SETOFSYMBOLS = SET OF SYMBOLTYPE;
 
   IDCLASS = (TYPES, CONSTS, VARS, FIELD, PROC, FUNC, PROG);
 
   TYPEFORM = (SCALARS,SUBRANGES,POINTERS,SETS,ARRAYS,RECORDS,
               FILES,VARIANTPART,VARIANT);
 
   DECLKIND = (STANDARD,DECLARED);
 
   FORMATOFDESCRIPTOR = ( ONEBYTE, TWOBYTE, THREEBYTE,
                          ONEWORDUNSCALED, ONEWORDSCALED,
                          TWOWORDUNSCALED, TWOWORDSCALED,
                          FORWORDUNSCALED, FORWORDSCALED  ) ;
 
   TYPEREPRESENTATION = PACKED RECORD
                           ACCESSDESCRIPTOR : FORMATOFDESCRIPTOR;
                           CASE SIZE : WORDNUMBER OF
                              1 : ( BYTESIZE : 1..BYTESPERWORD;
                                    MIN,MAX  : INTEGER )
                        END;
 
   FIELDOFFSET = PACKED RECORD
                    BYTEOFFSET,BYTESIZE : BYTENUMBER
                 END;
%NEWPAGE
   OBJADDRRANGE = WORDNUMBER;
   SERIALRANGE = INTEGER;
   OBJECTDESCR = PACKED RECORD
                   SIZEINBYTES : BYTENUMBER;
                   OBJSERIAL: SERIALRANGE;
                   CASE OBJCLASS: IDCLASS OF
                     TYPES:
                        (OBJREPRESENTATION: TYPEREPRESENTATION;
                         CASE OBJFORM: TYPEFORM OF
                           SCALARS:
                              (CASE OBJSCALARKIND: DECLKIND OF
                                 DECLARED: (OBJFIRSTCONST: SERIALRANGE);
                                 STANDARD: (STDTYPE:
                                            (INTSTD,REALSTD,CHARSTD)));
                           SUBRANGES:
                              (OBJRANGETYPE: SERIALRANGE;
                               OBJMIN, OBJMAX: INTEGER);
                           POINTERS:
                              ( );
                           SETS:
                              (SETISPACKED: BOOLEAN;
                               OBJBASETYPE: SERIALRANGE);
                           ARRAYS:
                              (ARRAYISPACKED: BOOLEAN;
                               OBJAELTYPE, OBJINXTYPE: SERIALRANGE);
                           RECORDS:
                              (RECORDISPACKED: BOOLEAN;
                               OBJNONVARPART, OBJVARPART: SERIALRANGE);
                           FILES:
                              (FILEISPACKED, FILEISTEXT: BOOLEAN;
                               OBJFELTYPE: SERIALRANGE);
                           VARIANTPART:
                              (OBJTAGFIELD,
                               OBJTAGTYPE,
                               OBJFSTVARIANT: SERIALRANGE);
                           VARIANT:
                              (OBJSUBNONVARPART, OBJSUBVARPART,
                               OBJNEXTVARIANT: SERIALRANGE;
                               OBJVARIANTVALUE: INTEGER));
                     CONSTS:
                        (CONSTNAME: ALFA;
                         CONSTVALUE: INTEGER;
                         NEXTCONST: SERIALRANGE);
                     VARS:
                        (VARNAME: ALFA;
                         VARTYPE: SERIALRANGE;
                         ISVARPARAM: BOOLEAN;
                         LOCALOFFSET: OBJADDRRANGE;
                         NEXTLOCALVAR: SERIALRANGE);
                     FIELD:
                        (FIELDTYPE: SERIALRANGE;
                         OBJOFFSET: FIELDOFFSET;
                         NEXTFIELD: SERIALRANGE);
                     PROG,PROC,FUNC:
                        (BLOCKNAME: ALFA;
                         FIRSTLOCALVAR: SERIALRANGE)
                 END;
%NEWPAGE
   KINDOFTOKEN = (SYMBOLTOKEN,FLOWTOKEN,BREAKTOKEN);
   KINDOFBREAK = (BLOCKHEAD,BLOCKBODY,STATLABEL,CASELABELLIST);
   COUNTERADDRRANGE = WORDNUMBER;
   FLOWADDRRANGE = ORDERNUMBER;
 
   TOKENREC = PACKED RECORD
                SIZEINBYTES : BYTENUMBER;
                CASE TOKENKIND: KINDOFTOKEN OF
                  SYMBOLTOKEN:
                     (CASE TOKENSYMBOL: SYMBOLTYPE OF
                        IDENT:       (TOKENSPELLING: ALFA);
                        INTCONST:    (TOKENINTVAL: INTEGER);
                        REALCONST:   (TOKENREALVAL: REAL);
                        CHARCONST:   (TOKENCHARVAL: BYTE);
                        MULOP,
                        ADDOP,
                        RELOP:       (TOKENOP: OPTYPE)      );
                  FLOWTOKEN:
                     (FLOWADDRESS: FLOWADDRRANGE;
                      CASE COUNTED: BOOLEAN OF
                        TRUE: (COUNTADDRESS: COUNTERADDRRANGE) );
                  BREAKTOKEN:
                  (BREAKADDRESS: FLOWADDRRANGE;
                   BREAKKIND: KINDOFBREAK)
              END;
 
   (* TYPES USED BY THE DIAGNOSTICS PACKAGE *)
 
   HOWBLOCKISKNOWN = (BYOFFSET, BYNAME, BYSERIAL);
 
   KINDOFBLOCK = (PROGBLOCK, PROCBLOCK, FUNCBLOCK, UNKNOWNBLOCK);
 
   ORDINAL = WORD;           (* COMPILER-DEPENDENT *)
   POINTER = VIRTUALADDRESS; (*    ""       ""     *)
 
   CONVERSIONTABLE = PACKED ARRAY [BYTE] OF BYTE;
   CODECONVERSION = @ CONVERSIONTABLE;
 
   OBJECTRECPTR = @ OBJECTDESCR;
 
   TOKENRECPTR = @ TOKENREC;
 
   MAPREC = BYTE;
   MAPRECPTR = VIRTUALADDRESS;
 
   RETROREC = RECORD FIRSTFIELD, SECONDFIELD : INTEGER END;
   RETRORECPTR = @ RETROREC;
 
   TRACEREC = RETROREC;
   TRACERECPTR = @ TRACEREC;
   BRACKETSYMBOLS = PACKED ARRAY [1..INDENTUNIT] OF CHAR;
 
   COLUMNRANGE = 0..MAXCOLUMN;
 
   DENOTATION = RECORD
                  LENGTH : 0..MAXDENOTATIONLENGTH;
                  BODY : PACKED ARRAY [1..MAXDENOTATIONLENGTH] OF CHAR
                END;
%NEWPAGE
VAR
 
   (* GLOBAL VARIABLES DEFINED FROM THE OPEH INTERFACE *)
 
   LINEMAPAVAILABLE, OBJECTSAVAILABLE : BOOLEAN;
 
   STACKFRAMEORIGIN, GLOBALORIGIN, HEAPORIGIN, HEAPLIMIT : VIRTUALADDRESS;
   STACKFRAMESIZE : WORDNUMBER;
   ARRAYSIZE : INTEGER;
 
   SOURCELINE : INTEGER;
 
   BLOCK : RECORD
           IDENTIFICATION : HOWBLOCKISKNOWN;
           OFFSET : BYTENUMBER;
           KIND : KINDOFBLOCK;
           SERIAL : SERIALRANGE;
           NAME : ALFA
           END;
 
   TERMINATION : RECORD
                   CASE NORMAL : BOOLEAN OF
                     TRUE:  ( );
                     FALSE: (LOCATED : BOOLEAN;
                             LOCATION : FLOWADDRRANGE;
                             CASE FAILED : BOOLEAN OF
                               FALSE:( );
                               TRUE: (FAILNO : INTEGER) )
                 END;
 
   CHARMAP : CODECONVERSION;
   CHARCODEUSED : CHARCODETYPE;  MAXORDCHAR : BYTE;
 
   (* GLOBAL VARIABLES USED BY THE OUTPUT CONTROLLER *)
 
   TOTALINDENT, COLUMNINDEX : COLUMNRANGE;
   INDENTCOUNT : INTEGER;
 
   (* TABLES *)
 
   SYMBOLDENOTATION : ARRAY [SYMBOLTYPE] OF DENOTATION;
   OPERATORDENOTATION : ARRAY [OPTYPE] OF DENOTATION;
   OBJECTTABLE : ARRAY [NILSERIAL..MAXSERIAL] OF OBJECTRECPTR;
% TITLE 'THE MACHINE-INTERFACE MODULE'
 
(*
 
BUILTIN FUNCTION BYTEAT (A : VIRTUALADDRESS) : BYTE;
 
BUILTIN FUNCTION WORDAT (A : VIRTUALADDRESS) : WORD;
 
BUILTIN PROCEDURE STOREWORDAT (W : WORD; A : VIRTUALADDRESS);
 
BUILTIN FUNCTION ANDX (X, Y : WORD) : WORD;
    [ ANDX := X AND Y ]
 
BUILTIN FUNCTION USHX (L : INTEGER;  X : WORD) : WORD;
    [ USHX := X SHIFTED LOGICALLY L PLACES
              -- LEFT IF L>0
              -- RIGHT IF L<0
    ]
 
*)
%TITLE 'THE OUTPUT MODULE'
PROCEDURE CONTINUE (VAR DFILE : TEXT);
 
    BEGIN
      COLUMNINDEX := TOTALINDENT;
      WRITELN(DFILE);
      WRITE(DFILE,BLANK:COLUMNINDEX)
    END (* CONTINUE *);
 
PROCEDURE MAKESPACEFOR (VAR DFILE : TEXT; N : COLUMNRANGE);
 
    BEGIN
      IF COLUMNINDEX+N > MAXCOLUMN THEN
        CONTINUE(DFILE);
      COLUMNINDEX := COLUMNINDEX+N
    END (* MAKESPACEFOR *);
 
PROCEDURE STARTDENT (N : COLUMNRANGE);
 
    BEGIN
    TOTALINDENT := N;
    COLUMNINDEX := TOTALINDENT;
    INDENTCOUNT := 0;
    END (* STARTDENT *);
 
PROCEDURE INDENT (VAR DFILE : TEXT;  DELIMITER : BRACKETSYMBOLS);
 
    BEGIN
    IF TOTALINDENT + INDENTUNIT < MAXCOLUMN - MAXDENOTATIONLENGTH - INDENTUNIT - 1 THEN
      TOTALINDENT := TOTALINDENT + INDENTUNIT
    ELSE
      BEGIN
      INDENTCOUNT := INDENTCOUNT + 1;
      CONTINUE(DFILE);
      END;
    MAKESPACEFOR(DFILE, INDENTUNIT);
    WRITE(DFILE, DELIMITER);
    END (* INDENT *);
 
PROCEDURE OUTDENT (VAR DFILE : TEXT;  DELIMITER : BRACKETSYMBOLS);
 
    BEGIN
    IF INDENTCOUNT > 0 THEN
      INDENTCOUNT := INDENTCOUNT - 1
    ELSE
      TOTALINDENT := TOTALINDENT - INDENTUNIT;
    MAKESPACEFOR(DFILE, INDENTUNIT);
    WRITE(DFILE, DELIMITER);
    END (* OUTDENT *);
 
FUNCTION ATLEFTMARGIN : BOOLEAN;
    
    BEGIN
    ATLEFTMARGIN := COLUMNINDEX=TOTALINDENT;
    END (* ATLEFTMARGIN *);
   
FUNCTION SPACEINFRESHLINE : COLUMNRANGE;
   
    BEGIN
    SPACEINFRESHLINE := MAXCOLUMN-TOTALINDENT+1;
    END (* SPACEINFRESHLINE *);
    
FUNCTION SPACELEFT : COLUMNRANGE;
 
    BEGIN
    SPACELEFT := MAXCOLUMN - COLUMNINDEX + 1;
    END (* SPACELEFT *);
 
PROCEDURE WRITESEPARATOR (VAR DFILE : TEXT;  FIELDWIDTH : COLUMNRANGE);
 
    BEGIN
    MAKESPACEFOR(DFILE, 1);
    WRITE(DFILE, ',');
    FIELDWIDTH := FIELDWIDTH - 1;
    IF FIELDWIDTH > 0 THEN
      IF FIELDWIDTH < SPACELEFT THEN
        BEGIN
        MAKESPACEFOR(DFILE, FIELDWIDTH);
        WRITE(DFILE, BLANK:(FIELDWIDTH));
        END
      ELSE
        CONTINUE(DFILE);
    END (* WRITESEPARATOR *);
 
PROCEDURE FINDIDENTIFIERDENOTATION (NAME : ALFA;
                                    VAR IDDENOTATION : DENOTATION);
 
    VAR
        L : 1..ALFALENGTH;
    BEGIN
      WITH IDDENOTATION DO
      BEGIN
        LENGTH := 0;
        FOR L := 1 TO ALFALENGTH DO
        BEGIN
          BODY[L] := NAME[L];
          IF NAME[L]<>BLANK THEN LENGTH := L
        END
      END
    END (* FINDIDENTIFIERDENOTATION *);
 
PROCEDURE FINDINTEGERDENOTATION (INTVALUE : INTEGER;
                                 VAR INTDENOTATION : DENOTATION);
 
    VAR
        DIGITS : ARRAY [1..INTSIGMAX] OF CHAR;
        INTVAL : INTEGER;
        I, L : 0..INTSIGMAX;
    BEGIN
      INTVAL := ABS(INTVALUE);
      L := 0;
      REPEAT
        L := L+1;
        DIGITS[L] := CHR(ORD('0') + INTVAL MOD 10);
        INTVAL := INTVAL DIV 10
      UNTIL INTVAL=0;
      WITH INTDENOTATION DO
      BEGIN
        IF INTVALUE>=0 THEN
          LENGTH := 0
        ELSE
          BEGIN  LENGTH := 1;  BODY[1] := '-'  END;
        FOR I := L DOWNTO 1 DO
          BEGIN  LENGTH := LENGTH+1;  BODY[LENGTH] := DIGITS[I]  END
      END
    END (* FINDINTEGERDENOTATION *);
 
PROCEDURE FINDPOINTERDENOTATION (POINTERVALUE : POINTER;
                                 VAR POINTERDENOTATION : DENOTATION);
(******** MACHINE&COMPILER&IMPLEMENTATION-DEPENDENT ********)
 
   VAR
      DIGIT : 0..15;
      L : 0..MAXDENOTATIONLENGTH;
 
   BEGIN
   WITH POINTERDENOTATION DO
      BEGIN
      BODY[1] := '@';
      LENGTH := BITSPERWORD DIV 4 + 1;
      FOR L := 2 TO LENGTH DO
        BEGIN
        DIGIT := ANDX(15, USHX(4*(L-1)-BITSPERWORD, POINTERVALUE));
        IF DIGIT < 10 THEN
        BODY[L] := CHR(ORD('0') + DIGIT)
      ELSE
        BODY[L] := CHR(ORD('A') - 10 + DIGIT);
        END;
      END;
   END (* FINDPOINTERDENOTATION *);
 
PROCEDURE FINDREALDENOTATION (REALVALUE : REAL;
                              VAR REALDENOTATION : DENOTATION);
 
    BEGIN
      REALDENOTATION := SYMBOLDENOTATION[REALCONST]  (****TEMP.****)
    END (* FINDREALDENOTATION *);
 
FUNCTION CONVERTEDCHAR (ORDINALVALUE : BYTE) : CHAR;
 
    CONST
        UNDEFINEDCHAR = 0;   (* NULL (IN EBCDIC OR ISO) *)
 
    BEGIN
    IF ORDINALVALUE>MAXORDCHAR THEN
      CONVERTEDCHAR := CHR(UNDEFINEDCHAR)
    ELSE
      BEGIN
      CASE CHARCODEUSED OF
         CCICL1900: ;
        CCINVALID: ORDINALVALUE:=UNDEFINEDCHAR;
        CCEBCDIC: (* TOO FIDDLY TO DO PROPERLY NOW *);
        CCISO:  IF (ORDINALVALUE<ORD(BLANK)) OR (ORDINALVALUE=MAXORDCHAR) THEN
                   ORDINALVALUE:=UNDEFINEDCHAR;
        END (*CASE*);
      CONVERTEDCHAR:=CHR(CHARMAP@[ORDINALVALUE]);
      END;
    END (* CONVERTEDCHAR *);
 
PROCEDURE FINDCHARDENOTATION (CHARORDINALVALUE : BYTE;
                              VAR CHARDENOTATION : DENOTATION);
 
    BEGIN
      WITH CHARDENOTATION DO
      BEGIN
        LENGTH := 3;
        BODY[1] := QUOTECHAR;
        BODY[2] := CONVERTEDCHAR(CHARORDINALVALUE);
        BODY[3] := QUOTECHAR;
        BODY[4] := QUOTECHAR;
        IF BODY[2]=QUOTECHAR THEN
          LENGTH := 4;
      END
    END (* FINDCHARDENOTATION *);
 
PROCEDURE FINDDENOTATION (TOKEN : TOKENREC;
                          VAR TOKENDENOTATION : DENOTATION);
 
    BEGIN
      WITH TOKEN DO
        CASE TOKENSYMBOL OF
          IDENT:
            FINDIDENTIFIERDENOTATION(TOKENSPELLING,TOKENDENOTATION);
          INTCONST:
            FINDINTEGERDENOTATION(TOKENINTVAL,TOKENDENOTATION);
          REALCONST:
            FINDREALDENOTATION(TOKENREALVAL,TOKENDENOTATION);
          CHARCONST:
            FINDCHARDENOTATION(TOKENCHARVAL,TOKENDENOTATION);
          MULOP,ADDOP,RELOP:
            TOKENDENOTATION := OPERATORDENOTATION[TOKENOP];
          STRINGCONST,
          NOTSY,
          LEFTPARENT,RIGHTPARENT,LEFTBRACKET,RIGHTBRACKET,
          COMMA,SEMICOLON,PERIOD,ARROW,COLON,BECOMES,
          LABELSY,CONSTSY,TYPESY,VARSY,FUNCSY,PROCSY,SETSY,
          PACKEDSY,ARRAYSY,RECORDSY,FILESY,
          BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY,
          GOTOSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY,
          THENSY,PROGRAMSY,VALUESY,OTHERSY,QUOTE,DIGIT:
            TOKENDENOTATION := SYMBOLDENOTATION[TOKENSYMBOL]
        END (* CASE *)
    END (* FINDDENOTATION *);
 
PROCEDURE WRITEDENOTATION (VAR DFILE : TEXT;
                           ADENOTATION : DENOTATION);
 
    VAR
        I : 1..MAXDENOTATIONLENGTH;
    BEGIN
      WITH ADENOTATION DO
      BEGIN
        IF LENGTH >= SPACELEFT THEN
          CONTINUE(DFILE);
        MAKESPACEFOR(DFILE, LENGTH);
        FOR I := 1 TO LENGTH DO
          WRITE(DFILE,BODY[I])
      END
    END (* WRITEDENOTATION *);
%TITLE 'THE CONTROL-LOCUS MODULE'
 
PROCEDURE ICL9LPRESETPMMAP;
    EXTERN;
 
FUNCTION ICL9LPNEXTPMMAP : MAPRECPTR;
    EXTERN;
 
FUNCTION ICL9LPPRELINKPM : BYTENUMBER;
    EXTERN;
   
FUNCTION ICL9LPPOSTLINKPM : BYTENUMBER;
    EXTERN;
     
PROCEDURE DESCRIBEBLOCK;
 
    BEGIN
    WITH BLOCK DO
    IF (SERIAL>NILSERIAL) AND (SERIAL<=MAXSERIAL) THEN
      IF OBJECTTABLE[SERIAL] <> NIL THEN
        WITH OBJECTTABLE[SERIAL]@ DO
          BEGIN
          IF OBJCLASS=PROC THEN
            KIND := PROCBLOCK
          ELSE
          IF OBJCLASS=FUNC THEN
            KIND := FUNCBLOCK
          ELSE
          IF OBJCLASS=PROG THEN
            KIND := PROGBLOCK
          ELSE
            KIND := UNKNOWNBLOCK;
          IF KIND<>UNKNOWNBLOCK THEN
            NAME := BLOCKNAME;
          END (*WITH*);
    END (* DESRIBEBLOCK *);
 
PROCEDURE FINDLOCUSOFCONTROL (ORIGINALCODEOFFSET : BYTENUMBER);
 
    VAR
        CODEOFFSET,
        OFFSETATENDOFLINE : BYTENUMBER;
        ENDOFMAP : BOOLEAN;
        MAPACCESS : MAPRECPTR;
        MAPENTRY : BYTE;
 
    PROCEDURE GETNEXTMAPENTRY;
    (******** IMPLEMENTATION-DEPENDENT ********)
 
        BEGIN
        MAPACCESS := ICL9LPNEXTPMMAP;
        ENDOFMAP := (MAPACCESS=0);
        IF NOT ENDOFMAP THEN
           MAPENTRY := BYTEAT(MAPACCESS);
        END (* GETNEXTMAPENTRY *);
 
    PROCEDURE GETFIRSTMAPENTRY;
    (******** IMPLEMENTATION-DEPENDENT ********)
 
        BEGIN
        ICL9LPRESETPMMAP;
        GETNEXTMAPENTRY;
        END (* GETFIRSTMAPENTRY *);
 
    PROCEDURE RESETMAPSCAN (NEWCODEOFFSET : BYTENUMBER);
    (******** IMPLEMENTATION-DEPENDENT ********)
     
        BEGIN
        CODEOFFSET := NEWCODEOFFSET;
        WITH BLOCK DO
           BEGIN
           IDENTIFICATION := BYOFFSET;
           OFFSET := CODEOFFSET;
           KIND :=  UNKNOWNBLOCK;
           END;
        SOURCELINE := 0;
        OFFSETATENDOFLINE := 0;
        ENDOFMAP := FALSE;
        ICL9LPRESETPMMAP;
        END (* RESETMAPSCAN *) ;
%NEWPAGE
    PROCEDURE DECODEMAPENTRY;
 
        CONST
           MAPESCAPE = 0;
           MAPPEDBLOCK = 0;
           MAPPEDJLKTASK = 1;
   
        VAR
           BASE, FENCE, LIMIT,
           LINEDELTA, ORDERDELTA : INTEGER;
           LONGLINEDELTA, LONGORDERDELTA : BOOLEAN;
           I : 1..ALFALENGTH;
 
        PROCEDURE GETMAPINTEGER (VAR N : INTEGER);
           VAR
              B : BYTE;
           BEGIN
           GETNEXTMAPENTRY;
           B := MAPENTRY;
           GETNEXTMAPENTRY;
           N := BYTESHIFT*B + MAPENTRY;
           END (* GETMAPINTEGER *);
     
        BEGIN
        IF NOT ENDOFMAP THEN
           IF MAPENTRY=MAPESCAPE THEN
              BEGIN
              GETNEXTMAPENTRY;
              IF MAPENTRY=MAPPEDBLOCK THEN
                 WITH BLOCK DO
                    IF OBJECTSAVAILABLE THEN
                       BEGIN
                       GETMAPINTEGER (SERIAL);
                       IDENTIFICATION := BYSERIAL;
                       END
                    ELSE
                       BEGIN
                       GETNEXTMAPENTRY;
                       IF MAPENTRY=ORD(PROGBLOCK) THEN
                          KIND := PROGBLOCK
                       ELSE IF MAPENTRY=ORD(PROCBLOCK) THEN
                          KIND := PROCBLOCK
                        ELSE IF MAPENTRY=ORD(FUNCBLOCK) THEN
                          KIND := FUNCBLOCK
                       ELSE
                          KIND := UNKNOWNBLOCK;
                       GETNEXTMAPENTRY;
                       IDENTIFICATION := BYNAME;
                       NAME := BLANKALFA;
                       FOR I := 1 TO MAPENTRY DO
                          BEGIN
                          GETNEXTMAPENTRY;
                          NAME[I] := CHR (MAPENTRY);
                          END;
                       END
              ELSE IF MAPENTRY=MAPPEDJLKTASK THEN
                 BEGIN
                 GETMAPINTEGER (BASE);
                 BASE := OFFSETATENDOFLINE + BYTESPERORDER*BASE;
                 GETMAPINTEGER (FENCE);
                 FENCE := BASE + BYTESPERORDER*FENCE;
                 GETMAPINTEGER (LIMIT);
                 LIMIT := FENCE + BYTESPERORDER*LIMIT;
                 OFFSETATENDOFLINE := LIMIT;
                 IF (BASE<=CODEOFFSET) AND (CODEOFFSET<FENCE) THEN
                    RESETMAPSCAN (ICL9LPPRELINKPM)
                 ELSE IF (FENCE<=CODEOFFSET) AND (CODEOFFSET<LIMIT) THEN
                    RESETMAPSCAN (ICL9LPPOSTLINKPM);
                 END
              ELSE
                 ENDOFMAP := TRUE;
              END (* =MAPESCAPE *)
           ELSE
              BEGIN
              ORDERDELTA := MAPENTRY MOD 32;
              LONGORDERDELTA := MAPENTRY DIV 32 MOD 2  <>  0;
              LINEDELTA := MAPENTRY DIV 64 MOD 2;
              LONGLINEDELTA := MAPENTRY DIV 128  <>  0;
              IF LONGORDERDELTA THEN
                 BEGIN
                 GETNEXTMAPENTRY;
                 ORDERDELTA := BYTESHIFT*ORDERDELTA + MAPENTRY;
                 END;
              IF LONGLINEDELTA THEN
                 BEGIN
                 GETNEXTMAPENTRY;
                 LINEDELTA := BYTESHIFT*LINEDELTA + MAPENTRY;
                 END;
              OFFSETATENDOFLINE := OFFSETATENDOFLINE + BYTESPERORDER*ORDERDELTA;
              SOURCELINE := SOURCELINE + LINEDELTA + 1;
              END (* <>MAPESCAPE *);
        END (* DECODEMAPENTRY *);
 
    BEGIN (* FINDLOCUSOFCONTROL *)
    RESETMAPSCAN (ORIGINALCODEOFFSET);
    IF LINEMAPAVAILABLE THEN
      BEGIN
      OFFSETATENDOFLINE := 0;
      GETFIRSTMAPENTRY;
      REPEAT
        DECODEMAPENTRY;
        GETNEXTMAPENTRY
        UNTIL (OFFSETATENDOFLINE>CODEOFFSET) OR ENDOFMAP;
    IF ENDOFMAP AND (OFFSETATENDOFLINE<CODEOFFSET) THEN
        RESETMAPSCAN (CODEOFFSET) ;
      END;
    IF BLOCK.IDENTIFICATION=BYSERIAL THEN
      DESCRIBEBLOCK;
    END (* FINDLOCUSOFCONTROL *);
%TITLE 'THE DUMP MODULE: INITIALIZATION'
 
PROCEDURE ICL9LPRESETPMOBJ;
    EXTERN;
 
FUNCTION ICL9LPNEXTPMOBJ : OBJECTRECPTR;
    EXTERN;
 
%KEYEDENTRY ON
PROCEDURE ICL9LPPMINITTABS
                 (LINEMAPGIVEN, OBJECTSGIVEN : BOOLEAN;
                  RUNTIMECHARCODE : CHARCODETYPE;
                  CODETABLEPOINTER : CODECONVERSION;
                  VAR RESULT : INTEGER);
 
    CONST
        NOTABLETOBEREAD = 0;
 
    PROCEDURE INITDENOTATIONTABLES;
 
        BEGIN
        SYMBOLDENOTATION[IDENT].BODY        := 'IDENT-ERROR!                    ';
        SYMBOLDENOTATION[INTCONST].BODY     := 'INTCONST-ERROR!                 ';
        SYMBOLDENOTATION[REALCONST].BODY    := '<REAL>                          ';
        SYMBOLDENOTATION[CHARCONST].BODY    := 'CHARCONST-ERROR!                ';
        SYMBOLDENOTATION[STRINGCONST].BODY  := '<STRING>                        ';
        SYMBOLDENOTATION[NOTSY].BODY        := 'NOT                             ';
        SYMBOLDENOTATION[MULOP].BODY        := 'MULOP-ERROR!                    ';
        SYMBOLDENOTATION[ADDOP].BODY        := 'ADDOP-ERROR!                    ';
        SYMBOLDENOTATION[RELOP].BODY        := 'RELOP-ERROR!                    ';
        SYMBOLDENOTATION[LEFTPARENT].BODY   := '(                               ';
        SYMBOLDENOTATION[RIGHTPARENT].BODY  := ')                               ';
        SYMBOLDENOTATION[LEFTBRACKET].BODY  := '[                               ';
        SYMBOLDENOTATION[RIGHTBRACKET].BODY := ']                               ';
        SYMBOLDENOTATION[COMMA].BODY        := ',                               ';
        SYMBOLDENOTATION[SEMICOLON].BODY    := ';                               ';
        SYMBOLDENOTATION[PERIOD].BODY       := '.                               ';
        SYMBOLDENOTATION[DOTDOT].BODY       := '..                              ';
        SYMBOLDENOTATION[ARROW].BODY        := '@                               ';
        SYMBOLDENOTATION[COLON].BODY        := ':                               ';
        SYMBOLDENOTATION[BECOMES].BODY      := ':=                              ';
        SYMBOLDENOTATION[LABELSY].BODY      := 'LABEL                           ';
        SYMBOLDENOTATION[CONSTSY].BODY      := 'CONST                           ';
        SYMBOLDENOTATION[TYPESY].BODY       := 'TYPE                            ';
        SYMBOLDENOTATION[VARSY].BODY        := 'VAR                             ';
        SYMBOLDENOTATION[FUNCSY].BODY       := 'FUNCTION                        ';
        SYMBOLDENOTATION[PROCSY].BODY       := 'PROCEDURE                       ';
        SYMBOLDENOTATION[SETSY].BODY        := 'SET                             ';
        SYMBOLDENOTATION[PACKEDSY].BODY     := 'PACKED                          ';
        SYMBOLDENOTATION[ARRAYSY].BODY      := 'ARRAY                           ';
        SYMBOLDENOTATION[RECORDSY].BODY     := 'RECORD                          ';
        SYMBOLDENOTATION[FILESY].BODY       := 'FILE                            ';
        SYMBOLDENOTATION[BEGINSY].BODY      := 'BEGIN                           ';
        SYMBOLDENOTATION[IFSY].BODY         := 'IF                              ';
        SYMBOLDENOTATION[CASESY].BODY       := 'CASE                            ';
        SYMBOLDENOTATION[REPEATSY].BODY     := 'REPEAT                          ';
        SYMBOLDENOTATION[WHILESY].BODY      := 'WHILE                           ';
        SYMBOLDENOTATION[FORSY].BODY        := 'FOR                             ';
        SYMBOLDENOTATION[WITHSY].BODY       := 'WITH                            ';
        SYMBOLDENOTATION[GOTOSY].BODY       := 'GOTO                            ';
        SYMBOLDENOTATION[ENDSY].BODY        := 'END                             ';
        SYMBOLDENOTATION[ELSESY].BODY       := 'ELSE                            ';
        SYMBOLDENOTATION[UNTILSY].BODY      := 'UNTIL                           ';
        SYMBOLDENOTATION[OFSY].BODY         := 'OF                              ';
        SYMBOLDENOTATION[DOSY].BODY         := 'DO                              ';
        SYMBOLDENOTATION[TOSY].BODY         := 'TO                              ';
        SYMBOLDENOTATION[DOWNTOSY].BODY     := 'DOWNTO                          ';
        SYMBOLDENOTATION[THENSY].BODY       := 'THEN                            ';
        SYMBOLDENOTATION[PROGRAMSY].BODY    := 'PROGRAM                         ';
        SYMBOLDENOTATION[VALUESY].BODY      := 'VALUESY-ERROR!                  ';
        SYMBOLDENOTATION[QUOTE].BODY        := '''                               ';
        SYMBOLDENOTATION[DIGIT].BODY        := 'DIGIT-ERROR!                    ';
        SYMBOLDENOTATION[OTHERSY].BODY      := 'OTHERSY-ERROR!                  ';
        OPERATORDENOTATION[MUL].BODY        := '*                               ';
        OPERATORDENOTATION[RDIV].BODY       := '/                               ';
        OPERATORDENOTATION[ANDOP].BODY      := 'AND                             ';
        OPERATORDENOTATION[IDIV].BODY       := 'DIV                             ';
        OPERATORDENOTATION[IMOD].BODY       := 'MOD                             ';
        OPERATORDENOTATION[PLUS].BODY       := '+                               ';
        OPERATORDENOTATION[MINUS].BODY      := '-                               ';
        OPERATORDENOTATION[OROP].BODY       := 'OR                              ';
        OPERATORDENOTATION[LTOP].BODY       := '<                               ';
        OPERATORDENOTATION[LEOP].BODY       := '<=                              ';
        OPERATORDENOTATION[GEOP].BODY       := '>=                              ';
        OPERATORDENOTATION[GTOP].BODY       := '>                               ';
        OPERATORDENOTATION[NEOP].BODY       := '<>                              ';
        OPERATORDENOTATION[EQOP].BODY       := '=                               ';
        OPERATORDENOTATION[INOP].BODY       := 'IN                              ';
        OPERATORDENOTATION[NOTOP].BODY      := 'NOTOP-ERROR!                    ';
        END (* INITDENOTATIONTABLES *);
 
    PROCEDURE READOBJECTTABLE;
 
        CONST  (* RESULT CODES *)
            TABLESUCCESSFULLYREAD   = 0;
            TABLESEEMSTOOBIG        = 1;
            CLASSOFOBJECTISWRONG    = 2;
            TYPEFORMOFOBJECTISWRONG = 3;
 
        VAR
            SERIAL : SERIALRANGE;
            OBJECTACCESS : OBJECTRECPTR;
            ENDOFOBJECTS : BOOLEAN;
 
        PROCEDURE GETNEXTOBJECT;
        (******** IMPLEMENTATION-DEPENDENT ********)
 
            BEGIN (* GETNEXTOBJECT *)
            OBJECTACCESS := ICL9LPNEXTPMOBJ;
            ENDOFOBJECTS := (OBJECTACCESS=NIL);
            END (* GETNEXTOBJECT *);
 
        PROCEDURE GETFIRSTOBJECT;
        (******** IMPLEMENTATION-DEPENDENT ********)
 
            BEGIN (* GETFIRSTOBJECT *)
            ICL9LPRESETPMOBJ;
            GETNEXTOBJECT;
            END (* GETFIRSTOBJECT *);
%NEWPAGE
        PROCEDURE CHECKOBJECTTABLE;
 
            TYPE
                SETOFTYPEFORMS = SET OF TYPEFORM;
            VAR
                SERIAL : SERIALRANGE;
 
            PROCEDURE CHECKCLASS (SERIAL : SERIALRANGE;
                                  ALLOWABLECLASS : IDCLASS);
 
                VAR
                    OK : BOOLEAN;
                BEGIN
                  OK := FALSE;
                  IF (SERIAL>NILSERIAL) AND (SERIAL<=MAXSERIAL) THEN
                    IF OBJECTTABLE[SERIAL] <> NIL THEN
                      WITH OBJECTTABLE[SERIAL]@ DO
                        OK := OBJCLASS=ALLOWABLECLASS;
                  IF NOT OK THEN
                    RESULT := CLASSOFOBJECTISWRONG;
                END (* CHECKCLASS *);
 
            PROCEDURE CHECKTYPEFORM (SERIAL : SERIALRANGE;
                                     ALLOWABLEFORMS : SETOFTYPEFORMS);
 
                VAR
                    OK : BOOLEAN;
                BEGIN
                  OK := FALSE;
                  IF (SERIAL>NILSERIAL) AND (SERIAL<=MAXSERIAL) THEN
                    IF OBJECTTABLE[SERIAL] <> NIL THEN
                      WITH OBJECTTABLE[SERIAL]@ DO
                        IF OBJCLASS=TYPES THEN
                          IF OBJFORM IN ALLOWABLEFORMS THEN OK := TRUE;
                  IF NOT OK THEN
                    RESULT := TYPEFORMOFOBJECTISWRONG;
                END (* CHECKTYPEFORM *);
 
            BEGIN (* CHECKOBJECTTABLE *)
              FOR SERIAL := NILSERIAL+1 TO MAXSERIAL DO
                IF OBJECTTABLE[SERIAL] <> NIL THEN
                  WITH OBJECTTABLE[SERIAL]@ DO
                    CASE OBJCLASS OF
                      TYPES:
                        CASE OBJFORM OF
                          SCALARS:
                            IF OBJSCALARKIND=DECLARED THEN
                              CHECKCLASS(OBJFIRSTCONST,CONSTS);
                          SUBRANGES:
                            CHECKTYPEFORM(OBJRANGETYPE,[SCALARS]);
                          SETS:
                            IF OBJBASETYPE<>NILSERIAL THEN
                              CHECKTYPEFORM(OBJBASETYPE,
                                          [SCALARS,SUBRANGES]);
%NEWPAGE
                          ARRAYS:
                            BEGIN
                              CHECKTYPEFORM(OBJAELTYPE,
                                 [SCALARS..RECORDS]);
                              CHECKTYPEFORM(OBJINXTYPE,
                                            [SCALARS,SUBRANGES])
                            END;
                          RECORDS:
                            BEGIN
                              IF OBJNONVARPART<>NILSERIAL THEN
                                CHECKCLASS(OBJNONVARPART,FIELD);
                              IF OBJVARPART<>NILSERIAL THEN
                                CHECKTYPEFORM(OBJVARPART,[VARIANTPART])
                            END;
                          POINTERS:;
                          FILES:
                            CHECKTYPEFORM(OBJFELTYPE,
                                [SCALARS..RECORDS]);
                          VARIANTPART:
                            BEGIN
                              IF OBJTAGFIELD<>NILSERIAL THEN
                                CHECKCLASS(OBJTAGFIELD,FIELD);
                              CHECKTYPEFORM(OBJFSTVARIANT,[VARIANT])
                            END;
                          VARIANT:
                            BEGIN
                              IF OBJSUBNONVARPART<>NILSERIAL THEN
                                CHECKCLASS(OBJSUBNONVARPART,FIELD);
                              IF OBJSUBVARPART<>NILSERIAL THEN
                                CHECKTYPEFORM(OBJSUBVARPART,
                                              [VARIANTPART]);
                              IF OBJNEXTVARIANT<>NILSERIAL THEN
                                CHECKTYPEFORM(OBJNEXTVARIANT,[VARIANT])
                            END
                        END (* CASE OBJFORM *);
                      CONSTS:
                        IF NEXTCONST<>NILSERIAL THEN
                          CHECKCLASS(NEXTCONST,CONSTS);
                      VARS:
                        BEGIN
                          CHECKTYPEFORM(VARTYPE,[SCALARS,SUBRANGES,
                             POINTERS,SETS,ARRAYS,RECORDS,FILES]);
                          IF NEXTLOCALVAR<>NILSERIAL THEN
                            CHECKCLASS(NEXTLOCALVAR,VARS)
                        END;
                      FIELD:
                        BEGIN
                          CHECKTYPEFORM(FIELDTYPE,[SCALARS,SUBRANGES,
                             POINTERS,SETS,ARRAYS,RECORDS]);
                          IF NEXTFIELD<>NILSERIAL THEN
                            CHECKCLASS(NEXTFIELD,FIELD)
                        END;
                      PROG,PROC,FUNC:
                        IF FIRSTLOCALVAR<>NILSERIAL THEN
                          CHECKCLASS(FIRSTLOCALVAR,VARS)
                    END (* CASE OBJCLASS *);
            END (* CHECKOBJECTTABLE *);
%NEWPAGE
        BEGIN (* READOBJECTTABLE *)
          FOR SERIAL := NILSERIAL TO MAXSERIAL DO
            OBJECTTABLE[SERIAL] := NIL;
          RESULT := TABLESUCCESSFULLYREAD;
          GETFIRSTOBJECT;
          WHILE (RESULT=TABLESUCCESSFULLYREAD) AND NOT ENDOFOBJECTS DO
          BEGIN
            WITH OBJECTACCESS@ DO
              IF (OBJSERIAL>NILSERIAL) AND (OBJSERIAL<=MAXSERIAL) THEN
                OBJECTTABLE[OBJSERIAL] := OBJECTACCESS
              ELSE
                RESULT := TABLESEEMSTOOBIG;
            GETNEXTOBJECT
          END;
          IF RESULT=TABLESUCCESSFULLYREAD THEN
            CHECKOBJECTTABLE;
        END (* READ OBJECT TABLE *);
 
    BEGIN (* ICL9LPPMINITTABS *)
    INITDENOTATIONTABLES;
    LINEMAPAVAILABLE := LINEMAPGIVEN;
    OBJECTSAVAILABLE := OBJECTSGIVEN;
    CHARCODEUSED := RUNTIMECHARCODE;
    CASE RUNTIMECHARCODE OF
      CCEBCDIC : MAXORDCHAR := 255;
      CCISO    : MAXORDCHAR := 127;
      CCICL1900: MAXORDCHAR := 63;
      CCINVALID: MAXORDCHAR := 255
      END (*CASE*);
    CHARMAP := CODETABLEPOINTER;
    IF OBJECTSAVAILABLE THEN
      READOBJECTTABLE
    ELSE
      RESULT := NOTABLETOBEREAD;
    END (* ICL9LPPMINITTABS *);
%KEYEDENTRY OFF
%TITLE 'THE DUMP MODULE: UTILITIES'
 
PROCEDURE DUMPBLOCK (VAR DFILE : TEXT;
                     BLOCKSERIAL : SERIALRANGE);
 
    TYPE
        HOWSPACEISALLOCATED = (BYBIT, BYBYTE, BYWORD);
        LOCATION = RECORD
                     WORDADDRESS : VIRTUALADDRESS;
                     CASE ALLOCATION : HOWSPACEISALLOCATED OF
                       BYBIT: (BITSIZE : 1..BITSPERWORDLESS1;
                               BITOFFSET: 0..BITSPERWORDLESS1);
                       BYBYTE:(BYTESIZE : 1..BYTESPERWORDLESS1;
                               BYTEOFFSET : 0..BYTESPERWORDLESS1);
                       BYWORD:( )
                   END;
 
    PROCEDURE DISPLAYLOCALS (FIRSTLOCAL : SERIALRANGE;
                             BASEADDRESS : VIRTUALADDRESS;
                             OFFSETLIMIT : WORDNUMBER);
 
        TYPE
            WHETHER = (FORBIDDEN,OPTIONAL,COMPULSORY);
        VAR
            VARADDRESS : LOCATION;
            VARDENOTATION : DENOTATION;
            I : 1..MAXDENOTATIONLENGTH;
            THISVAR : SERIALRANGE;
            VALUETOBESEPARATED : WHETHER;
 
 
        PROCEDURE WRITEVALUE (TYP : SERIALRANGE;
                              ADDR: LOCATION;
                              VAR TOBESEPARATED: WHETHER);
 
            CONST
                UNDEFINED = '??';
 
            PROCEDURE SEPARATE;
 
                BEGIN
                  IF TOBESEPARATED<>FORBIDDEN THEN CONTINUE(DFILE);
                  TOBESEPARATED := COMPULSORY
                END (* SEPARATE *);
 
            PROCEDURE  MAYSEPARATE;
 
                BEGIN
                  IF TOBESEPARATED=COMPULSORY THEN CONTINUE(DFILE);
                  TOBESEPARATED := OPTIONAL
                END (* MAYSEPARATE *);
 
 
            FUNCTION ORDINALCONTENTS (ADDR : LOCATION) : ORDINAL;
            (******* MACHINE&COMPILER&IMPLEMENTATION-DEPENDENT *******)
 
               BEGIN
               WITH ADDR DO
                 CASE ALLOCATION OF
                   BYWORD:
                     ORDINALCONTENTS := WORDAT(WORDADDRESS);
                   BYBYTE:
                     (* REQUIRES BYTESIZE = 1 *)
                     ORDINALCONTENTS := BYTEAT(WORDADDRESS+BYTEOFFSET);
                   BYBIT:
                     (* REQUIRES BITSIZE = 1 *)
                     ORDINALCONTENTS := ANDX(1, USHX(-BITOFFSET, WORDAT(WORDADDRESS)));
                   END (*CASE*);
               END (* ORDINALCONTENTS *);
 
            PROCEDURE POINTERCONTENTS (ADDR : LOCATION;
                                       VAR POINTERVALUE : POINTER);
            (******** MACHINE&COMPILER-DEPENDENT *******)
 
               BEGIN
               POINTERVALUE := ORDINALCONTENTS(ADDR);
               END (* POINTERCONTENTS *);
 
            PROCEDURE REALCONTENTS (ADDR : LOCATION;
                                    VAR REALVALUE : REAL;
                                    VAR ISVALID : BOOLEAN);
            (******** MACHINE&IMPLEMENTATION-DEPENDENT ********)
 
                VAR
                    R, S : VIRTUALADDRESS;
                    ISZERO : BOOLEAN;
                    W : WORD;
                    I : 1..WORDSPERREAL;
 
                BEGIN
                R := ADDRESSOF(REALVALUE);
                S := ADDR.WORDADDRESS;
                ISZERO := TRUE;
                FOR I := 1 TO WORDSPERREAL DO
                  BEGIN
                  W := WORDAT(S);
                  STOREWORDAT(W, R);
                  R := R + BYTESPERWORD;
                  S := S + BYTESPERWORD;
                  IF W<>0 THEN
                    ISZERO := FALSE;
                  END;
                ISVALID := ISZERO OR (BYTEAT(ADDR.WORDADDRESS+1) > 15);
                END (* REAL CONTENTS *);
 
            FUNCTION ISREAL (TYP : SERIALRANGE) : BOOLEAN;
 
                BEGIN
                  ISREAL := FALSE;
                  WITH OBJECTTABLE[TYP]@ DO
                    IF OBJFORM=SCALARS THEN
                      IF OBJSCALARKIND=STANDARD THEN
                        ISREAL := STDTYPE=REALSTD
                END (* IS REAL *);
 
            PROCEDURE GETBOUNDS (ORDINALTYPE : SERIALRANGE;
                                 VAR LOWERBOUND, UPPERBOUND : ORDINAL;
                                 VAR BOUNDLESS : BOOLEAN);
 
                VAR
                    THISCONST : SERIALRANGE;
                BEGIN
                  BOUNDLESS := FALSE;
                  WITH OBJECTTABLE[ORDINALTYPE]@ DO
                  BEGIN
                    CASE OBJFORM OF
                      SCALARS:
                        CASE OBJSCALARKIND OF
                          STANDARD:
                            CASE STDTYPE OF
                              INTSTD:
                                BOUNDLESS := TRUE;
                              CHARSTD:
                                BEGIN
                                  LOWERBOUND := 0;
                                  UPPERBOUND := MAXORDCHAR;
                                END
                            END (* CASE STDTYPE *);
                          DECLARED:
                            BEGIN
                              LOWERBOUND := 0;
                              UPPERBOUND := LOWERBOUND;
                              THISCONST := OBJFIRSTCONST;
                              WHILE THISCONST<>NILSERIAL DO
                                WITH OBJECTTABLE[THISCONST]@ DO
                                BEGIN
                                  IF CONSTVALUE>UPPERBOUND THEN
                                    UPPERBOUND := CONSTVALUE;
                                  THISCONST := NEXTCONST
                                END
                            END
                        END (* CASE OBJSCALARKIND *);
                      SUBRANGES:
                        BEGIN
                          LOWERBOUND := OBJMIN;
                          UPPERBOUND := OBJMAX
                        END
                    END (* CASE OBJFORM *)
                  END (* WITH *)
                END (* GET BOUNDS *);
 
            FUNCTION WIDTHOFQUOTEDSTRING (L,R : VIRTUALADDRESS) : INTEGER;
            (******* MACHINE&COMPILER&IMPLEMENTATION-DEPENDENT *******)
 
                VAR
                    A : VIRTUALADDRESS;
                    N : INTEGER;
 
                BEGIN
                N := 0;
                FOR A := L TO R DO
                  IF CONVERTEDCHAR(BYTEAT(A)) = QUOTECHAR THEN
                    N := N + 2
                  ELSE
                    N := N + 1;
                WIDTHOFQUOTEDSTRING := N + 2;
                END (* WIDTHOFQUOTEDSTRING *);
 
            PROCEDURE WRITECHARINSTRING (C : CHAR);
 
                BEGIN
                WRITE(DFILE, C);
                IF C = QUOTECHAR THEN
                  WRITE(DFILE, QUOTECHAR);
                END (* WRITECHARINSTRING *);
%TITLE 'THE DUMP MODULE: BASIC TYPES'
 
            PROCEDURE WRITEORDINALVALUE (ORDINALTYPE : SERIALRANGE;
                                         ORDINALVALUE : ORDINAL);
 
                VAR
                    LOWERBOUND, UPPERBOUND : ORDINAL;
                    UNBOUNDED, VALUEISUNDEFINED : BOOLEAN;
                    ACTUALTYPE : SERIALRANGE;
                    THISCONST : SERIALRANGE;
                    VALUEDENOTATION : DENOTATION;
                BEGIN
                  GETBOUNDS
                      (ORDINALTYPE,LOWERBOUND,UPPERBOUND,UNBOUNDED);
                  IF UNBOUNDED THEN
                    VALUEISUNDEFINED := ORDINALVALUE<MINORDINAL
                  ELSE
                    VALUEISUNDEFINED := (ORDINALVALUE<LOWERBOUND) OR
                                        (ORDINALVALUE>UPPERBOUND);
                  IF NOT VALUEISUNDEFINED THEN
                  BEGIN
                    WITH OBJECTTABLE[ORDINALTYPE]@ DO
                      IF OBJFORM=SUBRANGES THEN
                        ACTUALTYPE := OBJRANGETYPE
                      ELSE
                        ACTUALTYPE := ORDINALTYPE;
                    WITH OBJECTTABLE[ACTUALTYPE]@ DO
                    BEGIN
                      CASE OBJSCALARKIND OF
                        STANDARD:
                          CASE STDTYPE OF
                            INTSTD:
                                FINDINTEGERDENOTATION(ORDINALVALUE,
                                               VALUEDENOTATION);
                            CHARSTD:
                                FINDCHARDENOTATION(ORDINALVALUE,
                                                VALUEDENOTATION)
                          END (* CASE STDTYPE *);
                        DECLARED:
                          BEGIN
                            THISCONST := OBJFIRSTCONST;
                            VALUEISUNDEFINED := TRUE;
                            WHILE VALUEISUNDEFINED AND
                                          (THISCONST<>NILSERIAL) DO
                              WITH OBJECTTABLE[THISCONST]@ DO
                                BEGIN
                                  IF CONSTVALUE=ORDINALVALUE THEN
                                  BEGIN
                                    VALUEISUNDEFINED := FALSE;
                                    FINDIDENTIFIERDENOTATION(CONSTNAME,
                                                   VALUEDENOTATION);
                                  END
                                  ELSE THISCONST := NEXTCONST
                                END
                          END
                      END (* CASE OBJSCALARKIND *)
                    END (* WITH *)
                  END (* IF NOT VALUEISUNDEFINED *);
                  IF VALUEISUNDEFINED THEN
                    BEGIN MAKESPACEFOR(DFILE, 2); WRITE(DFILE,UNDEFINED) END
                  ELSE
                    WRITEDENOTATION(DFILE, VALUEDENOTATION)
                END (* WRITEORDINALVALUE *);
 
            PROCEDURE WRITEREAL (ADDR : LOCATION);
 
                VAR
                    REALVALUE : REAL;
                    ISVALID : BOOLEAN;
 
                BEGIN
                MAYSEPARATE;
                REALCONTENTS(ADDR, REALVALUE, ISVALID);
                IF ISVALID THEN
                  BEGIN
                  MAKESPACEFOR(DFILE, 22);
                  WRITE(DFILE,REALVALUE:22);
                  END
                ELSE
                  BEGIN
                  MAKESPACEFOR(DFILE, 2);
                  WRITE(DFILE, UNDEFINED);
                  END;
                END (* WRITEREAL *);
 
            PROCEDURE WRITEPOINTER (ADDR : LOCATION);
            (******** COMPILER-DEPENDENT ********)
 
                VAR
                    POINTERVALUE : POINTER;
                    POINTERDENOTATION : DENOTATION;
                    I : 1..MAXDENOTATIONLENGTH;
 
                BEGIN
                  MAYSEPARATE;
                  POINTERCONTENTS(ADDR, POINTERVALUE);
                  IF POINTERVALUE=NILVALUE THEN
                    BEGIN MAKESPACEFOR(DFILE, 3); WRITE(DFILE,'NIL') END
                  ELSE IF (POINTERVALUE<HEAPORIGIN) OR (POINTERVALUE>HEAPLIMIT) THEN
                     BEGIN MAKESPACEFOR(DFILE, 2); WRITE(DFILE,UNDEFINED) END
                  ELSE
                  BEGIN
                    FINDPOINTERDENOTATION(POINTERVALUE,
                                          POINTERDENOTATION);
                    WITH POINTERDENOTATION DO
                    BEGIN
                      MAKESPACEFOR(DFILE, LENGTH);
                      FOR I := 1 TO LENGTH DO WRITE(DFILE,BODY[I])
                    END
                  END
                END (* WRITEPOINTER *);
 
            PROCEDURE WRITEQUOTEDSTRING (L, R : VIRTUALADDRESS);
 
                VAR
                    M, S, W : INTEGER;
 
                PROCEDURE WRITESTRINGSEGMENT (W : INTEGER;
                                              L, R : VIRTUALADDRESS);
                (******** MACHINE&COMPILER&IMPLEMENTATION-DEPENDENT ********)
 
                    VAR
                        A : VIRTUALADDRESS;
 
                    BEGIN
                    MAKESPACEFOR(DFILE, W);
                    WRITE(DFILE, QUOTECHAR);
                    FOR A := L TO R DO
                      WRITECHARINSTRING(CONVERTEDCHAR(BYTEAT(A)));
                    WRITE(DFILE, QUOTECHAR);
                    END (* WRITESTRINGSEGMENT *);
 
                BEGIN (* WRITEQUOTEDSTRING *)
                W := WIDTHOFQUOTEDSTRING(L, R);
                S := SPACELEFT;
                IF W < S THEN
                  WRITESTRINGSEGMENT(W, L, R)
                ELSE IF W<SPACEINFRESHLINE THEN
                  BEGIN
                  CONTINUE (DFILE);
                  WRITESTRINGSEGMENT (W, L, R);
                  END
                ELSE
                  BEGIN
                  IF NOT ATLEFTMARGIN THEN
                    BEGIN
                    CONTINUE (DFILE);
                    S := SPACELEFT;
                    END;
                  M := (S-2) -2 +1;
                  REPEAT
                    M := M-1;
                    W := WIDTHOFQUOTEDSTRING(L, L+M-1);
                    UNTIL W < (S-2);
                  WRITESTRINGSEGMENT(W, L, L+M-1);
                  L := L + M;
                  IF L <= R THEN
                    BEGIN
                    MAKESPACEFOR(DFILE, 2);
                    WRITE(DFILE, ' &');
                    CONTINUE(DFILE);
                    WRITEQUOTEDSTRING(L, R);
                    END;
                  END;
                END (* WRITEQUOTEDSTRING *);
%TITLE 'THE DUMP MODULE: SETS'
            PROCEDURE WRITESET (ISPACKED : BOOLEAN;
                                BASETYPE : SERIALRANGE;
                                SETSIZE : WORDNUMBER;
                                SETADDR : LOCATION);
 
                CONST
                    SETOPENBRACKET = '[ ';
                    SETCLOSEBRACKET = ' ]';
                VAR
                    BASEMIN, BASEMAX : ORDINAL;
                    BASEUNBOUNDED : BOOLEAN;
                    BITADDR : LOCATION;
                    POTENTIALMEMBER : ORDINAL;
                    COMMAREQD : BOOLEAN;
 
                PROCEDURE DETERMINESETLAYOUT;
                (******** MACHINE&COMPILER-DEPENDENT ********)
 
                    BEGIN
                      WITH BITADDR DO
                      BEGIN
                        ALLOCATION := BYBIT;
                        BITSIZE := 1;
                      END
                    END (* DETERMINE SET LAYOUT *);
 
                FUNCTION ISMEMBER (POTENTIALMEMBER : INTEGER) : BOOLEAN;
                (******* MACHINE&COMPILER-DEPENDENT ********)
 
                    BEGIN
                      WITH BITADDR DO
                        BEGIN
                        WORDADDRESS := SETADDR.WORDADDRESS +
                            (SETSIZE - 1 - POTENTIALMEMBER DIV BITSPERWORD) * BYTESPERWORD;
                        BITOFFSET := POTENTIALMEMBER MOD BITSPERWORD;
                        END;
                      ISMEMBER := ODD(ORDINALCONTENTS(BITADDR))
                    END (* IS MEMBER *);
 
                BEGIN (* WRITE SET *)
                  GETBOUNDS(BASETYPE,BASEMIN,BASEMAX,BASEUNBOUNDED);
                  IF BASEUNBOUNDED OR (BASEMIN<0) THEN BASEMIN := 0;
                  IF BASEUNBOUNDED OR (BASEMAX>=SETSIZE*BITSPERWORD) THEN
                    BASEMAX := SETSIZE*BITSPERWORD-1;
                  DETERMINESETLAYOUT;
                  SEPARATE;
                  INDENT(DFILE,SETOPENBRACKET);
                  COMMAREQD := FALSE;
                  FOR POTENTIALMEMBER := BASEMIN TO BASEMAX DO
                    IF ISMEMBER(POTENTIALMEMBER) THEN
                    BEGIN
                      IF COMMAREQD THEN
                        WRITESEPARATOR(DFILE, 2)
                      ELSE COMMAREQD := TRUE;
                      WRITEORDINALVALUE(BASETYPE,POTENTIALMEMBER)
                    END;
                  OUTDENT(DFILE,SETCLOSEBRACKET)
                END (* WRITESET *);
%TITLE 'THE DUMP MODULE: ARRAYS'
            PROCEDURE WRITEARRAY (ISPACKED : BOOLEAN;
                                  ELEMENTTYPE, INDEXTYPE : SERIALRANGE;
                                  ARRAYADDR : LOCATION);
 
                CONST
                    ARRAYOPENBRACKET  = '( ';
                    ARRAYCLOSEBRACKET = ' )';
                VAR
                    BOUNDSPAN, NOOFLEADINGELEMENTS : INTEGER;
                    LOWERBOUND, UPPERBOUND : ORDINAL;
                    UNBOUNDED : BOOLEAN;
                    INDEX : BYTENUMBER;
                    ELEMENTTOBESEPARATED : WHETHER;
                    ELEMENTADDR : LOCATION;
                    ELEMENTSIZE : BYTENUMBER;
                    ISSTRING : BOOLEAN;
 
                PROCEDURE DETERMINEARRAYLAYOUT;
                (******** MACHINE&COMPILER-DEPENDENT ********)
 
                    BEGIN
                    WITH OBJECTTABLE[ELEMENTTYPE]@.OBJREPRESENTATION DO
                      BEGIN
                      IF (SIZE=1) AND (BYTESIZE<BYTESPERWORD) AND ISPACKED THEN
                        BEGIN
                        ELEMENTADDR.ALLOCATION := BYBYTE;
                        ELEMENTADDR.BYTESIZE := 1;
                        END
                      ELSE
                        BEGIN
                        ELEMENTADDR.ALLOCATION := BYWORD;
                        ELEMENTSIZE := SIZE * BYTESPERWORD;
                        END;
                      END;
                    END (* DETERMINE ARRAY LAYOUT *);
 
                PROCEDURE ACCESSELEMENT (NORMALISEDINDEX :  BYTENUMBER);
                (******** MACHINE&COMPILER-DEPENDENT ********)
 
                    BEGIN
                      WITH ELEMENTADDR DO
                        CASE ALLOCATION OF
                          BYBIT: ;
                          BYBYTE:
                            BEGIN
                            BYTEOFFSET := NORMALISEDINDEX MOD BYTESPERWORD;
                            WORDADDRESS := ARRAYADDR.WORDADDRESS + NORMALISEDINDEX - BYTEOFFSET;
                            END;
                          BYWORD:
                            WORDADDRESS := ARRAYADDR.WORDADDRESS + NORMALISEDINDEX*ELEMENTSIZE;
                          END (*CASE*);
                    END (* ACCESS ELEMENT *);
 
                PROCEDURE WRITESTRING (LENGTH : INTEGER);
                (******** MACHINE&COMPILER-DEPENDENT ********)
 
                    VAR
                        L, R : VIRTUALADDRESS;
 
                    BEGIN
                      MAYSEPARATE;
                      WITH ELEMENTADDR DO
                        BEGIN
                        ACCESSELEMENT(0);
                        L := WORDADDRESS + BYTEOFFSET;
                        ACCESSELEMENT(LENGTH-1);
                        R := WORDADDRESS + BYTEOFFSET;
                        END;
                      WRITEQUOTEDSTRING(L, R);
                    END (* WRITESTRING *);
 
                BEGIN (* WRITE ARRAY *)
                  GETBOUNDS(INDEXTYPE,LOWERBOUND,UPPERBOUND,UNBOUNDED);
                  BOUNDSPAN := UPPERBOUND-LOWERBOUND;
                  DETERMINEARRAYLAYOUT;
                  ISSTRING := FALSE;
                  IF ISPACKED THEN
                    WITH OBJECTTABLE[ELEMENTTYPE]@ DO
                      IF OBJFORM=SCALARS THEN
                        IF OBJSCALARKIND=STANDARD THEN
                          ISSTRING := STDTYPE=CHARSTD;
                  IF ISSTRING THEN
                    WRITESTRING(BOUNDSPAN+1)
                  ELSE
                  BEGIN
                    SEPARATE;
                    ELEMENTTOBESEPARATED := FORBIDDEN;
                    IF BOUNDSPAN>=ARRAYSIZE THEN
                      NOOFLEADINGELEMENTS := ARRAYSIZE-1
                    ELSE
                      NOOFLEADINGELEMENTS := BOUNDSPAN;
                    INDENT(DFILE,ARRAYOPENBRACKET);
                    FOR INDEX := 0 TO NOOFLEADINGELEMENTS-1 DO
                    BEGIN
                      ACCESSELEMENT(INDEX);
                      WRITEVALUE(ELEMENTTYPE,ELEMENTADDR,ELEMENTTOBESEPARATED);
                      WRITESEPARATOR(DFILE, 2);
                    END;
                    IF NOOFLEADINGELEMENTS<BOUNDSPAN THEN
                      IF ELEMENTTOBESEPARATED=COMPULSORY THEN
                      BEGIN
                        CONTINUE(DFILE);
                        MAKESPACEFOR(DFILE, 20); WRITE(DFILE,'...................,');
                      END
                      ELSE
                        BEGIN MAKESPACEFOR(DFILE, 8); WRITE(DFILE,'......, ') END;
                    ACCESSELEMENT(BOUNDSPAN);
                    WRITEVALUE(ELEMENTTYPE,ELEMENTADDR,ELEMENTTOBESEPARATED);
                    OUTDENT(DFILE, ARRAYCLOSEBRACKET)
                  END
                END (* WRITE ARRAY *);
%TITLE 'THE DUMP MODULE: RECORDS'
            PROCEDURE WRITERECORD (ISPACKED : BOOLEAN;
                                   NONVARPART, VARPART : SERIALRANGE;
                                   RECORDADDR : LOCATION);
 
                CONST
                    RECORDOPENBRACKET  = '< ';
                    RECORDCLOSEBRACKET = ' >';
                VAR
                    FIELDADDR : LOCATION;
                    THISVARPART, THISFIELD, THISVARIANT : SERIALRANGE;
                    TAGVALUE : ORDINAL;
                    LOOKINGFORVARIANT : BOOLEAN;
                    COMMAREQD : BOOLEAN;
                    FIELDTOBESEPARATED : WHETHER;
 
                PROCEDURE ACCESSFIELD (FIELD : FIELDOFFSET);
                (******** MACHINE&COMPILER-DEPENDENT ********)
 
                    BEGIN
                      WITH FIELDADDR DO
                        BEGIN
                          WORDADDRESS := RECORDADDR.WORDADDRESS + FIELD.BYTEOFFSET;
                          ALLOCATION := BYWORD;
                        END
                    END (* ACCESS FIELD *);
 
                BEGIN (* WRITE RECORD *)
                  SEPARATE;
                  FIELDTOBESEPARATED := FORBIDDEN;
                  INDENT(DFILE,RECORDOPENBRACKET);
                  COMMAREQD := FALSE;
                  THISFIELD := NONVARPART;
                  THISVARPART := VARPART;
                  WHILE (THISFIELD<>NILSERIAL) OR
                        (THISVARPART<>NILSERIAL) DO
                  BEGIN
                    WHILE THISFIELD<>NILSERIAL DO
                      WITH OBJECTTABLE[THISFIELD]@ DO
                      BEGIN
                        IF COMMAREQD THEN
                          WRITESEPARATOR(DFILE, 2)
                        ELSE COMMAREQD := TRUE;
                        ACCESSFIELD(OBJOFFSET);
                        WRITEVALUE(FIELDTYPE,FIELDADDR,FIELDTOBESEPARATED);
                        THISFIELD := NEXTFIELD
                      END;
                    IF THISVARPART<>NILSERIAL THEN
                    BEGIN
                      IF COMMAREQD THEN
                        BEGIN
                        WRITESEPARATOR(DFILE, 2);
                        SEPARATE;
                        END
                      ELSE COMMAREQD := TRUE;
                      WITH OBJECTTABLE[THISVARPART]@ DO
                        IF OBJTAGFIELD<>NILSERIAL THEN
                          WITH OBJECTTABLE[OBJTAGFIELD]@ DO
                            BEGIN
                            ACCESSFIELD(OBJOFFSET);
                            TAGVALUE := ORDINALCONTENTS(FIELDADDR);
                            MAKESPACEFOR(DFILE, 8);
                            WRITE (DFILE, 'VARIANT ');
                            WRITEVALUE (FIELDTYPE, FIELDADDR,
                                        FIELDTOBESEPARATED);
                            THISVARIANT :=
                               OBJECTTABLE[THISVARPART]@.OBJFSTVARIANT;
                            LOOKINGFORVARIANT := TRUE;
                            END
                        ELSE
                          BEGIN
                          LOOKINGFORVARIANT := FALSE;
                          THISVARIANT := NILSERIAL;
                          THISVARPART := NILSERIAL;
                          MAKESPACEFOR (DFILE,33);
                          WRITE (DFILE,'UNDIAGNOSABLE TAGLESS VARIANT ...');
                          END;
                      WHILE LOOKINGFORVARIANT AND
                            (THISVARIANT<>NILSERIAL) DO
                        WITH OBJECTTABLE[THISVARIANT]@ DO
                        BEGIN
                          IF OBJVARIANTVALUE=TAGVALUE THEN
                          BEGIN
                            LOOKINGFORVARIANT := FALSE;
                            THISFIELD := OBJSUBNONVARPART;
                            THISVARPART := OBJSUBVARPART
                          END
                          ELSE
                            THISVARIANT := OBJNEXTVARIANT
                        END;
                      IF LOOKINGFORVARIANT THEN
                        THISVARPART := NILSERIAL
                    END
                  END;
                  OUTDENT(DFILE, RECORDCLOSEBRACKET)
                END (* WRITE RECORD *);
%TITLE 'THE DUMP MODULE: FILES'
            PROCEDURE WRITEFILE (ISPACKED, ISTEXT : BOOLEAN;
                                 COMPONENTTYPE : SERIALRANGE;
                                 FILERECORDADDR : LOCATION );
 
                CONST
                    FILEOPENBRACKET  = '[[';
                    FILECLOSEBRACKET = ']]';
                    BUFFERINDICATOR = '@=';
                VAR
                    COMPONENTADDR : LOCATION;
                    ATENDOFFILE, ATHEADOFPAGE, ATENDOFLINE : BOOLEAN;
                    COMPONENTTOBESEPARATED : WHETHER;
                    MODE : INTEGER;
                    LINESTART, CURRENTPOSITION, LINEEND, CURRENTBUFFER : VIRTUALADDRESS;
                    RECORDNO : INTEGER;
 
                PROCEDURE DETERMINEFILEATTRIBUTES;
                (******** COMPILER-DEPENDENT ********)
 
                    FUNCTION HKRWORD (OFFSET : BYTENUMBER) : WORD;
                    (******* MACHINE&COMPILER&IMPLEMENTATION-DEPENDENT *******)
 
                        BEGIN
                        HKRWORD := WORDAT(FILERECORDADDR.WORDADDRESS + OFFSET);
                        END (* HKRWORD *);
 
                    FUNCTION FIBWORD (OFFSET : BYTENUMBER) : WORD;
                    (******* MACHINE&COMPILER&IMPLEMENTATION-DEPENDENT *******)
 
                        BEGIN
                        FIBWORD := WORDAT(HKRWORD(FIBSTARTWORDOFFSET) + OFFSET);
                        END (* FIBWORD *);
 
                    BEGIN (* DETERMINEFILEATTRIBUTES *)
                    MODE := FIBWORD(MODEWORDOFFSET);
                    IF (MODE<UNDEFINEDFILE) OR (MODE>=CORRUPTFILE) THEN
                      MODE := CORRUPTFILE;
                    CASE MODE OF
                      UNDEFINEDFILE, CORRUPTFILE : ;
 
                      INSPECTION :
                        BEGIN
                        RECORDNO := FIBWORD(RECORDNOWORDOFFSET);
                        ATENDOFFILE := HKRWORD(EOFWORDOFFSET) <> 0;
                        ATHEADOFPAGE := FALSE;
                        IF NOT ATENDOFFILE THEN
                          IF ISTEXT THEN
                            BEGIN
                            ATENDOFLINE := HKRWORD(EOLNWORDOFFSET) <> 0;
                            LINESTART := HKRWORD(FIBSTARTWORDOFFSET) + TEXTBUFFEROFFSET;
                            CURRENTPOSITION := HKRWORD(CURSORWORDOFFSET);
                            LINEEND := HKRWORD(TEXTENDWORDOFFSET);
                            END
                          ELSE
                            CURRENTBUFFER := HKRWORD(BUFFERWORDOFFSET);
                        END (* INSPECTION *);
 
                      GENERATION:
                        BEGIN
                        RECORDNO := FIBWORD(RECORDNOWORDOFFSET);
                        IF ISTEXT THEN
                          BEGIN
                          LINESTART := HKRWORD(FIBSTARTWORDOFFSET)+TEXTBUFFEROFFSET;
                          CURRENTPOSITION := HKRWORD(CURSORWORDOFFSET)-1;
                          ATHEADOFPAGE := (ORD(FIBWORD(PAGEFLAGOFFSET)) = ORD(TRUE));
                          END
                        ELSE
                          CURRENTBUFFER := HKRWORD(BUFFERWORDOFFSET);
                        END (* GENERATION *)
                      END (*CASE*);
                    END (* DETERMINEFILEATTRIBUTES *);
 
                PROCEDURE ACCESSCOMPONENT;
                (******** COMPILER-DEPENDENT ********)
 
                    BEGIN
                    (* NON-TEXTS *)
                    WITH COMPONENTADDR DO
                      BEGIN
                      WORDADDRESS := CURRENTBUFFER;
                      ALLOCATION := BYWORD;
                      END;
                    END (* ACCESSCOMPONENT *);
 
                PROCEDURE WRITEFILEPOSITION;
 
                    BEGIN
                    IF ISTEXT THEN
                      MAKESPACEFOR(DFILE, 4+INTSIGMAX+8+11+10+4)
                    ELSE
                      MAKESPACEFOR(DFILE, 4+INTSIGMAX+13+11+10+4);
                    WRITE(DFILE, '... ', (RECORDNO-1):1);
                    IF ISTEXT THEN
                      WRITE(DFILE, ' LINE(S)')
                    ELSE
                      WRITE(DFILE, ' COMPONENT(S)');
                    WRITE(DFILE, ' PREVIOUSLY');
                    IF MODE=GENERATION THEN
                      WRITE(DFILE, ' GENERATED')
                    ELSE
                      WRITE(DFILE, ' INSPECTED');
                    WRITE(DFILE, ' ...');
                    END (* WRITEFILEPOSITION *);
%NEWPAGE
                PROCEDURE WRITETEXTLINE;
 
                    BEGIN
                    IF ATHEADOFPAGE THEN
                      BEGIN
                      WRITESEPARATOR(DFILE, 2);
                      MAKESPACEFOR(DFILE, 6);
                      WRITE(DFILE, '(PAGE)');
                      END;
                    IF MODE=GENERATION THEN
                      BEGIN
                      IF CURRENTPOSITION>=LINESTART THEN
                        BEGIN
                        WRITESEPARATOR(DFILE, 2);
                        WRITEQUOTEDSTRING(LINESTART, CURRENTPOSITION);
                        END;
                      WRITESEPARATOR(DFILE, 2);
                      MAKESPACEFOR(DFILE, 2+2);
                      WRITE(DFILE, BUFFERINDICATOR, UNDEFINED);
                      END
                    ELSE
                    IF ATENDOFFILE THEN
                      BEGIN
                      WRITESEPARATOR(DFILE, 2);
                      MAKESPACEFOR(DFILE, 2+2+12);
                      WRITE(DFILE, BUFFERINDICATOR, UNDEFINED, ', (EOF=TRUE)');
                      END
                    ELSE
                      BEGIN
                      IF CURRENTPOSITION>LINESTART THEN
                        BEGIN
                        WRITESEPARATOR(DFILE, 2);
                        WRITEQUOTEDSTRING(LINESTART, CURRENTPOSITION-1);
                        END;
                      WRITESEPARATOR(DFILE, 2);
                      MAKESPACEFOR(DFILE,   2 + 4);
                      WRITE(DFILE, BUFFERINDICATOR);
                      WRITEQUOTEDSTRING(CURRENTPOSITION, CURRENTPOSITION);
                      IF CURRENTPOSITION+1<LINEEND THEN
                        BEGIN
                        WRITESEPARATOR(DFILE, 2);
                        WRITEQUOTEDSTRING(CURRENTPOSITION+1, LINEEND-1);
                        END;
                      IF ATENDOFLINE THEN
                        BEGIN
                        WRITESEPARATOR(DFILE, 2);
                        MAKESPACEFOR(DFILE, 11);
                        WRITE(DFILE, '(EOLN=TRUE)');
                        END;
                      END;
                    END (* WRITETEXTLINE *);
%NEWPAGE
                BEGIN (* WRITEFILE *)
                SEPARATE;
                COMPONENTTOBESEPARATED := FORBIDDEN;
                DETERMINEFILEATTRIBUTES;
                INDENT(DFILE, FILEOPENBRACKET);
                IF (MODE=UNDEFINEDFILE) OR (MODE=CORRUPTFILE) THEN
                  BEGIN
                  MAKESPACEFOR(DFILE, 2);
                  WRITE(DFILE, UNDEFINED);
                  IF MODE=UNDEFINEDFILE THEN
                    BEGIN
                    MAKESPACEFOR(DFILE, 16);
                    WRITE(DFILE,', (NOT YET OPEN)');
                    END
                  ELSE
                    BEGIN
                    MAKESPACEFOR(DFILE, 27);
                    WRITE(DFILE, ', (MAY HAVE BEEN CORRUPTED)');
                    END;
                  END
                ELSE
                IF ISTEXT THEN
                  BEGIN
                  WRITEFILEPOSITION;
                  WRITETEXTLINE;
                  END
                ELSE
                  BEGIN
                  WRITEFILEPOSITION;
                  WRITESEPARATOR(DFILE, 2);
                  IF MODE = GENERATION THEN
                    BEGIN
                    MAKESPACEFOR(DFILE, 2+2);
                    WRITE(DFILE, BUFFERINDICATOR, UNDEFINED);
                    END
                  ELSE
                  IF ATENDOFFILE THEN
                    BEGIN
                    MAKESPACEFOR(DFILE, 2+2+12);
                    WRITE(DFILE, BUFFERINDICATOR, UNDEFINED, ', (EOF=TRUE)');
                    END
                  ELSE
                    BEGIN
                    MAKESPACEFOR(DFILE, 2);
                    WRITE(DFILE, BUFFERINDICATOR);
                    ACCESSCOMPONENT;
                    WRITEVALUE(COMPONENTTYPE, COMPONENTADDR, COMPONENTTOBESEPARATED);
                    END;
                  END;
                OUTDENT(DFILE, FILECLOSEBRACKET);
                END (* WRITEFILE *);
%TITLE 'THE DUMP MODULE: WRITE VALUE'
            BEGIN (* WRITE VALUE *)
              WITH OBJECTTABLE[TYP]@ DO
              BEGIN
                CASE OBJFORM OF
                  SCALARS,
                  SUBRANGES:
                    IF ISREAL(TYP) THEN
                      WRITEREAL(ADDR)
                    ELSE
                      BEGIN
                      MAYSEPARATE;
                      WRITEORDINALVALUE(TYP,ORDINALCONTENTS(ADDR));
                      END;
                  POINTERS:
                    WRITEPOINTER(ADDR);
                  SETS:
                    WRITESET(SETISPACKED,OBJBASETYPE,OBJREPRESENTATION.SIZE,ADDR);
                  ARRAYS:
                    WRITEARRAY(ARRAYISPACKED,OBJAELTYPE,OBJINXTYPE,ADDR);
                  RECORDS:
                    WRITERECORD(RECORDISPACKED,OBJNONVARPART,OBJVARPART,ADDR);
                  FILES:
                    WRITEFILE(FILEISPACKED,FILEISTEXT,OBJFELTYPE,ADDR)
                END (* CASE *)
              END (* WITH *)
            END (* WRITEVALUE *);
%TITLE 'THE DUMP MODULE: DISPLAY LOCALS'
 
        PROCEDURE ACCESSVARIABLE (LOCALOFFSET : OBJADDRRANGE);
        (******** MACHINE&COMPILER-DEPENDENT ********)
 
            BEGIN
            VARADDRESS.WORDADDRESS := BASEADDRESS + LOCALOFFSET*BYTESPERWORD;
            VARADDRESS.ALLOCATION := BYWORD;
            END (* ACCESSVARIABLE *);
 
        BEGIN (* DISPLAYLOCALS *)
          THISVAR := FIRSTLOCAL;
          WHILE THISVAR<>NILSERIAL DO
            WITH OBJECTTABLE[THISVAR]@ DO
            BEGIN
              WRITELN(DFILE);
              FINDIDENTIFIERDENOTATION(VARNAME, VARDENOTATION);
              WITH VARDENOTATION DO
                FOR I := 1 TO LENGTH DO
                  WRITE(DFILE, BODY[I]);
              IF LOCALOFFSET>=OFFSETLIMIT THEN
                WRITE(DFILE, ' HAS BEEN LOST FROM THE STACK.')
              ELSE
              IF ISVARPARAM THEN
                WRITE(DFILE,' IS A VAR PARAMETER.')
              ELSE
              BEGIN
                WRITE(DFILE,' = ');
                STARTDENT(VARDENOTATION.LENGTH+3);
                VALUETOBESEPARATED := FORBIDDEN;
                ACCESSVARIABLE(LOCALOFFSET);
                WRITEVALUE(VARTYPE,VARADDRESS,VALUETOBESEPARATED)
              END;
              THISVAR := NEXTLOCALVAR
            END
        END (* DISPLAY LOCALS *);
%TITLE 'THE DUMP MODULE: DUMPBLOCK'
    PROCEDURE SUSPECTBLOCK;
 
        BEGIN
          WRITELN(DFILE); WRITELN(DFILE);
          WRITELN(DFILE,'>>>> ERROR IN PASCAL DIAGNOSTIC PACKAGE: ',
                  'BLOCK SERIAL NO. ',
                  BLOCKSERIAL:1, ' INVALID',
                  ' ( ** SEE CONSULTANT ** ).');
        END (* SUSPECTBLOCK *);
 
    BEGIN (* DUMPBLOCK *)
      IF (BLOCKSERIAL<=NILSERIAL) OR (BLOCKSERIAL>MAXSERIAL) THEN
        SUSPECTBLOCK
      ELSE
        WITH OBJECTTABLE[BLOCKSERIAL]@ DO
          IF NOT (OBJCLASS IN [PROC,FUNC,PROG]) THEN
            SUSPECTBLOCK
          ELSE
          BEGIN
            IF FIRSTLOCALVAR=NILSERIAL THEN
              WRITE(DFILE,'NO LOCALS.')
            ELSE
              BEGIN
                WRITELN(DFILE,'LOCALS :');
                IF OBJCLASS=PROG THEN
                  DISPLAYLOCALS(FIRSTLOCALVAR,GLOBALORIGIN,WORDSPERSEGMENT)
                ELSE
                  DISPLAYLOCALS(FIRSTLOCALVAR,STACKFRAMEORIGIN,STACKFRAMESIZE);
              END;
          END;
      WRITELN(DFILE);
    END (* DUMPBLOCK *);
%TITLE 'THE DUMP MODULE: OPEH INTERFACE'
%KEYEDENTRY ON
PROCEDURE ICL9LPPMLINENO (CODEOFFSET : BYTENUMBER;
                        VAR LINENUMBER : INTEGER);
 
    BEGIN
    FINDLOCUSOFCONTROL(CODEOFFSET);
    LINENUMBER := SOURCELINE;
    END (* ICL9LPPMLINENO *);
 
PROCEDURE ICL9LPPMBLOCKID (CODEOFFSET : BYTENUMBER;
                           VAR ROUTINEKIND : KINDOFBLOCK;
                           VAR ROUTINENAME : ALFA);
 
    BEGIN
    FINDLOCUSOFCONTROL(CODEOFFSET);
    ROUTINEKIND := BLOCK.KIND;
    IF BLOCK.KIND <> UNKNOWNBLOCK THEN
      ROUTINENAME := BLOCK.NAME;
    END (* ICL9LPPMBLOCKID *);
 
PROCEDURE ICL9LPPMDMPSPACE
             (CODEOFFSET : BYTENUMBER;
              FRAMEBASE, GLOBALBASE, HEAPBASE, HEAPLASTUSED : VIRTUALADDRESS;
              FRAMESIZE : WORDNUMBER;
              VAR DFILE : TEXT;
              ARRAYLIMIT : INTEGER);
 
    BEGIN (* ICL9LPPMDMPSPACE *)
    STACKFRAMEORIGIN := FRAMEBASE;
    GLOBALORIGIN := GLOBALBASE;
    HEAPORIGIN := HEAPBASE;
    HEAPLIMIT := HEAPLASTUSED;
    STACKFRAMESIZE := FRAMESIZE;
    ARRAYSIZE := ARRAYLIMIT;
    FINDLOCUSOFCONTROL(CODEOFFSET);
    IF BLOCK.KIND<>UNKNOWNBLOCK THEN
      DUMPBLOCK(DFILE, BLOCK.SERIAL);
    END (* ICL9LPPMDMPSPACE *);
 
PROCEDURE ICL9LPPMDMPGLOB
                 (PROGNAME : ALFA;
                  GLOBALBASE, HEAPBASE, HEAPLASTUSED : VIRTUALADDRESS;
                  VAR DFILE : TEXT;
                  ARRAYLIMIT : INTEGER);
 
    VAR
        S : SERIALRANGE;
        SEARCHCOMPLETE : BOOLEAN;
 
    BEGIN
    GLOBALORIGIN := GLOBALBASE;
    HEAPORIGIN := HEAPBASE;
    HEAPLIMIT := HEAPLASTUSED;
    ARRAYSIZE := ARRAYLIMIT;
    IF NOT OBJECTSAVAILABLE THEN
      BEGIN
      WRITELN(DFILE);
      WRITELN(DFILE,'>>>> ERROR IN PASCAL DIAGNOSTIC PACKAGE: ',
              'THERE IS NO OBJECT TABLE FOR ',
                       PROGNAME, ' ( ** SEE CONSULTANT ** ).');
      WRITELN(DFILE);
      END
    ELSE
      WITH BLOCK DO
        BEGIN
        IDENTIFICATION := BYNAME;
        NAME := PROGNAME;
 
        (* IDENTIFY PROGRAM *)
        KIND := UNKNOWNBLOCK;
        SEARCHCOMPLETE := FALSE;
        S := NILSERIAL + 1;
        REPEAT
          IF OBJECTTABLE[S] <> NIL THEN
            WITH OBJECTTABLE[S]@ DO
              IF (OBJCLASS=PROG) AND (BLOCKNAME=NAME) THEN
                BEGIN
                SERIAL := S;
                IDENTIFICATION := BYSERIAL;
                DESCRIBEBLOCK;
                SEARCHCOMPLETE := TRUE;
                END
              ELSE
                BEGIN
                S := S + 1;
                SEARCHCOMPLETE := (S>MAXSERIAL);
                END;
          UNTIL SEARCHCOMPLETE;
 
        IF KIND=PROGBLOCK THEN
          DUMPBLOCK(DFILE, SERIAL)
        ELSE
          BEGIN
          WRITELN(DFILE);
          WRITELN(DFILE,'>>>> ERROR IN PASCAL DIAGNOSTIC PACKAGE: ',
                  'THERE IS NO SUCH PROGRAM AS ',
                           PROGNAME, ' ( ** SEE CONSULTANT ** ).');
          WRITELN(DFILE);
          END;
        END (*WITH*);
    END (* ICL9LPPMDMPGLOB *);
 
(* ----------------  THE DIAGNOSTICS PACKAGE  ------------------------ *)
 
BEGIN
 
END .