T/CONST/
TS/(*  FILE HANDLING /
TS/EDSIMRD/
PS/EDNFORD/
TS/EDNFOPASSQF/ D/SQ/
G I/  EDNFOPASRCF  = 11 ;///
TS/(*  ERROR HANDLING/ P+4
TS/(*  CHARACTER CODE IDENT/
TS/CCJRNL/ PS/(*  TRANSLATION/
TS/(*  EDINBURGH CHANNEL NO/
TS/EDCHNMX/ R/108/99/
TS/EDCTSRCEIPCHN/ PS/EDSIMCHEOF/ P+1
TS/CTBASECHN/ P+2
TS/TXBFMXIX/ PS/TXOPBFDATALENB/ P+1
I/  TXBFMXDATALENB = 160 ;
  TXBFMXIX = 159 ;
  TXIPBFMXDATALENB = TXBFMXDATALENB ;
  TXOPBFLENB = TXBFMXDATALENB ;
  TXOPBFDATALENB = TXOPBFLENB ;
 
    (*  CTMLOG 'MESSAGETYPE' VALUES  *)
 
  LOGCTSUMMARYTYPE = 14 ;
  LOGCTDIAGTYPE = 14 ;
 
    (*  EBCDIC CHARACTERS FOR USE CLOSE TO SYSTEM INTERFACE  *)
 
  FORMFEEDFE = 12 ;    (* X'0C' = FORM FEED FORMAT EFFECTOR *)   
  SPACECHAR = 64 ;    (* X'40' = SPACE CHARACTER *)
/
T/TYPE/
TC/DEFINITIONS FOR ERROR HANDLING/
TC/DEFINITIONS FOR FILE-HANDLING/
TS/FETXIPRLINVALIDCH/ B/)/, FETXOPFFULL/
TS/FSTDMD/ P+1
I/  TXFCLASS =
    (ORDINARYTXF, RTSTDIP , RTSTDOP ,
     CTLIST, CTJRNL, CTDIAG, RTJRNL, RTDIAG) ;
  STDSYSOPF = CTLIST..RTDIAG ;
/
TS/CHNRNG/ B/C/ED/
G I/  FUNITRNG = EDCHNRNG ;///
TS/(*  -THE LAST POSITION/ I?  TXBFCOUNT = 0..TXBFMXDATALENB;??? P+3
TS/EDFD /
TS/JUNKA/ D/ARRAY [0..3] OF /
G P+1 I/      EDCHN : EDCHNRNG ;///
 B/WORD/ARRAY [2..5] OF /
TS/JUNKD/ R/27/31/
TS/FCBLOCK /
TS/FCHN / PS/FACS /
I/      FUNITNO : FUNITRNG ;///
TS/BFAD / B/B/RC/
G D/)/
G I/        EDRCFFDLK : EDFDPT)  ;///
TS/FCCINTERNAL /
I/        FESLOT : WORD  ;
        FTXBF : TXBF  ;
        EOLANDOFLOSLOT : WORD  ;
        TXBFAD : ADDRESS  ;
        THROWPAGE : BOOLEAN  ;
/
TS/FTXBF / P+1
I/        CASE TXFKIND : TXFCLASS OF
        ORDINARYTXF, RTSTDIP, RTSTDOP :
          (EDTXFFDLK : EDFDPT)  ;
        CTLIST, CTJRNL, CTDIAG, RTJRNL, RTDIAG :
          ()
           )
/
T/VAR/
TC/VARIABLES FOR ERROR HANDLING/
TC/VARIABLES FOR FILE HANDLING/
TS/CURTXIPCHN/
PS/CURRCCHN/ I/  HNOPLINEFAIL : BOOLEAN ;/// R/RC/ED/ B/CHNRNG/ED/
TS/(****  EDINBURGH INTERFACE ROUTINE SPECS/
TS/PROCEDURE  ICL9CEZSIM2 /
PS/FUNCTION  ICL9CEZNEWFILEOP /
B/CHNRNG/ED/
TS/(****  OPEH PROCEDURE SPECS/
I/    (****  COMPILER ENVIRONMENT PROCEDURE SPECS :-  ****)
    (****  ---------------------------------------  ****)
 
 
FUNCTION  ICL9HNLOG (MESSAGE : STRDESC ;
                     DESTINATION : INTEGER ) : RESPONSE  ;
  EXTERN  ;
 
 
FUNCTION  ICL9HNOUTPUTLINE (BUFFER : STRDESC) : RESPONSE ;
 
  EXTERN  ;
 
 
FUNCTION  ICL9HNNEWLINE (LINES : INTEGER) : RESPONSE ;
 
  EXTERN  ;
 
 
FUNCTION  ICL9HNNEWPAGE : RESPONSE ;
 
  EXTERN  ;
 
 
PROCEDURE  ICL9HNDUMP (CONTSUBTYPE, CONTTYPE : WORD; AREAS : DESC);
 
  EXTERN  ;
 
 
/
TC/FORWARD REFERENCES :-  ****)/
TS/PROCEDURE  P77FDEC /
G B/KIND/TX/ R/FSTDMD/TXFCLASS/ R/CHNRNG/FUNITRNG/
N
N LIABLE TO CHANGE
N
T/PROCEDURE  JRNLDIRECTMSGLN (/
TS/CONST/ PS/BEGIN/
G PS/ICL9LPCTMLOG/
T/PROCEDURE  JRNLFILEINIT/
?INS S/BEGIN/
  VAR
    TXKIND : TXFCLASS;
?INS S/P77FDEC/
    IF ATCOMPILETIME THEN
      TXKIND := CTJRNL
    ELSE
      TXKIND := RTJRNL;
?
TS/P77FDEC(/ R/FSTDJRNL/TXKIND/
G R/EDSIMCHNJRNL/FNULLCHN/ R/EDSIM/TXOP/
T/PROCEDURE  INITDIAGFILE/
?INS S/BEGIN/
  VAR
    TXKIND : TXFCLASS;
?INS S/P77FDEC/
    IF ATCOMPILETIME THEN
      TXKIND := CTDIAG
    ELSE
      TXKIND := RTDIAG ;
?
TS/P77FDEC(/ R/FSTDDIAG/TXKIND/
G R/EDSIMCHNDIAG/FNULLCHN/ R/EDSIM/TXOP/
N
N END LIABLE_TO_CHANGE
N
 
TS/PROCEDURE  FOPEHDIAGOUT (/
PS/PROCEDURE  FSYSOPEN (/
R/FSYS/EDF/ B/CHNRNG/ED/ BE/  ISTEXT : BOOLEAN ;/
TS/NFOACT / I/     NFOTYPE ,///
TS/CURRCCHN / R/RC/ED/
G I/    IF ISTEXT
      THEN NFOTYPE := EDNFOPASF
      ELSE NFOTYPE := EDNFOPASRCF ;
/
R/EDNFOPASSQF/NFOTYPE/
TS/END/ R/FSYS/EDF/
TS/PROCEDURE  TXFSELECT (/
PS/PROCEDURE  RCFSELECT (/
R/RC/ED/ B/CHNRNG/ED/
TS/NFORSP := ICL9/ D/SQ/
TS/CURRCCHN/ R/RC/ED/
TS/END/ R/RC/ED/
T/PROCEDURE  RCFREWIND (/
R/RC/ED/ B/CHNRNG/ED/
TS/CURRCCHN/ R/RC/ED/
TC/NFORSP :=/ D/SQ/
TS/NFORSP :=/ D/SQ/
TS/END/ R/RC/ED/
T/PROCEDURE  RCFCLOSE (/
R/RC/ED/ B/CHNRNG/ED/
TS/NFORSP := / D/SQ/
TS/CURRCCHN/ R/RC/ED/
TS/END/ R/RC/ED/
T/PROCEDURE  RCFBFIP (/ P+1
I/PROCEDURE  EDBFIN (EDFDP : EDFDPT ; VAR BFAD : ADDRESS ;
                     VAR BFLENB : RCBFRNG ; VAR ATEOF : BOOLEAN) ;
 
  VAR
    CHN : EDCHNRNG ;
    RSP : RESPONSE ;
/
TS/IF CHN / I/    CHN := EDFDP@.EDCHN ;///
R/RC/ED/
G R/RC/ED/
TS/END  (*/
I/    ATEOF := (RSP <> 0) ;
    IF ATEOF
      THEN
        BEGIN
        BFAD := NILAD ;
        BFLENB := 0 ;
        END
      ELSE
        BEGIN
        BFAD := EDFDP@.EDBFAD ;
        BFLENB := EDFDP@.EDRCLENB ;
        END ;
/
R/RCFBFIP/EDBFIN/
T/PROCEDURE  RCFBFOP (/ P+1
I/PROCEDURE  EDBFOUT (EDFDP : EDFDPT ; BFLENB : RCBFRNG ;
                      VAR FILEFULL : BOOLEAN) ;
 
  VAR
    CHN : EDCHNRNG ;
    RSP : RESPONSE ;
/
TS/IF CHN/ I/    CHN := EDFDP@.EDCHN ;///
R/RC/ED/
G R/RC/ED/
TS/END  (*/ I/    FILEFULL := (RSP <> 0) ;///
R/RCFBFOP/EDBFOUT/
T/PROCEDURE  TXLNOPSTART (/
TS/FTXBF [/ P+1 I/        THROWPAGE := FALSE ;///
 P+1 I/        FV.CHAD := TXBFAD ;///
T/PROCEDURE  RCBFOPSTART (/
TS/BFAD/ B/B/RC/ A/ED/RCF/
G B/BFAD/RC/
T/PROCEDURE  FCBSTART (/
TS/EDFDLK :=/ P+1
TS/THEN  FCCTTP / P+2
I/          THEN
            BEGIN
            TXBFAD := ADDRESSOF (FTXBF) ;
            THROWPAGE := FALSE ;
            FCCTTP := NIL ;
            IF TXFKIND IN [ORDINARYTXF, RTSTDIP, RTSTDOP]
              THEN  EDTXFFDLK := NIL ;
            END
          ELSE
            BEGIN
            RCBFAD := NILAD ;
            EDRCFFDLK := NIL ;
            END ;
/
T/PROCEDURE  FSTART (/
TS/IF  FKIND = /
PS/FCBSTART (/
I/            IF TX
              THEN
                IF TXFKIND = ORDINARYTXF
                  THEN  EDFREWIND(EDTXFFDLK@.EDCHN,FACS)
                  ELSE  FERROR(FV, FERWNDSTD)
              ELSE
                EDFREWIND(EDRCFFDLK@.EDCHN,FACS) ;
/
TS/IF  (FKIND /
PS/FACS := ACS/
I/        IF TX
          THEN
            BEGIN
            IF TXFKIND IN [ORDINARYTXF, RTSTDIP, RTSTDOP]
              THEN
                BEGIN
                EDFOPEN(FUNITNO,ACS,TRUE,EDTXFFDLK,OPENRSP) ;
                IF OPENRSP <>  EDRSPOK
                  THEN
                    IF TXFKIND = RTSTDIP
                      THEN  EDFOPEN(EDSTDIPCHN,ACS,TRUE,EDTXFFDLK,OPENRSP)
                  ELSE
                    IF TXFKIND = RTSTDOP
                      THEN  EDFOPEN(EDSTDOPCHN,ACS,TRUE,EDTXFFDLK,OPENRSP)
                      ELSE  FERROR(FV,FESYSOPEN) ;
                END ;
            IF ACS = FACSIP
              THEN  FCCTTP := CCTTPTB [CCSYSEXTNL,FCCINTERNAL]
              ELSE  FCCTTP := CCTTPTB [FCCINTERNAL,CCSYSEXTNL] ;
            END
          ELSE
            BEGIN
            EDFOPEN(FUNITNO,ACS,FALSE,EDRCFFDLK,OPENRSP) ;
            IF OPENRSP <> EDRSPOK
              THEN  FERROR(FV,FESYSOPEN) ;
            IF EDRCFFDLK@.EDMXRCLENB < RCLENRQB 
               THEN  FERROR(FV,FERCBFSYSMXLEN) ;
            END ;
/
TS/FV.LASTCHAD /./ADDRESSOF/ P./+/
I/TXBFAD / B/LEN/DATA/
TS/END  (*  FSTART/
G I/
 
PROCEDURE  EDTXLNIN (EDFDP : EDFDPT ; CCTTP : CCTTPT ; LNBFAD : ADDRESS ;
                     VAR LNBFLENB : TXBFCOUNT ; VAR LNBFOFLO, ATEOF : BOOLEAN) ;
 
  VAR
    EDBFAD : ADDRESS ;
    EDBFLENB : RCBFRNG ;
    EDBFBO : BYTE ;
    SCEDR,
    DESTDR : STRDESC ;
 
  BEGIN
    EDBFIN (EDFDP,EDBFAD,EDBFLENB,ATEOF) ;
    IF NOT ATEOF
      THEN
        BEGIN
        EDBFBO := BYTEAT(EDBFAD);
        IF EDBFBO = FORMFEEDFE
          THEN
            BEGIN
            EDBFAD := EDBFAD + 1 ;
            EDBFLENB := EDBFLENB - 1 ;
            END ;
        LNBFOFLO := (EDBFLENB > TXIPBFMXDATALENB) ;
        IF LNBFOFLO
          THEN  EDBFLENB := TXIPBFMXDATALENB ;
        DEVARSETUP(SCEDR,DETPBVC,EDBFLENB,EDBFAD) ;
        DEVARSETUP(DESTDR,DETPBVC,EDBFLENB,LNBFAD) ;
        PLIMV(SCEDR,DESTDR) ;
        LNBFLENB := EDBFLENB ;
        IF CCTTP <> IDCCTTP
          THEN  CCTRANSLATE(LNBFAD,EDBFLENB,CCTTP) ;
      END
    ELSE
      BEGIN
      LNBFOFLO := FALSE;
      LNBFLENB := EDBFLENB;
        END ;
  END  (*  EDTXLNIN  *) ;
 
 
PROCEDURE  EDTXLNOUT (EDFDP : EDFDPT ; CCTTP : CCTTPT ; LNBFAD : ADDRESS ;
                      LNBFLENB : TXBFCOUNT ; THROWPAGE : BOOLEAN ;
                      VAR FILEFULL : BOOLEAN ) ;
 
  VAR
    EDBFLENB : RCBFRNG ;
    SCEDR ,
    DESTDR : STRDESC ;
 
  BEGIN
    EDBFLENB := 0 ;
    IF THROWPAGE
      THEN
        BEGIN
        STOREBYTEAT(FORMFEEDFE,EDFDP@.EDBFAD) ;
        EDBFLENB := EDBFLENB + 1 ;
        END ;
    IF LNBFLENB = 0
      THEN
        BEGIN
        STOREBYTEAT(SPACECHAR,EDFDP@.EDBFAD+EDBFLENB) ;
        EDBFLENB := EDBFLENB + 1 ;
        END
      ELSE
        BEGIN
        IF CCTTP <> IDCCTTP
          THEN  CCTRANSLATE(LNBFAD,LNBFLENB,CCTTP) ;
        DEVARSETUP(SCEDR,DETPBVC,LNBFLENB,LNBFAD) ;
        DEVARSETUP(DESTDR,DETPBVC,LNBFLENB,EDFDP@.EDBFAD+EDBFLENB) ;
        PLIMV(SCEDR,DESTDR) ;
        EDBFLENB := EDBFLENB + LNBFLENB ;
        END ;
    EDBFOUT(EDFDP,EDBFLENB,FILEFULL) ;
  END  (*  EDTXLNOUT  *) ;
 
 
PROCEDURE  STDSYSTXLNOUT  (KIND : STDSYSOPF ; CCTTP : CCTTPT ;
                           LNBFAD : ADDRESS ; LNBFLENB : TXBFCOUNT ;
                           THROWPAGE : BOOLEAN ; VAR FILEFULL : BOOLEAN) ;
 
  VAR
    TEXTDR : STRDESC ;
    W : WORD ;
 
  FUNCTION  HNOPLINE : RESPONSE ;
 
    BEGIN
      W := ICL9HNOUTPUTLINE(TEXTDR) ;
      IF (W > 0) AND HNOPLINEFAIL
        THEN
          ICL9LPCTABORT(FALSE) ;
      HNOPLINE := W ;
    END  (* HNOPLINE *) ;
 
  BEGIN
    IF (CCTTP <> IDCCTTP) AND (LNBFLENB <> 0)
      THEN  CCTRANSLATE(LNBFAD,LNBFLENB,CCTTP) ;
    FILEFULL := FALSE ;
    CASE KIND OF
    RTJRNL, CTJRNL, CTDIAG :
      BEGIN
      IF LNBFLENB = 0
        THEN  DEVARSETUP(TEXTDR,DETPBVC,1,ADDRESSOF(SPACECHAR)+3)
        ELSE  DEVARSETUP(TEXTDR,DETPBVC,LNBFLENB,LNBFAD) ;
      CASE KIND OF
      RTJRNL :
        ICL9LPCTMLOG(TEXTDR);
      CTJRNL :
        W := ICL9HNLOG(TEXTDR,LOGCTSUMMARYTYPE) ;
      CTDIAG :
        W := ICL9HNLOG(TEXTDR,LOGCTDIAGTYPE)
      END ;
      END ;
    RTDIAG :
      BEGIN
      DEVARSETUP(TEXTDR,DETPBVC,LNBFLENB,LNBFAD) ;
      IF LNBFLENB = 0
        THEN  W := -2
        ELSE  W := -1 ;
      ICL9HEDIAGOUT(W,TEXTDR) ;
      END ;
    CTLIST :
      BEGIN
      IF THROWPAGE
        THEN  W := ICL9HNNEWPAGE ;
      IF LNBFLENB = 0
        THEN
          W := ICL9HNNEWLINE(1)
        ELSE
          BEGIN
          DEVARSETUP(TEXTDR,DETPBVC,LNBFLENB+2,LNBFAD-2) ;
          IF HNOPLINE > 0
            THEN
              BEGIN
              HNOPLINEFAIL := TRUE ;
              W := HNOPLINE ;
              END ;
          END ;
      END ;
    END (* CASE *) ;
  END  (*  STDSYSTXLNOUT  *) ;
/
T/PROCEDURE  P77RDLN (/
TS/DATACHCNT/ R/RNG/COUNT/
TS/TXBFAD / P+2 I/    BFOFLO : BOOLEAN ;///
TS/TXBFAD :=/
PS/FTXBF [DATA/ P+1
I/            EDTXLNIN(EDTXFFDLK,FCCTTP,TXBFAD,DATACHCNT,BFOFLO,FV.FEOF) ;
            IF BFOFLO
              THEN  FWARN(FV,FWTXIPBFOFLO) ;
            STOREBYTEAT(FUCRUPVCP@[UCSPACE],TXBFAD+DATACHCNT) ;
/
*7(D/    / G) P+1
T/PROCEDURE  P77WRLN (VAR FV : FVAR)  ;/
TS/DATACHCNT / P+3 I/    FILEFULL : BOOLEAN ;///
TS/TXBFAD := /
PS/TXLNOPSTART/
I/            IF TXFKIND IN [ORDINARYTXF, RTSTDOP]
              THEN
                EDTXLNOUT(EDTXFFDLK,FCCTTP,TXBFAD,FV.CHAD-TXBFAD,
                                                  THROWPAGE,FILEFULL)
              ELSE
                STDSYSTXLNOUT(TXFKIND,FCCTTP,TXBFAD,FV.CHAD-TXBFAD,
                                                  THROWPAGE,FILEFULL) ;
            IF FILEFULL
              THEN  FERROR(FV,FETXOPFFULL) ;
/
TS/FTXBF [/./TXO/ P./]/ I/0/
T/PROCEDURE  P77GREC /
TS/IPRSP / P+1 I/    IPLENB : RCBFRNG ;///
TS/RCFBFIP (/
PS/FV.TXCHRCAD /
I/            EDBFIN(EDRCFFDLK,RCBFAD,IPLENB,FV.FEOF) ;
            IF (NOT FV.FEOF) AND (IPLENB <> RCLENRQB)
              THEN  FERROR(FV,FERCIPBFLEN) ;
/
B/BFAD/RC/
T/PROCEDURE  P77PREC (/
TS/OPRSP / P+1 I/    FILEFULL : BOOLEAN ;///
TS/RCFBFOP (/ P+2
I/            EDBFOUT(EDRCFFDLK,RCLENRQB,FILEFULL) ;
            IF FILEFULL
/
T/PROCEDURE  P77FDEC/ 
TS/KIND/ B/K/TX/ R/FSTDMD/TXFCLASS/
G R/CHN/FUNIT/
TS/FKIND :=/ P+1 I/        FUNITNO := UNITNO ;///
TS/NAMEPRG [I]/./CHR/ P.E I/CHR(NAME[I]) ;/
T+2 T./CHR/ P.E I/' ' ;/
TS/IF ATCOMPILETIME/
PS/END  (*  WITH /
I/        IF TEXTF
          THEN
            BEGIN
            TXFKIND := TXKIND ;
            IF TXKIND IN [ORDINARYTXF, RTSTDIP, RTSTDOP]
              THEN  FCCINTERNAL := CCUSRPRG
              ELSE  FCCINTERNAL := CCPASSUBSYS ;
            FUCRUPVCP := UCRUPVCPVC [FCCINTERNAL] ;
            END
          ELSE
            IF RCLENWD > MAXINT DIV BINWD
              THEN  FERROR(FV,FERCBFSYSMXLEN)
              ELSE  RCLENRQB := RCLENWD * BINWD ;
/
TS/IF KIND/ B/K/TX/ R/FST/RTST/ R/FST/RTST/
T+2 B/K/TX/ R/FS/RTS/
T/PROCEDURE  INITFILEHANDLING /
TS/CURTXIPCHN / P+2 I/    HNOPLINEFAIL := FALSE ;///
R/RC/ED/
T/PROCEDURE  CLOSEDOWNFILEHANDLING /
TS/IF FVLK@.CHAD / P+1
I/                IF (FVLK@.CHAD <> TXBFAD) OR THROWPAGE///
TS/IF  FCHN /
PS/MYNEXTFCBP /
T/PROCEDURE  P77PAGE /
TS/IF  (FV.CHAD / P+2 I/            IF (FV.CHAD > TXBFAD) OR THROWPAGE///
TS/FTXBF [/ P+1 I/            THROWPAGE := TRUE ;///
T/PROCEDURE  P77HALT/
TS/CONVJRNLTTP :=/ R/CCJRNL/CCSYSEXTNL/
E