*M*      HANDLERS CR,TY,LP,DC,DP HANDLERS; COMMAND LIST BUILDER; GENERAL FAULT C
*        705537   SIGMA 5/7         BPM  STANDARD DEVICE HANDLERS
*        CREATED 12/29/71  PJH
*
*
ANSPROC  SET      1                 RURN ON ANSS MODE
*
*
BITS     SET      1
         SYSTEM   UTS
         PAGE
*
*    EXTERNAL DEFINITIONS AND REFERENCES
*
HANDLERS: RES
         DEF      HANDLERS:         PATCHING DEF
         DEF      DISCIO,DISCCU,CRDIN,CRDINCU,PRTOUTL
         DEF      PRTOUT,PRTCU,KBTIO,KBTCU,COMLIST,CHGMOD
         DEF      USECOM,DELCOM,REPCOM,IOSERCK,IOSEREC,RE:ENT
         DEF      DOTDC,4CHAR,XEOD
         DEF      RMARET,RMARET1,SPECHK
         DEF      NBYT2
*
         REF      DCT1,DCT3,DCT4,DCT5,DCT7
         REF      GETDEVAD
         REF      YC                DATA OF X'C0000000'
         REF      IOARS             GET ARS ROUTINE IN IOQ
         REF      AVRTBLSIZ         * USED TO TEST # OF TAPES IN SYS
         REF      S:SWSTAT
         REF      XE7               DATA OF X'000000E7'
         REF      DCT9
         REF      DCT10,DCT12,DCT13,DCT16,DCT17
         REF      DCT19,DCT20,DCT21
         REF      DCT25
         REF      IOQ5,IOQ6,IOQ8,IOQ14
         REF      IOQ9,IOQ11,IOQ12
         REF      MSG2,MSG3,MSG4,MSG5,MSG7
         REF      IOSST,IOSCU,RESCHED
         REF      XFE
         REF      XFF
         REF      Y15
         REF      YA
         REF      YFF
         REF      YFFFF             DATA X'FFFF0000'
         SREF     ANSFLGS
         REF      ERRLOG
         REF      XFFFF00
         REF      RMAPOLL
         REF      TB:FLGS
         REF      Y6
         REF      :DP
         REF      SWAP%PRI
         REF      IOQ13
         REF      M:RDCK
         REF      DCT24
         PAGE
*
*   REGISTER DEFINITIONS
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
BIT8     EQU      1**23
BIT9     EQU      1**22
BIT10    EQU      1**21
BIT11    EQU      1**20
BIT12    EQU      1**19
BIT13    EQU      1**18
BIT14    EQU      1**17
BIT15    EQU      1**16
BIT17    EQU      1**14
BIT20    EQU      1**11
         PAGE
*
*    TABLE GENERATION DIRECTIVES
*
:DOT     COM,8,8,8,8       BA(AF(1))-BA(DOT),AF(2),AF(3),AF(4)
:CLST    COM,8             DA(AF(1))-DA(DOT)
:CDW     COM,8,24,8,8,8,8  AF(1),AF(2),AF(3),0,AF(4),AF(5)
         PAGE
************************************************************************
*    TYPEWRITER HANDLER POST-PROCESSOR                                 *
************************************************************************
KBTCU    LI,R12   1                 NORMAL COMPLETION
         LI,R13   0                 NO MESSAGE
         LB,R8    DCT3,R1           DCTSWITCHES
         CI,R8    X'18'             TIME OUT OR SIO FAILURE
         BAZ      KBTCU1            NOPE-> ALRIGHT
         LW,R5    R8                <MASK OFF TIME OUT
         AND,R5   XE7               <AND SIO FAILURE BITS
         STB,R5   DCT3,R1           <REPLACE IT
         WD,0     X'41'             AND TURN ON THE AUDIBLE ALARM
         B        KBTCU2            JUMP TO MERGE
KBTCU1   EQU      %
         WD,0     X'40'             TURN OFF ALARM IF NO ERROR
KBTCU2   EQU      %
         LD,R10   DCT13,R1          GET TDV INFO
         AND,R11  M16               RBC
         LW,R5    10                DA OF LAST USED CDW
         SLS,5    1                 INTO WA
         INT,7    1,5               GET BYTE COUNT
         SW,7     11                SUBTRACT RBC
         LW,5     0,5               GET BYTE ADDRS OF USERS BUFFER
         AND,R5   M24               MASK OFF ANY GARBAGE
         LW,R0    R5                COPY BA OF BUFFER
         LB,R9    IOQ5,R3           GET FUNCTION STEP
         CI,R9    3                 EDITING
         BANZ     IOSCU             NO
         CI,R8    X'18'             CHECK FOR TIMEOUT OR SIO FAIL
         BAZ      %+3               NO
         LI,R9    X'15'             NEW LINE CODE
         STB,R9   0,R5              RETURN IT IN BUFFER
KBTIO1   LB,R9    0,R5              PICK UP BYTE
         CI,R9    8
         BE       KBTIO5            GO RETRY IF EOM
         CI,R9    X'15'
         BNE      KBTIO4            BR IF NOT NEW LINE
         BAL,R5   4CHAR             GET 4 CHARS
         CW,R0    XEOD              IS IT BANG EOD
         BNE      IOSCU             NO
         LI,R12   6                 YES, SET TYC = EOD
         B        IOSCU
KBTIO4   CI,R9    'ž'               IS IT A BACKSPACE?
         BNE      KBTIO4C           BR IF NOT
         AI,R7    -1                BDR INDEX -> MBS COUNT
         CW,R5    R0                FIRST CHAR IN BUFFER?
         BE       KBTIO4A           YES - NOTHING BEFORE IT!
         AI,R5    -1                BACK UP 1 = DESTINATION
         STB,R7   R5                STORE BYTES LEFT IN BUFFER
         MBS,R5   2                 SOURCE=DEST+2 (SHIFT 2 LEFT)
         LI,R9    2                 RECSIZE DROPS BY 2 BYTES
         B        KBTIO4B           GO FIX POINTER
KBTIO4A  STB,R7   R5                STORE BYTE COUNT
         MBS,R5   1                 SHIFT BUFFER LEFT BY 1
         LI,R9    1                 RECSIZE DROPS BY 1 BYTE
KBTIO4B  SW,R5    R7                RESTORE POINTER
         LD,R10   DCT13,R1          GET THE TDV INFO
         AW,R11   R9                BUMP RBC (SHORTEN THE RECORD)
         STD,R10  DCT13,R1          PUT IT BACK.
         AI,R7    1                 RESTORE BDR COUNT
         B        %+2               SKIP BUFFER INCREMENT
KBTIO4C  AI,R5    1                 ADVANCE PICKUP INDEX
         BDR,R7   KBTIO1            GO BACK FOR NEXT BYTE
         LI,R12   X'6000'           SET FOLLOW-ON (WRITE NEW LINE)
         B        IOSCU             RETURN TO CLEANUP
KBTIO5   LI,R12   X'C000'           RETRY
         B        IOSCU
         PAGE
************************************************************************
*    COMMAND LIST OFFSETS FOR TYPEWRITER                               *
************************************************************************
*
*
KBTIO    BAL,R10  COMLIST           ESTABLISH DOT TABLE ADDRESS
DOTTY    EQU      %
DOT      SET      %
         :DOT     TYRE,12,4,5       0 => READ WITH EDITING
         :DOT     TYWD,4,0,0        1 => WRITE
         :DOT     TYWN,4,0,0        2 => WRITE WITH DEVICE NAME
         :DOT     TYRNE,12,0,0      3 => READ WITHOUT EDITING
         :DOT     TYRER,12,4,5      4 => READ WITH EDITING RETRY
         :DOT     TYWNL,1,0,0       5 => WRITE N/L
         :DOT     TYWNT,4,0,0       6 => WRITE DEVICE NAME TABBED
************************************************************************
*    COMMAND LIST FOR TYPEWRITER                                       *
************************************************************************
TYRE     :CLST    RDTYE
TYWD     :CLST    WRBNC
TYWN     :CLST    WRCR
         :CLST    WRTYDC
         :CLST    WRBNC
TYRNE    :CLST    RDBNC
TYRER    :CLST    WRNLC
         :CLST    RDTYE
TYWNL    :CLST    WRNLNC
TYWNT    :CLST    WRCR3T
         :CLST    WRTYDC
         :CLST    WRBNC
*
         BOUND    4
         PAGE
************************************************************************
*    CARD READER PRE-PROCESSOR                                         *
************************************************************************
CRDIN    LI,R9    0                 BIN MODE FUNC CODE
         LB,R8    DCT5,R1           DCT SWITCHES
         CI,R8    1                 WHICH MODE
         BANZ     %+2               BIN
         LI,R9    2                 AUTO
*
         BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**
*
         STB,R9   IOQ5,R3           SET FUNC CODE
*
         ENABLE                                             **ENABLE**
*
         LI,R10   DOTCR
         B        COMLIST           GO BUILD COMMAND LIST
************************************************************************
*    CARD READER HANDLER POST-PROCESSOR                                *
************************************************************************
CRDINCU  BAL,R9   IOSERCK           CHECK FOR ERRORS
         B        CU50              ERROR
         CI,R8    X'6800'           TIO--DEVICE BUSY &/OR UNUSAL END
         BAZ      CU8               NO
         BAL,R9   IOSEREC           LOG ERROR
         B        CU50              TELL OPR.
CU8      LW,R9    IOQ6,R3           OLD FUNC CODE
         LB,R9    R9                TO LOW ORDER
         CI,R9    1                 CHECK IF DIRECT
         BANZ     IOSCU             YES, DONE
CU10     BAL,R5   4CHAR             GET 4 CHARS
*
         LB,R9    DCT5,R1           DCT SWITCHES(2)
         LI,R7    0                 FOR BCD
         CI,R9    1                 IS MODE BCD
         BAZ      CU11              YES--WE'RE IN THE BCD MODE
         LI,R7    3                 NO---WE'RE IN THE BIN MODE
         B        CU12              JUMP
CU11     EQU      %
         LB,R6    0,R6              GET NEXT BYTE FROM CARD INCOMING
         CI,R6    X'40'             IS NEXT CHAR A BLANK
         BNE      CU40              NO--CANNOT BE A CONTROL COMMAND
CU12     EQU      %
         CW,R0    XEOD,R7           IS IT BANG EOD
         BNE      CU20              NO
         LI,R12   6                 YES, SET TYC = EOD
         B        IOSCU
*
CU20     CW,R0    XEOD+1,R7         IS IT BANG BIN
         BNE      CU30              NO
         OR,R9    X1                YES, SET MODE BIN
         LI,R6    X'20000'          FOR DCB AND CONTIN.
         B        CU32
*
CU30     CW,R0    XEOD+2,R7         IS IT BANG BCD
         BNE      CU40              NO
         AND,R9   XFE               YES, SET MODE BCD
         LI,R6    2                 FOR DCB AND CONTIN.
CU32     BAL,R13  CHGMOD            CHANGE MODE IN DCT AND DCB
         LI,R12   X'4000'           SET FOLLOW-ON
         B        IOSCU
*
CU40     LW,R6    R9                GET MODE
         SLS,R6   17                SHIFT FOR DCB
         BAL,R13  CHGMOD            SET MODE IN DCB
         B        IOSCU
*
CU50     AI,R12   X'1000'           SET KEYIN REQUIRED
         AND,R11  M16               EXTRACT BYTE COUNT FROM STATUS
         SH,R11   IOQ9,R3           SUBTRACT REQUESTED COUNT
         CI,R11   -3                CHECK FOR THRE OR MORE BYTES
         BLE      IOSCU             YES, CARD WAS PICKED AND READ
         CI,R8    X'2200'           DO WE HAVE A JAM       27394-F00
         BAZ      %+2                NO, VALIDITY ERROR    27394-F00
         LI,R13   FERMSG              YES, TRUE FEED ERR   27394-F00
*C*               THAT'S TO CATCH BAD BINARY IN COLS 1-3   27394-F00
*
         B        IOSCU             AND BACK TO QUEUE
*
XEOD     TEXT     '!EOD!BIN!BCD'    CONTROL CARDS
*              BINARY EQUIVALENTS
         DATA     X'48281040',X'48288080',X'48288084'
*
*    ROUTINE TO CHANGE MODE IN DCT AND DCB
*
CHGMOD   EQU      %
*
         BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**
*
         STB,R9   DCT5,R1           SWITCHES(2)
         STH,R6   DCT17,R1          SET CONTIN. CODE
         B        *R13              RETURN
         PAGE
*
*        STANDARD SIGMA LINE PRINTER HANDLER PRE-PROCESSOR
*
PRTOUT   LI,R10   DOTCR
PRT10    LB,R8    IOQ5,R3           FUNC CODE
         CI,R8    3                 IS IT PRINT WITH FORMAT
         BNE      COMLIST           NO
         LW,R7    IOQ8,R3           BUF ADDR
         LB,R8    0,R7              GET FIRST BYTE
         CI,R8    X'F1'             IS IT TOP OF FORM
         BNE      COMLIST           NO
         LH,R8    DCT1,R1           DEVICE ADDR
         TDV,R8   *R8               GET TDV INFO
         CW,R9    Y1                IS PRINTER AT TOP OF FORM
         BAZ      COMLIST           NO
*
         BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**
*
         LH,R8    IOQ9,R3           GET # OF BYTES TO GO OUT
         AI,R8    -1                ADJUST TO COVER UP FORMAT BYTE
         BLEZ     COMLIST           SKIP IT
         STH,R8   IOQ9,R3           REPLACE
         LW,R8    YC                GET 'NO UPSPACE' BYTE
         STW,R8   IOQ12,R3          STORE INTO BUCKET
         LI,R8    5                 AND THEN
         STB,R8   IOQ5,R3           CHANGE FUNCTION CODE TO FORMAT CHAINED
         MTW,1    IOQ8,R3           BUMP BA OF BUF TO COVER UP FORM BYTE
*
         ENABLE                                             **ENABLE**
*
         B        COMLIST
         PAGE
************************************************************************
*    BUFFERED LINE PRINTER HANDLER POST-PROCESSOR                      *
************************************************************************
PRTCU    BAL,R9   IOSERCK           GO CHECK FOR ERRORS
         B        %+3
         LI,R12   1                 SET NORMA TYC
         B        IOSCU             GO BACK TO CLEANUP
         CI,R5    X'C000'           7441 BUF OR CODE DISC PARITY ERROR
         BAZ      IOSCU             NO, RETRY
         LI,R12   X'4800'           YES, FORCE KEYIN
         LI,R13   MSG7              CODE DISC ERR
         B        IOSCU
         PAGE
************************************************************************
*    COMMAND LIST OFFSETS FOR LINE PRINTER AND CARD READER             *
************************************************************************
DOTCR    EQU      %
DOT      SET      %
         :DOT     RDCRB,1,0,0       0 READ CARD READER BINARY
         :DOT     WRLP,1,1,0        1 WRITE PRINTER W/O FORMAT
         :DOT     RDCRA,1,2,0       2 READ CARD READER AUTOMATIC
         :DOT     WRLPF,1,3,0       3 WRITE PRINTER WITH FORMAT
         :DOT     FORM,1,4,0        4 FORMAT
         :DOT     FORM1,1,5,5       5 SWITCHING FORMAT BYTES FOR NO
*                                     UPSPACE
************************************************************************
*    COMMAND LISTS FOR CARD READER AND LINE PRINTER                    *
************************************************************************
RDCRB    :CLST    RDNC
RDCRA    :CLST    RDBNC
WRLP     :CLST    WRNC
WRLPF    :CLST    WRBNC
FORM     :CLST    FORMNC
FORM1    :CLST    FORMDC            DATA CHAINED FORMAT BYTE CHANGE
         :CLST    WRNC              AND THEN WRITE THE USER'S BUFFER
*
         PAGE
*
*   LOW-COST PRINTER
*
PRTOUTL  BAL,R10  COMLIST           ESTABLISH DOT TABLE ADDRESS
DOTLPL   EQU      %
DOT      SET      %
WRLPL    :CLST    WRC
         :CLST    WRNC
WRLPFL   :CLST    WRBC
         :CLST    WRBNC
         :DOT     WRLPL,1,1         1  PRINT W/O FORMAT
FORML    :CLST    FORMNC
         BOUND    4
         :DOT     WRLPFL,1,3        3  PRINT WITH FORMAT
         :DOT     FORML,1,4         4  FORMAT
         PAGE
COMLIST  EQU      %                 COMMAND LIST BUILDER
*
*    R10 HAS DOT ADDR
*
*    OTHER REGS AS FOR STARTIO
*
         LH,R7    DCT7,R1           GET COMMAND LIST ADDR
         BAL,R0   RE:ENT
         LB,R5    IOQ5,R3           FUNCTION CODE
         ENABLE
         LW,R6    *R10,R5           COMMAND LIST INDEX
         LB,R6    R6                POSITION
CL5      LB,R5    *R10,R6           COMMAND INDEX
         LD,R8    *R10,R5           GET COMMAND
CL7      LI,R5    2                 INDEX TO FUNCTION
         LB,R5    R9,R5             FUNCTION
         AND,R9   NBYT2             CLEAR FUNCTION BYTE
         LB,R5    CLTV,R5           GET TRANSFER OFFSET
         B        COMLIST,R5        AND GO TO IT
*
:CL      COM,8    AF(1)-COMLIST
*
CLTV     :CL      CL90              0 => STORE COMMAND AS IS
         :CL      CL10              1 => SEEK ADDRESS IN IOQ12
         :CL      CL20              2 => DATA TRANSFER
         :CL      CL30              3 => I/O DEVICE MESSAGE
         :CL      CL40              4 => SPECIAL HANDLER FUNCTION
*
         BOUND    4
*
*
CL20     LW,R11   IOQ8,R3           GET BUF ADDR
         LC       11                IF SKIP FLAG SET (Y1),
         BCR,1    %+2
         OR,9     Y01               SET THE SKIP BIT
         BCS,8    CL230             DATA CHAIN
         AND,R11  M24               MASK
         OR,R8    R11               TO COMMAND
         LH,R11   IOQ9,R3           GET BYTE COUNT
         AND,R11  M16               MASK
         OR,R9    R11               TO COMMAND
         B        CL90              GO STORE
*
CL230    EQU      %
         LW,11    7                 HOLD CURRENT LIST D/A
         LW,R7    IOQ8,R3           DATA CHAIN DBL-WORD ADDRESS
         LW,R5    R7                COPY TO R5
         SLS,R5   2                 R5 = HALFWORD ADDRESS OF LIST
         SLS,R7   3                 R7 = BYTE ADDRESS OF THE LIST
         SCS,R9   16                FLGS AND WT KEY TO RIGHT HALF
         OR,R9    X8000             SET DATA CHAIN FLAG INTO SKELETON FLG
         SCS,R8   8                 RIGHT ALIGN ORDER CODE
         LH,R12   IOQ9,R3           GET COMMAND PAIR COUNT
         BAL,R0   RE:ENT                    *** DISABLE ***
CL24     EQU      %
         STB,R8   0,R7              STORE ORDER CODE INTO LIST
         LW,R0    R9
         AND,R0   =X'0000DFFF'      STRIP COMMAND CHAIN BIT
         STH,R0   1,R5              REPLACE FLAGS IN LIST OF CDW'S
         AI,R7    8                 POINT TO NEXT ORDER CODE BYTE SLOT
         AI,R5    4                 INCREMENT A DOUBLEWORD
         BDR,R12  CL24              CONTINUE
         EOR,R9   X8000             EXTRACT DATA CHAIN BIT
         STH,R9   *M24,R5           IN LAST COMMAND
         LW,R8    M21               MAX DBL-WORD ADDRS POSSIBLE
         AND,R8   IOQ8,R3           GET THE TIC ADDRS
         OR,R8    Y08               SET TIC ORDER CODE
         SLS,R9   16                REPOSITION FLAGS FOR POSSIBLE
*                                   COMMAND CHAIN BIT SEQUENCE
         LW,7     11                RESTORE LIST D/A
         B        CL91              STORE TIC AND LOOP AGAIN
         PAGE
*
*        CL230 FIXES UP SEEK OUT OF IOQ12
*
*        OR FOR 7-TRACK READS INTO IOQ12
*
CL30     LW,R11   IOQ12,R3          DCT FOR DEVICE NAME
         AND,R11  XFF               MASK
         SLS,R11  3                 MUL BY 8 TO ADD DW'S
         AI,R11   BA(DCT16)         DCT16+INDEX IS BUF ADDR
         B        CL11              MERGE AND STORE
*
CL40     LW,R11   R8                ROUTINE ADDR
         AND,R8   YFF               MASK ORDER CODE
         B        *R11              GO BACK TO HANDLER
         PAGE
REPCOM   EQU      CL7               HERE TO REPEAT FUNCTION TEST
CL10     ANLZ,R11 CL30              WA(IOQ12(R3))
         SLS,R11  2                 CONVERT TO BYTE ADDRESS
CL11     OR,R8    R11               MERGE INTO COMMAND
*
USECOM   EQU      %                 RETURNS HERE TO STORE COMMAND
CL90     EQU      %
*
         BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**
*
CL91     STD,R8   0,R7              STORE COMMAND DW
*
         ENABLE                                             **ENABLE**
*
         CW,R9    YA                LAST IF NO CHAINING
         BANZ     CL94              NOT LAST
         LH,R0    DCT7,R1           LAST, GET CLIST ADDR
         B        IOSST
CL94     AI,R7    1                 INC COMMAND ADDR
DELCOM   AI,R6    1                 INC COMMAND INDEX
         B        CL5
*
NBYT2    DATA     X'FFFF00FF'
         PAGE
*
*    GENERAL ERROR TESTING FOR HANDLERS
*
*
*        AN ERROR RETURN WILL BE TAKEN BY ONE OF
*        THE FOLLOWING CONDITIONS:
*
*        AIO CC 1 NOT ZERO
*        TDV CC 1 NOT ZERO
*
*        AIO STATUS BIT 9 SET
*
*        TDV STATUS BIT 9,10,11,12,13,14 OR 15 SET
*
*        SIO FAILURE (DCT3,BIT 4)
*
*        DEVICE TIME OUT (DCT3,BIT 3)
*
*        NORMAL RETURN IS TO BAL+2
*        ERROR RETURN TO BAL+1
*
*        SPECHK ENTRY USES HANDLER SUPPLIED MASK
*               PASSED IN R15.  PERMITS MORE DEVICE DEPENDENT
*               ERROR DETECTION FOR GO-NOGO DECISION.
*               DETAILED RECOVERY ANALYSIS SHOULD STILL BE
*               DONE BY THE DEVICE HANDLER.
*
*
*
IOSERCK  EQU      %
         LW,R15   GENSTAT           GET MASK FOR GENERAL STATUS CHECKING
SPECHK   RES      0                 ENTRY WITH MASK FOR SPECIAL DEVICES
         LW,R6    DCT12,R1          AIO STATUS WORD
         SCS,R6   16                RIGHT ALIGN STATUS
         LH,R8    DCT21,R1          GET TIO STATUS
         LD,R10   DCT13,R1          TDV DW
         LH,R5    R11               GET TDV STATUS RIGHT ALIGNED
         STH,R6   R5                COMPOSE AIO/TDV STATUS INFO
         LB,R12   DCT3,R1           GET DCT SWITCHES
         CI,R12   X'18'             DID DEV TIME OUT/SIO FAIL
         BAZ      IS20              NEITHER..KEEP CHECKING
         LI,R6    X'1106'           CODE/CNT FOR SIO FAILURE
         LI,R13   MSG4              'NOT OPERATIONAL'MSG FOR SIO FAIL
         CI,R12   8                 GOT CORRECT REGISTERS LOADED
         BANZ     IS10              YUP - JUMP
         LI,R6    X'120D'           NO - LOAD DEV TIMEOUT CODE/CNT
         LI,R13   MSG3              'TIMED OUT' MSG FOR TIMEOUTS
IS10     EQU      %
         LI,R12   X'2800'           SET FLGINTER/KEYIN  REQUIRED BITS
IS12     PUSH     2,5               SAVE REQUIRED REGS
         BAL,5    REC:ERR           RECORD ERROR RECORD
         PULL     2,5               RESTORE REGS
         CI,R13   MSG3              IS IT TIMEOUT MSG?
         BNE      PRE%CU            NO.
         LB,R5    DCT4,R1           Y, GET DEVICE TYPE INDEX
         LC       TB:FLGS,R5        IS IT TAPE?
         BCR,8    PRE%CU               (I.E., IS CC1-2 = '10'B?)
         BCS,4    PRE%CU
         B        *R9               Y, TAKE ERROR RET TO HANDLER
         PAGE
IS20     EQU      %
         LC       DCT19,R1          TEST AIO CONDITION CODES
         BCS,8    IS25              **ERROR** LOG IT
         LC       R10               CHECK EVEN REG, TDV STATUS FOR
         BCS,6    IS25              **BUS CHK OR CNTRL CHK FAULT**
         LC       DCT20,R1          GET TDV CC
         CW,R5    R15               TEST FOR ANY ERRORS
         BCR,4+8  IS50              ALL RIGHT
*        B        IOSEREC           FALL THROUGH TO LOG ERROR
*
*        GENERATE I/O ERROR RECORD FOR ERRLOG; THIS
*        ROUTINE IS ALSO CALLED ELSEWHERE IN HANDLERS SO
*        NOTHING IS ASSUMED HERE.
*
*
*
IOSEREC  EQU      %
         LB,R4    DCT4,R1           GET INDEX TO TB:FLGS
         LB,R4    TB:FLGS,R4        GET DEVICE TYPE FLAGS
         CI,R4    X'F0'             IS THIS A DISC PACK
         BNE      IS25              NO--> GO AHEAD AND LOG EM
         LB,R4    DCT24,R1
         CI,R4    4                 MPC CONTROLED DISC
         BAZ      IS11              NO
         AI,R5    0                 YES-CHECK FOR ON SECTOR INT.
         BLZ      IS50              YES-NO ERROR INFO ON DEV INT.
         B        IS25              LOG THE MPC ERROR
IS11     CW,R5    Y08               IS THIS AN ON-SECTOR INT.
         BANZ     IS50              YUP-> NO ERROR RETURN NOW
         CI,R5    X'4000'           NOT ON-SECTOR-> IS FLAWED TRK SET
         BANZ     IS30              YUP-> NO LOG OF THOSE
IS25     EQU      %
         PUSH     2,R5              SAVE R5/R6
         LI,R6    X'150D'           ERROR MSG CODE AND COUNT
         BAL,R5   REC:ERR           RECORD AN ERROR MSG
         PULL     2,R5              RESTORE R5/R6
IS30     EQU      %
         CW,R10   Y6                IS IT BCF OR CCF
         BANZ     RMAPOLL           YES
         CI,R5    X'28'             IS IT TME OR IME
         BANZ     RMAPOLL           YES
RMARET   EQU      %
         LI,R12   X'C008'           SET RETRY AND TYC
         LI,R13   MSG2              DEFAULT ERROR MSG
         INT,R15  IOQ8,R3           DO WE HAVE AN EXTERNAL COMMAND LIST
         BCS,4    NOPOST            YES
         CW,R5    Y0004             IS ERROR A WLV
         BAZ      *9                NO, RETURN TO POST-PROCESSOR
RMARET1  EQU      %
NOPOST   EQU      %
         LI,R12   8                 YES, ERROR TYC
         B        IOSCU             SKIP POST-PROCESSING
*        NORMAL I/O COMPLETION RETURN POINT
*
IS50     EQU      %
         AI,9     1                 INCREMENT RETURN
         LI,R13   0
         LW,12    DCT9,1
         CW,12    Y2                IS DIAG FLG SET
         LI,R12   1                 ASSUME NORMAL TYC
         BANZ     DIAGIO            DON'T CHANGE CC1 &CC2 FROM
*                                   CI,12 4, YUP-SAVE REGS
         CI,R5    X'80'             CHECK FOR INCORRECT LENGTH
         BAZ      *R9               NOPE-> RETURN
         AND,R11  M16               ISOLATE REMAINING BYTE COUNT
         BNEZ     *R9               OK -> PROBABLY OK
         LI,R12   2                 POST LOST DATA TYC
         B        *R9               AND RETURN TO HANDLER
*
*
DIAGIO   PUSH     2,5               KEEP STACK IN ORDER
         LI,6     X'140D'           CODE/COUNT
*        B        REC:ERR           RECORD ERROR FOR DIAG USER
         PAGE
*
*        ERROR LOGGING INTERFACE
*
*        ENTER WITH:
*
*        R1:      DCT INDEX
*        R3:      IOQ INDEX
*        R5:      LINK ADDRESS
*        R6:      ERROR LOG CODE / COUNT OF WORDS IN MSG
*
         DEF      RECIOERR
RECIOERR EQU      %
REC:ERR  EQU      %
         PUSH     16,R7
*
*
         REF      IOQ10
         REF      BATAPE
         REF      DOUBLEZERO
         REF      IOQ4,AVRTBL
*
*
         LB,R9    IOQ5,R3           GET CURRENT FUNCTION STEP CODE
         LI,R2    2
         LB,R6    IOQ4,R3           GET ORIGINAL FUNCTION STEP
         STB,R6   R9,R2             INSERT ORIGINAL INTO PLACE
         LD,R12   DCT13,R1          TDV STATUS
         LW,R10   DCT12,R1          AIO STATUS / DEVICE ADDRESS
         LI,R2    X'7FFFF'          MAX DBL-WRD MASK
         AND,R2   R12               DBL ADDRS OF CDW
         REF      CORED
         LI,R14   -1                ASSUME TDV IS INVALID
         LW,R11   CORED             HIGHEST WA IN THE SYSTEM
         AI,R11   -1
         SLS,R11  -1                HIGHEST DBL-WORD ADR IN SYSTEM
         CW,R2    R11               IS THE TDV DBL-WRD LEGAL
         BGE      %+2               NO - JUMP
         LD,R14   0,R2              GET CURRENT COMMAND
         SLS,2    1
         LW,4     IOQ12,3           NORMAL SEEK ADDRESS
         LB,R5    DCT24,R1          MPC FLAG
         CI,R5    4                 MPC CONTROLED DEVICE
         BAZ      MPCTRN            NO
*
         LH,R7    DCT7,R1           CLIST ADDRESS
         AI,R7    7                 ADDRESS OF MPC SEEK
         LD,R4    0,R7              MPC SEEK DOUBLE WORD
         SLD,R4   4                 SHIFT INFORMATION INTO ONE WORD
*
         LB,R5    R14               SIGMA ORDER CODE
         CI,R5    X'03'             CONTROL ORDER
         BNE      MPC1              NO
         INT,R5   R14               BYTE ADDRESS OF CONTROL INFO
         SLS,R5   -3                DOUBLE WORD ADDRESS
         LD,R14   0,R5              DISPLAY CONTROL INFO
         B        MPC2
MPC1     CI,R5    X'B0'             MPC STOP ORDER
         BNE      MPCTRN            NO-LOOK AT IT
*
         AI,R7    -1                ADDRESS OF MPC ORDER
         LD,R14   0,R7              MPC ORDER DOUBLE WORD
MPC2     LW,R7    IOQ8,R3           DATA CHAIN FLAG
         LB,R7    R7                ISOLATE FLAGS
         OR,R15   R7                  INTO ORDER WORD
MPCTRN   EQU      %
         LB,0     IOQ14,3           CHECK PRIORITY FOR SWAPPER
         CI,0     SWAP%PRI          REQUEST.
         BE       1A1               IT IS.
         LB,0     IOQ10,3           RETRIES REQUESTED
         LB,6     IOQ11,3           RETRIES REMAINING
         STB,6    0
         SCS,0    8
1A2      LH,6     DCT21,1           TIO STATUS. SWAPPER RETURNS HERE
         STH,6    0                 WITH RETRIES CORRECT IN 0.
         LB,11    DCT19,1           AIO CC'S
         LB,2     DCT20,1           TDV CC'S
         STB,2    11
         SCS,11   16                LOG WORD 3
         STB,R3   *TSTACK           * STICK IOQ INDEX AWAY
         LD,R2    DOUBLEZERO        * CLEAR SERIAL NUMBER CELLS
         AND,R1   XFF               * CLOBBER PRIORITY IN R1
         STW,R1   R7                * AND STICK DCTX IN R7
         AI,R1    -BATAPE           * CREATE AN AVR INDEX
         BLZ      REC:ERR1          * AVR INDEX CANT BE NEGATIVE
         LD,R2    AVRTBL,R1         * LOAD VSN INFO
         LI,R6    BATAPE            * # OF NON-MT OR DP DEVICES
         CW,R7    R6                * IS DCT < TAPES
         BL       NOTANSI           * CAN'T BE ANSI THEN
         AI,R6    AVRTBLSIZ         * FOR END OF TAPE TABLE
         CW,R7    R6                * IS DCTX > TAPES
         BGE      NOTANSI           * IF SO, CANT BE ANSI EITHER
         LC       ANSFLGS,R1        * GET ANS INDICATORS
         BCR,8    NOTANSI           * IF NOT ANSI....
*
*        MUST BE ANSI BY THE TIME WE GET TO HERE
*
         LI,R6    1                 * THE ANS FLAG FOR ERR:FIL
         STH,R6   R3                * IN THE CORRECT HALF-WORD
         B        REC:ERR1          * BYPASS NOTANSI
NOTANSI  EQU      %
         LI,R6    0                 NOPE
         STH,R6   R3                PASS FLAG TO ERR:FIL ABOUT SN
REC:ERR1 EQU      %
         AND,R3   YFFFF             SAVE SN / CLEAR AVR TABLE BITS
         OR,R3    R9                INSERT ORIG F/C  - CURNT  F/C
         LW,R8    R7                MOVE DCT INDEX TO R8
         LW,R6    *TSTACK           GET CALLER'S CODE/CNT
         STH,R6   R8                CREATE MSG WORD ONE
         LI,R6    8                 LOAD MSG POINTER FOR ERROR LOGGER
         LB,R5    DCT3,R7           RMA DCT-CHECK NOERR BIT
         CI,R5    4                 SHOULD ERRORS BE LOGGED
         BANZ     NOLOG             NO, DO NOT LOG IT
         LW,R1    DCT25,R7          GET # OF SIO'S TO DATE
         BAL,R5   ERRLOG
         INT,R5   DCT9,R7           TEST FOR DIAG BIT IN DCT'S
         BCS,2    NOLOG             YES
         PULL     16,R7
         B        0,R5              EXIT TO CALLER
NOLOG    EQU      %
         LB,R3    *TSTACK           RETRIEVE THE IOQ INDEX AGAIN
         LD,R6    IOQ13,R3          YES,SET UP ERROR REPORT
         LCI      13                13 REGS OF INFO
         STM,R8   0,R7              EAI ADDRESS OF BUFFER
DIAGXIT  PULL     16,R7             RESTORE REGS
         PULL     2,R5
         LI,R12   0
         B        IOSCU
GENSTAT  DATA     X'0040007F'       GENERAL ERROR BITS
*
*
1A1      B        %+2-:DP           GET RAD SEEK ADDRESS FROM CLIST
         B        1A5+1             COMMAND.  GET PACK ADR FROM IOQ12.
         LI,5     5                 LOOK AT 5 COMMANDS.
1A4      LB,4     *2                FETCH ORDER CODE
         BEZ      1A5               BAD
         CI,4     3
         BE       1A3               ITS A SEEK.
         BL       %+3               ITS A READ OR WRITE.
         CI,4     5                 OR MAYBE A WRITE CHECK.
         BNE      1A5               NOPE, ITS A BAD UN.
         AI,2     -2                KEEP LOOKING.
         BDR,5    1A4
1A5      LI,4     0                 NO SEEK ADDRESS.
         LD,6     IOQ13,3           SWAPPER EA INFO HAS
         LW,0     M16               RETRIES REQUESTED AND
         AND,0    7                 RETRIES REMAINING.
         STD,12   S:SWSTAT
         B        1A2               REJOIN NORMAL ERRORS.
*
1A3      LW,6     *2                SEEK COMMAND
         AND,6    M24               BA(DISC ADDRESS)
         SLS,11   3                 BA(CORED-1)
         CW,6     11                CHECK ADDRESS
         BGE      1A5               NO GOOD..
         LW,7     =X'04000010'
         MBS,6    0                 LOAD SEEK ADDRESS
         SLS,4    -16               4 BYTES IF PACK SWAPPER.
         B        1A5+1             2 IF RAD.
         PAGE
*
*    RE-ENTRANCE TEST SUBROUTINE
*
*        CALLED BY HANDLERS (FRONT AND BACK)
*        RETURNS TO I/O SCHEDULER IF RE-ENTERED.
*
*        BAL,R0   RE:ENT
*
RE:ENT   DISABLE
         CH,R14   DCT10,R1          RE-ENTRANCE CHECK
         BE      *R0                NOT RE-ENTERED
         B        RESCHED           RE-ENTERED, BACK TO SCHEDULER
         PAGE
*
*
*
*    GET FIRST 4 CHARACTERS FROM BUFFER
*
*        BAL,R5   4CHAR
*
*    USES R6,R7,R8 - R0 HAS FIRST 4 BYTES
*
*    WARNING - IF IOQ8 CONTAINS THE ADDRESS (DA) OF A COMMAND
*       LIST, THE FIRST COMMAND DOUBLEWORD MUST CONTAIN THE BUFFER
*       ADDRESS, AND THE FIRST 4 CHARACTERS OF THE BUFFER MUST BE
*       POINTED TO BY THAT COMMAND DOUBLE WORD.  I.E., IF A COMMAND
*       LIST WAS BUILT BECAUSE A BUFFER CROSSED A PAGE BOUNDARY, THE
*       FIRST 4 CHARACTERS OF THE BUFFER MUST BE IN THE SAME PAGE.
*
4CHAR    EQU      %
         LW,R6    IOQ8,R3           L/BUFFER BA OR CMND DBL WD DA
         BGEZ     %+2               BGEZ; NOT COMMAND DBL WD ADR
         LD,R6    0,R6              L/1ST CMND DBL WD; BUF BA NOW IN R6
         LW,R7    Y04               L/BC (4) FOR MBS
         MBS,R6   0                 MOVE 4 BYTES
         B        0,R5              AND EXIT
         PAGE
*
* BIT DEFINITIONS
*
BIT31    EQU      1**0
BIT30    EQU      1**1
BIT29    EQU      1**2
BIT28    EQU      1**3
BIT27    EQU      1**4
BIT26    EQU      1**5
BIT25    EQU      1**6
BIT24    EQU      1**7
BIT23    EQU      1**8
BIT22    EQU      1**9
BIT21    EQU      1**10
BIT19    EQU      1**12
BIT18    EQU      1**13
BIT16    EQU      1**15
BIT7     EQU      1**24
BIT6     EQU      1**25
BIT5     EQU      1**26
BIT4     EQU      1**27
BIT3     EQU      1**28
BIT2     EQU      1**29
BIT1     EQU      1**30
         PAGE
*
*
*
FLGFOLOW EQU      X'4000'
FLGHOLD  EQU      X'400'
FLGINTER EQU      X'2000'
FLGKEYC  EQU      X'1000'
FLGKEYNC EQU      X'800'
FLGRETRY EQU      X'8000'
*
TYCOK    EQU      1
TYCERR   EQU      8
*
CC       EQU      X'2E'
NCC      EQU      X'1E'
*
XBIT1    EQU      Y4
XBIT0    EQU      Y8
XBIT16   EQU      X8000
XBIT2    EQU      Y2
XBIT26   EQU      X20
XBIT7    EQU      Y01
*
         PAGE
************************************************
*  DISC PACK CLIST AREA USAGE                  *
************************************************
*                                              *
*        WORD 0/1 - COMMAND DOUBLEWORD         *
*                                              *
************************************************
*                                              *
*        WORD 2/3 - COMMAND DOUBLEWORD         *
*                                              *
************************************************
*                                              *
*        WORD 4/5 - HEADER BUFFER              *
*                                              *
HEADERBUF EQU     4
*                                              *
************************************************
*                                              *
*        WORD 6/7 - SENSE BUFFER EXTENSION     *
*                                              *
SENSEBUF EQU      HEADERBUF
*                                              *
************************************************
         PAGE
************************************************
*        HANDLER TABLE GENERATING PROCS        *
************************************************
         OPEN     :DOT,:CDW,:CLIST
:DOT     CNAME
         PROC
         DO1      NUM(LF)=1
LF(1)    EQU      %-DOT
         GEN,8,8,8,8 BA(AF(1))-BA(DOT),AF(2),AF(3),AF(4)
         PEND
*
*
:CLIST   CNAME
         PROC
         DO1      NUM(LF)=1
LF(1)    EQU      BA(%)
         LOCAL    I
I        DO       NUM(AF)
         DATA,1   DA(AF(I))-DA(DOT)
         FIN
         PEND
*
*
:CDW     CNAME
         PROC
         BOUND    8
LF       GEN,8,24,8,8,8,8   AF(1),AF(2),AF(3),X'80',AF(4),AF(5)
         PEND
*
*
         PAGE
******************************************
*           RAD PRE-HANDLER              *
******************************************
*
DISCIO   BAL,R10  COMLIST
DOT      SET      %
*
******************************************
*       RAD DEVICE OPERATION TABLE       *
******************************************
*
DOTDC    RES      0                 USED EXTERNALLY BY CRDOUT
         :DOT     DCRD,1,DCSNS,CHK  0 => SEEK AND READ
         :DOT     DCWR,1,DCSNS,CHK  1 => SEEK AND WRITE
DCSN     :DOT     DCSEN,1,DCSN,0    2 => EXTERNAL SENSE
CHK      :DOT     DCWRC,1,DCSNS,0   3 => CHECK WRITE
         :DOT     DCWR,1,DCSNS,CHK  4 => WRITE, THEN CHECK WRITE
DCSNS    :DOT     DCLS,1,DCSNS,0    5 => DIAG SENSE
         :DOT     DCSWP,1,DCSNS,CHK 6 => SWAP COMMAND LIST REQUEST
         PAGE
********************************************
*    DISC PACK PRE-HANDLER                 *
********************************************
*
DISKAB   RES      0
DPAK     RES      0
         BAL,R10  COMLIST
DOT      SET      %
*
********************************************
*    DISC PACK DEVICE OPERATION TABLE      *
********************************************
*
SEEKREAD  :DOT  DPSK,1,DSENSE,READ        0 => READ
SEEKWRT   :DOT  DPSK,1,DSENSE,WRITE       1 => WRITE
SENSE     :DOT  DPSN,1,DSENSE,0           2 => SENSE
*
*        INTERNAL FUNCTIONS
*
READ      :DOT  DPRD,1,DSENSE,SEEKCWR
WRITE     :DOT  DPWR,1,DSENSE,SEEKCWR
*
*
DSENSE   :DOT     DPLS,1,DRESTORE,DRESTORE
DRESTORE :DOT     DPRS,1,DRESTORE,0
*
*
SEEKCWR   :DOT  DPSK,1,DSENSE,CKWR
CKWR      :DOT  DPCW,1,DSENSE,0
*
*
RDHDR     :DOT  DPRH,1,DSENSE,0               FLAWED TRACK RECOVERY
SUNREST  :DOT     DPRS,1,SUNREST,0
SEEKONLY :DOT     DPSK,1,DSENSE,SWAPFO  11=> SWAP SEEK W/FOLLOW ON
SEEKRHDR :DOT     DPSK,1,DSENSE,URDHDR     12 => SEEK, READ HEADER
URDHDR   :DOT     DPURH,1,DSENSE,0         13 => READ HEADER
SWAPFO   :DOT     DPSWP,1,DSENSE,0  14 => SWAP CLIST REQUEST
         PAGE
****************************
*  DISC PACK CLIST TABLE   *
****************************
*
DPSK     :CLIST   SEEKNCI
*
DPSN     :CLIST   SENSE1
*
DPRD     :CLIST   RDNC
*
DPWR     :CLIST   WRNC
*
DPCW     :CLIST   CKNC
*
DPLS     :CLIST   SENSE2
*
DPRS     :CLIST   RSC
         :CLIST   RHNC
*
DPRH     :CLIST   RHNC
*
DPURH    :CLIST   URH
DPSWP    :CLIST   SWAPC
*
DOT      SET      WA(DOTDC)
DCRD     :CLIST   SEEKC
         :CLIST   RDNC
DCWR     :CLIST   SEEKC
         :CLIST   WRNC
DCWRC    :CLIST   SEEKC
         :CLIST   CKNC
DCLS     :CLIST   SENSE2
DCSEN    :CLIST   SENSE1
DCSWP    :CLIST   SWAPC
         BOUND    4
         PAGE
************************************************************************
*    COMMAND DOUBLE WORDS FOR COMMAND LISTS                            *
************************************************************************
         BOUND    8
*
FNC      EQU      X'1E'             ICE,HTE,IUE,SIL NO COMMAND CHAIN
FC       EQU      X'2E'             ICE,HTE,IUE,SIL COMMAND CHAIN
*
WRC      :CDW     1,0,FC,2          WRITE
WRNC     :CDW     1,0,FNC,2         WRITE
RDNC     :CDW     2,0,FNC,2         READ
FORMNC   :CDW     3,0,FNC,2         FORMAT
FORMDC   :CDW     5,0,X'8E',1,1     VFC BYTE IN IOQ12 - ONE BYTE DATA
*                                   CHAINED TO USER'S BUFFER
SEEKC    :CDW     3,0,FC,1,2        SEEK
SENSE1   :CDW     4,0,FNC,2         SENSE
WRBC     :CDW     5,0,FC,2          WRITE BINARY
WRBNC    :CDW     5,0,FNC,2         WRITE BINARY
WRNLNC   :CDW     5,BA(Y15),FNC,0,1 TYPE NEW LINE
WRNLC    :CDW     5,BA(Y15),FC,0,1  TYPE NEW LINE
WRTYDC   :CDW     5,0,FC,3,8        TYPE DEVICE NAME
RDBNC    :CDW     6,0,FNC,2         READ BINARY
RDTYE    :CDW     134,0,FNC,2       READ TYPEWRITER WITH CONTROL
WRCR     :CDW     5,BA(CR),FC,0,1
WRCR3T   :CDW     5,BA(CR3T),FC,0,4
SWAPC    :CDW     0,PRESWP,0,4,0    SWAPPER BUILT COMMAND LIST
*
         PAGE
***********************************************
*    SKELETON COMMAND DOUBLEWORDS             *
***********************************************
*
*
SENSE2   :CDW     4,SENSELOG,NCC,4,16   SENSE FOR ERROR LOG
*
SEEKNCI  :CDW     X'83',SEEK,4,4,4   SEEK
*
RHNC     :CDW     X'0A',HEADER,NCC,4,8 READ HEADER
*
RSC      :CDW     X'33',0,CC,0,0    RESTORE CARRIAGE
*
CKNC     EQU      WRBNC             CHECK WRITE
*
URH      :CDW     X'0A',0,FNC,2     READ HEADER
*
         PAGE
********************************************
*    DISC PACK  POST-HANDLER               *
********************************************
*
DPAKCU   BAL,R7   DPAKCU1           SET INDEX FOR FAULT ANALYSIS
DISKABCU BAL,R7   DPAKCU1
DCU1     RES      0
         LW,R15   DMASK             GET MASK FOR PACK AND RAD
         BAL,R9   SPECHK            GENERAL ERROR CHECK WITH MASK
         B        DPAKERR           YES, GO ANALYZE FURTHER
*
*        NOTE:    IOSERCK HAS LOADED R12=01
*
DPOK     EQU      %
         LB,R7    IOQ5,R3           GET CURRENT FUNCTION STEP
         LB,R7    *R0,R7            GET ENTRY POINT FOR THIS FUN
         B        DPAKCUV,R7        AND GO TO IT
DMASK    DATA     X'02482B7F'       ERROR STATUS BIT MASK
         PAGE
**********************************
*   DISC PACK TRANSFER TABLE     *
*                                *
*   FOR NORMAL STEP COMPLETIONS  *
**********************************
*
DPBT     COM,8    AF(1)-DPAKCUV
*
DPAKCU1  BAL,R0   DCU1              SET BASE ADDRESS
DPAKCUV  RES      0
         DPBT     EXITFI            0 => SEEK FOR READ
         DPBT     EXITFI            1 => SEEK FOR WRITE
         DPBT     EXITDONE          2 => SENSE
         DPBT     EXITDDONE         3 => READ DATA TRANSFER
         DPBT     EXITDDONE         4 => WRITE DATA TRANSFER
         DPBT     EXITDF            5 => DIAG SENSE
         DPBT     EXITFO            6 => RESTORE FOR RECOVERY
         DPBT     EXITFI            7 => SEEK FOR CHECK-WRITE
         DPBT     EXITDONE          8 => CHECK-WRITE
         DPBT     EXITALTER         9 => READ HEADER FOR ERROR REC
         DPBT     EXITERR           10 => ERROR EXIT AFTER SECTOR UNAVAILABLE
         DPBT     EXITFI            11 => SWAP SEEK COMPLETED (FOLLOWON)
         DPBT     EXITFI            12 => SEEK FOR READ HEADER
         DPBT     EXITDONE          13 => READ HEADER
         DPBT     EXITDONE          14 => SWAP I/O COMPLETE
         PAGE
*************************************
*     RAD HANDLER TRANSFER TABLE    *
*                                   *
*     FOR NORMAL COMPLETION         *
*************************************
*
DCBT     COM,8    AF(1)-DPAKCUV
*
DISCCU   LI,R7    DISKABCU          TEST STATUS AS FOR PACK
DISCCU1  BAL,R0   DCU1              SET BASE AND MERGE
*
         DCBT     EXITDDONE         0 => READ
         DCBT     EXITDDONE         1 => WRITE
         DCBT     EXITDONE          2 => SENSE
         DCBT     EXITDONE          3 => CHECK-WRITE
         DCBT     EXITDDONE         4 => WRITE/CHECKWRITE
         DCBT     EXITDF            5 => LOG DAIG SENSE
         DCBT     EXITDONE          6 => SWAP I/O COMPLETED
         BOUND    4
         PAGE
***********************************
*       EXIT FUNCTIONS            *
***********************************
*
EXITDDONE EQU     %
         LH,R8    IOQ9,R3           GET REQ COUNT
         LW,R7    IOQ8,R3           CHK FOR DATA CHAIN
         BGZ      EXITDD2           NOT DATA CHAINED THIS TIME
         BAL,R13  IOARS             GET ARS IF DATA CHAINED
EXITDD2  EQU      %
         CI,R8    1024-1            TEST FOR INTEGRAL SECTOR
         BANZ     EXITDONE          NO, DONT CHECK WRITE
         CW,R5    Y01               DID RMP RETRY ITSELF
         BANZ     EXITDONE          YUP-> DONT FOLLOW ON ATALL
         MTB,0    IOQ4,R3           WAS ORIG ORDER A READ
         BEZ      CHKRDCK           B IF A READ
         RD,0     0                 ELSE CHECK SS1
         BCS,8    EXITFI            FOR WRITE CHECKS
         B        EXITDONE          NONE - SO JUST CONTINUE
CHKRDCK  EQU      %
         MTW,0    M:RDCK            IS READ CHECK FLAG SET
         BE       EXITDONE          NO READ CHECKS
*
*        FOLLOW ON TO READ CHECK IF SSW3 SET
*
*
*        EXIT POINT TO START A FOLLOW-ON
*
EXITFI   EQU      %
         LI,R12   FLGFOLOW+FLGINTER+TYCERR
EXITCU   EQU      %
         LI,13    MSG2             UNLIP IT
         B        IOSCU
*
*        EXIT NORMALLY
*
EXITDONE EQU      %
         LI,R12   1
         B        EXITCU
*
*        EXIT TO START A RETRY
*
EXITHIOR EQU      %
         LI,R12   FLGRETRY+FLGINTER+TYCERR
         CW,R5    Y01               IS RMP
         BAZ      EXITCU            OK TO RETRY
EXITERR  EQU      %
         LI,R12   TYCERR            NO RETRIES
         LI,R13   MSG2              DEFAULT ERROR MSG
         B        IOSCU             RETURN TO IOQ
*
*        EXIT TO RESTORE CARRAIGE
*
EXITREST EQU      %
         AI,R0    -DISCCU1          CHK FOR RAD DEVICE
         BGE      EXITERR           JUST AN ERROR ON A RAD
         LI,R7    SUNREST           FOR A PACK LOAD REST FC
         B        EXITFO1           FOLLOWON TO RESTORE
         PAGE
*
*        EXTRACT ALTERNATE DISC ADDRESS FROM 'HEADER'
*        WE JUST READ FROM THIS DEVICE
*
EXITALTER RES     0                 HANDLE FLAWED TRACK
         LH,R7    DCT7,R1           GET CLIST ADDRESS
         LD,R8    HEADERBUF,R7      GET HEADER
         MTB,1    R8                TEST FOR REAL FLAWED TRACK
         BNC      EXITHIOR          NOT A GOOD GUY
         AND,R9   XFFFF00           SCRUB
         BEZ      EXITHIOR          NO ALTERNATE SPECIFIED
         LW,R8    R9                SWITCH TO EVEN REGISTER
         CI,R8    BIT16             CHECK HIGH ORDER BIT OF CYL
         BAZ      NOHIBIT           NONE
         OR,R8    XBIT7             SET IT
         EOR,R8   XBIT16            AND RESET
NOHIBIT  LI,R9    X'FFF00'          GET MASK (YFFFFFF00)
         STS,R8   IOQ12,R3          AND SET NEW SEEK ADDRESS
*
*        EXIT TO RETURN TO ORIGINAL FUNCTION STEP
*
EXITFO   LB,R7    IOQ4,R3           GET ORIGINAL FUNCTION
EXITFO1  RES      0
         STH,R7   DCT17,R1          SET AS FOLLOW-ON
         MTB,0    IOQ11,R3          ANY RETRIES LEFT ?
         BNEZ     EXITFI            OKAY TO FOLLOW ON STILL
         B        EXITERR           QUIT AT ZERO RETRIES
         PAGE
***********************************************
*        ERROR CONDITION ANALYSIS             *
***********************************************
*
DPAKERR  RES      0
         AI,R7    D7242-DISKABCU    MAKE INITIAL INDEX INTO TABLE
DPERR1   CH,R5    CONDITION,R7      CHECK STATUS
         BANZ     DPERR2            GOT IT
         BDR,R7   DPERR1            KEEP GOING
DPERR2   EQU      %
         LB,R6    ACTION,R7         GET ACTION INDEX
         AI,R6    DPAKCU            ADD MODULE BASE ADDRESS/FALL THRU
*
*
*        CHECK FOR RE-ENTRANCE OR EXTERNAL COMMAND LIST
*
         INT,R9   IOQ8,R3           TEST FOR EXTERNAL CLIST
         BCR,4    0,R6              NO, CONTINUE
         B        EXITDONE          DONT CHK THOSE-> EXIT
*
*
         PAGE
************************************************
*        DISC PACK ERROR DECISION TABLES       *
************************************************
*
ACTION   COM,8    AF(1)-DPAKCU
CONDITION COM,16  AF(1)**-16
*
CONDITION RES     0
         CONDITION  0
         CONDITION  BIT8            INCORRECT LENGTH
         CONDITION  BIT1            FLAW MARK DETECTED
         CONDITION  BIT2            SECTOR UNAVAILABLE
         CONDITION  BIT3            WRITE PROTECTED
D7242    EQU      HA(%)-HA(CONDITION)
         CONDITION  BIT4+BIT6+BIT7+;
                    BIT9+BIT10+BIT11+;
                    BIT12+BIT13
D7260    EQU      HA(%)-HA(CONDITION)
         CONDITION  BIT5            7260 OPERATIONAL ERR
*
*
         BOUND    4
ACTION   RES      0
         ACTION   EXITHIOR          INCONSISTENT STATUS
         ACTION   DPOK              INCORRECT LENGTH
         ACTION   EXITFLAW          FLAW MARK
         ACTION   EXITHIOR          SECTOR UNAVAILABLE
         ACTION   EXITWP            WRITE PROTECTED
         ACTION   EXITHIOR          BAD TDV BITS
         ACTION   EXITHIOR          7260 OPERATIONAL ERROR
         BOUND    4
         PAGE
************************************************
*   DISC PACK PRE-HANDLER COMMAND EXITS        *
************************************************
*
SEEK     RES      0
         AI,R9    X'100'            MAKE IT AN IOQ12 FORM
         OR,R4    Y8                SET FLAG FOR CONTROLLER FREE
         B        REPCOM
*
*
SENSELOG RES      0
         DO       (SENSEBUF=HEADERBUF)=0
         LI,R0    SENSEBUF**-1
         B        HEADER1
         FIN
*
HEADER   LI,R0    HEADERBUF**-1
HEADER1  AH,R0    DCT7,R1
         SLS,R0   3
         OR,R8    R0                MERGE IN PROPER BYTE ADDRESS
         B        USECOM            AND GO USE IT
*
         PAGE
*
*        SWAPPER I/O RETURN TO IOQ
*
PRESWP   EQU      %
         LW,R0    IOQ8,R3           GET DA OF HIS CLIST
         B        IOSST             START SWAP LIST...
         PAGE
************************************************
*        SENSE DATA ERROR LOGGING              *
************************************************
*
EXITDF   RES      0
         LH,R5    DCT7,R1           GET CLIST AREA ADDRESS
         SLS,R5   1                 CONVERT TO WORD ADDRESS
         BAL,R11  GETDEVAD          GET DEVICE ADDRESS IN R6
         LW,R7    R6                MOVE TO WORK REGISTER
         OR,R7    =X'16060000'      SET CODE/COUNT
         LCI      4
         LM,R9    SENSEBUF,R5       GET SENSE DATA
         LI,R6    7                 LOAD MSG POINTER  FOR ERROR LOG
         BAL,R5   ERRLOG
         AI,R0    -DISCCU1          TEST FOR RAD TYPE OF OP
         BGE      EXITFO            YEP-> DO A RETRY RIGHT NOW
         B        EXITFI            NO--> DO RESTORE CARRAIGE FIRST
         PAGE
*
*        FLAW MARK DETECTED IN STATUS
*
EXITFLAW RES      0
         LI,R7    RDHDR             SET FOLLOW-ON TO READ HEADER
         B        EXITFO1
*
*        WRITE PROTECTED
*
EXITWP   LI,R13   MSG5              SET WRITE PROTECTED MESSAGE
         LI,R12   FLGKEYNC+FLGRETRY
         B        PRE%CU1           DON'T COUNT RETRY
         DEF      DPAK,DPAKCU
DSKABCU  EQU      DISKABCU
         DEF      DISKAB,DSKABCU
*
         PAGE
*
*
PRE%CU   EQU      %
         LB,R5    IOQ14,R3          GET PRIORITY
         CI,R5    SWAP%PRI          IS IT A SWAPPER
         BNE      IOSCU             NOT SWAPPER
*
*        NOTE:    R12 ALREADY HAS FLAGS LOADED
*
PRE%CU1  EQU      %
         MTB,1    IOQ11,3
         B        IOSCU
*
CR       EQU      %
CR3T     DATA     X'15050505'
FERMSG   TEXTC    ' FEED ERROR'     THIS MESSAGE INDICATES THAT THE
         END

