.TITLE	DATE -- SET SYSTEM DATE
	.IDENT	/V02.02/

;
; COPYRIGHT (C) 1990, 2009-2012 OLEG SAFIULLIN <form@pdp-11.org.ru>
; COPYRIGHT (C) 1990 NICKOLAY DROZD
;
; PERMISSION TO USE, COPY, MODIFY, AND DISTRIBUTE THIS SOFTWARE FOR ANY
; PURPOSE WITH OR WITHOUT FEE IS HEREBY GRANTED, PROVIDED THAT THE ABOVE
; COPYRIGHT NOTICE AND THIS PERMISSION NOTICE APPEAR IN ALL COPIES.
;
; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;
; V02.00	27-JUN-2009	FORM	REWRITE, Y2K SUPPORT
; V02.01	26-MAY-2011	FORM	FIX BUFFER ADDRESS
; V02.02	29-FEB-2012	FORM	FIX 29-FEB-2012 ;)
;

OP.Y2K	==	100000				;Y2K DATES OPTION
OP.TOY	==	200				;USE TOY CLOCK OPTION
OP.ASK	==	1				;ALWAYS ASK FOR DATE

$JSW	==	44				;JOB STATUS WORD
$USRTO	==	50				;USER TOP ADDRESS
$USRRB	==	53				;USER ERROR BYTE
TTSPC$	==	10000				;TTY SPECIAL BIT
WARN$	==	2				;WARNING STATUS BIT
ERROR$	==	4				;ERROR STATUS BIT

CR	==	15				;CARRIAGE RETURN
EOL	==	200				;END OF LINE

CHAN0	==	0				;FILE I/O CHANNEL

DDATE	==	55545				;DEFAULT DATE (27-JUN-2009)
ODATE	==	31773				;OLD STYLE DATE (31-DEC-99)

TSR	==	177526				;TOY STATUS REGISTER


	.MCALL	.CLOSE,.DATE,.EXIT,.LOOKUP	;SYSTEM MACRO CALLS
	.MCALL	.PRINT,.READW,.SDTTM,.SETTOP	;
	.MCALL	.TRPSET,.TTYIN,.WRITW		;


DATE::	.WORD	DDATE				;DEFAULT DATE
OPTS::	.WORD	OP.Y2K!OP.TOY			;PROGRAM FLAGS
DBLK::	.RAD50	/SY DATE  SAV/			;PROGRAM FILE DBLK


START::	BIT	#OP.ASK,OPTS			;ALWAYS ASK FOR DATE?
	BNE	80$				;IF NE YES
	.DATE					;GET SYSTEM DATE
	TST	R0				;IS DATE SET?
	BNE	10$				;IF NE YES
	TSTB	OPTS				;NO. USE TOY CLOCK?
	BPL	80$				;IF PL NO
	CALL	GETTOY				;YES. READ TOY CLOCK
	BCS	80$				;IF CS NO TOY
10$:	CALL	FIXDAT				;FIX DATE IF NEEDED
	BCS	80$				;IF CS DATE FIXED

15$:	MOV	R1,DTTM				;SET DATE
	.SDTTM	#AREA,#DTTM			;
	CMP	R1,DATE				;IS DATE CHANGFED?
	BEQ	30$				;IF EQ NO

	MOV	@#$USRTO,R2			;GET TOP ADDRESS
	TST	(R2)+				;
	MOV	R2,R3				;ALLOCATE 256-WORD BUFFER
	ADD	#1000,R3			;
	.SETTOP	R3				;SET TOP ADDRESS
	CMP	R0,R3				;SUCCESS?
	BLO	70$				;IF LO NO

	.LOOKUP	#AREA,#CHAN0,#DBLK		;LOOKUP PROGRAM FILE
	BCS	40$				;IF CS ERROR
	.READW	#AREA,#CHAN0,R2,#256.,#1	;READ BLOCK #1
	BCS	60$				;IF CS ERROR

	MOV	R2,R5				;SAVE BUFFER ADDRESS
	MOV	#DATE,R3			;
	MOV	#256.,R4			;
20$:	CMP	(R2)+,(R3)+			;
	BNE	50$				;IF NE FILE MISMATCH
	DEC	R4				;
	BNE	20$				;

	MOV	R1,@R5				;STORE NEW DATE
	.WRITW	#AREA,#CHAN0,R5,#256.,#1	;WRITE BACK BLOCK #1
	BCS	60$				;IF CS ERROR

	.CLOSE	#CHAN0				;CLOSE FILE
30$:	.EXIT					;EXIT

40$:	MOV	#ERR0,R0			;SET ERROR MESSAGE
41$:	BISB	#WARN$,@#$USRRB			;SET WARNING STATUS
42$:	.PRINT					;PRINT MESSAGE
	.EXIT					;EXIT

50$:	MOV	#ERR1,R0			;SET ERROR MESSAGE
	BR	41$				;SET STATUS, PRINT, EXIT

60$:	MOV	#ERR2,R0			;SET ERROR MESSAGE
61$:	BISB	#ERROR$,@#$USRRB		;SET ERROR STATUS
	BR	42$				;PRINT, EXIT

70$:	MOV	#ERR3,R0			;SET ERROR MESSAGE
	BR	61$				;SET STATUS, PRINT, EXIT

80$:	BIS	#TTSPC$,@#$JSW			;SET TTY SPECIAL MODE
	MOV	DATE,R0				;GET SAVED DATE
	CALL	ASKDAT				;ASK FOR NEW DATE
	MOV	R0,R1				;COPY DATE TO R1
	BR	15$				;CHECK, STORE, EXIT


;+
;ASKDAT -- ASK SYSTEM DATE
;
;INPUT:
;	R0	- DEFAULT DATE
;
;OUTPUT:
;	R0	- SELECTED DATE
;	R1-R5	- MODIFIED
;-
ASKDAT:	CALL	FIXDAT				;FIX DATE IF NEEDED
	MOV	R1,R5				;UNPACK YEAR INTO R5
	BIC	#^C37,R5			;
	TST	OPTS				;Y2K DATES SUPPORTED?
	BMI	10$				;IF MI YES
	ADD	#72.,R5				;NO, USE 2-DIGIT DATES
	BR	20$				;
10$:	MOV	R1,R4				;
	SWAB	R4				;
	ASR	R4				;
	BIC	#^C140,R4			;
	BIS	R4,R5				;
	ADD	#1972.,R5			;
20$:	MOV	R1,R4				;UNPACK MONTH INTO R4
	SWAB	R4				;
	ASR	R4				;
	ASR	R4				;
	BIC	#^C17,R4			;
	MOV	R1,R3				;UNPACK DAY INTO R3
	ASL	R3				;
	ASL	R3				;
	ASL	R3				;
	SWAB	R3				;
	BIC	#^C37,R3			;
	.PRINT	#CRLF				;PRINT <CR><LF>

30$:	MOV	#28.,DAYTB+2			;FIX FEB DAYS IF NEEDED
	BIT	#3,R5				;
	BNE	31$				;
	INC	DAYTB+2				;
31$:	MOV	R4,R0				;FIX DAY IF NEEDED
	ASL	R0				;
	CMP	R3,DAYTB-2(R0)			;
	BLE	35$				;
	MOV	DAYTB-2(R0),R3			;
35$:	MOV	#ADATE,R0			;POINT TO DATE BUFFER
	MOV	R3,R1				;CONVERT DAY TO ASCII
	CMP	#9.,R1				;
	BLT	40$				;
	MOVB	#'0,(R0)+			;
40$:	CALL	CBDMG				;
	INC	R0				;CONVERT MONTH TO ASCII
	MOV	R4,R1				;
	ASL	R1				;
	ADD	R4,R1				;
	ADD	#MONTHS-3,R1			;
	MOVB	(R1)+,(R0)+			;
	MOVB	(R1)+,(R0)+			;
	MOVB	(R1)+,(R0)+			;
	INC	R0				;
	MOV	R5,R1				;CONVERT YEAR TO ASCII
	CALL	CBDMG				;
	MOVB	#EOL,@R0			;TERMINATE LINE
	.PRINT	#MSGDAT				;PRINT DATE MESSAGE
50$:	.TTYIN					;GET CHAR FROM TTY
	CMPB	#'A,R0				;UP ARROW?
	BEQ	90$				;IF EQ YES
	CMPB	#'B,R0				;DOWN ARROW?
	BEQ	100$				;IF EQ YES
	CMPB	#'C,R0				;RIGHT ARROW?
	BEQ	110$				;IF EQ YES
	CMPB	#'D,R0				;LEFT ARROW?
	BEQ	120$				;IF EQ YES
	CMPB	#'>,R0				;RIGHT BRACKET?
	BEQ	70$				;IF EQ YES
	CMPB	#'<,R0				;LEFT BRACKET?
	BEQ	80$				;IF EQ YES
	CMPB	#CR,R0				;CARRIAGE RETURN?
	BNE	50$				;IF NE NO

	.TTYIN					;YES, POP LINE FEED
	.PRINT	#CRLF				;PRINT <CR><LF>
	SUB	#72.,R5				;PACK YEAR
	TST	OPTS				;
	BPL	60$				;
	SUB	#1900.,R5			;
60$:	MOV	R5,R0				;
	ASL	R5				;
	SWAB	R5				;
	BIC	#^C140000,R5			;
	BIC	#^C37,R0			;
	BIS	R5,R0				;
	ASL	R4				;PACK MONTH
	ASL	R4				;
	SWAB	R4				;
	BIS	R4,R0				;
	SWAB	R3				;PACK DAY
	ASR	R3				;
	ASR	R3				;
	ASR	R3				;
	BIS	R3,R0				;
	RETURN					;RETURN

70$:	INC	R5				;ONE YEAR FORWARD
	TST	OPTS				;
	BPL	75$				;
	CMP	#2099.,R5			;
	BGE	30$				;
	MOV	#1972.,R5			;
	BR	30$				;
75$:	CMP	#99.,R5				;
	BGE	30$				;
	MOV	#72.,R5				;
	BR	30$				;

80$:	DEC	R5				;ONE YEAR BACKWARD
	TST	OPTS				;
	BPL	85$				;
	CMP	#1972.,R5			;
	BLE	30$				;
	MOV	#2099.,R5			;
	BR	30$				;
85$:	CMP	#72.,R5				;
	BLE	30$				;
	MOV	#99.,R5				;
86$:	BR	30$				;

90$:	INC	R4				;ONE MONTH FORWARD
	CMP	#12.,R4				;
	BGE	86$				;
	MOV	#1,R4				;
	BR	70$				;

100$:	DEC	R4				;ONE MONTH BACKWARD
	BGT	86$				;
	MOV	#12.,R4				;
	BR	80$				;

110$:	INC	R3				;ONE DAY FORWARD
	MOV	R4,R0				;
	ASL	R0				;
	CMP	R3,DAYTB-2(R0)			;
	BLE	86$				;
	MOV	#1,R3				;
	BR	90$				;

120$:	DEC	R3				;ONE DAY BACKWARD
	BGT	86$				;
	MOV	#31.,R3				;
	BR	100$				;

;+
;CBDMG -- CONVERT DECIMAL TO MESSAGE
;
;INPUT:
;	R0	- BUFFER ADDRESS
;	R1	- VALUE
;
;OUTPUT:
;	R0	- UPDATED
;	R1, R2	- MODIFIED
;-
CBDMG:	MOV	R3,-(SP)			;SAVE R3-R4
	MOV	R4,-(SP)			;
	MOV	R0,R3				;SAVE BUFFER ADDRESS
	CLR	R4				;CLEAR DIGIT COUNT
	MOV	R1,R0				;SET DIVIDENT FOR $DIV
10$:	MOV	#10.,R1				;SET DIVISOR
	CALL	$DIV				;DIVIDE
	ADD	#'0,R1				;CONVERT REMAINDER TO ASCII
	MOVB	R1,-(SP)			;SAVE TO STACK
	INC	R4				;INCREASE DIGIT COUNT
	TST	R0				;IS QUORIENT ZERO?
	BNE	10$				;NO, COTTINUE
	MOV	R3,R0				;RESTORE BUFFER ADDRESS
20$:	MOVB	(SP)+,(R0)+			;COPY DIGITS TO BUFFER
	DEC	R4				;
	BNE	20$				;
	MOV	(SP)+,R4			;RESTORE R3-R4
	MOV	(SP)+,R3			;
	RETURN					;RETURN

;+
;FIXDAT -- FIX DATE
;
;INPUT:
;	R0	- DATE
;
;OUTPUT:
;	CARRY	- DATE FIXED
;	R1	- DATE/FIXED DATE
;	R2, R3	- MODIFIED
;-
FIXDAT:	MOV	#DDATE,R1			;SET DEFAULT DATE
	TST	OPTS				;Y2K SUPPORT?
	BMI	10$				;IF MI YES
	MOV	#ODATE,R1			;SET DEFAULT DATE (OLD)
	BIT	#140000,R0			;NO, VALIDATE YEAR
	BNE	20$				;IF NE INVALID
10$:	MOV	R0,R2				;VALIDATE MONTH
	ASR	R2				;
	ASR	R2				;
	SWAB	R2				;
	BIC	#^C17,R2			;
	BEQ	20$				;IF EQ INVALID
	CMP	#12.,R2				;
	BLT	20$				;IF LT INVALID
	MOV	#28.,DAYTB+2			;ASSUME 28 DAYS IN FEBRUARY
	BIT	#3,R0				;LEAP YEAR?
	BNE	15$				;NO
	INC	DAYTB+2				;YES
15$:	MOV	R0,R3				;VALIDATE DAY
	ASL	R3				;
	ASL	R3				;
	ASL	R3				;
	SWAB	R3				;
	BIC	#^C37,R3			;
	BEQ	20$				;IF EQ INVALID
	ASL	R2				;
	CMP	R3,DAYTB-2(R2)			;
	BGT	20$				;IF GT INVALID
	MOV	R0,R1				;COPY DATE TO R1
	TST	(PC)+				;CLEAR CARRY & SKIP SEC
20$:	SEC					;SET CARRY
	RETURN					;RETURN

GETTOY:	.TRPSET	#AREA,#BUSTMO			;SET TRAP4/10 ISR
	TST	@#TSR				;IS TOY AVAILABLE?
	BCS	50$				;IF CS NO
	MOV	#TSR+1,R5
	MOV	#TBUF,R4
	MOV	R4,-(SP)
	MOV	#1,R3
	MOV	#4,R2
	MOV	R2,R1
	MOVB	@R5,R0
10$:	ASR	R0
	ASR	@R4
	ROL	R0
	MOVB	R0,@R5
	ASL	R3
	BCC	10$
	ROL	R3
	TST	(R4)+
	DEC	R2
	BNE	10$
20$:	TST	-(R4)
30$:	MOVB	@R5,R0
	ASR	R0
	ROR	@R4
	ASL	R3
	BCC	30$
	ROL	R3
	DEC	R1
	BNE	20$
	MOV	(SP)+,R4
	CALL	BCDTB				;PACK MONTH
	SWAB	R0
	ASL	R0
	ASL	R0
	MOV	R0,R5
	CALL	BCDTB				;PACK YEAR
	MOV	#100.,R1
	CALL	$DIV
	TST	OPTS
	BPL	40$
	ADD	#100.,R1
40$:	SUB	#72.,R1
	MOV	R1,R0
	ASL	R0
	SWAB	R0
	BIC	#^C140000,R0
	BIS	R0,R5
	BIC	#^C37,R1
	BIS	R1,R5
	INC	R4
	CALL	BCDTB
	SWAB	R0
	ASR	R0
	ASR	R0
	ASR	R0
	BIS	R5,R0
	TST	(PC)+
50$:	SEC
	RETURN

BCDTB:	MOVB	(R4)+,R0
	MOV	R0,R1
	BIC	#^C377,R1
	BIC	#^C17,R0
	BIC	R0,R1
	ASR	R1
	ADD	R1,R0
	ASR	R1
	ASR	R1
	ADD	R1,R0
	RETURN

;+
;BUSTMO -- BUS TIMEOUT ISR
;-
BUSTMO:	BIS	#1,2(SP)			;SET CARRY
	RTI					;RETURN


	SEC					;NOTYET
	RETURN					;RETURN

AREA:	.BLKW	5				;EMT AGRUMENTS AREA
DTTM:	.WORD	0,-1,-1				;DATE/TIME BUFFER

DAYTB:	.WORD	31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.

TBUF:	.WORD	35305,56243,35305,56243
	.BLKW	4

ERR0:	.ASCIZ	"?DATE-W-Program file open error"
ERR1:	.ASCIZ	"?DATE-W-Program file mismatch"
ERR2:	.ASCIZ	"?DATE-E-Program file I/O error"
ERR3:	.ASCIZ	"?DATE-E-Not enough memory"
CRLF:	.ASCIZ	""

MONTHS:	.ASCII	/JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
MSGDAT:	.ASCII	<CR>/Date? /
ADATE:	.ASCII	/DD-MMM-YYYY/<EOL>

	.END	START