; **** ALPHA II Session Procedure & Protocol **** base equ 5c00h suspend equ 0109h ; Block Voluntarily pcheck equ 01a8h ; Z = Access Code & Password at (HL) correct kbsw equ 0fe52h ; Keyboard Switch Status ; launch equ 02003h rx equ 0200ch tx equ 0200fh spooler equ 02012h dsc equ 0201bh cut equ 0201eh cmsg equ 05600h ; Customer Message save area ; nul equ 00h eot equ 04h lf equ 0ah so equ 0eh time equ 7fh s equ 80h ; ; Z80 OP Codes-- djnz equ 00010h ldir equ 0b0edh ; ; Inter-Task Communication-- label equ 01c2h ; -> spool Diskette Label ctl equ 01d0h ; System Control Block hstate equ ctl ; B0: Call connected ; B1: Order Spooled ; B2: Long Fields ; B3: Rx done ; B4: Tx done ; B5: DTR dropped ; B7: Telecomms process terminated 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 tstate equ ctl+18 ; B6: RVI request name equ ctl+19 ; -> A/C Name & Address or Reason Refused ; org base lhld area !shld rptr !xchg !shld item mov a,b !lxi b,15 !cpi '4' !jnz a1; S/w version 2nd byte lda hstate !ori 04h !sta hstate ; B2: Long Fields push h !lxi b,7 !dw ldir pop h !inx h !inx h !mov a,m !ori '0' !mov m,a push d !call pcheck !pop d !jnz cutc !lxi b,8 a1 dw ldir push d !lxi d,cmsg !xchg !shld hptr !xchg !lxi b,451 !dw ldir pop d !call cref !call launch !call bump !call msg nblk call rx !cc rvi !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); Rx done 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 !lxi h,hstate !dw 0e6cbh ; SET 4,(HL) ; Tx done lda rxrecs !sta sxrecs !xra a !ret ; Z=0 ; notos call spooler !lda mstate !ani 40h !lxi h,nrec !rz xra a !sta tos !lxi h,crec !ret ; cancel TOS Report ; ; 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 dsc !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 ; cref mvi b,8 ; insert default C/ref if blank cr1 dcx d !ldax d !cpi ' ' !rnz !dw djnz+(cr1-$-2)*256 lhld label !lxi b,2ah !dad b !lxi b,8 !dw ldir ; default C/ref 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 ; ; 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 ; cutc lhld item !lxi d,cmsg !lxi b,32 !dw ldir ; save Header lxi h,tstate !dw 0f6cbh ; SET 6,(HL) ; request RVI call rx !lxi h,tx0 !cc rvic lhld item !xchg !lxi h,cmsg !lxi b,32 !dw ldir ; restore mvi a,s+'C' !lxi h,ln1 !jmp cut ; ; Send text (HL)... msgs lda sxrecs !inr a !sta sxrecs mov a,m !ora a !rz !inx h !mvi b,0 !mov c,a push h !dad b !xthl !call tx !pop h !jmp msgs ; msg lda kbsw !ani 02h !rz ; [SF3] requests message lxi h,tx1 !mov a,m !ora a !rz ; no RVI text lxi h,tstate !dw 0f6cbh ; SET 6,(HL) ; request RVI ret ; rvi lxi h,tx1 rvic call msgs lhld area !inx h !mov a,m !cpi '2' !cz rx ; dup. Header xra a !sta sxrecs !jmp rx ; tx0 db tx1-$-1,'Your password is wrong!',lf tx1 db 0 ; no message ; 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 ; -> Telecomms Line Buffer end base