; 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