; dos5/asm
*TITLE	'<DOS+II - system routines>'
;
;	SYS0 subroutines - following are contained
;
;		$SETUSR - SVC 2 - set user SVC vector
;		$SETBRK - SVC 3 - set break handler
;		$DELAY	- SVC 6 - decrement BC till 0
;		$VIDKEY - SVC 12 - display and key input
;		$RANDOM - SVC 20 - generate random number
;		$BINDEC - SVC 21 - binary/decimal convert
;		$STCMP	- SVC 22 - compare 2 strings
;		$MPYDIV - SVC 23 - multiply/divide
;		$BINHEX - SVC 24 - binary/hex convert
;		$TIMER	- SVC 25 - user timer control
;		$LOOKUP - SVC 28 - lookup entry in table
;		$HLDKEY - SVC 29 - hold key processor
;		$STSCAN - SVC 49 - scan memory for string
;		$XLATE - translate A from table
;		$UCASE - convert char in A to upper case
;
*EJECT
;
;	$SETUSR - SVC 2
;	insert/remove vector into SVC table
;
;	ENT	HL = routine address (if C<>0)
;		B = SVC # (0-127)
;		C = 0 = remove vector
;		C <> 0 = add vector
;
;	EXT	Z = OK
;		HL = removed vector (if C<>0)
;		NZ = A = error code
;
SETUSR	LD	A,B		;get SVC # affected
	ADD	A,A		;see if >127
	JR	NC,SETUOK	;go if valid
	LD	A,3		;parameter error
	OR	A		;set NZ flag
	RET			;NZ = error
;
;	locate table position
;
SETUOK	PUSH	DE		;save this
	EX	DE,HL		;DE = user vector
	LD	L,A		;L = SVC vector offset
	LD	H,2		;starts on page 2
	XOR	A		;set Z
	CP	C		;Z = remove
	JR	Z,SETREM	;remove the vector
;
;	insert vector into table
;
	LD	(HL),E		;else add vector
	INC	HL
	LD	(HL),D		;add MSB
;
;	completed
;
SETUDN	EX	DE,HL		;HL = user vector
	POP	DE		;restore DE
	XOR	A		;set Z flag for OK
	RET			;return
;
;	remove vector from table
;
SETREM	LD	DE,SVBAD	;nill vector
	LD	A,(HL)		;get previous
	LD	(HL),E		;put LSB dummy
	LD	E,A		;E = old LSB
	INC	L		;bump pointer
	LD	A,(HL)		;get MSB old
	LD	(HL),D		;put new
	LD	D,A		;DE = old vector
	JR	SETUDN
;
*EJECT
;	$SETBRK - SVC 3
;	insert/remove user BREAK processor
;
;	ENT	HL = break processor vector (0=remove)
;
;	EXT	HL = deleted vector if 0000 on entry
;		Z = OK
;		NZ = A = error code
;
; (NOTE) vector does not need to be disabled
;	 before it is changed
;
SETBRK	PUSH	IX		;save
	LD	A,KDCB@ 	;keyboard device
	CALL	LOCDCB		;locate DCB
	LD	A,H		;see if remove
	OR	L		;any bits?
	JR	Z,REMBRK	;remove if 0
;
;	install vector
;
	LD	(IX+19),L
	LD	(IX+20),H
	SET	5,(IX+5)	;set processor active
	RES	3,(IX+5)	;reset BREAK pressed
	JR	SETBRET-1	;return
;
;	turn off processor
;
REMBRK	BIT	5,(IX+5)	;active now?
	LD	A,66		;function does not exist
	JR	Z,SETBRET	;return in error
	LD	L,(IX+19)
	LD	H,(IX+20)	;get old vector
	RES	5,(IX+5)	;turn off processor
	XOR	A		;set OK
SETBRET POP	IX		;restore stack
	OR	A		;set flags
	RET			;done
;
*EJECT
;
;	$DELAY	- SVC 6
;	decrement BC till 0
;
;	ENT	BC = number of delay multiples
;
;	EXT	A = 0
;		Z set
;
; DELAY:	BC = 0 = 426 milliseconds
;		BC >0 = 6.5 * (BC - 1) + 22 microsecs.
;
DELAY	PUSH	BC		;don't change it
	DEC	BC		;less 1
	LD	A,B		;see if any left
	OR	C
	JR	NZ,DELAY+1	;go more if yes
	POP	BC		;restore original
	RET
;
*EJECT
;
;	$VIDKEY - SVC 12
;	display text and get keyboard string
;
;	ENT	HL => text message to display
;		DE => text buffer for keyboard input
;		B = number chars to display
;		C = max chars for key input
;
;	EXT	NZ = A = error code
;		Z = OK
;		DE => input buffer from keyboard
;		HL => displayed text string
;		B = number characters from keyboard
;		C = length of displayed string
;
VIDKEY	PUSH	BC		;save char/key count
	LD	C,0		;nil char at display end
	CALL	VDLINE		;display line to video
	POP	BC		;restore it
	RET	NZ		;error on that
;
	LD	A,B		;get display length
	LD	B,C		;max keys to fetch
	LD	C,A		;C = display length
	EX	DE,HL		;pass buffer to HL
	CALL	KBLINE		;get string from keyboard
	EX	DE,HL		;restore
	RET
;
*EJECT
;
;	$BINDEC - SVC 21
;	convert binary to ascii string and back
;
;	ENT	B = 0 = binary to ascii
;		DE = binary number to convert
;		HL => 5 byte string area
;
;		B <> 0 = ascii to binary
;		HL => 5 byte ascii string to convert
;
;	EXT	Z = OK (binary to ascii ALWAYS Z)
;		NZ = A = error code (invalid chars)
;		if B <> 0, DE = value of string
;
BINDEC	PUSH	IX		;need for table
	PUSH	BC		;will use this
	PUSH	HL		;string start
	PUSH	DE		;save too
	XOR	A		;see if B = 0
	CP	B
	LD	B,H		;give string to BC
	LD	C,L
	LD	IX,DECTBL	;decimal table
	JR	Z,BIN2ASC	;convert binary to ascii
;
;	convert ascii to binary
;
ASC2BIN LD	HL,0		;start value
A2BLP	LD	A,(BC)		;get string byte
	SUB	'0'             ;remove ascii
	JR	C,BDBAD 	;error, <'0'
	CP	'9'+1           ;>9?
	JR	NC,BDBAD	;error if >9
	LD	E,(IX)		;get table word
	LD	D,(IX+1)	;for max size test
	INC	A		;fixup for immed DEC
	JR	A2BLP2		;test if done
;
;	compute digit
;
A2BLP1	ADD	HL,DE		;add this place
	JR	C,BDBAD 	;too big of a number
A2BLP2	DEC	A		;less one
	JR	NZ,A2BLP1	;go more if NZ
	INC	IX		;bump table pointer
	INC	IX		;word table
	INC	BC		;bump string pointer
	DEC	E		;end of table?
	JR	NZ,A2BLP	;go if not
	EX	(SP),HL 	;set value into DE
	XOR	A		;set Z for OK
	JR	BDRET		;return
;
;	error return
;
BDBAD	LD	A,9		;invalid data provided
;
;	unstacker
;
BDRET	OR	A		;set flags
	POP	DE		;restore stack
	POP	HL
	POP	BC
	POP	IX
	RET
;
;	convert binary to ascii
;
BIN2ASC EX	DE,HL		;HL = binary number
B2ALP	LD	A,'0'           ;start digit
	LD	E,(IX)		;get table byte
	LD	D,(IX+1)	;for conversion
;
;	convert digit
;
B2ALP1	OR	A		;clear carry
	SBC	HL,DE		;remove this
	JR	C,B2ALP2	;have the digit
	INC	A		;bump ascii digit
	JR	B2ALP1		;go till found
B2ALP2	ADD	HL,DE		;adjust for last sub
	LD	(BC),A		;put into string
	INC	BC		;bump string
	INC	IX		;bump table
	INC	IX
	DEC	E		;see if terminator
	JR	NZ,B2ALP	;do next digit
	XOR	A		;set Z for OK
	JR	BDRET		;done, pop stack
;
;	table defining decimal places
;
DECTBL	DW	10000		;define decimal places
	DW	1000
	DW	100
	DW	10
	DW	1
;
*EJECT
;
;	$MPYDIV - SVC 23
;	multiply/divide (16 bit precision)
;
; multiply
;	ENT	B = 0 = multiply
;		HL = multiplicand
;		C = multiplier
;
;	EXT	HL = result (product HL * C)
;		A = overflow byte
;		C flag = overflow
;		Z flag = result is 0000
;
; divide
;	ENT	B <> 0 = divide
;		HL = dividend
;		C = divisor
;
;	EXT	HL = result (quotient HL / C)
;		C = remainder
;		C flag if divide by 0 (not attempted)
;		Z flag = result is 0000
;
; (NOTE) calls may be made directly to MULT and DIVID
;
MPYDIV	XOR	A		;check for way to go
	CP	B		;B = 0?
	JR	NZ,DIVID	;go divide
;
;	multiply routine
;
MULT	PUSH	DE		;save from use
	LD	A,C		;fetch
	CALL	DMULT		;do it!
	LD	E,A		;save LSB
	LD	D,L		;MSB
	LD	A,H		;overflow byte
	EX	DE,HL		;put it back
	POP	DE		;restore stack
	OR	A		;any overflow?
	JR	Z,DIVD1 	;go if not
	SCF			;else set carry
	RET			;done
;
;	divide routine
;
DIVID	LD	A,C		;get divisor
	OR	A		;zero?
	SCF			;carry if yes
	RET	Z		;cannot divide
	CALL	DDIVD		;do it!
	LD	C,A		;C = remainder
DIVD1	LD	A,H		;get flags on HL
	OR	L
	LD	A,0		;return with a 0
	RET			;done
;
*EJECT
;
;	$BINHEX - SVC 24
;	binary to hex to binary converter
;
;	ENT	B = 0 = binary to ascii hex
;		DE = binary number to convert
;		HL => 4 byte string area
;
;		B <> 0 = ascii hex to binary
;		HL => 4 byte string to convert
;
;	EXT	Z = OK (binary to ascii ALWAYS Z)
;		NZ = A = error code (invalid chars)
;		if B <> 0, DE = value of string
;
BINHEX	PUSH	HL		;save these
	PUSH	DE
	XOR	A		;see if B = 0
	CP	B
	JR	NZ,HEX2BIN	;go hex to binary
;
;	convert binary to hex
;
BIN2HEX LD	A,D		;get MSB
	CALL	B2H		;convert to hex
	LD	A,E		;get LSB
	CALL	B2H		;convert
HDOK	XOR	A		;set Z for OK
	JR	BHRET
;
;	invalid data in string
;
BHBAD	LD	A,9		;invalid data provided
	POP	BC		;restore BC from error
;
BHRET	OR	A		;set flags
	POP	DE
	POP	HL		;restore stack
	RET
;
;	convert A to 2 hex ascii digits
;
B2H	LD	D,A		;save here
	RRCA			;move bits down
	RRCA
	RRCA
	RRCA			;high bits => low bits
	CALL	B2HLP		;convert and put in
	LD	A,D		;get it back
;
;	convert digit and place into (HL)
;
B2HLP	AND	0FH		;low 4 bits only
	ADD	A,'0'           ;add the ascii
	CP	'9'+1           ;0-9?
	JR	C,B2H1		;go if OK
	ADD	A,7		;adjust for A-F
B2H1	LD	(HL),A		;put into string
	INC	HL		;bump string
	RET			;done
;
;	hex to binary conversion
;
HEX2BIN EX	DE,HL		;DE => string
	PUSH	BC		;save it
	LD	B,4		;4 loops
	LD	HL,0		;start value
;
H2BLP	LD	A,(DE)		;get a char
	CALL	UCASE		;make it upper case
	SUB	'0'             ;remove ascii
	JR	C,BHBAD 	;error
	CP	'9'+1           ;0-9?
	JR	C,H2B1		;go if ok
	SUB	7		;adjust for a-f
	JR	C,BHBAD 	;error
	CP	16		;must be 0-15
	JR	NC,BHBAD	;error
;
;	multiply temporary result by 16
;
H2B1	ADD	HL,HL		;*2
	ADD	HL,HL		;*4
	ADD	HL,HL		;*8
	ADD	HL,HL		;*16
;
;	add new digit
;
	ADD	A,L		;add new digit
	LD	L,A		;put it back
	JR	NC,H2B2 	;go if no overflow
	INC	H		;bump high byte
H2B2	INC	DE		;bump pointer
	DJNZ	H2BLP		;go more
	POP	BC		;restore it
	EX	(SP),HL 	;replace for DE
	JR	HDOK		;return with Z
;
*EJECT
;
;	$TIMER	- SVC 25
;	setup/remove user timer
;
;	ENT	HL = vector address
;		BC = number of seconds to time
;
;	if HL and BC = 0, timer is turned off
;	if HL = 0, and BC <> 0, reset time to BC
;
;	EXT	Z = OK
;		NZ = A = error code
;
TIMER	LD	A,H		;for compare
	OR	L		;see if 0
	JR	Z,TIMV0 	;timer vector 0000
;
;	initialize timer
;
	LD	(DATAK2),HL	;timer vector
	LD	(DATAK1),BC	;timer counter
	LD	BC,-1<8+7	;B = add, C = slot 7
	JP	NMICTL		;add the task
;
;	see if reset or remove
;
TIMV0	LD	A,B		;see if BC = 0
	OR	C
	JR	Z,TIMREM	;remove timer
	LD	(DATAK1),BC	;reset the counter
	XOR	A		;done, return Z
	RET
;
TIMREM	LD	BC,0<8+7	;B = remove, C = slot
	JP	NMICTL		;kill it
;
*EJECT
;
;	$LOOKUP - SVC 28
;	lookup entry in table
;
;	ENT	HL => lookup table (FF terminator)
;		B = search key
;
;	EXT	Z = found, HL = address
;		NZ = A = error code (not found)
;
LOOKUP	PUSH	HL		;save table start
LOOKLP	LD	A,(HL)		;get an entry
	INC	A		;FF ?
	JR	Z,LOOKNOT	;not found
	DEC	A		;put it back
	CP	B		;right one?
	JR	Z,LOOKHAV	;have it
	INC	HL		;bump it
	INC	HL
	INC	HL
	JR	LOOKLP		;get next entry
;
;	key found, fetch vector
;
LOOKHAV INC	HL		;point to vector
	LD	A,(HL)		;get LSB
	INC	HL
	LD	H,(HL)		;get MSB
	LD	L,A		;HL = vector
	POP	AF		;restore stack
	XOR	A		;set Z for found
	RET			;done
;
;	not found in table
;
LOOKNOT LD	A,2		;'char not available'
	OR	A		;set NZ
	POP	HL		;restore stack
	RET
;
*EJECT
;
;	$HLDKEY - SVC 29
;	hold key processor
;
;	ENT	B = 0 = turn off processor
;			(hold generates data 00)
;		B = 1 = turn on hold processor
;			(hold intercepted by DOS)
;		B > 1 = check for hold, wait if yes
;
;	EXT	Z = hold processor active
;		NZ = hold processor off
;
HLDKEY	PUSH	IX		;save
	LD	A,KDCB@ 	;keyboard device
	CALL	LOCDCB		;locate DCB
	LD	A,B		;get switch
	OR	A		;B = 0 ?
	JR	Z,HLDOFF	;turn it off
	DEC	A		;B = 1 ?
	JR	Z,HLDON 	;turn it on
;
;	check for HOLD & wait
;
	BIT	4,(IX+5)	;processor active?
	JR	Z,HLDOFF	;processor is off!
	BIT	2,(IX+5)	;hold pressed?
	JR	Z,HLDON 	;not pressed!
	RES	2,(IX+5)	;reset hold
;
HLDWAIT BIT	2,(IX+5)	;wait here for it
	JR	Z,HLDWAIT	;bit will change
;
;	Turn hold on, return Z
;
HLDON	SET	4,(IX+5)	;set active
	RES	2,(IX+5)	;turn off hold pressed
	POP	IX		;restore
	XOR	A		;set Z flag
	RET
;
;	Turn  hold off, return NZ
;
HLDOFF	RES	4,(IX+5)	;turn off processor
	POP	IX		;restore
	OR	-1		;set NZ flag
	RET			;done, NZ = inactive
;
*EJECT
;
;	$STCMP	- SVC 22
;	compare 2 strings
;
;	ENT	DE => first string
;		HL => second string
;		BC = length to compare
;
;	EXT	BC, DE, HL preserved
;		Z = strings identical
;		NZ = not identical
;		Carry = DE string less than HL string
;		DE' => first non-match string #1
;		HL' => first non-match string #2
;		BC' = number of chars remaining
;
STCMP	PUSH	BC		;pass registers to alt
	PUSH	DE
	PUSH	HL
;
;	load into alternate registers
;
	EXX			;swap sets
	POP	HL		;load 'em up
	POP	DE
	POP	BC
;
STC1	LD	A,(DE)		;get first byte
	CP	(HL)		;same as second?
	JR	NZ,STC2 	;return if not
	LDI			;advance parameters
	JP	PE,STC1 	;go if more left
;
STC2	EXX			;swap original back
	RET			;done
;
*EJECT
;
;	$STSCAN - SVC 49
;	scan block of data for a string
;
;	ENT	HL => text area to search
;		DE => string to locate
;		B = length of string
;
;	EXT	NZ = not found, HL unchanged
;		Z = found, HL => matching string
;
; scan will terminate if a string match is found
;	or on the first 0DH found in (HL)
;
STSCAN	PUSH	BC		;save registers
	PUSH	HL
	LD	C,B		;load BC with length
	LD	B,0
;
STS1	LD	A,(HL)		;get a byte
	CP	13		;C/R?
	LD	A,2		;'not available'
	JR	Z,STS3		;return if yes
;
;	see if match found
;
	CALL	STCMP		;compare strings
	JR	Z,STS2		;go if match
;
;	increment block pointer and try again
;
	INC	HL		;else bump data block
	JR	STS1		;try next one
;
;	found, force match address into HL
;
STS2	XOR	A		;set Z flag
	EX	(SP),HL 	;update HL
;
;	unstack and return
;
STS3	POP	HL		;unstack
	POP	BC
	OR	A		;set flags
	RET			;done
;
*EJECT
;
;	$XLATE
;	translate character in A from table
;
;	ENT	HL => table (2 byte entries)
;		B = number of entries in table
;		A = byte to translate
;
;	EXT	HL, B destroyed
;		NZ = not translated, B = 0
;		Z = translated, A = new char
;
XLATE	CP	(HL)		;this entry match?
	JR	Z,GOXLATE	;found it, translate
	INC	HL		;bump table pointer
	INC	HL		;to next entry
	DJNZ	XLATE		;go for B reg entries
	RET			;not found, do not change
GOXLATE INC	HL		;point to xlate byte
	LD	A,(HL)		;get it
	RET			;A = translated byte
;
;	$UCASE
;	convert character in A to upper case
;
;	ENT	A = character to convert
;
;	EXT	A = character in upper case
;		(codes <60H and >7FH are NOT converted)
;
UCASE	CP	'a'             ;already upper?
	RET	C		;don't change
	CP	'z'+1           ;non-ascii
	RET	NC		;don't change
	AND	5FH		;else make it upper
	RET
;
*EJECT
;
;	$FETMEM - fetch high memory block
;
;	ENT	BC = # of bytes requested in HIMEM
;
;	EXT	NZ = A = error code (insufficient mem)
;		Z = OK
;		BC = number bytes requested (unchanged)
;		HL => first free memory address to use
;		(HIMEM) is adjusted accordingly
;
FETMEM	PUSH	DE		;save
	PUSH	HL		;this too
;
	LD	HL,(DATAK7)	;get himem
	LD	DE,(DATAK6)	;get lomem
	OR	A		;clear carry
	SBC	HL,DE		;HL = free memory
;
	OR	A		;clear
	SBC	HL,BC		;check for enough
	LD	A,82		;'insufficient mem'
	JR	C,FETMRET	;nope, return NZ
;
	LD	HL,(DATAK7)	;fetch topmem
	SBC	HL,BC		;new topmem
	LD	(DATAK7),HL	;update
	INC	HL		;hl => user area
	EX	(SP),HL 	;to the stack
	XOR	A		;set Z
;
FETMRET POP	HL		;unstack & return
	POP	DE
	RET			;Z = all set to go!
;
;
;	$RECMEM - reclaim high memory area
;
;	ENT	HL => address of last block in memory
;		BC = length of block
;
;	EXT	memory reclaimed if (HIMEM) = HL-1
;
RECMEM	PUSH	HL		;save
	PUSH	BC		;save it
	LD	BC,(DATAK7)	;get topmem
	SCF			;clear carry
	SBC	HL,BC		;same?
	JR	NZ,RECRET	;done, return
	POP	HL		;get length
	PUSH	HL		;put it back
	ADD	HL,BC		;HL = reset topmem
	LD	(DATAK7),HL	;put it back
;
RECRET	POP	BC		;unstack & ret
	POP	HL
	RET
 