/Test version of
/Firmware for APM Ether Station Boards (CSD142)
/to aid 68000 interface data transfer loop tuning
/RWT May 1985
/using 'transparent mode' as 'echo mode'

org=16_1000

dd=16_23
mm=16_05
yy=16_85

/Miscellaneous constants
nbuffs=5;nprocs=20
nports=32;maxport=31
header=14;datamax=512+20
nchans=256

/Timeout control
retrgap=70;retrlim=30
/RetrGap should be larger than twice RetrLim.
/The  Kth  timeout will be (RetrGap-K)*K units.
/We give up (Nak) after RetrLim transmissions.
/A "unit" is approximately 0.5ms, more precisely
/it is roughly 57*nports machine cycles at 0.25us
/per port plus 46 cycles for each port waiting
/for an Ack (typically 1).
/The above values 100 and 15 give up after ca 5.4s.

/Device addresses
dmaer=0
dmaet=2
dmalr=4
dmalt=6
dma=8
tc=16_10   /read-only (clears DMA TC interrupt)
int=16_10  /write-only interrupt enable (ltbe.lrdr.lrcr.dmatc)
lkc=16_20  /link control (read/write)
lkd=16_30  /link data
er=16_40   /read: data/control, write: filter/reset
ls=16_50   /(link status) read-only (rbf.rdr.rcr.0.0.0.0.tbe)
etd=16_50  /write-only: data into fifo
es=16_60   /read-only: (tcol.ta.tdone.rctrl.crce.rcol.ra.over)
et=16_60   /write-only: hold-off counter, reset

/Interrupt enable bits
tcintbit=8
rcintbit=4
rdintbit=2
teintbit=1

/DMA enable bits
erdmabit=1
etdmabit=2
lrdmabit=4
ltdmabit=8
tcbit=16_40

/Control characters
rdy=16_10;stx=16_20;dtx=16_30;nak=16_50
err=16_a0;ack=16_c0;ssa=7;sna=6;etx=11;poke=14

/Structure of port records
/(incorporating ack packets)
port=ix
area port
var rems,remp,remn,,,
var locs,locp,locn,,,
var type,inseq,acklen,
var outseq,lives,timer,score,rdyexp,,stxexp,
var pltpro,,,,petpro,,,
portsize=32

/Structure of process records
process=iy
area process
var next,,stackp,,buffer,,size,
/stack (including saved registers)
procsize=40

/Global variables
area ram
loc 16_1e00
port0: loc portsize*nports+.
proc0: loc procsize*nprocs+.
buff0: loc header+datamax+6*nbuffs+.
spectrum: loc nchans>>3+.
/** w proc0
/** w buff0
loc 16_3d00
var prolist,         /Free processes
var buflist,         /Free buffers
var bufque,
var erbuf1,,erbuf2,
var lrpro,
var ltpro,,,,etpro,,,
var temp,,intstack,
var dmaon,dmaoff,inton,station,net,,,
var ptr,
var sizerr,,,,crcerr,,,,trcerr,,,,rejerr,,,
var heard,,,,hearc,,,,ignore,,,,duplic,,,
var closed,,,,dwrong,,,,swrong,,,,spuack,,,
var qwrong,,,,cretr,,,,aretr,,,,sent,,,
var sentc,,,,eovf,,,,eovr,,,,adderr,,,
var mode
/** w *

/Initial entry:
/Set up tables and variables
/Initialise hardware
/Set up ER DMA
/Enable interrupts (LRD,LRC,DTC)
/Idle

area rom
loc org

/Initial entry
  jp begin
  16_7f              /Station address
  dd; mm; yy         /Version date

loc 16_08+org; jp disaster
loc 16_10+org; jp disaster
loc 16_18+org; jp disaster
loc 16_20+org; jp disaster
loc 16_28+org; jp disaster
loc 16_30+org; jp disaster
loc 16_38+org; jp disaster
loc 16_66+org; jp disaster

/Clear store
begin:
  ld sp,16_4000
  ld hl,sysend
  ld bc,16_4000-sysend
cl:
  ld (hl),0; inc hl
  dec bc; ld a,b; or c
  jp nz,cl

/Set up port table
  ld b,nports; ld c,0
  ld port,#port0
  ld acklen,14
  ld de,portsize
  ld a,(3)
  ld station,a
portloop:
  ld locs,a
  ld locp,c
  add port,de
  inc c
  djnz portloop

/Set up buffer list
  ld b,nbuffs
  ld process,#buff0
  ld hl,0
  ld de,header+datamax+6
buffloop:
  ld next,hl
  push process; pop hl
  add process,de
  djnz buffloop
  ld buflist,hl

/Set up process list
  ld b,nprocs
  ld process,#proc0
  ld hl,0
  ld de,procsize
procloop:
  ld next,hl
  push process; pop hl
  add process,de
  djnz procloop
  ld prolist,hl

/Initialise hardware
  in a,(tc)           /reset DMA interrupt
  xor a; out (et),a   /reset transmitter
  ld a,station
  out (er),a          /reset receiver (sets overrun)
  in a,(er)           /(clears overrun)

/Set up ER DMA
  call getbuf
  ld erbuf2,hl
  call getbuf
  ld erbuf1,hl
  ld de,16_4000+header+datamax+5-1 /5=size(2)+crc(2)+pad(1)
  ld c,dmaer
  out (c),hl
  inc c
  out (c),de
  ld a,erdmabit+tcbit
  ld dmaon,a
  out (dma),a

/Enable interrupts
  ld a,rdintbit+rcintbit+tcintbit
  ld inton,a
  out (int),a
  ld a,inttab>>8
  ld i,a
  im2

/Idle loop
/(time out generator)
idle:
  ei
  ld b,nports         /for each of the ports
  ld hl,#port0+#lives /that is alive
iloop:
  xor a
  or (hl); jr z,idle0    /not alive ->
  inc hl; ld a,(hl); dec hl
  or a; jr z,idle0       /not armed ->
  inc hl; dec (hl); jr nz,idle1  /not expired ->
  ld de,-1-#lives
  add hl,de
  di                   /make sure
  push hl; pop port
  ld a,timer
  or a; jr nz,no       /timer must be zero
  or lives
  jr z,no              /lives must be non-zero
  ld de,petpro
  xor a; or d; jr z,no /process must exist
  push de; pop process
  exx; ex af,af        /simulate interrupt
  call wake
no:
  ld de,#lives
  add hl,de
  jr idle0
idle1: dec hl
idle0:
  ld de,#portsize; add hl,de
  djnz iloop
  jp idle

/Enqueue process on wait queue HL
enqueue:
  push af; push bc; push de; push hl
  push port
  ex de,hl
  ld temp,sp
  ld hl,temp
  ld stackp,hl
  ld sp,intstack
qloop:               /find end of queue
  ex de,hl
  ld e,(hl); inc hl
  ld d,(hl); dec hl
  xor a; or d; jr nz,qloop
  push process; pop de
  ld (hl),e; inc hl
  ld (hl),d
  ld next(1),0
  jp intret

/Process suspension
wait:
  push af; push bc; push de; push hl
  push port
  ld temp,sp
  ld hl,temp
  ld stackp,hl
  ld sp,intstack

/Return from interrupt
intret:
  exx; ex af,af

/+ return from spurious interrupt
intspu:
  ret          /*NOTE* interrupts not re-enabled

/Wake up process
wakesp:
  exx; ex af,af
  pop process
wake:
  ld intstack,sp
  ld hl,stackp
  ld sp,hl
  pop port
  pop hl; pop de; pop bc; pop af
  ret

/Process Death
suicide:
  ld hl,buffer        /relinquish buffer
  xor a; or h
  call nz,putbuf
  ld hl,prolist       /relinquish PCB
  ld next,hl
  ld prolist,process
  ld hl,disaster      /Prevent zombies
  push hl
  push af; push bc
  push de; push hl
  push port
  ld temp,sp
  ld hl,temp
  ld stackp,hl
  ld sp,intstack
  ld de,12            /reconstruct return address
  add hl,de; ld e,(hl)
  inc hl; ld d,(hl)
  ex de,hl; jp (hl)

die:
  call suicide
  jp intret

/   I N T E R R U P T   P R O C E S S I N G

/Link Transmitter Buffer Empty
inttbe:
  exx; ex af,af
  in a,(ls)
  and 1
  call z,disaster
  ld a,inton
  and 255-teintbit
  ld inton,a
  out (int),a         /Disable interrupt
  ld process,ltpro
  ld hl,ltpro         /Anyone waiting for this?
  xor a; or h
  jp nz,wake          /Yes ->
  call disaster       /and ignore =>

/Link Receiver Data Ready
intrdr:
  exx; ex af,af
  in a,(ls)
  and 16_e0; cp 16_c0
  call nz,disaster
  ld process,lrpro
  ld hl,lrpro       /Anyone waiting?
  xor a; ld lrpro(1),a  /Auto-release in any case
  or h
  jp nz,wake        /Yes ->
  in a,(lkd)        /Discard spurious data char
  call creprc       /but echo it
  call ltclaim
  out (lkd),a
  call ltrelease
  call die

/Link Receiver Control Ready
intrcr:
  exx; ex af,af
  in a,(ls)
  and 16_e0; cp 16_a0
  call nz,disaster
  in a,(lkc)
  ld b,a
  ld hl,lrpro         /DMA in progress?
  ld process,lrpro
  xor a; ld lrpro(1),a /(auto-release in any case)
  or h; jr nz,tryetx  /maybe ->
notetx:
  ld a,b; and 16_f0   /Port-specific?
  jr z,nonspec        /No ->
  ld c,a
  call creprc
  call lrsym
  ld b,a
  call select
  call suicide
  ld a,c
  rrca; rrca; rrca
index:                /into table
  ld hl,cctable
  add a,l; ld l,a
  ld e,(hl); inc hl; ld d,(hl)
  ex de,hl; jp (hl)
nonspec:
  ld a,15; and b
  or 16; rlca
  jp index
tryetx:
  ld a,dmaon               /Turn off DMA
  and 255-lrdmabit; ld c,a
  xor a; out (dma),a
  in a,(dma); cpl; and c
  out (dma),a
  ld dmaon,a
  xor c; ld c,a
  ld a,dmaoff
  or c; and 255-lrdmabit
  ld dmaoff,a
  ld a,inton               /Turn on data interrupts
  or rdintbit; out (int),a
  ld inton,a
  ld a,b; cp etx
  jp z,wake                /Was ETX ->
  jr notetx

/DMA Completion
intdtc:
  exx; ex af,af
revamp:
  in a,(tc)           /Clear interrupt
  ld a,dmaon; ld b,a
  xor a; out (dma),a  /Stop all channels briefly
  in a,(dma)          /Note which have completed
  cpl; and b
  out (dma),a         /Resume those not completed
  ld dmaon,a
  xor b               /The ones that have completed now
  ld hl,#dmaoff       /the ones that have completed before
  or (hl); ld (hl),a
  ld b,a              /the ones that have completed to date

/Now analyse completions
/ET is ignored, LT is woken, ER/LR are clobbered

  and lrdmabit
  jp z,trylt
/The host has delivered an outsize packet.
/enable data interrupts and let the process
/in charge sort it out later.
  xor b; ld (hl),a; ld b,a
  ld a,inton
  or rdintbit
  ld inton,a
  out (int),a

trylt:
  ld a,ltdmabit
  and b; jp z,tryer
/The link transmitter has accepted a packet.
/enable Buffer Empty interrupts to wake the
/process in charge when it is time to send the ETX.
  xor b; ld (hl),a; ld b,a
  ld a,inton
  or teintbit
  ld inton,a
  out (int),a

tryer:
  ld a, erdmabit
  and b; jp z,intret
/The ether receiver has delivered an outsize packet
/Clobber and re-initialise it
  xor b; ld (hl),a
  ld hl,#eovr
  call incl
erclobber:
  ld a,station          /freeze receiver
  out (er),a
  ld hl,erbuf1
  ld de,16_4000+header+datamax+5-1
  ld c,dmaer
  out (c),hl
  inc c
  out (c),de
  ld a,dmaon            /prepare to reactivate DMA
  or erdmabit
  ld dmaon,a
  in a,(er)             /unfreeze receiver (clear OVR)
  jp revamp

/Ether Receiver Fifo Overflow
intovf:
  exx; ex af,af
  ld hl,#eovf
  call incl
  jr erclobber

/Ether Transmitter Done
intetd:
  exx; ex af,af
  ld a,dmaon              /Did DMA complete?
  and etdmabit; jr z,etd1 /Yes ->
  ld a,dmaon              /Stop it
  and 255-etdmabit; ld b,a
  xor a; out (dma),a
  in a,(dma); cpl; and b
  out (dma),a
  ld dmaon,a
  ld hl,#dmaoff
  xor b; or (hl)
  and 255-etdmabit; ld (hl),a
etd1:
  ld hl,#sent
  call incl
  ld a,etpro(1)
  ld process,etpro
  or a; jp nz,wake
  out (et),a            /reset transmitter
  jp intret

/Ether Receiver Done
interd:
  exx; ex af,af
  ld hl,erbuf2       /let auxiliary buffer take over
  ld c,dmaer
  ld a,dmaon; ld b,a
  xor a; out (dma),a /suspend DMA briefly
  in a,(dma)
  in de,(c)          /read end address
  out (c),hl         /set new start address
  inc c
  ld hl,16_4000+header+datamax+5-1 /and new size
  out (c),hl
  cpl; and b; or erdmabit
  out (dma),a; ld c,a
  in a,(es); ld h,a  /Note ether status (in D)
  in a,(er)          /Read control character
  ex de,hl           /(ER now active) HL=endad,D=status
  ld a,c; ld dmaon,a
  xor b; ld b,a
  ld a,dmaoff; or b
  and 255-erdmabit
  ld dmaoff,a
/Now check whether the packet was intact
  ld a,16_1c; and d
  cp 16_10; jr nz,faulty /CRC or truncation error ->
  dec hl; dec hl       /back past CRC bytes
  dec hl; ld b,(hl)
  dec hl; ld c,(hl)    /BC = packet size (from packet)
  ld de,erbuf1
  or a; sbc hl,de      /HL = packet size (from DMA)
  ld a,(de)            /dest station byte in packet
  or a; jr z,forme     /broadcast ->
  push hl
    ld hl,#station
    cp (hl)
  pop hl
  jr nz,misaddressed
forme:
  ld a,b; xor h; jr nz,mismatch
  ld a,c; xor l; jr nz,mismatch
/Packet was intact.  If there are spare buffers,
/grab a new auxiliary one for the ether, and create
/a process to deal with the existing buffer.
/Otherwise, discard the received packet.
  ld hl,erbuf2
  ld erbuf1,hl
  ld erbuf2,de
  call getbuf
  jr nz,gotone      /all is well ->
  jp intret
misaddressed:
  ld hl,#adderr
  call incl
  jr reject
mismatch:
  ld hl,#sizerr
  call incl
  jr reject
faulty:
  ld hl,#crcerr
  bit 2,a
  call nz,incl
  ld hl,#trcerr
  bit 3,a
  call nz,incl
reject:
  ld hl,#rejerr
  call incl
  ld hl,erbuf2
  ld de,erbuf1
  ld erbuf2,de
  ld erbuf1,hl
  jp intret
gotone:
  ld erbuf2,hl
  call creprc
  ld buffer,de
  ld size,bc
  ld port,#port0
  ld a,mode
  or a; jp nz,rawin    /transparent mode ->
  push de; pop port

/ C O D E   T O   D E A L   W I T H
/ I N C O M I N G   D A T A   P A C K E T S

  bit 7,type           /Is this an ack packet?
  jp nz,ackpack        /Yes ->
  ld hl,#heard
  call incl
  ld a,rems            /Broadcast?
  or a; jr z,pz        /yes ->
  ld a,remp            /Is addressed port open?
  or a; jr z,pz        /port 0 ->
  call select
  xor a; or acklen
  ld hl,#closed
  jp z,ignpack         / No ->
  jr notzero
pz:
  ld port,#port0
  ld bc,6              / Port 0: copy source address
  ld hl,buffer
  add hl,bc
  ld de,#port0
  ldir
  ex de,hl
  jr ackit
notzero:
  ld hl,buffer
  push port; pop de
  ld bc,6
  ex de,hl; add hl,bc  / DE -> buffer, HL -> locs
daloop:
  ld a,(de); inc de
  cpi
  jp nz,dabad
  jp pe,daloop
  push port; pop hl    / DE -> buffer+6, HL -> rems
  ld bc,6
saloop:
  ld a,(de); inc de
  cpi
  jp nz,sabad
  jp pe,saloop
/Prepare to acknowledge the packet
ackit:                 / DE -> buffer+12
  ld a,(de); set 7,a   /Copy across (7-bit) type
  ld type,a
  inc de; ld a,(de)    /Swop sequence numbers
  ld b,inseq
  ld inseq,a
  ld a,b; ld (de),a
  ld hl,buffer
  ld a,(hl)
  or a; jr z,broadcast
  call etclaim
  push port; pop hl
  ld de,16_8010-1
  ld bc,etdmabit<<8+dmaet
  call dodma
  ld hl,#sentc
  call incl
  xor a; out (et),a        /reset ET
  call etrelease
/Now check sequence number
  ld a,inseq
  or a; jr z,ok            /always accept zero ->
  ld hl,buffer
  ld de,#inseq; add hl,de
  ld a,(hl)
  cp inseq                 /otherwise accept only if
  jp nz,ok                 /different from previous packet
  ld hl,#duplic
  jp ignpack               /assume retransmitted ->
broadcast:
  inc hl
  ld a,(hl)
  call prism
  and (hl)
  ld hl,#ignore
  jp z,ignpack
ok:
  ld a,16_81            /Check type code
  xor type
  ld hl,#ignore
  jp nz,ignpack         /type not data ->
rawin:
  push port; pop hl     /percolate through
  ld bc,#pltpro; add hl,bc
  call claim
  call ltclaim          /claim link to send DTX
  ld a,dtx
  call sign
  call ltrelease
  push process; pop hl
  ld rdyexp,hl
  call wait             /wait for RDY
  call ltclaim
  ld a,stx
  call sign
  ld hl,buffer
  ld a,locp             /port 0?
  or a; jr nz,nonzero   /no ->
  ld a,mode             /transparent mode?
  or a; jr nz,transp
  ld a,(hl)             /broadcast?
  or a; jr nz,zero      /no ->
  call ltwait
  out (lkd),a
  call ltwait
  inc hl
  ld a,(hl)
  dec hl
  out (lkd),a
zero:
  ld bc,6; add hl,bc    /send 6 source ad bytes
  ld de,16_8006-1
  ld bc,ltdmabit<<8+dmalt
  call dodma
nonzero:                /send data bytes
  ld hl,size
  ld bc,-14; add hl,bc
  ld a,h; or l; jr z,nullpak /dma copeth not with empty blocks
  ld bc,16_8000-1; add hl,bc
  ex de,hl
  ld hl,buffer
  ld bc,14; add hl,bc
  ld bc,ltdmabit<<8+dmalt
  call dodma
nullpak:
  call ltwait
  ld a,etx
  out (lkc),a           /send ETX
  call ltrelease
  ld de,#pltpro
  push port; pop hl
  add hl,de; call release
  call die
transp:
  ld hl,size
  ld a,h; or l; jr z,nullpak
  ld bc,16_8000-1; add hl,bc 
  ex de,hl
  ld hl,buffer
  ld bc,ltdmabit<<8+dmalt
  call dodma
  jr nullpak

dabad:
  ld hl,#dwrong
  jr ignpack
sabad:
  ld hl,#swrong
  jr ignpack
rignpack:
  call etrelease
ignpack:
  call incl
  call die

/ C O D E   T O   D E A L   W I T H
/ I N C O M I N G   A C K   P A C K E T S

ackpack:
  ld hl,#hearc
  call incl
  ld b,inseq               /remember for later
  ld a,remp
  call select
  call etclaim             /mutex on
  ld hl,petpro
  xor a; or h
  push hl                  /waiting process
  ld hl,#spuack
  jr z,rignpack            /spurious ack ->
  pop hl; push hl          / HL = #waiting process
  ld de,#buffer; add hl,de / HL = ##waiting buffer
  ld e,(hl); inc hl; ld d,(hl) / DE = #waiting buffer
  ld hl,#inseq; add hl,de  / HL = #seqno in waiting buffer
  ld a,(hl); cp b          / (B was seqno of ack packet)
  ld hl,#qwrong
  jr nz,rignpack           /wrong seq no ->
  ld a,lives
  ld score,a               /remember when ack came
  ld lives,0               /disarm timer
  ld timer,0
/*redundant*/  pop hl; push hl; or a    /disarm ETdone interrupt if
/*redundant*/  ld de,etpro              /still transmitting
/*redundant*/  sbc hl,de
/*redundant*/  ld a,h; or l; jr nz,ack1
/*redundant*/  ld etpro(1),a
/*redundant*/ack1:
  pop hl; call kill        /kill waiting process
  push port; pop hl
  ld de,#petpro; add hl,de
  call release
  call etrelease           /mutex off
  call ltclaim
  ld a,ack
  call sign
  call ltrelease
  call die

/ C O D E   T O   D E A L   W I T H
/    H O S T   I N T E R F A C E

badpsc:                 /Report bad port-specific command
  call creprc
  call ltclaim
  ld a,err; out (lkc),a
  call lthang
  ld a,c; out (lkd),a
  jr badc

badnps:                 /Report bad non-port-specific command
  call creprc
  call ltclaim
  ld a,err; out (lkc),a
badc:
  call lthang
  ld a,b; out (lkd),a
  call lthang
  call ltrelease
  call die

ccdiag:                 /Prevent interference with diags
  ld a,16_40
  out (er),a
  out (et),a
  out (dma),a
  jp intret

ccraw:                  /Set transparent mode
  ld a,255
  ld mode,a
  jp intret

ccload:                 /Load RAM version of firmware
  xor a; out (int),a    /most interrupts off
  out (er),a            /reset receiver
  out (et),a            /reset transmitter
  out (dma),a           /stop DMA
  ld hl,16_1000
ccl1:
  in a,(ls); add a,a
  jr nc,ccl1            /wait for data char
  jp p,ccl2             /control ->
  in a,(lkd); ld (hl),a; inc hl
  jp ccl1
ccl2:
  in a,(lkc)            /skip control char
  jp 16_1000

ccbon:                  /Enable broadcasts
  call creprc
  call lrsym
  call prism
  or (hl); ld (hl),a
  call die

ccbof:                  /Disable all broadcasts
  ld hl,#spectrum
  ld b,#nchans>>3
bof1: ld (hl),0; inc hl
  djnz bof1
  jp intret

ccesa:                  /Enquire Station Address
  call creprc
  call ltclaim
  ld a,ssa; out (lkc),a
  call ltwait
  ld a,station
  out (lkd),a
  call ltrelease
  call die

/*discontinued*/ccena:                  /Enquire Network Address
/*discontinued*/  call creprc
/*discontinued*/  call ltclaim
/*discontinued*/  ld a,sna; out (lkc),a
/*discontinued*/  ld hl,net
/*discontinued*/  ld de,net(2)
/*discontinued*/  ld c,lkd
/*discontinued*/  call ltwait
/*discontinued*/  out (c),h
/*discontinued*/  call ltwait
/*discontinued*/  out (c),l
/*discontinued*/  call ltwait
/*discontinued*/  out (c),d
/*discontinued*/  call ltwait
/*discontinued*/  out (c),e
/*discontinued*/  call ltrelease
/*discontinued*/  call die

ccssa:                  /Set Station Address
  call creprc
  call lrsym
  ld station,a
  out (er),a
  in a,(er)
  call die

/*discontinued*/ccsna:                  /Set Network Address
/*discontinued*/  call creprc
/*discontinued*/  call lrsym; ld h,a
/*discontinued*/  call lrsym; ld l,a
/*discontinued*/  call lrsym; ld d,a
/*discontinued*/  call lrsym; ld e,a
/*discontinued*/  ld net,hl
/*discontinued*/  ld net(2),de
/*discontinued*/  call die

ccptr:                  /Set Peek/Poke Pointer
  call creprc
  call lrsym
  ld ptr,a              /low-order byte first
  call lrsym
  ld ptr(1),a
  call die

ccpoke:                 /Poke one byte
  call creprc
  call lrsym
  ld hl,ptr
  ld (hl),a
  inc hl; ld ptr,hl     /increment pointer
  call die

ccpeek:                 /Peek one byte
  call creprc
  call ltclaim          /claim link transmitter
  ld a,poke
  out (lkc),a           /send POKE
  call ltwait
  ld hl,ptr
  ld a,(hl); inc hl     /increment pointer
  ld ptr,hl
  out (lkd),a           /send data byte
  call ltrelease        /release transmitter
  call die

ccack:                  /Discard packet
  ld hl,rdyexp
  xor a; or h
  jp z,badpsc
  call kill
  ld rdyexp(1),0
  ld pltpro(1),0
  ld hl,pltpro(2)       /Any more packets queued?
  xor a; or h
  jp z,intret           /No ->
  push hl; pop process
  ld hl,next
  ld pltpro(2),hl
  jp wake

ccrdy:                  /Accept packet
  ld hl,rdyexp
  xor a; or h
  jp z,badpsc
  push hl; pop process
  ld rdyexp(1),0
  jp wake

cccls:                      /Close a port
  call close
  ld port,#port0
  ld acklen,14
  jp intret

ccopn:                      /Open a port
  call close
  call creprc
  call ltclaim
  ld a,rdy
  call sign
  call ltrelease
  push process; pop hl
  ld stxexp,hl
  call wait
  ld a,station
  ld locs,a
  ld hl,net
  ld locn,hl
  ld hl,net(2)
  ld locn(2),hl
  ld hl,0
  ld rems,hl
  ld remn,hl
  ld remn(2),hl
  push port; pop hl
  ld de,16_4006-1
  call dolrdma
  ld acklen,14        /signify open
  call die

ccstx:                /Start of data frame
  ld hl,stxexp
  xor a; or h
  jp z,badpsc
  ld stxexp(1),0
  push hl; pop process
  jp wake

ccdtx:                /Packet coming
  xor a; or locp
  jr z,dtx0           /Port 0 ->
  ld a,acklen
  or a; jp nz,dtx1    /Open ->
  jp badpsc           /Closed =>
dtx0:
  ld a,station
  ld locs,a
  ld hl,net
  ld locn,hl
  ld hl,net(2)
  ld locn(2),hl
dtx1:
  call creprc
  call waitbuf        /acquire a buffer
  call ltclaim
  ld a,rdy
  call sign
  call ltrelease
  push port; pop hl   /set up packet header
  ld de,buffer
  ld bc,12
  ldir
  ex de,hl
  ld (hl),1; inc hl
  ld a,outseq; ld (hl),a
  inc a; jr nz,outplus; inc a
outplus: ld outseq,a
  push process; pop hl
  ld stxexp,hl
  call wait           /wait for STX
  ld a,locp           /port 0?
  or a; jr nz,dtx2    /no ->
  ld hl,buffer        /read dest ad bytes
  ld de,16_4000+datamax+header-1
  ld a,mode
  or a; jr nz,rawout  /transparent mode ->
  ld de,16_4006-1
  call dolrdma
dtx2:                 /read data part
  ld hl,buffer
  ld de,14; add hl,de
  ld de,16_4000+datamax-1
rawout:
  call dolrdma
  ld c,dmalr
  in hl,(c)          /end address (last byte + 1)
  push hl
  ld de,buffer
  or a; sbc hl,de    /transfer length
  inc hl; set 7,h    / - 1 + 2 for ET
  ld size,hl
  res 7,h
  dec hl; ex de,hl
  pop hl; ld (hl),e; inc hl; ld (hl),d
  ld hl,buffer       /force station address in case
  ld bc,6; add hl,bc /transparent mode
  ld a,station; ld (hl),a
  ld a,mode          /*echo*
  jr z,noecho        /*echo*
  ld size,de         /*echo*
  jp rawin           /*echo*
noecho:              /*echo*
  ld de,#petpro      /percolate through
  push port; pop hl
  add hl,de; call claim
  ld lives,retrlim
  jp loop1
loop:
  ld hl,#aretr
  call incl
loop1:
  call etclaim       /send the packet
retr:
  ld bc,etdmabit<<8+dmaet
  ld de,size
  ld hl,buffer
  call dodma
  in a,(es)          /read status
  and 16_80; jr z,dtx3 /no collision ->
  ld hl,#cretr
  call incl
  ld a,station
  out (et),a
  jr retr
dtx3:
  out (et),a         /reset transmitter
  call etrelease     /and release it
  ld hl,buffer       /was this a broadcast?
  ld a,(hl); or a
  ld a,ack; jr z,dtx4 /yes ->
  ld a,mode; or a    /transparent mode?
  ld a,ack; jr nz,dtx4 /yes ->
  ld a,retrlim+1     /wait for timeout period
  sub lives; ld b,a
backoff:
  ld a,retrgap; sub b
  ld timer,a
  call wait
  djnz backoff
  dec lives
  jr nz,loop         /keep going until bored
  ld a,nak
dtx4:
  call etclaim           /*new*/mutex on
  push port; pop hl
  ld de,#petpro
  add hl,de; call release
  call ltclaim
  call sign
  call ltrelease
  call etrelease         /*new*/mutex off
  call die

/(256-byte-aligned) interrupt table
  block 256-.&255
inttab:
  w intovf
  w interd
  w intetd
  w intdtc
  w intrcr
  w intrdr
  w inttbe
  w intspu

/Link control character despatch table
/(port-specific characters first)
cctable:
  w 0        /(cannot happen, denotes non-specific)
  w ccrdy    /10
  w ccstx    /20
  w ccdtx    /30
  w badpsc   /40
  w badpsc   /50
  w badpsc   /60
  w badpsc   /70
  w ccopn    /80
  w cccls    /90
  w badpsc   /A0
  w badpsc   /B0
  w ccack    /C0
  w badpsc   /D0
  w badpsc   /E0
  w badpsc   /F0
  w badnps   /00
  w ccdiag   /01
  w ccraw    /02
  w ccload   /03
  w badnps   /*discontinued*/ccena    /04
  w ccesa    /05
  w badnps   /*discontinued*/ccsna    /06
  w ccssa    /07
  w ccptr    /08
  w ccbon    /09
  w ccbof    /0A
  w badnps   /0B
  w badnps   /0C
  w ccpeek   /0D
  w ccpoke   /0E
  w 0        /0F

/ P R O C E D U R E S
/ All procedures except those listed here
/preserve the contents of all registers.
/ SELECT:   A<-A&??, PORT
/ CREPRC:   PROCESS, SP (SP preserved in INTSTACK)
/ LRSYM:    A
/ GETBUF:   HL, A
/ WAITBUF:  HL

/Address port A
select:
  and maxport
  push hl; push bc; push af
  ld l,a; ld h,0
  add hl,hl        /*2
  add hl,hl        /*4
  add hl,hl        /*8
  add hl,hl        /*16
  add hl,hl        /*32
  ld bc,#port0
  add hl,bc
  pop af; pop bc
  push hl; pop port
  pop hl
  ret

/Create a process
/Crash if none available
creprc:
  push af
  ld a,prolist(1)
  or a; call z,disaster
  ld process,prolist
  pop af; push hl
  ld hl,next
  ld prolist,hl
  ld next(1),0
  pop hl; ex (sp),hl
  ld (process+procsize-2),hl
  push process; pop hl
  push de; ld de,procsize-2
  add hl,de; ld temp,hl
  pop de; pop hl
  ld intstack,sp
  ld sp,temp
  ld buffer(1),0
  ret

/Report catastrophic error
disaster:
  call lthang
  ld a,15; out (lkc),a
  call lthang
  pop hl; ld a,h; out (lkd),a
  call lthang
  ld a,l; out (lkd),a
  call lthang
  ld sp,intstack
  jp idle

/Claim resource HL
/enqueue on HL+2 if unavailable
claim:
  push af
  inc hl; ld a,(hl)
  or a; jr nz,claim1     /resource held ->
  pop af; push de
  push process; pop de
  ld (hl),d
  dec hl; ld (hl),e
  pop de; ret
claim1:
  pop af; inc hl
  call enqueue
  dec hl; dec hl
  jr claim

/Claim Ether Transmitter
etclaim:
  push hl; ld hl,#etpro
  call claim
  pop hl; ret

/Claim Link Transmitter
ltclaim:
  push hl; ld hl,#ltpro
  call claim; pop hl

/+Wait for Link TBE
ltwait:
  push af
  in a,(ls); rra
  jr cy,ltw1
  ld a,inton
  or teintbit
  ld inton,a
  out (int),a
  call wait
  pop af
  jr ltwait
ltw1:
  pop af; ret

/Wait (non-interruptably) for Link TBE
lthang:
  push af
ltw2:
  in a,(ls); rra
  jr nc,ltw2
  pop af; ret

/Sign pscc with port number
sign: out (lkc),a
  call ltwait
  ld a,locp
  out (lkd),a
  ret

/Release resource HL
/signalling head of queue HL+2 if necessary
release:
  push hl
  inc hl; ld (hl),0
  push de; push af
  inc hl; ld e,(hl)
  inc hl; ld d,(hl)
  xor a; or d
  jr nz,rel2          /queue non-empty ->
rel1:
  pop af; pop de; pop hl; ret
rel2:
  ex de,hl            /HL=head, DE=queue+1
  inc hl; ld a,(hl); ld (de),a
  dec hl; dec de
  ld a,(hl); ld (de),a
  call signal
  jr rel1

/Release Link transmitter
ltrelease:
  push hl; ld hl,#ltpro
  call release
  pop hl; ret

/Release Ether transmitter
etrelease:
  push hl; ld hl,#etpro
  call release
  pop hl; ret

/Read symbol from link
lrsym:
  in a,(ls); and 16_40
  jr z,lrs1           /Not there yet ->
  in a,(lkd); ret
lrs1:
  ld lrpro,process
  call wait
  jr lrsym

/Put back buffer HL
/Signal buffer queue if necessary
putbuf:
  push hl; push de; push af
  ld de,buflist
  ld buflist,hl
  ld (hl),e
  inc hl; ld (hl),d
  ld a,bufque(1)
  or a; jr nz,putb2    /someone waiting ->
putb1:
  pop af; pop de; pop hl; ret
putb2:
  ld hl,bufque
  ld e,(hl); inc hl
  ld d,(hl)
  ld bufque,de
  ld (hl),0; dec hl
  call signal
  jr putb1

/Grab a buffer
/Address to HL
/A,CC Z iff none available
getbuf:
  ld hl,buflist
  xor a; or h; ret z    /No Go =>
  push de
  inc hl; ld d,(hl); ld (hl),0
  dec hl; ld e,(hl)
  ld buflist,de
  pop de
  ret

/Wait for a buffer
waitbuf:
  push af
  call getbuf
  jr z,wtb1
  pop af
  ld buffer,hl
  ret
wtb1:
  pop af
  ld hl,#bufque
  call enqueue
  jr waitbuf

/Signal to process HL
signal:
  push hl
  ld temp,sp
  ld sp,intstack
  push hl
  ld hl,#wakesp
  push hl
  ld intstack,sp
  ld sp,temp
  pop hl; ret

/Close a port
close:
  push af; push hl; push process
  ld a,station
  ld locs,a
  xor a
  ld inseq,a
  ld outseq,a
  ld acklen,a
  ld acklen(1),a
  ld lives,a
  ld timer,a
  ld rdyexp(1),a
  ld stxexp(1),a
  ld hl,pltpro
  ld pltpro(1),a
  or h; call nz,kill
  ld hl,petpro
  xor a
  ld petpro(1),a
  or h; call nz,kill
cl1:
  ld hl,pltpro(2)
  xor a; or h; jr z,cl2
  push hl; pop process
  ld de,next
  ld pltpro(2),de
  call kill
  jr cl1
cl2:
  ld hl,petpro(2)
  xor a; or h; jr z,cl3
  push hl; pop process
  ld de,next
  ld petpro(2),de
  call kill
  jr cl2
cl3:
  pop process; pop hl; pop af
  ret

/Kill process HL
kill:
  push process; push hl; push af
  push hl; pop process
  ld hl,prolist
  ld next,hl
  ld prolist,process
  xor a
  ld hl,buffer
  ld buffer(1),a
  or h; call nz,putbuf
  pop af; pop hl; pop process
  ret

/Routine to start DMA and wait for completion
/ HL -> buffer
/ DE =  bytecount-1 plus direction bit
/ C  =  DMA sub device address
/ B  =  DMA activation bit
dodma:
  push af; push bc; push hl
  out (c),hl
  inc c
  out (c),de
  ld a,dmaon
  or b; ld b,a
  xor a; out (dma),a
  in a,(dma)
  cpl; and b
  out (dma),a
  ld dmaon,a
  xor b; ld hl,#dmaoff
  or (hl); ld (hl),a
  pop hl; pop bc; pop af
  call wait
  ret

/Do Link Receiver DMA
/turning data interrupts off for
/the duration of the DMA
/ HL -> Buffer
/ DE =  bytecount-1 plus direction bit
dolrdma:
  ld lrpro,process      /auto-claim
  push af
  ld a,inton
  and 255-rdintbit
  ld inton,a
  out (int),a           /interrupts off
  pop af; push bc
  ld bc,lrdmabit<<8+dmalr
  call dodma
  pop bc; ret

/Increment 32-bit counter
incl:
  push hl
  inc (hl); jr nz,incl1
  inc hl; inc (hl); jr nz,incl1
  inc hl; inc (hl); jr nz,incl1
  inc hl; inc (hl)
incl1:
  pop hl; ret

/Convert channel number (in A) to address of
/byte containing spectrum bit (in HL) and the
/appropriate bit in A.
prism:
  and nchans-1
  push bc
  ld b,a; srl a
  srl a; srl a
  ld hl,#spectrum
  add a,l; ld l,a
  jr nc,pri1
  inc h
pri1: ld a,7; and b
  ld b,a; inc b      / 1<=B<=8
  xor a; scf
pri2: rla; djnz pri2
  pop bc
  ret

sysend:
  end