;') pSetClock 1.0 © 1993 PdT (Peter Thompson) as freeware.
;') Conceptually based on SetTime 0.9 by Acki (Andreas Ackerman) from Fish
;') 718, but little if any code remains from it.
;') A not quite drop-in replacement for SetClock

;'| Use at your own risk; all I certify is that it is not, in whole or
;'| part, designed to stuff up your system.

;') 1.0 (18.8.93) changes:
;') Back down to 2 SFS blocks
;'( Used slightly slower but smaller code

;') 0.4 (17.8.93) changes:
;') Fixed 0.3 bug.
;') 2.x version string
;') now uses 2.x OS calls if available.
;') Tidied and tightened CLI parsing code.
;'( Grew to 3 SFS blocks
;') Used waste space to put back some speedier code

;') 0.3 changes:
;')
;') Better command line parsing
;') Totally rewritten ClockToStamp and StampToClock routines.
;') Now clears "control bits" in clock on save
;') Now works until about 2045 AD
;') Better range checking on load - returns 10 if clock crazy

TEST	EQU	0	; set non-zero for test mode

	IFEQ	TEST
CLOCKADDR	= $00dc0000
	ENDC

; -- Error levels
ERR_FATAL	EQU	20
ERR_INVALID	EQU	10

; -- Exec library offsets.

AllocMem	= -198
FreeMem		= -210
FindTask	= -294
AllocSignal	= -330
FreeSignal	= -336
OpenDevice	= -444
CloseDevice	= -450
OpenResource	= -498
DoIO		= -456
WaitPort	= -384		; necessary for WB startup
GetMsg		= -372
ReplyMsg	= -378

; -- battmem.resource offsets
ResetBattClock = -6	; no deposit, no return
ReadBattClock = -12	; returns seconds or resets and returns 0
WriteBattClock = -18	; send time to set to in d0

push:	macro
	movem.l	\1,-(SP)
	endm

pop:	macro
	movem.l	(SP)+,\1
	endm

Call:	macro
	jsr	\1(a6)
	endm

	INCLUDE "exec/types.i"
	INCLUDE "devices/timer.i"

tio_secs	=	IOTV_TIME+TV_SECS
tio_cmd		=	IO_COMMAND
tio_mport	=	MN_REPLYPORT
tio_type	=	LN_TYPE
tio_dev		=	IO_DEVICE

MSGMEM	equ	$10001

Stamp	EQUR	d0
Clock	EQUR	a0
Table	EQUR	a1
tIOreq	EQUR	a2
tMport	EQUR	a3
TaskAddr	EQUR	a5
Valid		EQUR	a5

Scratch	EQUR	d1
MASK	EQUR	d5
TEN	EQUR	d6
Xfer	EQUR	d7

MAXARG = 32

; global a4-relative variables
args	equ	-MAXARG
WBmesg	equ	-4
GLOBAL = -MAXARG

;-- Generic(ish) startup code

TDNestCnt = $127
ThisTask = $114
pr_CLI	= $AC		; non-zero of from CLI
pr_Port = $5C		; Taskport address.

A
;	push	d1-d7/a0-a6		;-? save non-return registers
	link	a4,#GLOBAL

	move.l	4,a6			; get ExecBase
	move.l	ThisTask(a6),TaskAddr	; get task address of this task.

	clr.l	WBmesg(a4)		; zero message pointer
	tst.l	pr_CLI(TaskAddr)
	bne	.fromCLI
.fromWB	lea	pr_Port(TaskAddr),a0	; from WB - get and store message
	Call	WaitPort
	lea	pr_Port(TaskAddr),a0
	Call	GetMsg
	move.l	d0,WBmesg(a4)
	bsr	WBmain
	move.l	d0,d2			;-? save return value
	ADDQ.B	#1,TDNestCnt(a6)	; FORBID (from 1.3 includes)
	move.l	WBmesg(a4),a1
	Call	ReplyMsg
	move.l	d2,d0			;-? restore return value
	bra	ZZ
.fromCLI				; from CLI - do CLI things.
	bsr	_main
ZZ	unlk	a4
;	pop	d1-d7/a0-a6		;-? restore other registers
	rts

chopargs:			; split unquoted arguments into array
;	push	d5-d7
	moveq	#' ',d6
	move.l	d0,d5
	moveq	#0,d0
.cha1	sub.w	#1,d5
	bmi	.nomore
	move.b	(a0)+,d1
	cmp.b	d6,d1
	ble	.cha1			; control char - keep going
	addq.l	#1,d0			; got another argc
.cha2	move.b	d1,(a1)+
	sub.w	#1,d5
	bmi	.nomore2
	move.b	(a0)+,d1
	cmp.b	d6,d1			; not a control char - keep copying
	bgt	.cha2
	clr.b	(a1)+
	bra	.cha1
.nomore2
	clr.b	(a1)+
.nomore
;	pop	d5-d7
	rts

;-- main programs for pSetClock

WBmain:			; workbench always does load
	bra	doLoad

_main:
	IFNE	TEST
	bra	gotest
	ENDC

	cmp.w	#MAXARG,d0		; check line not over fixed length
	bcc	.badargs
	lea	args(a4),a1
	bsr	chopargs
	lea	args(a4),a1
	sub.l	#1,d0
	bmi	.badargs
	beq	.noopt			; single must be load, save, or reset
	sub.l	#1,d0
	bne	.badargs		; 2 args. max.
	lea	optStr(PC),a0		; of which the first must be "opt"
	bsr	argcmp
	bne	.badargs
	add.l	#4,a1			; add strlen("opt")+1 to argptr.
.noopt	lea	loadStr(PC),a0
	bsr	argcmp
	beq	doLoad
	lea	saveStr(PC),a0
	bsr	argcmp
	beq	doSave
	lea	resetStr(PC),a0
	bsr	argcmp
	beq	doReset
.badargs
	move.l	#ERR_FATAL,d0
	rts

argcmp:
	push	a1	; case insensitive strcmp to lower case string
.strclp	move.b	(a0)+,d0
	move.b	(a1)+,d1
	beq	.strcx		; run out of one string
	sub.b	d0,d1
	beq	.strclp
	add.b	#'a'-'A',d1	; bug here, but don't care; $D0 matches 0
	beq	.strclp
.strcx	ext.w	d0		; does other match?
	pop	a1
	rts

doLoad:
	bsr	getTimer		; have to do this first pto save a5
	move.l	#ReadBattClock,d7
	bsr	ResFunc
	move.l	d0,d7
	beq	.badAct
	move.l	tIOreq,a1
	move.w	#TR_SETSYSTIME,tio_cmd(a1)
	move.l	d7,tio_secs(a1)
	Call	DoIO			;-| Assumes IO always succeeds.
	bsr	freeTimer
	moveq	#0,d0
	rts
.badAct	moveq	#ERR_INVALID,d0
	rts

doSave:
	bsr	getTimer
	move.l	tIOreq,a1
	move.w	#TR_GETSYSTIME,tio_cmd(a1)
	Call	DoIO			;-| Assumes IO always succeeds.
	move.l	tio_secs(a1),d7
	bsr	freeTimer
	move.l	d7,d0
	ble	.badAct
	move.l	#WriteBattClock,d7
	bra	ResFunc
;	bsr	ResFunc
;	rts

doReset
	move.l	#ResetBattClock,d7
;	bra	ResFunc
;	bsr	ResFunc
;	rts

ResFunc				; do a battclock call.
	push	d0
	lea	battclockID(PC),a1
	moveq	#36,d0
	Call	OpenResource
	tst.l	d0
	beq	.FakeFunc
	move.l	d0,a6			; put base in the right place
	add.l	d7,d0			; add on offset
	move.l	d0,a1			; and move so can jump from it
	pop	d0
	jsr	0(a1)			; do desired call
	move.l	4,a6			; restore exec
	rts
.FakeFunc		; fake non-present battclock calls
	pop	d0
	add.l	#-ResetBattClock,d7
	beq	ResetClock
	add.l	#-(ReadBattClock-ResetBattClock),d7
	beq	ClockToStamp
	bra	StampToClock
;	add.l	#-(WriteBattClock-ReadBattClock),d7
;	beq	StampToClock
;	moveq	#ERR_FATAL,d0
;	rts

ResetClock
	moveq	#0,Stamp
	bra	StampToClock			;-( Assume Save zaps high
;	lea	CLOCKADDR,Clock
;	moveq	#16-1,d0
;	moveq	#0,d1
;.reslp	move.l	d1,(Clock)+
;	dbra	d0,.reslp
;	moveq	#0,d0
;	rts

DAYSECS		= 24*60*60
YEARDAYS	= 365
EPOCH		= 1978
EPOCHHI		= 1900
EPOCHLO		= 78		; (EPOCH MOD 100)
EPOCHFACT	= 1		; (EPOCH+3) mod 4

;-------------------------------------------------------------------------

LeapDays	EQUR Scratch
DaysIn		EQUR d2
DaySecs		EQUR DaysIn

FETCH:	macro
	bsr.S	doget
	endm

ClockToStamp:
;	push	d2-d7/Valid
	moveq	#10,TEN
	moveq	#%1111,MASK
	lea	maxvalid(PC),Valid
	lea	(CLOCKADDR+12*4),Clock	; set up for fetches.
	FETCH				; get years since 1900
	moveq	#-EPOCHLO,Stamp		; subtract for 1978 epoch
	add.l	Xfer,Stamp
	bcc	BadFetch
; Stamp == years since epoch
	moveq	#EPOCHFACT,LeapDays	; pre-adjust leap days
	add.w	Stamp,LeapDays		; add years since epoch
	lsr.w	#2,LeapDays		; and div 4 to get leap days
	lea	normdays(PC),Table	; assume non-leap year
	cmp.w	#(2000-EPOCH),Stamp	; 2000 special since non-leap
	beq	.notleap		; no adjustments needed if 2000
	ble	.daysok			; or to leap days if before
	sub.w	#1,LeapDays		; lost a leap day at 2000
.daysok
	and.w	#%11,Xfer		; check if otherwise leap year
	bne	.notleap
	lea	leapdays(PC),Table	; and pick leap daytable if so.
.notleap
	mulu	#YEARDAYS,Stamp
	add.l	LeapDays,Stamp
; Stamp == days from epoch to start of this year
	FETCH
	sub.w	#1,Xfer			; --months >= 0
	bmi	BadFetch
	moveq	#0,DaysIn
.addmon	move.b	(Table)+,DaysIn		; add preceding month's days.
	add.l	DaysIn,Stamp
	dbra	Xfer,.addmon
	sub.l	DaysIn,Stamp		; remove current month's days.
; Stamp == days from epoch to start of month
	FETCH
	sub.w	#1,Xfer			; --days >= 0
	bmi	BadFetch
	cmp.w	DaysIn,Xfer		; days < days_in_month[this_month]
	bge	BadFetch
	add.l	Xfer,Stamp
; Stamp == days since epoch
	mulu	#(DAYSECS/2),Stamp	; 1<<17 <= DAYSECS <= 1<<16
	add.l	Stamp,Stamp		; even(DAYSECS)
; Stamp == seconds since epoch to start of day
	moveq	#0,DaySecs
	FETCH
	lsl.w	#2,Xfer			; *60 == *64 - *4
	move.l	Xfer,DaySecs
	lsl.w	#4,DaySecs
	sub.w	Xfer,DaySecs
; DaySecs == minutes from start of day to start of hour
	FETCH
	add.l	Xfer,DaySecs
	lsl.w	#2,DaySecs
	move.l	DaySecs,Xfer
	lsl.l	#4,DaySecs
	sub.l	Xfer,DaySecs
; DaySecs == seconds from start of day to start of minute
	FETCH
	add.l	Xfer,DaySecs
; DaySecs == seconds since start of day
	add.l	DaySecs,Stamp
; Stamp == seconds since epoch
.ctsZZ
;	pop	d2-d7/Valid
	rts
BadPair
	add.l	#4,SP			; get rid of return address
BadFetch
	bsr	ResetClock
	moveq	#0,d0
	bra	.ctsZZ

; Fetch next number from clock.

doget:
	move.l	-(Clock),Xfer
	and.l	MASK,Xfer
	mulu	TEN,Xfer
;	moveq	#0,Xfer
;	move.l	-(Clock),Scratch	; fetch messy tens
;	and.b	MASK,Scratch		; get rid of known invalid bits
;	add.b	Scratch,Xfer
;	lsl.b	#2,Scratch
;	add.b	Scratch,Xfer
;	add.b	Xfer,Xfer		; Xfer = Scratch*10 in 20 cycles
	move.l	-(Clock),Scratch	; fetch messy ones
	and.b	MASK,Scratch		; get rid of known invalid bits
	add.b	Scratch,Xfer
	cmp.b	TEN,Scratch		; check last digit in range
	bge	BadPair
	cmp.b	(Valid)+,Xfer
	bcc	BadPair
	rts

;-------------------------------------------------------------------------

HalfDay	EQUR	Scratch		; Half a day's worth of seconds
LeapYrs	EQUR	Scratch		; for correcting years
MonDays	EQUR	Scratch		; Number of days in months
Divisor	EQUR	Scratch		; for converting to HHMMSS

Years		EQUR	d2
Month		EQUR	Years
vecsize		EQUR	Years
Days		EQUR	d3
ANOMALY		EQUR	d4

PUT	macro
;	move.w	\1,Scratch
;	swap	Scratch
;	move.w	\1,Scratch
;	move.l	Scratch,-(Clock)
	bsr	doput
	endm

PUTPAIR	macro
	bsr	dopair
	endm

StampToClock:
;	push	d2-d7
	moveq	#10,TEN
	moveq	#%11,MASK
	moveq	#(2000-EPOCHHI),ANOMALY
	moveq	#0,Years
	lea	(CLOCKADDR+16*4),Clock
; Clear top 4 longwords in clock - seems to reset clock
	move.l	Years,-(Clock)
	move.l	Years,-(Clock)
	move.l	Years,-(Clock)
	move.l	Years,-(Clock)
	move.l	#(DAYSECS/2),HalfDay
	divu	HalfDay,Stamp
	moveq	#0,Days
	move.w	Stamp,Days		; half days since epoch in Days
	clr.w	Stamp
	swap	Stamp
	lsr.w	#1,Days			; days since epoch in Days
	bcc	.isAM
	add.l	HalfDay,Stamp		; add this morning's seconds
.isAM
; Days == days since epoch && Stamp == seconds since start of day

	divu	#YEARDAYS,Days
	move.w	Days,Years		; get psuedo-years in Years
	clr.w	Days
	swap	Days			; get psuedo-days in Days
	move.w	Years,LeapYrs		; find number of leap days since epoch
	add.w	#EPOCHFACT,LeapYrs	; First leap day after epoch+2.
	lsr.w	#2,LeapYrs		; every 4 years.

	add.w	#EPOCHLO,Years		; turn Years into years since 1900
	cmp.w	ANOMALY,Years		; after 2000 one less leap day.
	ble	.pre2001
	sub.w	#1,LeapYrs		; never goes -ve
.pre2001
	sub.w	LeapYrs,Days		; If no underflow got years right.
	bpl	.gotyear

	add.w	#YEARDAYS,Days		; add a years worth of days.
; Can't be more than 1 year out for year range in question
	sub.w	#1,Years		; overshot by one.
	cmp.w	ANOMALY,Years		; 2000 is not a leap year
	beq	.gotyear
	move.w	Years,Scratch		; but any other year divisible by 4 is.
	and.w	MASK,Scratch
	bne	.gotyear
	add.w	#1,Days			; add a day if moved into leap year
.gotyear

; Years == years since 1900 && Days == days since start of year
; Find out if year is leap or not, and choose Month table appropriately.

	lea	normdays(PC),Table
	cmp.w	ANOMALY,Years		; 2000 not a leap year
	beq	.nonleap
	move.w	Years,Scratch		; also not if divisible by 4.
	and.w	MASK,Scratch
	bne	.nonleap
	lea	leapdays(PC),Table
.nonleap
	move.w	Years,Xfer
	PUTPAIR				; Decades & years (special case)
	moveq	#0,MonDays
	moveq	#0,Month
.monlp	add.w	#1,Month
	move.b	(Table)+,MonDays
	sub.w	MonDays,Days
	bpl	.monlp
	addx.w	MonDays,Days		; addback and adjust for 1st = 1
; Days == day of month && Month == month of year
	move.w	Month,Xfer
	PUTPAIR
	move.w	Days,Xfer
	PUTPAIR
	lea	basevec(PC),Table	; Mixed base vector
	moveq	#5-1,vecsize		; 5 entries.
.restlp	moveq	#0,Divisor
	move.w	(Table)+,Divisor
	moveq	#-1,Xfer
.rest2l	add.w	#1,Xfer
	sub.l	Divisor,Stamp
	bcc	.rest2l
	add.l	Divisor,Stamp
	PUT
	dbra	vecsize,.restlp
	move.w	Stamp,Xfer
	PUT				; remainder is seconds
	move.l	Stamp,-(Clock)
;	pop	d2-d7
	moveq	#0,d0
	rts

dopair:	moveq	#-1,Scratch
.dodo	add.w	#1,Scratch
	sub.w	TEN,Xfer
	bpl	.dodo
	add.w	TEN,Xfer
	swap	Xfer
	move.w	Scratch,Xfer
	swap	Scratch
	move.w	Xfer,Scratch
	move.l	Scratch,-(Clock)
	swap	Xfer
doput:	move.w	Xfer,Scratch
	swap	Xfer
	move.w	Scratch,Xfer
	move.l	Xfer,-(Clock)
	rts

;-------------------------------------------------------------------------

getTimer
	move.l	#MP_SIZE,d0		; Allocate a message port
	move.l	#MSGMEM,d1		; Public & cleared memory
	Call	AllocMem
	move.l	d0,tMport		;-( No failure check

	move.l	TaskAddr,MP_SIGTASK(tMport)	; say where signals go
	move.b	#NT_MSGPORT,LN_TYPE(tMport)	; init type field.
	lea	MP_MSGLIST(tMport),a0		; init message list.
	NEWLIST a0
	moveq	#-1,d0				; allocate signal for port.
	Call	AllocSignal
	move.b	d0,MP_SIGBIT(tMport)	;-( No failure check

	move.l	#IOTV_SIZE,d0		; Allocate an IOReq.
	move.l	#MSGMEM,d1		; Public & cleared memory
	Call	AllocMem		;-( No failure check
	move.l	d0,tIOreq

	move.b	#NT_MESSAGE,tio_type(tIOreq)	; message
	move.l	#IOTV_SIZE,d0			; of it's size
	move.l	d0,MN_SIZE(tIOreq)
	move.l	tMport,MN_REPLYPORT(tIOreq)	; that notifies via our port

	lea	timerID(PC),a0		; Open timer.device
	moveq	#0,d0			; Unit 0
	move.l	tIOreq,a1		; Using this IOReq
	move.l	d0,d1			; No flags
	Call	OpenDevice
	rts

freeTimer:
	move.l	tIOreq,a1		; close timer.device
	Call	CloseDevice
	moveq	#0,d0			; free signal bit
	move.b	MP_SIGBIT(tMport),d0
	Call	FreeSignal
	move.l	tMport,a1		; free message port memory
	move.l	#MP_SIZE,d0
	Call	FreeMem
	move.l	tIOreq,a1		; free IOReq memory
	move.l	#IOTV_SIZE,d0
	Call	FreeMem
	rts

;-------------------------------------------------------------------------

normdays				; days in months normal year
	dc.b	31,28,31,30,31,30,31,31,30,31,30,31
leapdays				; days in months in leap year
	dc.b	31,29,31,30,31,30,31,31,30,31,30,31
maxvalid				; valid digit pair range table
	dc.b	2041-EPOCHHI,13,32,24,60,60

	EVEN

basevec					; mixed base vector for HH:MM:SS
	dc.w	10*60*60		; 10s of hours (long subtraction)
	dc.w	60*60			; hours
	dc.w	10*60			; 10s of minutes
	dc.w	60			; minutes
	dc.w	10			; 10s of seconds
;	dc.w	1			; seconds

optStr	dc.b	"opt",0
loadStr	dc.b	"load",0
saveStr	dc.b	"save",0
resetStr
	dc.b	"reset",0

battclockID				; 2.x battery backed clock manager
	dc.b	"battclock.resource",0
timerID					; system timer manager
	dc.b	"timer.device",0
versionID				; 2.x style version string (I hope)
	dc.b	"$VER: pSetClock 1.0 (18.8.93)",0

	IFNE	TEST

	EVEN

CLOCKSTART = 0*365*24*60*60+1
CLOCKEND = 50*365*24*60*60
CLOCKGAP = 59*60+59
gotest:	move.l	#CLOCKSTART,d5
.testlp	push	d5
	move.l	d5,Stamp
	bsr	StampToClock
	moveq	#0,Stamp
	bsr	ClockToStamp
	pop	d5
	cmp.l	Stamp,d5
	bne	.err
	add.l	#CLOCKGAP,d5
	cmp.l	#CLOCKEND,d5
	bcs	.testlp
	move.l	#0,d0
.ZZZ	rts
.err	move.l	#ERR_FATAL,d0
	bra	.ZZZ

	DATA

CLOCKADDR:
	dcb.l	16,314156

	ENDC

	END