Source code of QTerm 4.3e added
This commit is contained in:
acn
parent
bad966dfcf
commit
5161e84617
|
|
@ -85,6 +85,8 @@ The file [QTERM43F.LBR](qterm43f.lbr) is the original QTerm distribution file.
|
|||
|
||||
The directory [files/](files/) contains all files from the .LBR file. There, the documentation for QTerm, [QTERM.DOC](files/QTERM.DOC) can be found.
|
||||
|
||||
In the directory [source/](source/), the source code of QTerm 4.3e can be found (as files and QT43SRC.LBR library).
|
||||
|
||||
### Applying a patch
|
||||
|
||||
The patches are applied using ```ZSM``` and ```ZPATCH```, which are included in the QTerm distribution (```QTERM43F.LBR```).
|
||||
|
|
|
|||
|
|
@ -0,0 +1,271 @@
|
|||
; baud.z - alter baud rate, and data word format
|
||||
|
||||
.var cmdlin 0x80
|
||||
|
||||
.macro baudtb speed
|
||||
dw speed
|
||||
dw b`speed
|
||||
.endm
|
||||
|
||||
.extern baud
|
||||
baud:
|
||||
call prompt
|
||||
db 'Baud rate? \0' ; see what is wanted
|
||||
ld hl,cmdlin - 1
|
||||
scanp: inc hl ; first look for +ch
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr z,noplus ; didn't find one, on to the next bit
|
||||
xor '+'
|
||||
jr nz,scanp ; not this char, on to the next
|
||||
ld (hl),a ; replace the '+' so we have a revised end
|
||||
inc hl
|
||||
ld bc,0x0200 ; b = 2: 2 chars, c = 0 for delimiter
|
||||
ld de,cschr ; save them in cschr and cqchr
|
||||
call parst ; crunch up the string
|
||||
noplus: ld hl,cmdlin - 1
|
||||
scansl: inc hl ; then look for a -del
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr z,nodel ; no '-' found: process normally
|
||||
xor '-'
|
||||
jr nz,scansl ; this was not a '-', on to the next
|
||||
ld (hl),a ; put a null in to make the '-' vanish
|
||||
call incbyp ; skip leading space
|
||||
or a ; anything there?
|
||||
jr z,nodel ; no - go crunch the rest
|
||||
cp '*' ; '*' as a place holder?
|
||||
jr z,nocsdl ; skip if no ^S delay
|
||||
ld de,1
|
||||
call scanm ; get a number, but default if none given
|
||||
ld a,e
|
||||
ld (csdely),a ; save in ^S delay
|
||||
nocsdl: call incbyp
|
||||
or a
|
||||
jr z,nodel ; exit now if nothing left
|
||||
cp '*'
|
||||
jr z,nochdl ; skip if no character delay
|
||||
sub '0'
|
||||
cp 10 ; check for a number
|
||||
ld de,ecflg
|
||||
ld (de),a ; set echo check flag
|
||||
jr nc,lcnum ; jump if not a number - this sets flag
|
||||
dec hl ; hl down to account for coming inx
|
||||
xor a ; clear acc
|
||||
ld (de),a ; and thus the echo check flag
|
||||
lcnum: inc hl
|
||||
ld de,0
|
||||
call scanm ; get another
|
||||
ld a,e
|
||||
ld (chd),a ; and save a character delay
|
||||
nochdl: call incbyp
|
||||
or a
|
||||
jr z,nodel ; exit now if nothing left
|
||||
cp '*'
|
||||
jr z,nodel ; and exit if a star
|
||||
ld de,lfecho
|
||||
ld (de),a ; set linefeed echo flag
|
||||
sub '0'
|
||||
cp 10 ; first char a digit
|
||||
jr nc,lfnum ; jump if not
|
||||
dec hl ; otherwise backstep hl
|
||||
xor a
|
||||
ld (de),a ; and clear linefeed echo flag
|
||||
lfnum: inc hl
|
||||
ld de,300
|
||||
call scanm
|
||||
ld (nld),de ; finally a newline delay
|
||||
nodel: ld hl,cmdlin
|
||||
call byp
|
||||
ld b,h
|
||||
ld c,l ; point bc at first non-white-space in line
|
||||
ld a,(bc)
|
||||
or a
|
||||
ret z ; end of line so do nothing
|
||||
cp '*' ; was a '*' skip over baud rate set
|
||||
jp z,bmode
|
||||
dec bc
|
||||
scan: inc bc ; now bypass leading zeros
|
||||
ld a,(bc)
|
||||
cp '0'
|
||||
jr z,scan
|
||||
ld hl,0 ; hl gets numeric value of rate
|
||||
ld ix,rate ; ix points to where string will live
|
||||
loop: ld a,(bc)
|
||||
sub '0'
|
||||
cp 10 ; get the next character & check it's a digit
|
||||
ld e,l
|
||||
ld d,h
|
||||
jr nc,gotit ; nope - we've finished
|
||||
add hl,hl ; * 2
|
||||
add hl,hl ; * 4
|
||||
add hl,de ; * 5
|
||||
add hl,hl ; * 10
|
||||
ld e,a
|
||||
ld d,0 ; new digit to de
|
||||
add hl,de ; add it in
|
||||
ld a,(bc) ; get the character again
|
||||
ld (ix),a ; save in string
|
||||
inc ix
|
||||
inc bc ; move both pointers
|
||||
jr loop ; and do it again
|
||||
gotit: ld a,d
|
||||
or e
|
||||
jr z,usage ; zero baud rate means we should complain
|
||||
ld a,' '
|
||||
push ix
|
||||
pop hl ; copy string save pointer to hl
|
||||
ld (hl),a
|
||||
inc hl
|
||||
ld (hl),a
|
||||
inc hl
|
||||
ld (hl),a ; add three spaces
|
||||
ld a,(bc) ; look at input char following rate
|
||||
or a
|
||||
jr z,cmdok ; zero byte is ok
|
||||
cp ' '
|
||||
jr z,cmdok ; and so is a space
|
||||
usage: call ilprt ; but we complain about anything else
|
||||
db 'Specify <rate> <mode>\r\n\0'
|
||||
ret
|
||||
cmdok: ld hl,table ; point at the table
|
||||
.dseg
|
||||
table: baudtb 38400
|
||||
baudtb 19200
|
||||
baudtb 9600
|
||||
baudtb 4800
|
||||
baudtb 2400
|
||||
baudtb 1200
|
||||
baudtb 600
|
||||
baudtb 300
|
||||
endtbl:
|
||||
|
||||
.cseg
|
||||
push bc ; save address in input string
|
||||
ld b,{endtbl - table} / 4
|
||||
scntbl: ld a,(hl)
|
||||
cp e
|
||||
inc hl ; check low byte of baud rate
|
||||
jr nz,bad2 ; skip if no match
|
||||
ld a,(hl)
|
||||
cp d ; check high byte
|
||||
jr z,gottbl ; match! - we got it
|
||||
bad2: inc hl ; this entry no good
|
||||
inc hl
|
||||
inc hl ; skip over it
|
||||
djnz scntbl ; and loop till we run out
|
||||
badbau: call ilprt ; go complain
|
||||
db 'Error: invalid baud rate\r\n\0'
|
||||
pop hl ; clean up the stack
|
||||
ret ; and exit
|
||||
gottbl: inc hl
|
||||
ld e,(hl)
|
||||
inc hl ; get address of baud value entry in
|
||||
ld d,(hl) ; configuration area
|
||||
ld a,(de) ; get the baud byte itself
|
||||
inc de
|
||||
ld b,a ; save in b
|
||||
ld a,(de) ; get the flag byte
|
||||
or a ; is it zero?
|
||||
jr z,badbau ; yes - go complain
|
||||
ld a,b
|
||||
call setbd ; go set the baud rate
|
||||
call ilprt ; and say what we did
|
||||
db 'Baud rate set to '
|
||||
|
||||
.extern rate
|
||||
rate: db ' \r\n\0'
|
||||
pop bc ; get the string address back to bc
|
||||
dec bc
|
||||
bmode: inc bc
|
||||
ld a,(bc)
|
||||
cp ' '
|
||||
jr z,bmode ; do a byp on bc
|
||||
or a
|
||||
ret z ; return now on end of string
|
||||
ld e,0 ; set e zero for mode selection
|
||||
ld ix,modsav ; point ix at save area
|
||||
ld (ix + 0),a ; save first byte in data bit count
|
||||
cp '7'
|
||||
jr z,seven ; better be '7'
|
||||
cp '8'
|
||||
jr z,eight ; or '8'
|
||||
badmod: call ilprt ; complain if it's wrong
|
||||
db 'Modes are [87][EON][12]\r\n\0'
|
||||
ret
|
||||
eight: inc e ; set bit 0 in e for 8 bit options
|
||||
seven: inc bc
|
||||
ld a,(bc) ; get the next character
|
||||
and 0x5f ; force upper case
|
||||
ld (ix + 2),a ; save it away
|
||||
cp 'N'
|
||||
jr z,nopty ; 'N' => no parity
|
||||
cp 'O'
|
||||
jr z,odd ; 'O' => odd parity
|
||||
cp 'E'
|
||||
jr nz,badmod ; 'E' => even parity: complain if no match
|
||||
set 2,e
|
||||
jr nopty ; set bit 2 to select even parity options
|
||||
odd: set 3,e ; set bit 3 to select odd parity options
|
||||
nopty: inc bc
|
||||
ld a,(bc) ; look at the last character
|
||||
ld (ix + 4),a ; and save it away
|
||||
cp '1'
|
||||
jr z,one ; better be '1'
|
||||
cp '2'
|
||||
jr nz,badmod ; or '2' - complain if it's neither
|
||||
set 1,e ; set bit 1 for 2 data bit options
|
||||
one: inc bc
|
||||
ld a,(bc)
|
||||
cp ' '
|
||||
jr z,one ; skip any trailing spaces
|
||||
or a
|
||||
jp nz,usage ; but complain if there was more junk
|
||||
ld d,0 ; extend index in e to 16 bits
|
||||
ld hl,modtab
|
||||
add hl,de ; index into table in configuration area
|
||||
ld a,(hl) ; get the byte
|
||||
call setmod ; go set the modes
|
||||
call ilprt
|
||||
db 'Mode set to '
|
||||
|
||||
.extern modsav
|
||||
modsav: db ' , , \r\n\0' ; and say what we did
|
||||
ret
|
||||
|
||||
scanm: ld a,(hl)
|
||||
sub '0'
|
||||
cp 10 ; did we get a digit?
|
||||
jr nc,donenm ; no - use default in de
|
||||
ld de,0 ; set de zero for answer
|
||||
scanlp: ld a,(hl)
|
||||
sub '0'
|
||||
cp 10 ; another digit?
|
||||
donenm: jp nc,unbyp ; exit if not - answer in de
|
||||
push hl ; save pointer
|
||||
ld h,d
|
||||
ld l,e
|
||||
add hl,hl
|
||||
add hl,hl
|
||||
add hl,de
|
||||
add hl,hl ; hl = de * 10
|
||||
ld e,a
|
||||
ld d,0
|
||||
add hl,de ; + new digit
|
||||
ex de,hl ; back to de
|
||||
pop hl
|
||||
inc hl ; look at next character
|
||||
jr scanlp
|
||||
|
||||
.dseg
|
||||
.extern csdely
|
||||
csdely: db 1
|
||||
.extern nld
|
||||
nld: dw 300
|
||||
.extern chd
|
||||
chd: db 0
|
||||
.extern cschr
|
||||
cschr: db 's' & 0x1f
|
||||
.extern cqchr
|
||||
cqchr: db 'q' & 0x1f
|
||||
|
||||
|
|
@ -0,0 +1,178 @@
|
|||
; catch.z - open & close catch files, also put them on hold
|
||||
|
||||
.incl "c:vars"
|
||||
|
||||
.extern catch
|
||||
catch:
|
||||
ld a,(cflg)
|
||||
or a
|
||||
jr z,tfileo
|
||||
ld a,2
|
||||
ld (cflg),a
|
||||
|
||||
.extern hold
|
||||
hold:
|
||||
ld hl,cflg
|
||||
ld a,(hl)
|
||||
or a ; file open?
|
||||
ret z ; no - so do nothing
|
||||
xor 3
|
||||
ld (hl),a ; toggle hold mode
|
||||
push af
|
||||
call ilprt
|
||||
db '\r\nCatch file \0'
|
||||
pop af
|
||||
dec a
|
||||
jr z,reac
|
||||
call ilprt
|
||||
db 'on hold\r\n\0'
|
||||
ret
|
||||
reac: call ilprt
|
||||
db 'reactivated\r\n\0'
|
||||
ret
|
||||
|
||||
.extern cclose
|
||||
cclose:
|
||||
ld a,(cflg)
|
||||
or a
|
||||
ret z
|
||||
call doclos
|
||||
call ilprt
|
||||
db '\r\nFile closed\r\n\0'
|
||||
ret
|
||||
|
||||
tfileo: call getfcb
|
||||
ret c
|
||||
jp z,nowc
|
||||
ld a,(fcb + 2)
|
||||
cp ' '
|
||||
scf
|
||||
ret z
|
||||
call reset
|
||||
ld hl,fcb
|
||||
ld de,cfcb
|
||||
push de
|
||||
ld bc,34
|
||||
ldir
|
||||
pop de
|
||||
push de
|
||||
ld c,open
|
||||
call usrbds
|
||||
inc a
|
||||
pop de
|
||||
jr z,isok
|
||||
appndq: ld hl,10
|
||||
add hl,de
|
||||
bit 7,(hl)
|
||||
jr z,appok
|
||||
call ilprt
|
||||
db 'Can\'t append file\r\n\0'
|
||||
ret
|
||||
appok: ld c,cfsize
|
||||
push de
|
||||
call usrbds
|
||||
pop de
|
||||
ld hl,36
|
||||
add hl,de
|
||||
ld a,(hl)
|
||||
dec hl
|
||||
or (hl)
|
||||
dec hl
|
||||
or (hl)
|
||||
jr z,creok
|
||||
declp: ld a,(hl)
|
||||
dec (hl)
|
||||
inc hl
|
||||
or a
|
||||
jr z,declp
|
||||
push de
|
||||
ld de,(cbuff)
|
||||
ld c,setdma
|
||||
call bdos
|
||||
call fill1a
|
||||
pop de
|
||||
ld c,redrnd
|
||||
call usrbds
|
||||
ld hl,(cbuff)
|
||||
dec hl
|
||||
eofl: inc hl
|
||||
ld a,(hl)
|
||||
cp 0x1a
|
||||
jr nz,eofl
|
||||
ld (cptr),hl
|
||||
jr setcfo
|
||||
isok: ld c,create
|
||||
call usrbds
|
||||
inc a
|
||||
jr nz,creok
|
||||
call ilprt
|
||||
db 'Can\'t create file\r\n\0'
|
||||
ret
|
||||
creok: call fill1a
|
||||
setcfo: call ilprt
|
||||
db 'File opened\r\n\0'
|
||||
xor a
|
||||
inc a
|
||||
setcfl: ld (cflg),a
|
||||
ret
|
||||
|
||||
doclos: call flushc
|
||||
ld de,cfcb
|
||||
ld c,close
|
||||
call usrbds
|
||||
call ctlq
|
||||
xor a
|
||||
jr setcfl
|
||||
|
||||
.extern flushc ; enter here to flush any pending write of
|
||||
flushc: ; catch buffer
|
||||
ld hl,(cptr)
|
||||
ld de,(cbuff) ; point at buffer
|
||||
or a
|
||||
sbc hl,de ; how many chars in buffer
|
||||
dec hl
|
||||
add hl,hl
|
||||
inc h
|
||||
ld b,h ; converted to sector count
|
||||
ret z ; nothing to write - exit now
|
||||
push bc
|
||||
push de
|
||||
call ctls ; hold up the other end
|
||||
pop de
|
||||
pop bc
|
||||
wrtlp: push bc
|
||||
push de ; save registers
|
||||
ld c,setdma
|
||||
call bdos ; set dma for next 128 bytes
|
||||
ld de,cfcb
|
||||
ld c,write
|
||||
call usrbds ; out they go
|
||||
pop de
|
||||
ld hl,128
|
||||
add hl,de ; move dma
|
||||
ex de,hl
|
||||
pop bc
|
||||
djnz wrtlp ; loop till all done
|
||||
|
||||
fill1a: ; enter here to fill catch buffer with 0x1a's
|
||||
; and reset catch pointer
|
||||
ld hl,(cbuff)
|
||||
ld (cptr),hl ; adjust catch pointer as well
|
||||
ld d,h
|
||||
ld e,l
|
||||
inc de ; copy to de & add 1
|
||||
ld bc,(cbfsiz) ; get buffer size
|
||||
ld (hl),0x1a ; first one
|
||||
ldir ; and the rest
|
||||
ret
|
||||
|
||||
.dseg
|
||||
.extern cflg
|
||||
cflg: db 0
|
||||
|
||||
.useg
|
||||
.extern cptr
|
||||
cptr: ds 2 ; pointer to next save address
|
||||
.extern cfcb
|
||||
cfcb: ds 37 ; fcb for catching
|
||||
|
||||
|
|
@ -0,0 +1,859 @@
|
|||
; cf.z - creeping featurism (i.e. file operations in chat scripts)
|
||||
; plus stuff to look after numbers in chat scripts
|
||||
|
||||
.incl "c:vars"
|
||||
|
||||
; stest - compare two strings !% = .s1.s2. `label jump if equal
|
||||
; !% _ .s1.s2. `label jump if equal case insens.
|
||||
; !% # .s1.s2. `label jump if not equal
|
||||
|
||||
.extern stest
|
||||
stest: xor a
|
||||
ld (casefl),a
|
||||
call areabp
|
||||
cp '#'
|
||||
jr z,ckseq ; '#' for inequality
|
||||
xor '='
|
||||
jr z,ckseq ; '=' for equality
|
||||
ld (casefl),a ; set case flag true
|
||||
xor '_' ^ '=' ; '_' for equality case insensitive
|
||||
ret nz
|
||||
ckseq: or a ; z equality, nz inequality
|
||||
push af ; save test value
|
||||
call incbyp ; step up to strings
|
||||
push hl
|
||||
ld hl,work2
|
||||
ld de,work2 + 1
|
||||
ld bc,255
|
||||
ld (hl),b
|
||||
ldir ; clear space where strings will live
|
||||
pop hl
|
||||
or a
|
||||
jr z,testzz
|
||||
ld de,work2 + 1
|
||||
ld b,2
|
||||
seqslp: push bc
|
||||
call scanst ; scan a string
|
||||
inc de
|
||||
pop bc
|
||||
jr c,testzz ; exit if end of input
|
||||
djnz seqslp ; otherwise loop till both read
|
||||
inc hl ; skip trailing terminator
|
||||
push hl ; save input pointer
|
||||
ld hl,work2 + 1
|
||||
ld de,work2 + 42 ; get the two strings
|
||||
csl: ld b,0x7f
|
||||
call cmptst ; check a characters
|
||||
jr nz,phltz ; different, so finish test operation
|
||||
ld a,(hl)
|
||||
or a ; end of string?
|
||||
jr z,phltz ; yes - finish test this way too
|
||||
inc hl
|
||||
inc de ; next chars .....
|
||||
jr csl
|
||||
|
||||
; the !~ creeping featurism entry
|
||||
|
||||
.extern cf
|
||||
cf:
|
||||
call areabu ; what's wanted?
|
||||
inc hl
|
||||
cp '-'
|
||||
jr z,cf_era ; '-' erases
|
||||
cp '='
|
||||
jr z,cf_ren
|
||||
cp '+'
|
||||
jr z,cf_copy ; '+' copies
|
||||
cp 'Y'
|
||||
jr z,cf_filq ; 'Y' file query: jump if file exists
|
||||
xor 'N'
|
||||
ret nz ; 'N' file query: jump if file doesn't exist
|
||||
|
||||
; fall into file query routine
|
||||
|
||||
; file query: check see if a file exists or not, and then jump to a label if
|
||||
; it does.
|
||||
|
||||
cf_filq:
|
||||
or a ; z for 'N', nz for 'Y'
|
||||
push af
|
||||
call scnfcb ; get a fcb
|
||||
ld de,fcb
|
||||
ld c,open ; try to open it - note that this will also
|
||||
; work with wildcards
|
||||
push hl
|
||||
call usrbds ; open
|
||||
inc a
|
||||
phltz: pop hl
|
||||
testzz: jr z,nofil ; not there - do test one way round
|
||||
pop af ; 'Y' / 'N' result back
|
||||
ret z ; 'N' and file exists => no skip
|
||||
jr dskp1 ; 'Y' and file => skip
|
||||
nofil: pop af ; no file .....
|
||||
ret nz ; 'Y' and no file => no skip
|
||||
dskp1: jp doskip ; go skip to the new line
|
||||
|
||||
; rename: du: is taken from the first name - a1:x = b7:y will rename a1:y
|
||||
|
||||
cf_ren: call gettwo
|
||||
ret c ; exit on an error
|
||||
ld hl,(auxfcb)
|
||||
ld (fcb),hl ; xfer drive / user info
|
||||
ld de,fcb
|
||||
ld c,open
|
||||
call usrbds ; open
|
||||
inc a
|
||||
ret z ; not there - exit
|
||||
ld a,(fcb + 10)
|
||||
add a,a
|
||||
ret c ; if it's R/O stop now
|
||||
ld de,auxfcb
|
||||
ld c,open
|
||||
call usrbds ; open
|
||||
inc a
|
||||
ret nz ; replacement _IS_ there - so exit
|
||||
ld hl,auxfcb + 1
|
||||
ld de,fcb + 17
|
||||
ld bc,16
|
||||
ldir ; shift stuff for rename
|
||||
ld de,fcb
|
||||
ld c,rename
|
||||
jp usrbds ; go do it
|
||||
|
||||
; erase subroutine: no wildcards, single file erase
|
||||
|
||||
cf_era: call scnfcb
|
||||
ret z ; no wildcards allowed
|
||||
ld de,fcb
|
||||
ld c,open
|
||||
call usrbds ; open the file
|
||||
ld a,(fcb + 10)
|
||||
add a,a
|
||||
ret c ; if it's R/O stop now
|
||||
ld de,fcb
|
||||
ld c,erase
|
||||
jp usrbds ; otherwise erase it
|
||||
|
||||
; copy file routine
|
||||
|
||||
cf_copy:
|
||||
call gettwo ; get two fcb's - one to fcb, one to auxfcb
|
||||
ret c ; exit on an error
|
||||
ld de,fcb
|
||||
ld c,open
|
||||
call usrbds ; open file1
|
||||
inc a
|
||||
ret z ; not there: exit
|
||||
ld de,auxfcb
|
||||
ld c,open
|
||||
call usrbds ; open file2
|
||||
inc a
|
||||
ret nz ; is there: exit
|
||||
ld de,auxfcb
|
||||
ld c,create
|
||||
call usrbds ; create file2
|
||||
inc a
|
||||
ret z ; create failed: exit
|
||||
ld de,xbuff
|
||||
ld c,setdma
|
||||
call bdos ; set dma address
|
||||
cplp: ld de,fcb
|
||||
ld c,read
|
||||
call usrbds ; read a sector
|
||||
or a
|
||||
jr nz,copied ; all done
|
||||
ld de,auxfcb
|
||||
ld c,write
|
||||
call usrbds ; write it back
|
||||
or a
|
||||
jr z,cplp ; exit if write failed
|
||||
copied: ld de,auxfcb
|
||||
ld c,close
|
||||
jp usrbds ; close output file
|
||||
|
||||
; parse two filenames, separated by an '=' sign
|
||||
|
||||
gettwo: call scnfcb ; get one
|
||||
scf
|
||||
ret z ; exit w/ carry if wildcards
|
||||
call byp
|
||||
cp '=' ; need an '='
|
||||
scf
|
||||
ret nz ; not there: exit
|
||||
push hl
|
||||
call xferax ; shift it to auxfcb
|
||||
pop hl
|
||||
inc hl
|
||||
call scnfcb ; get a second
|
||||
scf
|
||||
ret z ; exit with carry on an error
|
||||
or a
|
||||
ret ; else clear carry for OK
|
||||
|
||||
; !@ evaluation subroutine
|
||||
|
||||
.extern eval
|
||||
eval:
|
||||
call areabu ; set to read the string
|
||||
sub 'A' ; get the variable number
|
||||
cp 26
|
||||
jr nc,eerr0 ; not legal, exit now
|
||||
call ivar
|
||||
push de ; save it's address
|
||||
inc hl
|
||||
call scan ; scan a term
|
||||
jr c,eerr1 ; no good - exit
|
||||
push af ; save the value
|
||||
call byp
|
||||
cp '-'
|
||||
jr z,opok
|
||||
xor '+' ; check the operator
|
||||
jr nz,eerr2
|
||||
opok: push af ; save the operator (zero for '+', nz for '-')
|
||||
inc hl
|
||||
call scan ; get a second term
|
||||
jr nc,s2ok ; all OK, go set the variable
|
||||
pop de
|
||||
eerr2: pop de
|
||||
eerr1: pop de ; clean up the stack
|
||||
eerr0: call ilprt
|
||||
db 'Bad expression: \0'
|
||||
call dim ; tell the user
|
||||
ld hl,0x80
|
||||
call prtslp
|
||||
jp crlf ; and return
|
||||
s2ok: ld l,a ; second term to l
|
||||
pop bc ; operator to b
|
||||
pop af ; first term to a
|
||||
dec b
|
||||
inc b ; zero => '+'
|
||||
jr z,addem ; go do it
|
||||
sub l
|
||||
sub l ; setup for subtraction
|
||||
addem: add a,l ; do the addition
|
||||
pop hl ; restore variable address
|
||||
ld (hl),a ; save result
|
||||
ret
|
||||
|
||||
; !# test routine: compare variables with other variables or numbers
|
||||
|
||||
.extern test
|
||||
test:
|
||||
call areabu
|
||||
sub 'A' ; get the variable
|
||||
cp 26
|
||||
jr nc,eerr0 ; exit on an error
|
||||
call ivar
|
||||
ld a,(de) ; get te value
|
||||
push af ; save it
|
||||
call incbyp ; get the operator
|
||||
cp '<'
|
||||
jr z,cmpok
|
||||
cp '>'
|
||||
jr z,cmpok
|
||||
cp '#'
|
||||
jr z,cmpok
|
||||
xor '='
|
||||
jr nz,eerr1 ; exit if it's no good
|
||||
cmpok: push af ; save the operator
|
||||
inc hl
|
||||
call scan ; get the term
|
||||
jr c,eerr2 ; something wrong, exit
|
||||
ld e,a ; term to e
|
||||
pop af ; restore the operator
|
||||
or a
|
||||
jr nz,nocpe ; z => '=' => equality
|
||||
pop af
|
||||
cp e ; test for equality
|
||||
ret nz ; exit if no good
|
||||
jr doskip ; go do the goto
|
||||
|
||||
; this is here for jr length reasons
|
||||
|
||||
cplt: pop af
|
||||
cp e ; compare
|
||||
skipnc: ret nc ; if it failed exit now
|
||||
|
||||
; jump to a line number
|
||||
|
||||
doskip: call scnnum ; get the number to go to
|
||||
pop hl ; get return address back
|
||||
pop de ; get the next line
|
||||
dec a ; save it away (needs to be -1)
|
||||
push af ; save the new line away
|
||||
jp (hl) ; jump to return address
|
||||
|
||||
nocpe: cp '#' ; '#' => inequality
|
||||
jr nz,nocpne
|
||||
pop af ; restore variable value
|
||||
cp e
|
||||
ret z ; exit if test failed
|
||||
jr doskip ; else do the goto
|
||||
nocpne: cp '>'
|
||||
jr nz,cplt ; '>' => greater than
|
||||
pop af ; var to a
|
||||
ld d,a ; and to d
|
||||
ld a,e ; term to e
|
||||
cp d ; and compare
|
||||
jr skipnc ; go check the result
|
||||
|
||||
; initch - do odd bits and pieces of setup for chat operation
|
||||
|
||||
.extern initch
|
||||
initch: ld a,1
|
||||
ld (opentr),a ; clear number of open tries
|
||||
|
||||
.extern clrvar
|
||||
clrvar:
|
||||
ld a,'A'
|
||||
ld (_check_),a
|
||||
ld hl,vars ; nuke all variables to zero
|
||||
ld de,vars + 1
|
||||
ld bc,26 + 9 + 26 ; 26 numbers, plus 35 strings 0 - 9 & a - z
|
||||
ld (hl),b ; start with a zero from b
|
||||
ldir
|
||||
dec b ; b comes out of the ldir w/ zero: dec to -1
|
||||
ld (hl),b ; -1 byte to end strings
|
||||
ld bc,512 - 9 - 27
|
||||
ldir ; fill remaining space with -1's
|
||||
ret
|
||||
|
||||
ivar: push hl ; save hl
|
||||
ld l,a
|
||||
ld h,0 ; offset in a to hl
|
||||
ld de,vars
|
||||
add hl,de ; index into table
|
||||
ex de,hl ; swap to de
|
||||
pop hl ; restore hl
|
||||
ret
|
||||
|
||||
scan: call byp
|
||||
or 0x20
|
||||
sub 'a' ; was it a letter?
|
||||
cp 26
|
||||
jr nc,scnnum ; no, go see about a number
|
||||
inc hl ; step over it
|
||||
call ivar ; index into array
|
||||
ld a,(de) ; get the value
|
||||
ret ; and return - carry cleared by ivar
|
||||
|
||||
scnnum: ld e,0
|
||||
call byp ; find the number
|
||||
snlp: ld a,(hl) ; get char back
|
||||
sub '0'
|
||||
cp 10 ; number?
|
||||
ccf
|
||||
ret c ; return if not
|
||||
ld d,a ; save in d
|
||||
ld a,e
|
||||
add a,a
|
||||
add a,a
|
||||
add a,e
|
||||
add a,a ; a = e * 10
|
||||
add a,d ; + d
|
||||
ld e,a
|
||||
inc hl
|
||||
ld a,(hl) ; next letter
|
||||
cp '-'
|
||||
jr z,rete
|
||||
cp '+'
|
||||
jr z,rete ; + and - are legal delimiters
|
||||
or ' '
|
||||
xor ' ' ; so are ' ' and null
|
||||
rete: ld a,e ; get value from e
|
||||
jr nz,snlp
|
||||
ret ; return, carry clear from compare
|
||||
|
||||
; mattog - handle !& toggles: 'm' & 'l' for matches, 'o' for modem output echo
|
||||
|
||||
.extern mattog
|
||||
mattog: call areabu ; get command letter and upper case it
|
||||
cp 'O'
|
||||
ld c,op_bit ; 'O' - do output bit
|
||||
jr z,dotog
|
||||
cp 'L'
|
||||
ld c,lf_bit ; 'L' - do looking for message bit
|
||||
jr z,dotog
|
||||
cp 'M' ; 'M' - do match bit
|
||||
ret nz
|
||||
ld c,mat_bit
|
||||
dotog: call incbyp ; now look for a char to say what to do
|
||||
ld hl,mode ; point hl at mode byte
|
||||
or a
|
||||
jr z,xorit ; nothing: toggle the bit
|
||||
cp '0'
|
||||
jr nz,clrit ; not '0': clear the bit to enable
|
||||
ld a,(hl)
|
||||
or c ; otherwise set it
|
||||
jr smret
|
||||
clrit: ld a,c
|
||||
cpl ; toggle bit in c
|
||||
and (hl) ; clear the bit in questin
|
||||
jr smret
|
||||
xorit: ld a,(hl)
|
||||
xor c ; flip the bit
|
||||
smret: ld (hl),a ; save and we're done
|
||||
ret
|
||||
|
||||
; messag - process a !> printout
|
||||
|
||||
.extern messag
|
||||
messag: call areabp ; point at first non-white
|
||||
ld de,packet ; somewhere to put it
|
||||
push de
|
||||
ld bc,128 << 8 ; 128 chars max, and eoln is the delimiter
|
||||
call parst ; crunch up the string
|
||||
pop hl
|
||||
jp prtslp ; and dump it out
|
||||
|
||||
; fileio - process !( r/w commands to read / write variables from the file
|
||||
|
||||
.extern fileio
|
||||
fileio:
|
||||
call areabu ; get R or W
|
||||
cp 'R'
|
||||
jr z,setrd
|
||||
cp 'W'
|
||||
ret nz
|
||||
ld a,34 ; write random
|
||||
db 0x11 ; ld de,XXXX - kills ld a below
|
||||
setrd: ld a,33 ; read random
|
||||
ld (hibit),a ; save it away for later
|
||||
call incbyp
|
||||
or 0x20
|
||||
sub 'a'
|
||||
cp 26
|
||||
ret nc ; check valid string name
|
||||
push af ; save string index
|
||||
call incbyp
|
||||
sub '0' ; number zero to nine for file record
|
||||
|
||||
ld hl,lbrs ; get /QTERM.LBR as a filename
|
||||
push af
|
||||
call scnfcb ; parse into 0x5b
|
||||
pop af
|
||||
ld hl,['T' << 8] + 'S'
|
||||
ld (0x65),hl ; convert extent from LBR to STR
|
||||
ld hl,(chtusr)
|
||||
inc h
|
||||
ld (0x5b),hl ; set drive / user
|
||||
ld hl,0x68 ; point hl / de at nulls
|
||||
ld de,0x69
|
||||
ld bc,0xff - 0x68 ; clear to end of name
|
||||
ldir
|
||||
ld (0x7d),a ; save record number now
|
||||
|
||||
ld de,0x5b
|
||||
ld c,15
|
||||
call usrbds ; open it
|
||||
pop de
|
||||
inc a
|
||||
ret z ; exit if no good
|
||||
ld a,d
|
||||
add a,9
|
||||
call fparam ; point at string
|
||||
ld de,0x80
|
||||
push de ; save string address to read from
|
||||
push hl ; save string address in table
|
||||
push de ; and read address again
|
||||
ld b,d
|
||||
ld c,0x7f
|
||||
ldir ; shift the string
|
||||
pop de ; address to de
|
||||
ld c,26
|
||||
call bdos ; set dma
|
||||
ld bc,(hibit) ; r/w BDOS opcode to c
|
||||
ld de,0x5b
|
||||
push de
|
||||
call usrbds ; do the operation
|
||||
pop de
|
||||
ld c,16
|
||||
call usrbds ; close the file
|
||||
pop hl
|
||||
jr repstr ; replace string in table
|
||||
|
||||
; sinput - handle two cases of input processing for !<
|
||||
|
||||
.extern sinput
|
||||
sinput: call areabp ; get the command character
|
||||
ld d,a ; command char to d
|
||||
call incbyp ; get variable / string letter
|
||||
call ucsa ; upper case it
|
||||
sub 'A'
|
||||
cp 26 ; is it valid?
|
||||
ret nc ; nope
|
||||
ld e,a ; letter code to e
|
||||
ld a,d ; command char back from d
|
||||
xor '-'
|
||||
jr z,strin ; '-' for string input
|
||||
xor '.' ^ '-'
|
||||
ret nz ; '.' for hot key input
|
||||
ld d,a ; make code in e fill de
|
||||
push de ; save
|
||||
call kbdin ; go get a character
|
||||
pop de
|
||||
ld hl,vars
|
||||
add hl,de ; index into variables
|
||||
ld (hl),a ; save the letter
|
||||
ret
|
||||
|
||||
strin: ld d,e
|
||||
push de
|
||||
ld de,work2 ; point at input area
|
||||
ld a,40
|
||||
ld (de),a ; 40 chars maximum
|
||||
ld c,10
|
||||
call bdos ; go get them
|
||||
call crlf ; throw a new line just for the hell of it
|
||||
ld hl,work2 + 1
|
||||
ld e,(hl) ; get the length
|
||||
inc hl ; point at real text
|
||||
pop af
|
||||
push hl
|
||||
ld d,0 ; extend length to de
|
||||
add hl,de ; point at end of string
|
||||
ld (hl),d ; add a null terminating byte
|
||||
savstr: add a,9 ; get string index to a
|
||||
call fparam ; point at string
|
||||
repstr: call kilstr ; kill it
|
||||
xor a
|
||||
pop de
|
||||
jp insstr ; and replace it
|
||||
|
||||
; now starts the middle of the "read string variable from modem" code - this
|
||||
; is kinda cut to shreds for jr length reasons - we enter at the bottom and
|
||||
; leave via savstr above
|
||||
|
||||
; the very end - we've read the string, now it's time to save it
|
||||
|
||||
gotit: inc de ; point back to start
|
||||
push de ; save this point for later
|
||||
ld h,d
|
||||
ld l,e ; copy to hl
|
||||
kcclp: ld a,(hl) ; get a char
|
||||
and 0x7f ; nuke bit 7
|
||||
ld (de),a ; save it
|
||||
inc hl ; bump read ptr
|
||||
or a
|
||||
jr z,hsav ; exit on a null
|
||||
cp ' '
|
||||
jr c,kcclp ; ditch control chars
|
||||
cp 0x7f
|
||||
jr z,kcclp ; and deletes
|
||||
inc de ; otherwise step up to allow saved character
|
||||
jr kcclp
|
||||
|
||||
hsav: ld a,(hibit) ; get string number
|
||||
jr savstr ; go and save it
|
||||
|
||||
; now the loop to find the start
|
||||
|
||||
stlp: call redsch ; check a character
|
||||
jr z,wasec ; check for end character
|
||||
ld a,(de) ; no - we'll want to save original char back
|
||||
wasec: ld c,a ; save char to save
|
||||
push hl
|
||||
ld h,l ; load start char into h
|
||||
call chksch ; did we find it?
|
||||
pop hl
|
||||
ld a,c
|
||||
ld (de),a ; drop terminator in
|
||||
jr z,gotit ; yes - go save it away
|
||||
djnz stlp ; count chars
|
||||
ret ; return when we run out chars
|
||||
|
||||
; ![ ^ a c1c2
|
||||
;
|
||||
; After ![ - and ![ : and normal lines have left text in w2 (a la stufw2),
|
||||
; parse a string starting with c1 (but not including it), and ending with c2
|
||||
; (again not including it) - save in string a. If c1 (or c2) are a null
|
||||
; then the string becomes any whitespace delimited string: whitespace is
|
||||
; taken as ' ', tab, cr, lf. Note also that all control characters are
|
||||
; thrown away.
|
||||
|
||||
ipstr: call ucsahl
|
||||
sub 'A' ; convert .....
|
||||
cp 26 ; and test string index
|
||||
ret nc
|
||||
ld (hibit),a ; save it
|
||||
call incbyp ; step up to delimiter chars
|
||||
push hl
|
||||
ld hl,work2 + 257
|
||||
ld de,packet
|
||||
ld bc,66
|
||||
ldir
|
||||
pop hl
|
||||
ld de,pack + 1 ; save them in pack
|
||||
ld b,2 ; two, null terminates
|
||||
xor a
|
||||
ld (de),a ; preload chars with two nulls
|
||||
dec de
|
||||
ld (de),a
|
||||
call parst ; crunch up the string
|
||||
ld hl,(pack) ; load delimiters from where parst put them
|
||||
ld bc,64 << 8 ; max of 64 chars to look at / c == 0
|
||||
ld de,packet + 65 ; point de at saved text
|
||||
|
||||
; now loop looking for the end
|
||||
|
||||
endlp: call redsch ; check a character
|
||||
jr nz,noend ; check for end character
|
||||
inc c ; flag we saw an end char
|
||||
ld (de),a ; add a zero to terminate
|
||||
jr cntend ; jump to count
|
||||
noend: dec c
|
||||
inc c
|
||||
jr nz,stlp ; we've seen an end - go do it
|
||||
cntend: djnz endlp ; count chars
|
||||
ret ; return when we run out chars
|
||||
|
||||
; handle ![ multiple choice thingies from the modem
|
||||
|
||||
.extern multi
|
||||
multi:
|
||||
call areabp ; what's wanted?
|
||||
ld c,a ; save the second character
|
||||
call incbyp ; strip spaces
|
||||
xor a
|
||||
ld (casefl),a
|
||||
ld a,c
|
||||
cp '^'
|
||||
jr z,ipstr
|
||||
cp ':'
|
||||
jp z,silnce
|
||||
cp '-' ; '-' input ......
|
||||
jr z,minput
|
||||
xor '+' ; '+' for 8 bit string compare
|
||||
jr z,str8b
|
||||
cp '=' ^ '+' ; '=' for 7 bit
|
||||
jr z,str7b
|
||||
cp '_' ^ '+' ; '_' for 7 bit and case insensitive
|
||||
ret nz ; oops - don't grok it.
|
||||
ld (casefl),a ; set case flag
|
||||
str7b: ld a,0x7f ; set 7 bit flag
|
||||
db 0x06 ; makes the next byte the operand of a ld b,xx
|
||||
str8b: dec a ; really ld a,0xff since a == 0:
|
||||
; set all 8 bits
|
||||
push af ; save comparison mask
|
||||
ld de,packet ; somewhere to put match string
|
||||
ld bc,[40 << 8] + ' ' ; 40 chars max, space is the delimiter
|
||||
call parst ; crunch up the string
|
||||
pop bc ; comparison mask back to b
|
||||
ret c ; oops - bad string
|
||||
push hl
|
||||
ld hl,work2 + 322 ; point at stuff we read ..... (don't ask why
|
||||
mclp: dec hl ; it's there :-)
|
||||
ld a,(hl) ; end of string yet?
|
||||
or a
|
||||
pop de ; keep stack safe
|
||||
ret z ; end of string: exit
|
||||
push de ; save word back on stack
|
||||
ld de,packet
|
||||
call cmptst ; do we have a match??
|
||||
jr nz,mclp ; skip if no good
|
||||
push hl
|
||||
cmplp: ld a,(de)
|
||||
or a ; end of string we're searching for?
|
||||
jr nz,mtchmo ; yes - we got a hit
|
||||
pop hl
|
||||
pop hl ; get string pointer back to hl
|
||||
doskp1: jp doskip
|
||||
mtchmo: call cmptst
|
||||
jr nz,mchbad ; oops - didn't match, so exit now
|
||||
inc hl
|
||||
inc de
|
||||
jr cmplp ; and back for more
|
||||
mchbad: pop hl ; restore pointer
|
||||
jr mclp ; and back for more
|
||||
|
||||
minput: call scnnum ; get a time
|
||||
or a
|
||||
jr nz,timok
|
||||
ld a,15 ; none given, default to 15 seconds
|
||||
timok: push af
|
||||
push hl
|
||||
ld hl,work2
|
||||
ld de,work2 + 1
|
||||
ld bc,512
|
||||
ld (hl),c
|
||||
ldir ; clear space where strings will live
|
||||
pop hl
|
||||
call byp
|
||||
or a
|
||||
jr z,nostr ; no strings, all done
|
||||
ld de,work2 + 1
|
||||
ld b,4
|
||||
sslp: push bc
|
||||
call scanst ; scan a string
|
||||
inc de
|
||||
pop bc
|
||||
jr c,nostr ; exit if end of input
|
||||
djnz sslp ; otherwise loop till 4 read
|
||||
nostr: ld hl,work2 + 1
|
||||
call finstr ; get address of it's end
|
||||
ld (work2 + 240),hl ; and save it
|
||||
ld hl,work2 + 42
|
||||
call finstr
|
||||
ld (work2 + 242),hl ; and for string 2
|
||||
ld hl,work2 + 83
|
||||
call finstr
|
||||
ld (work2 + 244),hl ; and 3
|
||||
ld hl,work2 + 124
|
||||
call finstr
|
||||
ld (work2 + 246),hl ; and 4
|
||||
pop af ; get time back
|
||||
ld c,a ; save it
|
||||
second: dec c
|
||||
ret z ; all out of time - exit
|
||||
ld de,600
|
||||
call setspd ; set the speed
|
||||
qrtrms: ld b,96 ; hang loose a while
|
||||
qmslp: djnz qmslp
|
||||
push hl
|
||||
push bc
|
||||
call procch
|
||||
jr c,nochar
|
||||
call stufw2 ; save the char
|
||||
inc de
|
||||
ld hl,(work2 + 240)
|
||||
call chkbak ; did we get string1
|
||||
jr z,gotone ; exit if so
|
||||
ld hl,(work2 + 242)
|
||||
call chkbak ; string 2?
|
||||
jr z,gotone ; exit if so
|
||||
ld hl,(work2 + 244)
|
||||
call chkbak ; string 3
|
||||
jr z,gotone ; exit if so
|
||||
ld hl,(work2 + 246)
|
||||
call chkbak ; and lastly check string 4
|
||||
jr z,gotone
|
||||
nochar: pop bc
|
||||
pop hl
|
||||
dec hl ; count down second timer
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,qrtrms
|
||||
jr second ; loop back
|
||||
|
||||
gotone: pop bc
|
||||
pop hl
|
||||
ret
|
||||
|
||||
.extern stufw2
|
||||
stufw2: ld hl,work2 + 258
|
||||
ld de,work2 + 257
|
||||
ld bc,64
|
||||
ldir
|
||||
ld (de),a ; save the character
|
||||
ret
|
||||
|
||||
.extern clerw2
|
||||
clerw2: ld hl,work2 + 256
|
||||
ld de,work2 + 257
|
||||
ld bc,70
|
||||
ld (hl),b
|
||||
ldir
|
||||
ret
|
||||
|
||||
finstr: ld a,(hl)
|
||||
or a
|
||||
ret z
|
||||
inc hl
|
||||
jr finstr
|
||||
|
||||
chkbak: dec hl
|
||||
ld a,(hl)
|
||||
inc hl
|
||||
or a
|
||||
jr nz,isastr
|
||||
inc a
|
||||
ret
|
||||
isastr: push de
|
||||
cklp: dec de
|
||||
dec hl
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr z,pdret
|
||||
ld a,(de)
|
||||
xor (hl)
|
||||
and 0x7f
|
||||
jr z,cklp
|
||||
pdret: pop de
|
||||
ret
|
||||
|
||||
cmptst: ld a,(casefl)
|
||||
or a ; case insensitive?
|
||||
push af ; save z flag
|
||||
ld a,(de)
|
||||
jr z,noucs1 ; nope - use the character as is
|
||||
and 0x7f
|
||||
call ucsa ; force upper case
|
||||
noucs1: ld c,a
|
||||
pop af ; get z flag back for case insensitive
|
||||
ld a,(hl)
|
||||
jr z,noucs2
|
||||
and 0x7f
|
||||
call ucsa ; mask and force upper case
|
||||
noucs2: xor c ; get in the rest of it
|
||||
and b ; mask as necessary
|
||||
ret
|
||||
|
||||
silnce: call scnnum ; get a time
|
||||
or a
|
||||
jr nz,stimok
|
||||
ld a,15 ; none given, default to 15 seconds
|
||||
stimok: call clerw2
|
||||
ld b,a
|
||||
inc b
|
||||
setsil: ld c,b
|
||||
xsecnd: dec c
|
||||
ret z
|
||||
push bc
|
||||
ld de,600
|
||||
call setspd ; set the speed
|
||||
xrtrms: ld b,96 ; hang loose a while
|
||||
xmslp: djnz xmslp
|
||||
push hl
|
||||
call procch
|
||||
pop hl
|
||||
jr c,xnchar
|
||||
call stufw2
|
||||
pop bc
|
||||
jr setsil
|
||||
xnchar: dec hl ; cound down second
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,xrtrms
|
||||
pop bc
|
||||
jr xsecnd ; loop back
|
||||
|
||||
; read a char, and see if it matches the delimiter in c
|
||||
|
||||
redsch: dec de
|
||||
chksch: ld a,(de)
|
||||
and 0x7f ; nuke parity
|
||||
inc h
|
||||
dec h ; is h zero?
|
||||
jr nz,nowsp ; no - don't do white space check
|
||||
call iswa ; is it white space?
|
||||
scf
|
||||
ccf ; clear carry
|
||||
ret nz ; return nz if not (no match)
|
||||
xor a ; clear a so 'cp h' below forces zero
|
||||
nowsp: xor h ; see if char matches delimiter
|
||||
ret
|
||||
|
||||
.dseg
|
||||
.extern mode
|
||||
mode: db lf_bit
|
||||
|
||||
.useg
|
||||
casefl: ds 1 ; case insensitive string match?
|
||||
.extern vars
|
||||
vars: ds 26 ; space for 'a' through 'z'
|
||||
.extern strngs
|
||||
strngs: ds 512 ; space for 35 strings
|
||||
.extern _check_
|
||||
_check_:
|
||||
ds 1 ; check space
|
||||
|
||||
|
|
@ -0,0 +1,993 @@
|
|||
; chat.z - handle send/receive chat scripts
|
||||
|
||||
.incl "c:vars"
|
||||
|
||||
.var _sends 0 ; send string
|
||||
.var _expect 40 ; expect string
|
||||
.var _explen 80 ; length of expect string
|
||||
.var _sndlen 81 ; length of send string
|
||||
.var _time 82 ; time in seconds to try
|
||||
.var _tries 83 ; number of times to try before failing
|
||||
.var _yes 84 ; new state if success
|
||||
.var _no 85 ; new state if failure
|
||||
.var _slow 86 ; should we slow down outgoing string
|
||||
.var _curtry 87 ; current try at this one
|
||||
|
||||
.useg
|
||||
.extern area
|
||||
area: ; area where parsed line lives
|
||||
sends: ds 40 ; send string
|
||||
expect: ds 40 ; expect string
|
||||
explen: ds 1 ; length of expect string
|
||||
sndlen: ds 1 ; length of send string
|
||||
time: ds 1 ; time in seconds to try
|
||||
tries: ds 1 ; number of times to try before failing
|
||||
yes: ds 1 ; new state if success
|
||||
no: ds 1 ; new state if failure
|
||||
.extern slow ; externed for hangup
|
||||
slow: ds 1 ; should we slow down outgoing string
|
||||
curtry: ds 1 ; current try at this one
|
||||
|
||||
.cseg
|
||||
|
||||
.macro table byte,addr
|
||||
dw addr
|
||||
db byte
|
||||
.endm
|
||||
|
||||
pchat:
|
||||
pop hl ; needed for chaining
|
||||
pop hl
|
||||
jr ncchat ; don't clear vars when we chain
|
||||
|
||||
.extern chat
|
||||
chat:
|
||||
call initch ; set up
|
||||
ncchat: ld a,1
|
||||
ld (opentr),a ; clear number of open tries
|
||||
ld hl,scning
|
||||
dec (hl)
|
||||
call gofil ; get and open a file
|
||||
ld hl,scning
|
||||
inc (hl)
|
||||
jr nc,dochat ; open OK, go do it
|
||||
ld hl,cmdlin
|
||||
call byp ; look at first char on command line
|
||||
or a ; no line - give up right now
|
||||
ret z
|
||||
retryo: ld hl,(chtusr)
|
||||
inc h ; turn to a fcb type drive
|
||||
ld (auxfcb),hl ; replace drive / user in fcb
|
||||
jr tryaux ; try it again
|
||||
|
||||
.extern ichat ; enter here with command tail at 80: this
|
||||
ichat: ; is used to handle files given to qterm when
|
||||
; initially invoked
|
||||
call initch
|
||||
ld hl,buffer + 1
|
||||
call scnfcb ; go parse an fcb
|
||||
call byp
|
||||
ld (ppp),hl ; save base of parameter strings
|
||||
call xferax ; stuff it in auxfcb
|
||||
tryaux: ld a,(opentr)
|
||||
neg
|
||||
ld (scning),a
|
||||
call opnaux ; and open it
|
||||
ld hl,scning
|
||||
ld (hl),0 ; reset scanning flag
|
||||
inc hl ; how many tries
|
||||
dec (hl) ; second time - must be the .LBR failing
|
||||
jr nc,dochat ; opened OK, go use it
|
||||
ret nz ; give up if open failed
|
||||
inc hl
|
||||
call scnfcb
|
||||
ld hl,fcb
|
||||
ld de,auxfcb ; set pointers to fcbs
|
||||
ld b,34 ; 34 bytes to shift
|
||||
swplp: ld a,(de)
|
||||
ld c,a
|
||||
ld a,(hl)
|
||||
ld (de),a
|
||||
ld (hl),c ; swap bytes at hl and de
|
||||
inc hl
|
||||
inc de ; move pointers
|
||||
djnz swplp ; loop till done
|
||||
jr retryo ; and retry the open
|
||||
dochat: call nz,setlbr ; if .LBR file open, then set to read it
|
||||
jp c,fnferr ; file not found - complain & exit
|
||||
ld hl,(ppp)
|
||||
ld de,0x80 ; move the parameters to 0x80
|
||||
ld b,d
|
||||
ld c,e ; also 0x80 bytes to move
|
||||
ldir ; shift them down
|
||||
call prepclv ; prepare the command line variables
|
||||
ld hl,script
|
||||
ld (ppp),hl ; save address where lines will go
|
||||
ld de,script + 1
|
||||
ld bc,4096 + 1536 - 1
|
||||
xor a
|
||||
ld (hl),a
|
||||
ldir ; clear out the script and work areas
|
||||
ld a,0x7f
|
||||
ld (b7flag),a ; flag to zap bit 7
|
||||
loop: push bc ; save line number in bc
|
||||
call getlin ; get a line
|
||||
pop bc
|
||||
jr c,cnvrt ; eof - now convert labels and parameters
|
||||
ld hl,auxlin
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr z,loop ; ditch blank lines
|
||||
inc hl
|
||||
cp '!' ; first char a '!'
|
||||
jr nz,nobang ; no - so process normally
|
||||
ld e,(hl)
|
||||
call incbyp
|
||||
ld a,e
|
||||
cp ';' ; comment??
|
||||
jr z,loop ; yes - throw it away _RIGHT_NOW_
|
||||
cp ':' ; label??
|
||||
push af
|
||||
call z,label ; yes - save it away
|
||||
pop af
|
||||
ld hl,auxlin + 1
|
||||
cp '$' ; parameter default?
|
||||
jr nz,nodolr
|
||||
ld a,0x81 ; illegal value - not normally seen
|
||||
ld (hl),a ; set so we don't change
|
||||
nodolr: cp '@'
|
||||
jr nz,nobang
|
||||
ld a,0x82 ; ditto
|
||||
ld (hl),a
|
||||
nobang: ld de,auxlin ; where the line is
|
||||
ld hl,(ppp) ; where we want it to go
|
||||
xferlp: ld a,(de)
|
||||
ld (hl),a ; move a byte
|
||||
inc hl
|
||||
inc de ; bong the pointers
|
||||
or a
|
||||
jr nz,xferlp ; loop till whole line is moved
|
||||
ld (ppp),hl
|
||||
inc c
|
||||
ld de,work - 4
|
||||
sbc hl,de ; did we overflow?
|
||||
jr c,loop ; no - back for more
|
||||
toobig: call ilprt
|
||||
db 'Script is too large (4K maximum)\r\n\0'
|
||||
ret
|
||||
|
||||
; come here when script has been read, labels noted and parameters set
|
||||
|
||||
cnvrt: xor a
|
||||
ld hl,(ppp)
|
||||
ld (hl),a ; add an empty line to terminate
|
||||
dec a
|
||||
ld (lbrcnt),a ; disable library count
|
||||
jr doscr
|
||||
|
||||
perr: call ilprt ; print an error msg
|
||||
db 'Bad line in file\r\n\0'
|
||||
call dim ; set dim mode
|
||||
ld hl,auxlin ; point hl at string
|
||||
erplp: ld a,(hl) ; get a character
|
||||
or a
|
||||
jr z,doneer ; exit if done
|
||||
push hl
|
||||
ld c,a
|
||||
call scrout ; send it
|
||||
pop hl
|
||||
inc hl
|
||||
jr erplp
|
||||
doneer: call crlf ; print a newline
|
||||
jp main ; and exit to terminal mode
|
||||
|
||||
doscr: ld a,0xff
|
||||
ld (b7flag),a ; clear bit 7 zap flag
|
||||
ld (cvtp),a
|
||||
ld a,1 ; initially state 1
|
||||
scrlp: or a
|
||||
jr nz,moresc
|
||||
push bc
|
||||
finisp: pop bc
|
||||
finis: call ilprt ; state zero means we're done
|
||||
db '\r\nDone\r\n\0'
|
||||
jp main ; straight to main to avoid a second redraw
|
||||
moresc: ld c,a ; save state in c for command recovery
|
||||
dec a
|
||||
ld b,a
|
||||
ld hl,script ; point at script
|
||||
jr z,rps ; if line 1, we're all set
|
||||
srlp: ld a,(hl)
|
||||
inc hl
|
||||
or a
|
||||
jr nz,srlp ; loop till we hit a null
|
||||
djnz srlp
|
||||
rps: ld (redptr),hl ; set up read pointer
|
||||
push bc ; save line number in c
|
||||
call getwl
|
||||
jr c,finisp ; all out of script, exit
|
||||
call parse ; chop it up
|
||||
jr c,perr ; drop on an error
|
||||
pop bc ; line number back to c
|
||||
xor a
|
||||
ld (curtry),a ; zero out current try
|
||||
retry: ld ix,area
|
||||
ld a,(sndlen)
|
||||
ld b,a
|
||||
or (ix + _explen) ; if both strings are empty
|
||||
jr z,finis ; we fell off end of script: return
|
||||
jp m,commnd ; explen == -1 => command type line: go do it
|
||||
push ix
|
||||
pop hl ; address to hl == address of send string
|
||||
ld a,b
|
||||
or a ; zero length?
|
||||
call nz,sendcs
|
||||
ld a,(ix + _explen) ; get expect length
|
||||
or a
|
||||
jr z,expok ; not expecting anything, match by default.
|
||||
call clerw2 ; clear the work buffer for incoming chars
|
||||
ld a,(mode)
|
||||
and lf_bit
|
||||
jr nz,scanex
|
||||
push ix
|
||||
call pexstr
|
||||
db '\r\nLooking for: \0'
|
||||
pop ix
|
||||
scanex: ld c,(ix + _time) ; get time to c
|
||||
second: ld de,600
|
||||
call setspd ; set the speed
|
||||
qrtrms: ld b,96 ; hang loose a while
|
||||
qmslp: djnz qmslp
|
||||
push hl
|
||||
push bc
|
||||
call procch ; ok, see what characters are waiting
|
||||
jr c,nochar ; nothing waiting - bypass all this mess
|
||||
call stufw2 ; and save in the other buffer
|
||||
ld hl,work2 + 257 + 64 + 1
|
||||
ld c,(ix + _explen)
|
||||
or a
|
||||
sbc hl,bc ; get that point in buffer
|
||||
ld de,expect ; expect string address to de
|
||||
chekxp: ld a,(de)
|
||||
cp (hl) ; did we match a byte?
|
||||
jr nz,nochar ; no - skip and try again
|
||||
ldi ; move pointers, adjust and test bc
|
||||
jp pe,chekxp ; not done: check some more
|
||||
gotit: pop bc ; got a match!
|
||||
pop de ; clean up stack first
|
||||
expok: ld a,(yes) ; get success state transition
|
||||
push af
|
||||
ld a,(explen) ; see if we actually had anything to match
|
||||
or a
|
||||
jr z,pjs ; nope, so skip all of this
|
||||
ld a,(mode)
|
||||
and mat_bit
|
||||
jr nz,pjs ; don't print if match disabled
|
||||
call pexstr
|
||||
db '\r\nMatch: \0' ; tell that we matched
|
||||
pjs: pop af ; restore success state
|
||||
jp scrlp
|
||||
nochar: pop bc
|
||||
pop hl
|
||||
dec hl ; count down second timer
|
||||
ld a,h
|
||||
or l
|
||||
jp nz,qrtrms
|
||||
dec c ; second timeout done?
|
||||
jp nz,second ; loop back if not
|
||||
ld a,(mode)
|
||||
and mat_bit
|
||||
jr nz,nopf ; don't print if match disabled
|
||||
push ix
|
||||
call ilprt
|
||||
db '\r\nFail\0' ; failed
|
||||
pop ix
|
||||
nopf: inc (ix + _curtry) ; bump try count
|
||||
ld a,(curtry)
|
||||
cp (ix + _tries) ; did we exceed allowed tries?
|
||||
jr nc,failed ; yes - complete fail - do state transition
|
||||
ld a,(mode)
|
||||
and mat_bit
|
||||
jr nz,jrt ; don't print if match disabled
|
||||
push ix
|
||||
call ilprt
|
||||
db ', retry\r\n\0'
|
||||
pop ix
|
||||
jrt: jp retry
|
||||
failed: ld a,(no) ; get fail state transition
|
||||
push af
|
||||
call crlf ; throw a new line
|
||||
jr pjs
|
||||
|
||||
.extern canscr
|
||||
canscr: call ilprt ; quit if so
|
||||
db '\r\nCancelled\r\n\0'
|
||||
jp main ; long jump to main since we don't know what
|
||||
; state the stack is in
|
||||
|
||||
commnd: ld a,c ; restore line number from c
|
||||
ld (prmpfl),a ; use non-zero value to set prompt flag
|
||||
push af ; save line number
|
||||
ld hl,cmdret
|
||||
push hl ; push a return address to get back here
|
||||
ld a,(time) ; get the command letter
|
||||
call ucsa ; force upper case
|
||||
ld hl,chttbl
|
||||
.dseg
|
||||
chttbl: table '.',break
|
||||
table 0x2c,hangup ; we'd like to say ',',hangup but ZSM barfs
|
||||
table 0x82,eval ; was @, but converted during readin to avoid
|
||||
; getwl substitute problems
|
||||
table 0x81,setstr ; was $, changed for the same reason.
|
||||
table '#',test
|
||||
table '%',stest
|
||||
table '&',mattog
|
||||
table '<',sinput
|
||||
table '>',messag
|
||||
table '~',cf
|
||||
table '[',multi
|
||||
table '(',fileio
|
||||
table 'B',baud
|
||||
table 'C',catch
|
||||
table 'E',echo
|
||||
table 'H',hdxtog
|
||||
table 'J',jctog
|
||||
table 'K',ldfnk
|
||||
table 'L',lftog
|
||||
table 'M',msbtog
|
||||
table 'N',newdsk
|
||||
table 'O',optog
|
||||
table 'P',print
|
||||
table 'Q',quit
|
||||
table 'R',recv
|
||||
table 'S',send
|
||||
table 'U',0x0276
|
||||
table 'V',vttog
|
||||
table 'W',witog
|
||||
table 'X',pchat
|
||||
table 'Y',hold
|
||||
table 'Z',cclose
|
||||
endctb:
|
||||
.cseg
|
||||
ld b,{endctb - chttbl} / 3
|
||||
tbllp: ld e,(hl)
|
||||
inc hl
|
||||
ld d,(hl) ; get next table entry to de
|
||||
inc hl
|
||||
cp (hl) ; check byte in a vs. table letter
|
||||
inc hl
|
||||
push de ; push entry point
|
||||
ret z ; if we matched this takes us to the code
|
||||
pop de ; restore stack
|
||||
djnz tbllp ; loop till we run out of table
|
||||
pop hl ; clean up stack
|
||||
cmdret: xor a
|
||||
ld (prmpfl),a ; clear prompt flag
|
||||
pop af ; get line number back
|
||||
inc a ; bump by one: commands always succeed
|
||||
jp scrlp ; loop back for more
|
||||
|
||||
.extern sendcs
|
||||
sendcs:
|
||||
inc b ; clear the zero flag, and account for an
|
||||
; extra djnz
|
||||
push bc
|
||||
push hl ; stack these for later popping
|
||||
jr sendi ; and jump to where we delay a bit
|
||||
|
||||
sendcl: push bc
|
||||
ld a,(hl) ; get next character
|
||||
inc hl ; bump
|
||||
push hl ; and save pointer
|
||||
cp 0xff ; was it a -1?
|
||||
jr nz,nosbrk ; no - check for -2
|
||||
call break ; send a break
|
||||
jr chrsnt
|
||||
nosbrk: cp 0xfe ; check for -2
|
||||
jr nz,mdmchr ; no - send char normally
|
||||
ld de,1200 ; set for a 1 second delay
|
||||
call msip ; 1000 1/1000th of a second == 1 second
|
||||
jr chrsnt ; and check for incoming chars
|
||||
mdmchr: push af
|
||||
call modop ; send the character
|
||||
pop af ; restore back to a
|
||||
chrsnt: call lstmod ; keep tabs on incoming chars
|
||||
call lstmod
|
||||
ld a,(slow)
|
||||
or a ; do we need to slow it down
|
||||
sendi: call nz,tenth ; wait a while if so
|
||||
pop hl
|
||||
pop bc
|
||||
djnz sendcl ; and keep on sending
|
||||
ret
|
||||
|
||||
parse: ld hl,area ; point de at this record
|
||||
push hl
|
||||
ld de,area + 1
|
||||
ld bc,_curtry
|
||||
ld (hl),b
|
||||
ldir ; nuke parse area
|
||||
pop de ; restore input pointer to de
|
||||
ld hl,auxlin
|
||||
ld a,(hl)
|
||||
cp '!' ; bang?
|
||||
jr nz,nopb ; nope - parse as usual
|
||||
inc hl
|
||||
ld a,(hl) ; get command letter
|
||||
inc hl
|
||||
ld bc,_explen ; move enough stuff to fill to explen
|
||||
ldir
|
||||
ex de,hl
|
||||
ld (hl),b ; null terminate just in case
|
||||
inc hl
|
||||
ld (hl),-1 ; set -1 in sndlen as a flag
|
||||
inc hl
|
||||
ld (hl),a ; and save the letter
|
||||
ret
|
||||
nopb: ld hl,slow
|
||||
ld (hl),b
|
||||
ld a,(auxlin) ; get delimiter
|
||||
cp 'z' + 1 ; greater than 'z'?
|
||||
jr c,noslow ; skip if not
|
||||
ld (hl),a ; else set slow flag
|
||||
noslow: ld hl,auxlin ; point hl at incoming line
|
||||
call scanst ; scan send string
|
||||
ret c
|
||||
ld (sndlen),a ; save length
|
||||
call scanst ; scan expect string
|
||||
ld (explen),a
|
||||
ret c ; exit if error
|
||||
xor a
|
||||
call rednum ; parse time
|
||||
ret c
|
||||
or a
|
||||
jr nz,gottim
|
||||
ld a,15 ; if no time or zero, default to 15
|
||||
gottim: ld de,time
|
||||
ld (de),a ; save the time
|
||||
inc de
|
||||
xor a
|
||||
call rednum ; scan tries
|
||||
ret c
|
||||
or a
|
||||
jr nz,gottry
|
||||
inc a ; if none or zero set to 1
|
||||
gottry: ld (de),a
|
||||
inc de
|
||||
pop bc
|
||||
ex (sp),hl
|
||||
ld a,l ; get cur line num to a
|
||||
ex (sp),hl
|
||||
push bc
|
||||
inc a ; add one to get default yes
|
||||
call rednum ; read success
|
||||
ret c
|
||||
ld (de),a
|
||||
inc de
|
||||
xor a
|
||||
call rednum ; and finally the fail value
|
||||
ret c
|
||||
ld (de),a
|
||||
inc a
|
||||
ret
|
||||
|
||||
.extern scanst
|
||||
scanst: ld b,40 ; count max of 40 chars
|
||||
ld a,(hl) ; get the delimiter to a
|
||||
ld (de),a
|
||||
or a
|
||||
ret z ; return with z to show empty line
|
||||
ld c,a ; copy to c
|
||||
inc hl ; point to next char
|
||||
|
||||
.extern scnstp
|
||||
scnstp: call parst ; chomp up the string
|
||||
ret c
|
||||
donest: ld a,40
|
||||
sub b ; get length to a
|
||||
dec b
|
||||
inc b ; test b for zero
|
||||
jr z,bzero ; if b not zero
|
||||
setde: inc de ; bump de
|
||||
djnz setde ; till b runs out
|
||||
bzero: or a ; clear the carry
|
||||
ret
|
||||
|
||||
.extern parst
|
||||
parst:
|
||||
xor a
|
||||
ld (de),a ; add a trailing null
|
||||
ld a,(hl) ; get next char
|
||||
cp c ; delimiter?
|
||||
ret z ; yes - all done on this string
|
||||
or a
|
||||
ccf
|
||||
ret z ; handle error
|
||||
inc hl
|
||||
cp '\\' ; backslash gets special treatment
|
||||
call z,backsl ; parse the backslash escape
|
||||
inc b
|
||||
dec b ; any space left?
|
||||
jr z,parst ; no - just get end of line
|
||||
dec b
|
||||
ld (de),a ; save the char away
|
||||
inc de
|
||||
jr parst
|
||||
|
||||
.extern backsl
|
||||
backsl: ld a,(hl) ; get char after backslash
|
||||
inc hl
|
||||
or a ; end of string?
|
||||
scf ; flip carry to true
|
||||
ret z ; return on zero w/ error
|
||||
cp 'k'
|
||||
jr nz,nobrk
|
||||
ld a,0xff
|
||||
ret
|
||||
nobrk: cp 'd'
|
||||
jr nz,nodel
|
||||
ld a,0xfe
|
||||
ret
|
||||
nodel: cp 'f'
|
||||
jr nz,noff
|
||||
ld a,'\f'
|
||||
ret
|
||||
noff: cp 'b'
|
||||
jr nz,nobksp
|
||||
ld a,'\b'
|
||||
ret
|
||||
nobksp: cp 't'
|
||||
jr nz,notab
|
||||
ld a,'\t'
|
||||
ret
|
||||
notab: cp 'n'
|
||||
jr nz,nonl
|
||||
ld a,'\n'
|
||||
ret
|
||||
nonl: cp 'r'
|
||||
jr nz,nocr
|
||||
ld a,'\r'
|
||||
ret
|
||||
nocr: cp 'e'
|
||||
jr nz,noesc
|
||||
ld a,'\e'
|
||||
ret
|
||||
noesc: cp 'x'
|
||||
jr nz,nohex
|
||||
push bc
|
||||
ld bc,0x0200
|
||||
gethex: ld a,(hl)
|
||||
sub '0'
|
||||
cp 10
|
||||
jr c,hexok ; valid digit - use it
|
||||
sub 'A' - '0'
|
||||
cp 6
|
||||
jr c,hexlok ; valid A-F
|
||||
sub 'a' - 'A'
|
||||
cp 6
|
||||
jr c,hexlok ; valid a-f
|
||||
ld a,b
|
||||
add a,0xfe ; check if b was still 2
|
||||
jr endoct
|
||||
hexlok: add a,10 ; letter values need 10 added
|
||||
hexok: inc hl ; bump pointer
|
||||
sla c
|
||||
sla c
|
||||
sla c
|
||||
sla c ; c *= 16
|
||||
or c ; a += c
|
||||
ld c,a
|
||||
djnz gethex
|
||||
jr endoct
|
||||
nohex: sub '0' ; check for octal digit
|
||||
cp 8
|
||||
jr c,octal ; got one - handle it
|
||||
add a,'0' ; restore character
|
||||
or a ; clear carry
|
||||
ret
|
||||
octal: push bc
|
||||
ld b,2 ; 2 more chars to get
|
||||
ld c,a ; save current value in c
|
||||
getoct: ld a,(hl) ; get another char
|
||||
sub '0'
|
||||
cp 8 ; convert and test
|
||||
jr nc,endoct ; no good - skip
|
||||
inc hl ; now we move the pointer
|
||||
sla c
|
||||
sla c
|
||||
sla c ; c *= 8
|
||||
or c ; a += c (and clear the carry)
|
||||
ld c,a ; back to c
|
||||
djnz getoct ; loop till three chars done
|
||||
endoct: ld a,c ; char back from c
|
||||
pop bc
|
||||
ret
|
||||
|
||||
rednum: ex af,af' ; save default value in a'
|
||||
ld a,(hl)
|
||||
or a ; get and test a delimiter
|
||||
jr z,usedef ; end of string - use default
|
||||
inc hl
|
||||
ld c,a ; save it away
|
||||
ld a,(hl)
|
||||
cp c ; check see if anything in field
|
||||
jr nz,isnum ; yes - go parse it
|
||||
usedef: ex af,af'
|
||||
ret
|
||||
isnum: ld b,0
|
||||
scnnum: ld a,(hl)
|
||||
or a
|
||||
jr z,usedef ; end of string: exit
|
||||
cp c
|
||||
jr z,gotnum ; found delimiter: exit
|
||||
inc hl
|
||||
sub '0'
|
||||
cp 10 ; did we find a digit?
|
||||
ccf ; flip carry: set => error
|
||||
ret c ; so return
|
||||
push af ; save converted digit
|
||||
ld a,b
|
||||
add a,a
|
||||
add a,a
|
||||
add a,b
|
||||
add a,a
|
||||
ld b,a ; b *= 10
|
||||
pop af
|
||||
add a,b
|
||||
ld b,a ; b += new digit
|
||||
jr scnnum
|
||||
gotnum: ld a,b
|
||||
ret
|
||||
|
||||
; label saves a label / line number pair in the symbol table
|
||||
|
||||
label: push hl ; save input pointer
|
||||
ld hl,work + 1016 ; look in symbol table
|
||||
ld de,8 ; step 8 at a time
|
||||
findlb: add hl,de ; move to next
|
||||
ld a,(hl)
|
||||
or a ; end of table?
|
||||
jr nz,findlb ; no - look at next one
|
||||
pop de ; input pointer back to de
|
||||
ld b,7 ; 7 bytes of label
|
||||
scanit: ld a,(de) ; get an input byte
|
||||
or a
|
||||
jr z,elbl ; null
|
||||
cp ' '
|
||||
jr z,elbl ; or space terminates it
|
||||
ld (hl),a
|
||||
inc de
|
||||
inc hl
|
||||
djnz scanit ; loop till 7 bytes moved
|
||||
jr addnum ; go add the line number
|
||||
elbl: ld (hl),0
|
||||
inc hl ; zero fill
|
||||
djnz elbl
|
||||
addnum: ld (hl),c ; save the line number
|
||||
xor a
|
||||
inc hl
|
||||
ld (hl),a ; zero fill end of symtab
|
||||
ld (work + 1528),a ; prevent overflow
|
||||
ret
|
||||
|
||||
; flabel - find a label / line number pair in the symbol table
|
||||
|
||||
flabel: ex de,hl ; label pointer to de
|
||||
ld hl,work + 1016 ; look in symbol table
|
||||
flblp: ld bc,8 ; step 8 at a time
|
||||
add hl,bc ; move to next
|
||||
ld a,(hl)
|
||||
or a ; end of table?
|
||||
jr z,exdert ; yes - undefined labels do odd things
|
||||
ld a,(de)
|
||||
cp (hl) ; check first char
|
||||
jr nz,flblp ; nope - try again
|
||||
push hl
|
||||
push de ; save pointers
|
||||
ld b,7 ; 7 bytes of label
|
||||
fscnit: ld a,(de) ; get an input byte
|
||||
or a
|
||||
jr z,nomtch ; end of input
|
||||
cp (hl)
|
||||
jr nz,nomtch ; no match, but it may be end of label
|
||||
inc de ; bump pointers
|
||||
endok: inc hl
|
||||
djnz fscnit ; all 7 bytes done: we got it
|
||||
ld a,(hl) ; get line number to a
|
||||
pop hl
|
||||
pop hl ; clean stack
|
||||
exdert: ex de,hl ; input pointer back to hl
|
||||
ret ; and home we go
|
||||
nomtch: ld a,(hl)
|
||||
or a
|
||||
jr z,endok ; aha - end of entry in symtab, fake it
|
||||
pop de
|
||||
pop hl ; no good, restore pointers
|
||||
jr flblp ; back to look at the next one
|
||||
|
||||
; fparam - find parameter from array at 0x80 whose number is in a
|
||||
|
||||
.extern fparam
|
||||
fparam: ld hl,strngs ; point at strings
|
||||
fplp: or a ; finished?
|
||||
ret z ; return if so - hl points to string
|
||||
ld e,a ; save a
|
||||
byppl: ld a,(hl) ; step over non-null characters
|
||||
inc hl
|
||||
or a
|
||||
jr nz,byppl
|
||||
ld a,e ; get string number back
|
||||
dec a ; one more done
|
||||
jr fplp
|
||||
|
||||
; kilstr - kill string parameter hl points to
|
||||
|
||||
.extern kilstr
|
||||
kilstr: ld a,(hl)
|
||||
or a
|
||||
ret z ; if it's already empty, we're done
|
||||
push hl ; save hl for later
|
||||
ld e,l
|
||||
ld d,h
|
||||
ksel: inc hl ; loop to find end of old string
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr nz,ksel
|
||||
shftlp: ld a,(hl) ; by now hl points to end, de to string
|
||||
ldi ; move another byte
|
||||
inc a ; test for end of data
|
||||
jr nz,shftlp ; loop till all done
|
||||
ex de,hl
|
||||
xfill: ld (hl),0xff ; replace all the 0xffs
|
||||
inc hl
|
||||
ld a,(hl)
|
||||
cp 'A' ; we've got an 'A' at the end as a stopper
|
||||
jr nz,xfill
|
||||
pop hl ; restore pointer to string
|
||||
ret ; all done
|
||||
|
||||
; setstr - set a string variable
|
||||
|
||||
setstr: call areabu ; point hl at command tail
|
||||
call pnum
|
||||
ret nc
|
||||
inc hl ; skip over letter
|
||||
push hl ; and save address of source
|
||||
push af ; save parm number
|
||||
call fparam ; get ...
|
||||
pop af
|
||||
cp 9
|
||||
jr nc,repl ; 9 or above is letter string - force replace
|
||||
ld a,(hl)
|
||||
or a ; anything there yet?
|
||||
jr nz,pbcret ; yes - do nothing
|
||||
repl: call kilstr ; and kill current string
|
||||
ex (sp),hl ; save target, restore source
|
||||
call byp ; strip white space
|
||||
ex de,hl ; source to de
|
||||
pop hl ; dest back to hl
|
||||
xor a ; want this null terminated
|
||||
; and fall into insstr to put it in place
|
||||
|
||||
; insstr - shift string addressed by de to string var at hl, use char in
|
||||
; a (or null) to terminate string at de
|
||||
|
||||
.extern insstr
|
||||
insstr: push bc ; save bc
|
||||
ld b,a ; term char to b
|
||||
ld c,0 ; count in c
|
||||
push de ; save source in de
|
||||
fslen: ld a,(de)
|
||||
or a ; null
|
||||
jr z,estr1 ; ends the string
|
||||
cp b ; term char?
|
||||
jr z,estr ; yup end of string as well
|
||||
inc c ; count
|
||||
inc de ; and move pointer
|
||||
jr fslen
|
||||
estr: xor a
|
||||
estr1: ld b,a ; set len to word in bc
|
||||
cp c
|
||||
jr z,pop2r
|
||||
push hl ; save target in hl
|
||||
push bc ; and length as well
|
||||
inc bc
|
||||
ld hl,strngs + 511 ; start from very top of string space
|
||||
cpdr ; look for 0 on end of last string
|
||||
pop bc
|
||||
jr nz,isok ; nz means we didn't find it which is OK
|
||||
pop hl ; get hl back
|
||||
pop2r: pop bc
|
||||
pop bc ; clean up stack, de points to end already
|
||||
ret ; exit right now
|
||||
isok: pop de ; target back to de
|
||||
inc hl
|
||||
push hl ; source of lddr on stack
|
||||
sbc hl,de ; hl contains count to move up
|
||||
push bc ; length back on stack
|
||||
ld b,h
|
||||
ld c,l ; count to move to bc
|
||||
pop hl ; length back to hl
|
||||
ex (sp),hl ; resave length, get lower move point
|
||||
push de ; target back on stack
|
||||
ld de,strngs + 511
|
||||
inc bc ; why in the name of H*LL we have to inc this
|
||||
inc bc ; twice, I don't know. However, it works.
|
||||
lddr ; shift it all up to make the hole
|
||||
pop de ; target back
|
||||
pop bc ; length of string back
|
||||
pop hl ; source
|
||||
push de ; save target
|
||||
ldir ; move string into place
|
||||
ex de,hl ; updated source pointer back to de
|
||||
pop hl ; original hl back
|
||||
pbcret: pop bc ; restore bc
|
||||
ret
|
||||
|
||||
pnum:; call ucsa
|
||||
sub '1'
|
||||
cp 9 ; is it valid
|
||||
ret c ; default param
|
||||
sub 'A' - '1'
|
||||
cp 26 ; valid letter?
|
||||
ret nc ; return if not
|
||||
add a,9 ; convert above parameters
|
||||
scf ; set carry to show it's OK
|
||||
ret
|
||||
|
||||
; prepclv - convert command line args to $1 through $9
|
||||
|
||||
prepclv:
|
||||
ld de,0x80 ; point at command line params
|
||||
ld b,0 ; set counter to zero
|
||||
pcvlp: push de
|
||||
ld a,b
|
||||
call fparam ; address this parameter
|
||||
call kilstr ; get rid of the old
|
||||
pop de
|
||||
ex de,hl
|
||||
call byp ; find text
|
||||
ex de,hl
|
||||
ld a,' '
|
||||
call insstr ; drop the string in place
|
||||
inc b
|
||||
ld a,b
|
||||
cp 9 ; loop till nine are done
|
||||
jr nz,pcvlp
|
||||
ret
|
||||
|
||||
; get a line from wherever we're reading, stuff it in auxlin
|
||||
|
||||
getwl: ld hl,(redptr) ; pick up read pointer
|
||||
ld a,(hl)
|
||||
or a ; first byte zero?
|
||||
scf
|
||||
ret z ; return carry to show end of input
|
||||
ld de,auxlin ; auxlin is where we'll put it
|
||||
gwlp: ld a,(hl) ; get a byte
|
||||
cp '$'
|
||||
jr z,gwstr ; substitute strings,
|
||||
cp '@'
|
||||
jr z,gwnum ; numbers
|
||||
cp '`'
|
||||
jr z,gwlbl ; and labels
|
||||
nullt: ld a,(hl)
|
||||
ldi ; otherwise just transfer
|
||||
or a ; and test the byte
|
||||
jr nz,gwlp ; loop if more
|
||||
ld (redptr),hl ; save updated read pointer
|
||||
ret
|
||||
|
||||
gwstr: inc hl ; point at letter code for string wanted
|
||||
call ucsahl
|
||||
; ld a,(hl) ; get it
|
||||
call pnum ; see if it's a valid string number
|
||||
jr nc,nullt ; if not just copy the character as is
|
||||
inc hl
|
||||
push hl ; save string we're reading from
|
||||
push de
|
||||
call fparam ; get the string
|
||||
pop de
|
||||
scp: ld a,(hl)
|
||||
or a
|
||||
jr z,phlgwl
|
||||
ldi
|
||||
jr scp
|
||||
phlgwl: pop hl
|
||||
jr gwlp
|
||||
|
||||
gwnum: inc hl ; point at variable letter
|
||||
call ucsahl ; convert to upper case
|
||||
sub 'A' ; make it into an index
|
||||
cp 26 ; in range?
|
||||
jr nc,nullt ; nope - convert as a straight letter
|
||||
inc hl ; skip over the variable number
|
||||
push hl ; save source
|
||||
push de ; and target
|
||||
ld e,a
|
||||
ld d,0
|
||||
ld hl,vars
|
||||
add hl,de
|
||||
ld a,(hl) ; fetch the value
|
||||
pop hl ; restore target to hl
|
||||
jr dumpa
|
||||
|
||||
gwlbl: inc hl
|
||||
push de ; save target
|
||||
call flabel ; find the label
|
||||
inc a
|
||||
ex (sp),hl ; restore target, save source
|
||||
|
||||
dumpa: ld (hl),'0' - 1 ; put in hundreds digit
|
||||
ld e,0
|
||||
hundlp: inc (hl)
|
||||
sub 100
|
||||
jr nc,hundlp
|
||||
add a,100
|
||||
call cinc
|
||||
ld (hl),'0' - 1
|
||||
tenlp: inc (hl)
|
||||
sub 10
|
||||
jr nc,tenlp
|
||||
call cinc
|
||||
add a,'0' + 10
|
||||
ld (hl),a
|
||||
inc hl
|
||||
ex de,hl ; target back to de
|
||||
pop hl ; source to hl
|
||||
jr gwlp ; and we're done
|
||||
|
||||
; cinc - inc hl only if (hl) != 0: used to format numbers
|
||||
|
||||
cinc: dec e
|
||||
inc e ; test e
|
||||
jr nz,docinc ; already set, force a save
|
||||
ld c,a ; save a
|
||||
ld a,(hl)
|
||||
cp '0' ; pointing at a zero?
|
||||
ld a,c ; restore a
|
||||
ret z ; return if so,
|
||||
docinc: inc hl ; otherwise bump hl
|
||||
inc e ; and set e
|
||||
ret
|
||||
|
||||
; print expect string, but ignore control characters
|
||||
|
||||
pexstr: call dim ; dim mode
|
||||
pop hl
|
||||
call prtslp ; print inline string
|
||||
push hl ; resave return address
|
||||
ld hl,expect
|
||||
ld bc,(explen - 1) ; get explen to b
|
||||
prtncc: ld a,(hl) ; get a character
|
||||
cp ' '
|
||||
jr c,nopcc ; less than space, don't print
|
||||
cp 0x7f ; check >= delete
|
||||
push bc
|
||||
push hl
|
||||
ld c,a ; char to c for printout
|
||||
call c,scrout ; out it goes if legal
|
||||
pop hl
|
||||
pop bc
|
||||
nopcc: inc hl ; move pointer
|
||||
djnz prtncc ; loop till all done
|
||||
jp crlf
|
||||
|
||||
.dseg
|
||||
.extern scning
|
||||
scning: db 0
|
||||
.extern opentr
|
||||
opentr: db 0 ; should be useg, but need to bump hl for lbrs
|
||||
.extern lbrs
|
||||
lbrs: db '/QTERM.LBR\0' ; name of qterm script library
|
||||
|
||||
.useg
|
||||
redptr: ds 2
|
||||
.extern ppp
|
||||
ppp: ds 2 ; parameter pointer
|
||||
.extern chtusr
|
||||
chtusr: ds 1 ; extra drive / user to try for chat scripts
|
||||
.extern chtdrv
|
||||
chtdrv: ds 1
|
||||
cvtp: ds 1 ; do we convert params and numbers in getwl
|
||||
|
||||
|
|
@ -0,0 +1,144 @@
|
|||
; dir.z - print directories for qterm
|
||||
|
||||
.incl "c:vars"
|
||||
|
||||
.extern dir
|
||||
dir:
|
||||
call gauxfc ; get a fcb into auxfcb
|
||||
ld hl,auxfcb + 2
|
||||
ld a,(hl) ; get first actual character of filename
|
||||
cp ' '
|
||||
jr nz,isfil ; not a space - there was something
|
||||
ld de,auxfcb + 3
|
||||
ld bc,10
|
||||
ld (hl),'?' ; else fill with '?'s to do *.*
|
||||
ldir
|
||||
isfil: ld c,26
|
||||
ld de,auxlin
|
||||
call bdos
|
||||
call dim ; set dim mode
|
||||
call clrpsp ; set up to page output
|
||||
ld c,17
|
||||
xor a
|
||||
ld (nlp),a
|
||||
push af
|
||||
dslp: ld de,auxfcb
|
||||
call usrbds
|
||||
inc a
|
||||
jr z,dirxit
|
||||
push af
|
||||
ld a,(auxfcb + 1) ; get the drive code
|
||||
add a,'@' ; convert to a letter
|
||||
call tabexp ; and print it
|
||||
ld hl,(auxfcb) ; get the user number
|
||||
call decob ; print it too
|
||||
ld a,':'
|
||||
call tabexp ; and a colon
|
||||
pop af
|
||||
rrca
|
||||
rrca
|
||||
rrca
|
||||
ld hl,auxlin - 31
|
||||
ld e,a
|
||||
ld d,0
|
||||
add hl,de
|
||||
ld b,8 ; 8 chars filename
|
||||
call pdir ; print filename
|
||||
ld a,'.'
|
||||
push hl ; save fcb address
|
||||
call tabexp ; print a period
|
||||
pop hl
|
||||
ld b,3
|
||||
call pdir ; and print the extension
|
||||
dec hl
|
||||
dec hl
|
||||
ld a,(hl) ; let's see about R/O files
|
||||
add a,a
|
||||
dec hl
|
||||
ld a,(hl)
|
||||
adc a,a
|
||||
adc a,a ; get r/o and sys bits to bottom
|
||||
ld hl,rostr ; look at characters we have
|
||||
.dseg
|
||||
rostr: db ' -+*'
|
||||
.cseg
|
||||
and 3 ; get just the bits we want
|
||||
ld e,a
|
||||
ld d,0
|
||||
add hl,de ; index into characters
|
||||
ld a,(hl) ; get one
|
||||
call tabexp ; and print it
|
||||
pop af
|
||||
inc a
|
||||
push af
|
||||
and 3
|
||||
ld hl,sstr
|
||||
.dseg
|
||||
sstr: db ' \0' ; 3 spaces to separate
|
||||
.cseg
|
||||
jr nz,sepspc
|
||||
ld hl,crlfm
|
||||
sepspc: call prtsl1
|
||||
; for ^X to can a directory, add a 'jr c,dirxit' here
|
||||
ds18: ld c,18
|
||||
jr dslp
|
||||
|
||||
dirxit: pop af ; restore file count
|
||||
or a
|
||||
jr z,nfm
|
||||
and 3
|
||||
call nz,crlf ; print newline if needed
|
||||
jp bright ; otherwise restore bright mode
|
||||
nfm: call ilprt
|
||||
db 'No files'
|
||||
crlfm: db '\r\n\0' ; complain if no files
|
||||
ret
|
||||
|
||||
; pdir - print chars from hl, count in b
|
||||
|
||||
pdir: ld a,(hl) ; get next char
|
||||
inc hl
|
||||
and 0x7f ; get rid of top bit
|
||||
push hl ; save regs
|
||||
push bc
|
||||
call tabexp ; print it
|
||||
pop bc
|
||||
pop hl
|
||||
djnz pdir ; loop till all done
|
||||
ret
|
||||
|
||||
; nxtnam - get next name from work to fcb, return z if no files left
|
||||
|
||||
.extern nxtnam
|
||||
nxtnam:
|
||||
ld hl,(fnbspt) ; get last address saved to
|
||||
ld de,(fnbrpt) ; current read address
|
||||
or a
|
||||
sbc hl,de ; test them
|
||||
ret z ; return z if equal
|
||||
ex de,hl ; read address to hl
|
||||
ld de,fcb ; fcb address to de
|
||||
ld bc,16 ; 16 chars to go
|
||||
ldir ; move them
|
||||
ld (fnbrpt),hl ; and save read pointer
|
||||
ld a,(fcb) ; get lead byte
|
||||
cp 0xe5 ; check for erasure
|
||||
jr z,nxtnam ; loop back if gone
|
||||
ld a,b
|
||||
ld (fcb + 13),a
|
||||
ld (fcb + 33),a ; zero out extent and block numbers
|
||||
ret ; ret with no z flag
|
||||
|
||||
; data area
|
||||
|
||||
.useg
|
||||
.extern newusr
|
||||
newusr: ds 1 ; new user for dir command
|
||||
.extern newdrv
|
||||
newdrv: ds 1 ; new drive for dir command
|
||||
nlp: ds 1 ; number of lines on current page
|
||||
.extern fnbspt
|
||||
fnbspt: ds 2 ; fnbuff save pointer
|
||||
.extern fnbrpt
|
||||
fnbrpt: ds 2 ; fnbuff read pointer
|
||||
|
||||
|
|
@ -0,0 +1,434 @@
|
|||
; file.z - file handling odds and ends
|
||||
|
||||
.incl "c:vars"
|
||||
|
||||
.extern gofil ; get a filename, and open into auxfcb
|
||||
gofil:
|
||||
call gauxfc ; get a filename, parse in aux fcb
|
||||
ret c ; esc - exit now
|
||||
jr z,nowc ; no wildcards
|
||||
|
||||
.extern opnaux
|
||||
opnaux:
|
||||
xor a
|
||||
call clrw2 ; set pointers for read
|
||||
ld de,auxfcb
|
||||
ld c,open ; open the file
|
||||
call usrbds
|
||||
add a,1
|
||||
ret nc ; return now if open ok
|
||||
ld a,(scning)
|
||||
add a,a
|
||||
ret c
|
||||
|
||||
.extern fnferr
|
||||
fnferr: call ilprt ; beef and complain about file not found
|
||||
db 'File not found\r\n\0'
|
||||
scf
|
||||
ret
|
||||
|
||||
.extern nowc
|
||||
nowc:
|
||||
.extern nowcp
|
||||
nowcp:
|
||||
call ilprt
|
||||
db 'Can\'t handle wildcards\r\n\0'
|
||||
scf
|
||||
ret
|
||||
|
||||
.extern gauxfc
|
||||
gauxfc:
|
||||
call getfcb ; get a filename to fcb at 0x5b
|
||||
push af ; save return status in carry
|
||||
call byp
|
||||
ld (ppp),hl ; save pointer for chat
|
||||
pop af ; restore carry
|
||||
|
||||
.extern xferax
|
||||
xferax: ; transfer fcb at fbc to auxfcb
|
||||
ld bc,34 ; load the registers
|
||||
|
||||
.extern xferaz
|
||||
xferaz:
|
||||
ld hl,fcb
|
||||
ld de,auxfcb
|
||||
ldir ; and copy to auxfcb
|
||||
ret
|
||||
|
||||
.extern getfcb
|
||||
getfcb:
|
||||
call prompt
|
||||
db 'Filename? \0' ; prompt and input
|
||||
ld a,(ipbuf)
|
||||
cp '\e' ; carry?
|
||||
scf
|
||||
ret z ; return now with carry if so
|
||||
ld hl,ipbuf
|
||||
|
||||
.extern scnfcb ; parse a fcb at hl to 0x5b
|
||||
scnfcb:
|
||||
call byp ; step over any spaces
|
||||
push hl
|
||||
ld hl,fcb
|
||||
ld de,fcb + 1
|
||||
ld bc,33
|
||||
ld (hl),b
|
||||
ldir ; fill fcb with zeros
|
||||
ld bc,(curusr)
|
||||
inc b ; bump logged drive for fcb
|
||||
ld (fcb),bc ; drop in user and drive now
|
||||
pop hl ; get input pointer to hl
|
||||
push hl ; but save it again
|
||||
call ucsahl ; get (possible) drive spec to a
|
||||
cp 'A'
|
||||
jr c,trynum
|
||||
cp 'P' + 1 ; valid drive letter?
|
||||
jr nc,respar
|
||||
sub '@'
|
||||
ld b,a ; save the drive in b
|
||||
inc hl
|
||||
ld a,(hl) ; get the next letter
|
||||
cp ':' ; is it a ':'?
|
||||
jr z,usebc ; yes, only drive was given: use what we have
|
||||
trynum: sub '0'
|
||||
cp 10 ; do we have a valid digit?
|
||||
jr nc,respar ; no - reset and ignore whole mess
|
||||
scnusr: ld c,a ; save in c
|
||||
inc hl
|
||||
ld a,(hl) ; get the next letter
|
||||
cp ':' ; is it a ':'?
|
||||
jr z,usebc ; yes - we got a user: go process it all
|
||||
sub '0'
|
||||
cp 10
|
||||
jr nc,respar ; oops - not a number: reset and ignore
|
||||
ld e,a ; current digit to e
|
||||
ld a,c
|
||||
add a,a
|
||||
add a,a
|
||||
add a,c
|
||||
add a,a ; a = c * 10
|
||||
add a,e ; + e
|
||||
and 0x1f ; and 0x1f gives updated user number
|
||||
jr scnusr ; loop back for another go
|
||||
usebc: inc hl ; point at char after ':'
|
||||
ex (sp),hl ; save on stack
|
||||
ld (fcb),bc ; save new drive / user codes away
|
||||
respar: pop hl ; hl points at filename
|
||||
ld de,fcb + 2 ; point de at name area
|
||||
ld b,8
|
||||
call scanfn ; parse the filenane
|
||||
ld a,(hl)
|
||||
cp '.' ; '.' => extension
|
||||
jr nz,nodot
|
||||
inc hl ; step over it
|
||||
nodot: ld b,3
|
||||
call scanfn ; parse it
|
||||
push hl ; save pointer to text
|
||||
ld hl,fcb + 2
|
||||
ld a,'?' ; check for '?'s in the fcb (wildcards)
|
||||
ld bc,11
|
||||
cpir
|
||||
pop hl ; restore text pointer
|
||||
ret ; with z flag set for a match
|
||||
|
||||
scanfn: call ucsahl ; get a char
|
||||
or a ; exit on a zero byte
|
||||
jr z,gotnam
|
||||
cp '.' ; or a '.'
|
||||
jr z,gotnam
|
||||
cp ' ' ; or a ' '
|
||||
jr z,gotnam
|
||||
inc hl ; move input pointer
|
||||
dec b
|
||||
inc b ; test b
|
||||
jr z,scanfn ; loop back if zero
|
||||
ld (de),a ; save char in fcb
|
||||
cp '*' ; '*'?
|
||||
jr z,gotstr ; handle elsewhere if so
|
||||
inc de ; move output pointer
|
||||
dec b ; one less char to go
|
||||
jr scanfn
|
||||
gotnam: dec b ; decrease b till all done
|
||||
ret m
|
||||
ld a,' ' ; get a space
|
||||
ld (de),a ; put it in fcb
|
||||
inc de ; and move pointer
|
||||
jr gotnam
|
||||
gotstr: ld a,'?' ; put in a '?'
|
||||
ld (de),a
|
||||
inc de ; move pointer
|
||||
djnz gotstr ; loop till all full of '?'s
|
||||
jr scanfn ; continue parse
|
||||
|
||||
.extern areabu
|
||||
areabu: call areabp ; do an areabp, and ucsa the char
|
||||
|
||||
.extern ucsahl
|
||||
ucsahl: ld a,(hl) ; get char at hl
|
||||
|
||||
.extern ucsa
|
||||
ucsa: cp 'a'
|
||||
ret c ; return if it's below 'a'
|
||||
cp 'z' + 1
|
||||
ret nc ; or if it's above 'z'
|
||||
and 0x5f ; force lower case
|
||||
ret
|
||||
|
||||
; scnwld - enter with hl pointing at a filename, and add the list of
|
||||
; matching filenames to the list at fnbrpt / fnbspt
|
||||
|
||||
.extern scnwld
|
||||
scnwld:
|
||||
call byp ; strip leading space
|
||||
push hl ; save hl
|
||||
call scnfcb ; get a filename
|
||||
call xferax ; transfer to auxfcb
|
||||
ld hl,(auxfcb)
|
||||
ld (newusr),hl ; keep a copy of the drive and user
|
||||
ld de,auxlin
|
||||
ld c,setdma
|
||||
call bdos ; set dma to auxlin (seems like a safe place)
|
||||
ld c,srchf ; do a search first first time
|
||||
scnlp: ld de,auxfcb
|
||||
call usrbds ; any more names?
|
||||
inc a
|
||||
jr z,scannd ; exit if not
|
||||
rrca
|
||||
rrca
|
||||
rrca ; a *= 32
|
||||
ld de,(fnbspt)
|
||||
ld hl,work + 1024 ; out of room?
|
||||
or a
|
||||
sbc hl,de
|
||||
jr z,nosav ; skip if so - that's 64 filenames anyway!
|
||||
ld hl,(newusr) ; get drive and user
|
||||
ex de,hl
|
||||
ld (hl),e
|
||||
inc hl
|
||||
ld (hl),d ; and install them
|
||||
inc hl
|
||||
ex de,hl ; save save pointer in de
|
||||
ld l,a
|
||||
ld h,0
|
||||
ld bc,auxlin - 31 ; -32 because of the inc a above
|
||||
add hl,bc ; hl now points at name portion
|
||||
ld bc,14 ; 11 chars to transfer, + 3 for spacing
|
||||
ldir ; move them characters
|
||||
ld (fnbspt),de ; put save pointer back away
|
||||
nosav: ld c,srchn ; go look for next name
|
||||
jr scnlp
|
||||
scannd: pop hl ; restore string pointer
|
||||
; and step over filename to next one
|
||||
|
||||
.extern unbyp ; move a string pointer in hl to the end of
|
||||
unbyp: ; the current word
|
||||
ld a,(hl)
|
||||
cp ' '
|
||||
ret z ; stop when we hit a space
|
||||
or a
|
||||
ret z ; or a zero
|
||||
inc hl
|
||||
jr unbyp
|
||||
|
||||
.extern getlin ; read a line of data from file
|
||||
getlin:
|
||||
ld de,auxlin ; we'll save data in auxlin
|
||||
gallp: xor a
|
||||
ld (de),a ; set zero for end of line
|
||||
push de
|
||||
call getw2c ; get a character
|
||||
pop de
|
||||
ret c ; return carry on physical end of file
|
||||
cp 0x1a
|
||||
scf
|
||||
ret z ; or logical end of file
|
||||
cp 0x0d
|
||||
jr z,glstrp ; end of line - stip trailing blanks
|
||||
cp 0x7f
|
||||
jr z,gallp ; ignore deletes
|
||||
cp ' '
|
||||
jr c,gallp ; and other control characters
|
||||
ld (de),a ; save it
|
||||
ld hl,auxlin + 127
|
||||
or a
|
||||
sbc hl,de ; check line length
|
||||
jr z,gallp
|
||||
inc de ; and bump pointer if not at end of line
|
||||
jr gallp
|
||||
glstrp: ld hl,auxlin
|
||||
or a
|
||||
sbc hl,de ; did we hit the start of the line?
|
||||
ret z ; return if so
|
||||
dec de
|
||||
ld a,(de) ; look at previous character
|
||||
xor ' ' ; is it a space?
|
||||
ret nz ; no - leave it and return
|
||||
ld (de),a ; else turn it into a zero
|
||||
jr glstrp
|
||||
|
||||
.extern print ; print a local file to the remote
|
||||
print:
|
||||
call gofil ; get and open file
|
||||
ret c ; exit now on an error
|
||||
ld a,0x7f
|
||||
ld (b7flag),a ; set flag to strip bit 7
|
||||
ld a,2
|
||||
ld (cscqfl),a ; enable ctrl ^S ^Q spotting
|
||||
plp: call lstmod ; check incoming chars
|
||||
call kbdcc ; check the keyboard
|
||||
cp 'x' & 0x1f ; quit on a typed ^X
|
||||
jr z,prsent
|
||||
ld a,(cscqfl) ; ^S seen?
|
||||
rrca
|
||||
jr c,plp ; yes, so loop for a while
|
||||
call getw2c ; get next char to send
|
||||
jr c,prsent ; exit on physical end of file
|
||||
and 0x7f
|
||||
cp 0x1a
|
||||
jr z,prsent ; or logical end of file
|
||||
cp '\n'
|
||||
jr nz,nonlin ; not a linefeed
|
||||
ld a,(lflg)
|
||||
or a ; are we sending these?
|
||||
plpz: jr z,plp ; it gets thrown if disabled
|
||||
ld a,'\n'
|
||||
nonlin:
|
||||
cp ' '
|
||||
jr c,sendit ; if it's a control char, no echo check
|
||||
ld hl,ecflg
|
||||
inc (hl)
|
||||
dec (hl) ; echo check enabled?
|
||||
jr z,sendit ; nope - send as is
|
||||
inc hl
|
||||
ld (hl),a ; save echo check value
|
||||
sendit: push af ; save the char
|
||||
call modop ; send it
|
||||
ld a,(chd) ; get the character delay
|
||||
ld e,a
|
||||
ld d,0 ; to de
|
||||
pop af
|
||||
cp '\r' ; did we just send a return?
|
||||
jr nz,pwait ; nope - handle char delay / echo check
|
||||
ld de,(nld) ; get new line delay
|
||||
ld a,(lfecho) ; linefeed echo enabled?
|
||||
ld (ecval),a ; save it if so
|
||||
ld (lfwflg),a ; set linefeed wait flag if needed
|
||||
pwait: call setspd ; make a clock dependant value in hl
|
||||
add hl,hl ; and double it
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,pwlp
|
||||
inc l ; minimum 1
|
||||
pwlp: push hl
|
||||
call lstmod ; keep an eye on returning chars
|
||||
pop hl
|
||||
ld a,(ecval) ; echo check in progress?
|
||||
dec a
|
||||
jr z,ecok ; we got the needed char - break
|
||||
dec hl
|
||||
ld a,h
|
||||
or l ; count hl down
|
||||
jr nz,pwlp
|
||||
ecok: ld (ecval),a ; set echo check value to zero
|
||||
ld hl,lfwflg ; look at linefeed wait flag
|
||||
ld a,(hl)
|
||||
ld de,100 ; 100 ms delay in de (prototype)
|
||||
ld (hl),d ; turn linefeed wait flag off
|
||||
or a ; test original value
|
||||
jr z,plpz ; back to send next character if not there
|
||||
jr pwait ; back to wait again for the extra 1/10th sec.
|
||||
|
||||
prsent: call ilprt
|
||||
db '\r\nSent\r\n\0'
|
||||
jr cb7
|
||||
|
||||
.extern type ; type a file locally
|
||||
type:
|
||||
call gofil ; get and open the file
|
||||
ret c ; quit now on an error
|
||||
ld a,0x7f
|
||||
ld (b7flag),a ; set flag to strip bit 7
|
||||
call dim ; dim mode
|
||||
call clrpsp
|
||||
tlp: call getw2c ; get a character
|
||||
jr c,teof ; exit on eof
|
||||
cp 0x1a
|
||||
jr z,teof ; and on CP/M eof char
|
||||
call limitc
|
||||
jr c,tlp
|
||||
ld (lco),a ; save in last char
|
||||
call tabexp ; type it
|
||||
jr nc,tlp ; loop unless ^X cancelled
|
||||
teof: ld a,(lco)
|
||||
cp '\n'
|
||||
call nz,crlf ; output a newline if needed
|
||||
call bright ; back to bright
|
||||
cb7: xor a
|
||||
ld (cscqfl),a ; clear ^S ^Q flag
|
||||
dec a ; effectively ld a,0xff
|
||||
ld (b7flag),a ; clear bit 7 zap mask
|
||||
ret
|
||||
|
||||
.extern newdsk
|
||||
newdsk:
|
||||
call prompt
|
||||
db 'Drive? \0' ; prompt and input
|
||||
ld hl,ipbuf ; parse a full fcb, although we only want
|
||||
call scnfcb ; drive and user
|
||||
ld hl,(fcb) ; get new values
|
||||
dec h ; set drive correct
|
||||
ld (curusr),hl ; and save them
|
||||
|
||||
.extern reset ; reset: simply reset CP/M to remove R/O
|
||||
reset: ; status on changed disks
|
||||
ld a,(cflg)
|
||||
or a ; catch file open?
|
||||
ld c,rescpm
|
||||
jr z,zbdos ; nope, full reset
|
||||
ld a,(cfcb + 1) ; get catch file drive
|
||||
ld hl,fcb + 1
|
||||
cp (hl) ; same as reset drive?
|
||||
ret z ; yes, exit now
|
||||
dec a
|
||||
ld e,a
|
||||
ld c,seldrv ; select chat file drive
|
||||
call bdos
|
||||
ld a,(fcb + 1) ; get reset drive
|
||||
ld hl,1 ; set hl to 1
|
||||
ld c,logdrv
|
||||
shlp: dec a ; count down
|
||||
zbdos: jp z,bdos ; jump to bdos when done
|
||||
add hl,hl
|
||||
jr shlp
|
||||
|
||||
.dseg
|
||||
.extern b7flag
|
||||
b7flag: db 0xff
|
||||
.extern cscqfl
|
||||
cscqfl: db 0
|
||||
|
||||
.extern lfecho
|
||||
lfecho: db 0
|
||||
.extern ecflg
|
||||
ecflg: db 0
|
||||
.extern ecval
|
||||
ecval: db 0
|
||||
lfwflg: db 0
|
||||
|
||||
.useg
|
||||
lco: ds 1
|
||||
.extern curusr
|
||||
curusr: ds 1
|
||||
.extern curdrv
|
||||
curdrv: ds 1
|
||||
.extern auxfcb
|
||||
auxfcb: ds 37
|
||||
.extern auxlin
|
||||
auxlin: ds 128
|
||||
.extern script
|
||||
script: ds 1024
|
||||
.extern scrwrk
|
||||
scrwrk: ds 3072
|
||||
.extern work
|
||||
work: ds 1536
|
||||
|
||||
|
|
@ -0,0 +1,133 @@
|
|||
; flags.z - code to handle trivial flag toggles
|
||||
|
||||
.incl "c:termcap"
|
||||
|
||||
.var ipbuf 0x80
|
||||
|
||||
.extern msbtog
|
||||
msbtog: call force ; go see what we're doing to the flag
|
||||
ld hl,bmask ; address where mask lives
|
||||
jr z,domsbt ; zero => straight toggle
|
||||
sub '0' ; was it a '0'?
|
||||
res 7,(hl)
|
||||
jr z,domsbt ; bit 7 off (so it gets turned on) if so
|
||||
set 7,(hl) ; else bit 7 on, so it gets turned off
|
||||
domsbt: ld a,(hl)
|
||||
xor 0x80 ; toggle the bit
|
||||
ld (hl),a
|
||||
inc a ; now 0xff => no mask becomes zero
|
||||
ld de,bit7ms ; point de at the "label"
|
||||
.dseg
|
||||
bit7ms: db 'Bit 7 masking\0'
|
||||
.cseg
|
||||
jr pdisen ; and print whether we turned it on or off
|
||||
|
||||
.extern echo
|
||||
echo: ld hl,eflg ; point at echo flag
|
||||
ld de,ecomsg ; and message
|
||||
.dseg
|
||||
ecomsg: db 'Remote echo\0'
|
||||
.cseg
|
||||
jr toggle ; go do the toggle
|
||||
|
||||
.extern hdxtog
|
||||
hdxtog: ld hl,hflg ; same as echo
|
||||
ld de,hdxmsg
|
||||
.dseg
|
||||
hdxmsg: db 'Half duplex\0'
|
||||
.cseg
|
||||
jr toggle
|
||||
|
||||
.extern jctog
|
||||
jctog: ld hl,jflg ; same as echo
|
||||
ld de,jcmsg
|
||||
.dseg
|
||||
jcmsg: db 'Control character discard\0'
|
||||
.cseg
|
||||
jr toggle
|
||||
|
||||
.extern lftog
|
||||
lftog: ld hl,lflg ; same as echo
|
||||
ld de,lfmsg
|
||||
.dseg
|
||||
lfmsg: db 'Line feed in print\0'
|
||||
.cseg
|
||||
jr toggle
|
||||
|
||||
.extern optog
|
||||
optog: ld hl,oflg ; same as echo
|
||||
ld de,opmsg
|
||||
.dseg
|
||||
opmsg: db 'Output to printer\0'
|
||||
.cseg
|
||||
jr toggle
|
||||
|
||||
.extern vttog
|
||||
vttog: call initv
|
||||
ld hl,vflg
|
||||
ld de,vtmsg
|
||||
.dseg
|
||||
vtmsg: db 'VT-100 emulation\0'
|
||||
.cseg
|
||||
toggle: call togflg ; flip the flag as needed
|
||||
pdisen: push af ; save flag state
|
||||
push de ; and message
|
||||
call crlf ; throw a new line
|
||||
call dim ; go into dim mode
|
||||
pop hl
|
||||
call prtslp ; print the message
|
||||
pop af ; restore the flag state
|
||||
jr z,pdis ; zero - it got disabled
|
||||
call ilprt
|
||||
db ' enabled\0' ; print the enabled message
|
||||
jr finis
|
||||
pdis: call ilprt
|
||||
db ' disabled\0' ; or disabled
|
||||
finis: jp crlf
|
||||
|
||||
.extern togflg
|
||||
togflg: push hl
|
||||
push de ; save some registers
|
||||
call force ; get input state depending on if we're in
|
||||
pop de ; a chat script
|
||||
pop hl
|
||||
jr z,doftog ; zero => straight toggle
|
||||
sub '0' ; '0' => turn it off
|
||||
set 0,(hl) ; turn the bit on so the xor turns it off
|
||||
jr z,doftog
|
||||
res 0,(hl) ; else clear bit - xor will set it
|
||||
doftog: ld a,(hl)
|
||||
xor 1 ; flip the bit
|
||||
ld (hl),a
|
||||
ret
|
||||
|
||||
force: ld a,(prmpfl)
|
||||
or a
|
||||
ret z ; return zero if we're not in a chat script
|
||||
call areabp ; get the character
|
||||
or a ; see if one was given
|
||||
ret
|
||||
|
||||
.dseg
|
||||
.extern bmask
|
||||
bmask: db 0xff
|
||||
.extern jflg
|
||||
jflg: db 0
|
||||
.extern lflg
|
||||
lflg: db 0
|
||||
.extern oflg
|
||||
oflg: db 0
|
||||
|
||||
; These next to _MUST_ remain adjacent, and in this order
|
||||
|
||||
.extern vflg
|
||||
vflg: db 0
|
||||
.extern wflg
|
||||
wflg: db 0
|
||||
|
||||
.extern hflg
|
||||
hflg: db 0
|
||||
|
||||
.extern eflg
|
||||
eflg: db 0
|
||||
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
; kermit.i - definitions for kermit file transfer code
|
||||
|
||||
.var MAXPSIZ 90 ; Maximum packet size
|
||||
.var MINPSIZ 20 ; minimum packet size
|
||||
.var SOH 1 ; Start of header
|
||||
.var DEL 0x7f ; Delete
|
||||
|
||||
.var MAXTRY 10 ; Times to retry a packet
|
||||
.var MYQUOTE '#' ; Quote character I will use
|
||||
.var MYHIBIT '&' ; char I use for hi-bit sending
|
||||
.var MYPACK '~' ; char I use for repeat packing
|
||||
.var MYPAD 0 ; Number of pad characters I need
|
||||
.var MYPCHAR 0 ; Padding character I need (NULL)
|
||||
|
||||
.var MYTIME 12 ; Seconds before I'm to be timed out
|
||||
.var MAXTIM 30 ; Maximum timeout interval
|
||||
.var MINTIM 4 ; Minumum timeout interval
|
||||
|
||||
.var MYEOL '\r' ; End-Of-Line character I need
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,10 @@
|
|||
xsub
|
||||
zc
|
||||
c:qterm.z c:termio.z c:vt100.z c:chat.z c:catch.z c:baud.z
|
||||
c:dir.z c:flags.z c:file.z c:odds.z c:cf.z c:send.z c:recv.z
|
||||
c:srutil.z c:sendk.z c:recvk.z c:kutil.z c:sendx.z c:recvx.z
|
||||
c:xutil.z c:srscrn.z
|
||||
c:shrink.z
|
||||
-x -l -s -be
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,658 @@
|
|||
; odds.z - code that has no place else to live
|
||||
|
||||
.incl "c:termcap"
|
||||
.incl "c:vars"
|
||||
|
||||
.var slow 86 ; should we slow down outgoing string
|
||||
|
||||
.extern prompt ; print an inline prompt then get a buffer
|
||||
prompt: ; full of data from the keyboard
|
||||
ld a,(prmpfl) ; see if we're in a chat script or not
|
||||
or a
|
||||
jr z,nochat ; no - do normal input
|
||||
push ix
|
||||
pop hl ; get string address to hl
|
||||
ld de,ipbuf
|
||||
ld bc,116 ; reasonable amount to copy
|
||||
ldir ; move it over, and we're done
|
||||
skipze: pop hl ; get string address - we have to skip over it
|
||||
skiplp: inc hl ; this relies on a non-empty string
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr nz,skiplp ; skip till we reach the end
|
||||
jp (hl) ; and return to address in hl
|
||||
nochat: call dim ; set dim mode
|
||||
ld hl,crlfms
|
||||
call prtslp ; send a newline
|
||||
pop hl
|
||||
call prtslp ; print the prompt
|
||||
push hl
|
||||
ld de,ipbuf - 2 ; point at where we'll read info
|
||||
ld a,e
|
||||
ld (de),a ; set count
|
||||
ld c,buffin
|
||||
call bdos ; read a line
|
||||
ld hl,ipbuf - 1
|
||||
ld e,(hl) ; get count actually input
|
||||
ld d,h
|
||||
add hl,de
|
||||
inc hl ; turn into a buffer pointer
|
||||
ld (hl),d ; and zero terminate input data
|
||||
|
||||
.extern crlf ; just print a newline
|
||||
crlf:
|
||||
call ilprt
|
||||
crlfms: db '\r\n'
|
||||
zero: db 0
|
||||
ret
|
||||
|
||||
.extern ilprt
|
||||
ilprt: call dim ; in line print - start by going dim
|
||||
pop hl ; get string address
|
||||
call prtslp ; out it goes
|
||||
push hl ; restore return address - fall into bright
|
||||
|
||||
.extern bright
|
||||
bright: ld a,(tcbits)
|
||||
and b_brite ; do we have a bright string?
|
||||
ret z
|
||||
ld hl,bflag ; currently bright?
|
||||
ld a,(hl)
|
||||
dec a
|
||||
ret nz ; yes, don't resend
|
||||
ld (hl),a
|
||||
ld hl,brites ; get address of bright string
|
||||
jr prtslx ; and send it
|
||||
|
||||
.extern dim
|
||||
dim: ld a,(tcbits)
|
||||
and b_dim ; do we have a dim string?
|
||||
ret z
|
||||
ld hl,bflag ; currently dim?
|
||||
ld a,(hl)
|
||||
or a
|
||||
ret nz ; yes, don't resend
|
||||
inc (hl)
|
||||
ld hl,dims ; get address of dim string
|
||||
jr prtslx
|
||||
|
||||
.extern dellin
|
||||
dellin:
|
||||
ld hl,dlstr ; get address of dellin string
|
||||
jr prtslx ; and send it
|
||||
|
||||
.extern inslin
|
||||
inslin:
|
||||
ld hl,ilstr ; get address of inslin string
|
||||
jr prtslx ; and send it
|
||||
|
||||
.extern cleol
|
||||
cleol:
|
||||
ld hl,ceol ; get address of cleol string
|
||||
jr prtslx ; and send it
|
||||
|
||||
.extern cleos
|
||||
cleos:
|
||||
ld hl,ceos ; get address of cleos string
|
||||
jr prtslx ; and send it
|
||||
|
||||
.extern clear
|
||||
clear: ld hl,clrs ; get address of clear string
|
||||
|
||||
prtslx: ld a,h
|
||||
ld (optype),a
|
||||
call prtslp
|
||||
xor a
|
||||
ld (optype),a
|
||||
ret
|
||||
|
||||
.extern prtslp
|
||||
prtslp:
|
||||
call clrpcp
|
||||
|
||||
.extern prtsl1
|
||||
prtsl1:
|
||||
ld a,(hl)
|
||||
or a
|
||||
ret z
|
||||
inc hl
|
||||
push hl
|
||||
call tabexp
|
||||
pop hl
|
||||
; for ^X to can a long directory, add a 'ret c' here
|
||||
jr prtsl1
|
||||
|
||||
.extern tabexp
|
||||
tabexp:
|
||||
cp '\n'
|
||||
jr nz,nonl
|
||||
ld a,79
|
||||
ld (pos),a
|
||||
ld a,'\n'
|
||||
nonl: cp '\r'
|
||||
jr nz,nocr
|
||||
ld a,0xff
|
||||
ld (pos),a
|
||||
ld a,'\r'
|
||||
nocr: cp '\t'
|
||||
jr z,tablp
|
||||
call prtopc
|
||||
jr chk80
|
||||
tablp: ld a,' '
|
||||
call prtopc
|
||||
ld a,(pos)
|
||||
and 7
|
||||
jr nz,tablp
|
||||
chk80: ld hl,pos
|
||||
ld a,(hl)
|
||||
xor 80
|
||||
call z,newlin
|
||||
ret
|
||||
|
||||
prtopc: ld c,a
|
||||
ld a,(optype)
|
||||
or a
|
||||
ld a,c
|
||||
jp nz,scrout
|
||||
ld hl,mode
|
||||
ld e,(hl)
|
||||
push hl
|
||||
push de
|
||||
ld (hl),lf_bit
|
||||
call opchar
|
||||
pop de
|
||||
pop hl
|
||||
ld (hl),e
|
||||
ld hl,pos
|
||||
inc (hl)
|
||||
ret
|
||||
|
||||
newlin: ld (hl),a ; set char count back to zero
|
||||
inc hl ; point at line count
|
||||
inc (hl) ; bump that too
|
||||
ld a,(hl)
|
||||
xor 23 ; 23 lines?
|
||||
ret nz ; return if not
|
||||
ld a,(pagerf)
|
||||
or a
|
||||
ret z ; and return if not paging
|
||||
dec (hl) ; set back to 22 in case we get a return
|
||||
ld hl,mmsg
|
||||
.dseg
|
||||
mmsg: db '[more]\0'
|
||||
.cseg
|
||||
call prtsl1 ; print more message
|
||||
call kbdin ; get a character
|
||||
ld hl,cmstr
|
||||
.dseg
|
||||
cmstr: db '\r \r\0'
|
||||
.cseg
|
||||
cp (hl) ; return?
|
||||
jr z,clrmor ; yes - just remove '[more]', linec is set
|
||||
xor 'x' & 0x1f
|
||||
jr z,retcx ; special exit on a ^X
|
||||
xor a
|
||||
ld (linec),a ; else clear linc for a full page
|
||||
clrmor: jp prtsl1 ; and remove the more message
|
||||
|
||||
retcx: call prtsl1 ; come here after a ^X - we remove the message
|
||||
scf ; and return carry to flag the exit
|
||||
ret
|
||||
|
||||
.extern clrpsp
|
||||
clrpsp:
|
||||
db 0x3e ; makes a ld a,xx
|
||||
|
||||
.extern clrpcp
|
||||
clrpcp:
|
||||
xor a
|
||||
ld (pagerf),a
|
||||
push hl
|
||||
ld hl,0
|
||||
ld (pos),hl
|
||||
pop hl
|
||||
ret
|
||||
|
||||
.extern mtprt ; a call to this is followed by inline coords.
|
||||
mtprt: ; and a string to be printed at the coords
|
||||
pop hl
|
||||
ld e,(hl)
|
||||
inc hl
|
||||
ld d,(hl) ; get moveto coordinates
|
||||
inc hl
|
||||
push hl ; save address of string
|
||||
ex de,hl ; coords to hl
|
||||
call moveto ; move to wherever
|
||||
pop hl ; restore string to hl
|
||||
call prtslp ; print it
|
||||
jp (hl) ; and return
|
||||
|
||||
.extern decob ; print number in l, by zeroing h
|
||||
decob:
|
||||
ld h,0 ; clear h and fall through
|
||||
|
||||
.extern decout ; print number in hl in decimal
|
||||
decout:
|
||||
push de ; save running total
|
||||
push bc ; save char count
|
||||
ld bc,-10
|
||||
ld de,-1
|
||||
decou2: add hl,bc
|
||||
inc de
|
||||
jr c,decou2 ; divide hl by 10
|
||||
sbc hl,bc ; reset because of overflow
|
||||
ex de,hl ; remainder to e, answer to hl
|
||||
ld a,h
|
||||
or l
|
||||
pop bc ; restore char count for next call
|
||||
call nz,decout ; answer non-zero: print recursively
|
||||
ld a,e ; get remainder
|
||||
add a,'0'
|
||||
ld c,a
|
||||
push bc
|
||||
call scrout ; print to screen as a digit
|
||||
pop bc
|
||||
dec b ; keep count of printed chars in b
|
||||
pop de ; restore total
|
||||
ret
|
||||
|
||||
.extern break
|
||||
break:
|
||||
call tenth ; wait a while before beginning
|
||||
call sbreak ; start the break
|
||||
call tenth3 ; idle for 3/10 of a second
|
||||
jp ebreak ; finish off by ending the break
|
||||
|
||||
.extern hangup
|
||||
hangup:
|
||||
ld hl,#dtroff
|
||||
ld a,(hl)
|
||||
cp 0xc9 ; return at dtroff => no code
|
||||
jr z,strhup ; so send a string instead
|
||||
call dtroff ; drop dtr - should make modem hang up
|
||||
call tenth3
|
||||
call tenth3 ; wait a (long) while
|
||||
jp dtron ; dtr back on
|
||||
strhup: ld ix,hangup - slow
|
||||
inc hl
|
||||
ld b,(hl) ; get the string length
|
||||
inc hl
|
||||
jp sendcs ; and out it goes
|
||||
|
||||
tenth3: call tenth
|
||||
call tenth
|
||||
|
||||
.extern tenth ; delay for 1/10 of a second, but continue to
|
||||
tenth: ; save incoming chars
|
||||
ld de,100
|
||||
call setspd ; get speed constant to hl
|
||||
tnthlp: ld b,60
|
||||
tnthl1: djnz tnthl1 ; idle a while
|
||||
push hl
|
||||
call savrng ; check incoming chars, but only as far as
|
||||
pop hl ; the ring buffer
|
||||
dec hl ; count main timer
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,tnthlp
|
||||
ret
|
||||
|
||||
.extern tnthip ; delay for 1/10 of a second, but continue to
|
||||
tnthip: ; check the modem for incoming chars
|
||||
ld de,100
|
||||
|
||||
.extern msip ; delay for de msec, but continue to
|
||||
msip: ; check the modem for incoming chars
|
||||
ld a,d
|
||||
or e ; anything in de?
|
||||
ret z ; nope - return right now
|
||||
call setspd ; get speed constant to hl
|
||||
msil: ld b,60
|
||||
msl2: djnz msl2 ; idle a while
|
||||
push hl
|
||||
call lstmod ; process incoming chars and printer output
|
||||
pop hl
|
||||
dec hl ; count main timer
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,msil
|
||||
ret
|
||||
|
||||
.extern setspd ; take 1MHz value in de, get correct value in
|
||||
setspd: ; hl based on cpu speed
|
||||
ld hl,0
|
||||
ld a,(speed)
|
||||
ld b,a ; get cpu speed to b
|
||||
spdok: add hl,de ; multiply de by b
|
||||
djnz spdok
|
||||
ret
|
||||
|
||||
.extern help
|
||||
help:
|
||||
call crlf ; start off with a new line
|
||||
call dim ; and dim
|
||||
call presc ; print the escape character
|
||||
or a ; test the flag
|
||||
ld c,' '
|
||||
call z,scrout ; print a space if no '^'
|
||||
call ilprt ; and finish off
|
||||
db ' - Transmit escape character\t '
|
||||
db '? - Print this help\r\n'
|
||||
db '. - Send a break\t\t\t'
|
||||
db ', - Hang up modem\r\n'
|
||||
db 'B - Change baud rate and mode\t\t'
|
||||
db 'C - Open an input catch file\r\n'
|
||||
db 'D - Display local directory\t\t'
|
||||
db 'E - Toggle remote echo\r\n'
|
||||
db 'H - Toggle half duplex\t\t'
|
||||
db 'I - Print settings information\r\n'
|
||||
db 'J - Junk control characters\t\t'
|
||||
db 'K - Load a function key\r\n'
|
||||
db 'L - Toggle linefeed transmit for \'P\'\t'
|
||||
db 'M - Toggle bit 7 mask\r\n'
|
||||
db 'N - Select new default drive / user\t'
|
||||
db 'O - Toggle output to printer\r\n'
|
||||
db 'P - Print a file to remote\t\t'
|
||||
db 'Q - Quit\r\n'
|
||||
db 'R - Receive a file using protocol\t'
|
||||
db 'S - Send a file using protocol\r\n'
|
||||
db 'T - Type a local file\t\t\t'
|
||||
db 'U - Invoke user function\r\n'
|
||||
db 'V - Toggle VT100 Emulation\t\t'
|
||||
db 'W - Toggle split window mode\r\n'
|
||||
db 'X - Activate a chat script\t\t'
|
||||
db 'Y - Put catch file on hold\r\n'
|
||||
db 'Z - Close catch file\t\t\t'
|
||||
db '0-9 - Send function key string\r\n'
|
||||
db 0
|
||||
ret
|
||||
|
||||
.extern info ; print current settings
|
||||
info:
|
||||
call ilprt
|
||||
db '\r\nEscape character:\t\0'
|
||||
call dim
|
||||
call presc ; print the escape character
|
||||
call ilprt
|
||||
db '\r\nCurrent drive / user:\t\0'
|
||||
call dim
|
||||
ld hl,(curusr) ; get the current drive & user
|
||||
ld a,h
|
||||
add a,'A' ; convert drive to a letter
|
||||
ld c,a
|
||||
push hl
|
||||
call scrout ; print the drive
|
||||
pop hl
|
||||
call decob ; and print the user in l
|
||||
call ilprt
|
||||
db ':\r\n\0'
|
||||
ld a,(rate)
|
||||
cp ' '
|
||||
jr z,norate
|
||||
call ilprt
|
||||
db 'Baud rate:\t\t\0'
|
||||
call dim
|
||||
ld hl,rate
|
||||
call prtslp
|
||||
norate: ld a,(modsav)
|
||||
cp ' '
|
||||
jr z,nomode
|
||||
call ilprt
|
||||
db 'Communication Mode:\t\0'
|
||||
call dim
|
||||
ld hl,modsav
|
||||
call prtslp
|
||||
nomode: call ilprt
|
||||
db '^S delay:\t\t\0'
|
||||
call dim
|
||||
ld hl,(csdely) ; get the delay count
|
||||
call decob ; out it goes
|
||||
call ilprt
|
||||
db ' second(s)\r\nHalf duplex:\t\t\0'
|
||||
ld a,(hflg)
|
||||
call onoff ; say whether HDX is on or off
|
||||
call ilprt
|
||||
db 'Local echo:\t\t\0'
|
||||
ld a,(eflg)
|
||||
call onoff ; say what local echo is up to
|
||||
call ilprt
|
||||
db 'Control char. discard:\t\0'
|
||||
ld a,(jflg)
|
||||
call onoff ; say what local echo is up to
|
||||
call ilprt
|
||||
db 'Linefeed in \'P\':\t\0'
|
||||
ld a,(lflg)
|
||||
call onoff ; line feed in print
|
||||
call ilprt
|
||||
db 'Character delay:\t\0'
|
||||
call dim
|
||||
ld hl,(chd) ; get the character delay
|
||||
call decob ; out it goes
|
||||
call ilprt
|
||||
db ' msec. \0'
|
||||
ld a,(ecflg)
|
||||
or a
|
||||
jr z,noeci
|
||||
call ilprt
|
||||
db '\techo check\0'
|
||||
noeci: call ilprt
|
||||
db '\r\nNew line delay:\t\t\0'
|
||||
call dim
|
||||
ld hl,(nld) ; new line delay is a word
|
||||
call decout
|
||||
call ilprt
|
||||
db ' msec. \0'
|
||||
ld a,(lfecho)
|
||||
or a
|
||||
jr z,nolfe
|
||||
push af
|
||||
call ilprt
|
||||
db '\tnewline echo: \'\0'
|
||||
call dim
|
||||
pop af
|
||||
ld c,a
|
||||
call scrout
|
||||
ld c,'\''
|
||||
call scrout
|
||||
nolfe: call ilprt
|
||||
db '\r\nBit 7 masking:\t\t\0'
|
||||
ld a,(bmask)
|
||||
inc a
|
||||
call onoff ; say what bit 7 masking is up to
|
||||
call ilprt
|
||||
db 'VT100 emulation:\t\0'
|
||||
ld a,(vflg)
|
||||
call onoff ; and vt100 emulation
|
||||
call ilprt
|
||||
db 'Printer output:\t\t\0'
|
||||
ld a,(oflg)
|
||||
call onoff ; and printer output
|
||||
ld a,(cflg)
|
||||
or a
|
||||
jr nz,isctch ; catch file active?
|
||||
call ilprt ; if not then say so
|
||||
db 'Not catching\r\n\0'
|
||||
ret
|
||||
isctch: call ilprt
|
||||
db 'Current catch file:\t\0'
|
||||
call dim
|
||||
ld hl,cfcb
|
||||
call prtfl ; otherwise print the filename
|
||||
ld a,(cflg)
|
||||
dec a
|
||||
jp z,crlf ; if active we're done
|
||||
call ilprt ; else say it's on hold
|
||||
db ' (on hold)\r\n\0'
|
||||
ret
|
||||
|
||||
onoff: or a ; is the flag active
|
||||
jr z,proff ; jump if not
|
||||
call ilprt
|
||||
db 'on\r\n\0' ; say it's on
|
||||
ret
|
||||
proff: call ilprt
|
||||
db 'off\r\n\0' ; or say it's off
|
||||
ret
|
||||
|
||||
.extern presc
|
||||
presc:
|
||||
ld b,0
|
||||
ld a,(escval) ; get the escape character
|
||||
cp ' '
|
||||
jr c,prthat ; it's a control char - print the ^
|
||||
cp 0x7f
|
||||
jr nz,nohat ; also do that for deletes
|
||||
prthat: ld c,'^'
|
||||
push af ; save the escape val
|
||||
call scrout ; print the ^
|
||||
pop af
|
||||
ld b,64 ; flag we printed the ^
|
||||
xor b ; and "uncontrollify" the char
|
||||
nohat: ld c,a
|
||||
push bc ; save flag
|
||||
call scrout ; print the char
|
||||
pop af ; flag back to a
|
||||
ret
|
||||
|
||||
.extern quit
|
||||
quit:
|
||||
call cclose ; close catch file if open
|
||||
ld hl,23 * 256 ; blh corner of screen
|
||||
call moveto ; go there
|
||||
call exit ; call custom unwind code
|
||||
rst 0 ; exit to cp/m
|
||||
|
||||
.extern conin ; get char from function key or keyboard
|
||||
conin:
|
||||
ld a,(fkdely) ; check if we need to delay
|
||||
or a
|
||||
call nz,tnthip ; idle a while if we do
|
||||
ld hl,(fkptr)
|
||||
ld a,(hl) ; get the next char
|
||||
inc hl
|
||||
ld (fkptr),hl ; save revised pointer
|
||||
ret ; char is in a
|
||||
|
||||
.extern ctls
|
||||
ctls:
|
||||
ld a,(lxoff) ; get local xon / xoff status
|
||||
or a
|
||||
ld a,(cschr)
|
||||
call nz,modopc ; send the xoff if needed
|
||||
ld a,(csdely)
|
||||
or a
|
||||
ret z ; if it's zero, return right now
|
||||
ld b,a ; get the delay value
|
||||
add a,a
|
||||
add a,a
|
||||
add a,b
|
||||
add a,a ; * 10
|
||||
ld b,a ; to b
|
||||
waitlp: push bc
|
||||
call tenth ; wait a while
|
||||
pop bc
|
||||
djnz waitlp
|
||||
ret
|
||||
|
||||
.extern gotxon ; flag that an xon was sent from the kbd,
|
||||
gotxon: ; so we don't re-send
|
||||
ld (lxoff),a ; set the local xoff flag
|
||||
ret
|
||||
|
||||
.extern gotxof ; flag that an xof was sent: this just clears
|
||||
gotxof: ; the flag set in gotxon
|
||||
ld hl,lxoff
|
||||
ld (hl),0
|
||||
ret
|
||||
|
||||
.extern areabp ; areabp used in chat scripts: point at first
|
||||
areabp: ; non-white in text of a '!' command
|
||||
ld hl,area - 1 ; point at chat parse area and fall into byp
|
||||
|
||||
.extern incbyp
|
||||
incbyp: ; inc hl, and then byp
|
||||
inc hl
|
||||
|
||||
.extern byp ; step over spaces in string pointed to by hl
|
||||
byp:
|
||||
ld a,(hl)
|
||||
cp ' '
|
||||
ret nz ; return on the first char that is NOT a space
|
||||
inc hl
|
||||
jr byp
|
||||
|
||||
.extern ldfnk ; this will prompt and then use the string
|
||||
ldfnk: ; to program one of the 10 function keys
|
||||
ld hl,zero ; point the readback pointer at a zero
|
||||
ld (fkptr),hl ; in case we change the string under it
|
||||
call prompt
|
||||
db 'Key value: \0' ; get the string
|
||||
ld hl,ipbuf
|
||||
call byp ; strip spaces
|
||||
or a
|
||||
ret z ; skip if nothing to do
|
||||
cp '\e'
|
||||
ret z ; or if an escape typed
|
||||
ld c,0 ; clear c (will become slow/fast flag)
|
||||
sub '0'
|
||||
cp 10
|
||||
jr c,fast ; 0-9: is a fast, key index in a
|
||||
ld c,a ; non-digit: save a non-zero in c
|
||||
inc hl
|
||||
ld a,(hl) ; get the next character
|
||||
sub '0' ; and turn it into an index
|
||||
fast: cp 10
|
||||
jr c,fnkok ; check it's ok
|
||||
call ilprt ; complain and return if not
|
||||
db 'Invalid function key number\r\n\0'
|
||||
ret
|
||||
fnkok: inc hl ; point at string to be parsed
|
||||
push hl ; save input string address
|
||||
add a,a
|
||||
add a,a
|
||||
add a,a
|
||||
add a,a ; turn index into table offset
|
||||
ld e,a
|
||||
ld d,0 ; goes in de
|
||||
ld hl,fktbl
|
||||
add hl,de ; get table entry address
|
||||
ld (hl),c ; save speed flag
|
||||
inc hl
|
||||
ex de,hl ; string target address to de
|
||||
pop hl ; text back to hl
|
||||
ld bc,14 << 8 ; 14 chars, zero byte delimits
|
||||
jp parst ; go parse the string, and we're done
|
||||
|
||||
.extern cbios ; call the entry point in the bios witn number
|
||||
cbios: ; in a, saving ix and iy as we go
|
||||
push ix
|
||||
push iy
|
||||
call #bios
|
||||
pop iy
|
||||
pop iy
|
||||
ret
|
||||
|
||||
#bios: ; offset is in a
|
||||
ld hl,(1) ; get the warm boot value to hl
|
||||
ld l,a ; modify with function number
|
||||
jp (hl) ; go do the code
|
||||
|
||||
.dseg
|
||||
optype: db 0
|
||||
bflag: db 0
|
||||
.extern lxoff
|
||||
lxoff: db 1
|
||||
.extern prmpfl
|
||||
prmpfl: db 0
|
||||
.extern fkptr
|
||||
fkptr: dw zero
|
||||
|
||||
.useg
|
||||
pos: ds 1
|
||||
linec: ds 1
|
||||
pagerf: ds 1
|
||||
.extern fkdely
|
||||
fkdely: ds 1
|
||||
.extern fktbl
|
||||
fktbl: ds 16 * 10
|
||||
|
||||
Binary file not shown.
|
|
@ -0,0 +1,903 @@
|
|||
; qterm.z - patch area and main control loop for qterm
|
||||
|
||||
.incl "c:vars"
|
||||
.incl "c:version"
|
||||
|
||||
.var escchr '\\' & 0x1f
|
||||
.var biosjp 1
|
||||
.var memtop 6
|
||||
|
||||
.macro table byte,addr
|
||||
dw addr
|
||||
db byte
|
||||
.endm
|
||||
|
||||
jp start ; skip over the patch area
|
||||
|
||||
; now for the screen access routines - these are put here because moveto
|
||||
; will have to access scrout, and this provides a ready access point
|
||||
|
||||
#kbdsts:
|
||||
jp 6 ; keyboard status routine
|
||||
#kbdin:
|
||||
jp 9 ; keyboard input routine
|
||||
#scrout:
|
||||
jp 12 ; screen output
|
||||
jp decoj ; access to decimal output routine
|
||||
|
||||
; These bits are system dependant, and are put at the beginning of the
|
||||
; program so that them as what needs to change them, can.
|
||||
|
||||
; modist - return with z flag clear iff there is a char waiting at modem port
|
||||
|
||||
.org 0x0010
|
||||
#modist:
|
||||
ld hl,(_base_)
|
||||
ld a,(hl)
|
||||
inc hl
|
||||
xor (hl)
|
||||
ret
|
||||
|
||||
; modin - read char from modem port: modist has been used to check it's there
|
||||
|
||||
.org 0x0020
|
||||
#modin:
|
||||
ld hl,(_base_)
|
||||
inc (hl)
|
||||
res 5,(hl)
|
||||
ld e,(hl)
|
||||
inc hl
|
||||
inc hl
|
||||
ld d,0
|
||||
add hl,de
|
||||
ld a,(hl)
|
||||
ret
|
||||
|
||||
; modost - return with z flag clear iff the modem can accept another char
|
||||
|
||||
.org 0x0030
|
||||
#modost:
|
||||
in a,(0x2e)
|
||||
and 0x80
|
||||
ret
|
||||
|
||||
; modout - send char to modem port
|
||||
|
||||
.org 0x0040
|
||||
#modout:
|
||||
out (0x2f),a
|
||||
ret
|
||||
|
||||
; sbreak - start a break condition on line
|
||||
|
||||
.org 0x0050
|
||||
#sbreak:
|
||||
ld a,0x0d
|
||||
out (0x2e),a
|
||||
ret
|
||||
|
||||
; ebreak - terminate break condition
|
||||
|
||||
.org 0x0060
|
||||
#ebreak:
|
||||
ld a,0x05
|
||||
out (0x2e),a
|
||||
ret
|
||||
|
||||
; dtroff - disable dtr to cause modem to hang up
|
||||
|
||||
.org 0x0070
|
||||
.extern #dtroff ; external so hangup can work
|
||||
#dtroff:
|
||||
ld a,0x24
|
||||
out (0x21),a
|
||||
ret
|
||||
|
||||
; dtron - re-enable dtr
|
||||
|
||||
.org 0x0080
|
||||
#dtron:
|
||||
xor a
|
||||
out (0x21),a
|
||||
ret
|
||||
|
||||
; setbd - take byte in a from baud table, use it to set baud rate
|
||||
|
||||
.org 0x0090
|
||||
#setbd:
|
||||
out (0x2b),a
|
||||
ret
|
||||
|
||||
; these next eight are byte pairs - the first byte is used by setbd above.
|
||||
; the second is a -1 for an active baud rate entry, and a 0 for inactive
|
||||
|
||||
.org 0x00a0
|
||||
.extern b38400
|
||||
b38400: db 0,no
|
||||
.extern b19200
|
||||
b19200: db 0,no
|
||||
.extern b9600
|
||||
b9600: db 1,yes
|
||||
.extern b4800
|
||||
b4800: db 2,yes
|
||||
.extern b2400
|
||||
b2400: db 4,yes
|
||||
.extern b1200
|
||||
b1200: db 8,yes
|
||||
.extern b600
|
||||
b600: db 16,yes
|
||||
.extern b300
|
||||
b300: db 32,yes
|
||||
|
||||
; setmod - take a byte from the mode table, use it to set the uart mode
|
||||
|
||||
.org 0x00b0
|
||||
#setmod:
|
||||
out (0x2c),a
|
||||
ret
|
||||
|
||||
; now the twelve mode bytes for setting comm format
|
||||
|
||||
.org 0x00c0
|
||||
.extern modtab
|
||||
modtab:
|
||||
n17: db 0b10101010
|
||||
n18: db 0b10001010
|
||||
n27: db 0b10111010
|
||||
n28: db 0b10011010
|
||||
e17: db 0b10101110
|
||||
e18: db 0b10001110
|
||||
e27: db 0b10111110
|
||||
e28: db 0b10011110
|
||||
o17: db 0b10101100
|
||||
o18: db 0b10001100
|
||||
o27: db 0b10111100
|
||||
o28: db 0b10011100
|
||||
|
||||
.org 0x00cc
|
||||
.extern resrvd
|
||||
resrvd:
|
||||
db 0
|
||||
|
||||
; xfersz - number of K to read / write to disk during protocol transfers:
|
||||
; must be 1 / 2 / 4 / 8. Generally this is best left at 8 unless you have
|
||||
; a REALLY slow disk (C128 maybe) when writing / reading 8K at a time
|
||||
; causes timeouts. Drop this to 4 or 2 to do disk access in smaller chunks
|
||||
; to help avoid the timeout problem
|
||||
|
||||
.extern xfersz
|
||||
xfersz: db 8
|
||||
|
||||
; speed - simply the cpu speed for a z80 in mhz.
|
||||
|
||||
.extern speed
|
||||
speed: db 4
|
||||
|
||||
; escape - this is the character used as the escape char: since the addresses
|
||||
; in the table tend to move, we just put the byte here, and then transfer
|
||||
; to the table later
|
||||
|
||||
escape: db escchr
|
||||
|
||||
; the signon message - change this to be appropriate for your system
|
||||
|
||||
.org 0x00d0
|
||||
signon: db 'Televideo TS803\0'
|
||||
|
||||
; now the string for clear screen
|
||||
|
||||
.org 0x00f0
|
||||
.extern clrs
|
||||
clrs: db 'z' & 0x1f, 0
|
||||
|
||||
; moveto - this routine is called with a word in hl - h = row &
|
||||
; l = column to move to, at 109 is a routine to print a char in c,
|
||||
; at 10c is a routine to print a decimal number in hl (for ansi tubes)
|
||||
|
||||
.org 0x0100
|
||||
#moveto:
|
||||
push hl ; save coords
|
||||
ld c,'\e'
|
||||
call #scrout ; lead in escape
|
||||
ld c,'='
|
||||
call #scrout ; leadin '='
|
||||
pop hl
|
||||
push hl
|
||||
ld a,h ; row to a
|
||||
call poff ; out it goes w/ offset
|
||||
pop hl
|
||||
ld a,l ; col to a
|
||||
poff: add a,' ' ; add offset
|
||||
ld c,a
|
||||
jp #scrout ; & print it
|
||||
|
||||
; these next strings are used to do various screen functions. There are
|
||||
; eight of them, and immediately preceding them is a flag byte. Each string
|
||||
; has a bit in the byte, and if a capability is present, its bit should
|
||||
; be set. This byte is an absolute necessity, as various programs use it
|
||||
; to tell if various things are present.
|
||||
|
||||
.org 0x012f
|
||||
.extern tcbits
|
||||
tcbits:
|
||||
db 0b11111111
|
||||
; ||||||||
|
||||
; |||||||+------ 0: bright (end highlight)
|
||||
; ||||||+------- 1: dim (start highlight)
|
||||
; |||||+-------- 2: delete line
|
||||
; ||||+--------- 3: insert line
|
||||
; |||+---------- 4: delete character
|
||||
; ||+----------- 5: insert character
|
||||
; |+------------ 6: clear to end of line
|
||||
; +------------- 7: clear to end of screen
|
||||
|
||||
.org 0x0130
|
||||
.extern brites
|
||||
brites: db '\e(\0'
|
||||
|
||||
.org 0x0138
|
||||
.extern dims
|
||||
dims: db '\e)\0'
|
||||
|
||||
.org 0x0140
|
||||
.extern dlstr
|
||||
dlstr: db '\eR\0'
|
||||
|
||||
.org 0x0148
|
||||
.extern ilstr
|
||||
ilstr: db '\eE\0'
|
||||
|
||||
.org 0x0150
|
||||
.extern dcstr
|
||||
dcstr: db '\eW\0'
|
||||
|
||||
.org 0x0158
|
||||
.extern icstr
|
||||
icstr: db '\eQ\0'
|
||||
|
||||
.org 0x0160
|
||||
.extern ceol
|
||||
ceol: db '\eT\0'
|
||||
|
||||
.org 0x0168
|
||||
.extern ceos
|
||||
ceos: db '\eY\0'
|
||||
|
||||
; Entry and exit hooks. These are provided to perform custom initialisation
|
||||
; on startup, and also to perform custom code on exit.
|
||||
|
||||
.org 0x0170
|
||||
.extern entry
|
||||
entry: jp do_ent
|
||||
|
||||
.org 0x0173
|
||||
.extern exit
|
||||
exit: jp do_ext
|
||||
|
||||
.org 0x0176
|
||||
.extern #user
|
||||
#user:
|
||||
.if dg
|
||||
jp _user_ ; go do ours
|
||||
.else
|
||||
ret
|
||||
.endif
|
||||
|
||||
.org 0x0179
|
||||
.extern #kbmap
|
||||
#kbmap:
|
||||
.if dg
|
||||
jp _kbmp_ ; hook into keyboard map routine
|
||||
.else
|
||||
ret
|
||||
.endif
|
||||
|
||||
.org 0x017c
|
||||
_ilpr_: jp prmpjp
|
||||
|
||||
; finally a patch area that is provided for patching odd systems that need
|
||||
; a lot of space.
|
||||
|
||||
.org 0x0180
|
||||
|
||||
do_ent:
|
||||
|
||||
.if dg
|
||||
|
||||
ld c,14
|
||||
ld e,3
|
||||
call 5
|
||||
ld c,32
|
||||
ld e,30
|
||||
call 5
|
||||
ld a,0b10001010 ; 8n1
|
||||
out (0x2c),a
|
||||
ld a,4 ; 2400
|
||||
out (0x2b),a
|
||||
|
||||
.endif
|
||||
|
||||
di
|
||||
ld hl,(0xff00)
|
||||
xor a
|
||||
ld (hl),a
|
||||
ld (_base_),hl ; OK, use GSX interface area for interrupts
|
||||
inc hl
|
||||
ld (hl),a
|
||||
ld (_here_ + 1),hl
|
||||
ld de,33
|
||||
add hl,de
|
||||
ex de,hl
|
||||
push de
|
||||
ld hl,icode
|
||||
ld bc,{endi - icode}
|
||||
ldir
|
||||
ld c,0x10
|
||||
pop de
|
||||
jr endit
|
||||
|
||||
do_ext: di
|
||||
ld de,(ivec)
|
||||
ld c,0
|
||||
|
||||
endit: ld a,i
|
||||
ld h,a
|
||||
ld l,0x78
|
||||
ld a,(hl)
|
||||
ld (hl),e
|
||||
ld e,a
|
||||
inc hl
|
||||
ld a,(hl)
|
||||
ld (hl),d
|
||||
ld d,a
|
||||
ld (ivec),de
|
||||
ld a,0x65
|
||||
out (0x28),a
|
||||
ld a,c
|
||||
out (0x20),a
|
||||
out (0x27),a
|
||||
ld a,0x64
|
||||
out (0x28),a
|
||||
ei
|
||||
clrlp: in a,(0x2f)
|
||||
in a,(0x2d)
|
||||
add a,a
|
||||
jr c,clrlp
|
||||
ret
|
||||
|
||||
icode: di
|
||||
push hl
|
||||
push af
|
||||
iclp: in a,(0x2d)
|
||||
add a,a
|
||||
jr nc,icdone
|
||||
_here_: ld hl,0 ; filled in later
|
||||
inc (hl)
|
||||
res 5,(hl)
|
||||
ld a,(hl)
|
||||
inc hl
|
||||
add a,l
|
||||
ld l,a
|
||||
jr nc,hok
|
||||
inc h
|
||||
hok: in a,(0x2f)
|
||||
ld (hl),a
|
||||
jr iclp
|
||||
icdone: pop af
|
||||
pop hl
|
||||
ei
|
||||
reti
|
||||
endi:
|
||||
|
||||
ivec: dw 0
|
||||
_base_: dw 0
|
||||
|
||||
.if dg
|
||||
|
||||
.var linesz 40 ; default number of chars before we start
|
||||
|
||||
_user_:
|
||||
call _ilpr_ ; prompt for and get an answer
|
||||
db 'Split? \0'
|
||||
ld hl,0x7f ; point just before it
|
||||
_byp: inc hl
|
||||
ld a,(hl) ; get the next character
|
||||
cp ' ' ; space?
|
||||
jr z,_byp ; yes, skip over it
|
||||
sub '0'
|
||||
cp 10
|
||||
jr c,_numbr ; numeric input - go handle it
|
||||
add a,'0' ; convert back
|
||||
or 0x20 ; force lower case
|
||||
xor 0x20 ; this really tests for a null .....
|
||||
jr z,_gtans ; yes, save zero byte
|
||||
xor 0x20 ^ 'y' ; and check for a 'y' (including 'Y')
|
||||
_gtans: ld (split),a ; save the flag - zero enables, non-zero
|
||||
; disables
|
||||
ld a,linesz ; set line length to default of 40
|
||||
_setll: ld (linlen),a ; set the line length from a
|
||||
xor a
|
||||
ld (count),a ; and set the count to zero
|
||||
ret
|
||||
|
||||
_numbr: ld e,a ; save current value in e
|
||||
inc hl ; point to next character
|
||||
ld a,(hl)
|
||||
sub '0' ; convert .....
|
||||
cp 10 ; and test if it's a digit
|
||||
jr nc,_gtnum ; nope - we're all done
|
||||
ld d,a
|
||||
ld a,e
|
||||
add a,a ; a = e * 2
|
||||
add a,a ; * 4
|
||||
add a,e ; * 5
|
||||
add a,a ; * 10
|
||||
add a,d ; + d
|
||||
jr _numbr
|
||||
_gtnum: xor a
|
||||
ld (split),a ; else set split flag to enable
|
||||
ld a,e ; and get the line length back from e
|
||||
jr _setll ; go do the set with whatever we have
|
||||
|
||||
_kbmp_: and 0x7f ; ditch bit 7, just because I'm paranoid
|
||||
_nodel: ld hl,split ; point at the flag
|
||||
inc (hl)
|
||||
dec (hl)
|
||||
ld c,a ; save char in c
|
||||
jp nz,_jstcn ; not splitting - get outa here
|
||||
ld hl,(state)
|
||||
ld a,h
|
||||
or l ; are we in the middle of a line break?
|
||||
jr nz,_linbr ; yes, so handle it elsewhere
|
||||
ld a,c ; get the character back from c
|
||||
ld hl,0x01cf ; point at the escape character
|
||||
cp (hl)
|
||||
ret z ; we have to let these through!
|
||||
ld hl,count ; point hl at the count for everyone
|
||||
cp '\b'
|
||||
jr z,_bcksp ; handle backspaces
|
||||
cp 'y' & 0x1f
|
||||
jr z,_ctly ; and ^Y's
|
||||
cp '\r'
|
||||
jr z,_retrn ; and returns
|
||||
cp '\n'
|
||||
jr z,_newln ; and linefeeds
|
||||
inc b ; set b to 1 for a potential swallow
|
||||
cp 0x7f ; throw away deletes
|
||||
ret z
|
||||
cp ' ' ; is it a space?
|
||||
jr z,_space ; handle specially if so
|
||||
ret c ; and throw away other control characters
|
||||
dec b ; reset b to pass the single character
|
||||
inc (hl) ; bump count
|
||||
ret ; and return - char is still in a
|
||||
|
||||
_bcksp: dec (hl) ; anything in the current count
|
||||
inc b ; set b to 1 for a swallow
|
||||
inc (hl) ; restore count
|
||||
ret z ; and return if nothing there
|
||||
dec (hl) ; decrement count since we're allowing it
|
||||
dec b ; reset b
|
||||
ret
|
||||
|
||||
_retrn: ld hl,retstr ; point at the return string
|
||||
jr _linbr
|
||||
|
||||
_newln: ld hl,nlstr ; point at the new line string
|
||||
jr _linbr
|
||||
|
||||
_ctly: ld hl,(count)
|
||||
ld h,0 ; set state from count
|
||||
or a
|
||||
jr _setbs
|
||||
|
||||
_space: inc (hl) ; we passed another character, count it
|
||||
ld a,(linlen) ; get the line length
|
||||
cp (hl) ; too long yet?
|
||||
ld a,c
|
||||
dec b
|
||||
ret nc ; no, return character in a
|
||||
ld hl,string ; else point at the string to send
|
||||
|
||||
_linbr: ld a,h
|
||||
or a
|
||||
jr z,_sndbs ; if h is zero, send l backspaces
|
||||
ld a,(hl) ; get the next character from the string
|
||||
inc hl ; move the pointer
|
||||
inc (hl)
|
||||
dec (hl) ; end of string?
|
||||
ld b,2 ; set b to 2 to say there's more coming
|
||||
jr nz,_savhl ; not end of string, save hl and return
|
||||
ld b,(hl) ; set b to zero again
|
||||
ld hl,count
|
||||
ld (hl),b ; zero out the count from b
|
||||
ld h,b
|
||||
ld l,b ; set hl to zero to reset the state machine
|
||||
_savhl: ld (state),hl ; save the pointer / NULL
|
||||
ret
|
||||
|
||||
_sndbs: dec l ; one less to go
|
||||
_setbs: ld (state),hl ; save the state back
|
||||
ld b,2 ; flag more to come
|
||||
jr nz,_bok ; unless this is the last
|
||||
ld b,h ; in which case b gets zero
|
||||
ld (count),a ; set count to zero (a is zero from jp above)
|
||||
_bok: ld a,'\b' ; stuff a backspace in a, and we're done
|
||||
ret
|
||||
|
||||
_jstcn: ld hl,(state)
|
||||
ld a,h
|
||||
or l ; are we in the middle of a line break?
|
||||
jr nz,_linbr ; yes, so handle it elsewhere
|
||||
ld a,c
|
||||
ld b,0
|
||||
ld hl,count ; point hl at the count for everyone
|
||||
cp '\b'
|
||||
jr z,_cbksp ; count backwards
|
||||
cp '\n'
|
||||
jr z,_cntrt ; count return's - set to zero
|
||||
cp '\r'
|
||||
jr z,_cntrt
|
||||
cp 'y' & 0x1f
|
||||
jr z,_ctly ; handle ^Y's
|
||||
cp ' '
|
||||
ret c ; let control chars pass, but don't count them
|
||||
inc (hl)
|
||||
ret
|
||||
_cntrt: ld (hl),b ; set count to zero
|
||||
ret
|
||||
|
||||
_cbksp: dec (hl) ; anything in the current count
|
||||
inc (hl)
|
||||
ret z ; no, leave count alone
|
||||
dec (hl) ; drop it back by one
|
||||
ret ; all done
|
||||
|
||||
count: db 0 ; count of chars since the last new line
|
||||
linlen: db linesz ; line size we're currently using
|
||||
split: db 1 ; flag if we're splitting: zero => we are
|
||||
state: dw 0 ; what state are we in?
|
||||
|
||||
string: db ' .....\r\0' ; space string to break lines
|
||||
retstr: db ' [end]' ; return string to end a paragraph
|
||||
nlstr: db '\r\0' ; newline to end
|
||||
|
||||
.endif
|
||||
|
||||
.org 0x0400
|
||||
|
||||
; put this jump here, because decout may move, so we can't have it's address
|
||||
; in the patch area
|
||||
|
||||
decoj: jp decout
|
||||
|
||||
; same again: prompt may move
|
||||
|
||||
prmpjp: jp prompt
|
||||
|
||||
; now the start of the main code
|
||||
|
||||
start: ld sp,(memtop) ; set the stack
|
||||
ld a,(biosjp + 1) ; get the bios base address
|
||||
ld (#kbdsts + 2),a
|
||||
ld (#kbdin + 2),a
|
||||
ld (#scrout + 2),a ; fix the three jumps
|
||||
call #subchk ; but now check for XSUB installed
|
||||
ld a,(escape)
|
||||
ld (escval),a ; set the escape character in the jump table
|
||||
call setshr ; do shrink adjustment
|
||||
ld a,(xfersz)
|
||||
ld hl,512
|
||||
sizlp: add hl,hl ; set size in K in hl
|
||||
rra
|
||||
jr nc,sizlp ; loop till size is set in hl
|
||||
ld de,work2
|
||||
add hl,de
|
||||
ld (ew2p),hl ; and set pointer for transfers
|
||||
ld hl,fktbl
|
||||
ld de,fktbl + 1
|
||||
ld bc,16 * 10 - 1
|
||||
ld (hl),b
|
||||
ldir ; clear fk table initially
|
||||
call entry ; do the users custom code
|
||||
ld sp,(memtop) ; reload the stack pointer in case things got
|
||||
; bashed in the entry hook
|
||||
call ilprt ; print fixed part of signon
|
||||
db 'QTERM V'
|
||||
version
|
||||
db '\r\n'
|
||||
db '(C) Copyright DPG '
|
||||
year
|
||||
db ' - All rights reserved\r\n'
|
||||
db 'Version for \0'
|
||||
call dim
|
||||
ld hl,signon
|
||||
call prtslp ; print the system signon message
|
||||
call ilprt
|
||||
db '\r\nEscape character is \0'
|
||||
call dim
|
||||
call presc ; remind what the escape character is
|
||||
call crlf
|
||||
call crlf ; throw a newline or two
|
||||
ld a,(#dtroff)
|
||||
cp 0xc9
|
||||
call nz,dtron ; enable dtr
|
||||
ld c,getdrv ; now, in case we changed drive / user in the
|
||||
call bdos ; entry hook, we get the current drive / user
|
||||
ld (curdrv),a
|
||||
ld (chtdrv),a ; chat drive
|
||||
ld c,gsuser
|
||||
ld e,0xff
|
||||
call bdos ; find out which user
|
||||
ld (curusr),a ; save it away as well
|
||||
ld (chtusr),a ; chat user
|
||||
ld hl,0x80 ; get command tail
|
||||
ld e,(hl) ; get it's length
|
||||
ld (hl),' ' ; add a space so that byp will grok it
|
||||
inc hl
|
||||
ld d,h ; extend length to de
|
||||
ex de,hl
|
||||
add hl,de
|
||||
ld (hl),d ; stick a zero byte on the end of it
|
||||
ex de,hl ; base address back to hl
|
||||
call byp ; was there anything there?
|
||||
or a
|
||||
call nz,ichat ; yes - go process it
|
||||
|
||||
; this loop provides terminal mode: it simply loops round polling the kdb &
|
||||
; modem port - when it finds something, then it starts to get clever
|
||||
|
||||
.extern main
|
||||
main: ld sp,(memtop) ; since we long jump here occasionally
|
||||
ld hl,main
|
||||
push hl ; push "here" so a return gets us back
|
||||
ld a,lf_bit
|
||||
ld (mode),a ; reset mode
|
||||
call lstmod ; keep the printer going and check modem port
|
||||
ld hl,(fkptr)
|
||||
ld a,(hl)
|
||||
or a ; sending a function key?
|
||||
jr z,nofkey ; nope, go try the keyboard
|
||||
call conin ; get the key
|
||||
jr gotcon
|
||||
nofkey: ld (prmpfl),a
|
||||
ld a,(more)
|
||||
rra ; should we get a keyboard character
|
||||
jr c,skipin ; skip if not
|
||||
call kbdsts ; keyboard ready?
|
||||
or a
|
||||
ret z ; no, loop back
|
||||
call kbdin ; get the char
|
||||
skipin: ld b,0 ; set b so a return is a no-op
|
||||
call #kbmap ; run through the keyboard window
|
||||
srl b
|
||||
ret c ; swallowed, start again
|
||||
gotcon: ld c,a ; save in c
|
||||
ld a,b ; copy more bit to a
|
||||
ld (more),a ; and save it
|
||||
ld de,escstt
|
||||
ld a,(de) ; what state are we in?
|
||||
dec a
|
||||
ld a,c ; get char back
|
||||
jr z,hadesc ; we've had an esc char, handle next
|
||||
ld hl,cschr
|
||||
cp (hl)
|
||||
call z,gotxof ; note passing xoff's
|
||||
jr z,noxon
|
||||
ld hl,lxoff
|
||||
inc (hl)
|
||||
dec (hl)
|
||||
ld hl,escval
|
||||
jr nz,noxon
|
||||
cp (hl)
|
||||
call nz,gotxon ; and xon's
|
||||
noxon: cp (hl) ; test the char for an escape
|
||||
jr nz,modopj ; no it's not, send it to the modem
|
||||
ld hl,(fkptr)
|
||||
ld a,(hl) ; in the midst of a pfk send?
|
||||
or a
|
||||
ld a,(escval) ; get an escape char back into a
|
||||
modopj: jr z,gotesc ; yes - skip the usual escape
|
||||
ld a,(wflg)
|
||||
or a
|
||||
ld a,c
|
||||
call nz,limitb ; legal character?
|
||||
ret c ; nope - exit now
|
||||
modjp: jp modop
|
||||
|
||||
; gotesc - we just got the escape char in state 0: set state to 1
|
||||
|
||||
gotesc: ex de,hl
|
||||
inc (hl) ; set state to 1
|
||||
ret
|
||||
|
||||
; esctbl - table of special values for the escape handler
|
||||
|
||||
.dseg
|
||||
esctbl: dw modop
|
||||
.extern escval
|
||||
escval: db escchr
|
||||
table '?',help
|
||||
table '.',break
|
||||
table 0x2c,hangup
|
||||
table 'B',baud
|
||||
table 'C',catch
|
||||
table 'D',dir
|
||||
table 'E',echo
|
||||
table 'H',hdxtog
|
||||
table 'I',info
|
||||
table 'J',jctog
|
||||
table 'K',ldfnk
|
||||
table 'L',lftog
|
||||
table 'M',msbtog
|
||||
table 'N',newdsk
|
||||
table 'O',optog
|
||||
table 'P',print
|
||||
table 'Q',quit
|
||||
table 'R',recv
|
||||
table 'S',send
|
||||
table 'T',type
|
||||
table 'U',#user
|
||||
table 'V',vttog
|
||||
table 'W',witog
|
||||
table 'X',chat
|
||||
table 'Y',hold
|
||||
table 'Z',cclose
|
||||
tblend:
|
||||
.cseg
|
||||
|
||||
; hadesc - we are in state 1 and a char arrived: process it as appropriate
|
||||
|
||||
hadesc: ex de,hl
|
||||
dec (hl) ; reset state
|
||||
nowjp: ld a,c
|
||||
ld hl,esctbl ; get address of table
|
||||
ld b,{tblend - esctbl} / 3
|
||||
call ucsa ; force it upper case
|
||||
escscn: ld e,(hl)
|
||||
inc hl
|
||||
ld d,(hl) ; get jump address to de
|
||||
inc hl
|
||||
cp (hl) ; test for a match
|
||||
inc hl
|
||||
push de
|
||||
ret z ; got it: go and process
|
||||
pop de
|
||||
djnz escscn ; loop back & try again
|
||||
nowpop: ld a,c ; get char from c (again)
|
||||
sub '0'
|
||||
cp 10 ; check for '0' thru '9'
|
||||
ret nc ; didn't find it - give up
|
||||
add a,a
|
||||
add a,a
|
||||
add a,a
|
||||
add a,a ; * 16 gives table offset
|
||||
ld l,a
|
||||
ld h,0
|
||||
ld de,fktbl
|
||||
add hl,de ; index into table
|
||||
ld a,(hl) ; pick up
|
||||
ld (fkdely),a ; and save delay flag
|
||||
inc hl ; point at main string
|
||||
ld (fkptr),hl ; save string address
|
||||
ret
|
||||
|
||||
.dseg
|
||||
escstt: db 0 ; state of escape detection
|
||||
more: db 0 ; keyboard window code
|
||||
|
||||
; V4.1e rev
|
||||
;
|
||||
; we now save ix and iy through all patch and bios calls: these entries
|
||||
; are used, and do all the work needed
|
||||
|
||||
.cseg
|
||||
|
||||
.macro access entry
|
||||
.extern entry
|
||||
entry:
|
||||
push ix
|
||||
push iy
|
||||
call #`entry
|
||||
pop iy
|
||||
pop ix
|
||||
ret
|
||||
.endm
|
||||
|
||||
access kbdsts
|
||||
access scrout
|
||||
access modist
|
||||
access modin
|
||||
access modost
|
||||
access modout
|
||||
access sbreak
|
||||
access ebreak
|
||||
access dtroff
|
||||
access dtron
|
||||
access setbd
|
||||
access setmod
|
||||
access moveto
|
||||
|
||||
.extern kbdcc ; get a keyboard character if it's waiting
|
||||
kbdcc:
|
||||
call kbdsts
|
||||
or a
|
||||
ret z ; return 0 if nothing
|
||||
|
||||
access kbdin
|
||||
|
||||
.var #bdos 5
|
||||
|
||||
|
||||
.extern usrbds ; call bdos, but with a user switch
|
||||
usrbds:
|
||||
push bc ; save the function code
|
||||
ld a,(de) ; get the user number to switch to
|
||||
inc de ; point de at bdos's idea of the fcb
|
||||
push de ; save the address
|
||||
ld e,a
|
||||
ld c,gsuser
|
||||
call bdos ; set the user number
|
||||
pop de ; restore the fcb address
|
||||
pop bc ; and function number
|
||||
|
||||
.extern bdos
|
||||
bdos:
|
||||
push ix
|
||||
push iy
|
||||
call #bdos
|
||||
pop iy
|
||||
pop ix
|
||||
ret
|
||||
|
||||
.extern #subchk
|
||||
#subchk:
|
||||
ld hl,(1)
|
||||
ld a,l
|
||||
ld de,3
|
||||
xor e
|
||||
jr nz,chngit
|
||||
ld l,a
|
||||
ld b,6
|
||||
jplp: ld a,(hl)
|
||||
cp 0xc3
|
||||
jr nz,chngit
|
||||
add hl,de
|
||||
djnz jplp
|
||||
ret
|
||||
chngit: ld hl,jptab
|
||||
ld de,0x0103
|
||||
ld bc,9
|
||||
ldir
|
||||
ret
|
||||
|
||||
jptab: jp locst
|
||||
jp locin
|
||||
jp locout
|
||||
|
||||
locst: ld hl,peekc
|
||||
ld a,(hl)
|
||||
.dseg
|
||||
peekc: db 0
|
||||
.cseg
|
||||
or a
|
||||
ret nz
|
||||
ld c,6
|
||||
ld e,-1
|
||||
push hl
|
||||
call 5
|
||||
pop hl
|
||||
ld (hl),a
|
||||
or a
|
||||
ret
|
||||
|
||||
locin: call locst
|
||||
jr z,locin
|
||||
ld (hl),0
|
||||
ret
|
||||
|
||||
locout: res 7,c
|
||||
ld e,c
|
||||
ld c,6
|
||||
jp 5
|
||||
|
||||
|
|
@ -0,0 +1,77 @@
|
|||
; recv.z - protocol receive code for qterm
|
||||
|
||||
.incl "c:vars"
|
||||
|
||||
.extern recv
|
||||
recv:
|
||||
call pmode
|
||||
jr z,modok
|
||||
cp 'x'
|
||||
jp nz,moderr ; k & x are the only legal modes (for now)
|
||||
modok: inc hl
|
||||
push hl ; save pointer
|
||||
push af ; and mode character
|
||||
call unbyp ; step over flags
|
||||
call scnfcb ; parse name (or drive only for batch)
|
||||
ld hl,(fcb)
|
||||
ld (newusr),hl ; save receive drive and user
|
||||
pop bc
|
||||
pop hl
|
||||
jp z,nowcp
|
||||
push bc
|
||||
push hl
|
||||
call reset ; do a reset
|
||||
pop hl
|
||||
pop bc
|
||||
ld a,'k'
|
||||
cp b ; Kermit or Xmodem
|
||||
jr nz,recvx
|
||||
call recvk ; receive kermit
|
||||
jr xferd ; and unwrap
|
||||
recvx: call xmflgs ; parse xmodem flags
|
||||
call initx
|
||||
call initrc ; set up screen
|
||||
dorecv: call xrfile ; receive a file
|
||||
or a
|
||||
jr nz,dorecv ; loop if more to come
|
||||
ld a,(errorf)
|
||||
or a ; flag if there was an error or not
|
||||
|
||||
.extern xferd ; finish transfer - print completion message
|
||||
xferd:
|
||||
push af ; save z flag
|
||||
ld a,(beep)
|
||||
or a ; is a beep wanted?
|
||||
call nz,ilprt ; go beep ONLY IF ASKED!
|
||||
db 7,0 ; this ONLY works because 7 is a single byte
|
||||
; instruction: rlca.
|
||||
call mtprt
|
||||
dw [16 << 8] + 10
|
||||
db 'Transfer \0' ; start printout
|
||||
pop af
|
||||
ld hl,cplmsg ; assume all is well
|
||||
jr z,pxfmsg ; z => no error: go tell about it
|
||||
ld hl,ermsg ; else set up an error message
|
||||
pxfmsg: jp prtslp
|
||||
|
||||
.extern pmode
|
||||
pmode:
|
||||
pop hl
|
||||
ld (ressp),sp
|
||||
push hl
|
||||
call prompt
|
||||
db 'Mode? \0' ; how are we receiving?
|
||||
ld hl,ipbuf
|
||||
call byp ; see what first char is
|
||||
or a ; see if anything at all
|
||||
pop de
|
||||
ret z ; return to next lower level if not
|
||||
or 0x20 ; lower case
|
||||
push de
|
||||
cp 'k' ; check the 'k' of kermit
|
||||
ret
|
||||
|
||||
.dseg
|
||||
cplmsg: db 'complete\r\n\n\0'
|
||||
ermsg: db 'error\r\n\n\0'
|
||||
|
||||
|
|
@ -0,0 +1,259 @@
|
|||
; recvk.z - code to receive kermit protocol transfers
|
||||
|
||||
.incl "c:vars"
|
||||
.incl "c:kermit"
|
||||
|
||||
.extern recvk
|
||||
recvk:
|
||||
call kinit
|
||||
call initrc
|
||||
xor a
|
||||
ld (nn),a
|
||||
ld (numtry),a
|
||||
ld (ksflg),a
|
||||
ld a,(getflg)
|
||||
or a
|
||||
call nz,sndget
|
||||
ld a,'R'
|
||||
recvlp: ld (state),a
|
||||
cp 'R'
|
||||
jr nz,norr
|
||||
call rinit
|
||||
jr recvlp
|
||||
norr: cp 'F'
|
||||
jr nz,norf
|
||||
call rfile
|
||||
jr recvlp
|
||||
norf: cp 'D'
|
||||
jr nz,nord
|
||||
call rdata
|
||||
jr recvlp
|
||||
nord: xor 'C'
|
||||
ret
|
||||
|
||||
rinit:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY + 1
|
||||
jr nc,reta
|
||||
call rpack
|
||||
cp 'S'
|
||||
jr nz,noris
|
||||
ld a,(nn)
|
||||
cp c
|
||||
jr nz,retan
|
||||
call rpar
|
||||
call spar
|
||||
call pktok
|
||||
ld a,'Y'
|
||||
ld bc,(nn)
|
||||
ld de,13
|
||||
ld b,d
|
||||
call spack
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
ld (oldtry),a
|
||||
xor a
|
||||
ld (hl),a
|
||||
ld (getflg),a
|
||||
ld hl,nn
|
||||
inc (hl)
|
||||
res 6,(hl)
|
||||
ld a,(cktypq)
|
||||
ld (cktyp),a
|
||||
ld a,'F'
|
||||
ret
|
||||
noris: or a
|
||||
jr nz,norif
|
||||
call dtime
|
||||
ld a,(getflg)
|
||||
or a
|
||||
jr z,rinak
|
||||
call sndget
|
||||
jr rierr
|
||||
rinak: ld bc,(nn)
|
||||
ld de,0
|
||||
ld b,e
|
||||
ld a,'N'
|
||||
sretst: call spack
|
||||
rierr: call pkterr
|
||||
ld a,(state)
|
||||
ret
|
||||
norif: cp 'E'
|
||||
jr nz,retab
|
||||
call prerrp
|
||||
jr reta
|
||||
retan: call dnum
|
||||
jr reta
|
||||
retab: call dbadp
|
||||
jr reta
|
||||
retar: call dtries
|
||||
reta: ld a,'A'
|
||||
ret
|
||||
|
||||
rfile:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY + 1
|
||||
jr nc,reta
|
||||
call rpack
|
||||
cp 'S'
|
||||
jr nz,norfs
|
||||
ld hl,oldtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY + 1
|
||||
jr nc,retar
|
||||
ld a,(nn)
|
||||
dec a
|
||||
and 63
|
||||
cp c
|
||||
jr nz,retan
|
||||
push de
|
||||
call spar
|
||||
pop de
|
||||
ld de,13
|
||||
ld b,d
|
||||
cntsrs: xor a
|
||||
ld (numtry),a
|
||||
ld a,'Y'
|
||||
jr sretst
|
||||
norfs: cp 'Z'
|
||||
jr nz,norfz
|
||||
ld hl,oldtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY + 1
|
||||
retanc: jr nc,retar
|
||||
ld a,(nn)
|
||||
dec a
|
||||
and 63
|
||||
xor c
|
||||
jr nz,retan
|
||||
ld e,a
|
||||
ld d,a
|
||||
ld b,a
|
||||
jr cntsrs
|
||||
norfz: cp 'F'
|
||||
jr nz,norff
|
||||
ld a,(nn)
|
||||
cp c
|
||||
retanz: jr nz,retan
|
||||
ld hl,packet
|
||||
ld de,packet + 500
|
||||
ld a,(pack)
|
||||
or a
|
||||
jr z,nopkfn
|
||||
call exprp
|
||||
ld hl,packet + 500
|
||||
nopkfn: call cpmaux
|
||||
xor a
|
||||
ld (ymdmb),a
|
||||
call auxopn
|
||||
ld de,-1
|
||||
ld hl,auxfcb
|
||||
call prfile
|
||||
pokd: call pktok
|
||||
ld a,'Y'
|
||||
ld bc,(nn)
|
||||
ld de,0
|
||||
ld b,e
|
||||
call spack
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
ld (oldtry),a
|
||||
ld (hl),0
|
||||
ld hl,nn
|
||||
inc (hl)
|
||||
res 6,(hl)
|
||||
ld a,'D'
|
||||
ret
|
||||
norff: cp 'B'
|
||||
noris1: jp nz,noris
|
||||
ld a,(nn)
|
||||
xor c
|
||||
retnz1: jr nz,retanz
|
||||
call pktok
|
||||
ld a,'Y'
|
||||
ld bc,(nn)
|
||||
ld de,0
|
||||
ld b,e
|
||||
call spack
|
||||
ld a,'C'
|
||||
ret
|
||||
|
||||
rdata:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY + 1
|
||||
retnc1: jp nc,retar
|
||||
call rpack
|
||||
cp 'D'
|
||||
jr nz,nordd
|
||||
ld a,(nn)
|
||||
cp c
|
||||
jr z,dnok
|
||||
ackold: ld hl,oldtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY + 1
|
||||
jr nc,retnc1
|
||||
ld a,(nn)
|
||||
dec a
|
||||
and 63
|
||||
xor c
|
||||
retnz2: jr nz,retnz1
|
||||
ld e,a
|
||||
ld d,a
|
||||
ld b,a
|
||||
jp cntsrs
|
||||
dnok: call bufemp
|
||||
jp pokd
|
||||
nordd: cp 'F'
|
||||
jr z,ackold
|
||||
cp 'Z'
|
||||
jr nz,noris1
|
||||
ld a,(nn)
|
||||
cp c
|
||||
jr nz,retnz2
|
||||
call flshw2
|
||||
ld de,auxfcb
|
||||
ld c,close
|
||||
call usrbds
|
||||
call pktok
|
||||
ld hl,nn
|
||||
ld c,(hl)
|
||||
inc (hl)
|
||||
res 6,(hl)
|
||||
ld de,0
|
||||
ld b,e
|
||||
ld a,'Y'
|
||||
call spack
|
||||
ld a,'F'
|
||||
ret
|
||||
|
||||
sndget: ld bc,(getnam)
|
||||
ressg: ld hl,packet
|
||||
ld de,0xff
|
||||
sgelp: ld a,(bc)
|
||||
inc bc
|
||||
ld (hl),a
|
||||
cp ':'
|
||||
jr z,ressg
|
||||
cp MYQUOTE
|
||||
jr nz,noquot
|
||||
inc hl
|
||||
inc e
|
||||
ld (hl),a
|
||||
noquot: inc hl
|
||||
inc e
|
||||
or a
|
||||
jr nz,sgelp
|
||||
ld b,d
|
||||
ld c,d
|
||||
ld a,'R'
|
||||
jp spack
|
||||
|
||||
|
|
@ -0,0 +1,359 @@
|
|||
; recvx.z - receive a file via xmodem protocol
|
||||
|
||||
.incl "c:vars"
|
||||
.incl "c:xmodem"
|
||||
|
||||
.extern xrfile
|
||||
xrfile:
|
||||
xor a
|
||||
ld (batch),a
|
||||
ld (ymdmb),a
|
||||
ld (fatal),a
|
||||
ld (errors),a
|
||||
ld (crcerc),a
|
||||
ld (errorf),a
|
||||
ld (openfl),a
|
||||
ld (secip),a
|
||||
ld (eotc),a
|
||||
ld h,a
|
||||
ld l,a
|
||||
ld (sectnm),hl
|
||||
ld (sntsec),hl
|
||||
ld l,128
|
||||
ld (bufsiz),hl
|
||||
call snint
|
||||
jr mainlp
|
||||
sndnk1: call flsnak
|
||||
mainlp: xor a
|
||||
ld (errorf),a
|
||||
reget: call gettc3
|
||||
ld hl,eotc
|
||||
jr c,nmoneh
|
||||
cp EOT
|
||||
jp z,soheot
|
||||
ld (hl),0
|
||||
cp CAN
|
||||
jr z,sohcan
|
||||
cp STX
|
||||
jr z,sohsh1
|
||||
cp SOH
|
||||
sohsh1: jp z,sohsoh
|
||||
cp ACK
|
||||
jr nz,reget
|
||||
sohack: ld hl,(sntsec)
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,reget
|
||||
ld (chksum),a
|
||||
ld de,auxfcb + 2
|
||||
ld b,NAMSIZ
|
||||
acknlp: ld a,4
|
||||
call gettcp
|
||||
jr c,nmonec
|
||||
cp CAN
|
||||
jr nz,nonmcn
|
||||
sohcan: call chkcan
|
||||
ret z
|
||||
nmonec: jp ckserr
|
||||
nmoneh: ld a,(hl)
|
||||
or a
|
||||
jp nz,ackeot
|
||||
jr nmonec
|
||||
nonmcn: cp EOT
|
||||
jr nz,nonmet
|
||||
ld hl,auxfcb + 2
|
||||
sbc hl,de
|
||||
ld a,l
|
||||
ret z
|
||||
ld a,BADNAM
|
||||
nonmet: cp BADNAM
|
||||
jr z,nmonec
|
||||
nmsavc: ld (de),a
|
||||
inc de
|
||||
ld hl,chksum
|
||||
add a,(hl)
|
||||
ld (hl),a
|
||||
ld a,ACK
|
||||
push bc
|
||||
push de
|
||||
call modopc
|
||||
pop de
|
||||
pop bc
|
||||
djnz acknlp
|
||||
call gettc3
|
||||
cp CTRLZ
|
||||
jr nz,nmonec
|
||||
ld hl,chksum
|
||||
add a,(hl)
|
||||
call modopc
|
||||
call gettc3
|
||||
cp ACK
|
||||
jr nz,nmonec
|
||||
ld hl,(newusr)
|
||||
ld (auxfcb),hl
|
||||
ld hl,auxfcb + 13
|
||||
ld de,auxfcb + 14
|
||||
ld bc,20
|
||||
ld (hl),b
|
||||
ldir
|
||||
call auxopn
|
||||
ld (batch),a
|
||||
ld (openfl),a
|
||||
call pktok
|
||||
jp setb
|
||||
sohsoh: ld hl,128
|
||||
cp SOH
|
||||
jr z,gotbsz
|
||||
ld hl,1024
|
||||
gotbsz: ld (bufsiz),hl
|
||||
ld hl,(sntsec)
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,noinit
|
||||
ld (errors),a
|
||||
noinit: call gettc3
|
||||
push af
|
||||
call gettc3
|
||||
pop bc
|
||||
ld c,a
|
||||
add a,b
|
||||
inc a
|
||||
jp nz,snerr
|
||||
ld a,(sectnm)
|
||||
inc a
|
||||
xor b
|
||||
jr nz,pnerr
|
||||
inc a
|
||||
ld (secip),a
|
||||
call redsec
|
||||
jp c,ckerr
|
||||
call pktok
|
||||
xor a
|
||||
ld (errors),a
|
||||
ld a,(bufsiz + 1)
|
||||
or a
|
||||
ld de,1
|
||||
jr z,updrsc
|
||||
ld e,8
|
||||
updrsc: ld hl,(sntsec)
|
||||
add hl,de
|
||||
ld (sntsec),hl
|
||||
ld hl,sectnm
|
||||
inc (hl)
|
||||
dec hl ; i.e. ld hl,openfl
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr nz,isopen
|
||||
inc (hl)
|
||||
ld bc,13
|
||||
call xferaz
|
||||
ld de,auxfcb + 2
|
||||
ld a,(de)
|
||||
cp ' '
|
||||
jr nz,isaux
|
||||
ld hl,genfn
|
||||
ld bc,11
|
||||
ldir
|
||||
isaux: call auxopn
|
||||
jr isopen
|
||||
opener: call can3
|
||||
xor a
|
||||
ret
|
||||
isopen: ld hl,(bufsiz)
|
||||
ld de,xbuff
|
||||
wrtlp: ld a,(de)
|
||||
push de
|
||||
push hl
|
||||
call putw2c
|
||||
pop hl
|
||||
pop de
|
||||
inc de
|
||||
dec hl
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,wrtlp
|
||||
sndack: ld a,ACK
|
||||
call modopc
|
||||
jp mainlp
|
||||
pnerr: ld hl,(sntsec)
|
||||
ld a,h
|
||||
or l
|
||||
or b
|
||||
jr z,ymname
|
||||
ld a,(sectnm)
|
||||
cp b
|
||||
jr nz,numbad
|
||||
call diag
|
||||
db 'Duplicate sector flushed\0'
|
||||
flsdup: call gettc3
|
||||
jr nc,flsdup
|
||||
jr sndack
|
||||
numbad: call dnum
|
||||
ld a,1
|
||||
ld (fatal),a
|
||||
call can3
|
||||
jr ckserr
|
||||
ymname: call redsec
|
||||
jr c,ckerr
|
||||
call pktok
|
||||
ld a,(xbuff)
|
||||
or a
|
||||
jr nz,isynam
|
||||
ld a,ACK
|
||||
call modopc
|
||||
xor a
|
||||
ret
|
||||
isynam: ld (ymdmb),a
|
||||
ld hl,xbuff
|
||||
call cpmaux
|
||||
call auxopn
|
||||
ld a,ACK
|
||||
ld (batch),a
|
||||
ld (openfl),a
|
||||
call modopc
|
||||
ld b,20
|
||||
waitjn: push bc
|
||||
call tenth
|
||||
pop bc
|
||||
djnz waitjn
|
||||
jr setb
|
||||
snerr: call dnum
|
||||
ckserr: ld hl,errorf
|
||||
inc (hl)
|
||||
ckerr: call pkterr
|
||||
ld hl,errors
|
||||
inc (hl)
|
||||
ld hl,(sntsec)
|
||||
ld a,(secip)
|
||||
or h
|
||||
or l
|
||||
jr z,setb
|
||||
ld a,(errorf)
|
||||
or a
|
||||
jr z,noerr
|
||||
ld a,(fatal)
|
||||
or a
|
||||
jp nz,killit
|
||||
quiet: call gettc3
|
||||
jr nc,quiet
|
||||
jr sndnak
|
||||
setb: ld hl,errors
|
||||
ld a,(hl)
|
||||
xor CRCSW
|
||||
jr nz,crcnak
|
||||
ld (hl),a
|
||||
inc hl
|
||||
inc (hl)
|
||||
ld a,(hl)
|
||||
xor 4
|
||||
jp z,killit
|
||||
inc hl
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr z,setcrc
|
||||
ld (hl),0
|
||||
call diag
|
||||
db 'Switching to checksum\0'
|
||||
jr crcnak
|
||||
setcrc: inc (hl)
|
||||
call diag
|
||||
db 'Switching to CRC\0'
|
||||
crcnak: call snint
|
||||
jr noerr
|
||||
sndnak: call flsnak
|
||||
noerr: ld a,(errors)
|
||||
cp ERRMAX
|
||||
jp c,mainlp
|
||||
killit: call can3
|
||||
xor a
|
||||
ret
|
||||
soheot: ld a,1
|
||||
call gettoc
|
||||
jr c,eotok
|
||||
call diag
|
||||
db 'EOT followed by character - ignored\0'
|
||||
jp ckserr
|
||||
eotok: ld hl,eotc
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr nz,ackeot
|
||||
inc (hl)
|
||||
ld a,(errors)
|
||||
cp ERRMAX
|
||||
jr nc,killit
|
||||
jp sndnk1
|
||||
ackeot: call flshw2
|
||||
ld de,auxfcb
|
||||
ld c,close
|
||||
call usrbds
|
||||
ld a,ACK
|
||||
call modopc
|
||||
ld a,(batch)
|
||||
or a
|
||||
ret
|
||||
|
||||
redsec: ld hl,0
|
||||
ld (chksum),hl
|
||||
ld hl,(bufsiz)
|
||||
ld de,xbuff
|
||||
rblp: push hl
|
||||
push de
|
||||
call gettc3
|
||||
pop de
|
||||
jr nc,nordto
|
||||
pop hl
|
||||
rdtime: call dtime
|
||||
seterr: ld hl,errorf
|
||||
inc (hl)
|
||||
scf
|
||||
ret
|
||||
nordto: ld (de),a
|
||||
ld a,(crcmod)
|
||||
or a
|
||||
ld a,(de)
|
||||
jr z,updcsm
|
||||
push de
|
||||
call updcrc
|
||||
pop de
|
||||
jr mvptr
|
||||
updcsm: ld hl,chksum
|
||||
add a,(hl)
|
||||
ld (hl),a
|
||||
mvptr: pop hl
|
||||
inc de
|
||||
dec hl
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,rblp
|
||||
ld a,(crcmod)
|
||||
or a
|
||||
call nz,gettc3
|
||||
jr c,rdtime
|
||||
ld d,a
|
||||
push af
|
||||
call gettc3
|
||||
pop de
|
||||
jr c,rdtime
|
||||
ld e,a
|
||||
ld hl,(chksum)
|
||||
xor a
|
||||
sbc hl,de
|
||||
ret z
|
||||
ld a,(crcmod)
|
||||
or a
|
||||
jr nz,badcrc
|
||||
call dcheck
|
||||
jr seterr
|
||||
badcrc: call dcrc
|
||||
jr seterr
|
||||
|
||||
snint: ld a,(crcmod)
|
||||
or a
|
||||
ld a,CRCCHR
|
||||
jr nz,sendnc
|
||||
flsnak: ld a,NAK
|
||||
push af
|
||||
call flsrng
|
||||
pop af
|
||||
sendnc: jp modopc
|
||||
|
||||
|
|
@ -0,0 +1,84 @@
|
|||
; send.z - protocol send code for qterm
|
||||
|
||||
.var ipbuf 0x80
|
||||
|
||||
.extern send
|
||||
send:
|
||||
call pmode
|
||||
inc hl
|
||||
jr z,modokk
|
||||
cp 'x'
|
||||
jr z,modok ; k & x are the only legal modes (for now)
|
||||
|
||||
.extern moderr
|
||||
moderr:
|
||||
call ilprt
|
||||
db 'Unknown mode\r\n\0'
|
||||
ret
|
||||
|
||||
modokk:
|
||||
ld a,(hl)
|
||||
or 0x20
|
||||
cp 'f'
|
||||
jr z,arefil
|
||||
cp 'l'
|
||||
jr z,arefil
|
||||
xor a
|
||||
modok: push hl ; save pointer
|
||||
push af ; and mode character
|
||||
call unbyp ; step over flags
|
||||
call scnswl ; parse names
|
||||
ld hl,(fnbspt)
|
||||
ld de,work
|
||||
pop af
|
||||
sbc hl,de
|
||||
pop hl
|
||||
jr nz,arefil ; any files found?
|
||||
call ilprt ; tell if not
|
||||
db 'No files to send\r\n\0'
|
||||
ret
|
||||
arefil: ex af,af'
|
||||
ld a,(xfersz) ; get proposed transfer size
|
||||
ld e,4
|
||||
sizlp: sla e ; shift size around in e
|
||||
rra
|
||||
jr nc,sizlp ; loop till we hit a bit
|
||||
ld a,e
|
||||
ld (btxf),a ; and save it away
|
||||
ex af,af'
|
||||
cp 'x' ; Kermit or Xmodem
|
||||
jr z,sendx
|
||||
call sendk ; send kermit
|
||||
jr xferdj ; and unwrap
|
||||
sendx: call xmflgs ; parse xmodem flags
|
||||
call initx
|
||||
call initsn ; set up screen
|
||||
ld hl,(mdm7b)
|
||||
ld a,h
|
||||
or l ; batch send?
|
||||
jr z,nosb ; no - just send one file
|
||||
ld a,(longpk)
|
||||
ld (olp),a ; save 1K packet flag
|
||||
sblp: call srnxt
|
||||
jr z,doneb ; loop till all names done
|
||||
call xsfile ; send a file
|
||||
jr nz,xferdj ; terminate on an error
|
||||
ld a,(olp)
|
||||
ld (longpk),a ; reset 1K packet flag
|
||||
jr sblp
|
||||
doneb: xor a
|
||||
ld (auxfcb + 2),a ; set flag for end of transfer
|
||||
jr xjsf
|
||||
nosb: call srnxt ; single file send - get it
|
||||
jr nz,xjsf ; send it if it exists
|
||||
call can3 ; kill the far end
|
||||
xor a
|
||||
inc a
|
||||
jr xferdj ; and return error
|
||||
xjsf: call xsfile ; send single file or batch close
|
||||
xferdj: push af
|
||||
ld a,(obtxf)
|
||||
ld (btxf),a ; reset transfer size to whatever
|
||||
pop af
|
||||
jp xferd
|
||||
|
||||
|
|
@ -0,0 +1,262 @@
|
|||
; sendk.z - kermit send xfer code
|
||||
|
||||
.incl "c:vars"
|
||||
.incl "c:kermit"
|
||||
|
||||
.extern sendk
|
||||
sendk:
|
||||
call kinit
|
||||
call initsn
|
||||
ld a,(sercmd)
|
||||
or a
|
||||
ld l,'G'
|
||||
jr nz,sendit
|
||||
call srnxt
|
||||
ret z
|
||||
ld l,'S'
|
||||
sendit: xor a
|
||||
ld (nn),a
|
||||
ld (numtry),a
|
||||
ld a,l
|
||||
ld (ksflg),a
|
||||
sndklp: ld (state),a
|
||||
cp 'S'
|
||||
jr nz,nosini
|
||||
call sinit
|
||||
jr sndklp
|
||||
nosini: cp 'F'
|
||||
jr nz,nosfil
|
||||
call sfile
|
||||
jr sndklp
|
||||
nosfil: cp 'D'
|
||||
jr nz,nosdat
|
||||
call sdata
|
||||
jr sndklp
|
||||
nosdat: cp 'Z'
|
||||
jr nz,noseof
|
||||
call seof
|
||||
jr sndklp
|
||||
noseof: cp 'B'
|
||||
jr nz,nosbrk
|
||||
call sbreak
|
||||
jr sndklp
|
||||
nosbrk: cp 'G'
|
||||
jr nz,nossrv
|
||||
call sserve
|
||||
jr sndklp
|
||||
nossrv: xor 'C'
|
||||
ret
|
||||
|
||||
sinit:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY
|
||||
ld a,'A'
|
||||
ret nc
|
||||
call spar
|
||||
call flsrng
|
||||
ld a,'S'
|
||||
ld bc,(nn) ; packet number
|
||||
ld de,13 ; size
|
||||
ld b,d ; b == 0 => not extended
|
||||
call spack
|
||||
call rpack
|
||||
ld b,a
|
||||
cp 'N'
|
||||
jr nz,nosin
|
||||
retstt: ld a,b
|
||||
or a
|
||||
jr z,perr
|
||||
cp 'N'
|
||||
jr nz,pbn
|
||||
call dnak
|
||||
jr perr
|
||||
pbn: call dnum
|
||||
perr: call pkterr
|
||||
ld a,(state)
|
||||
ret
|
||||
nosin: or a
|
||||
jr z,perr
|
||||
cp 'E'
|
||||
jr nz,nosie
|
||||
call prerrp
|
||||
jr sreta1
|
||||
sireta: call dbadp
|
||||
sreta1: ld a,'A'
|
||||
ret
|
||||
nosie: cp 'Y'
|
||||
jr nz,sireta
|
||||
ld a,(nn)
|
||||
cp c
|
||||
jr nz,retstt
|
||||
ipakok: call rpar
|
||||
xor a
|
||||
ld (numtry),a
|
||||
ld hl,nn
|
||||
inc (hl)
|
||||
res 6,(hl)
|
||||
call pktok
|
||||
ld a,(cktypq)
|
||||
ld (cktyp),a
|
||||
ld a,'F'
|
||||
ret
|
||||
|
||||
sfile:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY
|
||||
ld a,'A'
|
||||
ret nc
|
||||
call kresgp
|
||||
ld de,auxfcb + 2
|
||||
ld hl,packet
|
||||
ld b,8
|
||||
call scnfil
|
||||
ld a,(de)
|
||||
and 0x7f
|
||||
cp ' '
|
||||
jr z,noext
|
||||
ld (hl),'.'
|
||||
inc hl
|
||||
ld b,3
|
||||
call scnfil
|
||||
noext: ld (hl),b
|
||||
ld de,packet
|
||||
sbc hl,de
|
||||
ld bc,(nn)
|
||||
ld e,l
|
||||
ld d,0
|
||||
ld b,d
|
||||
ld a,'F'
|
||||
finsf: call spack
|
||||
call rpack
|
||||
ld b,a
|
||||
cp 'N'
|
||||
jr nz,nosfn
|
||||
dec c
|
||||
res 7,c
|
||||
res 6,c
|
||||
ld a,'Y'
|
||||
nosfn: cp 'Y'
|
||||
jp nz,nosin
|
||||
ld a,(nn)
|
||||
xor c
|
||||
jp nz,retstt
|
||||
ld (numtry),a
|
||||
ld a,c
|
||||
inc a
|
||||
and 63
|
||||
ld (nn),a
|
||||
call pktok
|
||||
call bufill
|
||||
ld (size),bc
|
||||
inc a
|
||||
ld a,'Z'
|
||||
ret z
|
||||
ld a,'D'
|
||||
ret
|
||||
|
||||
sdata:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY
|
||||
ld a,'A'
|
||||
ret nc
|
||||
ld de,(size)
|
||||
ld bc,(nn)
|
||||
ld b,1
|
||||
ld a,e
|
||||
cp MAXPSIZ
|
||||
ld a,'D'
|
||||
jr nc,finsf
|
||||
ld b,d
|
||||
jr finsf
|
||||
|
||||
seof:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY
|
||||
ld a,'A'
|
||||
ret nc
|
||||
ld a,'Z'
|
||||
ld bc,(nn)
|
||||
ld de,0
|
||||
ld b,e
|
||||
call spack
|
||||
call rpack
|
||||
ld b,a
|
||||
cp 'N'
|
||||
jr nz,nosen
|
||||
dec c
|
||||
res 7,c
|
||||
res 6,c
|
||||
ld a,'Y'
|
||||
nosen: cp 'Y'
|
||||
jp nz,nosin
|
||||
ld a,(nn)
|
||||
xor c
|
||||
jp nz,retstt
|
||||
ld (numtry),a
|
||||
ld a,c
|
||||
inc a
|
||||
and 63
|
||||
ld (nn),a
|
||||
call pktok
|
||||
call srnxt
|
||||
ld a,'F'
|
||||
ret nz
|
||||
ld a,'B'
|
||||
ret
|
||||
|
||||
sbreak:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY
|
||||
ld a,'A'
|
||||
ret nc
|
||||
ld a,'B'
|
||||
ld de,0
|
||||
finsb: ld bc,(nn)
|
||||
ld b,d
|
||||
call spack
|
||||
call rpack
|
||||
ld b,a
|
||||
cp 'N'
|
||||
jr nz,nosbn
|
||||
dec c
|
||||
res 7,c
|
||||
res 6,c
|
||||
ld a,'Y'
|
||||
nosbn: cp 'Y'
|
||||
jp nz,nosin
|
||||
ld a,(nn)
|
||||
xor c
|
||||
jp nz,retstt
|
||||
ld (numtry),a
|
||||
ld a,c
|
||||
inc a
|
||||
and 63
|
||||
ld (nn),a
|
||||
call pktok
|
||||
ld a,'C'
|
||||
ret
|
||||
|
||||
sserve:
|
||||
ld hl,numtry
|
||||
ld a,(hl)
|
||||
inc (hl)
|
||||
cp MAXTRY
|
||||
ld a,'A'
|
||||
ret nc
|
||||
ld a,(sercmd)
|
||||
and 0x5f
|
||||
ld (packet),a
|
||||
ld a,'G'
|
||||
ld de,1
|
||||
jr finsb
|
||||
|
||||
|
|
@ -0,0 +1,402 @@
|
|||
; sendx.z - file send using xmodem protocol
|
||||
|
||||
.incl "c:vars"
|
||||
.incl "c:xmodem"
|
||||
|
||||
.extern xsfile
|
||||
xsfile:
|
||||
xor a
|
||||
ld (closeo),a
|
||||
ld (attmps),a
|
||||
ld a,(auxfcb + 2)
|
||||
or a
|
||||
jr nz,noclos
|
||||
inc a
|
||||
ld (closeo),a
|
||||
jr sbufsz
|
||||
noclos: ld de,auxfcb
|
||||
ld c,cfsize
|
||||
call usrbds
|
||||
ld hl,(auxfcb + 34)
|
||||
ld (expsec),hl
|
||||
sbufsz: ld a,(longpk)
|
||||
or a
|
||||
ld hl,128
|
||||
jr z,gotbsz
|
||||
ld hl,1024
|
||||
gotbsz: ld (bufsiz),hl
|
||||
waitsu: ld a,30
|
||||
call gettoc
|
||||
cp 'K'
|
||||
jr z,waitsu
|
||||
cp CAN
|
||||
jr z,sucan
|
||||
cp CRCCHR
|
||||
jr z,sucrcn
|
||||
xor NAK
|
||||
jr z,sucrcn
|
||||
ld hl,attmps
|
||||
inc (hl)
|
||||
ld a,(hl)
|
||||
cp NAKMAX
|
||||
jr c,waitsu
|
||||
call rnresp
|
||||
jr m7err
|
||||
sucan: call chkcan
|
||||
jr nz,waitsu
|
||||
jr m7err
|
||||
sucrcn: ld (crcmod),a
|
||||
ld a,(mdm7b)
|
||||
or a
|
||||
jp z,nom7
|
||||
ld a,(closeo)
|
||||
or a
|
||||
jr z,nom7c
|
||||
ld a,ACK
|
||||
call modopc
|
||||
ld a,EOT
|
||||
call modopc
|
||||
xor a
|
||||
ret
|
||||
nom7c: ld (attmps),a
|
||||
call sndnam
|
||||
jr nc,m7nmok
|
||||
call pkterr
|
||||
ld a,(attmps)
|
||||
inc a
|
||||
cp RETRMX
|
||||
jr c,nom7c
|
||||
call diag
|
||||
db 'MODEM7 batch filename error\0'
|
||||
m7errc: call can3
|
||||
m7err: xor a
|
||||
inc a
|
||||
ret
|
||||
m7nmok: call pktok
|
||||
wack: ld a,5
|
||||
call gettoc
|
||||
cp 'K'
|
||||
jr z,wack
|
||||
cp CRCCHR
|
||||
jr z,setm7c
|
||||
xor NAK
|
||||
jr z,setm7c
|
||||
call diag
|
||||
db 'MODEM7 error: NAK/C expected\0'
|
||||
jr m7errc
|
||||
setm7c: ld (crcmod),a
|
||||
nom7: ld hl,1
|
||||
ld (sectnm),hl
|
||||
ld a,(ymdmb)
|
||||
or a
|
||||
jr z,noymf
|
||||
ld hl,128
|
||||
ld (bufsiz),hl
|
||||
ld l,h
|
||||
ld (sectnm),hl
|
||||
noymf: xor a
|
||||
ld (errors),a
|
||||
ld h,a
|
||||
ld l,a
|
||||
ld (sntsec),hl
|
||||
packlp: xor a
|
||||
ld (attmps),a
|
||||
ld a,(ymdmb)
|
||||
or a
|
||||
jr z,noym
|
||||
ld hl,(sectnm)
|
||||
dec hl
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,noym
|
||||
ld a,(closeo)
|
||||
or a
|
||||
jr z,noymc
|
||||
xor a
|
||||
ret
|
||||
noymc: ld a,(longpk)
|
||||
or a
|
||||
jr z,getyfs
|
||||
ld h,1024 >> 8
|
||||
ld (bufsiz),hl
|
||||
getyfs: call gettc3
|
||||
cp CAN
|
||||
jr z,yfscan
|
||||
cp 'K'
|
||||
jr z,getyfs
|
||||
cp CRCCHR
|
||||
jr z,yfscrc
|
||||
ld hl,attmps
|
||||
inc (hl)
|
||||
ld a,(hl)
|
||||
cp NAKMAX
|
||||
jr c,getyfs
|
||||
call diag
|
||||
db 'YMODEM error: C expected\0'
|
||||
yfserc: call can3
|
||||
yfserr: xor a
|
||||
inc a
|
||||
ret
|
||||
yfscan: call chkcan
|
||||
jr nz,getyfs
|
||||
jr yfserr
|
||||
yfscrc: ld (crcmod),a
|
||||
xor a
|
||||
ld (attmps),a
|
||||
noym: ld a,(bufsiz 1)
|
||||
or a
|
||||
jr z,bsok
|
||||
ld a,(errors)
|
||||
cp KSWMAX
|
||||
jr nz,noksw
|
||||
call diag
|
||||
db 'Too many errors - reducing packet size\0'
|
||||
xor a
|
||||
ld (olp),a
|
||||
jr dropbs
|
||||
noksw: ld hl,(expsec)
|
||||
ld de,(sntsec)
|
||||
or a
|
||||
sbc hl,de
|
||||
jr z,bsok
|
||||
ld a,l
|
||||
and ~7
|
||||
or h
|
||||
jr nz,bsok
|
||||
call diag
|
||||
db 'End of file - reducing packet size\0'
|
||||
dropbs: ld hl,128
|
||||
ld (bufsiz),hl
|
||||
xor a
|
||||
ld (longpk),a
|
||||
bsok: ld hl,(sectnm)
|
||||
ld a,h
|
||||
or l
|
||||
jr z,ymname
|
||||
ld de,xbuff
|
||||
ld hl,(bufsiz)
|
||||
filbuf: push hl
|
||||
push de
|
||||
call getw2c
|
||||
pop de
|
||||
pop hl
|
||||
jp c,pakbrk
|
||||
ld (de),a
|
||||
inc de
|
||||
dec hl
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,filbuf
|
||||
jr xmitlp
|
||||
ymname: ld hl,xbuff
|
||||
ld de,xbuff + 1
|
||||
ld bc,127
|
||||
ld (hl),b
|
||||
ldir
|
||||
ld a,(closeo)
|
||||
or a
|
||||
jr nz,noymnm
|
||||
ld de,auxfcb + 2
|
||||
ld hl,xbuff
|
||||
ld b,8
|
||||
call scnfil
|
||||
ld a,(de)
|
||||
and 0x7f
|
||||
cp ' '
|
||||
jr z,noext
|
||||
ld (hl),'.'
|
||||
inc hl
|
||||
ld b,3
|
||||
call scnfil
|
||||
noext: ld hl,xbuff - 1
|
||||
lower: inc hl
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr z,setfs
|
||||
cp 'A'
|
||||
jr c,lower
|
||||
cp 'Z' + 1
|
||||
jr nc,lower
|
||||
set 5,(hl)
|
||||
jr lower
|
||||
setfs: ld hl,(expsec)
|
||||
ld (xbuff + 126),hl
|
||||
noymnm: xor a
|
||||
ld (attmps),a
|
||||
xmitlp: ld a,(bufsiz + 1)
|
||||
or a
|
||||
ld a,SOH
|
||||
jr z,gotsoh
|
||||
inc a
|
||||
gotsoh: call modopc
|
||||
ld a,(sectnm)
|
||||
push af
|
||||
call modopc
|
||||
pop af
|
||||
cpl
|
||||
call modopc
|
||||
ld hl,0
|
||||
ld (chksum),hl
|
||||
ld hl,(bufsiz)
|
||||
ld de,xbuff
|
||||
snddat: ld a,(de)
|
||||
push hl
|
||||
push de
|
||||
call modopc
|
||||
pop de
|
||||
ld a,(crcmod)
|
||||
or a
|
||||
ld a,(de)
|
||||
jr z,updcsm
|
||||
push de
|
||||
call updcrc
|
||||
pop de
|
||||
jr sndcnt
|
||||
updcsm: ld hl,chksum
|
||||
add a,(hl)
|
||||
ld (hl),a
|
||||
sndcnt: pop hl
|
||||
inc de
|
||||
dec hl
|
||||
ld a,h
|
||||
or l
|
||||
jr nz,snddat
|
||||
call flsrng
|
||||
ld a,(crcmod)
|
||||
or a
|
||||
ld a,(chksum + 1)
|
||||
call nz,modopc
|
||||
ld a,(chksum)
|
||||
call modopc
|
||||
ld hl,attmps
|
||||
inc (hl)
|
||||
ld a,10
|
||||
call gettoc
|
||||
jr c,timeo
|
||||
cp ACK
|
||||
jr z,respok
|
||||
cp CAN
|
||||
jr nz,nocan
|
||||
call chkcan
|
||||
jp z,m7err
|
||||
nocan: push af
|
||||
call cvtnib
|
||||
ld (char + 1),a
|
||||
pop af
|
||||
rrca
|
||||
rrca
|
||||
rrca
|
||||
rrca
|
||||
call cvtnib
|
||||
ld (char),a
|
||||
call diag
|
||||
db 'Non-ACK: 0x'
|
||||
char: db 'ZZ\0'
|
||||
jr ackerr
|
||||
timeo: call diag
|
||||
db 'Timeout\0'
|
||||
ackerr: call pkterr
|
||||
ld hl,errors
|
||||
inc (hl)
|
||||
ld a,(attmps)
|
||||
cp RETRMX
|
||||
jr nc,retrer
|
||||
ld a,(hl)
|
||||
cp ERRMAX
|
||||
jp c,xmitlp
|
||||
call diag
|
||||
db 'Too many errors\0'
|
||||
jr rtrcan
|
||||
retrer: call diag
|
||||
db 'Too many retries\0'
|
||||
rtrcan: jp m7errc
|
||||
respok: call pktok
|
||||
ld hl,(sectnm)
|
||||
inc hl
|
||||
ld (sectnm),hl
|
||||
dec hl
|
||||
ld a,h
|
||||
or l
|
||||
jr z,jppl
|
||||
ld a,(bufsiz + 1)
|
||||
ld de,8
|
||||
or a
|
||||
jr nz,updss
|
||||
ld e,1
|
||||
updss: ld hl,(sntsec)
|
||||
add hl,de
|
||||
ld (sntsec),hl
|
||||
jppl: jp packlp
|
||||
pakbrk: ld b,RETRMX
|
||||
eotlp: push bc
|
||||
ld a,EOT
|
||||
call modopc
|
||||
ld a,15
|
||||
call gettoc
|
||||
pop bc
|
||||
cp ACK
|
||||
jr z,didit
|
||||
cp NAK
|
||||
jr z,eotlp
|
||||
eotna: call diag
|
||||
db 'EOT not acked\0'
|
||||
badeot: djnz eotlp
|
||||
call rnresp
|
||||
xor a
|
||||
inc a
|
||||
ret
|
||||
didit: xor a
|
||||
ret
|
||||
|
||||
.extern sndnam
|
||||
sndnam:
|
||||
ld hl,auxfcb + 2
|
||||
ld de,auxlin
|
||||
push de
|
||||
ld bc,11
|
||||
ldir
|
||||
pop hl
|
||||
ld bc,11 << 8
|
||||
ld a,ACK
|
||||
call moppsh
|
||||
snlp: call mopahl
|
||||
cknak: ld a,6
|
||||
call gettcp
|
||||
cp CAN
|
||||
jr nz,nocan1
|
||||
ld a,3
|
||||
call gettcp
|
||||
cp CAN
|
||||
jr nz,cknak
|
||||
scf
|
||||
ret
|
||||
nocan1: cp ACK
|
||||
jr nz,badnam
|
||||
acknam: inc hl
|
||||
djnz snlp
|
||||
ld (hl),0x1a
|
||||
call mopahl
|
||||
ld a,10
|
||||
call gettcp
|
||||
cp c
|
||||
jr nz,badnam
|
||||
ld a,ACK
|
||||
call modopc
|
||||
or a
|
||||
ret
|
||||
badnam: ld a,BADNAM
|
||||
call modopc
|
||||
scf
|
||||
ret
|
||||
|
||||
mopahl: ld a,(hl)
|
||||
add a,c
|
||||
ld c,a
|
||||
ld a,(hl)
|
||||
moppsh: push bc
|
||||
push hl
|
||||
call modopc
|
||||
pop hl
|
||||
pop bc
|
||||
ret
|
||||
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
; shrink.z - buffers and pointers that get small for a "shrunk" QTERM
|
||||
|
||||
.var memtop 6
|
||||
|
||||
.extern setshr
|
||||
setshr:
|
||||
ld hl,(memtop)
|
||||
ld de,work2 + 16384 + 1024
|
||||
or a
|
||||
sbc hl,de
|
||||
ex de,hl
|
||||
ld hl,xfersz
|
||||
set 3,(hl)
|
||||
ret nc
|
||||
set 2,(hl)
|
||||
ld hl,work2 + 4096
|
||||
ld (cbuff),hl
|
||||
ld hl,work2 + 8192
|
||||
ld (endcbf),hl
|
||||
ld hl,4095
|
||||
ld (cbfsiz),hl
|
||||
ld a,4096 / 128
|
||||
ld (btxf),a
|
||||
ld (obtxf),a
|
||||
ld hl,8192
|
||||
add hl,de
|
||||
ret c
|
||||
call ilprt
|
||||
db 'Insufficient memory\r\n\0'
|
||||
rst 0
|
||||
|
||||
.dseg
|
||||
.extern cbuff
|
||||
cbuff: dw work2 + 8192
|
||||
.extern endcbf
|
||||
endcbf: dw work2 + 16384
|
||||
.extern cbfsiz
|
||||
cbfsiz: dw 8191
|
||||
.extern btxf
|
||||
btxf: db 8192 / 128
|
||||
.extern obtxf
|
||||
obtxf: db 8192 / 128
|
||||
|
||||
.useg
|
||||
.extern work2
|
||||
work2:
|
||||
ds 16384 ; so that #end in the .SYM file is right
|
||||
|
||||
|
|
@ -0,0 +1,226 @@
|
|||
; srscrn.z - screen routines for displaying status of a transfer
|
||||
|
||||
.incl "c:termcap"
|
||||
|
||||
.extern initsc ; initialise everything
|
||||
initsc:
|
||||
push hl
|
||||
ld hl,0
|
||||
ld (packet),hl
|
||||
ld (terr),hl
|
||||
ld (perr),hl ; clear the variables
|
||||
call clear ; and the screen
|
||||
ld hl,30
|
||||
call moveto ; set up for the title
|
||||
pop hl
|
||||
call prtslp ; print protocol type
|
||||
ld hl,m1
|
||||
.dseg
|
||||
m1: db ' File Transfer\0'
|
||||
.cseg
|
||||
call prtslp ; finish title
|
||||
call mtprt
|
||||
dw [5 << 8] + 10
|
||||
db 'Packet:\0'
|
||||
call mtprt
|
||||
dw [5 << 8] + 26
|
||||
db '0\0'
|
||||
call mtprt
|
||||
dw [7 << 8] + 10
|
||||
db 'Packet Errors: 0\0'
|
||||
call mtprt
|
||||
dw [9 << 8] + 10
|
||||
db 'Total Errors: 0\0'
|
||||
ret ; print rest of screen background
|
||||
|
||||
.extern initsn ; finish setting up screen for send
|
||||
initsn:
|
||||
call mtprt
|
||||
dw [3 << 8] + 10
|
||||
db 'Sending:\0' ; direction for where filename goes
|
||||
call mtprt
|
||||
dw [11 << 8] + 10
|
||||
db 'Sent:\0' ; set up for K transferred printout
|
||||
ret
|
||||
|
||||
.extern initrc ; finish setting up screen for receive
|
||||
initrc:
|
||||
call mtprt
|
||||
dw [3 << 8] + 10
|
||||
db 'Receiving:\0' ; direction for where filename goes
|
||||
call mtprt
|
||||
dw [11 << 8] + 10
|
||||
db 'Received:\0' ; and for K transferred
|
||||
ret
|
||||
|
||||
.extern pktok ; register a good packet
|
||||
pktok:
|
||||
ld hl,kcnt ; point at k count flag
|
||||
ld a,(hl) ; get value
|
||||
or a
|
||||
jr z,nokprt ; not set, so don't print
|
||||
dec (hl) ; clear flag
|
||||
call one_k ; and print a K
|
||||
nokprt: ld hl,dcnt ; look at count till we need clear
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr z,nocdg ; no clear needed - bypass
|
||||
dec (hl)
|
||||
jr nz,nocdg ; not yet ..... skip it
|
||||
call diag
|
||||
db 0 ; OK there goes the message
|
||||
xor a
|
||||
ld (dcnt),a ; and reset dcnt back to zero
|
||||
nocdg: ld hl,(perr)
|
||||
ld a,h
|
||||
or l
|
||||
jr z,ncperr
|
||||
call mtprt
|
||||
dw [7 << 8] + 26
|
||||
db '0 \0' ; reset packet error count on screen
|
||||
ld hl,0
|
||||
ld (perr),hl ; and in memory
|
||||
ncperr: ld a,(qcount)
|
||||
or a
|
||||
ret nz
|
||||
ld hl,[5 << 8] + 26
|
||||
call moveto ; moveto where packet number goes
|
||||
ld hl,(packet)
|
||||
inc hl
|
||||
ld (packet),hl ; bump
|
||||
jp decout ; and print
|
||||
|
||||
.extern pkterr ; register a bad packet
|
||||
pkterr:
|
||||
ld hl,[7 << 8] + 26
|
||||
call moveto
|
||||
ld hl,(perr)
|
||||
inc hl
|
||||
ld (perr),hl ; bump and print packet errors
|
||||
call decout
|
||||
ld hl,[9 << 8] + 26
|
||||
call moveto
|
||||
ld hl,(terr)
|
||||
inc hl
|
||||
ld (terr),hl ; same for total errors
|
||||
jp decout
|
||||
|
||||
.extern prfile ; print the filename from auxfcb
|
||||
prfile:
|
||||
push hl
|
||||
ld a,d
|
||||
and e
|
||||
inc a ; check if there's a real size
|
||||
jr z,noprte ; skip if not - this is receive
|
||||
push de
|
||||
call mtprt
|
||||
dw [11 << 8] + 34
|
||||
db 'out of \0' ; and file size print
|
||||
pop hl
|
||||
call decout ; and print it
|
||||
ld hl,m2
|
||||
call prtslp ; and the 'K'
|
||||
noprte: ld hl,0
|
||||
ld (kxfer),hl ; reset count of K transferred
|
||||
call mtprt
|
||||
dw [11 << 8] + 26
|
||||
db '0' ; and print 0K to start things
|
||||
m2: db 'K \0'
|
||||
ld hl,[3 << 8] + 26
|
||||
call moveto ; move to where filename gets printed
|
||||
pop hl ; get fcb address to hl
|
||||
call prtfl ; print the filename
|
||||
ld b,14 ; 14 chars to nuke anything left over
|
||||
jr cleol
|
||||
|
||||
.extern prtfl
|
||||
prtfl:
|
||||
ld c,(hl) ; get user number to c
|
||||
inc hl
|
||||
ld a,(hl) ; get drive code
|
||||
inc hl ; point at first char of name
|
||||
push hl ; save fcb address
|
||||
push bc ; save user number
|
||||
add a,'@' ; convert to a letter
|
||||
ld c,a
|
||||
call scrout ; and print it
|
||||
pop hl ; user number back to l
|
||||
call decob ; and print it
|
||||
ld c,':'
|
||||
call scrout ; add a ':'
|
||||
pop hl
|
||||
nodrv: ld b,8
|
||||
call pfilnm ; print the name portion
|
||||
ld a,(hl)
|
||||
cp ' ' ; check for an extension
|
||||
ret z ; no - all done
|
||||
push hl
|
||||
ld c,'.'
|
||||
call scrout ; print a '.'
|
||||
pop hl
|
||||
ld b,3
|
||||
|
||||
pfilnm: ld a,(hl) ; get a char from fcb
|
||||
inc hl
|
||||
push hl
|
||||
push bc
|
||||
and 0x7f ; ditch attribute bit
|
||||
cp ' ' ; is it printable?
|
||||
ld c,a
|
||||
call nz,scrout ; print if so
|
||||
pop bc
|
||||
pop hl
|
||||
djnz pfilnm ; loop till all done
|
||||
ret
|
||||
|
||||
.extern diag
|
||||
diag:
|
||||
ld a,3
|
||||
ld (dcnt),a ; set so that 3 packets later we'll clear
|
||||
ld hl,[14 << 8] + 10
|
||||
call moveto ; move to where messages go
|
||||
pop hl ; string address to hl
|
||||
push hl ; back on stack
|
||||
call prtslp ; print it
|
||||
pop de ; restore start to de
|
||||
push hl ; save end
|
||||
or a
|
||||
sbc hl,de ; get length
|
||||
ld a,50
|
||||
sub l ; get 50 - length
|
||||
ld b,a ; to b
|
||||
cleol: ld a,(tcbits)
|
||||
and b_cleol ; clear to eol possible
|
||||
jp z,cleol ; do it if so
|
||||
ld c,' ' ; put a space in c
|
||||
cleolp: push bc
|
||||
call scrout ; and print it
|
||||
pop bc
|
||||
djnz cleolp ; till count runs out
|
||||
ret
|
||||
|
||||
.extern one_k
|
||||
one_k:
|
||||
ld a,(qcount)
|
||||
or a
|
||||
ret nz
|
||||
ld hl,[11 << 8] + 26
|
||||
call moveto ; move to where K printout goes
|
||||
ld hl,(kxfer)
|
||||
inc hl
|
||||
ld (kxfer),hl ; add one to count
|
||||
call decout ; print the number
|
||||
ld c,'K'
|
||||
jp scrout ; and add a 'K'
|
||||
|
||||
.dseg
|
||||
.extern kcnt
|
||||
kcnt: db 0
|
||||
|
||||
.useg
|
||||
dcnt: ds 1
|
||||
packet: ds 2
|
||||
terr: ds 2
|
||||
perr: ds 2
|
||||
kxfer: ds 2
|
||||
|
||||
|
|
@ -0,0 +1,468 @@
|
|||
; 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
|
||||
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
; termcap.i - bit values for telling which terminal capabilities are present
|
||||
|
||||
.var b_brite 1
|
||||
.var b_dim 2
|
||||
.var b_delln 4
|
||||
.var b_insln 8
|
||||
.var b_delch 16
|
||||
.var b_insch 32
|
||||
.var b_cleol 64
|
||||
.var b_cleos 128
|
||||
|
||||
|
|
@ -0,0 +1,512 @@
|
|||
; termio.z - subroutines for doing the terminal i/o part of qterm
|
||||
|
||||
.incl "c:termcap"
|
||||
.incl "c:vars"
|
||||
|
||||
.macro table byte,addr
|
||||
dw addr
|
||||
db byte
|
||||
.endm
|
||||
|
||||
.extern procch
|
||||
procch: call kbdcc ; get a char if it's waiting
|
||||
or a
|
||||
jr z,lstmod ; skip if no character
|
||||
cp 'x' & 0x1f ; ctl x?
|
||||
jp z,canscr ; quit if so
|
||||
ld e,a ; save char in e
|
||||
ld a,(escval) ; get the escape value
|
||||
ld hl,pccs
|
||||
inc (hl)
|
||||
dec (hl) ; what state?
|
||||
jr z,pccs0 ; state zero - look for escape
|
||||
dec (hl) ; reset to 0
|
||||
cp e ; escape twice?
|
||||
jr z,pccop ; yes - send one to modem
|
||||
ld a,e ; get char back
|
||||
cp ',' ; was it a ','?
|
||||
call z,hangup ; hang up if so
|
||||
cp '.' ; or a '.'
|
||||
call z,break ; do a break
|
||||
jr lstmod
|
||||
|
||||
; This is here for branch length reasons
|
||||
|
||||
.extern modop
|
||||
modop: ; send a character to the modem, respecting
|
||||
; half duplex etc.
|
||||
push af
|
||||
call modopc ; send it to the modem first
|
||||
pop hl
|
||||
ld a,(wflg) ; window mode?
|
||||
or a
|
||||
ld a,h ; get character back
|
||||
jr z,nowin
|
||||
push hl
|
||||
call winsnd ; go give it to window input code
|
||||
pop af ; char back
|
||||
cp '\r'
|
||||
ret nz ; returns get special processing
|
||||
ld a,(eflg) ; echo mode?
|
||||
or a
|
||||
ret z ; return if not
|
||||
ld a,'\n' ; throw a linefeed into the system
|
||||
jr modop
|
||||
nowin: ld a,(hflg) ; half duplex?
|
||||
or a
|
||||
ret z
|
||||
ld a,h ; get character again
|
||||
cp '\r'
|
||||
jr nz,ipchar ; pass non-return chars straight in
|
||||
ld a,(eflg) ; echo mode too?
|
||||
or a
|
||||
ld a,h ; get the '\r' back
|
||||
jr z,ipchar ; no echo mode, don't expand it
|
||||
call ipchar ; go send return to receive code
|
||||
ld a,'\n'
|
||||
jr ipmchr ; throw a newline into system as well
|
||||
|
||||
pccs0: cp e ; did we see an escape?
|
||||
jr z,setesc ; yes, set the flag
|
||||
ld a,e
|
||||
pccop: call modop ; send char to modem
|
||||
db 0x3e ; ld a,xx opcode
|
||||
setesc: inc (hl)
|
||||
|
||||
.extern lstmod
|
||||
lstmod:
|
||||
call wrtscn ; keep the printer going and check if a
|
||||
; character is waiting at the modem port.
|
||||
ret c ; return if nothing arrived
|
||||
|
||||
ld hl,ecval ; echo check needed?
|
||||
dec (hl)
|
||||
inc (hl)
|
||||
jr z,noec ; jump if not
|
||||
cp (hl) ; did we match?
|
||||
jr nz,noec ; no - leave value in place
|
||||
ld (hl),1 ; reset to say we got it
|
||||
noec: ld hl,bmask
|
||||
and (hl) ; mask if 7 bit mode
|
||||
scf
|
||||
ret z ; return on nulls as well
|
||||
ld hl,cscqfl
|
||||
inc (hl)
|
||||
dec (hl) ; ^S ^Q spotting enabled?
|
||||
jr z,nocscq
|
||||
bit 0,(hl)
|
||||
jr nz,nocs ; waiting for a ^Q?
|
||||
cp 's' & 0x1f ; ^S ?
|
||||
jr nz,nocscq ; nope, check status now
|
||||
set 0,(hl) ; flag that a ^S arrived
|
||||
scf
|
||||
ret
|
||||
nocs: cp 'q' & 0x1f ; was it a ^Q
|
||||
jr z,wascq
|
||||
cp 's' & 0x1f ; also let a second ^S toggle
|
||||
jr nz,nocscq ; not yet - pass this character
|
||||
wascq: res 0,(hl) ; clear the flag
|
||||
scf
|
||||
ret
|
||||
nocscq: ld hl,eflg
|
||||
inc (hl)
|
||||
dec (hl) ; echo mode?
|
||||
zipch: jr z,ipchar ; no, hand straight to input code
|
||||
cp '\r' ; return?
|
||||
jr nz,ipmchr ; no, echo and hand to input code
|
||||
call ipmchr ; otherwise process,
|
||||
ld a,'\n' ; and send a newline into the system as well
|
||||
|
||||
ipmchr: push af
|
||||
call modopc ; send character to modem to echo it
|
||||
pop af
|
||||
|
||||
.extern ipchar ; needed for sendcs in chat
|
||||
ipchar: ld c,a ; save char in c
|
||||
ld a,(jflg)
|
||||
or a ; junking control characters?
|
||||
ld a,c
|
||||
call nz,limitb ; if so it gets tested
|
||||
ret c ; and thrown if bad
|
||||
push af ; save the character
|
||||
call opchar
|
||||
pop af
|
||||
call oplst ; output to printer
|
||||
or a ; clear the carry
|
||||
ld hl,cflg
|
||||
bit 0,(hl) ; catch mode enabled
|
||||
ret z ; no - return
|
||||
ld hl,(cptr)
|
||||
ld (hl),a ; save char away
|
||||
inc hl
|
||||
ld (cptr),hl ; update pointer
|
||||
ld de,(endcbf)
|
||||
or a
|
||||
sbc hl,de ; buffer full?
|
||||
scf
|
||||
ccf ; clear carry w/o affecting zero
|
||||
ret nz ; no - keep going
|
||||
push af
|
||||
call flushc ; go flush data in catch buffer
|
||||
call ctlq
|
||||
pop af
|
||||
ret
|
||||
|
||||
.extern savrng
|
||||
savrng: ; get a char and save in ring buffer
|
||||
call modist ; char available?
|
||||
ret z ; no.
|
||||
call modin ; get it
|
||||
ld de,(ringpw) ; pick up indices
|
||||
ld hl,(ringpr)
|
||||
inc de ; move write index
|
||||
res 2,d
|
||||
or a
|
||||
sbc hl,de ; buffer full?
|
||||
ret z ; return if so
|
||||
ld (ringpw),de ; save revised index
|
||||
ld hl,ring
|
||||
add hl,de
|
||||
ld (hl),a
|
||||
ret
|
||||
|
||||
wrtscn: call wrtlst ; keep printer output rolling
|
||||
call savrng ; get any incoming characters
|
||||
ld de,(ringpr)
|
||||
ld hl,(ringpw)
|
||||
xor a
|
||||
sbc hl,de ; anything in the ring?
|
||||
scf
|
||||
ret z ; nope
|
||||
inc de
|
||||
res 2,d
|
||||
ld (ringpr),de ; save new index
|
||||
ld hl,ring
|
||||
add hl,de ; index into buffer
|
||||
ld a,(hl) ; get the char
|
||||
ret ; and return it
|
||||
|
||||
.extern oplst ; put a character in the list ring buffer
|
||||
oplst:
|
||||
ld hl,oflg ; are we saving?
|
||||
bit 0,(hl)
|
||||
ret z ; return if not
|
||||
push bc ; save bc
|
||||
ld hl,(lstpr)
|
||||
ld de,(lstpw) ; get the list ring buffer indices
|
||||
inc de ; move the write pointer
|
||||
res 2,d ; wrap if it hits 1K
|
||||
or a
|
||||
sbc hl,de ; check for buffer full
|
||||
jr nz,notful
|
||||
push af ; save the character
|
||||
call ctls ; send an xoff and wait for things to cool
|
||||
mtloop: call wrtlst ; write a character if we can
|
||||
jr nc,mtloop ; keep writing if we're not done
|
||||
call ctlq ; OK - you can wake up again
|
||||
pop af ; restore char again
|
||||
notful: ld hl,(lstpw)
|
||||
inc hl
|
||||
res 2,h
|
||||
ld (lstpw),hl ; save the revised write pointer
|
||||
ld de,lstbuf ; address the list buffer
|
||||
add hl,de
|
||||
ld (hl),a ; and save the character
|
||||
pop bc ; get bc back.
|
||||
ret
|
||||
|
||||
wrtlst: ld de,(lstpr) ; see if we can send a character to the lst
|
||||
ld hl,(lstpw) ; get the ring buffer indices
|
||||
or a
|
||||
sbc hl,de ; anything in the buffer
|
||||
scf ; set carry to say we're done
|
||||
ret z ; nope - nothing to do
|
||||
push de
|
||||
ld a,0x2d
|
||||
call cbios ; call to list status
|
||||
pop de ; get read pointer back
|
||||
or a
|
||||
ret z ; can't write - return now
|
||||
ld hl,lstbuf
|
||||
add hl,de ; index into buffer
|
||||
inc de
|
||||
res 2,d ; wrap if over 1K
|
||||
ld (lstpr),de ; save new index
|
||||
ld c,(hl)
|
||||
|
||||
.extern lstout
|
||||
lstout: ld a,0x0f
|
||||
call cbios
|
||||
or a ; clear the carry
|
||||
ret
|
||||
|
||||
.extern ctlq
|
||||
ctlq:
|
||||
ld a,(lxoff) ; get local xon / xoff status
|
||||
or a
|
||||
ret z ; send nothing if xoff sent from keyboard
|
||||
ld a,(cqchr)
|
||||
|
||||
.extern modopc
|
||||
modopc: push af ; save character on stack
|
||||
modopl: call modost ; check if we can send
|
||||
jr z,modopl ; can't send - loop back
|
||||
pop af ; char back to a
|
||||
jp modout ; and away it goes
|
||||
|
||||
.extern limitb
|
||||
limitb: ; like limitc, but includes backspace
|
||||
cp '\b'
|
||||
ret z
|
||||
|
||||
.extern limitc
|
||||
limitc:
|
||||
cp 0x7f ; del or greater
|
||||
ccf
|
||||
ret c ; are invalid
|
||||
|
||||
.extern iswa
|
||||
iswa:
|
||||
cp ' ' ; space to '~'
|
||||
ret nc ; are valid
|
||||
cp '\r'
|
||||
ret z ; return is valid
|
||||
cp '\n'
|
||||
ret z ; newline also
|
||||
cp '\t'
|
||||
ret z ; and tab
|
||||
scf ; rest are bad
|
||||
ret
|
||||
|
||||
.var #where 0
|
||||
.var #bot 1
|
||||
.var #top 2
|
||||
.var #col 6
|
||||
.var #row 7
|
||||
.var #lff 8
|
||||
|
||||
nocndo: call ilprt ; and finish the message
|
||||
db '\r\nW ignored - insufficient terminal capabilities\r\n\0'
|
||||
ret
|
||||
|
||||
wend: ld hl,23 << 8
|
||||
jp moveto
|
||||
|
||||
.extern witog
|
||||
witog: ld a,(tcbits) ; check what terminal abilities we have
|
||||
cpl
|
||||
and b_delln | b_insln
|
||||
ld (wtflag),a ; save window type value
|
||||
jr z,cando ; got insert and delete - away we go
|
||||
ld a,(tcbits)
|
||||
and b_cleol ; alternatively check for clear to end-of-line
|
||||
jr z,nocndo ; missing it as well - can't do this
|
||||
|
||||
cando: ld hl,wflg
|
||||
call togflg ; toggle the flag first of all
|
||||
jr z,wend ; disabled - so return & do nothing
|
||||
dec (hl) ; temporarily turn mode back off so prompt
|
||||
push hl ; works right
|
||||
call prompt
|
||||
db 'Window size (b / s)? \0'
|
||||
pop hl
|
||||
inc (hl) ; turn flag back on
|
||||
ld hl,ipbuf
|
||||
call byp
|
||||
or 0x20
|
||||
xor 's' ; did they say 's'?
|
||||
|
||||
; we could probably optimise this even more, only two numbers actually change
|
||||
|
||||
ld hl,sdat ; get small window data
|
||||
jr z,gotdat ; jump if so
|
||||
ld hl,bdat ; otherwise large window data
|
||||
gotdat: ld de,wrdat
|
||||
ld bc,6
|
||||
ldir ; go install it
|
||||
ld h,d
|
||||
ld l,e
|
||||
inc de
|
||||
ld c,5
|
||||
ld (hl),b ; clear the rest of the information
|
||||
ldir
|
||||
ld a,(wtflag)
|
||||
or a ; what sort of windowing
|
||||
jr nz,setrol ; rolling w/ clear to eol
|
||||
ld hl,(rbot) ; normal - get bottom row
|
||||
ld a,(sbot) ; and the other
|
||||
jr wsetsc ; and install them
|
||||
setrol: ld hl,(rtop) ; get top row
|
||||
ld a,(stop) ; and the other
|
||||
wsetsc: ld (srow),a ; save send window current row
|
||||
ld a,l
|
||||
ld (rrow),a ; and receive window
|
||||
ld (where),a ; and set where so we'll do a moveto
|
||||
call clear
|
||||
ld hl,(rtop - 1) ; get top of receive window
|
||||
dec h ; - 1 to move up a line
|
||||
ld l,0 ; and the first positon
|
||||
call moveto ; go there
|
||||
call dim ; dim mode
|
||||
ld bc,[80 << 8] + '-'
|
||||
dashes: push bc
|
||||
call scrout ; spit out 80 dashes
|
||||
pop bc
|
||||
djnz dashes
|
||||
jp bright ; set bright mode and we're done
|
||||
|
||||
istab: ld c,' '
|
||||
call opwc
|
||||
ld a,(iy + #col)
|
||||
and 7
|
||||
jr nz,istab
|
||||
ret
|
||||
|
||||
trybs: cp '\b'
|
||||
jr nz,trytab
|
||||
ld a,(iy + #col)
|
||||
or a
|
||||
ret z
|
||||
dec (iy + #col)
|
||||
call opbs
|
||||
ld c,' '
|
||||
call scrout
|
||||
opbs: ld c,'\b'
|
||||
jp scrout
|
||||
|
||||
trytab: cp '\t'
|
||||
jr z,istab
|
||||
|
||||
nobs: cp '~' + 1
|
||||
ret nc
|
||||
cp ' '
|
||||
ret c
|
||||
opwc: push hl
|
||||
call scrout
|
||||
pop hl
|
||||
ld (iy + #lff),0
|
||||
inc (iy + #col)
|
||||
ld a,(iy + #col)
|
||||
xor 80
|
||||
jr z,scrl
|
||||
ret
|
||||
|
||||
.extern winrec
|
||||
winrec: ld iy,wrdat
|
||||
jr winpc
|
||||
|
||||
winsnd: ld iy,wsdat
|
||||
ld c,a
|
||||
|
||||
winpc: ld hl,where
|
||||
ld a,(iy + #where)
|
||||
cp (hl)
|
||||
jr z,posok
|
||||
ld (hl),a
|
||||
push hl
|
||||
push bc
|
||||
ld l,(iy + #col)
|
||||
ld h,(iy + #row)
|
||||
call moveto
|
||||
pop bc
|
||||
pop hl
|
||||
posok: ld a,c
|
||||
cp '\n'
|
||||
jr z,scrl
|
||||
cp '\r'
|
||||
jr nz,trybs
|
||||
scrl: xor a
|
||||
cp (iy + #lff)
|
||||
ret nz
|
||||
ld (iy + #col),a
|
||||
ld (hl),h
|
||||
ld (iy + #lff),h
|
||||
ld a,(wtflag)
|
||||
or a
|
||||
jr nz,roll
|
||||
ld a,(iy + #top)
|
||||
ld h,(iy + #bot)
|
||||
ld l,22
|
||||
|
||||
; rollit - scroll a region on the screen - this is made external so the VT100
|
||||
; code can get at it
|
||||
|
||||
.extern rollit
|
||||
rollit: or a
|
||||
push hl
|
||||
jr nz,dell
|
||||
ld hl,23 << 8
|
||||
call moveto
|
||||
ld c,'\n'
|
||||
call scrout
|
||||
jr dontop
|
||||
dell: ld l,0
|
||||
ld h,a
|
||||
call moveto
|
||||
call dellin
|
||||
dontop: pop hl
|
||||
ld a,h
|
||||
cp l
|
||||
ret z
|
||||
ld l,0
|
||||
call moveto
|
||||
jp inslin
|
||||
|
||||
roll: ld a,(iy + #row)
|
||||
call incrow
|
||||
ld (iy + #row),a
|
||||
call incrow
|
||||
ld h,a
|
||||
ld l,0
|
||||
call moveto
|
||||
jp cleol
|
||||
|
||||
incrow: cp (iy + #bot)
|
||||
jr z,reload
|
||||
inc a
|
||||
ret
|
||||
reload: ld a,(iy + #top)
|
||||
ret
|
||||
|
||||
.dseg
|
||||
.extern pccs
|
||||
pccs: db 0
|
||||
ringpr: dw 0
|
||||
ringpw: dw 0
|
||||
lstpr: dw 0
|
||||
lstpw: dw 0
|
||||
|
||||
.useg
|
||||
ring: ds 1024
|
||||
lstbuf: ds 1024
|
||||
|
||||
wrdat:
|
||||
rwhere: ds 1
|
||||
rbot: ds 1
|
||||
rtop: ds 1
|
||||
|
||||
wsdat:
|
||||
swhere: ds 1
|
||||
sbot: ds 1
|
||||
stop: ds 1
|
||||
|
||||
rcol: ds 1
|
||||
rrow: ds 1
|
||||
rlff: ds 1
|
||||
|
||||
scol: ds 1
|
||||
srow: ds 1
|
||||
slff: ds 1
|
||||
|
||||
.extern where
|
||||
where: ds 1
|
||||
wtflag: ds 1
|
||||
|
||||
.dseg
|
||||
|
||||
sdat: db 0,22,12
|
||||
db 1,10,0
|
||||
|
||||
bdat: db 0,22,5
|
||||
db 1,3,0
|
||||
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
; vars.i - global variables for qterm
|
||||
|
||||
.var buffin 10 ; console buffered input
|
||||
.var versn 12 ; get operating system version
|
||||
.var rescpm 13 ; reset bdos to avoid R/O disk problems
|
||||
.var seldrv 14 ; select drive
|
||||
.var open 15 ; open a file
|
||||
.var close 16 ; close a file
|
||||
.var srchf 17 ; find the first occurance
|
||||
.var srchn 18 ; find the next occurance
|
||||
.var erase 19 ; erase file
|
||||
.var read 20 ; read sequential
|
||||
.var write 21 ; write sequential
|
||||
.var create 22 ; create a file
|
||||
.var rename 23 ; rename file
|
||||
.var getdrv 25 ; get current drive
|
||||
.var setdma 26 ; set the dma address
|
||||
.var dpbadr 31 ; get disk parameter block address
|
||||
.var gsuser 32 ; get or set user code
|
||||
.var redrnd 33 ; read random
|
||||
.var cfsize 35 ; compute the filesize
|
||||
.var logdrv 37 ; reset individual drive
|
||||
|
||||
.var fcb 0x5b ; fcb address
|
||||
.var ipbuf 0x80 ; input buffer
|
||||
.var buffer 0x80 ; buffer used for wildcard scans
|
||||
.var cmdlin 0x80 ; where the command tail lives
|
||||
|
||||
.var op_bit 1 ; output modem chars flag
|
||||
.var mat_bit 2 ; print match messages flag
|
||||
.var lf_bit 4 ; print looking for messages flag
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
; version.i - keep the version in one place
|
||||
|
||||
.var no 0
|
||||
.var yes ! no
|
||||
|
||||
.var major 4
|
||||
.var minor 3
|
||||
.var rev 'e'
|
||||
.var subver 0
|
||||
|
||||
;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
|
||||
.var dg yes ; set this no for release versions
|
||||
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||
|
||||
.macro year
|
||||
db '1991'
|
||||
.endm
|
||||
|
||||
.macro version
|
||||
.if major >= 100
|
||||
db major / 100 + '0'
|
||||
.endif
|
||||
.if major >= 10
|
||||
db [major / 10] % 10 + '0'
|
||||
.endif
|
||||
db major % 10 + '0'
|
||||
db '.'
|
||||
.if minor >= 100
|
||||
db minor / 100 + '0'
|
||||
.endif
|
||||
.if minor >= 10
|
||||
db [minor / 10] % 10 + '0'
|
||||
.endif
|
||||
db minor % 10 + '0', rev
|
||||
.if subver
|
||||
db ' ('
|
||||
.if subver >= 1000
|
||||
db subver / 1000 + '0'
|
||||
.endif
|
||||
.if subver >= 100
|
||||
db [subver / 100] % 10 + '0'
|
||||
.endif
|
||||
.if subver >= 10
|
||||
db [subver / 10] % 10 + '0'
|
||||
.endif
|
||||
db subver % 10 + '0', ')'
|
||||
.endif
|
||||
.endm
|
||||
|
||||
|
|
@ -0,0 +1,508 @@
|
|||
; vt100.z - handle vt100 emulation in QTERM
|
||||
|
||||
.incl "c:vars"
|
||||
|
||||
.var decom 0x20
|
||||
.var ascrl 0x40
|
||||
|
||||
.extern initv
|
||||
initv:
|
||||
ld hl,inits
|
||||
ld de,inits + 1
|
||||
ld bc,{inite - inits}
|
||||
ld (hl),b
|
||||
ldir
|
||||
jp23: ld hl,23 << 8
|
||||
jr dochk
|
||||
chkxy: ld hl,(x)
|
||||
dochk: ld a,l
|
||||
ld e,79
|
||||
call chk1
|
||||
ld l,a
|
||||
ld a,h
|
||||
ld e,23
|
||||
call chk1
|
||||
ld h,a
|
||||
ld a,(flags)
|
||||
and decom
|
||||
jr z,savmov
|
||||
ld de,(hi)
|
||||
ld a,h
|
||||
cp e
|
||||
jr nc,aok1
|
||||
ld h,e
|
||||
aok1: ld a,d
|
||||
cp h
|
||||
jr nc,savmov
|
||||
ld h,d
|
||||
savmov: ld (x),hl
|
||||
lodmov: ld hl,(x)
|
||||
jp moveto
|
||||
|
||||
.extern opchar
|
||||
opchar: ld c,a ; save char in c
|
||||
ld a,(mode)
|
||||
and op_bit
|
||||
ret nz ; exit if not doing output
|
||||
ld a,(wflg) ; split window mode?
|
||||
or a
|
||||
jp nz,winrec ; yes - hand to receive portion
|
||||
ld a,(vflg) ; vt100 emulation on?
|
||||
or a
|
||||
jp z,scrout ; no- send to screen
|
||||
; otherwise give char to vt100 processor
|
||||
|
||||
.extern vt100
|
||||
vt100:
|
||||
ld a,c
|
||||
cp '\b'
|
||||
ld hl,x
|
||||
jr nz,nobs
|
||||
ld a,(hl)
|
||||
dec a
|
||||
ret m
|
||||
savho: ld (hl),a
|
||||
jpsco: jp scrout
|
||||
nobs: xor '\r'
|
||||
jr z,savho
|
||||
cp '\t' ^ '\r'
|
||||
jr nz,notab
|
||||
ld a,(hl)
|
||||
and ~7
|
||||
add a,8
|
||||
cp 80
|
||||
ret z
|
||||
ld (hl),a
|
||||
jr lodmov
|
||||
notab: cp '\n' ^ '\r'
|
||||
jr nz,nonl
|
||||
inc hl
|
||||
ld a,(lo)
|
||||
or a
|
||||
jr nz,islo
|
||||
ld a,23
|
||||
islo: cp (hl)
|
||||
jp z,scrlvt
|
||||
ld a,(hl)
|
||||
cp 23
|
||||
jr z,lodmov
|
||||
inc (hl)
|
||||
lodmv1: jr lodmov
|
||||
nonl: cp '\7' ^ '\r'
|
||||
jr z,jpsco
|
||||
ld hl,nk
|
||||
ld a,(hl)
|
||||
or a
|
||||
jr z,nokil
|
||||
dec (hl)
|
||||
ret
|
||||
nokil: ld a,(state)
|
||||
or a
|
||||
jr nz,stt1
|
||||
ld a,c
|
||||
cp '\e'
|
||||
jr nz,noesc
|
||||
xor a
|
||||
ld (fbits),a
|
||||
ld (setv),a
|
||||
inc a
|
||||
savstt: ld (state),a
|
||||
ret
|
||||
noesc: cp ' '
|
||||
ret c ; all other control chars are tossed
|
||||
cp 0x7f ; delete?
|
||||
ret z ; yes - we throw it away
|
||||
jr c,okasc ; less than delete => not a grafix char
|
||||
ld c,'+' ; assume all are '+'s
|
||||
ld hl,vtxtbl ; except special ones in the table
|
||||
.dseg
|
||||
vtxtbl: db 205,'='
|
||||
db 186,'|'
|
||||
db 196,'-'
|
||||
db 179,'|'
|
||||
db 0
|
||||
.cseg
|
||||
xtblp: ld e,(hl) ; get char to match
|
||||
dec e
|
||||
inc e ; is it zero?
|
||||
jr z,okasc ; yes, all done so exit
|
||||
inc hl
|
||||
ld d,(hl) ; get ascii char to use
|
||||
inc hl
|
||||
cp e ; did we hit it?
|
||||
jr nz,xtblp ; nope, back to try again
|
||||
ld c,d ; else save character from d
|
||||
okasc: ld hl,x
|
||||
ld a,(hl)
|
||||
cp 79
|
||||
jr nc,xge79
|
||||
inc (hl)
|
||||
jr jpsco
|
||||
xge79: inc hl
|
||||
ld a,(hl)
|
||||
cp 23
|
||||
jr nz,yne23
|
||||
ld a,(lo)
|
||||
or a
|
||||
jr z,cka
|
||||
cp 23
|
||||
ret nz
|
||||
cka: ld a,(flags)
|
||||
and ascrl
|
||||
ret z
|
||||
push bc
|
||||
call scrlvt
|
||||
ld hl,[22 << 8] + 79
|
||||
call moveto
|
||||
pop bc
|
||||
call scrout
|
||||
jp jp23
|
||||
yne23: call scrout
|
||||
ld a,(flags)
|
||||
and ascrl
|
||||
jr z,lodmv1
|
||||
ld hl,y
|
||||
ld a,(lo)
|
||||
or a
|
||||
jr z,nolo
|
||||
cp (hl)
|
||||
jr nz,nolo
|
||||
push hl
|
||||
call scrlvt
|
||||
pop hl
|
||||
dec (hl)
|
||||
nolo: inc (hl)
|
||||
dec hl
|
||||
ld (hl),0
|
||||
jr lodmv2
|
||||
stt1: dec a
|
||||
jr nz,stt2
|
||||
ld a,c
|
||||
cp '['
|
||||
ld a,2
|
||||
jr z,savstt
|
||||
xor a
|
||||
ld (state),a
|
||||
ld a,c
|
||||
cp '#'
|
||||
jr z,k1
|
||||
cp '('
|
||||
jr z,k1
|
||||
cp ')'
|
||||
jr nz,tryM
|
||||
k1: ld hl,nk
|
||||
inc (hl)
|
||||
ret
|
||||
tryM: ld hl,y
|
||||
cp 'M'
|
||||
jr nz,tryE
|
||||
ld a,(hi)
|
||||
cp (hl)
|
||||
jr nz,nohi
|
||||
call revsvt
|
||||
jr lodmv2
|
||||
nohi: dec (hl)
|
||||
jp p,lodmov
|
||||
inc (hl)
|
||||
jr lodmv2
|
||||
tryE: xor 'E'
|
||||
jr nz,tryD
|
||||
dec hl
|
||||
ld (hl),a
|
||||
inc hl
|
||||
jr doD
|
||||
tryD: dec a
|
||||
jr nz,try7
|
||||
doD: ld a,(lo)
|
||||
or a
|
||||
jr z,look
|
||||
ld a,23
|
||||
look: cp (hl)
|
||||
jr nz,nolo1
|
||||
call scrlvt
|
||||
jr lodmv2
|
||||
nolo1: ld a,(hl)
|
||||
cp 23
|
||||
jr nc,lodmv2
|
||||
inc (hl)
|
||||
lodmv2: jp lodmov
|
||||
try7: cp ['7' ^ 'E'] - 1
|
||||
jr nz,try8
|
||||
ld hl,(x)
|
||||
ld (sx),hl
|
||||
ld a,(mm)
|
||||
ld (sm),a
|
||||
ret
|
||||
try8: cp ['8' ^ 'E'] - 1
|
||||
ret nz
|
||||
ld hl,(sx)
|
||||
ld (x),hl
|
||||
ld a,(sm)
|
||||
call setdb
|
||||
jp chkxy
|
||||
stt2: dec a
|
||||
jr nz,stt3
|
||||
ld hl,p1
|
||||
ld (pp),hl
|
||||
ld hl,0
|
||||
ld (p1),hl
|
||||
ld a,3
|
||||
ld (state),a
|
||||
ld a,c
|
||||
cp '?'
|
||||
jr nz,stt3
|
||||
ld (setv),a
|
||||
ret
|
||||
cs2: call clear
|
||||
lodmv3: jr lodmv2
|
||||
vclrs: ld a,(de)
|
||||
or a
|
||||
jp z,cleos
|
||||
dec a
|
||||
jr nz,cs2
|
||||
push hl
|
||||
ld hl,0
|
||||
call moveto
|
||||
pop bc
|
||||
push bc
|
||||
ld a,b
|
||||
or a
|
||||
jr z,nolin
|
||||
cslp: push bc
|
||||
call cleol
|
||||
ld c,'\n'
|
||||
call scrout
|
||||
pop bc
|
||||
djnz cslp
|
||||
nolin: ld b,c
|
||||
inc b
|
||||
ld c,' '
|
||||
cllp: push bc
|
||||
call scrout
|
||||
pop bc
|
||||
djnz cllp
|
||||
ld c,'\b'
|
||||
jp scrout
|
||||
cl2: ld c,'\r'
|
||||
call scrout
|
||||
call cleol
|
||||
jr lodmv3
|
||||
vclrl: ld a,(de)
|
||||
or a
|
||||
jp z,cleol
|
||||
dec a
|
||||
jr nz,cl2
|
||||
ld c,'\r'
|
||||
push hl
|
||||
call scrout
|
||||
pop bc
|
||||
jr nolin
|
||||
stt3: ld a,c
|
||||
cp ';'
|
||||
jr nz,nosc
|
||||
ld a,(setv)
|
||||
or a
|
||||
jr z,nosv
|
||||
dofbit: ld hl,p1
|
||||
ld a,(hl)
|
||||
or a
|
||||
ret z
|
||||
ld b,a
|
||||
xor a
|
||||
ld (hl),a
|
||||
scf
|
||||
fblp: adc a,a
|
||||
djnz fblp
|
||||
dec hl
|
||||
or (hl)
|
||||
ld (hl),a
|
||||
ret
|
||||
nosv: ld hl,(pp)
|
||||
ld de,p1
|
||||
sbc hl,de
|
||||
jr nz,setp3
|
||||
add hl,de
|
||||
inc hl
|
||||
savpp: ld (pp),hl
|
||||
ret
|
||||
setp3: ld hl,p3
|
||||
ld (hl),0
|
||||
jr savpp
|
||||
nosc: sub '0'
|
||||
cp 10
|
||||
jr nc,notdig
|
||||
ld hl,(pp)
|
||||
ld e,a
|
||||
ld a,(hl)
|
||||
add a,a
|
||||
add a,a
|
||||
add a,(hl)
|
||||
add a,a
|
||||
add a,e
|
||||
ld (hl),a
|
||||
ret
|
||||
notdig: ld hl,state
|
||||
ld (hl),0
|
||||
ld hl,swtab - 1
|
||||
.dseg
|
||||
.macro table byte,word
|
||||
dw word
|
||||
db byte - '0'
|
||||
.endm
|
||||
swtab:
|
||||
table 'A',vup
|
||||
table 'B',vdown
|
||||
table 'C',vright
|
||||
table 'D',vleft
|
||||
table 'H',vmove
|
||||
table 'f',vmove
|
||||
table 'J',vclrs
|
||||
table 'K',vclrl
|
||||
table 'r',vmarg
|
||||
table 'm',vmode
|
||||
table 'h',vsm
|
||||
table 'l',vrm
|
||||
endtab:
|
||||
.cseg
|
||||
ld b,{endtab - swtab} / 3
|
||||
switch: inc hl
|
||||
ld e,(hl)
|
||||
inc hl
|
||||
ld d,(hl)
|
||||
inc hl
|
||||
cp (hl)
|
||||
jr z,hitit
|
||||
djnz switch
|
||||
ret
|
||||
hitit: push de
|
||||
ld hl,(x)
|
||||
ld de,p1
|
||||
ret
|
||||
vup: call defp1
|
||||
neg
|
||||
jr addy
|
||||
vdown: call defp1
|
||||
addy: add a,h
|
||||
ld h,a
|
||||
dochk1: jp dochk
|
||||
vleft: call defp1
|
||||
neg
|
||||
jr addx
|
||||
vright: call defp1
|
||||
addx: add a,l
|
||||
ld l,a
|
||||
jr dochk1
|
||||
vmove: call defp1
|
||||
ld h,a
|
||||
ld a,(flags)
|
||||
and decom
|
||||
jr z,hok
|
||||
ld a,(hi)
|
||||
add a,h
|
||||
ld h,a
|
||||
hok: inc de
|
||||
call defp1
|
||||
ld l,a
|
||||
dec h
|
||||
dec l
|
||||
jr dochk1
|
||||
vmarg: call defp1
|
||||
ld c,a
|
||||
inc de
|
||||
ld a,(de)
|
||||
or a
|
||||
jr nz,look1
|
||||
ld a,24
|
||||
look1: ld b,a
|
||||
ld hl,[24 << 8] + 1
|
||||
sbc hl,bc
|
||||
jr nz,chkbc
|
||||
ld b,c
|
||||
jr setbc
|
||||
chkbc: ld a,c
|
||||
cp b
|
||||
ret nc
|
||||
setbc: dec b
|
||||
dec c
|
||||
ld (hi),bc
|
||||
ld hl,0
|
||||
jr dochk1
|
||||
vmode: ld hl,(pp)
|
||||
ld a,(hl)
|
||||
setdb: ld (mm),a
|
||||
or a
|
||||
jp nz,dim
|
||||
jp bright
|
||||
vsm: call dofbit
|
||||
ld a,(fbits)
|
||||
ld hl,flags
|
||||
or (hl)
|
||||
ld (hl),a
|
||||
ret
|
||||
vrm: call dofbit
|
||||
ld a,(fbits)
|
||||
cpl
|
||||
ld hl,flags
|
||||
and (hl)
|
||||
ld (hl),a
|
||||
ret
|
||||
|
||||
chk1: or a
|
||||
jp p,chkp
|
||||
xor a
|
||||
ret
|
||||
chkp: cp e
|
||||
ret c
|
||||
ld a,e
|
||||
ret
|
||||
|
||||
defp1: ld a,(de)
|
||||
or a
|
||||
ret nz
|
||||
inc a
|
||||
ret
|
||||
|
||||
scrlvt: ld hl,(hi)
|
||||
ld a,l
|
||||
cp h
|
||||
ld l,23
|
||||
jr nz,jproll
|
||||
ld h,l
|
||||
jproll: jp rollit
|
||||
|
||||
revsvt: ld a,(lo)
|
||||
or a
|
||||
jr z,norevd
|
||||
cp 23
|
||||
jr z,norevd
|
||||
ld h,a
|
||||
ld l,0
|
||||
call moveto
|
||||
call dellin
|
||||
norevd: ld hl,(hi - 1)
|
||||
ld l,0
|
||||
call moveto
|
||||
jp inslin
|
||||
|
||||
.useg
|
||||
inits:
|
||||
state: ds 1
|
||||
hi: ds 1
|
||||
lo: ds 1
|
||||
flags: ds 1
|
||||
sx: ds 1
|
||||
sy: ds 1
|
||||
mm: ds 1
|
||||
sm: ds 1
|
||||
nk: ds 1
|
||||
inite:
|
||||
x: ds 1
|
||||
y: ds 1
|
||||
|
||||
setv: ds 1
|
||||
fbits: ds 1
|
||||
p1: ds 1
|
||||
p2: ds 1
|
||||
p3: ds 1
|
||||
pp: ds 2
|
||||
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
; xmodem.i - header file for xmodem file transfer code
|
||||
|
||||
.var FALSE 0
|
||||
.var TRUE 1
|
||||
|
||||
; ASCII Constants
|
||||
|
||||
.var SOH 001
|
||||
.var STX 002
|
||||
.var ETX 003
|
||||
.var EOT 004
|
||||
.var ENQ 005
|
||||
.var ACK 006
|
||||
.var LF '\n'
|
||||
.var CR '\r'
|
||||
.var NAK 025
|
||||
.var SYN 026
|
||||
.var CAN 030
|
||||
.var ESC '\e'
|
||||
|
||||
; XMODEM Constants
|
||||
|
||||
.var TIMEOUT -1
|
||||
.var ERRMAX 20
|
||||
.var NAKMAX 2
|
||||
.var RETRMX 8
|
||||
.var CRCSW 3
|
||||
.var KSWMAX 5
|
||||
.var BBUFSIZ 1024
|
||||
.var NAMSIZ 11
|
||||
.var CTRLZ 032
|
||||
.var CRCCHR 'C'
|
||||
.var BADNAM 'u'
|
||||
|
||||
|
|
@ -0,0 +1,178 @@
|
|||
; xutil.z - xmodem utilities
|
||||
|
||||
.incl "c:xmodem"
|
||||
|
||||
.extern initx ; set up an xmodem file transfer
|
||||
initx:
|
||||
ld hl,xabort
|
||||
ld (abortf),hl ; set the abort function
|
||||
ld hl,xmstr
|
||||
jp initsc ; just set up screen with 'Xmodem' string
|
||||
.dseg
|
||||
xmstr: db 'Xmodem\0'
|
||||
.cseg
|
||||
|
||||
.extern xmflgs ; parse flags for an xmodem send
|
||||
xmflgs:
|
||||
call clrflg
|
||||
ld a,1
|
||||
ld (crcmod),a ; but set crc flag
|
||||
xmflp: ld a,(hl)
|
||||
or 0x20
|
||||
cp 0x20
|
||||
ret z ; return on end of string or space
|
||||
inc hl
|
||||
cp 'b' ; 'b' - modem7 batch
|
||||
jr nz,noxmb
|
||||
ld (mdm7b),a ; set modem7 batch flag
|
||||
xor a
|
||||
ld (ymdmb),a ; clear ymodem batch (can't have both)
|
||||
jr xmflp
|
||||
noxmb: cp 'y' ; 'y' - ymodem batch
|
||||
jr nz,noxmy
|
||||
ld (ymdmb),a ; set ymodem batch flag
|
||||
xor a
|
||||
ld (mdm7b),a ; clear modem7 batch (can't have both)
|
||||
jr xmflp
|
||||
noxmy: cp 'k' ; 'k' - 1K packets
|
||||
jr nz,noxmk
|
||||
ld (longpk),a ; set the flag
|
||||
jr xmflp
|
||||
noxmk: cp 'q' ; 'q' - quiet value
|
||||
jr nz,noxmq
|
||||
ex de,hl
|
||||
ld hl,qcount
|
||||
inc (hl) ; bump the count
|
||||
ex de,hl
|
||||
jr xmflp
|
||||
noxmq: cp 'a' ; 'a' - alarm
|
||||
jr nz,noxma
|
||||
ld (beep),a ; set flag to beep on completion
|
||||
jr xmflp
|
||||
noxma: xor 'c' ; 'c' - checksum mode
|
||||
jr nz,xmflp
|
||||
ld (crcmod),a ; set to checksum
|
||||
jr xmflp
|
||||
|
||||
.extern updcrc ; update crc with value in a
|
||||
updcrc:
|
||||
ld c,a ; save byte in c
|
||||
call dou1
|
||||
dou1: ld hl,chksum
|
||||
ld a,c
|
||||
rrca
|
||||
rrca
|
||||
rrca
|
||||
rrca
|
||||
ld c,a
|
||||
xor a
|
||||
rld
|
||||
inc hl
|
||||
rld
|
||||
xor c
|
||||
and 0x0f
|
||||
add a,a
|
||||
push hl
|
||||
ld l,a
|
||||
ld h,0
|
||||
ld de,crctab + 1
|
||||
add hl,de
|
||||
ex de,hl
|
||||
pop hl
|
||||
ld a,(de)
|
||||
dec de
|
||||
xor (hl)
|
||||
ld (hl),a
|
||||
dec hl
|
||||
ld a,(de)
|
||||
xor (hl)
|
||||
ld (hl),a
|
||||
ret
|
||||
|
||||
.extern can3 ; send 5 CAN's to far end to force it to stop
|
||||
can3: ; used to be three, but with Zmodem systems
|
||||
ld b,5 ; sometimes more are needed
|
||||
can3lp: push bc
|
||||
ld a,CAN
|
||||
call modopc
|
||||
pop bc
|
||||
djnz can3lp
|
||||
ret
|
||||
|
||||
.extern chkcan ; called when we get a CAN - checks for a
|
||||
chkcan: ; second right behind it
|
||||
call gettc3 ; wait 3 seconds
|
||||
cp CAN
|
||||
ret nz ; no - didn't get one
|
||||
call diag
|
||||
db 'Cancelled by remote\0'
|
||||
xor a
|
||||
ret
|
||||
|
||||
.extern rnresp ; beef about failure of far end to respond
|
||||
rnresp:
|
||||
call diag
|
||||
db 'Remote not responding\0'
|
||||
ret
|
||||
|
||||
.extern cvtnib ; convert a nibble at the bottom of a to a
|
||||
cvtnib: ; character
|
||||
and 0x0f ; get just the bits we want
|
||||
add a,'0'
|
||||
cp '9' + 1 ; check if it's a digit ok
|
||||
ret c ; yes - return as is
|
||||
add a,0x27 ; else conver to a letter
|
||||
ret
|
||||
|
||||
xabort: call gettc3
|
||||
jr nc,xabort ; let the line cool down
|
||||
call can3
|
||||
jp dabort
|
||||
|
||||
.useg
|
||||
.extern olp
|
||||
olp: ds 1
|
||||
.extern attmps
|
||||
attmps: ds 1
|
||||
.extern closeo
|
||||
closeo: ds 1
|
||||
.extern fatal
|
||||
fatal: ds 1
|
||||
.extern errorf
|
||||
errorf: ds 1
|
||||
.extern batch
|
||||
batch: ds 1
|
||||
.extern secip
|
||||
secip: ds 1
|
||||
.extern eotc
|
||||
eotc: ds 1
|
||||
.extern openfl ; \
|
||||
openfl: ds 1 ; \ Bound
|
||||
.extern sectnm ; /
|
||||
sectnm: ds 2 ; /
|
||||
.extern bufsiz
|
||||
bufsiz: ds 2
|
||||
.extern chksum
|
||||
chksum: ds 2
|
||||
|
||||
.extern expsec
|
||||
expsec: ds 2
|
||||
.extern sntsec
|
||||
sntsec: ds 2
|
||||
.extern xbuff
|
||||
.extern packet
|
||||
xbuff:
|
||||
packet:
|
||||
ds 1024
|
||||
|
||||
.dseg
|
||||
crctab:
|
||||
dw 0x0000, 0x1021
|
||||
dw 0x2042, 0x3063
|
||||
dw 0x4084, 0x50a5
|
||||
dw 0x60c6, 0x70e7
|
||||
dw 0x8108, 0x9129
|
||||
dw 0xa14a, 0xb16b
|
||||
dw 0xc18c, 0xd1ad
|
||||
dw 0xe1ce, 0xf1ef
|
||||
|
||||
Loading…
Reference in New Issue