home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
trs80model2.tar.gz
/
trs80model2.tar
/
trsutil.mac
< prev
next >
Wrap
Text File
|
1997-03-26
|
18KB
|
492 lines
subttl kutil/mac utilities and other odd routines
extrn rlen,slen,csvc,rsvc,ssvc,r,n,mjump
extrn spaket,rpaket,byte,recptr,sinit
extrn fcb,lrecl,filbuf,recbuf,lrecl,paraml
public flush,rplus,abort,exit,acsum,spack
public open,close,writnx,readnx,kill
public rpack,initcm
extrn init,port,altsvc,nsvc
;
; useful symbole
;
soh equ 1
tout equ 10
len equ 0
seq equ 1
type equ 2
data equ 3
dfport equ 'A'
;
;
;timer to interrupt a given routine after a number of seconds
; syntax timer routin,seconds
; where routin is the interrupt handler
;
timer macro routin,second
push hl
push bc
ld hl,routin ;routine to jump to
ld bc,second ;number of seconds
svc 25 ;timer call
pop bc
pop hl
endm
;
;svc to make a trsdos supervisor call
; syntax svc code
; where code is the trsdos code
;
svc macro code
ld a,code
rst 8
endm
;
;
;prmes to print messages on the screen
; syntax prmes lab
; where lab if the label as defined with mssg
;
prmes macro lab
.xlist
extrn m_&lab,l_&lab
push hl
push bc
ld hl,m_&lab ;get address of message
ld bc,(l_&lab) ;and length
ld c,13 ;add a CR at end of ttyout
svc 9 ;call dos
pop bc
pop hl
.list
endm
;
;blmov to move a block of text
; syntax blmov source,destination,length
; if length is 0 then assume 256
;
blmov macro source,dest,len
.xlist
local $1,$2
push hl
push bc
push de
ld hl,source ;address of source
ld de,dest ;address of destination
ld a,(len) ;get length
cp 0 ;is it zero ?
jr nz,$1
ld b,1 ;then set bc = 256
ld c,0 ;(b=1 ; c=0)
jp $2 ;go to start move
$1:
ld b,0
ld c,a ;bc = length
$2:
ldir ;move and check if bc=0
pop de
pop bc
pop hl
.list
endm
;
;readnx to read next record sequentially
; Returs with the record in recbuf
; And, at eof, will jump to sendeof
; (This macro will not save redisters)
;
readnx:
ld de,fcb ;file control block
svc 34 ;read next svc
jp nz,abort ;bad read, abort
ld a,(lrecl) ;get logacal record length
cp 0 ;is it 256 ?
jp nz,read0 ;no, all is ok
blmov filbuf,recbuf,lrecl ;move to recbuf
read0:
ret
;
;open open a file according to fcb and paramlist
;
open:
push hl
push de
ld de,fcb ;file control block
ld hl,paraml ;parameter list
svc 40 ;open call
jp nz,abort ;file not found
;or file cannot create
pop de
pop hl
ret
;
;kill kill a file using current fcb
;
kill:
push de
ld de,fcb ;file control block
svc 41 ;kill call
jp nz,abort ;no good (password ?)
pop de
ret
;
;close file using current fcb
;
close:
push de
ld de,fcb
svc 42
jp nz,abort
xor a ;clr a
ld (recptr),a ;reset pointer to 0
pop de
ret
;
;writnx write next sequential record
;
writnx:
ld a,(lrecl) ;get logical record length
cp 0 ;is it 256 ?
jp nz,writ0 ;no, go on
blmov recbuf,filbuf,lrecl ;get to filbuf
writ0:
push de
ld de,fcb ;file control block
svc 43 ;write call
jp nz,abort ;no good
pop de
ret
;
;delay in seconds
;
delay macro sec
.xlist
local $1
push bc
ld bc,0 ;set for 426 milisecs
push hl
ld l,sec ;number of seconds
$1:
svc 6 ;call for delay
svc 6 ;2 * 426 milisecs = 1 s.
dec l ;sec--
xor a ;a = 0
cp l ;sec = 0 ?
jr nz,$1 ;no, play it again sam
pop hl
pop de
.list
endm
;
;jumptb jump according to a given table and a one byte code
;
; syntax jumptb table,code
;
jumptb macro table,code
.xlist
local $1
ld hl,table ;get jump table address
ld bc,(code) ;and code (note that c is messed up)
ld a,c
ld b,a
svc 28 ;lookup call
jr z,$1 ;found
ld hl,table+1 ;get abort address
$1:
jp (hl) ;bye ...
.list
endm
;
;initcm initalise comm channel A or B
; and set up correct svc communication calls
;
initcm:
ld a,(init) ;get initial code
cp 0 ;should we init ?
jr z,i1 ;no, go set up svc
;
ld hl,port ;get port paramlist
ld b,0 ;turn off port
svc 55 ;dos call
ld b,1 ;turn on
svc 55 ;dos call
i1:
ld a,(port) ;get channel A or B
cp dfport ;is this default ?
jr z,i2 ;yes, all ok
blmov altsvc,init,nsvc;set up alternate svc's
i2:
ret
;
;xmitb transmit a byte that is pointed to by hl
;
xmitb macro
.xlist
local $1
$1:
ld a,(ssvc) ;get transmit svc
ld b,(hl) ;and byte to transmit
rst 8 ;dos call
jr nz,$1 ;assume busy, try again
.list
endm
;
;rcvb receive byte and return it in a
;
rcvb macro
.xlist
local $1
push bc
$1:
ld a,(rsvc) ;get receive svc
rst 8 ;dos call
jr nz,$1 ;try it again
ld a,b ;store (might not be good)
pop bc
.list
endm
;
;nplus to increment the packet number count
;
nplus macro
ld hl,n
inc (hl)
endm
;
;dec3 decrement three times a register or register pair
;
dec3 macro reg
dec reg
dec reg
dec reg
endm
;
;addbc to add a to bc in checksum computation
;
addbc macro
.xlist
add a,c ;c=c+1 (there might be a carry)
ld c,a ;back in c
ld a,0 ;not xor a because we need the carry
adc a,b ;add the carry to b
ld b,a ;back in b
.list
endm ;bc=bc+a
;
;f_ack to format ack using current n
;
f_ack macro
.xlist
ld (iy+len),3 ;length=3
ld a,(n) ;current packet count
add a,' ' ;make printable
ld (iy+seq),a ;put n in packet
ld (iy+type),'Y' ;type = ack
ld hl,spaket ;hl points to send packet
call acsum ;and add the checksum
.list
endm
;
;movb to move a byte to memory
;
movb macro value,loc
.xlist
push af ;save
ld a,value ;get byte
ld (loc),a ;save
pop af ;restore
.list
endm
subttl rpack - receive packet routine
page
;
; rpack receive packet routine
; call rpack
; will discard soh on reception
; and will return with carry set
; if timout occured or cheksum wrong
;
rpack:
timer rp0,tout ;set timer handler
rp1:
ld hl,rpaket ;set up hl
rcvb ;get a byte
cp soh ;is it a soh ?
jr nz,rp1 ;no, not yet, start over
ld b,0 ;for checksum bc=0
ld c,0 ;*****************
rp2: ;len
rcvb ;get a byte
cp soh ;is it a soh ?
jp z,rp1 ;yes, re-sync
ld (hl),a ;save in rpaket
addbc ;add to bc for checksum
ld a,(hl) ;get back byte
inc hl ;point to next byte
sub ' '+3 ;convert to numeric
ld (rlen),a ;and save
rp3: ;packet number
rcvb ;get a byte
cp soh ;soh ?
jp z,rp1 ;yes, re-sync
ld (hl),a ;save in rpaket
inc hl ;update counter
addbc ;add to bc for checksum
rp4: ;type of packet
rcvb ;get a byte
cp soh ;soh ?
jp z,rp1 ;yes, re-sync
ld (hl),a ;save in rapket
inc hl ;update pointer
addbc ;add to bc for checksum
ld a,(rlen) ;get data length
cp 0 ;is it null ?
jp z,rp6 ;yes, get checksum now
rp5: ;data field
rcvb ;get a byte
cp soh ;soh ?
jp z,rp1 ;yes, re-sync
ld (hl),a ;save
inc hl ;update counter
addbc ;add to bc for checksum
ld a,(rlen) ;get length of packet
dec a ;decrement
ld (rlen),a ;ans store back
cp 0 ;is it null ?
jp nz,rp5 ;no, get one more byte
rp6: ;checksum
rcvb ;get a byte
cp soh ;soh ???
jp z,rp1 ;yes, re-sync
sub ' ' ;convert to numeric
ld (byte),a ;save received checksum
ld a,c ;get low byte
and 300O ;only two high bits
rlca ;rotale left
rlca ;twice
add a,c ;add back to low byte
and 077O ;only six bits
ld c,a ;computed checksum
ld a,(byte) ;received checksum
cp c ;equal ?
jp nz,rp0 ;no good
timer 0,0 ;terminate timout handler
scf ;ser carry to 1
ccf ;back to 0
ret ;and return
rp0: timer 0,0 ;terminate timout handler
scf ;set carry flag
ret
;
;
subttl flush - to reset communication port
page
;
; flush to reset internal communication buffer
; (mostly to get rid of stacked up naks)
flush:
push bc ;save
ld b,6 ;code to reset buffer
ld a,(csvc) ;control svc
rst 8 ;dos call
pop bc ;restore
ret
;
subttl rplus - to increment retry count
page
; rplus increment retry count and jump back
;
rplus:
ld a,(r) ;get retry count
inc a ;increment it
cp tout ;to maximum ?
jp z,abort ;yes abort
ld (r),a ;save back
jp mjump ;and go back
;
subttl abort - end in disaster sending an error packet
page
; abort end transmission and die...
;
abort:
prmes a0 ;aborting ...
ld (iy+len),3 ;length = 3
ld a,(n) ;get current packet seq
cp 0 ;are we at beginning ?
jp z,ab0 ;yes, do not send error pak
add a,' ' ;make printable
ld (iy+seq),a ;and store
ld (iy+type),'E' ;type error packet
ld hl,spaket ;set up hl
call acsum ;compute checksum
call spack ;and send packet
ab0:
exit: prmes e0 ;end of job
rst 0 ;bye !
;
subttl acsum - add checksum to a packet
page
; acsum compute and store checksum (hl)
;
acsum:
push hl ;save
push bc ;save
ld b,0 ;initialize bc to 0
ld c,0 ;******************
ld a,(hl) ;get length
ld (slen),a ;save it
add a,' ' ;make printable
ld (hl),a ;store back in packet
ac0:
ld a,(hl) ;get a byte
addbc ;add to bc for checksum
inc hl ;increment pointer
ld a,(slen) ;get length
dec a ;decrement it
ld (slen),a ;save it back
cp 0 ;are we at end ?
jp nz,ac0 ;no, get one more byte
ld a,c ;get low byte of sum
and 300O ;only 2 high bits
rlca ;rotate left
rlca ;twice
add a,c ;add it back to low byte
and 077O ;mask off 2 high bits
add a,' ' ;and make pintable
ld (hl),a ;store in packet
pop bc ;restore
pop hl ;restore
ret
;
subttl spack - send a packet already formatted
page
; spack send a packet already formatted
;
spack:
push hl ;save
ld a,(spaket) ;get length
sub 31 ;real length
ld (slen),a ;save it
movb soh,byte ;store a soh
ld hl,byte ;set up hl
xmitb ;transmit (hl)=soh
ld hl,spaket ;packet address
ld a,(slen) ;and length
sp1:
push af ;save
xmitb ;transmit (hl)
pop af ;restore a
dec a ;decrement length of packet
inc hl ;update pointer
cp 0 ;are we at end ?
jp nz,sp1 ;no, one more byte
;now send eol
ld hl,sinit+4 ;where eol is stored
xmitb ;send it
pop hl ;restore
ret
;
;
end