(*#T-,C0
%RANGECHECKS=NO
%CHARCODE=EBCDIC
*)
 
PROGRAM ICL9LPCTSYSIF ;
 
 
CONST
 
      (* GENERAL, HARDWARE:- *)
  
   MAXINTFORBYTE = 255 ;
   BYTESINWORD = 4 ;
   BITSINBYTE = 8 ;
   SEGBSIZE = ?I 40000 ;
   MAXBIXINSEG = ?I 3FFFF ;
   SEGWDSIZE = ?I 10000 ;
   MAXWDIXINSEG = ?I FFFF ;
   NILDESC=?D FFFFFFFFFFFFFFFF;
   NILAD=0;
   ALFALENGTH=32;
   ALFA8LENGTH=8;
   LONGSTRINGLENGTH=64;
   BLANK=' ';
   BLANKALFA='                                ';
 
      (* GENERAL EDINBURGH DEFINITIONS:- *)
 
   IMPSTRINGLENGTH=ALFALENGTH;   (*-PASCAL CONVENTION*)
   EDINEMASFLAG=0;
   EDINVMEBFLAG=1;
   EDINVMEKFLAG=2;
 
      (* CE DEFINITIONS:- *)
 
   CECOMPOKRESPONSE=0;
   CECOMPERRRESPONSE=4;
   CECOMPFAILRESPONSE=5;
 
      (* COMPILER/EDINBURGH "LPUT" OBJECT MODULE GENERATION INTERFACE:- *)
 
      (*  COMPILE-TIME ERROR CODES :-  *)
   MAXCTENUMBER = 398 ;
   CTEDMABUFFULL = 395 ;
   CTEDMARRBUFFULL = 396 ;
   CTEDIAGAREAFULL = 397 ;
      (*  SPECIAL IMPLEMENTATION FOR DIAGNOSTIC MAP AREA :-  *)
   DMABUFBSIZE = ?I 4000 ;
   MAXBIXINDMABUF = ?I 3FFF ;
   MAXDMARRALLOWED = 10 ;
      (*  "LPUT" STANDARD AREAS :-  *)
   LATCODE = 1 ;
   LATGLA = 2 ;
   LATPLT = 3 ;
   LATSST = 4 ;
   LATUST = 5 ;
   LATINITCMN = 6 ;
   LATINITSTACK = 7 ;
   LATFIRST = LATCODE ;
   LATLAST = LATINITSTACK ;
      (*  "LPUT" CALL TYPE PARAMETER VALUES :-  *)
   LCTINITOBJGEN = 0 ;
   LCTCODECOPY = LATCODE ;
   LCTGLACOPY = LATGLA ;
   LCTPLTCOPY = LATPLT ;
   LCTSSTCOPY = LATSST ;
   LCTUSTCOPY = LATUST ;
   LCTENDOBJGEN = 7 ;
   LCTNAMEDCOMMON = 10 ;
   LCTENTRYPROC = 11 ;
   LCTEXTERNALPROC = 12 ;
   LCTRELOCATEWORD = 19 ;
      (*  VALUES FOR STANDARD REGION AT HEAD OF EDIN. "GLA" AREA :-  *)
   STDGOSUSTBASEAD = 2 ;
   STDGOSSSTBASEAD = 3 ;
   STDGOSFLAGS = 4 ;
   MAXSTDGLAWDOFFSET = 7 ;
   PASCALFLAGFORGLA = 7 ;
 
      (* COMPILER SUPPORT -I/O, OPTIONS SETTINGS:- *)
 
   CCEBCDIC=0;
   CCISO=1;
   CCICL1900=2;
   LISTHEADMAX=74;
   MAXMARGIN=96;
 
 
TYPE 
 
      (* GENERAL, HARDWARE :- *)
  
   WORD = INTEGER ;
   ADDRESS = WORD ;
   RESPONSE=WORD;
   POSINT = 0..MAXINT ;
   BYTE = 0..MAXINTFORBYTE ;
   BSIZEINSEG = 0..SEGBSIZE ;
   BIXINSEG = 0..MAXBIXINSEG ;
   WDSIZEINSEG = 0..SEGWDSIZE ;
   WDIXINSEG = 0..MAXWDIXINSEG ;
   VSUSEMODE= (VSDENSE, VSLOCALISED, VSSPARSE, VSSERIAL);
   CHARCODETRANSLATIONTABLE= PACKED ARRAY [BYTE] OF BYTE;
   CHARCODETRANSLATIONTABLEPT= @CHARCODETRANSLATIONTABLE;
   STRINGDESC= DESC;
   INTDESC= DESC;
   DESCDESC= DESC;
   TEXTPT= @TEXT;
   ALFARANGE= 1..ALFALENGTH;
   ALFA= PACKED ARRAY [ALFARANGE] OF CHAR;
   ALFACOUNT= 0..ALFALENGTH;
   ALFA8RANGE= 1..ALFA8LENGTH;
   ALFA8= PACKED ARRAY [ALFA8RANGE] OF CHAR;
   ALFA8PT= @ALFA8;
   LONGSTRINGRANGE= 1..LONGSTRINGLENGTH;
   LONGSTRING= PACKED ARRAY [LONGSTRINGRANGE] OF CHAR;
 
      (* GENERAL EDINBURGH DEFINITIONS:- *)
 
   IMPSTRINGRANGE = 0..IMPSTRINGLENGTH ;
   IMPSTRING = PACKED ARRAY [IMPSTRINGRANGE] OF BYTE ;
 
      (* COMPILER/EDINBURGH "LPUT" OBJECT MODULE GENERATION INTERFACE:- *)
 
      (*  COMPILE-TIME ERROR IDENTIFICATION :-  *)
   CTERRORCODE = 1..MAXCTENUMBER ;
      (*  SPECIAL IMPLEMENTATION FOR DIAGNOSTIC MAP AREA :-  *)
   BIXINDMABUF = 0..MAXBIXINDMABUF ;
   BSIZEINDMABUF = 0..DMABUFBSIZE ;
   DIAGMAPAREABUFFER = PACKED ARRAY [BIXINDMABUF] OF BYTE ;
   DMARELOCREQREC =
     RECORD
       OFFSETB : BIXINSEG ;
       PLTOFFSETWD : WDIXINSEG
     END ;
   DMARRIX = 1..MAXDMARRALLOWED ;
   DMARRCOUNTER = 0..MAXDMARRALLOWED ;
   DMARELOCREQBUFFER = ARRAY [DMARRIX] OF DMARELOCREQREC ;
      (*  TYPES DEFINED BY EDINBURGH "LPUT" ROUTINE :-  *)
   LPUTAREATYPE = LATFIRST..LATLAST ;
   LATVECTOR = ARRAY [LPUTAREATYPE] OF POSINT ;
   LATSIZEREC =
     RECORD
       LATSIZESB : LATVECTOR ;
       TOTALSIZEB : POSINT
     END ;
   STDGLAWDOFFSET = 0..MAXSTDGLAWDOFFSET ;
      (* COMPILER OBJECT MODULE GEN. DEFINITIONS:- *)
   PASCALAREATYPE =
     (PATCODE, PATPLT, PATDIAGOBJECT, PATDIAGTOKEN, PATDIAGMAP) ;
   PATVECTOR = ARRAY [PASCALAREATYPE] OF POSINT ;
 
 
      (* COMPILER SUPPORT -I/O, OPTIONS SETTINGS:- *)
 
   CHARCODE= CCEBCDIC..CCICL1900;
   COMPILEROPTIONS=
     (CHECKSOPT, COMPILEROPT, LINEMAPOPT, PMDUMPOPT, ENTRYOPT,
      SOURCELISTOPT, OBJECTLISTOPT, PROFILEOPT, RETROOPT, TRACEOPT,
      NOCODEGENOPT);
   SETOFCOMPILEROPTIONS= SET OF COMPILEROPTIONS;
         (*-ALSO USED IN "LPUT" INTERFACE SECTION*)
   LISTHEADRANGE= 1..LISTHEADMAX;
   LISTHEADING= PACKED ARRAY [LISTHEADRANGE] OF BYTE;
   LISTPAGEHEADINGKIND=
     (SOURCELISTHEADING, PROGOBJECTLISTHEADING, PROCOBJECTLISTHEADING,
      FUNCOBJECTLISTHEADING);
   LINEPOSITION= 0..MAXMARGIN;
   SOURCELINEBUF= PACKED ARRAY [LINEPOSITION] OF CHAR;
   SOURCELINESTATUS=
     (SOURCEIPOK, SOURCEIPTRUNCATED, SOURCEIPIGNORE, SOURCEIPLISTONLY,
      SOURCEIPFILEEND);
 
      (* OMF MODULE GENERATION:- *)
 
   OMFGENOPTIONS=
     (OMFSHARE, OMFLIBPROC, OMFNOCASCADE, OMFMAXKEYS, OMFFIXUPTRACE,
      OMFMAPMODULE);
   SETOFOMFGENOPTIONS= SET OF OMFGENOPTIONS;
 
 
VAR
 
      (* PREMATURE ERROR EXIT TO CE:- *)
 
   CONTROLSTACKBASEAD: ADDRESS;
 
      (* COMPILE-TIME LOW-LEVEL FACILITIES:- *)
 
   JOURNALFILEP,
   DIAGFILEP: TEXTPT;
   ETOITABP,
   ITOETABP: CHARCODETRANSLATIONTABLEPT;
   JCLCDIAGVALUE: BYTE;
 
      (* COMPILER/EDINBURGH "LPUT" OBJECT MODULE GENERATION INTERFACE:- *)
 
      (*  SPECIAL IMPLEMENTATION OF DIAGNOSTIC MAP AREA :-  *)
   DMARRCOUNT : DMARRCOUNTER ;
   DMARELOCREQHOLD : DMARELOCREQBUFFER ;
   DMAREAHOLD : DIAGMAPAREABUFFER ;
 
      (* COMPILER SUPPORT -I/O, OPTIONS SETTINGS:- *)
 
   JCLCHARCODEOPTION: CHARCODE;
   JCLBOOLOPTSFORCOMPILER: SETOFCOMPILEROPTIONS;
   LISTFILEP: TEXTPT;
 
      (* SUPPORT FOR MAIN COMPILATION "CONTROL" ROUTINE:- *)
 
   COMPILATIONERRORCOUNT: POSINT;
 
 
(******** SPECIALLY CODED PRIMITIVE SUPPORT ********)
 
 
FUNCTION ICL9LPCTDATEAD : ADDRESS;
   EXTERN;                              (*CE INTERFACE*)
 
FUNCTION ICL9LPCTTIMEAD : ADDRESS;
   EXTERN;                              (*CE INTERFACE*)
 
FUNCTION ICL9LPCURSTACKBASEAD : ADDRESS;
   EXTERN;
 
PROCEDURE ICL9LPEXITWITHRESPATLNB (RESPVAL: RESPONSE; LNBVAL: ADDRESS);
   EXTERN;
 
 
(******** INTERFACE TO JCL DIRECT ENTRY PROCEDURE MODULE ********)
 
 
PROCEDURE ICL9LPCTGETPASCALJCLOPTS (VAR JCLBOOLOPTS: SETOFCOMPILEROPTIONS;
                                    VAR JCLCHARCODEOPT: CHARCODE);
   EXTERN;
 
 
(******** SPECIAL COMPILE-TIME INTERFACE TO "LIBNUC" MODULE ********)
 
 
PROCEDURE ICL9LPINITCTSUPPORT (VAR LISTFP, DIAGFP, JOURNALFP: TEXTPT;
                               VAR EBCDICTOISOTABP, ISOTOEBCDICTABP:
                                   CHARCODETRANSLATIONTABLEPT;
                               CDIAGVALUE: BYTE);
   EXTERN;
 
 
(******** INTERFACE TO THE COMPILER ********)
 
 
PROCEDURE ICL9LPCOMPILE;
   EXTERN;
 
 
(******** COMPILER'S COMPILATION ERROR HANDLING ********)
 
 
PROCEDURE ICL9LPCTERROR (ERRORID: CTERRORCODE);
   EXTERN;
 
 
(******** EDINBURGH SUPPORT ROUTINES ********)
 
 
PROCEDURE ICL9CEZNCODE (STARTAD, STOPAD: ADDRESS;           (*PLI LISTING*)
                        QUOTEBOFFSETINMARGIN: BIXINSEG);
   EXTERN;
 
PROCEDURE ICL9CEZLPUT (CALLTYPE: POSINT; PARAM1, PARAM2, PARAM3: INTEGER);
   EXTERN;
 
FUNCTION ICL9CEZOMFOUT (OPSYS: WORD; TMPOBJAREAAD, WRKAREAAD: ADDRESS;
                        CONTROL: WORD; EBCDICLANGCODE: CHAR;
                        EBCDICDATEAD, EBCDICTIMEAD: ADDRESS;
                        VAR EBCDICSUBNAME, EBCDICVERSIONNAME, ISOMODULENAME,
                        ISOICL9CEPREFIX, ISOMATHSLIBPREFIX: IMPSTRING) : RESPONSE;
   EXTERN;
 
   (* ROUTINES IN "LPUT" MODULE ESPECIALLY FOR PASCAL:- *)
 
PROCEDURE ICL9CEZINITLPUT (WORKAREAAD, TEMPAREAAD: ADDRESS);
   EXTERN;
 
PROCEDURE ICL9CEZGIVELPUTITEMS (VAR ERRORFLAG: INTEGER;
                                VAR MAINENTRYNAME: IMPSTRING);
   EXTERN;
 
 
(******** CE SUPPORT ROUTINES ********)
 
 
PROCEDURE ICL9HNLOG (MESSAGEDESC: STRINGDESC; DESTINATIONCODE: BYTE);
   EXTERN;
 
FUNCTION ICL9HNCREATEVS (NAMED: STRINGDESC; BSIZE: POSINT;
                         MODE: VSUSEMODE; AREADESCDESC: DESCDESC) : RESPONSE;
   EXTERN;
 
FUNCTION ICL9HNMONITOR (CDIAGTAG: INTEGER) : RESPONSE ;
   EXTERN;
 
FUNCTION ICL9HNCREATEMODULE (NAME: STRINGDESC; FULLNAMEDESC: STRINGDESC;
                             BSIZE: INTEGER) : RESPONSE;
   EXTERN;
 
FUNCTION ICL9HNENDMODULE (DELETE: BOOLEAN) : RESPONSE;
   EXTERN;
 
FUNCTION ICL9HNCREATEALIAS (ALIASNAMEDESC, DUMMYDESC: DESC) : RESPONSE;
   EXTERN;
 
FUNCTION ICL9HNSUBHEAD (SUBHEADDESC: STRINGDESC;
                        LINESINSUBHEAD,
                        ZEROORLINESFORSAMEPAGE,
                        LINESWANTEDBEFORESUBHEAD: POSINT;
                        TRYTODELAYUNTILPAGETHROW: BOOLEAN) : RESPONSE;
   EXTERN;
 
FUNCTION ICL9HNREADCARD (BUFFD: STRINGDESC; SEQUENCEIDD: STRINGDESC;
                         BYTELENGTHDESC: INTDESC) : RESPONSE;
   EXTERN;
 
 
(******** DESCRIPTOR CONVERSION ********)
   
   
FUNCTION DESCFORINT(VAR I: INTEGER) : INTDESC;
   CONST
      DETPWV=?I 28000000;
   VAR
      D: DESC;
   BEGIN
   DEVARSETUP(D,DETPWV,1,ADDRESSOF(I));
   DESCFORINT:=D;
   END (* DESCFORINT *);
    
FUNCTION DESCFORDESC(VAR D: DESC) : DESCDESC;
   CONST
      DETPDWV=?I 30000000;
   VAR
   DD: DESC;
   BEGIN;
   DEVARSETUP(DD,DETPDWV,1,ADDRESSOF(D));
   DESCFORDESC:=DD;
   END (* DESCFORDESC *);
   
   
(******** STRING TYPE CONVERSION UTILITIES ********)
 
 
FUNCTION NULLPLEX(PLEXAD: ADDRESS) : BOOLEAN;
   BEGIN
   IF PLEXAD<>NILAD THEN
      NULLPLEX:=(BYTEAT(PLEXAD) = 0)
   ELSE
      NULLPLEX:=TRUE;
   END (* NULLPLEX *);
 
FUNCTION ALFASIGLEN(A: ALFA) : ALFACOUNT;
   VAR
      I: ALFACOUNT;
   BEGIN
   IF A[1]=BLANK THEN
      I:=0
   ELSE
      BEGIN
      I:=ALFALENGTH;
      WHILE A[I]=BLANK DO I:=I-1;
      END;
   ALFASIGLEN:=I;
   END (* ALFASIGLEN *);
 
FUNCTION DESCFORSTRING(STRLENB: BSIZEINSEG; STRAD: ADDRESS) : STRINGDESC;
   CONST
      DETPBV=?I 18000000;
   VAR
      D: DESC;
   BEGIN
   DEVARSETUP(D,DETPBV,STRLENB,STRAD);
   DESCFORSTRING:=D;
   END (* DESCFORSTRING *);
 
FUNCTION SIGALFADESC(VAR A: ALFA) : STRINGDESC;
   VAR
      D: DESC;
   BEGIN
   D:=DESCFORSTRING(ALFASIGLEN(A),ADDRESSOF(A));
   SIGALFADESC:=D;
   END (* SIGALFADESC *);
 
PROCEDURE PLEXTOALFA(PLEXAD: ADDRESS; VAR A: ALFA);
   VAR
      ENDIX: BYTE;
      I: ALFARANGE;
   BEGIN
   A:=BLANKALFA;
   IF NOT NULLPLEX(PLEXAD) THEN
      BEGIN
      ENDIX:=BYTEAT(PLEXAD);
      IF ENDIX>ALFALENGTH THEN
         ENDIX:=ALFALENGTH;
      FOR I:=1 TO ENDIX DO
         A[I]:=CHR(BYTEAT(PLEXAD+I));
      END;
   END (* PLEXTOALFA *);
 
PROCEDURE ALFATOPLEX(A: ALFA; PLEXAD: ADDRESS);
   VAR
      SIGLEN, I: ALFACOUNT;
   BEGIN
   SIGLEN:=ALFASIGLEN(A);
   STOREBYTEAT(SIGLEN,PLEXAD);
   FOR I:=1 TO SIGLEN DO
      STOREBYTEAT(ORD(A[I]),PLEXAD+I);
   END (* ALFATOPLEX *);
 
PROCEDURE IMPTOALFA(I: IMPSTRING; VAR A: ALFA);
   VAR
      IX, MAXIX: IMPSTRINGRANGE;
   BEGIN
   A:=BLANKALFA;
   MAXIX:=I[0];
   IF MAXIX>ALFALENGTH THEN
      MAXIX:=ALFALENGTH;
   FOR IX:=1 TO MAXIX DO
      A[IX]:=CHR(ITOETABP@[I[IX]]);
   END (* IMPTOALFA *);
 
PROCEDURE ALFATOIMP(A: ALFA; VAR I: IMPSTRING);
   VAR
      IX, MAXIX: IMPSTRINGRANGE;
   BEGIN
   MAXIX:=ALFASIGLEN(A);
   I[0]:=MAXIX;
   FOR IX:=1 TO MAXIX DO
      I[IX]:=ETOITABP@[ORD(A[IX])];
   END (* ALFATOIMP *);
 
PROCEDURE ALFATOEBCDICIMP(A: ALFA; VAR EI: IMPSTRING);
   VAR
      IX, MAXIX: IMPSTRINGRANGE;
   BEGIN
   MAXIX:=ALFASIGLEN(A);
   EI[0]:=MAXIX;
   FOR IX:=1 TO MAXIX DO
      EI[IX]:=ORD(A[IX]);
   END (* ALFATOEBCDICIMP *);
 
 
(******** SUPPORT ROUTINES FOR THIS & OTHER LOW LEVEL MODULES ********)
 
 
(*#E+
%KEYEDENTRY ON
*)
 
PROCEDURE ICL9LPCTABORT (COMPILERFAIL: BOOLEAN);
   VAR
      RESPONSETOCE: RESPONSE;
   BEGIN
   IF COMPILERFAIL THEN
      RESPONSETOCE:=CECOMPFAILRESPONSE
   ELSE
      RESPONSETOCE:=CECOMPERRRESPONSE;
   ICL9LPEXITWITHRESPATLNB(RESPONSETOCE,CONTROLSTACKBASEAD);
   END (* ICL9LPCTABORT *) ;
 
PROCEDURE ICL9LPCTGETVSAREA (AREANAMED: STRINGDESC; SIZEB: POSINT;
                             MODE: VSUSEMODE; VAR AREAAD: ADDRESS) ;
   VAR
      AREADESC: DESC;
      CERESPONSE: RESPONSE;
 
   PROCEDURE ALLOCFAILABANDON;
      CONST
         FAILMESS='VIRTUAL STORE WORK AREA CREATION FAILURE';
         FAILMESSLEN=40;
         CTMMESSTYPE=14;
      BEGIN
            (*USE "LOG", AS "JOURNALFILEP@" ROUTE MAY NOT BE READY YET:-*)
      ICL9HNLOG(DESCFORSTRING(FAILMESSLEN,ADDRESSOF(FAILMESS)),CTMMESSTYPE);
      ICL9LPCTABORT(FALSE);
      END (*ALLOCFAILABANDON*);
 
   BEGIN
   CERESPONSE:=ICL9HNCREATEVS(AREANAMED,SIZEB,MODE,DESCFORDESC(AREADESC));
   IF CERESPONSE<>0 THEN
      ALLOCFAILABANDON;
   AREAAD:=DEADDR(AREADESC);
   END (* ICL9LPCTGETVSAREA *) ;
 
PROCEDURE ICL9LPCTDATEANDTIME (VAR DATE, TIME: ALFA8);
   VAR
      DATEP, TIMEP: ALFA8PT;
      I: ALFA8RANGE;
   BEGIN
   DATEP:=TYPECONV(ALFA8PT,(ICL9LPCTDATEAD+2));   (*-SKIP '19' IN YEAR*)
   TIMEP:=TYPECONV(ALFA8PT,ICL9LPCTTIMEAD);
   FOR I:=1 TO ALFA8LENGTH DO
      BEGIN DATE[I]:=DATEP@[I]; TIME[I]:=TIMEP@[I] END;
   END (* ICL9LPCTDATEANDTIME *) ;
 
 
(******** COMPILER'S OBJECT MODULE GENERATION INTERFACE ********)
 
 
      (* -BASED ON THE EDINBURGH "LPUT" ROUTINE; THIS SECTION IMPLEMENTS     *)
      (*  THAT WHICH HAS PREVIOUSLY BEEN REFERRED TO AS THE "LPUT" INTERFACE *)
 
      (* -FORWARD DECLARATIONS FOR SPECIAL IMPLEMENTATION OF *)
      (* THE DIAGNOSTIC MAP AREA:-                           *)
 
(*#E+
%KEYEDENTRY ON
*)
 
PROCEDURE ICL9LPOMGCOPY (COPYSIZEB : BSIZEINSEG ;
                         FROMAD : ADDRESS ;
                         INTOAREA : PASCALAREATYPE ;
                         OFFSETINAREAB : BIXINSEG) ;
 
  FORWARD ;
 
 
PROCEDURE ICL9LPOMGRELOC (BASEAREA : PASCALAREATYPE ;
                          OFFSETINAREAB : BIXINSEG ;
                          PLTDESCOFFSETWD : WDIXINSEG) ;
 
  FORWARD ;
 
(*#E-
%KEYEDENTRY OFF
*)
 
      (* -GENERAL SUPPORT FOR LPUT INTERFACE:- *)
 
FUNCTION LPUTAREA (PASCALAREA : PASCALAREATYPE) : LPUTAREATYPE ;
 
  BEGIN
    CASE  PASCALAREA  OF
      PATCODE :  LPUTAREA := LATCODE ;
      PATPLT :  LPUTAREA := LATGLA ;
      PATDIAGOBJECT :  LPUTAREA := LATSST ;
      PATDIAGTOKEN :  LPUTAREA := LATUST ;
      PATDIAGMAP :  (* - SHOULD NEVER GET HERE *)
                    LPUTAREA := LATSST ;
    END (* CASE *) ;
  END (* LPUTAREA *) ;
 
 
PROCEDURE SETGLAWORD (VALUE : WORD ;  WORDOFFSET : WDIXINSEG) ;
 
  BEGIN
    ICL9CEZLPUT
        (LCTGLACOPY, BYTESINWORD,
         WORDOFFSET * BYTESINWORD, ADDRESSOF (VALUE)) ;
  END (* SETGLAWORD *) ;
 
 
 
 
      (* -SPECIAL IMPLEMENTATION OF DIAGNOSTIC MAP AREA:- *)
 
PROCEDURE INITMAPAREAHANDLING ;
 
  BEGIN
    DMARRCOUNT := 0 ;
  END (* INITMAPAREAHANDLING *) ;
 
 
PROCEDURE COPYINTOMAPAREA (COPYSIZEB : BSIZEINSEG ;
                           FROMAD : ADDRESS ;
                           OFFSETINMAPAREAB : BIXINSEG) ;
 
  VAR
    IX : BIXINSEG ;
    STOPIX : BSIZEINSEG ;
 
  BEGIN
    STOPIX := OFFSETINMAPAREAB + COPYSIZEB ;
    IF  STOPIX > DMABUFBSIZE
      THEN
        ICL9LPCTERROR (CTEDMABUFFULL)
      ELSE
      BEGIN
        IX := OFFSETINMAPAREAB ;
        WHILE  IX < STOPIX  DO
          BEGIN
            DMAREAHOLD [IX] := BYTEAT (FROMAD) ;
            FROMAD := FROMAD +1 ;
            IX := IX +1 ;
          END ;
      END ;
  END (* COPYINTOMAPAREA *) ;
 
 
PROCEDURE RELOCATEDMAPAREAREF (OFFSETINMAPAREAB : BIXINSEG ;
                               PLTDESCOFFSETWD : WDIXINSEG) ;
 
  BEGIN
    IF  DMARRCOUNT >= MAXDMARRALLOWED
      THEN
        ICL9LPCTERROR (CTEDMARRBUFFULL)
      ELSE
      BEGIN
        DMARRCOUNT := DMARRCOUNT + 1 ;
        WITH  DMARELOCREQHOLD [DMARRCOUNT]  DO
          BEGIN
            OFFSETB := OFFSETINMAPAREAB ;
            PLTOFFSETWD := PLTDESCOFFSETWD ;
          END ;
      END ;
  END (* RELOCATEDMAPAREAREF *) ;
 
 
PROCEDURE FINISHMAPAREAHANDLING (VAR ERRORCOUNT : POSINT ;
                                 VAR PATSIZES : PATVECTOR) ;
 
  VAR
    OBJAREABSIZE,
    MAPAREABSIZE : BSIZEINSEG ;
    I : BIXINDMABUF ;
 
  BEGIN
    IF  (PATSIZES [PATDIAGMAP] > 0) OR (DMARRCOUNT > 0)
      THEN
      BEGIN
        OBJAREABSIZE := PATSIZES [PATDIAGOBJECT] ;
        MAPAREABSIZE := PATSIZES [PATDIAGMAP] ;
        IF  OBJAREABSIZE + MAPAREABSIZE > SEGBSIZE
          THEN
          BEGIN
            ERRORCOUNT := ERRORCOUNT + 1 ;
            ICL9LPCTERROR (CTEDIAGAREAFULL) ;
          END
          ELSE
          BEGIN
            ICL9LPOMGCOPY (MAPAREABSIZE, ADDRESSOF (DMAREAHOLD),
                           PATDIAGOBJECT, OBJAREABSIZE) ;
          FOR  I := 1  TO  DMARRCOUNT  DO
                WITH  DMARELOCREQHOLD [I]  DO
                    ICL9LPOMGRELOC
                        (PATDIAGOBJECT,
                         OBJAREABSIZE + OFFSETB,
                         PLTOFFSETWD) ;
            PATSIZES [PATDIAGOBJECT] := OBJAREABSIZE + MAPAREABSIZE ;
          END (* ELSE *) ;
      END (* THEN *) ;
  END (* FINISHMAPAREAHANDLING *) ;
 
      (* -ROUTINES COMPRISING COMPILER'S OBJECT MODULE GENERATION INTERFACE:- *)
 
(*#E+
%KEYEDENTRY ON
*)
 
PROCEDURE ICL9LPOMGCOPY ;
 
  (* PARAMETER LIST IS :-
                        (COPYSIZEB : BSIZEINSEG ;
                         FROMAD : ADDRESS ;
                         INTOAREA : PASCALAREATYPE ;
                         OFFSETINAREAB : BIXINSEG) ;
  *)
 
  BEGIN
    IF  INTOAREA = PATDIAGMAP
      THEN
        COPYINTOMAPAREA (COPYSIZEB, FROMAD, OFFSETINAREAB)
      ELSE
        ICL9CEZLPUT
            (LPUTAREA (INTOAREA), COPYSIZEB,
             OFFSETINAREAB, FROMAD) ;
  END (* ICL9LPOMGCOPY *) ;
 
 
PROCEDURE ICL9LPOMGMNENTRY (MAINENTRYNAME : ALFA ;
                            PLTDESCOFFSETWD : WDIXINSEG) ;
 
  (*  N.B. : IT IS EXPECTED THAT, IN ACCORDANCE WITH EDINBURGH    *)
  (*         "LPUT" CONVENTIONS, THE VALUE OF THE PARAMETER       *)
  (*         "PLTDESCOFFSETWD" WILL ALWAYS BE 0 .                 *)
 
  CONST
    TOPBITINWORD = ?I 80000000 ;
 
  VAR
    IMPMAINENTRYNAME : IMPSTRING ;
 
  BEGIN
    ALFATOIMP (MAINENTRYNAME, IMPMAINENTRYNAME) ;
    ICL9CEZLPUT
        (LCTENTRYPROC,
         ORX (TOPBITINWORD, LATGLA),
         PLTDESCOFFSETWD * BYTESINWORD,
         ADDRESSOF (IMPMAINENTRYNAME)) ;
  END (* ICL9LPOMGMNENTRY *) ;
 
 
PROCEDURE ICL9LPOMGENTRY (ENTRYNAME : ALFA ;
                          PLTDESCOFFSETWD : WDIXINSEG) ;
 
  VAR
    IMPENTRYNAME : IMPSTRING ;
 
  BEGIN
    ALFATOIMP (ENTRYNAME, IMPENTRYNAME) ;
    ICL9CEZLPUT
        (LCTENTRYPROC,
         LATGLA,
         PLTDESCOFFSETWD * BYTESINWORD,
         ADDRESSOF (IMPENTRYNAME)) ;
  END (* ICL9LPOMGENTRY *) ;
 
 
PROCEDURE ICL9LPOMGEXTREF (EXTREFNAME : ALFA ;
                           PLTDESCOFFSETWD : WDIXINSEG) ;
 
  VAR
    IMPEXTREFNAME : IMPSTRING ;
 
  BEGIN
    ALFATOIMP (EXTREFNAME, IMPEXTREFNAME) ;
    ICL9CEZLPUT
        (LCTEXTERNALPROC,
         LATGLA,
         PLTDESCOFFSETWD * BYTESINWORD,
         ADDRESSOF (IMPEXTREFNAME)) ;
  END (* ICL9LPOMGEXTREF *) ;
 
 
PROCEDURE ICL9LPOMGRELOC ;
 
  (* PARAMETER LIST IS :-
                         (BASEAREA : PASCALAREATYPE ;
                          OFFSETINAREAB : BIXINSEG ;
                          PLTDESCOFFSETWD : WDIXINSEG) ;
  *)
 
  BEGIN
    IF  BASEAREA = PATDIAGMAP
      THEN
        RELOCATEDMAPAREAREF (OFFSETINAREAB, PLTDESCOFFSETWD)
      ELSE
      BEGIN
        SETGLAWORD (OFFSETINAREAB, PLTDESCOFFSETWD + 1) ;
        ICL9CEZLPUT
            (LCTRELOCATEWORD,
             LATGLA,
             (PLTDESCOFFSETWD + 1) * BYTESINWORD,
             LPUTAREA (BASEAREA)) ;
      END ;
  END (* ICL9LPOMGRELOC *) ;
 
 
PROCEDURE ICL9LPOMGAREANAM (AREANAME : ALFA ;
                            AREASIZEB : BSIZEINSEG ;
                            PLTDESCOFFSETWD : WDIXINSEG) ;
 
  VAR
    IMPAREANAME : IMPSTRING ;
 
  BEGIN
    SETGLAWORD (0, PLTDESCOFFSETWD+1) ;
    ALFATOIMP (AREANAME, IMPAREANAME) ;
    ICL9CEZLPUT
        (LCTNAMEDCOMMON,
         ORX (USHX (3 * BITSINBYTE, LATGLA),
              AREASIZEB),
         (PLTDESCOFFSETWD +1) * BYTESINWORD,
         ADDRESSOF (IMPAREANAME)) ;
  END (* ICL9LPOMGAREANAM *) ;
 
 
PROCEDURE ICL9LPOMGINIT (COMPILERRELEASE,
                         COMPILERVERSION : BYTE) ;
 
  VAR
    GOS : STDGLAWDOFFSET ;
 
  BEGIN
    INITMAPAREAHANDLING ;
    ICL9CEZLPUT
        (LCTINITOBJGEN,
         PASCALFLAGFORGLA,
         COMPILERRELEASE,
         COMPILERVERSION) ;
    SETGLAWORD (USHX (2 * BITSINBYTE,
                      ORX (USHX (BITSINBYTE, PASCALFLAGFORGLA),
                           COMPILERVERSION)),
                STDGOSFLAGS) ;
    FOR  GOS := STDGOSFLAGS + 1  TO  MAXSTDGLAWDOFFSET  DO
        SETGLAWORD (0, GOS) ;
  END (* ICL9LPOMGINIT *) ;
 
 
PROCEDURE ICL9LPOMGFINISH (PATSIZES : PATVECTOR ;
                           GLOBALBSIZE : BSIZEINSEG) ;
 
  VAR
    LPUTSIZES : LATSIZEREC ;
    THISSIZEB : POSINT ;
    LA : LPUTAREATYPE ;
    PA : PASCALAREATYPE ;
 
  BEGIN
    FINISHMAPAREAHANDLING (COMPILATIONERRORCOUNT, PATSIZES) ;
      (*  FINISH SETTING OF STANDARD "GLA" HEADER REGION :-  *)
    SETGLAWORD (0, STDGOSUSTBASEAD) ;
    SETGLAWORD (0, STDGOSSSTBASEAD) ;
    ICL9CEZLPUT
        (LCTRELOCATEWORD,
         LATGLA,
         STDGOSUSTBASEAD * BYTESINWORD,
         LATUST) ;
    ICL9CEZLPUT
        (LCTRELOCATEWORD,
         LATGLA,
         STDGOSSSTBASEAD * BYTESINWORD,
         LATSST) ;
      (*  END OBJECT MODULE GENERATION :-  *)
    WITH  LPUTSIZES  DO
      BEGIN
        FOR  LA := LATFIRST  TO  LATLAST  DO  LATSIZESB [LA] := 0 ;
        TOTALSIZEB := 0 ;
        FOR  PA := PATCODE  TO  PRED (PATDIAGMAP)  DO
          BEGIN
            THISSIZEB := PATSIZES [PA]  ;
            LATSIZESB [LPUTAREA (PA)] := THISSIZEB ;
            TOTALSIZEB := TOTALSIZEB + THISSIZEB ;
          END ;
      END (* WITH LPUTSIZES DO .... *) ;
    ICL9CEZLPUT
        (LCTENDOBJGEN,
           (* BYTESIZE OF "LPUTSIZES" RECORD :- *)
         (LATLAST - (LATFIRST -1) + 1) * BYTESINWORD,
         0,
         ADDRESSOF (LPUTSIZES)) ;
  END (* ICL9LPOMGFINISH *) ;
 
 
(******** SUPPORT COMPILER I/O, OPTIONS SETTINGS, ERROR NOTIFICATION ********)
 
 
(*#E+
%KEYEDENTRY ON
*)
 
PROCEDURE ICL9LPCTGIVEENVOPTIONS (VAR BOOLOPTSON: SETOFCOMPILEROPTIONS;
                                  VAR CC: CHARCODE);
   BEGIN
   BOOLOPTSON:=JCLBOOLOPTSFORCOMPILER;
   CC:=JCLCHARCODEOPTION;
   END (* ICL9LPCTGIVEENVOPTIONS *) ;
 
PROCEDURE ICL9LPCTUPDATELISTHEADING (KIND: LISTPAGEHEADINGKIND;
                                     VARIABLEPART: ALFA);
   CONST
      SOURCESKEL='** LINE  MODES LEVEL                    ';
      OBJECTSKEL='**  OBJECT CODE LISTING FOR             ';
      PROGWORD='PROGRAM   ';
      PROCWORD='PROCEDURE ';
      FUNCWORD='FUNCTION  ';
      SOURCESKELSIGLEN=40;
      OBJECTSKELSIGLEN=28;
      SKELLEN=SOURCESKELSIGLEN;
      PROGSIGLEN=8;
      PROCSIGLEN=10;
      FUNCSIGLEN=9;
      ROUTINELEN=PROCSIGLEN;
      MULTINEWLINEFE=?I 21;   (*-EBCDIC*)
   TYPE
      ROUTINERNG= 1.. ROUTINELEN;
      ROUTINESTR= PACKED ARRAY [ROUTINERNG] OF CHAR;
      SKELRNG= 1..SKELLEN;
      SKELSTR= PACKED ARRAY [SKELRNG] OF CHAR;
   VAR
      IX, VARPARTBASEIX: LISTHEADRANGE;
      ROUTINEMAXIX: ROUTINERNG;
      TEMPSKEL: SKELSTR;
      TEMPROUTINE: ROUTINESTR;
      LISTHEADDESC: STRINGDESC;
      CURRENTLISTHEAD: LISTHEADING;
      CERESPONSE: RESPONSE;
   BEGIN
   IF KIND=SOURCELISTHEADING THEN
      TEMPSKEL:=SOURCESKEL
   ELSE
      TEMPSKEL:=OBJECTSKEL;
   FOR IX:=1 TO SKELLEN DO
      CURRENTLISTHEAD[IX] := ORD(TEMPSKEL[IX]);
   CURRENTLISTHEAD[1]:=MULTINEWLINEFE;
   CURRENTLISTHEAD[2]:=1;
   IF KIND=SOURCELISTHEADING THEN
      VARPARTBASEIX := SOURCESKELSIGLEN
   ELSE
      BEGIN
      CASE KIND OF
      PROGOBJECTLISTHEADING:
         BEGIN TEMPROUTINE:=PROGWORD; ROUTINEMAXIX:=PROGSIGLEN END;
      PROCOBJECTLISTHEADING:
         BEGIN TEMPROUTINE:=PROCWORD; ROUTINEMAXIX:=PROCSIGLEN END;
      FUNCOBJECTLISTHEADING:
         BEGIN TEMPROUTINE:=FUNCWORD; ROUTINEMAXIX:=FUNCSIGLEN END;
         END (*CASE*);
      FOR IX:=1 TO ROUTINEMAXIX DO
         CURRENTLISTHEAD[OBJECTSKELSIGLEN+IX] := ORD(TEMPROUTINE[IX]);
      VARPARTBASEIX := OBJECTSKELSIGLEN+ROUTINEMAXIX;
      END;
   FOR IX:=1 TO ALFALENGTH DO
      CURRENTLISTHEAD[VARPARTBASEIX+IX] := ORD(VARIABLEPART[IX]);
   CURRENTLISTHEAD[VARPARTBASEIX+ALFALENGTH+1] := MULTINEWLINEFE;
   CURRENTLISTHEAD[VARPARTBASEIX+ALFALENGTH+2] := 1;
   LISTHEADDESC:=DESCFORSTRING(VARPARTBASEIX+ALFALENGTH+2,
                               ADDRESSOF(CURRENTLISTHEAD));
   CERESPONSE:=ICL9HNSUBHEAD(LISTHEADDESC,2,0,0,FALSE);
   END (* ICL9LPCTUPDATELISTHEADING *) ;
 
PROCEDURE ICL9LPCTSUMMARYHEADING (MINLINESTOFOLLOW: POSINT;
                                  FORCEPAGETHROW: BOOLEAN);
   CONST
      SUMMARY='****COMPILATION SUMMARY**';
      SUMMARYLEN=25;
      MULTISPACEFE=?I 20;
      MULTINEWLINEFE=?I 21;
      PREBLANKLINES=3;
      PRESPACES=19;
   TYPE
      SUMMARYRNG= 1..SUMMARYLEN;
      SUMMARYSTR= PACKED ARRAY [SUMMARYRNG] OF CHAR;
      SUMMARYBUF= PACKED ARRAY [SUMMARYRNG] OF BYTE;
   VAR
      I: SUMMARYRNG;
      HOLDSTR: SUMMARYSTR;
      HEADING: SUMMARYBUF;
      HEADDESC: STRINGDESC;
      ZEROORLINESFORSAMEPAGE: POSINT;
      CERESPONSE: RESPONSE;
   BEGIN
   HOLDSTR:=SUMMARY;
   FOR I:=1 TO SUMMARYLEN DO HEADING[I]:=ORD(HOLDSTR[I]);
   HEADING[1]:=MULTINEWLINEFE;
   HEADING[2]:=1;
   HEADING[3]:=MULTISPACEFE;
   HEADING[4]:=PRESPACES;
   HEADING[SUMMARYLEN-1]:=MULTINEWLINEFE;
   HEADING[SUMMARYLEN]:=1;
   HEADDESC:=DESCFORSTRING(SUMMARYLEN,ADDRESSOF(HEADING));
   IF FORCEPAGETHROW THEN
      ZEROORLINESFORSAMEPAGE:=0
   ELSE
      ZEROORLINESFORSAMEPAGE:=MINLINESTOFOLLOW;
   CERESPONSE:=ICL9HNSUBHEAD(HEADDESC, 2, ZEROORLINESFORSAMEPAGE,
                             PREBLANKLINES, FALSE);
   END (* ICL9LPCTSUMMARYHEADING *) ;
 
PROCEDURE ICL9LPCTGETLISTFILEPTR (VAR LISTFP: TEXTPT);
   BEGIN
   LISTFP:=LISTFILEP
   END (* ICL9LPCTGETLISTFILEPTR *) ;
 
PROCEDURE ICL9LPCTPLILIST (CODESIZEB: BSIZEINSEG; FROMAD: ADDRESS;
                          QUOTEBOFFSETINMARGIN: BIXINSEG);
   BEGIN
   ICL9CEZNCODE(FROMAD,FROMAD+CODESIZEB,QUOTEBOFFSETINMARGIN);
   END (* ICL9LPCTPLILIST *);
 
PROCEDURE ICL9LPCTNEXTSOURCELINE (VAR LINE: SOURCELINEBUF;
                                  VAR LENGTH: LINEPOSITION;
                                  VAR STATUS: SOURCELINESTATUS);
   CONST
      CERESPOK=0;
      CERESPENDCOPYFILE=-1;
      CERESPENDFILEBUTNOTLAST=-2;
      CERESPLINETRUNCATED=-255;
      CERESPIGNORELINE=-511;
      CERESPIGNOREBUTLIST=-512;
      CERESPFINALENDFILE=-3;
      CERESPTTANSFERFAIL=256;
   VAR
      LINEDESC: STRINGDESC;
      CELENGTHDESC: INTDESC;
      CERESPONSE: RESPONSE;
      CELENGTH: POSINT;
 
   PROCEDURE IPFAILABANDON;
      BEGIN
      WRITELN(JOURNALFILEP@,'SOURCE I/P TRANSFER FAILURE');
      ICL9LPCTABORT(FALSE);
      END (*IPFAILABANDON*);
 
   BEGIN
   LINEDESC:=DESCFORSTRING(MAXMARGIN,ADDRESSOF(LINE));
             (*-N.B.: LAST BUFFER POSITION IS NEVER USED*)
   CELENGTHDESC:=DESCFORINT(CELENGTH);
   CELENGTH:=0;
   REPEAT
      CERESPONSE:=ICL9HNREADCARD(LINEDESC,NILDESC,CELENGTHDESC);
      UNTIL (CERESPONSE<>CERESPENDCOPYFILE) AND
            (CERESPONSE<>CERESPENDFILEBUTNOTLAST);
   IF CELENGTH>MAXMARGIN THEN
      LENGTH:=MAXMARGIN
   ELSE
      LENGTH:=CELENGTH;
   IF CERESPONSE=CERESPOK THEN
      STATUS:=SOURCEIPOK
   ELSE IF CERESPONSE=CERESPLINETRUNCATED THEN
      STATUS:=SOURCEIPTRUNCATED
   ELSE IF CERESPONSE=CERESPIGNORELINE THEN
      STATUS:=SOURCEIPIGNORE
   ELSE IF CERESPONSE=CERESPIGNOREBUTLIST THEN
      STATUS:=SOURCEIPLISTONLY
   ELSE IF CERESPONSE=CERESPFINALENDFILE THEN
      STATUS:=SOURCEIPFILEEND
   ELSE (* CERESPTRANSFERFAIL *)
      IPFAILABANDON;
   END (* ICL9LPCTNEXTSOURCELINE *) ;
 
PROCEDURE ICL9LPNOTECOMPILEERRORS (ERRORCOUNT: POSINT);
   BEGIN
   COMPILATIONERRORCOUNT:=ERRORCOUNT;
   END (* ICL9LPNOTECOMPILATIONERRORS *);
 
 
(******** SUPPORT FOR COMPILATION CONTROL ********)
 
 
(*#E-
%KEYEDENTRY OFF
*)
 
PROCEDURE SETJCLCDIAGVALUE (CEOPTIONSARRAYAD: ADDRESS; VAR JCLCDIAG: BYTE);
   CONST
      CDIAGDIAGCEOFFSETB=19;
   BEGIN
   JCLCDIAG := BYTEAT(CEOPTIONSARRAYAD + CDIAGDIAGCEOFFSETB);
   END (* SETJCLCDIAGVALUE *);
    
PROCEDURE SETJCLOPTIONSVALUES (CEOPTIONSARRAYAD: ADDRESS;
                               VAR COMPILERJCLBOOLOPTS: SETOFCOMPILEROPTIONS;
                               VAR JCLCHARCODE: CHARCODE;
                               VAR OMFGENJCLOPTIONS: SETOFOMFGENOPTIONS;
                               VAR CEPROCPLEXAD: ADDRESS;
                               VAR CEOMFFILENAME: ALFA);
   CONST
      CODECEOFFSETB=0;
      SOURCELISTCEOFFSETB=1;
      PROCEDURECEOFFSETB=2;
      OBJECTLISTCEOFFSETB=9;
      DIAGNOSTICSCEOFFSETB=10;
      LIBPROCCEOFFSETB=13;
      CDIAGOMFCEOFFSETB=18;
      OMFFILECEOFFSETB=22;
      CDIAGMONITORCEOFFSETB=49;
      SOURCELISTERRORSONLYVAL=3;
      OMFBITNOCASCADE=8;
      OMFBITMAXKEYS=4;
      OMFBITFIXUPTRACE=2;
      OMFBITMAPMODULE=1;
   VAR
      B: BYTE;
      COMPOPTIONSON: SETOFCOMPILEROPTIONS;
      OMFOPTIONSON: SETOFOMFGENOPTIONS;
 
   FUNCTION PLEXAD (CEOFFSETB: BYTE) : ADDRESS;
      VAR
         PLEXBYTE: BYTE;
      BEGIN
      PLEXBYTE:=BYTEAT(CEOPTIONSARRAYAD+CEOFFSETB);
      IF PLEXBYTE=0 THEN
         PLEXAD:=NILAD
      ELSE
         PLEXAD:=CEOPTIONSARRAYAD+PLEXBYTE;
      END (*PLEXAD*);
 
   BEGIN (* SETJCLOPTIONSVALUES *)
 
      (*OPTIONS FOR COMPILER:-*)
   ICL9LPCTGETPASCALJCLOPTS(COMPOPTIONSON,JCLCHARCODE);
   B:=BYTEAT(CEOPTIONSARRAYAD + SOURCELISTCEOFFSETB);
   IF B<>0 THEN
      IF B<>SOURCELISTERRORSONLYVAL THEN
         COMPOPTIONSON := COMPOPTIONSON + [SOURCELISTOPT];
   IF BYTEAT(CEOPTIONSARRAYAD+OBJECTLISTCEOFFSETB)<>0 THEN
      COMPOPTIONSON := COMPOPTIONSON + [OBJECTLISTOPT];
   IF BYTEAT(CEOPTIONSARRAYAD+DIAGNOSTICSCEOFFSETB)<>0 THEN
      COMPOPTIONSON := COMPOPTIONSON + [LINEMAPOPT,PMDUMPOPT];
   IF BYTEAT(CEOPTIONSARRAYAD+CODECEOFFSETB)=0 THEN
      COMPOPTIONSON := COMPOPTIONSON + [NOCODEGENOPT];
   COMPILERJCLBOOLOPTS:=COMPOPTIONSON;
 
      (*OPTIONS FOR (EDINBURGH) OMF FILE GENERATION:-*)
   OMFOPTIONSON:=[OMFSHARE,OMFMAXKEYS];
   IF BYTEAT(CEOPTIONSARRAYAD + LIBPROCCEOFFSETB)<>0 THEN
      OMFOPTIONSON := OMFOPTIONSON + [OMFLIBPROC];
   B := BYTEAT(CEOPTIONSARRAYAD + CDIAGOMFCEOFFSETB);
   IF ANDX(B, OMFBITNOCASCADE)<>0 THEN
      OMFOPTIONSON := OMFOPTIONSON + [OMFNOCASCADE];
   IF ANDX(B, OMFBITMAXKEYS)<>0 THEN
      OMFOPTIONSON := OMFOPTIONSON - [OMFMAXKEYS];
   IF ANDX(B, OMFBITFIXUPTRACE)<>0 THEN
      OMFOPTIONSON := OMFOPTIONSON + [OMFFIXUPTRACE];
   IF ANDX(B, OMFBITMAPMODULE)<>0 THEN
      OMFOPTIONSON := OMFOPTIONSON + [OMFMAPMODULE];
   OMFGENJCLOPTIONS := OMFOPTIONSON;
 
      (*ADDRESSES OF USEFUL "PLEXES":-*)
   CEPROCPLEXAD := PLEXAD(PROCEDURECEOFFSETB);
   PLEXTOALFA(PLEXAD(OMFFILECEOFFSETB), CEOMFFILENAME);
   END (* SETJCLOPTIONSVALUES *) ;
 
PROCEDURE LISTPASCALJCLOPTIONS (COMPILERJCLBOOLOPTS: SETOFCOMPILEROPTIONS;
                                JCLCHARCODE: CHARCODE;
                                OMFGENJCLOPTIONS: SETOFOMFGENOPTIONS);
   CONST
      KWENDPOSITION=33;
      FLOWVALLEN=16;
   TYPE
      FLOWVALRNG= 1..FLOWVALLEN;
      FLOWVALSTRING= PACKED ARRAY [FLOWVALRNG] OF CHAR;
 
   PROCEDURE LISTFLOWVAL (PREFIXAND, OPTIONISON: BOOLEAN; VAL: FLOWVALSTRING);
      VAR
         I: FLOWVALRNG;
      BEGIN
      IF PREFIXAND THEN
         WRITE(LISTFILEP@,' & ');
      IF NOT OPTIONISON THEN
         WRITE(LISTFILEP@,'NO');
      I:=1;
      REPEAT
         WRITE(LISTFILEP@,VAL[I]);
         I:=I+1;
         UNTIL VAL[I]=' ';
      END (*LISTFLOWVAL*);
 
   BEGIN (* LISTPASCALOPTIONS *)
 
         (*RANGECHECKS:-*)
   WRITE(LISTFILEP@,'RANGECHECKS     ':KWENDPOSITION);
   IF CHECKSOPT IN COMPILERJCLBOOLOPTS THEN
      WRITELN(LISTFILEP@,'YES')
   ELSE
      WRITELN(LISTFILEP@,'NO');
 
         (*CHARCODE:-*)
   WRITE(LISTFILEP@,'CHARCODE        ':KWENDPOSITION);
   CASE JCLCHARCODE OF
      CCEBCDIC: WRITELN(LISTFILEP@,'EBCDIC');
      CCISO: WRITELN(LISTFILEP@,'ISO');
      CCICL1900: WRITELN(LISTFILEP@,'ICL1900');
      END (*CASE*);
 
         (*FLOWANALYSES:-*)
   WRITE(LISTFILEP@,'FLOWANALYSES    ':KWENDPOSITION);
   LISTFLOWVAL(FALSE, PROFILEOPT IN COMPILERJCLBOOLOPTS, 'PROFILE         ');
   LISTFLOWVAL(TRUE, RETROOPT IN COMPILERJCLBOOLOPTS, 'RETROTRACE      ');
   LISTFLOWVAL(TRUE, TRACEOPT IN COMPILERJCLBOOLOPTS, 'FORWARDTRACE    ');
   WRITELN(LISTFILEP@);
   END (* LISTPASCALOPTIONS *) ;
 
PROCEDURE INITFOREDINSUPPORT (VAR WRKAREAAD, TMPOBJAREAAD: ADDRESS);
   CONST
      WORKANAME='ICL9CEWRK';
      WORKANAMELEN=9;
      WORKASIZEB=?I 80000;
      TEMPANAME='ICL9CETMPOBJ';
      TEMPANAMELEN=12;
      TEMPASIZEB=?I 80000;
 
   PROCEDURE STARTEDINAREA(NAMELEN: POSINT; NAMEAD: ADDRESS;
                           SIZEB: POSINT; VAR AREAAD: ADDRESS);
      BEGIN
      ICL9LPCTGETVSAREA(DESCFORSTRING(NAMELEN,NAMEAD),SIZEB,VSLOCALISED,AREAAD);
      STOREWORDAT(4*BYTESINWORD,AREAAD);
      STOREWORDAT(4*BYTESINWORD,AREAAD+BYTESINWORD);
      STOREWORDAT(SIZEB,AREAAD+(2*BYTESINWORD));
      STOREWORDAT(0,AREAAD+(3*BYTESINWORD));
      END (*STARTEDINAREA*);
 
   BEGIN (* INITFOREDINSUPPORT *)
   STARTEDINAREA(WORKANAMELEN, ADDRESSOF(WORKANAME), WORKASIZEB, WRKAREAAD);
   STARTEDINAREA(TEMPANAMELEN, ADDRESSOF(TEMPANAME), TEMPASIZEB, TMPOBJAREAAD);
   ICL9CEZINITLPUT(WRKAREAAD, TMPOBJAREAAD);
      (*PLAY SAFE:-*)
   COMPILATIONERRORCOUNT:=MAXINT;
   END (* INITFOREDINSUPPORT *) ;
 
PROCEDURE GETCOMPILATIONERRORSTATUS (VAR ERRORFREE: BOOLEAN);
   BEGIN
   ERRORFREE:=(COMPILATIONERRORCOUNT = 0);
   END (* GETCOMPILATIONERRORSTATUS *);
 
PROCEDURE GETFULLCOMPILATIONDETAILS (VAR ERRORFREE: BOOLEAN;
                                     VAR MAINENTRYNAME: ALFA);
   VAR
      IMPMAINENTRY: IMPSTRING;
      LPUTFLAG: INTEGER;
   BEGIN
   ICL9CEZGIVELPUTITEMS(LPUTFLAG,IMPMAINENTRY);
   IF LPUTFLAG<> 0 THEN
      WRITELN(JOURNALFILEP@, 'PROGRAM TOO LARGE FOR OBJECT CODE WORKSPACE');
   ERRORFREE := (LPUTFLAG=0) AND (COMPILATIONERRORCOUNT=0);
   IMPTOALFA(IMPMAINENTRY,MAINENTRYNAME);
   END (* GETCOMPILATIONOUTCOME *) ;
 
 
PROCEDURE GENERATEOMFMODULE(OPTIONSFOROMFGEN: SETOFOMFGENOPTIONS;
                            EDINOPSYSFLAG: WORD;
                            EDINTMPOBJAREAAD, EDINWRKAREAAD: ADDRESS;
                            CEOMFFILENAME, MAINENTRYNAME: ALFA;
                            CEPROCPLEXAD: ADDRESS;
                            VAR OMFGENOK: BOOLEAN;
                            VAR FULLOMFFILENAME: LONGSTRING);
   CONST
      BIT26=?I 00000020;
      PASSUBNAME='PASC                            ';
      PASVERSION='20                              ';
      PASLANGCODE='P';
      OMFRESRECORDFAIL=1000000;
      OMFRESPALIASFAIL=1000001;
   VAR
      I, J: OMFGENOPTIONS;
      EDINCONTROLBITS: WORD;
      CONTROLBITTAB: ARRAY [OMFGENOPTIONS] OF WORD;
      OMFFILENAME: ALFA;
      SUBNAMEEBCDICISTR, VERSIONEBCDICISTR, MODULENAMEISTR, EMPTYISTR: IMPSTRING;
      CERESPINIT, CERESPEND, EDINRESP, MAINKEYRESP: RESPONSE;
      OMFGENCOMPLETE: BOOLEAN;
 
   PROCEDURE ADDOMFKEY(KEYNAME: ALFA; VAR KEYRESPONSE: RESPONSE);
      BEGIN
      KEYRESPONSE:=ICL9HNCREATEALIAS(SIGALFADESC(KEYNAME),NILDESC);
      END (*ADDOMFKEY*);
 
   BEGIN
   OMFGENCOMPLETE:=FALSE;
   IF CEOMFFILENAME<>BLANKALFA THEN
       OMFFILENAME:=CEOMFFILENAME
   ELSE
      OMFFILENAME:=MAINENTRYNAME;
   IF NULLPLEX(CEPROCPLEXAD) THEN
      ALFATOPLEX(MAINENTRYNAME,CEPROCPLEXAD);
   CONTROLBITTAB[OMFSHARE] := BIT26;
   FOR I:=OMFLIBPROC TO OMFMAPMODULE DO
      BEGIN J:=PRED(I); CONTROLBITTAB[I]:=CONTROLBITTAB[J] DIV 2 END;
   EDINCONTROLBITS:=0;
   FOR I:=OMFSHARE TO OMFMAPMODULE DO
      IF I IN OPTIONSFOROMFGEN THEN
         EDINCONTROLBITS:=ORX(EDINCONTROLBITS, CONTROLBITTAB[I]);
   ALFATOEBCDICIMP(PASSUBNAME,SUBNAMEEBCDICISTR);
   ALFATOEBCDICIMP(PASVERSION,VERSIONEBCDICISTR);
   ALFATOIMP(MAINENTRYNAME,MODULENAMEISTR);
   EMPTYISTR[0]:=0;
   CERESPINIT:=ICL9HNCREATEMODULE(SIGALFADESC(OMFFILENAME),
                                  DESCFORSTRING(LONGSTRINGLENGTH,
                                                ADDRESSOF(FULLOMFFILENAME)),
                                  -1);
   EDINRESP:=0;
   MAINKEYRESP:=0;
   IF CERESPINIT<>0 THEN
      WRITELN(JOURNALFILEP@,'OMF MODULE CREATION FAILURE')
   ELSE
      BEGIN
      EDINRESP:=ICL9CEZOMFOUT(EDINOPSYSFLAG, EDINTMPOBJAREAAD, EDINWRKAREAAD,
                              EDINCONTROLBITS, PASLANGCODE,
                              ICL9LPCTDATEAD, ICL9LPCTTIMEAD,
                              SUBNAMEEBCDICISTR, VERSIONEBCDICISTR,
                              MODULENAMEISTR,
                              EMPTYISTR, EMPTYISTR);
      IF (EDINRESP=0) AND (OMFFILENAME<>MAINENTRYNAME) THEN
         ADDOMFKEY(MAINENTRYNAME,MAINKEYRESP);
      END;
   IF EDINRESP<>0 THEN
      IF EDINRESP=OMFRESRECORDFAIL THEN
         WRITELN(JOURNALFILEP@,'OMF RECORD OUTPUT FAILURE')
      ELSE IF EDINRESP=OMFRESPALIASFAIL THEN
         WRITELN(JOURNALFILEP@,'OMF ALIAS CREATION FAILURE')
      ELSE   (*-SHOULD NEVER GET HERE*)
         WRITELN(JOURNALFILEP@,'OMF GENERATION FAILURE');
   IF MAINKEYRESP>0 THEN
      WRITELN(JOURNALFILEP@,'OMF ALIAS CREATION FAILURE');
   CERESPEND:=ICL9HNENDMODULE(FALSE);
   IF CERESPEND>0 THEN
      WRITELN(JOURNALFILEP@,'OMF MODULE TERMINATION FAILURE');
   IF (CERESPINIT=0) AND (EDINRESP=0) AND (CERESPEND<=0) THEN
      OMFGENCOMPLETE:=TRUE;
   OMFGENOK:=OMFGENCOMPLETE;
   END (* GENERATEOMFMODULE *) ;
 
PROCEDURE FINALMESSAGES(COMPILEOK, SYNTAXCHECKONLY, OMFGENOK: BOOLEAN;
                        FULLOMFID: LONGSTRING);
   BEGIN
   IF OMFGENOK THEN
      BEGIN
      WRITELN(JOURNALFILEP@,'OMF MODULE IS IN');
      WRITELN(JOURNALFILEP@,FULLOMFID);
      WRITELN(LISTFILEP@,'OMF LOCATION = ':25,FULLOMFID);
      END;
   WRITELN(JOURNALFILEP@,'TOTAL OCP (MILLISECS.) : ',
                         (CLOCK+500):1);
   END (* FINALMESSAGES *) ;
 
 
(******** MAIN COMPILATION CONTROL ROUTINE ********)
 
 
(*#E+
%KEYEDENTRY ON
*)
 
FUNCTION ICL9LPCTCONTROL(CEOPTIONSARRAYDTB: WORD;
                         CEOPTIONSARRAYAD: ADDRESS) : RESPONSE;
 
   VAR
      COMPILATIONOK,
      SYNTAXCHECKONLY, OMFGENOK: BOOLEAN;
      OMFGENCONTROLOPTIONS: SETOFOMFGENOPTIONS;
      CEPROCPLEXAD: ADDRESS;
      CEOMFFILENAME, MAINENTRYNAME: ALFA;
      EDINWRKAREAAD, EDINTMPOBJAREAAD: ADDRESS;
      EDINOPSYSFLAG: WORD;
      FULLOMFFILENAME: LONGSTRING;
   BEGIN
   CONTROLSTACKBASEAD:=ICL9LPCURSTACKBASEAD;
   EDINOPSYSFLAG:=EDINVMEBFLAG;
   SETJCLCDIAGVALUE(CEOPTIONSARRAYAD,JCLCDIAGVALUE);
   ICL9LPINITCTSUPPORT(LISTFILEP,DIAGFILEP,JOURNALFILEP,
                       ETOITABP,ITOETABP,JCLCDIAGVALUE);
   SETJCLOPTIONSVALUES(CEOPTIONSARRAYAD, JCLBOOLOPTSFORCOMPILER,
                       JCLCHARCODEOPTION, OMFGENCONTROLOPTIONS, CEPROCPLEXAD,
                       CEOMFFILENAME);
   SYNTAXCHECKONLY:=NOCODEGENOPT IN JCLBOOLOPTSFORCOMPILER;
   LISTPASCALJCLOPTIONS(JCLBOOLOPTSFORCOMPILER,JCLCHARCODEOPTION,
                        OMFGENCONTROLOPTIONS);
   OMFGENOK:=FALSE;
   IF SYNTAXCHECKONLY THEN
      BEGIN
      ICL9LPCOMPILE;
      GETCOMPILATIONERRORSTATUS(COMPILATIONOK);
      END
   ELSE
      BEGIN
      INITFOREDINSUPPORT(EDINWRKAREAAD,EDINTMPOBJAREAAD);
      ICL9LPCOMPILE;
      GETFULLCOMPILATIONDETAILS(COMPILATIONOK,MAINENTRYNAME);
      IF COMPILATIONOK THEN
         GENERATEOMFMODULE(OMFGENCONTROLOPTIONS,
                           EDINOPSYSFLAG,
                           EDINTMPOBJAREAAD,EDINWRKAREAAD,
                           CEOMFFILENAME,MAINENTRYNAME,CEPROCPLEXAD,
                           OMFGENOK,FULLOMFFILENAME);
      END;
   FINALMESSAGES(COMPILATIONOK,SYNTAXCHECKONLY,OMFGENOK,FULLOMFFILENAME);
   IF COMPILATIONOK AND (SYNTAXCHECKONLY OR OMFGENOK) THEN
      ICL9LPCTCONTROL:=CECOMPOKRESPONSE
   ELSE
      ICL9LPCTCONTROL:=CECOMPERRRESPONSE;
   END (* ICL9LPCTCONTROL *) ;
 
 
(******** DUMMY MAIN PROGRAM ********)
 
 
BEGIN  (*  DUMMY MAIN PROGRAM BODY  *)
END  (*  DUMMY MAIN PROGRAM BODY  *)  .