*COMDECK BLOADM 
  
**        ++++++++++++++++
*         + MAP ROUTINE. +
*         ++++++++++++++++
* 
* 
*              *BLOADM* IS THE COMMON DECK WHICH CONTAINS THE MAP 
*         GENERATION AND ERROR PROCESSING CODE.  IT IS USED IN TWO
*         PLACES:                                                              .
* 
*         1) CALLED BY THE DECK *LOADER* TO FORM THE OVERLAY *LOADM*. 
*            THIS WRITES THE MAP FOR CONTROL-CARD-INITIATED LOADS.
* 
*         2) CALLED BY THE DECK *LOADU* TO FORM THE OVERLAY *LOADUM*. 
*            THIS WRITES THE MAPS FOR USER-CALL LOADS.
* 
*              NOTE THAT IN BOTH OF THE ABOVE CASES, THE ROUTINE IS 
*         CALLED IN EITHER FOR THE WRITING OF A MAP OR FOR THE REPORTING
*         OF ERRORS.  IT CONTAINS THE CODE FOR THE FETCHING OF
*         PARTICULAR ERROR MESSAGES AND ADDING INFORMATION TO THEM. 
*         IF A MAP IS NOT REQUESTED, THE MESSAGES GO TO THE DAYFILE.
* 
* 
*         MAP - CONTROL ROUTINE.
* 
*              THE CONTROL ROUTINE IN THE MAP PROCESSOR DOES THE
*         FOLLOWING 
* 
  
          RELOC  ON 
  
 MAP      PS                 ENTRY/EXIT 
  
 IC       IFCARD
 IS       IFSCOPE 
          SA1    DFMFLAG
          NZ     X1,MAP0B    IF MESSAGE ALREADY ISSUED
          SA1    SDMFLAG
          SX1    X1-1 
          ZR     X1,MAP0B    IF MESSAGE NOT TO BE ISSUED
          SA1    TPGM 
          SX1    X1+70B 
          MESSAGE X1,R,6     ISSUE MESSAGE (BUT NOT TO TERMINAL)
 MAP0B    SX6    B1 
          SA6    DFMFLAG     INDICATE COMMAND IMAGE DAYFILED
 IS       ENDIF 
 IC       ENDIF 
  
**        1)   THE MANAGE TABLE ORIGIN IS ADJUSTED SO AS TO BE AT 
*              THE END OF THE MAP BUFFER, WHICH IS, IN TURN, ORIGINED 
*              AT THE END OF THE MAP ROUTINE.  THIS WILL NEVER RESULT 
*              IN A DECREASE IN TABLE SPACE, SINCE, AS ACCORDING TO 
*              THE CHECKS AT THE END, THE MAP ROUTINE MUST NOT EXCEED 
*              A CERTAIN SIZE.  THIS STEP IS SKIPPED DURING OVERLAY/
*              CAPSULE/OVCAP GENERATION LOADS BECAUSE THERE MAY BE
*              MORE LOADING TO DO FOLLOWING MAP GENERATION. 
* 
  
          SX6    MAPABT1     SET ADDRESS OF TABLE OVERFLOW
          SA6    TO          PROCESSOR WHILE IN MAP ROUTINE 
          IFCARD 4
          SA1    OG 
          SA2    CPYF 
          BX1    X1+X2       IF COPY THEN LEAVE BUFFER LARGE ENOUGH 
          NZ     X1,MAP0     IF OVERLAY/CAPSULE/OVCAP GENERATION LOAD 
          RECALL L           WAIT FOR I/O COMPLETION                     LDR0214
          IFCARD 1
          RECALL O
          MX7    60          SET FLAG SO TABLE MANAGER WILL NOT 
          SA7    MM          TRY TO LOWER TABLE ORIGIN
          SA7    /TMGR/AMUA  TELL *AMU* THAT MAP ROUTINE IS IN
          SX6    MAPEND+IP.MBUF    SET LOW MEMORY ADDRESS TO END OF 
          SA6    LM          MAP ROUTINE + MAP BUFFER SIZE
          SA6    L+4         *LIMIT* IN *FET* = LOW MEMORY ADR
          SX7    MAPEND      *FIRST* IN *FET* = END OF MAP ROUTINE
          SA7    L+1
  
**        1A)  *CPY* IS CALLED TO SPOOL BACK ANYTHING WRITTEN TO Z32. 
  
 MAP0     BSS    0
 IC       IFCARD
          SA1    NEWL1
          NZ     X1,MAP0A    IF NOT SAFE TO SPOOL BACK
          RJ     CPY
 MAP0A    BSS    0
 IC       ENDIF 
  
**        2)   IF A MAP WAS NOT SELECTED, OR IF THE LOAD WAS ABSOLUTE,
*              OR IF THE LOAD WAS OF AN EXECUTE-ONLY FILE,
*              THE MAP ROUTINE WAS CALLED BECAUSE ONE OR MORE ERRORS
*              OCCURRED (FATAL OR NON-FATAL).  IN THIS CASE, THE ERRORS 
*              ARE PLACED IN THE DAYFILE, AND THE MAP ROUTINE IS EXITED.
* 
  
          SA1    MAPTYPE
          NZ     X1,MAP2     IF MAP REQUESTED, DONT WRITE DAYFILE 
 MAP1     RJ     LERR        LIST ERRORS IN DAYFILE 
 IC       IFCARD
          SA1    OG 
          ZR     X1,MAP      IF NOT OVERLAY/CAPSULE/OVCAP GENERATION
          MI     X1,MAP1A    IF CAPSULE GENERATION
          SA1    NEWCARD
          RJ     LOC         LIST OVERLAY CARD
          RJ     LCE         LIST CARD ERROR (IF ANY) 
          RJ     /MISC/CFA
          NZ     X6,MAP7     IF ERRORS INDICATE ABORT 
          SA1    NEWLFN 
          ZR     X1,MAP12    IF NOTHING MORE TO DO
 IC       ENDIF 
          EQ     MAP         EXIT 
  
 IC       IFCARD
 MAP1A    RJ     /MISC/CFA
          NZ     X6,MAP13    IF ERRORS INDICATE ABORT 
          SA1    NEXCPNAM 
          ZR     X1,MAP11    IF NO MORE CAPSULES TO GENERATE
          SA1    CURREQBP    CHECK IF WORKING ON *NOGO* 
          R=     X1,X1-CNOGO
          ZR     X1,MAP11    IF WORKING ON *NOGO* 
          SA1    MAPTYPE
          ZR     X1,MAP      IF MAP NOT REQUESTED (ERRORS IN DAYFILE) 
          WRITER L,RCL       FLUSH BUFFER 
          EQ     MAPX        GO TO MAP EXIT ROUTINE 
  
 IC       ENDIF 
 MAP2     BSS    0
  
 IC       IFCARD
          SA1    ABS
          NZ     X1,MAP1     IF ABSOLUTE LOAD, NO MAP 
          IFNOS  2
          SA1    XEQOF
          NZ     X1,MAP1     IF EXECUTE-ONLY FILE, NO MAP 
 IC       ENDIF 
  
          SMSG   (=30H  WRITING MAP                 ) 
          SX7    1
          SA7    MAPFLAG     SET FLAG THAT MAP IS TO BE WRITTEN 
          SA1    MAPLFN 
          SA2    =0LZZZZZMP 
          BX6    X1-X2       NON-ZERO IF NOT *ZZZZZMP*
          CX6    X6          STILL NON-ZERO IFF NON-ZERO BEFORE 
          SA6    VISIBLE     ZERO IF LFN IS *ZZZZZMP* (INVISIBLE MAP) 
  
**        3)   THE *FET* IS INITIALIZED 
* 
  
          SETFET L,MAPLFN,CODED 
  
**        4)   THE VARIOUS PARTS OF THE MAP, AS SELECTED, ARE NOW 
*              WRITTEN.  THIS IS ALWAYS DONE EXCEPT IN THE CASE WHERE 
*              THE MAP ROUTINE WAS CALLED ONLY BECAUSE THE FIRST
*              OVERLAY CARD WAS IN ERROR. 
  
          MX6    0
          SA6    PGPAR
          GETPAGE PGPAR      GET JOB PAGE PARAMETERS
          SA1    PGPAR
          MX0    -8 
          AX1    12          POSITION FOR *PW*
          SA2    PGWID
          NZ     X2,MAP2B    IF *PW* ALREADY SPECIFIED
          BX6    -X0*X1 
          SA6    A2 
 MAP2B    AX1    8           POSITION FOR *PS*
          SA2    PGSIZ
          BX6    -X0*X1 
          NZ     X2,MAP2C    IF *PS* ALREADY SPECIFIED
          SA6    A2 
 MAP2C    AX1    8           POSITION FOR *PD*
          MX0    -4 
          SA2    PRDEN
          NZ     X2,MAP2D    IF *PD* ALREADY SPECIFIED
          BX6    -X0*X1 
          SA6    A2 
 MAP2D    RJ     SPD         SET PRINT DENSITY
          RJ     HEADER      LIST HEADER
 IC       IFCARD
          SA1    OG 
          ZR     X1,MAP3     IF NOT OVERLAY/CAPSULE/OVCAP GENERATION
          PL     X1,MAP2A    IF OVERLAY/OVCAP GENERATION
          RJ     LCPGP       LIST CAPSULE/GROUP NAME
          EQ     MAP3        CONTINUE 
  
 MAP2A    BSS    0
          SA1    OGLFN
          ZR     X1,MAP5     IF ERROR ON FIRST OVERLAY CARD 
          SA1    OGCARD 
          RJ     LOC         LIST OVERLAY CARD
 IC       ENDIF 
 MAP3     RJ     LST         LIST STATISTICS
          RJ     LERR        LIST ERRORS
          RJ     ICF         INITIALIZE CHAIN FIELDS
 SEG      IFCARD
          RJ     CPO         CORRECT PROGRAM ORIGINS
          SX6    -B1
          SA6    SN 
 MAP3A    RJ     SSI         SET SEGMENT INDEX
          SA1    SI 
          SA2    TBLK+1 
          IX3    X1-X2
          PL     X3,MAP3B    IF SEGMENTS COMPLETE 
 SEG      ENDIF 
          RJ     LBA         LIST BLOCK ASSIGNMENTS 
          RJ     LEP         LIST ENTRY POINTS AND XREFS
          IFCARD 2
          SA1    SEGFLAG
          NZ     X1,MAP3A    IF A SEGMENT LOAD
 MAP3B    SX6    B0 
          SA6    TPRX+1      CLEAR *TPRX* 
 IC       IFCARD
          SA1    OG 
          MI     X1,MAP1A    IF CAPSULE GENERATION
          NZ     X1,MAP4     IF OVERLAY/OVCAP GENERATION
 IC       ENDIF 
          RJ     LES         LIST ENDING STATISTICS 
          RJ     PDC
          EQ     MAPX        GO TO MAP EXIT ROUTINE 
  
 IC       IFCARD
  
**        5)   IF THE NEXT OVERLAY/OVCAP DIRECTIVE IS ERRORED, THE
*              DIRECTIVE AND ERROR MESSAGE ARE NOW LISTED.
  
 MAP4     SA1    NEWERR 
          ZR     X1,MAP6     IF NO ERROR
 MAP5     SX6    B0 
          SA6    OGL1 
          SA1    NEWCARD
          RJ     LOC         LIST OVERLAY CARD
          RJ     LCE         LIST CARD ERROR
  
**        6)   IF ERRORS MAKE IT NECESSARY TO TERMINATE OVERLAY/OVCAP 
*              GENERATION, THE MESSAGE *ERRORS IN OVERLAY GENERATION* 
*              REPLACES THE (0,0) BINARY OUTPUT AND THE JOB IS ABORTED. 
  
 MAP6     RJ     /MISC/CFA
          ZR     X6,MAP10    IF NO ERRORS OR IF ONLY NON-FATAL ERRORS 
                              WITHOUT *ERR=ALL* 
          RJ     LES         TERMINATE MAP
          RJ     PDC
 MAP7     SA1    OGLST00
          ZR     X1,MAP9     IF NO FILE DETERMINED
          RJ     CPY         SPOOL EVERYTHING BACK FROM Z32 
          SA1    OGLST00     (A1) POINTS TO FILE NAME 
          SETFET L,A1,BINARY
          SA1    OGSKIP 
          ZR     X1,MAP8     IF FILE IS IN POSITION 
          SKIPB  L,X1,0,RCL  POSITION TO (0,0)
 MAP8     SB6    =C*ERRORS IN OVERLAY GENERATION* 
          WRITEC L,B6 
          WRITER L,RCL
 MAP9     RJ     /MISC/CFA   CHECK FOR ABORT (RETURNS X6 = 1 OR -1 HERE)
          MI     X6,MAP9A    IF TO ABORT
          RJ     RSF         RETURN SYSTEM FILES
          SX6    4RENDP/16   ISSUE *END*
          LX6    40 
          RJ     SYS= 
  
 MAP9A    SX6    B1 
          SA6    ABTTYPE
          ERROR  CAT,B0      ABORT JOB
  
**        7)   IF MORE OVERLAYS/OVCAPS ARE TO BE GENERATED, CONTROL 
*              RETURNS TO THE LOADER. 
  
 MAP10    SA1    NEWLFN 
          ZR     X1,MAP11    IF NO MORE OVERLAYS
          WRITER L,RCL       FLUSH BUFFER 
          EQ     MAPX        GO TO MAP EXIT ROUTINE 
  
**        8)   AT THIS POINT, OVERLAY GENERATION IS NOW COMPLETE. 
*              THE MAP (IF ANY) IS FINISHED.  IF EXECUTION IS DESIRED,
*              THE LOADER IS RELOADED TO LOAD THE (0,0) OVERLAY.
  
 MAP11    RJ     LES         LIST ENDING STATISTICS 
          SA1    MAPTYPE
          ZR     X1,MAP12    IF MAP NOT REQUESTED (ERRORS IN DAYFILE) 
          RJ     PDC
 MAP12    BSS    0
          RJ     ISD         ISSUE STATISTICS TO DAYFILE
          SA1    EX 
          NZ     X1,XEQ      IF EXECUTION DESIRED 
          RJ     SPYOFF      TURN OFF *SPY* 
          SX6    4RENDP/16
          LX6    40 
          RJ     SYS=        ENDRUN 
  
 MAP13    SA1    MAPTYPE     ENCAPSULATION, ABORT INDICATED 
          ZR     X1,MAP13B   IF WRITTEN TO DAYFILE
          WRITER L,RCL       FLUSH BUFFER 
 MAP13B   SA1    OF 
          NZ     X1,MAP13A   IF LFN ALREADY IN *OF* 
          SA1    DFLTLFN
          BX6    X1 
          SA6    OF          SET DEFAULT LFN INTO *OF*
 MAP13A   SETFET L,A1,BINARY
          SB6    =C*ERRORS IN ENCAPSULATION*
          WRITEC L,B6 
          WRITER L,RCL
          EQ     MAP9        ABORT
  
 IC       ENDIF 
  
*         WE COME HERE IF THE TABLE MANAGER RUNS OUT OF ROOM
  
 MAPABT1  MESSAGE (=C*INSUFFICIENT  FL FOR MAP*)
          EQ     MAP3B
          SPACE  4,8
*         WE COME TO *MAPX* PRIOR TO EXITING THE MAP ROUTINE IF 
*         A MAP WAS WRITTEN (ERRORS TO THE DAYFILE DON-T COUNT).
*         IF MAP OPTIONS E OR X WERE SELECTED, THEN WE MUST RESTORE 
*         *TLNK* TO ITS DOCUMENTED FORMAT AS IT HAS BEEN SEMI-
*         GARBAGED BY ROUTINES *LEP* AND *SRC*. 
  
 MAPX     SA1    MAPTYPE
          LX1    59-3        BIT 59 = X MAP OPTION
          LX2    X1,B1       BIT 59 = E MAP OPTION
          BX1    X2+X1
          PL     X1,MAP      EXIT IF NEITHER E NOR X SELECTED 
          MX0    18 
          SA1    TLNK        (X1) = *TLNK* FWA
          SA2    A1+B1       (X2) = *TLNK* LENGTH 
          SB2    X1          (B2) = *TLNK* FWA
          SB3    X2+B2       (B3) = *TLNK* LWA+1
          GE     B2,B3,MAP   IF NO ENTRY POINTS THEN EXIT 
 MAPX1    SA1    B2          ENTRY POINT NAME FROM *TLNK* 
          LX1    42          RESTORE TO DOCUMENTED FORMAT 
          BX6    -X0*X1 
          SA6    B2          REWRITE ENTRY POINT TO *TLNK*
          R=     B2,B2+2     INDEX TO NEXT ENTRY POINT
          LT     B2,B3,MAPX1  IF MORE ENTRY POINTS TO PROCESS 
          EQ     MAP         EXIT MAP ROUTINE 
 WBL      TITLE  LOAD MAP - PRINT SUBROUTINES.
**        WBL - WRITE BLANK LINES.
* 
*         ENTRY  (X6) = NUMBER OF LINES.
*         CALLS  WOF. 
  
  
 WBL      PS                 ENTRY/EXIT 
 WBL1     SA6    WBLA        STORE LINE COUNT 
          SA1    LC 
          R=     X6,1        LINE COUNT + 1 
          IX6    X1+X6
          SA1    PGSIZ       PAGE SIZE
          IX6    X6-X1
          PL     X6,WBL      IF BLANK LINES WILL CROSS PAGE BOUNDRY 
          SX1    =C*  * 
          RJ     WOF
          SA1    WBLA        DECREMENT LINE COUNT 
          R=     X6,X1-1
          NZ     X6,WBL1
          EQ     WBL
  
 WBLA     BSS    1
 WOF      SPACE  4,8
**        WOF - WRITE OUTPUT FILE.
* 
*              THIS ROUTINE WRITES ONE LINE IN *C* FORMAT TO THE MAP. 
*         IT ALSO CHECKS FOR END-OF-PAGE AND STARTS A NEW PAGE WHEN 
*         NECESSARY.
* 
*         ENTRY  (X1) = FWA LINE. 
*         CALLS  CDD=, WTC=.
  
  
 WOF      PS                 ENTRY/EXIT 
          SA2    LC          ADVANCE LINE COUNT 
          R=     X6,1 
          IX6    X2+X6
          SA6    A2 
          SA2    PGSIZ
          IX7    X6-X2
          NG     X7,WOF3     IF BOTTOM OF PAGE NOT REACHED
          R=     X6,3        RESET LINE COUNT 
          BX7    X1          SAVE LINE ADDRESS
          SA6    A6 
          SA7    WOFA 
          SA1    PC          ADVANCE PAGE COUNT 
          SX6    X1+B1
          SA6    A1 
          RJ     CDD=        CONVERT THE PAGE NUMBER
          MX7    -12
          LX6    24 
          BX6    X7*X6
          SA6    PAGE 
          WRITEC L,TITL 
 IC       IFCARD
          SA1    OG 
          ZR     X1,WOF1     IF NOT OVERLAY GENERATION LOAD 
          MI     X1,WOF1     IF ENCAPSULATION 
          WRITEC L,OGLINE    WRITE OVERLAY CARD AS SECOND LINE OF TITLE 
          SA1    LC 
          SX6    X1+B1       BUMP LINE COUNT
          SA6    A1 
 WOF1     BSS    0
 IC       ENDIF 
          WRITEC L,(=2L  )
          SA2    ST 
          ZR     X2,WOF2     IF NO SUBTITLE 
          MI     X2,WOF2     IF PRINTING SUBHEADER ALREADY
          SA1    LC 
          R=     X6,X1+2
          SA6    A1 
          WRITEC L,(=2L  )
          SA1    ST 
          WRITEC L,X1 
 WOF2     WRITEC L,(=2L  )
          SA1    WOFA        RESTORE REQUEST
 WOF3     WRITEC L,X1        WRITE LINE 
          EQ     WOF         RETURN 
  
 WOFA     BSS    1
 SPD      SPACE  4,10 
**        SPD -  SET PRINT DENSITY. 
* 
*              THIS ROUTINE ISSUES A CARRIAGE CONTROL LINE TO SET THE 
*         PRINT DENSITY FOR THE MAP.  IT ALSO FLAGS THAT MAP PRINTING HAS 
*         BEGUN.
*         USES   X - 1,2,6. 
*                A - 1,2,6. 
*                B - NONE.
* 
*         CALLS  WTO=.
  
  
 SPD      PS                 ENTRY/EXIT 
          SA1    PRDEN
          MI     X1,SPD1     IF NOT FIRST TIME
          BX6    -X1         FLAG MAP STARTED 
          SA6    A1 
          BX1    -X1
 SPD1     SA2    =0LT 
          R=     X1,X1+8
          ZR     X1,SPD2     IF PRINT DENSITY IS 8 LINES/INCH 
          SA2    =0LS 
 SPD2     BX6    X2 
          WRITEO L
          EQ     SPD         EXIT 
 PDC      SPACE  4,10 
**        PDC - RESET PRINT DENSITY AND CLEAR BUFFER. 
* 
*              THIS ROUTINE ISSUES A CARRAGE CONTROL LINE TO RESET THE
*         PRINT DENSITY TO INSTALLATION DEFAULT.
* 
*         USES   X - 1,2,6. 
*                A - 1,2,6. 
*                B - NONE.
* 
*         CALLS  WTO=.
  
  
 PDC      PS                 ENTRY/EXIT 
          SA1    PGPAR       GET JOB PAGE PARAMETERS
          MX6    -4 
          AX1    12+8+8      POSITION FOR *PD*
          SA2    PRDEN
          BX1    -X6*X1 
          BX6    X2 
          AX6    60          FORM SIGN
          BX2    X6-X2       FORM ABSOLUTE *PD* 
          IX6    X1-X2
          ZR     X6,PDC1     NO NEED TO RESET PRINT DENSITY 
          R=     X6,1RS-6/2  FORM BASE FOR *PD* 
          AX1    1           DIVIDE *PD* BY 2 
          IX6    X6+X1
          LX6    -6          *PD* TO HIGH ORDER BIT 
          WRITEO L
 PDC1     WRITER L,RCL       FLUSH BUFFER 
          EQ     PDC         EXIT 
 SHL      SPACE  4,8
**        SHL - SET HEADER LINE.
* 
*              THIS ROUTINE PLACES A HEADER AND SUB-HEADER IN THE MAP,
*         ADVANCING THE LINE COUNT ACCORDINGLY. 
* 
*         ENTRY  (X6) = FWA OF SUBTITLE LINE. 
*                (X7) = FWA OF HEADER LINE. 
*         EXIT   NONE.
*         USES   X - 1, 6, 7. 
*                B - NONE.
*                A - 1, 6, 7. 
*         CALLS  WBL, WOF, WTC=.
  
  
 SHL      PS                 ENTRY/EXIT 
          BX6    -X6
          SA7    HL          SET HEADER LINE
          SA6    ST 
          R=     X6,3 
          RJ     WBL         WRITE BLANK LINES
          SA1    HL 
          RJ     WOF         WRITE HEADER LINE
          SA2    LC          LINE COUNT 
          SA1    PGSIZ       PAGE SIZE
          IX6    X1-X2       NUMBER OF LINES LEFT ON PAGE 
          R=     X2,5 
          R=     X7,1 
          IX2    X6-X2
          IX6    X6-X7
          ZR     X6,SHL2     IF NO BLANK LINES NEEDED 
          MI     X2,SHL1     IF LESS THAN FOUR LINES LEFT ON PAGE 
          SX6    B1 
 SHL1     RJ     WBL         WRITE BLANK LINE/LINES 
 SHL2     SA1    ST          SUBTITLE ADDRESS 
          BX1    -X1
          RJ     WOF         WRITE SUBHEADER LINE 
          SA1    ST 
          BX6    -X1
          SA6    A1 
          PRINT  (=C*  *) 
          EQ     SHL
  
  
          RELOC  OFF
 BUF      BSS    0           LINE BUFFER
          DATA   1H 
          BSS    14 
 BUFL     EQU    *-BUF       BUFFER LENGTH
 IU       IFUSER
 TITL     DATA   10H1 
          DATA   50HPROGRAM-INITIATED LOAD
          DATA   30H    CYBER LOADER "VER"-"LEVEL"
 DATE     DATA   10H
 TIME     DATA   10H
          DATA   10H      PAGE
 PAGE     CON    0
  
 LC       CON    PGSIZ
 PC       CON    1           PAGE COUNT 
 IU       ENDIF 
 ST       CON    0           ADDRESS OF SUBTITLE
 HL       CON    0           ADDRESS OF HEADER LINE 
          RELOC  ON 
 SEG      IFCARD
 CPO      SPACE  4,8
**        CPO - CORRECT PROGRAM ORIGINS.
* 
*              IF PASS 2 OF A SEGMENT LOAD IS NOT COMPLETED THE PROGRAM 
*         ADDRESS FIELD IN *TBLK* CONTAINS THE DISK ADDRESS OF THE
*         PROGRAM ON THE FILE ZZZZZ31.  WE WANT TO CHANGE THIS FIELD TO 
*         THE PROGRAM ADDRESS.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 6, 7. 
*                A - 1, 2, 3, 4, 6. 
  
  
 CPO      PS                 ENTRY/EXIT 
          SA1    SEGFLAG
          ZR     X1,CPO      IF NOT A SEGMENT LOAD
          SA2    FE 
          MI     X1,CPO      IF PASS 1 HAS NOT GENERATED *TBLK* 
          ZR     X2,CPO      IF NO FATAL ERRORS *TBLK* IS OK
          SA3    TBLK 
          MX7    -24
          SA1    A3+B1
          SB7    8           (B7) = CURRENT INDEX IN *TBLK* 
          SB6    X1          (B6) = LENGTH OF *TBLK*
          SB2    B1+B1       (B2) = 2 
 CPO1     GE     B7,B6,CPO   IF END OF TABLE
          SA1    X3+B7
          SB7    B7+B2
          LX1    59-0 
          MI     X1,CPO1     IF NOT PROGRAM ENTRY 
          SA4    A1+B1
          BX4    X7*X4
          SA2    A1 
          MX1    -12
 CPO2     SA2    A2-B2       GET PREVIOUSLY DEFINED ENTRY 
          LX2    59-0 
          PL     X2,CPO3     IF PROGRAM BLOCK 
          LX2    0-1
          MI     X2,CPO2     IF ECS BLOCK - TRY AGAIN 
          LX2    1-2
          MI     X2,CPO3     IF SEGMENT BLOCK 
          LX2    -3 
          BX2    -X1*X2 
          NZ     X2,CPO2     IF OWNER NOT THIS SEGMENT
 CPO3     SA2    A2+B1
          SX6    X2          PREVIOUS PROGRAM ADDRESS 
          AX2    24 
          SX2    X2          PREVIOUS LENGTH
          IX6    X6+X2       CURRENT *PA* 
          BX6    X6+X4
          SA6    A4          ADD *PA* TO CURRENT PROGRAM ENTRY
          EQ     CPO1 
 SSI      SPACE  4,8
**        SSI - SET SEGMENT INDEX.
* 
*              DURING A SEGMENT LOAD WE OFTEN NEED TO KNOW WHERE IN 
*         *TBLK* ALL THE ENTRIES FOR THIS SEGMENT ARE.  WE SET THE
*         INDEX OF THE CURRENT SEGMENT INDEX INTO *SI* AND THE INDEX
*         OF THE NEXT SEGMENT ENTRY INTO *SI+1*.  IF WE ARE GENERATING
*         A MAP OF TYPE *X*, *E* OR *B* WE PRINT THE LINE GIVING THE
*         NAME OF THE CURRENT SEGMENT.
* 
*         ENTRY  *SI+1* = INDEX OF CURRENT SEGMENT ENTRY IN *TBLK*. 
*         EXIT   *SI* = INDEX OF CURRENT SEGMENT ENTRY. 
*                *SI+1* = INDEX OF NEXT SEGMENT ENTRY.
*         USES   X - 1, 2, 4, 6, 7. 
*                B - 2, 3, 4. 
*                A - 1, 2, 4, 6, 7. 
*         CALLS  WOF. 
  
  
 SSI      PS                 ENTRY/EXIT 
          SA1    SEGFLAG
          ZR     X1,SSI      IF NOT A SEGMENT LOAD
          SA2    SI+1 
          SX6    X2 
          SA6    A2-B1       SET SEGMENT INDEX
          SA1    TBLK 
          SA4    A1+B1
          SB2    X1          (B2) = FWA OF *TBLK* 
          SB3    X4          (B3) = LENGTH OF *TBLK*
          SX4    4
          SB4    X2          (B4) = STARTING INDEX
          SA1    X6+B2       CURRENT SEGMENT ENTRY
          MX2    42 
          BX6    X2*X1
          SA1    SN 
          SA6    SSIB        SAVE SEGMENT NAME IN MESSAGE 
          SX7    X1+B1
          SA7    A1          INCREMENT SEGMENT NUMBER 
          GE     B4,B3,SSI   IF ALREADY AT END OF *TBLK*
 SSI1     SB4    B4+2 
          GE     B4,B3,SSI3  IF END OF *TBLK* 
          SA1    B2+B4
          BX6    X4*X1
          ZR     X6,SSI1     IF NOT SEGMENT ENTRY 
          SX6    B4 
          SA6    A2          NEW SEGMENT INDEX
 SSI2     SA1    MAPTYPE
          R=     X2,16B 
          BX2    X2*X1
          ZR     X2,SSI      IF S, E OR X TYPE MAP NOT SELECTED 
          MX6    0
          SA6    ST          CLEAR SUBTITLE 
          PRINT  SSIA,4 
          EQ     SSI
  
 SSI3     SX6    B3          SET SEGMENT INDEX = LENGTH OF *TBLK* 
          SA6    A2 
          EQ     SSI2 
  
 SSIA     DATA   20H -------- SEGMENT - 
 SSIB     CON    0
 SEG      ENDIF 
 HEADER   SPACE  4,8
**        HEADER - SET PAGE HEADER. 
* 
*              THIS ROUTINE PLACES THE DATE AND CLOCK TIME IN THE 
*         PAGE HEADER.  THE SUBROUTINE *WOF* IS CALLED IN ORDER THAT THE
*         HEADER BE PLACED ON THE FIRST PAGE. 
* 
*         CALLS  SYS=, WOF. 
  
  
 HEADER   EQ     *+400000B   ENTRY/EXIT 
          IFCARD 4
          SA1    SEGFLAG
          NZ     X1,HEADER4  IF SEGMENTED LOAD HEADER ALREADY SET UP
          SA1    DATE 
          NZ     X1,HEADER1  IF NOT FIRST TIME
          DATE   DATE        PUT DATE IN HEADER 
          CLOCK  TIME        PUT TIME IN HEADER 
 IC       IFCARD
 HEADER1  SA1    OGL1 
          NZ     X1,HEADER2  IF OVERLAY BUT NOT (0,0) 
          SA1    ON 
          RJ     SFN= 
          LX6    -6 
          SA6    PNAM        PUT PROGRAM NAME IN HEADER 
          SA1    OG 
          PL     X1,HEADER3  IF NOT ENCAPSULATION 
          SA1    LASCPNAM 
          NZ     X1,HEADER2  IF NOT FIRST CAPSULE 
          EQ     HEADER3
  
 HEADER2  SA1    PGSIZ
          BX6    X1 
          SA1    LC 
          R=     X2,10
          IX1    X1-X6
  
          IX1    X1+X2
          MI     X1,HEADER4  IF PLENTY OF ROOM LEFT ON  PAGE
 HEADER3  SA1    PGSIZ
          BX6    X1 
          SA6    LC          FORCE PAGE EJECT ON NEXT WRITE 
 IC       ENDIF 
 HEADER4  PRINT  (=2L  )     PRINT BLANK LINE TO WRITE HEADER 
          EQ     HEADER      EXIT 
          SPACE  4
 IC       IFCARD
 LCPGP    SPACE  4,8
**        LCPGP - LIST CAPSULE AND GROUP NAME.
* 
*              THIS ROUTINE IS GIVEN CONTROL TO WRITE THE CAPSULE 
*         AND GROUP NAMES TO THE LOAD MAP.
  
 LCPGP    PS                 ENTRY/EXIT 
          SA1    CURCPNAM 
          RJ     SFN= 
          SA6    LCPGPM+2    SPACE FILLED CAP NAME INTO MESSAGE 
          SA1    CURGPNAM 
          RJ     SFN= 
          SA6    LCPGPM+4    SPACE FILLED GP NAME INTO MESSAGE
          SA1    OF 
          NZ     X1,LCPGP1   IF FILE NAME IN *OF* 
          SA1    DFLTLFN     ELSE FILE NAME IN *DFLTLFN*
 LCPGP1   BSS    0
          RJ     SFN= 
          SA6    LCPGPM+7    SPACE FILLED FILE NAME INTO MESSAGE
          PRINT  LCPGPM,2    PRINT MESSAGE
          EQ     LCPGP       EXIT 
  
 LCPGPM   DATA   50H -------- CAPSULE                GROUP
          DATA   30H   WRITTEN TO FILE
          DATA   0
  
 CGSEX    SPACE  4,8
**        CGSEX - SET ENTRY OR EXTERNAL INDICATOR.
* 
*              THIS SUBROUTINE IS CALLED FROM *LEP* AND IS RESPONSIBLE
*         FOR SETTING *E* (ENTRY INDICATOR) OR *X* (EXTERNAL INDICATOR) 
*         INTO THE ENTRY POINT NAME FIELD OF THE LOAD MAP.  TABLE 
*         *TCPENTR* CONTAINS THE CAPSULE/OVCAP ENTRY POINT NAMES AND
*         *TCPEXTR* CONTAINS THE CAPSULE/OVCAP EXTERNAL NAMES.
* 
*         ENTRY  (X1) = NAME (60/0LNAME). 
*         EXIT   (X6) = NAME, BLANK FILLED, POSSIBLY *E* OR *X* AS
*                       THE NINTH CHARACTER OF THE WORD.
*         USES   X - 2, 6.
*                B - 6, 7.
*                A - 2. 
*         CALLS  SFN=.
  
 CGSEX    PS                 ENTRY/EXIT 
          SA2    TCPENTR
          SB6    X2          (B6) = FWA *TCPENTR* 
          SA2    A2+B1
          SB7    X2+B6       (B7) = LWA+1 OF *TCPENTR*
          MX6    42 
 CGSEX1   GE     B6,B7,CGSEX2  IF *TCPENTR* EXHAUSTED (NOT ENTRY) 
          SA2    B6          NEXT NAME FROM *TCPENTR* 
          BX2    X2*X6       SAVE ONLY NAME FIELD 
          SB6    B6+B1       BUMP FETCH POINTER 
          BX2    X2-X1       COMPARE NAMES
          NZ     X2,CGSEX1   IF NOT THE SAME
          RJ     SFN=        SPACE FILL NAME
          MX2    -6 
          LX2    6
          BX6    X6*X2
          R=     X2,1RE 
          LX2    6
          BX6    X6+X2       NAME, BLANK FILLED, *E* AS NINTH CHARACTER 
          EQ     CGSEX       RETURN 
  
 CGSEX2   SA2    TCPEXTR
          SB6    X2          (B6) = FWA *TCPEXTR* 
          SA2    A2+B1
          SB7    X2+B6       (B7) = LWA+1 OF *TCPEXTR*
 CGSEX3   GE     B6,B7,CGSEX4  IF *TCPEXTR* EXHAUSTED (NOT EXTERNAL)
          SA2    B6          NEXT NAME FROM *TCPEXTR* 
          BX2    X2*X6       SAVE ONLY NAME FIELD 
          SB6    B6+B1       BUMP FETCH POINTER 
          BX2    X2-X1       COMPARE NAMES
          NZ     X2,CGSEX3   IF NOT THE SAME
          RJ     SFN=        SPACE FILL NAME
          MX2    -6 
          LX2    6
          BX6    X6*X2
          R=     X2,1RX 
          LX2    6
          BX6    X6+X2       NAME, BLANK FILLED, *X* AS NINTH CHARACTER 
          EQ     CGSEX       RETURN 
  
 CGSEX4   RJ     SFN=        SPACE FILL NAME
          EQ     CGSEX       RETURN 
  
          TITLE  LOAD MAP - OVERLAY GENERATION SUBROUTINES
 LOC      SPACE  4
**        LOC - LIST OVERLAY/OVCAP CARD.
* 
*         ENTRY  (A1) ADDRESS OF CARD IMAGE 
*                (X1) FIRST WORD OF CARD IMAGE
  
  
 LOC      PS                 ENTRY/EXIT 
          SA2    OG 
          ZR     X2,LOC      IF OVERLAY GENERATION NOT IN PROGRESS
          MI     X2,LOC      IF ENCAPSULATION 
          BX6    X1 
          SA6    LOCB        MOVE CARD IMAGE
          MX7    -12
 LOC1     BX1    -X7*X1 
          ZR     X1,LOC2     IF END OF LINE 
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          EQ     LOC1 
  
 LOC2     SA1    MAPFLAG
          ZR     X1,LOC      EXIT IF NO MAP WANTED
          SA1    OGL1 
          ZR     X1,LOC3     IF (0,0) WE JUST STARTED A NEW PAGE
          R=     X6,4 
          RJ     WBL         PRINT 4 BLANK LINES
 LOC3     PRINT  LOCA        PRINT OVERLAY/OVCAP CARD 
          SA1    OG 
          R=     X1,X1-2
          ZR     X1,LOC5     IF OVCAP GENERATION
          SA1    OF 
          ZR     X1,LOC4     IF LFN NOT SPECIFIED BY *NOGO* CARD
          BX6    X1 
          SA6    LSTC1
          PRINT  LSTC        PRINT *WRITTEN TO FILE XXXXXXX*
 LOC4     PRINT  (=2L  )     PRINT BLANK LINE 
          EQ     LOC         EXIT 
  
 LOC5     PRINT  (=2L  )     PRINT BLANK LINE 
          SA1    CURCPNAM    OVCAP NAME 
          RJ     SFN=        SPACE FILL 
          SA6    LSTF1       PUT INTO MESSAGE 
          SA1    CURGPNAM    GROUP NAME 
          RJ     SFN=        SPACE FILL 
          SA6    LSTF2       PUT INTO MESSAGE 
          SA1    OGLFN       FILE NAME
          RJ     SFN=        SPACE FILL 
          SA6    LSTF3       PUT INTO MESSAGE 
          PRINT  LSTF,1      PRINT MESSAGE
          EQ     LOC         EXIT 
  
  
 LOCA     DATA   10H -------- 
 LOCB     BSSZ   9
 LCE      SPACE  4
**        LCE - LIST CARD ERROR (OVERLAY/OVCAP CARD). 
  
  
 LCE      PS                 ENTRY/EXIT 
          SA5    NEWERR 
          ZR     X5,LCE      IF NO ERROR, EXIT
          SA1    MAPFLAG
          ZR     X1,LCE1     IF NO MAP (WRITE TO DAYFILE) 
          PRINT  (=2L)
          SA1    X5+OCET-1
          RJ     WOF         WRITE ERROR
          SA1    VISIBLE
          ZR     X1,LCE1     IF MAP IS INVISIBLE
          SA1    FE 
          NZ     X1,LCE      IF DAYFILE MSG ALREADY TAKEN CARE OF 
          MESSAGE FEMESS
          EQ     LCE
  
 LCE1     MESSAGE  (=C/DIRECTIVE ERROR/),R
          SA1    X5+OCET-1
          SX3    X1+B1
          MESSAGE LOCB,R     DAYFILE CARD IMAGE 
          MESSAGE X3         DAYFILE SPECIFIC MESSAGE 
          EQ     LCE
 OCET     SPACE  4
**        OCET - OVERLAY CARD ERROR TABLE 
  
  
OCET BSS 0
  LOC 0 
  CON =C/ FE0241***SYNTAX ERROR ON OVERLAY OR OVCAP CARD/ 
  CON =C/ FE0242***NO FILE SPECIFIED FOR OVERLAY/ 
  CON =C/ FE0243***ILLEGAL LEVEL NUMBER/
  CON =C/ FE0244***PRIMARY OVERLAY NOT PRECEDED BY (0,0) OVERLAY/ 
  CON =C/ FE0245***SECONDARY OVERLAY NOT PRECEDED BY ITS PRIMARY/ 
  CON =C/ FE0240***OVERLAY OR OVCAP CARD NOT SEPARATE SECTION/
  CON =C/ FE0521***OVERLAY DIRECTIVE FOLLOWING OVCAP DIRECTIVE MUST SPEC
,IFY (0,0) LEVEL/ 
  LOC *O
 CPY      SPACE  4
**        CPY - COPY FROM ZZZZZ32.
* 
*                IF USER-SPECIFIED BINARY OUTPUT FILES COULD NOT BE 
*         USED DUE TO REQUIREMENTS FOR RANDOM I/O, THE FILE *ZZZZZ32* 
*         WAS USED INSTEAD.  IF THIS WAS THE CASE, THE FLAG *CPYF*
*         WAS SET NONZERO.  THIS ROUTINE CHECKS *CPYF* AND IF SET 
*         COPIES Z32 TO THE USER FILES. 
* 
*                Z32 IS REWOUND BEFORE COPYING AND RETURNED AFTERWARDS. 
*         NULL RECORDS ARE IGNORED AND COPYING STOPS WHEN AN EOF IS 
*         READ.  THE FIRST WORD OF EACH RECORD IS THE NAME OF THE 
*         FILE TO WHICH THE REST OF THE RECORD IS TO BE COPIED. 
*         IF THIS IS A SEGMENT LOAD, THIS WORD IS NOT WRITTEN TO THE
*         SPECIFIED FILE.  OTHERWISE, IT IS CHANGED TO A STANDARD LENGTH
*         *PRFX* TABLE HEADER AND RETAINED DURING THE COPY. 
* 
*                THIS ROUTINE ASSUMES THAT THE BUFFER USED BY FET *L* 
*         IS AT LEAST 1001B WORDS IN LENGTH.
  
  
  
*         EXIT IF NOTHING TO DO.  SET UP FET AND REWIND Z32.
  
 CPY      EQ     *+400000B   ENTRY/EXIT 
          SA1    CPYF 
          ZR     X1,CPY      IF NOTHING TO COPY 
          SMSG   (=C/  SPOOLING BACK FROM "SFN"/) 
          SA1    L+1
          SA2    L+4
          SX6    X1 
          SX7    X2 
          IX5    X7-X6       (X5) = BUFFER LENGTH 
          SX3    B1 
          SA7    O+4         LIMIT
          SA6    A7-B1       OUT
          SA6    A6-B1       IN 
          LX3    18 
          BX6    X6+X3
          SA6    A6-B1       FIRST (+ 6-WORD FET) 
          SA1    Z32         SPOOLING FILE NAME 
          R=     X6,3        BINARY MODE + COMPLETE BIT 
          BX6    X1+X6
          SA6    A6-B1       SET NAME INTO FET O
          REWIND O,RCL
  
  
*         READ FILE NAME FROM Z32 AND SET UP BINARY OUTPUT FET. 
*         REPLACE FILE NAME WITH *PREFIX* HEADER IN BUFFER
  
 CPY1     SA2    O+2
          BX6    X2 
          SA6    A2+B1       INDICATE EMPTY BUFFER (SET OUT=IN) FET O 
          SA2    L+2
          BX6    X2 
          SA6    A2+B1       INDICATE EMPTY BUFFER (SET OUT=IN) FET L 
          READ   O,RCL       *O* = INPUT FET, ISSUE READ
          SA2    O+2         (X2) = IN POINTER
          SA3    A2+B1       (X3) = OUT POINTER 
          IX2    X2-X3       IN-OUT 
          NZ     X2,CPY1A    IF DATA READ 
          SA2    O           GET STATUS FIELD OF FET
          LX2    59-9 
          MI     X2,CPY7     IF EOI 
          EQ     CPY1        IGNORE EMPTY RECORD/FILE 
  
 CPY1A    SA1    X3          GET FILE NAME FROM BUFFER
          SA4    IH          *PREFIX* HEADER
          BX6    X4 
          SA6    A1          REPLACE FILE NAME WITH *PREFIX* HEADER 
          SETFET L,A1,BINARY *L* = OUTPUT FET 
          SA1    O+3
          SX6    X1 
          SA3    SEGFLAG     IF *SEGLOAD*, ADVANCE *OUT* POINTER SO AS
                              TO NOT WRITE THE 1ST WORD OF THE RECORD 
          ZR     X3,CPY1B    IF NOT *SEGLOAD* 
          SA2    A1+B1       (X2) = *LIMIT* 
          SX2    X2 
          SX6    X6+B1       ADVANCE *OUT*
          IX1    X2-X6
          NZ     X1,CPY1B    IF (OUT+1) NE *LIMIT*
          SA1    O+1         SET *OUT* = *FIRST*
          SX6    X1 
 CPY1B    SA6    L+3         STORE *OUT* IN OUTPUT FET
  
  
*         UPDATE *IN* OF *L* AND *OUT* OF *Z*, EACH FROM THE OTHER FET. 
  
 CPY2     SA1    O+2
          SA2    L+3
          BX6    X1 
          LX7    X2 
          SA6    A2-B1
          SA7    A1+B1
  
*         IF INPUT FET IS COMPLETE, FIGURE OUT WHY. RESTART IF POSSIBLE.
  
          SA1    O
          LX1    59 
          PL     X1,CPY3     IF BUSY
          LX1    -4 
          MI     X1,CPY6     IF EOR 
          SA1    O+2         IN 
          SA2    A1+B1       OUT
          IX2    X1-X2       IN-OUT 
          BX1    X2 
          AX2    59 
          BX2    -X2*X5      BUFFER LENGTH, OR ZERO 
          IX1    X1-X2       -(FREE WORDS IN BUFFER)
          R=     X1,X1+100B 
          PL     X1,CPY3     IF NOT ENOUGH ROOM IN BUFFER FOR 1 PRU 
          READ   O
  
  
*         DO THE SAME FOR THE OUTPUT FET. 
  
 CPY3     SA1    L
          LX1    59 
          PL     X1,CPY5     IF OUTPUT FET BUSY 
          SA1    L+2         IN 
          SA2    A1+B1       OUT
          IX2    X1-X2       IN-OUT 
          BX1    X2 
          AX2    59 
          BX2    X2*X5       BUFFER LENGTH, OR ZERO 
          IX1    X1+X2       VALID DATA FOR WRITE 
          R=     X1,X1-1000B
          MI     X1,CPY5     IF NOT ENOUGH TO TRY WRITING 
          WRITE  L
  
  
*         RECALL TO GIVE CIO A CHANCE.
  
 CPY5     RECALL
          EQ     CPY2 
  
  
*         EOR WAS READ.  FLUSH THE BUFFER AND GO BACK FOR THE NEXT FILE.
  
 CPY6     SA1    O+2
          BX6    X1 
          SA6    L+2         FINAL *IN* POINTER 
          WRITER L,RCL       FLUSH BUFFER 
          SA1    L+3
          BX6    X1 
          SA6    O+3         FINAL *OUT* POSITION 
          EQ     CPY1 
  
  
*         EOF WAS READ.  RETURN Z32, SET *CPYF* FALSE, AND EXIT.
  
 CPY7     SA1    O
          LX1    59-9 
          MI     X1,CPY8     IF EOI BIT SET 
          WRITEF L,RCL       ADD EOF
 CPY8     CLOSE  O,RETURN    RETURN *ZZZZZ32* 
          SA2    L+4
          SA1    LM 
          SX6    X2 
          SX7    X1 
          SA6    O+1         RESET *FIRST* AND *LIMIT* IN FET *O* 
          SA7    O+4
          SX6    B0 
          SA6    CPYF 
          EQ     CPY
  
  
 IC       ENDIF 
 LES      TITLE  LOAD MAP - LIST ENDING STATISTICS. 
**        LES - LIST ENDING STATISTICS. 
* 
*              THIS ROUTINE LISTS THE FOLLOWING INFORMATION AT THE END
*         OF THE MAP.  IT GOES AT THE END SO THAT 
*         IT WILL INCLUDE RESOURCES USED AT MAP TIME ITSELF.
* 
*         1) CPU SECONDS USED DURING LOADING. 
*         2) FL REQUIRED. 
*         3) NUMBER OF TABLE MOVES. 
*         4) IF A SEGMENT LOAD, THE NUMBER OF SEGMENTS, PROGRAMS, 
*            AND COMMON BLOCKS IN THE LOAD. 
* 
*         CALLS  SYS=, TCV=, COD, CDD=, WBL, WOF. 
  
  
 LES      PS                 ENTRY/EXIT 
          SA1    MAPTYPE
          LX1    59 
          PL     X1,LES      IF STATISTICS NOT WANTED, EXIT 
          SA2    TM          (X2) = BEGINNING LOAD TIME 
          MX3    -36
          BX2    -X3*X2 
          TIME   T1          FETCH CURRENT CP TIME
          MX7    0           CLEAR SUBTITLE FOR HEADER LINE 
          SA1    X6          CURRENT CP TIME
          SA7    ST 
          BX1    -X3*X1 
          IX1    X1-X2       (CURRENT TIME) - (START TIME)
          RJ     TCV=        CONVERT TIME 
          SA6    LESA1
          SA1    MU          FL REQUIRED
          R=     X1,X1+100B  ROUND CM USED TO NEAREST 100B
          MX7    -6 
          BX1    X7*X1
          RJ     COD
          SA6    LESA2
          SA1    /TMGR/ATSA  NUMBER OF TABLE MOVES
          SB2    X1 
          NE     B2,B1,LES2  IF NOT 1 MOVE
          MX3    6           MODIFY MESSAGE TO SINGULAR 
          SA4    LESA3+2
          BX6    X3*X4
          SA6    A4 
 LES2     RJ     CDD= 
          SA6    LESA3
          PRINT  LESA,3      LIST PERFORMANCE STATISTIC LINE
  
 IC       IFCARD
          SA2    SEGFLAG
          ZR     X2,LES4     IF NOT SEGMENTED LOAD
          SA1    TSEGFIN     NUMBER OF ENTRIES IN *TSEG*
          NZ     X1,LES2A    IF IN PASS 2 (*TSEG* EMPTIED)
          SA1    TSEG+1      GET LENGTH FROM *TSEG* ITSELF
          AX1    1
 LES2A    RJ     CDD= 
          SA1    LESB1
          MX7    5*6
          BX1    X7*X1
          BX6    -X7*X6 
          BX6    X6+X1
          SA6    A1 
          PRINT  LESB,1      WRITE *SEGLOAD* STATISTIC LINE 
 LES4     BSS    0
 IC       ENDIF 
  
          SA2    LC 
 LES3     SA1    PGSIZ
          R=     X6,4 
          IX2    X2-X1
          IX2    X2+X6
          PL     X2,LES      IF FEWER THAN 5 LINES LEFT ON PAGE 
          PRINT  (=C*  *),3        WRITE 4 BLANK LINES AT END 
          EQ     LES         EXIT 
  
          RELOC  OFF
 LESA     DATA   10H
 LESA1    CON    0
          DATA   20H CP SECONDS 
 LESA2    CON    0
          DATA   30HB CM STORAGE USED 
 LESA3    CON    0
          DATA   C* TABLE MOVES*
 IC       IFCARD
 LESB     DATA   60H                NO. OF SEGMENTS+PROGRAMS+BLOCKS USED
, = NNNNN 
 LESB1    EQU    LESB+5 
          DATA   40H          MAXIMUM PERMITTED = "TSEGMX"
          CON    0
 IC       ENDIF 
  
          RELOC  ON 
 LST      TITLE  LOAD MAP - LIST STATISTICS.
**        LST - LIST STATISTICS.
* 
*              THIS ROUTINE LISTS THE FOLLOWING:                               .
* 
*         1) FWA AND LWA+1 OF THE LOAD (CM ALWAYS, ECS IF ANYTHING
*            WAS LOADED INTO ECS).
*         2) NAME OF OVERLAY FILE WRITTEN, IF ANY SPECIFIED BY THE
*            *NOGO* OPTION. 
*         3) TRANSFER NAME AND ADDRESS. 
*         4) *TRAP* ENTRY NAME AND ADDRESS IF A *TRAP* RUN. 
*         5) DEBUG ENTRY NAME AND ADDRESS IF INTERACTIVE DEBUG IS ON. 
*         6) PROGRAM ENTRY POINTS IF *54* TABLE MAIN OVERLAY. 
* 
*              IF CAPSULE/OVCAP GENERATION THEN ONLY THE
*         CAPSULE/OVCAP LENGTH IS LISTED. 
* 
*         CALLS  COD, CDD=, WOF, WBL, SFN=. 
  
  
 LST      PS                 ENTRY/EXIT 
 IC       IFCARD
          SA1    OG 
          MI     X1,LST5     IF ENCAPSULATION 
          R=     X1,X1-2
          ZR     X1,LST6     IF OVCAP GENERATION
 IC       ENDIF 
 SEG      IFCARD
          SA1    SEGFLAG
          ZR     X1,LST0B    IF NOT SEGMENT LOAD
          SA1    TBLK 
          SA2    X1+7        GET ROOT SEGMENT ENTRY 
          SA3    X1+B1
          SX6    X2 
          SX7    X3          FWA OF CM // 
          SA6    PO          SET *PO* FOR MAP 
          AX3    24 
          SX3    X3          LENGTH OF CM //
          IX7    X7+X3       LWA+1 OF LOAD
          SA7    PA 
 LST0B    BSS    0
 SEG      ENDIF 
          SA1    PO 
          RJ     COD
          SA6    LSTA1       FWA OF LOAD
          PRINT  LSTA 
          SA1    PA          LWA+1 OF LOAD
          RJ     COD
          SA6    LSTB1       LWA OF LOAD
          PRINT  LSTB 
 SEG      IFCARD
          SA2    SEGFLAG
          ZR     X2,LST0A    IF NOT SEGMENT LOAD
          SA3    TBLK 
          SA4    X3+B1       CM // DEFINITION 
          SX1    X4 
          MI     X4,LST0A    IF CM // NOT REFERENCED
          RJ     COD         CONVERT FWA OF CM // 
          SA6    LSTE1
          PRINT  LSTE 
 LST0A    BSS    0
 SEG      ENDIF 
 ECS      IFTEST NE,IP.MECS,0 
          SA1    ECSPO       ECS FWA OF LOAD
          SA5    ECSPA       ECS LWA+1 OF LOAD
          IX2    X1-X5
          IFUSER 1
          NZ     X5,LST0     IF ECS LOADED PREVIOUSLY OR NOW
          ZR     X2,LST1     IF NO ECS LOADED 
          IFUSER 1
 LST0     BSS    0
          SB7    LSTX1
          RJ     COD         CONVERT FWA
          SA6    B7          STORE FWA IN MAP LINE
          BX1    X5          CONVERT LWA+1
          RJ     COD
          SA6    LSTY1       STORE LWA+1 IN MAP LINE
          PRINT  LSTX,1      PRINT BOTH LINES 
          PRINT  LSTY 
 SEG      IFCARD
          SA1    SEGFLAG
          ZR     X1,LST1A    IF NOT SEGMENT LOAD
          SA3    TBLK 
          SA4    X3+3        ECS // DEFINITION
          MI     X4,LST1A    IF BLOCK NOT REFERENCED
          MX1    -24
          BX1    -X1*X4 
          RJ     COD         CONVERT FWA OF ECS //
          SA6    LSTZ1
          PRINT  LSTZ 
 LST1A    BSS    0
 SEG      ENDIF 
 LST1     BSS    0
 ECS      ENDIF 
          IFCARD 2
          SA1    OG 
          NZ     X1,LST2     IF OVERLAY GENERATION LOAD, LIST ELSEWHERE 
          SA1    OF 
          ZR     X1,LST2     IF NO FILE WRITTEN 
          RJ     SFN=        SPACE FILL NAME
          SA6    LSTC1       FILE NAME
          PRINT  LSTC,1 
 LST2     SA4    XF 
          MX0    42 
          BX1    X0*X4       ISOLATE NAME 
          SX4    X4          SAVE ADDRESS 
          RJ     SFN=        SPACE FILL NAME
          SA6    LSTD1       STORE XFER NAME
          ZR     X4,LST4     IF NO TRANSFER ADDRESS 
          BX1    X4 
          RJ     COD         CONVERT ADDRESS TO DISPLAY CODE
          SA6    LSTD2       XFER ADDRESS 
 LST3     PRINT  LSTD,1 
 IC       IFCARD
 IT       IFTEST NE,IP.TRAP,0 
          SA1    TRAPADR
          ZR     X1,LST3A    IF NOT A TRAP RUN
          SA5    =0L"TRAPNAME"     NAME OF TRAP ENTRY POINT 
          RJ     COD         CONVERT ADDRESS
          BX0    X6          SAVE ADDRESS 
          LX1    X5          SPACE FILL NAME
          RJ     SFN= 
          SA6    LSTDA1      STORE NAME 
          BX7    X0          STORE ADDRESS
          SA7    A6+B1
          PRINT  LSTDA       PRINT LINE 
 LST3A    BSS    0
 IT       ENDIF 
          SA2    OGL1 
          NZ     X2,LST      IF NOT (0,0) OVERLAY 
          SA1    TA 
          SX5    X1          (X5) = DEBUG TRANSFER ADDRESS OR ZERO
          ZR     X5,LST3B    IF NOT USING INTERACTIVE DEBUG 
          MX5    42 
          BX5    X5*X1       SAVE NAME
          SX1    X1 
          RJ     COD         CONVERT ADDRESS
          BX0    X6 
          BX1    X5 
          RJ     SFN=        SPACE FILL NAME
          SA6    LSTDA1 
          BX7    X0 
          SA7    A6+B1
          PRINT  LSTDA       PRINT LINE 
 LST3B    SA1    SEGFLAG
          NZ     X1,LST      IF SEGMENT GENERATION
          SA1    OG 
          R=     X6,COMLTH
          ZR     X1,LST3C    IF NOT OVERLAY GENERATION
          R=     X6,10B 
 LST3C    BSS    0           (X6) = INDEX OF EPT LIST (REL TO *TPGM*) 
          SA6    LSTH        SAVE INDEX 
          SA1    EPTC 
          BX7    X1 
          SA7    LSTH1       SAVE ENTRY POINT COUNT 
          RJ     LST3E       PLUG NAME AND ADDRESS INTO MESSAGE 
          PRINT  LSTH2,1     PRINT MESSAGE
          SA1    LSTH2       CHANGE MESSAGE FOR SUBSEQUENT PRINTING 
          BX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          SA6    A6+B1
 LST3D    SA1    LSTH        (X1) = INDEX INTO *TPGM* 
          SA2    LSTH1       ENTRY POINT COUNT
          SX6    X1+B1       BUMP INDEX 
          R=     X7,X2-1     DECREMENT COUNT
          SA6    A1          SET FOR NEXT TIME THRU LOOP
          SA7    A2 
          ZR     X7,LST      IF DONE
          RJ     LST3E       PLUG NAME AND ADDRESS INTO MESSAGE 
          PRINT  LSTH2       PRINT MESSAGE
          EQ     LST3D       LOOP FOR ALL ENTRY POINTS
  
 LST3E    PS                 ENTRY/EXIT 
          SA1    LSTH        (X1) = INDEX INTO *TPGM* 
          SA2    TPGM        (X2) = FWA *TPGM*
          SB2    X1 
          SA1    X2+B2       (X1) = NEXT EPT NAME FROM *54* HEADER
          MX2    42 
          BX5    X2*X1       NAME 
          BX1    -X2*X1      ADDRESS
          RJ     COD         CONVERT ADDRESS
          BX0    X6 
          BX1    X5 
          RJ     SFN=        SPACE FILL NAME
          SA6    LSTH2A      NAME INTO MESSAGE
          BX7    X0 
          SA7    A6+B1       ADDRESS INTO MESSAGE 
          EQ     LST3E       EXIT 
  
 IC       ENDIF 
          EQ     LST
  
 LST4     SA1    LSTD3
          BX6    X1 
          SA6    LSTD2
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          EQ     LST3 
  
 IC       IFCARD
 LST5     SA1    TPGM        GET CAPSULE LENGTH FROM *6000* HEADER
          MX2    42 
          SA1    X1 
          BX1    -X2*X1      (X1) = CAPSULE LENGTH
          RJ     COD
          SA6    LSTCG1      LENGTH INTO MESSAGE
          PRINT  LSTCG,1     PRINT
          EQ     LST         EXIT 
  
 LST6     SA1    TPGM        GET OVCAP LENGTH FROM *6000* HEADER
          MX2    42 
          SA1    X1 
          BX1    -X2*X1      (X1) = OVCAP LENGTH
          RJ     COD
          SA6    LSTG1       PUT INTO MESSAGE 
          PRINT  LSTG,1      PRINT
          EQ     LST         EXIT 
  
 IC       ENDIF 
  
          RELOC  OFF
 LSTA     DATA   1H 
          DATA   20HFWA OF THE LOAD 
 LSTA1    DATA   1H 
          CON    0
 LSTB     DATA   1H 
          DATA   20HLWA+1 OF THE LOAD 
 LSTB1    DATA   1H 
          DATA   0
  
 ECS      IFTEST NE,IP.MECS,0 
 LSTX     DATA   1H 
          DATA   20HECS FWA 
 LSTX1    DATA   1H 
          CON    0
 LSTY     DATA   1H 
          DATA   20HECS LWA+1 
 LSTY1    DATA   10H
          CON    0
 ECS      ENDIF 
  
 LSTC     DATA   1H 
          DATA   20HWRITTEN TO FILE 
 LSTC1    DATA   1H 
          DATA   1H 
          DATA   0
 LSTD     DATA   1H 
          DATA   20HTRANSFER ADDRESS -- 
 LSTD1    DATA   1H 
 LSTD2    DATA   1H 
          DATA   1H 
          DATA   0
 LSTD3    DATA   20HADDRESS UNSPECIFIED 
          IFCARD 4
          IFTEST NE,IP.TRAP,0,3 
 LSTDA    DATA   1H 
          DATA   20HDEBUG ENTRY USED -- 
 LSTDA1   CON    0,0,0
 IC       IFCARD
 LSTCG    DATA   1H 
          DATA   20HCAPSULE LENGTH -- 
 LSTCG1   DATA   1H 
          CON    0
 IC       ENDIF 
 SEG      IFCARD
 LSTE     DATA   30H          CM BLANK COMMON FWA 
 LSTE1    DATA   10H
          CON    0
 LSTF     DATA   1H 
          DATA   10HOVCAP 
 LSTF1    DATA   1H 
          DATA   10HGROUP 
 LSTF2    DATA   1H 
          DATA   20HWRITTEN TO FILE 
 LSTF3    DATA   1H 
          CON    0
 LSTG     DATA   1H 
          DATA   20HOVCAP LENGTH -- 
 LSTG1    DATA   1H 
          CON    0
 LSTH     CON    0           SAVE AREA FOR INDEX INTO *TPGM*
 LSTH1    CON    0           SAVE AREA FOR ENTRY POINT COUNT
 LSTH2    DATA   1H 
          DATA   30HPROGRAM ENTRY POINTS -- 
 LSTH2A   DATA   1H 
          DATA   1H 
          CON    0
          IFTEST NE,IP.MECS,0 
 LSTZ     DATA   30H          ECS BLANK COMMON FWA
 LSTZ1    DATA   10H
          CON    0
 SEG      ENDIF 
 LSTERR   DATA   C/     ********* ERROR SUMMARY/
          RELOC  ON 
 LERR     TITLE  LOAD MAP - LIST ERRORS.
**        LERR - LIST ERRORS. 
* 
*              THIS ROUTINE IS ALWAYS CALLED.  IF A MAP IS NOT SELECTED,
*         IT PLACES ERROR MESSAGES IN THE DAYFILE.  OTHERWISE, THE
*         ERRORS, IF ANY, ARE PLACED IN THE MAP, AFTER THE STATISTICS.
* 
*              IT DOES THE FOLLOWING:                                          .
* 
*         1)   ERROR INDICATOR MESSAGES ARE MODIFIED DEPENDING ON 
*              WHETHER OR NOT A MAP IS BEING WRITTEN. 
* 
  
 LERR     PS                 ENTRY/EXIT 
          SA1    MAPFLAG
          SA4    FE          (X0) = FATAL ERROR FLAG
          SA5    NE          (X5) = NON-FATAL ERROR FLAG
          BX0    X4 
          IX4    X4+X5
          ZR     X4,LERR     EXIT IF NO ERRORS
          NZ     X1,LERR1    IF MAP IS BEING WRITTEN
          MX7    0           MODIFY GENERAL ERROR MESSAGES
          SA7    FEMESS1
          SA7    NEMESS1
          EQ     LERR3
  
**        2)   IF A MAP IS BEING WRITTEN, THE ERROR HEADER LINE IS
*              WRITTEN.  ALSO, THE APPROPRIATE ERROR INDICATORS ARE 
*              PLACED IN THE DAYFILE WHICH REFER TO THE MAP.
* 
  
 LERR1    PRINT  LSTERR,3    PRINT ERROR HEADER IN MAP
          SA1    VISIBLE
          NZ     X1,LERR1A   IF MAP IS VISIBLE
          MX6    0           REMOVE *SEE MAP* AS THE MAP IS INVISIBLE 
          SA6    FEMESS1
          SA6    NEMESS1
 LERR1A   ZR     X5,LERR2    IF NO NON-FATAL ERRORS 
          MESSAGE NEMESS,RCL
 LERR2    ZR     X0,LERR3    IF NO FATAL ERRORS 
          MESSAGE FEMESS,RCL
  
**        3)   EACH ENTRY FROM THE ERRORS TABLE *TERR* IS FETCHED, AND
*              THE APPROPRIATE ERROR ROUTINE (SEE BELOW) IS ENTERED.
* 
*              IF THIS IS A USER-CALL LOAD, THE APPROPRIATE ERROR NUMBER
*              IS SAVED FOR THE USER CALL REPLY.  THE NUMBER TO BE SAVED
*              IS THE FIRST FATAL ERROR NUMBER, UNLESS THERE ARE NO 
*              FATAL ERRORS, IN WHICH CASE, IT IS THE FIRST NON-FATAL 
*              ERROR NUMBER.
  
 LERR3    SA1    TERR        (X5) = NEXT *TERR* ENTRY 
          SA2    A1+B1
          SX6    B1 
          SX7    X1+B1
          ZR     X2,LERR     EXIT IF NO MORE *TERR* ENTRIES 
          SA5    X1 
          SA7    A1          ADVANCE TABLE FWA
          IX6    X2-X6       REDUCE TABLE LENGTH
          SA6    A2 
          SB2    X5          SET ERROR ROUTINE ADDRESS
          ZR     X5,LERR3    IF ONE OF THE EMPTY ENTRIES
 IU       IFUSER
          SA1    ERRNUM      FETCH LAST STORED ERROR NUMBER 
          BX3    X5          NEW ERROR NUMBER TO UPPER 12 BITS
          LX3    30 
          LX1    59-11
          ZR     X1,LERR4    IF NO NUMBER STORED YET
          PL     X1,LERR5    IF A FATAL ERROR NO. ALREADY STORED
          NG     X3,LERR5    IF THIS IS A NON-FATAL ERROR NO. 
 LERR4    MX6    12          STORE THIS ERROR NUMBER
          BX6    X6*X3
          LX6    12 
          SA6    A1 
 LERR5    BSS    0
 IU       ENDIF 
          BR     B2          GO TO ERROR ROUTINE
  
*         ROUTINES WHICH HAVE ONLY ONE MESSAGE TO OUTPUT SHOULD NORMALLY
*         RETURN HERE.  THE FOLLOWING CONDITIONS MUST EXIST - 
* 
*         (B1) = 1. 
*         (X0) = FWA OF MESSAGE.
*         (X5) = *TERR* ENTRY (SAME AS PASSED TO ROUTINE).
  
 EPR      RJ     ERROUT      OUTPUT PRIMARY MESSAGE 
  
*         ROUTINES WHICH HAVE MORE THAN ONE MESSAGE TO OUTPUT MUST CALL 
*         *ERROUT* THEMSELVES TO PROCESS THE PRIMARY (FIRST) MESSAGE. 
*         THESE ROUTINES RETURN TO THE FOLLOWING LOCATION.
  
 EPR1     EQ     LERR3       PROCESS NEXT ERROR 
  
          RELOC  OFF
 IC       IFCARD
 FEMESS   DATA   30H         FATAL LOADER ERROR - 
 FEMESS1  DATA   C* SEE MAP*
 NEMESS   DATA   30H     NON-FATAL LOADER ERRORS -
 NEMESS1  DATA   C* SEE MAP*
 IC       ENDIF 
 IU       IFUSER
 FEMESS   DATA   30HFATAL LOADER USER CALL ERROR -
 FEMESS1  DATA   C* SEE MAP*
 NEMESS   DATA   30HNONFTL LOADER USER CALL ERRORS
 NEMESS1  DATA   C*-SEE MAP*
 IU       ENDIF 
          RELOC  ON 
 ERROUT   SPACE  4,8
**        ERROUT - OUTPUT PRIMARY MESSAGE.
* 
*              THIS ROUTINE PLACES THE PRIMARY (FIRST) LINE OF AN ERROR 
*         IN EITHER THE MAP OR THE DAYFILE.  IF IT IS TO GO TO THE
*         DAYFILE, THE ERROR INDICATOR MESSAGE IS SENT FIRST. 
* 
*         ENTRY  (X0) = FWA OF MESSAGE. 
*                (X5) = *TERR* ENTRY. 
*         USES   X - 0, 1, 2, 7.
*                B - NONE.
*                A - 2. 
*         CALLS  ERRLINE, MSG=. 
  
  
 ERROUT   PS                 ENTRY/EXIT 
          SA2    MAPFLAG
          BX7    X5          CHECK ERROR TYPE 
          LX7    30 
          SX1    FEMESS      (X1) = GENERAL MESSAGE ADDRESS 
          PL     X7,ERROUT1  IF FATAL ERROR 
          SX1    NEMESS 
 ERROUT1  NZ     X2,ERROUT2  IF MAP BEING WRITTEN 
          SA3    NE          DONT ISSUE GENERAL MSG IF ALL ERRS FE
          ZR     X3,ERROUT3 
          MESSAGE X1,RCL     ISSUE GENERAL MESSAGE TO DAYFILE 
          EQ     ERROUT3
  
 ERROUT2  PRINT  (=C*  *)          SKIP ONE LINE
 ERROUT3  BX0    -X0         FWA IS EITHER -(X0) OR -(X0)+1 
          RJ     ERRLINE     OUTPUT PRIMARY MESSAGE 
          EQ     ERROUT      EXIT 
 ERRLINE  SPACE  4,8
**        ERRLINE - OUTPUT MESSAGE. 
* 
*              THIS ROUTINE PLACES ANY MESSAGE TO EITHER THE DAYFILE
*         OR THE MAP, AS APPROPRIATE. 
* 
*         ENTRY  (X0) = FWA OF MESSAGE. 
*                (IF (X0)<0 THEN FWA OF MAP MESSAGE IS -(X0), 
*                  AND FWA OF DAYFILE MESSAGE IS -(X0)+1).
*         USES   X - 1, 2, 6, 7.
*                B - NONE.
*                A - 1, 2, 6, 7.
*         CALLS  MSG=, WBL, WOF.
  
  
 ERRLINEX EQ     *+1S17      EXIT 
 ERRLINE  EQ     *+1S17      ENTRY
          SX7    X0          (X7) = FWA FOR DAYFILE MESSAGE 
          PL     X0,ERRLINE1  IF NOT PRIMARY MESSAGE
          BX0    -X0         (X0) = FWA FOR MESSAGE TO MAP
          SX7    X0+B1
 ERRLINE1 SA2    MAPFLAG
          SA1    VISIBLE     WAS MADE SMALL ENOUGH FOR INTEGER MULTIPLY 
          IX6    X1*X2        BY THE *CX* WHEN SAVED
          NZ     X6,ERRLINE2 IF MAP SELECTED AND IS VISIBLE, SKIP DFM 
          MESSAGE  X7,RCL 
          SA2    A2          RESTORE X2 (A2 INTACT) 
          ZR     X2,ERRLINE  RETURN IF MAP IS NOT BEING PRODUCED
  
 ERRLINE2 R=     X0,X0-1     SAVE WORD AT FWA-1 OF MESSAGE
          SA1    X0          AND INSERT WORD OF BLANKS
          BX7    X1 
          SA2    =10H 
          SA7    ERRLINES 
          BX7    X2 
          SA7    A1 
          PRINT  X0          WRITE LINE 
          SA1    ERRLINES 
          BX7    X1          RESTORE WORD AT FWA-1
          SA7    X0 
          RJ     ERRLINEX    RETURN (CLEAR INSTRUCTION STACK) 
  
 ERRLINES CON    0
 VISIBLE  CON    1           MAP IS VISIBLE BY DEFAULT
 PROG     SPACE  4,8
**        PROG - SHOW LAST PROGRAM READ.
* 
*              THIS ROUTINE OUTPUTS THE COMMONLY-USED MESSAGE SHOWING 
*         THE LAST PROGRAM READ AT THE TIME OF THE ERROR. 
* 
*         ENTRY  (X5) = *TERR* ENTRY. 
*         USES   X - 0, 1, 2, 3, 6. 
*                B - 2, 3.
*                A - 1, 2, 6. 
*         CALLS  ERRLINE. 
  
  
 PROG     PS                 ENTRY/EXIT 
          IFCARD 3
          SA1    ABS
          SX0    ISABS       SET FOR MESSAGE INDICATING ABS LOAD
          NZ     X1,PROG1    IF ABSOLUTE LOAD 
          IFCARD 2
          SA1    SEGFLAG
          MI     X1,PROG2    IF FIRST PASS OF SEGMENT LOAD
          SA1    TBLK 
          BX3    X5          (B3) = PROGRAM INDEX IN *TBLK* 
          SB2    B1+B1       (B2) = 4 
          LX3    30 
          SX0    NOPROG      SET FOR MESSAGE IF NO PROGRAM
          SB2    B2+B2
          SB3    X3 
          LT     B3,B2,PROG1 IF (PI) < 4, NO PROGRAMS LOADED
          SA2    X1+B3       FETCH PROGRAM NAME 
          MX3    42 
          SX0    ISPROG      SET FOR MESSAGE WITH PROGRAM NAME
          BX6    X2*X3
          SA6    ISPROG1     STORE NAME IN MESSAGE
 PROG1    RJ     ERRLINE     OUTPUT MESSAGE 
          EQ     PROG        EXIT 
  
 SEG      IFCARD
 PROG2    BX3    X5 
          SX0    NOPROG 
          LX3    30 
          SA1    TSEG 
          SB3    X3          (B3) = PROGRAM INDEX IN *TSEG* 
          ZR     B3,PROG1    IF NO PROGRAMS READ YET
          SX0    ISPROG 
          MX3    42 
          SA2    X1+B3       PROGRAM NAME 
          BX6    X3*X2
          SA6    ISPROG1
          EQ     PROG1
 SEG      ENDIF 
  
          RELOC  OFF
          IFCARD 1
 ISABS    DATA   C*ABS LOAD*
 NOPROG   DATA   C*NO PROGRAMS READ YET*
 ISPROG   DATA   20HLAST PROGRAM READ - 
 ISPROG1  CON    0
          RELOC  ON 
 FILE     SPACE  4,8
**        FILE - SHOW LAST FILE ACCESSED. 
* 
*              THIS ROUTINE OUTPUTS THE COMMONLY-USED MESSAGE SHOWING 
*         THE LAST FILE ACCESSED AT THE TIME OF THE ERROR.
* 
*         ENTRY  (X5) = *TERR* ENTRY. 
*         USES   X - 0, 1, 2, 3, 6. 
*                B - 2. 
*                A - 1, 6.
*         CALLS  ERRLINE. 
  
  
 FILE     PS                 ENTRY/EXIT 
          NG     X5,FILE     EXIT IF NO FILE ACCESSED YET 
          MX2    -12
          BX3    X5          ISOLATE FILE INDEX IN *TLFN* 
          SA1    TLFN 
          LX3    12 
          SB2    X1 
          BX3    -X2*X3 
          MX6    42 
          SA1    B2+X3
          SX0    ISFILE      SET MESSAGE ADDRESS
          BX6    X6*X1
          SA6    ISFILE1
          RJ     ERRLINE     OUTPUT LINE
          EQ     FILE        EXIT 
  
          RELOC  OFF
 ISFILE   DATA   20HLAST FILE ACCESSED- 
 ISFILE1  CON    0
          RELOC  ON 
 F1TERR   SPACE  4,8
**        F1TERR - FETCH ONE WORD FROM FRONT OF *TERR*. 
* 
*         ENTRY  NONE.
*         EXIT   (X2) = (X7) = 1ST WORD REMOVED FROM *TERR*.
*                *TERR* HAS BEEN SHORTENED BY ONE WORD. 
*         USES   X - 1, 2, 6, 7.
*                B - NONE.
*                A - 1, 2, 6. 
*         CALLS  NONE.
  
  
 F1TERR   PS                 ENTRY / EXIT 
          SA1    TERR 
          SA2    X1          1ST WORD 
          SX6    X1+B1       ADVANCE FWA
          SA6    A1 
          SA1    A1+B1       SHORTEN LENGTH 
          R=     X6,X1-1
          BX7    X2 
          SA6    A1 
          EQ     F1TERR      RETURN 
 ERRORS   TITLE  LOAD MAP - ERRORS AND ERROR PROCESSING.
**        ERROR PROCESSING BY THE LOADER. 
* 
*              EACH ERROR ENCOUNTERED BY THE LOADER IS ONE OF 
*         THREE TYPES 
* 
*         1) CATASTROPIC - RESULTS IN AN IMMEDIATE MESSAGE AND ABORT. 
*         2) FATAL - RESULTS IN THE ERROR BEING RECORDED IN THE TABLE 
*            *TERR* AND AN IMMEDIATE EXIT MADE TO THE LOCATION *ABEND*
*            IN THE LOAD COMPLETION PROCESSOR.  AT THIS POINT, A MAP
*            IS WRITTEN (IF SELECTED) TO SHOW WHAT HAS HAPPENED UP TO 
*            THE POINT OF THE ERROR.  THE JOB IS THEN ABORTED UNLESS
*            LDSET(ERR=NONE) WAS SELECTED.
*         3) NON-FATAL - RESULTS IN THE ERROR BEING RECORDED IN THE 
*            TABLE *TERR*.  THE LOADING PROCESS CONTINUES.  AT LOAD 
*            COMPLETION TIME, THE ERRORS WILL SHOW UP IN THE MAP (IF
*            SELECTED).  THE JOB IS NOT ABORTED UNLESS LDSET(ERR=ALL) 
*            WAS SELECTED.
* 
*              TO ADD A NEW ERROR CHECK TO THE LOADER (I.E. WITHIN
*         *LOADER* OR *LOADU*), THE FOLLOWING MUST BE DONE:                    .
* 
*         1) SELECT A NUMBER FOR THE ERROR, UNLESS A CATASTROPIC ERROR. 
*            THE EASIEST WAY TO SEE IF A PARTICULAR NUMBER IS ALREADY 
*            BEING USED IS TO LOOK IN THE CROSS-REFERENCE TABLE OF
*            THE LISTING (IN THE *LOADM* QUAL BLOCK).  ALL OF THE 
*            NUMBERS USED SHOW UP UNDER THE ROUTINE NAMES *EPNNNN*, 
*            WHERE *NNNN* IS THE ERROR NUMBER.
* 
*                 NOTE THAT FATAL ERRORS ARE IN THE RANGE 0001_3777B, 
*            AND NON-FATAL ERRORS ARE 4001_7777B.  NUMBERS DO NOT AND 
*            SHOULD NOT ALL BE CONSECUTIVE, SINCE THE FOLLOWING 
*            CONVENTION WAS USED WHILE THE LOADER WAS BEING WRITTEN 
* 
*            (ALL NUMBERS ARE +4000B FOR NON-FATAL ERRORS)
* 
*            1-77B       RESERVED FOR ROUTINES OTHER THAN *LOADER* AND
*                        *LOADU*  (SUCH AS *LDV* AND *LDW*).
* 
*            100-177B    MISCELLANEOUS STANDARD LOADER-TYPE ERRORS NOT
*                        BELONGING IN OTHER CATAGORIES (SUCH AS 
*                        *INSUFFICIENT FL FOR LOAD*, *EMPTY LOAD*,
*                        *UNSATISFIED EXTERNALS*. 
* 
*            200-277B    SPECIFICATION ERRORS, MORE SPECIFICALLY -
*            200-207B      CARDS AND DIRECTIVES.
*            210-217B      USER CALLS - OTHER THAN SPECIFIC REQUESTS. 
*            220-267B      DURING REQUEST PROCESSING. 
*            270-277B      DURING COMPLETION. 
* 
*            300-377B    BAD LOADER INPUT, MORE SPECIFICALLY -
* 
*            300-307B      DIRECTIVES.
*            310-337B      PREFIX TABLE.
*            340-377B      OTHER TABLES.
* 
*            400-477B    SEGMENT GENERATION ERRORS -
* 
*            400-417B      DIRECTIVE ERRORS.
*            420-447B      PASS 1 ERRORS. 
*            450-477B      PASS 2 ERRORS. 
* 
*            NOTE - SYSTEM ERRORS SHOULD BE MADE OF TYPE CATASTROPIC
*                   SO THAT A MEANINGFUL DUMP IS MADE POSSIBLE FROM 
*                   THE IMMEDIATE ABORT.
* 
*         2) PLACE THE *ERROR* MACRO CALL IN THE APPROPRIATE SPOT.  SEE 
*            THE MACRO DEFINITIONS AT THE FRONT OF THE LISTING FOR A
*            DESCRIPTION OF THE MACRO FORMAT. 
* 
*         3) INSERT THE ERROR ROUTINE IN THE FOLLOWING SECTION OF CODE. 
*            THE ROUTINE MUST BE PRESENT, OR AN ASSEMBLY ERROR WILL 
*            RESULT, SINCE THE MACRO GENERATES A REFERENCE TO THE 
*            ROUTINE.  THE ROUTINE SHOULD END UP RETURNING TO EITHER
*            *EPR* OR *EPR1*. 
* 
* 
*                   ++++ ERROR LIST ++++
* 
*              THE FOLLOWING IS A LIST OF ALL FATAL AND NON-FATAL 
*         ERRORS WHICH MAY BE ISSUED BY *LOADER* OR *LOADU*.  TO REPEAT,
*         ERROR NUMBERS ABOVE 4000B INDICATE NON-FATAL ERRORS.  THE 
*         *USE* FIELD INDICATES WHETHER IT IS POSSIBLE FROM A CONTROL-
*         CARD-INITIATED LOAD, A USER-CALL LOAD, OR BOTH. 
* 
* 
*         ERROR  USE         MESSAGE PRODUCED 
* 
*          100   CU          INSUFFICIENT FL FOR LOAD 
*          101   C           EMPTY LOAD 
*          102   CU          NO TRANSFER ADDRESS
*          103   C           ATTEMPT TO LOAD MORE THAN ONE PROGRAM ON 
*                            ABS LOAD 
*          104   CU          INSUFFICIENT ECS FL FOR LOAD 
*          106   C           TRANSFER POINT NOT FOUND - (NAME)
*          107   C           INSUFFICIENT FL FOR EXECUTION
*          200   CU          ATTEMPT TO LOAD SUPPRESSED BINARY
*          202   CU          OVERLAY DIRECTIVE NOT FIRST
*          203   C           NO SUCH PROGRAM CALL NAME  - 
*          204   C           NOT CONTROL-CARD-CALLABLE  - 
*          205   C           USER NOT AUTHORIZED FOR PROGRAM -(NAME)
*          206   C           USEP INVALID FOR ABS LOAD
*          210    U          BAD REQUEST NO. IN USER CALL 
*          211    U          CANNOT PROCESS ENTRY REQUEST - PARAM 
*                            AREA OVERWRITTEN 
*          220   CU          EMPTY LOAD FILE - (FILE NAME)
*          221   CU          LOAD FILE NOT SPECIFIED
*          240   C           OVERLAY OR OVCAP CARD NOT SEPARATE SECTION 
*          241   C           SYNTAX ERROR ON OVERLAY OR OVCAP CARD
*          242   C           NO FILE SPECIFIED FOR OVERLAY
*          243   C           ILLEGAL LEVEL NUMBER 
*          244   C           PRIMARY OVERLAY NOT PRECEDED BY (0,0) OVLY 
*          245   C           2NDARY OVLY NOT PRECEDED BY ITS PRIMARY
*          246   C           INCONSISTENT FILE USAGE - (FILE NAME)
*          250   C           INSUFFICIENT FOL DIRECTORY SPACE 
*          300   C           DIRECTIVE OR UNRECOGNIZABLE INPUT IN ABS 
*                            LOAD 
*          301   CU          BAD LOADER INPUT OR DIRECTIVE SYNTAX ERROR 
*          303    U          ABSOLUTE INPUT IN USER CALL
*          304   C           ABSOLUTE INPUT IN RELOCATABLE LOAD 
*          305   C           ABS INPUT NOT (0,0) LEVEL OVERLAY
*          306   C           ABS LOAD ADR LT RA+100 
*          307    U          OVLY CARD ENCOUNTERED DURING USER CALL LOAD
*          310   CU          HARDWARE DEFICIENCY - (PROGRAM)
*          340   CU          BAD LINK BINARY TABLE
*          341    U          PROCEDURE DISALLOWED IN USER-CALL LOAD 
*          342   C           PROCEDURE CALL MUST BE SINGLE CARD LOAD
*                            SEQUENCE 
*          343   C           PROCEDURE DISALLOWED IN RELOCATABLE LOAD 
*          370   CU          CANNOT PROCESS FILES REQUEST - 1ST RECORD
*                            OF ZZZZZDF TOO BIG 
*          371   CU          CANNOT PROCESS STAT REQUEST - ILL-FORMATTED
*                            ZZZZZDG FILE 
*          400   C           UNBALANCED PARENTHESIS.
*          401   C           MISSING PARAMETER. 
*          402   C           ILLEGAL SEPARATOR. 
*          403   C           (NAME) - UNRECOGNIZABLE DIRECTIVE. 
*          404   C           INCOMPLETE PARAMETER.
*          405   C           (NAME) - USED ON LOWER LEVEL.
*          406   C           (NAME) - CONFLICTS WITH EARLIER USAGE. 
*          407   C           MORE THAN ONE ROOT SEGMENT.
*          410   C           NO ROOT SEGMENT. 
*          411   C           MORE THAN 4095 SEGMENTS. 
*          412   C           (NAME) - UNDEFINED SEGMENT.
*          422   C           SEGMENT LWA+1 GT 377777B 
*          420   C           ABS OR NEG RELOCATION NOT ALLOWED-PROG 
*                            (NAME) 
*          500   C           OVERLAY-CAPSULE DIRECTIVES INCOMPATIBLE
*          501   C           CAPSULE DIRECTIVES NOT ALL AT BEGINNING
*                            OF FIRST LOAD FILE 
*          502    U          CAPSULE DIRECTIVES DISALLOWED IN 
*                            USER-CALL LOAD 
*          503   C           ECS TEXT DISALLOWED IN CAPSULES OR OVCAPS
*          504   C           NON-STANDARD RELOCATION DISALLOWED IN
*                            CAPSULES OR OVCAPS 
*          505   C           ENCAPSULATION NOT TERMINATED BY NOGO 
*          506   C           ENCAPSULATION AND NO CAPSULES SPECIFIED
*          507   C           CAPSULE WITH NO ENTRY POINTS 
*          520   C           OVCAP DIRECTIVE ILLEGAL IF NOT IN OVERLAY
*                            GENERATION 
*          521   C           OVERLAY DIRECTIVE FOLLOWING OVCAP DIRECTIVE
*                            MUST SPECIFY (0,0) LEVEL 
*          525   CU          OVCAP BINARY NOT STATICALLY LOADABLE 
*          526    U          OVCAP DIRECTIVE ILLEGAL IN USER-CALL LOAD
*         4100   CU          UNSATISFIED EXTERNAL REF -- (NAME) 
*         4101   CU          COMMON BLOCK REDEFINITION - (NAME) 
*         4102   CU          DUPLICATE ENTRY POINT NAME - (NAME)
*         4103   CU          DUPLICATE PROGRAM NAME FROM FILE 
*         4104   CU          DUPLICATE PROGRAM NAME 
*         4105   CU          BLANK COMMON TRUNCATED 
*         4106   C           SPEC LGR BLANK COM THAN DCL AT LOWER LEVEL 
*         4107   CU          ABSOLUTE LOAD NOT FOLLOWED BY EXECUTE
*         4110   C           INTERACTIVE DEBUG IGNORED ON THIS LOAD 
*         4111   C           TRAP OVERRIDES INTERACTIVE DEBUG 
*         4200   CU          LOADER CARD ERROR - FOLLOWING CARD IGNORED 
*         4201   CU          PROGRAM NOT FOUND - (NAME) 
*         4204   C           ILLEGAL ORIGIN SPECIFICATION 
*         4205   C           NO BLANK COM AT LOWER LVL - CNNNNNN IGNORED
*         4206   C           ENTRY NAME SPECIFIED ON OVLY CARD NOT FOUND
*         4207   CU          OBJECT DIRECTIVES NOT ALLOWED
*         4210   C           FOL GENERATION - WRITING ALL BINARIES TO 
*                            SAME FILE AS MAIN OVERLAY
*         4211   C           ILLEGAL OV SPECIFICATION 
*         4220   CU          ILLEGAL LOADER REQUEST 
*         4221    U          LOAD FILE NAME FORMAT ERROR - (NAME) 
*         4222    U          NO PROGRAMS SPECIFIED ON SLOAD 
*         4224   CU          SLOAD PROGRAM NOT FOUND - (NAME) 
*         4225   CU          FORMAT ERROR ON LIBLOAD REQUEST
*         4227   CU          ENTRY ON LIBLOAD NOT FOUND - (NAME)
*         4230    U          FORMAT ERROR ON CMLOAD OR ECLOAD REQUEST 
*         4231    U          FORMAT ERROR - SATISFY REQUEST - (NAME)
*         4232   CU          FORMAT ERROR ON LIB REQUEST - (NAME) 
*         4233   CU          FORMAT ERROR ON MAP REQUEST
*         4234   CU          FORMAT ERROR ON PRESET REQUEST 
*         4235   CU          FORMAT ERROR ON USEP REQUEST - (NAME)
*         4236   CU          FORMAT ERROR ON USE REQUEST - (NAME) 
*         4237   CU          SUBST FORMAT ERROR 
*         4240   CU          FORMAT ERROR ON OMIT REQUEST - (NAME)
*         4241    U          FORMAT ERROR ON PASSLOC REQUEST             LDR0173
*         4242   C           FORMAT ERROR ON COMMON REQUEST - (NAME)
*         4271   CU          TRANSFER NAME NOT FOUND - (NAME) 
*         4272    U          TOO MANY PARAMS IN EXECUTE REQUEST 
*         4273   CU          NON-EXISTENT LIBRARY GIVEN - (LIB NAME)
*         4274   CU          LIBRARY NOT ON MASS-STORAGE - (LIB NAME) 
*         4275   CU          ILL-FORMATTED LIBRARY - (LIB NAME) 
*         4310   C           POTENTIAL HARDWARE DEFICIENCY - (PROGRAM)
*         4340   CU          TRIED TO LOAD INTO BLOCK BELOW ORIGIN - (NA
*         4341   C           TRIED TO LOAD INTO ABSOLUTE BLOCK
*         4400   C           PARAMETER NAME TRUNCATED TO 7 CHARACTERS.
*         4401   C           END CARD MISSING.
*         4402   C           (NAME) - NOT DECLARED GLOBAL.
*         4420   C           COULD NOT FIND COMMON OR GLOBAL BLOCK -NAME
*         4421   C           SATISFY IGNORED ON SEGMENT LOAD. 
*         4422   C           TRIED TO LOAD INTO BLOCK OUTSIDE SEGMENT - 
*                            (NAME) 
*         4450   C           CONFLICTING SEGMENTS CALLED BY SAME WORD.
*         4500   C           FORMAT ERROR ON EPT REQUEST
*         4501   C           FORMAT ERROR ON NOEPT REQUEST
*         4502   C           NOT ALL CAPSULE DIRECTIVES PROCESSED 
*         4503   C           EPT REQUEST IGNORED - (NAME) 
  
          SPACE  4
 EP100    SX0    =C/ FE0100***INSUFFICIENT FL FOR LOAD/ 
          RJ     ERROUT      OUTPUT PRIMARY MESSAGE 
 EP100A   RJ     PROG        OUTPUT PROGRAM NAME
 EP100B   RJ     FILE        OUTPUT FILE NAME 
          EQ     EPR1        RETURN 
  
 IC       IFCARD
          SPACE  4
 EP101    SX0    =C/ FE0101***EMPTY LOAD/ 
          SA1    FE 
          R=     X1,X1-2
          PL     X1,EPR1     DONT OUTPUT UNLESS ONLY FATAL ERROR
          EQ     EPR
  
 IC       ENDIF 
          SPACE  4
 EP102    SX0    =C/ FE0102***NO TRANSFER ADDRESS/
          EQ     EPR
  
 IC       IFCARD
          SPACE  4
 EP103    SX0    =C/ FE0103***ATTEMPT TO LOAD MORE THAN ONE PROGRAM ON A
,BS LOAD/ 
          RJ     ERROUT 
          EQ     EP100A      GO OUTPUT LAST PROGRAM AND FILE
  
 IC       ENDIF 
          SPACE  4
 EP104    SX0    =C/ FE0104***INSUFFICIENT ECS FL FOR LOAD/ 
          RJ     ERROUT 
          EQ     EP100A      GO OUTPUT PROGRAM AND FILE 
  
          SPACE  5
 IC       IFCARD
 EP106    SX0    =50H FE0106***TRANSFER POINT NOT FOUND  -
          EQ     ADDNAME1 
          SPACE  4
 EP107    SX0    =C/ FE0107***INSUFFICIENT FL FOR EXECUTION/
          EQ     EPR
  
 IC       ENDIF 
          SPACE  4
 EP200    SX0    =C/ FE0200***ATTEMPT TO LOAD SUPPRESSED BINARY/
          RJ     ERROUT 
 EP200A   RJ     PROG        OUTPUT PROGRAM NAME
          RJ     FILE        OUTPUT FILE NAME 
 EP200B   SA4    TERR        FETCH CARD IMAGE FROM *TERR* AND 
          SA1    X4          OUTPUT IT (TERMINATED BY ZERO BYTE)
          SX0    X4 
          SA5    A4+B1       *TERR* LENGTH
          MX7    0
 EP200C   MX2    -12         LOOP TO END OF THE IMAGE 
          BX3    -X2*X1 
          SA1    A1+B1
          SX7    X7+B1
          NZ     X3,EP200C
          SX6    A1          REMOVE WORDS CONTAINING IMAGE
          SA6    A4          FROM *TERR*
          IX7    X5-X7       SHORTEN *TERR* LENGTH
          SA7    A5 
          RJ     ERRLINE     OUTPUT THE IMAGE 
          EQ     EPR1        RETURN 
          SPACE  4
 EP202    SX0    =C/ FE0202***OVERLAY DIRECTIVE NOT FIRST/
          RJ     ERROUT 
          EQ     EP200A      GO OUTPUT PROGRAM, FILE, IMAGE 
  
 IC       IFCARD
          SPACE  4,6
 EP203    SX0    =50H FE0203***NO SUCH PROGRAM CALL NAME  - 
          EQ     ADDNAME1 
          SPACE  4,6
 EP204    SX0    =50H FE0204***NOT CONTROL-CARD-CALLABLE  - 
          EQ     ADDNAME1 
          SPACE  4,8
 S        IFSCOPE 
 EP205    SX0    =C/ FE0205***USER NOT AUTHORIZED FOR PROG- ......./
          EQ     ADDNAME1 
 S        ENDIF 
          SPACE  4,8
 EP206    SX0    =C/ FE0206***USEP INVALID FOR ABS LOAD/
          EQ     EPR
 IC       ENDIF 
  
 IU       IFUSER
          SPACE  4
 EP210    SX0    =50H FE0210***BAD REQUEST NO. IN USER CALL - 
          RJ     F1TERR      FETCH NUMBER FROM *TERR* 
          BX1    X2 
          RJ     COD         CONVERT NUMBER 
          R=     B2,4        STORE NUMBER IN MESSAGE
          LX6    30 
          MX2    48 
          BX6    X2*X6
          SA6    X0+B2
          EQ     EPR         GO OUTPUT MESSAGE
          SPACE  4
 EP211    SX0    =C/ FE0211***CANNOT PROCESS ENTRY REQUEST - PARAM AREA 
,OVERWRITTEN/ 
          EQ     EPR
  
 IU       ENDIF 
          SPACE  4
 EP220    SX0    =40H FE0220***EMPTY LOAD FILE  - 
          BX1    X5          FETCH FILE NAME FROM *TLFN*
          MX2    -12         USING FILE INDEX GIVEN IN *TERR* 
          SA3    TLFN 
          LX1    12 
          SB2    X3 
          BX1    -X2*X1 
          SA4    B2+X1
          MX2    42 
          BX6    X4*X2       PLACE NAME IN MESSAGE
          R=     A6,X0+3
          EQ     EPR         GO OUTPUT MESSAGE
  
          SPACE  4
 EP221    SX0    =C/ FE0221***LOAD FILE NOT SPECIFIED / 
          EQ     EPR
  
 IC       IFCARD
          SPACE  4
 EP246    SX0    =50H FE0246***INCONSISTENT FILE USAGE   -
          EQ     ADDNAME1 
          SPACE  4
 EP250    SX0    =C/ FE0250***INSUFFICIENT FOL DIRECTORY SPACE/ 
          EQ     EPR
          SPACE  4
 EP300    SX0    =C/ FE0300***DIRECTIVE OR UNRECOGNIZABLE INPUT IN ABS L
,OAD -             /
          RJ     F1TERR      FETCH 1ST 10 CHARS OF DIRECTIVE FROM 
          R=     A7,X0+6     *TERR* AND PLACE IN MESSAGE
          RJ     ERROUT      OUTPUT MESSAGE 
          EQ     EP100B      GO OUTPUT FILE 
  
 IC       ENDIF 
          SPACE  4
 EP301    SX0    =C/ FE0301***BAD LOADER INPUT OR DIRECTIVE SYNTAX ERROR
,/
          RJ     ERROUT      OUTPUT PRIMARY MESSAGE 
          RJ     F1TERR      FETCH 2ND WORD FROM *TERR* ENTRY 
          BX6    X5          SAVE HEADER WORD FROM *TERR* 
          SA6    EP301SV
          SA7    A6+B1       SAVE 2ND WORD
          IFCARD 3
          IFNOS  2
          SA2    XEQOF
          NZ     X2,EP301G   IF EXECUTE-ONLY FILE 
          LX7    30          SHOW LAST TABLE NUMBER 
          SX1    X7 
          NZ     X1,EP301A   IF NOT AT BEGINING OF RECORD 
          SX0    EP301M2A 
          RJ     ERRLINE
          EQ     EP301B 
  
 EP301A   MX0    -12         CONVERT TABLE NUMBER 
          RJ     C10D 
          BX6    -X0*X6 
          LX6    48 
          SA6    EP301M2B+3 
          SX0    EP301M2B 
          RJ     ERRLINE
 EP301B   SA1    EP301SV+1
          SA5    EP301M3     INSERT WORD COUNT INTO MESSAGE 
          SX1    X1 
          MX0    -24
          RJ     CDD= 
          BX5    X0*X5
          BX6    -X0*X6 
          IX6    X5+X6
          SA6    A5 
          SX0    A5          OUTPUT MESSAGE 
          MX5    0           INITIALIZE FETCH COUNT 
          RJ     ERRLINE
 EP301C   SA4    EP301SV+1   START WORD OUTPUT LOOP 
          SX1    X4 
          IX3    X1-X5
          ZR     X3,EP301E   IF ALL WORDS DONE
          RJ     F1TERR      FETCH NEXT WORD
          BX4    X2 
          SX5    X5+B1       ADVANCE FETCH COUNT
          MX3    30 
          SA1    =10H              INSERT UPPER 30 BITS CODED 
          BX1    X3*X1
          MX2    -6 
          BX0    X3*X4
          LX0    30 
          BX1    X1+X0
          BX2    -X2*X1      IF THE UPPER 30 BITS RESULT IN ANY 
          BX6    X1          TRAILING-ZERO-CHARS, THEY ARE
          LX4    30          REMOVED SO AS TO AVOID CUTTING THE 
          NZ     X2,EP301D   LINE IMAGE SHORT 
          RJ     SFN= 
 EP301D   SA6    EP301M4+2   STORE UPPER 30 BITS CODED
          BX7    X3*X4       FORM LOWER 30 BITS CODED (END LINE)
          SA7    A6+B1       STORE LOWER 30 BITS CODED
          BX0    X3*X4       SAVE LOWER 30 BITS FOR CONVERSION
          BX1    -X3*X4      UPPER 30 BITS IN LOW-ORDER POSITION
          RJ     C10D        CONVERT TO OCTAL (NO ZERO SUPPRESS)
          SA6    EP301M4     STORE UPPER 30 BITS OCTAL
          BX1    X0          CONVERT LOWER 30 BITS TO OCTAL 
          LX1    30 
          RJ     C10D 
          SA6    A6+B1       STORE LOWER 30 BITS OCTAL
          SX0    A6-B1       OUTPUT IMAGE OF THIS WORD
          RJ     ERRLINE
          SX0    EP301M5     PREPARE FOR EOR MESSAGE IF NEEDED
          EQ     EP301C      LOOP 
  
 EP301E   PL     X4,EP301F   IF NO EOR INDICATOR
          RJ     ERRLINE     OUTPUT EOR MESSAGE 
 EP301F   SA5    EP301SV     RESTORE *TERR* 1ST WORD OF ENTRY 
          EQ     EP100A      GO OUTPUT PROGRAM AND FILE 
  
 IC       IFCARD
 IN       IFNOS 
  
 EP301G   SX2    X7          THE BAD FILE IS EXECUTE-ONLY, SO DO NOT
          SA1    TERR         DISPLAY ANYTHING TO TELL OF THE CONTENTS
          IX6    X1+X2       SHORTEN *TERR* BY NUMBER OF DATA WORDS 
          SA6    A1          ADVANCE FWA
          SA3    A1+B1
          IX6    X3-X2
          SA6    A1+B1       SHORTEN LENGTH 
          SX0    EP301M6     INDICATE EXEC-ONLY FILE AND THUS NO OUTPUT 
          RJ     ERRLINE
          SA5    EP301SV     RESTORE *TERR* 1ST WORD OF ENTRY 
          EQ     EP100B      GO OUTPUT FILE NAME ONLY 
  
 IN       ENDIF 
 IC       ENDIF 
  
          RELOC  OFF
 EP301SV  CON    0,0         SAVE AREA
 EP301M2A DATA   C/  **AT BEGINNING OF RECORD**/
 EP301M2B DATA   30H  LAST GOOD TABLE READ WAS -- 
          CON    0
 EP301M3  DATA   C*   1ST   N WORDS OF GARBAGE AS FOLLOWS -*
 EP301M4  CON    0,0,0,0
 EP301M5  DATA   C/ **EOR**/
  
          IFCARD 2
          IFNOS  1
 EP301M6  DATA   C*  ON EXECUTE-ONLY FILE - OUTPUT SUPPRESSED*
  
          RELOC  ON 
  
 IU       IFUSER
          SPACE  4
 EP303    SX0    =C/ FE0303***ABSOLUTE INPUT IN USER CALL/
          RJ     ERROUT 
          EQ     EP100A      GO OUTPUT PROGRAM AND FILE 
  
 IU       ENDIF 
 IC       IFCARD
          SPACE  4
 EP304    SX0    =50H FE0304***ABS INPUT IN RELOCATABLE LOAD
          RJ     F1TERR      GET ABSOLUTE PROGRAM NAME
          R=     A7,X0+4     PUT IN MESSAGE 
          RJ     ERROUT 
          EQ     EP100A      GO OUTPUT PROGRAM AND FILE 
          SPACE  4
 EP305    SX0    =C/ FE0305***ABS INPUT NOT (0,0) LEVEL OVERLAY/
          RJ     ERROUT 
          EQ     EP100B      GO OUTPUT FILE 
          SPACE  4
 EP306    SX0    =C/ FE0306***ABS INPUT LOAD ADR LT RA+100/ 
          RJ     ERROUT 
          EQ     EP100B      GO OUTPUT FILE 
  
 IC       ENDIF 
          IFUSER 3
          SPACE  4
EP307  SX0  =C/ FE0307***OVERLAY CARD ENCOUNTERED DURING USER CALL LOAD/
          EQ     EPR
          SPACE  4
 EP310    SX0    =50H FE0310***HARDWARE DEFICIENCY, PROGRAM-
          R=     B2,4 
 EP310Z   BX6    X5 
          MX3    42 
          SA6    EP301SV
          RJ     F1TERR      FETCH 2ND WORD FROM *TERR* ENTRY 
          SA0    X2          (A0) = ERROR BITS
          BX7    X3*X2       PROGRAM NAME TO PRIMARY MESSAGE
          SA7    X0+B2
          RJ     ERROUT      OUTPUT PRIMARY MESSAGE 
          SX0    =C*  OPTIONS SPECIFIED BY PROGRAM ARE NOT PRESENT -* 
          RJ     ERRLINE
          SX5    A0          (X5) = ERROR BITS (BIT 0 FOR CMU,
          LX5    -1          BIT 1 FOR INT. MULT., BIT 2 FOR XJ)
          PL     X5,EP310A
          SX0    =C*    CMU INSTRUCTIONS* 
          RJ     ERRLINE
 EP310A   LX5    -1 
          PL     X5,EP310B
          SX0    =C*    INTEGER MULTIPLY* 
          RJ     ERRLINE
 EP310B   LX5    -1 
          PL     X5,EP310C
          SX0    =C*    CENTRAL EXCHANGE JUMP*
          RJ     ERRLINE
 EP310C   SA5    EP301SV     RESTORE 1ST WORD OF *TERR* ENTRY 
          EQ     EP100A      GO OUTPUT PROGRAM AND FILE 
  
  
  
  
 EP340    RJ     F1TERR      FETCH BINARY TABLE NAME INDICATOR
          MX3    6*4
          SX0    =C* FE0340///BAD XXXXX BINARY TABLE* 
          SA1    X2+BINTBL   GET BINARY TABLE NAME
          SA4    X0+B1       MODIFY MESSAGE 
          BX4    X3*X4
          BX6    X1+X4
          SA6    A4 
          RJ     ERROUT      OUTPUT PRIMARY MESSAGE 
          EQ     EP100A      GO OUTPUT PROGRAM AND FILE 
  
          RELOC  OFF
 BINTBL   DATA   R* LINK *
          RELOC  ON 
  
          SPACE  4
 IU       IFUSER
 EP341    SX0    =C/ FE0341***PROCEDURE DISALLOWED IN USER-CALL LOAD/ 
          EQ     EPR
 IU       ENDIF 
          SPACE  4
 IC       IFCARD
 EP342    SX0    =C/ FE0342***PROCEDURE CALL MUST BE SINGLE CARD LOAD SE
,QUENCE/
          EQ     EPR
          SPACE  4
 EP343    SX0    =C/ FE0343***PROCEDURE DISALLOWED IN RELOCATABLE LOAD/ 
          EQ     EPR
 IC       ENDIF 
          SPACE  4,5
 EP370    SX0    =C/ FE0370***CANNOT PROCESS FILES REQUEST - 1ST RECORD 
,OF ZZZZZDF TOO BIG/
          EQ     EPR
          SPACE  4
 EP371    SX0    =C/ FE0371***CANNOT PROCESS STAT REQUEST - ILL-FORMATTE
,D ZZZZZDG FILE/
          EQ     EPR
          SPACE  4,8
 SEG      IFCARD
 EP420    SX0    =60H FE0420***ABS OR NEG RELOCATION NOT ALLOWED-PROG  .
,...... 
          RJ     F1TERR      FETCH PROGRAM NAME 
          SA7    X0+5 
          EQ     EPR
 SEG      ENDIF 
          SPACE  4
 SEG      IFCARD
 EP422    SX0    =50H FE0422***SEGMENT LWA+1 GT 377777B ----
          EQ     ADDNAME1    GO INSERT SEGMENT NAME 
 SEG      ENDIF 
          SPACE  4
 IC       IFCARD
          SPACE  4
 EP500    SX0    =C/ FE0500***OVERLAY-CAPSULE DIRECTIVES INCOMPATIBLE/
          EQ     EPR
          SPACE  4
 EP501    SX0    =C/ FE0501***CAPSULE DIRECTIVES NOT ALL AT BEGINNING OF
, FIRST LOAD FILE/
          EQ     EPR
 IC       ENDIF 
 IU       IFUSER
          SPACE  4
 EP502    SX0    =C/ FE0502***CAPSULE DIRECTIVES DISALLOWED IN USER-CALL
, LOADS/
          EQ     EPR
 IU       ENDIF 
 IC       IFCARD
          SPACE  4
 EP503    SX0    =C/ FE0503***ECS TEXT DISALLOWED IN CAPSULES OR OVCAPS/
          EQ     EPR
          SPACE  4
 EP504    SX0    =C/ FE0504***NONSTANDARD RELOCATION AT ADDRESS 
,          /
          RJ     F1TERR 
          SA7    X0+5 
          EQ     EPR
          SPACE  4
 EP505    SX0    =C/ FE0505***ENCAPSULATION NOT TERMINATED BY NOGO/ 
          EQ     EPR
          SPACE  4
 EP506    SX0    =C/ FE0506***ENCAPSULATION AND NO CAPSULES SPECIFIED/
          EQ     EPR
          SPACE  4
 EP507    SX0    =C/ FE0507***CAPSULE WITH NO ENTRY POINTS/ 
          EQ     EPR
          SPACE  4
 EP520    SX0    =C/ FE0520***OVCAP DIRECTIVE ILLEGAL IF NOT IN OVERLAY 
,GENERATION/
          EQ     EPR
          SPACE  4,8
 IC       ENDIF 
 EP525    SX0    =C/ FE0525***OVCAP BINARY NOT STATICALLY LOADABLE/ 
          RJ     ERROUT 
          SX0    =30HCAPSULE/OVCAP ---- 
          EQ     EP4103A     GO OUTPUT MESSAGE WITH NAME
          SPACE  4,8
 IU       IFUSER
 EP526    SX0    =C/ FE0526***OVCAP DIRECTIVE ILLEGAL IN USER-CALL LOAD/
          EQ     EPR
          SPACE  4,8
 IU       ENDIF 
 EP4100   SX0    =50H NE4100///  UNSATISFIED EXTERNAL REF --
          EQ     ADDNAME1 
          SPACE  4
 EP4101   SX0    =50H NE4101///COMMON BLOCK REDEFINITION -
          RJ     F1TERR      FETCH BLOCK NAME 
          R=     A7,X0+4
          RJ     ERROUT 
          EQ     EP100A      OUTPUT PROGRAM AND FILE
          SPACE  4
 EP4102   SX0    =50H NE4102///DUPLICATE ENTRY POINT NAME - 
          R=     B2,4        FETCH NAME FROM *TERR* 
          RJ     F1TERR 
          MX3    42 
          BX4    -X3*X7      (X4) = PI
          BX7    X3*X7       (X7) = ENTRY POINT NAME
          SA7    X0+B2
          SA1    TBLK 
          SB3    X4 
          SA2    X1+B3       GET PROGRAM NAME 
          SX1    EP4102A     *PROGRAM NAME ------          *
          BX6    X3*X2
          R=     A6,X1+2     PUT PROGRAM NAME IN MESSAGE
          RJ     ERROUT      OUTPUT PRIMARY MESSAGE 
          SX0    EP4102A     *PROGRAM NAME ------          *
          RJ     ERRLINE     PRINT OUT PROGRAM NAME 
          EQ     EP100B      OUTPUT FILE NAME 
          SPACE  1
          RELOC  OFF
 EP4102A  DATA   30HPROGRAM NAME ------ 
          RELOC  ON 
          SPACE  4
 EP4103   SX0    =C* NE4103///DUPLICATE PROGRAM NAME FROM FILE* 
          RJ     ERROUT 
          SX0    =30HPROGRAM SKIPPED ---
 EP4103A  SB2    B1+B1
          RJ     F1TERR      FETCH PROGRAM NAME FROM *TERR* 
          SA7    X0+B2
          RJ     ERRLINE     OUTPUT MESSAGE WITH NAME 
          EQ     EP100B      GO OUTPUT FILE NAME
          SPACE  4
 EP4104   SX0    =C* NE4104///DUPLICATE PROGRAM NAME* 
          RJ     ERROUT 
          SX0    =30HPROGRAM LOADED ----
          EQ     EP4103A     GO OUTPUT MESSAGE WITH NAME
          SPACE  4
 EP4105   RJ     F1TERR      FETCH CM OR ECS INDICATOR
          MX3    6*3
          SX0    =C* NE4105/// CM BLANK COMMON TRUNCATED BY XXXXXXB WORD
,S* 
          SA1    X2+BCTYPE   * CM* OR *ECS* 
          SA4    X0+B1       MODIFY MESSAGE 
          BX4    -X3*X4 
          IX6    X1+X4
          SA6    A4 
          AX2    18          GET AMOUNT TRUNCATED 
          BX1    X2 
          RJ     COD
          MX7    36 
          LX6    24 
          BX6    X7*X6
          R=     A4,X0+4
          BX4    -X7*X4 
          BX6    X6+X4
          SA6    A4          INSERT IN MESSAGE
          EQ     EPR         OUTPUT MESSAGE 
  
          RELOC  OFF
 BCTYPE   DATA   3L CM
          DATA   3LECS
          RELOC  ON 
          SPACE  4
          IFCARD 3
 EP4106   SX0    =C* NE4106///SPECIFIED LARGER BLANK COMMON THAN DECLARE
,D AT LOWER LEVEL*
          EQ     EPR
          SPACE  4
 EP4107   SX0    =C* NE4107///ABSOLUTE LOAD NOT FOLLOWED BY EXECUTE * 
          EQ     EPR
          SPACE  4,8
 IC       IFCARD
 EP4110   SX0    =C* NE4110///INTERACTIVE DEBUG IGNORED ON THIS LOAD* 
          EQ     EPR
          SPACE  4,8
 EP4111   SX0    =C* NE4111///TRAP OVERRIDES INTERACTIVE DEBUG* 
          EQ     EPR
 IC       ENDIF 
          SPACE  4
 EP4200   SX0    =C* NE4200///LOADER CARD ERROR - FOLLOWING CARD IGNORED
,*
          RJ     ERROUT 
          EQ     EP200B      GO OUTPUT IMAGE
          SPACE  4,8
 EP4201   SX0    =C* NE4201///PROGRAM NOT FOUND - .......*
          RJ     F1TERR 
          R=     A7,X0+3
          EQ     EPR
          SPACE  4
 IC       IFCARD
 EP4204   SX0    =C* NE4204///ILLEGAL ORIGIN SPECIFICATION* 
          EQ     EPR
          SPACE  4
 EP4205   SX0    =C* NE4205///NO BLANK COMMON AT LOWER LEVEL - CNNNNNN I
,GNORED*
          EQ     EPR
          SPACE  4
 EP4206   SX0    =60H NE4206///ENTRY NAME ON OVERLAY CARD NOT FOUND - 
          R=     B2,5 
          EQ     ADDNAME
 IC       ENDIF 
          SPACE  4
 EP4207   SX0    =C* NE4207///OBJECT DIRECTIVES NOT ALLOWED*
          RJ     ERROUT 
          EQ     EP200A      GO OUTPUT PROGRAM, FILE, IMAGE 
 IC       IFCARD
          SPACE  4
 EP4210   SX0    =C* NE4210///FOL GENERATION - WRITING BINARY TO SAME FI
,LE AS MAIN OVERLAY*
          EQ     EPR
          SPACE  4
 EP4211   SX0    =C* NE4211///ILLEGAL OV SPECIFICATION* 
          EQ     EPR
 IC       ENDIF 
          SPACE  4
 EP4220   SX0    =C* NE4220///ILLEGAL LOADER REQUEST* 
          RJ     ERROUT      OUTPUT PRIMARY MESSAGE 
          MX0    42          FETCH NEXT *TERR* WORD 
          RJ     F1TERR      BITS 0-12 = REQUEST TYPE EXPECTED
                                     BITS 18-59 = REQUEST NAME
          BX1    X0*X2       REQUEST NAME 
          BX0    -X0*X2      SAVE TYPE
          RJ     /MISC/SFN   SPACE FILL NAME
          BX2    X0 
          SX0    =40H           NOT ALLOWED WITHIN
          SA3    X0 
          SA6    A3          INSERT NAME IN 2ND MESSAGE 
 IC       IFCARD
          LX2    59-3        BIT 3 SET IF OBJECT DIRECTIVE
          SA1    =C*OBJ DIR*
          NG     X2,EP4220A 
          LX2    3-1         BIT 1 SET IF ABS LOAD CONTROL CARD 
          SA1    =C*ABS LOAD* 
          NG     X2,EP4220A 
          SA1    =C*REL LOAD*      OTHERWISE REL LOAD CONTROL CARD
 IC       ENDIF 
 IU       IFUSER
          LX2    59-3        BIT 3 SET IF OBJECT DIRECTIVE
          SA1    =C*OBJ DIR*
          NG     X2,EP4220A 
          SA1    =C*USERCALL*      OTHERWISE USER CALL REQUEST
 IU       ENDIF 
 EP4220A  BSS    0
          BX6    X1          INSERT REQUEST TYPE
          R=     A6,X0+3
          RJ     ERRLINE     OUTPUT 2ND MESSAGE 
          EQ     EPR1        RETURN 
  
 IU       IFUSER
          SPACE  4
 EP4221   SX0    =50H NE4221///LOAD FILE NAME FORMAT ERROR -
          EQ     ADDNAME1 
          SPACE  4
 EP4222   SX0    =C* NE4222///NO PROGRAMS SPECIFIED ON SLOAD* 
          EQ     EPR
  
 IU       ENDIF 
          SPACE  4
 EP4224   SX0    =50H NE4224///SLOAD PROGRAM NOT FOUND  - 
          EQ     ADDNAME1 
          SPACE  4
 EP4225   SX0    =C* NE4225///FORMAT ERROR ON LIBLOAD REQUEST*
          RJ     ERROUT      OUTPUT PRIMARY MESSAGE 
          SX0    =20HBAD NAME-
          RJ     F1TERR      FETCH ONE WORD FROM *TERR* 
          ZR     X2,EPR1     IF NO NAME TO DISPLAY
          SA7    X0+B1       INSERT NAME IN MESSAGE 
          RJ     ERRLINE     OUTPUT MESSAGE 
          EQ     EPR1        RETURN 
          SPACE  4
 EP4227   SX0    =50H NE4227///ENTRY ON LIBLOAD NOT FOUND - 
          EQ     ADDNAME1 
  
 IU       IFUSER
          SPACE  4
 EP4230   SX0    =C* NE4230///FORMAT ERROR ON CMLOAD OR ECLOAD REQUEST* 
          EQ     EPR
          SPACE  4
 EP4231   SX0    =50H NE4231///FORMAT ERR - SATISFY REQUEST-
          EQ     ADDNAME1 
 IU       ENDIF 
          SPACE  4
 EP4232   SX0    =50H NE4232///FORMAT ERROR ON LIB REQUEST -
          EQ     ADDNAME1 
  
          SPACE  4
 EP4233   SX0    =C* NE4233///FORMAT ERROR ON MAP REQUEST*
          RJ     ERROUT 
          EQ     EP100A      OUTPUT PROG AND LFN, IF APPLICABLE 
  
          SPACE  4
 EP4234   SX0    =C* NE4234///FORMAT ERROR ON PRESET REQUEST* 
          RJ     ERROUT 
          EQ     EP100A      OUTPUT PROG AND LFN, IF APPLICABLE 
          SPACE  4
 EP4235   SX0    =50H NE4235///FORMAT ERROR ON USEP REQUEST-
          EQ     ADDNAME1 
          SPACE  4
 EP4236   SX0    =50H NE4236///FORMAT ERROR ON USE REQUEST -
          EQ     ADDNAME1 
          SPACE  4
 EP4237   SX0    =50H NE4237///SUBST FORMAT ERROR,
          RJ     F1TERR      FETCH 1ST OF 2 NAMES IN *TERR* 
          SB3    B1+B1
          BX1    X2 
          RJ     SFN=        SPACE FILL 
          SB3    B3+B1
          R=     X1,700B     ADD A -
          IX6    X6-X1
          SA6    X0+B3       INSERT IN MESSAGE
          EQ     ADDNAME1    GO GET NEXT NAME AND OUTPUT MESSAGE
          SPACE  4
 EP4240   SX0    =50H NE4240///FORMAT ERROR ON OMIT REQUEST-
          EQ     ADDNAME1 
 IU       IFUSER
          SPACE  4
 EP4241   SX0    =C* NE4241///FORMAT ERROR ON PASSLOC REQUEST*
          EQ     EPR
 IU       ENDIF 
          SPACE  4
 IC       IFCARD
 EP4242   SX0    =50H NE4242///FORMAT ERR - COMMON REQUEST -
          EQ     ADDNAME1 
 IC       ENDIF 
 IU       IFUSER
  
          SPACE  4
 EP4270   SX0    =40H NE4270///BAD LFN ON NOGO  - 
          R=     B2,3        (B2) = POSITION IN MESSAGE TO STORE
 IU       ENDIF 
          SPACE  4
 ADDNAME  RJ     F1TERR      FETCH NAME FROM *TERR* 
          SA7    X0+B2       STORE NAME IN MESSAGE
          EQ     EPR         GO OUTPUT MESSAGE
          SPACE  4
 EP4271   SX0    =50H NE4271///TRANSFER NAME NOT FOUND   -
 ADDNAME1 R=     B2,4        STORE NAME IN 5TH WORD OF MESSAGE
          EQ     ADDNAME     GO INSERT NAME AND OUTPUT MESSAGE
  
 IU       IFUSER
          SPACE  4
 EP4272   SX0    =C* NE4272///TOO MANY PARAMS IN EXECUTE REQUEST* 
          EQ     EPR
  
 IU       ENDIF 
          SPACE  4,5
 EP4273   SX0    =50H NE4273///NON-EXISTENT LIBRARY GIVEN - 
          EQ     ADDNAME1 
          SPACE  4,5
 EP4274   SX0    =50H NE4274///LIBRARY NOT ON MASS-STORAGE -
          EQ     ADDNAME1 
          SPACE  4
 EP4275   SX0    =50H NE4275///ILL-FORMATTED LIBRARY -
          EQ     ADDNAME1 
          SPACE  4
          IFCARD 3
 EP4310   SX0    =60H NE4310///POTENTIAL HARDWARE DEFICIENCY, PROGRAM-
          R=     B2,5 
          EQ     EP310Z 
          SPACE  4
 EP4340   SX0    =60H NE4340///TRIED TO LOAD INTO BLOCK BELOW ORIGIN -
          RJ     F1TERR      GET BLOCK NAME 
          R=     A7,X0+5     PUT IN MESSAGE 
          RJ     ERROUT      OUTPUT ERROR MESSAGE 
          EQ     EP100A      OUTPUT PROGRAM AND FILE
          SPACE  4
 EP4341   SX0    =C* NE4341///TRIED TO LOAD INTO ABSOLUTE BLOCK*
          RJ     ERROUT 
          EQ     EP100A      OUTPUT PROGRAM NAME AND FILE 
          SPACE  4,8
 SEG      IFCARD
 EP4420   SX0    =C* NE4420///COULD NOT FIND COMMON OR GLOBAL BLOCK - ..
,.....* 
          RJ     F1TERR 
          SA7    X0+5 
          EQ     EPR
          SPACE  4,8
 EP4421   SX0    =C* NE4421///SATISFY IGNORED ON SEGMENT LOAD.* 
          EQ     EPR
          SPACE  4,10 
 EP4422   SX0    =C* NE4422///TRIED TO LOAD INTO BLOCK OUTSIDE SEGMENT -
, .......*
          RJ     F1TERR 
          SA1    X0+5 
          MX3    18 
          SX6    X7 
          SA6    EP301SV     SAVE SEGMENT INDEX 
          LX7    -18
          BX7    -X3*X7 
          BX1    X3*X1
          BX7    X7+X1
          SA7    A1 
          RJ     ERROUT 
          SA1    TBLK 
          SA2    EP301SV
          SX0    =C*SEGMENT - .......*
          IX2    X1+X2
          SA3    X2 
          MX7    42 
          BX7    X7*X3
          SA7    X0+B1
          RJ     ERRLINE
          EQ     EP100A      OUTPUT PROGRAM AND FILE
          SPACE  4,8
 EP4450   SX0    =C* NE4450///CONFLICTING SEGMENTS CALLED BY SAME WORD.*
          RJ     ERROUT 
          RJ     F1TERR 
          SX1    X7          ADDRESS OF WORD
          AX7    18 
          SX6    X7 
          SA6    EP301SV
          RJ     COD         CONVERT ADDRESS
          MX7    -12
          LX6    18 
          SX0    =C*ADDRESS -  ......*
          BX6    X7*X6
          SA6    X0+B1
          RJ     ERRLINE
          SA1    EP301SV
          SA2    TBLK 
          SX0    =C*SEGMENT - .......*
          IX3    X1+X2
          MX7    42 
          SA3    X3 
          BX7    X7*X3
          SA7    X0+B1
          RJ     ERRLINE
          EQ     EPR1 
 SEG      ENDIF 
  
 IC       IFCARD
          SPACE  4
 EP4500   SX0    =50H NE4500///FORMAT ERROR ON EPT REQ     -
          EQ     ADDNAME1 
          SPACE  4
 EP4501   SX0    =50H NE4501///FORMAT ERROR ON NOEPT REQ   -
          EQ     ADDNAME1 
          SPACE  4
 EP4502   SX0    =C* NE4502///NOT ALL CAPSULE DIRECTIVES PROCESSED* 
          EQ     EPR
          SPACE  4,8
 EP4503   SX0    =50H NE4503///EPT REQUEST IGNORED       -
          EQ     ADDNAME1 
          SPACE  4,8
 IC       ENDIF 
 COD      TITLE  LOAD MAP - OCTAL CONVERSION SUBROUTINE.
 C10D     SPACE  4,8
**        C10D - CONSTANT TO OCTAL DISPLAY CODE CONVERSION. 
* 
*              THIS ROUTINE CONVERTS TEN DIGITS TO OCTAL DISPLAY CODE 
*         WITH NO LEADING ZERO SUPPRESSION. 
* 
*         ENTRY  (X1) = NUMBER TO BE CONVERTED. 
*         EXIT   (X6) = CONVERTED NUMBER. 
*         USES   X - 1, 2, 3, 6.
*                B - 2. 
*                A - NONE.
*         CALLS  NONE.
  
  
 C10D     PS                 ENTRY/EXIT 
          MX6    0           CLEAR ASSEMBLY 
          R=     B2,10       SET CHAR COUNT 
          MX2    -3          ONE DIGIT MASK 
 C10D1    BX3    -X2*X1      NEXT CHAR
          R=     X3,X3+1R0   CONVERT CHAR 
          SB2    B2-B1       DOWN CHAR COUNT
          AX1    3           TO NEXT CHAR 
          IX6    X6+X3       ADD TO ASSEMBLY
          LX6    -6          SHIFT ASSEMBLY 
          NZ     B2,C10D1    LOOP 
          EQ     C10D        EXIT 
 STB      TITLE  LOAD MAP - TABLE SORT ROUTINE. 
**        STB - SORT TABLE. 
* 
*              THIS ROUTINE SORTS A TABLE SO AS TO PLACE THE VALUES IN
*         THE SPECIFIED ADDRESS FIELD IN ASCENDING ORDER. 
* 
*         ENTRY  (B2) = TABLE POINTER.
*                (X3) = MASK INDICATING ADDRESS SIZE = VFD  60-ADR/ADR
*         EXIT   TABLE SORTED.
*                (X3) = MASK AS PER ENTRY 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 0, 1, 2, 6, 7. 
*         CALLS NONE. 
  
  
 STB      PS                 ENTRY/EXIT 
          SA1    B2          FWA
          SA2    A1+B1       LENGTH 
          R=     A0,X1-1     FWA - 1
          SB7    X2          N = NO. OF ENTRIES 
          SB6    X2          M = NO. OF ENTRIES 
 STB1     SX6    B6 
          AX6    1
          SB6    X6          M = M/2
          SB3    B1          J = 1
          ZR     B6,STB      RETURN IF M = 0
          SB4    B7-B6       K = N-M
          SB2    B3          I = J
 STB2     SB5    B2+B6       L = I + M
          SA1    A0+B2
          BX6    -X3*X1      A(I) 
          SA2    A0+B5
          BX7    -X3*X2      A(L) 
          IX4    X7-X6
          PL     X4,STB3     IF A(L) > A(I) 
          BX6    X1          INTERCHANGE A(I) AND A(L)
          BX7    X2 
          SA6    A2 
          SA7    A1 
          SB2    B2-B6       I = I - M
          GT     B2,B0,STB2  IF I > 0 
 STB3     SB3    B3+B1       J = J + 1
          SB2    B3          I = J
          LE     B3,B4,STB2  IF J @ K 
          EQ     STB1 
 IEA      TITLE  INTERCHANGE EQUAL ADDRESSES. 
**        IEA - INTERCHANGE EQUAL ADDRESSES.
* 
*              THIS ROUTINE SEARCHES *TSCR*, ALREADY SORTED BY ADDRESS
*         FIELD, FOR ENTRIES WITH EQUAL ADDRESS FIELDS.  IF THE LATTER
*         ENTRY IS A COMMON BLOCK OF ZERO LENGTH, THE ENTRIES ARE INTER-
*         CHANGED.  THIS CORRECTS THE ORDERING OF THE BLOCKS SO THAT
*         ALL COMMON BLOCKS ARE LISTED BEFORE OWNING PROGRAM BLOCKS AND 
*         PROGRAM REFERENCES IN THE ENTRY POINT REFERENCE CHAIN ARE 
*         CORRECT.
* 
*         ENTRY  (X3) = MASK INDICATING ADDRESS SIZE = VFD  60- ADR/ADR 
*         EXIT   *TSCR* IS SORTED SO THAT COMMON BLOCKS OCCUR BEFORE
*                BEFORE PROGRAM BLOCKS THAT DEFINE THEM.
*         USES   X - 1, 2, 4, 5, 6, 7.
*                B - 4, 5, 6. 
*                A - 1, 2, 5, 6, 7. 
*         CALLS  NONE.
  
  
 IEA      PS                 ENTRY/EXIT 
          SA2    TSCR 
          SA1    A2+B1
          SB5    X2          (B5) = FWA OF *TSCR* 
          SB6    B5+X1       (B6) = LWA OF *TSCR* 
          SB6    B6-B1
          SA2    X2 
 IEA1     GE     B5,B6,IEA   IF END OF TABLE
          SA1    A2 
          BX6    -X3*X1      MASK ADDRESS 
          SA2    A1+B1
          BX7    -X3*X2      MASK ADDRESS 
          SB5    B5+B1
          IX4    X7-X6       COMPARE ADDRESSES
          NZ     X4,IEA1     IF NOT THE SAME
          BX5    X2*X3       GET *TBLK* INDEX 
          LX5    18 
          SB4    X5 
          SA5    TBLK 
          SA5    X5+B4       GET *TBLK* ENTRY 
          LX5    59-0 
          PL     X5,IEA1     IF NOT COMMON BLOCK
          SA5    A5+B1       GET DEFINITION 
          MX4    24          MASK LENGTH
          LX4    -12
          BX4    X4*X5
          NZ     X4,IEA1     IF BLOCK NOT ZERO
          BX6    X1          INTERCHANGE ENTRIES
          BX7    X2 
          SA6    A2 
          SA7    A1 
          EQ     IEA1        CONTINUE SEARCH
 PFX      TITLE  LOAD MAP - REGENERATE PREFIX TABLE WORD. 
**        PFX - REGENERATE PREFIX TABLE WORD
* 
*              THIS ROUTINE RETURNS ONE SPECIFIED WORD FROM THE PREFIX
*         TABLE OF A PROGRAM. 
* 
*         ENTRY  (B6) = WORD TO GET    (2@B6@16B) 
*                (B7) = *TPRX* ORDINAL
*         EXIT   (X1) = (X6) = WORD FROM PREFIX TABLE 
*         USES   X - 1, 6.
*                B - 2, 3, 4, 5.
*                A - 1. 
*         CALLS  NONE.
  
  
 PFX0     SA1    B5 
          BX6    X1 
 PFX      PS                 ENTRY/EXIT 
          SA1    TPRX 
          R=     B2,B6-2     (B2) = SHIFT COUNT 
          R=     B3,X1+16B   (B3) = ADDRESS OF CURRENT *TPRX* ENTRY 
          R=     B4,X1+B7    (B4) = ADDRESS OF TARGET *TPRX* ENTRY
          SB5    =0          (B5) = POINTER TO CURRENT VALUE OF WORD
 PFX1     SA1    B3          GET FIRST WORD OF *TPRX* ENTRY 
          LX1    B2 
          CX6    X1 
          PL     X1,PFX2     IF DESIRED WORD NOT CHANGED
          SX1    X1 
          CX1    X1 
          SB5    B3+B1
          SB5    B5+X1       POINT TO NEW VERSION 
 PFX2     GE     B3,B4,PFX0  IF FINAL VERSION, EXIT 
          SB3    B3+B1
          SB3    B3+X6
          EQ     PFX1 
 LBA      TITLE  LOAD MAP - LIST BLOCKS.
**        LBA - LIST BLOCK ASSIGNMENTS. 
* 
*              THIS ROUTINE LISTS THE FOLLOWING:                               .
* 
*              A) BLOCK NAME (ENCLOSED BY SLASHES IF A COMMON BLOCK). 
*                 (ENCLOSED BY PARENTHESIS IF A SEGMENT NAME).
*              B) BLOCK FWA. (+4000000B IF AN ECS BLOCK). 
*              C) BLOCK LENGTH. 
*              D) FILE FROM WHICH BLOCK WAS LOADED IF A PROGRAM BLOCK.
*              E) CONTENTS OF *PRFX* TABLE IF A PROGRAM BLOCK.
  
  
 LBA      PS                 ENTRY/EXIT 
          SA1    MAPTYPE
          AX1    1
          ZR     X1,LBA      IF NO MAP WANTED THEN EXIT 
          LX1    59 
          PL     X1,LBA0     IF BLOCK MAP NOT WANTED, SKIP PRINTING 
          SX6    LBAB        PRINT HEADER AND SUBHEADER LINES 
          SX7    LBAA        FOR BLOCK LIST 
          RJ     SHL
  
*         MOVE AND SORT BLOCK TABLE.
* 
*         FORM *TSCR* ENTRIES TO THE FORMAT - 18/PI,18/SI,24/PA.
*                PI = *TBLK* INDEX. 
*                SI = SEGMENT INDEX.
*                PA = PROGRAM ADDRESS.
  
 LBA0     SA4    TBLK        (X4) = FWA TBLK
          SA1    A4+B1       (X0) = LENGTH OF TBLK
          BX0    X1 
          AX1    X0,B1       LENGTH FOR TSCR
          SA5    TSCR 
          MX6    0
          SA6    A5+B1       CLEAR TSCR 
          ALLOC  A5,X1       ALLOCATE SCRATCH TABLE FOR SORT
          SB4    X2 
          SA2    TBLK 
          MX0    -24         ADDRESS MASK FOR *TBLK* ENTRY
          SB2    B1+B1       (B2) = LENGTH OF ENTRY IN TBLK 
          SB5    B0          (B5) = *TBLK* POINTER
 IC       IFCARD
          SA3    OG 
          R=     X3,X3-2
          NZ     X3,LBAG     IF NOT OVCAP GENERATION
          SA3    OCOGBC      OVCAP ORIGIN BLANK COMMON
          NZ     X3,LBAF     IF CM // DEFINED IN (0,0)
          SA1    X2+B1       WORD TWO OF CM // *TBLK* ENTRY 
          NG     X1,LBAF     IF NOT REFERENCED
          BX6    -X0*X1      CM // ADDRESS
          SA6    B4          INSERT IN *TSCR* 
          SB4    B4+B1       INCREMENT *TSCR* POINTER 
 LBAF     SA3    OCBPI       OVCAP BASE PROGRAM INDEX 
          SB5    X3          START MOVE WITH OVCAP BLOCKS 
 LBAG     BSS    0
 IC       ENDIF 
          SA1    A2+B1
          SB3    X1          LENGTH OF TBLK 
          SB6    B0          (B6) = SEGMENT INDEX 
 LBAM     SA3    X2+B5       FETCH NEXT *TBLK* ENTRY
          SA1    A3+B1
          NG     X1,LBAM1    DO NOT LIST AN UNREFERENCED BLOCK
          SX4    B1+B1       CM/ECS FLAG
          BX4    X3*X4
          SX6    B5          BLOCK INDEX
          BX1    -X0*X1      BLOCK ADDRESS
          LX4    23-1        SET BIT 23 IN ECS ADDRESSES
          R=     X7,4 
          BX7    X7*X3       *S* BIT
          ZR     X7,LBAM0    IF NOT A SEGMENT ENTRY 
          SB6    B5          NEW SEGMENT INDEX
 LBAM0    SX7    B6 
          LX6    -18
          LX7    24 
          BX6    X7+X6       COMBINE SEGMENT INDEX AND BLOCK INDEX
          BX1    X1+X4
          BX6    X1+X6       MERGE ADDRESS AND INDEX
          SA6    B4          INSERT IN TSCR 
          SB4    B4+B1
 LBAM1    SB5    B5+B2
          LT     B5,B3,LBAM 
          MX3    18          ADDRESS MASK FOR *STB* 
          SA1    TSCR 
          SB2    A1 
          SX6    B4          SET ACTUAL *TSCR* LIMIT
          IX6    X6-X1
          SA6    B2+B1
          ZR     X6,LBA      IF NO BLOCKS TO LIST 
          RJ     STB         SORT TABLE 
          RJ     IEA
  
*         LIST BLOCK NAMES AND DEFINITIONS. 
  
          SA1    MAPTYPE
          LX1    58 
          PL     X1,LBA      IF BLOCK MAP NOT WANTED, SKIP PRINTING 
          SA1    TSCR 
          SA0    X1          (A0) = ADDRESS OF NEXT *TSCR* ENTRY
 LBA1     SA4    A0          NEXT *TSCR* ENTRY
          SA0    A0+B1
          SA1    PO 
          MX3    -23
          BX2    -X3*X4 
 ECS      IFTEST NE,IP.MECS,0 
          LX4    59-23
          PL     X4,LBA1A    IF NOT ECS BLOCK 
          SA1    ECSPO
 LBA1A    LX4    60-59+23 
 ECS      ENDIF 
          IX2    X2-X1
          MI     X2,LBA17    IF BLOCK BELOW FWA OF OVERLAY
 SEG      IFCARD
          LX4    -24
          SA2    SI 
          SX1    X4 
          LX4    24          RESTORE *TSCR* ENTRY 
          IX2    X1-X2       COMPARE SEGMENT INDICES
          NZ     X2,LBA17    IF NOT IN THIS SEGMENT 
 SEG      ENDIF 
          MX0    42 
          MX3    18 
          BX1    X3*X4       *TBLK* INDEX 
          LX1    18 
          SA5    TBLK 
          IX1    X5+X1
          SA5    X1+B1
          SA1    X1 
          SX2    B1          (B6) = 1 IF COMMON BLOCK 
          BX2    X2*X1
          BX3    -X0*X1      (B7) = *TPRX* ORDINAL
          AX3    3
          SB6    X2 
          SB7    X3 
          R=     X2,4 
          BX2    X2*X1       *S* BIT
          AX2    2
          SB5    X2          (B5) = 1 IF SEGMENT ENTRY
          BX1    X0*X1       BLOCK NAME 
          ZR     B6,LBA4
          NZ     X1,LBA2     TEST FOR BLANK COMMON
          SA1    LBAC        BLANK COMMON ENTRY 
          BX6    X1 
          EQ     LBA5 
  
 LBA2     MX0    6
          AX1    6
          SA2    LBAE+B5     / OR ( BEFORE NAME 
          BX1    -X0*X1      CLEAR UPPER CHARACTER FOR /
          SB5    B5+B5       (B5) = 2 IF A SEGMENT ENTRY
          BX1    X1+X2
          SB2    B0 
          LD     B3,6 
 LBA3     SB2    B2+B3       SHIFT COUNT
          LX1    6
          BX2    X0*X1
          NZ     X2,LBA3
          SA3    LBAE+B5     / OR ) AFTER NAME
          BX1    X1+X3
          SB2    -B2
          LD     B2,B2+60 
          LX1    X1,B2       LEFT JUSTIFY 
 LBA4     RJ     SFN=        BLANK FILL 
 LBA5     SA6    BUF+1       PUT IN LINE BUFFER 
          MX0    -24         PROGRAM ADDRESS
          BX1    -X0*X4 
          RJ     COD         CONVERT TO DISPLAY CODE
          AX5    24          BLOCK LENGTH 
          BX1    -X0*X5 
          LX6    6
 IC       IFCARD
          SA2    OG 
          R=     X2,X2-2
          NZ     X2,LBA5A    IF NOT OVCAP GENERATION
          MX2    -6 
          BX6    X6*X2       CLEAR TRAILING BLANK 
          R=     X2,1R+ 
          BX6    X6+X2       INSERT TRAILING PLUS 
 LBA5A    BSS    0
 IC       ENDIF 
          SA6    A6+B1       PUT ADDRESS IN BUFFER
          BX0    X6 
          RJ     COD         CONVERT TO DISPLAY CODE
          LX6    12 
          MX2    54 
          BX3    X2*X6
          AX5    24 
          MX4    -11
          BX5    -X4*X5      FILE INDEX 
          MX0    42 
          ZR     B6,LBA6     LIST FILES ONLY FOR PROGRAM BLOCKS 
          MX0    -12
          BX6    X0*X3       END LINE FOR COMMON BLOCKS 
          SA6    A6+B1
          SA3    UID
          SA1    A5-B1       GET WORD 1 OF *TBLK* ENTRY 
          MX0    42 
          BX6    X1*X0       CHECK FOR UNIQUE IDENTIFIER
          MX0    12 
          BX0    X6*X0
          BX3    X0-X3
          NZ     X3,LBA5D    IF NOT A LOCAL SAVE
          SA2    TLSB 
          SA2    X2 
          SB2    B1+B1
 LBA5B    BX2    X6-X2       COMPARE BLOCK NAME WITH *TLSB* ENTRY 
          ZR     X2,LBA5C    IF MATCH FOUND 
          SA2    A2+B2
          EQ     LBA5B       CONTINUE SEARCH
  
 LBA5C    SA1    A2+B1       GET PROGRAM BLOCK NAME 
          RJ     SFN= 
          SA3    =3R-LS 
          MX0    42 
          BX1    X6*X0
          BX6    X1+X3
          SA6    BUF+1       STORE FOR OUTPUT 
          EQ     LBA15
  
 LBA5D    BSS    0
          IFCARD 1
          RJ     ASS         ADD STATUS CHARACTER TO BLOCK DEFINITION 
          EQ     LBA15       GO PRINT LINE
  
 LBA6     SA1    TLFN 
          IX1    X1+X5
          SA1    X1          FETCH *TLFN* ENTRY 
          SB6    X1          (B6) = 0 IF LOCAL FILE, 1 IF USER
          BX1    X0*X1       LIB, 2 IF SYSTEM LIB 
          RJ     SFN=        SPACE FILL NAME
          SA2    B6+LBAD     FETCH APPROPRIATE LIBRARY INDICATOR
          SX7    X2 
          BX2    X2-X7
          BX7    X7+X3
          SA7    A6+B1       LENGTH TO BUF+3
          AX6    12 
          MX0    12 
          BX6    -X0*X6 
          BX6    X6+X2
          SA6    A7+B1       FILE NAME TO BUF+4 
          NZ     B7,LBA7     IF *TPRX* ORDINAL PRESENT
          MX6    0
          SA6    A6+B1       TERMINATE LINE -- NO PRFX TABLE
          EQ     LBA15       GO PRINT IT
  
*         LIST DATE, PROCESSOR INFO, AND MACHINE INFO FROM PREFIX TABLE 
  
 LBA7     R=     B6,2 
          RJ     PFX         GET DATE COMPILED
          MX0    48 
          BX6    X0*X6
          R=     X1,5555B 
          BX6    X6+X1
          LX6    -6 
          SA6    A6+B1
          R=     B6,5 
          RJ     PFX         GET LANGUAGE PROCESSOR AND VERSION 
          MX0    42 
          BX5    -X0*X6 
          BX6    X0*X6
          R=     X1,55B 
          LX1    12 
          BX6    X6+X1
          LX5    -6 
          SX2    X5 
          BX6    X6+X2
          BX5    X5-X2
          SA6    A6+B1
          LX1    36 
          BX5    X5+X1
          R=     B6,6 
          RJ     PFX         GET MOD LEVEL AND MACHINE INFO 
          MX0    30 
          BX1    X0*X6
          LX1    -12
          BX5    X5+X1
          R=     X1,5555B 
          LX1    6
          BX4    X5+X1
          LX6    -24
          MX0    18 
          BX5    X0*X6
          MX0    54 
          BX6    -X0*X6 
          BX6    X6+X4
          SA6    A6+B1
          R=     B6,7 
          RJ     PFX         GET HARDWARE INSTRUCTION DEPENDENCIES
          AX6    18 
          MX0    -36
          BX6    -X0*X6 
          BX6    X6+X5
          R=     X1,55B 
          LX1    36 
          BX6    X6+X1
          SA6    A6+B1
          SX7    B0 
          SA7    A6+B1
  
*         LIST COMMENTS FROM PREFIX TABLE 
*         IF WORD 10B IS BLANK, START AT WORD 13B 
  
          R=     X2,5        MAXIMUM OF 5 WORDS OF COMMENTS 
          R=     B6,10B 
          RJ     PFX         GET FIRST WORD OF COMMENTS 
          SA5    =10H 
          ZR     X6,LBA8     IF NONE
          BX1    X6-X5
          NZ     X1,LBA10    IF NOT BLANK 
          MI     X1,LBA10 
 LBA8     R=     X2,4        SET MAXIMUM TO 4 WORDS 
          R=     B6,13B      AND TRY *USER COMMENTS* FIELD INSTEAD
 LBA9     RJ     PFX
 LBA10    SA1    =10HCOPYRIGHT
          IX1    X6-X1
          NZ     X1,LBA11    IF NOT *COPYRIGHT* 
          SX6    B0          IF COPYRIGHT WORD TERMINATE
 LBA11    SA6    A6+B1
          MX0    -12
          BX7    -X0*X6 
          SB6    B6+B1
          ZR     X7,LBA15    IF TERMINATOR FOUND, GO PRINT LINE 
          R=     X2,X2-1
          NZ     X2,LBA9     IF FIELD NOT EXHAUSTED, GET NEXT WORD
          SX7    B0 
          SA7    A6+B1
          R=     B6,B6-16B
          PL     B6,LBA15    IF TERMINATED BECAUSE OF END OF TABLE
          MX0    42 
          BX6    X6*X0       CHOP OFF AFTER 137 CHARACTERS
          SA6    A6 
 LBA15    PRINT  BUF         PRINT LINE 
 LBA17    SA1    TSCR+1      CHECK PROGRESS THROUGH BLOCKS
          SA2    A1-B1
          IX1    X1+X2       LWA+1 OF *TSCR*
          SX3    A0          FETCH POINTER
          IX6    X3-X1
          NZ     X6,LBA1     IF MORE BLOCKS 
          EQ     LBA         EXIT 
  
          RELOC  OFF
 LBAA     BSS    0           BLOCK LIST HEADER
          DATA   1H 
          DATA   C*PROGRAM AND BLOCK ASSIGNMENTS.*
 LBAB     DATA   1H          BLOCK LIST SUBHEADER 
          DATA   50HBLOCK       ADDRESS   LENGTH    FILE     DATE 
          DATA   38LPROCSSR VER LEVEL  HARDWARE   COMMENTS
 LBAC     DATA   10H // 
 LBAD     CON    1R +2L 
          CON    1RU+2LL-    UL-
          CON    1RS+2LL-    SL-
 LBAE     DATA   1L/
 SEG      IFCARD
          DATA   1L(         USED FOR SEGMENT NAME ENTRIES
          DATA   1L)
 SEG      ENDIF 
          RELOC  ON 
 IC       IFCARD
 ASS      SPACE  4,8
**        ASS - ADD STATUS CHARACTER TO BLOCK DEFINITION. 
* 
*              FOR A SEGMENT LOAD MAP WE WILL ADD A STATUS TO ALL CM
*         BLOCKS WHICH WERE SPECIFIED ON *SEGLOAD* DIRECTIVES.
*         GLOBAL BLOCKS WHICH ARE IN THE SEGMENT WHICH OWNS THEM HAVE 
*         THE STATUS *G* FOR *GLOBAL* OR *GS* FOR *GLOBAL-SAVE*.
*         OTHERWISE EQUAL AND GLOBAL BLOCKS HAVE A STATUS REPRESENTING
*         THE SAFETY OF THE BLOCK. *B* MEANS THE BLOCK WILL NEVER BE
*         LOADED IF THIS SEGMENT REFERENCES IT.  *S* MEANS THE BLOCK
*         CAN BE REFERENCED AND IT WILL BE LOADED.  *D* MEANS THE 
*         BLOCK MAY OR MAY NOT BE LOADED WHEN THIS SEGMENT REFERENCES 
*         IT. 
* 
*         ENTRY  (A5) = ADDRESS OF *TBLK* DEFINITION. 
*         EXIT   STATUS CHARACTER ADDED TO FIRST CHARACTER IN *BUF*+2.
*         USES   X - 1, 2, 3, 6.
*                B - 2, 3.
*                A - 1, 2, 6. 
*         CALLS  CCS. 
  
  
 ASS      PS                 ENTRY/EXIT 
          SA1    A5-B1
          LX1    -2 
          MI     X1,ASS      IF ECS BLOCK 
          MX2    -3 
          LX1    -1 
          MI     X1,ASS      IF SEGMENT ENTRY 
          BX2    -X2*X1      *Q*, *G*, *V* BITS 
          LX1    -3 
          MX3    -12
          BX3    -X3*X1      *OWN*
          ZR     X2,ASS      IF NOT GLOBAL OR EQUAL BLOCK 
          ZR     X3,ASS2     IF THIS SEGMENT OWNS BLOCK 
          SA1    SN 
          SB3    X3-1 
          SB2    X1 
          SB3    B3+B3       *TCEL* INDEX FOR REFERENCED SEGMENT
          SB2    B2+B2       *TCEL* INDEX OF REFERENCING SEGMENT
          RJ     CCS         CHECK FOR COMPATIBLE SEGMENTS
          SX1    2RS         -SAFE- 
          ZR     X6,ASS1     IF SAFE STATUS 
          SX1    2RD         -DOUBTFULL-
          PL     X6,ASS1     IF DOUBTFUL STATUS 
          SX1    2RB         -BAD-
 ASS1     SA2    BUF+2
          MX6    12 
          LX1    -12
          BX6    -X6*X2 
          BX6    X1+X6
          SA6    A2 
          EQ     ASS
  
 ASS2     SX1    2RG         -GLOBAL- 
          LX2    -3 
          MX6    -6 
          PL     X2,ASS1     IF NOT GLOBAL SAVE 
          SX1    2RGS        -GLOBAL(SAVE)- 
          EQ     ASS1 
 IC       ENDIF 
 LEP      TITLE  LOAD MAP - LIST ENTRY POINTS.
**        LEP - LIST ENTRY POINTS.
* 
*              THIS ROUTINE IS CALLED ONLY IF THE MAP *E* OPTION IS 
*         SELECTED.  IT ALSO HANDLES THE CROSS-REFERENCE LIST IF THE
*         *X* OPTION IS SELECTED.  THE FOLLOWING IS PLACED IN THE MAP 
*         FOR EACH ENTRY POINT:                                                .
* 
*              FOR *E* OPTION 
* 
*              A) ENTRY POINT NAME. 
*              B) ENTRY POINT ADDRESS (*UNSAT* IF UNSATISFIED). 
*              C) NAME OF PROGRAM IN WHICH ENTRY POINT RESIDES. 
* 
*              FOR *X* OPTION, FOR EACH PROGRAM CONTAINING ONE OR 
*              MORE REFERENCES TO THE ENTRY POINT 
* 
*              D) PROGRAM NAME. 
*              E) ADDRESS OF UP TO SEVEN REFERENCES WITHIN THE ABOVE
*                 PROGRAM ON A LINE.  AS MANY LINES AS NECESSARY ARE
*                 USED. 
  
  
 LEP      PS                 ENTRY/EXIT 
          SA1    =10H 
          BX6    X1 
          SA6    BUF+4
 SEG      IFCARD
          SA2    SEGFLAG
          NZ     X2,LEP0     IF A SEGMENT LOAD
          SA6    LEPB1       CLEAR *SEGMENT* FROM HEADER
 LEP0     BSS    0
 SEG      ENDIF 
          SA1    MAPTYPE
          R=     X2,14B 
          BX1    X2*X1
          ZR     X1,LEP      IF NEITHER *E* NOR *X* SELECTED, EXIT
          AX1    3
          NZ     X1,LEP1     IF *X* NOT SELECTED
          SX6    B0 
          SA6    LEPB1       CLEAR *SEGMENT* AND *REFERENCES* FROM HEADE
          SA6    A6+B1
 LEP1     SX6    LEPB        PRINT HEADER AND SUBHEADER LINES FOR 
          SX7    LEPA        THE ENTRY POINT LIST 
          RJ     SHL
          SA1    TLNK+1 
          ZR     X1,LEP      IF NO ENTRY POINTS 
          RJ     SRC         SET REFERENCE CHAIN
  
*         MOVE AND SORT ENTRY NAMES.
  
          MX6    0           CLEAR *TSCR* 
          SA6    TSCR+1 
          SA2    TLNK+1      (B4) = LENGTH OF *TLNK*
          SB4    X2 
          SB3    B1+B1       (B3) = LENGTH OF ENTRY 
          SB5    B1          (B5) = *TLNK* POINTER
          MX0    -24         ADDRESS MASK 
 LEPM1    SA1    TLNK        FETCH NEXT TLNK ENTRY
          SA4    X1+B5       WORD 2 OF ENTRY
          SX1    B5-B1
          LX1    30          INDEX
          SA2    TBLK 
          BX5    -X0*X4      ADDRESS
          SX6    B1+B1       FETCH CM/ECS INDICATOR 
          AX4    36          AND INSERT IN BIT 23 OF ADDRESS
          SB2    X2 
          SA3    X4+B2
          BX6    X6*X3
          LX6    23-1 
          BX5    X6+X5
          BX1    X1+X5       MERGE ADDRESS AND INDEX
 IC       IFCARD
          SA2    OG 
          R=     X2,X2-2
          NZ     X2,LEPM1D   IF NOT OVCAP GENERATION
          SA2    OCBPI       (X2) = BASE *PI* FOR OVCAP GENERATION
          SX4    X4          (X4) = *PI* FOR THIS *TLNK* ENTRY
          NZ     X4,LEPM1C   IF ENTRY NOT IN CM //
          SA2    OCOGBC      CM // ORIGIN IN (0,0) (NONE=0) 
          NZ     X2,LEPM1D   IF CM // DEFINED IN (0,0)
 LEPM1B   R=     X2,3        ENTRY IS IN THE OVCAP, SET BITS 23 AND 22
          LX2    23-1        (SO THAT OVCAP EPTS ARE LISTED LAST) 
          BX1    X1+X2       MERGE ADDRESS, INDEX, BITS 
          EQ     LEPM1D 
  
 LEPM1C   IX2    X4-X2
          PL     X2,LEPM1B   IF ENTRY POINT IS IN THE OVCAP 
 LEPM1D   BSS    0
 IC       ENDIF 
 SEG      IFCARD
          SA2    SEGFLAG
          ZR     X2,LEPM1A   IF NOT A SEGMENT LOAD
          SX2    A3-B2       INDEX INTO *TBLK*
          SA3    SI 
          SA4    A3+B1
          IX3    X2-X3
          IX4    X2-X4
          MI     X3,LEPM2    IF ENTRY NOT IN THIS SEGMENT 
          PL     X4,LEPM2    IF ENTRY NOT IN THIS SEGMENT 
 LEPM1A   BSS    0
 SEG      ENDIF 
          ADDWRD TSCR,X1     INSERT INTO TSCR 
 LEPM2    SB5    B5+B3
          LT     B5,B4,LEPM1
          MX3    -24         ADDRESS MASK FOR SORT
          SB2    TSCR        SET TABLE POINTER
          RJ     STB         SORT TABLE 
  
*         LIST ENTRY NAMES. 
  
          SA1    TSCR 
          SB5    B0 
          MX0    30 
          SA5    A1+B1
          ZR     X5,LEP      IF NO ENTRIES TO LIST
 LEP2     SA1    X1+B5       PICK UP FIRST WORD OF ENTRY
          SA5    TLNK        GET ENTRY IN *TLNK*
          BX1    X0*X1
          LX1    30 
          IX1    X1+X5
          SA5    X1+B1
          MX0    42 
          SA1    X1 
          BX1    X0*X1       NAME 
          IFCARD 1
          RJ     CGSEX
          IFUSER 1
          RJ     SFN= 
          SA6    BUF+1
          BX4    X5 
          SA2    TBLK 
          AX4    36          POSITION INDEX INTO *TBLK* TABLE 
          SB2    X2 
          SA2    X4+B2       (X2) = *TBLK* ENTRY FOR THIS ENTRY POINT.
          MX1    -21         ECS ADDRESS MASK 
          LX2    59-1        SIGN BIT = CM/ECS BIT FROM *TBLK*. 
          MI     X2,LEP2A    IF ECS ADDRESS 
          MX1    -18         CM ADDRESS MASK
 LEP2A    BX1    -X1*X5      EXTRACT ADDRESS
          LX5    59-57       CHECK IF SATISFIED 
          PL     X5,LEP3
          SA1    LEPD 
          LX5    57-55       CHECK FOR WEAK EXTERNAL
          PL     X5,LEP2B    IF STRONG EXTERNAL 
          SA1    A1+B1       GET *WEAK* 
 LEP2B    BSS    0
          SA5    A5-B1
          BX6    X1 
          SA6    BUF+2       *UNSAT*
          SA4    =1H
          BX6    X4 
          EQ     LEP4 
  
 LEP3     RJ     COD
 IC       IFCARD
          SA1    OG 
          R=     X1,X1-2
          NZ     X1,LEP3A    IF NOT OVCAP GENERATION
          SA1    TSCR 
          SA1    X1+B5       CURRENT *TSCR* ENTRY 
          LX1    59-22       BIT 22 SET IF ENTRY POINT IS IN OVCAP
          PL     X1,LEP3A    IF ENTRY POINT IS NOT IN THE OVCAP 
          MX1    6
          BX6    -X1*X6      ZERO TRAILING BLANK
          R=     X1,1R+ 
          LX1    59-5 
          BX6    X1+X6       INSERT TRAILING PLUS 
 LEP3A    BSS    0
 IC       ENDIF 
          LX6    18 
          SA6    BUF+2
          LX5    57-59-36 
          BX4    -X0*X5 
          SA1    TBLK 
          SA5    A5-B1
          IX1    X1+X4
          SA1    X1 
          BX1    X0*X1       BLOCK NAME 
          SX6    A1 
          SA6    LEPG        SAVE ADDRESS OF *TBLK* ENTRY 
          SA2    =10H 
          BX6    X2 
          SA2    LEPE        BLOCK NAME IN EFFECT 
          BX2    X1-X2       COMPARE TO CURRENT NAME
          ZR     X2,LEP4     USE BLANK AS NAME IS THE SAME
          BX6    X1 
          SA6    LEPE        SET NEW NAME 
          BX6    X1-X2
          SA6    LEPH        SAVE PREVIOUS NAME 
          RJ     SFN= 
 LEP4     SA6    BUF+3
          BX5    -X0*X5      CHAIN TO TREF ENTRY
          SX7    B5 
          SA7    LEPF 
          RJ     LRC         LIST REFERENCE CHAIN 
          SA1    LEPF 
          SB5    X1 
          MX0    30          RESTORE MASK 
          SA1    TSCR 
          SA2    A1+B1
          SB6    X2 
          SB5    B5+B1
          LT     B5,B6,LEP2  TEST FOR END OF TLNK TABLE 
          MX6    0
          SA6    A1+B1       EMPTY TSCR 
          EQ     LEP
  
          RELOC  OFF
 LEPA     DATA   1H 
          DATA   C*ENTRY POINTS.* 
 LEPB     DATA   1H 
          DATA   10HENTRY 
          DATA   10HADDRESS 
          DATA   10HPROGRAM 
          IFUSER 1
 LEPB1    DATA   10H
          IFCARD 1
 LEPB1    DATA   10HSEGMENT 
          DATA   10HREFERENCES
          CON    0
 LEPD     DATA   10H   *UNSAT*
          DATA   10H    *WEAK*
 LEPE     DATA   0           BLOCK NAME IN EFFECT 
 LEPF     DATA   0
 LEPG     DATA   0           ADDRESS OF *TBLK* ENTRY
 LEPH     DATA   0           BLOCK NAME PREVIOUSLY IN EFFECT
          RELOC  ON 
 LRC      TITLE  LOAD MAP - LIST REFERENCE CHAIN. 
**        LRC - LIST REFERENCE CHAIN. 
* 
*             THIS ROUTINE IS CALLED BY *LEP* FOR EACH ENTRY NAME TO
*         GO IN THE MAP.  IF A CROSS-REFERENCE LIST IS SELECTED, IT 
*         FETCHES THE LIST OF REFERENCES FROM THE TABLE *TREF* AND ADDS 
*         THEM TO THE MAP.
* 
*         ENTRY  (X5) = FIRST ENTRY POINTER.
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                B - 2, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*         CALLS  ADW, WOF.
  
  
 LRC      PS                 ENTRY/EXIT 
          SA1    MAPTYPE     CHECK TYPE OF MAP
          MX6    0
          LX1    59-3 
          PL     X1,LRC0     IF X OPTION NOT SELECTED 
          NZ     X5,LRC1     IF ANY ENTRIES IN CHAIN
 IC       IFCARD
          SA1    LEPG        GET ADDRESS OF *TBLK* ENTRY
          SA2    PO 
 ECS      IFTEST NE,IP.MECS,0 
          SA3    X1 
          LX3    59-1 
          PL     X3,LRCA     IF NOT ECS BLOCK 
          SA2    ECSPO
 ECS      ENDIF 
 LRCA     SA1    X1+B1
          MX3    -23
          BX1    -X3*X1 
          IX1    X1-X2
          MI     X1,LRC00    IF BLOCK IN LOWER OVERLAY, DONT LIST 
 IC       ENDIF 
          SA1    MAPTYPE
          LX1    57 
          MI     X1,LRC0     IF *E* MAP SELECTED, PRINT ANYWAY
 LRC00    SA1    BUF+3
          SA2    =10H 
          BX2    X1-X2
          ZR     X2,LRC 
          SA1    LEPH 
          BX6    X1 
          SA6    LEPE 
          EQ     LRC
  
 LRC0     SA6    BUF+4       PRINT ENTRY
          PRINT  BUF
          EQ     LRC         RETURN 
  
 LRC1     SA1    TREF        SET PROGRAM NAME 
          SA2    TBLK 
          R=     B2,X1-1     FWA-1
          SA5    B2+X5       NEXT ENTRY 
          SB3    X2 
          LX5    -18         EXTRACT BLOCK NUMBER 
          SA2    B3+X5
          BX6    X6-X6       EMPTY *TSCR2*
          SA6    TSCR2+1
          MX3    42 
          BX1    X3*X2
          RJ     SFN= 
          SA6    BUF+5
          SX0    X5          SET CURRENT BLOCK
          LX5    18 
          SA3    =1H
          BX6    X3 
          SA6    A6-B1       CLEAR SEGMENT NAME 
 SEG      IFCARD
          SA1    SEGFLAG
          ZR     X1,LRC3     IF NOT A SEGMENT LOAD
          SA3    TBLK 
          IX1    X3+X0
          SA1    X1          CURRENT BLOCK ENTRY
          SX4    4
 LRC1A    SA1    A1-2        LOOK FOR SEGMENT ENTRY 
          BX2    X4*X1
          ZR     X2,LRC1A    IF NOT A SEGMENT ENTRY 
          SX2    A1 
          IX2    X2-X3       INDEX INTO *TBLK*
          SA3    SI 
          IX6    X3-X2
          ZR     X6,LRC3     IF THIS IS IN SAME SEGMENT 
          MX2    42 
          BX1    X2*X1       SEGMENT NAME 
          RJ     SFN=        SPACE FILL NAME
          SA6    BUF+4
 SEG      ENDIF 
          EQ     LRC3 
  
 LRC2     SA2    TREF 
          R=     X2,X2-1
          SA5    X2+B5
 LRC3     LX5    -36
          SX1    X5 
          RJ     COD
 IC       IFCARD
          SA4    OG 
          R=     X4,X4-2
          NZ     X4,LRC3A    IF NOT OVCAP GENERATION
          MX4    -6 
          LX6    6
          BX6    X4*X6       CLEAR TRAILING BLANK 
          R=     X4,1R+ 
          BX6    X4+X6       INSERT TRAILING PLUS 
 LRC3A    BSS    0
 IC       ENDIF 
          ADDWRD TSCR2,X6 
          LX5    18          CHECK BLOCK NUMBER 
          SX2    X5 
          IX6    X2-X0
          NZ     X6,LRC4     IF NEW BLOCK 
          LX5    18          NEXT LINK
          SB5    X5 
          NZ     B5,LRC2     IF NOT END OF CHAIN
 LRC4     SX5    B5          *TREF* POINTER 
          SA1    A2 
          SB2    X1          (B2) = FWA *TSCR2* 
          SA2    A2+B1
          SB7    X2+B2       (B7) = LWA+1 
          ZR     X5,LRC5     PRINT ALL OF TSCR2 THE LAST TIME 
          SB7    B7-B1
 LRC5     SB4    B0          (B4) = LINE INDEX
          R=     B3,7        (B3) = REFERENCES / LINE 
 LRC6     SA1    B2          MOVE ENTRY TO LINE BUFFER
          BX6    X1 
          SA6    BUF+6+B4    MOVE ENTRY TO BUFFER 
          SB2    B2+B1
          LT     B2,B7,LRC7 
          SX7    B0          CLEAR END OF LINE
          SA7    A6+B1
          PRINT  BUF
          ZR     X5,LRC      CHECK FOR END OF REFERENCE CHAIN 
          SA1    =1H         CLEAR FIRST PART OF BUFFER 
          BX6    X1 
          SA6    BUF+1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          EQ     LRC1 
  
 LRC7     SB4    B4+B1
          LT     B4,B3,LRC6  CHECK FOR END OF LINE
          SX6    B0 
          SA6    A6+B1       TERMINATE LINE 
          SA0    B2          SAVE *TSCR2* FWA 
          SX0    B7          SAVE *TSCR2* LWA+1 
          PRINT  BUF
          SA1    =1H
          BX6    X1 
          SB2    A0 
          SB7    X0 
          SA6    BUF+1       CLEAR FRONT OF THE LINE
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          EQ     LRC5        START NEXT LINE
 ICF      SPACE  4,8
**        ICF - INITIALIZE CHAIN FIELDS.
* 
*              FOR *E* OR *X* TYPE MAPS THE *TLNK* ENTRY NAMES WILL 
*         BE CHANGED TO THE FORMAT 42/NAME,18/0.  THIS IS SO THE
*         ROUTINES *SRC* AND *LRC* CAN LINK ALL THE REFERENCES TO THE 
*         MATCHING ENTRY POINT IN AN EASY MANNER. 
* 
*         USES   X - 1, 3, 4, 6.
*                B - 2, 3, 4, 5.
*                A - 1, 3, 4, 6.
  
 ICF      PS                 ENTRY/EXIT 
          SA1    MAPTYPE
          MX4    2
          LX1    59-3 
          BX4    X4*X1
          ZR     X4,ICF      IF NO *E* OR *X* MAP DO NOT SHIFT *TLNK* 
          SA3    TLNK 
          R=     B5,18       SHIFT *TLNK* NAME TO UPPER 42 BITS 
          SA4    A3+B1
          SB2    B1+B1
          SB3    B0 
          SB4    X4 
 ICF1     SA1    X3+B3
          LX6    X1,B5
          SB3    B3+B2
          SA6    A1 
          LT     B3,B4,ICF1  IF MORE TO *TLNK*
          EQ     ICF
 SRC      TITLE  LOAD MAP - SET REFERENCE CHAIN.
**        SRC - SET REFERENCE CHAIN.
* 
*              THIS ROUTINE IS CALLED BY *LEP* TO SET UP A REFERENCE
*         CHAIN OF ALL EXTERNAL REFERENCES.  PROVIDED A CROSS-REFERENCE 
*         LIST WAS SELECTED, THE REFERENCES ARE OBTAINED FROM THE TABLE 
*         *TLBC2*.
* 
*         CALLS  ADW=, STB. 
  
  
 SRC      PS                 ENTRY/EXIT 
          SA3    MAPTYPE
          LX3    59-3 
          MX0    1
          PL     X3,SRC      IF X OPTION NOT SELECTED 
          SA1    TLBC2+1
          ZR     X1,SRC      IF NO REFERENCES 
          SB3    X1          (B3) = *TLBC2* LENGTH
          MX6    0           CLEAR *TREF* 
          SA6    TREF+1 
          SB4    B0          (B4) = POINTER TO TLBC2
          SA1    TLBC2
          MX4    18 
          LX4    -12
          SA1    X1          FIRST ENTRY
          EQ     SRC2 
  
*         ENTER BYTE CHAIN IN *TREF*. 
* 
*         FORM *TREF* ENTRIES TO THE FORMAT - 24/RF,18/SI,18/DI 
*                RF = REFERENCE ADDRESS.
*                SI = SEGMENT INDEX.
*                DI = DEFINITION INDEX INTO *TLNK*. 
  
 SRC1     ZR     X1,SRC3     IF END OF LINK = ZERO WORD 
          MI     X0,SRC3     IF LOWER HALF OF WORD
          BX5    X1          24/0,18/SEGMENT INDEX,18/DEFINITION INDEX
          LX0    30 
 SEG      IFCARD
          SA3    SEGFLAG
          ZR     X3,SRC3     IF NOT SEGMENT LOAD
          SA3    TLNK 
          SX6    X5 
          IX3    X6+X3
          SA3    X3          *TLNK* DEFINITION
          AX3    36 
          SX6    X3          *PI* 
          SA3    SI 
          IX3    X6-X3
          MI     X3,SRC1A    IF NOT IN THIS SEGMENT 
          SA3    A3+B1
          IX3    X6-X3
          MI     X3,SRC3     IF IN THIS SEGMENT 
 SRC1A    MX5    1
 SEG      ENDIF 
          EQ     SRC3 
  
 SRC2     BX6    X4*X1
          LX0    30 
          PL     X1,SRC1     IF POSITIVE BYTE 
          MI     X5,SRC3     IF ENTRY NOT IN THIS SEGMENT 
          LX6    6
          IX1    X6+X5       MERGE BYTE AND LINK INDEX
          LX1    24 
          ADDWRD TREF,X1
          SA1    TLBC2
          SA1    X1+B4
          MX4    18 
          LX4    -12
 SRC3     LX1    30          SWITCH BYTES 
          PL     X0,SRC2
          SB4    B4+B1
          SA1    TLBC2
          SA1    X1+B4       NEXT ENTRY 
          LT     B4,B3,SRC2 
          SB2    TREF 
          MX3    18 
          LX3    -18         SORT ON SEGMENT INDEX AND ADDRESS
          RJ     STB         SORT TABLE 
          SA3    TREF        SHIFT FIELDS TO PROPER POSITIONS 
          SA2    A3+B1
          SB2    X2 
          SB3    B0 
 SRCM1    SA1    X3+B3       NEXT ENTRY 
          LX1    -24
          BX6    X1 
          SA6    A1 
          SB3    B3+B1
          LT     B3,B2,SRCM1
  
*         CHAIN LINK TABLE TO REFERENCE TABLE.
* 
*         FORM *TREF* ENTRIES TO THE FORMAT - 24/RF,18/SI,18/CP.
*                RF = RELOCATED REFERENCE ADDRESS.
*                SI = SEGMENT INDEX.
*                CP = CHAIN POINTER INTO *TREF* FOR NEXT ENTRY. 
  
          SA1    TREF        (B2) = FWA *TREF* - 1
          SA2    A1+B1       (B4) = LENGTH *TREF* 
          R=     B2,X1-1
          SA3    TLNK        (B3) = FWA-1 *TLNK*
          SB4    X2 
          ZR     B4,SRC      TREF IS EMPTY, RETURN
          SB3    X3 
          SB3    B3-B1
          MX4    -18         (X4) = REPLACEMENT MASK
          SA2    B2+B4       LAST ENTRY IN *TREF* 
          MX0    -18         (X0) = INSERTION MASK
          SA5    BI          (X5) = ADDRESS BIAS
          SA1    PO 
          SB7    B4 
          IX5    X1-X5
          LX5    36 
          SA1    TBLK 
          SB6    X1+B1       (B6) = FWA+1 OF TBLK 
 SRC4     BSS    0
 SEG      IFCARD
          SA1    SEGFLAG
          ZR     X1,SRC4A    IF NOT SEGMENT LOAD
          LX2    -18
          SA3    X2+B6       SEGMENT DEFINITION 
          LX2    18 
          MX5    -24
          BX5    -X5*X3      PROGRAM ORIGIN 
          LX5    36 
 SRC4A    BSS    0
 SEG      ENDIF 
          SA3    X2+B3       *TLNK* ENTRY 
          BX6    X0*X3       CHAIN TO PREVIOUS REFERENCE
          BX7    X4*X2       REMOVE *TLNK* INDEX
          IX7    X7+X5       SET PROGRAM ADDRESS
          SX2    A2-B2       INDEX OF THIS REFERENCE
          SX3    X3 
          IX7    X7+X3
          BX6    X6+X2       ENTER CHAIN OF THIS REFERENCE
          SA7    A2 
          SA6    A3 
          SA2    A2-B1       NEXT REFERENCE ENTRY 
          SB4    B4-B1
          NZ     B4,SRC4     LOOP TO END OF *TREF*
  
*         SET BLOCK INDEX OF REFERENCES.
* 
*         FORM *TREF* ENTRIES INTO THEIR FINAL FORMAT - 24/RF,18/L,18/CP
*                RF = RELOCATED REFERENCE ADDRESS.
*                L = *TBLK* INDEX OF CALLING PROGRAM. 
*                CP = CHAIN POINTER INTO *TREF* FOR NEXT ENTRY. 
  
          SA1    TSCR 
          SB6    X1 
          SA2    A2+B1       FIRST *TREF* ENTRY 
          R=     A1,X1-1     (FIRST *TSCR* ENTRY) - 1 
          MX0    18 
          LX2    24 
          BX7    -X0*X2      REMOVE SEGMENT INDEX 
          LX7    -24
          LX2    -24
          BX1    X2-X7       SEGMENT INDEX IN BITS 18-35
          AX2    -24         REFERENCE ADDRESS
          LX1    6
          BX2    X1+X2       FORM SEGMENT INDEX AND REFERENCE ADDRESS 
          SA5    TSCR+1      (B6) = LWA+1 *TSCR*
          SB6    B6+X5
 SRC5     SA1    A1+B1       NEXT BLOCK ENTRY 
          SB5    A1+B1
          BX6    -X0         (X6) = 77777777B IN CASE LAST BLOCK
          SA3    A1+B1
          BX5    -X0*X1      (X5) = FWA OF CURRENT BLOCK
          AX1    -18         (X4) = CURRENT BLOCK INDEX 
          SX4    X1 
          LX4    18 
          EQ     B5,B6,SRC6  IF AT LAST BLOCK 
          BX6    -X0*X3      (X6) = FWA OF NEXT BLOCK 
 SRC6     IX1    X5-X6
          IX3    X2-X6       (REF ADR) - (FWA NEXT BLOCK) 
          ZR     X1,SRC5     IF CURRENT BLOCK ZERO-LENGTH 
          PL     X3,SRC5     IF REF NOT IN CURRENT BLOCK
          BX7    X7+X4       ENTER BLOCK INDEX
          SA7    A2 
          SB7    B7-B1
          SA2    A2+B1
          LX2    24 
          BX7    -X0*X2      REMOVE SEGMENT INDEX 
          LX7    -24
          LX2    -24
          BX1    X2-X7       SEGMENT INDEX IN BITS 18-35
          AX2    -24         REFERENCE ADDRESS
          LX1    6
          BX2    X1+X2       FORM SEGMENT INDEX AND REFERENCE ADDRESS 
          NZ     B7,SRC6     LOOP TO END OF TABLE 
          EQ     SRC
  
  
          RELOC  OFF
          USE    // 
          IFUSER 1
          CON    0           ENTRY/EXIT FROM RELOCATOR
  
