LEX    'SERIOLEX'
LEXID  EQU    #53
       ID     LEXID
       MSG    MSGTBL
       POLL   POLHND
       ENTRY  SERIO$
       CHAR   #F
       KEY    'SERIO$'
       TOKEN  #B
       ENDTXT
ADHEAD EQU    #181B7
ARGERR EQU    #0BF19
ARGSTA EQU    #0E90C
BSERR  EQU    #0939A
CSPEED EQU    #2F977
Except EQU    #0000C
FLTDH  EQU    #1B223
IDIV   EQU    #0EC7B
MEMERR EQU    #0944D
MPY    EQU    #0ECBB
XXHEAD EQU    #1A44E
fLEX   EQU    #0E208
*
MSGTBL
       CON(2) 2
       CON(2) 3
*
eSrInt EQU    2
       CON(2) 41
       CON(2) 2
       CON(1) 10
       NIBASC 'SERIO In'
       NIBASC 'ter'
       CON(1) 5
       NIBASC 'rupted'
       CON(1) 12
*
eSrTim EQU    3
       CON(2) 33
       CON(2) 3
       CON(1) 11
       CON(1) 12
       NIBASC 'SERIO Ti'
       NIBASC 'meout'
       CON(1) 12
*
       NIBHEX FF
*
* Poll handler goes here.  Handler for VER$ poll is provided.
*
POLHND ?B=0   B
       GOYES  hVER$0
       GONC   hVER$2
hVER$0 C=R3
       D1=C
       A=R2
       D1=D1- (VER$en)-(VER$st)-2
       CD1EX
       ?A>C   A
       GOYES  hVER$1
       D1=C
       R3=C
*
**!! LCASC text to be returned for VER$ here
*  Include a leading blank!
*
VER$st LCASC  ' SERIO:A'
VER$en DAT1=C (VER$en)-(VER$st)-2
hVER$2
hVER$1 RTNSXM
*
* ----(see CC V2N7P58 Nov/Dec 85 for additional comments)----
*
BITCNT EQU    11-1
BAUD   EQU    1200
*
       NIBHEX 88433
SERIO$
       P=     0
       LC(5)  CSPEED
       CD0EX
       A=0    W
       A=DAT0 A
       CD0EX
       R1=A
       ASL    W
       C=0    W
       LC(5)  BAUD
       GOSBVL IDIV
       C=0    W
       P=     0
       LC(2)  81
       A=A-C  W
       LC(2)  15
       GOSBVL IDIV
       C=A    X
       ST=C
*
*
       GOSBVL ARGSTA
       GOC    argerc
       P=     0
       LC(3)  3
       A=A+C  X
       LCHEX  5
       ?A>C   X
       GOYES  argerc
       GOSBVL FLTDH
       GONC   argern
       C=0    W
       C=A    A
       A=C    W
       C=R1
       GOSBVL MPY
       ASL    W
       ASL    W
       ASL    W
       ASL    W
       C=0    W
       LC(5)  51*1000
       GOSBVL IDIV
       R0=A
***
       D1=D1+ 16
       GOSBVL ARGSTA
argerc GOC    argerr
       GOSBVL FLTDH
argern GONC   argerr
       SETHEX
       R2=A
       D1=D1+ 16
       A=0    M
       GOSBVL XXHEAD
       ASRB
       R3=A
       A=R2
       C=R1
       D1=C
       D1=D1- 16
       CD1EX
       C=C-A  A
       C=C-A  A
       ?C<D   A
       GOYES  memerr
       C=0    W
       INTOFF
       ?ST=0  Except
       GOYES  SERIO10
       C=C-1  S
       ST=0   Except
SERIO10
       R4=C
OUTPUTLOOP
       C=R3
       C=C-1  A
       GOC    DOINPUT
       R3=C
       D1=D1- 2
       A=DAT1 B
       GOSUB  OUTBYT
       C=R4
       ?C=0   A
       GOYES  OUTPUTLOOP
       GONC   INPUTDONE
argerr GOVLNG ARGERR
memerr GOVLNG MEMERR
DOINPUT
       C=R1
       D1=C
INPUTLOOP
       C=R2
       C=C-1  A
       GOC    INPUTDONE
       R2=C
       GOSUB  INBYTE
       ?P#    0
       GOYES  INPUTDONE
       ASR    A
       ASRB
       A=-A-1 A
       D1=D1- 2
       DAT1=A B
       C=R4
       ?C=0   A
       GOYES  INPUTLOOP
INPUTDONE
       C=R4
       ?C=0   S
       GOYES  INPD10
       ST=1   Except
INPD10
       ?C#0   A
       GOYES  INTRPD
       ?P#    0
       GOYES  TIMEUP
       D=0    A
       ST=0   0
       GOVLNG ADHEAD
*
INTRPD
       P=     0
       LC(4)  (LEXID)*256+eSrInt
bserr
       INTON
       GOVLNG BSERR
TIMEUP P=     0
       LC(4)  (LEXID)*256+eSrTim
       GOTO   bserr
***
*** OUTBYT routine -- see CC article for add'l comments
***
OUTBYT P=     0
       LCHEX  00010
       B=C    A
       C=ST
       D=C    B
       P=     15
       LC(1)  BITCNT
       A=0    XS
       A=A-1  XS
       A=A+A  A
       A=A+A  A
       A=A+A  A
       A=A+A  A
       A=A+A  A
*
       A=-A-1 A
       C=A    X
       C=C&B  X
OUT20  P=     0
       OUT=C
       ASRB
       C=ST
       D=C    B
       C=A    X
       C=C&B  X
       P=     0
       P=     0
       C=C-1  S
       RTNC
OUT40  D=D-1  B
       GONC   OUT40
       GOC    OUT20
***
*** INBYTE routine -- see CC article for add'l comments
***
INBYTE A=0    W
       C=R0
       C=ST
       D=C    W
       CSRB
       A=C    B
       LCHEX  04000
       B=C    A
       P=     15
       LC(1)  (BITCNT)-1
***
       P=     3
IN20   C=IN
       C=C&B  P
       ?C#0   P
       GOYES  IN30
       ?ST#0  Except
       RTNYES
       D=D-1  M
       GONC   IN20
       RTN
***
IN30   P=     0
IN40   A=A-1  B
       GONC   IN40
***
IN50   C=IN
       C=C&B  A
       A=A!C  A
       ASRB
       C=C-1  S
       RTNC
IN70   D=D-1  B
       GONC   IN70
       C=ST
       D=C    B
       GOC    IN50
*
* End of LEXFILE
*
 FILEND
       END