; -*-Midas-*- Wednesday 23 April 1980  4:41:58 am

TITLE TI/Timoon -- Jason/RWT@ML
; (adapted from PDL's Time to allow JCL, etc.)

; Does this with no JCL:
; "Wednesday, July 28, 1977  2:08:15 AM EDT  FQ+4D.22H.52M.59S."

; JCL may be given as follows:

; JCL consists of switches preceded by / and strings delimited by ".
; Available switches are:
; /T Time,  /D Date,  /M Phase of the Moon,  /U System Uptime,  /# # Lusers,
; /R regular (uses /D /T /M),  /A all (uses /D /T /M /# /U),
; /, comma'ed format for date,  /! print CRLF,  /" print ",
; /V verbose,  /B brief,  /S short format,  /Px uses x as a  cursor code:
; 	(e.g., A = fresh line, C = clear screen, Z = bottom line).
; For example,
;	:TI /PA "Today is "/,/D"  The Moon's phase:  "/M /! /V /U
; might produce:
;	Today is Saturday, May 17, 1980  The Moon's phase:  NM+3D.1H.36M.53S.
;	ML ITS 1168 has run for 14 hours, 45 minutes, 9 seconds
; (or)
;	Today is Sunday, April 2, 1978  The Moon's phase:  LQ+2D.1H.53M.51S.
;	ML ITS 1099 has run for 1 day, 13 hours, 57 minutes, 59 seconds

.MLLIT=1
.insrt syseng;fsdefs >

A=1
B=2
C=3
D=4
E=5
F=6
Verbose=7
xjn=10
comma=10				; comma format for date
PDTIM=11	; number seconds since start of year
RYEAR=12	; various info about this year
RTIME=13
RDATE=14
RDTIM=15			; system uptime in 30ths.
DIETI=16			; time til system goes down

P=17

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
JCL:	block 40

START:	MOVE	P,[-40,,PDL]
	.call	[setz ? sixbit /OPEN/ ? [%tjdis+.uao,,TYOC]	; Display codes
		 setz [sixbit/TTY/]]
	 .value	1000
	.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, February has 29. days
	 AOS	FEBRUA
	TLNE	RYEAR,100000	; If daylight savings, back up an hour
	 SUBI	PDTIM,3600.
	.CALL	RDSYST
	 .VALUE
	setz	verbose,
	.break	12,[5,,JCL]
	.suset	[.rxjname,,xjn]
	skipn	jcl
	 jrst	[camn	xjn,[sixbit/TIME/]	; comma flag = xjn > 0
		  jrst	[pushj	p,xjTime	; so Time & Date have
			 jrst	Quit]	; comma format
		 camn	xjn,[sixbit/DATE/]
		  jrst	[pushj	p,date
			 oasc	[asciz /  /]
			 pushj	p,time
			 jrst	Quit]
		 setz	comma,		; but other xjnames don't use commas
		 pushj	p,date		; With no JCL, do Date, Time, POM
		 oasc	[asciz /  /]
		 pushj	p,time
		 oasc	[asciz /  /]
		 pushj	p,pom
		 jrst	quit]
	setz	comma,
	move	d,[440700,,JCL]

getchr:	ildb	b,d		; parse JCL
	cain	b,^M		; CR ends JCL
	 jrst	Quit
	cain	b,"/		; process switch
	 jrst	slash
	cain	b,"?
	 jrst	[oasc	[asciz |JCL consists of switches preceded by / and strings delimited by ".
Available switches are:
/T Time,  /D Date,  /M Phase of the Moon,  /U System Uptime,  /# # Lusers,
/R regular (uses /D /T /M),  /A all (uses /D /T /M /# /U),
/, comma'ed format for date,  /! print CRLF,  /" print ",
/V verbose,  /B brief,  /S short format,  /Px uses x as a  cursor code:
(e.g., A = fresh line, C = clear screen, Z = bottom line).
For example, :TI /PA "Today is "/D"  The Moon's phase:  "/M /! /V /U|]
		 jrst	quit]
	cain	b," 		; ignore space
	 jrst	getchr
	cain	b,"		; ignore tab
	 jrst	getchr
	caie	b,""		; If not a known item.
				; Could interpret as switch, but ...
	 jrst	[.iot	tyoc,[^P]	; fresh line
		 .iot	tyoc,["A]
		 oasc	[asciz/Do :TI ? for details on JCL switches./]
		 jrst	Quit]
loop:	ildb	b,d		; Loop to print chars delimited by "s
	cain	b,^M
	 jrst	Quit
	cain	b,"/		; quote next char
	 jrst	[ildb	b,d
		 cain	b,^M	; CR ends JCL
		  jrst	Quit
		 .iot	tyoc,b	; type quoted char
		 jrst	Loop]
	cain	b,""
	 jrst	getchr
	.iot	tyoc,b
	jrst	loop	

slash:	ildb	b,d
	cain	b,"^M
	 jrst	Quit
	pushj	p,Upperc	; convert to uppercase.

	cain	b,"!		; Print CR
	 jrst	[.iot	tyoc,[^M]
		 jrst 	getchr]
	cain	b,",			; comma format for date
	 jrst	[seto	comma,
		 jrst	getchr]
	cain	b,""
	 jrst	[.iot	tyoc,[""]
		 jrst	getchr]
	cain	b,"#		; # of Lusers
	jrst	[pushj	p,Users
		 jrst	getchr]		
	cain	b,"V		; Verbose mode
	jrst	[seto	Verbose,
		 jrst	getchr]
	cain	b,"B		; Brief mode
	jrst	[setz	Verbose,
		 jrst	getchr]
	cain	b,"S		; Short mode
	jrst	[movei	Verbose, 1
		 jrst	getchr]
	cain	b,"T		; Time
	jrst	[pushj	p,Time
		 jrst	getchr]
	cain	b,"D		; Date
	jrst	[pushj	p,Date
		 jrst	getchr]
	cain	b,"U		; Uptime
	jrst	[pushj	p,Uptime
		 jrst	getchr]	
	cain	b,"R		; regular
	 jrst	[skipge	Verbose
		  jrst	[pushj	p,vbreg
			 jrst getchr]
		 pushj	p,brreg
		 jrst	getchr]
	cain	b,"A		; All
	 jrst	[skipge	Verbose
		  jrst	[pushj	p,vbreg
			 pushj	p,vbmor
			 jrst getchr]
		 pushj	p,brreg
		 pushj	p,brmor
		 jrst	getchr]
	cain	b,"M		; Moon phase
	 jrst	[pushj	p,POM
		 jrst	getchr]
	cain	b,"P		; ^P cursor codes
	 jrst	[.iot	tyoc,[^P]
		 ildb	b,d
		 cain	b,^M	; CR ends JCL
		  jrst	Quit
		 cain	b,"h
		  movei	b,"H
		 cain	b,"v
		  movei	b,"V
		 caie	b,"H
		 cain	b,"V
		  jrst	[ildb	c,d	; If H or V
			 cain	c,^M	; CR ends JCL
			  jrst	Quit	; if there is no arg for H or V, ignore
			 .iot	tyoc,b	; else H or V
			 .iot	tyoc,c	; The fact that some chars can't
			 jrst	getchr]
		 .iot	tyoc,b
		 jrst	getchr]
	.iot	tyoc,[^P]	; Else illegal, so... newline
	.iot	tyoc,["A]
	oasc	[asciz /Illegal switch: /]
	.iot	tyoc,b
	oasc	[asciz /.  Do :TI ? for info./]
	jrst	Quit	

Upperc:	caige	b,"a
	 popj	p,		; less than lowest lower case alphabetic
	caile	b,"z
	 popj	p,		; greater than highest lower case alphabetic
	subi	b,40
	popj	p,
xjtime:				; XJNAME is Time
	pushj	p,time
	skipl	verbose
	 oasc	[asciz/  /]
	skipge	verbose
	 .iot	tyoc,[^M]
	pushj	p,date
	skipl	verbose
	 oasc	[asciz/  /]
	skipge	verbose
	 .iot	tyoc,[^M]
	pushj	p,uptime
	pushj	p,revetc
	skipn	JCL
	 popj	p,
	.iot	tyoc,[^M]
	pushj	p,POM
	.iot	tyoc,[^M]
	pushj	p,Tide
	popj	p,
vbreg:				; Verbose, regular:  Time, Date, POM
	pushj	p,time
	.iot	tyoc,[^M]
	pushj	p,date
	.iot	tyoc,[^M]
	pushj	p,pom
	popj	p,
brreg:
	pushj	p,date		; Brief
	skipg	verbose
	oasc	[asciz / /]
	oasc	[asciz / /]
	pushj	p,time
	skipg	verbose
	oasc	[asciz / /]
	oasc	[asciz / /]
	pushj	p,pom
	popj	p,

vbmor:	.iot	tyoc,[^M]
	pushj	p,users
	.iot	tyoc,[^M]
	pushj	p,uptime
	pushj	p,revetc
	popj	p,

brmor:	.iot	tyoc,[^M]
	pushj	p,users
	oasc	[asciz/ Lusers, /]
	osix	system
	oasc	[asciz/'s Uptime /]
	pushj	p,uptime
	pushj	p,revetc
	popj	p,

Date:
; Day of week
	skipge	Verbose
	 oasc	[asciz /Today is /]
	LDB	A,[320300,,RYEAR]
	OASC	@WEEK3(A)
	jumpg	Verbose, dowsp
	OASC	@WEEKR(A)
	OASC	[ASCIZ /day/]
	skipe	comma
	 oasc	[asciz/,/]
dowsp:	oasc	[asciz/ /]
	jumpe	comma, day

; Month
Month:
	LDB	B,[141400,,RDATE]
	ANDI	B,1700
	LSH	B,-6
	IMULI	B,10.
	LDB	A,[141400,,RDATE]
	ANDI	A,17
	ADD	A,B
	OASC	@MONTH3-1(A)
	jumpg	verbose, montnx
	OASC	@MONTHR-1(A)
montnx:	jumpn	comma, montny
	skiple	verbose
	 oasc	[asciz/-/]
	skipg	verbose
	 oasc	[asciz/ /]
	jrst	year
montny:	oasc	[asciz/ /]

Day:
; 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
	jumpe	comma, daynx
	oasc	[asciz /, /]
	jrst	year
daynx:	skiple	verbose
	 oasc	[asciz/-/]
	skipg	verbose
	 oasc	[asciz/ /]
	jrst	month

Year:
; Year
	HRRZ	A,RYEAR
	ODEC	A
	popj	p,

Time:
	skipge	 Verbose
	 oasc	[asciz /The time is /]
; HH:MM:SS
	LDB	A,[301400,,RTIME]
	caig	A,(sixbit / 12/)	; Skip if before Noon.
	 jrst	mod12d
	move	b,a
	subi	b,0102		; convert to mod 12 day
	cain	a,(sixbit / 20/)	; special cases
	 movei	b,(sixbit /  8/)
	cain	a,(sixbit / 21/)
	 movei	b,(sixbit /  9/)
	move	a,b
mod12d:	cain	a,(sixbit / 00/)	; If 0 , make it 12.
	 movei	a,(sixbit / 12/)
	CAIGE	A,(sixbit / 1 /)	; Stifle leading zero.
	 ANDI	A,77
	ROT	A,-6
	TRNE	A,77
	 JRST	.-2
	OSIX	A
	OASCI	":
	LDB	A,[141400,,RTIME]
	ROT	A,-12.
	OSIX	A
	jumpg	Verbose, Merid		; if Short, no second chance.       
	OASCI	":
	LDB	A,[001400,,RTIME]
	ROT	A,-12.
	OSIX	A

Merid:
; AM or PM ?
	LDB	A,[301400,,RTIME]
	MOVEI	B,[ASCIZ / am/]
	CAIL	A,2122		; Skip if before Noon.
	 MOVEI	B,[ASCIZ / pm/]
	OASC	(B)
	skiple	verbose
	 popj	p,

; EST or EDT ?
	MOVEI	A,[ASCIZ / EDT/]
	TLNN	RYEAR,100000
	 MOVEI	A,[ASCIZ / EST/]
	OASC	(A)

	popj	p,

QUIT:	.iot	tyoc,[^M]
	.BREAK	16,164000	; silent kill

Users:	odec	Nusers
	skipge	Verbose
	 oasc	[asciz / Lusers./]	
	popj	p,

Uptime:	PUSHJ	P,GetUPTIME	; calc uptime from time sys came up, not .RDTIM
	skipl	Verbose
	 jrst	Unotvb
	OSIX	SYSTEM
	OASC	[ASCIZ / ITS /]
	OSIX	SYSVER
	OASC	[ASCIZ / has run for /]
Unotvb:
; days, hours, minutes, seconds
	MOVE	A,RDTIM
	PUSHJ	P,PTIME
	skipl	Verbose		; That's all if not verbose.
	 popj	p,

; 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
	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:	popj	p,

Revetc:
	MOVE	C,[SQUOZE 0,RVVTIM]
	.EVAL	C,
	 JRST	NOREV
	HRLS	C
	HRRI	C,C
	.GETLOC	C,		; Get time revived
	JUMPE	C,NOREV		; If 0, never happened
	MOVE	A,[SQUOZE 0,TIME]
	.EVAL	A,
	 .LOSE	%LSSYS
	.iot	tyoc,[^P]
	.iot	tyoc,["A]
	OASC	[ASCIZ	/System last revived /]	; forget about Verbose
	HRLS	A
	HRRI	A,A
	.GETLOC	A,		; GET CURRENT TIME
	SUB	A,C		; TIME SINCE REVIVAL
	PUSHJ	P,PTIME
	OASCR	[ASCIZ	/ ago./]	

norev:
; sys down time
	CAMN	DIETI,[-1]
	JRST	CHKDBG	; not dying
	CAMN	DIETI,[-2]
	JRST	DEAD
	.iot	tyoc,[^P]
	.iot	tyoc,["A]
	OASC	[ASCIZ /The system will go down in /]

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

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

; being debugged?
CHKDBG:	skipn	DBGSW
	 popj	p,
	.iot	tyoc,[^P]
	.iot	tyoc,["A]
	OASCR	[ASCIZ /The system is being debugged./]
	popj	p,

; Days of week
WEEK3:	[ASCIZ /Sun/]
	[ASCIZ /Mon/]
	[ASCIZ /Tue/]
	[ASCIZ /Wed/]
	[ASCIZ /Thu/]
	[ASCIZ /Fri/]
	[ASCIZ /Sat/]
WEEKR:	[ASCIZ //]
	[ASCIZ //]
	[ASCIZ /s/]
	[ASCIZ /nes/]
	[ASCIZ /rs/]
	[ASCIZ //]
	[ASCIZ /ur/]

; Month table
MONTH3:	[ASCIZ /Jan/]
	[ASCIZ /Feb/]
	[ASCIZ /Mar/]
	[ASCIZ /Apr/]
	[ASCIZ /May/]
	[ASCIZ /Jun/]
	[ASCIZ /Jul/]
	[ASCIZ /Aug/]
	[ASCIZ /Sep/]
	[ASCIZ /Oct/]
	[ASCIZ /Nov/]
	[ASCIZ /Dec/]
MONTHR:	[ASCIZ /uary/]
	[ASCIZ /ruary/]
	[ASCIZ /ch/]
	[ASCIZ /il/]
	[ASCIZ //]
	[ASCIZ /e/]
	[ASCIZ /y/]
	[ASCIZ /ust/]
	[ASCIZ /tember/]
	[ASCIZ /ober/]
	[ASCIZ /ember/]
	[ASCIZ /ember/]

MONLNG:	31.
FEBRUA:	28.
	31. ? 30. ? 31. ? 30. ? 31. ? 31. ? 30. ? 31. ? 30. ? 31.

; Type out the phase of the moon

; [Phase of Moon algorithm not quite precise, taken directly from PDL's Time.]

POM:	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
	ANDI	B,3		; get quarter in B
	skipge	Verbose
	 jrst	[oasc	[asciz/The Moon is /]
		 jrst 	pvb]
	OASC	@PHASES(B)
	caile	a,15.		; If remarkably close, don't print +.
	 .iot	tyoc,["+]
pvb:	PUSHJ	P,PTIME
	skipge	Verbose
	 oasc	@VPHASE(B)
	POPJ	P,

;; The Tide algorithm is verbatim from PDL

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.

PTIME:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C

	CAIG	A,15.		; If remarkably close to the exact quarter
	 JRST	PEXACT		; Then jump
				; else add the days, hours, minutes, seconds

	ADDI	A,15.
	SETZ	C,
	IDIV	A,[30.*60.*60.*24.]
	JUMPE	A,PHOURS
	ODEC	A
	MOVE	C,A
	skipl	Verbose
	 jrst	[OASC	[ASCIZ /D./]
		 jrst 	Phours]
	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
	skipge	Verbose
	 oasc	[asciz /, /]
PHOUR1:	ODEC	A
	MOVE	C,A
	skipl	Verbose
	 jrst	[OASC	[ASCIZ /H./]
		 jrst	Pminut]
	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
	skipge	Verbose
	 oasc	[asciz /, /]
PMINU1:	ODEC	A
	MOVE	C,A
	skipl	Verbose
	 jrst	[OASC	[ASCIZ /M./]
		 jrst Psecon]
	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
	skipge	Verbose
	 oasc	[asciz /, /]

PSECO1:	ODEC	A
	MOVE	C,A
	skipl	Verbose
	 jrst	[OASC	[ASCIZ /S./]
		 jrst Ptimex]
	oasc	[asciz / second/]
	caie	c,1
	oasci	"s
	JRST	PTIMEX

PEXACT:	skipl	Verbose
	 jrst	[OASC	[ASCIZ / exactly!/]
		 jrst	Ptimex]
	oasc	[asciz /a VERY short time/]

PTIMEX:	POP	P,C
	POP	P,B
	POP	P,A
	POPJ	P,

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	@MONTH3(B)
	oasc	@monthr(b)
	OASCI	" 
	ODEC	A
	POP	P,B
	POP	P,A
	POPJ	P,

PDATE:	PUSH	P,A
	PUSH	P,B
	TLNE	RYEAR,100000	; if daylight savings, add 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,

PHASES:	[ASCIZ "NM"]
	[ASCIZ "FQ"]
	[ASCIZ "FM"]
	[ASCIZ "LQ"]

VPHASE:	[ASCIZ " past new."]
	[ASCIZ " into 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.)
	; [Note:  The above is certainly not true]

; 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

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.
;  call block for .call /sstatu/

RDSYST:	SETZ
	'SSTATU
	MOVEM	dieti		;  time til system down
	MOVEM	dbgsw'		;  debug mode?
	MOVEM	NUsers'		;	 users
	MOVEM	Memerr'		;	 parerr+cornxm
	MOVEM	rdtim		;  time system up
	MOVEM	SYSTEM'		;  sixbit /system-name/
	SETZM	SYSVER'		;  sixbit /system-version/

RQDATE:	SETZ
	'RQDATE
	MOVEM QTIME'
	SETZM QUPTIM'

getUPTIME:
	.CALL	RQDATE
	 .LOSE	%LSSYS
	SETZB	C,F
	LDB	A,[UNMON QTIME]
	SOJLE	A,[LDB E,[UNMON QUPTIM]		; WIN WHEN YEAR CHANGES
		   SOJLE E,UPTIM1		; LOSES IF UP > 1 YR., CHORTLE
		   MOVEI C,365.
		   JRST UPTIM1]
	ADD	C,MONLNG-1(A)
	SOJG	A,.-1
UPTIM1:	LDB	A,[UNDAY QTIME]
	ADD	C,A
	IMULI	C,SPD
	HRRZ	A,QTIME
	LSH	A,-1
	ADD	C,A
	LDB	E,[UNMON QUPTIM]
	SOJLE	E,UPTIM2
	ADD	F,MONLNG-1(E)
	SOJG	E,.-1
UPTIM2:	LDB	E,[UNDAY QUPTIM]
	ADD	F,E
	IMULI	F,SPD
	HRRZ	E,QUPTIM
	LSH	E,-1
	ADD	F,E
	CAMGE	C,F
	ADD	C,[SPD*365.]
	SUB	C,F
	IMULI	C,30.
	MOVEM	C,RDTIM
	POPJ	P,


; ================================================================
;		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
