*        705537   SIGMA 5/7         BPM  STANDARD DEVICE HANDLERS
*        CREATED 12/29/71  PJH
*
*
ANSPROC  SET      1                 RURN ON ANSS MODE
*
*
         SYSTEM   UTS
         PAGE
*
*    EXTERNAL DEFINITIONS AND REFERENCES
*
         DEF      HANDLERS
HANDLERS EQU      %
         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
*
         REF      DCT1,DCT3,DCT4,DCT5,DCT6,DCT7
         REF      DCT9
         REF      DCT10,DCT12,DCT13,DCT16,DCT17
         REF      DCT19,DCT20,DCT21
         REF      IOQ7
         REF      DCT25
         REF      IOQ5,IOQ6,IOQ8,IOQ14
         REF      IOQ9,IOQ11,IOQ12
         REF      MSG2,MSG3,MSG4,MSG5,MSG7
         REF      IOSST,IOSCU,RESCHED
         REF      M16,XFE,XFF,Y1,Y15,YA,YFF
         REF      X8000
         REF      ERRLOG,TIME
         REF      Y8,Y0001,Y2,Y01
         REF      XFFFF00
         REF      Y08
         REF      M24,M23,24BM2
         REF      MASKS,CC3FAIL,RMAPOLL,TB:FLGS
         REF      Y04,Y0004,Y6
         REF      ;
                  MB:SDI,;                                      #6124
 SWAP%PRI
         REF      IOQ13,IOQ15,UX;JIT
         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      %+3               NO, ALL RIGHT
         WD,0     X'41'             ERROR, TURN ALARM ON
         B        %+2
         WD,0     X'40'             TURN OFF ALARM FOR SUCCESSFUL OPERATION
         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
         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   AI,R5    1                 ADV 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
         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      %+2               YES
         LI,R7    3                 NO, BIN
         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
         LI,R13   FERMSG            SET FEED ERROR MESSAGE
         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
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
         LCI      0                 CLEAR CONDITION CODES FOR CC3 TEST
         TDV,R8   *R8               GET TDV INFO
         BCS,2    CC3FAIL           LOG ERROR AND CRASH
         CW,R9    Y1                IS PRINTER AT TOP OF FORM
         BAZ      COMLIST           NO
*
         BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**
*
         LI,R8    X'C0'
         STB,R8   0,R7              SET FOR NO PRE-UPSPACE
*
         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
************************************************************************
*    COMMAND LISTS FOR CARD READER AND LINE PRINTER                    *
************************************************************************
RDCRB    :CLST    RDNC
RDCRA    :CLST    RDBNC
WRLP     :CLST    WRNC
WRLPF    :CLST    WRBNC
FORM     :CLST    FORMNC
         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   FFFF00FF          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,R6    IOQ8,R3           GET DATA CHAIN LIST ADDR
         LW,R5    R6
         SLS,R5   2                 MAKE HALFWORD ADR
         SLS,R6   3                 MAKE BYTE ADDRESS
         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     STB,R8   0,R6              SET ORDER CODE
         STH,R9   1,R5              AND FLAGS
         AI,R6    8                 INCREMENT A DOUBLEWORD
         AI,R5    4                 INCREMENT A DOUBLEWORD
         BDR,R12  CL24              CONTINUE
         AI,R9    -X'8000'          RESET DATA CHAIN BIT
         STH,R9   *M24,R5           IN LAST COMMAND
         LI,R8    X'FFFF'           MASK
         AND,R8   IOQ8,R3           DATA CHAIN ADDRESS
         OR,R8    Y08               SET TIC ORDER CODE
         B        CL91              AND STORE
*
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
USECOM   EQU      CL90              RETURNS HERE TO STORE COMMAND
*
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
*
*
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
*
FFFF00FF 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
         LC       DCT19,R1          GET AIO CC
         CI,R12   X'18'             TEST FOR SIO FAIL OR TIME OUT
         BCR,4+8  IS20              OK, SO FAR
         CI,R12   X'08'             DID SIO FAIL
         BAZ      IS10              NO
         PAGE
*
*        SIO FAILURE HAS OCCURED. NO I/O HAS BEEN ALLOWED
*        TO THIS DEVICE SINCE THEN, AND NO TDV-TIO HAS
*        BEEN PERFORMED YET EITHER, SO THIS ROUTINE
*        WILL SET UP THE DCT'S FOR THE ERROR RECORD
*        SUBROUTINE.
*
         LD,R8    DCT13,R1          SIO STATUS FROM SIO
         SLS,R9   -16               POSITION STATUS
         LH,R10   DCT1,R1           DEVICE ADDRESS
         STH,R9   R10               COMBINE STATUS W/ADDRESS
         STW,R10  DCT12,R1          SAVE LIKE AIO STATUS
         LH,R6    DCT1,R1           DEVICE ADDRESS TO R6
         LCI      0                 CLEAR CONDITION CODES FOR CC3 TEST
         TDV,R8   0,R6              PERFORM TDV
         BCS,2    CC3FAIL           LOG ERROR AND CRASH
         STCF     DCT20,R1          SAVE CC'S
         STD,R8   DCT13,R1          SAVE STATUS
         LCI      0                 CLEAR CONDITION CODES FOR CC3 TEST
         TIO,R5   0,R6              PERFORM TIO
         BCS,2    CC3FAIL           LOG ERROR AND CRASH
         STCF     DCT19,R1          SAVE TIO CC'S
         LH,R5    R5                POSITION STATUS
         STH,R5   DCT21,R1          SAVE TIO STATUS
         LI,R6    X'1106'           CODE/COUNT
         LI,R13   MSG4              MSG ADDR
         LI,R12   X'2800'           SET INTER-OP, KEYIN (NO C)
         B        IS12              GO LOG ERROR
*
IS10     CI,R12   X'10'             DID OP TIME OUT
         BAZ      IOSEREC           NO, MUST BE AIO CC ERROR
         LI,R6    X'120D'           CODE/COUNT
         LI,R13   MSG3              MSG ADDR
         LI,R12   X'3000'           SET INTER-OP, KEYIN
IS12     PUSH     2,5               SAVE REQUIRED REGS
         LI,9     PRE%CU            RETURN THRU R9
         BAL,5    REC:ERR           RECORD ERROR RECORD
         PULL     2,5               RESTORE REGS
         B        PRE%CU
         PAGE
IS20     EQU      %
         LC       R10               CHECK EVEN REG, TDV STATUS FOR
         BCS,4+2  IOSEREC            BUS CHK OR CONTROL 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      %
         PUSH     2,R5              SAVE REQUIRED SET OF REGS
         LB,R6    DCT4,R1           GET DEVICE TYPE
         LB,R15   TB:FLGS,R6
         CI,R15   X'F0'             IS IT A PACK
         BNE      IS25              NO, LOG ERROR
         CW,R5    =X'4184400'       IS IT ONLY A FLAW MARK
         BE       IS30              YES, DON'T LOG IT
         CW,R5    =X'184000'        IS IT ONLY A FLAW MARK (RMC)
         BE       IS30              YES, DON'T LOG IT
IS25     EQU      %
         WD,0     X'37'             LONG PATH THRU CLEANUP GOES
         LB,R6    DCT5,R1           DISABLED W/CLEANUP PENDING RESET
         EOR,R6   X40               RESET CLEANUP PENDING BIT
         STB,R6   DCT5,R1           SO WE DONT GET RE-ENTERED
         LI,R6    X'150D'           ERROR MSG CODE AND COUNT
         BAL,R5   REC:ERR           RECORD ERROR MSG
IS30     EQU      %
         PULL     2,R5              RESTORE REQUIRED SET
         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
         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      IS52              NO
         AND,R11  M16               ISOLATE REMAINING BYTE COUNT
         BNEZ     IS52              OK, SOME LEFT
         LB,R8    DCT4,R1           MAYBE LOST DATA,GET TYPMNE
         CI,R8    9                 IS A 7T DEVICE
         BE       IS52              YES,IGNORE LOST DATA
         LI,R12   2                 NO,SET LOST DATA TYC
IS52     B        *9                RETURN
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,OH:NM,CHKANS1,BATAPE,DOUBLEZERO,M22
         REF      IOQ4,AVRTBL
*
*
         LW,R7    R3                KEEP IOQ INDEX IN R7
         SREF     ANSFLGS
         LD,R8    DOUBLEZERO        ASSUME NULL SN
         LB,R2    IOQ7,R3           GET DCT
         AI,R2    -BATAPE           GET AVR TABLE INDEX
         BLZ      REC:ERR3          NOT TAPE
         LD,R8    AVRTBL,R2         GET AVR TABLE ENTRY
         LC       ANSFLGS,R2        IS THIS AN ANSS TAPE
         BCS,8    %+2               YEP
         LI,R2    0                 NOPE
         STH,R2   R9                PASS FLAG TO ERR:FIL THRU RECORD
         STH,R2   R9                PASS FLAG TO ERR:FIL THRU RECORD
REC:ERR3 LI,R2    2                 NOW PUT
         LB,R6    IOQ4,R7           GET ORIG FUNCTION STEP
         STB,R6   R9,R2             AND PUT AWAY
         LI,R2    3
         LB,R6    IOQ5,R7           GET CURRENT FUNCTION STEP
         STB,R6   R9,R2             AND PUT AWAY
         LW,R3    R7                RESTORE R3 (IOQ INDEX)
         LD,R12   DCT13,R1          TDV STATUS
         LW,R10   DCT12,R1          AIO STATUS / DEVICE ADDRESS
         LI,R2    X'FFFF'           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
         LI,R2    1
         LI,R11   0                 SIGMA'S DONT HAVE MFI
         LB,R0    DCT19,R1          AIO CC'S
         STB,R0   R11,R2
         LI,R2    2
         LB,R0    DCT20,R1          TDV CC'S
         STB,R0   R11,R2
         LH,R0    DCT21,R1          TIO STATUS
         SLS,0    16                MOVE INTO POSITION
         LB,R2    IOQ10,R3          RETRIES REQUESTED
         SLS,R2   8
         LB,R6    IOQ11,R3          RETRIES REMAINING
         AW,R2    R6                TOGETHER IN R2
         AW,R0    R2                ALL WITH TIO STATUS
         LW,R7    R1                DCTX TO R7
         LW,R1    DCT25,R7          GET SIO COUNTER (B00 SPECIFIC)
         LB,R5    DCT4,R7           GET INDEX TO
         LW,R4    IOQ12,R3          SEEK ADDRESS TO R4
         STB,R3   R7                HANG ONTO IOQ INDEX
         LD,R2    R8                MOVE VOLUMN SERIAL #
         LW,R8    R7                DCT INDEX TO R8
         LW,R6    *TSTACK           GET CALLER'S R6 FROM STACK
         STH,R6   R8                PUT IN CODE AND COUNT
         LW,R9    TIME              GET HHMM
         LI,R6    R8                ADDR.OF BUFFER IN R6
         REF      Y4
         AW,R6    Y4                SET FLAG FOR ERHNDLR
*
*        THAT Y4 IN REG 6 TELLS ERRLOG NOT TO CALL
*        IOQ TO WRITE OUT AN ERRLOG BUFFER. YOU CAN
*        GET INTO TROUBLE BY SUCH A THING.
*
         LB,R5    DCT3,R7           RMA DCT-CHECK NOERR BIT
         CI,R5    4                 SHOULD ERRORS BE LOGGED
         BANZ     NOLOG             NO, DO NOT LOG IT
         BAL,R5   ERRLOG
         LW,6     DCT9,7            IS IT DIAG
         LC       6
         BCS,2    NOLOG             YES
         PULL     16,R7
         B        0,R5              EXIT TO CALLER
NOLOG    EQU      %
         LB,R3    R7                RESTORE IOQ INDEX
         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
         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,DCSN,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
         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
         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
*
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
         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
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
         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
*
         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
DPOK     BAL,R6   DRE:ENT           *** DISABLE ***
         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
         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     EXITDONE          0 => READ
         DCBT     EXITDONE          1 => WRITE
         DCBT     EXITDONE          2 => SENSE
         DCBT     EXITDONE          3 => CHECK-WRITE
         DCBT     EXITF             4 => WRITE/CHECKWRITE
         DCBT     EXITDF            5 => LOG DAIG SENSE
         BOUND    4
         PAGE
***********************************
*       EXIT FUNCTIONS            *
***********************************
*
EXITDDONE RD,0    0                 GET SENSE SWITCHES
         BCR,8    EXITDONE          AND TEST FOR CHECK WRITE
         LH,R6    IOQ9,R3           GET REQUEST COUNT
         LW,R7    IOQ8,R3           TEST FOR DATA CHAIN
         BLZ      EXITDD1           YES
EXITDD2  CI,R6    1024-1            CHECK FOR INTEGRAL SECTOR
         BANZ     EXITDONE          NO, DONT CHECK WRITE
*
EXITFI   AI,R12   FLGINTER          SET INEROP BIT
*
EXITF    AI,R12   FLGFOLOW          SET FOLLOWON FLAG
EXITCU   RES      0
         ENABLE                     **ENABLE**
         LI,R11   0
         B        IOSCU
*
EXITDONE LI,R12   TYCOK             SET NORMAL COMPLETION
EXITHIO  RES      0
         LH,R7    DCT1,R1           GET DEVICE ADDRESS
         LCI      0                 CLEAR CONDITION CODES FOR CC3 TEST
         HIO,R0   0,R7              HALT IT TO RELEASE CONTROLLER
         BCS,2    CC3FAIL           LOG ERROR AND CRASH
         B        EXITCU            MERGE WITH COMMON CODE
*
EXITHIOR LI,R12   FLGRETRY+TYCERR
         B        EXITHIO
EXITERR  LI,R12   TYCERR            SET ERROR TYC
         B        EXITHIO           AND RELEASE
EXITREST AI,R0    -DISCCU1          CHECK FOR RAD
         BGE      EXITERR           RAD JUST ERROR
         LI,R7    SUNREST           CARRIAGE RESTORE FOR PACK
         B        EXITFO1           FOLLOWON TO RESTORE
EXITDD1  SLS,R7   1                 MAKE WA
         AI,R6    -1                CONVERT COUNT TO INDEX
         LD,R8    *R7               GET FIRST COMMAND
         AD,R8    *R7,R6            ADD NEXT
         BDR,R6   %-1               ADD THEM ALL
         LW,R6    R9                TRANSFER TO TEST REG
         B        EXITDD2           AND CHECK FOR INTEGRAL SECTORS
         PAGE
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
EXITFO   LB,R7    IOQ4,R3           GET ORIGINAL FUNCTION
EXITFO1  RES      0
         STH,R7   DCT17,R1          SET AS FOLLOW-ON
         B        EXITF             AND PROCEED
         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   LB,R7    ACTION,R7         GET ACTION
         BAL,R6   DRE:ENT           *** DISABLE ***
         B        DPAKCU,R7         AND GO TO IT
*
*
*        CHECK FOR RE-ENTRANCE OR EXTERNAL COMMAND LIST
*
DRE:ENT  DISABLE                    *** DISABLE ***
         CH,R14   DCT10,R1          CHECK FOR RE-ENTRANCE
         BNE      RESCHED           YES, GET OUT
         INT,R9   IOQ8,R3           TEST FOR EXTERNAL CLIST
         BCR,4    0,R6              NO, CONTINUE
         B        EXITHIO           YES, SKIP CHECKS
*
*
         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   EXITREST          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
************************************************
*        SENSE DATA ERROR LOGGING              *
************************************************
*
EXITDF   RES      0
         LH,R5    DCT7,R1           GET CLIST AREA ADDRESS
         SLS,R5   1                 CONVERT TO WORD ADDRESS
         LH,R7    DCT1,R1           GET CURRENT I/O ADDRESS
         OR,R7    =X'16060000'      SET CODE/COUNT
         LW,R8    TIME              GET HHMM
         LCI      4
         LM,R9    SENSEBUF,R5       GET SENSE DATA
         LW,R6    =X'40000007'      SET NO I/O FLAG AND MSG ADDR
         BAL,R5   ERRLOG
         LI,R12   0                 INITIALIZE FLAGS
         B        EXITF
         PAGE
*
*        FLAW MARK DETECTED IN STATUS
*
EXITFLAW RES      0
         LI,R7    RDHDR             SET FOLLOW-ON TO READ HEADER
         LI,R12   FLGINTER+TYCOK    INITIALIZE FLAGS TO HOLD DEVICE
         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
         LI,12    X'C000'
PRE%CU1  EQU      %
         MTB,1    IOQ11,3
         B        IOSCU
*
CR       EQU      %
CR3T     DATA     X'15050505'
FERMSG   TEXTC    ' FEED ERROR'     THIS MESSAGE INDICATES THAT THE
         DEF      HANDLERSZ
HANDLERSZ EQU     %-HANDLERS
         END

