3270IO:  EQU      %
         DEF      3270IO:
*********************************************************
*     THIS ASSEMBLY CONTAINS THE CP-V 3270 HANDLER FOR  *
*TRANSACTION PROCESSING  -- SMK                         *
*********************************************************
         SYSTEM   SIG7FDP
*   REGISTER DEFINITIONS            COMMON USAGE
*                                   :
R0       EQU      0                 GENERAL TEMP - BAL'S
R1       EQU      1                 DCTX (I/O STND)
R2       EQU      2                 IOQ LINKAGE (I/O STND)
R3       EQU      3                 IOQX (I/O STND)
R4       EQU      4                 FLGS,CITX (I/O STND)
R5       EQU      5                 DA(CLIST)
R6       EQU      6                 P-S LIST ADDR
R7       EQU      7                 TEMP P-S WD 1
SR1,R8   EQU      8                 GENERAL TEMP - I/O CDW'S
SR2,R9   EQU      9                 GENERAL TEMP - I/O CDW'S
SR3,R10  EQU      10                GENERAL TEMP - CLST BUF CNTS
SR4,R11  EQU      11                GENERAL TEMP - CLST BUF CNTS
D1,R12   EQU      12                GENERAL TEMP - TYC AT EXIT
D2,R13   EQU      13                GENERAL TEMP - CURR CRC
D3,R14   EQU      14                DAC (I/O STND)
D4,R15   EQU      15                IOQ LINKAGE (I/O STND)
*
         PAGE
*
*
*          REFS AND DEFS
*
         DEF      3270IO,3270CU
         REF      COMLIST,USECOM,DELCOM
         REF      IOSCU,IOSERCK,RE:ENT,RESCHED
         REF      IOQ4,IOQ11,IOQ5,IOQ8,IOQ9,IOQ13,IOQ12
         REF      DCT7,DCT13,DCT2,DCT17,DCT3
         REF      DCT6,DCT8
         REF      M11,M9,M16,M7,M8,M24,M22,Y008
         REF      XFFFF00,M4,M5,X8000
         REF      TSTACK,DOUBLEZERO
*
*
*
*          RANDOM  DEFINITIONS
*                                   P-S LIST FLAGS
*                                   :
HALT     EQU      X'40000'          HALT
AUTO     EQU      X'80000'          AUTO
CLOSED   EQU      X'10000'          CLOSED
*
*FIRST 8 CHARS OF POL OR SEL HEADING
*
         BOUND    8
SYNSET   DATA,1   PAD,SYNC,SYNC,SYNC
         DATA,1   SYNC,EOT,PAD,SYNC
CRC%ESC  EQU      X'1A40'           CRC OF ESC
         PAGE
*
*        :DOT TABLE FOR COMLIST
*
:DOT     CNAME
         PROC
LF       EQU      %-DOT
         GEN,8,8,8,8 BA(AF(1))-BA(DOT),AF(2),AF(3),AF(4)
         PEND
*
*
*
PST:SET  CNAME
*
DOT%X    SET      1
         PROC
         ERROR,15,(AF(1)-BASE:)>255 'PST TOO FAR FROM BASE:'
POST%V(DOT%X)  SET   AF(1)-BASE:
DOT%X    SET      DOT%X+1
         PEND
*
*
         PAGE
*
*THE :DOT PROC GENERATES:  DUMMY CMND PTR, T.O. 5 SEC INCR.,
*RETRY FC, FOLLOWON FC - 8,8,8,8 -- THE PST:SET PROC
*GENERATES THE BACKEND ENTRY VECTOR IN THE TABLE BELOW
*
DOT      SET      %
32:DOT   EQU      DOT
*
ETX%PAD  DATA     PAD+ETX**24       32RD:DOT MUST BE FC=1
*
         PST:SET  BASE:
32RD:DOT :DOT     WP%,1,32NK:DOT,32R0:DOT  POL - RD 1ST BLOCK
         PST:SET  CHK%RD                   :
32R0:DOT :DOT     R0%,1,32N1:DOT,32R1:DOT  SND ACK0 - RD ODD BLK
         PST:SET  CHK%RD1                  :
32R1:DOT :DOT     R1%,1,32N0:DOT,32R0:DOT  SND ACK1 - RD EVEN BLK
         PST:SET  CHK%RD1                  :
32SL:DOT :DOT     SL%,1,32SL:DOT,32WT:DOT  SELECT - RD FOR ACK0
         PST:SET  CHK%AK                   :
32WT:DOT :DOT     WT%,1,32WT:DOT,32ET:DOT  WRITE - RD FOR ACK1
         PST:SET  CHK%AK1                  :
32ET:DOT :DOT     ET%,1,32ET:DOT,32RD:DOT  SEND EOT
         PST:SET  NXT%OP                   :
32NK:DOT :DOT     NK%,1,32NK:DOT,32RD:DOT  NAK 1ST BLK - REREAD
         PST:SET  CHK%RD                   :
32N0:DOT :DOT     NN%,1,32N0:DOT,32R0:DOT  NAK EVEN BLK - REREAD
         PST:SET  CHK%RD1                  :
32N1:DOT :DOT     NN%,1,32N1:DOT,32R1:DOT  NAK ODD BLK - REREAD
         PST:SET  CHK%RD1                  :
32WG:DOT :DOT     WG%,1,32RD:DOT,32RD:DOT  WRITE W/SKIP 4 TIMING DELAY
         PST:SET  FOLLOWON
DOT%X    SET      DOT%X-1           SIZE OF :DOT TABLE
         PAGE
:CLST    CNAME
         PROC
LF       GEN,8    DA(AF(1))-DA(DOT)
         PEND
*
*SHELL COMMAND POINTERS
*
WP%      :CLST    WHCOM             WRT POL HDR FROM CLST
RH%      :CLST    RHCOM             RD RSP (3) INTO LST
RX%      :CLST    RDCOM             RD DATA
         :CLST    RDCOM             RD DATA
         :CLST    RSCOM             RD TRAILER INTO CLST
*                                   -
SL%      :CLST    WHCOM             WRT SEL HDR FROM CLST
         :CLST    RSCOM             RD RSP INTO CLST
*                                   -
WT%      :CLST    STXCOM            WRT STX ESC MSG
WX%      :CLST    WTXTCOM           WRT DATA
         :CLST    WTXTCOM           WRT DATA
         :CLST    ETXCOM            WRT ETX CRC CRC PAD
         :CLST    RSCOM             RD RSP INTO CLST
*                                   -
ET%      :CLST    ETCOM             WRT EOT MSG
*
*WHEN RH1COM IS USED WHAT AMMOUNTS TO A BRANCH
*TO RX% OCCURS.  NOTE THAT RHCOM READS 3 BYTES INTO THE
*HEADER BUFFER WHILE RH1COM READS 1. THIS IS TO HANDLE
*THE DEVICE ADDRESS SENT IN THE FIRST BLOCK
*
NK%      :CLST    NKCOM             WRT NAK MSG
         :CLST    RHCOM             RD RSP (3) INTO CLST
*                                   -
R0%      :CLST    A0COM             WRT ACK0 MSG
         :CLST    RH1COM            RD RSP (1) INTO CLST
*                                   -
R1%      :CLST    A1COM             WRT ACK1 MSG
         :CLST    RH1COM            RD RSP (1) INTO CLST
*                                   -
NN%      :CLST    NKCOM             WRT NAK MSG
         :CLST    RH1COM            RD RSP (1) INTO CLST
*                                   -
WG%      :CLST    WGCOM             WRT 200MS OF ZERO (SKIP)
         PAGE
*
*       COMMAND LIST DEFINITIONS
*
AKB%DSP  EQU      56
STRT%DSP EQU      60
AKB%IND  EQU      14
CM1%BBC  EQU      18
CM2%BBC  EQU      20
CNT%RD   EQU      CM1%BBC-(RD%ST**1)
CNT%WRT  EQU      CM1%BBC-(WT%ST**1)
HDR%DSP  EQU      40
SVSTF    EQU      16
RD%ST    EQU      BA(RX%)-BA(WP%)
WT%ST    EQU      BA(WX%)-BA(WT%)
ADDR%IND EQU      12
EOM%IND  EQU      14
EOM%DSP  EQU      60
PSS%IND  EQU      10
*
*THE CLST AREA IS AS FOLLOWS:
*
*0 FIVE DOUBLEWORDS FOR I/O CDW'S
*
*10 POLLING OR SELECTION HEADER (4 WORDS)
*
*14 BUFFER FOR RSCOM
*
*15 BUFFER FOR RH(1)COM (INPUT)
*   ETX CRC CRC PAD (OUTPUT)
*
*16 P-S LIST ADDRESS
*
*17 TEMP WORD 1 OF P-S LIST
*
*18 TWO DOUBLEWORDS CONTAINING BUF AND B.C. FOR
*   DATA XFER CMDS BUF=0 MEANS SKIP THIS CMND
         PAGE
:CDW     CNAME
         PROC
LF       EQU      WA(%)
         DO       AF(2)=4
         DATA,1   CF(2)
         DATA,3   WA(AF(1))
         ELSE
         DATA,1   CF(2)
         DATA,3   BA(AF(1))
         FIN
         GEN,8,8,8,8         CF(3),X'80',AF(2),AF(3)
         PEND
*
         BOUND    8
*
*
*
WRT      EQU      1
RD       EQU      2
ENDF     EQU      X'1E'
DCF      EQU      X'9E'
CCF      EQU      X'2E'
SKF      EQU      X'1F'
*
*SHELL COMMAND DOUBLEWORDS
*
WHCOM    :CDW,WRT,CCF  32%SPC1,4,16
STXCOM   :CDW,WRT,DCF     STXM,0,6
ETXCOM   :CDW,WRT,CCF     32%SPC5,4,4
RHCOM    :CDW,RD,DCF      32%SPC4,4,3
RH1COM   :CDW,RD,DCF      32%SPC4,4,1
RDCOM    :CDW,RD,DCF    32%SPC2,4,0
WTXTCOM  :CDW,WRT,DCF     32%SPC25,4,0
RSCOM    :CDW,RD,ENDF     32%SPC3,4,3
ETCOM    :CDW,WRT,ENDF       EOTM,0,6
NKCOM    :CDW,WRT,CCF        NAKM,0,6
WGCOM    :CDW,WRT,SKF   3270IO,0,100
A0COM    :CDW,WRT,CCF     ACK1M,0,7
A1COM    :CDW,WRT,CCF     ACK0M,0,7
*
         PAGE
*
32%SPC1  EQU      %
         LI,R5    HDR%DSP
32%SPC01 EQU      %                 INSERT CLST ADDR INTO COMMAND
         LH,R12   DCT7,R1           CLST DISP IN R5
         SLS,R12  3
         AW,R12   R5
32%SPC   EQU      %
         OR,R8    R12
         B        USECOM
32%SPC2  EQU      %
         LI,R12   CNT%RD
32%SPC28 AD,R8    *R12,R7           INSERT BUF AND B.C. INTO DATA
         CW,R8    M22               *XFER CMND - IF BUF=0 SKIP IT
         BAZ      DELCOM
         B        USECOM
32%SPC25 LI,R12   CNT%WRT
         B        32%SPC28
32%SPC3  EQU      %
         LI,R5    AKB%DSP
         B        32%SPC01
32%SPC4  EQU      %
         LI,R5    STRT%DSP
         LI,R6    BA(RX%)-BA(DOT)-1    BRANCH TO RX%
         B        32%SPC01
32%SPC5  EQU      %
         LI,R5    EOM%DSP
         B        32%SPC01
         PAGE
SYNC     EQU      X'32'
SOH      EQU      X'01'
STX      EQU      X'02'
ETB      EQU      X'26'
ETX      EQU      X'03'
ENQ      EQU      X'2D'
EOT      EQU      X'37'
NAK      EQU      X'3D'
ACK0     EQU      X'70'
ACK1     EQU      X'61'
DLE      EQU      X'10'
WACK     EQU      X'6B'
RVI      EQU      X'7C'
ESC      EQU      X'27'
PAD      EQU      X'FF'
*
*
DAK0     EQU      ACK0+DLE**8
DAK1     EQU      ACK1+DLE**8
DWAK     EQU      WACK+DLE**8
DRVI     EQU      RVI+DLE**8
         PAGE
*
*CANNED MESSAGES
*
STXM     DATA,1   SYNC,SYNC,SYNC,SYNC,STX,ESC
NAKM     DATA,1   SYNC,SYNC,SYNC,SYNC,NAK,PAD
ACK0M    DATA,1   SYNC,SYNC,SYNC,SYNC,DLE,ACK0,PAD
ACK1M    DATA,1   SYNC,SYNC,SYNC,SYNC,DLE,ACK1,PAD
EOTM     DATA,1   SYNC,SYNC,SYNC,SYNC,EOT,PAD
         PAGE
*
*BACKEND ENTRY VECTORS BY FC
*
PST%VEC  EQU      %
PV       DO       DOT%X
         DATA,1   POST%V(PV)
         FIN
         BOUND    4
         PAGE
*
*
3270IO   EQU      %                 HANDLER FRONT END
         LB,R5    IOQ5,R3           :
         AND,R5   M7                IF THIS IS FIRST ENTRY ON
         BEZ      SET%UP            THIS IOQ GO TO SET%UP
PRE%XIT  EQU      %                 OTHERWISE OFF TO COMLIST
         STB,R5   IOQ5,R3           :
         LI,R10   32:DOT            IOQ4 -- 0=RD 80=WRT
         B        COMLIST
         SPACE    5
3270CU   EQU      %                 HANDLER BACKEND
         LB,R5    DCT3,R1           :
         CI,R5    X'10'             IF WE TIMED OUT GO RETRY
         BANZ     32%TO             OTHERWISE GET CLST DA IN
         BAL,R9   IOSERCK           R5, P-S LIST WA IN R6,
         B        PST%XIT           TEMP P-S WORD 1 IN R7, AND
         LB,R5    IOQ5,R3           CLST BUFS INTO 10 AND 11
         LB,R12   PST%VEC,R5        :
         AI,R12   BASE:             THEN TAKE VECTOR TO BACKEND
         LH,R5    DCT7,R1           ENTRY BY FC
         LD,R6    SVSTF,R5
         LD,R10   AKB%IND,R5
         B        *R12
         PAGE
BASE:    EQU      %                 BASE FOR BACKEND BYTE VECTORS
*
*
CHK%RD   EQU      %                 BACKEND FOR POL - RD 1ST
         BAL,R8   RD%CK             :
         BNE      RD%SET            CHECK LEADER - IF SOH NAK
         LI,R6    2                 SO THAT USER GETS 1ST 2 BYTES
         LI,R9    -1                :
         SLS,R11  8                 GET CRC OF DEV ADDR
         LB,R7    R11               :
         BAL,R12  CRC%MSG2          AND OFF TO COMMON READ CODE
         SLS,R11  8
         LB,R7    R11
         BAL,R12  CRC%MSG2
         B        DO%RD
CHK%RD1  EQU      %                 BACKEND FOR RD NEXT(S)
         BAL,R8   RD%CK             :
         BNE      NAKOUT1           CHK LDR - NEW SOH -> NAK
DO%RD    EQU      %
         AI,R5    RD%ST             COMMON READ CODE
         LI,R8    0                 :
         LD,R10   DCT13,R1          PROCESS COMMANDS FIRST TO
         AND,R10  M22               LAST CRC'ING EACH BYTE
         LI,R4    2                 :
GT%COM   EQU      %                 IF AN ENQ IS FOUND SET TEMP
         LD,R6    0,R5              ERROR CODE AND NAK. - IF HE
         LW,R12   R7                SAYS EOT, ERROR CODE WILL
         AND,R12  M16               STICK. OTHERWISE IT WAS A
         CW,R5    R10               LINE HIT AND ERROR CODE WILL
         BG       END%RD            BE OVERWRITTEN
         BNE      CNT%BYTS          :
         AND,R11  M16               ON LAST COMMAND SUBTRACT
         SW,R12   R11               OUT THE REMAINING BYTE
CNT%BYTS EQU      %                 COUNT
         AW,R8    R12               :
IN%CRC   EQU      %                 AFTER THE CRC'ING IS DONE
         LB,R7    0,R6              ON ALL COMMANDS GO TO END%RD
         CI,R7    ENQ               :
         BNE      INCRC1            NUMBER OF BYTES READ IS
         LI,R12   X'2A'             ACCUMULATED IN R8
         STB,R12  IOQ4,R3
         B        NAKOUT2
INCRC1   EQU      %
         LB,R9    R13,R4
         AND,R13  M8
         EOR,R7   R13
         LH,R13   CRCTBL,R7
         EOR,R13  R9
         AI,R6    1
         BDR,R12  IN%CRC
         AI,R5    1
         B        GT%COM
*******************************************************
END%RD   EQU      %                 CRC DONE ON READ OPERATION
         AI,R13   0                 :
         BNEZ     NAKOUT2           IF THE CRC WAS BAD NAK HIM
         AI,R8    -3                :
         LH,R10   IOQ9,R3           KEEP THE RBC IN IOQ9 AND THE
         SW,R10   R8                TYC IN IOQ4 UP TO DATE - IF
         STH,R10  IOQ9,R3           WE EVER GET AN EOT WE GO
         LH,R5    DCT7,R1           STRAIGHT TO NXT%OP
         LD,R10   CM1%BBC,R5        :
BK%BF    EQU      %                 SUBTRACT ETX CRC CRC OUT OF
         AW,R10   R8                BYTE COUNT
         SW,R11   R8                :
         BGZ      SET%OUT           CORRECT THE CUR RBC IN IOQ9
         LI,R12   0                 :
         LCW,R8   R11               CORRECT THE BUFF AND B.C.
         LD,R10   CM2%BBC,R5        CELLS IN THE CLST SO THAT
         STD,R12  CM2%BBC,R5        THE NEXT BLOCK WILL ABUT
         BNEZ     BK%BF             THE LAST
SET%OUT  EQU      %                 :
         STD,R10  CM1%BBC,R5        IF THE TEMP TYC HAS X'40'
         LC       IOQ4,R3           SET KEEP IT - ELSE SET IT TO
         BCS,4    FOLLOWON          1 AND SET THE KEEP BIT
         LI,R12   X'41'
         B        NF%1
****************************************************
RD%SET   EQU      %                 NAK SOH MSG SO THAT THE NEXT
         LI,R11   32N0:DOT          READ WILL NOT LOOSE 2 CHAR
         B        NEW%FLO
RD%CK    EQU      %                 CHECK 1ST CHAR OF INPUT BLK
         LI,R13   0                 :
         LB,R12   R11               R13=0 TO START CRC
         CI,R12   EOT               :
         BE       NXT%OP            EOT -> RD DONE
         CI,R12   STX               STX -> AOK (CC'S =)
         BE       *R8               SOH -> SET ERROR CODE
         CI,R12   SOH                   TO STATUS READ
         BNE      RD%CK1            ENQ -> REPEAT ORIGONAL
         LI,R12   X'50'                 OPERATION
         CB,R12   IOQ4,R3           :
         B        *R8               ANYTHING ELSE WE NAK
RD%CK1   EQU      %
         CI,R12   ENQ
         BNE      NAKOUT1
         LB,R12   IOQ5,R3
         SLS,R12  8
         STH,R12  DCT17,R1
         B        NAKOUT1
****************************************************
CHK%AK1  EQU      %                 CHECK FOR ACK0 ON SELECT
         LI,R12   DAK1
         B        CK%AK
CHK%AK   EQU      %                 CHECK FOR ACK1 ON WRITE
         LI,R12   DAK0
CK%AK    EQU      %                 CHECK ACK RESPONSE
         CH,12    10                :
         BE       FOLLOWON          IF ACK CONTINUE
         LH,R10   R10               :
         CI,R10   DWAK              IF WACK OR RVI FIRST SEND
         BE       ET%OUT            EOT, THEN QUIT WITH TYC=
         CI,R10   DRVI              NOT IN RECIEVE STATE
         BE       ET%OUT            :
         SLS,R10  -8                IF EOT, QUIT NOW WITH
         CI,R10   EOT               TYC= NOT IN RECIEVE STATE
         BNE      NAKIN             :
         LI,R11   0                 ANYTHING ELSE IS NAK
         LI,R12   9
         B        SET%STI
ET%OUT   EQU      %
         LI,R12   X'A9'
         LI,R11   32ET:DOT          ANYTHING ELSE IS NAK
NEW%FLO  EQU      %
         STH,R11  DCT17,R1
NF%1     EQU      %
         STB,R12  IOQ4,R3
         B        FOLLOWON
**********************************************************
NXT%OP   EQU      %                 MOVE DOWN P-S LIST
         LI,R12   X'B'              :
         LI,R11   0                 IF WE DID A WRITE OR
         LC       IOQ4,R3           A READ WHERE WE GOT
         BCS,6    ST%STI1           DATA WE'RE DONE
         BCS,8    SET%STI           :
         LI,R12   3                 ON AN UNANSWERED POL
         LW,R10   0,R6              WE TRY TO DO THE NEXT
         CI,R10   HALT              GUY
         BANZ     SET%STI           :
         CI,R10   AUTO              IF HALT WAS SPECIFIED OR
         BAZ      SET%STI           AUTO WASN'T TELL THE
         LB,R13   R7                USER NO DATA AND QUIT
         BAL,R0   G%PADR            :
         LB,R13   *R13              OTHERWISE ADVANCE TO THE
         LI,R0    32RD:DOT          NEXT P-S ENTRY
         LI,R4    2                 :
         CB,R13   R7,R4             IF THIS ISN'T WHERE WE
         BNE      N%OP1             STARTED - FOLLOWON TO
         LI,R12   X'F'              READ THIS GUY
         CI,R10   CLOSED            :
         BAZ      SET%STI           IF IT IS AND THE LIST IS
         LI,R0    32WG:DOT          OPEN WE'RE DONE
N%OP1    EQU      %                 :
         STH,R0   DCT17,R1          OTHERWISE WRITE TIMING DELAY
         STB,R13  R7                BEFORE GOING ON TO THE NEXT
         STD,R6   SVSTF,R5          GUY
         BAL,R7   SET%ADR
FOLLOWON EQU      %                 SET FOLLOWON - INTEROP
         LI,R12   X'6000'           :
PST%XIT  EQU      %                 RESTORE R4 AND EXIT TO IOQ
         LB,R4    DCT2,R1
         B        IOSCU
******************************************************
SET%UP   EQU      %                 TRANSLATE INPUT INFO
         STB,R3   DCT6,R1           INTO USABLE FORM
         LH,R5    DCT7,R1           :
         LD,R6    SYNSET            THE END ACTION INFO OF
         STD,R6   PSS%IND,R5        ALL TP I/O CALLS IS A
         LD,R6    IOQ13,R3          POINTER TO A 4 WORD BUFFER
         LW,R6    1,R7              AS FOLLOWS:
         LW,R10   3,R7              *
         LH,R12   R10               1 - IGNORED
         BEZ      SET%BGPL          2 - STRT P-S INDX, RA(P-S) 8,24
         LCW,R13  1,R7              3 - IGNORED
         AND,R13  M9                4 - PG#2(P-S),PG#2(BUFF) 16,16
         BNEZ     %+2               :
SET%BGPL LI,R13   511               IOQ12 IS SET TO BE:
         AI,R13   -1                *
         STH,R13  R12               (SZ(P-S(PG#1)))-1,PG#2(P-S) 16,16
         STW,R12  IOQ12,R3          :
         LI,R13   0                 THE STARTING P-S INDEX IS
         BAL,R0   G%PADR            OBTAINED FROM THE BUF OR P-S
         LW,R7    *R13              AND MADE THE STRT AND CUR
         LC       IOQ4,R3           INDEX IN THE TEMP P-S WD 1,
         LI,R3    2                 AND IT AND THE P-S ADDR ARE
         BCR,8    %+2               STORED IN THE CLST
         LI,R3    3                 :
         LB,R13   R6                THE HEADER FOR THE POL OR
         BNEZ     %+2               SEL OF THE STRTING GUY IS
         LB,R13   R7,R3             SET IN THE CLST
         STB,R13  R7,R3             :
         AI,R3    -2                THE BUF AND B.C. FOR 1 OR
         STB,R13  R7,R3             2 DATA XFER CMNDS IS
         STD,R6   SVSTF,R5          CALCULATED AND STORED IN
         LB,R3    DCT6,R1           THE CLST
         BAL,R7   SET%ADR           :
SET%BUF  EQU      %                 IF THIS IS A READ THE CALLING
         LW,R8    IOQ8,R3           FC IS CHANGED TO POL - READ
         LH,R9    IOQ9,R3           AND WE GO OFF TO COMLIST
         LW,R11   IOQ8,R3           :
         AND,R10  M16               IF ITS A WRITE THE MESSAGE
         BEZ      STR%CL            IS CRC'ED, THEN AN ETX
         SLS,R10  11                CHARACTER IS CRC'ED AND
         AND,R11  M11               A WORD OF ETX CRC CRC PAD IS
         AH,R11   IOQ9,R3           STORED IN THE CLST
         AI,R11   -X'800'           :
         SW,R9    R11               THEN WE GO TO COMLIST
STR%CL   EQU      %                 WITH A NEW CURRENT FC
         STD,R8   CM1%BBC,R5        OF SELECT
         STD,R10  CM2%BBC,R5
         LI,R5    32RD:DOT
         LC       IOQ4,R3
         BCR,8    PRE%XIT
         LI,R13   CRC%ESC
         LI,R6    2
         PSW,R1   TSTACK
         LW,R1    R8
         BAL,R12  CRC%MSG
         LW,R1    R10
         BEZ      %+3
         LW,R9    R11
         BAL,R12  CRC%MSG
         LI,R7    ETX
         BAL,R12  CRC%MSG2
         PLW,R1   TSTACK
         STH,R13  R13
         AND,R13  XFFFF00
         OR,R13   ETX%PAD
         LH,R5    DCT7,R1
         STD,R12  EOM%IND,R5
         LI,R5    32SL:DOT
         B        PRE%XIT
***********************************************************
G%PADR   EQU      %                 GET P-S LIST ADDRESS INTO
         AI,R13   1                 R13 GIVEN INDEX INTO P-S
         LW,R8    IOQ12,R3          :
         CH,R13   R8                IF INDEX IS IN THE FIRST
         BG       %+3               PAGE WE JUST ADD DISP IN R6
         AW,R13   R6                :
         B        *R0               IF NOT WE GET THE DISP INTO
         SH,R13   R8                THE SECOND PAGE AND ADD IN
         AI,R13   -1                THE PG#2 ADDR IN IOQ12
         AND,R8   M16
         SLS,R8   9
         AW,R13   R8
         B        *R0
*******************************************************
CRC%MSG  EQU      %                 CRC OUTPUT MESSAGE
         LB,R7    0,R1              :
CRC%MSG1 EQU      %                 IN:  R1=BA(MSG),R9=B.C.
         AI,R1    1                      R6=2,R13=CUR CRC(OR 0)
CRC%MSG2 EQU      %                 :
         LB,R8    R13,R6            GETS NEW CURRENT CRC INTO R13
         AND,R13  M8                :
         EOR,R7   R13               FOR 1 CHAR SET 9<=0 AND 7=CHAR
         LH,R13   CRCTBL,R7         AND COME IN AT CRC%MSG2
         EOR,R13  R8
         BDR,R9   CRC%MSG
         B        *R12
******************************************************
SET%ADR  EQU      %                 SET 2ND TWO WORDS OF POL
         BAL,R0   G%PADR            OR SEL HDR INTO CLST
         LW,R13   *R13              :
         LC       IOQ4,R3           1ST TWO FIXED SET BY SET%UP
         BCR,8    ST%ADR1           :
         AI,R13   X'2000'           IF THIS IS A SEL SET
         INT,R9   R13               THE X'20' BIT IN THE
         SLS,R9   -8                CNTRLR ADDR TO GET SEL
         CI,R9    X'E1'             ADDR.  IF ITS ONE OF
         BE       %+3               THE WEIRD ONES FIX IT
         CI,R9    X'70'             :
         BNE      ST%ADR1           :
         EOR,R13  X8000             :
ST%ADR1  EQU      %                 :
         LI,R9    PAD+ENQ**8        :
         STH,R13  R9                SETUP:  (CA=CNTRLR ADDR,DA=DEV ADDR)
         STB,R13  R9                *
         LI,R8    SYNC+SYNC**8      SYNC SYNC CA CA
         SLS,R13  -8                DA DA ENQ PAD
         STH,R13  R8                *
         STB,R13  R8                R13 IS CONVERTED FROM P-S INDEX
         SCS,R8   16                TO P-S ENTRY W/ADDR IN H.W. 1
         STD,R8   ADDR%IND,R5
         B        *R7
********************************************************
ST%STI1  EQU      %                 SPECIAL SET%STI ENTRY
         BCS,8    %+2               :
         LH,R11   IOQ9,R3           GET TYC FROM IOQ4
         LB,R12   IOQ4,R3           IF IN GET RBC FROM IOQ9
         AND,R12  M5
SET%STI  EQU      %                 OPERATION COMPLETE
         LI,R4    0                 :
         LC       IOQ4,R3           SET STARTING INDEX IN P-S
         BCR,8    %+2               :
         LI,R4    1                 THE APPROPRIATE CUR INDEX IS
         LB,R13   R7,R4             PICKED UP AND STORED INTO THE
         LD,R8    IOQ13,R3          CXT BUFF, AND USED TO FIND THE
         AI,R9    1                 NEXT INDEX WHICH IS MADE THE
         STB,R13  *R9               NEW START INDEX
         BAL,R0   G%PADR            :
         LB,R13   *R13,R4           THE CORRECTED P-S WORD 1
         AI,R4    2                 NOW IN R7 IS STORED BACK
         STB,R13  R7,R4             INTO THE P-S LIST AND WE'RE
         LI,R13   0                 READY TO EXIT TO THE USER
         BAL,R0   G%PADR
         STW,R7   *R13
         B        PST%XIT
**********************************************************
32%TO    EQU      %                 GO TO CORRECT TIMEOUT ROUTINE
         LC       IOQ4,R3           :
         BCS,8    TO%WT             IF OUTPUT -> TO%WRT
         LB,R5    IOQ5,R3           :
         CI,R5    32RD:DOT          IF ITS POL FOR INPUT REPEAT
         BNE      TO%RD             THE POL, OTHERWISE REPEAT THE
         LI,R5    32RD:DOT**8       READ OPERATION
         STH,R5   DCT17,R1
         B        TO%RD
NAKIN    MTB,5    R5
TO%WT    MTB,1    R5                *
NAKOUT1  MTB,1    R5                *TOP BYTE OF R5 IS TYC
NAKOUT2  MTB,3    R5                *
TO%RD    MTB,2    R5
         LB,R12   R5                TYC TO R12 AND RESTORE REGS
         LH,R5    DCT7,R1           :
         LD,R6    SVSTF,R5          IF LAST TRY GET OUT VIA
         LI,R11   0                 SET%STI, OTHERWISE SET
         MTB,-1   IOQ11,R3          THE RETRY BIT IN R12 AND
         BEZ      SET%STI           LET IOSCU DECREMENT IOQ11
         MTB,1    IOQ11,R3
         AI,R12   X'C000'
         LI,R13   0                 DONT PRINT ANY OC MESSAGES
         B        PST%XIT
********************************************************
*    PARTIAL REMAINDER TABLE FOR CRC CALCULATION
CRCTBL   EQU      %
         DATA     X'0000C0C1'
         DATA     X'C1810140'
         DATA     X'C30103C0'
         DATA     X'0280C241'
         DATA     X'C60106C0'
         DATA     X'0780C741'
         DATA     X'0500C5C1'
         DATA     X'C4810440'
         DATA     X'CC010CC0'
         DATA     X'0D80CD41'
         DATA     X'0F00CFC1'
         DATA     X'CE810E40'
         DATA     X'0A00CAC1'
         DATA     X'CB810B40'
         DATA     X'C90109C0'
         DATA     X'0880C841'
         DATA     X'D80118C0'
         DATA     X'1980D941'
         DATA     X'1B00DBC1'
         DATA     X'DA811A40'
         DATA     X'1E00DEC1'
         DATA     X'DF811F40'
         DATA     X'DD011DC0'
         DATA     X'1C80DC41'
         DATA     X'1400D4C1'
         DATA     X'D5811540'
         DATA     X'D70117C0'
         DATA     X'1680D641'
         DATA     X'D20112C0'
         DATA     X'1380D341'
         DATA     X'1100D1C1'
         DATA     X'D0811040'
         DATA     X'F00130C0'
         DATA     X'3180F141'
         DATA     X'3300F3C1'
         DATA     X'F2813240'
         DATA     X'3600F6C1'
         DATA     X'F7813740'
         DATA     X'F50135C0'
         DATA     X'3480F441'
         DATA     X'3C00FCC1'
         DATA     X'FD813D40'
         DATA     X'FF013FC0'
         DATA     X'3E80FE41'
         DATA     X'FA013AC0'
         DATA     X'3B80FB41'
         DATA     X'3900F9C1'
         DATA     X'F8813840'
         DATA     X'2800E8C1'
         DATA     X'E9812940'
         DATA     X'EB012BC0'
         DATA     X'2A80EA41'
         DATA     X'EE012EC0'
         DATA     X'2F80EF41'
         DATA     X'2D00EDC1'
         DATA     X'EC812C40'
         DATA     X'E40124C0'
         DATA     X'2580E541'
         DATA     X'2700E7C1'
         DATA     X'E6812640'
         DATA     X'2200E2C1'
         DATA     X'E3812340'
         DATA     X'E10121C0'
         DATA     X'2080E041'
         DATA     X'A00160C0'
         DATA     X'6180A141'
         DATA     X'6300A3C1'
         DATA     X'A2816240'
         DATA     X'6600A6C1'
         DATA     X'A7816740'
         DATA     X'A50165C0'
         DATA     X'6480A441'
         DATA     X'6C00ACC1'
         DATA     X'AD816D40'
         DATA     X'AF016FC0'
         DATA     X'6E80AE41'
         DATA     X'AA016AC0'
         DATA     X'6B80AB41'
         DATA     X'6900A9C1'
         DATA     X'A8816840'
         DATA     X'7800B8C1'
         DATA     X'B9817940'
         DATA     X'BB017BC0'
         DATA     X'7A80BA41'
         DATA     X'BE017EC0'
         DATA     X'7F80BF41'
         DATA     X'7D00BDC1'
         DATA     X'BC817C40'
         DATA     X'B40174C0'
         DATA     X'7580B541'
         DATA     X'7700B7C1'
         DATA     X'B6817640'
         DATA     X'7200B2C1'
         DATA     X'B3817340'
         DATA     X'B10171C0'
         DATA     X'7080B041'
         DATA     X'500090C1'
         DATA     X'91815140'
         DATA     X'930153C0'
         DATA     X'52809241'
         DATA     X'960156C0'
         DATA     X'57809741'
         DATA     X'550095C1'
         DATA     X'94815440'
         DATA     X'9C015CC0'
         DATA     X'5D809D41'
         DATA     X'5F009FC1'
         DATA     X'9E815E40'
         DATA     X'5A009AC1'
         DATA     X'9B815B40'
         DATA     X'990159C0'
         DATA     X'58809841'
         DATA     X'880148C0'
         DATA     X'49808941'
         DATA     X'4B008BC1'
         DATA     X'8A814A40'
         DATA     X'4E008EC1'
         DATA     X'8F814F40'
         DATA     X'8D014DC0'
         DATA     X'4C808C41'
         DATA     X'440084C1'
         DATA     X'85814540'
         DATA     X'870147C0'
         DATA     X'46808641'
         DATA     X'820142C0'
         DATA     X'43808341'
         DATA     X'410081C1'
         DATA     X'80814040'
****************************************************
         END

