// GateConTime.bcpl -- talks to the Time server
// Last modified July 2, 1983  10:26 PM by Boggs

get "Pup0.decl"
get "Pup1.decl"
get "PupTimeServ.decl"
get "AltoDefs.d"

external
[
// outgoing procedures
CreateTimeCtx; RestartTime; Time; TimeSummary

// incoming procedures
OpenLevel1Socket; CloseLevel1Socket; GetBuf; ReleasePBI; CompletePup
Zero; MoveBlock; ReturnFrom; Allocate; Free; Enqueue; Dequeue
InitializeContext; Block; SetTimer; TimerHasExpired
Ws; Wss; Puts; PutTemplate; GetString; GetPartner; Confirm; GetNumber
SendCommand; MiscCmd; UNPACKDT; WRITEUDT; PrintPort
TopLevel; ResetCmdMenu; CreateCmdBox; BoxProc; Noop

// incoming statics
dsp; sysZone; ctxQ; wheel; gcHost; oldStatsQ
]

static @tu

structure TU:		// tu -> this 'global frame' for this module
[
soc word		// -> PupSoc
stats word		// -> Time Server Stats block
timer word		// update stats when this expires
]
manifest lenTU = size TU/16

//----------------------------------------------------------------------------
let CreateTimeCtx() be
//----------------------------------------------------------------------------
[
Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 150), 150, TimeCtx))
tu = Allocate(sysZone, lenTU); Zero(tu, lenTU)
tu>>TU.soc = Allocate(sysZone, lenPupSoc); OpenLevel1Socket(tu>>TU.soc)
]

//----------------------------------------------------------------------------
and RestartTime() be
//----------------------------------------------------------------------------
[
SetTimer(lv tu>>TU.timer, 0)
if tu>>TU.stats ne 0 then
   [ Enqueue(oldStatsQ, tu>>TU.stats); tu>>TU.stats = 0 ]
]

//----------------------------------------------------------------------------
and Time() be
//----------------------------------------------------------------------------
[
ResetCmdMenu()
CreateCmdBox(TopLevel, "TopLevel")
CreateCmdBox(AltoTime, "Alto")
CreateCmdBox(TenexTime, "Tenex")
CreateCmdBox(StringTime, "String")
CreateCmdBox(SurveyTime, "Survey")
if gcHost ne 0 then
   [
   CreateCmdBox(TimeStats, "TimeStats")
   if wheel then
      [
      CreateCmdBox(LockServer, "Lock")
      CreateCmdBox(ResetTime, "Reset")
      ]
   ]
// ResetCmdMenu destroyed the BoxQ which BoxProc is following.
// If we just return now, BoxProc will get horribly confused.
// So don't let it continue: force a return from BoxProc.
ReturnFrom(BoxProc)
]

//----------------------------------------------------------------------------
and TimeSummary(stream) be
//----------------------------------------------------------------------------
[
if tu>>TU.stats ne 0 then
   PutTemplate(stream, "Time: $EUD  ", lv tu>>TU.stats>>Stats.altoReqs)
]

//----------------------------------------------------------------------------
and SurveyTime() be
//----------------------------------------------------------------------------
[
let net = GetNumber("*NNet number: ")
let soc = tu>>TU.soc
let pbi = GetBuf(soc)
pbi>>PBI.pup.dPort.net = net
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
CompletePup(pbi, ptAltoTimeRequest, pupOvBytes)
let timer = nil; SetTimer(lv timer, 1000)
   [
   Block() repeatuntil TimerHasExpired(lv timer) % soc>>PupSoc.iQ.head ne 0
   if TimerHasExpired(lv timer) break
   let pbi = Dequeue(lv soc>>PupSoc.iQ)
   if pbi>>PBI.pup.type eq ptAltoTimeReply then PrintAlto(pbi)
   ReleasePBI(pbi)
   ] repeat
]

//----------------------------------------------------------------------------
and TimeCtx(ctx) be  //a context
//----------------------------------------------------------------------------
[
Block() repeatuntil TimerHasExpired(lv tu>>TU.timer) & gcHost ne 0
SetTimer(lv tu>>TU.timer, 1000)  // 10 sec
let pbi = GetBuf(tu>>TU.soc)
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
pbi = SendCommand(pbi, ptTimeStatsRequest, pupOvBytes, (tu>>TU.stats? 1, 3))
if pbi ne 0 then
   [
   let stats = lv pbi>>PBI.pup.words
   if pbi>>PBI.pup.type eq ptTimeStatsReply &
    stats>>Stats.version eq timeStatsVersion then
      [
      if tu>>TU.stats then Enqueue(oldStatsQ, tu>>TU.stats)
      let lenStatBlock = (pbi>>PBI.pup.length-pupOvBytes+1)/2
      tu>>TU.stats = Allocate(sysZone, lenStatBlock)
      MoveBlock(tu>>TU.stats, stats, lenStatBlock)
      ]
   ReleasePBI(pbi)
   ]
] repeat

//----------------------------------------------------------------------------
and TimeStats() be
//----------------------------------------------------------------------------
[
let oldStats = tu>>TU.stats
SetTimer(lv tu>>TU.timer, 0)
let timer = nil; SetTimer(lv timer, 500)  // 5 sec
Block() repeatuntil TimerHasExpired(lv timer) % tu>>TU.stats ne oldStats
test tu>>TU.stats ne oldStats
   ifso Ws("*NTime Server stats:")
   ifnot
      [
      Ws("*NThe Time Server doesn't answer.")
      if tu>>TU.stats ne 0 then
         Ws("*NWhen last heard from its stats were:")
      ]
if tu>>TU.stats ne 0 then
   PutTemplate(dsp, "*NAlto: $EUD  Tenex: $EUD  String: $EUD  Correction: $D  Set from: $P",
    lv tu>>TU.stats>>Stats.altoReqs, lv tu>>TU.stats>>Stats.tenexReqs,
    lv tu>>TU.stats>>Stats.stringReqs, tu>>TU.stats>>Stats.correction,
    PrintPort, lv tu>>TU.stats>>Stats.resetPort)
]

//----------------------------------------------------------------------------
and ResetTime() be
//----------------------------------------------------------------------------
[
let name = vec 128; unless GetString("*NReset time from: ", name) return
let port = vec lenPort
unless GetPartner(name, dsp, port, 0, psMiscServ) return
MiscCmd(ptResetTimeRequest, ptResetTimeReply, Noop, port, lenPort*2)
]

//----------------------------------------------------------------------------
and LockServer() be if Confirm("*NLock time server") then
//----------------------------------------------------------------------------
   MiscCmd(ptLockTimeRequest, ptLockTimeReply, Noop)

//----------------------------------------------------------------------------
and AltoTime() be MiscCmd(ptAltoTimeRequest, ptAltoTimeReply, PrintAlto)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and PrintAlto(pbi) be
//----------------------------------------------------------------------------
[
let tp = lv pbi>>PBI.pup.words↑3
let temp = vec 2; MoveBlock(temp, timeParams, 2)
timeParams>>LTP.sign = tp>>TimeParams.zoneS
timeParams>>LTP.zoneH = tp>>TimeParams.zoneH
timeParams>>LTP.zoneM = tp>>TimeParams.zoneM
timeParams>>LTP.beginDST = tp>>TimeParams.beginDST
timeParams>>LTP.endDST = tp>>TimeParams.endDST
let utv = vec 7; UNPACKDT(lv pbi>>PBI.pup.words, utv)
MoveBlock(timeParams, temp, 2)
PutTemplate(dsp, "*N$P: $P", PrintPort, lv pbi>>PBI.pup.sPort, WRITEUDT, utv)
PutTemplate(dsp, ", Zone $C$D:$2F0D, DST $UD, $UD",
 (tp>>TimeParams.zoneS? $-, $+), tp>>TimeParams.zoneH,
 tp>>TimeParams.zoneM, tp>>TimeParams.beginDST,
 tp>>TimeParams.endDST)
]

//----------------------------------------------------------------------------
and TenexTime() be MiscCmd(ptTenexTimeRequest, ptTenexTimeReply, PrintTenex)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and PrintTenex(pbi) be
//----------------------------------------------------------------------------
[
PutTemplate(dsp, "*N$P: ", PrintPort, lv pbi>>PBI.pup.sPort)
for i = 1 to pbi>>PBI.pup.length-pupOvBytes do
   PutTemplate(dsp, "$3UF0O ", pbi>>PBI.pup.bytes↑i)
]

//----------------------------------------------------------------------------
and StringTime() be MiscCmd(ptStringTimeRequest, ptStringTimeReply, PrintString)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and PrintString(pbi) be
//----------------------------------------------------------------------------
[
PutTemplate(dsp, "*N$P: ", PrintPort, lv pbi>>PBI.pup.sPort)
for i = 1 to pbi>>PBI.pup.length-pupOvBytes do
   Puts(dsp, pbi>>PBI.pup.bytes↑i)
]