          EJECT
*         CTEXT  CTP$DFT RESIDENT II COMMON.
*
*         THIS DECK DEFINES ROUTINES IN RESIDENT II WHICH ARE COMMON
*         TO ALL VARIANTS OF DFT.

          QUAL   *

 BRL      SPACE  4,10
**        BRL - BUILD REGISTER LIST.
*
*         ENTRY  (A) IS REGISTER LIST TO ADD.
*                (ET) IS THE ASSOCIATED ELEMENT TYPE
*
*         EXIT   *REGL*, *REGI* UPDATED. IF LIST OVERFLOW EXIT
*                TO ERRH.
*
*         USES   T1.
*
*         NOTE:  REGISTER LIST ENTRIES ARE A TUPLE CONSISTING OF THE ELEMENT TYPE AND
*                ASSOCIATED REGISTER LIST, THUS IT IS POSSIBLE TO BUILD A REGISTER LIST
*                FOR MANY DIFFERENT ELEMENTS DEPENDING ON THE ERROR ANALYZED.


 BRL      SUBR               ENTRY/EXIT
          STM    BRLA        SAVE LIST ADDRESS
          LDM    REGI
          ADN    2
          SBN    MAXRL       MAX LIST LENGTH
          PJN    BRL1
          LDM    REGI        UPDATE LIST INDEX
          STD    T1
          LDD    ET          GET ELEMENT TYPE
          STM    REGL,T1     SAVE ET PART OF TUPLE
          AOD    T1          SAVE LIST ADDRESS PORTION OF TUPLE
          LDC    **          RETRIEVE LIST ADDRESS
 BRLA     EQU    *-1
          STM    REGL,T1
          LDN    2
          RAM    REGI        BUMP LIST INDEX
          UJN    BRLX        RETURN

*         DFT ANALYSIS - LIST SIZE BIGGER THAN ALLOCATED SIZE.

 BRL1     SETDAN (EPUN,DASE)
          LDC    TDFT+DASE   60B - DFT BRL SIZE ERROR
          STML   RTP1
          CALL   ERRH        ISSUE MESSAGE AND HANG
 CKF      SPACE  4,10
**        CKF - CHECK OS FLAGS FOR APPLICABILITY.
*
*         ENTRY  FLAGS SET IN SCRATCH BUFFER CONTROL WORD FROM *SETFLG*
*                MACRO.
*
*         EXIT   ONLY THOSE FLAGS WHICH MAKE SENSE IN THE GIVEN DFT
*                ENVIRONMENT WILL REMAIN SET.  VALID 170 FLAG WILL BE
*                SET IN 170 STANDALONE.  IT WILL ALSO BE SET IN
*                DUAL STATE IF THE ERROR IS NOT FROM IOU1.  VALID 180
*                FLAG WILL BE SET IN DUAL STATE OR 180 STANDALONE.
*
*         CALLS  IDA, IIB.


 CKF      SUBR               ENTRY/EXIT
          LDN    HDRP
          RJM    IDA
          CRML   CKFA,ON     GET DFT HEADER
          LDM    CKFA+DHFLG  GET FLAGS PORTION
          SHN    21-DH.FL
          PJN    CKF1        IF NOS/VE OR DUAL STATE
          LDDL   BC+BCFLG    GET FLAGS IN SCRATCH BUFFER CONTROL WORD
          SCN    2           WE ARE ONLY IN 170 STANDALONE
          STDL   BC+BCFLG
          UJN    CKFX        RETURN

 CKF1     LDN    D7TY        170 DEADSTART TYPE
          RJM    IIB
          CRML   CKFA,ON     GET 170 DEADSTART TYPE FROM EICB
          LDML   CKFA+3
          SHN    -14         GET 4 LEAST SIGNIFICANT BITS OF TYPE
          ZJN    CKF2        IF WE ARE IN 180 STANDALONE
          LDD    ET
          LMN    IOUID
          NJN    CKFX        IF NOT IOU ELEMENT
          LDM    IOUO
          ZJN    CKFX        IF IOU0
 CKF2     LDDL   BC+BCFLG
          SCN    1           CLEAR 170 VALID DATA FLAG
          STDL   BC+BCFLG
          UJP    CKFX        RETURN

 CKFA     BSSZ   4           BUFFER FOR 1 CM WORD
 CLR      SPACE  4,10
**        CLR - CLEAR BUFFER AREA.
*
*         ENTRY  (A) = FWA OF DIRECT CELLS TO CLEAR.
*
*         EXIT   ((A) - (A)+3) = 0.
*
*         USES   T1.


 CLR      SUBR               ENTRY/EXIT
          STD    T1
          LDN    0
          STI    T1
          STM    1,T1
          STM    2,T1
          STM    3,T1
          UJN    CLRX        RETURN
 FMB      SPACE  4,10
**        FMB - FIND MAINTENANCE REGISTER IN SCRATCH BUFFER.
*
*         ENTRY  (A) = MAINTENANCE REGISTER TO FIND.
*
*         EXIT   (A) AND (R) SET FOR ACCESS.
*
*         CALLS  IMB.
*
*         NOTE   THIS ROUTINES USES NO DIRECT CELLS, AS IT IS CALLED
*                FROM A WIDE VARIETY OF ENVIRONMENTS.


 FMB      SUBR               ENTRY/EXIT
          STML   FMBB        SAVE REGISTER TO BE FOUND
          LDN    0           INITIALIZE FOR FIRST REGISTER GROUP
          STML   FMBC

*         READ NEXT HEADER WORD.

 FMB1     RJM    IMB         READ HEADER WORD
          CRML   FMBD,ON
          LDC    FMBD        INITIALIZE SEARCH LOOP
          STML   FMBA

*         CHECK IF REGISTER IS IN THIS REGISTER GROUP.

 FMB2     LDML   **          CHECK NEXT REGISTER DESCRIPTOR
 FMBA     EQU    *-1         (HEADER BYTE TO CHECK)
          LPC    0#FFF       FOR NOW EXCLUDE THE TYPE CODE FROM EXAMINATION
          LMML   FMBB
          ZJN    FMB3        IF REGISTER FOUND
          AOML   FMBA
          LMC    FMBD+4
          NJN    FMB2        IF MORE BYTES IN CURRENT HEADER WORD
          LDN    5           ADVANCE TO NEXT HEADER WORD
          RAML   FMBC
          SBML   LBUF        SUBTRACT LENGTH OF BUFFER FROM PRESENT LOCATION
          ZJN    FMB4        IF AT END OF BUFFER
          LDML   FMBC
          UJN    FMB1        LOOP

*         SET RETURN PARAMETERS FOR REGISTER ADDRESS IN GROUP.

 FMB3     LDML   FMBC        SET OFFSET FOR REGISTER GROUP
          ADN    1
          ADML   FMBA        INCLUDE WORD OFFSET IN FOUR REGISTER GROUP
          ADC    -FMBD
          RJM    IMB         SET (A) AND (R) FOR ACCESS
          LJM    FMBX        RETURN

*         REGISTER NOT FOUND DURING SEARCH.

*         DFT ANALYSIS - REGISTER NOT FOUND DURING SEARCH.

 FMB4     SETDAN (EPUN,DARE)
          LDC    DARE+TDFT   607 - DFT REG NOT IN MRB
          STML   RTP1
          CALL   ERRH


 FMBB     BSS    1           REGISTER TO LOCATE
 FMBC     BSS    1           HEADER ADDRESS IN BUFFER
 FMBD     BSS    4           HEADER WORD BUFFER
 GCM      SPACE  4,10
**        GCM - GET CM RESIDENT WORD.
*
*         ENTRY  (A) = OFFSET TO DESIRED CM WORD.
*
*         EXIT   (CM - CM+3) = REQUESTED CM WORD.
*
*         USES   CM - CM+3.
*
*         CALLS  IDA.


 GCM      SUBR               ENTRY/EXIT
          STDL   T0
          LDK    DCMP        GET POINTER TO CM AREA
          RJM    IDA
          CRDL   CM
          LRD    CM+1        READ DESIRED WORD
          LDDL   CM
          ADDL   T0
          ADC    RR
          CRDL   CM
          UJN    GCMX        RETURN
 ICC      SPACE  4,10
**        ICC - INCREMENT CM BASED COUNTER.
*
*         ENTRY  (A) = 4/OFFSET TO CM WORD, 12/BYTE DESIGNATOR.
*
*         USES   T1, T2.
*
*         CALLS  GCM, PCM, VCK.


 ICC      SUBR               ENTRY/EXIT
          STD    T2          SAVE BYTE DISGNATOR
          SHN    -14
          STD    T1          SAVE OFFSET TO CM WORD
          LDN    VER4
          RJM    VCK         CHECK VERSION
          MJN    ICCX        IF NOT VERSION 4
          LDD    T1
          RJM    GCM         GET CM RESIDENT WORD
          AOIL   T2          INCREMENT COUNTER
          LDD    T1
          RJM    PCM         PUT CM RESIDENT WORD
          UJN    ICCX        RETURN
 IHS      SPACE  4,10
**        IHS - INITIATE CPU/PP HANDSHAKE.
*
*         EXIT   (DFTE) = *LDN 1*.


 IHS      SUBR               ENTRY/EXIT
          LDC    LDNI+1
          STM    DFTE
          UJN    IHSX        RETURN
 DPD      SPACE  4,10
**        DPD - DUMP PP REGISTER DATA.
*
*


 DPD      SUBR               ENTRY/EXIT
          LDC    LDNI+1
          STM    DFTF
          UJN    DPDX        RETURN
 LRP      SPACE  4,10
**        LRP - LOAD REQUEST POINTER.
*
*         ENTRY  (JT - JT+2) = R-POINTER VALUE.
*
*         EXIT   R-REGISTER LOADED.
*                (A) = (JT) + 400000.


 LRP      SUBR               ENTRY/EXIT
          LRD    JT+1
          LDDL   JT
          ADC    RR
          UJN    LRPX        RETURN
 PCM      SPACE  4,10
**        PCM - PUT CM RESIDENT WORD.
*
*         ENTRY  (A) = OFFSET TO DESIRED CM WORD.
*                (CM - CM+3) = CONTENTS OF WORD TO WRITE.
*
*         USES   T4 - T7.
*
*         CALLS  IDA, SPB.


 PCM      SUBR               ENTRY/EXIT
          STML   PCMB
          LDK    DCMP        GET POINTER TO CM AREA
          RJM    IDA
          CRDL   T4
          LRD    T5          SET R-REGISTER FOR *SPB* CALL
          LDD    T4          SAVE OFFSET
          STM    PCMA
          RJM    SPB         SET PP BOUNDS
          LDC    **          OFFSET
 PCMA     EQU    *-1
          ADC    **          OFFSET TO CM WORD
 PCMB     EQU    *-1
          ADC    RR
          CWDL   CM
          UJN    PCMX        RETURN
 SEC      SPACE  4,10
**        SEC - PROCESS ONCE-PER-SECOND ITEMS.
*
*         ENTRY  ONCE PER SECOND FROM *TIM*.
*
*         EXIT   (UETV) = 1.
*                (TSIT) = 1.
*                (DRCR) = 1.
*                (CPSA) = 1.
*                (PKTIM) UPDATED IF LOADING *DFT-S*.
*
*         USES   *STIM*, *TIMU*.
*
*         CALLS  ICC.


 SEC      SUBR               ENTRY/EXIT

*         SET FLAGS FOR VARIOUS PROCESSES.

          LDN    1           SET DFT/SCI RELOCATION CHECK REQUIRED
          STM    DRCR
          AOM    CPSA        SET CHECK-IN PACKET FLAG
          AOM    TSIT        SET FLAG TO CHECK *SIT*
          LDM    IOUN
          NJN    SEC1        IF NOT IOU0
          LDN    1           SET FLAG TO CALL UWE (FLAG CLEARED IN UWE)
          STM    UETV
 SEC1     LDM    STIM        CHECK FOR TIMEOUT VALUE
          ZJN    SEC2        IF NO TIMEOUT VALUE
          SOM    STIM        DECREMENT TIMER FOR THIS MODE
          NJN    SEC2        IF NOT YET TIMED OUT
          LDN    1
          STM    TIMU        SET TIME DELAY HAS EXPIRED

 SEC2     LDML   PKTIM
          ZJN    SECX        IF NOT TIMING PACKET RESPONSES
          AOML   PKTIM       INCREMENT WAITING TIME
          LPC    7777
          SBN    5
          MJN    SEC3        IF WAITING TIME NOT ELAPSED
          SBN    5
          PJN    SEC2.5      IF TIME ELAPSED REGARDLESS OF MAINFRAME TYPE
          LDM    S0FLG
          NJN    SEC3        IF TIME NOT ELAPSED FOR 93X CLASS
 SEC2.5   LDML   PKTIM       SET TIME OUT FLAG
          SHN    -14
          ADC    TPKT-1
          STD    T1
          LDC    PKWTO
          RAIL   T1
          LDN    0           RESET PACKET TIMING WORD
          STML   PKTIM
          LDC    CMTO*10000+CM+2
          RJM    ICC         INCREMENT CM BASED COUNTER
 SEC3     UJP    SECX        RETURN
 SET      SPACE  4,10
**        SET - SET BUFFER TO ONES.
*
*         ENTRY  (A) = ADDRESS OF BUFFER.
*
*         EXIT   ((A) - (A)+3) = 0#FFFF.
*
*         USES T1.


 SET      SUBR               ENTRY/EXIT
          STD    T1
          LDC    0#FFFF
          STIL   T1
          STML   1,T1
          STML   2,T1
          STML   3,T1
          UJN    SETX        RETURN
 SRS      SPACE  4,10
**        SRS - SET REQUEST STATUS.
*
*         ENTRY  (JOBF) = OS REQUEST STATUS.
*
*         EXIT   REQUEST UPDATED WITH STATUS.
*                (R170) = 0.
*
*         USES   CM - CM+3, W0 - W0+7, *R170*.
*
*         CALLS  IDA, LRP, SPB.


 SRS      SUBR               ENTRY/EXIT
          LDM    IOUN
          ZJN    SRS1        IF DFT IS RUNNING IN IOU0
          LDN    NVEP        CLEAR THE LENGTH FIELD OF NOS/VE POINTER
          RJM    IDA         INCREMENT DFT ADDRESS
          CRDL   W0
          LDN    0
          STML   W3
          RJM    SPB         SET PP BOUNDS
          LDN    NVEP
          RJM    IDA         INCREMENT DFT ADDRESS
          CWDL   W0
 SRS1     RJM    LRP
          CRDL   CM
          RJM    SPB         SET PP BOUND
          LDD    CM
          LPN    77
          ADM    JOBF        JOB STATUS FLAG
          STD    CM
          RJM    LRP
          CWDL   CM
          LDM    R170        REQUEST WAS 170 ORIGIN
          ZJP    SRSX        IF NOT
          LDN    OSRP
          RJM    IDA
          CRDL   W0          FETCH POINTER TO OS REQUESTS
          LRD    W1          POINTER TO REQUEST
          LDD    W0
          ADC    RR
          CRDL   W4          READ IN REQUEST POINTER
          LDN    0
          STD    W7          CLEAR ACTIVE REQUEST
          LDD    W0
          ADC    RR
          CWDL   W4          UPDATE STATUS FIELD IN REQUEST POINTER
          LDN    0
          STM    R170        CLEAR 170 REQUEST FLAG
          LJM    SRSX        RETURN
 SSE      SPACE  4,10
**        SSE - SET SECONDARY ELEMENT IDENTIFIER.
*
*         ENTRY  (A) = ELEMENT ORDINAL.
*
*         USES   W0 - W3.
*
*         CALLS  FMB, SPB.


 SSE      SUBR               ENTRY/EXIT
          ZJN    SSEX        IF ELEMENT ZERO
          LDN    EIMR
          RJM    FMB         FIND MAINTENANCE REGISTER IN SCRATCH BUFFER
          CRDL   W0          GET *EID* REGISTER
          LDD    W2
          LMC    0#1000      SECONDARY ELEMENT IDENTIFIER
          STDL   W2
          LRD    DP+1
          RJM    SPB         SET PP BOUNDS
          LDN    EIMR
          RJM    FMB         FIND MAINTENANCE REGISTER IN SCRATCH BUFFER
          CWDL   W0          REWRITE *EID* REGISTER
          UJP    SSEX        RETURN
 IBW      SPACE  4,10
**        IBW - INCREMENT BUFFER CONTROL WORDS POINTER
*
*         ENTRY  (RTP1) = 1 = USE NON REGISTER STATUS BUFFER.
*                       = 0 = USE BUFFER CONTROL WORDS.
*                    (A)= INDEX DESIRED.
*
*         EXIT   R REGISTER AND A OFFSET SETUP TO READ A
*                PARTICULAR BUFFER CONTROL WORD
*
*         CALLS  IDA, VCK.
*
*         USES   W0 - W3.


 IBW      SUBR               ENTRY/EXIT
          STML   IBWA        SAVE CONTROL WORD INDEX
          LDN    0
          STM    IBWB
          LDN    VER4
          RJM    VCK         CHECK VERSION
          MJN    IBW1        IF LESS THAN VERSION 4
          LDM    RTP1
          NJP    IBW3        IF TO USE NON REGISTER STATUS BUFFER
          LDML   IBWA
          ADD    BW
          LRD    BW+1
          ADC    RR
          UJN    IBWX        RETURN

 IBW1     LDML   IBWA
          ADM    NUMHW
          RJM    IDA
          UJN    IBWX        RETURN

 IBW3     SOML   IBWA
          MJN    IBW4        IF REQUESTED INDEX FOUND
          LDML   SNRB        SIZE OF NON REGISTER BUFFER ENTRY
          RAML   IBWB
          UJN    IBW3        CONTINUE

 IBW4     LDN    NRSP        GET ADDRESS OF NON REGISTER BUFFER
          RJM    IDA         INCREMENT DFT POINTER ADDRESS
          CRDL   W0
          LDD    W0          ADD IN A OFFSET
          ADML   IBWB        ADD IN OFFSET TO CURRENT CONTROL WORD
          LRD    W1
          ADC    RR+1
          UJP    IBWX        RETURN

 IBWA     CON    0           STORAGE FOR BUFFER CONTROL WORD INDEX
 IBWB     CON    0           OFFSET TO REQUESTED CONTROL WORD IN NRSB
          EJECT

 STEP$    IF     DEF,STEP$   ASSEMBLE *STEP* CONDITIONALLY
 STEP     SPACE  4,10
**        STEP - STOP AT VARIOUS ADDRESSES TO ALLOW FOR PROGRAM DEBUGGING.
*
*
*                WRITING THE ADDRESS OF THE INSTRUCTION IMMEDIATELY FOLLOWING
*                THE RJM TO STEP TO CM ADDRESS 2 WILL CAUSE THE PROGRAM TO GO
*                INTO STEP MODE.  IT WILL REMAIN HERE UNTIL THE ADDRESS IS
*                CHANGED TO THE NEXT DESIRED STEP.  CLEARING CM ADDRESS 2 WILL
*                DISABLE STEP UNTIL REQUIRED AGAIN.
*
*                CENTRAL MEMORY LOCATION 1 IS USED.
*
*                TO USE STEP, INSERT *RJM STEP* WHEREVER A BREAKPOINT IS DESIRED.


 STEP     SUBR               ENTRY/EXIT
          STML   STEPB
          SHN    -16D
          STML   STEPC
 STEP1    LDN    2
          CRML   STEPA,ON
          LDML   STEPA+3
          LMML   STEP
          ZJP    STEP1
          LDML   STEPC
          SHN    16D
          LMML   STEPB
          UJN    STEPX

 STEPA    CON    0,0,0,0
 STEPB    CON    0
 STEPC    CON    0

 STEP$    ENDIF

*         END    CTP$DFT RESIDENT II COMMON
