COCG     EQU      %
************************************************************************
*
*
*M*      COCG     7611 CHARACTER ORIENTED COMMUNICATION HANDLER (GHOST)
*
*
************************************************************************
*P*  NAME:    COCG
*P*  PURPOSE: TO PROVIDE THE COC INITIALIZATION FUNCTIONS UNIQUE
*P*           TO A 7611 CHARACTER ORIENTED COMMUNICATIONS DEVICE.
************************************************************************
 TITLE 'C O C G   -   C O M M E N T A R Y   S Y M B O L S'
**************************************************************************
*
*  COMMENTARY PREFIXES:
*
*  SYMBOL         MEANING
*
*  L/             'LOAD'
*  S/             'STORE'
*  X/             'EXCHANGE'
*  XVALUE         'MULTIPLY BY (VALUE)'
*  &              'AND' (LOGICAL OPERATION)
*  G/             'GET'
*  C/             'COMPARE'
*  W/             'WITH'
*  B/             'BRANCH IF' OR 'BRANCH AND'
*  0/             'ZERO (CLEAR)' OR 'IF ZERO, THEN'
*  NZ/            'IF NON-ZERO, THEN'
*  +              'ADD' OR 'IF POSITIVE, THEN'
*  -              'SUBTRACT' OR 'IF NEGATIVE, THEN'
*  M/             'MULTIPLY BY' OR 'MOVE'
*  /              'DIVIDE' OR 'DIVIDE BY'
*  LJ/            'LEFT JUSTIFY'
*  RJ/            'RIGHT JUSTIFY'
*  MNEMONIC       LITERAL
*  VALUE/         'IF (VALUE), THEN'
*
**************************************************************************
 TITLE 'C O C G   -   C O M M A N D   D E F I N I T I O N S'
         SYSTEM   UTS
         SYSTEM   BPM
,BPM0,BPM1 M:PT   1                 PUT SYSTEM BPM FPTS IN PT 1
*
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
*
INHIBIT  COM,32   X'6D000037'       INHIBIT
UNINHIBIT COM,32  X'6D000027'       RESET INHIBITS
CC       FNAME                      DEFINE CONDITION CODE
         PROC
         ERROR,3,AF(1)<5|AF(1)>8 'AF OUT OF RANGE'
         PEND     1**(AF(1)-5)
AC       FNAME                      DEFINE ABSOLUTE CONSTANT
         PROC
         ERROR,3,AF(1)<1|AF(1)>32 'AF OUT OF RANGE'
         PEND     1**(AF(1)-1)
LC       FNAME                      DEFINE LITERAL CONSTANT
         PROC
         ERROR,3,AF(1)<1|AF(1)>32 'AF OUT OF RANGE'
         PEND     BT31TO0+AF(1)
NLC      FNAME                      DEFINE .NOT. LITERAL CONSTANT
         PROC
         ERROR,3,AF(1)<1|AF(1)>32 'AF OUT OF RANGE'
         PEND     NB31TO0+AF(1)
*
*  THE FOLLOWING PROCS ARE USED FOR FORMATTING MESSAGES, AND ARE
*  A SUBSET OF P:SYSTEM.X
*
         LIST     0
         OPEN     CHEX,FCHEX,FLPTBL,FSBNHX,I,IAF,IIAF,LBL,LOAD,LPTBL,;
         MOVE,N,P,PLOC,Q,SBNHX,SECT,STORE,TCBTD,TSZ,TX,T0,T1,VT,%FIN,;
         %FIN3,%PEND,#BA,#WA,#X1,#X2,#X3,#1,#1U1,#4
IAF      EQU      'P:SYSTEM:  ILLEGAL AF'
IIAF     EQU      'P:SYSTEM:  ILLEGAL INDIRECT AF'
#X1      SET      1                 INDEX
#X2      SET      2                 INDEX
#X3      SET      3                 ODD INDEX
#4       SET      11                ANY
#1       SET      12                EVEN
#1U1     SET      13                #1U1 (#1+1)
FCHEX,FLPTBL,FSBNHX SET 0
T0       SET      1
T1       SET      2
P:PT0    CSECT    0
SECT(T0) SET      %
P:PT1    CSECT    1
SECT(T1) SET      %
         USECT    COCG
*  CHANGE CONTROL SECTIONS.
P:TOSECT CNAME
         PROC
LF       SET      %
         ORG      AF
         PEND
*  RETURN AF POINTED TO BY AF(1)+2.
P:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
*  RETURN AF(1), SET AF(1) TO AF(2) OR 1 IF NO AF(2).
P:FLAG   FNAME
         PROC
%FIN     SET      AF(1)
AF(1)    SET      AF(2)+(NUM(AF)=1)
         PEND     %FIN
P:DISP   CNAME
         PROC
         LOCAL    TCWA
TCBTD,%FIN3  SET  1
LF(1)    EQU      %
TX       SET
N        WHILE    N<NUM(AF)
         DO       TCOR(S:C,AF(N))=1
TX       SET      TX,AF(N)
TCBTD    SET      TCBTD+S:NUMC(AF(N))
         ELSE
         DO       SCOR(AF(N,1),NOPRINT)
%FIN3    SET      0
         ELSE
         CONV,TCWA    AF(N)
         FIN
         FIN
         FIN
         DO       %FIN3>0
,,(TCWA,LF(2))     P:PRINT,0    S:PT(TX)
         ELSE
PLOC     P:TOSECT SECT(1)
TCWA,LF(2) TEXTC  S:PT(TX)
SECT(1)  P:TOSECT PLOC
         FIN
         PEND
CONV     CNAME
         PROC
Q  SET S:KEYS(2,20,LZ,*24,BUF,BTD,*SIZE,27,HEX,DEC,X,HEXX,*31,TRNSLT)
   ERROR,3,(Q(2)&X'C0')=0|(Q(2)&X'1F')=0    IAF,': AF(',P:BD(N),')'
   ERROR,3,AFA(Q(3),2)|AFA(Q(4),2)|AFA(Q(5),2)|AFA(Q(5),3)         ;
                  IIAF,': AF(',P:BD(N),')'
         GOTO,(Q(2)&X'12')=0    LBL
TSZ      SET      P:S(NUM(AF(Q(5)))=3,AF(Q(5),2)*2,AF(Q(5),3))
TX       SET    TX,P:S(Q(2)&2,P:BLANKS(TSZ),,('X''',P:BLANKS(TSZ),''''))
         P:BINHEX (BTD,TCBTD+(Q(2)&2)),(SIZE,TSZ),;
         (BUF,CF(2)),(SUB),(BIN,#BA(AF(Q(3),2))+AF(Q(4),2))
TCBTD    SET      TCBTD+3*((Q(2)&2)>0)+TSZ
         GOTO     %PEND
LBL      DO       (Q(2)&8)>0
         DO1      (#1U1=AF(Q(3),2)&(Q(2)&X'40')=0)=0
         LOAD     #1U1,(AF(Q(5),2),WA(AF(Q(3),2))+#WA(AF(Q(4),2)),;
                  #BA(AF(Q(3),2))+BA(AF(Q(4),2))),AF(Q(5),2)
TSZ      SET  P:S(NUM(AF(Q(5)))=3,P:S(AF(Q(5),2),3,3,5,8,10),AF(Q(5),3))
         DO       TSZ>1&(Q(2)&X'800')=0
         LW,1     SECT(T1)
         MBS,0    BA(=X'00405C00')+1
PLOC     P:TOSECT SECT(T1)
         GEN,8,24 TSZ-1,BA(CF(2))+TCBTD
SECT(T1) P:TOSECT PLOC
         FIN
         DO       (Q(2)&X'800')>0
         P:BINDEC (BIN,#1U1),(BUF,CF(2)),(BTD,TCBTD),(SIZE,TSZ),(LZ)
         ELSE
         P:BINDEC (BIN,#1U1),(BUF,CF(2)),(BTD,TCBTD),(SIZE,TSZ)
         FIN
TCBTD    SET      TCBTD+TSZ
         ELSE
         LW,#1U1  SECT(T1)
         MBS,#1U1 #BA(AF(Q(3),2))+AF(Q(4),2)-BA(CF(2))-TCBTD
         GOTO,(Q(2)&1)=0    PLOC
         LW,1     SECT(T1)
         TBS,0    P:S(NUM(AF(Q(6)))=1,AF(Q(6),2),LPTBL)
PLOC     P:TOSECT SECT(T1)
         GEN,8,24 AF(Q(5),2),BA(CF(2))+TCBTD
         GOTO,P:S(NUM(AF(Q(6)))=1,1,P:FLAG(FLPTBL))|(Q(2)&4)>0 LBL
LPTBL    EQU      %
 TEXT '..............................................................',;
   '.. ...........<(+|&.........|%*);.-/.........,%.>...........:#@''=.'
 TEXT '................................................................'
 TEXT '.ABCDEFGHI.......JKLMNOPQR........STUVWXYZ......0123456789......'
LBL,SECT(T1) P:TOSECT PLOC
TCBTD    SET      TCBTD+AF(Q(5),2)
         FIN
TX       SET      TX,P:BLANKS(P:S((Q(2)&5)>0,TSZ,AF(Q(5),2)))
%PEND    PEND
#BA      FNAME
         PROC
         PEND     P:S(TCOR(AF,1),BA(AF),4*AF)
#WA      FNAME
         PROC
         PEND     P:S(TCOR(AF,1),WA(AF),AF/4)
LOAD     CNAME    2
STORE    CNAME    5
MOVE     CNAME    0
         PROC
   ERROR,3,NAME>0&AF(3)>4    'P:SYSTEM:  FIELD LENGTH > 4: AF(',P:BD(I),')'
         DO       (NAME>0|(ABSVAL(AF(1,3))&3)=0)&(ABSVAL(AF(2,3))&3)=0;
                  &(AF(3)=1|AF(3)=2|AF(3)=4)
J        DO       NAME=0
         GEN,4,4,4,20,4,4,4,20    7-(AF(3)&6),2,#X3,AF(1,2),;
                                  7-(AF(3)&6),5,#X3,AF(2,2)
         ELSE
         GEN,4,4,4,20  7-(AF(3)&6),NAME,AF(1),AF(2,2)
         FIN
         ELSE
         DO1      NAME=2&AF(3)<4
         LI,AF(1) 0
  LW,#X3   =AF(3)**24+P:S(NAME**-1,AF(2,3),AF(1)*4+4-AF(3),AF(2,3))
         MBS,#X3  P:S(NAME**-1,AF(1,3),AF(2,3),AF(1)*4+4-AF(3))-;
                  P:S(NAME**-1,AF(2,3),AF(1)*4+4-AF(3),AF(2,3))
         FIN
         PEND
*  IMMEDIATE OPERAND IF AF ISN'T INDIRECT, ELSE WORD ADDRESS OPERAND.
*  NOTHING GENERATED IF INDIRECT TO SAME REGISTER
*        P:LI,REG AF
P:LI     CNAME    X'22'
         PROC
LF       DO1      P:S(TCOR(AF(1),1),0,(CF(2)=AF(1)&NAME=X'22'&AFA(1)))=0
         GEN,8,4,20    NAME+AFA(1)*X'10',CF(2),AF(1)
         PEND
*  LOAD WORD UNLESS LW,X  X OR STW,X  X; THEN NOTHING.
P:LW     CNAME    X'32'
         PROC
LF       DO1      AFA(1)|(CF(2)=AF(1))=0
         GEN,1,7,4,20    AFA(1),NAME,CF(2),AF(1)
         PEND
P:BD     FNAME    '0','1','2','3','4','5','6','7','8','9'
         PROC
         PEND     S:PT(P:S(AF>9,,P:BD(AF/10)),NAME(AF-AF/10*10+1))
P:BLANKS FNAME
         PROC
%FIN     SET      ' '
         DO1      AF(1)-1
%FIN     SET      %FIN,' '
         PEND     S:PT(%FIN)
*  GENERATE CAL1,2, FPT, AND TEXTC.
P:MESSAGE CNAME   0
P:PRINT  CNAME    1
P:TYPE   CNAME    2
         PROC
         DO       NAME=1
         DO1      TCOR(M:LL,S:FR)
         REF      M:LL
         ELSE
         DO1      TCOR(M:OC,S:FR)
         REF      M:OC
         FIN
LF(1)    CAL1,2   SECT(T1)
PLOC     P:TOSECT SECT(T1)
VT       SET      P:S(NUM(CF)=2,T1,(CF(2)=1)+1)
LF(2)    GEN,8,25,63    NAME,1,SECT(VT)+3*(VT=T1)
SECT(T1) P:TOSECT SECT(VT)
LF(3)    TEXTC    AF
SECT(VT) P:TOSECT PLOC
         PEND
*  CONVERT SINGLE-PRECISION BINARY TO EBCDIC INTEGER.
P:BINDEC CNAME
         PROC
P        SET      S:KEYS(2,*27,*BIN,BUF,BTD,*SIZE,31,(LZ,NOLZ))
         LOCAL    I
LF       P:LW,#1U1    AF(P(3),2)
         LI,#4    AF(P(6),2)
         LI,#X1   BA(AF(P(5),2))+AF(P(6),2)-1
I        LI,#1    0
         DW,#1    =10
         AI,#1    '0'
         STB,#1   AF(P(4),2),#X1
         DO       (P(2)&1)=0
         CI,#1U1  0
         BEZ      %+3
         FIN
         AI,#X1   -1
         BDR,#4   I
         PEND
*  CONVERT SINGLE-PRECISION BINARY TO EBCDIC HEX.
*        P:BINHEX (BIN,ADDR),(BUF,ADDR),(BTD,VALUE),(SIZE,VALUE)
P:BINHEX CNAME
         PROC
P        SET      S:KEYS(2,*25,*BIN,BUF,BTD,*SIZE,30,SUB,(NOLZ,LZ))
    DO       AF(P(6),2)>8|AFA(P(6),2)|(P(2)&2)>0|AFA(P(4),2)|AFA(P(5),2)
LF       P:LI,#X1 BA(AF(P(3),2))
         DO       AFA(P(4),2)|AFA(P(5),2)
%FIN     SET      2
         DO       (P(2)&X'20')>0
%FIN     SET      0
         DO       AFA(P(4),2)
         LW,#X2   AF(P(4),2)
         SLS,#X2  2
         ELSE
         LI,#X2   BA(AF(P(4),2))
         FIN
         FIN
         DO1      (P(2)&X'10')>0
         GEN,4,4,4,20    2+AFA(P(5),2),%FIN,#X2,WA(AF(P(5),2))
         ELSE
         LI,#X2   BA(AF(P(4),2))+BA(AF(P(5),2))
         FIN
         P:LI,#4  AF(P(6),2)
         BAL,#1   SBNHX+7*(AFA(P(6),2)=0&AF(P(6),2))
         GOTO,P:FLAG(FSBNHX)    %FIN
PLOC     P:TOSECT SECT(T1)
         AI,#X1   1
         AI,#X2   1
SBNHX    LB,#X3   0,#X1
         SLS,#X3  -4
         LB,#X3   CHEX,#X3
         STB,#X3  0,#X2
         BDR,#4   %+2
         B        *#1
         AI,#X2   1
         LB,#X3   0,#X1
         AND,#X3  =X'F'
         LB,#X3   CHEX,#X3
         STB,#X3  0,#X2
         BDR,#4   SBNHX-2
         B        *#1
SECT(T1) P:TOSECT PLOC
         ELSE
         LOCAL    I
LF       P:LW,#1U1    AF(P(3),2)
         LI,#4    AF(P(6),2)
         LI,#X1   BA(AF(P(5),2))+AF(P(6),2)-1
I        LW,#X3   #1U1
         AND,#X3  =X'F'
         LB,#X3   CHEX,#X3
         STB,#X3  AF(P(4),2),#X1
         AI,#X1   -1
         SLS,#1U1 -4
         DO       P(2)&1
         LW,#X3   #1U1
         BEZ      %+2
         FIN
         BDR,#4   I+(P(2)&1)
%FIN     FIN
         GOTO,P:FLAG(FCHEX)    %PEND
PLOC     P:TOSECT SECT(T1)
CHEX     TEXT     '0123456789ABCDEF'
SECT(T1) P:TOSECT PLOC
%PEND    PEND
         CLOSE    CHEX,FCHEX,FLPTBL,FSBNHX,I,IAF,IIAF,LBL,LOAD,LPTBL,;
         MOVE,N,P,PLOC,Q,SBNHX,SECT,STORE,TCBTD,TSZ,TX,T0,T1,VT,%FIN,;
         %FIN3,%PEND,#BA,#WA,#X1,#X2,#X3,#1,#1U1,#4
         LIST     1
 TITLE 'C O C G   -   S Y M B O L I C   C O N S T A N T S'
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
CX       EQU      5                 COC INDEX
R6       EQU      6
R7       EQU      7                 COC INDEX
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
#PASSES  EQU      104/2             # OF PASSES IN TRANSMITTER STATUS
*                                   .. CHECKING LOOP
TXBELL   EQU      ' '               BELL CHARACTER
TXCR     EQU      '
'               CARRIAGE RETURN CARACTER
*
*  THE FOLLOWING ARE USED WITH THE AC, LC, AND NLC PROCS TO CHECK AND
*  MODIFY BITS IN COCGFLG
*
G1RCVRY  EQU      16                GHOST1 CALLING; RECOVERY
G1BOOT   EQU      15                GHOST1 CALLING; BOOT
OUMI     EQU      13                ONLINE USER MAX INCREASED
CSE      EQU      12                CSECOM INIT REQUEST
CLK3     EQU      10                CLOCK3 DIRECTLY CALLING
PFSR     EQU      9                 POWER FAILSAFE DIRECTLY CALLING
*
*  THE FOLLOWING ARE USED WITH THE AC, LC, AND NLC PROCS TO CHECK
*  BITS IN COCEFLG
*
AUTO     EQU      1                 AUTOMATIC CONFIGURATION
         PAGE
*
*  MODE6 TABLE BIT DEFINITIONS
*
*  THE FOLLOWING SYMBOLIC DEFINITIONS ARE USED TO SET, RESET, AND CHECK
*  MODE6 PARAMETERS VIA THE CC, AC, LC, AND NLC PROCS.
*
HD       EQU      8                 HALF-DUPLEX LINE
HDIN     EQU      7                 HALF-DUPLEX LINE IN INPUT MODE
UTO      EQU      6                 READ WITH USER-CONTROLLED TIME-OUT
HLT      EQU      5                 HALT OUTPUT INTERRUPT PROCESSING
HDTA     EQU      4                 HALF-DUPLEX LINE TO BE TURNED AROUND
HDTA2    EQU      3                 HALF-DUPLEX LINE IN SECOND PHASE
*                                   .. OF TURN-AROUND
HW       EQU      1                 HARDWIRED LINE
 TITLE 'C O C G   -   R E F S'
         REF      BT31TO0           BITS
         REF      C:TINC            CLOCK3 COUNTER CELL
         REF      CO:AIL            ALL COC INTERRUPT LEVEL SELECT BITS
         REF      CO:CMND           DA(COC COMMAND DOUBLEWORD)
         REF      CO:HIIL           HIGHEST INPUT INTERRUPT LEVEL SELECT BIT
         REF      CO:IIL            INPUT INTERRUPT LEVEL
         REF      CO:LST            POINTER TO NEXT CHAR IN RING BUF
         REF      CO:OIL            OUTPUT INTERRUPT LEVEL SELECT BITS
         REF      CO:RCVDOFF        WD: TURN RECEIVER DATASET OFF
         REF      CO:RCVON          WD: TURN RECEIVER ON
         REF      CO:STAT           FOR 'SYSTEM IS UP' MESSAGE
         REF      CO:TSTAT          WD: SENSE TRANSMITTER STATUS
         REF      CO:XDATA          WD: TRANSMIT DATA
         REF      CO:XPSDI          INPUT INT XPSD INST
         REF      CO:XPSDO          OUTPUT INT XPSD INST
         REF      COA:IG            COC INTERRUPT GROUP NUMBER
         REF      COB:MNIC          FOR 'SYSTEM IS UP' MESSAGE
         REF      COB:SIOS          LAST SIO CONDITION CODES
         REF      COCTERM           FOR 'SYSTEM IS UP' MESSAGE
         REF      COCEFLG           COC EXECUTION OPTION FLAGS
         REF      COCENABL          ENABLE COC INTERRUPTS
         REF      COCGFLG           COC GHOST FLAGS
         REF      COCPHYLN          FOR 'SYSTEM IS UP' MESSAGE
         REF      COCSENDX          FOR 'SYSTEM IS UP' MESSAGE
         REF      COD:LPC           LIMITS OF LINE NUMBERS
         REF      COCDSABL          DISABLE COC INTERRUPTS
         REF      COCOTV            FOR 'SYSTEM IS UP' MESSAGE
         REF      COH:DN            COC DEVICE ADDRESS
         REF      COH:II            INPUT INTERRUPT LOC
         REF      COH:IO            OUTPUT INTERRUPT LOC
         REF      COH:RBS           RING BUFFER SIZE
         REF      CPOS              FOR 'SYSTEM IS UP' MESSAGE
         REF      J:JIT             JOB TYPE FLAGS
         REF      LB:UN             CHECK FOR USER ASSOCIATED
         REF      LCOC              LAST COC INDEX
         REF      LNOL              FOR 'SYSTEM IS UP' MESSAGE
         REF      MASKS             MASKS
         REF      MODE2             SET/RESET 2741 FLAG
         REF      MODE4INIT         AUTO CONFIGURE ALGORITHM/SPEED
         REF      MODE6             HALF-DUPLEX STATUS
         REF      NB31TO0           MASKS
         REF      QUEUE             FOR VALIDATING M:SYS/MONSTK ADR'S
         REF      S:OUIS            FOR 'SYSTEM IS UP' MESSAGE
         REF      S:OUAIS           FOR 'SYSTEM IS UP' MESSAGE
         REF      SITEID            FOR COC AUTO CONFIG TITLE
         SREF     T:TURNOUT         FOR 'SYSTEM IS UP' MESSAGE
 TITLE 'C O C G   -   D E F S'
         DEF      COCG              BASE OF COCG MODULE
         DEF      P:PT0             BASE OF P: PROCS DATA
         DEF      P:PT1             BASE OF P: PROCS PROCEDURE
         DEF      BPM0              BASE OF M: PROCS DATA
         DEF      BPM1              BASE OF M: PROCS PROCEDURE
         DEF      SNAP              PATCH IN NOP TO GET SNAP OF COUNT TABLE
         DEF      ALGO110           DEFAULT ALGORITHM FOR 110 BAUD
         DEF      ALGO150           DEFAULT ALGORITHM FOR 150 BAUD
         DEF      ALGO300           DEFAULT ALGORITHM FOR 300 BAUD
         DEF      ALGO600           DEFAULT ALGORITHM FOR 600 BAUD
         DEF      ALGO1200          DEFAULT ALGORITHM FOR 1200 BAUD
         DEF      ALGO2400          DEFAULT ALGORITHM FOR 2400 BAUD
         DEF      ALGO4800          DEFAULT ALGORITHM FOR 4800 BAUD
         DEF      ALGO2741          DEFAULT ALGORITHM FOR 2741
         DEF      NOTAFLG           PATCH NON-ZERO TO SKIP TURNAROUND
*,*                                 CHECKING IN COC INITIALIZATION
PATCH    DSECT    0                 PATCH AREA
         RES      200
         USECT    COCG
 TITLE 'C O C G   -   D Y N A M I C   D A T A'
         BOUND    8
COUNT    RES,1    64                COUNT OF 2-MS INTERVALS BEFORE
*                                   .. TRANSMISSION WAS COMPLETE
LPLN     DO1      16                LAST PHYSICAL LINE #, INDEXED BY COC
         DATA
HPCX     DATA                       HIGHEST PRIORITY COC INDEX
DUMMY    DATA                       FOR INST TIMING PURPOSES
CLOCK    DATA                       COUNTER THAT TRACKS C:TINC
TAFLG    DATA     0                 -/TURNAROUND RESET HAS BEEN PERFORMED
TCOCGFLG DATA                       TEMP (SAVED) COCGFLG
TCTITLE  TEXTC    '1 C O C   A U T O M A T I C   ',;
                  'C O N F I G U R A T I O N',P:BLANKS(8*4)
TXSITEID EQU      %-7               ADR OF SITEID TEXT IN ABOVE MESSAGE
TXDATE   EQU      %-4               ADR OF DATE IN ABOVE MESSAGE
 TITLE 'C O C G   -   S T A T I C   D A T A'
         BOUND    8
COCLIMS  DATA     LCOC+1,0          # OF COC'S, 0
TICSTYPE DATA,1                     DUMMY ENTRY
         DATA,1   97/2              110
         DATA,1   75/2              150
         DATA,1   45/2              300
         DATA,1   22/2              600
         DATA,1   11/2              1200
         DATA,1   6/2               2400
         DATA,1   3/2               4800
#TYPES   EQU      BA(%)-BA(TICSTYPE)-1  # OF TICSTYPES
         BOUND    4
ALGOTAB  DATA                       DUMMY ENTRY
ALGO110  DATA     5                 110 BAUD
ALGO150  DATA     5                 150 BAUD
ALGO300  DATA     5                 300 BAUD
ALGO600  DATA     5                 600 BAUD
ALGO1200 DATA     0                 1200 BAUD
ALGO2400 DATA     0                 2400 BAUD
ALGO4800 DATA     0                 4800 BAUD
ALGO2741 DATA     1                 2741
TXBAUD   DATA     ' 110'
         DATA     ' 150'
         DATA     ' 300'
         DATA     ' 600'
         DATA     '1200'
         DATA     '2400'
         DATA     '4800'
         DATA     '9600'
         DATA     ' 134'
TXFORMAT DATA     '8/11'
         DATA     '8/10'
         DATA     '8/10'
         DATA     '8/10'
         DATA     '8/10'
         DATA     '8/10'
         DATA     '8/10'
         DATA     '8/10'
         DATA     '7/9 '
M4LS     DATA,1                     DUMMY ENTRY
         DATA,1   0                 110 BAUD
         DATA,1   1                 150 BAUD
         DATA,1   2                 300 BAUD
         DATA,1   3                 600 BAUD
         DATA,1   4                 1200 BAUD
         DATA,1   5                 2400 BAUD
         DATA,1   6                 4800 BAUD
         DATA,1   7                 9600 BAUD
         DATA,1   1                 134 BAUD; 2741
         BOUND    4
TCSYSUP  TEXTC    TXBELL,TXCR,'SYSTEM IS UP',TXBELL,TXCR
NOTAFLG  DATA     0                 PATCH NON-ZERO TO SKIP TURNAROUND
*                                   .. CHECKING
 TITLE 'C O C G   -   F R O N T E N D / D R I V E R'
START    LC       J:JIT
         BCR,8    STRT050           B/NOT ONLINE; OK TO RUN
         P:TYPE   'COCG:  CAN''T RUN ONLINE'
         M:XXX                      ABORT
STRT050  M:SYS                      G/MASTER MODE
         BCR,8    STRT100           B/GOT MASTER MODE
         P:TYPE   'COCG:  CAN''T GET MASTER MODE'
         M:XXX                      ABORT
STRT100  CI,R8    QUEUE             C/CURRENT QUEUE ADR W/OUR QUEUE ADR
         BE       STRT120           B/OK
         P:TYPE   'COCG:  LOADED WITH WRONG MONSTK'
         M:XXX                      ABORT
STRT120  M:TIME   TXDATE            PUT DATE/TIME IN TITLE
         LCI      2
         LM,R2    SITEID            L/SITEID FROM ROOT
         STM,R2   TXSITEID          S/SITEID IN TITLE
STRT150  LI,R15   0                 L/0; INITIAL VALUE FOR COCGFLG
         XW,R15   COCGFLG           X/0 W/CURRENT VALUE
         STW,R15  TCOCGFLG          S/COCGFLG'S OLD VALUE
         BNEZ     %+2               B/SOMETHING SET
         M:EXIT                     NOTHING LEFT TO DO; EXIT
         CI,R15   AC(G1RCVRY)+AC(G1BOOT)+AC(CSE)+AC(CLK3)+AC(PFSR)
         BANZ     STRT500           B/COC INIT REQUEST
STRT200  LW,R15   TCOCGFLG          L/OLD GHOST REQUEST FLAGS
         CI,R15   AC(OUMI)+AC(G1RCVRY)+AC(G1BOOT)
         BANZ     OUMI050           B/ONLINE-USER-MAX-INCREASED OR SYSTEM
*                                   .. JUST CAME UP
STRT300  B        STRT150           B; SEE IF NEW REQUESTS
 TITLE 'C O C G   -   T U R N A R O U N D   C H E C K'
STRT500  BAL,R13  COCDSABL          DISABLE COC INTS, SET INT STATUS
         LI,R1    0                 L/0
         STW,R1   CO:HIIL           0/HIGHEST INPUT INTERRUPT LEVEL
*                                   .. SELECT BIT
         STW,R1   CO:AIL            0/ALL INTERRUPT LEVEL SELECT
*                                   .. BITS CELL
         LD,R4    COCLIMS           L/# OF COC'S, 0
TAC100   LD,R2    COD:LPC,CX        L/1ST LOGICAL LINE #, LAST # FOR COC
         SW,R3    R2                (1ST LOG LN #) - (LAST LOG LN #)
         STW,R3   LPLN,CX           S/LAST PHYSICAL LINE # FOR THIS COC
         LW,R7    NOTAFLG           L/TURN-AROUND FLAG
         BNEZ     TAC300            BNEZ; DON'T DO ANY TURNAROUND CHECKING
         LH,R1    COH:DN,CX         L/COC DEVICE ADR
         :TIO,0   0,R1              TIO, SEE IF COC IS THERE
         BCS,12   TAC300            B/COC NOT THERE OR IS RUNNING; SKIP
         LW,R7    TCOCGFLG          L/COC EXECUTION OPTION FLAGS
         CI,R7    AC(PFSR)          CHECK REQUEST FLAGS
         BANZ     TAC150            B/POWER FAILSAFE; RESET TURNAROUND
         CI,R7    AC(CSE)+AC(G1RCVRY) CHECK REQUEST FLAGS
         BANZ     TAC300            B/RECOVERY OR CSECOM; DON'T RESET TA
         RD,0     0                 CHECK SENSE SWITCHES
         BCR,4    TAC300            B/SS2 DOWN; DON'T CHECK BACK-TO-BACK
TAC150   LW,R7    LPLN,CX           L/LAST PHYSICAL LINE # FOR COC
TAC200   EXU      CO:RCVDOFF,CX     TURN RECEIVER L DATASET OFF -
*                                   TURN BACK-TO-BACK TEST OFF
         BDR,R7   TAC200            BDR/GET NEXT LINE
         AI,R7    0                 CHECK FOR LINE 0
         BE       TAC200            B/LINE 0
         MTW,-1   TAFLG             SET TURNAROUND-RESET-PERFORMED FLAG
TAC300   AI,CX    1                 +1 TO COC NUMBER
         BDR,R4   TAC100            BDR/GET NEXT COC
         LC       TAFLG             CHECK TURNAROUND RESET FLAG
         BCR,8    INIT020           B/RESET NOT PERFORMED
         LI,R8    X'17000'          DELAY FOR AT LEAST 80 MILLI-SECONDS
         BDR,R8   %                    BEFORE INITIALIZING COC
 TITLE 'C O C G   -   C O C   S T A R T - U P'
INIT020  LI,CX    0                 L/0; COC INDEX
INIT050  LW,R0    CO:XPSDI          L/INPUT INTERRUPT XPSD INSTRUCTION
         LH,R6    COH:II,CX         L/INPUT INTERRUPT ADR FOR THIS COC
         STW,R0   0,R6              S/XPSD INST
         LW,R1    CO:XPSDO,CX       L/OUTPUT INTERRUPT XPSD INSTRUCTION
         LH,R6    COH:IO,CX         L/OUTPUT INTERRUPT ADR
         STW,R1   0,R6              S/XPSD
         LW,R0    CO:CMND,CX        L/DA OF COMMAND DOUBLE WORD
         LH,R6    COH:DN,CX         L/COC ADR FOR THIS COC
         SIO,R0   0,R6              START COC
         STCF     COB:SIOS,CX       S/SIO CC'S IN STATUS TABLE
         BCR,8    INIT100           B/ADR RECOGNIZED
         AI,R6    0                 CHECK FOR NEGATIVE DEVICE ADR
         BLZ      INIT300           B/NEGATIVE; DEVICE IS PARTITIONED
**************************************************************************
*  SIO FAILURE ON THIS COC HAS OCCURED.
*  GIVE ERROR MESSAGE ON THE OC.
*  GO ON TO NEXT COC
**************************************************************************
*O*  MESSAGE: COCG:  UNSTARTABLE COC - X'NNDD' - SIO CC'S = X'Y'
*O*  ACTION:  IF THE COC SHOULD BE OPERATIONAL, CALL A CE. OTHERWISE,
*O*           IGNORE THE MESSAGE.
*O*  MEANING: COCINIT WAS CALLED, AND TRIED TO START A COC THAT WAS'T
*O*           STARTABLE AND WASN'T ALREADY RUNNING.
**************************************************************************
         LB,R13   COB:SIOS,CX       L/SIO CC'S
         SLS,R13  -4                RJ/CC'S
,TCSIOF  P:DISP   NOPRINT,'COCG:  UNSTARTABLE COC - I/O ADR = ',;
                  (HEXX,(BUF,R6),(BTD,2),(SIZE,2)),;
                  ' - SIO CC''S = ',(HEXX,(BUF,R13),(BTD,3),(SIZE,1,1))
         M:TYPE   (MESS,TCSIOF)
         B        INIT300           SKIP TO NEXT COC
         PAGE
INIT100  BCS,4    INIT250           B/COC ALREADY WAS RUNNING
         LCH,R0   COH:RBS,CX        L/COMPLEMENT OF RING BUFFER SIZE
         STW,R0   CO:LST,CX         S/RING BUFFER POINTER
         LW,R7    LPLN,CX           L/LAST PHYSICAL LINE # FOR COC
         LD,R2    COD:LPC,CX        L/LAST LOGICAL LN # FOR COC INTO R3
***********************************************************************
*  TURN RECEIVER ON
***********************************************************************
INIT150  EXU      CO:RCVON,CX       TURN RECEIVER L ON
         LC       MODE6,R3
         BCR,CC(HD) INIT220         B/NOT HALF DUPLEX
         LB,R6    MODE6,R3          L/MODE6
         OR,R6    LC(HDIN)          SET INPUT MODE
         AND,R6   NLC(HDTA)         RESET TURNING-AROUND MODE
         STB,R6   MODE6,R3          S/MODE6
INIT220  AI,R3    -1                DEC LOGICAL LINE #
         BDR,R7   INIT150           BDR/CHECK NEXT LINE
         AI,R7    0                 CHECK FOR LINE 0
         BE       INIT150           B/LINE 0
         LW,R7    COCEFLG           CHECK COC EXECUTION FLAGS
         CW,R7    LC(AUTO)          C/FLAGS W/AUTO CONFIGURE BIT
         BANZ     AUTO100           B/AUTO CONFIGURATION SET
INIT230  UNINHIBIT                  RESET INHIBITS
         BAL,R15  TXB100            XMIT BELL TO ALL LINES ON THIS COC
***********************************************************************
*  ALL LINES ON THIS COC HAVE BEEN SET UP.
***********************************************************************
INIT250  LW,R7    CO:IIL,CX         L/INPUT INTERRUPT LEVEL SELECT BITS
         CW,R7    CO:HIIL           C/THIS COC'S INT LEVEL W/CURRENT
*                                   .. HIGHEST PRIO INT LEVEL
         BLE      %+3               BLE; THIS COC ISN'T HIGHEST
         STW,R7   CO:HIIL           S/HIGHEST PRIO INPUT INT LEVEL
         STW,CX   HPCX              S/HIGHEST PRIORITY COC #
         OR,R7    CO:OIL,CX         OR IN OUTPUT INT LEVEL SELECT BITS
         STS,R7   CO:AIL            ADD INPUT AND OUTPUT SELECT BITS
*                                   .. FOR THIS COC TO SELECT BITS FOR
*                                   .. ALL COCS
INIT300  AI,CX    1                 +1 TO COC #
         CI,CX    LCOC              C/COC # W/LAST COC #
         BLE      INIT050           BLE; CHECK NEXT COC
         LW,CX    HPCX              L/COC # W/HIGHEST PRIORITY
         LH,R6    COH:II,CX         L/ADR OF HIGHEST PRIO INT LOCATION
         MTW,-4   0,R6              -4 TO XPSD REF ADR; POINT TO CO:IN0
************************************************************************
*  ARM AND ENABLE THE COC INTERRUPTS
************************************************************************
         LW,R4    CO:AIL            L/ALL COC INT LEVEL SELECT BITS
         :WD,R4   ARM%ENABLE,COA:IG   ARM & ENABLE INPUT & OUTPUT INTERRUPTS
         BAL,R13  COCENABL          DO INTERRUPT STATUS HOUSEKEEPING
         B        STRT200           B; GO BACK TO TOP OF COCG
 TITLE 'C O C G   -   T R A N S M I T   B E L L   C H A R A C T E R'
TXB100   LI,R1    0                 L/0; INDEX FOR 'DUMMY'
         LW,R2    LPLN,CX           L/LAST PHYSICAL LINE # ON THIS COC
         LW,R6    LPLN,CX           L/LAST PHYSICAL LINE # ON THIS COC
         AI,R6    (X'80'+TXBELL)**8 +BELL CHARACTER W/PARITY
TXB200   EXU      CO:XDATA,CX       TRANSMIT BELL CHARACTER
         AI,R6    -1                DEC PHYSICAL LINE #
         BCS,0    %                 UNSATIFIED BRANCH FOR TIMING
         MTH,1    DUMMY,R1          INC DUMMY
         BDR,R2   TXB200            BDR/TRANSMIT TO NEXT LINE
         AI,R2    0                 CHECK FOR LINE 0
         BE       TXB200            B/LINE 0
         B        *R15              RETURN
 TITLE 'C O C G   -   A U T O M A T I C   C O N F I G U R A T I O N'
AUTO100  LI,R2    64/8              L/# OF DBL WDS IN COUNT TABLE
         LI,R3    0                 L/0
         STD,R3   COUNT-2,R2        0/COUNT TABLE
         BDR,R2   %-1               BDR/ZERO NEXT DBL WD
         INHIBIT                    SET INTERRUPT INHIBITS
         LI,R13   2                 L/2; LET TICWAIT GET SYNC'D
AUTO120  LW,R11   C:TINC            L/HARDWARE CLOCK VALUE
         STW,R11  CLOCK             SET UP OUR CLOCK FOLLOWER
         BAL,R1   TICWAIT           WAIT FOR CLOCK TO TIC
         BDR,R13  AUTO120           RTN HERE IF CLOCK TIC'D WHILE SETTING
*                                   .. UP AND CALLING TICWAIT
         B        CANTSYNC          B/CAN'T GET SYNC'D TO CLOCK
         BAL,R15  TXB100            XMIT BELL TO ALL LINES ON THIS COC
         LI,R14   #PASSES           L/MAX # OF PASSES ON STATUS CHECK LOOP
AUTO200  LI,R7    0                 L/0
         STW,R7   DUMMY             0/DUMMY
         BAL,R1   TICWAIT           WAIT FOR NEXT CLOCK3 TIC
         B        TOOSLOW           B/MISSED; WE'RE EXECUTING TOO SLOW
         B        %-1               ''CAN'T'' BRANCH HERE
         LI,R1    1                 L/'DUMMY' INDEX
         LW,R7    LPLN,CX           L/LAST PHYSICAL LINE # ON THIS COC
AUTO300  EXU      CO:TSTAT,CX       WD: SENSE TRANSMITTER STATUS
         BCS,1    AUTO350           B/CHARACTER TRANSMISSION COMPLETE
         MTB,1    COUNT,R7          INC COUNTER FOR THIS LINE
         B        AUTO380           B
AUTO350  MTH,1    DUMMY,R1          INC 'DUMMY'
         BCS,0    %                 UNSATISFIED BRANCH FOR TIMING
AUTO380  BDR,R7   AUTO300           BDR/CHECK NEXT LINE
         AI,R7    0                 CHECK FOR LINE 0
         BE       AUTO300           B/LINE 0
         LW,R7    DUMMY             L/NUMBER OF LINES COMPLETED
         CW,R7    LPLN,CX           C/# COMP W/# OF LINES - 1
         BG       %+2               BG; ALL COMPLETED
         BDR,R14  AUTO200           BAL/MAKE ANOTHER PASS
         UNINHIBIT                  RESET INHIBITS
         LD,R6    COD:LPC,CX        L/FIRST LOGICAL LINE # IN R6
         LI,R7    0                 L/0; FIRST PHYSICAL LINE #
         LH,R4    COH:DN,CX         L/COC DEVICE ADR
         LW,R8    CO:TSTAT,CX       L/WD INST TO COC
         SLS,R8   -4                SHIFT DIO ADR IN WD TO BITS 28 -> 31
         M:DEVICE M:LL,(HEADER,1,0) RESET HEADER
         M:DEVICE M:LL,(VFC)        SET VFC ON M:LL
         M:PRINT  (MESS,TCTITLE)    PRINT 'COC AUTO CONFIG ...'
         P:DISP   'ACOC NUMBER = ',(DEC,(BUF,CX),(SIZE,4,1)),;
                  '    COC ADR = ',(HEXX,(BUF,R4),(BTD,2),(SIZE,2)),;
                  '    DIO ADR = ',(HEXX,(BUF,R8),(BTD,3),(SIZE,1,1))
 P:PRINT 'BITEM       DESCRIPTION'
 P:PRINT 'ALIU        LINE INTERFACE UNIT NUMBER; 0 IS FIRST'
 P:PRINT ' SLOT       SEND/RECEIVE/INTERFACE MODULE POSITION WITHIN LIU'
 P:PRINT ' LINE       LOGICAL (SOFTWARE) LINE NUMBER;  0 IS FIRST'
 P:PRINT ' RSCC       RECEIVER STATUS CONDITION CODES'
 P:PRINT ' TSCC       TRANSMITTER STATUS CONDITION CODES'
 P:PRINT ' FORMAT     LINE FORMAT'
 P:PRINT ' BAUD       BAUD RATE OF LINE'
 P:PRINT ' ALGORITHM  SOFTWARE TIMING ALGORITHM NUMBER'
         P:PRINT  'A'               SKIP 2 LINES
         M:DEVICE M:LL,(HEADER,1,TCAHDR)  SET HEADER
         M:DEVICE M:LL,(NOVFC)      RESET VFC ON M:LL
,,TCAHDR P:PRINT  ' LIU/SLOT  LINE  RSCC  TSCC  FORMAT  BAUD  ALGORITHM'
AUTO500  LB,R1    LB:UN,R6          L/USER #
         BNEZ     AUTO900           BNEZ; USER ASSOCIATED, DON'T CONFIGURE
         LI,R14   0                 L/0; ASSUME NOT 2741
         LB,R15   COUNT,R7          L/# OF PASSES TIL TRANS COMPLETE
         LI,R4    #TYPES            L/# OF SPEED RANGES
         CB,R15   TICSTYPE,R4       C/COUNTER W/LIMITS
         BL       AUTO600           B/OUR SPEED FOUND
         BDR,R4   %-2               BDR/CHECK FOR NEXT RANGE
         B        AUTO900           B/LINE NOT OPERATIONAL; SKIP CONFIGURATION
AUTO600  CI,R4    ALGO150-ALGOTAB   C/SPEED WITH 134/150
         BNE      AUTO700           B/NOT 134/150 BAUD
         LI,R4    ALGO2741-ALGOTAB  L/TYPE INDEX OF 2741
         LI,R14   X'10'             L/.10; 2741 BIT
AUTO700  LW,R2    ALGOTAB,R4        L/DEFAULT TIMING ALGORITHM FOR
*                                   .. THIS LINE SPEED/TYPE
         SLS,R2   3                 SHIFT LEFT 3 BITS
         LB,R3    MODE4INIT,R6      L/MODE4 INITIALIZATION VALUE
         AND,R3   =X'C0'            SAVE .80, .40 BITS
         OR,R3    R2                OR/MODE4INIT W/ALGORITHM
         LB,R15   M4LS,R4           L/MODE4INIT LINE SPEED INDICATOR
*                                   .. FOR THIS TYPE OF LINE
         OR,R3    R15               OR/MODE4INIT W/LINE SPEED INDICATOR
         STB,R3   MODE4INIT,R6      S/MODE4INIT
         LI,R15   X'10'             L/.10; MASK FOR 2741 BIT
         LB,R13   MODE2,R6          L/MODE2
         STS,R14  R13               S/2741 BIT (0 OR .10)
         STB,R13  MODE2,R6          S/MODE2
AUTO900  LW,R9    R7                L/PHYSICAL LINE #
         SLD,R8   29                SHIFT LIU # INTO R8
         SLS,R8   5                 SHIFT LIU # 5 MORE BITS
         SLD,R8   15                POSITION LIU, SLOT FOR LATER SHIFTS
         LW,R10   R7                L/PHYSICAL LINE # FOR CO:STAT WD
         EXU      CO:STAT,CX        WD: SENSE RECEIVER STATUS
         STCF     R8                S/CC'S
         SLS,R8   -8                POSITION R8
         EXU      CO:TSTAT,CX       WD: SENSE TRANSMITTER STATUS
         STCF     R8                S/CC'S
         SLS,R8   -4                POSITION THE MESS FOR P:DISP
         LB,R4    MODE4INIT,R6      L/MODE4INIT
         AND,R4   =7                &/MODE4INIT W/7; G/SPEED
         LC       MODE2,R6
         BCR,1    %+2               B/NOT 2741 LINE
         LI,R4    8                 L/8; TEXT INDEX FOR 2741
         LW,R10   TXFORMAT,R4       L/TEXT FOR FORMAT (E.G., 8/10)
         LW,R14   TXBAUD,R4         L/TEXT FOR BAUD (E.G., 300)
         LB,R9    MODE4INIT,R6      L/MODE4INIT
         SLS,R9   -3                RJ/ALGORITHM #
         AND,R9   =7                &/ALGORITHM W/7; MASK
         P:DISP   '   ',(DEC,(BUF,R8),(BTD,2),(SIZE,1,1)),;  LIU #
                  '/',(DEC,(BUF,R8),(BTD,3),(SIZE,1,1)),; SLOT #
                  '    ',(HEXX,(BUF,R7),(BTD,3),(SIZE,1)),; LOGICAL LINE #
                  '     ',(HEX,(BUF,R8),(BTD,1),(SIZE,1,1)),;  RSCC
                  '     ',(HEX,(BUF,R8),(BTD,0),(SIZE,1,1)),;  TSCC
                  '    ',(X,(BUF,R10),(SIZE,4)),;  FORMAT
                  '  ',(X,(BUF,R14),(SIZE,4)),;  BAUD
                  '          ',(HEX,(BUF,R9),(BTD,3),(SIZE,1,1)) ALGORITHM
         AI,R6    1                 INC LOGICAL LINE #
         AI,R7    1                 INC PHYSICAL LINE #
         CW,R7    LPLN,CX           C/PHYS # W/LAST PHYS # ON THIS COC
         BLE      AUTO500           BLE; KEEP CHECKING LINES
SNAP     B        INIT250           B; FINISH PROCESSING THIS COC
         M:SNAP   'COUNT',(COUNT,COUNT+63/4)    SNAP THE COUNT TABLE
         B        INIT250           B; FINISH PROCESSING THIS COC
 TITLE 'C O C G   -   W A I T   F O R   C L O C K   T I C'
*        BAL,R1   TICWAIT
*        (RETURN 1)  MISSED A TIC SINCE LAST CHECK
*        (RETURN 2)  NEVER BRANCH HERE
*        (RETURN 3)  CLOCK TIC'D (OK)
TICWAIT  LW,R11   CLOCK             L/OUR CLOCK COUNTER
         CW,R11   C:TINC            C/OUR CLOCK WITH HARDWARE CLOCK
         BNE      0,R1              BNE; CLOCK TIC'D WHILE WE WERE
*                                   .. EXECUTING, E.G., WE MISSED A TIC
         LI,R12   500               L/COUNTER FOR APPROX 4 MILLISEC
*                                   .. LOOP (VERY APPROXIMATE)
         AI,R11   -1                DEC OUR CLOCK COUNTER
         STW,R11  CLOCK             S/OUR CLOCK COUNTER
TICW200  CW,R11   C:TINC            C/OUR COUNTER W/HARDWARE CLOCK
         BE       2,R1              B/CLOCK TIC'D WHILE WE WERE WATCHING
         BG       CLKRST            B/CLOCK SOMEHOW GOT RESET ON US
         BDR,R12  TICW200           BDR/KEEP WATCHING CLOCK
         P:TYPE   'COCG:  CLOCK3 DOESN''T APPEAR TO BE TICKING'
         B        INIT230           B; DO NON-AUTO INITIALIZATION
CLKRST   P:TYPE   'COCG:  CLOCK3 COUNTER GOT RESET'
         B        INIT230           B; DO NON-AUTO INITIALIZATION
TOOSLOW  P:TYPE   'COCG:  AUTO-CONFIGURATION CODE TOO SLOW'
         B        INIT230           B; DO NON-AUTO INITIALIZATION
CANTSYNC P:TYPE   'COCG:  CAN''T GET SYNC''D TO CLOCK3 COUNTER'
         B        INIT230           B; DO NON-AUTO INITIALIZATION
 TITLE 'C O C G   -   S Y S T E M   U P   M E S S A G E'
OUMI050  RD,0     0                 CHECK SENSE SWITCHES
         BCS,4    STRT300           B/SS2 UP; SKIP
         LW,R1    S:OUIS            L/# OF ONLINE USERS
         CW,R1    S:OUAIS           C/USERS W/MAX ALLOWED ONLINE USERS
         BGE      STRT300           BGE; CAN'T HAVE MORE; SKIP
         LI,R2    LNOL              L/# OF LAST LOGICAL LINE
OUMI100  BAL,R13  COCDSABL          DISABLE COC INTERRUPTS
         LB,R1    MODE6,R2          L/MODE6
         CI,R1    AC(HW)            C/MODE6 W/HARDWIRED BIT
         BAZ      OUMI700           B/DIAL-UP LINE; SKIP
         LB,R1    LB:UN,R2          L/USER #
         BNEZ     OUMI700           B/USER ASSOCIATED; SKIP LINE
         LC       MODE2,R2
         BCS,1    OUMI700           B/2741; SKIP LINE
         BAL,R6   COCPHYLN          COCX INTO R3, PHYS LINE # INTO R7
         LH,R1    COH:DN,R3         L/DEVICE ADR OF THIS COC
         TIO,0    0,R1              TIO COC
         BCS,8    OUMI700           B/COC NOT THERE; SKIP
         LW,R10   R7                SET UP REGS FOR CO:STAT
         EXU      CO:STAT,R3        SENSE RECEIVER STATUS
         BCR,3    OUMI700           B/DATASET READY NOT UP; SKIP
         LC       MODE6,R2          CHECK FOR HALF-DUPLEX
         BCR,CC(HD) %+2             B/NOT HALF-DUPLEX
         BAL,R9   T:TURNOUT         TURN LINE TO OUTPUT MODE IF HALFDUPLEX
         LB,R7    MODE4INIT,R2      L/TIMING ALGORITHM
         SLS,R7   -3                RJ/TIMING ALGO
         AND,R7   =7                &/ALGO W/7; MASK
         LB,R7    COB:MNIC,R7       L/COLUMN # OF MAX # OF IDLES ON CR
         STB,R7   CPOS,R2           S/COL # AS CURRENT CARRIAGF POSITION
         LB,R7    COCTERM,R2        L/TERMINAL TYPE INDEX
         LH,R10   COCOTV,R7         L/OUTPUT TRANSLATE TABLE ADR
         LI,R7    1                 L/1; BTD TO 1ST BYTE IN TEXTC
         LOCAL    R5
R5       EQU      5
OUMI200  LB,R5    TCSYSUP,R7        L/BYTE OF 'SYSTEM IS UP' MESSAGE
         BAL,R9   COCSENDX          SEND CHARACTER
         AI,R7    1                 INC BTD
         CB,R7    TCSYSUP           C/BTD W/BC OF MESSAGE
         BLE      OUMI200           BLE; GET NEXT BYTE
OUMI700  BAL,R13  COCENABL          ENABLE COC INTERRUPTS
         AI,R2    -1                DEC LINE #
         BGEZ     OUMI100           BGEZ; GET NEXT LINE
         B        STRT300           B; GO ON TO NEXT REQUEST
         END      START

