home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
PACKET
/
RLI120.ARK
/
MISC.MAC
< prev
next >
Wrap
Text File
|
1987-05-11
|
10KB
|
587 lines
; MISC.MAC - 5/11/87 - Misc routines.
.z80
.xlist
maclib TNC.LIB
asciictl
tncdefs
timdef
.list
entry settim,curtime,date,time,ynbq
entry primet,tm1,tm2,tm3,tm4,tm5
external cmd,cmdlen,@prtx,fcb1,fcb2,getcmd
external erwhat
dseg
date: ds 6
time: ds 6
primet: ds 3 ;24 bits, which are primetime hours
cseg
twodig macro addr
local tda
call bindec
ld a,(numb+3)
cp ' '
jr nz,tda
ld a,'0'
tda: ld (addr),a
movb addr+1,numb+4
endm
; Place current date/time into DATE and TIME in ascii.
curtime: ld h,0
di
ld a,(sec)
ld l,a
push hl
ld a,(min)
ld l,a
push hl
ld a,(hr)
ld l,a
push hl
ld a,(day)
ld l,a
push hl
ld a,(mo)
ld l,a
push hl
ld a,(yr)
ei
ld l,a
twodig date
pop hl
twodig date+2
pop hl
twodig date+4
pop hl
twodig time
pop hl
twodig time+2
pop hl
twodig time+4
ret
; Decide if a timed param is on or off
; Call with A/ one of TRUE, FALSE, BTIME or QTIME
; Return with A/ 0 or FF (false or true) and Z flag to match
ynbq: or a ; Called with FALSE?
ret z ; Return false if so
cp btime ; Called with BTIME?
jr z, ynbqb ; If so, see if busy time
cp qtime ; Called qith QTIME?
jr z, ynbqq ; If so, see if quiet time
ynbqnz: xor a ; Return TRUE and NZ flag
dec a
ret
ynbqq: call ynbqb ; Quiet is complement of busy
cpl
or a
ret
ynbqb: ld hl, primet ; Point at 0000-0759 bits
ld a, (hr) ; Pick up the hour
ynbq1: sub 8 ; Is it 0-7?
jr c, ynbq2 ; Go if found right 8 hrs
inc hl ; Step to next 8 hours
jr ynbq1 ; Will break within 3 loops, 32 if hr nuts
ynbq2: ld c, (hl) ; Pick up the 8 hours
and 7 ; Mask 0-7 for bit in this byte
ynbq3: rl c ; Shift bit into CY
dec a ; Right bit yet?
jp p, ynbq3 ; Loop, up to 8 times, for right bit
jr c, ynbqnz ; If bit is 1, return NZ
xor a ; If bit is 0, return Z
ret
; Set current date and time.
dseg
tm1: ds 2
tm2: ds 2
tm3: ds 2
tm4: ds 2
tm5: ds 2
cseg
getnum: call getcmd
move numb,fcb1+1,5
call decbin
ld a,l
ret
settim: prtx tm1
call getnum
push af
prtx tm2
call getnum
push af
prtx tm3
call getnum
push af
; Get the current time.
prtx tm4
call getnum
push af
prtx tm5
call getnum
di
ld (min),a
pop af
ld (hr),a
mvim sec,0
pop af
ld (day),a
pop af
ld (mo),a
pop af
ld (yr),a
ei
ret
; (A) to upper case.
entry ucase
ucase: cp 'a'
ret c
cp 'z'+1
ret nc
and 5fh
ret
entry @upper
@upper: ld a,(hl)
call ucase
ld (hl),a
inc hl
dec c
jr nz,@upper
ret
; Compare string at (de) with string in command buffer for (c) chars.
; Return zero set if match.
entry @cmpcmd
@cmpcmd: ld a,(cmdlen)
cp c
ret c
ld hl,cmd
; Compare string at (de) with string at (hl) for (c) chars.
; Return zero set if match.
entry @cmp
@cmp: ld a,(de)
cp (hl)
ret nz
inc hl
inc de
dec c
ret z
jr @cmp
; As above, but with wildcards allowed in the string at (de).
; "*" means match rest of item, "?" means match this one character.
entry @cmpwc
@cmpwc: ld a,(de)
cp '*'
ret z ; Star says it all matches
cp '?' ; Question mark matches any 1 char
jr z, cmpwc1
cp (hl)
ret nz
cmpwc1: inc hl
inc de
dec c
ret z
jr @cmpwc
; Search a fixed width list.
; Return zero set if find.
; Return @srcl pointing to start of found item,
; or to item beyond current end of list.
; Return the number of the found record in @srcf.
; Enter with non-zero in A if wild cards allowed in target item.
entry @srct,@srcl,@srcn,@srcw,@srcc,@srcf,@src
dseg
@srct: ds 2 ; Target address
@srcl: ds 2 ; List address
@srcn: ds 2 ; # items in list
@srcw: ds 2 ; # bytes/item
@srcc: ds 2 ; # bytes to compare
@srcf: ds 2 ; Record number of found record
@srcq: ds 1 ; Non-zero if wildcards allowed
cseg
@src: ld (@srcq),a
lxim @srcf,0
@srca: dtz @srcn
jr nz,@srcb
retnz ; No find
@srcb: inxm @srcf ; Count the record
ld de,(@srct)
ld hl,(@srcl)
ld a,(@srcc)
ld c,a
ld a,(@srcq) ; See if wildcards allowed
or a
jr z,@src1
call @cmpwc ; If so, use different search routine
jr @src2
@src1: call @cmp
@src2: ret z ; Return if matched
ld de,(@srcw)
ld hl,(@srcl)
add hl,de
ld (@srcl),hl
dcxm @srcn
jr @srca
; Add or update an item to a time odered list.
entry @adll,@adlm,@adlw,@adln,@adlt,@adlc,@adl
dseg
@adll: ds 2 ; Address of list
@adlm: ds 2 ; Max entries in list
@adlw: ds 2 ; Bytes per entry
@adln: ds 2 ; Items on list
@adlt: ds 2 ; Addres of item to add
@adlc: ds 2 ; Bytes to compare
cseg
@adl: movw @srct,@adlt
movw @srcl,@adll
movw @srcn,@adln
movw @srcw,@adlw
movw @srcc,@adlc
call @src ; Is it already on the list?
jr z,adla ; Yes
ld de,(@adlm)
ld hl,(@adln)
or a ; Clear carry
sbc hl,de
jr z,adla ; List full
inxm @adln ; New count
adla: ld de,(@adll) ; Start of list
ld hl,(@srcl) ; Pointer to slot
or a ; Clear carry
sbc hl,de ; Put at top?
jr z,adlc ; Yes
ld b,h
ld c,l ; (BC)=# bytes to move
ld hl,(@srcl) ; Start of slot
dec hl ; End of previous slot
ld de,(@adlw) ; Slot size
add hl,de ; End of this slot
ex de,hl ; (DE)=dest address
ld hl,(@srcl)
dec hl ; (HL)=source address
adlb: ldd ; Move byte
ld a,c
or b
jr nz,adlb
; Move new item into list.
adlc: ld hl,(@adlt)
ld de,(@adll)
ld bc,(@adlw)
ldir
ret
; Return(HL) pointing to the oldest item in a list, remove item.
; Return zero set if no items.
; entry @slst
;@slst: dtz @adln ; List empty?
; ret z ; Yes
; dec hl ; One less item
; ld (@adln),hl
; ex de,hl
; ld bc,(@adlw) ; Bytes/item
; call muldec
; ld hl,(@adll) ; List start
; add hl,de
; retnz
; Move bytes from command line to (hl).
; Move at most (c) bytes, start (e) bytes from beginning.
entry @mcmd
@mcmd: ld a,(cmdlen)
sub e
cp c
jr nc,@mcme
ld c,a
@mcme: ld b,0
push hl
ld hl,cmd
add hl,de
ex de,hl
pop hl
; Move (bc) bytes from (de) to (hl). LDIR for 8080.
entry @move
@move: ld a,b
or c
ret z
ld a,(de)
ld (hl),a
inc hl
inc de
dec bc
jr @move
; move call from (HL) to (DE), (A) length of string at (HL).
; Ignore trailing "-x".
entry movcal
movcal: ld c,a
cp 7
jr c,@mca
ld c,6
@mca: push hl
push de
push bc
ex de,hl
fill ,6,' '
pop bc
pop de
pop hl
@mcb: dec c
ret m
ld a,(hl)
cp ' '
ret z
cp '-'
ret z
call ucase
ld (de),a
inc hl
inc de
jr @mcb
; Fill (bc) bytes at (hl) with (e).
entry @fill
@fill: ld a,b
or c
ret z
ld (hl),e
inc hl
dec bc
jr @fill
; Wait until timer counts down to zero.
; No registers altered.
entry @wait
cseg
@wait: push af
wa: dtz timer
jr nz,wa
pop af
ret
; 8 by 8 Multiply
; DE=D*E, No other registers disturbed.
mulde: push hl
ld h,d ; Set up multipliers
ld l,0 ; Clear some
ld d,l
add hl,hl ; Shift and add (S/A) 1
jr nc,m2 ; No add
add hl,de ; Add
m2: add hl,hl ; S/A 2
jr nc,m3
add hl,de
m3: add hl,hl ; S/A 3
jr nc,m4
add hl,de
m4: add hl,hl ; S/A 4
jr nc,m5
add hl,de
m5: add hl,hl ; S/A 5
jr nc,m6
add hl,de
m6: add hl,hl ; S/A 6
jr nc,m7
add hl,de
m7: add hl,hl ; S/A 7
jr nc,m8
add hl,de
m8: add hl,hl ; S/A 8
jr nc,m9 ; Done
add hl,de
m9: ex de,hl ; Product to DE
pop hl
ret
; 16 by 8 multiply.
; (DE)=(DE)*(C) No other registers altered.
entry muldec
muldec: push hl
push de
ld e,c
call mulde
ex de,hl
ld h,l
ld l,0
pop de
ld d,c
call mulde
add hl,de
ex de,hl
pop hl
ret
; Divide 16/8 to 8 with remainder, rounded and unrounded quotients.
; L = HL/E, Unrounded, H=Remainder
; DE = HL/E, Rounded
; (BC) Not changed.
; Carry cleared if overflow.
entry div8
div8: push bc
ld a,h ; Check for overflow
sub e
jr nc,d6 ; Overflow
ld b,0 ; Initialize quotient register.
ld c,8 ; Initialize shift counter.
d3: add hl,hl ; Shift HL left
jr c,q1 ; Jump if a bit fell off
ld a,h ; Test subtract
sub e ; Will it fit?
jr c,q2 ; No, too small
q1: ld a,h ; Do the subtraction for real
sub e
ld h,a ; Stick it back
scf ; Shift a 1 into qoutient
d5: ld a,b ; Set up to shift carry into quotient
rla ; Shift
ld b,a ; Stick it back
dec c ; Update shift counter
jr nz,d3 ; Loop if more shifts to do
ld a,e ; Round qoutient
ld d,0
and a ; Clear carry
rra ; Divide by 2
ld e,b ; Unrounded quotient to E
cp h ; Remainder*2>=divisor?
jr nc,d4 ; No
inc de ; Yes, increment
d4: scf ; Set flag for no overflow
d6: ld l,b ; Move unrounded quotient to L
pop bc
ret
q2: and a ; Clear carry to shift a 0
jr d5 ; Shift it in
; Binary to decimal conversion for 16 bit value.
; Input: (HL) = Binary value.
; Output: NUMB has 5 digits, right justified, leading zeros supressed.
; No registers preserved.
entry bindec,numb
dseg
numb: ds 5
cseg
; First count the 10,000's
bindec: ld de,10000
ld c,'0'
b0: or a ; Clear carry
sbc hl,de
jr c,b1
inc c
jr b0
b1: add hl,de
ld a,c
ld (numb),a ; 10,000's
; Now deal with the remaining number, <10,000
push hl
ld e,100
call div8 ; (H)=2 low, (L)=2 hi digits
push hl
ld h,0
ld e,10
call div8 ; (H)=1st digit, (L)=2nd
ld a,l
add a,'0'
ld (numb+1),a
ld a,h
add a,'0'
ld (numb+2),a
pop hl
ld l,h
ld h,0
ld e,10
call div8 ; (H)=3rd digit, (L)=4th
ld a,l
add a,'0'
ld (numb+3),a
ld a,h
add a,'0'
ld (numb+4),a
pop hl
; Remove leading zeros
ld c,4
ld a,'0'
ld hl,numb
b2: cp (hl)
ret nz
ld (hl),' '
inc hl
dec c
jr nz,b2
ret
; Decimal to binary conversion for 16 bit values.
; Input: NUMB has 5 digit ASCII to be converted.
; Output: (HL) = Binary value, carry set if error.
; No registers preserved.
entry decbin
decbin: ld hl,0
ld de,numb
ld b,5
ld c,10
r1: ld a,(de)
cp ' '
jr z,r2
cp '9'+1
jr nc,r3 ; Not a digit
sub '0'
ret c ; Not a digit
push de
ex de,hl
ld l,a
ld h,0
call muldec
add hl,de
pop de
r2: inc de
dec b
jr nz,r1
or a ; Clear carry
ret
r3: scf
ret
end