; **** Vestric Link Protocol Handler ****
pif equ 0
base equ 6800h
suspend equ 0109h ; Block Voluntarily
listen equ 012ah ; Z = Modem Character -> A
clock equ 0133h ; Date & Time -> (DE)
timer equ 014bh ; Load Slow Timer with DE units
pcheck equ 01a8h ; Z=Access Code & Password at (HL) correct
;
launch equ 2003h ; spawn vdu & reporter
spooler equ 2012h
wait equ 2015h
putif equ 2018h ; A -> Modem if DSR is on
dsr equ 201bh ; terminate if DSR OFF
cut equ 201eh ; force disconnect
cmsg equ 5600h ; Customer Message save area (512 bytes)
;
sec equ 1200 ; Slow Timer frequency 1200Hz
cint equ sec/30 ; Char interval (sec/bit rate)*10
;
nul equ 00h
soh equ 01h
stx equ 02h
etx equ 03h
eot equ 04h
enq equ 05h
so equ 0eh
dle equ 10h
nak equ 15h
etb equ 17h
page equ 5ch ; Vestric page separator
sep equ 7eh ; Vestric field separator
time equ 7fh
s equ 80h
;
; Z80 OP Codes--
djnz equ 00010h
ldir equ 0b0edh
cpir equ 0b1edh
;
; Inter-Task Communication--
ctl equ 01d0h ; System Control Block
hstate equ ctl ; B0: Call connected
; B1: Order Spooled
; B3: Rx done
; B4: Tx done
; B5: DSR fail
; B6: Cancelled, incorrectly received
; B7: Done
rxrecs equ ctl+1 ; Rx Records Received count
hptr equ ctl+4 ; -> sub-header
sxrecs equ ctl+7 ; Tx Records Sent count
area equ ctl+8 ; -> data storage area
lrecl equ ctl+10 ; = record length (bytes)
mstate equ ctl+12 ; B0: Electronic (not Terminal) Mode
; B1: Passing Rx data to M18
; B2: Despooling Rx data
; B3: Spooling Rx data
; B4: KYBD requests M18 Terminal Mode
; B5: M18 has refused order
; B7: Done
txrecs equ ctl+13 ; Tx Records ready count
name equ ctl+19 ; -> A/C Name & Address or Reason Refused
naks equ ctl+26 ; Count of records nak'ed
;
org base
shld frame !mov a,m !cpi enq !rnz !inx h !mov a,m !ora a !rnz
mvi a,9ah !call putif !call odd4 !rnz !cpi enq !rnz
;
; ************* V1 Protocol Handler *************
call rxset !lxi h,cmsg !shld hptr !shld cptr !call v1rx
call field !jnz $-3 !lhld rptr !mvi m,eot !lxi h,rxrecs !inr m
lhld area !shld rptr !xra a !sta tos
lxi h,hstate !dw 0decbh ; SET 3,(HL); Rx done
lxi h,try !mvi m,0ffh ; 1st time Tx flag
lxi h,mstate !dw 04ecbh ; BIT 1,(HL); processing Rx data
cz notos !cnz sx ; Tx
call rxbid !call field !mvi a,'Y' !jz cut
lxi d,t4 !call match !jnz ditch !call field !jnz $-3
lxi h,hstate !dw 0e6cbh ; SET 4,(HL); Tx done
mvi b,6 !call seot !mvi a,'Z' !jmp cut ; disintegrate
;
notos call spooler !lxi h,vr2 !call tx !lxi h,sxrecs !inr m !xra a !ret
;
sx0 call v1tos !lxi h,sxrecs !inr m
sx call suspend !lxi h,txrecs !lda sxrecs !cmp m !jnz sx0
call dsr !lda mstate !ora a !jp sx !ani 20h !rz
lhld name !call tx !lda rxrecs !sta sxrecs !ret ; order refused
v1tos ora a !rz !call bump ; skip Header
mov a,m !cpi eot !jz vt1 ; Trailer
lxi d,16 !dad d !mov a,m !cpi ' ' !rz ; full delivery
sta vr3c !inx h !lxi d,vr3b !lxi b,5 !dw ldir ; flag & TOS
lxi d,vr3a !lxi b,43 !dw ldir ; Description
mvi a,sep !sta vr3a+30 ; split line
lhld rptr !lxi d,vr3+6 !lxi b,4 !dw ldir ; PIP Code
inx d !lxi b,4 !dw ldir
lxi d,vr3+20 !lxi b,5 !dw ldir ; Qty
lxi h,tos !inr m !lxi h,vr3 !jmp tx
vt1 inx h !jmp tx
;
vh0 ora m !mov m,a !lhld savehl !dw 04bedh,savebc ; move field -> cmsg
inx b !dw 05bedh,cptr,ldir,053edh,cptr ; LD DE,() ; LDIR ; LD (),DE
v1rx call v1item !xra a !call m0 !cnz m1 !cnz m2 ; process Header fields
lxi h,vflag !jz vh0 !xra a !dw 04ecbh ; BIT 1,(HL)
jz vh0 !lhld cptr !mvi m,nul ; looks like end of Header
lhld area !shld rptr !xchg !lxi h,v1id !lxi b,16 !dw ldir
call launch !call bump !jmp v1line+3 ; 1st line is ready
v1line call v1item !call m3 !rz !dw 05bedh,rptr ; LD DE,(rptr)
lxi h,pad !lxi b,17 !dw ldir ; preset defaults
lhld savehl !dw 04bedh,savebc ; LD BC,(savebc)
mov a,m !cpi '0' !jc v1line !cpi '9'+1 !jnc v1line ; not numeric
call vcode !call vqty
lxi h,rxrecs !inr m !call bump !jmp v1line
;
vcode mvi b,0 !lxi d,wsfq-1
vc1 call puc !jz vc2 !cpi '*' !jz vc2 !inx d !stax d !inr b !jmp vc1
vc2 mov a,b !ora a !rz !cpi 9 !jc $+5 !mvi a,8 ; truncate
push b !push h !lhld rptr !lxi b,7 !dad b !xchg
mov c,a !dw 0b8edh ; LDDR ; move PIP/Product Code
pop h !pop b !ret
;
vqty mov a,c !ora a !rz ; defaults
lxi d,wsfq !mvi b,0
mvi a,' ' !stax d !inx d !stax d !inx d !stax d
vq1 mov a,m !inx h !cpi '*' !jz vq3
cpi 'B' !jnz $+6 !sta wsfq !cpi 'C' !jnz $+6 !sta wsfq+1
cpi '0' !jc vq2 !cpi '9'+1 !jnc vq2
inx d !stax d !inr b
vq2 dcr c !jnz vq1
vq3 mov a,b !lhld rptr !lxi b,12 !dad b !xchg
ora a !jz vq4 !cpi 6 !jc $+5 !mvi a,5 ; truncate
push d !mov c,a !dw 0b8edh ; LDDR ; move Qty
pop d
vq4 inx d !lxi h,wsfq !lxi b,3 !dw ldir ; move Flags
ret
;
m0 lxi d,t0 !call match !rnz ; "ORDER SET "
lxi d,vr1+10 !mvi b,3 !call mpad !mvi a,1 !ret
m1 lxi d,t1 !call match !rnz !dad b !lxi d,-10 !dad d ; "ACC "
push h !call pcheck !pop h !jnz wp
m1pif lxi d,v1id+2 !lxi b,5 !dw ldir
mvi a,2 !ret
m2 lxi d,t2 !call match !rnz ; "REF "
lxi d,v1id+7 !mvi b,8 !call mpad !mvi a,4 !ret
m3 lxi d,t3 ; "ORDER END"
match lhld savehl !dw 04bedh,savebc ; LD BC,(savebc)
ma1 ldax d !inx d !ora a !rz !cmp m !inx h !dcx b !rnz !jmp ma1
;
wp IF pif
lxi d,5 !dad d !jmp m1pif
ENDIF
mvi a,s+'C' !lxi h,msg2 !jmp cut
;
mpad call puc !stax d !inx d !dw djnz+(mpad-$-2)*256
xra a !ret ; Z=1
puc mov a,c !ora a !mvi a,' ' !rz !dcr c !mov a,m !inx h
cpi 'a' !rc !cpi 'z' !jz $+4 !rnc !sui 20h !ret
;
ditch mvi a,s+'B' !lxi h,msg1 !jmp cut
;
v1item call field !rnz !mvi a,'Y' !jmp cut
field lhld fptr !dw 04bedh,roc ; LD BC,(roc)
fi0 mov a,b !ora c !jnz fi1 !call rx !rz !jmp fi0
fi1 push h !mvi a,sep !dw cpir,043edh,roc ; CPIR ; LD (roc),BC
shld fptr !jnz $+4 !dcx h !pop d
ora a !dw 052edh ; SBC HL,DE ; leaves length
jz field !mov b,h !mov c,l !shld savebc !xchg !shld savehl !ret
;
rx lxi h,try !mvi m,6 !call listen !jz $-3 ; flush buffer
rx0 call rxe !mvi a,dle !call puto
lda ackn !rrc !mvi a,'0' !jnc $+5 !mvi a,'1' !call puto
rx1 call odd4 !jnz rx5 !cpi enq !jz rx0
cpi eot !jz rx6 !cpi stx !jnz rx1
lxi h,0 !shld crcws !lhld frame !lxi b,-2
rx2 call oddi !jnz rx3 !mov m,a !call crc !inx h !inx b
mov a,b !cpi 2 !jnz rx2 !mvi a,'7' !jmp cut ; > 512 chars
rx3 xchg !lhld crcws !mov a,h !ani s !ora l !jnz rx4
xchg !dcx h !dcx h !mov a,m !mvi m,nul
cpi etx !jz $+5 !cpi etb !jnz rx4 !sta tail
lxi h,ackn !inr m !lhld frame !ora a !ret ; Z=0, C=0
rx4 call err !call rxe !mvi a,nak !call puto !jmp rx1 ; garbled data
rx5 call rxe !jmp rx1 ; no data
rx6 lda tail !xri etx !jnz rx0 !ret ; Z=1, C=0
rxe lxi h,try !dcr m !rp !mvi a,'6' !jmp cut ; retry count expired
;
txbid xra a !sta ackn !mvi a,etb !sta tail
call listen !jz $-3 !lxi h,trye !mvi m,8
tb0 lxi h,trye !dcr m !mvi a,'5' !jm cut !mvi a,enq !call puto
lxi d,2*sec !call timer !call oddw !jnz tb0 !cpi dle !jnz $-8
call oddi !jnz tb0 !lxi h,ackn !dw 046cbh ; BIT 0,(HL)
mvi e,'0' !jz $+5 !mvi e,'1' !cmp e !cnz flush !jnz tb0
inr m !lxi d,vr1a !call clock
lhld savehl !push h !lxi h,vr1 !call tx !pop h
tx shld savehl !lxi h,try !inr m !mvi m,6 !jz txbid
tx0 lxi h,try !dcr m !mvi a,'4' !jm cut ; retry count expired
lxi h,0 !shld crcws !mvi a,stx !call puto !lhld savehl
tx1 mov a,m !inx h !ora a !jz tx2 !call putc !jmp tx1
tx2 mvi a,sep !call putc !lda tail !call putc !lda crcws !call puto
call listen !jz $-3 !lxi h,trye !mvi m,6 !jmp ry1
ry0 call rye !mvi a,enq !call puto
ry1 lxi d,3*sec !call timer
ry2 call oddw !jnz ry0 !cpi nak !jz ry4 !cpi dle !jnz ry2
call oddi !jnz ry0 !lxi h,ackn !dw 046cbh ; BIT 0,(HL)
lxi d,'01' !jz $+6 !lxi d,'10'!cmp e !jnz ry3 !inr m !ret
ry3 cmp d !cnz flush !jnz ry0
ry4 call err !jmp tx0
rye lxi h,trye !dcr m !rp !mvi a,'5' !jmp cut ; retry count expired
;
rxbid lda rxrecs !sui 2 !lxi d,vr0 !call ba3 ; Lines Taken
lxi h,vr0 !mvi a,etx !sta tail !call tx
lxi h,try !mvi m,3 !lxi h,hstate !dw 0e6cbh ; SET 4,(HL)
rb0 lxi h,try !dcr m !mvi a,'8' !jm cut
mvi a,eot !call puto !lxi d,3*sec !call timer
call oddw !jnz rb0 !cpi enq !jnz $-8
rxset xra a !sta ackn !sta tail !sta vflag !lxi h,0 !shld roc !ret
;
seot mvi a,eot !call puto !lxi d,sec/2 !call timer
call wait !jz $-3 !dw djnz+(seot-$-2)*256
ret
;
crc push psw !push h !mov e,a
lhld crcws !ora h !mov h,a !mov a,e !xra l !mov l,a
shld crcws !pop h !pop psw !ret
;
err lhld naks !inx h !shld naks !ret
;
odd4 lxi d,4*sec !jmp oddi+3
oddi lxi d,cint*4 !call timer
oddw call wait !rnz
ora a !jpo $+8 !ori s !jmp $+5 !ani 7fh !cmp a !ret ; Z=1
flush call oddi !rnz !jmp flush
;
putc call crc
puto ora a !jpo $+5 !ori s !jmp putif ; ensure odd parity
;
bump lhld lrecl !xchg !lhld rptr !dad d !shld rptr !ret
;
; A -> (DE) 3 ASCII chars--
ba3 push h !mvi h,' ' !lxi b,100 !call digit !lxi b,10 !call digit
ori '0' !stax d !inx d !pop h !ret
; Divide A by 10, convert to ASCII--
digit inr b !sub c !jnc digit !add c !mov l,a ; save remainder
mov a,h !dcr b !jz di1 !mvi h,'0' !mov a,b !ori '0'
di1 stax d !inx d !mov a,l !ret ; remainder -> A
;
t0 db 'ORDER SET ',nul
t1 db 'ACC ',nul
t2 db 'REF ',nul
t3 db 'ORDER END',nul
t4 db 'OK',nul
v1id db 'V2 0000 ',nul
pad db '0000000000001 ',nul
msg1 db s+2,'****** ',time,so,' Strange frame received:-',nul
msg2 db s+2,so,'*** Wrong password:',nul
null db nul
vr0 db 'nnn LINES TAKEN ',sep,'REPLY END',nul
vr1 db 'REPLY SET xxx ',sep,'Sent '
vr1a db 'ddd dd mmm yy hh:mm:ss',nul
vr2 db 'Stock not checked',nul
vr3 db page,'ORD pppp-pppp Qty nnnnn',sep
vr3a db 'd123456789d123456789d123456789',sep,'packsize pre',sep
db 'Regret '
vr3b db 'nnnnn Out-of-Stock ('
vr3c db 'f)',nul
frame ds 2 ; -> input buffer (1K)
rptr ds 2 ; -> current record in data area
cptr ds 2 ; -> next position in cmsg area
crcws ds 2
tos ds 1 ; Count of TOS lines
ackn ds 1 ; Current Ack
tail ds 1 ; most recent etb/etx
try ds 1 ; error retry counter
trye ds 1 ; enq retry counter
vflag ds 1 ; V1 Header field flags
fptr ds 2 ; field pointer
roc ds 2 ; remains of count, current frame
savehl ds 2
savebc ds 2
wsfq ds 16 ; w/s for flags & qty
end base