*M*      CRDOUT   7160 HIGH SPEED CARD PUNCH HANDLER
         DEF      CRDOUT:
CRDOUT:  EQU      %
*        705696   SIGMA 5/7         BPM   CARD PUNCH HANDLER
         SYSTEM   SIG7P
         PAGE
*
*    EXTERNAL DEFINITIONS AND REFERENCES
*
         DEF      CRDOUT,CRDOCU
*
         REF      DCT7,IOQ5,IOQ8,IOQ9,DCT10
         REF      RE:ENT,IOSST,IOSCU,DOTDC,IOSERCK
         REF      Y1,Y04,M2
         REF      Y4
         REF      TSTACK
         REF      DCT21,IOSEREC
         PAGE
*
*   REGISTER DEFINITIONS
*
R0       EQU      0
R1       EQU      1
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
         PAGE
************************************************************************
*    CARD PUNCH HANDLER PRE-PROCESSOR                                  *
************************************************************************
CRDOUT   LH,R5    DCT7,R1           CLIST ADDR
         LD,R12   0,R5              GET STATE AND BUF POINTER
         AW,R5    R12               DISP TO PUNCH COMMAND
         LD,R10   0,R5              GET PUNCH COMMAND
         LB,R9    R12               GET STATE
         BEZ      CP10              NEW CARD
         CI,R9    2                 2ND CARD OF READ CHK RETRY
         BE       CP40              YES
         OR,R10   Y1                NO, SET ALT STACKER BIT
         B        CP42
*
CP10     EQU      %
         LB,R9    IOQ5,R3           FUNCTION CODE
         BNEZ     CP20              BINARY
         LW,R0    Y4                PAD CHAR FOR BCD
         LI,R9    80                BCD CHAR COUNT IS 80
         OR,R10   Y04               SET BCD BIT
         B        CP30
*
CP20     LI,R0    0                 FILL IS 0
         LI,R9    120               BINARY COUNT IS 120
         AND,R10  =X'FBFFFFFF'      RESET BCD BIT
*
*
*        THE FOLLOWING ROUTINE WILL MOVE THE USER'S RECORD TO
*           CLIST AREA
*        REGISTER USAGE:
*          R0=FILL CHAR IN BYTE ZERO
*        R5=DA OFCDW SLOT IN CLIST
*        R6=USER BUFFER BA
*        R7=DEST BA IN CLIST AREA
*        R8=CHAR COUNT TO PUNCH
*        R9=FILL CHAR COUNT
*        R10,R11=CDW FOR THIS OP
*
CP30     EQU      %
         LW,R12   R1                HOLD DCTX IN 12
         LI,R7    3
         STB,R9   R11,R7
         AW,R7    R5                BASE DA OF CLIST
         SLS,R7   3                 R7 BA FORMAT OF DEST
         LW,R6    IOQ8,R3           USER BUFFER BA
         LH,R1    IOQ9,R3           USER BYTE COUNT
         CW,R1    R9                TEST REQUESTED VS MAX
         BLE      %+2               OK
         LW,R1    R9                MAX ONLY
         SW,R9    R1                CALC FILL COUNT
         STB,R1   R7                COMP MBS PAIR
         MBS,R6   0                 MOVE RECORD INTO PLACE
         LW,R1    R7                OBTAIN PADDING DEST
         STB,R9   R1                STORE FILL COUNT
         MBS,R0   0                 PAD OUT BUFFER
         LW,R1    R12               RESTORE DCTX
CP40     AND,R10  =X'EFFFFFFF'      SET FOR NORMAL STACKER, NO ERR
*
CP42     BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**
*
         STD,R10  0,R5              STORE PUNCH COMMAND
         LI,R10   DOTDC             DOT ADDR FOR STARTIO (SAME AS RAD)
         LW,R0    R5                COPY CLIST ADDR
         B        IOSST
         PAGE
************************************************************************
*    CARD PUNCH HANDLER POST-PROCESSOR                                 *
************************************************************************
CRDOCU   BAL,R9   IOSERCK           GEN ERROR CHECK
         LI,R12   1                 SET TYC = NORMAL
         LH,R7    DCT7,R1           CLIST ADDR
         LD,R8    0,R7              GET STATE AND BUF POINTERS
         LB,R6    R8                STATE
         CI,R6    1                 IS IT 01 OR 11
         BANZ     CP52              YES, IGNORE READ CHECK ERROR
         CI,R5    X'2000'           NO, IS IT READ CHECK ERROR
         BAZ      CP50              NO
         LI,R6    1                 YES, SET STATE TO 01
         B        CP60
CP50     LI,R6    3                 SET STATE TO 11
CP52     EQU      %
         LH,R0    DCT21,R1          TIO STAT.
         CI,R0    X'6600'           DEVICE & CONTR. READY
         BAZ      CP54
         LI,R12   X'C008'           GOING TO RETRY
         LW,R6    R9                SAVE R9 -- SIDR #21705  04:02:74
         BAL,R9   IOSEREC           NO--LOG ERROR
         LW,R9    R6                RESTORE R9  -- #21705
         LI,R6    2                 FEED CK.
         B        CP62
CP54     EQU      %
         CI,R5    X'907E'           ANY TRANSMISSION ERRORS
         BANZ     CP62              YES
         EOR,R6   M2                NO, SET STATE TO 00 OR 10
*
CP60     XW,R8    R9                EXCHANGE BUFFER OFFSETS
CP62     STB,R6   R8                SAVE STATE
         CI,R6    0                 IS STATE 00
         BE       %+2               YES
         OR,R12   =X'6000'          NO, SET FOLLOW-ON, INTER-OP
*
         BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**
*
         STD,R8   0,R7              STORE BUF POINTERS
         B        IOSCU             TO CLEANUP
*
         END

