subttl kutil/mac utilities and other odd routines extrn rlen,slen,csvc,rsvc,ssvc,r,n,mjump extrn spaket,rpaket,byte,recptr,sinit extrn fcb,lrecl,filbuf,recbuf,lrecl,paraml public flush,rplus,abort,exit,acsum,spack public open,close,writnx,readnx,kill public rpack,initcm extrn init,port,altsvc,nsvc ; ; useful symbole ; soh equ 1 tout equ 10 len equ 0 seq equ 1 type equ 2 data equ 3 dfport equ 'A' ; ; ;timer to interrupt a given routine after a number of seconds ; syntax timer routin,seconds ; where routin is the interrupt handler ; timer macro routin,second push hl push bc ld hl,routin ;routine to jump to ld bc,second ;number of seconds svc 25 ;timer call pop bc pop hl endm ; ;svc to make a trsdos supervisor call ; syntax svc code ; where code is the trsdos code ; svc macro code ld a,code rst 8 endm ; ; ;prmes to print messages on the screen ; syntax prmes lab ; where lab if the label as defined with mssg ; prmes macro lab .xlist extrn m_&lab,l_&lab push hl push bc ld hl,m_&lab ;get address of message ld bc,(l_&lab) ;and length ld c,13 ;add a CR at end of ttyout svc 9 ;call dos pop bc pop hl .list endm ; ;blmov to move a block of text ; syntax blmov source,destination,length ; if length is 0 then assume 256 ; blmov macro source,dest,len .xlist local $1,$2 push hl push bc push de ld hl,source ;address of source ld de,dest ;address of destination ld a,(len) ;get length cp 0 ;is it zero ? jr nz,$1 ld b,1 ;then set bc = 256 ld c,0 ;(b=1 ; c=0) jp $2 ;go to start move $1: ld b,0 ld c,a ;bc = length $2: ldir ;move and check if bc=0 pop de pop bc pop hl .list endm ; ;readnx to read next record sequentially ; Returs with the record in recbuf ; And, at eof, will jump to sendeof ; (This macro will not save redisters) ; readnx: ld de,fcb ;file control block svc 34 ;read next svc jp nz,abort ;bad read, abort ld a,(lrecl) ;get logacal record length cp 0 ;is it 256 ? jp nz,read0 ;no, all is ok blmov filbuf,recbuf,lrecl ;move to recbuf read0: ret ; ;open open a file according to fcb and paramlist ; open: push hl push de ld de,fcb ;file control block ld hl,paraml ;parameter list svc 40 ;open call jp nz,abort ;file not found ;or file cannot create pop de pop hl ret ; ;kill kill a file using current fcb ; kill: push de ld de,fcb ;file control block svc 41 ;kill call jp nz,abort ;no good (password ?) pop de ret ; ;close file using current fcb ; close: push de ld de,fcb svc 42 jp nz,abort xor a ;clr a ld (recptr),a ;reset pointer to 0 pop de ret ; ;writnx write next sequential record ; writnx: ld a,(lrecl) ;get logical record length cp 0 ;is it 256 ? jp nz,writ0 ;no, go on blmov recbuf,filbuf,lrecl ;get to filbuf writ0: push de ld de,fcb ;file control block svc 43 ;write call jp nz,abort ;no good pop de ret ; ;delay in seconds ; delay macro sec .xlist local $1 push bc ld bc,0 ;set for 426 milisecs push hl ld l,sec ;number of seconds $1: svc 6 ;call for delay svc 6 ;2 * 426 milisecs = 1 s. dec l ;sec-- xor a ;a = 0 cp l ;sec = 0 ? jr nz,$1 ;no, play it again sam pop hl pop de .list endm ; ;jumptb jump according to a given table and a one byte code ; ; syntax jumptb table,code ; jumptb macro table,code .xlist local $1 ld hl,table ;get jump table address ld bc,(code) ;and code (note that c is messed up) ld a,c ld b,a svc 28 ;lookup call jr z,$1 ;found ld hl,table+1 ;get abort address $1: jp (hl) ;bye ... .list endm ; ;initcm initalise comm channel A or B ; and set up correct svc communication calls ; initcm: ld a,(init) ;get initial code cp 0 ;should we init ? jr z,i1 ;no, go set up svc ; ld hl,port ;get port paramlist ld b,0 ;turn off port svc 55 ;dos call ld b,1 ;turn on svc 55 ;dos call i1: ld a,(port) ;get channel A or B cp dfport ;is this default ? jr z,i2 ;yes, all ok blmov altsvc,init,nsvc;set up alternate svc's i2: ret ; ;xmitb transmit a byte that is pointed to by hl ; xmitb macro .xlist local $1 $1: ld a,(ssvc) ;get transmit svc ld b,(hl) ;and byte to transmit rst 8 ;dos call jr nz,$1 ;assume busy, try again .list endm ; ;rcvb receive byte and return it in a ; rcvb macro .xlist local $1 push bc $1: ld a,(rsvc) ;get receive svc rst 8 ;dos call jr nz,$1 ;try it again ld a,b ;store (might not be good) pop bc .list endm ; ;nplus to increment the packet number count ; nplus macro ld hl,n inc (hl) endm ; ;dec3 decrement three times a register or register pair ; dec3 macro reg dec reg dec reg dec reg endm ; ;addbc to add a to bc in checksum computation ; addbc macro .xlist add a,c ;c=c+1 (there might be a carry) ld c,a ;back in c ld a,0 ;not xor a because we need the carry adc a,b ;add the carry to b ld b,a ;back in b .list endm ;bc=bc+a ; ;f_ack to format ack using current n ; f_ack macro .xlist ld (iy+len),3 ;length=3 ld a,(n) ;current packet count add a,' ' ;make printable ld (iy+seq),a ;put n in packet ld (iy+type),'Y' ;type = ack ld hl,spaket ;hl points to send packet call acsum ;and add the checksum .list endm ; ;movb to move a byte to memory ; movb macro value,loc .xlist push af ;save ld a,value ;get byte ld (loc),a ;save pop af ;restore .list endm subttl rpack - receive packet routine page ; ; rpack receive packet routine ; call rpack ; will discard soh on reception ; and will return with carry set ; if timout occured or cheksum wrong ; rpack: timer rp0,tout ;set timer handler rp1: ld hl,rpaket ;set up hl rcvb ;get a byte cp soh ;is it a soh ? jr nz,rp1 ;no, not yet, start over ld b,0 ;for checksum bc=0 ld c,0 ;***************** rp2: ;len rcvb ;get a byte cp soh ;is it a soh ? jp z,rp1 ;yes, re-sync ld (hl),a ;save in rpaket addbc ;add to bc for checksum ld a,(hl) ;get back byte inc hl ;point to next byte sub ' '+3 ;convert to numeric ld (rlen),a ;and save rp3: ;packet number rcvb ;get a byte cp soh ;soh ? jp z,rp1 ;yes, re-sync ld (hl),a ;save in rpaket inc hl ;update counter addbc ;add to bc for checksum rp4: ;type of packet rcvb ;get a byte cp soh ;soh ? jp z,rp1 ;yes, re-sync ld (hl),a ;save in rapket inc hl ;update pointer addbc ;add to bc for checksum ld a,(rlen) ;get data length cp 0 ;is it null ? jp z,rp6 ;yes, get checksum now rp5: ;data field rcvb ;get a byte cp soh ;soh ? jp z,rp1 ;yes, re-sync ld (hl),a ;save inc hl ;update counter addbc ;add to bc for checksum ld a,(rlen) ;get length of packet dec a ;decrement ld (rlen),a ;ans store back cp 0 ;is it null ? jp nz,rp5 ;no, get one more byte rp6: ;checksum rcvb ;get a byte cp soh ;soh ??? jp z,rp1 ;yes, re-sync sub ' ' ;convert to numeric ld (byte),a ;save received checksum ld a,c ;get low byte and 300O ;only two high bits rlca ;rotale left rlca ;twice add a,c ;add back to low byte and 077O ;only six bits ld c,a ;computed checksum ld a,(byte) ;received checksum cp c ;equal ? jp nz,rp0 ;no good timer 0,0 ;terminate timout handler scf ;ser carry to 1 ccf ;back to 0 ret ;and return rp0: timer 0,0 ;terminate timout handler scf ;set carry flag ret ; ; subttl flush - to reset communication port page ; ; flush to reset internal communication buffer ; (mostly to get rid of stacked up naks) flush: push bc ;save ld b,6 ;code to reset buffer ld a,(csvc) ;control svc rst 8 ;dos call pop bc ;restore ret ; subttl rplus - to increment retry count page ; rplus increment retry count and jump back ; rplus: ld a,(r) ;get retry count inc a ;increment it cp tout ;to maximum ? jp z,abort ;yes abort ld (r),a ;save back jp mjump ;and go back ; subttl abort - end in disaster sending an error packet page ; abort end transmission and die... ; abort: prmes a0 ;aborting ... ld (iy+len),3 ;length = 3 ld a,(n) ;get current packet seq cp 0 ;are we at beginning ? jp z,ab0 ;yes, do not send error pak add a,' ' ;make printable ld (iy+seq),a ;and store ld (iy+type),'E' ;type error packet ld hl,spaket ;set up hl call acsum ;compute checksum call spack ;and send packet ab0: exit: prmes e0 ;end of job rst 0 ;bye ! ; subttl acsum - add checksum to a packet page ; acsum compute and store checksum (hl) ; acsum: push hl ;save push bc ;save ld b,0 ;initialize bc to 0 ld c,0 ;****************** ld a,(hl) ;get length ld (slen),a ;save it add a,' ' ;make printable ld (hl),a ;store back in packet ac0: ld a,(hl) ;get a byte addbc ;add to bc for checksum inc hl ;increment pointer ld a,(slen) ;get length dec a ;decrement it ld (slen),a ;save it back cp 0 ;are we at end ? jp nz,ac0 ;no, get one more byte ld a,c ;get low byte of sum and 300O ;only 2 high bits rlca ;rotate left rlca ;twice add a,c ;add it back to low byte and 077O ;mask off 2 high bits add a,' ' ;and make pintable ld (hl),a ;store in packet pop bc ;restore pop hl ;restore ret ; subttl spack - send a packet already formatted page ; spack send a packet already formatted ; spack: push hl ;save ld a,(spaket) ;get length sub 31 ;real length ld (slen),a ;save it movb soh,byte ;store a soh ld hl,byte ;set up hl xmitb ;transmit (hl)=soh ld hl,spaket ;packet address ld a,(slen) ;and length sp1: push af ;save xmitb ;transmit (hl) pop af ;restore a dec a ;decrement length of packet inc hl ;update pointer cp 0 ;are we at end ? jp nz,sp1 ;no, one more byte ;now send eol ld hl,sinit+4 ;where eol is stored xmitb ;send it pop hl ;restore ret ; ; end