acn/qterm
acn/qterm
1
0
Fork 0
Code Releases Activity

Source code of QTerm 4.3e added

Browse Source
This commit is contained in:
acn 2020-10-05 14:03:34 +02:00
parent bad966dfcf
commit 5161e84617
30 changed files with 9234 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -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```).

271
source/BAUD.Z Normal file
View File

@ -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


178
source/CATCH.Z Normal file
View File

@ -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


859
source/CF.Z Normal file
View File

@ -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


993
source/CHAT.Z Normal file
View File

@ -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


144
source/DIR.Z Normal file
View File

@ -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


434
source/FILE.Z Normal file
View File

@ -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


133
source/FLAGS.Z Normal file
View File

@ -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


20
source/KERMIT.I Normal file
View File

@ -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


1121
source/KUTIL.Z Normal file
View File

File diff suppressed because it is too large Load Diff

10
source/MAKEQT.SUB Normal file
View File

@ -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


658
source/ODDS.Z Normal file
View File

@ -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


BIN
source/QT43SRC.LBR Normal file
View File

Binary file not shown.

903
source/QTERM.Z Normal file
View File

@ -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


77
source/RECV.Z Normal file
View File

@ -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'


259
source/RECVK.Z Normal file
View File

@ -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


359
source/RECVX.Z Normal file
View File

@ -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


84
source/SEND.Z Normal file
View File

@ -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


262
source/SENDK.Z Normal file
View File

@ -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


402
source/SENDX.Z Normal file
View File

@ -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


48
source/SHRINK.Z Normal file
View File

@ -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


226
source/SRSCRN.Z Normal file
View File

@ -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


468
source/SRUTIL.Z Normal file
View File

@ -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


11
source/TERMCAP.I Normal file
View File

@ -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


512
source/TERMIO.Z Normal file
View File

@ -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


31
source/VARS.I Normal file
View File

@ -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

49
source/VERSION.I Normal file
View File

@ -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


508
source/VT100.Z Normal file
View File

@ -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


34
source/XMODEM.I Normal file
View File

@ -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'


178
source/XUTIL.Z Normal file
View File

@ -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