         DEF      BSCIO:
BSCIO:   EQU      %
******************************************************
* THIS MODULE IS A CONGLOMERATION OF COMMON CODE FOR *
* 2780 AND IRBT CONSISTING OF WHATEVER CODE I COULD  *
* COMBINE FROM 2780IO AND HASPIO -- SMK              *
******************************************************
         SYSTEM   SIG7P
*                                   COMMON USAGE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4                 SYMB INDEX
R5       EQU      5                 IOQ INDEX
R6       EQU      6                 ALWAYS CXT BUF ADDR (RB:BUF)
R7       EQU      7                 ALWAYS DCTX
SR1,R8   EQU      8
SR2,R9   EQU      9
SR3,R10  EQU      10
SR4,R11  EQU      11
D1,R12   EQU      12                CURRENT CRC
D2,R13   EQU      13
D3,R14   EQU      14
D4,R15   EQU      15
         REF      Y004,Y008,Y01,Y02,Y04,Y08,Y1,Y2,Y4,Y8
         REF      IOQ13,IOQ2,IOQ8,M8,Y002
         REF      QFREE,CURBQ,STB:Q,TSTACK
         REF      ENBSR4,IOQ12,RB:BUF,IOQ7,RB:FLAG
         REF      IOQ9,JIT,STH:FLG,SYMX,Q51,Q15A
         REF      NEWQ,RBH:ACK,M19,USECOM
         REF      DCT2,IOQ11,DCT7,IOQ4,IOQ5,IOSCU
         REF      RB%LGER,REG%SET,DCT10,FIN,LORR
         REF      XF7FF,DCT13,DCT17,M16,HUP,RBSGCQP
         SREF     27CTL,H%CTL3
         SREF     H%BCK
         SREF     H%CTL4,27DIO1,27WRT,H%CTL
         SREF     H%CRC1,H%HU,27HU
         SREF     BACKUP,27B,27BG,27P,H%BCLS,27PEF
         SREF     H%BLD3,H%BLD,H%PRS2,27P2,H%PEOF,H%PRS1
         DEF      BSC%BC,CRCX,BSC%BCX,CRC1,BSC%BL0
         DEF      CRC4,H%CRCI,BSC%BLD,ENDAC,BSC%PRS
         DEF      CRCO3
         DEF      CRCI1,ENDAC1,BSC%PEA,CRCI2,ENDAC2
         DEF      BSC%PE1,CRCO,BSC%EOB,CRCI,CRCI3,BSC%LGN
         DEF      BSCAKM,BSCDIO,BSCNAKM,BSCSPC1,FORCWR
         DEF      BSC%FB,BSC%GB,BSCSPC,ML%CTL,4SYNC
         DEF      E%DISC,TEL%RBBAT,RPT%ORG,NEW%FLO
         DEF      BSC%BO,BSC%FL,BSC%GL,BSC%GN,BSC%GO
         DEF      BSC%PO,BSC%PRE,BSC%PX,BSC%PX1,BSC%RTR
         DEF      UNKN%RD1,UNKN%RD2,UNKN%RD3,UNKN%RD4
         DEF      BD%CRC,TO%NAK,HE%NAKD,ENQ%PRB,LGN%ACK
         DEF      ENQ%NOT,TO%OUT,BD%BCB,OLD%BCB1,LOG%ERR
         DEF      BSC%HO,BSC%HEA,BSC%BO1,RBQCKH,CRCI4
         DEF      CRCI0,BSC%DSC
**********************************************
*
*        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'           FLAG BITS FOUND IN RB:FLAG
LOFBIT   EQU      X'2000'
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
*
SYNC     EQU      X'32'
SOH      EQU      X'01'
STX      EQU      X'02'
ITB      EQU      X'1F'
ETB      EQU      X'26'
ETX      EQU      X'03'
ENQ      EQU      X'2D'
EOT      EQU      X'37'             BSC-EBCDIC LINE CODES
NAK      EQU      X'3D'
DLE      EQU      X'10'
ACK0     EQU      X'70'
ACK1     EQU      X'61'
WACK     EQU      X'6B'
RVI      EQU      X'7C'
EM       EQU      X'19'
BEL      EQU      X'2F'
ESC      EQU      X'27'
PAD      EQU      X'FF'
4SYNC    DATA     X'32323232'       FOUR SYNCS FOR MSG START
PRINRT   DATA     X'00FF0F00'       ADD FC AND DCT FOR NEWQ R12
FCKPTR   GEN,8,24 4,BA(FIN)         USED TO SCAN INPUT FOR FIN
BUBIT    EQU      X'100'            ++SEE HASPIO
HUTYC    EQU      2                 HUNG UP TYC FROM HANDLER
HUTYC1   EQU      Y02               H. U. TYC TO SYMB
%RBC     EQU      389               DATA SPACE IN 400 BYTE BUFF
DISC:DOT EQU      0                 DISCONNECT FC
NORTYC   EQU      Y01               NORMAL TYC TO SYMB
NWFCN    EQU      2                 NO DATA TO OUTPUT FC
NWFQBT   EQU      XF7FF             ++ SEE HASPIO
*********************************************
*                                   CONTEXT POINTERS****
FNSV     EQU      0
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 PARSE BUFF
CBB      EQU      6                 CURRENT BUILD BUFF
CRB      EQU      7                 CURRENT READ BUFF
CWB      EQU      8                 CURRENT WRITE BUFF
POP      EQU      9                 POINTER OF PARSE
POB      EQU      10                POINTER OF BUILD
PIP      EQU      11                PARSE 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)
*FOR 2780 CURX HOLDS SYMX OF O.S. UNTIL RREADY
BIP      EQU      17                BUILD IN PROGRESS
FBF      EQU      18                FORCE BUFFER FULL
CIP      EQU      19                CONTROL IN PROGRESS
FCSI     EQU      20                COMB. INPUT FCS
*FOR 2780 FCSI HOLDS VFC BEING SIMULATED
CFC      EQU      21                CUR. FUNCTION CODE
BUT      EQU      22                BACKUP TOGGLE
BIN      EQU      23                BINARY REC RCVD.
CURF     EQU      24                LAST FAILING USER (OUT)
*FOR 2780 CURF COUNTS CURRENT RECS IN OUTPUT BLOCK
LTYC     EQU      25                LINE TYC
RST      EQU      26                SUSPENDED USERS TO RESTART
SAB      EQU      27                SUSCK ABORTS BUILD
*FOR 2780 SAB IS USED TO PREVENT WRITES B4 READY
PSP      EQU      28                PERMISSION SPECIAL POINTER
EOF      EQU      29                EOF IN THIS BLOCK
CONT     EQU      30                CONTINUATION BUFF ADDR
*FOR 2780 CONT SET MEANS SYMB OPERATION IN PROG.
CONTCK   EQU      31                CONT SYMB INDES
*FOR 2780 CONTCK IS SET BY RBBAT TO: SRB=1,MRB=FF
CONTCNT  EQU      32                CONT BYTE COUNT
SCRC     EQU      33                PERMISSION SPECIAL CRC
HIP      EQU      34                HANG-UP IN PROGRESS
BKD      EQU      35                SYMB BACKED UP
TTYP     EQU      36                1=2780 -- 0=IRBT
SPB      EQU      38                BUFFER WHEN WAB SENT
**********************************************
*           COMLIST ROUTINES
BSCSPC1  EQU      %                 SET BUF TO BA(RBH:ACK,1)
         LI,R11   HA(RBH:ACK)
         AW,R11   R1
         SLS,R11  1
         AND,R11  M19
BSCSPC   EQU      %                 PUT NEW BUF IN 11 INTO COMMAND IN 8
         OR,R8    R11
         B        USECOM
*********************************************
: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 . . . . . . . . .
*
*
BSCAKM   :CHAR    SYNC,SYNC,SYNC,SYNC,DLE,ACK0,PAD
BSCNAKM  :CHAR    SYNC,SYNC,SYNC,SYNC,NAK,PAD
         BOUND    4
********************************************
*                                   HANDLER PRE ENTRY COMMON CODE
BSC%PRE  EQU      %                 :
         BAL,R9   REG%SET           SET R13=RB:FLAG,R5=CUR FC,R7=CLIST DA
         CI,R13   RBXBIT            :
         BAZ      %+3               IF RBXBIT CHANGE FC TO DISCONNECT
         LI,R5    DISC:DOT
         STB,R5   IOQ5,R3
         B        *R11
************************************************
BSC%GL   EQU      %                 GET INPUT MESSAGE LENGTH
         LD,R8    0,R7              :
         LD,R10   DCT13,R1          ON EXIT:  R11= -(MSG LENGTH)
         AND,R11  M16                           R5= FIRST CHAR
         AND,R9   M16               COME IN W/R6=BA(MESSAGE)
         SW,R11   R9
         LB,R5    0,R6
         B        *R12
*******************************************************
*
*
*                 NAK ERRLOGING ROUTINES
*
ENTER    COM,8,4,20 X'73',+1,R5    MTB,+1 R5
*
**
UNKN%RD1 ENTER                      X'C'
UNKN%RD2 ENTER                      X'B'
UNKN%RD3 ENTER                      X'A'
UNKN%RD4 ENTER                        9
BD%CRC   ENTER                        8
TO%NAK   ENTER                        7
         LI,R0    BSC%FL            AFTER LOG FOLLOWON ON ABOVE
         MTB,6    R5
         B        LOG%ERR
HE%NAKD  ENTER                        6
ENQ%PRB  ENTER                        5
LGN%ACK  ENTER                        4
ENQ%NOT  ENTER                        3
         LI,R0    RPT%ORG           AFTER LOG REDO ORIG FC ON ABOVE
         MTB,2    R5                :
         B        LOG%ERR           :
TO%OUT   ENTER                        2
         LI,R0    BSC%RTR           ON TO%OUT RETRY AFTER LOG
BD%BCB   ENTER                        1
OLD%BCB1 EQU      %                   0
LOG%ERR  EQU      %                 :
*                                   :
         LB,R6    IOQ5,R3           FOR ERRLOG DESC SEE RP REF MANUAL
         SLS,R6   16
         OR,R5    R6
         LB,R6    IOQ4,R3
         SLS,R6   8
         OR,R5    R6
         LW,R14   R5
         LI,R5    0
         BAL,R12  RB%LGER           LOG THE ERROR
         MTB,-1   IOQ11,R3          :
         BNEZ     *R0               LAST RETRY????
E%DISC   EQU      %                 :
         MTB,1    IOQ11,R3          YES SET BIT FOR ERROR MAX MSG
         LI,R5    DISC:DOT          AND DISCONNECT
         AI,R13   EDISBIT
         B        NEW%FLO
*********************************************************
*            FOLLOWON
BSC%FL   EQU      %
         LI,R12   X'6000'           SET FOLLOW-ON, INTER-OP
         B        BSC%PX1           RETURN TO DSC HANDLER
*          NORMAL EXIT OF I/O
BSC%PX   EQU      %
         LI,R12   1                 NORMAL COMPLETION
BSC%PX1  LH,R7    DCT7,R1           RESTORE CLST
         LB,R4    DCT2,R1    RESTORE CITX FOR IOS ROUTINES
         LI,R11   0                 RBC
         STW,R13  RB:FLAG,R1
         LI,R13   0
         LH,R14   DCT10,R1          MAKE RE:ENT HAPPY
         B        IOSCU             EXIT TO CLEANUP
*
*             RETRY
BSC%RTR  EQU      %
         LI,R12   X'C008'
         B        BSC%PX1
******************************************************
*                                   INPUT CRC ROUTINE
H%CRCI   LI,R0    H%CRC1            :
CRCI     EQU      %                 IN:  R11= -(BC),R6=BA(BUF),R7=BA(BUF) (IF US
         LI,R12   0                 OUT:  EXITS SKIPPING IF CRC IS OK
CRCI0    EQU      %                 :
         LI,R4    2                 :
CRCI1    EQU      %                 ON EACH BYTE A TYPE SPECIFIC CHECK
         LB,R5    0,R6              ROUTINE (*R0) IS CALLED TO LOOK FOR
         AI,R6    1                 DLE,ITB,ETC.  IRBT USES CRCI2 TO SQUEEZE
         B        *R0               DLE'S -- 2780 USES CRCI3 AND CRC'S IN PLACE
CRCI2    EQU      %
         STB,R5   0,R7
         AI,R7    1
CRCI3    EQU      %
         LB,R10   R12,R4
         AND,R12  M8
         EOR,R5   R12
         LH,R12   CRCTBL,R5
         EOR,R12  R10
CRCI4    EQU      %
         BIR,R11  CRCI1
         BNEZ     *R9
         AI,R9    1
         B        *R9
************************************************
CRCO     EQU      %                 OUTPUT CRC ROUTINE
         LI,R10   CRC2              :
CRCX     LI,R1    2                 IN:  R9=BC R2=BA(SOURCE BUF) R3=BA(DEST BUF)
CRC5     EQU      %                 OUT:  MSG MOVED R2 -> R3 AND CRC IN R12
         LB,R5    0,R2              :
         CI,R5    DLE               :
         B        *R10              AS EACH CHAR IS PICKED UP A CALLER SPECIFIC
CRC2     EQU      %                 DLE CHECKING ROUTING (*R10) IS CALLED TO ACT
         BNE      CRCO3              ON DLE'S FOUND.-- ONE USE IS CRC2 WHICH
         MTW,1    RBC,R6            INSERTS AN EXTRA UN-CRCED DLE FOR TRANSPAREN
         BGZ      H%BCK             IF THERE IS BUFFER SPACE -- 2780 USES CRCO3
         STB,R5   0,R3              IN R10 -- HASPIO USES CRC2 AND OTHERS
         AI,R3    1
CRCO3    EQU      %
         STB,R5   0,R3
         AI,R3    1
CRC4     LB,R13   R12,R1
         AND,R12  M8
         EOR,R5   R12
         LH,R12   CRCTBL,R5
         EOR,R12  R13
         AI,R2    1
         BDR,R9   CRC5
         B        *R11
*****************************************************
CRC1     EQU      %                 CRC AND STORE ONE CHAR
         STB,R2   0,R3              :
         AI,R3    1                 IN:  R2=CHAR,R3=BA(DEST BUF)
         LW,R12   CCRC,R6           OUT: CHAR CRCED AND STORED -- BUF ADVANCED
         INT,R13  CCRC,R6
         SLS,R13  -8
         AND,R12  M8
         EOR,R2   R12
         LH,R12   CRCTBL,R2
         EOR,R12  R13
         STW,R12  CCRC,R6
         B        *R11
********************************************************
*    PARTIAL REMAINDER TABLE FOR CRC CALCULATION
CRCTBL   EQU      %
         DATA     X'0000C0C1'
         DATA     X'C1810140'
         DATA     X'C30103C0'
         DATA     X'0280C241'
         DATA     X'C60106C0'
         DATA     X'0780C741'
         DATA     X'0500C5C1'
         DATA     X'C4810440'
         DATA     X'CC010CC0'
         DATA     X'0D80CD41'
         DATA     X'0F00CFC1'
         DATA     X'CE810E40'
         DATA     X'0A00CAC1'
         DATA     X'CB810B40'
         DATA     X'C90109C0'
         DATA     X'0880C841'
         DATA     X'D80118C0'
         DATA     X'1980D941'
         DATA     X'1B00DBC1'
         DATA     X'DA811A40'
         DATA     X'1E00DEC1'
         DATA     X'DF811F40'
         DATA     X'DD011DC0'
         DATA     X'1C80DC41'
         DATA     X'1400D4C1'
         DATA     X'D5811540'
         DATA     X'D70117C0'
         DATA     X'1680D641'
         DATA     X'D20112C0'
         DATA     X'1380D341'
         DATA     X'1100D1C1'
         DATA     X'D0811040'
         DATA     X'F00130C0'
         DATA     X'3180F141'
         DATA     X'3300F3C1'
         DATA     X'F2813240'
         DATA     X'3600F6C1'
         DATA     X'F7813740'
         DATA     X'F50135C0'
         DATA     X'3480F441'
         DATA     X'3C00FCC1'
         DATA     X'FD813D40'
         DATA     X'FF013FC0'
         DATA     X'3E80FE41'
         DATA     X'FA013AC0'
         DATA     X'3B80FB41'
         DATA     X'3900F9C1'
         DATA     X'F8813840'
         DATA     X'2800E8C1'
         DATA     X'E9812940'
         DATA     X'EB012BC0'
         DATA     X'2A80EA41'
         DATA     X'EE012EC0'
         DATA     X'2F80EF41'
         DATA     X'2D00EDC1'
         DATA     X'EC812C40'
         DATA     X'E40124C0'
         DATA     X'2580E541'
         DATA     X'2700E7C1'
         DATA     X'E6812640'
         DATA     X'2200E2C1'
         DATA     X'E3812340'
         DATA     X'E10121C0'
         DATA     X'2080E041'
         DATA     X'A00160C0'
         DATA     X'6180A141'
         DATA     X'6300A3C1'
         DATA     X'A2816240'
         DATA     X'6600A6C1'
         DATA     X'A7816740'
         DATA     X'A50165C0'
         DATA     X'6480A441'
         DATA     X'6C00ACC1'
         DATA     X'AD816D40'
         DATA     X'AF016FC0'
         DATA     X'6E80AE41'
         DATA     X'AA016AC0'
         DATA     X'6B80AB41'
         DATA     X'6900A9C1'
         DATA     X'A8816840'
         DATA     X'7800B8C1'
         DATA     X'B9817940'
         DATA     X'BB017BC0'
         DATA     X'7A80BA41'
         DATA     X'BE017EC0'
         DATA     X'7F80BF41'
         DATA     X'7D00BDC1'
         DATA     X'BC817C40'
         DATA     X'B40174C0'
         DATA     X'7580B541'
         DATA     X'7700B7C1'
         DATA     X'B6817640'
         DATA     X'7200B2C1'
         DATA     X'B3817340'
         DATA     X'B10171C0'
         DATA     X'7080B041'
         DATA     X'500090C1'
         DATA     X'91815140'
         DATA     X'930153C0'
         DATA     X'52809241'
         DATA     X'960156C0'
         DATA     X'57809741'
         DATA     X'550095C1'
         DATA     X'94815440'
         DATA     X'9C015CC0'
         DATA     X'5D809D41'
         DATA     X'5F009FC1'
         DATA     X'9E815E40'
         DATA     X'5A009AC1'
         DATA     X'9B815B40'
         DATA     X'990159C0'
         DATA     X'58809841'
         DATA     X'880148C0'
         DATA     X'49808941'
         DATA     X'4B008BC1'
         DATA     X'8A814A40'
         DATA     X'4E008EC1'
         DATA     X'8F814F40'
         DATA     X'8D014DC0'
         DATA     X'4C808C41'
         DATA     X'440084C1'
         DATA     X'85814540'
         DATA     X'870147C0'
         DATA     X'46808641'
         DATA     X'820142C0'
         DATA     X'43808341'
         DATA     X'410081C1'
         DATA     X'80814040'
****************************************************
ENDAC    EQU      %                 SYMBIONT PSEUDO END ACTION
         OR,R12   NORTYC            :
ENDAC1   EQU      %                 SETS UP REGISTERS AS IN
         WD,0     X'37'             NEWQ END ACTION INCLUDEING
         LB,R2    IOQ2,R5           BIN BIT AND BACKUP TOGGLE IN
         STB,R2   STB:Q,R4          TOP BYTE OF BUF.
         WD,0     X'27'             :
         LI,R15   0                 MANAGES AND FREES Q ENTRY
         XW,R15   BIN,R6            :
         OR,R15   BUT,R6            ENTER WITH RBC IN 12
ENDAC2   EQU      %                 :
         OR,R15   IOQ8,R5           ENDAC1 I CALLED FOR OTHER THAN
         LD,R10   IOQ13,R5          NORMAL TYC'S AND ENDAC2 IN
         LW,R14   R11               SPECIAL BACKUP CASES.
         WD,0     X'37'
         LB,R2    QFREE
         STB,R5   QFREE
         STB,R2   IOQ2,R5
         WD,0     X'27'
         MTW,-1   CURBQ
         AI,R10   0
         BEZ      *R8
         LCI      3
         PSM,R6   TSTACK
         BAL,R11  *R10              WHEN YOU LEAVE HERE YOU MAY
         LCI      3                 GET BACK VIA (E.G.) BSC%BLD
         PLM,R6   TSTACK            BUT IUCK WILL PREVENT RE-ENTS
         B        *R8
*****************************************
RBQCKH   EQU      %                 IOQ INTERCEPT ROUTINE
         LW,R4    IOQ12,R3          :
         BEZ      Q15A              :
         LW,R7    HUBIT             IF IOQ12 IS NON ZERO THIS IS A
         STB,R7   IOQ2,R3           SYMBIONT CALL AND WE PROCESS --
         WD,0     X'37'             RBSSS HAS DECIDED ITS OURS ALREADY
         MTW,0    RB:BUF,R1         IF IOQ12 IS ZERO ITS OUR OWN REAL
         BEZ      %+3               I/O CALL AND WE LET IT GO
         CW,R7    RB:FLAG,R1        :
         BAZ      RBQCK1            IF THE LINE IS HUNG-UP GIVE INSTANT
         WD,0     X'27'             END ACTION WITH HUTYC -- NOTE THAT
         LW,R5    R3                SYMB MAY GET ENDAC B4 Q EXIT BUT
         LI,R8    Q51               THATS REALTIME BIZ.
BSC%HEA  EQU      %                 :
         LW,R12   HUTYC1            IF ALL IS COOL WE SAVE THE Q ENTRY
         B        ENDAC1            IN THE APPROPRIATE STB:Q AND GO TO
RBQCK1   EQU      %                 THE PARSER IF ITS INPUT-- IF ITS
         LB,R7    STB:Q,R4          OUTPUT WE SEE IF WE ARE WAITING TO
         BNEZ     %+3               BACK THIS GUY UP AND IF SO GO
         STB,R3   STB:Q,R4          TO BACKUP-- OTHERWISE OFF TO BUILD
         B        %+2               :
         STB,R3   IOQ2,R7           WFQBIT IS RESET TO TELL BUILD THIS
         WD,0     X'27'             SYMB IS READY TO GO
         LB,R7    IOQ7,R3
         LI,R11   Q51
         LB,R9    SYMX,R4
         CI,R9    1
         BANZ     BSC%PRS
         WD,0     X'37'
         LH,R10   STH:FLG,R4
         AND,R10  NWFQBT
         CI,R10   BUBIT
         BANZ     BACKUP
         STH,R10  STH:FLG,R4
         WD,0     X'27'
         B        BSC%BLD
***********************************************
BSC%PRS  EQU      %                 COMMON PARSING ENTRY
         LI,R14   PIP               :
         BAL,R10  IUCK              IF WE ARE ALREADY PARSING EXIT
         LW,R2    POP,R6            :
         BNEZ     MPRSVC,R1         IF WE HAVE A BUFFER TO PARSE
PRS0     EQU      %                 CONTINUE PARSING
         LI,R15   HPB               :
         BAL,R11  BSC%GB            OTHERWISE TRY TO GET A BUFFER TO
         BEZ      BSC%PO            PARSE -- IF NONE EXIT --IF THERE IS
         STW,R2   CPB,R6            ONE REMEMBER IN CPB GET BA IN 2 AND
         SLS,R2   2                 POP AND GO TO APPROPRIATE BEGINNING
         AI,R2    4                 OF PARSER.
         STW,R2   POP,R6
         B        PRSVC,R1
**************************************************
BSC%PEA  EQU      %                 SETUP INPUT PSEUDO END ACTION
         LW,R14   IOQ8,R5           :
         LW,R15   FCKPTR            IF THIS WAS A FIN COMMAND SET IGBIT
         CBS,R14  0                 AND GO TO APPROPRIATE (APP) PARSE
         BNE      PRSEA2            EOF PROCESS
         LW,R1    IGBIT             :
         STS,R1   RB:FLAG,R7        OTHERWISE CALC RBC AND GO TO ENDAC
         LW,R1    TTYP,R6           :
         B        PEOFVC,R1         AFTER ENDAC GET CORRECT POP INTO 2
PRSEA2   EQU      %                 AND GO TO APP CONTINUE PARSING
         STW,R2   POP,R6            ROUTINE
         LH,R12   IOQ9,R5
         SW,R3    IOQ8,R5
         SW,R12   R3
         BAL,R8   ENDAC
BSC%PE1  EQU      %
         MTW,1    POP,R6
         LW,R2    POP,R6
         LW,R1    TTYP,R6
         B        MPRSVC,R1
****************************************************
BSC%EOB  EQU      %                 END OF BUFFER PARSE
         LI,R2    0                 :
         STW,R2   POP,R6            CLEAR POP AND CPB
         XW,R2    CPB,R6            :
         LI,R15   HRB               CHAIN BUFFER BACK TO READ
         LI,R11   PRS0              BUFFERS AND TRY TO PARSE
         LW,R1    TTYP,R6           ANOTHER ONE
         B        BSC%FB
******************************************************
IUCK     EQU      %                 RE-ENTRANCY PREVENTING ROUTINE
         LW,R6    JIT               :
         BNEZ     *R11              NONE OF THIS CAN RUN MAPPED (IOQ CAN)
         LW,R6    RB:BUF,R7         :
         WD,0     X'37'             EXIT WITH 6=RB:BUF AND 1=TTYP
         LW,R15   CIP,R6            :
         BNEZ     ENBSR4            ON INPUT R15 HAS DISP OF LOCK
         LW,R15   *R14,R6           WORD IF THIS FUNCTION OR THE
         BNEZ     ENBSR4            CONTROL FUNCTION IS IN PROG
         STW,R11  *R14,R6           WE EXIT -- OTHERWISE THE LOCK IS
         WD,0     X'27'             SET AND WE CONTINUE
         LW,R1    TTYP,R6
         B        *R10
******************************************************
***************************************************
BSC%GB   EQU      %                 GET A BUFFER
         WD,0     X'37'             :
         LW,R2    *R15,R6           LI,15 APPHEAD
         BEZ      GBOUT             BAL,11 BSC%GB
         LW,R0    *R2               BEZ   NO BUFFERS
         STW,R0   *R15,R6           ***BUF ADDR IN 2
GBOUT    WD,0     X'27'
         AI,R2    0
         B        *R11
BSC%FB   EQU      %                 FREE A BUFFER
         WD,0     X'37'             :
         LW,R0    *R15,R6           LI,15 APPHEAD
         STW,R2   *R0               BAL,11 BSC%FB
         STW,R0   *R15,R6           ***BUFFER IS FREE
         LI,R0    0
         STW,R0   *R2
         B        ENBSR4
**************************************************
BSC%BLD  EQU      %                 COMMON BUILDING ENTRY
         LI,R14   BIP               :
         BAL,R10  IUCK              IF ALREADY BUILDING EXIT
BSC%BL0  EQU      %                 :
         EXU      2BTST,R1          IF THIS IS THE SECOND BUFFER
         AW,R3    SAB,R6            AND WE ARENT SUPPOSED TO BUILD
         BNEZ     BSC%BO1           MORE THAN ONE OR SOMEONE IS
         LW,R3    POB,R6            WAITING (USUALLY CONTROL) FOR
         BNEZ     MBLDVC,R1         BUILD TO FINISH --EXIT
         LW,R2    CBB,R6            :
         BNEZ     BLD01             IF WE HAVE A BUFFER PARTIALLY
         LI,R15   HBB               BUILT GO TO THE APP CONTINUE
         BAL,R11  BSC%GB            BUILDING PROCESS
         BEZ      BSC%BO1           :
         STW,R2   CBB,R6            IF WE HAVE A BUFFER BUT ITS
BLD01    EQU      %                 EMPTY DONT GET ANOTHER
         AI,R2    2                 :
         LW,R3    R2                IF WE NEED ONE GET ONE
         SLS,R3   2                 NONE? -- EXIT
         LI,R15   0                 :
         STW,R15  CCRC,R6           PUT BUF IN CBB (BUT NOT YET
         LI,R15   -%RBC             POB) AND BA IN 3 -- SET UP
         STW,R15  RBC,R6            CCRC AND RBC AND GO TO APP
         B        BLDVC,R1          BUILD STARTING ROUTINE
*************************************************
BSC%BO   EQU      %                 EXIT OF BUILD ROUTINES
BSC%BO1  LI,R14   BIP
         B        BSC%GO
BSC%BC   EQU      %                 CLOSE COMPLETED BLOCK
BLDCLS1  WD,0     X'27'             :
         LW,R9    POB,R6            CALCULATE SIZE OF BLOCK INTO 9
         LW,R15   CBB,R6            :
         SLS,R15  2                 CLEAR CELLS DEPENDENT ON THIS BLOCK
         SW,R9    R15               :
         AI,R9    -3                IF WE REALLY DIDNT GET ANY DATA IN
         LI,R3    0                 EXIT
         STW,R3   CURF,R6           :
         STW,R3   FBF,R6            IF ITS IRBT THERE IS EXTRA STUFF
         XW,R3    POB,R6            TO DO IN HASPIO
         CI,R9    10                :
         BLE      BSC%BO1           PUT A PAD ON THE END -- PUT
         LW,R1    TTYP,R6           THE BUFFER ON THE WRITE CHAIN --
         BEZ      H%BCLS            INCREMENT THE IRBT BCB COUNT --
BSC%BCX  EQU      %                 CLEAR CBB -- PUT THE BC IN THE FRONT
         LI,R2    PAD               OF THE BLOCK FOR THE HANDLER--
         STB,R2   0,R3              AND TRY TO BUILD ANOTHER BLOCK
         LI,R2    0
         LI,R15   HWB
         LI,R11   BSC%BL0
         WD,0     X'37'
         MTW,1    CBCB,R6
         XW,R2    CBB,R6
         STW,R9   1,R2
         B        BSC%FB
*******************************************************
BSCDIO   EQU      %                 DO REAL I/O
         LI,R15   0                 :
         STW,R15  FBF,R6            SET UP NEWQ REGS BUF ALREADY
         STW,R15  BKD,R6            IN 13 AND BC IN 14 ENDAC IS
         LI,R0    ML%CTL            ML%CTL -- CONTROL CALLER IS SAVED
         SCS,R12  -8                IN STACK AND CONTROL LOCK IS
         AND,R7   M8                CLEARED AFTER GOING TO NEWQ
         OR,R12   PRINRT
         OR,R12   R7
         LW,R11   CIP,R6
         PSW,R11  TSTACK
         BAL,R11  NEWQ
         NOP
         LI,R11   0
         STW,R11  CIP,R6
         B        *R10
**************************************************
FORCWR   EQU      %                 TRY TO FORCE A BUFFER FULL
         STW,R12  CFC,R6            TO GET SOME DATA TO WRITE
         MTW,1    FBF,R6            :
         LW,R1    TTYP,R6           SET THE FORCE FULL FLAG
         LI,R11   FORCWR1           :
         XW,R11   BIP,R6            IF WE ARE NOT BUILDING NOW
         BEZ      BSC%BL0           OFF TO BUILD
         XW,R11   CIP,R6            :
         B        *R11              IF WE ARE BUILDING FIX IT SO THAT
FORCWR1  EQU      %                 BUILD EXITS TO US -- CONTROL
         LW,R12   CFC,R6            EXITS TO THE GUY WHO CALLED BUILD
         LW,R1    TTYP,R6           AND TAKE THE CONTROL EXIT NOW
         LW,R11   HWB,R6            :
         BNEZ     FWW,R1            GO TO SUCCESS OR FAILURE ROUTINE
FORCWR2  EQU      %                 BASED ON WHETHER WE GOT SOME DATA
         LI,R12   NWFCN             OR NOT
         B        FWN,R1
***********************************************
ML%CTL   EQU      %                 END ACTION FOR REAL LINE I/O
         LW,R6    RB:BUF,R7         :
         STW,R11  CIP,R6            SET UP 6,1 AND THE CONTROL LOCK
         LW,R1    TTYP,R6           :
         LB,R3    R12               IF WE GOT HUNG UP GO TO THE HANGUP
         CI,R3    HUTYC             ROUTINE
         BE       HANGUP            :
         STW,R3   LTYC,R6           FREE THE CWB IF ANY AND GO TO
         LI,R2    0                 THE APP CONTROL ROUTINE
         XW,R2    CWB,R6
         BEZ      CTLVEC,R1
         AI,R2    -1
         LI,R15   HBB
         ANLZ,R11 CTLVEC,R1
         B        BSC%FB
**********************************************
BSC%LGN  EQU      %                 TELL RBBAT ABOUT TERM LOGON REC RCVD
         LI,R12   LORR              :
         LW,R14   IOQ8,R3           WHEN DONE ZAP RMB ENDACTION
         SLS,R14  -2
         BAL,R0   TEL%RBBAT
         LI,R12   0
         STD,R12  IOQ13,R3
         B        0,R5
TEL%RBBAT EQU     %                 CALL RBBAT FROM HANDLER
         BAL,R4   RBSGCQP           :
         LI,R0    BSC%FL            IF NO BUFFS FOLLOWON
         PLW,R1   TSTACK
         B        *R0
**************************************************
RPT%ORG  EQU      %                 REPEAT CALLING FUNCTION
         LB,R5    IOQ4,R3
NEW%FLO  EQU      %                 START NEW FC IN R5
         STH,R5   DCT17,R1
         B        BSC%FL
****************************************************
BSC%GN   EQU      %                 LINE H.U. IN HANDLER
         LW,R5    HUBIT             :
         STS,R5   RB:FLAG,1         SET HUBIT
         OR,R13   HUBIT             :
         LI,R12   HUP               TELL RBBAT
         BAL,R0   TEL%RBBAT         :
         LI,R12    HUTYC            TELL ML%CTL
         B        BSC%PX1
BSC%HO   EQU      %                 HANG UP ROUTINE EXIT
         LW,R11   HIP,R6
         B        *R11
*****************************************************
BSC%PO   EQU      %                 PARSING ROUTINE EXIT
         LI,R14   PIP
BSC%GO   EQU      %                 GENERAL EXIT ROUTINE
         LI,R11   0                 :
         XW,R11   *R14,R6           CLEAR THE LOCK POINTED TO
         LW,R1    HUBIT             BY R14
         CW,R1    RB:FLAG,R7        :
         BAZ      ENBSR4            IF WE WERE HUNG UP THE LAST
         LW,R1    BIP,R6            INTERRUPT LEVEL (OUT OF A POSS-
         AW,R1    PIP,R6            IBLE 3) TO EXIT DRIVES INTO
         AW,R1    HIP,R6            THE APP HANGUP ROUTINE IF WE
         BNEZ     ENBSR4            ARENT ALREADY THERE
         STW,R11  HIP,R6
         LW,R1    TTYP,R6
         B        HUVEC,R1
*******************************************************
HANGUP   EQU      %                 H.U. REPORTED TO ML%CTL
         STW,R11  SAB,R6            :
         LI,R14   CIP               STOP BUILD AND EXIT - BSC%GO
         B        BSC%GO            WILL FINISH VIA HUBIT
*****************************************************
BSC%DSC  EQU      %                 IDLE: DISC IF DISCBIT SET
         LI,R11   DISCBIT+RBXBIT    :
         CW,R11   RB:FLAG,R7        EXITS SKIPPING IF NOT
         BAZ      1,R1
         STS,R11  RB:FLAG,R7
         B        0,R1
*******************************************************
*VECTORS TO CALL PROCESSES BY TYPE OF TERMINAL
*TO ADD A NEW ONE PICK A NEW VALUE (2 IS NEXT)
*FOR TTYP AND PUT AN APPROPRIATE INSTRUCTION
*IN EACH VECTOR  -- SMK
MPRSVC   B        H%PRS2            CONTINUE PARSING
         B        27P2              *
PRSVC    B        H%PRS1            BEGIN PARSING
         B        27P               *
PEOFVC   B        H%PEOF            PARSE EOF FOUND
         B        27PEF             *
2BTST    LW,R3    HWB,R6            TEST FOR SECOND BUFF LEGAL
         LW,R3    EOF,R6            *
MBLDVC   B        H%BLD3            CONTINUE BUILDING
         B        27BG              *
BLDVC    B        H%BLD             BEGIN BUILDING
         B        27B               *
FWN      B        H%CTL4            FORCE WRITE FAILED
         B        27DIO1            *
FWW      B        H%CTL3            FORCE WRITE WORKED
         B        27WRT             *
CTLVEC   B        H%CTL             CONTROL ENTRY
         B        27CTL             *
HUVEC    B        H%HU              HUNG UP ENTRY
         B        27HU
         END

