; **** Richardsons Protocol Handler **** base equ 7000h suspend equ 0109h ; Block Voluntarily listen equ 012ah ; Z = Modem Character -> A timer equ 014bh ; Load Slow Timer with DE units pcheck equ 01a8h ; Z = Access Code & Password at (HL) correct ; launch equ 02003h spooler equ 02012h wait equ 02015h putif equ 02018h dsr equ 0201bh cut equ 0201eh cmsg equ 05600h ; 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 stx equ 02h etx equ 03h eot equ 04h enq equ 05h ack equ 06h so equ 0eh s equ 80h ; ; Z80 OP Codes-- djnz equ 00010h ldir equ 0b0edh sspd equ 073edh ; LD (nn),SP lspd equ 07bedh ; LD SP,(nn) ; ; Inter-Task Communication-- label equ 01c2h ; -> spool Diskette Label ctl equ 01d0h ; System Control Block hstate equ ctl ; B0: Call connected ; B1: Order Spooled ; B3: Rx done ; B4: Tx done ; B5: DSR fail ; 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 ; B6: Electronic Mode axed ; B7: Done txrecs equ ctl+13 ; Tx Records ready count flags equ ctl+18 ; B6: RVI request name equ ctl+19 ; -> A/C Name & Address or Reason Refused naks equ ctl+26 ; Count of records Nak'ed ; org base shld item !mov a,m !cpi enq !rnz !inx h !mov a,m !ora a !rnz mvi a,enq !call putif !call wait4 !rnz !cpi enq !rnz xra a !sta blkno !sta btype !sta ackn call rx !mvi a,'Y' !jz cut ; get Header push h !xchg !lhld area !shld rptr !xchg !lxi b,7 !dw ldir pop h !push d !mov a,m !inx h cpi 'R' !jnz cuta !mov a,m !cpi '1' !jz h3 !cpi '2' !jnz cuta lda hstate !ori 04h !sta hstate ; B2: Long Fields h3 inx h !call pcheck !pop d !jnz wp !lxi b,8 !dw ldir push d !lxi d,cmsg !xchg !shld hptr !xchg !lxi b,451 !dw ldir pop d !mvi b,8 h1 dcx d !ldax d !cpi ' ' !jnz h2 !dw djnz+(h1-$-2)*256 lhld label !lxi b,2ah !dad b !lxi b,8 !dw ldir ; default C/ref h2 call launch !call bump ; nblk call rx !jz rxdone !push h !dad b !xthl nline pop b !mov d,h !mov e,l !ora a !dw 042edh ; SBC HL,BC jnc nblk !xchg !push b !call unpack !push h call cdgen !call bumpup !pop h !jmp nline rxdone 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) lxi h,try !mvi m,0ffh ; 1st time Tx flag lxi h,mstate !dw 04ecbh ; BIT 1,(HL); processing Rx data cnz sx !cz notos lxi d,erec+2 !lxi b,2 !call move !lxi h,erec !call tx lda rxrecs !sta sxrecs !call seot lxi h,hstate !dw 0e6cbh ; SET 4,(HL); Tx done call seot !call seot !call seot !call hsec !mvi a,'Z' !jmp cut ; notos call spooler !lda mstate !ani 40h !lxi h,nrec !rz xra a !sta tos !lxi h,crec !ret ; cancel TOS Report ; wp mvi a,s+'C' !lxi h,ln1 !jmp quit ; wrong password ; seot mvi a,stx !call putif !lxi h,-1 !shld crcws lda blkno !call putc !mvi a,eot !call putc xra a !call putc !mvi a,etx !call putc lhld crcws !mov a,l !call putif !mov a,h !call putif hsec call waith !jz $-3 !ret ; unpack mov d,m !inx h !mov e,m !inx h !push d ; Qty dw 05bedh,rptr ; LD DE,(rptr) call upip ; unpack PIP/Product Code xthl !push psw !call bd5 !pop b !pop h ; Qty -> 5 ASCII mvi a,'B' !call flag ; Back Order flag mvi a,'C' !call flag ; Case Qty flag mvi a,' ' ; spare flag flag dw 038cbh ; SRL B jc $+5 !mvi a,' ' !stax d !inx d !ret ; ; Regenerate Check Digit-- cdgen lhld rptr !mvi c,0 !dw 038cbh ; SRL B jc mod26 call x2 !call x1 !call x1 !call x1 xra a !sub c !jp $+8 !adi 10 !jm $-2 !ori '0' !mov m,a !ret mod26 inx h !inx h ; skip 2 digits call x0+2 !rlc !rlc !rlc ; 10000x8 call x0 !rlc !mov b,a !rlc !add b ; 1000x6 call x0 !rlc !rlc ; 100x4 call x0 !mov b,a !rlc !rlc !add b ; 10x5 call x0 !mov b,a !rlc !add b !add c ; 1x3 sui 26 !jnc $-2 !adi 'A'+26 !mov m,a !ret ; x0 add c !mov c,a !mov a,m !inx h !ani 0fh !ret x1 mov a,m !inx h !ani 0fh !add c !mov c,a x2 mov a,m !inx h !ani 0fh rlc !cpi 10 !jm $+5 !sui 9 !add c !mov c,a !ret ; upip lda hstate !ani 04h !cnz up2 !jnz up6 ; B2: Long Fields call up1 !call up1 ; insert 2 leading zeros up6 call up2 !call up2 up2 mov a,m !rrc !rrc !rrc !rrc !call up1 !mov a,m !inx h up1 ani 0fh !ori '0' !stax d !inx d !ret ; ; Send TOS Report-- sx xra a !call send0 ; acknowledge Rx promptly sx0 lxi h,sxrecs !inr m sx1 call suspend !lxi h,txrecs !lda sxrecs !cmp m !jnc sx3 call bump !mov a,m !cpi eot !jz sx2 !call send !jmp sx0 sx2 inx h !lda tos !inr a !sta tos !ret ; HL-> Outcome, Z=0 sx3 call dsr !lda mstate !ora a !jp sx1 ani 40h !xri 40h !lhld name !ret ; Z=0 if refused, Z=1 if axed ; send lxi d,16 !dad d !mov a,m !cpi ' ' !jz se1 ; full delivery lxi d,trec !stax d !inx d ; Flag lda sxrecs !stax d !inx d ; Line No lda hstate !ani 04h !jnz $+5 !inx h !inx h ; B2: Long Fields inx h !lxi b,2 !call move ; TOS Qty, text lxi h,tos !inr m !lxi h,trec !jmp tx se1 lxi h,sxrecs !lda txrecs !dcr a !cmp m !rnz ; later lines ready send0 lxi h,prec+1 !mov m,a !dcx h !lxi b,2 !jmp tx ; move mov a,m !ora a !rz !stax d !inx h !inx d !inx b !jmp move ; bumpup lxi h,rxrecs !inr m bump lhld lrecl !xchg !lhld rptr !dad d !shld rptr !ret ; ; HL -> (DE) 5xASCII-- bd5 lxi b,10000 !call digit !lxi b,1000 !call digit lxi b,100 !call digit !lxi b,10 !call digit mvi a,'0' !ora l !stax d !inx d !ret digit xra a di1 inr a !dw 042edh ; SBC HL,BC jnc di1 !dad b !adi '0'-1 !stax d !inx d !ret ; cuta mvi a,'A' !jnz cut ; wrong tag ; ; Receive Frame-- rx lxi h,try !mvi m,6 !call listen !jz $-3 ; flush buffer rx0 lxi h,try !dcr m !mvi a,'6' !jm cut ; retry count expired mvi a,ack !call putif !lda ackn !call putif rx1 call wait4 !jnz rx3 !cpi enq !jz rx0 !cpi stx !jnz rx1 lxi h,-1 !shld crcws !lhld item call wait10 !jnz rx0 !call plonk ; Block Number call wait !jnz rx0 !call plonk ; Block Type call wait !jnz rx0 !mov b,a !inr b ; Data Length rx2 call plonk !call wait !jnz rx0 !dw djnz+(rx2-$-2)*256 cpi etx !cnz flush !jnz rx0 !mvi m,nul !call crc call wait !jnz rx0 !call crc !call wait !jnz rx0 !call crc lhld crcws !mov a,h !ora l !cnz err !jnz rx0 ; CRC fail lhld item !lda blkno !inr a !sub m ; expected - actual block no mov a,m !inx h !jm $+6 !sta ackn !jnz rx0 !sta blkno mov a,m !inx h !mvi b,0 !mov c,m !inx h sta btype !xri eot !jz rx !ret ; Z=0, C=0 rx3 lda btype !xri eot !jnz rx0 !ret ; Z=1, C=0 ; tx shld savehl !mov b,c !mvi c,1 !dw 043edh,savebc ; LD (savebc),BC lxi h,try !inr m !mvi m,6 !cz txbid tx0 lxi h,try !dcr m !mvi a,'4' !jm cut ; retry count expired lxi h,-1 !shld crcws !lhld savehl !dw 04bedh,savebc; LD BC,(savebc) mvi a,stx !call putif !lda blkno !call putc xra a !call putc !mov a,b !call putc tx1 mov a,b !ora a !jz tx2 !dcr b !mov a,m !inx h !call putc !jmp tx1 tx2 mvi a,etx !call putc lhld crcws !mov a,l !call putif !mov a,h !call putif call listen !jz $-3 !lxi h,trye !mvi m,6 !jmp ry1 ry0 lxi h,trye !dcr m !mvi a,'5' !jm cut !mvi a,enq !call putif ry1 lxi d,3*sec !call timer !call wait !jnz ry0 !cpi ack !jnz $-8 call wait3 !jnz ry0 !lxi h,blkno !sub m !jnz ry2 !inr m !ret ry2 cpi 0ffh !cnz flush !jnz ry0 !call err !jmp tx0 ; go again ; txbid xra a !sta blkno call listen !jz $-3 !lxi h,trye !mvi m,6 bd0 lxi h,trye !dcr m !mvi a,'5' !jm cut !mvi a,enq !call putif lxi d,3*sec !call timer !call wait !jnz bd0 !cpi ack !jnz $-8 call wait3 !jnz bd0 !lxi h,blkno !sub m !cnz flush !jnz bd0 inr m !ret ; putc call crc !jmp putif plonk mov m,a !inx h crc push psw !push b !push h lhld crcws !lxi d,8408h !mvi b,8 !xra l !mov l,a cc1 dw 03ccbh,01dcbh ; SRL H ; RR L ; Shift HL right jnc cc2 !mov a,h !xra d !mov h,a !mov a,l !xra e !mov l,a cc2 dw djnz+(cc1-$-2)*256 shld crcws !pop h !pop b !pop psw !ret ; err lhld naks !inx h !shld naks !ret ; wait10 lxi d,10*sec !jmp waiti+3 wait4 lxi d,4*sec !jmp waiti+3 wait3 lxi d,3*sec !jmp waiti+3 waith lxi d,sec/2 !jmp waiti+3 waiti lxi d,cint*4 !call timer !jmp wait flush call waiti !rnz !jmp flush ; quit push h !lhld item !mvi m,' ' !inx h !mvi m,' ' !inx h mvi m,' ' !pop h !jmp cut ; ln1 db s+2,so,'*** Wrong password:',nul nrec db 'Stock not checked',nul crec db 'Stock check abandoned',nul prec db ' ' ; TOS progress record rptr dw 0 ; -> current record in buffer area erec db eot tos ds 1 ; Count+1 of TOS lines (0=not available) trec ds 54 item ds 2 ; -> input buffer (1K) crcws ds 2 ackn ds 1 ; Current Ack blkno ds 1 ; Current Block Number btype ds 1 ; block type code try ds 1 ; error retry counter trye ds 1 ; enq retry counter savehl ds 2 savebc ds 2 end base