.mcall	.module
.module	DC,release=X05,version=8,comment=<Digital Clock Handler>,audit=YES
;+
;			Copyright (c) 1986
;			   C. E. Chew
;
; This software is furnished without license and may be used and  copied
; with the inclusion of the above copyright  notice.  This  software  or
; any other copies thereof may be provided or otherwise  made  available
; to any other person.  No title to and ownership  of  the  software  is
; hereby transferred.
;
; The information in this software is subject to change  without  notice
; and should not be construed as a commitment by the author.
;
; The author nor Digital Equipment Corporation assumes no responsibility
; for the use or reliability of this software.
;
; Edit History:
;
; 26-Jan-87	Set carry before accounting for missing clock tick, otherwise
;		SJ loses time.
;
; 01-Dec-86	Added nul timer so that screen saver code in PI would work.
;
; 29-Nov-86	Added job abort code so that synch wouldn't get tied up.
;
; 26-Nov-86	Included ^X and terminal output context check in synch
;		code. This will fix a problem -
;			1) background has control
;			2) you type ^X and output is attempted
;			3) foreground has control but background prints
;			   the time after a pause and now background has
;			   output context and retains it until the next
;			   cycle and the process repeats.
;
; 23-Nov-86	Tidied up clock interrupt vector determination. Checked
;		for presence of KW11-P clock also.
;
; 11-Nov-86	SJ can find interrupted location on the stack and doesn't
;		need to save it (this saves one word).
;		FB no longer checks terminal context in the synch code. This
;		didn't seem to be very useful.
;		The date is now included in the display.
;
; 09-Nov-86	Made dependence on EIS optional. SET DC SYSGEN will now
;		patch out the div instruction if necessary. mul instruction
;		replaced by repeated addition.
;		Assumed that .inten and .synch code executes in kernel
;		mode and priority 0 so that $mfps call is replaced by
;		clr -(sp). This makes the EIS version smaller, getting
;		around a strange bug in RT11. This bug shows up when
;		the handler is loaded in a particular way and its size
;		is about 134/135 words...
;-
;+
;
; Handler supports the following set options:
;
;  SET DC SYSGEN
;	Configure the handler for the current operating system.
;  SET DC ON
;	Load handler if required and start displaying the time.
;  SET DC OFF
;	Stop displaying the time and unload the handler.
;  SET DC UPDATE=n
;	Time to delay between screen updates. Numbers less than the clock
; frequency will be treated as the number of seconds, whereas numbers greater
; than the clock frequency will be treated as the number of ticks.
;
; SET DC SYSGEN must be performed to configure the handler before it will
; install.
;-
	.sbttl	Macro Declarations
;
;debug	=: 1
;trace	=: 1
;
;+
; The dbg macro is used to conditionalise out debugging code in an
; aesthetically pleasing manner.
;-
.macro	dbg	comand
.if df	debug
	comand
.endc
.endm	dbg
;
.macro	ndbg	comand
.if ndf	debug
	comand
.endc
.endm
;+
; Due to the size of the set code, it is impossible to squeeze everybody
; into block 0. Thus blocks 2 and above are used for overlays which are
; read in when the set code is invoked. The overlays will be read into
; locations 1000-1776 (relative) and this must be kept in mind.
;
; The general structure is:
;
;	overlay
;	ovcmd	foo1
;	    ...
;	ovcmd	foo2
;	    ...
;	ovend
;-
.macro	overlay
	.blkb	<. - dcstrt + 777>&^c<777> + dcstrt - .
ovly	= .
.endm	overlay
;
.macro	ovend
.assume	.-ovly le 1000
.endm	ovend
;
.macro	ovcmd	name ?foo
.assume	<<ovly-dcstrt>&777> eq 0
ob.'name	==: <<ovly-dcstrt>/1000>+1
oo.'name	==: <. - ovly>/2
.if df	trace
	mov	r0,-(sp)
	jsr	r0,foo
	.asciz	/name/
	.even
foo:	.print
	mov	(sp)+,r0
.endc
.endm	ovcmd
;+
; These macros allow overlay sections to access data and code in block 0,
; and vice versa.
;
; ojsr allows overlay code to call a subroutine in block 0.
;-
.macro	ojsr	reg rtn
	jsr	reg,rtn - dcstrt + ovly
.endm
;+
; ovlink allows transfer of control to another overlay. If ov is not blank
; then the transfer of control is from one overlay to another, otherwise
; a transfer from block 0 to the overlay is assumed.
;-
.macro	ovlink	name ov
.if nb	<ov>
	ojsr	r0 o.read
.iff
	jsr	r0,o.read
.endc
	.byte	ob.'name
	.byte	oo.'name
.endm	ovlink
;+
; omov allows data to be moved within block 0 from an overlay. ov1 and ov2
; specify which (src or dst) operand is the one residing in block 0.
;-
.macro	omov	src dst ov1 ov2
.if nb	<ov1>
.if nb	<ov2>
	mov	src-dcstrt+ovly,dst-dcstrt+ovly
.iff
	mov	src-dcstrt+ovly,dst
.endc
.iff
.if nb	<ov2>
	mov	src,dst-dcstrt+ovly
.iff
	mov	src,dst
.endc
.endc
.endm	omov
;+
; To save space, much of the code within the handler is patched dynamically
; at runtime. To aid in this process the following macros are provided. The
; general usage is:
;
; Within the handler code:
;
;	patblk	foo
;	    ...				; code to be patched
;	pateob	foo
;
; In the start up code:
;
;	patcod	foo
;	    ...				; code to patch into handler
;	pateoc	foo
;
; To effect the patch:
;
;	patch	foo
;-
.macro	patblk	name
pb.'name	==: .
.endm	patblk
;
.macro	pateob	name
pl.'name	==: .-pb.'name
.endm	pateob
;
.macro	patcod	name
pc.'name	==: .
.endm	patcod
;
.macro	pateoc	name
.assume	.-pc.'name eq pl.'name
.endm
;
.macro	patch	name
	jsr	r5,o.patch
	.word	pc.'name-.-2
	.word	pb.'name-dclqe
	.word	pl.'name/2
.endm	patch
	.sbttl	Global Declarations
;
	.dsabl	gbl
;
	.mcall	.drdef .br .assume .addr .exit .timio
	.mcall	.print .inten .readw .ttinr .date
	dbg	<.mcall	.twait .gtim .ttyout>
;
mmg$t	==: 0
erl$g	==: 0
tim$it	==: 0
;
h.siz	=: 52				; size of handler in bytes
h.gen	=: 60				; sysgen options in effect
;
lkint	=: 100				; line time clock vector
kw11int	=: 104				; KW11-P programmable clock vector
proclk	=: 230				; PRO clock vector
;
emtvec	=: 30				; emt trap vector
pr7	=: 340				; psw priority 7 mask
sysptr	=: 54				; base of RMON
	$mtps	=: 360			; mtps entry point
	$mfps	=: 362			; mfps entry point
	fork	=: 402			; offset to fork processor
	confg2	=: 370			; configuration word
		pro$	=: 20000	; PRO machine
		eis$ 	=: 400		; EIS present
	config	=: 300			; configuration word
		usr$	=: 1000		; USR permanently resident
		clk50$	=: 40		; 50 Hz clock
		fbmon$	=: 1		; FB or XM monitor
		kt11$	=: 10000	; XM monitor
		kw11p$	=: 40000	; programmable clock exists
		clock$	=: 100000	; system clock present
	sysver	=: 276			; system version byte
		ver.05	=: 05.		; version 5
	sysupd	=: 277			; release number
		rls.01	=: 29.		; release 01 (believe it or not!)
	usrare	=: 374			; size of USR in bytes
	$usrlc	=: 266			; load address of USR
	usrloc	=: 352			; USR entry address
	$date	=: 262			; date
	e16lst	=: 316			; emt sub dispatcher
		ttinr	=: 0		; offset to .ttinr dispatcher
		rctrlo	=: 26.		; offset to .rctrlo dispatcher
	$time	=: 320			; SJ time longword
	cntxt	=: 320			; FB/XM job context
	synch	=: 324			; synch routine address
	conlog	=: 422			; offset to time of day routine
	pnptr	=: 404			; offset to pname table
		pnsiz	=: 32.		; maximum number of entries
	p1ext	=: 432			; par1 externalisation
	sysgen	=: 372			; sysgen features word
		erlg$	=: 1		; error logging support
		mmgt$	=: 2		; memory management support
		timit$	=: 4		; device time out support
		timer$	=: 2000		; sj timer support
		mtty$	=: 20000	; multiterminal support
		stask$	=: 40000	; system job support
	$inddv	=: 426			; pointer to IND device string
rmonsz	=: 6000.			; approximate size of RMON (words)
usrbuf	=: 2000				; size of USR buffer (bytes)
jsw	=: 44				; job status word
	spxit$	=: 40			; command and preserve command file
chnarg	=: 510				; place to stuff command
;
mxjbnm	=: 8.				; maximum number of jobs
intval	=: 60.				; default pausing interval
tinlen	=: 100				; approximate .ttyin code length
;
i.jnum	=: 24				; job number owning impure area
i.ioct	=: 32				; channel wait
i.sctr	=: 34				; suspension counter
i.blok	=: 36				; impure offset for job blocking
	usrwt$	=:     20
	kspnd$	=:    100
	exit$	=:    400
	norun$	=:   1000
	spnd$	=:   2000
	chnwt$	=:   4000
	ttoem$	=:  10000
	ttowt$	=:  20000
	ttiwt$	=:  40000
;
	.drdef	dc, 366, hndlr$, 0, 0, 0
	.sbttl	Installation Code
;+
; Install the handler ensuring that it is not already present in
; another guise.
;-
	.enabl	lsb
	.drins	dc
	br	10$
	br	o.erri			; cannot be a system device
;
10$:	call	o.mon			; ensure we have the right monitor
	bcs	o.erri
;
	mov	o.rnam,o.dnam
	call	o.find
	bcc	o.erri			; we already exist
o.reti:	tst	(pc)+			; ok to install
o.erri:	sec
	return
;
o.name::
	mov	@#sysptr,r0		; base of RMON
	add	pnptr(r0),r0		; base of pname table
	mov	#pnsiz,r1		; entries to search through
20$:	cmp	o.dnam,(r0)+
	beq	30$			; this is it
	sob	r1,20$
o.errl:	br	o.erri			; not there
;
30$:	tst	-(r0)			; point at it
	br	o.reti
;
o.find::
;	.dstatu	#o.addr #o.dnam		; find out where I am
	mov	pc,r0
	add	#<o.addr-.>,r0
	mov	r0,-(sp)
	add	#<o.dnam-o.addr>,r0
	emt	342
	clz				; may need to indicate no such device
	bcs	o.erri			; cannot find me
;
	mov	o.load,r3
	beq	o.erri			; not loaded
o.retl:	br	o.reti
;
o.kmon::
	tst	(sp)+			; clean up stack
	mov	#chnarg,r1		; chain area
	mov	(r0),r3			; number of bytes
40$:	movb	(r0)+,(r1)+		; pass the stuff
	sob	r3,40$
	clrb	(r1)+			; kill any crud
	clrb	(r1)+
	clr	r0			; set up for exit
	bis	#spxit$,@#jsw
	.exit
;
o.addr:	.blkw	4
o.load	=: o.addr + 4
o.dnam:	.rad50	/dc /
o.snam:	.rad50	/dc /
o.rnam:	.rad50	/$dc/
;
.assume	. le 400
	.sbttl	Activation Code
;+
; This set code must be used to activate and deactivate the daemon. The proper
; technique is to load the handler, then turn it on.
;-
	.enabl	lsb
	.drset	on, 1, o.on
	.drset	off, 1, o.off
	.drset	sysgen, 1, o.sysg
	.drset	update, 1, o.dly, NUM
	.drset	state, 1, o.stat
;
o.mon::
	mov	@#sysptr,r0		; point at RMON base
;
	bit	#clock$,config(r0)	; check for a clock
	beq	o.errl
;
	mov	confg2(r0),-(sp)	; check for EIS compatibility
	bic	#^c<eis$>,(sp)
	cmp	(pc)+,(sp)+
eis:	.word	eis$
	bne	o.errl
;
	bit	#mtty$,sysgen(r0)	; ensure not multi-terminal
	bne	o.errl
;
	bit	#fbmon$,config(r0)
	beq	o.retl			; SJ installation will work
;
	cmpb	sysver(r0),#ver.05
	blo	o.errl			; must be at least V5
	br	o.retl
;
o.dly::
	jmp	o.delay
;
o.sysg::
	jmp	o.sgen
;
o.read::
	mov	r0,r1			; copy across
	.addr	#o.rblk r0
	mov	r0,4(r0)		; point at overlay region
	add	#<dcstrt-o.rblk>,4(r0)
	movb	(r1)+,2(r0)		; block to read
	movb	(r1)+,r1		; byte offset to subroutine
	.readw	code=noset
	bcs	60$
	clr	r0			; enter subroutine
	bisb	r1,r0			; don't sign extend
	asl	r0			; make it a byte offset
	.addr	#dcstrt r0 add
	rts	r0
;
60$:	inc	(sp)+			; clear the stack
	return				; say error
;
o.rblk:	.byte	17, 10			; emt block for .readw
	.blkw	1
	.blkw	1
	.word	400
	.word	0
;
o.on::
	ovlink	on
;
o.off::
	ovlink	off
;
o.stat::
	ovlink	sta
;
o.freq::
	mov	#60.,-(sp)		; assume it's 60 Hz
	mov	@#sysptr,r1		; base of RMON
	bit	#pro$,confg2(r1)
	beq	700$			; not a PRO
	mov	#64.,(sp)		; PRO clock ticks at 64 Hz
	br	710$
;
700$:	bit	#clk50$,config(r1)	; fix line frequency if it's 50Hz
	beq	710$
	mov	#50.,(sp)
710$:	mov	(sp)+,r1
	return
;
.assume	. le 1000
	.sbttl	Clock Data
;+
; The display text will overwrite the error code at runtime. To begin
; with we just declare it nicely.
;-
	.enabl	lsb
	.drbeg	dc
;
dcentry::
;
	patblk	msg
mesage:	.byte	33, '7			; save cursor and attributes
	.byte	33, '[, ';, '1, '3, '2, 'H ; top line
	.byte	33, '[, '2, '0, 'D	; position 60
	.ascii	/ /
dcdate:	.ascii	/01-Jan-72  /
dcbuff:	.ascii	/12:12:12 /
	.byte	33, '8			; restore cursor and attributes
	.byte	200
	.even
	pateob	msg
;
dccode	=: . - dcentry			; length of error code
.	= . - dccode
	.sbttl	Handler Entry Point
;+
; Force hard errors on any IO transaction foisted upon us.
;-
	.enabl	lsb
	ndbg	<mov	dccqe,r5>	; get queue element
	ndbg	<bis	#hderr$,@-(r5)>	; force a hard error
	ndbg	<.drfin	dc>
.if gt	<dcentry+dccode>-.
	.blkb	<dcentry+dccode>-.
.endc
	.sbttl	Abort Code
;+
; This code is entered every time a job aborts. This code will ensure that
; the synch code is not trapped by this occurrence.
;-
	.enabl	lsb
dcstop::
	asr	dcsema			; check if we're in the synch code
	bcc	dcclr			; not within critical section
;
	cmp	r4,dcjbnm		; check for this particular job
	bne	dcret			; nope
	clr	synblk+q.comp		; clear the synch block for reuse
;
dcwait:	clr	dcnull			; say cpu is busy
dcretry:inc	dctock			; try again soon
	br	dcclr
	.sbttl	Clock Interrupt Entry
;+
; Clock interrupts are redirected here. A semaphore is used to control
; entry into the code proper.
;-
	.enabl	lsb
dcclock::
;
dcgo::	asr	(pc)+			; toggle semaphore
dcsema:	.word	^c<1>			; no carry means entry ok
	bcc	dcsched
dcfake:	rol	dcsema			; undo semaphore touch (and set carry)
	jmp	@(pc)+			; join main interrupt code
.lkint:	.blkw	1
;
dcsched:dec	(pc)+			; carry unaltered
dctock:	.word	intval
	bne	dcfake			; not time yet
	br	dcint
;
;	.drast	dc 0 dcint
	br	dcstop			; abort entry point
dcint::	jsr	r5,@$inptr		; go to system state
	.word	^c<0*^o40>&^o340
;+
; We can pass a half baked interrupt since the inten call guarantees that
; intlvl will be positive. Thus the interrupt service will simply increment
; a counter and return immediately.
;-
	clr	-(sp)			; account for missing clock tick
	sec				; SJ requires carry set
	call	@.lkint
;
	.br	dcconv
	.sbttl	Obtain the Time
;+
; For SJ monitors without timer support, we can grab the time from
; the RMON offset area. We can do this without locking out interrupts
; since the high order time only ticks over about once every 18 to 21 minutes.
;-
	.enabl	lsb
dcconv::
;
	patblk	sj1
	mov	@(pc)+,r4		; find who owns output context
.ttousr:.blkw	1
	bit	#<ttiwt$!spnd$!chnwt$>,i.blok(r4)
	beq	dcwait			; not blocked correctly
.i.octr	=: .+2
	tstb	0(r4)			; check for space in output buffer
	bne	dcwait
;
	mov	r4,(pc)+		; context of this job
dcntxt:	.blkw	1
;
	mov	i.jnum(r4),dcjbnm	; give it to synch
	pateob	sj1
;
	mov	r0,-(sp)		; save scratch
	mov	r1,-(sp)
;
dctod:	mov	(pc)+,r5		; point at high order time
.tod:	.blkw	1
10$:	mov	(r5)+,r0		; move across high order time
	mov	(r5),timlo		; move across low order time
	cmp	-(r5),r0
	bne	10$			; time ticked over
todlen	= .-dctod
;
	mov	r0,timhi		; high order time
	mov	(sp)+,r1		; recover
	mov	(sp)+,r0
;
	.br	dcsynch
	.sbttl	Synch Level Processing
;+
; Perform the conversion from binary to ascii at fork and completion
; level.
;-
	.enabl	lsb
dcsynch:
;	.synch	synblk pic		; ask for it
	mov	(pc)+,r4
.synblk:.word	synblk-dclqe
	jsr	r5,@(pc)+
.synch:	.blkw	1
	br	dcwait
;
	patblk	sys
dcsyst::tstb	@(pc)+			; check for context change in progress
.xflag:	.blkw	1
	bne	dcwait
syslen	= . - dcsyst
;
.	= . - syslen
	.rept	syslen/2
	nop				; assume it's not a system job monitor
	.endr
	pateob	sys
;
	patblk	sj2
	cmp	@.ttousr,dcntxt		; confirm the output context
	bne	dcwait
	pateob	sj2
;
.nultim	= .+2
	cmp	#0,dcnull		; look for null timeout
	blo	dcretry
;
dcout::
	mov	r2,-(sp)		; save registers
	mov	r4,-(sp)
;
	mov	(pc)+,r2		; point at output buffer
.dcbuff:.word	dcbuff-dclqe
	mov	(pc)+,r1		; low order time
timlo:	.blkw	1
	jsr	r3,dctime		; convert the time
;
.minute:.word	60.*60.			; ticks per minute
		.byte	60.			; minutes per hour
			.byte	10.			; hours per ten
				.byte	200
				.byte	201
			.byte	10.			; minutes per ten
				.byte	200
				.byte	201
.second:	.byte	60.			; ticks per second
			.byte	10.			; seconds per ten
				.byte	200
				.byte	201

	.byte	0			; finished
;
	.br	dcprint
	.sbttl	Print the Time
;+
; The time has been assembled in the message block. All that is required
; now is that we print it out.
;
; The print request is performed at pr7 so that keyboard input interrupts
; won't disturb the sequence of characters as they are placed into the
; output buffer.
;-
	.enabl	lsb
dcprint::
	ndbg	<clr	-(sp)>		; fake an emt
	ndbg	<mov	(pc)+,-(sp)>
.ttout:	ndbg	<.word	ttout-dclqe>
;
	mov	(pc)+,r0		; point at output buffer
.mesage:.word	mesage-dclqe
;
	ndbg	<mov	#pr7,-(sp)>	; perform at pr7
	ndbg	<mov	@#emtvec,-(sp)>
	ndbg	<rti>
;
	.print
ttout:	mov	(sp)+,r4		; restore
	mov	(sp)+,r2
	dbg	return
;
	mov	dctick,dctock		; restart timer
	add	(pc)+,(pc)+		; bump null timer
dctick:	.word	intval
dcnull:	.word	0
;
dcclr:	asl	dcsema			; clear the semaphore
dcret:	return
	.sbttl	Convert the Time to ASCII
;+
; Now we have the time in registers r0 [high order] and r1 [low order].
; Convert the time from ticks (t) to hours (h), minutes (m) and seconds (s).
;-
	.enabl	lsb
dctime::
	dbg	<mov	sp,(pc)+>
spcheck:dbg	<.blkw	1>
;
	mov	(r3)+,r4		; split into h/m (r0) and s/t (r1)
30$:	patblk	eis
	ndbg	<div	r4,r0>		; divide
	dbg	<br	divide>
divdon:	pateob	eis
;
	mov	r1,-(sp)		; stack it
	mov	r0,-(sp)
;
20$:	mov	(sp)+,r1		; grab next part
	clr	r0			; extend to 32 bits
	movb	(r3)+,r4
	beq	40$			; done
	bgt	30$			; split again
;
	add	#'0,r1			; make to ascii
	movb	r1,(r2)+
	dbg	<mov	r1,-(sp)>
	dbg	<.ttyou	r1>
	dbg	<mov	(sp)+,r1>
	ror	r4			; skip if required
	adc	r2
	br	20$
;
40$:	dbg	<bit	#1,r3>
	dbg	<beq	50$>
	dbg	<.print	#emsg>
	dbg	<.exit>
50$:	dbg	<cmp	sp,spcheck>
	dbg	<beq	60$>
	dbg	<.print	#spmsg>
	dbg	<.exit>
60$:	rts	r3
	.sbttl	Synch Queue Element
;+
; The queue element will be patched in at runtime. It is assumed that the
; only RMON vectors that we will use will be $inptr and maybe $fkptr. This
; leaves up to 7 ($rlptr, $mpptr, $gtbyt, $ptbyt, $ptwrd, $elptr and $timit)
; words unused.
;-
	.enabl	lsb
;
	patblk	syn
synblk:	.blkw	1
dcjbnm:	.blkw	1			; job number to switch
	.blkw	2
timhi:	.blkw	1			; synch identifier
	.word	-1
	.word	0
	pateob	syn
	.sbttl	Software Division Patch Block
;+
; If required, the software division code will be patched into this
; area, overwriting the RMON vectors.
;-
	.enabl	lsb
;
	patblk	div
divide:	mov	#<16.+1>,-(sp)		; sixteen bit quotient
10$:	cmp	r4,r0
	bhi	20$			; won't go, carry clear
	sub	r4,r0			; divide
	sec				; set next quotient bit
20$:	rol	r1			; bring up next bit
	rol	r0
	dec	(sp)			; until all bits done
	bne	10$
	ror	r0			; bring back remainder
;
	mov	r1,(sp)			; quotient is in r1
	mov	r0,r1			; remainder is in r0
	mov	(sp)+,r0		; now they're swapped
	br	divdon
divlen	=: . - divide
	pateob	div
	ndbg	<.	= . - divlen>
;
	.drend	dc
	.sbttl	Alter Sysgen Parameters
;+
; Change some parameters to allow for sysgen parameters.
;-
	.enabl	lsb
o.sgen::
	mov	@#sysptr,r0
	mov	sysgen(r0),r0		; get sysgen options
	bic	#^c<mmgt$!erlg$!timit$>,r0
	mov	r0,h.gen		; change our options
;+
; Since we have some headroom at the end of the handler, due to the
; presence of the synch queue element, we don't have to resize
; the handler.
;-
	.if eq	1
	asl	r0			; create an index into the tables
	mov	pc,r1
	sub	#.,r1			; locate the base of the code
	add	r1,r0
;
	mov	#<dcend-dcstrt>,h.siz	; re-size the handler
	add	o.size(r0),h.siz
;
	mov	#<$inptr-dcint-4>,dcint+2 ; re-direct the interrupt server
	add	o.size(r0),dcint+2
	.endc
;+
; Now that we have made provision for software division, we have to enlarge
; the handler if there is no eis present so that the division subroutine can
; be patched in.
;-
	mov	@#sysptr,r0		; base of RMON
	mov	#eis$,r1
	clr	-(sp)
	bit	r1,confg2(r0)
	bne	10$			; yes we have EIS
	clr	r1			; say no eis
	mov	#divlen,(sp)
;
10$:	mov	r1,eis			; say whether it's software or not
;
	mov	#<dcend-dcstrt>,h.siz	; re-size the handler
	add	(sp),h.siz
;
	mov	#<$inptr-dcint-4>,dcint+2 ; re-direct the interrupt server
	add	(sp)+,dcint+2
;
20$:	clc
	return
;
	.if eq	1
o.size::
	.word	0.			; no options
	.word	2.			; erlg
	.word	10.			; mmgt
	.word	12.			; erlg, mmgt
	.word	2.			; timit
	.word	4.			; erlg, timit
	.word	12.			; mmgt, timit
	.word	14.			; erlg, mmgt, timit
	.endc
	.sbttl	Set the Update Frequency
;+
; The update frequency will be set to the value in r0. This value will
; be interpreted as the number of seconds if it is greater than the line
; time clock frequency, otherwise it will be interpreted as the number
; of ticks.
;-
	.enabl	lsb
o.delay::
	call	o.freq			; determine the clock frequency
;
	cmp	r0,r1			; consider scale
	bhis	20$			; leave it in ticks
;
	clr	-(sp)			; product
10$:	add	r0,(sp)			; repeated addition is easiest
	sob	r1,10$
;
	mov	(sp)+,r0
	beq	40$			; must not be zero
;
20$:	dec	r0			; update disk copy
	mov	r0,dctick
	mov	o.rnam,o.dnam		; find in core copy
	call	o.find
	bcs	30$			; not there, doesn't matter
	mov	#intval,<dctock-dclqe>(r3)
	mov	dctick,<dctick-dclqe>(r3)
;
30$:	tst	(pc)+
40$:	sec
	return
;
.assume	.-dcstrt le 1000
	.sbttl	Turn On the Handler
;+
; Enables displaying of the time of day on the console.
;-
	overlay
	ovcmd	on
;
	.enabl	lsb
	omov	o.snam o.dnam o o	; look for original name
	ojsr	pc o.find
	bcc	20$			; no problem
	bne	50$			; not found in tables
	ojsr	r0 o.kmon		; attempt to load the handler
	.word	10$-.
	.asciz	/load dc/
	.asciz	/set dc on/
10$:	.even
;
20$:	ojsr	pc o.name		; find our name
	bcs	50$
	omov	o.rnam (r0) o		; fix it
	mov	r0,(pc)+		; record where it is
o.ent:	.blkw	1
;
	call	o.par			; enforce par1 restriction
	bcs	o.errn
;
	call	o.gtim			; fix up gtim routine
	bcs	o.errn
;
	patch	msg			; implement general patches
	patch	syn
;
	mov	@#sysptr,r0		; base of RMON
	bit	#stask$,sysgen(r0)	; check for system jobs
	beq	1999$
	mov	$inddv(r0),-(sp)	; device name for IND
	add	#4,(sp)			; point at xflag (I hope)
	patch	sys			; patch in system job support
	mov	(sp)+,<.xflag-dclqe>(r3)
;
1999$:	omov	eis r1 o		; implement software division
	bne	30$
	patch	div
	patch	eis
;
30$:	mov	@#sysptr,r0		; base of RMON
	bit	#fbmon$,config(r0)
	bne	40$			; FB or XM
;
	patch	sj1			; implement SJ patches
	patch	sj2
;
40$:	ovlink	on1 o
;
o.errn:	omov	o.snam @o.ent o		; fix up name
50$:	sec				; force an error
	return
	.sbttl	Implement Patches
;+
; This code will actually implement the patches invoked using the patch
; macro. r0, r1, r2 will be corrupted. It is assumed that r3 will point
; at dclqe in the loaded handler.
;-
	.enabl	lsb
o.patch::
	mov	(r5)+,r1		; patch source
	add	r5,r1
	mov	(r5)+,r2		; patch destination
	add	r3,r2
	mov	(r5)+,r0		; size of patch in words
;
10$:	mov	(r1)+,(r2)+		; do it
	sob	r0,10$
	rts	r5
	.sbttl	General Patches
;+
; The display message is patched in to overwrite the error
; code at the head of the handler. This saves about 7 words of low
; memory!. We assume that once the handler is started up, it is
; VERY, VERY unlikely to be entered at the entry point (as opposed
; to VERY unlikely before being started up.
;-
	.enabl	lsb
;
	patcod	msg
$mesage:.byte	33, '7			; save cursor and attributes
	.byte	33, '[, ';, '1, '3, '2, 'H ; top line
	.byte	33, '[, '2, '0, 'D	; position 60
	.ascii	/ /
$dcdate:.ascii	/           /
$dcbuff:.ascii	/12:12:12 /
	.byte	33, '8			; restore cursor and attributes
	.byte	200
	.even
	pateoc	msg
;+
; The synch queue element is patched in at the end of the handler
; overwriting all unused RMON vectors.
;-
	patcod	syn
$synblk:.blkw	1
$dcjbnm:.blkw	1			; job number to switch
	.blkw	2
$timhi:	.blkw	1			; synch identifier
	.word	-1
	.word	0
	pateoc	syn
	.sbttl	Patches for Systems Without EIS
;+
; These patches are implemented if the handler is to be used on a system
; without EIS.
;-
;+
; Quick and dirty division algorithm. This is a trade off between speed and
; space. Repeated subtraction is out of the question, so I chose restoring
; unsigned division. It is assumed that the time will never cause the
; quotient to overflow, hence on the first compare/subtract no check is
; made for overflow.
;
; Register allocation is as follows:
;
; 	Input:	r0	high order dividend
;		r1	low order dividend
;		r4	unsigned divisor
;
;	Output:	r0	quotient
;		r1	remainder
;-
	.enabl	lsb
;
	patcod	eis
	br	divide-pb.eis+pc.eis
	pateoc	eis
;
	patcod	div
$divide:mov	#<16.+1>,-(sp)		; sixteen bit quotient
10$:	cmp	r4,r0
	bhi	20$			; won't go, carry clear
	sub	r4,r0			; divide
	sec				; set next quotient bit
20$:	rol	r1			; bring up next bit
	rol	r0
	dec	(sp)			; until all bits done
	bne	10$
	ror	r0			; bring back remainder
;
	mov	r1,(sp)			; quotient is in r1
	mov	r0,r1			; remainder is in r0
	mov	(sp)+,r0		; now they're swapped
	br	divdon-pb.div+pc.div
	pateoc	div
	.sbttl	SJ Patches
;+
; These patches provide for the printing of the time under SJ. Because
; SJ doesn't have an impure area, we must allow for printing only
; when the cpu is waiting for terminal input.
;-
	.enabl	lsb
;
	patcod	sj1
	mov	6(sp),r4		; grab interrupted pc from stack
	cmp	(r4),(pc)+
	 .ttinr
	beq	10$			; stopped at .ttinr
	cmp	r4,@#sysptr
	blo	dcwait-pb.sj1+pc.sj1	; wasn't in RMON
	cmp	(r4),(pc)+
	 bne	.-4
	bne	dcwait-pb.sj1+pc.sj1	; wasn't stuck busy waiting
;
10$:	tst	@(pc)+
.ttoctr:.blkw	1
	bne	dcwait-pb.sj1+pc.sj1	; terminal buffer not empty
	pateoc	sj1
;
	patcod	sj2
	nop				; kill the code
	nop
	nop
	nop
	pateoc	sj2
	.sbttl	System Job Support Patches
;+
; This code will check for a ^X sequence. The time will not be printed
; under such circumstances.
;-
	.enabl	lsb
	patcod	sys
	tstb	@(pc)+			; check for context change in progress
$.xflag:.blkw	1
	bne	dcwait-pb.sys+pc.sys
	pateoc	sys
	.sbttl	Determine Address of Time of Day Routine
;+
; The time of day routine can be located using an (undocumented) RMON offset
; in version 5 of RT11XM and RT11FB. This method will not work for version 5
; of RT11SJ. For the SJ monitor without timer support, the time is stored
; in the RMON offset area. For SJ monitors with timer support, we must
; use a heuristic to find the time of day routine.
;
; Although this is very general, the unfortunate thing is that this handler
; REQUIRES timer support, so if we're running under SJ without timer support
; we won't get this far since installation will fail!
;-
	.enabl	lsb
o.gtim::
	mov	@#sysptr,r0		; base of RMON
	bit	#fbmon$,config(r0)
	beq	10$			; SJ monitor
	add	conlog(r0),r0		; calculate address of gtim routine
	br	40$
;
10$:	bit	#timer$,sysgen(r0)
	bne	20$			; SJ monitor with timer support
;+
; SJ without timer support. It is possible to determine the time directly
; from the RMON offset area.
;-
	add	#$time,r0		; address of time longword
	mov	r0,<.tod-dclqe>(r3)
	br	60$
;+
; SJ with timer support. The time must be obtained via the GTIM service
; routine. The method used to find this is to first locate the main
; EMT dispatch table, then use the 18th entry to find the GTIM routine
;-
20$:	mov	@#emtvec,r0		; address of emt processor
30$:	cmp	r0,#160000		; don't look in IO page
	bhis	70$
	cmp	(r0)+,(pc)+		; look for emt table
	 add	pc,(sp)
	bne	30$
	cmp	(r0)+,(pc)+
	 add	@(sp)+,pc
	bne	30$
;
	add	<18.-1>*2(r0),r0	; point at GTIM routine
	add	#10,r0			; push past ensys
;+
; The address of the GTIM service routine is in r0. Overwrite the time
; of day code in the handler.
;-
40$:	mov	r0,.time		; store address of subroutine
	mov	r3,r2			; patch point in handler
	add	#<dctod-dclqe>,r2
	mov	pc,r1			; GTIM call code
	add	#<dcgtim-.>,r1
	mov	#<todlen/2>,r0		; words to patch
;
50$:	mov	(r1)+,(r2)+		; patch
	sob	r0,50$
;
60$:	tst	(pc)+
70$:	sec
	return
	.sbttl	GTIM Call Code
;+
; This code is used to determine the time of day from those systems
; with timer support.
;-
	.enabl	lsb
dcgtim::
	cmp	-(sp),-(sp)		; make room for time
	mov	sp,r0
	call	@(pc)+			; determine time of day
.time:	.blkw	1			; time of day vector in RMON
	mov	(sp)+,r0
	mov	(sp)+,timlo-dctod+dcgtim
.assume	todlen eq .-dcgtim
	.sbttl	Enforce PAR1 Restriction
;+
; If running under XM, this handler must not reside in the PAR1 area.
;-
	.enabl	lsb
o.par::	clc
	mov	@#sysptr,r0		; base of RMON
	bit	#kt11$,config(r0)
	beq	10$			; no problem, not XM
;
	cmp	r3,#40000		; base of par2
10$:	return
;
	ovend
	.sbttl	Continuation of Turn On Code
;+
; The turn on code is extended into a second overlay due to lack of
; space.
;-
	overlay
	ovcmd	on1
	.enabl	lsb
;
	call	o.imp			; fix impure pointers
;
	call	o.date			; fix the date
;
	mov	@#sysptr,r0		; base of RMON
	mov	synch(r0),<.synch-dclqe>(r3) ; point at synch routine
;
	ojsr	pc o.freq		; determine clock frequency
	mov	#60.,r2			; scale up to one minute
	clr	-(sp)
;
42$:	add	r1,(sp)
	sob	r2,42$
	mov	(sp)+,<.nultim-dclqe>(r3)
;
	bit	#clk50$,config(r0)	; fix line frequency if it's 50Hz
	beq	10$
	movb	#<50.>,<.second-dclqe>(r3)
	mov	#<50.*60.>,<.minute-dclqe>(r3)
;
10$:	add	r3,<.mesage-dclqe>(r3)	; fix message address
	add	r3,<.dcbuff-dclqe>(r3)	; fix output buffer address
	add	r3,<.ttout-dclqe>(r3)	; fix print request
	add	r3,<.synblk-dclqe>(r3)	; fix synblk pointer
;
	call	o.lkint			; find clock interrupt vector
	mov	(r1),<.lkint-dclqe>(r3)	; adjust clock vector
	mov	r3,-(sp)
	add	#<dcclock-dclqe>,(sp)
	mov	(sp)+,(r1)
	.exit
	.sbttl	Fix the Date in the Display
;+
; Decode the system date and convert it for the display in the handler.
;-
	.enabl	lsb
o.date::
	.date				; get the date
	bic	#140000,r0		; clear out junk
	beq	50$			; no date
;
10$:	mov	#5,r1			; decode
	mov	r0,-(sp)
	bic	#^c<37>,(sp)
20$:	asr	r0
	sob	r1,20$
	bne	10$
;
	asl	(sp)			; convert month to ascii
	asl	(sp)
	.addr	#months-4 r2
	add	(sp)+,r2
;
	mov	r3,r1			; point into handler
	add	#<dcdate-dclqe>,r1
;
	mov	(sp)+,r0		; convert day of month to ascii
	call	o.decmal
;
	mov	#5,r0			; move month name across
30$:	movb	(r2)+,(r1)+
	dbg	<mov	r0,-(sp)>
	dbg	<.ttyou	-1(r1)>
	dbg	<mov	(sp)+,r0>
	sob	r0,30$
;
	mov	(sp)+,r0		; convert year to ascii
	add	#72.,r0
;
o.decmal::
	movb	#'0-1,(r1)		; initialise quotient
;
40$:	incb	(r1)			; divide
	sub	#10.,r0
	bhis	40$
;
	add	#'0+10.,r0		; undo final subtract and convert
	inc	r1
	movb	r0,(r1)+
	dbg	<.ttyou	-2(r1)>		; show what we've done
	dbg	<.ttyou	-1(r1)>
50$:	return
;
months:	.ascii	/-Jan-Feb-Mar-Apr-May-Jun-Jul-Aug-Sep-Oct-Nov-Dec-/
	.even
	.sbttl	Locate the Impure Tables
;+
; Scan RMON and locate the job and terminal context table. This will not be
; possible if we're running under SJ.
;-
	.enabl	lsb
o.imp::
	mov	@#sysptr,r0		; base of rmon
	bit	#fbmon$,config(r0)
	beq	30$			; SJ monitor
;
	mov	cntxt(r0),r1		; background context
	add	#p1ext,r0		; skip past fixed offsets
;
	.if eq	1
10$:	cmp	(r0)+,#-1		; scan for impure table
	bne	10$
	cmp	(r0),r1			; background must be first
	bne	10$
	mov	r0,<.impure-dclqe>(r3)
	.endc
;
20$:	tst	(r0)+			; next word
	cmpb	1(r0),#'C-100		; control c
	bne	20$
	cmpb	3(r0),#'O-100		; control o
	bne	20$
	sub	#4,r0			; roll back to ttousr
	mov	r0,<.ttousr-dclqe>(r3)
;
30$:	mov	@#sysptr,r0		; base of rmon
	mov	r0,r1			; save for later
	add	e16lst(r0),r0		; base of sub dispatch table
	add	rctrlo(r0),r0		; .rctrlo processor
	bit	#fbmon$,config(r1)
	beq	40$			; SJ monitor
;+
; In the FB monitor, the counter is stored as an offset into the
; impure area.
;-
	mov	2(r0),r0		; i.octr+1
	dec	r0			; i.octr
	mov	r0,<.i.octr-dclqe>(r3)
	br	50$
;+
; In the SJ monitor, the ^O flag is accessed pc relative, and the
; output counter is offset from there:
;
;	TTOBUF::.WORD	OBUFR
;		.WORD	0		; this is it
;		.WORD	OBUFR
;		.WORD	OBUFR+TTYOUT
;	TTOCLO::.BYTE	0,0		; .rctrlo code points here
;-
40$:	tst	(r0)+			; skip opcode
	add	(r0)+,r0		; now point at ttoclo
	sub	#6,r0			; now point at output pointer
	mov	r0,<.ttoctr-pc.sj1+pb.sj1-dclqe>(r3)
;
50$:	return
	.sbttl	Turn Off the Time Display
;+
; Cancel the timer request and unload the handler.
;-
	ovcmd	off
	.enabl	lsb
;
	omov	o.rnam o.dnam o o
	ojsr	pc o.find		; find where we're loaded
	ojsr	pc o.name
	bcs	30$			; not turned on
;
	mov	#-1,<dctick-dclqe>(r3)	; force interrupt server off
	mov	#1,<dctock-dclqe>(r3)
10$:	bit	#1,<dcsema-dclqe>(r3)	; wait for it to settle
	bne	10$
;
	omov	o.snam (r0) o		; restore our good name
	call	o.lkint			; determine clock interrupt vector
	mov	<.lkint-dclqe>(r3),(r1)	; adjust clock vector
	ojsr	r0 o.kmon		; unload the handler
	.word	20$-.
	.asciz	/unload dc/
20$:	.even
30$:	.exit
	.sbttl	Determine Clock Interrupt Vector
;+
; Find exactly where the clock interrupt vector is. This will vary depending
; on whether we're running on a PRO or not. If so, it will also depend on
; the version of RT. The clock interrupt vector will be returned in r1
; and r0 will be loaded with the base of RMON.
;-
	.enabl	lsb
o.lkint::
	mov	@#sysptr,r0		; point at base of RMON
	mov	#lkint,r1		; clock interrupt vector
	bit	#pro$,confg2(r0)
	beq	20$			; not a PRO
	cmpb	sysver(r0),#ver.05
	bne	10$			; not version 5
	cmpb	sysupd(r0),#rls.01
	beq	30$			; 5.1 used normal vector
10$:	mov	#proclk,r1		; point at PRO clock
	br	30$
;
20$:	bit	#kw11p$,config(r0)	; check for programmable clock
	beq	30$
	mov	#kw11int$,r1		; point at programmable clock vector
;
30$:	return
;
	ovend
	.sbttl	State Display for Debugging
;+
; This shows some fairly basic facts about the state of the handler to
; aid in debugging lock up conditions.
;-
	.enabl	lsb
	overlay
	ovcmd	sta
;
	omov	o.rnam o.dnam o o
	ojsr	pc o.find		; find where we're loaded
	bcs	999$			; it's not activated
;
	.addr	#10$ r0			; semaphore state
	.print
	.addr	#30$ r0
	bit	#1,<dcsema-dclqe>(r3)	; check semaphore
	beq	200$
	add	#<20$-30$>,r0
200$:	.print
;
	.addr	#40$ r0			; synch completion routine state
	.print
	.addr	#60$ r0
	tst	<synblk+q.comp-dclqe>(r3)
	beq	300$
	add	#<50$-60$>,r0
300$:	.print
;
	.exit
999$:	return
;
10$:	.ascii	/Semaphore is /<200>
20$:	.asciz	/locked/
30$:	.asciz	/open/
;
40$:	.ascii	/Synch element is /<200>
50$:	.asciz	/in use/
60$:	.asciz	/free/
	.even
;
	ovend
	.sbttl	Debugging Driver
;+
; This will drive most of the service routines during the debugging
; phase.
;-
	dbg	overlay
	.enabl	lsb
dcdebug::
	dbg	<add	#dclqe,.mesage>	; offset relevant parts
	dbg	<add	#dclqe,.dcbuff>
	dbg	<mov	#dclqe,r3>	; set up the date
	dbg	<call	o.date>
;
	dbg	<.print	#smsg>
10$:	dbg	<.twait	#dcarea #tiktok>; wait a while
	dbg	<.print	#tmsg>		; say we ticked
	dbg	<.gtim	#dcarea #timbuf>; get time
	dbg	<mov	timbuf+2,timlo>
	dbg	<mov	timbuf,r0>
	dbg	<call	dcout>		; convert
	dbg	<br	10$>
;
dcarea:	dbg	<.blkw	10>
tiktok:	dbg	<.word	0, 60.>
timbuf:	dbg	<.blkw	2>
smsg:	dbg	<.asciz	/Debugging/>
tmsg:	dbg	<.asciz	/Tick/>
emsg:	dbg	<.asciz	/Parity error in r3/>
spmsg:	dbg	<.asciz	/SP error/>
;
	dbg	ovend
	.end	dcdebug
