         DEF      HASPIO:
HASPIO:  EQU      %
*********************************************************
*     THIS ASSEMBLY CONTAINS THE BASIC PARTS OF CP-V    *
*IRBT SUPPORT:  1) THE LINE HANDLER, 2) THE BLOCK PARSER*
*3) THE BLOCK BUILDER, 4) THE LINE MANAGER, AND 5) THE  *
*CLOCK DRIVEN ROUTINES.  IT MUST BE COMBINED WITH RBSSS *
*BSCIO AND HSPM IN  THE MONITOR TO PROVIDE COMPLETE IRBT*
*SUPPORT  -- SMK                                        *
*********************************************************
         SYSTEM   SIG7FDP
*
*        WANT HASPIO TO EQU 0
HASPIO   EQU      %
         B        HASPIO1
*
*   REGISTER DEFINITIONS
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5                 IN THE LINE HANDLER THE
R6       EQU      6                 STANDARD REGISTER SETUP
R7       EQU      7                 IS USED - IN ADDITION R13
SR1,R8   EQU      8                 CONTAINS RB:FLAGS
SR2,R9   EQU      9                 :
SR3,R10  EQU      10                IN THE REST (USUALLY)
SR4,R11  EQU      11                R7=DCTX,R6=CXT(RB:BUF)
D1,R12   EQU      12                R4=SYMBX,R5=IOQX,R12=CCRC
D2,R13   EQU      13
D3,R14   EQU      14
D4,R15   EQU      15
*
         PAGE
*                 DEFS/REFS  FOR HANDLER
         DEF      HASPIO            * HANDLER NAME
         DEF      HASPCU            *   ( AND CLEAN-UP ENTRY)
         DEF      HSP:DOT           *  DEVICE OPERATION TABLE
         DEF      HAR:DOT,HRS:DOT,HSE:DOT
         DEF      CRCH,MVREC,PSRCB
         DEF      H%SSET,H%AKTIM,H%CRC1,H%HU,H%LGST
*
*****  REFS  *****
*
         REF      IOQ4,IOQ8,IOQ9
         REF      RB:FLAG,XN2,TSTACK,Y02
         REF      M4,M8,RBB:BCB
         REF      LORR,SGCQ
         REF      Y01,Y1,Y004
         REF      NXT%DEV,RB%TDV,RB%CU
         REF      RB%PREX,RBLIMS
         REF      RBH:ACK
         REF      GMBSIZ
         REF      IOQ13
         REF      M19,Y4
         REF      CRCI4,CRCI0
         REF      Y008,Y04,Y08,Y2,Y8,Y002
         REF      BD%BCB,BSC%FL,UNKN%RD1,BD%CRC,LGN%ACK
         REF      UNKN%RD2,BSC%GL,OLD%BCB1,UNKN%RD3
         REF      BSC%PRE,BSC%PX,BSC%PX1,UNKN%RD4
         REF      E%DISC,BSC%RTR,ENQ%NOT,TO%NAK
         REF      ENQ%PRB,TO%OUT,HE%NAKD,BSC%LGN
         REF      RPT%ORG,TEL%RBBAT,BSC%GN,NEW%FLO
         PAGE
*********************************************************
*                                                       *
*               THE LINE HANDLER                        *
*                                                       *
*     THIS PART IS A MORE OR LESS COMMON DEVICE HANDLER *
*FOLLOWING THE SYSTEM RULES FOR HANDLERS                *
*********************************************************
*
*        :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 BACKEND VECTOR
*
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(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:
DOT%X    SET      DOT%X+1
         PEND
*
         PAGE
* THE :DOT PROC GENERATES - DUMMY CMD PTR, T.O. 5 SEC INCR,
*RETRY FC, FOLLOWON FC - 8,8,8,8 - FC IS DISP INTO DOT TABLE
*  THE T:SET PROC GENERATES - EVEN/ODD BIT TO PICK I/O ADDR
*IN FULL DUP AND THE HANDLER BACKEND VECTOR - THE VALUES
*GO INTO TABLES BELOW
*
DOT      SET      %                 FIRST 5 ARE CALLING FC'S
HSP:DOT  EQU      DOT               OTHERS AS USED
*
DISC:DOT :DOT     DS%,1,DISC:DOT,DISC:DOT  DISCONNECT
         T:SET    EVEN,,H%GONE             :
HWR:DOT  :DOT     HW%,1,HWR:DOT,HRD:DOT    WRITE DATA - READ DATA
         T:SET    ODD,,FOLLOWON            :
HAR:DOT  :DOT     HA%,1,HAR:DOT,HRD:DOT    WRITE ACK0 - READ DATA
         T:SET    ODD,,FOLLOWON            :
HWA:DOT  :DOT     HW%,1,HWA:DOT,HRD:DOT    WRT DATA (W/WAB) - RD SHORT
         T:SET    ODD,,FOLLOWON            :
HHA:DOT  :DOT     HH%,1,HHA:DOT,HRD:DOT    WRT WAB MSG - RD SHORT
         T:SET    ODD,,FOLLOWON            :
HRD:DOT  :DOT     HR%,1,HRD:DOT,HNK:DOT    READ DATA
         T:SET    EVEN,,H%INCHK            :
HNK:DOT  :DOT     HN%,1,HNK:DOT,HRD:DOT    SEND NAK
         T:SET    ODD,,FOLLOWON            :
HSE:DOT  :DOT     HSE%,1,HSE:DOT,HRS:DOT   SEND ENQ (SLV LOGON)
         T:SET    ODD,,FOLLOWON            :
HRS:DOT  :DOT     HRS%,1,HRS:DOT,HAS:DOT   RD ENQ/ACK0 (MST LOGON)
         T:SET    EVEN,,ENQ%ACK            :
HAS:DOT  :DOT     HA%,1,HAS:DOT,HRL:DOT    ACK0 TO ENQ (AUTO LOGON)
         T:SET    ODD,,FOLLOWON            :
HRL:DOT  :DOT     HRL%,1,HRL:DOT,HNS:DOT   READ LOGON REC
         T:SET    EVEN,,H%RDLR             :
HNS:DOT  :DOT     HN%,1,HNS:DOT,HRL:DOT    NAK LOGON REC
         T:SET    ODD,,FOLLOWON
*
DOT%X    SET      DOT%X-1           :DOT TABLE SIZE
*
         PAGE
:CLST    CNAME
         PROC
LF       GEN,8    DA(AF(1))-DA(DOT)
         PEND
*
HW%      :CLST    HWRCOM
HA%      :CLST    HACOM
HH%      :CLST    HHCOM
HR%      :CLST    HRDCOM            DUMMY (SHELL) CMND PTRS
HN%      :CLST    HNCOM
HSE%     :CLST    HSECOM
HRS%     :CLST    HRSCOM
HRL%     :CLST    HRLCOM
DS%      :CLST    DSCOM
*
         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
*
GMBBA    EQU      GMBSIZ+GMBSIZ+GMBSIZ+GMBSIZ
*
         BOUND    8
*
*        SHELL COMMAND DOUBLEWORDS
*
HWRCOM   :CDW,WRT,FLG1              H%SPC1,4,0
HACOM    :CDW,WRT,FLG1              BSCAKM,0,7
HHCOM    :CDW,WRT,FLG1              HWABM,0,15
HRDCOM   :CDW,RD,FLG1               H%SPC2,4,0
HNCOM    :CDW,WRT,FLG1              BSCNAKM,0,6
HSECOM   :CDW,WRT,FLG1              HENQM,0,7
HRSCOM   :CDW,RD,FLG1               BSCSPC1,4,2
HRLCOM   :CDW,RD,FLG1               H%SPC4,4,GMBBA
DSCOM    :CDW,DISO,FLG1             0,0
*
*
*   SPECIAL ROUTINES FOR COMLIST
*
*
H%SPC1   EQU      %                 SETUP WRITE COMMAND
         LI,R13   1                 :
         LH,R12   IOQ9,R3           GET BC FROM IOQ9 AND
H%SPC    EQU      %                 BUFF FROM CWB IN CXT
         OR,R9    R12               :
         LW,R5    IOQ8,R3           THEN TO COMLIST VIA BSCIO
         LW,R11   *R13,R5
         SLS,R11  2
         B        BSCSPC
H%SPC2   EQU      %                 SETUP READ COMMAND
         LI,R13   0                 :
         LI,R12   HNBSZ             GET BUFF FROM CRB IN CXT
         LB,R11   IOQ4,R3           ::
         CI,R11   HWA:DOT           CHOOSE EITHER NORMAL OR
         BL       H%SPC             SPECIAL BUFFER SIZE BY
         LI,R12   HSBSZ             WHETHER WE WROTE WAB
         B        H%SPC
H%SPC4   EQU      %                 USE REAL BUFF IN IOQ8
         LW,R11   IOQ8,R3           FOR MPOOL LOGON REC RD
         B        BSCSPC
         PAGE
WRT      EQU      1                 WRITE ORDER
RD       EQU      2                 READ ORDER
DISO     EQU      11                DISCONNECT ORDER
*
FLG1     EQU      X'1E'
FLG2     EQU      0
*
*
HNBSZ    EQU      436               NORMAL BUFFER SIZE
HSBSZ    EQU      136               SPECIAL WAB BUFFER (SPB) SIZE
*
*        FLAG WORD BIT MASKS
*
FRBIT    EQU      1
EMBIT    EQU      2
OBBIT    EQU      1
FINBIT   EQU      4
LIPBIT   EQU      8
SSSBIT   EQU      X'10'
FIABIT   EQU      X'20'
OADBIT   EQU      X'40'
XP2BIT   EQU      X'80'
CTRBIT   EQU      X'100'
ACTBIT   EQU      X'200'
CLKBIT   EQU      X'400'
HALBIT   EQU      X'800'
SYSBIT   EQU      X'1000'           BIT DEFINITIONS FOR RB:FLAG
LOFBIT   EQU      X'2000'           SEE D.B. TECH MANUAL
DISCBIT  EQU      X'4000'
DUPBIT   EQU      X'8000'
RBXBIT   EQU      X'10000'
OFFBIT   EQU      X'20000'
EDISBIT  EQU      X'40000'
*
*
2780BIT  EQU      Y002
XP1BIT   EQU      Y004
ALBIT    EQU      Y008
SLVBIT   EQU      Y01
HASPBIT  EQU      Y02
DCBIT    EQU      Y04
PUNBIT   EQU      Y08
HUBIT    EQU      Y1
MORBIT   EQU      Y2
IGBIT    EQU      Y4
BPBIT    EQU      Y8
*
NOBBIT   EQU      XN2
*
* LINE CHARACTERS FOR HASP
*
SYNC     EQU      X'32'
PAD      EQU      X'FF'
DLE      EQU      X'10'
STX      EQU      X'02'
ETB      EQU      X'26'
ACK0     EQU      X'70'
NAK      EQU      X'3D'
ENQ      EQU      X'2D'
SOH      EQU      X'01'
IBCB     EQU      X'90'             IGNORE BCB COUNT BCB
FCSX     EQU      X'FF'             FCS WITH WAB
ERCB     EQU      X'00'             END-OF-REC RCB
         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 . . . . . . . . .
*
*                                   MESSAGE WITH WAB SET
*                                   BUT NO DATA
*
HWABM    :CHAR    SYNC,SYNC,SYNC,SYNC,DLE,STX,IBCB,;
                  FCSX,FCSX,ERCB,DLE,ETB,X'41',X'E3',PAD
HENQM    :CHAR    SYNC,SYNC,SYNC,SYNC,SOH,ENQ,PAD
         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
*        POST   ENTRY   VECTOR     TABLE
*
POST%VEC EQU      %
I        DO       DOT%X
         DATA,1   BACKEND%V(I)
         FIN
         BOUND    4
*
         PAGE
*        ENTER HANDLER FRONT END
*
HASPIO1  EQU      %                 DO STANDARD STUFF
         BAL,R11  BSC%PRE           :
         LB,R0    FCN%TAB,R5        SET UP REGS AND OFF
         LI,R10   HSP:DOT           TO COMLIST VIA BSCIO
         B        RB%PREX
         SPACE    5
BASE:    EQU      %                 BASE FOR BACKEND BYTE VECTORS
*
*        ENTER HANDLER BACK END
*
HASPCU   EQU      %                 RB%CU SAYS:
         BAL,R4   RB%CU             H.U. GO TO HANG UP ROUTINE
H%GONE   B        BSC%GN            T.O. GO TO TIMEOUT ROUTINE
         B        CK%TO             AOK TAKE VECTOR FOR CUR FC
         LB,R6    POST%VEC,R5       GET VECTOR
         B        BASE:,R6          ONWARD
*
         PAGE
CK%TO    EQU      %                 TIMEOUT ROUTINE
         CI,R5    DISC:DOT          :
         BE       BSC%GN            IF IT WAS DISC WE'RE DONE
         CI,R5    HRS:DOT           :
         BE       ENQ%NOT           OTHERWISE SELECT ERROR TO LOG
         CI,R5    HRD:DOT           AND FOLLOWING ACTION BASED ON
         BE       TO%NAK            CURRENT FC IN R5 FROM RB%CU
         CI,R5    HRL:DOT
         BE       TO%NAK
         B        TO%OUT
         PAGE
*
*                                   TRNSP DLE CHECKER FOR CRCI
H%CRC1   EQU      %                 :
         CI,R5    DLE               IF NOT DLE CONTINUE
         BNE      CRCI2             :
         CI,R11   -2                IF IN CRC NOW CONTINUE
         BGE      CRCI2             :
         LB,R10   0,R6              IF DLE ETB DONT CRC DLE AND
         AI,R11   1                 CONTINUE
         CI,R10   ETB               :
         BE       CRCI1             IF DLE DLE CRC AND STORE ONLY 1
         AI,R6    1                 :
         CI,R10   DLE               IF DLE SYNC SKIP BOTH
         BE       CRCI2             :
         CI,R10   SYNC              IF UNKNOWN ERROR
         BE       CRCI4
         B        *R9
H%CRCIN  EQU      %                 TRSP-NTRSP CRC SETUP
         AI,R12   0                 :
         BEZ      H%CRCI            R12=0 MEANS TRSP - CALL CRCI
         BAL,R0   CRCI0             W/H%CRC1 AS CHECKER
         CI,R5    SYNC              :
         BNE      CRCI2             IF NTRSP THIS IS CHECKER
         CI,R11   -2                :
         BGE      CRCI2             IGNORE SYNC IF NOT IN CRC
         B        CRCI4
         PAGE
*
FOLLOWON B        BSC%FL            NEEDED SO VECTORS WORK
*
H%RDLR   EQU      %                 READ LOGON REC
         LW,R6    IOQ8,R3           :
         LI,R12   H%IN2             ONLY DIF FROM RD IS BUFF
         B        BSC%GL
H%INCHK  EQU      %                 READ DATA
         LW,R6    IOQ8,R3           :
         LW,R6    0,R6              GET NEG BC AND 1ST CHAR
         SLS,R6   2                 FROM BSCIO
         BAL,R12  BSC%GL            :
H%IN2    EQU      %                 IF NAK LOG AND RETRY
         CI,R5    NAK               :
         BE       HE%NAKD           IF DLE STX ITS TRSP REC
         LI,R12   0                 SET R12=0
         CI,R5    DLE               :
         BE       H%IN5             IF SOH STX ITS NTRSP REC
         CI,R5    SOH               SET R12=CRC OF STX
         BNE      UNKN%RD1          :
         LI,R12   X'C181'           IF ACK AND NOT LOGON GIVE
H%IN5    EQU      %                 ACK TYC
         AI,R6    1                 :
         LB,R5    0,R6              IF ACK AND LOGON LOG ERROR
         CI,R5    ACK0
         BNE      H%IN3
         AND,R13  NOBBIT
         CI,R13   LIPBIT
         BANZ     LGN%ACK
         LI,R12   ACKTYC
         B        BSC%PX1
H%IN3    EQU      %                 DATA HAS BEEN READ
         CI,R11   -10               :
         BG       UNKN%RD2          IF ITS TOO SHORT TO BE
         CI,R5    STX               A BLOCK OR HAS NO STX
         BNE      UNKN%RD3          LOG ANDD NAK
         AI,R6    1                 :
         LW,R7    R6                CHECK FOR CORRECT BCB
         LB,R8    RBB:BCB,R1        IGNORE IT IF IT SAYS SO
         LB,R5    0,R6              AND RESET IT IF IT SAYS TO
         AND,R5   M4                 IF ITS OK CONTINUE
         LC       0,R6               IF NOT SEE WHATS WRONG IN
         BCS,1    H%IN4             OLD%BCB
         BCR,2    %+3               :
         LW,R8    R5                IF THE TRAILER ISN'T ETB
         B        H%IN4             LOG THE ERROR
         CB,R5    RBB:BCB,R1        :
         BNE      OLD%BCB           CHECK THE CRC AND IF IN
         AI,R8    1                 ERROR LOG AND NAK - WE DO
         AND,R8   M4                THIS LAST BECAUSE WE WANT
H%IN4    EQU      %                 TO AVOID THE CONSIDERABLE
         SW,R6    R11               TIME IT TAKES IF WE CAN.
         AI,R6    -5                WE NAK IF ANYTHING ELSE IS
         LB,R5    0,R6              WHONG IN CASE IT WAS CAUSED
         CI,R5    ETB               BY LINE HITS
         BNE      UNKN%RD4          :
         AI,R11   2                 IF ALL IS AOK AND WE WERE
         LW,R6    R7                NOT LOGGING ON, EXIT WITH
         BAL,R9   H%CRCIN           NORMAL TYC
         B        BD%CRC            :
         CI,R13   LIPBIT            IF LOGON PASS THE RECORD TO RBBAT
         BAZ      SET%BCB
         BAL,R5   BSC%LGN
SET%BCB  EQU      %
         AND,R13  NOBBIT
         STB,R8   RBB:BCB,R1
POST%EXT B        BSC%PX
OLD%BCB  EQU      %                 BCB WAS FUNNY
         LI,R0    E%DISC            :
         XW,R8    R5                IF IT TURNS OUT TO BE
         AI,R5    X'100'            IRRECOVERABLE NAK BECAUSE
         SW,R5    R8                IT MIGHT BE A LINE HIT
         AND,R5   M4                (NO CRC YET)
         CI,R5    2                 :
         BG       BD%BCB            IF THE BCB IS LOW BY 2 OR
         LI,R0    OLD%BCB2          1 DISCARD THE DATA AND GO
         CI,R13   OBBIT             INTO RECOVERY SEQUENCE
         BANZ     OLD%BCB1          :
         AI,R13   OBBIT             IF OFF BY MORE THAN 2 OR
         LI,R0    RPT%ORG           HIGH NO HOPE EXCEPT LINE HIT
         B        OLD%BCB1
OLD%BCB2 EQU      %
         LI,R5    HHA:DOT
         B        NEW%FLO
ENQ%ACK  EQU      %                 BACKEND FOR LOGON FC'S
         LH,R5    RBH:ACK,R1        :
         CW,R13   SLVBIT            IF MASTER AND WE READ ENQ
         BAZ      CKENQ             CAHNGE CALLING FC TO READ
         CI,R5    ACK0+DLE**8       LOGON OR ACK-READ AND CONTINUE
         BNE      ENQ%PRB           :
         LI,R5    HWR:DOT           IF SLV AND ACK0 CHANGE FC TO
E%A1     EQU      %                 WRITE THE LOGON REC AND CONT.
         STB,R5   IOQ4,R3           :
         B        NEW%FLO           IF NOT WHAT WE WANTED LOG
CKENQ    EQU      %                 AND RETRY
         CI,R5    ENQ+SOH**8
         BNE      ENQ%PRB
H%LGST   EQU      %                 ENTRY POINT FOR 2780IO
         LI,R5    HAS:DOT
         CI,R13   LIPBIT
         BANZ     E%A1
         LI,R5    HAR:DOT
         B        E%A1
         PAGE
*************************************************************
******************************************************
*                                                    *
*DATA AND DEFINITIONS FOR THE REST OF HASPIO         *
*                                                    *
******************************************************
         DEF      BACKUP,H%BCLS,H%BLD3,H%BLD,H%PRS2
         DEF      H%PEOF,H%PRS1
         DEF      H%CTL3,H%CTL4,H%CTL
         DEF      H%BCK
         REF      BSC%BC,BSC%BO,BSC%PO,4SYNC,BSC%GO
         REF      BLANK,M5,M16
         REF      RB:BUF,RBB:HIN
         REF      STH:FLG,STB:LNK,STB:Q,STB:TYP,STH:SUS
         REF      M6,M7,M3
         REF      RBB:HFE,RBB:HOU
         REF      SAQNSERT,SSIG,SSTAT
         REF      Y07,XDFFF,X400
         REF      GMB,RMB,OCMGFC
         REF      BSC%BCX,BSC%BL0,BSC%BLD,CRCI1
         REF      CRCI2,CRCO,CRCX,CRC1,CRC4,ENDAC
         REF      ENDAC1,ENDAC2,BSC%EOB,H%CRCI,BSC%PRS
         REF      BSC%PEA,BSC%PE1,BSC%HO
         REF      BSCAKM,BSCDIO,BSCNAKM,BSCSPC,BSCSPC1
         REF      FORCWR,BSC%FB,BSC%GB
         REF      BSC%DSC
********************************************************
NBUBTS   DATA     X'FFFFCEFF'       TURN OFF EOF,BUT,BU
*
*BITS FOR TOP OF BUF ON PSEUDO END ACTION
*
BUTFLG   EQU      Y01               BACKUP TOGGLE
BINFLG   EQU      Y02               BINARY REC READ
*
*TYC'S FOR SYMBIONT ON PSEUDO END ACTION
*
NORTYC   EQU      Y01               NORMAL
EOFTYC   EQU      Y07               END-OF-FILE
HUTYC1   EQU      Y02               HUNG UP
BUTYC    EQU      Y1                BACK UP (PAGE ABORT)
*
*TYC'S FROM HANDLER PART
*
ACKTYC   EQU      0                 ACK0 READ
RDTYC    EQU      1                 DATA READ
HUTYC    EQU      2                 HUNG UP
*
*FUNCTION CODES TO CALL HANDLER
*
WRFCN    EQU      1                 WRITE DATA - READ DATA
ARFCN    EQU      2                 SEND ACK0 - READ DATA
WAFCN    EQU      3                 WRT DATA W/WAB - RD SPECIAL
HAFCN    EQU      4                 WRT WAB MSG - RD SPECIAL
*
*STH:FLG SYMBIONT STREAM FLAGS
*
BUBIT    EQU      X'100'            WAITING TO BACKUP
BKSBIT   EQU      X'200'            TURNED OFF BY FCS
STPBIT   EQU      X'400'            DATA PENDING TO OUTPUT
*STP FOR INPUT SAYS TO GRANT FUNCTION PERMISSION
WFQBIT   EQU      X'800'            WAITING FOR WRITE TO START
*WFQ ALSO USED TO SAY FUNC PERM REQUESTED
BUTBIT   EQU      X'1000'           SAVE BU TOGGLE
EOFBIT   EQU      X'2000'           EOF REC RCVD FROM SYMB
ALNBIT   EQU      X'4000'           START W/ALIGN (RBBAT)
INBIT    EQU      1                 INPUT SYMB
OCBIT    EQU      2                 OPERATOR'S CONSOLE
SRCB1BT  EQU      4                 SRCB=P
SRCB2BT  EQU      8                 SRCB=C
LOCBIT   EQU      X'10'             STREAM LOCKED
FLKBIT   EQU      X'20'             LOCKED FOR FORMS (RBBAT)
FMSBIT   EQU      X'40'             FORMS MESSAGE SENT (RBBAT)
NLGBITS  EQU      M8                KEEPS NON-I/O BITS
XSTPBIT  EQU      X400              STPBIT FOR ORING
NEOFBT   EQU      XDFFF             TURNS OFF EOFBIT
*
*SPECIAL DATA CODES IN BLOCKS
*
GFPRCB   EQU      X'A0'             GIVE FUNC PERM RCB
RFPRCB   EQU      X'90'             REQ FUNC PERM RCB
BINSRCB  EQU      X'10'             BIN BIT IN CSRCB
EORSCB   EQU      0                 END-OF-REC SCB
EODRCB   EQU      0                 END-OF-BLOCK RCB
EOFSRCB  EQU      X'80'             SRCB USED IN EOF REC
FCS1     EQU      X'BF'             NORMAL 1ST BYTE OF FCS (OUT)
FCS2     EQU      X'FF'             NORMAL 2ND BYTE OF FCS (OUT)
EOC      EQU      X'08'             RBBAT END-OF-COMMAND
%RBC     EQU      389               INITIAL REMAINING BC FOR BLOCK
WAB      EQU      X'40'             WAIT-A-BIT (WAB) IN 1ST FCS BYTE
*
**************  CONTEXT POINTERS *******************
*
FNSV     EQU      0                 PREV INSYMX FOR FIN READ
HPB      EQU      1                 HEAD PARSE BUFFS
HBB      EQU      2                 HEAD BUILD BUFFS
HRB      EQU      3                 HEAD READ BUFFS
HWB      EQU      4                 HEAD WRITE BUFFS
CPB      EQU      5                 CURRENT BSC%PRS BUFF
CBB      EQU      6                 CURRENT BSC%BLD BUFF
CRB      EQU      7                 CURRENT READ BUFF
CWB      EQU      8                 CURRENT WRITE BUFF
POP      EQU      9                 POINTER OF BSC%PRS
POB      EQU      10                POINTER OF BSC%BLD
PIP      EQU      11                BSC%PRS IN PROGRESS
CBCB     EQU      12                CUR. OUTPUT BCB
OCRCB    EQU      13                INPUT RCB FOR OC
RBC      EQU      14                REMAINING BYTE COUNT (OUT)
CCRC     EQU      15                CUR. CRC (OUT)
CURX     EQU      16                CUR. USER (OUT)
BIP      EQU      17                BSC%BLD IN PROGRESS
FBF      EQU      18                FORCE BUFFER FULL
CIP      EQU      19                CONTROL IN PROGRESS
FCSI     EQU      20                COMB. INPUT FCS
CFC      EQU      21                CUR. FUNCTION CODE
BUT      EQU      22                BACKUP TOGGLE
BIN      EQU      23                BINARY REC RCVD.
CURF     EQU      24                LAST FAILING USER (OUT)
LTYC     EQU      25                LINE TYC
RST      EQU      26                SUSPENDED USERS TO RESTART
SAB      EQU      27                SUSCK ABORTS BSC%BLD
PSP      EQU      28                FUNC PERM POINTER
EOF      EQU      29                EOF(S) IN THIS BLOCK (OUT)
CONT     EQU      30                CONTINUATION BUFF ADDR
CONTCK   EQU      31                CONT SYMB INDEX
CONTCNT  EQU      32                CONT BYTE COUNT
SCRC     EQU      33                FUNC PERM CRC
HIP      EQU      34                HANG UP IN PROGRESS
BKD      EQU      35                SYMBIONT ACTUALLY BACKED UP
TTYP     EQU      36                0=IRBT, 1=2780
SPB      EQU      38                SPECIAL BUFFER WHEN WAB SENT
*
*VECTOR FOR CONTROL RCB'S IN SPECREC
*
VEC      COM,8    AF(1)-SPECBSE
SPECVEC  EQU      %
         VEC      DUMPREC
         VEC      RRFT              REQ FUNC PERM (X'90'
         VEC      RGFP              GRANT FUNC PERM (X'A0')
         VEC      DUMPREC
         VEC      DUMPREC
         VEC      DUMPREC
         VEC      BCBEOFF           BAD BCB RCVD (X'E0')
         VEC      LGCK              SIGNON CARD (X'F0')
************************************************
         PAGE
******************************************************
*                                                    *
*               THE BLOCK PARSER                     *
*                                                    *
******************************************************
*
*                                   START OF PARSE ENTRY
*                                   :
H%PRS1   AI,R2    5                 SKIP DLE STX BCB FCS FCS
         MTW,5    POP,R6
H%PRS2   EQU      %                 MIDDLE OF PARSE ENTRY
         LB,R3    0,R2              :
         BEZ      BSC%EOB           GET RCB
         CW,R3    OCRCB,R6          :
         BE       OCIN              IF ZERO END OF BLOCK
         LI,R0    H%PRS2            :
         CI,R3    X'F'              IF OCRCB ITS OC MSG FOR RBBAT
         BAZ      SPECREC           :
         LI,R1    BA(RBB:HIN)       (R0 IS WHERE TO GO WHEN DONE)
         BAL,R5   FND               :
         B        DUMPREC           IF CONTROL REC GO TO SPECREC
         CB,R3    STB:TYP,R4        :
         BNE      FND1              IF DEVICE RCB BUT NOT ON INPUT
         WD,0     X'37'             CHAIN DISCARD REC
         LB,R5    STB:Q,R4          :
         BEZ      BSC%PO            DEVICE IS ON INPUT CHAIN
         WD,0     X'27'             :
         STW,R1   FNSV,R6           IF NO READ READY EXIT
         LI,R0    BSC%PEA           :
         LH,R10   STH:FLG,R4        IF THIS IS A CONTINUATION,
         LI,R3    0                 APPEND IT TO THE LAST REC
         XW,R3    CONT,R6           :
         BEZ      PRS2              IF IT IS AN EOF GO TO
         LW,R9    CONTCNT,R6        THE EOF PROCESSOR
         INT,R5   CONTCK,R6         :
         CW,R4    R5                IF ITS A DATA RECORD PROCESS
         BE       PRS3              THE SRCB AND MOVE IT TO THE
         AI,R2    -1                CALLERS BUFFER DECOMPRESSING
         LW,R4    CONTCK,R6         IT AS WE GO
         BLZ      OCIN3
         LB,R5    STB:Q,R4
         B        BSC%PEA
PRS3     EQU      %
         AI,R2   2
         B        MVREC
PRS2     EQU      %
         STW,R4   CONTCK,R6
         LW,R3    IOQ8,R5
         LH,R9    IOQ9,R5
         AI,R2    1
         LB,R15   0,R2
         AI,R2    1
         LB,R14   0,R2
         BEZ      PRSEOF
         CI,R10   SRCB2BT
         BANZ     CSRCB
         AI,R9    -1
         CI,R10   SRCB1BT
         BANZ     PSRCB
         STB,R15  0,R3
MVREC1   AI,R3    1
MVREC    EQU      %                 DECOMPRESS AND MOVE REC TO CALLER
         LB,R13   0,R2              :
         BEZ      *R0               IF ITS CONTINUED SET UP THE
         CI,R13   X'80'             CONTEXT AND END THE BUFFER
         BNE      MVREC2            :
         STW,R3   CONT,R6           IF THE SIZE EXCEEDS THE CALLERS
         STW,R9   CONTCNT,R6        BUFFER, DISCARD THE REST FROM
         B        BSC%EOB           A CONVENIENT POINT (AN SCB)
MVREC2   EQU      %                 :
         AI,R2    1                 WHEN DONE EXIT ON R0
         CI,R13   X'40'             :
         BAZ      MVDUP             FOR A DESCRIPTION OF THE
         AND,R13  M6                COMPRESSION SCHEME SEE THE
         SW,R9    R13               REMOTE PROCESSING REF MANUAL
         BLZ      DR4
         STB,R13  R3
         MBS,R2   0
         B        MVREC
MVDUP    EQU      %
         LW,R1    R3
         LW,R11   R13
         AND,R13  M5
         SW,R9    R13
         BLZ      DR4
         STB,R13  R1
         CI,R11   X'20'
         BANZ     MVNB
         MBS,0    BA(BLANK)
MVD1     EQU      %
         LW,R3    R1
         B        MVREC
MVNB     EQU      %
         LB,R13   0,R2
         AI,R2    1
         MBS,0    3+R13**2
         B        MVD1
*******************************************************
FND      EQU      %                 SEARCH SYMB CHAIN
         AI,R1    -BA(STB:LNK)      :
         AND,R7   M8                LI,1 BA(CHAIN HEAD TO SEARCH)
         AW,R1    R7                BAL,5 FIND
         B        FND2              B ALL DONE
FND1     EQU      %                 ***R4=NEXT SYMB,R1=PREV
         LW,R1    R4                IS THIS THE ONE?
FND2     LB,R4    STB:LNK,R1        NO -> FIND1
         BNEZ     1,R5
         B        0,R5
RELNK    EQU      %                 MOVE SYMB TO NEW CHAIN
         WD,0     X'37'             :
         LB,R14   STB:LNK,R4        IN:  R4=SYMBX, R1=PREV
         STB,R14  STB:LNK,R1        R15=NEW HEAD
         LB,R14   *R15,R7
         STB,R14  STB:LNK,R4
         STB,R4   *R15,R7
         WD,0     X'27'
         B        *R11
***************************************************
H%PEOF   LW,R1    FNSV,R6           FROM BSCIO R1 ZAPPED
*
PRSEOF   EQU      %                 EOF RECIEVED FROM LNE
         LH,R10   STH:FLG,R4        :
         AND,R10  NLGBITS           CLEAR I/O BTS IN STH:FLG
         STH,R10  STH:FLG,R4        :
         LI,R15   RBB:HFE           LINK SYMB BACK TO FREE CHAIN
         BAL,R11  RELNK             :
         LH,R12   IOQ9,R5           GIVE PSEUDO E.A. W/EOF TYC
         OR,R12   EOFTYC            :
         STW,R2   POP,R6            CLEAR SRCB=P STUFF
         LI,R8    0                 :
         STH,R8   STH:SUS,R4        AND BACK TO THE NEXT REC
         LI,R8    BSC%PE1
         B        ENDAC1
***************************************************
SPECREC  EQU      %                 PROCESS CONTROL RCB
         AI,R2    1                 :
         LB,R14   0,R2              GO TO SUBTASK BASED ON RCB
         AND,R3   M7
         SLS,R3   -4
         LB,R3    SPECVEC,R3
SPECBSE  B        SPECBSE,R3
RRFT     EQU      %                 HE REQS FUNC PERM
         BAL,R11  GETSYM            :
         BAZ      FND1              TRY TO FIND A LEGAL SYMB
         LB,R3    SSIG,R4           WITH RCB OF REC'S SRCB
         BNEZ     BSC%PO            :
         OR,R10   XSTPBIT           IF ONE IS FOUND AND IS BUSY
RFT2     EQU      %                 EXIT TILL HE'S DONE
         STH,R10  STH:FLG,R4        :
         LW,R3    R4                IF HE'S INACTIVE SET STPBIT
         LI,R14   'I'               SO FUNC PERM WILL BE
         LW,R1    HUBIT             GRANTED AND START HIM UP
         WD,0     X'37'             (IF THE LINE IS STILL THERE)
         CW,R1    RB:FLAG,R7        :
         BANZ     BSC%PO            THEN DISCARD THE RECORD
         STB,R14  SSIG,R3
         PSW,R2   TSTACK
         BAL,R11  SAQNSERT
         PLW,R2   TSTACK
         B        DR4
RGFP     EQU      %                 HE GRANTS FUNC PERM
         BAL,R11  GETSYM            :
         BANZ     FND1              TRY TO FIND A LEGAL SYMB
         CI,R10   WFQBIT            WITH RIGHT RCB
         BAZ      DR4               :
         LI,R11   RFT2              IF WE GOT ONE BUT HE ISNT
         LI,R15   RBB:HOU           WAITING FOR FUNC PERM,
         LH,R14   STH:SUS,R4        FORGET IT
         BEZ      RELNK             :
         CW,R14   FCSI,R6           IF HE'S OK CHAIN HIM TO THE
         BANZ     RELNK             OUTPUT CHAIN AND START HIM.
         AI,R10   BKSBIT            IF FCS SAYS NO SET BKSBIT
         B        RELNK
LGCK     EQU      %                 LOGON REC IF SRCB='A'
         CI,R14   'A'               :
         BNE      DR4               THROW THE BLOCK AWAY - AUTO LOG
         B        BSC%EOB
BCBEOFF  EQU      %                 HE DIDN'T LIKE OUR BCB EH?
         LI,R1    RBXBIT+EDISBIT    :
         STS,R1   RB:FLAG,R7        THIS'LL TEACH HIM
         B        DR4
**************************************************
GETSYM   EQU      %                 GET LEGAL SYMB FOR SPECREC
         LI,R1    BA(RBB:HFE)       :
         BAL,R5   FND               SEARCH FREE CHAIN - IF
         B        DR4               NONE FOUND DISCARD REC
         CB,R14   STB:TYP,R4        :
         BNE      FND1              LEGAL MEANS TYP OK
         LH,R10   STH:FLG,R4        CALLER CHECKS CC'S FOR IN-OUT
         CI,R10   INBIT
         B        *R11
DR4      EQU      %
         AI,R2    -3
DUMPREC  EQU      %                 DISCARD REC OR REST OF REC
         AI,R2    2                 :
DR1      LC       0,R2              DECOMPRESS JUST ENOUGH TO
         BCS,8    %+3               FIND THE END - WHEN DONE
         AI,R2    1                 EXIT *R0
         B        *R0               :
         BCS,4    DR3               VARIOUS ENTRY POINTS TO
         BCR,2    DR2               POINT R2 AT AN SCB
         AI,R2    1
DR2      AI,R2    1
         B        DR1
DR3      LB,R13   0,R2
         AI,R13   -X'C0'
         AW,R2    R13
         B        DR2
***********************************************
         PAGE
***************************************************
*                                                 *
*          THE BLOCK BUILDER                      *
*                                                 *
*    WE PUT AS CLOSE TO 400 BYTES IN EACH BLOCK AS*
*WE CAN AND TRY TO PERFECTLY MULTI-LEAVE          *
***************************************************
H%BLD    EQU      %                 BEGINING OF BUILDD ENTRY
         LI,R1    STX+DLE**8        :
         STH,R1   *R2               PUT DLE STX INTO BLOCK
         AI,R3    2                 :
         LW,R2    CBCB,R6           CRC IN BCB FCS FCS
         AND,R2   M4                :
         AI,R2    X'80'             SETUP INITIAL POB
         BAL,R11  CRC1
         LI,R2    FCS1
         BAL,R11  CRC1
         LI,R2    FCS2
         BAL,R11  CRC1
         STW,R3   POB,R6
         LI,R1    BA(RBB:HFE)       LOOK FOR FUNC PERMS
         BAL,R5   FND               :
         B        H%BLD3            IF NONE GO TO CONTINUE BUILD
         LH,R10   STH:FLG,R4        :
         CI,R10   STPBIT            TO BE LEGAL A SYMB HAS TO BE
         BAZ      FND1              ON THE FREE CHAIN - HAVE STPBIT
         CI,R10   WFQBIT+LOCBIT+FMSBIT+EOFBIT
         BANZ     FND1              SET AND NOT BE LOCKED OUT
         MTW,3    RBC,R6            BY ANOTHER BIT
         CI,R10   INBIT             :
         BANZ     BLD2              IF WE FIND SOMEONE PUT 3
         AI,R10   WFQBIT            CHAR MSG IN BLOCK
         LI,R2    RFPRCB            :
BLD1     EQU      %                 FOR OUTPUT WE SET WFQBIT
         STH,R10  STH:FLG,R4        TO ACCEPT FUNC PERM AND
         BAL,R11  CRC1              USE REQ FUNC PERM RCB
         LB,R2    STB:TYP,R4        :
         BAL,R11  CRC1              FOR INPUT WE CHECK TO SEE
         LI,R2    EORSCB            IF THE SYMB HAS A READ READY
         BAL,R11  CRC1              YET AND I NOT SKIP HIM.
         STW,R3   POB,R6            OTHERWISE WE RESET STP,PUT
         STW,R3   PSP,R6            HIM ON THE INPUT CHAIN,AND
         STW,R12  SCRC,R6           USE GIVE FUNC PERM RCB
         LW,R2    XP1BIT            :
         CW,R2    RB:FLAG,R7        WE CRC THE MSG INTO THE
         BAZ      BSC%BC            BLOCK AND RECORD PSP AND SCRC
         B        FND1              :
BLD2     EQU      %                 IF THIS GUY ISN'T XP1 WE CAN'T
         LB,R11   STB:Q,R4          PUT ANYTHING ELSE IN THE BLK
         BEZ      FND1              :
         LI,R15   RBB:HIN           IF HE IS MORE FUNC PERMS AND
         BAL,R11  RELNK             DATA ARE OK
         AI,R10   -STPBIT
         LI,R2    GFPRCB
         B        BLD1
H%BLD3   EQU      %                 CONTINUE BUILD ENTRY
         LW,R4    CURX,R6           :
         BNEZ     BLD5              OUTPUT SYMBS ARE TREATED AS
BLD4     EQU      %                 A CIRCULAR CHAIN WITH THE
         LB,R4    RBB:HOU,R7        HEAD IN CURX
         STW,R4   CURX,R6           :
         BEZ      BLDOUT            SAB TELLS IF SOMEONE IS WAITING
BLD5     EQU      %                 ON US
         WD,0     X'37'             :
         LW,R5    SAB,R6            TO BE USED AN OUTSYM MUST
         BNEZ     BLDOUT            NOT HAVE EOF OR BKS AND MUST
         LH,R10   STH:FLG,R4        HAVE A WRRITE PENDING
         CI,R10   EOFBIT+BKSBIT     :
         BANZ     BLDCK1            IF HE PASSES THESE TESTS WE
         LB,R5    STB:Q,R4          TRY TO PUT HIS REC IN
         BEZ      BLDCK             :
         WD,0     X'27'             IF THE B.C.IS ZERO ITS AN EOF
         LH,R9    IOQ9,R5           :
         BEZ      OUTEOF            DECREMENT THE REMAINING SPACE
         AWM,R9   RBC,R6            :
         BGEZ     BLDCK2            IF NO ROOM SEE IF WE CAN FIND
         MTW,1    RBC,R6            SOMEONE ELSE
         LB,R2    STB:TYP,R4        :
         LW,R8    CCRC,R6           IF HE'S OK CRC IN HIS RCB
         BAL,R11  CRC1              FROM STB:TYP, THEN HIS DATA
         STW,R8   CCRC,R6           :
         LW,R2    IOQ8,R5           NOTE THAT CRCO MAY ABORT HIM
         BAL,R11  CRCO              TO H%BCK IF DLE'S MAKE HIM
         STW,R12  CCRC,R6           TOO LONG
         LB,R5    STB:Q,R4          :
         STW,R3   POB,R6            WHEN REC IS MOVED CLEAR CURF
         LI,R12   0                 TO SAY WE PUT A REC IN AND
         STW,R12  CURF,R6           GIVE THE SYMBIONT PSEUDO
         BAL,R8   ENDAC             END ACTION
         LW,R3    POB,R6            :
BLD6     EQU      %                 THEN GET THE NEXT SYMB AND
         WD,0     X'37'             TRY TO PUT MORE RECS IN
         LW,R4    CURX,R6
         BEZ      BLD8
BLD7     EQU      %
         LB,R4    STB:LNK,R4
         STW,R4   CURX,R6
         BNEZ     BLD5
BLD8     EQU      %
         WD,0     X'27'
         B        BLD4
BLDCK    EQU      %                 SEE IF WE SHOULD WAIT ON THIS SYMB
         LW,R10   FBF,R6            :
         BNEZ     BLDCK1            IF FORCEWRITE - NO
         LB,11    SSIG,R4           IF HE'S NOT RUNNING YET - NO
         BEZ      BLDCK1            IF HE'S RUNNING  - YES
         LB,11    SSTAT,R4          (HE'S DOING DISC I/O)
         BNEZ     BLDOUT
BLDCK1   EQU      %                 SEE IF EVERYONE MISSED HIS CHANCE
         CW,R4    CURF,R6           :
         BE       BLDOUT            IF CUR GUY IS CURF THEY HAVE
         WD,0     X'27'             :
         LW,R12   CURF,R6           IF WE DONT HAVE A CURF HE'S IT
         BNEZ     BLD6
         STW,R4   CURF,R6
         B        BLD6
H%BCK    EQU      %                 REC TOO BIG FOR BLOCK
BLDCK2   EQU      %                 :
         STW,R4   FBF,R6            SET FORCEWRITE TO CLOSE
         LW,R3    POB,R6            BLOCK WHEN NO ONE FITS
         LB,R5    STB:Q,R4          :
         LCH,R9   IOQ9,R5           RESET RBC (ALMOST) AND
         AWM,R9   RBC,R6            SEE IF BLOCK DONE
         B        BLDCK1
*************************************************
OUTEOF   EQU      %                 SYMB WROTE EOF
         CI,R10   OCBIT             :
         BANZ     OTEF1             IF HE'S THE OC NO EOF REC
         MTW,3    RBC,R6            :
         BGZ      BSC%BC            OTHERWISE SEND EOF REC IF IT
         LB,R2    STB:TYP,R4        FITS (LATER IF NOT) BUT DONT
         BAL,R11  CRC1              GIVE PSEUDO ENDAC YET.
         LI,R2    EOFSRCB           WE'LL GET CONFUSED IF WE HAVE
         BAL,R11  CRC1              TO DISCARD THE BLOCK AND THE
         LI,R2    EORSCB            SYMB HAS EXITED
         BAL,R11  CRC1              :
         STW,R3   POB,R6            AFTER THE MSG IS IN SET THE
OTEF1    EQU      %                 EOF BIT AND FLAG AND CONTINUE
         WD,0     X'37'             BUILDING
         LH,R10   STH:FLG,R4
         AI,R10   EOFBIT
         STH,R10  STH:FLG,R4
         MTW,1    EOF,R6
         B        BLD7
*****************************************************
BLDOUT   EQU      %                 INNTERNAL BUILD EXIT
         LW,R14   FBF,R6            :
         BNEZ     BSC%BC            IF FORCEWRITE CLOSE BLK
         STW,R14  CURF,R6           ELSE CLEAR CURF AND EXIT
         B        BSC%BO
H%BCLS   EQU      %                 BLOCK CLOSING SUBROUTINE
         LI,R2    EODRCB            CALLED BY BSC%BC
         BAL,R11  CRC1              :
         LI,R2    DLE               PUT IN LAST RCB,ENDING
         STB,R2   0,R3              SEQUENCE (DLE ETB), AND
         AI,R3    1                 CRC CRC PAD
         LI,R2    ETB               :
         BAL,R11  CRC1              CORRECT SOME POINTERS
         STB,R12  0,R3              AND BACK TO BSCIO
         AI,R3    1
         SLS,R12  -8
         STB,R12  0,R3
         AI,R3    1
         AI,R9    5
         B        BSC%BCX
*******************************************************
         PAGE
*******************************************************
*                                                     *
*               THE LINE MANAGER                      *
*                                                     *
*******************************************************
H%CTL    EQU      %                 CONTROL ENTRY POINT
         LI,R12   WRFCN             :
         CI,R3    ACKTYC            R12 WILL CARRY WHAT WE THINK
         BE       CTL2              THE FC WILL BE AS WE GO ALONG
         LW,R3    CRB,R6            :
         LW,R2    0,R3              IF THE BLOCK SAID WAIT-A-BIT
         CI,R2    WAB               SKIP THE SUSBIT CHECKS AND
         BAZ      %+3               SET EXPECTED FC (EFC) TO ACK-READ
         LI,R12   ARFCN             :
         B        CTL2              CHECK TO SEE IF THE SUSBITS
         LW,R3    1,R3              HAVE CHANGED AND IF NOT GO
         SLD,R2   8                 TO CTL2
         AND,R2   M16
         CW,R2    FCSI,R6
         BE       CTL2
SUSCK    EQU      %                 SUSBITS CHANGED
         STW,R12  SAB,R6            :
         STW,R2   RST,R6            IF NO BUILD IS IN PROG.
         LW,R11   BIP,R6            CONTINUE OTHERWISE EXIT
         BEZ      SUSCK0            AND COME BACK ON BUILD'S
         XW,R11   CIP,R6            INTERRUPT LEVEL
         LI,R10   SUSCK0
         STW,R10  BIP,R6
         B        *R11
SUSCK0   EQU      %                 PROCESS SUSBIT CHANGES
         LW,R3    RST,R6            :
         XW,R3    FCSI,R6           GET NEW BITS ON TO RST AND
         EOR,R3   FCSI,R6           NEW BITS OFF TO R2
         LW,R2    R3                :
         AND,R3   FCSI,R6           IF NO NEW OFFS -> SUSCK3
         STW,R3   RST,R6            :
         EOR,R2   R3                IF THERE ARE FUNC PERMS AND
         BEZ      SUSCK3            HE'S NOT XP1 THEREIS NO
         LW,R1    PSP,R6            DATA TO RELEASE
         BEZ      SUSCKNX
         LI,R1    XP1BIT
         AND,R1   RB:FLAG,R7
         BNEZ     SUSCKNX
         LI,R3    -1
SUSCKNX  EQU      %                 BACKUP AND SET BKS FOR SYMBS
         LI,R1    BA(RBB:HOU)       WITH BITS NOW OFF
         BAL,R5   FND               :
         B        SUSCK1            WHEN AN APPROPRIATE SYMB IS
         CH,R2    STH:SUS,R4        FOUND BACKUPI IS CALLED TO
         BAZ      FND1              BACK HIM UP AND SET BKSBIT
         LCI      4                 WHERE NECESSARY - BKSBIT
         PSM,R2   TSTACK            KEEPS BUILD FROM ACCEPTING
         LI,R11   BKSBIT            DATA
         BAL,R8   BACKUPI
         LCI      4
         PLM,R2   TSTACK
         B        FND1
SUSCK1   EQU      %                 PROCESS EXISTING DATA AND OTHER
         LW,R11   BKD,R6            SYMBS IF NECESARY
         BEZ      SUSCK3            :
         LI,R15   HWB               IF WE DIDN'T REALLY BACK UP
         BAL,R11  BSC%GB            ANYONE WE'RE DONE
         BEZ      %+4               :
         MTW,-1   CBCB,R6           IF THERE IS NO FULLY OR
         STW,R2   CBB,R6            PARTIALLY BUILT BUFFER WE'RE DONE
         B        SUSCK1A           :
         LW,R2    CBB,R6            IF THERE IS ONE BUT IT CONTAINS
         BEZ      SUSCK3            NO FUNC PERMS IT IS RELEASED TO
         LW,R3    POB,R6            THE BUILD CHAIN.
         BEZ      SUSCK3            :
SUSCK1A  EQU      %                 IF THERE WERE FUNC PERMS THE
         LW,R3    PSP,R6            POINTERS ARE SET AS THOUGH ONLY
         BEZ      SUSCK1B           THEY ARE IN THE BUFFER AND WE
         STW,R3   POB,R6            ARE STILL BUILDING IT
         LW,R3    SCRC,R6           :
         STW,R3   CCRC,R6           IN ANY CASE, IF THERE WAS A
         B        SUSCK1C           WRITE OR BUILD BUFFER ALL SYMBS
SUSCK1B  EQU      %                 WHICH MIGHT HAVE HAD DATA IN IT
         LI,R15   HBB               ARE BACKED UP
         BAL,R11  BSC%FB            :
         STW,R0   POB,R6            THE RESULT IS THAT WE DISCARD
         STW,R0   CBB,R6            ANY OUTPUT DATA (BUT NOT FUNC
SUSCK1C  EQU      %                 PERMS) WE HAVE READY TO OUTPUT,
         LB,R4    RBB:HOU,R7        BACKUP ALL THE SYMBIONTS, AND
SUSCK2   EQU      %                 RE-BUILD THE BUFFER WITH THE
         STB,R4   R6                FCS SUSPENDED GUY(S) LEFT OUT
         LI,R11   0                 :
         LI,3     0                 BACKUP IS TOGGLED WHEN WE START
         BAL,R8   BACKUPI           A NEW BLK AND GIVEN TO THE
         LB,R4    R6                SYMBS ON PSEUDO E.A. SO THEY
         LB,R4    STB:LNK,R4        KNOW HOW FAR TO BACKUP
         BNEZ     SUSCK2
SUSCK3   EQU      %                 RESET BKSBIT FOR SYMBS
         LW,R12   RST,R6            WITH BITS NOW BACK ON
         BEZ      SUSCKO            :
         LI,R1    BA(RBB:HOU)       WHEN AN APPROPRIATE SYMB
         BAL,R5   FND               IS FOUND (SUSBIT NOW ON
         B        SUSCKO            AND BKSBIT SET) BKS IS
         CH,R12   STH:SUS,R4        RESET SO THAT BUILD WILL
         BAZ      FND1              ACCEPT DATA FROM HIM
         LH,R10   STH:FLG,R4
         CI,R10   BKSBIT
         BAZ      FND1
         AI,R10   -BKSBIT
         AND,R10  NBUBTS
         STH,R10  STH:FLG,R4
         B        FND1
SUSCKO   EQU      %                 GET EFC BACK AND LET BUILD GO
         LI,R12   0
         XW,R12   SAB,R6
CTL2     EQU      %                 PROCESS CURRENT READ BUFFER
         LW,R2    CRB,R6            :
         LW,R3    CFC,R6            IF WE SENT WAB GO PROCESS
         LW,R1    LTYC,R6           RESPONSE (COULD BE FUNC
         CI,R3    WAFCN             PERMS) AT ACKCTL
         BGE      ACKCTL            :
         AI,R2    -1                FREE THE BUFFER TO THE PARSE
         LI,R15   HPB               OR READ CHAIN DEPENDING ON
         CI,R1    ACKTYC            WHETHER IT CONTAINS DATA OR NOT
         BNE      %+2               :
         LI,R15   HRB               IF WE READ WAB SKIP CTL3
         BAL,R11  BSC%FB
         CI,R12   ARFCN
         BE       H%CTL4
H%CTL3   EQU      %                 TRY TO GET SOMETHING TO WRITE
         LI,R15   HWB               :
         BAL,R11  BSC%GB            IF THERE WERE NO WRITE BUFFERS
         BEZ      FORCWR            TRY TO FORCE ONE WRITTEN--
         LW,R14   BUTFLG            FORCEWRITE WILL RETURN TO CTL3
         EOR,R14  BUT,R6            ON SUCCESS, CTL4 W/EFC=ACK-RD
         STW,R14  BUT,R6            ON FAILURE
         AI,R2    1                 :
         STW,R2   CWB,R6            TOGGLE THE BACKUP TOGGLE AND
         LW,R4    EOF,R6            SET THE CURRENT WRITE BUFF
         BEZ      CTL3B             WE NEVER BUILD A SECOND BLOCK
         STB,R12  R6                UNTIL WE ARE WRITING THE FIRST
         LI,R1    BA(RBB:HOU)       :
         BAL,R5   FND               IF THERE ARE NO EOFS IN THIS
CTL3X    B        CTL3A             BLOCK CONTINUE
         LH,R10   STH:FLG,R4        :
         CI,R10   EOFBIT            IF THERE WERE EOFS IT IS NOW
         BAZ      FND1              SAFE TO GIVE THE SYMBS PSEUDO
         AI,R10   -EOFBIT           END ACTION WITH EOF TYC AND
         STH,R10  STH:FLG,R4        MOVE THEM TO THE FREE CHAIN
         CI,R10   OCBIT             :
         BAZ      %+3               THE OC ALWAYS STAYS ON THE
         PSW,R4   TSTACK            OUTPUT CHAIN SINCE THERE IS
         B        CTL3C             NO FUNC PERM SEQ FORR IT
         LI,R15   RBB:HFE
         BAL,R11  RELNK
         PSW,R1   TSTACK
CTL3C    EQU      %
         LB,R5    STB:Q,R4
         LI,R12   0
         BAL,R8   ENDAC
         PLW,R1   TSTACK
         LI,R5    CTL3X
         B        FND2
CTL3A    STW,R4   EOF,R6            IF THERE WERE EOF'S THESE CELLS
         STW,R4   CURX,R6           NO LONGER APPLY
         STW,R4   CURF,R6
         LB,R12   R6
         LW,R2    CWB,R6
CTL3B    EQU      %                 CLEAR PSP AND TRADE 4 SYNCS
         STW,R4   PSP,R6            FOR BYTE COUNT INTO R14 FOR IOQ
         LW,R14   4SYNC
         XW,R14   0,R2
H%CTL4   EQU      %                 TRY TO GET READ BUFFER
         LI,R15   HRB               :
         BAL,R11  BSC%GB            IF WE DIDN'T SET WAB IN THE
         BEZ      SETWAB            BLOCK WE WROTE - IF WE DID
         AI,R2    1                 SET CURRENT READ BUFFER
         STW,R2   CRB,R6
CTL5     EQU      %                 CHECK FOR RBDISC OR DELAY
         STW,R12  CFC,R6            :
         CI,R12   ARFCN             IF RBDISC WAS SENT, WE ARE
         BNE      CTL6              SENDING ACK AND WE RECIEVED ACK
         LW,R1    LTYC,R6           LAST DISCONNECT.
         BNEZ     CTL6              :
         BAL,R1   BSC%DSC           IF THE ABOVE TWO TESTS ARE TRUE
         B        CTL6              BUT THERE WAS NO RBDISC, WAIT
         LI,R1    CLKBIT            1.2 SEC BEFORE SENDING ACK0
         WD,0     X'37'
         STS,R1   RB:FLAG,R7
         LI,R14   CIP
         B        BSC%GO
CTL6     EQU      %                 DO THE I/O VIA BSCIO
         LI,R13   CRB               :
         AW,R13   R6                ON RETURN TRY TO BUILD AND/OR
         BAL,R10  BSCDIO            PARSE SOMETHING
         BAL,R11  BSC%PRS
         PLW,R11  TSTACK
         B        BSC%BLD
*********************************************************:
CRCH     EQU      %                 RE-CRC ROUTINE WHEN SETTING WAB
         BAL,R10  CRCX              :
         BNE      CRC4              JUST SKIP DLE BUT CRC THE NEXT
         AI,R2    1                 CHAR EVEN IF DLE
         AI,R9    -1
         LB,R5    0,R2
         B        CRC4
****************************************************
SETWAB   EQU      %                 SET WAIT-A-BIT IN OUR OUTPUT
         LI,R15   SPB               :
         AW,R15   R6                MAKE SRB THE CUR RD BUFF
         STW,R15  CRB,R6            :
         CI,R12   ARFCN             IF WE HAVE NOTHING TO WRITE
         BNE      %+3               SEND SPECIAL WAB MESSAGE
         LI,R12   HAFCN             :
         B        CTL5              IF WE HAVE A WRITE BUFFER
         LW,R2    CWB,R6            SET THE WAB (WHICH RREQUIRES
         LI,R1    WAB               THE WHOLE THING TO BE CRC'ED
         AWM,R1   1,R2              AGAIN) AND SET EFC TO WRT W/WAB-
         SLS,R2   2                 RD SPECIAL
         AI,R2    6
         LW,R9    R14
         AI,R9    -9
         LI,R12   0
         BAL,R11  CRCH
         STB,R12  0,R2
         AI,R2    1
         SLS,R12  -8
         STB,R12  0,R2
         LI,R12   WAFCN
         B        CTL5
***************************************************
ACKCTL   EQU      %                 PROCESS SPEC RDS WHEN WAB SENT
         CI,R1    ACKTYC            :
         BE       H%CTL3            IF WE RECIEVEDD ACK0 OR THERE
         SLS,R2   2                 IS NO DATA IN THE BLOCK,
         AI,R2    5                 CONTINUE
ACKCTL1   EQU     %                 :
         LB,R5    0,R2              IF THERE WAS DATA IT MUST BE
         BEZ      H%CTL3            CONTROL RECORDS - GET SPECREC
         CI,R5    X'F'              TO PROCESS THEM
         BANZ     H%CTL3
         LI,R0    ACKCTL1
         B        SPECREC
********************************************************
CSRCB    EQU      %                 PROC SRCB WHEN SRCB=C (INPUT)
         CI,R15   BINSRCB           :
         BAZ      MVREC             IF BIN BIT IS SET IN SRCB SET
         LW,R15   BINFLG            BIN FLAG WHICH IS GIVEN TO
         STW,R15  BIN,R6            INSYM ON PSEUDO END ACTION
         B        MVREC
PSRCB    EQU      %                 PROC SRCB WHEN SRCB=P (INPUT)
         LH,R14   STH:SUS,R4        :
         BEZ      PSRCBNI           THIS IS A BIT COMPLICATED
         STB,R14  0,R3              :
         AI,R3    1                 HASP HAS TWO KINDS OF VFC:
         LI,R14   0                 HE CAN SPACE OR SKIP BEFORE
         STB,R14  0,R3              PRINT, OR HE CAN SPACE OR SKIP
         STH,R14  STH:SUS,R4        AFTER PRINT.  WE ONLY SPACE OR
         AI,R3    1                 SKIP BEFORE PRINT SO I HAVE
         AI,R2    -3                TO PULL SOME TRICKS TO MAKE
         B        BSC%PEA           THE LISTINGS LOOK RIGHT.
PSRCBNI  EQU      %                 :
         AI,R2    -1                IF THE HASP VFC IS A SUPRESS
         CI,R15   X'80'             SPACE, SKIP B4 PRINT, OR
         BNE      %+3               SPACE B4 PRINT; A ONE TO
         LI,R14   X'60'             ONE CONVERSION CAN BE DONE
         B        PSRCB1            AND THE CP-V VFC IS STORED IN
         AI,R15   -1                THE RECORD
         LI,R14   X'C0'             :
         LC       0,R2              OTHERWISE WE PUT A NORMAL
         BCR,1    %+4               PRINT AND UPSPACE VFC ON THE
         AI,R14   X'F0'-X'C0'       DATA, AND SAVE WHAT WE WANT
         AI,R15   1                 TO DO AFTER THE PRINT IN
         AND,R15  M3                THIS GUY'S STH:SUS WHICH
         AND,R15  M4                IS OTHERWISE UNUSED FOR
         AW,R14   R15               INPUT SYMBS.  WWHEN WE GET
         AI,R4    0                 CALLED TO DO THE NEXT RECORD
         BEZ      PSRCB1            WE STICK IN AN EXTRA RECORD
         LC       0,R2              WITH THE DESIRED CODE FROM
         BCS,2    PSRCB1            STH:SUS AND GIVE THE SYMB
         CI,R14   X'C0'             PSEUDO END ACTION WITH STH:SUS
         BLE      PSRCB1            CLEARED.  WHEN WE GET IN AGAIN
         CI,R14   X'10'             FOR THE RECORD THAT CALLED US
         BANZ     %+2               STH:SUS IS ZERO AND WE NOW
         AI,R14   -1                CAN PROCESS THAT RECORD'S SRCB
         STH,R14  STH:SUS,R4        :
         LI,R14   X'C0'             RBSWITCH ALSO USES THIS CODE,
PSRCB1   STB,R14  0,R3              BUT HIS R4 IS ZERO SO WE DONT
         AI,R2    1                 TRY TO GIVE ENDAC TO A NON-
         B        MVREC1            EXISTENT SYMBIONT (WHEW!)
*********************************************************
BACKUP   EQU      %                 BACKUP SYMB WE WERE WAITING TO BU
         WD,0     X'27'             :
         LW,R8    R11               GIVE PSEUDO ENDACTION WITH
         LB,R5    STB:Q,R4          THE BACKUP TOGGLE SAVED BY
         LI,R15   0                 BACKUPI WITH BACKUP TYC
         STB,R15  STB:Q,R4          :
         CI,R10   BUTBIT            CLEAR THE WAITING FOR BACKUP
         BAZ      %+2               BITS AND EXIT BACK OUT TO IOQ
         LW,R15   BUTFLG
         AND,R10  NBUBTS
         STH,R10  STH:FLG,R4
         LW,R12   BUTYC
         B        ENDAC2
BACKUPI  EQU      %                 TRY TO BACKUP SYMB
         LH,R10   STH:FLG,R4        :
         AND,R10  NEOFBT            EOFBIT NO LONGER APPLIES SINCE
         CI,R10   WFQBIT+BUBIT+BKSBIT HE WILL WRT DATA THEN EOF AGAIN
         BANZ     *R8               :
         LC       SSIG,R4           IF HE ISN'T STARTED OR ALREADY
         BCR,4    *R8               BACKED UP SKIP HIM
         AW,R10   R11               :
         AI,R3    0                 SET THE BIT (IF ANY) IN R11
         BLZ      BUI2              INTO HIS STH:FLG
         MTW,1    BKD,R6            :
         WD,0     X'37'             IF R3=-1 NO NEED TO REALLY
         LB,R5    STB:Q,R4          BACKUP (FUNC PERMS ONLY IN BLK)
         BEZ      BUI1              :
         WD,0     X'27'             IF HE HAS A Q ENTRY GIVE PSEUDO
         LW,R12   BUTYC             END ACTION WITH BACKUP TYC
         STH,R10  STH:FLG,R4        :
         B        ENDAC1            IF NOT SET WAITING TO BACKUP
BUI1     EQU      %                 AND SAVE THE CURRENT BACKUP
         AI,R10   BUBIT             TOGGLE AND WE'LL GET HIM WHEN
         LW,R12   BUT,R6            HE GOES TO IOQ NEXT
         BEZ      %+2
         AI,R10   BUTBIT
BUI2     EQU      %
         STH,R10  STH:FLG,R4
         WD,0     X'27'
         B        *R8
************************************************************:
OCIN     EQU      %                 CONSOLE MESSAGE RECIEVED
         LI,R3    0                 :
         XW,R3    CONT,R6           DECOMPRESS THE MESSAGE INTO AN
         BNEZ     OCIN2             MPOOL, SET RBBAT EOC AT END, AND
         BAL,R11  GMB               SEND IF OFF TO RBBAT WITH OCMGFC
         BEZ      BSC%PO            :
         MTB,-1   R14               IF ITS TOO LONG TRUNCATE IT
         STW,R14  CONTCK,R6         :
         LW,R2    POP,R6            IF WE CANT GET AN MPOOL OR COMBUF
         LW,R3    R14               WE JUST EXIT. WE WILL KEEP
         LI,R9    115               COMMING TO PARSE AND EVENTUALLY
         SLS,R3   2                 WE WILL GET ONE
OCIN2    EQU      %                 :
         BAL,R0   PRS3              WHEN THE MSG IS ON ITS WAY TO
OCIN3    EQU      %                 RBBAT WE CONTINUE PARSING THE
         LW,R14   CONTCK,R6         BUFFER
         MTB,1    R14               :
         LI,R12   EOC               IT EVEN WORKS FOR CONTINUED
         STB,R12  0,R3              CONSOLE MESSAGES (YEEECH!!)
         AI,R2    1
         LW,R12   R7
         SLS,R12  8
         AI,R12   OCMGFC
         LI,R11   BSC%PO
         BAL,R4   SGCQ
         B        RMB
         STW,R2   POP,R6
         B        H%PRS2
****************************************************
H%HU     EQU      %                 HANG UP ENTRY
         WD,0     X'27'             :
         LI,R15   RBB:HFE           GET ALL THE SYMBIONTS BACK
         LI,R3    2                 TO THE FREE CHAIN AND GIVE
         LI,R1    BA(RBB:HOU)       ANYONE WHICH STILL HAS A
         BAL,R5   FND               Q ENTRY PSEUDO END ACTION
         B        %+3               WITH THE HUNG UP TYC
         BAL,R11  RELNK             :
         B        FND2              WHEN DONE GET OUT FOR GOOD
         LI,R1    BA(RBB:HIN)
         BDR,R3   FND
         LI,R1    BA(RBB:HFE)
         BAL,R5   FND
HU%1     EQU      %
         B        BSC%HO
         LB,R5    STB:Q,R4
         BEZ      HU%2
         LW,R12   HUTYC1
         PSW,R1   TSTACK
         BAL,R8   ENDAC1
         PLW,R1   TSTACK
         LW,R4    R1
HU%2     EQU      %
         LI,R5    HU%1
         B        FND1
*****************************************************:
         PAGE
****************************************************
*                                                  *
*           CLOCK DRIVEN ROUTINES                  *
*                                                  *
*    H%SSET IS CALLED BY RBSS OFF THE FIVE SECOND  *
*CLOCK AND H%AKTIM BY CLOCKI OFF THE 1.2 SEC ONE   *
****************************************************
H%SSET   EQU      %                 CHECK FOR DIAL UP
         LI,R11   CTRBIT+LIPBIT+OFFBIT :
         BAL,R5   RB%TDV            RB%TDV HANDLES DU - OFFBIT
         B        NXT%DEV           IS SET TO GET RID OF RBSS
         B        NXT%DEV           AFTER DIAL UP
*******************************************
H%AKTIM  EQU      %                 RETURN FROM 1.2 SECOND IDLE WAIT
         PSW,R11  TSTACK            :
         LW,R7    RBLIMS+1          LOOK THROUGH ALL RB DEVICES
         B        AKTIM2            FOR ONES WAITING WHILE IDLE
AKTIM1   AI,R7    -1                :
         CW,R7    RBLIMS            WHEN ONE IS FOUND GO TO IOQ
         BGE      AKTIM2            VIA CTL6 TO Q UP AN ACK0 - READ
         PLW,R11  TSTACK            :
         B        *R11              WHEN ALL HAVE BEEN PROCESSED
AKTIM2   EQU      %                 BACK TO CLOCKI
         LI,R5    CLKBIT
         CW,R5    RB:FLAG,R7
         BAZ      AKTIM1
         LI,R4    0
         STS,R4   RB:FLAG,R7
         LW,R6    RB:BUF,R7
         BEZ      AKTIM1
         LI,R12   ARFCN
         LI,R11   AKTIM1
         STW,R11  CIP,R6
         B        CTL6
********************************************************
         END

