         DEF      DSCIO:
DSCIO:   EQU      %
AOV      SET      1
  SYSTEM SIG7FDP
*
*        WANT DSCIO TO EQU 0
DSCIO    EQU      %
         B        DSCIO1
*
*   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
SR1,R8   EQU      8
SR2,R9   EQU      9
SR3,R10  EQU      10
SR4,R11  EQU      11
D1,R12   EQU      12
D2,R13   EQU      13
D3,R14   EQU      14
D4,R15   EQU      15
*
         PAGE
*                 DEFS/REFS  FOR HANDLER
         DEF      DSCIO             * HANDLER NAME
         DEF      DSCCU             *   ( AND CLEAN-UP ENTRY)
         DEF      DSC:DOT           *  DEVICE OPERATION TABLE
         DEF      TOF0:DOT          *    (FOR GHO DIRECT I/O)
         DEF      D%SSET
*
*****  REFS  *****
*
         REF      HUP               * HUNG-UP GFC
         REF      DUP               * DIAL-UP GFC
         REF      LORR              * LOG-ON REC RECVD GFC
         REF      SGCQ              * SYM GHO CALL Q
         REF      ERRLOG            * ERROR LOG SUBROUTINE
         REF      DCT16             * DEVICE NAME
         REF      DCT12             * AIO STATUS
         REF      DCT1P             * PRIMARY SIO ADDR.
         REF      TSTACK            * MONITOR TEMP STACK
         REF      COMLIST,DCT1,DCT17,DCT3,DCT7
         REF      GMB,IOQ10,IOQ11,IOQ5,IOQ8,IOQ9
         REF      M4,USECOM,XEOD,XFF,4CHAR
         REF      M19,XN2,IOSCU,IOSERCK
         REF      Y8,X1,M16,RB:FLAG,RBB:CPZ,RBB:LPZ
         REF      RBB:SPC,RBH:ACK,Y2,SNDDX,SSIG
         REF      NXT%DEV,RB%TDV,RBSGCQ1,RBSGCQP
         REF      RB%CU,REG%SET,RB%PREX,RB%LGER
         REF      X80,Y1,SYMX,Y02,RBB:SFC,FIN
         REF      Y08,DCT4,RBLIMS,SAQNSERT,Y4,X100
         REF      RBB:HFE,RBB:HOU,RBB:HIN
         REF      STB:LNK,STB:TYP,STH:FLG
         REF      IOQ13,IOQ4,DCT10
         REF      SCRSIZE
         REF      DCT13
         REF      M7
         REF      RMB               * RELEASE MONITOR BUF
         REF      DCT2              * CITX
         REF      RBB:BCB
*
*        :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
*
*******           *******           *******
*
T:SET    CNAME
*
*        T:SET ESTABLISHES VALUES FOR:
* 1. EVEN OR ODD ADDRESS BIT FOR FULL DUPLEX CONTROLLERS
* 2. HANDLER FRONT END VECTOR
* 3. HANDLER BACKEND VECTOR
* 4. RETRY FUNTION CODES WHEN :DOT TABLE ENTRY WON'T DO
*
FULL%DPX%ADDR,FRONTEND%V,BACKEND%V,SPECIAL%RETRY  SET  0
DOT%X    SET      1                 INITIAL SUBSCRIPT VALUE
EVEN     SET      0
ODD      SET      1
*
         PROC
         ERROR,15,(AF(2)-BASE:)>255  'AF(2) VALUE OUT OF RANGE'
         ERROR,15,(AF(3)-BASE:)>255  'AF(3) VALUE OUT OF RANGE'
FULL%DPX%ADDR(DOT%X)    SET  AF(1)
BACKEND%V(DOT%X)        SET  AF(3)-BASE:
FRONTEND%V(DOT%X)       SET  AF(2)-BASE:
         DO       NUM(AF)=4
SPECIAL%RETRY(DOT%X)    SET  AF(4)
         ELSE
SPECIAL%RETRY(DOT%X) SET X'FF'         IF NONE CASE
         FIN
DOT%X    SET      DOT%X+1
         PEND
*
         PAGE
*
DOT      SET      %
DSC:DOT  EQU      DOT
*
WRCP:DOT :DOT     WO%,1,WRCP:DOT,RACP:DOT      PUNCH
         T:SET    ODD,PUNCH,FOLLOWON
WRLP:DOT :DOT     WO%,1,WRLP:DOT,RALP:DOT      PRINT
         T:SET    ODD,PRINT,FOLLOWON
ACKR:DOT :DOT     SA%,1,ACKR:DOT,RDCR:DOT      SEND ACK, THEN READ
         T:SET    ODD,READ,FOLLOWON
TOF0:DOT :DOT     T0%,1,TOF0:DOT,RAT0:DOT      TOP OF FORM BP=0
         T:SET    ODD,FORMAT,FOLLOWON
TOF1:DOT :DOT     T1%,1,TOF1:DOT,RAT1:DOT      TOF   BP=1
         T:SET    ODD,PRE%EXIT,FOLLOWON
SPC0:DOT :DOT     S0%,1,SPC0:DOT,RAS0:DOT        SPACE BP=0
         T:SET    ODD,PRE%EXIT,FOLLOWON
SPC1:DOT :DOT     S1%,1,SPC1:DOT,RAS1:DOT       SPACE BP=1
         T:SET    ODD,PRE%EXIT,FOLLOWON
RDCR:DOT :DOT     MS%,2,RDCR:DOT,ACKR:DOT
         T:SET    EVEN,PRE%EXIT,INCHK,WNAK:DOT
LGN:DOT  :DOT     T0%,1,LGN:DOT,RAT0:DOT   SPECIAL LOGON FC
         T:SET    ODD,FORMAT,FOLLOWON
SRD:DOT  :DOT     MS%,1,WDC1:DOT,ACKR:DOT
         T:SET    EVEN,PRE%EXIT,INCHK,WNAK:DOT
RACP:DOT :DOT     RA%,1,RACP:DOT               READ ACK AFTER PUNCH
         T:SET    EVEN,PRE%EXIT,OUTACK,WRCP:DOT
RALP:DOT :DOT     RA%,1,RALP:DOT               READ ACK AFTER PRINT
         T:SET    EVEN,PRE%EXIT,OUTACK,WRLP:DOT
RAT0:DOT :DOT     RA%,1,RAT0:DOT,WRLP:DOT      READ ACK AFTER TOF(0)
         T:SET    EVEN,PRE%EXIT,POST%FRMT,TOF0:DOT
RAT1:DOT :DOT     RA%,1,RAT1:DOT,WRLP:DOT      READ ACK AFTER TOF(1)
         T:SET    EVEN,PRE%EXIT,POST%FRMT,TOF1:DOT
RAS0:DOT :DOT     RA%,1,RAS0:DOT,SPC1:DOT
         T:SET    EVEN,PRE%EXIT,POST%FRMT,SPC0:DOT
RAS1:DOT :DOT     RA%,1,RAS1:DOT,SPC0:DOT
         T:SET    EVEN,PRE%EXIT,POST%FRMT,SPC1:DOT
EOT1:DOT :DOT     ET%,1,EOT1:DOT,WDC1:DOT      SEND EOT, THEN DC1
         T:SET    ODD,PRE%EXIT,FOLLOWON
WDC1:DOT :DOT     DC%,1,WDC1:DOT,RDCR:DOT      SEND DC1, THEN READ
         T:SET    ODD,PRE%EXIT,FOLLOWON
WACK:DOT :DOT     SA%,1,WACK:DOT               WRITE ACK
         T:SET    ODD,PRE%EXIT,POST%EXT
WNAK:DOT :DOT     WN%,1,WNAK:DOT,RDCR:DOT      WRITE NAK, THEN READ
         T:SET    ODD,PRE%EXIT,FOLLOWON
NAK1:DOT :DOT     WN%,1,NAK1:DOT
         T:SET    ODD,PRE%EXIT,POST%EXT
WSIG:DOT :DOT     SG%,1,WSIG:DOT               SEND SIGNAL
         T:SET    ODD,PRE%EXIT,POST%SIG
BLDS:DOT :DOT     SG%,1,DISC:DOT,DISC:DOT
         T:SET    ODD,PRE%EXIT,FOLLOWON
DISC:DOT :DOT     DS%,6,DISC:DOT               DISCONNECT
         T:SET    EVEN,PRE%EXIT,HUNG%UP1
*
DOT%X    SET      DOT%X-1           :DOT TABLE SIZE
*
         PAGE
:CLST    CNAME
         PROC
LF       GEN,8    DA(AF(1))-DA(DOT)
         PEND
*
ET%      :CLST    ETCOM
RA%      :CLST    RACOM
MS%      :CLST    MSCOM
T0%      :CLST    T0COM
T1%      :CLST    T1COM
SG%      :CLST    SGCOM
SA%      :CLST    SACOM
WN%      :CLST    WNCOM
WO%      :CLST    WHCOM
         :CLST    WOCOM
DS%      :CLST    DSCOM
DC%      :CLST    DCCOM
S1%      :CLST    SP1COM
S0%      :CLST    SP0COM
*
         PAGE
:CDW     CNAME
         PROC
LF       EQU      WA(%)
         DO       AF(2)=4
         GEN,8,24 CF(2),WA(AF(1))
         ELSE
         GEN,8,24 CF(2),BA(AF(1))
         FIN
         GEN,8,8,8,8    CF(3),X'80',AF(2),AF(3)
         PEND
*
         BOUND    8
ETCOM    :CDW,WRT,FLG1       EOTM,0,6     SEND EOT COMMAND,BC=6
RACOM    :CDW,RD,FLG1        RBT%SPC,4,2  READ ACK COMMAND,BC=6
MSCOM    :CDW,RD,FLG1        RBT%SPC1,4,85  READ INPUT, BC=85
T0COM    :CDW,WRT,FLG1       TOF0M,0,11    SEND TOF,BP=0,BC=11
T1COM    :CDW,WRT,FLG1       TOF1M,0,11    SEND TOF,BP=1,BC=11
SP1COM   :CDW,WRT,FLG1    SPC1M,0,11    SPACE,BP=1,BC=11
SP0COM   :CDW,WRT,FLG1    SPC0M,0,11    SPACE,BP=0,BC=11
SGCOM    :CDW,WRT,FLG1       BELM,0,6     SEND SIG. REMOTE,BC=6
SACOM    :CDW,WRT,FLG1       ACKM,0,6     SEND ACK COMMAND,BC=6
WNCOM    :CDW,WRT,FLG1       NAKM,0,6     SEND NAK COMMAND,BC=6
WHCOM    :CDW,WRT,X'9E'     RBT%SPC3,4,10
WOCOM    :CDW,WRT,FLG1       0,2          WRITE OUTPUT COMMAND,IOQ8,IOQ9
DSCOM    :CDW,DISO,FLG1      0,0          DISCONNECT COMMAND
DCCOM    :CDW,WRT,FLG1      DC1M,0,6  DC1 COMMAND
*
*        ADD BUFFER ADDRESS TO READ (INPUT OR ACK) COMMANDS
*
RBT%SPC  EQU      %
         LI,R11   HA(RBH:ACK)       BUFFER FOR ACKS
         AW,R11   R1                INDEX
         SLS,R11  1                 BYTE ADDR
         B        RBT%SPC2          CONTINUE
RBT%SPC1 EQU      %
         LW,R11   IOQ8,R3           SYMBIONT BUFFER ADDRESS
RBT%SPC2 EQU      %
         AND,R11  M19
         OR,R8    R11               ADD TO COMMAND
         B        USECOM            BACK TO COMLIST
*
RBT%SPC3 EQU      %
         LW,11    R7                CLIST DW ADDR
         SLS,R11  3                 BYTE ADDR
         AI,R11   HEAD%DISP         BYTE DISP TO 1ST SYNC
         B        RBT%SPC2
         PAGE
WRT      EQU      1
RD       EQU      2
DIALO    EQU      5
LSPO     EQU      9
ERO      EQU      7
DRO      EQU      3
DISO     EQU      11
*
FLG1     EQU      X'1E'
FLG2     EQU      0
*
%RBC     EQU      SCRSIZE-80        ALL INPUT RECORDS ARE 80 BYTES
*
*
*        FLAG WORD BIT MASKS
*
BPBIT    EQU      Y8                BLOCK PROTECT TOGGLE
DUPBIT   EQU      X'8000'           1=FULL DUPLEX
EMBIT    EQU      2                 'NO EM' SPECIFIED
FINBIT   EQU      4                 !FIN ENCOUNTERED
FRBIT    EQU      X1                FIRST READ--MUST BE ONE
LIPBIT   EQU      8                 LOGON IN PROGRESS
MORBIT   EQU      Y2                EOT WITHOUT !FIN
SSSBIT   EQU      X'10'             SUSPEND AND SWITCH SYMBIONT
HUBIT    EQU      Y1                HUNG UP
FIABIT   EQU      X'20'             FILES ALTERED(GHOST)
PUNBIT   EQU      Y08               OK TO PUNCH
CTRBIT   EQU      X'100'            0=RBSS CAN RUN
ACTBIT   EQU      X'200'            TERMINAL ACTIVE
IGBIT    EQU      Y4                CARDS WERE IGNORED
HALBIT   EQU      X'800'            HOLDALL(GHOST)
SYSBIT   EQU      X'1000'           :SYS PRIV.(GHOST)
LOFBIT   EQU      X'2000'           LOGGED OFF
DISCBIT  EQU      X'4000'           HANG UP ON READ
RBXBIT   EQU      X'10000'          HANG UP NOW
OFFBIT   EQU      X'20000'          DONT SCHEDULE(KEYIN)
EDISBIT  EQU      X'40000'
HEAD%DISP EQU     24                BYTE DISP OF 1ST SYNC FROM CLIST
SEL%LOC  EQU      29                BYTE DISP OF SEL FROM CLIST
FRMORBT  DATA     X'20000001'
XCTRBIT  EQU      X100
NMORBT   DATA     X'DFFFFFFF'
STPBIT   EQU      X'400'  STREAM PENDING
LOCBIT   EQU      X'10'             DEVICE LOCKED
ALNBIT   EQU      X'4000'           RBALGN SENT
HUTYC    EQU      2
EOFTYC   EQU      7
         PAGE
*
:CHAR    CNAME
         PROC
         BOUND    4
LF       EQU      %
I        DO       NUM(AF)
         GEN,8    AF(I)
         FIN
         PEND
*
*
*   SPECIAL MESSAGES : COMMAND DBL WRD BUFFERS
*
EIEIO    EQU      %       WITH A SYNC-SYNC HERE, AND A . . .
*                 SYNC-SYNC THERE, HERE A SYNC, THERE A SYNC,
*                 EVERYWHERE A SYNC-SYNC . . . . . . . . .
         DEF      EIEIO
ACKM     :CHAR    SYNC,SYNC,SYNC,SYNC,ACK,ACK
NAKM     :CHAR    SYNC,SYNC,SYNC,SYNC,NAK,NAK
EOTM     :CHAR    SYNC,SYNC,SYNC,SYNC,EOT,EOT
BELM     :CHAR    SYNC,SYNC,SYNC,SYNC,BEL,BEL
DC1M     :CHAR    SYNC,SYNC,SYNC,SYNC,DC1,DC1
TOF0M    :CHAR    SYNC,SYNC,SYNC,SYNC,SOH,X'20',STX,TOF,EM,ETX,X'34'
TOF1M    :CHAR    SYNC,SYNC,SYNC,SYNC,SOH,X'B0',STX,TOF,EM,ETX,X'A4'
SPC1M    :CHAR    SYNC,SYNC,SYNC,SYNC,SOH,X'B0',STX,X'20',EM,ETX,X'08'
SPC0M    :CHAR    SYNC,SYNC,SYNC,SYNC,SOH,X'20',STX,X'20',EM,ETX,X'98'
         PAGE
*
*    SPECIAL RBT CONSTANTS
*
ACK      EQU      X'86'             ACKNOWLEDGE
EOT      EQU      X'04'             END OF TRANSMISSION
SOH      EQU      X'01'             START OF HEADER
STX      EQU      X'02'             START OF TEXT
ETX      EQU      X'83'             END OF TEXT
EM       EQU      X'19'             END OF MEDIUM
SYNC     EQU      X'16'             SYNC
NAK      EQU      X'15'             NEGATIVE ACKNOWLEDGE
DC1      EQU      X'91'             NO DATA/XMIT START
TOF      EQU      X'8C'             TOP OF FORM
BEL      EQU      X'07'             BELL
VT       EQU      X'0B'             VERTICAL TAB
SELCP    EQU      X'21'              PUNCH SELECT CHAR
SELLP    EQU      X'20'              PRINT SELECT CHAR
         BOUND    4
         PAGE
*                 TABLE FOR FULL DUPLEX FUNCTION
*                     I/O  ADDRESSING.
*                 NECCESARY BECAUSE FULL DUPLEX OPTION
*                 LIMITS I/O FUNCTIONS TO CERTAIN
*                 I/O CHANNELS.
*
FCN%TAB  EQU      %
I        DO       DOT%X
         DATA,1   FULL%DPX%ADDR(I)
         FIN
         BOUND    4
*
       PAGE
*        PRE-ENTRY VECTOR TABLE
*
PRE%VEC EQU       %
I        DO       DOT%X
         DATA,1   FRONTEND%V(I)
         FIN
         BOUND    4
*
       PAGE
*        POST   ENTRY   VECTOR     TABLE
*
POST%VEC EQU      %
I        DO       DOT%X
         DATA,1   BACKEND%V(I)
         FIN
         BOUND    4
*
         PAGE
*        RETRY FUNCTION TABLE
*        USED WHEN RETRY IS THE RESULT OF RECIEVING
*        NEGATIVE ACKNOWLEDGE OR UNEXPECTED INPUT
*
RETRY%FC EQU      %
I        DO       DOT%X
         DATA,1   SPECIAL%RETRY(I)
         FIN
         BOUND    4
*
         PAGE
*        ENTER HANDLER FRONT END
*
DSCIO1   EQU      %
         BAL,R9   REG%SET
         CI,13    RBXBIT            KEYIN KILL
         BAZ      %+3               NO
         CI,5     DISC:DOT          DONE ALREAY?
         BNE      ZAP               NO DO IT
         LB,R6    IOQ10,R3          RETRIES REQUESTED
         CB,R6    IOQ11,R3          RETRIES REMAINING
         BNE      PRE%EXIT          RETRY, SKIP THE OTHER STUFF
         LB,R6    PRE%VEC,R5        GET VECTOR
         B        BASE:,R6          CONTINUE
*
         SPACE    5
*
*        ENTER HANDLER BACK END
*
DSCCU    EQU      %
         BAL,R4   RB%CU
         B        CK%HU
         B        CK%TO
         LB,R6    POST%VEC,R5       GET VECTOR
         B        BASE:,R6          ONWARD
*
         PAGE
CK%HU    EQU      %
         CW,R13   HUBIT
         BANZ     HES%GONE
         B        HUNG%UP
CK%TO    EQU      %
         CI,R5    DISC:DOT
         BE       HUNG%UP           WE TRIED
         CI,R5    RDCR:DOT
         BE       TO%READ
         CI,R5    SRD:DOT
         BE       RD%M1
         CI,R13   SSSBIT            --------------------------------------
         BANZ     POST%EXT          HNDL%TO HANDLES TIMED OUT OPERATIONS
         B        TO%LOG            INTERNALLY SINCE THIS IS THE ONLY REAL
*                                   WAY THE RBT SHOWS ERRORS.  THE ACTION
TO%READ  EQU      %                 TAKEN DEPENDS ON THE OPERATION AND
         CI,R13   FINBIT            THE STATE OF THE RBT (RB:FLAG)
         BANZ     DO%EOT1           ---------------------------------------
         CW,R13   MORBIT
         BANZ     RD%M1
         CW,R13   FRBIT
         BANZ     SIM%FIN
         B        TO%LOG
HUNG%UP  EQU      %
         CI,R13   ACTBIT+LIPBIT
         BAZ      POST%EXT
         CW,R13   HUBIT
         BANZ     HES%GONE
         AW,R13   HUBIT
         LI,R12   HUP               *  TELL GHOST HEES GONE
         BAL,R4   RBSGCQP
         B        NO%COM%NAK-1
         PLW,R1   TSTACK            * RESTORE SAVED DCTX
*
HES%GONE EQU      %
         LI,R12   HUTYC
         B        POST%EXT1
*
CHK%ACK  EQU      %
         LH,R7    RBH:ACK,R1        GET ACK BUFFER
         AND,R7   M16
         CI,R7    X'8686'           IS IT ACK?
         BE       *11               YES  EXIT
         CI,R7    X'404'            IS IT EOT?
         BE       ACK%EOT           YES
         CI,R7    X'1515'           IS IT NAK?
         BE       NAK%LOG           YES
         CI,R7    X'9191'           IS IT DC1?
         BE       *11               YES,ACK HIM
         CI,R7    X'707'            IS IT BEL?
         BNE      %+3
         OR,R13   PUNBIT
         B        RETRY
         SLS,R7   -8
         CI,R7    SOH
         BNE      UNKN%LOG
         CI,R13   LIPBIT
         BAZ      %+3
         LI,R5    WNAK:DOT
         B        AK%LGN
         BAL,R11  ACK%EOT
ROR      LI,R5    NAK1:DOT
         B        NEW%FLO
*
DO%DC1   EQU      %
         CW,R13   FRBIT
         BAZ      DO%B1
DO%DC11  EQU      %
         CW,13    MORBIT
         BANZ     DC1%SPC
SIM%FIN  LI,R12   EOFTYC
         B        POST%EXT1
*
DO%BEL   EQU      %
         OR,R13   PUNBIT
         CW,R13   FRBIT
         BANZ     RD%M1
DO%B1    EQU      %
         LI,R5    RDCR:DOT
         B        NEW%FLO
*
DO%EOT   EQU      %
         CW,R13   FRBIT
         BANZ     DO%DC11
         CI,R13   FINBIT
         BAZ      READ%MORE
DO%EOT1  AI,R13   -FINBIT
         OR,R13   BPBIT
         B        SIM%FIN
*
READ%MORE EQU     %
         OR,R13   FRMORBT
RD%M1    LI,R5    WDC1:DOT
         B        NEW%FLO
*
DC1%SPC  EQU      %
         LI,R5    SRD:DOT
         B        NEW%FLO
*
ACK%EOT  EQU      %
         CI,R13   LOFBIT+DISCBIT
         BANZ     KILL%HIM
         CI,R13   SSSBIT+LIPBIT
         BANZ     *R11
         LW,R10   R11
         LI,R8    'S'
         LB,R6    RBB:HOU,R1
         STB,R8   SSIG,R6
         AI,R13   SSSBIT
         B        *R10
KILL%HIM LI,R5    BLDS:DOT
         B        NEW%FLO
         PAGE
*
*
*                 NAK ERRLOGING ROUTINES
*
*        ENTRY FROM INCHK;EXIT TO RETRY;R7=CHAR;R6=CNT;ANSWER
*    IN SEEK ADDRESS AND CALL ERRLOG FOR DEV ERR.
ENTER    COM,8,4,20 X'73',+1,R7    MTB,+1 R7
*
*        I = R6,R7 DATA; R3 IOQX; R1 DCTX.
*        U = R5,6,7,8,9,10,11,12,13,14
*        RESTORES = R12,13,14,15,R0,1,2 FROM STACK(ERR:1-9)
**
UNKN%LOG LH,R7    RBH:ACK,R1        12 : UNKNOWN ACK ANSWER
         AND,R7   M16                    (FROM ACK CHK)
         ENTER
*
NAK%LOG  ENTER                      11 : NAK ANSWER FROM RBT
*                                        (FROM ACK CHK)
*
TO%LOG   ENTER                      10 : TIME-OUT ERRLOG
*                                         (FROM HANDLE TIM-OUT)
         LW,R6    IOQ8,R3                RESULTING IN A 0
*
BCNAK9   ENTER                      9 : BLK CHK ERR
BCNAK8   ENTER                      8 : BLK CHK BAD PARITY
CCNAK7   ENTER                      7 : NOT ETX
CHNAK6   ENTER                      6 : BAD CHAR PARITY
CCNAK5   ENTER                      5 : NO MBUF AND LIP
CCNAK4   ENTER                      4 : NOT STX
BPNAK3   ENTER                      3 : BAD BLOCK PROTECT
CCNAK2   ENTER                      2 : SEL BAD PARITY
CCNAK1   ENTER                      1 : NOT SOH
         SW,R6    IOQ8,R3           *ADJUST CHAR POS
         SLS,R6   8                 *
         OR,R7    R6                *  ERR CDE,-,BC,CHAR 8,8,8,8
         LB,R6    IOQ5,R3           *
         SLS,R6   16                *
         OR,R7    R6                *  ERR CDE,FC,BC,CHAR 8,8,8,8
*                 --THIS FUNNY CODE WILL APPEAR IN ERRLOG SEEK ADDR-
         LW,R14   R7
         LI,R5    2
         BAL,R12  RB%LGER
*        B        RETRY             *
         PAGE
******
*
*        RETRY               IF NO SPECIAL RETRY CODE
*                            EXISTS FOR THIS FC, RETRY THE
*                            SAME FC;     ELSE
*                            SEND SIGNAL IF RETRIES
*                            EXHAUSTED;     ELSE
*                            DECREMENT NRT AND DO
*                            THE SPECIAL
RETRY    EQU      %
         LB,R5    RBB:BCB,R1
         AI,R5    1
         STB,R5   RBB:BCB,R1
         CI,R5    15                MAX ERROR COUNT
         BNE      RTRY0
         AI,R13   EDISBIT
         LI,R5    BLDS:DOT
         B        NEW%FLO
RTRY0    EQU      %
         LB,R5    IOQ5,R3
         LB,R5    RETRY%FC,R5
         CI,R5    X'FF'
         BE       RTRY2
*
         MTB,0    IOQ11,R3
         BNEZ     RTRY1
*
         STB,R5   RBB:SFC,R1        SAVE FOR AFTER SIG
         LB,R5    IOQ10,R3
         AI,R5    -1         NO MAUD:
         STB,R5   IOQ11,R3
         LI,R5    WSIG:DOT
*
RTRY1    SLS,R5   8
         STH,R5   DCT17,R1
*
RTRY2    LI,R12   X'C008'
         B        POST%EXT2
*****
         PAGE
*
*        BASE VALUE USED IN CONJUNCTION WITH VECTOR TABLES
BASE:    EQU      %
*
READ     EQU      %
         CI,R13   DISCBIT
         BAZ      %+3
ZAP      EQU      %
         LI,R5    BLDS:DOT
         B        READ1
         CW,R13   FRBIT             PERFORM ACK-READ SEQUENCE
         BAZ      PRE%EXIT             IF NOT FIRST READ.
         LI,R5    WDC1:DOT          DON'T SEND EOT
         LD,R10   0,R7              UNLESS LAST COMMAND
         AND,R11  M16               WAS READ FOR ACK
         CI,R11   2                 BECASE HALF DUPLEX LOSES
         BNE      READ1             DC1 IF SEQUENCE IS EOT-DC1-READ
         CB,R11   R10
         BNE      READ1
         LI,R5    EOT1:DOT          ***                  ***
READ1    EQU      %
         STB,R5   IOQ5,R3             FOR EOT-DC1-READ SEQUENCE.
         B        PRE%EXIT
*
OUTACK   EQU      %
         BAL,R11  CHK%ACK
         LB,R5    IOQ4,R3
         CI,R5    LGN:DOT
         BNE      POST%EXT
         LI,R5    EOT1:DOT
AK%LGN   EQU      %
         MTW,-1   IOQ8,R3
         OR,R13   FRMORBT
         B        NEW%FLO
*
POST%FRMT EQU     %
         BAL,R11  CHK%ACK
         MTB,-1   RBB:SPC,R1
         BNEZ     FOLLOWON
         LB,R5    IOQ10,R3   * RESET NRA IN CASE
         STB,R5   IOQ11,R3   *  FORMAT HAD TROUBLE.
         LI,R5    WRLP:DOT
NEW%FLO  STH,R5   DCT17,R1
         B        FOLLOWON
*
POST%SIG EQU      %
         LB,R5    RBB:SFC,R1        GET SAVED FUNCTION CODE
         B        NEW%FLO           AND START TRYING AGAIN
*
HUNG%UP1 B        HUNG%UP           BELOW BASE:
         PAGE
*
*
INCHK    EQU      %
         LW,R6    IOQ8,R3           GET BUFFER ADDRESS
         LB,R7    0,R6              GET FIRST CHAR
         CI,R7    DC1               WAS THERE ANY DATA
         BE       DO%DC1
         CI,R7    BEL
         BE       DO%BEL
         CI,R7    EOT
         BE       DO%EOT
         CI,R13   FINBIT            READ FOR EOT?
         BAZ      %+3
         OR,R13   IGBIT
         B        FOLLOWON
         AND,R13  NMORBT
*  READY TO LOOK AT THE RECORD IN THE BUFFER;
*  CHECK IT FOR FORM AND FORMAT,COMPUTE BLOCK
*  CHECKSUM,MOVE IT TO A MBUF IF LIP, TRANSLATE
*  TO EBCDIC(CHECKING PARITY), TELL THE GHOST IF
*  LIP, AND EXIT TO DO%FIN, OTHERWISE EXIT TO
*  SYMBCALL UNLESS BAD IN WHICH CASE ERRLOG AND
*  NAK VIA RETRY.  THIS IS THE FORMAT DEPENDANT
*  PROCEDURE.  USES RBTIN TO TRANSLATE,GMB FOR
*  BUF PROCURMENT,SGCQ TO TELL GHO,AND REGS
*    7,8,9,11,12,13(BP),14,0,1,4,5,6
*    I=3 IOQX,1 DCTX,13 FLAGS,6 REC AD.
*    O=13(BP) INVERTED IF OK.
*
         CI,R7    SOH               IS IT SOH
         BNE      CCNAK1   *E1*     NO, ERROR
         AI,R6    1                 YES, INC BUF
         LI,R12   STX||ETX          INITIALIZE BLOCK PARITY
         LB,R7    0,R6              GET SEL CHAR
         SCS,R7   32                SHIFT TO COUNT ONES
         BEV      CCNAK2   *E2*     PARITY ERROR
         LW,R8    R7                SET FOR POS STS
         EOR,R12  R8                CHECKSUM
         SLS,R8   27          POSITION BLOCK PROTECT BIT
         LW,R9    BPBIT             MASK
         CW,R13   FRBIT          IS THIS FIRST READ
         BAZ      IN1          NO
         MTW,-1   RB:FLAG,R1        RESET FIRST READ FLAG
         STS,R8   R13               INITIALZE BLOCK PROTECT
         AND,R13  XN2               FINISH OFF FRBIT
IN1      EQU      %
         CS,R8    R13               IS BLOCK PROTECT OK
         BNE      BPNAK3   *E3*     NO, ERROR
         AI,R6    1                 YES, INC BUF
         LB,R7    0,R6              GET NEXT CHAR
         CI,R7    STX               IS IT STX
         BNE      CCNAK4   *E4*     NO, ERROR
         AI,R6    1                 YES, INC BUF
         LI,R8    80                DATA COUNT
         LW,R5    IOQ8,R3
IN10     LB,R7    0,R6              GET NEXT CHAR
         AI,R6    1                 INC BUF
         EOR,R12  R7                CHECKSUM
         CI,R7    EM                IS IT EM
         BE       IN24              YES END OF RECORD
IN20     EQU      %
         LB,R7    RBTIN,R7          CONVERT TO EBCDIC
         BEZ      CHNAK6   *E6*     * BAD CHAR PARITY
         STB,R7   0,R5              STORE IN USER BUF
         AI,R5    1                 INC USER BUF
         BDR,R8   IN10              LOOP
IN24     LB,R7    0,R6              NEXT CHAR
         CI,R7    ETX               IS IT ETX
         BNE      CCNAK7   *E7*     NO, ERROR
         AI,R6    1                 INC BUF
         LB,R7    0,R6              NEXT CHAR
         SCS,R7   32                SHIFT TO COUNT ONES
         BEV      BCNAK8   *E8*     PARITY ERROR
         AND,R12  M7                ** 7 BITS OF SHOULD BE
         AND,R7   M7                ** 7 BITS OF IS
         CW,R7    R12               ** COMPARE BLOCK PARITY
         BNE      BCNAK9   *E9*     NO GOOD
         AI,R8    0                 WAS THERE EM?
         BEZ      IN26              NO,DONE
         LI,R7    X'40'             GET BLANK
IN25     EQU      %
         STB,R7   0,R5              BLANK PAD TO 80 CHAR
         AI,R5    1
         BDR,R8   IN25
IN26     EQU      %
*   RECORD AOK
         EOR,R13  BPBIT             AOK, INVERT BLOCK PROTECT
         CI,R13   LIPBIT            LOGON IN PROGRESS?
         BAZ      SYMBCALL
         OR,R13   XCTRBIT
         LI,R4    DO%FIN            * RETURN FROM GHO CALL
         LI,R12   LORR              * LOG-ON RECORD RECEIVED
         LW,R14   IOQ8,R3
         SLS,R14  -2
         BAL,R4   RBSGCQP
DO%FIN   EQU      %                 PRETEND FIN CARD READ
         B        NO%COM%NAK        NO COM BUFS
         PLW,R1   TSTACK            *  RESTORE SAVED DCTX
         LI,R12   0
         LD,R8    IOQ13,R3
         STD,R12  IOQ13,R3
         LCI      4
         PSM,R0   TSTACK
         BAL,R11  GMB
         LCI      4
         PLM,R0   TSTACK
         LW,R9    R14
         BEZ      SIM%FIN
         STD,R8   IOQ13,R3
         SLS,R9   2
         STW,R9   IOQ8,R3
DO%FIN%1 EQU      %
         AI,R13   FINBIT            SET FIN ENCOUNTERED
         B        FOLLOWON          READ FOR EOT
SYMBCALL BAL,R5   4CHAR
         CW,R0    FIN
         BE       DO%FIN%1
         OR,R13   XCTRBIT
         B        POST%EXT
         SW,R13   HUBIT
NO%COM%NAK EQU    %
         PLW,R1   TSTACK
         B        CCNAK5
         PAGE
*
FORMAT   EQU      %
         LW,R5    IOQ8,R3           BUFFER BYTE ADDRESS
         LB,R8    0,R5              GET FORMAT CHARACTER
         MTH,-1   IOQ9,R3           DECREMENT FOR VFC CHAR
         BNEZ     FMT1              THERE IS A MESSAGE
         MTH,1    IOQ9,R3           WOOPS VFC ONLY
         LI,R11   X'40'             MAKE VFC A BLANK
         STB,R11  0,R5
         B        %+2               AND LEAVE BUF ALONE
FMT1     EQU      %
         MTW,1    IOQ8,R3           MOVE BUF PAST VFC
         CI,R8    X'C0'             FORMATING?
         BLE      PRINT1            NO
         CI,R8    X'D0'
         BGE      TRY%TOF           MAYBE TOF
         MTB,SPC0:DOT-TOF0:DOT  IOQ5,R3   CHANCE FC TO SPACE
GET%BP   EQU      %                 ABOVE SET FC=SPACE
         AND,R8   M4                GET COUNT
         STB,R8   RBB:SPC,R1        SAVE COUNT
         CW,R13   BPBIT             BLOCK PROTECT=1?
         BAZ      %+2               NO - AOK
         MTB,1    IOQ5,R3           GET RIGHT FC
         CI,R8    1                 ODD # OF FORMATS?
         BAZ      PRE%EXIT          NO BP IS OK
         EOR,R13  BPBIT             CHANGE FOR PRINT
         B        PRE%EXIT          DO IT
TRY%TOF  EQU      %
         CI,R8    X'F1'             TOP OF FORM?
         BE       GET%BP            YES DO IT
PRINT1   MTB,WRLP:DOT-TOF0:DOT  IOQ5,R3  CHANGE FC TO PRINT
*
PRINT    EQU      %
         LI,R11   SELLP             PRINTER SELECT
         LB,R6    RBB:LPZ,R1        LINE WIDTH
         B        P1
PUNCH    EQU      %
         LI,R11   SELCP             PUNCH SELECT
         LB,R6    RBB:CPZ,R1        COLUMNS
         CI,R13   EMBIT             NO END OF MEDIUM?
         BAZ      P1
         B        P3                SKIP STRIPPING
P1       EQU      %
         CH,R6    IOQ9,R3
         BL       %+2
         LH,R6    IOQ9,R3
         STH,R6   IOQ9,R3
         AW,R6    IOQ8,R3
         AI,R6    -2                ***                  ***
         LB,R8    0,R6              *  IF CHARACTER 2ND    *
         CI,R8    ETX               * FROM END IS 'ETX',   *
         BNE      %+3               * SKIP OUTPUT TRANS-   *
         EOR,R12  BPBIT             * LATION. (EETS ALREADY*
         B        PRE%EXIT          * ASCII ENCODED)       *
         AI,R6    2                 ***                  ***
         LI,R8    X'40'
P2       EQU      %
         AI,R6    -1
         CB,R8    0,R6              ------------------------------------
         BNE      P3                AS THE TRANSLATION IS DONE THE FIRST
         MTH,-1   IOQ9,R3           THREE TRANSLATED BYTES ARE MOVED TO
         BGZ      P2                THE COMMAND LIST AREA WHICH ALREADY
         MTH,1    IOQ9,R3           HAS THE LEADING FRAMING CHARACTERS.
P3       EQU      %                 THE REST OF THE CHARACTERS ARE MOVED
         CW,R13   BPBIT             UP THREE BYTES IN THE BUFFER AS THEY
         BAZ      %+2               ARE TRANSLATED LEAVING ROOM FOR EM,
         AI,R11   X'10'             ETX, AND BLOCK CHECK.
         EOR,R13  BPBIT             -------------------------------------
         SCS,R11  32
         BOD      %+2
         AI,R11   X'80'
         SLS,R7   3
         AI,R7    SEL%LOC
         STB,R11  0,R7
         AI,R7    2
         AI,R11   STX               TRICKY EOR OF STX
         LH,R8    IOQ9,R3
         LW,R5    IOQ8,R3
         LI,R9    3
P4       EQU      %
         LB,R6    0,R5
         LB,R6    RBTOUT,R6         * TRANSLATE EBCDIC-ASCII
         EOR,R11  R6         COMPUTE CHECKSUM
         STB,R6   0,R7
         AI,R7    1
         AI,R5    1
         BDR,R9   %+3
         LI,R9    X'FFFF'
         LW,R7    IOQ8,R3
         BDR,R8   P4
         LI,R6    128
         CH,R6    IOQ9,R3
         BE       P5
         LI,R6    EM
         EOR,R11  R6
         STB,R6   0,R7
         AI,R7    1
         BDR,R9   %+3
         LI,R9    X'FFFF'
         LW,R7    IOQ8,R3
P5       EQU      %
         LI,R6    ETX
         EOR,R11  R6
         STB,R6   0,R7
         AI,R7    1
         BDR,R9   %+2
         LW,R7    IOQ8,R3
         SCS,R11  32
         BOD      %+2
         EOR,R11  X80
         STB,R11  0,R7
*
         PAGE
*********************************************************
*****    EXIT IF  ENTERED FROM PRE-HANDLER          *****
*********************************************************
PRE%EXIT EQU      %
         LH,R7    DCT7,R1           RESTORE R7 FOR COMLIST
         LW,R10   R13
         LW,R11   XN2
         STS,R10  RB:FLAG,R1
         LB,R5    IOQ5,R3
         LB,R0    FCN%TAB,R5
         LI,R10   DSC:DOT
         B        RB%PREX
         PAGE
*********************************************************
*****     EXIT IF ENTERED FROM POST-HANDLER         *****
*********************************************************
*
FOLLOWON EQU      %
         LI,R12   X'6000'           SET FOLLOW-ON, INTER-OP
         B        POST%EXT2
*
POST%EXT LI,R12   1                 NORMAL COMPLETION
POST%EXT1 EQU     %
         LI,7     0
         STB,7    RBB:BCB,1
POST%EXT2 EQU     %
         LH,R7    DCT7,R1           RESTORE CLST
         LB,R4    DCT2,R1    RESTORE CITX FOR IOS ROUTINES
         LW,R8    R13               GET FLAGS
         LW,R9    XN2               MASK TO AVOID FRBIT
         CI,R13   1
         BAZ      %+2
         AI,R9    1
         STS,R8   RB:FLAG,R1        SAVE FLAGS
         LI,R13   0                 NO MESSAGES
         LI,SR4   %RBC       SET RBC FOR ARS= S T D
         LH,R14   DCT10,R1          MAKE RE:ENT HAPPY
         B        IOSCU      EXIT CLEAN-UP COMMON
         PAGE
D%SSET   EQU      %                 CALLED BY RBSSS
         LB,R3    RBB:HIN,R7
         BNEZ     TDV%1
         CI,R13   SSSBIT
         BANZ     TDV%2
         LB,R3    RBB:HOU,R7
         BEZ      TDV%2
TDV%1    EQU      %
         LB,R6    SSIG,R3
         BNEZ     NXT%DEV
TDV%2    EQU      %
         LI,R11   CTRBIT+LIPBIT
         BAL,R5   RB%TDV
         B        TDV%FAIL
NOTNEW   EQU      %
         CI,R13   LIPBIT
         BANZ     NXT%DEV
         CI,R13   SSSBIT
         BANZ     STRT%RD           RBSS IS ENTERED FROM CLOCK4 ON THE
         LI,R6    STPBIT
         LI,R2    LOCBIT
         LB,R3    RBB:HFE,R7
NN%1     EQU      %
         LB,R3    STB:LNK,R3
         BEZ      STRT%RD
         CH,R6    STH:FLG,R3
         BAZ      NN%1
         CH,R2    STH:FLG,R3
         BANZ     NN%1
STRT%OUT EQU      %
         LB,R1    STB:TYP,R3
         CI,R1    5
         BNE      %+3
         CW,R13   PUNBIT
         BAZ      NN%1
         STB,R3   RBB:HOU,R7
         LI,R6    0
         STB,R6   RBB:HIN,R7
         B        STRT
STRT%RD  EQU      %
         LW,R1    FRBIT
         STS,R1   RB:FLAG,R7
         LB,R3    RBB:HFE,R7
         BEZ      NXT%DEV
         STB,R3   RBB:HIN,R7
STRT     EQU      %
         LI,R2    'I'
         STB,R2   SSIG,R3
         LI,R11   NXT%DEV
         B        SAQNSERT
TDV%FAIL EQU      %
         CW,R13   HUBIT      --- IF HUNG UP DON'T BOTHER
         BANZ     NXT%DEV    ---
         CI,R13   ACTBIT+LIPBIT
         BAZ      NXT%DEV
         LI,R12   HUP               * TDV SAYS CONN GONE
         LW,R11   HUBIT             *  SET RB:FLAG
         B        RBSGCQ1
*
*
*   REMOTE BATCH CONVERSION TABLES
*
  OPEN  I,J,TAB,Q,A,N,JSUB,%PEND
RBCONV   CNAME
         PROC
         DO       AOV               PRODUCTION VERSION DOES HAVE
*                                   RBCONV TABLE PROC
         BOUND    4
J,JSUB   SET      0
TAB      SET      0
         DO       254
TAB      SET      TAB,0
         FIN
I        DO       16
Q        DO       16
JSUB(I,Q) SET     0
         FIN
         FIN
LF(1)    EQU      %
         GEN,8    X'80'
I        DO       NUM(AF)
J        SET      J+1
         DO       NUM(AF(I))=1
Q        SET      AF(I)
         DO1      NUM(Q)
         GEN,8    X'80'
J        SET      J+NUM(Q)-1
         ELSE
A        SET      AF(I,1)*16+AF(I,2)
N        SET      A|X'80'
         DO       7
         DO       (A&X'40')=X'40'
N        SET      N||X'80'
         FIN
A        SET      A**1
         FIN
         GEN,8    N
JSUB((I**-4)+1,(I&15)+1) SET N
TAB(N+1) SET      J*(N~=X'80')
         FIN
         FIN
         ERROR,1,J~=255             'BAD ARG LIST.'
         BOUND    4
LF(2)    EQU      %
I        DO       254
         GEN,8    TAB(I)
         FIN
         GEN,8    0
         GEN,8    0
         ELSE                       ELSE FOR PROC LINE+1 DO
LF       EQU      %                 DEFINE SYMBOLS
         RES,1    256+256
         FIN                        FIN FOR P L+1 DO
         PEND
  CLOSE I,J,TAB,Q,A,N,JSUB,%PEND
         PAGE
*
*  DEFINE NULL ENTRIES
*
Z        EQU      (0,0)
2Z       EQU      Z,Z
3Z       EQU      2Z,Z
4Z       EQU      2Z,2Z
6Z       EQU      4Z,2Z
7Z       EQU      6Z,Z
8Z       EQU      7Z,Z
9Z       EQU      8Z,Z
10Z      EQU      9Z,Z
16Z      EQU      10Z,6Z
         PAGE
*
*   CONVERSION TABLES
*
RBTOUT,RBTIN    RBCONV ;
         4Z,(0,9),Z,(0,7),(0,8),2Z,(0,11),(0,12),(0,13),7Z,;
         (0,10),Z,(1,7),8Z,16Z,16Z,;
         (2,0),9Z,(5,11),(2,14),(3,12),(2,8),(2,11),(2,1),;
         (2,6),9Z,(5,13),(2,4),(2,10),(2,9),(3,11),(5,14),;
         (2,13),(2,15),8Z,(7,12),(2,12),(2,5),(5,15),(3,14),(3,15),;
         9Z,(6,0),(3,10),(2,3),(4,0),(2,7),(3,13),(2,2),;
         Z,(6,1),(6,2),(6,3),(6,4),(6,5),(6,6),(6,7),;
         (6,8),(6,9),7Z,(6,10),(6,11),(6,12),(6,13),(6,14),;
         (6,15),(7,0),(7,1),(7,2),7Z,(7,14),(7,3),(7,4),(7,5),(7,6),;
         (7,7),(7,8),(7,9),(7,10),7Z,(5,12),(7,11),(7,13),;
         10Z,3Z,(4,1),(4,2),(4,3),(4,4),(4,5),;
         (4,6),(4,7),(4,8),(4,9),6Z,(7,13),(4,10),(4,11),(4,12),;
         (4,13),(4,14),(4,15),(5,0),(5,1),(5,2),8Z,;
         (5,3),(5,4),(5,5),(5,6),(5,7),(5,8),(5,9),(5,10),;
         6Z,(3,0),(3,1),(3,2),(3,3),(3,4),(3,5),(3,6),(3,7),(3,8),;
         (3,9),6Z
END%OF%IT         EQU               %
         ORG,1    BA(RBTOUT)+255
         GEN,8    X'07'             LACE BELL - OUTPUT ONLY
		 ORG      END%OF%IT
*
         END
