468 lines
11 KiB
Plaintext
468 lines
11 KiB
Plaintext
; srutil.z - utilities for file transfer
|
||
|
||
.incl "c:vars"
|
||
|
||
.extern kgettc ; kgettc - get a character for kermit - we
|
||
kgettc: ; wait as prescribed by kermit's timint
|
||
ld a,(timint) ; get the timeout
|
||
; fall into gettcp
|
||
|
||
.extern gettcp ; call gettoc, but save registers as we do so
|
||
gettcp:
|
||
push hl
|
||
push de
|
||
push bc
|
||
call gettoc
|
||
pop bc
|
||
pop de
|
||
pop hl
|
||
ret
|
||
|
||
.extern gettc3 ; calls gettoc with a timeout of 3 seconds
|
||
gettc3:
|
||
ld a,4 ; set up, and fall through
|
||
|
||
.extern gettoc ; gettoc - get a character, noting timeout.
|
||
gettoc: ; enter with timeout (in seconds) in a, return
|
||
; char in a, carry set <=> timeout
|
||
ld c,a ; seconds of timeout to c
|
||
push bc
|
||
call fstmc ; quick pre-check to make sure this has a
|
||
pop bc ; chance of working at 38400
|
||
ret nc
|
||
gtlp: push bc
|
||
call kbdcc ; character from kbd?
|
||
xor 'x' & 0x1f ; was it a ^X?
|
||
jr nz,noab
|
||
ld hl,(abortf) ; abort function set up?
|
||
ld e,a
|
||
ld d,a
|
||
ld (abortf),de ; kill it whatever
|
||
ld a,h
|
||
or l
|
||
jr z,noab ; nope - don't do anything
|
||
jp (hl) ; go do the abort code
|
||
noab: pop bc
|
||
ld de,1100
|
||
call setspd ; set delay value
|
||
qrtrms: push hl
|
||
push bc
|
||
call fstmc ; check for a char at the modem
|
||
pop bc
|
||
pop hl
|
||
ret nc ; yes - send it back
|
||
ld b,60 ; wait a while
|
||
qmslp: djnz qmslp
|
||
dec hl
|
||
ld a,h
|
||
or l
|
||
jr nz,qrtrms ; count down hl
|
||
dec c
|
||
jr nz,gtlp ; and seconds
|
||
scf ; timed out - return w/ carry
|
||
ret
|
||
|
||
fstmc: call modist ; modem character available?
|
||
scf
|
||
ret z ; return with carry if not
|
||
call modin ; get one if so
|
||
or a ; and clear carry
|
||
ret
|
||
|
||
.extern flsrng
|
||
flsrng: call fstmc ; get a char if there's one there
|
||
jr nc,flsrng ; loop while they're coming
|
||
ret ; exit - all flushed
|
||
|
||
.extern srnxt ; get next name from batched list for send
|
||
srnxt:
|
||
call nxtnam ; get next name from buffer to fcb
|
||
ret z ; all done - return zero
|
||
call xferax ; move fcb from fcb to auxfcb
|
||
ld de,auxfcb
|
||
push de ; get and save it's address
|
||
ld c,open
|
||
call usrbds ; try to open the file
|
||
ld h,l
|
||
pop de
|
||
add a,a ; test a == -1 this way so we get a carry on
|
||
sbc a,a ; failure
|
||
ret nz ; open failed - return now
|
||
push de
|
||
ld c,cfsize
|
||
call usrbds ; how big is it?
|
||
ld de,(auxfcb + 34)
|
||
dec de
|
||
ld a,d
|
||
and e
|
||
inc a ; was de dec'ed from 0 to 0xffff
|
||
ld a,(auxfcb + 36)
|
||
jr nz,aok
|
||
dec a ; drop a by 1 if so (big file!)
|
||
aok: ld b,3
|
||
mulk: rra ; convert 128 byte blocks to K
|
||
rr d
|
||
rr e ; shift right
|
||
djnz mulk
|
||
inc de ; reset de - we ditch what's left in a
|
||
pop hl ; fcb back to hl
|
||
call prfile ; print file
|
||
xor a ; clear carry
|
||
inc a ; and z flag
|
||
|
||
.extern clrw2
|
||
clrw2:
|
||
ld (onekp),a
|
||
ld hl,(w2ptr)
|
||
ld (endw2),hl ; set pointers so reads from getw2c work
|
||
ret
|
||
|
||
.extern getw2c ; get a character from work2, via fcb at
|
||
getw2c: ; auxfcb, return c on eof
|
||
ld de,(w2ptr) ; get current read pointer
|
||
ld hl,(endw2)
|
||
or a
|
||
sbc hl,de ; compare with end of data
|
||
ld hl,work2 - 1
|
||
jr z,fillw2 ; at end of buffer - go fill it up again
|
||
sbc hl,de ; see how far down buffer we are
|
||
ld a,h
|
||
and 3
|
||
or l ; on a K boundary?
|
||
push de
|
||
jr nz,no1k
|
||
ld a,(onekp) ; printing k?
|
||
ld (kcnt),a
|
||
no1k: ld hl,b7flag ; zapping bit 7?
|
||
ld a,(hl) ; get the mask
|
||
pop hl
|
||
and (hl) ; mask a character (and clear the carry)
|
||
inc hl
|
||
ld (w2ptr),hl ; resave new pointer
|
||
ret
|
||
fillw2: ld a,(btxf)
|
||
ld b,a
|
||
inc hl
|
||
ld (w2ptr),hl ; get dma address & reset read pointer
|
||
filw2l: push bc
|
||
push hl
|
||
ex de,hl
|
||
ld c,setdma
|
||
call bdos ; set dma
|
||
ld de,auxfcb
|
||
ld c,read
|
||
call usrbds ; read
|
||
pop hl
|
||
pop bc
|
||
or a
|
||
jr nz,filled ; eof - exit now
|
||
ex de,hl
|
||
ld hl,lbrcnt
|
||
inc (hl) ; .LBR active?
|
||
jr z,cntok ; nope, don't check
|
||
dec (hl) ; adjust count
|
||
cntok: dec (hl)
|
||
ld hl,128
|
||
add hl,de ; bump dma
|
||
jr z,filled ; exit if all done
|
||
djnz filw2l ; loop till count runs out
|
||
filled: ld (endw2),hl ; save end pointer
|
||
ld de,work2
|
||
or a
|
||
sbc hl,de ; anything in buffer?
|
||
ccf
|
||
ret z ; return with carry if not
|
||
jr getw2c ; else jump back & get a character
|
||
|
||
.extern gw2pb ; push a character back onto work2
|
||
gw2pb:
|
||
ld hl,(w2ptr) ; get current read pointer
|
||
dec hl ; decrease
|
||
ld (hl),a ; and save character
|
||
ld (w2ptr),hl ; restore pointer
|
||
ret
|
||
|
||
.extern putw2c ; output a character in a to file at auxfcb
|
||
putw2c: ; update K count as needed
|
||
ld hl,(w2ptr)
|
||
ld (hl),a ; save the character
|
||
inc hl
|
||
ld (w2ptr),hl
|
||
ld de,(ew2p)
|
||
sbc hl,de
|
||
jr z,wrtw2
|
||
ld a,h
|
||
and 3
|
||
or l
|
||
ret nz
|
||
jr jone_k
|
||
wrtw2: call flshw2
|
||
jone_k: jp one_k
|
||
|
||
.extern flshw2 ; flush pending write to auxfcb
|
||
flshw2:
|
||
ld hl,(w2ptr) ; what is in buffer
|
||
ld de,work2
|
||
ld (w2ptr),de ; reset save pointer
|
||
or a
|
||
sbc hl,de ; see if anything there
|
||
ret z ; no - stop right now
|
||
dec hl
|
||
add hl,hl
|
||
inc h
|
||
ld b,h ; convert bytes to 128 byte blocks in b
|
||
flshlp: push bc
|
||
push de
|
||
ld c,setdma
|
||
call bdos ; set dma address
|
||
ld de,auxfcb
|
||
ld c,write
|
||
call usrbds ; write the data
|
||
pop de
|
||
ld hl,128
|
||
add hl,de
|
||
ex de,hl ; move dma pointer
|
||
pop bc
|
||
djnz flshlp ; loop till all written
|
||
|
||
.extern fill1a ; fill write buffer with 0x1a
|
||
fill1a:
|
||
ld hl,work2
|
||
ld (w2ptr),hl
|
||
ld de,work2 + 1
|
||
ld bc,(cbfsiz)
|
||
ld (hl),0x1a
|
||
ldir
|
||
ret
|
||
|
||
; setlbr - getw2c is used to read text for a script. Under certain
|
||
; circumstances we need to adjust auxfcb to read from a .LBR, so setlbr
|
||
; does the necessary work
|
||
|
||
.extern setlbr
|
||
setlbr:
|
||
ld de,xbuff ; point at buffer to use
|
||
push de ; save for later
|
||
ld c,setdma
|
||
call bdos ; set dma address
|
||
ld de,auxfcb
|
||
ld c,read
|
||
call usrbds ; read a sector
|
||
or a
|
||
scf
|
||
pop de ; restore address
|
||
ret nz ; return carry (i.e. error on eof)
|
||
ld hl,lbrcnt
|
||
bit 7,(hl) ; first time through?
|
||
jr z,scnlbr ; nope - go check the stuff
|
||
ld a,(xbuff + 14) ; get directory size
|
||
ld (hl),a ; save it away
|
||
jr add32 ; go move to first real entry
|
||
scnlbr: ld a,(de) ; get first byte of this entry
|
||
or a
|
||
jr nz,add32 ; no file here, move to next
|
||
push de ; save pointer to sector in xbuff
|
||
inc de ; point at .LBR filename entry
|
||
ld hl,fcb + 2 ; point at filename saved in fcb
|
||
ld b,11 ; 11 characters to check
|
||
nchk: ld a,(de)
|
||
xor (hl) ; did we match?
|
||
and 0x7f ; don't care about MS bit
|
||
jr nz,add32p ; failed the match, try the next name
|
||
inc hl
|
||
inc de ; move pointers
|
||
djnz nchk ; and loop
|
||
ex de,hl ; swap .LBR directory pointer to hl
|
||
ld e,(hl)
|
||
inc hl
|
||
ld d,(hl) ; get the starting index to de
|
||
inc hl
|
||
ld (auxfcb + 34),de ; save it in the fcb
|
||
ld a,(hl) ; get the record count
|
||
ld (lbrcnt),a
|
||
xor a
|
||
ld (auxfcb + 36),a ; zero fill top byte of auxfcb
|
||
ld de,auxfcb
|
||
ld c,redrnd
|
||
call usrbds ; seek as needed
|
||
or a ; any errors
|
||
pop de ; clean up the stack
|
||
ret z ; yeaaa - we got it - return w/ no carry
|
||
scf ; else set carry for error
|
||
ret
|
||
add32p: pop de
|
||
add32: ld hl,32
|
||
add hl,de ; bump de by 32
|
||
ex de,hl ; save result to de
|
||
ld hl,xbuff + 0x80
|
||
sbc hl,de ; end of sector?
|
||
jr nz,scnlbr ; no - look for another
|
||
ld hl,lbrcnt
|
||
dec (hl) ; out of directory sectors?
|
||
jr nz,setlbr ; no, back for another chunk
|
||
dec (hl) ; turn off .LBR scans
|
||
scf ; carry for the error
|
||
ret
|
||
|
||
; scnswl - parse a list of wildcard filenames into work buffer for subsequent
|
||
; transmission
|
||
|
||
.extern scnswl ; generate list of filenames for batch send
|
||
scnswl:
|
||
ld de,work
|
||
ld (fnbrpt),de
|
||
ld (fnbspt),de ; set read and write pointers
|
||
swloop: call byp ; look at next one
|
||
or a
|
||
ret z ; return when all done
|
||
call scnwld ; parse the next selection
|
||
jr swloop ; and try again
|
||
|
||
.extern cpmaux ; convert generic filename in (hl) to a
|
||
cpmaux: ; cp/m fcb in auxfcb
|
||
push hl ; save string
|
||
ld hl,auxfcb + 2
|
||
ld de,auxfcb + 3
|
||
ld bc,10
|
||
ld (hl),' '
|
||
ldir ; fill filename portion with spaces
|
||
ld bc,(newusr) ; get receive drive and user
|
||
pop de ; name string back to de
|
||
ld hl,auxfcb + 10 ; point hl at extent part of name
|
||
push hl
|
||
ld hl,auxfcb
|
||
ld (hl),c ; save user in place
|
||
inc hl
|
||
ld (hl),b ; and the drive
|
||
inc hl ; point at name part
|
||
ld a,3 ; 3 chars in extent
|
||
ex af,af' ; in a'
|
||
ld b,8 ; 8 chars in name
|
||
scanlp: ld a,(de)
|
||
inc de ; get next char
|
||
cp ' '
|
||
jr nz,nospc ; space gets changed to '-'
|
||
ld a,'-'
|
||
nospc: or a ; end of string?
|
||
jr nz,more ; carry on going if not
|
||
pop hl
|
||
ret
|
||
more: cp '.' ; swap portions on a '.'
|
||
jr z,swap
|
||
inc b
|
||
dec b ; any space left?
|
||
jr z,scanlp ; no - loop back
|
||
cp '?'
|
||
jr z,scanlp ; ignore '?'
|
||
cp '*'
|
||
jr z,scanlp ; and '*'s
|
||
call ucsa ; convert to upper case
|
||
ld (hl),a ; finally got us a letter - save it away
|
||
inc hl ; move pointer
|
||
dec b ; keep count
|
||
jr scanlp ; and keep going
|
||
swap: ex (sp),hl ; swap pointer on top of stack
|
||
ld a,b ; count to a
|
||
ex af,af' ; swap w/ a'
|
||
ld b,a ; back to b
|
||
jr scanlp
|
||
|
||
.extern auxopn
|
||
auxopn:
|
||
call fill1a ; prepare buffer & reset pointer
|
||
ld hl,auxfcb + 13
|
||
ld de,auxfcb + 14
|
||
ld bc,20
|
||
ld (hl),b ; nuke out rest of fcb
|
||
ldir
|
||
ld de,auxfcb
|
||
ld c,open
|
||
push de
|
||
call usrbds ; open the file if we can
|
||
pop de
|
||
inc a
|
||
jr z,fileok ; failed - create & we're done
|
||
ld hl,genfn
|
||
inc de
|
||
inc de
|
||
ld bc,11
|
||
ldir ; copy in "canned" filename
|
||
mvnaml: dec hl
|
||
inc (hl) ; keep filenames changing
|
||
ld a,(hl)
|
||
cp '9' + 1
|
||
jr c,auxopn ; done - try this one
|
||
jr nz,ckltr ; greater than '9', check if it's a letter
|
||
ld (hl),'A' ; no - put in 'A' now
|
||
ckltr: cp 'Z' + 1 ; used all the letters?
|
||
jr c,auxopn ; no - back and try it
|
||
ld (hl),'0' ; reset to '0' and try next character
|
||
jr mvnaml
|
||
fileok: ld c,create ; file doesn't exist - create it
|
||
call usrbds
|
||
ld a,(ymdmb) ; ymodem name incoming?
|
||
ld de,-1
|
||
or a
|
||
jr z,nosiz ; no - don't print a size
|
||
ld hl,(xbuff + 126); get the record count
|
||
ld de,7
|
||
add hl,de ; adjust
|
||
ld b,3
|
||
stok: sra h
|
||
rr l ; divide by 8 to get K
|
||
djnz stok
|
||
ex de,hl
|
||
nosiz: ld hl,auxfcb ; print filename from aux fcb
|
||
jp prfile
|
||
|
||
.extern dnak ; call diag to complain about a NAK
|
||
dnak:
|
||
call diag
|
||
db 'NAK received\0'
|
||
ret
|
||
|
||
.extern dnum ; ..... a bad packet number
|
||
dnum:
|
||
call diag
|
||
db 'Bad packet number\0'
|
||
ret
|
||
|
||
.extern dtime ; ..... a timeout
|
||
dtime:
|
||
call diag
|
||
db 'Timeout error\0'
|
||
ret
|
||
|
||
.extern dcheck ; ..... a checksum error
|
||
dcheck:
|
||
call diag
|
||
db 'Checksum error\0'
|
||
ret
|
||
|
||
.extern dcrc ; ..... a crc error
|
||
dcrc:
|
||
call diag
|
||
db 'CRC error\0'
|
||
ret
|
||
|
||
.extern dtries ; ..... too many retries
|
||
dtries:
|
||
call diag
|
||
db 'Too many retries\0'
|
||
ret
|
||
|
||
.dseg
|
||
.extern genfn
|
||
genfn: db '--XFER--000'
|
||
.extern abortf
|
||
abortf: dw 0
|
||
.extern lbrcnt
|
||
lbrcnt: db 0xff
|
||
|
||
.useg
|
||
w2ptr: ds 2
|
||
endw2: ds 2
|
||
onekp: ds 1
|
||
.extern ew2p
|
||
ew2p: ds 2
|
||
|