.title	clock
	.ident	'X02-000'
;++
;
; Facility:	DCL Prompt Clock
;
; Abstract:
;	This routine turns your DCL prompt into a Digital clock.
;
; Author:
;	Lee K. Gleason		1-OCT-1987
;	Control-G Consultants
;	2416 Branard #D
;	Houston TX 77098
;	Phone 713/528-1859
;
;--

	.SBTTL	clock
;++
; Functional Description:
;
;	  This program will load a PIC, re-entrant routine into your
;	P1 allocation region, and aim a repeating EXEC mode AST at it.
;	EXEC mode is used, to keep the AST from disappearing at image
;	exit. The routine will change your DCL prompt to be the current
;	time. This is the Hours,Minutes,Seconds version, ie 10:32:23>.
;	See MINUTE_CLOCK.MAR for the Hours, Minutes version.
;--
	.entry	clock,^m<>

	$cmexec_s -
		routin = do_clock	;call our loader, in exec mode

	$exit_s	r0	;get out of the door, light out and look all around

	.entry	do_clock,^m<>

	movl	#rolexlen,r1			;how much we need?
	jsb	g^exe$alop1proc			;try to get it
	blbc	r0,1$				;if we fail, get out
	movl	r2,r6				;save address of block allocated
	movc3	#rolexlen,rolexcode,(r6)	;copy our code

	$dclast_s	astadr = (r6)		;call it the first time

1$:	ret


;+
; *** Following code must be PIC!!! ***
;-

	.entry	rolexcode,^m<r2>

	tlen = -4	;length of time conversion stack offset
	tbuf = -12	;descriptor for ASCII string returned by $ASCTIM here

	subl	#12,sp	;room for space on the stack

	$setimr_s	daytim = rolextime,-	;set alarm for next update
			astadr = rolexcode	;use relative address

	moval	@#ctl$ag_clidata,r2	;addr of CLI data area here
	movl	ppd$l_prc(r2),r2	;addr of another area
	moval	prc_g_prompt(r2),r2	;addr of the prompt buffer

;+
;  the prompt buffer is arranged thusly...
;  1st byte The byte count of all following bytes
;  2nd byte a Carriage return
;  3rd byte a Line Feed
;  4th byte The DCL line continuation prompt character. It is
;		prefixes your normal prompt on the lines following
;		a hyphen-continued line.
; 5th through N bytes
;	the actual prompt string. Note well, that byte 5 is where
;	prc_g_prompt points - the bytes above precede it.
;-

	movl	r2,tbuf+4(fp)	;address of the prompt buffer
	movl	#8,tbuf(fp)	;max len

	$asctim_s	timlen = tlen(fp),-	;convert time to asc
			timbuf = tbuf(fp),-	;use desc on stack
			timadr = @#exe$gq_systime,-	;use system time
			cvtflg = #1		;leave the date off, ok?

	clrl	r0			;make sure it's empty
	addw3	#3+1,tlen(fp),r0	;make length come out ok
	movb	r0,-4(r2)		;store new prompt length
	movb	#^A/>/,-4(r2)[r0]				
	ret			;get back, JoJo

rolextime:
	.long	^XFF67697F	;this is a second, relative time
	.long	^XFFFFFFFF

rolexlen=.-rolexcode		;used to calculate length to load

	.end	clock