<<< trsdata.mac >>> subttl data segment dseg ; ; state symbols ; _a equ 1 ;abort _c equ 2 ;complete _r equ 3 ;receive init _rf equ 4 ;receive file header _rd equ 5 ;receive data _s equ 6 ;send init _sf equ 7 ;send file header _sd equ 8 ;send data _se equ 9 ;send end-of-file _sb equ 10 ;send break transmission _o equ 11 ;open file (pre send init) _end equ 255 ; public fcb,filbuf,recptr,recbuf,paraml,lrecl public create,byte,word,screen,rftab,rdtab public slen,spaket,rlen,rpaket,sinit public rinit,port,baud,wdlen,baudtb,lab,parsetb public parity,stop,oldstk,scrtch,cmdlin,high public state,n,r,init,ssvc,rsvc,csvc,altsvc public nsvc,stack,stjump,rtype extrn abort,exit,r_init,r_file,r_data extrn rf_f,rf_b,rf_x,rd_d,rd_z extrn s_open,s_file,s_data,s_eof,s_break,s_init public filnam,crp,cbp,work extrn eof,sets,setr,setb,setf,setp,setc,setw,seter extrn setl ; ; fcb and others file related matters ; filnam: ds 30 ;will hold filename for send fcb: ds 60 ;file control block filbuf: ds 512 ;file buffer crp: recptr: db 0 ; recbuf: ds 256 ;record buffer paraml: dw filbuf ;parameter list for file svc's dw recbuf dw eof ;send end of file routine db 'W' ;read/write lrecl: db 1 ;default is 1 db 'F' ;always fixed record length create: db 2 ;default is create db 0 ;user attrib = 0 ; ; packet buffers ; cbp: slen: db 0 ;send buffer length (all included) spaket: ds 100 ;send packet rlen: db 0 ;receive buffer length rpaket: dw 0 ;receive packet store rtype: ds 100 ;here is where we store type ; ; the send init exchange ; sinit: db 13 ;will contain the send init received db 13,13,13,13,13,13,13,13,13,13,13 maxlen equ 94 ;maximum packet length tout equ 10 ;time out quote equ '#' cr equ 13 ;carriage return (eol) rinit: ;the send-init we will send db maxlen+32 db tout+32 db 0+32 db 64 db cr+32 ;eol db quote db 'N' db '1' db ' ' db 32 ; telecomm buffers ; port: db 'A' ;default is A baud: db 8 ;baud rate (9600) wdlen: db 8 ;8 bits' byte parity: db 'N' ;none stop: db 1 db 0 ;end ; ; misc ; oldstk: dw 0 ;save stack here on entry scrtch: dw 0 ;last+1 byte of pgm on entry cmdlin: dw 0 ;address of command line byte: db 0 ;scratch byte word: dw 0 ;scratch word work: ;work space for parser db '0','0','0','0','0' screen: db 0 ;flag for typing on screen ; high: dw 0 ;high memory state: db 3 ;current state of automaton n: db 0 ;current packet number r: db 0 ;current retry count init: db 0 ;do comm init on entry if != 0 ; ; svc for comm operations ; ssvc: db 97 ;send on channel A rsvc: db 96 ;receive on channel A csvc: db 100 ;control on channel A altsvc: db 0,99,98,101 ;same for channel B nsvc: db 4 ;number of bytes to move ; ; stack ; ds 400 ;lots of space stack: stjump: db _a ;main jump table dw abort db _c dw exit db _r dw r_init db _rf dw r_file db _rd dw r_data db _o dw s_open db _s dw s_init db _sf dw s_file db _sd dw s_data db _se dw s_eof db _sb dw s_break db _end ;end of table rftab: db _a dw abort db 'F' dw rf_f db 'B' dw rf_b db 'X' dw rf_x db _end rdtab: db _a dw abort db 'D' dw rd_d db 'Z' dw rd_z db _end ; baudtb: db '110 ',1 db '150 ',2 db '300 ',3 db '600 ',4 db '1200',5 db '2400',6 db '4800',7 db '9600',8 db 13 ;end of table lab: dw l1,l2,0 l1: db 3,'{}',13 l2: db 1,'/' parsetb: db 0 dw seter db 'W' dw setw db 'S' dw sets db 'R' dw setr db 'F' dw setf db 'P' dw setp db 'B' dw setb db 'C' dw setc db 'L' dw setl db _end end <<< trsmain.mac >>> subttl kmain/mac main parser and initialization routin cseg extrn oldstk,scrtch,high,cmdlin,stack,stjump,lab extrn rftab,rdtab,rtype,abort,parity,port,fcb,baud extrn wdlen,baudtb,parsetb,byte,initcm,init,state public mjump,rdjump,rfjump,sets,setr,setf,setb,setp,setc public setw,seter,setl extrn lrecl,filnam,paraml,work ; ; macros ; ; prmes to display a message stored by mssg ; call prmes lab ; prmes macro lab .xlist extrn m_&lab,l_&lab push hl push bc ld hl,m_&lab ld bc,(l_&lab) ld c,13 ld a,9 rst 8 pop bc pop hl .list endm ; ; jumptb jump according to a jump table ; call jumptb table,code ; where table is the address of the table ; and code is a one-byte code ; jumptb macro table,code .xlist local $1 ld hl,table ld bc,(code) ld b,c ld a,28 ;lookup call rst 8 ;dos jr z,$1 ;no error ld hl,table+1 ;get abort address (first entry) $1: jp (hl) .list endm ; ; main entry save usefull registers ; start: ld (oldstk),sp ;save stack ld (scrtch),bc ;first byte after pgm ld (high),de ;high memory ld (cmdlin),hl ;command line ld sp,stack ;new stack ; ; main parsing routine ; will respond to the following syntax : ; KERMIT {S,F=file,B=baud,P=par,W=word,C=channel} ; update {L=lrecl} 85.09.19 ; iparse: ld e,0 ;init for first call nxtfld ld hl,(cmdlin) ;get command line ld c,(hl) ;maximum length to parse inc hl ;points to first byte i0: ld a,(hl) ;get first byte cp ' ' ;white space ? jr z,i1 ;yes, now find { dec c ;decrement length to parse inc hl ;update pointer ld a,c ;length in a cp 0 ;is it null ? jr nz,i0 ;no, go on jp go ;yes, no parse to be done i1: dec c ;decrement length to parse inc hl ;update pointer ld a,c ;get length in a cp 0 ;is it null ? jp z,go ;nothing to parse ld a,(hl) ;get byte in a cp ' ' ;is it another null ? jp z,i1 ;yes, get one more cp '{' ;is it valid start ? jp nz,seter ;no good dec c ;decrement length inc hl ;update pointer ld a,c ;get length in a cp 0 ;is it null ? jp z,seter ;no good parse: call nxtfld ;get next field jp nz,go ;go ! ld a,b ;length of field cp 0 ;is it null ? jp z,seter ;disaster ... call handler ;work with this parameter ld a,c ;length left to parse or a ;is it null ? jp nz,parse ;no, do it again ld a,0FFH ;terminator ? cp d ;in register D jp z,seter ;yes and parse is incomplete jp go ;go ! handler: ld a,(hl) ;get first caracter of field ld (byte),a ;in byte push hl ;save push bc jumptb parsetb,byte ;jump accordingly sets: pop bc pop hl ld a,11 ;open pseudo-state ld (state),a ;set send state ld a,'R' ;read only ld (paraml+6),a ;put fcb in read state ld a,0 ;do not create ld (paraml+9),a ;and do not create ret setr: pop bc pop hl ld a,3 ld (state),a ;set receive state ret setf: pop bc pop hl call nxtfld ;get next field push hl ;save push de push bc push hl ;i will need it twice ld a,b ;get length in a cp 0 ;is it null ? jp z,f0 ;yes error cp 30 ;greater than 30 jp nc,f0 ;yes, error ld de,fcb ;where filaname should be ld c,b ;with length in BC ld b,0 ldir ;move from hl to de ex de,hl ;end of filnam in hl ld (hl),13 ;put in a CR ld (filnam),a ;get filename length in place ld de,filnam ;to filenam inc de ;plus one (first byte is len) pop hl ;from here ld c,a ;length in bc ld b,0 ldir ;move from param list to filnam ex de,hl ;hl points to end ld (hl),13 ;put in a CR pop bc ;restore pop de pop hl ret f0: prmes e4 ;not valid filename jp abort ;end in disaster setp: pop bc pop hl call nxtfld ;get next field ld a,(hl) ;get first byte in a cp 'O' ;is it odd jr nz,p0 ;no ... ld (parity),a ;set in comm buffer ld (init),a ;init flag ret p0: cp 'E' ;is it even ? jr nz,p1 ;no ... ld (parity),a ;set in comm buffer ld (init),a ;init flag ret p1: cp 'N' ;is it none ? jr nz,p2 ;no, error ld (parity),a ;set in comm buffer ld (init),a ;init flag ret p2: prmes e5 ;invalid parity jp abort ;end in disaster setb: pop bc pop hl call nxtfld ;get next field push hl ;save push de push bc ex de,hl ;de=compare string ld hl,baudtb ;baud rate table ld a,49 ;svc scan rst 8 ;dos jr nz,b0 ;not found inc hl ;increment to code inc hl inc hl inc hl ld a,(hl) ;get code in a ld (baud),a ;in comm buffer ld (init),a ;init flag pop bc ;restore pop de pop hl ret b0: prmes e6 ;unsupported baud rate jp abort ;in disaster setw: pop bc pop hl call nxtfld ;get next field ld a,(hl) ;first byte in a cp '7' ;is it 7 jr nz,w0 ;no, try 8 sub '0' ;convert to binary ld (wdlen),a ;in comm buffer ld (init),a ;set init flag ret w0: cp '8' ;is it 8 jr nz,w1 ;no, error ld (wdlen),a ;in comm buffer ld (init),a ;init flag ret w1: prmes e7 ;bad word length jp abort ;disaster setc: pop bc pop hl call nxtfld ;get next field ld a,(hl) ;first byte in a cp 'A' ;is it cnannel A ? jr nz,c0 ;no, try B ld (port),a ;in comm buffer ld (init),a ;init flag ret c0: cp 'B' ;is it B jr nz,c1 ;no, error ld (port),a ;in comm buffer ld (init),a ;init flag ret c1: prmes e8 ;invalid channel jp abort ;disaster seter: pop bc pop hl prmes e9 ;invalid parameter prmes u0 ;usage is... jp abort ;disaster setl: pop bc ;restore pop hl call nxtfld ;get record length push hl ;save push bc push de ld de,work ;to store value and padd ld a,b ;get length cp 6 ;maximum lebgth + 1 jp nc,seter ;no good ... bye l0: cp 5 ;maximum length jr z,l1 ;finished moving inc a ;increase length inc de ;and pointer jr l0 l1: ld c,b ;get length in bc ld b,0 ldir ;move to work+(5-bc) ld hl,work ;get hl to point correctly ld b,1 ;code to convert to bin ld a,21 ;BINDEC svc rst 8 ;dos ld a,e ;get binary value ld (lrecl),a ;save in fcb pop de ;restore pop bc pop hl ret nxtfld: ld d,0 ;initialize de to e add hl,de ;add to hl - where to start ld de,lab ;list address block ld a,46 ;parse svc rst 8 ;dos ret go: call initcm ;initialize comm channel prmes 00 ;now say hello ; here is the main jump, every routine ends here ; mjump: jumptb stjump,state ; ; ; ; and this is the main receive file jump ; rfjump: jumptb rftab,rtype ; ; and the main receive data jump ; rdjump: jumptb rdtab,rtype ; end start <<< trsmssg.mac >>> subttl messages (because the assembler is too dumb) dseg ; ; ;mssg to reserve space for a message and it's length ; syntax mssg lab, ; where lab is a maximum of four bytes ; mssg macro lab,mess .xlist ;do not list expansion public m_&lab,l_&lab m_&lab: db '&mess' l_&lab: db 0 db $-m_&lab .list endm ; ; the message that should appear ; mssg 00, mssg a0, mssg u0, mssg e0, mssg db0, mssg db1, mssg db2, mssg db3, mssg db4, mssg db5, mssg db6, mssg db7, mssg db8, mssg db9, mssg db10, mssg db11, mssg db12, mssg db13, mssg db14, mssg e3, mssg e4, mssg e5, mssg e6, mssg e7, mssg e8, mssg e9, end <<< trsrecv.mac >>> title krecv/mac reception unit cseg ; ; extrn recptr,recbuf,rplus,mjump,rfjump,rdjump extrn spaket,rpaket,screen extrn rplus,sinit,state,byte,n,r extrn rpack,spack,abort,acsum,flush extrn fcb,writnx,open,rinit,close extrn lrecl public r_init,r_file,rf_b,rf_x,rf_f public r_data,rd_z,rd_d ; len equ 0 seq equ 1 type equ 2 data equ 3 quote equ '#' _a equ 1 _c equ 2 _r equ 3 _rf equ 4 _rd equ 5 ; ; subttl macros used in this module ; ;prmes to display messages ; prmes macro lab .xlist extrn m_&lab,l_&lab push hl push bc ld hl,m_&lab ld bc,(l_&lab) ld c,13 ld a,9 rst 8 pop bc pop hl .list endm ;movb ; movb macro value,loc .xlist push af ld a,value ld (loc),a pop af .list endm ; ;blmov ; blmov macro source,dest,len .xlist local $1,$2 push hl push bc push de ld hl,source ld de,dest ld a,(len) cp 0 jr nz,$1 ld b,1 ld c,0 jp $2 $1: ld b,0 ld c,a $2: ldir pop de pop bc pop hl .list endm ; ;fack to format an ack paket ; f_ack macro .xlist ld (iy+len),3 ld a,(n) add a,' ' ld (iy+seq),a ld (iy+type),'Y' ld hl,spaket call acsum .list endm ; ;nplus ; nplus macro .xlist ld hl,n inc (hl) res 6,(hl) ;not over 63 .list endm ; subttl receive initialize ; ; receive init ; r_init: movb 0,n ;set packet count to 0 movb 0,r ;and retry count to 0 ld ix,rpaket ;ix will always point there call flush ;flush comm port call rpack ;and get a packet jp c,rplus ;no good, nack, r+ ld a,(ix+type) ;get packet type cp 'S' ;is it a send ? jp nz,abort ;nope, no good movb 10,byte ;will move 10 bytes blmov rpaket+data,sinit,byte ;to send init buffer ld hl,sinit+4 ;address of eol res 5,(hl) ;sub 32 to get real eol ;and prepare to ack ;with our parameters ld iy,spaket ;iy will always point there ld (iy+len),12 ;length ld (iy+type),'Y' ;ack ld a,(n) ;current packet number add a,32 ;make printable ld (iy+seq),a ;save in ack packet blmov rinit,spaket+data,byte ;all the info ld hl,spaket ;hl points to send packet call acsum ;add checksum call spack ;and pray it gets there nplus ;increment n movb 0,r ;set retry count to 0 movb _rf,state ;to receive file jp mjump ;back subttl receive file page ; ; receive file ; r_file: call rpack ;get a packet jp c,rplus ;no good ld a,(n) ;packet number expected add a,' ' ;make printable cp (ix+seq) ;equal to received packet jp z,rfgood ;yes call spack ;re-ack, it was lost jp rplus ;increment r, nak rfgood: jp rfjump ;jump according to table rf_b: ;case(break) f_ack ;format ack call spack ;and send it nplus movb _c,state ;set state to complete jp mjump ;and back rf_x: ;case(type on screen) movb 1,screen ;set flag on movb _rd,state ;set state to receive data f_ack ;format ack call spack ;and send it nplus ;increment packet count jp mjump ;and back rf_f: ;case(file header) ld a,(ix+len) ;get lenght sub ' '+3 ;minus seq,type, chksum ld (ix+len),a ;store back blmov rpaket+data,fcb,rpaket ;move filename to fcb ld hl,fcb ;start of filename ld c,a ;length ld b,0 ;bc = length ld a,'.' ;to scan for dot cpir ;found dot dec hl ;adjust pointer ld (hl),'/' ;replace by '/' ld a,0 ;clr a cp c ;c = 0 ? jp z,r_f0 ;yes, put in cr ld hl,fcb ;first byte of filename ld a,(rpaket) ;length of filename add a,l ;add low byte to length ld l,a ;store back low byte ld a,0 ;clear a adc a,h ;add high byte to carry ld h,a ;put back in h r_f0: ld (hl),13 ;put in a carriage return call open ;and open file f_ack ;format an ack call spack ;and send it nplus ;increment packet count movb _rd,state ;set state to receive data jp mjump ;and back subttl receive data page ; ; receive data ; r_data: call rpack ;get a packet jp c,rplus ;no good ld a,(n) ;get expected packet count add a,' ' ;make printable cp (ix+seq) ;equal to received ? jp z,rdgood ;yes, all ok call spack ;re-ack, it was lost jp rplus ;update retry count rdgood: jp rdjump rd_z: ;case(end of file) call writnx ;flush buffer call close ;close file f_ack ;format an ack call spack ;and send it nplus ;increment packet count movb _rf,state ;set state to receive file jp mjump ;and back rd_d: ;case(data) ld hl,rpaket+data ;start of data ld a,(rpaket) ;total length sub ' '+3 ;convert to numeric cp 0 ;is it null ? jp z,rd_d2 ;yes, finish ld bc,(recptr) ;pointer inside recbuf ld b,0 ;turn off high byte push hl ;save temporarily ld hl,recbuf ;record address add hl,bc ;plus length ex de,hl ;pointer in de pop hl ;restore hl ;at this point : ; hl = rpaket ; de = inside recbuf ; a = length of packet rd_d1: push af ;save temporarily ld a,(hl) ;get current byte cp quote ;is it a quote ? jr nz,rd_d3 ;no, go on inc hl ;point to next byte pop af ;restore a dec a ;decrement counter push af ;and save again ld a,(hl) ;get next byte cp quote ;is it a quote ? jr z,rd_d3 ;yes, don't touch cp quote or 128 ;quote and eight bit jr z,rd_d3 ;yes don't touch either xor 64 ;uncontrollify ld (hl),a ;store back rd_d3: pop af ;restore ldi ;from rapket to recbuf dec a ;paket length minus one ld bc,(recptr) ;pointer inside recbuf inc c ;is incremented movb c,recptr ;and stored back push af ;save a ld a,(lrecl) ;get logical record length cp c ;compare to len(recbuf) jp nz,rd_d0 ;no, do not update yet call writnx ;write next record movb 0,recptr ;set pointer back to zero ld de,recbuf ;reset pointer to record buffer rd_d0: pop af ;restore a cp 0 ;is packet empty ? jp nz,rd_d1 ;no, get one more byte rd_d2: f_ack ;format an ack call spack ;and send it nplus ;update packet counter jp mjump ;and back end <<< trssend.mac >>> title ksend/mac sending unit cseg ; ; extrn recptr,recbuf,rplus,mjump extrn spaket,rpaket,screen extrn rplus,sinit,state,byte,n,r extrn rpack,spack,abort,acsum,flush extrn fcb,writnx,open,rinit,close extrn lrecl,readnx,buffil,filnam,tstack public s_init,s_file,s_open,s_break public s_data,s_eof ; len equ 0 seq equ 1 type equ 2 data equ 3 quote equ '#' _a equ 1 _c equ 2 _r equ 3 _rf equ 4 _rd equ 5 _s equ 6 _sf equ 7 _sd equ 8 _se equ 9 _sb equ 10 _o equ 11 ; ; subttl macros used in this module ; ;prmes to display messages ; prmes macro lab .xlist extrn m_&lab,l_&lab push hl push bc ld hl,m_&lab ld bc,(l_&lab) ld c,13 ld a,9 rst 8 pop bc pop hl .list endm ;movb ; movb macro value,loc .xlist push af ld a,value ld (loc),a pop af .list endm ; ;blmov ; blmov macro source,dest,len .xlist local $1,$2 push hl push bc push de ld hl,source ld de,dest ld a,(len) cp 0 jr nz,$1 ld b,1 ld c,0 jp $2 $1: ld b,0 ld c,a $2: ldir pop de pop bc pop hl .list endm ; ;fack to format an ack paket ; f_ack macro .xlist ld (iy+len),3 ld a,(n) add a,' ' ld (iy+seq),a ld (iy+type),'Y' ld hl,spaket call acsum .list endm ; ;nplus ; nplus macro .xlist ld hl,n inc (hl) res 6,(hl) movb 0,r .list endm ; subttl open file (pseudo-state, precedes send_init) page ; ; open file ; s_open: call open ;open file (assume fcb set) movb _s,state ;state = send_init movb 0,n ;packet number to 0 movb 0,r ;reset retry count call flush ;clear comm buffers jp mjump ;and back subttl send initialisation routine page ; ; send init parameters ; s_init: ld ix,rpaket ld iy,spaket ld (iy+len),12 ;length of init packet ld (iy+type),'S' ;type send init ld a,(n) ;current packet number add a,' ' ;make printable ld (iy+seq),a ;into packet movb 12,byte ;number of bytes to move blmov rinit,spaket+data,byte ld hl,spaket ;to point correctly call acsum ;compute checksum call spack ;and send packet ld a,(hl) ;get paket length and fix it sub ' ' ;because there might be a retry ld (hl),a ;save back call rpack ;get answer jp c,rplus ;no good call tstack ;was it a good ack ? jp c,rplus ;no, send it again blmov rpaket+data,sinit,byte ;move parameters to keep ld hl,sinit+4 ;address of eol res 5,(hl) ;sub 32 to get real eol ld hl,sinit ;maxlen to send res 5,(hl) ;sub 32 nplus ;increment packet count movb _sf,state ;state = send file header jp mjump ;and back subttl send file header information page ; ; send file header ; s_file: ld hl,filnam+1 ;where the filame start ld a,(filnam) ;it's length ld b,a ;store len in b ld a,'/' ;byte to look for s1: cp (hl) ;is this a '/' ? jp z,s2 ;yes change it t '.' inc hl ;advance pointer djnz s1 ;and check next byte jp s3 ;there was no '/' s2: ld a,'.' ;a dot to normalize filename ld (hl),a ;in place s3: ld (iy+type),'F' ;of type file header ld a,(n) ;get packet count add a,' ' ;make printable ld (iy+seq),a ;insert in spacket blmov filnam+1,spaket+data,filnam ;put in filename ld a,(filnam) ;get filename length add a,3 ;add len,seq,type ld (iy+len),a ;set in spacket ld hl,spaket ;hl to point correctly call acsum ;compute checksum call spack ;send it ld a,(hl) ;get paket length and fix it sub ' ' ;because there might be a retry ld (hl),a ;save back in spaket call rpack ;get answer jp c,rplus ;no good call tstack ;was it a good ack ? jp c,rplus ;no nplus ;update packet count call buffil ;get a bufferfull jp c,s_eof ;it was the end of file movb _sd,state ;state = send_data jp mjump ;return subttl send data from file page ; ; send data ; s_data: ld (iy+type),'D' ;data packet ld a,(n) ;packet number add a,' ' ;make printable ld (iy+seq),a ;into packet ld hl,spaket ;hl point correctly call acsum ;compute checksum call spack ;send it ld a,(hl) ;get length to fix it in case sub ' ' ; of a bad ack ld (hl),a ;save back in spaket call rpack ;get answer jp c,rplus ;no good call tstack ;a good ack ? jp c,rplus ;nope... nplus ;yes, update packet count call buffil ;get next packet ready jp c,s_eof ;we reach the eof jp mjump ;and back subttl send end of file page ; ; send end of file ; s_eof: movb _se,state ;might not be done ld (iy+type),'Z' ;eof in spacket ld (iy+len),3 ;length ld a,(n) ;packet number add a,' ' ;make printable ld (iy+seq),a ;into packet ld hl,spaket ;to point correctly call acsum ;compute checksum call spack ;send packet ld a,(hl) ;get paket length sub ' ' ;and fix it ld (hl),a ;back in spaket call rpack ;get answer jp c,rplus ;no good call tstack ;test for good ack jp c,rplus ;no good nplus ;good, update packet count movb _sb,state ;state = break transmission jp mjump ;and back subttl send break transmission page ; ; send break transmission ; s_break: ld (iy+type),'B' ;in spaket, set type ld (iy+len),3 ;and length ld a,(n) ;current packet number add a,' ' ;make printable ld (iy+seq),a ;store in spaket ld hl,spaket ;hl to point correctly call acsum ;compute checksum call spack ;send packet ld a,(hl) ;get paket length and fix it sub ' ' ;there might be a retry ld (hl),a ;save back in spaket call rpack ;get answer jp c,rplus ;no good call tstack ;check if correct ack jp c,rplus ;no, send again movb _c,state ;complete jp mjump ;FIN... end <<< trsutil.mac >>> 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 <<< trsutil2.mac >>> subttl kutil2/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 extrn readnx,crp,cbp,word public tstack,buffil,eof ; ; useful symbols ; soh equ 1 tout equ 10 len equ 0 seq equ 1 type equ 2 data equ 3 dfport equ 'A' ; ; ; ;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 movb macro value,loc .xlist push af ld a,value ld (loc),a pop af .list endm ; ; ; tstack to test a received packet for a good ack ; tstack: ld a,(n) ;cirrent packet count add a,' ' ;make printable cp (ix+seq) ;equal to seq received ? jp nz,plus1 ;no, test n+1 ld a,(ix+type) ;get packet type cp 'Y' ;is an ack ? jp nz,nogood ;no return error code $1: scf ccf ret ;return no error plus1: inc a ;increment packet count cp (ix+seq) ;equal to received ? jp z,$1 ;yes, all ok nogood: scf ;set carry ret ; ; buffil to fill a send packet data field from ; record buffer ; buffil: movb 3,cbp ;initialize buffer pointer b5: ld a,(cbp) ;get buffer pointer inc a ;it might be one less ld hl,sinit ;maxlen to send cp (hl) ;equal to max or max-1 ? jp c,b0 ;no, there is room b4: ld a,(cbp) ;buffer pointer ld (iy+len),a ;in packet scf ccf ret ;return all ok b0: xor a ;clear a ld hl,crp ;record pointer address cp (hl) ;buffer empty ? jp nz,b1 ;no call readnx ;get something (EOF...) jp nc,b1 ;not end of file yet ld a,(cbp) ;spaket pointer ld (iy+len),a ;put in place cp 3 ;is this the start ? jp nz,b13 ;not yet, return normally scf ;flag to never return here b13: ret b1: ld a,(cbp) ;buffer pointer ld b,a ;save in b ld a,(sinit) ;maxlen to send sub b ;a=SA=mxl-cbp ld (byte),a ;save in byte ld a,(crp) ;record pointer ld b,a ;save in b ld a,(lrecl) ;record length sub b ;a=BA=lrecl-crp ld hl,byte ;get byte address cp (hl) ;BA > SA ? jp nc,b2 ;go move SA bytes ld (byte),a ;save BA in byte b2: ld hl,spaket ;packet address ld a,(cbp) ;current pointer add a,l ;add to low byte ld l,a ;save back ld a,0 ;clear a keeping carry adc a,h ;add carry to high byte ld h,a ;save back ex de,hl ;save in DE ld hl,recbuf ;record address ld a,(crp) ;record pointer add a,l ;add to low byte ld l,a ;save back ld a,0 ;clear a keeping carry adc a,h ;add to high byte ld h,a ;save back ; ; here we move from recbuf to spaket ; making sure the control caracters are quoted, ; and uncontrollified (same thing for del), ; and that the quote caracter is itself quoted. ; movb 0,word ;this will be the count from recbuf movb 0,word+1 ;and the count of quote bytes b9: ld a,31 ;limit of control char. ld b,(hl) ;get character in b to res 7,b ; reset seventh bit cp b ;compare 31 to byte to send jp c,b6 ;this is not a control char. b8: ld a,(sinit+5) ;get the quote byte ld (de),a ;move in spaket inc de ;update spaket pointer push hl ;save ld hl,word+1 ;points to quote count inc (hl) ;update count pop hl ;restore ld a,64 ;to uncontrollify xor (hl) ;the byte to send ld (hl),a ;and put it back in recbuf jp b7 ;go send it b6: ld a,127 ;del byte cp b ;is this it ? jp z,b8 ;yes go uncontrollify it ; ld a,(sinit+5) ;quote byte cp (hl) ;is this what we are sending ? jp nz,b7 ;no, go on ld (de),a ;yes put it in spaket inc de ;and update pointer push hl ;save ld hl,word+1 ;get quote count address inc (hl) ;and update it pop hl ;restore hl b7: ldi ;move the byte in spaket push hl ;save ld hl,word ;count address inc (hl) ;update it ld a,(hl) ;get count of bytes from recbuf ld hl,word+1 ;and count of quote bytes add a,(hl) ;add them to get real count ld hl,byte ;address of max to moved inc a ;increment real count ; to get to max-1 or max cp (hl) ;compare count+1 to max jp nc,b10 ;this is it, finish. pop hl ;restore jp b9 ;one more time... b10: ld a,(word) ;real count moved from recbuf ld (byte),a ;put where we need it pop hl ;restore to recbuf b11: ; ; at this point we have moved up to (byte) bytes ; maby less if there was only one control character ; Most of those bytes come from recbuf plus some ; instances of the quote byte. ; ld a,(word) ;number of bytes moved ld hl,word+1 ;address of quote count add a,(hl) ;a = total count ld hl,cbp ;buffer pointer add a,(hl) ;increment ld (hl),a ;save back in cbp ld hl,crp ;record pointer ld a,(word) ;get back bytes moved from rec add a,(hl) ;fix pointer ld (hl),a ;save back in cbp ld a,(lrecl) ;record length cp (hl) ;equal to record pointer ? jp nz,b3 ;no, go on movb 0,crp ;yes, reset crp b3: jp b5 ;one more time ; ; eof this routine will be accessed automatically ; from a read of eof by trsdos. ; Might be accessed twice ... ; eof: scf ;set carry ret end