// 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)
]