;	The following ten symbols define important reference points
;	in the computer's memory map.  These symbols are usually
;	defined in the BIOS source, so if you incorporate the CPM3BUFF
;	source into your own BIOS source, you will probably not need to
;	define any of these symbols.  The only ones that MUST be defined
;	for CPM3BUFF are "BDOS" AND "BIOS".
;
;SIZE DEFINITIONS
;----------------
MSIZE	EQU	64		; Memory size of target CP/M (in K-bytes)
SIZE	EQU	(MSIZE*1024)	; Memory size of target CP/M (in bytes)
;
CCPLN	EQU	800H		; Length of the CCP (in bytes)
BDOSLN	EQU	0E00H		; Length of BDOS (in bytes)
BIOSLN	EQU	1CH		; Length of BIOS (in 256 byte "pages")
;
;STARTING ADDRESSES
;------------------
;
CBIOS	EQU	SIZE-(BIOSLN*100H)	; Start address of customized BIOS
BIOS	EQU	CBIOS			; Address of BIOS jump table
BDOS	EQU	BIOS-BDOSLN		; Start address of BDOS
CCP	EQU	BDOS-CCPLN		; Start address of CCP
CCPBUFF	EQU	CCP+8			; CCP command line buffer
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;
;=========================================================================
;
WCBFUNC	EQU	9		; C-reg parameter value for BDOS function 9..
;				;  ..Write Console Buffer
;
;
LF EQU	0AH
CR EQU	0DH
;
	ORG	100H
;
;
	LD	DE,CCPBUFF	; Announce that we're here!!
	LD	C,WCBFUNC
	CALL	BDOSNTRY
;
;	routine to move buffer code into BIOS memory space
;
	LD	DE,LODPOINT
	LD	HL,LOMEMLOC
	LD	BC,CODESIZE
	LDIR
;
	JP	SETCLOCK	; Go to routine to set time and date

;
;
NEXTPAGE EQU	(($/100H)+1)*100H	; Define a symbolic reference to..
;					;  ..the next memory page, and..
	DS	NEXTPAGE-$		;   ..zero-fill to that address
;
;
LOMEMLOC EQU	$	; Location in low memory where CPM3BUFF is loaded
LODPOINT EQU	0FD00H	; Location in high memory to which CPM3BUFF is moved..
;			;  ..before execution
;
BIAS	EQU	LODPOINT-LOMEMLOC	Define BIAS for address offsets
;
;=========================START OF BUFFER ROUTINE=========================
;
;	Replacement for BDOS function 10 (Read Console Buffer)
;
;
;	Define some symbols referencing BDOS and BIOS entry points
;
;
;	The next two symbols refer to locations within BDOS.
;	These differ depending upon your CP/M revision level.
;
;	See CPM3BUFF.DOC for treatise on how to find these addresses.
;
;	They are currently commented out to prevent conflict with the..
;	 ..testbed program.  Re-Enable them when you incorporate the..
;	  ..buffer routine into your BIOS.
;
CTLPTOGL EQU	BDOS+30DH	; ^P toggle (echo screen to printer)
;
;
BUFFADDR EQU	BDOS+343H	; Pointer to User's message buffer
;
;
;	The next two symbols refer to locations within BIOS.
;	They probably conflict with symbols within your BIOS
;	source.  If they do, and you incorporate this source
;	into your BIOS source, you can delete them so that the
;	references to those symbols will be correctly resolved.
;
CONIN	EQU	BIOS+(3*3)	; CONIN  position in BIOS vector table
CONOUT	EQU	BIOS+(4*3)	; CONOUT position in BIOS vector table
;
;
;	The next 27 symbols define the ASCII values for the null (00H)
;	and the control letter keys.
;
CTRLA	EQU	'A'-40H		; Define..
CTRLB	EQU	'B'-40H
CTRLC	EQU	'C'-40H
CTRLD	EQU	'D'-40H
CTRLE	EQU	'E'-40H
CTRLF	EQU	'F'-40H		;  ..symbols..
CTRLG	EQU	'G'-40H
CTRLH	EQU	'H'-40H
CTRLI	EQU	'I'-40H
CTRLJ	EQU	'J'-40H
CTRLK	EQU	'K'-40H		;   ..for..
CTRLL	EQU	'L'-40H
CTRLM	EQU	'M'-40H
CTRLN	EQU	'N'-40H
CTRLO	EQU	'O'-40H
CTRLP	EQU	'P'-40H		;    ..all..
CTRLQ	EQU	'Q'-40H
CTRLR	EQU	'R'-40H
CTRLS	EQU	'S'-40H
CTRLT	EQU	'T'-40H
CTRLU	EQU	'U'-40H		;     ..control..
CTRLV	EQU	'V'-40H
CTRLW	EQU	'W'-40H
CTRLX	EQU	'X'-40H
CTRLY	EQU	'Y'-40H
CTRLZ	EQU	'Z'-40H		;      ..characters
;
MAXCTRL	EQU	CTRLX		; editing character with highest value
;
;
;	The next three symbols define the ASCII values for
;	cursor positioning.  Refer to your terminal documents
;	for the correct values for your terminal
;
CURSORRT EQU	CTRLF		; Define Cursor Right code for console used
;				;  (CTRLF on ADDS Viewpoint, ..
;				;   CTRLL on LSI, etc.)
;
CURSORLF EQU	CTRLH		; Define Cursor Left code for console used
;				;  (CTRLH on ADDS, may differ on others)
;
BELL	EQU	CTRLG		; Define the Bell character for console used
;
DELETE	EQU	07FH		; Define Delete Key value
;
;
CPM3BUFF:		; Main entry point to CP/M 3.x style console buffer..
;			;  ..routine
	CALL	LOADADDR+BIAS	; Get caller's buffer address
	INC	HL		; Bump past the length byte
	PUSH	HL		; Copy address..
	POP	DE		;  ..into End-of-Message pointer
;
READBUFF:		; Start of main loop
	PUSH	DE		; Save End-of-Message pointer..
	PUSH	HL		;  ..and Cursor Pointer
	CALL	CONIN		; Go get data byte from user
	POP	HL		; Restore Cursor Pointer and..
	POP	DE		;  ..End-of-Message pointer
	CALL	PROCESCH+BIAS	; Process the input character
	JR	READBUFF	; Repeat until user types CR or LF, or..
;				;  ..a ^C as first byte in message
;
PROCESCH:		; Process the character just read
	CP	DELETE		; Is data byte DELETE?
	JR	Z,DELPROC	; Process DELETE key like BACKSPACE
	CP	MAXCTRL+1	; Test for valid range, process as data..
	JR	NC,STORE	;  ..if NOT an editing control character
	PUSH	HL		; Save cursor pointer
	LD	HL,PROCTABL+BIAS ; Load pointer to procedure vector table
	LD	C,A		; Use data byte as a..
	LD	B,0		;  ..pointer into the..
	ADD	HL,BC		;   ..procedure table
	LD	C,(HL)		; Add in the..
	ADD	HL,BC		;  ..procedure offset
	EX	(SP),HL		; Restore HL value from stack
	RET			; Pop computed procedure address into PC
;
;
PROCTABL:
	DB	CTL@PROC-$	; "null" character (00H)
	DB	CTLAPROC-$	; Vector..
	DB	CTLBPROC-$
	DB	CTLCPROC-$
	DB	CTLDPROC-$
	DB	CTLEPROC-$
	DB	CTLFPROC-$	;  ..table..
	DB	CTLGPROC-$
	DB	CTLHPROC-$
	DB	CTLIPROC-$
	DB	CTLJPROC-$
	DB	CTLKPROC-$	;   ..for..
	DB	CTLLPROC-$
	DB	CTLMPROC-$
	DB	CTLNPROC-$
	DB	CTLOPROC-$
	DB	CTLPPROC-$	;    ..Control-Character..
	DB	CTLQPROC-$
	DB	CTLRPROC-$
	DB	CTLSPROC-$
	DB	CTLTPROC-$
	DB	CTLUPROC-$	;     ..processing
	DB	CTLVPROC-$
	DB	CTLWPROC-$
	DB	CTLXPROC-$
;
;
STORE:			; Non-functional Control-character..
			;  ..or ordinary data byte
CTL@PROC:
CTLEPROC:
CTLIPROC:
CTLLPROC:
CTLNPROC:
CTLOPROC:
CTLQPROC:
CTLTPROC:
CTLUPROC:
CTLVPROC:
CTLRPROC:
	PUSH	AF		; Save data byte
	CALL	CALCETOB+BIAS	; Get total message length in B-reg
	LD	A,B		;  ..and buffer size in C-reg
	CP	C		; If buffer capacity exhausted..
	JR	NC,TOOMANY	;  ..then go to warn user
	CALL	CALCLTOE+BIAS	; Get byte count to right of cursor
	JR	Z,NOPUSH	; If 0, then no data to push to right
	PUSH	DE		; Copy End-of-Message..
	POP	IX		;  ..address to IX-reg
PUSHLOOP:		; Shift everything from cursor one byte to right
	DEC	IX		; Decrement index reg
	LD	A,(IX+0)	; Move indicated byte..
	LD	(IX+1),A	;  ..right one byte
	DJNZ	PUSHLOOP	; Loop on byte count
NOPUSH:
	POP	AF		; Restore data byte
	LD	(HL),A		; Plug into message at cursor location
	CALL	WRITEIT+BIAS	; Write the current data byte
	INC	DE		; Bump End-of-Message pointer
	INC	HL		; Bump cursor pointer
WRITOEND:		; Re-write any bytes to right of cursor position
	CALL	CALCLTOE+BIAS	; Get byte count to right of cursor
	PUSH	AF		; Save data byte and Flags reg
	PUSH	BC		; Save current byte count
	CALL	WRITLTOE+BIAS	; Re-write any bytes which were moved
	POP	BC		; Restore current byte count
	POP	AF		; Restore data byte and Flags reg
;				; If cursor at right end of message, then..
	RET	Z		;  ..exit to main loop..
;				; Else recover cursor position on screen
;
CTLBLLUP:		; Move cursor left on screen count (B-reg) bytes
	PUSH	BC		; Save current byte count
	CALL	CTLAPROC+BIAS	; Move cursor one byte to left on screen
	POP	BC		; Restore current byte count
	DJNZ	CTLBLLUP	; Decrement byte count and loop until done
	RET
;
;
CTLGPROC:		; Eat character AT cursor position
	CALL	CTLFPROC+BIAS	; Position cursor to right of target character
	DEC	B		; If there wasn't any target character..
	RET	M		;  ..(cursor at end of message), then exit..
;				;   ..else fall into BACKSPACE routine
;
CTLHPROC:		; Eat character TO LEFT OF..
DELPROC:		;  ..cursor position (Backspace AND delete keys)
	CALL	CALCLTOB+BIAS	; Get byte count to left of cursor
	RET	Z		; Exit if there are none
	CALL	DRAGLEFT+BIAS	; Delete left character and drag rest to left
	JR	WRITOEND	; Re-write any bytes to right of cursor..
;				;  ..and exit to main loop
;
CTLCPROC:		; Control-C
	CALL	CALCLTOB+BIAS	; If ^C is not first byte in buffer..
	JR	NZ,STORE	;  ..then process as any other data byte
	CALL	WRITEIT+BIAS	; If it is the first byte in buffer..
	JP	000H		;  ..then display it and do warm boot
;
;
TOOMANY:		; Warn user the buffer is FULL!!!!
	POP	AF		; Throw away the data byte and adjust Stack
	JR	RINGBELL	; Go to ring the Bell and exit to main loop
;
;
CTLBPROC:		; Reset cursor to START or END of message
	CALL	CALCLTOB+BIAS	; Get byte count to left of cursor
;				; If any bytes to left of cursor, then..
	JR	NZ,CTLBLLUP	;  ..reset cursor to START of message
;				; If none, then reset cursor to END of message
;
CTLBRGHT:		; Re-position cursor to right end of message on screen
	CALL	CALCLTOE+BIAS	; Get byte count to right of cursor
	RET	Z		; If none, then exit
CTLBRLUP:
	PUSH	BC		; Save current byte count
	CALL	CTLFPROC+BIAS	; Move cursor one byte to right on screen
	POP	BC		; Restore current byte count
	DJNZ	CTLBRLUP	; Decrement byte count and loop until done
	RET
;
;
CTLWPROC:		; Restore previous message if buffer empty, else..
;			;  ..re-position cursor to right end of message
	CALL	CALCETOB+BIAS	; Get total current message size
;				; If buffer is NOT empty, then..
	JR	NZ,CTLBRGHT	;  ..reset cursor to END of message, else..
;				;   ..restore previous message image:
;				; Condition flags for MOVEPROC routine:
;				;  ..(Not-Zero [NZ] and Carry [C])
	XOR	A		;   ..Set accumulator = 0..
	SUB	D		;    ..Subtract some non-zero reg to force..
;				;     ..a Carry with a non-zero result
;				; (D-reg will always be non-zero, since..
;				;  ..Save-Area will NEVER be in Page 0)
	CALL	MOVEPROC+BIAS	; Call routine to move message image
	CALL	LOADADDR+BIAS	; Get Buffer address
	INC	HL		; Bump to first data byte
;
WRITLTOE:		; Write data bytes from current cursor position..
;			;  ..to end-of-message
	CALL	CALCLTOE+BIAS	; Get byte count to right of cursor 
	JR	Z,WRITPADS	; If none, write pad bytes at end and exit
WRITLOOP:
	LD	A,(HL)		; Get byte at cursor position
	CALL	WRITEIT+BIAS	; Write it to screen
	INC	HL		; Bump cursor pointer
	DJNZ	WRITLOOP	; Loop until all bytes written
WRITPADS:		; Write two pad blanks at end of message on screen 
	LD	A,' '		; Load blank character
	CALL	WRITEA+BIAS	; Write..
	CALL	WRITEA+BIAS	;  ..two blanks
	CALL	CRSRLEFT+BIAS	; Re-position cursor..
	JR	CRSRLEFT	;  ..back over the two blanks, and exit
;
;
CTLPPROC:		; process ^P (echo screen to printer) toggle:
	LD	A,(CTLPTOGL)	; Load current ^P toggle from BDOS
	XOR	01H		; Invert it
	LD	(CTLPTOGL),A	; Store it back into BDOS area
	RET	Z		; If it was ON, return to main loop
RINGBELL:
	LD	A,BELL		; But if it was OFF, warn user..
	JR	WRITEA		;  ..that it is ON now!!
;
;
CTLAPROC:		; Move cursor one byte left on screen
CTLSPROC:		; (Word-Star compatibility)
	CALL	CALCLTOB+BIAS	; Get byte-count to LEFT of cursor
	RET	Z		; If zero, then exit
	DEC	HL		; Adjust Cursor Pointer
	CALL	LEFTSPAC+BIAS	; Test if character under cursor..
;				;  ..is Control Character, adjust screen if so
	JR	CRSRLEFT	; Go shift cursor left one byte and exit
;
;
CTLFPROC:		; Move cursor right one byte on sceen
CTLDPROC:			; (Word-Star compatibility)
	CALL	CALCLTOE+BIAS	; Get byte count to right of cursor 
	RET	Z		; If zero, then exit
	LD	A,(HL)		; If not zero..
	INC	HL		;  ..then test for..
	CP	' '		;   ..control-character..
	CALL	C,CRSRIGHT+BIAS	;    ..and move cursor TWO bytes on screen
CRSRIGHT:
	LD	A,CURSORRT	; Load cursor-to-right control
	JR	WRITEA		; Write to screen and exit
;
;
CTLKPROC:		; Clear all bytes to RIGHT of cursor
	CALL	CALCLTOE+BIAS	; Get byte-count to RIGHT of cursor
	RET	Z		; If zero, then exit
CTLKLOOP:
	PUSH	BC		; Save current byte count
	CALL	CTLGPROC+BIAS	; Delete the byte AT the cursor
	POP	BC		; Restore current byte count
	DJNZ	CTLKLOOP	; Decrement byte count and loop until done
	RET
;
;
CTLJPROC:		; Line-Feed (treated as a Carriage-Return)
	LD	A,CTRLM		; Force data-byte to Carriage-Return
CTLMPROC:		; Carriage-Return (signals user is done)
	POP	BC		; Throw away "Return to main loop"..
;				;  ..(now a RET will return to BDOS!)
	CALL	WRITEA+BIAS	; Write the Carriage-Return to screen
	CALL	CALCETOB+BIAS	; Get total message length in B-reg
;
;
MOVEPROC:		; Move message from buffer to save, or vice-versa:
;
;	If entered with Zero-flag set, then set length byte to zero & exit.
;	If entered with Carry-flag set (Zero-flag will NOT be set in this case)
;	 ..then move buffer save-area to user's buffer, and exit
;	If entered with NEITHER Carry-flag NOR Zero-flag set,
;	 ..then move user's buffer to save-area, and exit
;
	CALL	LOADADDR+BIAS	; Get message buffer address
	LD	(HL),B		; Plug byte count into message length byte..
	RET	Z		; Dont bother saving buffer if it's empty
	LD	DE,SAVEAREA+BIAS	; Get buffer save-area address
	JR	NC,GETCOUNT	; If direction flag set..
	EX	DE,HL		;  ..then swap pointers to restore save-image
GETCOUNT:
	LD	C,SAVESIZE	; Set maximum move-length
	LD	A,(HL)		; Get count from first byte of source buffer
	LD	B,0		; Zero hi-order byte of size-regs
	CP	C		; If message is smaller than target buffer..
	JR	NC,OVRLIMIT	;  ..then use actual message size from..
	LD	C,A		;   ..count in first byte of source buffer
OVRLIMIT:
	LD	A,C		; Save number of bytes moved in A-reg
	INC	BC		; Bump length to account for byte count
	LDIR			; Move byte count and message image
	LD	(SAVEAREA+BIAS),A ; Set save area byte count to..
;				;    ..actual number of bytes moved
	RET
;
;
CTLXPROC:		; Clear all bytes to LEFT of cursor
	CALL	CALCLTOB+BIAS	; Get byte-count to LEFT of cursor
	RET	Z		; If zero, then exit
CTLXLOOP:
	PUSH	BC		; Save current byte count
	CALL	CTLHPROC+BIAS	; Call routine to delete one byte to left
	POP	BC		; Restore current byte count
	DJNZ	CTLXLOOP	; Decrement byte count and loop until done
	RET
;
;
DRAGLEFT:		; Shift bytes to right of cursor left in buffer
	DEC	HL		; Decrement End-of-Message pointer
	DEC	DE		; Decrement cursor pointer
	CALL	LEFTSPAC+BIAS	; check if character moved onto..
;				;  ..is a control-character
	CALL	CALCLTOE+BIAS	; Get byte-count to RIGHT of cursor
	JR	Z,CRSRLEFT	; If zero, then no bytes to drag
	PUSH	HL		; Copy cursor pointer.. 
	POP	IX		;  ..to IX-reg
DRAGLOOP:
	LD	A,(IX+1)	; Get character to right of cursor..
	LD	(IX+0),A	;  ..and shift it left one byte
	INC	IX		; Bump pointer
	DJNZ	DRAGLOOP	; Loop on byte-count
;
CRSRLEFT:		; Shift cursor left on screen one byte
	LD	A,CURSORLF	; Load Control Character to shift cursor left
;
WRITEA:			; Write byte in A-reg to console device
	PUSH	AF		; Save AF-regs
WRITECHR:		; Enter here if AF-regs already PUSHed
	PUSH	HL		; Save..
	PUSH	DE		;  ..rest of..
	PUSH	BC		;   ..registers
	LD	C,A		; Set up for CONOUT call
	CALL	CONOUT		; Call standard BIOS console output routine
	POP	BC		; Restore..
	POP	DE		;  ..
	POP	HL		;   ..
	POP	AF		;    ..registers
	RET
;
;
LEFTSPAC:		; Adjust cursor on screen when back-spacing..
;			;  ..over control characters
	LD	A,(HL)		; Get byte at cursor position
	CP	' '		; Is it a control character
	RET	NC		; No - return to caller
	JR	CRSRLEFT	; Yes - adjust cursor one byte left on screen..
;				;  ..and return to caller
;
WRITEIT:		; Write a data byte to screen.
;			;  (control characters written with carat [e.g.  ^Z ])
	PUSH	AF		; Save data byte
	CP	' '		; Is it a control character?
	JR	NC,WRITECHR	; No - just go and write it and exit
	ADD	A,'@'		; Yes - force it to visible range of ASCII
	PUSH	AF		; Save it
	LD	A,'^'		; Go display..
	CALL	WRITEA+BIAS	;  ..the carat ( ^ )
	POP	AF		; Restore the "visibleized" character
	JR	WRITECHR	; Go to write it and exit
;
;
LOADADDR:		; Load buffer address into (HL-reg)..
;			;  ..and maximum message size into (C-reg)
	LD	HL,(BUFFADDR)	; Load buffer address
	LD	C,(HL)		; Load Maximum size
	INC	HL		; Bump past max-size to byte-count
	RET
;
;
CALCETOB:		; Compute current message length
	PUSH	DE		; Save End-of-Message pointer
	PUSH	HL		; Save cursor position pointer
	JR	LODBEGAD	; Go to load buffer address
;
;
CALCLTOE:		; Compute byte count from cursor to End-of-Message
	PUSH	DE		; Save End-of-Message pointer
	PUSH	HL		; Save cursor position pointer
	JR	CALCSUB		; Go to swap pointers and..
;				;  ..compute their difference
;
;
CALCLTOB:		; Compute byte count from start of buffer to cursor
	PUSH	DE		; Save End-of-Message pointer
	PUSH	HL		; Save cursor position pointer
	EX	DE,HL		; Swap cursor pointer into minuend register
LODBEGAD:
	CALL	LOADADDR+BIAS	; Get buffer address into subtrahend reg 
	INC	HL		; Bump past byte-count bucket
CALCSUB:
	EX	DE,HL		; Swap pointers
	CP	A		; Clear carry without harming A-reg
	SBC	HL,DE		; Subtract subtrahend from minuend
	LD	B,L		; Load result into B-reg
	POP	HL		; Restore cursor position pointer
	POP	DE		; Restore End-of-Message pointer
	RET
;
;
;
SAVEAREA:		; First byte of Buffer Image save area
	DB	0		; Length of current "saved" buffer image
SAVIMAGE:
	EQU	$		; Define start of save-area
;
SAVEEND	EQU	(($/100H)+1)*100H	; Define a symbolic reference to..
;					;  ..the next page boundary, to be..
;					;   ..used as the end-of-save-area..
;					;    ..address
;
;	The next symbol defines the number of bytes of the user's
;	input to be saved for recovery via the ^W function (restore
;	last previous input line).  This value can be anything from
;	1 to 255.  If the user enters an input line longer than the
;	save area, only the first SAVESIZE bytes will be saved.
;
SAVESIZE EQU	SAVEEND-SAVIMAGE	; Define buffer image save-area size
;
;
CODESIZE EQU	SAVEEND-CPM3BUFF 	; Define size of code to be moved..
;					;  ..during enablement of routine
;
; PATCH-AREA:	The following 32 lines define 256 bytes of potential
;		patch space, beginning at the defined buffer save-area.
;		If the statement above defining CODESIZE is moved down
;		below these lines, then these self-referencing words
;		will be moved into the High-Memory area where the CPM3BUFF
;		module resides, and can serve as patch-space for any
;		patching requirement.  The only caveat to using this
;		area is that ANY USE OF THE SYMBOL "SAVESIZE" IN CPM3BUFF
;		MUST BE PATCHED TO REFLECT THE REDUCED SIZE OF THE SAVE-AREA!
;		====

;		Another reason for including these self-referencing
;		words in the CPM3BUFF save-area is that it allows the
;		user to use a de-bugger to easily determine the highest
;		byte over-written during use of the save-area, and 
;		therefore to determine the longest message images input
;		thru BDOS function 10 calls.  Frequent monitoring of this
;		information after installation can be helpful in determining
;		the optimum size for the save-area, and reductions can 
;		be made by re-assembling the module with a smaller value
;		defined for SAVESIZE.
;
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
	DW	$+BIAS+0,$+BIAS+2,$+BIAS+4,$+BIAS+6
;===========================END OF BUFFER ROUTINE=========================
;
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;	SUBTTL	'(C) MORROW DESIGNS INC.'

;	TITLE	'DECISION 1 REAL-TIME CLOCK SOFTWARE' 

;************************************************************************
;*									*
;* TIME DISPLAY/SET PROGRAM FOR THINKER TOYS WBI/O BOARD.               *
;*									*
;* BOBBY DALE GIFFORD.							*
;* 9/25/80								*
;* REVISED FOR DECISION I/O ON 10/5/81  BJG				*
;*									*
;************************************************************************


REV	EQU	10		; REVISION # X.X

BASE	EQU	48H		; BASE OF MULT I/O PORTS
GRPSEL	EQU	BASE+7		; GROUP SELECT
CLK	EQU	BASE+2		; CLOCK PORT
CLKCLK	EQU	2		; CLOCK CLK BIT
CLKC1	EQU	8		; CLOCK C1 BIT
RCLK	EQU	0CH		; READ CLOCK COMMAND
CSTB	EQU	20H		; CLOCK STROBE BIT
SHFT	EQU	4		; SHIFT BITS COMMAND
TP64	EQU	10H		; OUTPUT TICK PULSES AT 64 HZ.
REGHLD	EQU	0		; REGISTER HOLD COMMAND
WCLK	EQU	8		; WRITE CLOCK COMMAND

BDOSNTRY EQU	5		; BDOS ENTRY POINT
WBOOT	EQU	0		; WARM BOOT LOCATION
CONST	EQU	11		; BDOS GET CONSOLE STATUS FUNCTION
PSTR	EQU	9		; BDOS PRINT STRING FUNCTION
READCON	EQU	10		; BDOS READ CONSOLE BUFFER FUNCTION
ACR	EQU	0DH		; CARRIAGE RETURN
ALF	EQU	0AH		; LINE FEED

;
BUFFLEN	EQU	80H		; DEFINE BUFFER AND STACK LENGTH
;
	DS	BUFFLEN		; RESERVE SPACE FOR A HUMUNGOUS STACK
STACK	EQU	$
TIMEBUF	DB	BUFFLEN		; BUFFER FOR BDOS FUNCTION 10
CLEN	DB	0		; COMMAND LENGTH BYTE
CBUFF	DS	BUFFLEN		; COMMAND BUFFER STRING

SETCLOCK:
	LD	SP,STACK	; SET UP STACK
	LD	DE,CURRENT	; SET UP TO WRITE..
	CALL	PMSG		;  ..CURRENT..
	CALL	DISPL1		;    ..DATE AND TIME
;
	LD	DE,PROMPT	; SET UP TO WRITE PROMPT
	CALL	PMSG		; CALL OUTPUT ROUTINE
;
	LD	DE,TIMEBUF	; SET UP TO READ..
	LD	C,READCON	;  ..COMMAND LINE
	CALL	BDOSNTRY
;
	LD	HL,CBUFF	; INITIALIZE..
	LD	(SCANPNT),HL	;  ..SCAN POINTER
	CALL	SKIPB		; SKIP COMMAND LINE BLANKS
	JP	Z,DISPLAY	; NO COMMAND LINE
SETT:
	LD	A,29H		; Initialize for..
	LD	(FEBLAST),A	;  ..29 day February
	LD	HL,DAYS		; ARRAY OF STRING POINTERS TO MATCH
	CALL	MATCH3		; LOOK FOR MATCH
	JP	Z,RESTART	; NO MATCH
	LD	DE,0-DAYS	; FORM INDEX
	ADD	HL,DE
	LD	A,L		; GET LOW-ORDER BYTE
	SCF			; CLEAR THE CARRY
	CCF
	RRA			; DIVIDE INDEX BY 2
	DEC	A		; Make relative to zero
	LD	(MONTHWK),A	; DAY OF WEEK FINISHED
;
	LD	HL,MONTHS	; ARRAY OF STRING POINTERS TO MATCH
	CALL	MATCH3		; LOOK FOR MATCH
	JP	Z,RESTART	; NO MATCH
	LD	DE,0-MONTHS	; FORM INDEX
	ADD	HL,DE
	XOR	A		; CLEAR THE CARRY
	LD	A,L		; GET LOW-ORDER BYTE
	RLA
	RLA
	RLA
	LD	B,A		; SAVE IN B-REG
	LD	A,(MONTHWK)
	OR	B		; OR IN WITH DAY OF WEEK
	LD	(MONTHWK),A	; 
	CALL	BCD2		; SCAN FOR TWO VALID BCD DIGITS
	JP	C,RESTART	; Restart on error
	LD	(DATE),A	; SET NEW DAY OF MONTH
	CALL	CKDATE		; Check that day-of-month doesn't..
	JP	C,RESTART	;  ..exceed last-day-of-month
	CALL	BCD2		; SCAN FOR TWO MORE VALID BCD DIGITS (century)
	JP	C,RESTART	; Restart on error
	LD	HL,CENTURY	; Test for..
	CP	(HL)		;  ..change..
	JR	Z,GETYEAR	;   ..of..
	LD	(HL),A		;    ..century
GETYEAR:
	CALL	BCD2		; SCAN FOR TWO MORE VALID BCD DIGITS (year)
	JP	C,RESTART	; Restart on error
	LD	HL,YEAR		; Test for..
	CP	(HL)		;  ..change..
	JR	Z,GETHOUR	;   ..of..
	LD	(HL),A		;    ..year
GETHOUR:
	CALL	BCD2		; SCAN FOR TWO MORE VALID BCD DIGITS (hour)
	JP	C,RESTART	; Restart on error
	CP	13H		; Test for invalid hour
	JP	NC,RESTART	; Restart on error
	LD	(HOUR),A	; Set new hour
	CALL	BCD2		; SCAN FOR TWO MORE VALID BCD DIGITS (minutes)
	JP	C,RESTART	; Restart on error
	CP	60H		; Test for invalid minutes
	JP	NC,RESTART	; Restart on error
	LD	(MINUTES),A	; Set new minutes
	CALL	BCD2		; SCAN FOR LAST VALID BCD DIGITS (seconds)
	JP	C,RESTART	; Restart on error
	CP	60H		; Test for invalid minutes
	JP	NC,RESTART	; Restart on error
	LD	(SECONDS),A	; Set new seconds
	CALL	SKIPB		; SKIP TRAILING BLANKS
	JP	Z,NOAP
	CALL	SCAN
	CALL	TOUPPER		; FORCE TO UPPER CASE
	CP	'P'		; CHECK FOR "PM"
	PUSH	AF
	CALL	Z,UPHRS
	POP	AF
	CP	'A'		; CHECK FOR "AM" / "PM"
	CALL	Z,DWNHRS
	CALL	SKIPC
	CALL	SKIPB
	JP	NZ,RESTART	; Restart on error
;
NOAP:
;!!!!!
	CALL	PRESET
	LD	DE,WAITMSG	; WAIT FOR CARRIAGE RETURN
	CALL	PMSG
	LD	DE,IBUFF	; READ CONSOLE
	LD	C,READCON
	CALL	BDOSNTRY
;!!!!!
	CALL	WRITEC		; WRITE THE TIME
	LD	DE,ACRALF
	CALL	PMSG
	CALL	DISPLAY		; DISPLAY THE CURRENT TIME
	JP	WBOOT		; ALL DONE ! ! !
;
;************************************************************************
;*									*
;* RESTART FORCES STANDARD ERROR MESSAGE AND RETRY FOR INVALID COMMANDS	*
;*									*
;************************************************************************

RESTART:
	LD	DE,ACRALF
	CALL	PMSG
	LD	HL,(SCANPNT)
	LD	DE,0-CBUFF
	ADD	HL,DE
	LD	A,L
	LD	HL,CBUFF
	OR	A
	JR	Z,RESTART3
	LD	B,A
	LD	A,' '
RESTART2:
	LD	(HL),A
	INC	HL
	DJNZ	RESTART2
RESTART3:
	LD	(HL),'^'
	INC	HL
	LD	(HL),'$'
	LD	DE,CBUFF
	CALL	PMSG
	LD	DE,BADTMSG
	CALL	PMSG
	JP	SETCLOCK

;************************************************************************
;*									*
;* CKDATE checks that the day-of-month doesn't exceed the		*
;* last-day-of-the-month
;*									*
;************************************************************************
CKDATE:
	LD	B,A		; Save Day-Of-Month
	CALL	GETMONTH	; Get month from (MONTHWK)
	DEC	A		; Make relative to zero
	LD	HL,LASTDAYS	; Load pointer to Last-day-of-month table
	ADD	A,L		; form..
	LD	L,A		;  ..index to..
	JR	NC,NOPAGE	;   ..indicated..
	INC	H		;    ..month entry
NOPAGE:
	LD	A,B		; Recover day-of-month
	LD	B,(HL)		; Load indicated last-day-of-month
	SUB	B		; Is day-of-month..
	RET	Z		;  ..equal to..
	JR	C,DATEOK	;   ..or less than the last-day-of-month?
	DAA			; No - then use difference..
	LD	(DATE),A	;  ..as day-of-month,
	LD	A,(MONTHWK)	; and bump month..
	LD	B,10H		;  ..(in hi-order nibble of MONTHWK)..
	CP	12.SHL.4	; Is next month also next YEAR?
	JR	C,NOTYROLL	; No - just update day and month
	AND	00001111B	; Yes - reset month and roll..
NOTYROLL:
	ADD	A,B		;  ..to next month
	LD	(MONTHWK),A	; Replace into memory
	XOR	A		; Zero carry flag so CCF sets it!
DATEOK:
	CCF		; Change sense of carry flag so that..
	RET		;  .."date" > "last" returns carry flag SET

GETMONTH:
	LD	A,(MONTHWK)	; Load month/week
GETHINIB:
	RRA			; Shift..
	RRA			;  ..month..
	RRA			;   ..into..
	RRA			;    ..low-order byte of A-reg
	AND	00001111B	; Throw away irrelevant bits
	RET			; Return to caller

;************************************************************************
;*									*
;* COMPYEAR: 	Computes the correct year from the month, day-of-month,	*
;*		and day-of-week.					*
;*									*
;************************************************************************

;  PROCEDURE ComputeYear;
;
;    PROCEDURE DoYear;
;    BEGIN  { DoYear }
;      I := ((Day MOD 7) - WeekDay);
;      IF I < 0
;        THEN
;          I := I + 7;
;      Year := ((FirstSundayOf [Month] - I) MOD 7) + BaseYear;
;    END;  { DoYear }
;
DOYEAR:		; On entry:
;			; HL => either FIRSTSUN or OTHERSUN table
;			; C contains the adjusted BASEYEAR value
;		; On exit:
;			; A contains the computed YEAR
;		; Scratch regs are: A, B, D, & E
;
	LD	A,(MONTHWK)	; Get the..
	AND	00001111B	;  ..day-of-the-week
	LD	B,A		; Save it
	LD	A,(DATE)	; Get the day-of-the-month
	PUSH	BC		; Save B-reg
	CALL	DECTOBIN	; Convert from BCD (decimal) to binary
	POP	BC		; Restore B-reg
	CALL	MOD7		; Divide it by 7, use the REMAINDER
	SUB	B		; Subtract out the day-of-the-week
	JR	NC,NOTMINUS	; If it goes negative..
	ADD	A,7		;  ..add 7 back in
NOTMINUS:
	LD	B,A		; Save the result
	CALL	GETMONTH	; Get the month
	DEC	A		; Make relative to zero
	LD	E,A		; Use month as..
	LD	D,0		;  ..a pointer into the.. 
	ADD	HL,DE		;   ..first-Sunday-of-the-month table
	LD	A,(HL)		; Get the day of month of the first Sunday of..
	SUB	B		;  ..this month, subtract out value in B-reg
	JR	NC,CALLMOD7	; If it goes negative, normalize by..
	ADD	A,7		;  ..adding 7 before the MOD by 7
CALLMOD7:
	CALL	MOD7		; Divide by 7 and save the REMAINDER
	ADD	A,C		; Add in the adjusted Base-Year
	DAA			; Decimal adjust
	RET			; Return to caller

;
DECTOBIN:	; Convert a decimal number (in BCD notation) to binary
;		; On entry:
;			; A contains BCD number
;		; On exit:
;			; A contains binary equivalent
;		; A, B, C are Scratch registers
	LD	C,A
	CALL	GETHINIB
	LD	B,A
	LD	A,C
	AND	00001111B
	INC	B
ADDTEN:
	DEC	B
	RET	Z
	ADD	A,10
	JR	ADDTEN	
	
;
MOD7:		; Divide A-reg by 7, Return REMAINDER in A-reg
;		; On entry:
;			; A contains dividend
;		; On exit:
;			; A contains dividend MOD 7 (remainder)
;		; NO scratch registers
	
	SUB	7
	JR	NC,MOD7
	ADD	A,7
	RET

;
;  BEGIN  { ComputeYear }
;    IF NOT ((CHR (Year) IN [CHR (BaseYear), CHR (BaseYear + 1)])
;            OR (CHR (Year) IN [CHR (BaseYear + 2)]) AND (Month < 3))
;      THEN
;        BEGIN
;          BaseYear := 88;
;          FOR I := 1 TO 12 DO
;            FirstSundayOf [ I ] := (FirstSundayOf [ I ] + 4) MOD 7;
;        END;
;  END;  { ComputeYear }

COMPYEAR:
	PUSH	BC		; Save..
	PUSH	DE		;  ..callers..
	PUSH	HL		;   ..registers
	LD	A,BASEYEAR	; Load the Base-Year..
	LD	C,A		;  ..into parm-reg (C)
	LD	HL,FIRSTSUN	; Load First-Sunday table for Base-Year
	CALL	DOYEAR		; Compute the year
	CP	BASEYEAR	; Is the computed year the Base-Year?
	JR	Z,CMPYRXIT	; Yes - store it and return to caller
	CP	BASEYEAR+1	; Is the computed year the Base-Year + 1?
	JR	Z,CMPYRXIT	; Yes - store it and return to caller
	CP	BASEYEAR+2	; Is the computed year the Base-Year + 2?
	JR	NZ,PASTLEAP	; No - then we're past the leap-year
	LD	B,A		; Yes - save the computed year 
	CALL	GETMONTH	; Get the month
	CP	3		; Is month < 3
	LD	A,B		; (restore computed year)
	JR	C,CMPYRXIT	; Yes - go to store year and return to caller
PASTLEAP:
	LD	C,BASEYEAR+2	; No - adjust Base (in C) to next Leap-Year
	LD	HL,OTHERSUN	; Load pointer to alternate First-Sunday table
	CALL	DOYEAR		; Call proc to re-compute year
CMPYRXIT:
	LD	(YEAR),A	; Store the computed year in (YEAR)
	POP	HL		; Restore..
	POP	DE		;  ..callers..
	POP	BC		;   ..registers
	RET

;************************************************************************
;*									*
;* DISPLAY CONTINUALLY DISPLAYS THE TIME AS LONG AS NOTHING IS		*
;* TYPED ON THE CONSOLE							*
;*									*
;************************************************************************

DISPLAY:
	CALL	DISPL1		; DISPLAY ONE TIME LINE
	LD	C,CONST		; CHECK CONSOLE..
	CALL	BDOSNTRY	;  ..FOR INPUT
	AND	A		; IF ANYTHING TYPED..
	JP	NZ,WBOOT	;  ..THEN RE-BOOT
	LD	DE,ACRMSG	; PRINT CARRIAGE-RETURN..
	CALL	PMSG		;  ..ONLY
	JP	DISPLAY		; GO PRINT THE TIME AGAIN

;************************************************************************
;*									*
;* DISPL1 DISPLAYS THE CURRENT TIME ONCE				*
;*									*
;************************************************************************

DISPL1:
;V!!!!V	CALL	BUMPDATE	; Bump date by one day for DEBUGGING! ! !
;^!!!!^
	CALL	READC		; READ THE CLOCK - WATCH OUT..
;				;  ..IF INTERRUPTS ARE ON	
;V!!!!V	LD	DE,ACRALF	; Do a line feed when DEBUGGING! ! !
;^!!!!^
	LD	DE,ACRMSG	; Don't do line-feed if not debugging! ! !
	CALL	PMSG
	LD	B,29H		; Load Feb. last-day-of-month for a leap-year
	CALL	COMPYEAR	; Compute the year from date and day of week
	LD	A,(YEAR)	; Get year
	RRCA			; If year is..
	JR	C,NOTLEAP	;  ..odd, it's not leap
	AND	00001001B	; If (decade MOD 2) = (year MOD 4)
	JR	Z,LEAP		;   then it's a leap year (both OFF..
	XOR	00001001B	;    ..or..
	JR	Z,LEAP		;     ..both ON)
NOTLEAP:
	DEC	B		; Bump to 29
LEAP:
	LD	A,B		; Reset February..
	LD	(FEBLAST),A	;  ..last-day-of-month
	LD	A,(DATE)	; Get day-of-month to..
	CALL	CKDATE		;  ..make sure date hasn't rolled past..
;				;   ..last-day-of-month
;!!!!
	CALL	C,RESET		; If it did, then reset to adjusted date
	LD	A,(MONTHWK)	; GET THE DAY OF THE WEEK
	AND	00000111B	; THROW AWAY IRRELEVENT BITS
OKDAY:
	RLA			; MULTIPLY BY 2
	LD	E,A		; FORM 16 BIT..
	LD	D,0		;  ..OFFSET
	LD	HL,DAYS		; ARRAY OF STRING POINTERS
	ADD	HL,DE		; FORM ABSOLUTE ADDRESS OF STRING
	LD	E,(HL)		; GET LOW STRING ADDRESS BYTE
	INC	HL		; POINT TO HIGH BYTE
	LD	D,(HL)		; GET HIGH STRING ADDRESS BYTE
	LD	A,E		; CHECK FOR..
	OR	D		;  ..INVALID DAY
	JP	Z,BADDISPL	; DISPLAY ERROR MESSAGE IF INVALID
	CALL	PMSG		; PRINT THE DAY
;
	CALL	GETMONTH	; Get month from (MONTHWK)
	DEC	A		; Make relative to zero
	ADD	A,A		; FORM..
	LD	E,A		;  ..16 BIT..
	LD	D,0		;   ..OFFSET
	LD	HL,MONTHS	; ARRAY OF STRING POINTERS
	ADD	HL,DE		; FORM ABSOLUTE ADDRESS OF STRING
	LD	E,(HL)		; GET LOW STRING ADDRESS BYTE
	INC	HL		; POINT TO HIGH BYTE
	LD	D,(HL)		; GET HIGH STRING ADDRESS BYTE
	LD	A,D		; CHECK FOR..
	OR	E		;  ..INVALID DAY
	JP	Z,BADDISPL	; DISPLAY ERROR MESSAGE IF INVALID
	CALL	PMSG		; PRINT THE MONTH
;
	LD	HL,TBUFF	; POINTER TO TEMPORARY STORAGE
	PUSH	HL		; SAVE FOR PRINTING
	LD	A,(DATE)	; CONVERT THE DATE TO ASCII
	CALL	GETHINIB	; Get the high-order nibble
	CALL	NZ,PUTLOW	; DON'T PRINT LEADING ZEROS
	LD	A,(DATE)	; GET THE LOW-ORDER DIGIT
	CALL	PUTLOW		; STUFF IT INTO THE BUFFER
	LD	A,','		; ALONG WITH..
	CALL	PUT		;  ..THE COMMA..
	LD	A,' '		;   ..AND..
	CALL	PUT		;    ..THE SPACE

	LD	A,(CENTURY)	; CONVERT THE CENTURY TO ASCII
	CALL	GETHINIB	; Get the high-order nibble
	CALL	PUTLOW		; STUFF IT INTO THE BUFFER
	LD	A,(CENTURY)	; GET THE LOW-ORDER DIGIT
	CALL	PUTLOW		; STUFF IT INTO THE BUFFER

	LD	A,(YEAR)	; CONVERT THE YEAR TO ASCII
	CALL	GETHINIB	; Get the high-order nibble
	CALL	PUTLOW		; DON'T PRINT LEADING ZEROS
	LD	A,(YEAR)	; GET THE LOW-ORDER DIGIT
	CALL	PUTLOW		; STUFF IT INTO THE BUFFER
	LD	A,','		; ALONG WITH..
	CALL	PUT		;  ..THE COMMA..
	LD	A,' '		;   ..AND..
	CALL	PUT		;    ..THE SPACE

	LD	A,(HOUR)	; GET THE HOUR
	CP	13H		; CHECK FOR AM OR PM
	CALL	NC,SUBHR	; CONVERT PM FROM 13-24 TO 1-12
	OR	A		; CHECK FOR..
	CALL	Z,MAK12		;  ..12 MIDNIGHT
	CALL	PUTHI		; PUT BOTH DIGITS INTO THE BUFFER
	LD	A,':'		; PUT THE COLON..
	CALL	PUT		;  ..INTO THE BUFFER
	LD	A,(MINUTES)	; GET THE MINUTES
	CALL	PUTHI		; PUT BOTH MINUTES DIGITS INTO THE BUFFER
	LD	A,':'		; PUT ANOTHER COLON..
	CALL	PUT		;  ..INTO THE BUFFER
	LD	A,(SECONDS)	; GET THE SECONDS
	CALL	PUTHI		; PUT BOTH SECONDS DIGITS INTO THE BUFFER
	LD	A,' '		; PUT ONE SPACE..
	CALL	PUT		;  ..INTO THE BUFFER
	LD	A,(HOUR)	; CHECK FOR..
	CP	12H		;  ..AM OR PM
	LD	A,'A'		; PRINT "A"..
	JP	C,ISAM		;  ..OR..
	LD	A,'P'		;   .."P"
ISAM:
	CALL	PUT		; PUT THE "A" OR "P" IN THE BUFFER
	LD	A,'M'		; PUT THE "M"..
	CALL	PUT		;  ..IN THE BUFFER
SPLOOP:
	LD	A,(HL)		; GET THE NEXT CHARACTER IN THE BUFFER
	CP	'$'		; IS IT THE END-OF-BUFFER FLAG?
	JP	Z,ENDSP		; YES - ALL DONE
	LD	A,' '		; PUT A SPACE..
	CALL	PUT		;  ..INTO THE BUFFER
	JP	SPLOOP		; LOOP UNTIL END-OF-BUFFER SENSED
;
ENDSP:
	POP	DE		; RECOVER THE BUFFER ADDRESS
	JP	PMSG		; PRINT THE BUFFER

BADDISPL:
	LD	DE,ERRORMSG	
	JP	PMSG		; Print error and return

;************************************************************************
;*									*
;* PUTHI PUTS THE HIGH AND LOW NIBBLES OF THE BCD NUMBER IN		*
;* THE A-REG. INTO THE TEMPORARY BUFFER.				*
;*									*
;************************************************************************

PUTHI:
	PUSH	AF		; SAVE THE LOW NIBBLE
	RRA			; PUT HIGH..
	RRA			;  ..NIBBLE..
	RRA			;   ..INTO..
	RRA			;    ..LOW NIBBLE
	CALL	PUTLOW		; PRINT THE LOW NIBBLE OF A-REG BYTE
	POP	AF		; RECOVER LOW NIBBLE
PUTLOW:
	AND	00001111B	; STRIP OFF IRRELEVENT BITS
	ADD	A,'0'		; ADD IN ASCII BIAS
PUT:
	LD	(HL),A		; PUT THE CHARACTER IN THE BUFFER
	INC	HL		; BUMP BUFFER POINTER
	RET

;************************************************************************
;*									*
;* BCD2 SCANS THE COMMAND LINE FOR UP TO TWO VALID ASCII DIGITS		*
;* AND RETURNS THE RESULT AS A PACKED BCD BYTE IN THE A-REG.		*
;*									*
;************************************************************************

BCD2:
	CALL	SKIPB		; SKIP ANY PRECEEDING BLANKS
	CALL	SCAN		; GET FIRST CHAR. OF DAY OF MONTH
	SCF			; CARRY IS ERROR
	RET	Z
	CP	':'
	JP	Z,BCD2
	CP	','
	JP	Z,BCD2
	CALL	DIGIT		; CHECK FOR VALID DECIMAL DIGIT
	RET	C
	LD	B,A		; SAVE IN B-REG
	CALL	SCAN
	JP	Z,OKD
	CP	','		; CHECK FOR END OF DAY OF MONTH
	JP	Z,OKD
	CP	' '
	JP	Z,OKD
	CP	':'
	JP	Z,OKD
	CALL	DIGIT		; CHECK FOR VALID DECIMAL DIGIT
	RET	C
	SCF			; CLEAR..
	CCF			;  ..THE CARRY
	PUSH	AF		; SAVE THE LOW-ORDER NIBBLE
	LD	A,B
	RLA			; PUT PREVIOUS..
	RLA			;  ..DIGIT..
	RLA			;   ..INTO..
	RLA			;    ...HIGH-ORDER NIBBLE
	LD	B,A		; SAVE IN B-REG
	POP	AF		; RECOVER THE LOW-ORDER NIBBLE
	OR	B		; FORM BYTE
	LD	B,A		; SAVE IN B-REG
OKD:
	LD	A,B		; RECOVER THE DAY-OF-MONTH
	SCF			; CLEAR..
	CCF			;  ..THE CARRY
	RET			; RETURN TO CALLER

;************************************************************************
;*									*
;* DIGIT CHECKS IF THE CHAR. IN THE A-REG IS A VALID ASCII DIGIT	*
;*									*
;************************************************************************

DIGIT:
	CP	'0'		; LESS THAN '0'?
	RET	C		; YES, RETURN ERROR CODE
	CP	'9'+1		; GREATER THAN '9'?
	CCF
	RET	C		; YES, RETURN ERROR CODE
	SUB	'0'		; STRIP OFF ASCII BIAS

	RET			; RETURN TO CALLER

;************************************************************************
;*									*
;* MATCH3 GUARANTEES THAT AT LEAST THREE CHARACTERS ARE MATCHED		*
;* WITH THE COMMAND LINE						*
;*									*
;************************************************************************

MATCH3:
	LD	A,3		; SET..
	LD	(MCNT),A	;  ..MATCH COUNT
	LD	E,(HL)		; GET CURRENT STRING POINTER
	INC	HL
	LD	D,(HL)
	INC	HL
	LD	A,E		; CHECK IF..
	OR	D		;  ..ALL DONE
	RET	Z		; NO MATCH
	PUSH	HL		; SAVE CURRENT ARRAY POINTER
	LD	HL,(SCANPNT)	; SAVE CURRENT..
	PUSH	HL		;  ..SCAN POINTER
	LD	A,(CLEN)	; SAVE CURRENT..
	PUSH	AF		;  ..COMMAND LENGTH
MTCHMO:
	CALL	SCAN		; SCAN AND CONVERT TO UPPER CASE
	JP	Z,NOMATCH	; NO MATCH IF OUT OF CHARACTERS
	CALL	TOUPPER		; CONVERT TO UPPER CASE
	LD	B,A		; SAVE IN B-REG
	LD	A,(DE)		; GET NEXT CHARACTER IN STRING
	INC	DE		; BUMP STRING POINTER
	CALL	TOUPPER		; CONVERT TO UPPER CASE
	CP	B		; DOES IT MATCH?
	JP	NZ,NOMATCH	; NO MATCH
	LD	A,(MCNT)	; GET MATCH COUNT
	DEC	A		; MATCHED THREE?
	LD	(MCNT),A	; SAVE MATCH COUNT
	JP	NZ,MTCHMO	; MATCH MORE?
	CALL	SKIPC		; SKIP REST OF CHARACTERS
	POP	HL		; THROW AWAY OLD SCAN POINTER
	POP	HL		; THROW AWAY OLD COMMAND LENGTH
	POP	HL		; RECOVER ARRAY POINTER
	OR	H		; Force flag to Non-Zero
	RET			;  ..RETURN
;
NOMATCH:
	POP	AF		; RECOVER COMMAND LENGTH
	LD	(CLEN),A	; RESTORE COMMAND LENGTH
	POP	HL		; RECOVER SCAN POINTER
	LD	(SCANPNT),HL	; RESTORE SCAN POINTER
	POP	HL		; RECOVER ARRAY POINTER
	JP	MATCH3		; TRY AGAIN


;************************************************************************
;*									*
;* PMSG IS THE CP/M PRINT STRING FUNCTION				*
;*									*
;************************************************************************

PMSG:
	LD	C,PSTR		; SET BDOS PRINT-STRING FUNCTION CODE
	JP	BDOSNTRY	; GO TO BDOS, RETURN TO CALLER

;************************************************************************
;*									*
;* SUBHR ADJUSTS THE BCD NUMBER TO BE BETWEEN 1-12.			*
;*									*
;************************************************************************

SUBHR:
	ADD	A,88H
	DAA
	RET

MAK12:
	LD	A,12H
	RET

UPHRS:
	LD	A,(HOUR)
	CP	12H
	RET	Z
	ADD	A,12H
	DAA
	LD	(HOUR),A
	RET

DWNHRS:
	LD	A,(HOUR)
	SUB	12H
	RET	NZ
	LD	(HOUR),A
	RET

SKIPC:
	CALL	SCAN		; GET NEXT CHARACTER
	RET	Z		; RETURN TO CALLER IF NO MORE CHARACTERS
	CP	' '		: CHECK FOR SPACE
	JP	NZ,SKIPC	; LOOP UNTIL SPACE FOUND
	RET

SKIPB:
	CALL	SCAN		; GET NEXT CHARACTER
	RET	Z		; RETURN TO CALLER IF NO MORE CHARACTERS
	CP	' '		: CHECK FOR SPACE
	JP	Z,SKIPB		; SKIP SPACES
UNSCAN:
	PUSH	HL		; SAVE POINTER REG
	LD	HL,(SCANPNT)	; GET COMMAND SCAN POINTER
	DEC	HL		; BACK UP THE SCAN POINTER
	LD	(SCANPNT),HL	; SAVE COMMAND SCAN POINTER
	LD	A,(CLEN)	; UPDATE..
	INC	A		;  ..THE..
	LD	(CLEN),A	;   ..LENGTH
	POP	HL		; RESTORE POINTER REG
	RET

SCAN:
	LD	A,(CLEN)	; CHECK IF..
	AND	A		;  ..ANYTHING LEFT
	RET	Z		; NO - RETURN WITH Z-FLAG SET
	DEC	A		; YES - UPDATE..
	LD	(CLEN),A	;  ..LENGTH
	PUSH	HL
	LD	HL,(SCANPNT)	; GET COMMAND POINTER
	LD	A,(HL)		; GET INDICATED BYTE
	INC	HL		; BUMP COMMAND POINTER
	LD	(SCANPNT),HL	; SAVE COMMAND POINTER
	POP	HL
	OR	A		; CLEAR Z-FLAG
	RET

TOUPPER:
	CP	'a'		; IS IT LOWER CASE?
	RET	C		; NO - RETURN TO CALLER
	CP	'z'+1		; IS IT LOWER CASE?
	RET	NC		; NO - RETURN TO CALLER
	SUB	' '		; YES - FORCE TO UPPER CASE
	RET


;************************************************************************
;*									*
;* PRESET initializes the clock for writing;				*
;* RESET re-writes the clock after a month-end roll.
;*									*
;************************************************************************

PRESET:
	LD	A,REGHLD	; ISSUE REGISTER HOLD COMMAND
	CALL	SETUP
	LD	A,TP64		; SET UP CLOCK PULSE
	JP	SETUP


;************************************************************************
;*									*
;* WRITEC DOES THE ACTUAL CLOCK TIME WRITING.  THIS ROUTINE MUST	*
;* NOT BE INTERRUPTED.							*
;*									*
;************************************************************************

RESET:
	CALL	PRESET
WRITEC:
	XOR	A		; SELECT GROUP 0
	OUT	(GRPSEL),A
	LD	A,SHFT		; LOAD SHIFT COMMAND
	CALL	SETUP
	PUSH	HL		; SAVE CLOCK DATA ADDRESS
WBYTE:
	LD	E,8		; BIT SHIFT COUNTER
	INC	HL		; BUMP TO NEXT BYTE OF DATA
WBIT:
	LD	A,(HL)		; GET CURRENT BYTE OF DATA
	RRA			; SHIFT LSB INTO CARRY
	LD	(HL),A		; SAVE CURRENT BYTE
	RLA			; SHIFT CARRY INTO LSB
	AND	1		; THROW AWAY USELESS BITS
	EX	(SP),HL		; RECOVER ADDRESS OF CLOCK DATA
	OR	(HL)		; GET CURRENT STATE
	EX	(SP),HL		; RECOVER CURRENT BYTE COUNTER
	CALL	CLKSTB		; STROBE IN ONE BIT
	DEC	E		; UPDATE BIT COUNTER
	JP	NZ,WBIT		; LOOP UNTIL ALL 8 BITS PROCESSED
	DEC	D		; UPDATE BYTE COUNTER
	JP	NZ,WBYTE	; LOOP UNTIL ALL BYTES PROCESSED
	POP	HL		; RECOVER ADDRESS OF CLOCK DATA
	LD	A,(HL)		; GET CURRENT STATE
	OR	WCLK		; SET WRITE CLOCK BIT
	CALL	CLKCMD		; ISSUE WRITE-TIME COMMAND
	XOR	WCLK		; TURN OFF WRITE TIME COMMAND
	JP	CLKCMD
;

;************************************************************************
;*									*
;* READC DOES THE ACTUAL CLOCK READING (40 BITS) FROM THE		*
;* HARDWARE.  IF THE INTERRUPTS ARE ENABLED, THEN CARE MUST BE TAKEN	*
;* TO ASSURE THAT THIS ROUTINE IS NOT INTERRUPTED UNTIL IT		*
;* IS COMPLETED.							*
;*									*
;************************************************************************

READC:
	XOR	A		; SELECT..
	OUT	(GRPSEL),A	;  ..GROUP ZERO
	LD	A,RCLK		; READ CLOCK INTO..
	CALL	SETUP		;  ..40 BIT SHIFT REGISTER
	PUSH	HL		; SAVE ADDRESS OF CLKDATA
	XOR	CLKC1		; ISSUE..
	CALL	CLKCMD		;  ..SHIFT COMMAND
RBYTE:
	LD	E,8		; PREPARE FOR 8 BITS
	INC	HL		; BUMP TO NEXT ADDRESS OF CLOCK DATA

RBIT:
	XOR	A		; SELECT..
	OUT	(GRPSEL),A	;  ..GROUP ZERO
	IN	A,(CLK)		; READ	ONE BIT
	RRA			; PUT BIT IN CARRY
	LD	A,(HL)		; RECOVER PARTIALLY ASSEMBLED BYTE
	RRA			; SHIFT IN THE BIT JUST READ
	LD	(HL),A		; SAVE THE BYTE AGAIN
	EX	(SP),HL		; GET THE ADDRESS OF CLOCK DATA
	LD	A,(HL)		; GET THE CLOCK DATA
	EX	(SP),HL		; SAVE THE ADDRESS OF CLOCK DATA
	CALL	CLKSTB		; STROBE THE SHIFT REGISTER
	DEC	E		; ALL DONE WITH THIS BYTE?
	JP	NZ,RBIT		; NO - LOOP UNTIL NO MORE BITS
	DEC	D		; COMPLETELY DONE?
	JP	NZ,RBYTE	; NO - LOOP UNTIL NO MORE BYTES
	POP	HL		; RECOVER ADDRESS OF CLKDATA
CLKCMD:
	LD	C,CSTB		; GET CLOCK STROBE BIT
CLKSTB:
	PUSH	AF
	XOR	A		; SELECT..
	OUT	(GRPSEL),A	;  ..GROUP ZERO
	POP	AF
	OUT	(CLK),A		; OUTPUT STROBE LOW
	CALL	DELAY		; WAIT FOR CHIP TO SEE STROBE LOW
	XOR	C		; TOGGLE STROBE HIGH
	OUT	(CLK),A		; OUTPUT STROBE HIGH
	CALL	DELAY		; WAIT FOR CHIP TO SEE STROBE HIGH
	XOR	C		; TOGGLE STROBE LOW
	OUT	(CLK),A		; OUTPUT STROBE LOW
	CALL	DELAY		; WAIT FOR CHIP TO SEE STROBE LOW
	LD	C,CLKCLK	; CLOCK CLK BIT
	RET			; RETURN TO CALLER

SETUP:
	LD	D,5		; SET COUNT OF BYTES TO BE READ
	LD	HL,CLKDATA	; SET ADDRESS OF CLOCK DATA
	OR	(HL)		; GET CURRENT BIT STATE
	JP	CLKCMD		; ISSUE THE COMMAND

DELAY:
	LD	B,1		; TIME DELAY
DELAY1:
	DEC	B
	JP	NZ,DELAY1
	RET

;************************************************************************
;*									*
;* THE FOLLOWING ARE DATA USED WITHIN THE PROGRAM.			*
;*									*
;************************************************************************

CLKDATA	DB	0		; CURRENT STATE OF CLOCK PORT
;
;				; Date & Time Initialized to:---VV
SECONDS	DB	59H		; SECONDS			59
MINUTES	DB	59H		; MINUTES			59
HOUR	DB	23H		; HOURS				11pm
DATE	DB	01H		; DATE			January	 1,
MONTHWK	DB	13H		; MONTH & DAY OF WEEK 	Wednesday
CENTURY	DB	19H		; CENTURY (Patch to change)
YEAR	DB	86H		; YEAR (Adjust FIRSTSUN table..
;				;  ..and BASEYEAR to change)
;
;************************************************************************
;*									*
;* DAYS IS AN ARRAY OF POINTERS TO STRINGS, USED TO PRINT THE 		*
;* ENGLISH VERSION OF THE DAY OF THE DAY OF THE WEEK.			*
;*									*
;************************************************************************

DAYS:
	DW	SUN
	DW	MON
	DW	TUE
	DW	WED
	DW	THU
	DW	FRI
	DW	SAT
	DW	0		; ILLEGAL DAY!

SUN	DB	'Sunday, $'
MON	DB	'Monday, $'
TUE	DB	'Tuesday, $'
WED	DB	'Wednesday, $'
THU	DB	'Thursday, $'
FRI	DB	'Friday, $'
SAT	DB	'Saturday, $'

;************************************************************************
;*									*
;* MONTHS IS AN ARRAY OF POINTERS TO STRINGS, USED TO PRINT THE 	*
;* ENGLISH VERSION OF THE DAY OF THE MONTH.				*
;*									*
;************************************************************************

MONTHS:
	DW	JAN
	DW	FEB
	DW	MAR
	DW	APR
	DW	MAY
	DW	JUN
	DW	JUL
	DW	AUG
	DW	SEP
	DW	OCT
	DW	NOV
	DW	DEC
	DW	0,0,0,0		; ILLEGAL MONTHS

JAN	DB	'January $'
FEB	DB	'February $'
MAR	DB	'March $'�
APR	DB	'April $'�
MAY	DB	'May $'�
JUN	DB	'June $'�
JUL	DB	'July $'�
AUG	DB	'August $'�
SEP	DB	'September $'�
OCT	DB	'October $'�
NOV	DB	'November $'�
DEC	DB	'December $'

;************************************************************************
;*									*
;* LASTDAYS is a table of last-day-of-month values for checking		*
;* for month-wrap, to update month, and reset day-of-month		*
;*									*
;************************************************************************

LASTDAYS:
	DB	31H	; JAN
FEBLAST	DB	29H	; FEB
	DB	31H	; MAR
	DB	30H	; APR
	DB	31H	; MAY
	DB	30H	; JUN
	DB	31H	; JUL
	DB	31H	; AUG
	DB	30H	; SEP
	DB	31H	; OCT
	DB	30H	; NOV
	DB	31H	; DEC
;
;************************************************************************
;*									*
;* BASEYEAR:	Is the year to which the first Sunday tables pertain	*
;*									*
;* FIRSTSUN:	Is a table of the first Sunday of every month for the 	*
;*		Base-Year.						*
;*									*
;* OTHERSUN:	Is a table of the first Sunday of every month for the 	*
;*		first leap-year after the Base-Year.			*
;*									*
;************************************************************************

BASEYEAR EQU	86H		; Define Base-Year value

FIRSTSUN:
	DB	5,2,2,6,4,1,6,3,7,5,2,7

OTHERSUN:
	DB	2,6,6,3,1,5,3,0,4,2,6,4

;
;
ACRMSG	DB	ACR,'$'
ACRALF	DB	ACR,ALF,'$'

ERRORMSG DB	ACR,ALF,'Invalid Time in Clock, please reset!',ACR,ALF,'$'

BADTMSG	DB	ACR,ALF,'Invalid Time specified.$'

WAITMSG	DB	ACR,ALF,'Press return to set the time: $'
;
CURRENT	DB	ACR,ALF,'The current date and time is:',ACR,ALF,'$'
PROMPT	DB	ACR,ALF,'Re-enter if incorrect, or type ^C if O.K. as is'
	DB	ACR,ALF,'$'
;
IBUFF	DB	10,10
	DS	10

SCANPNT	DW	CBUFF

MCNT	DB	0

;************************************************************************
;*									*
;* TBUFF IS USED TO PREPARE THE DAY OF THE MONTH, HOURS, MINUTES,	*
;* AND SECONDS PRIOR TO PRINTING.					*
;*									*
;************************************************************************

TBUFF	DB	'00, 00:00:00 AM                        $'


;		THE FOLLOWING ROUTINE IS FOR DEBUGGING, AND MUST
;		BE MOVED UP IN ORDER TO BE USED, AND THE ORIGINAL
;		"READC" ROUTINE COMMENTED OUT.

;************************************************************************
;*									*
;* BUMPDATE:	Temporarily replaces READC: for testing the calendar	*
;*		algorithm without affecting the hardware clock		*
;*									*
;************************************************************************

BUMPDATE:	; DUMMY READC ROUTINE FOR TESTING!!!!!!!!!!!!!
	XOR	A		; Zero carry flag
	LD	A,(DATE)	; Load day-of-month
	ADD	A,1		; Increment
	DAA			; Decimal adjust
	LD	(DATE),A	; Store incremented day-of-month
	CALL	CKDATE		; Check for month roll
	LD	A,(MONTHWK)	; Get..
	PUSH	AF		;  ..and save the..
	AND	00001111B	;   ..day-of-week
	INC	A		; Increment
	XOR	00000111B	; Did it go to seven?
	JR	Z,WENTTO7	; Yes - then the test reset it to zero
	XOR	00000111B	; No - then re-invert it
WENTTO7:
	LD	B,A		; Save in B-reg
	POP	AF		; Restore month/day-of-week value..
	AND	11110000B	;  ..and clear previous day-of-week
	OR	B		; OR in the incremented day-of-week
	LD	(MONTHWK),A	; Store incremented day-of-week
	RET			; Return to caller

	END		; END OF PROGRAM!!!!!!!