From 2c7a2dbd6a10648bd2b74b63a008bc00ed522407 Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Wed, 17 Mar 2021 19:53:17 -0400 Subject: [PATCH 1/3] king: remove the 'hardware femtosecond clock' --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index f977907a2..317ed5c8c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -604,7 +604,7 @@ processWork serf maxSize q onResp spin = do Nothing -> do atomically (writeTVar vDone True) Just evErr@(EvErr ev _) -> do - now <- Time.now + now <- Time.chop <$> Time.now let cb = onResp now evErr atomically $ modifyTVar' vInFlight (:|> (ev, cb)) sendWrit serf (WWork 0 now ev) From 6fa380ddc11503106c8ea47e1273ee53f81eda56 Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Wed, 17 Mar 2021 19:53:36 -0400 Subject: [PATCH 2/3] king: remove the 'hardware femtosecond clock' --- pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs index 55122fcb3..e232e5674 100644 --- a/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs +++ b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs @@ -149,3 +149,9 @@ gap (Wen x) (Wen y) | x > y = x - y addGap :: Wen -> Gap -> Wen addGap (Wen x) y = Wen (x+y) + +-- | Produce a Wen with precision compatible to that from vere's time.c +chop :: Wen -> Wen +chop (Wen (Gap g)) = Wen (Gap (mop g)) + where + mop n = shiftL (shiftR n 48) 48 From 0e332c325904f65ebb61168f15b189920299f11e Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Fri, 19 Mar 2021 14:44:52 -0400 Subject: [PATCH 3/3] king: joe had good suggestions re time precision --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 2 +- pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs | 30 +++++++++++++------- 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 317ed5c8c..f977907a2 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -604,7 +604,7 @@ processWork serf maxSize q onResp spin = do Nothing -> do atomically (writeTVar vDone True) Just evErr@(EvErr ev _) -> do - now <- Time.chop <$> Time.now + now <- Time.now let cb = onResp now evErr atomically $ modifyTVar' vInFlight (:|> (ev, cb)) sendWrit serf (WWork 0 now ev) diff --git a/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs index e232e5674..1976c11a5 100644 --- a/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs +++ b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs @@ -17,22 +17,22 @@ import Data.Time.Clock.System (systemToUTCTime, utcToSystemTime) import Data.Time.LocalTime (TimeOfDay(..), timeToTimeOfDay) import Data.Word (Word64) import Text.Printf (printf) -import Urbit.Noun (FromNoun, ToNoun) +import Urbit.Noun (deriveToNoun, FromNoun, ToNoun(..)) -- Types ----------------------------------------------------------------------- newtype Gap = Gap { _fractoSecs :: Integer } - deriving newtype (Eq, Ord, Show, Num, ToNoun, FromNoun) + deriving newtype (Eq, Ord, Show, Num, FromNoun) newtype Unix = Unix { _sinceUnixEpoch :: Gap } - deriving newtype (Eq, Ord, Show, ToNoun, FromNoun) + deriving newtype (Eq, Ord, Show, FromNoun) newtype Wen = Wen { _sinceUrbitEpoch :: Gap } - deriving newtype (Eq, Ord, Show, Num, ToNoun, FromNoun) + deriving newtype (Eq, Ord, Show, Num, FromNoun) newtype Date = MkDate { _dateWen :: Wen } - deriving newtype (Eq, Ord, Num, ToNoun, FromNoun) + deriving newtype (Eq, Ord, Num, FromNoun) -- Record Lenses --------------------------------------------------------------- @@ -45,6 +45,20 @@ makeLenses ''Date -- Instances ------------------------------------------------------------------- +instance ToNoun Gap where + toNoun (reducePrecision -> Gap fs) = toNoun fs + +-- | Produce a Gap with fewer digits after the binary point, more +-- appropriately capturing the precision our clock gives us. +reducePrecision :: Gap -> Gap +reducePrecision (Gap fs) = Gap (chop fs) + where + chop fs = shiftL (shiftR fs 32) 32 + +deriveToNoun ''Unix +deriveToNoun ''Wen +deriveToNoun ''Date + instance Show Date where show (MkDate wen) = if fs == 0 then printf "~%i.%u.%u..%02u.%02u.%02u" y m d h min s @@ -149,9 +163,3 @@ gap (Wen x) (Wen y) | x > y = x - y addGap :: Wen -> Gap -> Wen addGap (Wen x) y = Wen (x+y) - --- | Produce a Wen with precision compatible to that from vere's time.c -chop :: Wen -> Wen -chop (Wen (Gap g)) = Wen (Gap (mop g)) - where - mop n = shiftL (shiftR n 48) 48