TITLE TIME -- P. D. LEBLING (PDL)

.MLLIT=1

A=1
B=2
C=3
D=4
E=5
F=6
G=7

MODE=10
PDTIM=11	; number seconds since start of year
RYEAR=12	; various info about this year
RTIME=13
RDATE=14
RDTIM=15	; how long system has been up
DIETI=16	; when system will go down

P=17

; mode bits

%TIDE==1
%POM==2

TYOC==2

DEFINE SECS D,H,M,S
	<S+<60.*<M+<60.*<H+<24.*D>>>>>>
TERMIN

SPD==<SECS 1>	; 24.*60.*60.

PDL:	BLOCK 40

RECORD:	SETZ
	SIXBIT/OPEN/
	[.UII,,17]
	[SIXBIT/SYS/]
	[SIXBIT/RECORD/]
	SETZ [SIXBIT/TIME/]

GETREC:	SETZ
	'RFDATE	
	MOVEI 17
	SETZM A

SETREC:	SETZ
	'SFDATE
	MOVEI 17
	SETZ A

;	val 1	The creation date of the file:
;		4.7-4.1	Year (mod 100.).
;		3.9-3.6	Month (January = 1).
;		3.5-3.1	Day of month.
;		2.9-1.1	Time of creation, in half-seconds
;			after midnight.

COMMND:	BLOCK	10.

START:	MOVE	P,[-40,,PDL]
	.OPEN	TYOC,[SIXBIT /  !TTYXXXXXXYYYYYY/]
	.VALUE

	.BREAK	12,[5,,COMMND]
	SETZ	MODE,
	SKIPN	COMMND			; none there?
	 JRST	GATHER
; for the moment, any jcl means print all crap...
	TLO	MODE,%TIDE+%POM

; gather ye rosebuds
GATHER:	.RDATI	RTIME,
	.RLPDT	PDTIM,	; also RYEAR into RYEAR
	TLNE	RYEAR,400000	; if not leap year, after 2/28, back up a day
	 SUBI	PDTIM,SPD
	TLNE	RYEAR,200000	; if leap year, feb. has 29. days
	 AOS	FEBRUA
	TLNE	RYEAR,100000	; if daylight savings in effect, back up an hour
	 SUBI	PDTIM,3600.
	.CALL	RDSYST
	 .VALUE

; time
	OASC	[ASCIZ /The time is /]

; hh:mm:ss
	LDB	A,[301400,,RTIME]
	ROT	A,-12.
	OSIX	A
	OASCI	":
	LDB	A,[141400,,RTIME]
	ROT	A,-12.
	OSIX	A
	OASCI	":
	LDB	A,[001400,,RTIME]
	ROT	A,-12.
	OSIX	A

ifn 1,[
	;; hack configured timezone
	tlnn ryear,10000	;TZ known?
	 jrst tz5		;No, assume 5 = EST
	ldb a,[230400,,ryear]	;Get absolute TZ
	tlne ryear,4000		;Negative?
	 movns a
	skipa
tz5:	 movei a,5
	push p,b
	hlrz b,tznam(a)		;Assume standard
	tlne ryear,100000	;DST?
	 hrrz b,tznam(a)	;Yes
	skipe (b)
	 oasc [asciz / /]
	oasc (b)
	pop p,b
	oascr [asciz /./]
]
.else [
; est or edt?
	MOVEI	A,[ASCIZ / EDT./]
	TLNN	RYEAR,100000
	 MOVEI	A,[ASCIZ / EST./]
	OASCR	(A)
]

; date
	OASC	[ASCIZ /Today is /]

; day of week
	LDB	A,[320300,,RYEAR]
	OASC	@WEEK(A)
	OASC	[ASCIZ /day, the /]

; day of month
	LDB	A,[001400,,RDATE]
	CAIG	A,(SIXBIT / 09/)
	 ANDI	A,77
	MOVE	B,A
	ROT	A,-6
	TRNE	A,77
	 JRST	.-2
	OSIX	A
	MOVE	A,B
	ANDI	A,17		; units digit
	ANDI	B,1700		; tens digit
	CAIN	B,100
	 MOVEI	A,0
	CAIL	A,4
	 MOVEI	A,0
	OASC	@SUFFIX(A)
	
; month
	OASC	[ASCIZ / of /]
	LDB	B,[141400,,RDATE]
	ANDI	B,1700
	LSH	B,-6
	IMULI	B,10.
	LDB	A,[141400,,RDATE]
	ANDI	A,17
	ADD	A,B
	OASC	@MONTHS-1(A)

; year
	OASC	[ASCIZ /, /]
	HRRZ	A,RYEAR
	ODEC	A
	OASCR	[ASCIZ /./]

; phase of the moon
	TLNE	MODE,%TIDE
	PUSHJ	P,POM		; phase of the moon

; next and previous high tide in Boston Harbor
	TLNE	MODE,%POM
	PUSHJ	P,TIDE		; tides

; uptime
	OSIX	SYSTEM
	OASC	[ASCIZ / ITS /]
	OSIX	SYSVER
	OASC	[ASCIZ / has run for /]

; days, hours, minutes, seconds
	MOVE	A,RDTIM
	PUSHJ	P,PTIME
	OASCR	[ASCIZ /./]

; see if record-breaking uptime
CHKREC:	.CALL	RECORD
	 JRST	NOREC
	.CALL	GETREC
	 JRST	NOREC
	TLNE	A,177000
	 JRST	NOREC	;SYSTEM DOESN'T STAY UP FOR YEARS ON END
;;	LDB	B,[220500,,A]	;GET NUMBER OF DAYS
;; BV: use more bits here (certainly we stay up more than 63 days)
	ldb	b,[221100,,a]	; Get up to 1023 days 
	IMULI	B,<SPD*2>
	ADDI	B,(A)		;B := PREVIOUS RECORD IN HALF SEC
	IMULI	B,15.		;CONVERT TO JIFFIES
	CAML	B,RDTIM
	 JRST	OLDREC
	MOVE	A,RDTIM		;NEW RECORD!  STORE ON DISK
	IDIVI	A,15.
	IDIVI	A,<SPD*2>
	HRLZ	A,A		;DAYS IN LH
	HRR	A,B			;1/2 SECONDS IN RH
	.CALL	SETREC
	 JFCL
	.CLOSE	17,
	OASC	[ASCIZ/Surpassing all previous /]
	OSIX	SYSTEM
	OASCR	[ASCIZ/ records for uptime!/]
	JRST	NOREC

OLDREC:	MOVE	A,B	
	MOVE	B,RDTIM
	ADD	B,[30.*3600.*30.]	;WITHIN 30 HOURS OF RECORD?
	CAMG	B,A
	 JRST	NOREC
	OASC	[ASCIZ/Approaching the previous /]
	OSIX	SYSTEM
	OASC	[ASCIZ/ record of /]
	PUSHJ	P,PTIME
	OASCR	[ASCIZ/./]
NOREC:

; sys down time
	CAMN	DIETI,[-1]
	JRST	CHKDBG	; not dying
	CAMN	DIETI,[-2]
	JRST	DEAD
	OASC	[ASCIZ /The system will go down in /]

; days, etc.
	MOVE	A,DIETI
	PUSHJ	P,PTIME
CONTIN:	OASCR	[ASCIZ /./]
	JRST	CHKDBG

DEAD:	OASCR	[ASCIZ /The system is down./]

; being debugged?
CHKDBG:	SKIPN	DBGSW
	JRST	QUIT
	OASCR	[ASCIZ /The system is being debugged./]

; exit
QUIT:	.BREAK	16,140000


PMONDA:	PUSH	P,A
	PUSH	P,B
	ADDI	A,1
PMONIN:	MOVSI	B,-12.
PMONLP:	CAMG	A,MONLNG(B)
	 JRST	PMOND1
	SUB	A,MONLNG(B)
	AOBJN	B,PMONLP
	JRST	PMONIN
PMOND1:	HRRZS	B
	OASC	@MONTHS(B)
	OASCI	" 
	ODEC	A
	POP	P,B
	POP	P,A
	POPJ	P,

PDATE:	PUSH	P,A
	PUSH	P,B
;	TLNE	RYEAR,400000	; if not leap year, after 2/28, back up a day
;	 ADDI	A,SPD
	TLNE	RYEAR,100000	; if daylight savings in effect, back up an hour
	 ADDI	A,3600.
	IDIVI	A,SPD
	PUSHJ	P,PMONDA
	OASC	[ASCIZ ", "] 
	MOVE	A,B
	IDIVI	A,3600.
	ODEC	A
	MOVE	A,B
	IDIVI	A,60.
	OASCI	":
	ODEC	2,A
	MOVE	A,B
	OASCI	":
	ODEC	2,A
	POP	P,B
	POP	P,A
	POPJ	P,

PTIME:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C

	CAIG	A,15.
	 JRST	PEPSI
	ADDI	A,15.

	SETZ	C,
	IDIV	A,[30.*60.*60.*24.]
	JUMPE	A,PHOURS
	ODEC	A
	MOVE	C,A
	OASC	[ASCIZ / day/]
	CAIE	C,1
	OASCI	"s

PHOURS:	MOVE	A,B
	IDIVI	A,30.*60.*60.	; HOURS IN A
	JUMPE	A,PMINUT
	JUMPE	C,PHOUR1
	OASC	[ASCIZ /, /]
PHOUR1:	ODEC	A
	MOVE	C,A
	OASC	[ASCIZ / hour/]
	CAIE	C,1
	OASCI	"s

PMINUT:	MOVE	A,B
	IDIVI	A,30.*60.	; MINS IN A+1
	JUMPE	A,PSECON
	JUMPE	C,PMINU1
	OASC	[ASCIZ /, /]
PMINU1:	ODEC	A
	MOVE	C,A
	OASC	[ASCIZ / minute/]
	CAIE	C,1
	OASCI	"s

PSECON:	MOVE	A,B
	IDIVI	A,30.		; SEC IN A+2
	JUMPE	A,PTIMEX
	JUMPE	C,PSECO1
	OASC	[ASCIZ /, /]
PSECO1:	ODEC	A
	MOVE	C,A
	OASC	[ASCIZ / second/]
	CAIE	C,1
	OASCI	"s
	JRST	PTIMEX

PEPSI:	OASC	[ASCIZ /a VERY short time/]

PTIMEX:	POP	P,C
	POP	P,B
	POP	P,A
	POPJ	P,

; days of week
WEEK:	[ASCIZ /Sun/]
	[ASCIZ /Mon/]
	[ASCIZ /Tues/]
	[ASCIZ /Wednes/]
	[ASCIZ /Thurs/]
	[ASCIZ /Fri/]
	[ASCIZ /Satur/]

; month table
MONTHS:	[ASCIZ /January/]
	[ASCIZ /February/]
	[ASCIZ /March/]
	[ASCIZ /April/]
	[ASCIZ /May/]
	[ASCIZ /June/]
	[ASCIZ /July/]
	[ASCIZ /August/]
	[ASCIZ /September/]
	[ASCIZ /October/]
	[ASCIZ /November/]
	[ASCIZ /December/]

MONLNG:	31.
FEBRUA:	28.
	31. ? 30. ? 31. ? 30. ? 31. ? 31. ? 30. ? 31. ? 30. ? 31.

; number suffixes
SUFFIX:	[ASCIZ /th/]
	[ASCIZ /st/]
	[ASCIZ /nd/]
	[ASCIZ /rd/]

DEFINE TZONE STD,DST
	[ASCIZ /STD/],,[ASCIZ /DST/]
TERMIN
	repeat 12.-2,TZONE	;Dunno -3..-12
	tzone EET,EEST		;-2
	tzone CET,CEST		;-1
tznam:	TZONE GMT,BST	; 0 How to ask for British Summer Time??
	TZONE		; 1
	TZONE		; 2
	TZONE		; 3 (NST = Newfoundland is -0330)
	TZONE AST,ADT	; 4 Atlantic
	TZONE EST,EDT	; 5 Eastern
	TZONE CST,CDT	; 6 Central
	TZONE MST,MDT	; 7 Mountain
	TZONE PST,PDT	; 8 Pacific
	TZONE YST,YDT	; 9 Yukon
	TZONE HST,HDT	; 10 Alaska-Hawaii
	TZONE BST,BDT	; 11 Bering
	REPEAT 24.-11.,TZONE	; 12-24 unspecified


;  type out the phase of the moon

POM:	OASC	[ASCIZ "The Moon is "]
	PUSHJ	P,GNDS0		; get number of days since 1/1/0000
	MULI	A,SPD		; convert to seconds in a and aa
	JFCL	17,.+1		; clear flags for following
	ADD	B,PDTIM		; # seconds since beginning of year
	ADD	B,SYNOFS	; moon doesn't quite believe in the gregorian calendar
	JFCL	4,[AOJA A,.+1]	; cry1
	ASHC	A,2		; convert to quarter seconds
	DIV	A,SYNP		; divide by number of seconds in a period to get
				; number of quarters since then
	ASH	B,-2		; convert remainder to seconds (# seconds into this
				; quarter)
	EXCH	B,A
	IMULI	A,30.		; expressed in 1/30ths of a second
	PUSHJ	P,PTIME

	ANDI	B,3		; get quarter in B
	OASCR	@PHASES(B)
	POPJ	P,

PHASES:	[ASCIZ " past new."]
	[ASCIZ " beyond its first quarter."]
	[ASCIZ " past full."]
	[ASCIZ " into its last quarter."]

SYNP:	SECS 29.,12.,44.,3
	; lunar month expressed in seconds (29d 12h 44m 2.7s)
SYNOFS:	SECS 7.,23.,54.,42.
	; offset of lunar period in seconds (7d 23h 54m 42s)
	; (Basically, phase of the moon is reckoned from something
	;  like 12/23 in 1 BC.)

;  type out the of the next high tide

TIDE:	PUSH	P,A
	PUSH	P,B
	MOVE	A,PDTIM		; seconds so far this year
	SUB	A,TIDOFS	; first high tide this year was...
	ASH	A,1		; convert to half seconds
	IDIV	A,TIDEP		; divide by number of seconds in a period to get
				; number of halves since then
	IMUL	A,TIDEP
	MOVE	B,A
	ADD	B,TIDEP
	ASH	A,-1
	ADD	A,TIDOFS
	OASC	[ASCIZ /Last high tide:  /]
	PUSHJ	P,PDATE
	OASCR	[0]
	OASC	[ASCIZ /Next high tide:  /]
	MOVE	A,B
	ASH	A,-1
	ADD	A,TIDOFS
	PUSHJ	P,PDATE
	OASCR	[0]
	POP	P,B
	POP	P,A
	POPJ	P,

TIDTAB:	MOVE	B,TIDOFS
	SETZ	C,
TIDLUP:	OALIGN	3,C
	OHPOS	8.
	MOVE	A,B
	PUSHJ	P,PDATE
	OASCR	[0]
	ADD	B,TIDEP
	AOJA	C,TIDLUP


TIDEP:	SECS 0,24.,49.,50.
	; time between successive high tides
TIDOFS:	SECS 0,10.,38.,30.
	; offset of first high tide of 1976.

; get number of days since 1/1/0000 (as of 1/1/current year) in a

GNDS0:	PUSH	P,B
	PUSH	P,C
	HRRZ	C,RYEAR ; get year
	MOVEI	A,-1(C)	; also get year-1 in a
	IMULI	C,365.	; first approximation
	IDIVI	A,4
	ADD	C,A	; add number of years divisible by 4
	IDIVI	A,25.
	SUB	C,A	; subtract number of years divisible by 100
	IDIVI	A,4
	ADD	A,C	; add crud already calculated to number of years divisible
	AOS	A
	POP	P,C
	POP	P,B
	POPJ	P,	; by 400

;  call block for .call /sstatu/

RDSYST:	SETZ
	'SSTATU
	MOVEM	DIETI	;  time til system down
	MOVEM	DBGSW'	;  debug mode?
	MOVEM		;	 users
	MOVEM		;	 parerr+cornxm
	MOVEM	RDTIM	;  time system up
	MOVEM	SYSTEM'	;  sixbit /system-name/
	SETZM	SYSVER'	;  sixbit /system-version/


; ================================================================
;		uuo handler (typeout uuos)
; ================================================================

ZZZ==.
        LOC 40
        0
        JSR UUOH
        LOC ZZZ
UUOCT==0
UUOTAB:	JRST ILUUO
	IRPS X,,[DEC BPTR OCT CTLP ASCC SIX ASC ASCI ASCR SIXS HPOS ALIGN SIGN]
	UUOCT==UUOCT+1
	O!X=UUOCT_27.
	JRST UO!X
	TERMIN

IFG UUOCT-37, PRINTC /---TOO MANY UUO'S---/

UUOMAX==.-UUOTAB


UUOD:	0		; contents of UUO eff addr.
UUOE:	0		; UUO effad.

UUOH:	0
	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	MOVEI	@40			; get eff addr. of uuo
	MOVEM	UUOE
	MOVE	@0
	MOVEM	UUOD			; contents of eff adr
	MOVE	B,UUOE			; eff adr
	LDB	A,[270400,,40]		; get uuo ac,
	LDB	C,[330600,,40]		; op code
	CAIL	C,UUOMAX
	MOVEI	C,0			; grt=>illegal
	JRST	@UUOTAB(C)		; go to proper rout

UUORET:	POP	P,D
	POP	P,C
	POP	P,B
	POP	P,A			; restore ac's
	JRST	2,@UUOH

ILUUO:	.VALUE	[ASCIZ /:ILLEGAL UUO/]

UOBPTR:	MOVEI	C,0
	MOVE	B,UUOD
	JRST	UOASC1

UOASCR:	SKIPA	C,[^M]			; cr for end of type
UOASC:	MOVEI	C,0			; no cr
	HRLI	B,440700		; make ascii pointer
UOASC1:	ILDB	A,B			; get char
	JUMPE	A,.+3			; finish?
	PUSHJ	P,IOTA
	JRST	.-3			; and get another
	SKIPE	A,C			; get saved cr?
	PUSHJ	P,IOTA
	JRST	UUORET

UOASCC:	HRLI	B,440700		; make ascii pointer
UOAS1C:	ILDB	A,B			; get char
	CAIN	A,^C
	JRST	UUORET
	PUSHJ	P,IOTA
	JRST	UOAS1C			; and get another

UOCTLP:	MOVEI	A,^P
	PUSHJ	P,IOTA1

UOASCI:	MOVE	A,B			; prt ascii immediate
	PUSHJ	P,IOTA
	JRST	UUORET

UOSIX:	MOVE	B,UUOD
USXOOP:	JUMPE	B,UUORET
	LDB	A,[360600,,B]
	ADDI	A,40
	PUSHJ	P,IOTA
	LSH	B,6
	JRST	USXOOP

UOSIXS:	MOVE	A,[440600,,UUOD]
USLOOP:	ILDB	C,A
	ADDI	C,40
	PUSHJ	P,IOTC
	TLNE	A,770000
	JRST	USLOOP
	JRST	UUORET

UOHPOS:	SUB B,HPOS
	SKIPG B
	MOVEI B,1	; always at least one space
UOHPO1:	MOVEI A,40
	PUSHJ P,IOTA
	SOJG B,UOHPO1
	JRST UUORET

POWER:	0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000.

UOSIGN:	MOVM D,UUOD
	ANDI A,7
	MOVE A,POWER-1(A)
	MOVEI C,40
UOSIG1:	CAMLE A,D
	PUSHJ P,IOTC
	IDIVI A,10.
	CAIE A,1
	 JRST UOSIG1
	MOVEI A,"+
	SKIPGE UUOD
	MOVEI A,"-
	SKIPN UUOD
	MOVEI A," 
	PUSHJ P,IOTA
	SETZ A,
	JRST UODEC

UOALIG:	MOVE D,UUOD
	ANDI A,7
	MOVE A,POWER(A)
	MOVEI C,40
UOALI1:	CAMLE A,D
	PUSHJ P,IOTC
	IDIVI A,10.
	CAIE A,1
	 JRST UOALI1
	SETZ A,

UODEC:	SKIPA	C,[10.]			; get base for decimal
UOOCT:	MOVEI	C,8.			; octal base
	MOVE	B,UUOD			; get actual word to prt
	JRST	.+3			; join code
UODECI:	SKIPA	C,[10.]			; decimal
UOOCTI:	MOVEI	C,8.
	MOVEM	C,BASE'
	SKIPN	A
	HRREI	A,-1			; a=digit count
	PUSHJ	P,UONUM			; print numbr
	JRST	UUORET

UONUM:	IDIV	B,BASE
	HRLM	C,(P)			; save digit
	SOJE	A,UONUM1		; done if 0
	SKIPG	A			; + => more
	SKIPE	B			; - => b=0 => done
	PUSHJ	P,UONUM			; else more
UONUM1:	HLRZ	C,(P)			; retreive digits
	ADDI	C,"0			; make to ascii
	CAILE	C,"9			; is it good dig
	ADDI	C,"A-"9-1		; make hex digit
	PUSHJ	P,IOTC
	POPJ	P,			; ret

IOTC:	PUSH	P,A
	MOVE	A,C
	PUSHJ	P,IOTA
	POP	P,A
	POPJ	P,

HPOS:	0	; line pos

IOTA:	CAIN	A,^P
	JRST	[.IOT TYOC,["^]
		 ADDI A,100
		 JRST IOTA1]
	CAIN	A,^J
	POPJ	P,
IOTA1:	.IOT	TYOC,A
	CAIE	A,^M
	 JRST	IOTTAB
	SKIPE	SCRFLG'
	 .IOT TYOC,[^J]
	SETZM	HPOS
	POPJ	P,
; update line pos
IOTTAB:	CAIN	A,^I
	 JRST	[MOVE A,HPOS
		 ADDI A,10
		 ANDI A,7770
		 MOVEM A,HPOS
		 POPJ P,]
	AOS	HPOS
	POPJ	P,

	END	START

