// PupTimeServ.bcpl - Pup Time Server
// Last modified March 19, 1980 12:07 AM by Boggs
get "pup0.decl"
get "pup1.decl"
get "PupTimeServ.decl"
external
[
// outgoing procedures
TimeServ; TimeServCtx; ResetTimeServ; GetTime
// incoming procedures
Dequeue; Enqueue; Unqueue
MoveBlock; MultEq; Zero; NovaDiv
SetTimer; TimerHasExpired; InitializeContext; Block; Dismiss
AppendStringToPup; GetPBI; ReleasePBI; CompletePup
ExchangePorts; OpenLevel1Socket; CloseLevel1Socket; SetPupDPort
DoubleIncrement; DoubleAdd; DoubleSubtract
// outgoing statics
@ts
// incoming statics
lenPup; pbiTQ; @ms
]
compileif nova then [ external [ RTC ] ]
compileif stringFormat then [ external [ UNPACKDT; CONVUDT ] ]
static @ts
// TimeServCtx is the main process for this module.
// It maintains the calendar clock, correcting when necessary.
// ResetTimeServ causes the time server to forget what time it is
// and probe for the time from another time server.
// Until it has reset itself, it doesn't answer requests.
// The time is reset by spawning a process, so the time probably wont
// have been reset yet when ResetTimeServ returns.
// TimeServ is logically part of the miscellaneous services process,
// handling the Time protocol packet types.
//----------------------------------------------------------------------------
let TimeServ(pbi) be
//----------------------------------------------------------------------------
// Called from Misc Server, pbi contains a time protocol Pup
[
ExchangePorts(pbi)
switchon pbi>>PBI.pup.type into
[
compileif stringFormat then
[
case ptStringTimeRequest:
[
if ts>>TS.dontKnowTime ne 0 % ts>>TS.doCorrect eq 0 endcase
let dateVec = vec 6; UNPACKDT(lv ts>>TS.altoClk, dateVec)
let buffer = vec 20; CONVUDT(buffer, dateVec)
AppendStringToPup(pbi, 1, buffer)
CompletePup(pbi, ptStringTimeReply)
DoubleIncrement(lv ts>>TS.stats.stringReqs)
return
]
]
case ptTenexTimeRequest:
[
if ts>>TS.dontKnowTime ne 0 % ts>>TS.doCorrect eq 0 endcase
// Q1, R1 ← AltoTime/43200. Q1 = halfDays, R1 = seconds
// Q2, R2 ← Q1/2, Q2 = days. R2 = halfDays (0 or 1)
// Days ← Q2 + 15385
// Seconds ← R1 + R2*43200
let R1 = nil
let Q1 = NovaDiv(lv ts>>TS.altoClk, #124300, lv R1)
let R2 = Q1 & 1
let Q2 = Q1 rshift 1
let days = vec 1; days!0 = 0; days!1 = Q2
DoubleAdd(days, table [ 0; 15385 ])
let seconds = vec 1; seconds!0 = 0; seconds!1 = R1
if R2 ne 0 then DoubleAdd(seconds, table [ 0; #124300 ])
pbi>>PBI.pup.words↑1 = days!0 lshift 8 + days!1 rshift 8
pbi>>PBI.pup.words↑2 = days!1 lshift 8 + seconds!0
pbi>>PBI.pup.words↑3 = seconds!1
CompletePup(pbi, ptTenexTimeReply, pupOvBytes+6)
DoubleIncrement(lv ts>>TS.stats.tenexReqs)
return
]
case ptAltoTimeRequest:
[
if ts>>TS.dontKnowTime ne 0 % ts>>TS.doCorrect eq 0 endcase
MoveBlock(lv pbi>>PBI.pup.words↑1, lv ts>>TS.altoClk, 2)
MoveBlock(lv pbi>>PBI.pup.words↑3, lv ts>>TS.timeParams, 3)
CompletePup(pbi, ptAltoTimeReply, pupOvBytes+10)
DoubleIncrement(lv ts>>TS.stats.altoReqs)
return
]
case ptTimeStatsRequest:
[
MoveBlock(lv pbi>>PBI.pup.words, lv ts>>TS.stats, size Stats/16)
CompletePup(pbi, ptTimeStatsReply, pupOvBytes+size Stats/8)
return
]
case ptLockTimeRequest:
[
unless Authenticate(pbi) endcase
ts>>TS.dontKnowTime = true
CompletePup(pbi, ptLockTimeReply, pupOvBytes)
return
]
case ptResetTimeRequest:
[
unless Authenticate(pbi) endcase
ResetTimeServ(lv pbi>>PBI.pup.words)
CompletePup(pbi, ptResetTimeReply, pupOvBytes)
return
]
]
ReleasePBI(pbi) // Failure: discard the Pup.
]
//----------------------------------------------------------------------------
and TimeServCtx() be // a context
//----------------------------------------------------------------------------
[
let lvRTC = alto? 575b, lv RTC
let myRTC = @lvRTC
[
Block() repeatuntil @lvRTC-myRTC gr ticksPerSec
[ //1 second has elapsed since last update
myRTC = myRTC + ticksPerSec
if ts>>TS.doCorrect then
[
DoubleIncrement(lv ts>>TS.corrCount, -1)
if MultEq(lv ts>>TS.corrCount, table [ 0; 0 ]) then
[
MoveBlock(lv ts>>TS.corrCount, lv ts>>TS.correction, 2)
test ts>>TS.corrSign ne 0
ifso myRTC = myRTC - ticksPerSec //gain 1 second
ifnot myRTC = myRTC + ticksPerSec //lose 1 second
]
]
DoubleIncrement(lv ts>>TS.altoClk)
]
] repeat
]
//----------------------------------------------------------------------------
and GetTime(lvDest) = valof
//----------------------------------------------------------------------------
[
unless ts>>TS.dontKnowTime do MoveBlock(lvDest, lv ts>>TS.altoClk, 2)
resultis ts>>TS.dontKnowTime eq 0
]
//----------------------------------------------------------------------------
and Authenticate(pbi) = pbi>>PBI.pup.id↑1 eq 27182
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and ResetTimeServ(port; numargs na) be
//----------------------------------------------------------------------------
// Call this to Reset clock from the internet.
// The work is done asynchronously by a process spawned by this procedure
// so time may not yet be reset when this procedure returns.
// Port is who to send the request to. It defaults to all time servers
// on all directly connected nets.
// If ResetTimeCtx is active and we get another reset request, perhaps the
// port was bad in the first request, so reach into the context and change
// the port.
[
if ts>>TS.resetCtx eq 0 then
[
ts>>TS.resetCtx = InitializeContext(lv GetPBI(ms>>MS.soc)>>PBI.pup,
lenPup, ResetTimeCtx)
Enqueue(ms>>MS.ctxQ, ts>>TS.resetCtx)
]
let resetPort = lv ts>>TS.stats.resetPort
MoveBlock(resetPort, (na eq 0 ? table [ 0; 0; 0 ], port), lenPort)
if MultEq(lv resetPort>>Port.socket, table [ 0; 0 ]) then
resetPort>>Port.socket↑2 = psMiscServ
]
//----------------------------------------------------------------------------
and ResetTimeCtx(ctx) be
//----------------------------------------------------------------------------
// This context's stack is a PBI. The context destroys itself
// when done by removing itself from its ctxQ and releasing the PBI.
[
let resetPort = lv ts>>TS.stats.resetPort
let soc = vec lenPupSoc; OpenLevel1Socket(soc, 0, 0)
let gotTime = false
[
let pbi = GetPBI(soc, true); if pbi ne 0 then
[
SetPupDPort(pbi, resetPort)
pbi>>PBI.allNets = resetPort>>Port.host eq 0 & resetPort>>Port.net eq 0
CompletePup(pbi, ptAltoTimeRequest, pupOvBytes)
]
let timer = nil; SetTimer(lv timer, 1000) // 10 seconds
[
Block() repeatuntil TimerHasExpired(lv timer) % soc>>PupSoc.iQ.head ne 0
pbi = Dequeue(lv soc>>PupSoc.iQ); if pbi eq 0 break
if pbi>>PBI.pup.type eq ptAltoTimeReply then
[
gotTime = true
MoveBlock(lv ts>>TS.altoClk, lv pbi>>PBI.pup.bytes, 2)
MoveBlock(resetPort, lv pbi>>PBI.pup.sPort, lenPort)
]
ReleasePBI(pbi)
] repeatuntil gotTime
] repeatuntil gotTime
CloseLevel1Socket(soc)
ts>>TS.dontKnowTime = false
ts>>TS.resetCtx = 0
Unqueue(ms>>MS.ctxQ, ctx)
Enqueue(pbiTQ, ctx-offset PBI.pup/16)
]