WRIT1 EQU * 
      JSB BITCK     CHECK STATUS
      JMP WRIT2     TIMEOUT 
      JMP WRIT3     LINE ERROR
      NOP           DATA ERROR
      SLA           BREAK?
      JMP WRIT4     YES 
WRITW EQU * 
      LDA EQT39,I   GET FLAGS I 
      RAL 
      SSA           ACK EXPECTED? 
      JMP WRITN     YES 
      LDA EQT40,I   NO,GET FLAGS II 
      SSA           ESC OUT FLAG SET? 
      JMP WRITC     YES 
      RAL           NO
      AND =B160000
      SZA           H,ROOF,OR SML A OUT FL SET? 
      JMP WRITH     YES 
      LDA EQT40,I   NO,GET FLAGS AGAIN
      ALF 
      SSA           DC1 OUT FLAG SET? 
      JMP WRITA     YES 
      RAL           NO
      SSA           SML D OUT FLAG SET? 
      JMP WRITM     YES 
      RAL           NO
      SSA           RS OUT FLAG SET(BEFORE READ)? 
      JMP WRIT7     YES 
      RAL           NO
      SSA           & OUT FLAG SET? 
      JMP WRITP     YES 
      RAL           NO
      SSA           SML B OUT FLAG SET? 
      JMP WRITS     YES 
      RAL           NO
      SSA           X OUT FLAG SET? 
      JMP WRITU     YES 
      LDA EQT13,I   NO,GET CHAR COUNT 
      SZA,RSS       CHAR COUNT = 0? 
      JMP WRITR     YES 
      CPA P01$      NO. CHAR COUNT = +1?
      JMP WRITD     YES,RS HAS BEEN OUTPUT
      ISZ EQT42,I   NO. 81ST CHAR OUT NEXT? 
      JMP WRITL     NO
      JSB HAND      YES,IS HANDSHAKE REQ? 
      JMP WRITL     NO
      JMP WRIT8     YES 
WRITL EQU * 
      JSB GET       NO
      CPA ARROW     LEFT ARROW? 
      JMP WRIT5     YES 
WRIT8 CLB 
WRITG EQU * 
      ISZ WRITE+1 
      JMP WRITE+1,I 
WRIT2 EQU * 
      LDA EQT40,I 
      AND B6$ 
      SZA           X OUT FLAG SET? 
      JMP WRITT     YES,OK
      LDA =B11      ERR,NO TIMEOUT SHOULD OCCUR 
      JMP WRIT3+1 
WRIT3 EQU * 
      LDA P04$      SET LINE ERROR STATUS 
      JSB STAT
      JMP WRITX 
WRIT4 EQU * 
      LDA EQT9,I    GET I/O REQ CNTRL WORD
      ALF,ALF 
      RAL,RAL 
      AND M77$
      CPA P02$      LINE OPEN?
      JMP WRITW     YES,IGNORE BREAK
      LDA P03$      NO
      JSB STAT      SET BREAK STATUS
      JMP WRITX 
WRITN EQU * 
      LDB =D-60 
      JMP WRITB 
WRITD EQU * 
      LDA EQT41,I 
      RAR,SLA       AUTO-READ?
      RSS           YES 
      JMP WRITX     NO
      LDA WRITE+1 
      STA READ+1
      JMP READC 
WRITX EQU *         ADJUST TRANSMISSION LOG 
      LDA EQT14,I 
      LDB EQT11,I   GET BUFFER LENGTH 
      SSB           WORD COUNT SPECIFIED? 
      JMP *+3       NO
      INA           YES,CONVERT T LOG TO WORD COUNT 
      ARS 
      STA EQT14,I 
      JMP WRITE+1,I 
WRITA EQU * 
      LDB EQT43,I   LOAD B WITH TIME CONSTANT 
      LDA EQT40,I 
      AND NB11$     CLEAR DC1 OUT FLAG
      STA EQT40,I 
WRITB EQU * 
      LDA EQT39,I 
      IOR B0$       SET TIMER FLAG
      STA EQT39,I 
      LDA B15$      START READ
      JMP WRITG 
WRITC EQU * 
      AND NB15$     CLEAR ESC OUT FLAG
      STA EQT40,I 
      LDA EQT9,I    GET I/O REQ CNTRL WORD
      ALF,ALF       ISOLATE FUNCTION
      RAL,RAL 
      AND M77$
      CPA =B42      CURSOR SENSE? 
      JMP WRITI     YES 
      CPA =B43      NO,TERM STAT REQ? 
      JMP WRITJ     YES 
      CPA =B44      NO,BLOCK TRANSFER REQUEST?
      JMP WRITF     YES 
      CPA P02$      NO,LINE OPEN? 
      JMP WRITQ     YES 
      LDA EQT40,I   NO,THEN HOME UP IN PROGRESS 
      IOR B14$      SET H OUT FLAG
      STA EQT40,I 
      LDA H         OUTPUT H
      JMP WRITK 
WRITI EQU * 
      LDA EQT40,I 
      IOR B12$      SET SML A OUT FLAG
      STA EQT40,I 
      LDA SMLA      OUTPUT SMALL A
      JMP WRITK 
WRITJ EQU * 
      LDA EQT40,I 
      IOR B13$      SET ROOF OUT FLAG 
      STA EQT40,I 
      LDA ROOF      OUTPUT ROOF 
      JMP WRITK 
WRITF EQU * 
      LDA EQT40,I 
      IOR B10$      SET SML D OUT FLAG
      STA EQT40,I 
      LDA SMLD      OUTPUT SMALL D
      JMP WRITK 
WRITQ EQU * 
      LDA EQT40,I 
      IOR B8$       SET & OUT FLAG
      STA EQT40,I 
      LDA &         OUTPUT &
WRITK EQU * 
      ISZ EQT42,I   81ST CHAR OUT NEXT? 
      JMP WRIT8     NO
      JSB HAND      YES,IS HANSHAKE REQ?
      NOP 
      JMP WRIT8 
WRITR EQU * 
      LDA EQT41,I   GET OPTION BITS 
      AND B6$ 
      SZA,RSS       APPEND RS?
      JMP WRITD     NO
      ISZ EQT42,I   YES,81ST CHAR OUT NEXT? 
      JMP WRIT6     NO
      JSB HAND      YES,IS HANDSHAKE REQ? 
      JMP WRIT6     NO
      JMP WRIT8     YES 
WRIT6 EQU * 
      LDA P01$
      STA EQT13,I   SET CHAR COUNT TO +1
      LDA RS        OUTPUT RS 
      JMP WRIT8 
WRITH EQU * 
      LDA EQT40,I 
      AND =B107777  CLEAR H,ROOF,SML A FLAGS
      IOR B11$      SET DC1 OUT FLAG
      STA EQT40,I 
      LDB N81$
      ISZ EQT42,I   81ST CHAR OUT NEXT? 
      JMP *+2       NO
      STB EQT42,I   YES 
      LDA DC1 
      JMP WRIT8 
WRITM EQU * 
      LDA EQT40,I   GET FLAGS II
      AND NB10$     CLEAR SML D OUT FLAG
      IOR B0$       SET BLCK TRANFR ENABLE FLAG 
      STA EQT40,I 
      JMP WRITE+1,I 
WRIT5 EQU * 
      LDA EQT41,I   GET OPTION BITS 
      AND B5$ 
      SZA           LEFT ARROW ENABLED? 
      JMP WRITR     YES,TERMINATE WRITE 
      LDA ARROW 
      JMP WRIT8 
WRIT9 EQU * 
      LDA EQT40,I 
      AND NB0$      CLEAR BL TRANS ENAB FLAG
      IOR B15$      SET ESC OUT FLAG
      STA EQT40,I 
      LDA ESC 
      ISZ EQT42,I   81ST CHAR OUT NEXT? 
      JMP WRIT8     NO
      JSB HAND      YES,IS HANDSHAKE REQ? 
      NOP           NO
      JMP WRIT8 
WRIT7 EQU * 
      LDA EQT40,I 
      AND NB9$      CLEAR RS OUT FLAG(BEFORE READ)
      STA EQT40,I 
      LDA EQT41,I   GET OPTION BITS 
      AND B2$ 
      SZA,RSS       HOME UP REQUIRED? 
      JMP WRIT9     YES 
      JSB WRDC1     NO,OUTPUT DC1 
      JMP WRIT8 
WRITP EQU * 
      LDA EQT40,I 
      AND NB8$      CLEAR & OUT FLAG
      IOR B7$       SET SML B OUT FLAG
      STA EQT40,I 
      LDA SMLB      OUTPUT SMALL B
      JMP WRITK 
WRITS EQU * 
      LDA EQT40,I 
      AND NB7$      CLEAR SML B OUT FLAG
      IOR B6$       SET X OUT FLAG
      STA EQT40,I 
      LDA X 
      JMP WRITK 
WRITT EQU * 
      LDA EQT40,I 
      AND NB6$      CLEAR X OUT FLAG
      STA EQT40,I 
      LDA EQT39,I 
      AND NB0$      CLEAR TIMER FLAG
      STA EQT39,I 
      LDA N81$      RESET COUNTER TO -81
      STA EQT42,I 
      JMP WRITE+1,I 
WRITU EQU * 
      LDA EQT39,I 
      SLA           TIMER IN PROGRESS?
      JMP WRITV     YES,WAIT FOR TIMEOUT
      IOR B0$       NO,SET TIMER FLAG 
      STA EQT39,I 
      LDB =D-6      SET 600 MILLISEC TIMER
      LDA NULL
      JMP WRITG 
WRITV EQU * 
      LDA NULL
      JMP WRIT8 
      SKP 
*     SUBROUTINES 
* 
RSET  EQU * 
      NOP 
      CLA 
      JSB STAT      CLEAR POSSIBLE PARITY ERRORS
      LDA EQT10,I   GET BUFFER ADDRESS
      RAL           CONVERT TO CHARACTER ADDRESS
      STA EQT12,I   STORE IT
      LDA EQT11,I   GET BUFFER LENGHT 
      SZA,RSS       ZERO LENGTH BUFFER? 
      JMP RSET1     YES-ERROR 
      SSA           NO,CHARACTERS SPECIFIED?
      JMP RSET2     YES 
      ALS           NO,SO CONVERT TO NEG BYTE COUNT 
      CMA,INA 
RSET2 EQU * 
      STA EQT13,I 
      CLA 
      STA EQT14,I   CLEAR LOG 
      ISZ RSET
      JMP RSET,I
RSET1 EQU * 
      LDA P01$      INVALID REQUEST ERROR 
      JSB STAT
      JMP RSET,I
* 
PUT   EQU * 
      NOP 
      LDB EQT12,I   GET CHAR. ADDRESS 
      CLE,ERB 
      SEZ,RSS       EVEN? 
      JMP PUT1      YES,LEFT BYTE 
      STA STAT1     NO,RIGHT BYTE,SAVE CHAR 
      LDA B,I       GET BUFFER CONTENTS 
      AND LBYT$     SAVE LEFT BYTE
      IOR STAT1     MERGE IN NEW CHAR 
      JMP PUT2
PUT1  EQU * 
      ALF,ALF       POSITION NEW CHARACTER
      STA STAT1     SAVE IT TEMPORARILY 
      LDA B,I       GET BUFFER CONTENTS 
      AND RBYT$     PRESERVE RIGHT BYTE 
      IOR STAT1     MERGE NEW CHARACTER 
PUT2  EQU * 
      STA B,I       STORE CHAR. 
      ISZ EQT12,I   BUMP CHAR ADDR
      ISZ EQT14,I   BUMP T LOG
      ISZ EQT13,I   BUMP CHAR COUNT 
      JMP PUT,I     CONTINUE
      ISZ PUT       CHAR COUNT = 0,SO BUMP RET ADDR 
      JMP PUT,I 
* 
STAT  EQU * 
      NOP 
      STA STAT1     SAVE STATUS 
      LDA EQT4,I
      AND LBYT$     KEEP LEFT BYTE
      IOR STAT1     MERGE IN STATUS 
      STA EQT4,I
      JMP STAT,I
* 
BITCK EQU * 
      NOP 
      LDA SAVA      GET STATUS
      RAL,SLA 
      JMP BITCK,I   BIT 15
      ISZ BITCK 
      RAL,SLA 
      JMP BITCK,I   BIT 14
      ISZ BITCK 
      RAL,SLA,RAL 
      JMP BITCK,I   BIT 13
      ISZ BITCK 
      JMP BITCK,I   NONE
* 
GET   EQU * 
      NOP 
      LDB EQT12,I   GET CHAR ADDRESS
      CLE,ERB       CONVERT TO WORD ADDR
      LDA B,I       PICKUP WORD 
      SEZ,RSS       BYTE ADDR EVEN? 
      ALF,ALF       YES,USE LEFT BYTE 
      AND RBYT$     MASK OFF CHAR TO BE OUTPUT
      ISZ EQT12,I   BUMP CHAR ADDR
      ISZ EQT14,I   BUMP LOG
      ISZ EQT13,I   BUMP COUNTER
      NOP 
      JMP GET,I 
* 
LOG   EQU *         LOG DRIVER ENTRY&BOARD STAT 
      NOP 
      LDB EQT44,I 
      SZB,RSS       TRACE TABLE PRESENT 
      JMP LOGX      NO
      STA LOGA      YES 
      ISZ SEQ       INCR SEQ COUNTER
      NOP 
      LDA SEQ 
      ALF,ALF       POSITION IN LEFT BYTE 
      AND LBYT$ 
      IOR LOGA      MERGE IN ID 
      ADB P04$      BUMP POINTER
      STB EQT44,I 
      ADB P04$
      CMB,INB 
      ADB EQT18,I 
      SSB,RSS       END OF TABLE
      JMP LOG1      NO
      LDB =D28      YES 
      STB EQT44,I   RESET POINTER 
LOG1  EQU * 
      CCB 
      ADB EQT44,I 
      ADB EQT18     FORM ENTRY ADDRESS
      STA B,I       SEQ/ID
      INB 
      LDA SAVA      A 
      STA B,I 
      INB 
      LDA SAVB      B 
      STA B,I 
      INB 
      LDA EQT25,I   STATUS
      STA B,I 
LOGX  EQU * 
      LDA SAVA
      LDB SAVB
      JMP LOG,I 
* 
SETQ  EQU *         SET EQT LINKS 
      NOP 
      STA SAVA
      STB SAVB
      LDA EQTB
      ADA P03$
      CPA EQT4
      JMP SETQ,I
      STA EQT4
      ADA P05$
      STA EQT9
      INA 
      STA EQT10 
      INA 
      STA EQT11 
      INA 
      STA EQT12 
      INA 
      STA EQT13 
      INA 
      STA EQT14 
      ADA P03$
      LDA A,I 
SETQ1 EQU * 
      STA EQT18 
      INA 
      STA EQT19 
      INA 
      STA EQT20 
      INA 
      STA EQT21 
      ADA P04$
      STA EQT25 
      ADA P14$
      STA EQT39 
      INA 
      STA EQT40 
      INA 
      STA EQT41 
      INA 
      STA EQT42 
      INA 
      STA EQT43 
      INA 
      STA EQT44 
      JMP SETQ,I
SETQI NOP 
      STA IQT18 
      INA 
      STA IQT19 
      ADA P02$
      STA IQT21 
      ADA P04$
      STA IQT25 
      ADA =D17
      STA IQT42 
      INA 
      STA IQT43 
      INA 
      STA IQT44 
      JMP SETQI,I 
* 
TIMRD EQU * 
      NOP 
      LDB =D-190    PRESET B TO 19 SECS 
      LDA EQT21,I   GET BAUD RATES
      AND M17$      ISOLATE ONE 
      CPA =B17      9600 BAUD?
      JMP TIMRD,I   YES 
      BLS           NO,SET B TO 38 SECS 
      CPA =B14      4800 BAUD?
      JMP TIMRD,I   YES 
      BLS           NO,SET B TO 76 SECS 
      CPA =B13      2400 BAUD?
      JMP TIMRD,I   YES 
      BLS           NO,SET B TO 152 SECS
      CPA =B11      1200 BAUD?
      JMP TIMRD,I   YES 
      LDB =D-6000   NO,SET B TO 600 SECS
      CPA =B5       300 BAUD? 
      JMP TIMRD,I   YES 
      BLS           NO,SET B TO 1200 SECS 
      CPA =B3       150 BAUD? 
      JMP TIMRD,I   YES 
      LDB =D-18000  NO,THEN 110 BAUD ASSUMED
      JMP TIMRD,I 
* 
HAND  EQU * 
      NOP 
      STA SAVA
      LDA N81$      RESET COUNTER TO -81
      STA EQT42,I 
      LDA EQT19,I 
      SSA,RSS       HALF DUPLEX?
      JMP HAND1     YES,DISABLE HANDSHAKE 
      LDA EQT41,I   GET OPTION BITS 
      AND B4$ 
      SZA           IS HANSHAKE REQ?
      JMP HAND1     NO,RETURN TO P+1
      LDA EQT39,I   YES 
      IOR B14$      SET ACK EXP FLAG
      AND NB0$      CLEAR TIMER FLAG
      STA EQT39,I 
      LDA ENQ       PREPARE ENQ FOR OUTPUT
      ISZ HAND
      JMP HAND,I    RETURN TO P+2 
HAND1 LDA SAVA      RESTORE A REGISTER
      JMP HAND,I    RETURN TO P+1 
* 
WRDC1 EQU * 
      NOP 
      LDA EQT40,I   NO
      AND NB0$      CLEAR BLCK TRANS ENAB FLAG
      IOR B11$      SET DC1 OUT FLAG
      STA EQT40,I 
      LDB N81$
      ISZ EQT42,I   81ST CHAR OUT NEXT? 
      JMP *+2       NO
      STB EQT42,I   YES RESET COUNTER TO -81
      LDA DC1 
      JMP WRDC1,I 
* 
CFLGS EQU * 
      NOP 
      CLA 
      STA EQT39,I   CLEAR FLAGS I 
      LDA EQT40,I 
      AND P01$
      STA EQT40,I   CLEAR FLAGS II (EXCEPT 0) 
      JMP CFLGS,I 
      SKP 
*     CONSTANTS AND VARIABLES 
* 
IQT18 NOP 
IQT19 NOP 
IQT21 NOP 
IQT25 NOP 
IQT42 NOP 
IQT43 NOP 
IQT44 NOP 
* 
A     EQU 0 
B     EQU 1 
SAVA  NOP 
SAVB  NOP 
P14$  DEC 14
P15$  DEC 15
P16$  DEC 16
N11$  DEC -11 
N81$  DEC -81 
B15$  OCT 100000
B14$  OCT 40000 
B13$  OCT 20000 
B12$  OCT 10000 
B11$  OCT 4000
B10$  OCT 2000
B9$   OCT 1000
B8$   OCT 400 
B7$   OCT 200 
B6$   OCT 100 
B5$   OCT 40
B4$   OCT 20
B2$   OCT 4 
B0$   OCT 1 
NB15$ OCT 77777 
NB11$ OCT 173777
NB10$ OCT 175777
NB9$  OCT 176777
NB8$  OCT 177377
NB7$  OCT 177577
NB6$  OCT 177677
NB0$  OCT 177776
* 
SPEC  DEF *+1       ADDR OF SPEC CHAR TABLE 
      DEC -4        - NUMBER OF SPEC CHARS
CR    OCT 15
DC2   OCT 22
RS    OCT 36
ACK   OCT 6 
* 
NULL  NOP 0 
ARROW OCT 137 
ESC   OCT 33
H     OCT 110 
&     OCT 46
SMLA  OCT 141 
ROOF  OCT 136 
SMLD  OCT 144 
SMLB  OCT 142 
X     OCT 130 
ENQ   OCT 5 
DC1   OCT 21
RCODE OCT 3 
STAT1 NOP 
LOGA  NOP 
SEQ   NOP 
EQT4  NOP 
EQT9  NOP 
EQT10 NOP 
EQT11 NOP 
EQT12 NOP 
EQT13 NOP 
EQT14 NOP 
EQT18 NOP 
EQT19 NOP 
EQT20 NOP 
EQT21 NOP 
EQT25 NOP 
EQT39 NOP 
EQT40 NOP 
EQT41 NOP 
EQT42 NOP 
EQT43 NOP 
EQT44 NOP 
RATE  NOP 
LPLEX NOP 
STOP  OCT 62522     STOP BITS FOR EACH BAUD RATE
* 
PLEX  DEF *+1 
      OCT 0         0-HALF DUPLEX,
      OCT 100       1-HALF DUPLEX,ECHO
      OCT 40000     2-HALF DUPLEX,SEC.CHAN. 
      OCT 40100     3-HALF DUPLEX,SEC. CHAN.,ECHO 
      OCT 100000    4-FULL DUPLEX 
      OCT 100100    5-FULL DUPLEX,ECHO
      OCT 140000    6-FULL DUPLEX,SEC. CHAN.
      OCT 140100    7-FULL DUPLEX,SEC.CHAN.,ECHO
* 
TERTA DEF *+1 
      OCT 52447 
      OCT 0         EXTERNAL CLOCK....0 
      OCT 0         110 BAUD..........1 
      OCT -1        134.5 BAUD        2 
      OCT 0         150 BAUD..........3 
      OCT -1        220 BAUD..........4 
      OCT 0         300 BAUD..........5 
      OCT -1        440 BAUD..........6 
      OCT -1        600 BAUD..........7 
      OCT -1        880 BAUD.........10 
      OCT 0        1200 BAUD.........11 
      OCT -1       1760 BAUD.........12 
      OCT 0        2400 BAUD.........13 
      OCT 0        4800 BAUD.........14 
      OCT -1       3600 BAUD.........15 
      OCT -1       7200 BAUD.........16 
      OCT 0        9600 BAUD.........17 
* 
P2640 NOP           DUMMY 
      SKP 
*     BASE PAGE CONSTANTS 
* 
#     EQU 53B 
N01$  EQU #-1 
N02$  EQU #-2 
N03$  EQU #-3 
N04$  EQU #-4 
N05$  EQU #-5 
N06$  EQU #-6 
N07$  EQU #-7 
N08$  EQU #-8 
N09$  EQU #-9 
N10$  EQU #-10
N64$  EQU #-11
P00$  EQU # 
P01$  EQU #+1 
P02$  EQU #+2 
P03$  EQU #+3 
P04$  EQU #+4 
P05$  EQU #+5 
P06$  EQU #+6 
P07$  EQU #+7 
P08$  EQU #+8 
P09$  EQU #+9 
P10$  EQU #+10
P17$  EQU #+11
P64$  EQU #+12
M17$  EQU #+13
M37$  EQU #+14
M77$  EQU #+15
M177$ EQU #+16
RBYT$ EQU #+17      OCT 377 
LBYT$ EQU #+18      OCT 177400
M3777 EQU #+19      OCT 3777
M1777 EQU #+20      OCT 177700
* 
*     BASE PAGE VARIABLES 
* 
##    EQU 202B
EQTB  EQU 300B      ADDRESS OF EQT ENTRY
$EQ1  EQU ##+1
$EQ3  EQU ##+3
$EQ5  EQU ##+5
$EQ6  EQU ##+6
$EQ9  EQU ##+9
$EQ10 EQU ##+10 
$EQ14 EQU ##+14 
$EQ16 EQU ##+16 
$EQ17 EQU ##+17 
RQP3  EQU 230B
RQP4  EQU 231B
MPTFL EQU 271B      MEMORY PROTECT FLAG 
      END 
