          EJECT
*         CTEXT  CTP$DFT PP REQUESTS RELOCATION.
*
*         THIS DECK PROVIDES CODE TO SUPPORT PP RELOCATION
*         WHICH IS DONE ONLY ON S0/S0E MAINFRAMES.
 CRQ      SPACE  4,10
**        CRQ - CHECK FOR RELOCATION REQUEST.
*
*         EXIT   (*DRCR*) = 0.
*                NO ACTION TAKEN IF EICB LEVEL < 4.
*                *SCI* RELOCATED IF REQUESTED.
*                *DFT* IDLED IF REQUESTED.
*
*         USES   T1, W0 - W3.
*
*         CALLS  DCD, IIB, RSC.


          ROUTINE  CRQ

          LDN    0           CLEAR MAIN LOOP FLAG
          STM    DRCR
          RJM    DCD         DETERMINE IF CPU/PP COMMUNICATION BLOCK DEFINED
          ZJP    CRQX        IF NO POINTER OR EICB REVISION < 04

*         CHECK RELOCATION CONTROL WORD.

          LRD    W4+1
          LDD    W4          READ RELOCATION CONTROL WORD
          ADC    RR
          CRDL   W0
          LDD    W0          IGNORE UPPER BITS (INITIALIZE FLAG)
          SCN    77
          ADDL   W0+1
          SCN    77
          ZJP    CRQX        IF NO REQUESTS PRESENT

*         PROCESS *SCI* FLAGS.

          LDD    W0+1        CHECK SCI FLAGS
          SHN    21-10
          MJN    CRQ3        IF *SCI* DELIBERATELY DIED
          SHN    21-7-21+10
          MJN    CRQ2        IF *SCI* READY TO BE RELOCATED
          SHN    21-6-21+7
          PJN    CRQ3        IF *REQUEST SCI IDLE* NOT PENDING
          LDM    CRQA        CHECK TIMER VALIDITY
          NJN    CRQ1        IF TIMER ACTIVE
          LDN    10D+1       INITIALIZE 10 SECOND TIMER
          STM    CRQA
 CRQ1     SOM    CRQA        DECREMENT TIMER
          NJP    CRQX        IF TIMER NOT EXPIRED

*         RELOAD *SCI*.

 CRQ2     RJM    RSC         RELOCATE *SCI*
          LRD    W4+1        REREAD RELOCATION CONTROL WORD
          LDD    W4
          ADC    RR
          CRDL   W0
          LDDL   W0+1        CLEAR ALL *SCI* FLAGS
          LPN    77
          STDL   W0+1

*         PROCESS *DFT* FLAGS.

 CRQ3     LDD    W0          PROPAGATE *REQUEST DFT IDLE* TO *DFT IDLED*
          LPC    100
          SHN    1
          RADL   W0
          LDD    W4          REWRITE RELOCATION CONTROL WORD
          ADC    RR
          CWDL   W0
          LDDL   W0
          SHN    21-6
          PJP    CRQX        IF *REQUEST DFT IDLE* NOT SET
          UJN    *           WAIT FOR *SCI* TO IDLE PP

 RSC      SPACE  4,10
**        RSC - RELOCATE *SCI*.
*
*         ENTRY  (W0 - W0+3) = RELOCATION CONTROL WORD.
*
*         EXIT   *SCI* RELOCATED.
*
*         CALLS  IIB, PFE.
*
*         USES   T1, W0 - W3.
*
*         MACROS FINDCM.


 RSC      SUBR               ENTRY/EXIT

*         IDLE EXISTING COPY OF *SCI*.

          LDD    W0+1        SET NEW PP NUMBER FOR *SCI*
          LPN    77
          STM    RSCA
          LDN    D8ST        SET PRESENT PP NUMBER FOR *SCI*
          RJM    IIB
          CRDL   W0
          LDDL   W0+2
          SHN    -10
          STM    RSCA+1
          STM    PPTN
          RJM    IDP         IDLE EXISTING COPY OF *SCI*

*         UPDATE *EICB* TO REFLECT NEW *SCI* PP NUMBER.

          LDDL   W0+2        UPDATE *SCI* PP NUMBER
          LPC    0#FF
          STDL   W0+2
          LDM    RSCA
          STM    PPTN
          SHN    10
          RADL   W0+2
          LDN    D8ST        REWRITE *EICB* WITH UPDATED PP NUMBER
          RJM    IIB
          CWDL   W0

*         INITIALIZE DIRECT CELLS IN BOOTSTRAP IMAGE.

          FINDCM SCI         LOCATE *SCI* IN THE CIP DIRECTORY
          ADN    1
          STML   RSCB+DE     SAVE ADDRESS OF *SCI* DIRECTORY ENTRY
          CRML   RSCB+T1,ON
          LDD    CM+1
          STML   RSCB+DE+1
          LDD    CM+2
          STML   RSCB+DE+2
          LDN    DSEBP       SAVE ADDRESS OF *CIP* DIRECTORY
          RJM    IIB
          CRML   RSCB+CD,ON
          LDM    RSCA        SAVE PP NUMBER
          LMC    4000        SET RESTART FLAG
          STM    RSCB+27

*         ACTIVATE NEW COPY OF *SCI*.

          LDM    PPTN
          RJM    IDP         IDLE PP
          LDN    MX          GET MUX CHANNEL INTERLOCK
          RJM    SCF
          LDN    MX          USE MUX CHANNEL FOR DEADSTARTING THE PP
          STD    T1
          LDM    PPTN        LOAD SELECTED PP
          RJM    DLP
          LDN    RSCBL       OUTPUT BOOTSTRAP TO PP
          OAM    RSCB,MX
          FJM    *,MX        WAIT FOR PP TO ACCEPT DATA
          DCN    MX+40
          CCF    *,MX        RELEASE CHANNEL INTERLOCK
          LJM    RSCX        RETURN

 RSCA     BSS    2

 RSCB     BSS    0           BOOTSTRAP PROGRAM
          LOC    0

          CON    BTS-1       ADDRESS - 1 TO EXECUTE

 T1       BSS    4           DIRECTORY ENTRY

 BTS      LDD    T1          SET PP LOAD ADDRESS
          STD    BTSA
          LDD    DE          SET CM LOAD ADDRESS
          ADC    RR+1
          LRD    DE+1
          CRML   **,T2       READ PROGRAM INTO PP
 BTSA     EQU    *-1         (LOAD ADDRESS)
          LJM    100         ENTER *SCI* PRESET

          BSS    30-*

 DE       BSS    3           ADDRESS OF *SCI* DIRECTORY ENTRY
          BSS    1           (USED ONLY FOR CTI/MDD LOADS)
 CD       BSS    3           ADDRESS OF *CIP* DIRECTORY
          BSS    1           (UNUSED - REQUIRED BY *CRML* INTO *CD*)
          LOC    *O
 RSCBL    EQU    *-RSCB      LENGTH OF BOOTSTRAP
 PPTN     CON    0           PP TYPE AND NUMBER
*COPY DSI$930_DUMP_LOAD_IDLE_PP

*         END    CTP$DFT PP REQUESTS RELOCATION
