T/CONST/
TC/DETPBVC/
I/  NILDESC = ?D FFFFFFFFFFFFFFFF;
/
 
TS/CCDIAG/,R/JRNL/PASSUBSYS/
TS/CCTTICLISO/,T+10,I/
  CCTTEBCGRAPHICS = 
 
    ?X '4040404040404040404040404040404040404040404040404040404040404040'& 
       '4040404040404040404040404040404040404040404040404040404040404040'& 
       '404040404040404040404A4B4C4D4E4F504040404040404040405A5B5C5D5E5F'& 
       '606140404040404040406A6B6C6D6E6F404040404040404040797A7B7C7D7E7F'& 
       '4081828384858687888940404040404040919293949596979899404040404040'& 
       '40A1A2A3A4A5A6A7A8A940404040404040404040404040404040404040404040'& 
       'C0C1C2C3C4C5C6C7C8C9404040404040D0D1D2D3D4D5D6D7D8D9404040404040'& 
       'E040E2E3E4E5E6E7E8E9404040404040F0F1F2F3F4F5F6F7F8F9404040404040' ; 
/
 
TS/UCCONST =/,T+1,I/
 
    (****  CONSTANT DEFINITIONS FOR POSTMORTEM PACKAGE INTERFACE :-  ****)
    (****  --------------------------------------------------------  ****)
 
  MAPRECSIZE = 1 ;  (* IN BYTES *)
/
TC/ERROR HANDLING/
TC/"COMREG" CONT/,I/
  (* OMF T16 ENTRY ('MODCHAINENTRY') CONSTANTS :- *)
 
  EHMCENAMELENOFFSET = 31;
  EHMCENAMEOFFSET    = 32;
  EHMCEDTTMOFFSET    = 12;
  EHMCEDATELEN       = 10;
  EHMCETIMELEN       = 8;
 
  (* OMF T17 ENTRY ('AREA ENTRY') CONSTANTS :- *)
 
  EHAENAMELENOFFSET = 19;
  EHAENAMEOFFSET   = 20;
 
  (* MESSAGE TEXT BASE NUMBERS *)
 
  EHDOCNMESSBASE = 1000;        (* DOCUMENTATION MESSAGES (IE ERRORLINE,ROUTE,ETC*)
  EHCTDOCNMESSBASE = 1060; 
  EHRNGERRMESSBASE = 1100;
  EHCASEERRMESSBASE = 1200;
  EHHEAPERRMESSBASE = 1300;
  EHFILEERRMESSBASE = 1400;
  EHIMPERROR = 1900;
 
/
PS/CONTING/
I/  (* OPEH VALUES *)
 
  EHDIAGROUTEONLY = 1;    (* DIAGNOSTIC PARAMETER *)
  EHDIAGFULLREPORT = 4;   (*     "          "     *)
  PASCALLANGUAGECODE = 'P';
 
  (* GENERAL VALUES *)
 
  EHCOMPFAILRESPONSE = 5;
 
  (* CONTINGENCIES *)
 
  EHSTACKCONTINGENCY = 8;
  EHCONTINGENCYUPPERBOUND = 100;
/
R/8/7/
T/TYPE/
TC/WORDPT/,I/  BYTEPT = @BYTE;///
TC/"IMPSTRING" DEFS/
I/  (*  DESCRIPTOR DEFS:-  *)////  PROCDESC = DESC;    (* PROCEDURE *)
  WVDESC = DESC;    (* WORD VECTOR *)
  LWVDESC = DESC;    (* LONG WORD VECTOR *)
 
/
 
TS/VSUMD =/,T+2,I/
    (*  RUNTIME-COMPILETIME OPTIONS  *)
 
  BOOLOPTIONTYPE = 
    (RANGECHECKSOPT, COMPILEROPT, DIAGLINEMAPOPT, DIAGNAMETABLEOPT, 
     KEYEDENTRYOPT, FORWARDTRACEOPT); 
 
  SETOFBOOLOPTIONTYPE = SET OF BOOLOPTIONTYPE;
/
TS/GLOBALAREA =/,TS/END/,T+1,I/
 
    (*  DEFINITION OF LAYOUT OF FIXED PART OF OBJECT PROGRAM PLT  *)
 
  PLTLAYOUT = 
    RECORD
      STANDARD : ARRAY [0..7] OF WORD;
      GLOBAREADESCS : ARRAY [8..25] OF WORD;
      OBJECTAREADESC,
      TOKENAREADESC,
      MAPAREADESC    : STRDESC;
      VALIDRTOPTIONS : SETOFBOOLOPTIONTYPE
    END;
  PLTLAYOUTPT = @PLTLAYOUT;
 
    (*  DEFINITION OF LAYOUT OF FIXED PART OF STACK FRAME  *)
 
  STACKFRAMELAYOUT = 
    RECORD
      LNB : ADDRESS;
      PSR : WORD;
      PC  : ADDRESS;
      PLTDESCTOP : WORD;
      PLTDESCAD : ADDRESS
    END;
  STACKFRAMELAYOUTPT = @STACKFRAMELAYOUT;
/
TS/UCRUPVCVCTYPE/,T+1,I/
 
    (****  TYPE DEFINITIONS FOR POSTMORTEM PACKAGE INTERFACE :-  ****)
    (****  ----------------------------------------------------  ****)
 
  OBJECTRECPT = BYTEPT;
  TOKENRECPT = BYTEPT;
  MAPRECPT    = BYTEPT;
/
TC/FOR DUMPS/,
I/  KINDOFBLOCK = (PROGBLK,PROCBLK,FUNCBLK,UNKNOWNBLK);
 
  EHDOCNMESSTYPE = 
    (INTERRUPTERRORMESS, ERRORMESS, LIBRARYERRORMESS, GROUPMESS,
     DESCRIPTIONMESS, LOCATIONMESS, LINEMESS, DISPMESS, INMESS, 
     PROCEDUREMESS, FUNCTIONMESS, OFMESS, PROGRAMMESS,
     COMPILEDONMESS, ATMESS, PASCALMESS, MODULEMESS);
 
  EHCTDOCNMESSTYPE = 
    (FAILUREHEADMESS, CONTINGENCYMESS, SUBTYPEMESS, IMPERRMESS, 
     PASCALERRMESS, MODMESS, IINMESS, OFFSETMESS); 
 
  CONTINGENCYMESSAGELAYOUT = 
    RECORD 
      CONTSUBTYPE, 
      CONTTYPE    : WORD 
    END; 
 
  REGISTERSLAYOUT = 
    RECORD 
      LNB, PSR, PC, SSR, SF, IT, IC, CTB, 
      XNB, B, DRO, DR1, ACCO, ACC1, ACC2, ACC3, 
      PPC                                      : WORD 
    END; 
 
  CDIAGTYPE = (EHCTNULL, EHCTHLDUMP, EHCTHEXDUMP);
 
/
TS/EHAREATYPE =/,G,R/CCYDATA/REGISTERS/
A/STACK/FRAME/
TC/EHINIT/,B/)/,EHIFTPFAIL/
T/VAR/
TS/IDCC/,I/  PASSBSYSGRAPHICSTTP : CCTTPT;///
 
TC/*  GLOBAL VARIABLES FOR ERROR/
I/    (****  GLOBAL VARIABLES FOR POSTMORTEM PACKAGE INTERFACE :-  ****)
      (****  ----------------------------------------------------  ****)
 
  OBJECTSTARTADDR,
  TOKENSTARTADDR,
  MAPSTARTADDR,
  OBJECTCURRADDR,
  TOKENCURRADDR,
  MAPCURRADDR,
  OBJECTENDADDR,
  TOKENENDADDR,
  MAPENDADDR      : ADDRESS ;
 
 
/
TC/DIAGFP/,T+1
TS/CONTING/,T+1,I/  CURRSTACKFRAMEAD,///
T+5,I/  CURRSTACKFRAMELENW : SGMTRNGWD;
  DIAGLINEMAP,
  DIAGNAMETABLE : BOOLEAN;
  EHCONTINGENCYMESSAGE : CONTINGENCYMESSAGELAYOUT; 
  EHREGISTERS : REGISTERSLAYOUT; 
  CDIAG : CDIAGTYPE;
  COMPILERSTACKBASEAD : ADDRESS;
/
T/PROCEDURE  P77SETICL9LDLIBPROC/
P+1,I/FUNCTION  P77GETICL9HERRADDR : ADDRESS ;///
TC/P77SENDMESS/,T+3,I/
 
FUNCTION  P77TIDYPROCDESC : PROCDESC;
 
  EXTERN  ;
/
?INS /FUNCTION  ICL9CEZCOMREG/
PROCEDURE  ICL9CEZTIDY ;
 
  EXTERN  ;
 
 
?
TS/(*  ERROR HANDLING :-/
PS/(*  VIRTUAL STORE/
TC/*  ICL MATHS. LIB/,I/
    (****  RUN-TIME MESAGE TEXT PROCEDURE SPEC :-  ****)
    (****  --------------------------------------  ****)
 
 
FUNCTION  ICL9LPRTMTM (MESSNO : INTEGER) : STRDESC;
 
  EXTERN  ;
 
 
 
 
    (****  POST-MORTEM PACKAGE PROCEDURE SPECS.:-  ****)
    (****  --------------------------------------  ****)
 
 
PROCEDURE  P79INITDIAGTABLES (MAPREQD,
                              OBJTABREQD : BOOLEAN;
                              USERCC : CC;
                              FROMUSERCCTRANTABP : CCTTPT;
                          VAR RESULT : RESPONSE) ;
  EXTERN  ;
 
 
PROCEDURE  P79GETLINENO (CODEOFFSETB : SGMTRNGB;
                     VAR SOURCELINE : POSINT) ;
  EXTERN  ;
 
 
PROCEDURE  P79GETROUTINEID (  CODEOFFSETB : SGMTRNGB;
                          VAR BLOCKKIND : KINDOFBLOCK;
                          VAR BLOCKNAME  : ALFA            );
  EXTERN  ;
 
 
PROCEDURE  P79DUMPNAMESPACE (     CODEOFFSETB : SGMTRNGB;
                                  FRAMEBASEAD,
                                  GLOBALBASEAD : INTEGER;
                                  FRAMESIZEWD  : SGMTRNGWD;
                              VAR DIAGFILE     : TEXT;
                                  ARRAYSIZE    : INTEGER   );
  EXTERN  ;
 
 
 
 
    (****  OPEH PROCEDURE SPECS.:-  ****)
    (****  -----------------------  ****)
 
 
PROCEDURE  ICL9HEDIAGOUT (VAR POSITION : INTEGER;
                              TEXT     : STRDESC );
  EXTERN  ;
 
 
PROCEDURE  ICL9HEFATALCOMPERR (LANGUAGECODE : CHAR;
                               ERRORNUMBER  : POSINT );
  EXTERN  ;
 
 
PROCEDURE  ICL9HEPROLOG (STEERINGPARAM : INTEGER);
 
  EXTERN  ;
 
 
FUNCTION  ICL9HEFILETIDYPROC (TIDYPROCDESC : PROCDESC) : RESPONSE;
 
  EXTERN  ;
 
 
PROCEDURE ICL9HETIDYUP;
 
  EXTERN  ;
 
 
 
 
 
/
 
TC/FROM INICLS SECTION/,P+5
T/FUNCTION  P77WORDAT/,P/FUNCTION  CURLOCALNAME/
 
?INS /PROCEDURE  WRITESTR/ 
PROCEDURE  WRITESIGHEXWORD (VAR F : TEXT ; W : WORD) ; 
 
VAR 
   WAD : ADDRESS; 
   I : 0..3; 
   B : BYTE; 
   SIG : BOOLEAN; 
 
BEGIN 
   SIG := FALSE; 
   WAD := ADDRESSOF(W); 
   FOR I := 0 TO 3 DO BEGIN 
      B := BYTEAT(WAD+I); 
      SIG := SIG OR (B <> 0); 
      IF SIG OR (I = 3) THEN 
         WRITE(F,HEXDIGITS[B DIV 16],HEXDIGITS[B MOD 16]); 
      END; 
END  (* WRITESIGHEXWORD *); 
 
 
PROCEDURE  WRITESIGALFA (VAR F : TEXT; A : ALFA); 
 
VAR 
  LEN : 0..ALFALENB; 
  IX : 1..ALFALENB; 
  ENDFOUND : BOOLEAN; 
 
BEGIN 
  LEN := 0; 
  REPEAT 
    ENDFOUND := (LEN = ALFALENB); 
    IF NOT ENDFOUND THEN BEGIN 
      IX := LEN + 1; 
      ENDFOUND := (A[IX] = ' '); 
      IF NOT ENDFOUND THEN 
        LEN := IX; 
      END; 
    UNTIL ENDFOUND; 
  WRITE(F,A:LEN); 
END (* WRITESIGALFA *); 
 
 
? 
TC/MAKEIMPSTR/,I/
FUNCTION  MODSTRDESC (D : STRDESC; MODIFIER : INTEGER) : STRDESC;
 
VAR
  BND:BNDRNG;
  AD:ADDRESS;
  TYP:WORD;
  DMODDED:STRDESC;
 
BEGIN
  DESPLIT(D,TYP,BND,AD);
  BND:=BND-MODIFIER;
  AD:=AD+MODIFIER;
  DEVARSETUP(DMODDED,TYP,BND,AD);
  MODSTRDESC:=DMODDED
END (* MODSTRDESC *);
 
 
/
T/PROCEDURE  INITCHARCODE/
TS/IDCC/
I/    PASSBSYSGRAPHICSTTP:=TYPECONV(CCTTPT,ADDRESSOF(CCTTEBCGRAPHICS));///
 
/INS C/*  E R R O R /
    (**** P O S T M O R T E M   P A C K A G E   I N T E R F A C E  ****)
    (**** -------------------------------------------------------  ****)
 
 
(*#E-*)
 
PROCEDURE  PMINITDIAGTABLES (STACKFRAMEPT : STACKFRAMELAYOUTPT);
 
VAR
  PLTPT : PLTLAYOUTPT;
  DR : STRDESC;
  RC : RESPONSE ;
 
PROCEDURE  SETVBLES (AREADR:STRDESC; VAR STARTAD,CURRAD,ENDAD:ADDRESS);
 
BEGIN
  STARTAD := DEADDR(AREADR);
  IF STARTAD = NILAD THEN
    ENDAD := NILAD
  ELSE
    ENDAD := STARTAD + DEBOUND(AREADR);
  CURRAD := NILAD;
END (* SETVBLES *) ;
 
BEGIN
  PLTPT := TYPECONV(PLTLAYOUTPT,STACKFRAMEPT@.PLTDESCAD); 
  WITH PLTPT@ DO BEGIN 
    DIAGLINEMAP := DIAGLINEMAPOPT IN VALIDRTOPTIONS; 
    DIAGNAMETABLE := DIAGNAMETABLEOPT IN VALIDRTOPTIONS; 
    END;
  DR := PLTPT@.OBJECTAREADESC;                     (* OBJECT AREA *)
  SETVBLES(DR,OBJECTSTARTADDR,OBJECTCURRADDR,OBJECTENDADDR);
 
  DR := PLTPT@.TOKENAREADESC;                      (* TOKEN AREA *)
  SETVBLES(DR,TOKENSTARTADDR,TOKENCURRADDR,TOKENENDADDR);
 
  DR := PLTPT@.MAPAREADESC;                        (* MAP AREA *)
  SETVBLES(DR,MAPSTARTADDR,MAPCURRADDR,MAPENDADDR);
 
  P79INITDIAGTABLES(DIAGLINEMAP,DIAGNAMETABLE,CCUSRPRG,
                    CCTTPTB[CCUSRPRG,CCPASSUBSYS],RC) ;
  IF RC <> 0 THEN BEGIN
    DIAGLINEMAP := FALSE;
    DIAGNAMETABLE := FALSE;
    END;
END (* PMINITDIAGTABLES *);
 
(*#E+*)
 
PROCEDURE  P77RESETOBJECTAREA;
 
BEGIN
  OBJECTCURRADDR := NILAD;
END (* P77RESETOBJECTAREA *);
 
 
PROCEDURE  P77RESETTOKENAREA;
 
BEGIN
  TOKENCURRADDR := NILAD;
END (* P77RESETTOKENAREA *);
 
 
PROCEDURE  P77RESETMAPAREA;
 
BEGIN
  MAPCURRADDR := NILAD;
END (* P77RESETMAPAREA *);
 
 
FUNCTION  P77NEXTOBJECT : OBJECTRECPT ;
 
VAR
  RECSIZE : POSINT ;
 
BEGIN
  IF OBJECTCURRADDR = NILAD THEN
    OBJECTCURRADDR := OBJECTSTARTADDR
  ELSE BEGIN
    RECSIZE := WORDAT(OBJECTCURRADDR);
    IF RECSIZE = 0 THEN
      OBJECTCURRADDR := NILAD
    ELSE BEGIN
      OBJECTCURRADDR := OBJECTCURRADDR + RECSIZE;
      IF OBJECTCURRADDR >= OBJECTENDADDR THEN
        OBJECTCURRADDR := NILAD;
      END;
    END;
  P77NEXTOBJECT := TYPECONV(OBJECTRECPT,OBJECTCURRADDR);
END (* P77NEXTOBJECT *);
 
 
FUNCTION  P77NEXTTOKEN : TOKENRECPT ;
 
VAR
  RECSIZE : POSINT ;
 
BEGIN
  IF TOKENCURRADDR = NILAD THEN
    TOKENCURRADDR := TOKENSTARTADDR
  ELSE BEGIN
    RECSIZE := WORDAT(TOKENCURRADDR);
    IF RECSIZE = 0 THEN
      TOKENCURRADDR := NILAD
    ELSE BEGIN
      TOKENCURRADDR := TOKENCURRADDR + RECSIZE;
      IF TOKENCURRADDR >= TOKENENDADDR THEN
        TOKENCURRADDR := NILAD;
      END;
    END;
  P77NEXTTOKEN := TYPECONV(TOKENRECPT,TOKENCURRADDR);
END (* P77NEXTTOKEN *);
 
 
FUNCTION  P77NEXTMAPREC : MAPRECPT ;
 
BEGIN
  IF MAPCURRADDR = NILAD THEN
    MAPCURRADDR := MAPSTARTADDR
  ELSE BEGIN
    MAPCURRADDR := MAPCURRADDR + MAPRECSIZE;
    IF MAPCURRADDR >= MAPENDADDR THEN
      MAPCURRADDR := NILAD;
    END;
  P77NEXTMAPREC := TYPECONV(MAPRECPT,MAPCURRADDR);
END (* P77NEXTMAPREC *);
 
 
 
/
T/PROCEDURE  EHINITERRSTOP/
TC/EHIHEAPOFLO/,T+2,I/      EHIFTPFAIL :  MSGD := DEREFWITHBND (
          ' - ICL9HEFILETIDYPROC FAILURE') ;
/
TC/EHINTRODERR/,P+18
TC/EHDUMPAREA/,I/
PROCEDURE  EHWRITEDUMPEDAREA (AREAADDR : ADDRESS;
                              AREALENB : SGMTRNGB;
                              AREAID   : EHAREATYPE );
 
CONST
  MAXLINELEN = 32;            (* THESE TWO DEFINE NUMBER OF *)
  MAXCHARINDEXINLINE = 31;    (* BYTES PER LINE OF OUTPUT   *)
 
TYPE
  LINETYPE = PACKED ARRAY [0..MAXCHARINDEXINLINE] OF CHAR;
  ARRAYOF4BTYPE = PACKED ARRAY [0..3] OF CHAR;
 
VAR
  CURRENTLINE : LINETYPE;
  CURRENTCHAR : CHAR;
  LINEADDR : ADDRESS;
  WORDGAPMARK : 0..3;
  LINEDR : STRDESC;
  LASTLINEINDEX,
  CURRENTLINEINDEX,
  CURRENTLINELEN,
  CURRENTCHARINDEX,
  LEFTOVERS        : POSINT;
  LINEADDRARRAY : ARRAYOF4BTYPE ;
 
BEGIN
  LASTLINEINDEX := AREALENB DIV MAXLINELEN;
  LEFTOVERS := AREALENB - (LASTLINEINDEX * MAXLINELEN);
  IF LEFTOVERS = 0 THEN LASTLINEINDEX := LASTLINEINDEX - 1;
 
  FOR CURRENTLINEINDEX := 0 TO LASTLINEINDEX DO
  BEGIN
    LINEADDR := AREAADDR + (CURRENTLINEINDEX * MAXLINELEN);
    LINEADDRARRAY := TYPECONV(ARRAYOF4BTYPE,LINEADDR);
    IF AREAID <> EHAREGISTERS
    THEN
      FOR CURRENTCHARINDEX := 0 TO 3 DO
      BEGIN
        CURRENTCHAR := LINEADDRARRAY[CURRENTCHARINDEX];
        WRITE(DIAGFP@,HEXDIGITS[USHX(-4,ORD(CURRENTCHAR))],
                      HEXDIGITS[ANDX(15,ORD(CURRENTCHAR))] );
      END;
    WRITE(DIAGFP@,'   ');
    IF (CURRENTLINEINDEX = LASTLINEINDEX) AND (LEFTOVERS <> 0)
    THEN
      CURRENTLINELEN := LEFTOVERS
    ELSE
      CURRENTLINELEN := MAXLINELEN;
    FOR CURRENTCHARINDEX := 0 TO MAXCHARINDEXINLINE DO
    BEGIN
      WORDGAPMARK := ANDX(CURRENTCHARINDEX,3);    (* EVERY 4 BYTES *)
      IF WORDGAPMARK = 0 THEN WRITE(DIAGFP@,' ');
      IF CURRENTCHARINDEX < CURRENTLINELEN
      THEN
        BEGIN
        CURRENTCHAR := TYPECONV(CHAR,BYTEAT(LINEADDR + CURRENTCHARINDEX));
        CURRENTLINE[CURRENTCHARINDEX] := CURRENTCHAR;
        WRITE(DIAGFP@,HEXDIGITS[USHX(-4,ORD(CURRENTCHAR))],
                      HEXDIGITS[ANDX(15,ORD(CURRENTCHAR))] );
        END
      ELSE
        WRITE(DIAGFP@,'  ');
    END;
    IF AREAID <> EHAREGISTERS
    THEN
      BEGIN
      WRITE(DIAGFP@,'  ');
      IF CCUSRPRG <> CCPASSUBSYS
      THEN
        CCTRANSLATE(ADDRESSOF(CURRENTLINE),CURRENTLINELEN,
                                        CCTTPTB[CCUSRPRG,CCPASSUBSYS]);
      CCTRANSLATE(ADDRESSOF(CURRENTLINE),CURRENTLINELEN,
                                            PASSBSYSGRAPHICSTTP);
      LINEDR := DEREFFOR(CURRENTLINE);
      DESETBOUND(LINEDR,CURRENTLINELEN);
      WRITESTR(DIAGFP@,LINEDR);
      END;
    WRITELN(DIAGFP@);
  END;
END (* EHWRITEDUMPEDAREA *);
 
 
/
TS/EHACCY/,R/CCYDATA/REGISTERS/
T+2,R/CONTINGENCY DATA/REGISTERS/
TS/EHASTACK/,A/K/FRAME/
T+2,A/STACK/ FRAME/
T+1,R/USRPRG/CURR/,R/BASE/FRAME/
T+1,R/TOPOF/R/,R/AD - AD/FRAMELENW * 4/
TS/ICL9CEZDUMP/,I/    WRITELN(DIAGFP@);///
R/ICL9CEZDUMP/EHWRITEDUMPEDAREA/
B/)/,AREAID/
T/PROCEDURE  EHDUMPSTOP/
P/PROCEDURE  INITERRORHANDLING/
TC/INITERROR/,A/INIT/RT/,TS/LABEL/,PS/USRPRGGLBLP/
I/VAR
  TIDYPROCDESC : PROCDESC ;
  REPLY : RESPONSE ;
 
BEGIN
/
*8(D/  /,G)
I/  ICL9HEPROLOG(0);
  TIDYPROCDESC := ICL9LPRTTIDYPROCDESC ;
  REPLY := ICL9HEFILETIDYPROC(TIDYPROCDESC);
  IF REPLY > 0 THEN EHINITERRSTOP(EHIFTPFAIL);
/
P+3,D/  /
T+1,I/
 
PROCEDURE  INITCTERRORHANDLING (COMPBASELNBVAL : ADDRESS;
                                CDIAGVAL : CDIAGTYPE) ;
 
BEGIN
   CDIAG := CDIAGVAL;
   COMPILERSTACKBASEAD := COMPBASELNBVAL;
   INITDIAGFILE;
   ICL9LPCTNOMINATEERRPROC(ADDRESSOF(EHCONTINGENCYMESSAGE),
                           ADDRESSOF(EHREGISTERS)) ;
END (* INITCTERRORHANDLING *);
 
 
PROCEDURE  EHWRITETEXT (MESSDR : STRDESC);
 
BEGIN
  WRITESTR(DIAGFP@,MESSDR);
END (* EHWRITETEXT *);
 
 
PROCEDURE  EHWRITEDOCNMESS(EHDOCNMESS : EHDOCNMESSTYPE);
 
BEGIN
  EHWRITETEXT(ICL9LPRTMTM(ORD(EHDOCNMESS) + EHDOCNMESSBASE));
  WRITE(DIAGFP@,' ');
END (* EHWRITEDOCNMESS *) ;
 
 
PROCEDURE  EHWRITEMODNAME (MODCHAINENTRY : STRDESC);
 
VAR
  NAMELEN:BNDRNG;
  STRD:STRDESC;
 
BEGIN
  EHWRITEDOCNMESS(MODULEMESS);
  NAMELEN:=ORD(BYTEAT(DEADDR(MODCHAINENTRY)+EHMCENAMELENOFFSET));
  STRD:=MODSTRDESC(MODCHAINENTRY,EHMCENAMEOFFSET);
  DESETBOUND(STRD,NAMELEN);
  EHWRITETEXT(STRD);                         (* WRITE MODULE NAME *)
END (* EHWRITEMODNAME *);
 
 
PROCEDURE  EHWRITEMODDATETIME (MODCHAINENTRY : STRDESC);
 
VAR
  STRD : STRDESC;
 
BEGIN
  EHWRITEMODNAME(MODCHAINENTRY);    (* WRITE MODULE NAME *)
  WRITE(DIAGFP@,' ');
  EHWRITEDOCNMESS(COMPILEDONMESS);
  STRD:=MODSTRDESC(MODCHAINENTRY,EHMCEDTTMOFFSET);
  DESETBOUND(STRD,EHMCEDATELEN);
  EHWRITETEXT(STRD);                         (* WRITE DATE *)
  WRITE(DIAGFP@,' ');
  EHWRITEDOCNMESS(ATMESS);
  STRD:=MODSTRDESC(STRD,EHMCEDATELEN);
  DESETBOUND(STRD,EHMCETIMELEN);
  EHWRITETEXT(STRD);                         (* WRITE TIME *)
END (* EHWRITEMODDATETIME *) ;
 
 
PROCEDURE  EHNEXTSTACKFRAME (VAR STACKFRAMEAD : ADDRESS; 
                             VAR STACKFRAMELENW : SGMTRNGWD; 
                             VAR CODEADDRESS : ADDRESS); 
 
VAR 
  NEXTFRAMEAD : ADDRESS; 
  FRAMEPT: STACKFRAMELAYOUTPT; 
 
BEGIN 
  FRAMEPT := TYPECONV(STACKFRAMELAYOUTPT,STACKFRAMEAD); 
  NEXTFRAMEAD := ANDX(FRAMEPT@.LNB,?I FFFFFFFC); 
  CODEADDRESS := FRAMEPT@.PC; 
  STACKFRAMELENW := (STACKFRAMEAD-NEXTFRAMEAD) DIV 4; 
  IF NEXTFRAMEAD <> FRAMEPT@.LNB THEN 
    STACKFRAMELENW := STACKFRAMELENW - 1; 
  STACKFRAMEAD := NEXTFRAMEAD; 
END  (* EHNEXTSTACKFRAME *); 
 
 
PROCEDURE  EHWRITECTDOCNMESS (EHCTDOCNMESS : EHCTDOCNMESSTYPE); 
 
BEGIN 
  WRITESTR(DIAGFP@,ICL9LPRTMTM(ORD(EHCTDOCNMESS)+EHCTDOCNMESSBASE)); 
  WRITE(DIAGFP@,' '); 
END  (* EHWRITECTDOCNMESS *); 
 
 
PROCEDURE EHWRITEMODIINOFFSET (CODEADDRESS : ADDRESS); 
 
VAR 
   MODULENAME : ALFA; 
   IIN : POSINT; 
   OFFSET : SGMTRNGB; 
 
BEGIN 
   ICL9LPCTMRMLD(CODEADDRESS,MODULENAME,IIN,OFFSET); 
   EHWRITECTDOCNMESS(MODMESS); 
   WRITESIGALFA(DIAGFP@,MODULENAME); 
   WRITE(DIAGFP@,' '); 
   EHWRITECTDOCNMESS(IINMESS); 
   WRITE(DIAGFP@,IIN:1,' '); 
   EHWRITECTDOCNMESS(OFFSETMESS); 
   WRITESIGHEXWORD(DIAGFP@,OFFSET); 
   WRITELN(DIAGFP@); 
END  (* EHWRITEMODIINOFFSET *); 
 
 
PROCEDURE EHCTREPORT (ERRORNO , 
                      SUBTYPE : POSINT; 
                      LNB , 
                      PC : ADDRESS; 
                      NAMESPACELENW : SGMTRNGWD); 
 
VAR 
   STACKDESCENT : BOOLEAN; 
   STACKFRAMEAD : ADDRESS; 
   CODEADDRESS : ADDRESS; 
   STACKFRAMELENW : SGMTRNGWD; 
 
BEGIN 
   STACKFRAMEAD := LNB; 
   CODEADDRESS := PC; 
   EHWRITECTDOCNMESS(FAILUREHEADMESS); 
   WRITELN(DIAGFP@);WRITELN(DIAGFP@); 
   IF (CDIAG = EHCTHEXDUMP) OR (ERRORNO = EHSTACKCONTINGENCY) THEN 
      ICL9HNDUMP(SUBTYPE,ERRORNO,NILDESC) 
   ELSE BEGIN 
      IF ERRORNO < EHCONTINGENCYUPPERBOUND THEN BEGIN 
         EHWRITECTDOCNMESS(CONTINGENCYMESS); 
         WRITE(DIAGFP@,ERRORNO:1,' '); 
         EHWRITECTDOCNMESS(SUBTYPEMESS); 
         WRITE(DIAGFP@,ANDX(SUBTYPE,?I 07FFFFFF)); 
         WRITELN(DIAGFP@); 
         CONTINGENCYDATAAD := ADDRESSOF(EHREGISTERS);
         EHDUMPAREA(EHAREGISTERS); 
         END 
      ELSE IF ERRORNO = EHIMPERROR THEN 
         EHWRITECTDOCNMESS(IMPERRMESS) 
      ELSE BEGIN 
         EHWRITECTDOCNMESS(PASCALERRMESS); 
         WRITESTR(DIAGFP@,ICL9LPRTMTM(ERRORNO)); 
         END; 
      WRITELN(DIAGFP@); 
      WRITELN(DIAGFP@); 
      STACKDESCENT := TRUE; 
      WHILE STACKDESCENT DO BEGIN 
         IF CDIAG = EHCTNULL THEN 
            EHWRITEMODIINOFFSET(CODEADDRESS); 
         STACKDESCENT := (STACKFRAMEAD <> COMPILERSTACKBASEAD); 
         EHNEXTSTACKFRAME(STACKFRAMEAD,STACKFRAMELENW,CODEADDRESS); 
         END; 
      END; 
END  (* EHCTREPORT *); 
 
 
PROCEDURE  EHFLAGERROR (ERRNO : POSINT);
 
VAR
   STACKFRAMEAD : ADDRESS; 
   STACKFRAMELENW : SGMTRNGWD; 
   CODEADDRESS : ADDRESS; 
 
BEGIN 
   IF ATCOMPILETIME THEN BEGIN 
      STACKFRAMEAD := CURLOCALNAMEBASEAD; 
      EHNEXTSTACKFRAME(STACKFRAMEAD,STACKFRAMELENW,CODEADDRESS); 
      EHNEXTSTACKFRAME(STACKFRAMEAD,STACKFRAMELENW,CODEADDRESS); 
      EHCTREPORT(ERRNO,0,STACKFRAMEAD,CODEADDRESS,STACKFRAMELENW); 
      ICL9LPCTABORT(TRUE); 
      END
   ELSE 
      ICL9HEFATALCOMPERR(PASCALLANGUAGECODE,ERRNO); 
END (* EHFLAGERROR *);
 
 
 
PROCEDURE EHWRITELINENO (OFFSET : SGMTRNGB) ; 
 
VAR 
   LINENO : POSINT ; 
 
BEGIN 
   LINENO := 0; 
   IF DIAGLINEMAP THEN P79GETLINENO(OFFSET,LINENO); 
   IF LINENO = 0 THEN BEGIN 
      EHWRITEDOCNMESS(DISPMESS); 
      WRITESIGHEXWORD(DIAGFP@,OFFSET); 
      END 
   ELSE BEGIN 
      EHWRITEDOCNMESS(LINEMESS); 
      WRITE(DIAGFP@,LINENO:1); 
      END; 
END (* EHWRITELINENO *) ; 
 
 
PROCEDURE EHWRITEBLOCKID (OFFSET : SGMTRNGB); 
 
VAR 
   BLKKIND : KINDOFBLOCK; 
   BLKNAME : ALFA; 
   BLKKINDMESS : EHDOCNMESSTYPE; 
 
BEGIN 
   BLKKIND := UNKNOWNBLK; 
   IF DIAGNAMETABLE THEN 
      P79GETROUTINEID(OFFSET,BLKKIND,BLKNAME); 
   IF BLKKIND = UNKNOWNBLK THEN 
      EHWRITEDOCNMESS(PROGRAMMESS) 
   ELSE BEGIN 
      CASE BLKKIND OF 
         PROGBLK : BLKKINDMESS := PROGRAMMESS; 
         PROCBLK : BLKKINDMESS := PROCEDUREMESS; 
         FUNCBLK : BLKKINDMESS := FUNCTIONMESS; 
         END; 
      EHWRITEDOCNMESS(BLKKINDMESS); 
      WRITESIGALFA(DIAGFP@,BLKNAME); 
      END; 
END  (* EHWRITEBLOCKID *); 
 
 
PROCEDURE EHDUMPNAMESPACE (DISPLACEMENT : SGMTRNGB; 
                            ARRAYSIZE : INTEGER); 
 
BEGIN 
   IF DIAGNAMETABLE THEN 
      P79DUMPNAMESPACE (DISPLACEMENT,CURRSTACKFRAMEAD,USRPRGGLOBALBASEAD, 
                       CURRSTACKFRAMELENW,DIAGFP@,ARRAYSIZE) 
   ELSE 
      IF CURRSTACKFRAMEAD = USRPRGSTACKBASEAD THEN 
         EHDUMPAREA(EHAUSRPRGGLOBAL) 
      ELSE 
         EHDUMPAREA(EHASTACKFRAME); 
END  (* EHDUMPNAMESPACE *); 
 
 
(*#E+*)
 
 
FUNCTION  ICL9LPCTINTERRUPTERROR : RESPONSE; 
 
BEGIN 
   EHCTREPORT(EHCONTINGENCYMESSAGE.CONTTYPE, 
              EHCONTINGENCYMESSAGE.CONTSUBTYPE, 
              EHREGISTERS.LNB, 
              EHREGISTERS.PC, 
              (EHREGISTERS.SF - EHREGISTERS.LNB) DIV 4); 
   ICL9LPCTINTERRUPTERROR := EHCOMPFAILRESPONSE; 
END  (* ICL9LPCTINTERRUPTERROR *); 
 
 
FUNCTION  ICL9HERRMESSP (VAR ERRNO : INTEGER;
                        VAR EMESS : STRDESC) : RESPONSE;
 
BEGIN
  IF ERRNO >= 0
  THEN
    EMESS:=ICL9LPRTMTM(ERRNO)
  ELSE
    EMESS:=NILDESC;
  ICL9HERRMESSP:=0
END (* ICL9HERRMESSP *);
 
 
FUNCTION  ICL9LPPMPROCL    (ERRNO,
                            PROCNO,
                            GROUPNO       : INTEGER;
                            EMESS,
                            LANG1         : STRDESC;
                            DISPLACEMENT  : SGMTRNGB;
                            DIAGREC       : PROCDESC;
                            MODCHAINENTRY,
                            AREAENTRY     : STRDESC;
                            STACKFRAME    : WVDESC   ) : RESPONSE;
 
BEGIN
  WRITELN(DIAGFP@);WRITELN(DIAGFP@);
  IF ERRNO < 0
  THEN         (* INTERRUPT ERROR *)
    BEGIN
      EHWRITEDOCNMESS(INTERRUPTERRORMESS);
      WRITELN(DIAGFP@,ERRNO:1);
    END
  ELSE
    IF GROUPNO = 0
    THEN         (* <LANGUAGE> ERROR *)
      BEGIN
        EHWRITETEXT(MODSTRDESC(LANG1,1));
        EHWRITEDOCNMESS(ERRORMESS);
        WRITELN(DIAGFP@,ERRNO:1);
      END
    ELSE         (* LIBRARY ERROR *)
      BEGIN
        EHWRITEDOCNMESS(LIBRARYERRORMESS);
        WRITE(DIAGFP@,(((256*GROUPNO)+PROCNO)*256+ERRNO):1,' (');
        EHWRITETEXT(MODSTRDESC(LANG1,1));
        EHWRITEDOCNMESS(GROUPMESS);
        WRITELN(DIAGFP@,GROUPNO:1,')');
      END;
  EHWRITEDOCNMESS(DESCRIPTIONMESS);
  EHWRITETEXT(EMESS);
  WRITELN(DIAGFP@);
  PMINITDIAGTABLES(TYPECONV(STACKFRAMELAYOUTPT, 
                   ANDX(DEADDR(STACKFRAME),?I FFFFFFFC))); 
  EHWRITEDOCNMESS(LOCATIONMESS); 
  EHWRITELINENO(DISPLACEMENT); 
  WRITELN(DIAGFP@); 
  EHWRITEDOCNMESS(INMESS); 
  EHWRITEBLOCKID(DISPLACEMENT); 
  WRITELN(DIAGFP@);
  EHWRITEDOCNMESS(OFMESS);
  EHWRITEMODDATETIME(MODCHAINENTRY);
  WRITELN(DIAGFP@);
  IF (ERRNO < 0) AND NOT (DIAGNAMETABLE AND DIAGLINEMAP)
  THEN
    BEGIN
      CONTINGENCYDATAAD := ICL9LPRTGETICL9HERRADDR;
      EHDUMPAREA(EHAREGISTERS);
    END;
  WRITELN(DIAGFP@);
  ICL9LPPMPROCL := 0;
END (* ICL9LPPMPROCL *) ;
 
 
 
FUNCTION  ICL9LPPMPROCR    (DIAGNOSTICS,
                            ARRAYSIZE     : INTEGER;
                            DISPLACEMENT  : SGMTRNGB;
                            STACKFRAME    : WVDESC;
                            DIAGREC       : PROCDESC;
                            MODCHAINENTRY,
                            AREAENTRY     : STRDESC;
                            AREASOFMODULE  :  LWVDESC  ):RESPONSE;
 
VAR 
  STACKFRAMEPT : STACKFRAMELAYOUTPT;
 
BEGIN
 
  STACKFRAMEPT := TYPECONV(STACKFRAMELAYOUTPT, 
                           ANDX(DEADDR(STACKFRAME),?I FFFFFFFC)); 
  PMINITDIAGTABLES(STACKFRAMEPT); 
  EHWRITEDOCNMESS(PASCALMESS); 
  EHWRITEBLOCKID(DISPLACEMENT); 
  WRITE(DIAGFP@,' ('); 
  EHWRITEMODNAME(MODCHAINENTRY); 
  WRITE(DIAGFP@,') '); 
  EHWRITEDOCNMESS(ATMESS); 
  EHWRITELINENO(DISPLACEMENT); 
  WRITELN(DIAGFP@); 
  IF DIAGNOSTICS > EHDIAGROUTEONLY THEN BEGIN 
    WRITELN(DIAGFP@); 
    CURRSTACKFRAMEAD := TYPECONV(ADDRESS,STACKFRAMEPT); 
    CURRSTACKFRAMELENW := DEBOUND(STACKFRAME); 
    EHDUMPNAMESPACE(DISPLACEMENT,ARRAYSIZE); 
    IF DIAGNOSTICS >= EHDIAGFULLREPORT THEN 
       IF CURRSTACKFRAMEAD = USRPRGSTACKBASEAD THEN 
          EHDUMPAREA(EHAHEAP); 
    WRITELN(DIAGFP@);
    END;
  ICL9LPPMPROCR := 0;
END (* ICL9LPPMPROCR *);
 
 
    (*  SOFTWARE-DETECTED ERROR NOTIFICATION PROCEDURES :-  *)
 
 
PROCEDURE  P77RNGR (VALUEINERROR : INTEGER);
 
BEGIN
  EHFLAGERROR(EHRNGERRMESSBASE);
END (* P77RNGR *);
 
 
PROCEDURE  P77CASER ;
 
BEGIN
  EHFLAGERROR(EHCASEERRMESSBASE);
END (* P77CASER *);
 
 
/
TC/*  M A T H S/
T/PROCEDURE  P77MATHSLIBERR/
P/FUNCTION  P77SIN/
T/PROCEDURE  HEAPERROR/
TS/VAR/
I/  BEGIN
    EHFLAGERROR(ORD(ERRORID) + EHHEAPERRMESSBASE);
/
PS/END  (*  HEAPERROR/
TC/ FERROR /,G,TC/VAR/,I/  BEGIN
    EHFLAGERROR(ORD(ERRID)+EHFILEERRMESSBASE);///
PC/(*  FERROR/
TC/ FSYSOPEN /,I/PROCEDURE  FOPEHDIAGOUT (TEXTAD : ADDRESS;
                         TEXTLEN : TXBFRNG);
 
VAR
  TEXTDR:STRDESC;
  POSITION:INTEGER;
 
BEGIN
  DEVARSETUP(TEXTDR,DETPBVC,TEXTLEN,TEXTAD);
  IF TEXTLEN = 0
  THEN
    POSITION := -2
  ELSE
    POSITION:=-1;
  ICL9HEDIAGOUT(POSITION,TEXTDR);
END (* FOPEHDIAGOUT *);
 
 
/
TC/ FSTART /,TC/THEN  FCCTTP/,T+1
I/              ELSE
                IF FKIND = FSTDDIAG
                  THEN FCCTTP:=CCTTPTB[FCCINTERNAL,CCSYSEXTNL]
/
I/    /
TC/ P77WRLN /,TC/CCTRANSLATE/,T+1
I/            IF FKIND = FSTDDIAG
              THEN FOPEHDIAGOUT(TXBFAD+1,DATACHCNT)
/
B/T/  ELSE /
TC/P77FINSH/,TC/JRNL/,P+2,I/    ICL9HETIDYUP;///
TC/END/,T+1,I/
 
PROCEDURE P77TIDY ;
BEGIN
  JRNLFINISHMSG;
  CLOSEDOWNFILEHANDLING;
  ICL9CEZTIDY;
END (* P77TIDY *);
/
E