;CLOCKS/ASM - LS-DOS 6.2
	SUBTTL	'<Heartbeat & Bank handling>'
	PAGE	OFF
*MOD
;
;	Model IV time clock & blinking cursor
;
TIMETBL	DB	60,60,24,30	;Sec/min, min/hr, hr/day
TIMTSK$
	LD	A,(CRSAVE)	;If cursor not on,
	OR	A		;  then don't blink
	LD	HL,VFLAG$	;Point to video flag
	JR	Z,$?2
				;Check if blinking
	BIT	7,(HL)		;Check system INHIBIT
	RES	7,(HL)		;Allow blink next time
	JR	NZ,$?2
	INC	(HL)		;Increment the counter
	BIT	3,(HL)		;  & see if to 8
	JR	Z,$?2		;Not this time
	RES	3,(HL)		;Reset counter
	BIT	6,(HL)		;Check if SOLID cursor
	JR	Z,NOSOLID	;If not, then blink
	SET	5,(HL)		;Force SOLID mode
NOSOLID	CALL	ENADIS_DO_RAM	;Bring up the video RAM
	LD	A,(HL)		;Grab the toggle bit
	XOR	20H		;  and flip it
	LD	(HL),A
	AND	20H		;Was it on?
	LD	DE,(CURSOR)	;Get the cursor pos
	LD	A,(CRSAVE)	;  and char under cursor
	JR	NZ,$?1		;Put character if flip on
	LD	A,(CRSCHAR)	;  else put the cursor
$?1	LD	(DE),A		;Put the char
$?2	LD	IX,TIMETBL	;Point to data area
	DEC	(IX+3)		;Count down by 30
	RET	NZ		;Back if not one second
	IF	@HZ50
	LD	(IX+3),25	;Set for 50 hertz
HERTZ$	EQU	$-1
	ELSE			;  else use 60 hertz
	LD	(IX+3),30	;Reset for one second
HERTZ$	EQU	$-1
	ENDIF
	BIT	4,(HL)		;Is clock on? (VFLAG$)
	JR	Z,$?3		;Go if off
	LD	DE,CLOCK	;Set to display clock
	PUSH	DE
$?3	LD	B,3
	LD	HL,TIME$
	LD	DE,TIMETBL	;Pt to max sec, min, hr
TIMER1	INC	(HL)		;Bump time parm
	LD	A,(DE)
	SUB	(HL)
	RET	NZ		;Ret if not max
	LD	(HL),A		;  else set to 0
	INC	L		;Pt to next parm
	INC	E
	DJNZ	TIMER1		;Loop thru 3 parms
;
;	Update date at midnight
;
	LD	L,DATE$+2&0FFH	;Point to day of month
	LD	A,(HL)		;Get the month
	OR	A		;See if date used
	RET	Z		;Back if not
	DEC	L
	LD	DE,MAXDAY$	;Point to test table
	INC	(HL)		;Bump the day
	ADD	A,E
	LD	E,A
	LD	A,(DE)		;P/u max days
	CP	(HL)		;Is day in range?
	RET	NC		;Return if it is
	LD	(HL),1		;  else reset day to 1
	INC	L		;  & bump the month
	INC	(HL)
	LD	A,(HL)		;If went past Dec,
	SUB	12+1		;  then need to fix
	RET	C
	LD	(HL),1		;Correct to Jan
	DEC	L		;Backup to year
	DEC	L
	INC	(HL)
	RET
;
;	Clock display processor
;
CLOCK
	CALL	ENADIS_DO_RAM	;Bring up the video
	LD	HL,CRTBGN$+69	;Point to display CRT
@TIME	LD	DE,TIME$+2	;Point to time$
	LD	C,':'		;Set the separator
TIME1	LD	B,3		;Init for three fields
TIME2	LD	A,(DE)		;Get a field item
	LD	(HL),2FH	;Init display
TIME3	INC	(HL)		;Bump until proper digit
	SUB	10
	JR	NC,TIME3
	ADD	A,3AH		;Correct the remainder
	INC	HL		;Bump to next display
	LD	(HL),A		;  & stuff the digit
	INC	HL
	DEC	B
	RET	Z		;Back when done
	LD	(HL),C		;  else stuff separator
	INC	HL
	DEC	DE		;Point to next field
	JR	TIME2		;  & loop
;
;	Return formatted date, HL => user buffer
;
	IF	@BLD631
DATELO$				;<631>
	ELSE
@DATE
	ENDIF
	LD	DE,DATE$+2
	LD	C,'/'
	JR	TIME1
;
PCSAVE$	DW	00		;PC at entry to RST 38
;
;	Dynamic Trace routine
;
TRACE_INT
	DW	$+2
	LD	HL,(PCSAVE$)
	EX	DE,HL		;Program counter to DE
	CALL	ENADIS_DO_RAM	;Bring up the video
	LD	HL,CRTBGN$+62	;Crt trace adr
;
;	Hexadecimal display routine
;
@HEX16	LD	A,D		;Convert reg D to
	CALL	@HEX8		;  two hex digits
	LD	A,E		;Convert reg E to
@HEX8	PUSH	AF		;  two hex digits
	RRA			;Do left nybble first
	RRA
	RRA
	RRA
	CALL	HXD1		;Bits 0-3 stuffed in hex
	POP	AF		;Reget the byte
HXD1	AND	0FH		;  & use right nybble
	ADD	A,90H		;Convert nybble to hex
	DAA
	ADC	A,40H
	DAA
	LD	(HL),A		;Stuff in (HL)
	INC	HL
	RET
;
;	Scan for PAUSE or BREAK & set KFLAG$
;
SHIFT	EQU	0F480H
	IF	@USA
KB1	EQU	0F401H
	ENDIF
	IF	@GERMAN
KB1	EQU	0F420H
	ENDIF
	IF	@FRENCH
KB1	EQU	0F408H
	ENDIF
KB7	EQU	0F440H
KCK@	CALL	ENADIS_DO_RAM	;Bring up the keyboard
	LD	HL,KFLAG$	;Hang onto flag
	LD	A,(SHIFT)	;P/u SHIFT row & ignore
	AND	7		;  CTRL key pressed
	CPL
	BIT	2,A
	RET	Z		;Back if CTRL
;
;	Set carry flag if a SHIFT key is down
;
	ADD	A,1		;Set CF if no SHIFT
	CCF			;Set CF if SHIFT
	JR	NC,KCK1		;No pause if no SHIFT
	LD	A,(KB1)		;Test for "@"
	IF	@USA
	BIT	0,A
	ENDIF
	IF	@INTL
	BIT	4,A		;Foriegn keyboard
	ENDIF
	JR	Z,KCK1A		;Bypass if no "@"
	SET	1,(HL)		;Turn on pause bit
	JR	KCK1A
;
;	Inhibit test of unshifted BREAK if nested ENA_DO
;
KCK1	LD	A,(OPREG_SV_PTR) ;If not at highest level
	SUB	OPREG_SV_AREA+1&0FFH ;  then don't allow
	JR	NZ,KCK1B	;  tasker BREAK handler
KCK1A	LD	A,(KB7)		;Check on BREAK & ENTER
	BIT	0,A		;Check on ENTER
	JR	Z,KCK1B		;Go if not
	SET	2,(HL)		;  else note set
KCK1B	BIT	2,A		;Is <BREAK> depressed?
	PUSH	AF
	JR	Z,KCK2		;Go if not
	JR	C,KCK2		;Ignore if shifted
	LD	A,(SFLAG$)	;Permit break bit only
	BIT	4,A		;  if BREAK enabled?
	JR	NZ,KCK2
	SET	0,(HL)		;Turn on BREAK bit
KCK2	POP	AF		;C=shift, NZ=break
	RET
;
;	Routine to enable video RAM & change stack if necessary
;
*MOD
ENADIS_DO_RAM
	DI			;Can't while we test stack
	LD	(HLSAV),HL	;Save HL but not on stack
	PUSH	AF		;Save AF
	POP	HL
	LD	(AFSAV),HL
	LD	HL,0C03H	;Can't exceed X'F3FC'
	ADD	HL,SP
	JR	NC,$?1
;
;	Switch to the system stack
;
	POP	HL		;Transfer RET address
	LD	(SPSAV),SP	;Save stack pointer
	LD	SP,STACK$-40H	;Keep room at top
	PUSH	HL		;Put RET back
$?1	LD	HL,DIS_DO_RAM	;Stack return to disable
	EX	(SP),HL		;  video RAM below RET
	PUSH	HL
	LD	HL,OPREG_SV_AREA
OPREG_SV_PTR	EQU	$-2
	INC	HL		;Get next save location
	LD	A,(OPREG$)	;P/u port mask
	JR	NC,$?2		;Bypass if NC (no stack switch)
	AND	7FH		;Strip bit 7 to use as flag
$?2	LD	(HL),A		;Save current state
	AND	0FCH		;Strip SEL1 & SEL0
	OR	82H		;Set SEL1,0 = (1,0) & NZ condx
	JR	DOOPREG		;Set new assignment
;
;	Routine to disable video RAM
;
DIS_DO_RAM
	DI			;Interrupts off
	LD	(HLSAV),HL	;Save off of stack
	PUSH	AF
	POP	HL		;Save AF
	LD	(AFSAV),HL
	LD	HL,(OPREG_SV_PTR)
	LD	A,(HL)		;P/u previous state
	BIT	7,A		;Test if we switch stack
	SET	7,A		;Make sure PAGE is set
	DEC	HL
;
DOOPREG	LD	(OPREG_SV_PTR),HL
	LD	(OPREG$),A	;Restore port image
	OUT	(@OPREG),A	;  and the port
	JR	NZ,$?3
;
;	Switch back to the old stack
;
	LD	SP,$-$		;Get the old stack
SPSAV	EQU	$-2
$?3	LD	HL,$-$
AFSAV	EQU	$-2
	PUSH	HL		;Restore AF
	POP	AF
	LD	HL,$-$		;Restore HL
HLSAV	EQU	$-2
	EI			;Interrupts back on
	RET
OPREG_SV_AREA	EQU	$-1
	DB	0,0,0,0,0,0,0,0
;
;	Bank selection SVC handler
;	HL=> transfer address for function B=0
;	C => Bank request <0-2>; Set bit 7 to transfer
;	B => Request function
;		0 => Select bank C
;		1 => Reset in-use bit of bank C
;		2 => Test in-use bit of bank C
;		3 => Set in-use bit of bank C
;
*MOD
@BANK
	AND	7FH		;Strip possible bit 7
	CP	2+1		;Bank out of range?
	JP	NC,PERR
	DEC	B		;Check option
	JP	M,$?3		;Go if bank select
	LD	C,86H		;Set for reset BUR$
	JR	Z,$?1		;Go if function 1
	LD	C,46H		;Set for test BUR$
	DEC	B
	JR	Z,$?1		;Go if function 2
	DEC	B
	JR	Z,$?0		;Go on set BUR$
	DEC	B
PERRX	JP	NZ,PERR		;SVC parameter error
	LD	A,(LBANK$)	;P/u current bank
	CP	A
	RET
$?0	LD	B,A		;Save the bank requested
	CALL	$?1		;Test if in use already
	RET	NZ		;Back if error
	LD	A,B		;Reget the request #
	LD	C,0C6H		;Set for set BUR$
$?1	AND	7		;Strip to bank 0-7
	RLCA			;Shift <0-2> to <3-5>
	RLCA
	RLCA
	OR	C		;Merge the code type
	LD	($?2+1),A	;Change the OP code
	XOR	A		;Init Z-flag
	LD	A,8		;Init "Device not avail
	PUSH	HL		;Don't alter HL
	LD	HL,BUR$		;Point to bank-used-RAM
$?2	BIT	0,(HL)		;*** Modified instruction
	POP	HL
	RET
$?3	PUSH	HL		;Ck if stack is in upper
	LD	HL,8005H	;  bank area
	ADD	HL,SP
	POP	HL
	JP	C,PERR		;Error if > X'7FFE'
	CP	1		;Change <0, 1, 2, 3>
	RLA			;  to <1, 2, 4, 6>
	LD	B,A		;  & save for later
	LD	A,(BAR$)	;P/u Bank Avail Ram
	AND	B		;Is the bank installed?
	JR	NZ,PERRX	;Error if not in machine
	LD	A,B		;Get the requested bank
	RRA			;Change <1, 2, 4> to
	CCF			;  <0, 2, 3> {CF on 0
	ADC	A,0		;  switched to 2 & 4}
	RLCA			;Shift bits 0-1
	RLCA			;  to 4-5 (MBIT0,1)
	RLCA
	RLCA
	LD	B,A		;Save bit mask
	LD	A,(OPREG$)	;P/u current memory
	AND	08FH		;  configuration &
	OR	B		;  mask off old &
	LD	(OPREG$),A	;  merge the new
	OUT	(@OPREG),A	;Switch the hardware
	LD	A,(LBANK$)	;Get old bank #
	LD	B,A		;  & save it
	LD	A,C		;P/u new bank #
	AND	7FH		;Strip any bit-7
	LD	(LBANK$),A	;  & save new bank #
	XOR	C		;Keep bit-7
	OR	B		;Merge in new bank #
	LD	C,A		;  & replace into C
	BIT	7,C		;Transfer to new bank?
	LD	B,0		;Init for invoke later
	RET	Z		;No if bit-7 = 0
	EX	(SP),HL		;Exchange RET with new
	CP	A		;  transfer & go to it
	RET