          EJECT
*         CTEXT  CTP$DFT PP UTILITY REQUESTS.
*
*         THIS DECK EXTERNALIZES THE DFT PP UTILITY FUNCTIONS
*         WHICH INCLUDE *LDC*, *PUF*, *PUR*, AND *REP*.
          SPACE  4,10
 QUAL$    EQU    0           DEFINE UNQUALIFIED COMMON DECKS
 PPTN     CON    0           GLOBAL PP TYPE/NUMBER VALUE
 CBUF     BSSZ   100         PP MEMORY BUFFER
 LDC      SPACE  4,10
**        LDC - BEGIN LOAD OF DRIVER CODE.
*
*         ENTRY  (JT - JT+2) = REQUEST POINTER.
*
*         CALLS  LDR, LRP.


          ROUTINE  LDC

          RJM    LRP         LOAD REQUEST POINTER
          CRDL   W0          READ FIRST WORD OF REQUEST
          RJM    LRP         LOAD REQUEST POINTER
          ADN    1
          CRDL   W4          READ SECOND WORD OF REQUEST
          RJM    LDR         LOAD DRIVER CODE COMPLETION
          LJM    LDCX        RETURN
 PUF      SPACE  4,10
**        PUF - PP UTILITY FUNCTIONS.
*
*         ENTRY  (JT - JT+3) = DFT REQUEST POINTER IN R POINTER FORMAT.
*                DFT REQUEST FORMAT:
*                   WORD 0 = 8/RESPONSE.
*                            8/DFT FUNCTION.
*                            8/CONCURRENT, = 1 IMPLIES CONCURRENT, = 0 IMPLIES
*                               NON CONCURRENT.
*                            8/PP NUMBER.
*                            8/DUMP REGISTERS ONLY, = 1 IMPLIES DUMP REGISTERS
*                               ONLY, = 0 IMPLIES DUMP BOTH REGISTERS AND MEMORY.
*                            8/DUMP PP, = 1 IMPLIES PP SHOULD BE DUMPED, = 0
*                               IMPLIES PP ONLY IDLED.
*                            8/IDLE PP, = 1 IMPLIES PP IDLED BEFORE DUMPED, = 0
*                               IMPLIES PP NOT IDLED BEFORE DUMP, ONLY REGISTERS
*                               CAN BE DUMPED IN THIS CASE.
*                            8/0.
*                   WORD 1 = POINTER FOR PP REGISTERS AND MEMORY IF BEING DUMPED,
*                            R REGISTER FORMAT.
*
*         EXIT   ONE OF ABOVE REQUESTS IS PERFORMED.
*
*         CALLS   DPM, DPR, IDP, LRP.
*
*         USES   W0 - W5.

          ROUTINE  PUF

          RJM    LRP         LOAD REQUEST POINTER
          CRDL   W0          WORD 0 OF DFT REQUEST
          LDDL   W1          GET PP TYPE AND NUMBER
          STML   PPTN
          LDDL   W3
          SHN    -8D         IDLE PP BOOLEAN
          ZJN    PUF5        IF NOT IDLE PP
          LDDL   W1          GET PP TYPE AND NUMBER
          RJM    IDP         HARDWARE IDLE PP
 PUF5     LDDL   W2          DUMP FLAGS
          LPC    0#FF
          ZJP    PUFX        IF NOT DUMPING PP
          RJM    LRP         LOAD REQUEST POINTER
          ADN    1
          CRDL   W4          READ SECOND WORD OF REQUEST
          LDML   PPTN        PP TYPE AND NUMBER
          RJM    DPR         DUMP PP REGISTERS
 PUF6     LDDL   W2          DUMP FLAGS
          SHN    -10
          NJP    PUFX        IF JUST DUMP REGISTERS
          LDML   PPTN        PP TYPE AND NUMBER
          RJM    DPM         DUMP PP MEMORY
          LJM    PUFX        RETURN
 PUR      SPACE  4,30
**        PUR - PP UTILITY FUNCTIONS.
*
*         ENTRY  (JT - JT+3) = DFT REQUEST POINTER IN R-POINTER FORMAT.
*                (REQUEST) = 16/, 8/IOU, 8/CIO, 8/PP, 8/SUBFUNCTION, 16/ADDR.
*                            64/R-POINTER.
*                WHERE -
*                SUBFUNCTION -
*                  1 = DUMP PP REGISTERS ONLY.
*                  2 = IDLE PP ONLY.
*                  3 = IDLE PP AND DUMP PP REGISTERS AND MEMORY.
*                  4 = IDLE PP AND DUMP PP REGISTERS.
*                  5 = LOAD PP.
*                  6 = RESUME PP.
*                  7 = RETURN PP R REGISTER.
*                  8 = MASTER CLEAR A SPECIFIC CHANNEL.
*
*                IOU = IOU NUMBER (0 OR 1).
*                CIO = 1 IF CIO PP, ELSE 0.
*                PP = PP NUMBER.
*                ADDR = RESUME ADDRESS.
*                R-POINTER = POINTER FOR PP REGISTERS AND MEMORY IF BEING DUMPED,
*                            R REGISTER FORMAT.
*
*         EXIT   IF NO ERROR, ONE OF THE ABOVE REQUESTS IS PERFORMED.
*                TO *ERR* IF ERROR ENCOUNTERED IN REQUEST.
*
*         USES   W0 - W7.
*
*         CALLS  DPM, DPR, DPS, IDP, LRP.


          ROUTINE  PUR

          RJM    LRP         LOAD REQUEST POINTER
          CRDL   W0          WORD 0 OF DFT REQUEST
          ADN    1
          CRDL   W4          WORD 1 OF DFT REQUEST
          LDDL   W1          PP TYPE
          LPC    0#FF
          SHN    10
          STDL   T1
          LDDL   W2          PP NUMBER
          SHN    -10
          LMDL   T1
          STML   PPTN        PP TYPE AND NUMBER
          STM    PURC

*         FOR IOU1 REQUESTS, VERIFY THAT PP IS LOGICALLY ON.
*         PP WILL BE VIEWED AS LOGICALLY OFF IF IOU1 IS LOGICALLY OFF.

          LDDL   W1
          SHN    -10
          ZJN    PUR40       IF IOU0 REQUEST
          LDML   PPTN        PP TYPE AND NUMBER
          RJM    DPS         DETERMINE PP STATUS
          NJN    PUR40       IF PP IS LOGICALLY ON
 PUR30    LJM    ERR         RETURN ERROR STATUS

*         ALLOW NO OPERATION ON DFT PP.

 PUR40    LDDL   W2          EXTRACT SUBFUNCTION
          LPC    0#FF
          STDL   T3
          LMN    10B         CHECK FOR MASTER CLEAR
          ZJN    PUR50       IF MASTER CLEAR OF SPECIFIC CHANNEL
          LDML   PPTN
          LMML   //PPNO
          ZJN    PUR30       IF MATCH ON PP TYPE AND NUMBER

 PUR50    LDDL   T3          SUBFUNCTION
          SBN    TPURL
          PJN    PUR30       IF REQUEST NOT RECOGNIZED
          LDM    TPUR,T3
          STD    T2
          ZJN    PUR30       IF NO PROCESSOR FOR REQUEST
          LJM    0,T2        EXECUTE SUBFUNCTION

*         SUBFUNCTION 1 - DUMP PP REGISTERS WITHOUT IDLING PP.

 PUR60    LDDL   W7          CHECK LENGTH
          SBN    2
          MJN    PUR30       IF BUFFER WILL NOT HOLD RESULT
          RJM    DPR         DUMP PP REGISTERS
          UJN    PUR80       RETURN

*         SUBFUNCTION 2 - ONLY IDLE PP.

 PUR70    LDML   PPTN        PP TYPE AND NUMBER
          RJM    IDP         IDLE PP
 PUR80    LJM    PURX        RETURN

*         SUBFUNCTION 3 - IDLE AND DUMP PP.

 PUR90    LDDL   W7          ENSURE MINIMUM SPACE IS AVAILABLE
          SBN    100/4+2
          MJP    ERR         IF BUFFER WILL NOT HOLD MINIMUM
          LDML   PPTN
          RJM    IDP         IDLE PP
          RJM    DPR         DUMP PP REGISTERS
 PUR100   LDC    **          PP TYPE AND NUMBER
 PURC     EQU    *-1
          RJM    DPM         DUMP PP MEMORY
          UJP    PUR80       RETURN

*         SUBFUNCTION 4 - IDLE PP AND DUMP REGISTERS.

 PUR120   LDDL   W7          CHECK LENGTH
          SBN    2
          MJP    ERR         IF LENGTH INSUFFICIENT TO RETURN REGISTERS
          LDML   PPTN        PP TYPE AND NUMBER
          RJM    IDP         IDLE PP
          RJM    DPR         DUMP REGISTERS
          LJM    PURX        RETURN

*         SUBFUNCTION 5 - LOAD PP.

 PUR130   LDML   PPTN        PP TYPE AND NUMBER
          STDL   W1
          RJM    LDR         LOAD DRIVER CODE COMPLETION
          LJM    PURX        RETURN

*         SUBFUNCTION 6 - RESUME PP.

 PUR140   LDDL   W3          SET STARTING ADDRESS
          STML   RPCA
          RJM    RPC         RESTART PP (COMMON CODE)
          LJM    PURX

*         SUBFUNCTION 7 - RETURN PP R REGISTER.

 PUR150   LDDL   W4
          STML   BB+GRVA
          LDDL   W5
          STML   AA+GRVA
          LDDL   W6
          STML   AA+1+GRVA
          LDDL   JT
          STML   REQ+GRVA
          LDDL   JT+1
          STML   REQ+GRVA+1
          LDDL   JT+2
          STML   REQ+GRVA+2
          RJM    GRV         GET R REGISTER VALUE
          RJM    RCS         RESET CALL STACK
          LJM    DFT10       RETURN TO MAIN DO NOT ANSWER REQUEST HERE

*         SUBFUNCTION 8 - MASTER CLEAR CHANNEL.

 PUR160   LDM    IOUM
          SHN    -4
          LMN    4                                                                                                                 I
          NJP    ERR         IF NOT AN I4 IOU
          LDC    ENIO
          STD    RN          SETUP FOR NIO DEC
          LDM    IOUM
          LMC    0#42
          ZJN    PUR161      IF MODEL 42 IOU
          LDD    W1          GET NIO/CIO
          ZJN    PUR161      IF NIO
          LDC    ECIO
          STD    RN
 PUR161   LOCKMR SET
          READMR RDATA,I0CC  GET THE IOU DEC REGISTER
          LDDL   W2          CHANNEL NUMBER
          SHN    -10
          STML   RDATA+5
          LDML   RDATA+7
          SCN    2
          LMN    2                                                                                                     S
          STML   RDATA+7     SET CHANNEL MASTER CLEAR
          WRITMR RDATA,I0CC
          RJM    CIE         CLEAN UP DEC REGISTER
          LOCKMR CLEAR
          LJM    PURX        RETURN
 TPUR     SPACE  4,10
**        TPUR - TABLE OF PP UTILITY REQUEST SUBFUNCTION CODES.


 TPUR     BSS    0
          LOC    0
          CON    0
          CON    PUR60       DUMP PP REGISTERS
          CON    PUR70       IDLE PP
          CON    PUR90       IDLE AND DUMP PP
          CON    PUR120      IDLE PP AND DUMP REGISTERS
          CON    PUR130      LOAD PP
          CON    PUR140      RESUME PP
          CON    PUR150      RETURN PP R REGISTER
          CON    PUR160      MASTER CLEAR CHANNEL
          LOC    *O
 TPURL    EQU    *-TPUR      TABLE LENGTH
 REP      SPACE  4,10
**        REP - RESTART PP VIA HARDWARE.
*
*         ENTRY  PP NUMBER TO RESTART AND STARTING ADDRESS.
*
*         EXIT   PP STARTED TO ADDRESS.
*
*         CALLS  LRP, RPC.
*
*         NOTE   LOCATIONS 0, 1 AND (A) WILL BE DESTROYED IN TARGET PP.


          ROUTINE  REP

          RJM    LRP         LOAD REQUEST POINTER
          CRDL   W0          GET PARAMETERS
          LDDL   W2          STARTING ADDRESS
          STML   RPCA+T0     SAVE FOR BLOCK INPUT
          LDD    W1          PP NUMBER
          STM    PPTN
          RJM    RPC         RESTART PP (COMMON CODE)
          LJM    REPX        RETURN
 DPM      SPACE  4,10
**        DPM - DUMP PP MEMORY.
*
*         ENTRY  (A) = PP TYPE AND NUMBER.
*                (W4 - W7) = POINTER TO AREA FOR PP MEMORY TO BE WRITTEN
*                          IN MEMORY, R-POINTER FORMAT.
*
*         EXIT   PP MEMORY WRITTEN TO SPECIFIED AREA IN MEMORY.
*                (W4) = OFFSET IN R-POINTER UPDATED TO REFLECT WORDS WRITTEN.
*
*         USES   T1, T4, T5, T6, T7.
*
*         CALLS  DDP, SCF, SPB.


 DPM      SUBR               ENTRY/EXIT
          STD    T6          SAVE PP TYPE AND NUMBER
          LDN    D8TY
          RJM    IIB         INDEX TO INTERFACE BLOCK
          CRDL   CM          GET 180 OS INTERFACE LEVEL
          LDC    DFTPSR      GET PSR LEVEL
          SBDL   CM          SUBTRACT OS SPECIFIED LEVEL
          ZJN    DPM2        IF AT SAME LEVEL
          LDD    T6          PP NUMBER
          SHN    21-10
          PJN    DPM1        IF NIO PP
          LDC    20000/4     PP WORD SIZE CIO
          STDL   T7
          UJN    DPM3

 DPM1     LDC    10000/4     PP WORD SIZE NIO
          STDL   T7
          UJN    DPM3

 DPM2     LDDL   W7
          STDL   T7          GET SIZE FROM R POINTER
 DPM3     LDN    MX          MUX CHANNEL
          STD    T1          SAVE MUX CHANNEL FOR CALL TO *DDP*
          RJM    SCF         SET CHANNEL FLAG
          LDD    T6          PP NUMBER
          RJM    DDP         DEADSTART DUMP PP

*         LOAD R-REGISTER TO WRITE PP MEMORY TO SPECIFIED AREA.

          LRD    W5
          RJM    SPB         SET PP BOUNDARY
          LDN    100/4       WORD COUNT IN BLOCK
          STD    T3
          LDN    0
          STD    T4          TRANSFER COUNT
 DPM4     EJM    DPM2,MX     JUMP ON CHANNEL EMPTY
          LDC    100
          IAM    CBUF,MX     INPUT BLOCK OF 16 BIT PP WORDS
          LDDL   W4          OFFSET
          ADDL   T4          TRANSFER COUNT
          LMC    RR
          CWML   CBUF,T3     WRITE DATA TO BUFFER
          LDDL   T3
          RADL   T4          INCREMENT TRANSFER COUNT
          SBDL   T7          DUMP LENGTH SHORTENS
          MJN    DPM4        IF MORE WORDS TO STORE
          DCN    MX          DEACTIVATE CHANNEL
          CCF    *,15        RELEASE CHANNEL 15
          LDDL   T4          UPDATE OFFSET IN R-POINTER
          RADL   W4
          LJM    DPMX        RETURN
 DPS      SPACE  4,15
**        DPS - DETERMINE IOU1 PP STATUS.
*
*         ENTRY  (A) = 8/CIO, 8/PP.
*                WHERE CIO = 0, IF NIO PP.
*                          = 1, IF CIO PP.
*                      PP  = PP NUMBER (0 - 11, 20 - 31).
*
*         EXIT   (A) = 1, IF PP IS LOGICALLY ON.
*                    = 0, IF PP IS LOGICALLY OFF.
*
*         USES   T1, T2.
*
*         CALLS  FHE.


 DPS40    LDN    0           PP IS LOGICALLY OFF

 DPS      SUBR               ENTRY/EXIT
          STML   DPSB        SAVE PP CHARACTERISTICS
          LDC    10000+IOUID
          RJM    FHE         FIND HARDWARE ELEMENT
          MJN    DPS40       IF NOT FOUND
          LDM    HBUF+CIOST
          SHN    21-0
          MJN    DPS40       IF SECOND IOU IS LOGICALLY OFF
          LDML   DPSB        EXTRACT PP NUMBER
          LPC    0#FF
          STD    T1
          LDML   IOUM        CHECK IOU MODEL NUMBER
          LMC    0#43
          ZJN    DPS3        IF MODEL 43 IOU
          LMN    0#44&0#43
          NJN    DPS4        IF NOT MODEL 44 IOU
 DPS3     LDML   DPSB
          SHN    -10
          ZJN    DPS40       IF NIO SELECTED ON MODEL 44
          UJN    DPS6        PROCESS REQUEST FOR MODEL 44 PP AS IF NIO

 DPS4     LDML   DPSB
          SHN    -10
          NJN    DPS10       IF CIO PP
 DPS6     LDD    T1
          SBN    20
          PJN    DPS20       IF NIO 20 - 31
          LDN    CIOPLM      OFFSET TO STATUS OF NIO PP-S 0 - 11
          STD    T2
          UJN    DPS30       FORM SHIFT INSTRUCTION

 DPS10    LDN    CIOCLM      OFFSET TO STATUS OF CIO PP-S 0 - 11
          STD    T2
          UJN    DPS30       FORM SHIFT INSTRUCTION

 DPS20    STD    T1          SAVE PART OF SHIFT COUNT
          LDN    CIOPLM+1    OFFSET TO STATUS OF NIO PP-S 20 - 31
          STD    T2
 DPS30    LDC    SHNI+21     FORM SHIFT INSTRUCTION
          SBD    T1
          STM    DPSA
          LDML   HBUF,T2
          LPC    1777        USE ONLY DEFINED BITS
 DPSA     SHN    **
          MJP    DPS40       IF PP IS LOGICALLY OFF
          LDN    1           PP IS LOGICALLY ON
          UJP    DPSX        RETURN

 DPSB     BSS    1           8/CIO, 8/PP NUMBER
 LDR      SPACE  4,10
**        LDR - LOAD DRIVER CODE COMPLETION.
*
*         ENTRY  (W1) = 8/PP TYPE, 8/PP NUMBER.
*                (W4 - W7) = R-POINTER.
*
*         EXIT   TO *ERRH* IF PP LOAD ERROR.
*
*         CALLS  DLP, IDP, IIB, LRP, SCF.
*
*         MACROS EXITMR, READMR.


 LDR      SUBR               ENTRY/EXIT
          EXITMR *
          READMR RDATA,I0CC,IOSB
          LDD    W4
          STM    LDRA+LDRB   SAVE OFFSET OF R POINTER
          LDD    W5
          STM    LDRA+LDRC   SAVE R UPPER OF POINTER
          LDD    W6
          STM    LDRA+LDRC+1 SAVE R LOWER OF POINTER
          LDN    D8TY
          RJM    IIB         INDEX TO INTERFACE BLOCK
          CRDL   CM          GET 180 OS INTERFACE LEVEL
          LDC    DFTPSR      GET PSR LEVEL
          SBDL   CM          SUBTRACT OS SPECIFIED LEVEL
          ZJN    LDR20       IF AT SAME LEVEL

*         DETERMINE PP SIZE.

          LDM    S0FLG       CHECK MAINFRAME TYPE
          ZJN    LDR10       IF NOT *S0*
          LDC    37777/4     SET LOAD FOR 16K PP
          UJN    LDR25       CONTINUE

 LDR10    LDD    W1          PP NUMBER AND TYPE
          SHN    21-10       GET TYPE
          PJN    LDR30       IF NIO PP
          LDC    17777/4     SET LOAD FOR 8K CIO PP
          UJN    LDR25       CONTINUE

 LDR20    LDDL   W7          GET SIZE IN R POINTER
 LDR25    STML   LDRA+LDRD   SAVE SIZE FROM R POINTER
 LDR30    EXITMR FMR
          LDD    W1
          STM    PPTN        SAVE PP TYPE/NUMBER
          RJM    IDP         IDLE PP
          LDN    MX
          RJM    SCF         INTERLOCK TWO PORT MUX
          LDN    MX
          STD    T1
          LDM    PPTN
          RJM    DLP         DEADSTART LOAD PP
          LDN    LDRAL
          OAM    LDRA,MX
          FJM    *,MX        WAIT FOR CHANNEL EMPTY
          DCN    MX+40
          CCF    *,MX        CLEAR MUX INTERLOCK
          ZJP    LDR40       IF TRANSFER COMPLETE

*         SINCE THE TRANSFER WAS INCOMPLETE, AN ATTEMPT WILL BE MADE
*         TO IDLE THE PP.  THEN THE REQUEST WILL BE TERMINATED WITH AN
*         ERROR, AND AN ERROR MESSAGE WILL BE PLACED IN THE EICB.

          LDM    PPTN        PP TYPE/NUMBER
          RJM    IDP
          LDC    0#200       TERMINATE REQUEST WITH ERROR
          STM    JOBF
          RJM    SRS         SET REQUEST STATUS

*         DFT ANALYSIS - PP LOAD ERROR.

          SETDAN (EPUN,DALE)
          LDC    DALE        60C - PP LOAD ERROR
          STML   RTP1
          CALL   ERRH        ISSUE MESSAGE TO EICB

 LDR40    LJM    LDRX        RETURN

*         THE FOLLOWING IS A SHORT BOOT PROGRAM WHICH IS SENT TO
*         THE DESTINATION PP.  WHEN IT STARTS EXECUTING IN THE
*         DESTINATION PP, IT WILL READ THE SELECTED PP PROGRAM
*         INTO THE PP.  SINCE IT READS INTO LOCATION ZERO OF THE
*         PP, IT WILL START EXECUTING AT THE ADDRESS CONTAINED
*         IN THE PROGRAM IT IS LOADING AFTER THE READ IS COMPLETE.

 LDRA     BSS    0
          LOC    0
          CON    0
          LRD    LDRC
          LDC    RR
 LDRB     EQU    *-1
          CRML   0,LDRD

 LDRC     CON    0,0         PP R-REGISTER VALUE
 LDRD     CON    7777/4      LOAD SIZE
          LOC    *O
 LDRAL    EQU    *-LDRA      BOOT SIZE
 RPC      SPACE  4,10
**        RPC - RESTART PP (COMMON CODE).
*
*         ENTRY  (RPCA) = STARTING ADDRESS.
*                (PPTN) = 8/PP TYPE, 8/PP NUMBER.
*
*         CALLS  PFE, SCF.


 RPC      SUBR               ENTRY/EXIT
          LDN    MX
          RJM    SCF         INTERLOCK TWO PORT MUX
          LDN    MX
          STD    T1          SAVE TWO PORT MUX CHANNEL
          LDML   PPTN
          RJM    DLP         DEADSTART LOAD PP
          LDN    RPCAL       LENGTH OF BLOCK
          OAM    RPCA,MX
          FJM    *,MX        WAIT CHANNEL EMPTY
          DCN    MX+40B      DEACTIVATE CHANNEL
          CCF    *,MX        CLEAR MUX INTERLOCK
          UJP    RPCX        RETURN

 RPCA     BSS    0
          LOC    0
          CON    **          STARTING ADDRESS
          LOC    *O
 RPCAL    EQU    *-RPCA

 GRV      SPACE  4,10
**        GRV - GET R REGISTER VALUE.
*
*         THIS ROUTINE LOADS A BOOT PROGRAM IN THE TARGET PP THAT
*         READS THAT PPS R REGISTER AND WRITES THE VALUE TO A SPECIFIED
*         LOCATION IN CM.


 GRV      SUBR               ENTRY
          EXITMR FMR
          LDM    PPTN        SAVE PP TYPE/NUMBER
          RJM    IDP         IDLE PP
          LDN    MX
          RJM    SCF         INTERLOCK TWO PORT MUX
          LDN    MX
          STD    T1
          LDM    PPTN
          RJM    DLP         DEADSTART LOAD PP
          LDN    GRVAL
          OAM    GRVA,MX
          FJM    *,MX        WAIT FOR CHANNEL EMPTY
          DCN    MX+40
          CCF    *,MX        CLEAR MUX INTERLOCK
          ZJP    GRVX        IF TRANSFER COMPLETE

*         SINCE THE TRANSFER WAS INCOMPLETE, AN ATTEMPT WILL BE MADE
*         TO IDLE THE PP.  THEN THE REQUEST WILL BE TERMINATED WITH AN
*         ERROR, AND AN ERROR MESSAGE WILL BE PLACED IN THE EICB.

          LDM    PPTN        PP TYPE/NUMBER
          RJM    IDP
          LDC    0#200       TERMINATE REQUEST WITH ERROR
          STM    JOBF
          RJM    SRS         SET REQUEST STATUS

*         DFT ANALYSIS - PP LOAD ERROR.

          SETDAN (EPUN,DALE)
          LDC    DALE        60C - PP LOAD ERROR
          STML   RTP1
          CALL   ERRH        ISSUE MESSAGE TO EICB

*         THE FOLLOWING IS A SHORT BOOT PROGRAM WHICH IS SENT TO
*         THE DESTINATION PP.  WHEN IT STARTS EXECUTING IN THE
*         DESTINATION PP, IT WILL READ THE R REGISTER AND WRITE IT
*         INTO THE SPECIFIED CM AREA.

 GRVA     BSS    0
          LOC    0
          CON    0
          SRD    RRS+2
          LRD    AA
          LDDL   BB
          ADC    RR
          CWDL   RRS         WRITE R REGISTER
          LDDL   REQ
          LRD    REQ+1
          ADC    RR
          CRDL   RETR
          LDN    RCNE        REQUEST COMPLETE CODE
          SHN    10
          LMDL   RETR
          STDL   RETR
          LDDL   REQ         RE-BUILD A OFFSET
          ADC    RR
          CWDL   RETR
          UJN    *

 BB       CON    0
 AA       CON    0,0         PP R - REGISTER VALUE TO WRITE TO
 RRS      CON    0,0,0,0     R - REGISTER TO SAVE
 RETR     CON    0,0,0,0     BUFFER FOR RETURNING REQUEST STATUS
 REQ      CON    0,0,0       REQUEST POINTER
          LOC    *O
 GRVAL    EQU    *-GRVA      BOOT SIZE

 RIS      SPACE  4,10
**        RIS - READ IOU STATUS REGISTER.
*

          ROUTINE RIS        ENTRY

          READMR RDATA,I0CC,ISTR  READ STATUS REGISTER
          RJM    PAC         PACK THE DATA INTO ONE CM WORD
          RJM    LRP
          ADN    1           WRITE TO NEXT WORD
          CWML   MRVAL,ON
          LJM    RISX        EXIT




*         END    CTP$DFT PP UTILITY REQUESTS
