home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
c
/
tr2ker.asm
< prev
next >
Wrap
Assembly Source File
|
2020-01-01
|
72KB
|
1,880 lines
<<< 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,<message>
; 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,<Kermit (trsdos II, version 1.2)>
mssg a0,<aborting due to fatal error>
mssg u0,<KERMIT {(S,R),F=filename,B=baud,P=par,L=lrecl,C=channel}>
mssg e0,<Kermit exit>
mssg db0,<jumping from mjump>
mssg db1,<jumping from rfjump>
mssg db2,<jumping from rdjump>
mssg db3,<entering receive-init>
mssg db4,<entering receive-file>
mssg db5,<entering receive-data>
mssg db6,<entering rpack>
mssg db7,<entering spack>
mssg db8,<exiting timer call>
mssg db9,<entering rp1>
mssg db10,<entering rp2>
mssg db11,<entering rp3>
mssg db12,<entering rp4>
mssg db13,<entering rp5>
mssg db14,<entering rp6>
mssg e3,<invalid word length>
mssg e4,<invalid filename>
mssg e5,<invalid parity>
mssg e6,<unsupported baud rate>
mssg e7,<invalid word length>
mssg e8,<invalid channel>
mssg e9,<invalid parameter>
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
