PDP-10.its/src/sysen1/netime.127

; -*- Midas -*-

title NETIME - Get the time from the network.

rdtim=:702200,,			; KS10 clock instructions.
wrtim=:702600,,
clk==:500			; PD clock on KA10s and MX-KL

a=:1
b=:2
c=:3
d=:4
e=:5
t=:6
tt=:7

p=:17

ttyoch==:1
netoch==:2
nnetch==:<20-netoch>/2
netich==:netoch+nnetch
utilch==:2

call=:pushj p,
return=:popj p,
save==:push p,
rest==:pop p,
flose=:.lose %lsfil
slose=:.lose %lssys
pause=:.break 16,100000
quit=:.logout 1,
tyo=:.iot ttyoch,

define conc foo,bar
foo!bar!termin

%f==:1,,525252			; Flags in LH(0)
%fhsts==:000002			; Host table loaded?
%ftime==:000004			; Timer

repeat nnetch, conc %fnet,\.rpcnt,==:1_<netich+.rpcnt>

netmsk==:<1_nnetch-1>_netich

define syscall name,args
	.call [setz ? sixbit /name/ ? args(400000)]
termin

popbj1:	rest b
popj1:	aosa (p)
popbj:	 rest b
cpopj:	return

datime"$$svng==:1
datime"$$out==:1
datime"$$abs==:1
.insrt dsk:syseng;datime >

format"$$time==:1
format"datime==:datime"twdasc
format"time==:datime"timasc
format"date==:datime"datasc
format"$$pcode==:1
.insrt dsk:syseng;format >

outstr:	syscall siot,[movei ttyoch ? a ? b]
	 slose
	return

define format &string&,args
	call [
	call $format
.zzz.==-1
irp arg,,[args]
	save arg
.zzz.==.irpcnt
termin
	hrroi a,[ascii string]
	movei b,.length string
	movni c,.zzz.+1
	jrst format"format]
termin

$forma:	save a
	save b
	save c
	save [.+2]
	jrst @-4(p)
	rest c
	rest b
	rest a
	rest (p)
	return

; Hosts are arranged first into three groups by approximate speed and
; reliability.  Each group is in alphabetical order.  Presumably there is
; little correlation between a machine's speed and reliability, and the
; alphabetical position of its name.

hosts:

; Ask the reliable ITS machines first.  They are all on subnet 6 and tend
; to answer quickly.

	<(sixbit /AI/)>,,[asciz "AI"]
	<(sixbit /MC/)>,,[asciz "MC"]
	<(sixbit /ML/)>,,[asciz "ML"]

; File servers tend to be up.  Approximately in the order that they seem
; likely to come up after a mass shutdown.

	[asciz "REAGAN"]
	[asciz "ZERMATT"]
	[asciz "GOLDILOCKS"]
	[asciz "LIVE-OAK"]
	[asciz "PYGMALION"]
	[asciz "HEPHAESTUS"]

; Ordinary hosts.  Alphabetical order.

	[asciz "BIGBOOTE"]
	[asciz "CROSBY"]
	[asciz "DIALUP-CHAOS"]
	[asciz "GAAK"]
	[asciz "MINTAKA"]
	[asciz "OTIS"]
	[asciz "PIGPEN"]
	[asciz "SAFFRON"]
	[asciz "SINATRA"]

; Unreliable hosts start here.  Putting hosts that tend to not answer at
; the end keeps them from acting as a bottleneck.  (It also gives them less
; time to respond...)

	<(sixbit /MD/)>,,[asciz "MD"]
	[asciz "GOLEM"]
	[asciz "LSD"]
	[asciz "EMACK-AND-BOLIOS"]

nhosts==:.-hosts

;;; Parameters that can be patched:

setp:	-1			; 0 => don't actually set the time.

wait:	20.*60.			; Wait 20 seconds polling other hosts.
	0 ? 0 ? 0		; Zeros for .REALT just in case...

numerq:	2			; Ceiling of 2/3 of the hosts that respond
denomq:	3			; must agree on the time.

minq:	4			; Insist on at least 4 hosts with times in
				; agreement.

spread:	400.			; Times agree if they differ by less than
				; 400 seconds (6 mins 40 secs)

days:	3			; If machine looks like it was down for
				; this many days, then require a human to
				; set the time.

filesn:	sixbit /DRAGON/		; The creation date of this file is some
filen1:	sixbit /DRAGON/		; indication of what time the system last
filen2:	sixbit /HOARD/		; thought it was.

.scalar lstime			; Creation date of above file.

.insrt dsk:system;chsdef >
.vector opkt(%cpmxw)		; Output packet
.vector ipkt(%cpmxw)		; Input packet

.vector state(nnetch)		; What each net channel is working on.

.vector times(nhosts)		; The time reported by each host.
				; In seconds since January 1, 1900, GMT.

.vector atimes(nhosts)		; The time we believe the host looked at
				; his clock.  In 60ths of a second since
				; system was booted.

.scalar count			; The number of outstanding time requests.

lpdl==:100.
.vector pdl(lpdl)		; The usual.

.scalar itsnam			; The name of this machine in SIXBIT.

usrvar:	sixbit /OPTION/	? tlo %opint\%opopc
	sixbit /MASK/	? move [%pirlt\%piioc\%piwro\%pimpv\%pilos\%piilo]
	sixbit /MSK2/	? movei netmsk
lusrvar==:.-usrvar

go:	.pdtime b,
	.suset [.rsuppro,,a]
	came b,[-1]
	 jumpl a,[quit]
	movsi b,(sixbit /T00/)
	skipl a
	 movsi b,(sixbit /TTY/)
	syscall open,[[.uao\%tjdis,,ttyoch] ? b]
	 skipa
	  jrst go1
	movei tt,5*30.
	.sleep tt,
	jrst go

go1:	move tt,[%rlfls\%rlset,,wait]
	.realt tt,
	movsi 0,netmsk		; initial flags
	move p,[-lpdl,,pdl-1]
	move tt,[-lusrvar,,usrvar]
	syscall usrvar,[movei %jself ? tt]
	 slose
	syscall sstatu,[repeat 6,[ ? movem itsnam]]
	 slose
	syscall open,[[.uai\%donrf,,utilch] ? [sixbit /DSK/]
			filen1 ? filen2 ? filesn]
	 jrst nofile
	syscall rfdate,[movei utilch ? movem lstime]
	 flose
	.close utilch,
irps sym,,[ka10p,kl10p,ks10p,pdtime,fyear]
.scalar sym
	move tt,[squoze 0,sym]
	.eval tt,
	 .lose
	movem tt,sym
termin
	move tt,[squoze 0,ksfreq]
	.eval tt,
	 movei tt,<<1000._12.>+30.>/60.
	movem tt,ksfreq

	movei a,netgo
	movem a,state+0
	move tt,[state+0,,state+1]
	blt tt,state+nnetch-1
	setzm times+0
	move tt,[times+0,,times+1]
	blt tt,times+nhosts-1
	movei a,%corfc
	dpb a,[$cpkop opkt]
	movei a,4
	dpb a,[$cpknb opkt]
	move a,[.byte 8 ? "T ? "I ? "M ? "E]
	movem a,opkt+%cpkdt
	setzm count
	hrloi c,-1-nhosts	; C: aobjn into hosts
loop:	tlnn netmsk\%ftime
	 .hang
	tlze %ftime
	 jrst timout
	jffo .+1
	movei b,17.-netich
	sub b,a			; B: current net channel
	move t,state(b)
	hlrz d,t		; D: usually current host
	jrst (t)

tsint:
loc 42
	-ltsint,,tsint
loc tsint
	0,,p
	%piioc ? 0 ? 0 ? 0 ? iocint	; synchronous
	%pirlt ? 0 ? 0 ? 0 ? timint
	0 ? netmsk ? 0 ? 0 ? netint
	%piwro\%pimpv\%pilos\%piilo ? 0 ? -1 ? -1 ? badint
ltsint==:.-tsint

dismis:	setz ? sixbit /DISMIS/ ? setz p

badint:	.close ttyoch,		; Close TTY channel to let hacker log in
	.value			; Leave a corpse

netint:	tso -3(p)
	.call dismis
	 slose

timint:	tlo %ftime
	.call dismis
	 slose

iocint:	save t
	aos -1(p)
	hrrz t,-1(p)
	caie t,iocok+1
	 .lose
	rest t
	.call dismis
	 slose

netgo:	aobjp c,nomore
	hllz a,hosts(c)
	camn a,itsnam		; Is this us?
	 jrst netgo
	hrrz a,hosts(c)
	call look
	 jrst netgo		; Must be gone or something?
	dpb a,[$cpkda opkt]
	syscall chaoso,[movei netich(b) ? movei netoch(b)]
	 jrst netgo		; Chaosnet full?  Broken?
	tdz netbit(b)
	syscall pktiot,[movei netoch(b) ? movei opkt]
	 slose
	.rdtime tt,
	movem tt,atimes(c)	; Begin our wait
	hrrzi a,netin
	hrli a,(c)
	movem a,state(b)
	aos count
	jrst loop

netin:	sos count
iocok::	syscall pktiot,[movei netich(b) ? movei ipkt]
	 jrst netgo		; IOC ints return to here.
	.rdtime tt,
	addm tt,atimes(d)	; End our wait (computes average in 60ths)
	ldb t,[$cpkop ipkt]
	caie t,%coans
	 jrst netgo
	ldb t,[341000,,ipkt+%cpkdt]
	dpb t,[001000,,times(d)]
	ldb t,[241000,,ipkt+%cpkdt]
	dpb t,[101000,,times(d)]
	ldb t,[141000,,ipkt+%cpkdt]
	dpb t,[201000,,times(d)]
	ldb t,[041000,,ipkt+%cpkdt]
	dpb t,[301000,,times(d)]
	jrst netgo

netbit:	repeat nnetch, 1_<netich+.rpcnt>,,0

nomore:	syscall close,[movei netich(b)]
	 slose
	syscall close,[movei netoch(b)]
	 slose
	tdz netbit(b)
	movei a,[ jfcl ? .lose ]
	movem a,state(b)
	skipe count
	 jrst loop
	jrst setime

.vector sorted(nhosts)		; Sorted indices of times.

timout::	
setime:	skipn setp
	 jrst sort
	setoi tt,
	.iotlsr tt,
	;; Set time relative to -now-.
	skipe ks10p
	 rdtim kstime
	skipn ks10p
	 datai clk,clktim
sort:	.rdtime e,
	lsh e,1			; E: system time in 60ths
	addi e,30.		; (for rounding later)
	setzi b,		; B: # entries sorted so far
	movsi a,-nhosts		; A: aobjn into TIMES
	skipn c,times(a)	; C: time
sortlp:	 aobjn a,.-1		; Skip people who didn't answer
	jumpge a,vote
	move t,e		; Compute time since he looked at his clock
	sub t,atimes(a)
	idivi t,60.		; Convert to seconds (rounded)
	add c,t
	movem c,times(a)
	skipn d,b		; D: candidate index for insertion
	 jrst sort0
sort1:	move tt,sorted-1(d)
	camge c,times(tt)
	 sojg d,sort1
sort0:	movei tt,(d)
	subi tt,1(b)
	hrli d,(tt)		; D: aobjn into part or SORTED to move
	movei tt,(a)		; The index to insert
	exch tt,sorted(d)
	 aobjn d,.-1
	aoja b,sortlp

.scalar ntimes			; The number of people who responded.
.scalar quorum			; The size of a quorum

vote:	movem b,ntimes
	imul b,numerq
	add b,denomq
	soj b,
	idiv b,denomq
	camge b,minq
	 move b,minq
	movem b,quorum
	setzi a,0		; A: index of possible lowest good time
	soj b,			; B: must agree with A for quorum
low:	caml b,ntimes
	 jrst nogo
	move tt,sorted(b)
	move t,times(tt)
	move tt,sorted(a)
	sub t,times(tt)
	camg t,spread
	 jrst gotlow
	aoj a,
	aoja b,low

gotlow:	move b,ntimes
	movei c,-1(b)		; C: index of possible highest good time
	sub b,quorum		; B: must agree with C for quorum
high:	move tt,sorted(c)
	move t,times(tt)
	move tt,sorted(b)
	sub t,times(tt)
	camg t,spread
	 jrst gotime
	soj b,
	soja c,high

.scalar lowest			; Index of lowest of good times.
.scalar highest			; Index of highest of good times.
.scalar median			; Index of median of good times.
.scalar host			; Pointer to ASCIZ name of winning host.
.scalar time			; Winning network time.
.scalar qtime			; Winning network time in disk format.
.scalar qzone			; SIXBIT timezone of QTIME.
.scalar year			; Year of winner.
.scalar ticks			; PD-ticks since January 1 of winner.
.scalar ksfreq			; KS-tick per PD-tick
.vector kstime(2)		; Set time relative to this.
.scalar clktim			; Or this.

s%d==:24.*60.*60.
s%y==:365.*s%d
s%est==:datime"estdif*60.*60.
gotime:	movem a,lowest
	movem c,highest
	addi c,1(a)
	lsh c,-1
	movem c,median
	move tt,sorted(c)
	hrro a,hosts(tt)
	movem a,host
	move a,times(tt)
	movem a,time
	call cvtime
	movem e,qzone
	movem a,qtime
	move b,lstime
	call datime"timsub
	add a,spread		; Allow for the usual fuzz...
	jumpl a,past
	move tt,days
	imuli tt,s%d
	camle a,tt
	 jrst future
	ldb b,[.bp datime"tm%yr,qtime]	; EST and EDT always agree about
	movei tt,1900.(b)		; the year!
	movem tt,year
	subi b,1		; (Compensates for the fact that 1900. was
	idivi b,4		; not a leap year.  (Screws up if you give
	addi c,1		; a time in 1900., but who cares?))
	imul b,[4*s%y+s%d]
	imul c,[s%y]
	add b,c			; B: Seconds from 1/1/00 to this year.
	move a,time
	subi a,s%est		; GMT -> EST
	sub a,b
	imuli a,60.
	movem a,ticks
	skipn setp
	 jrst nsetp

	skipn ks10p
	 jrst notks
	dmove a,kstime
	hrrz a,a		; Clear possible gubbish from high bits.
	div a,ksfreq		; KS-ticks -> PD-ticks
	jrst doit

notks:	move a,clktim
	tlz a,600000		; Clear possible gubbish from high bits.
	;; On a KA if this is zero then apparently the PD clock is off.
	;; Fix this code to deal with that if you try to bring this code up
	;; on a KA (see PDSET program).  (Where did you find a working ITS
	;; KA10 anyway?)
	skipe ka10p
	 .lose
doit:	sub a,ticks		; A: offset for loading into PDTIME
	format "~&Setting the time to be ~Q ~S ~
		(supplied by ~A).~&",[qtime,qzone,host]
	move tt,fyear
	hrli tt,year
	.setloc tt,
	move tt,pdtime
	hrli tt,a
	.setloc tt,
	skipa			; This is supposed to give the SETLOC
	 skipa			; a chance to happen before starting the
	  .hang			; clock. 
	setoi tt,
	.iotlsr tt,
	skipe kl10p
	 cono clk,400007	; Start clock on KL
	skipn ks10p
	 quit
	rdtim t
	hrli t,1729.
	wrtim t
	quit

nsetp:	format "~&Would have set the time to be ~Q ~S (supplied by ~A).~
		~&  FYEAR/ ~D.   PDTIME/ ~D.~&",[qtime,qzone,host,year,ticks]
	call table
	quit

notset:	format "

                              Attention!

                              Attention!

The time could not be set because:"
	call (a)
	format "~&It will be necessary for someone to set the time~@
		manually by logging in and running :PDSET.~2&"
	quit

nofile:	jsp a,notset
	format "~&There was an error accessing the file ~
			~S;~S ~S.",[filesn,filen1,filen2]
	return

bogus:	format "~&The best time, ~Q ~S (supplied by ~A),",[qtime,qzone,host]
	call (a)
	format "~Q, the creation date of ~
			~S;~S ~S.",[lstime,filesn,filen1,filen2]
	return

future:	jsp a,notset
	jsp a,bogus
	format " was more than~&~D day~P beyond ",[days]
	return

past:	jsp a,notset
	jsp a,bogus
	format " was~&prior to "
	return

nogo:	jsp a,notset
	skipn t,ntimes
	 jrst nogo0
	camge t,quorum
	 jrst nogo1
	format "~&Of the ~D answer~P recieved, ~
		no ~D agreed to within ~D seconds.",[ntimes,quorum,spread]
	return

nogo0:	format "~&No host responded."
	return

nogo1:	format "~&Only ~D host~P responded.",ntimes
	return

;;; CALL TABLE:  Print a table of everything we know.
table:	save a
	save b
	save e
	format "~&~D host~P responded.",ntimes
	skipe count
	 format "  ~D outstanding request~P.",count
	movei b,0
tablel:	caml b,ntimes
	 jrst tablex
	move tt,sorted(b)
	move a,times(tt)
	call cvtime
	move tt,sorted(b)
	hrro t,hosts(tt)
	format "~&~3<~D~>:  ~Q ~S   ~A",[b,a,e,t]
	aoja b,tablel
	
tablex:	format "~&Low=~D  High=~D  Median=~D",[lowest,highest,median]
	format "~&Quorum=~D  Spread=~D sec.~&",[quorum,spread]
	rest e
	rest b
	rest a
	return

;;; CALL CVTIME:  Convert network time to local disk format time word.
;;; A (arg):  network time
;;; A (val):  disk format date
;;; E (val):  SIXBIT of timezone
cvtime:	subi a,s%est		; GMT -> EST
	call datime"sectim	; -> disk format date
	save b
	movei b,60.*60.
	call datime"odayl
	 skipa e,[sixbit /EDT/]
	  skipa e,[sixbit /EST/]
	   call datime"timadd
	rest b
	return

netwrk"$$hstmap==:1
netwrk"$$hostnm==:1
netwrk"$$symlook==:1
netwrk"$$chaos==:1
.insrt dsk:sysnet;netwrk >

;;; CALL LOOK:  Look up the Chaosnet address of a host.
;;; A (arg):  address of ASCIZ string
;;; A (val):  host number
;;; Skips if the host is found.
look:	save b
	tloe %fhsts
	 jrst look1
	save a
	movei a,ffpage
	movei b,utilch
	.iopush utilch,
	call netwrk"hstmap
	 .lose
	.iopop utilch,
	rest a
look1:	call netwrk"hstlook
	 jrst popbj	 
	rest b
	aos (p)
	return

cnstnts:
constants

patch::
pat:	block 100.

variables

ffaddr:	-1			; Make memory exist

ffpage==:<ffaddr+1777>_-12

end go