diff --git a/INSTALL.md b/INSTALL.md index cac6ca94d..5f84f1797 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -56,11 +56,10 @@ Debian and Ubuntu systems, you can say: $ apt-get install \ libghc-regex-compat-dev \ libghc-syb-dev \ - libghc-old-time-dev \ libghc-split-dev The second command will install the Haskell libraries `regex-compat`, `syb`, -`old-time`, and `split`, as well as some libraries that they depend on. +and `split`, as well as some libraries that they depend on. If you wish to do profiling builds of the compiler itself, you will also need to install versions of the Haskell libraries built using the profiling flags. @@ -70,7 +69,6 @@ On Debian and Ubuntu, this can be done with: ghc-prof \ libghc-regex-compat-prof \ libghc-syb-prof \ - libghc-old-time-prof \ libghc-split-prof You can do the analogous package-install on other Linux distributions using @@ -87,12 +85,12 @@ commands to install Haskell libraries. For cabal v2.x: $ cabal update - $ cabal install regex-compat syb old-time split + $ cabal install regex-compat syb split For cabal v3.x: $ cabal update - $ cabal v1-install regex-compat syb old-time split + $ cabal v1-install regex-compat syb split Cabal's newer `v2-install` has the advantage of not installing the libraries into the GHC installation. This is useful if the GHC @@ -104,7 +102,7 @@ passing an additional flag to GHC, which can be done by defining `GHC` in the environment when calling `make` in the later steps. For example (cabal v3.x only): - $ cabal v2-install --package-env=default syb old-time split + $ cabal v2-install --package-env=default syb split $ make GHC="ghc -package-env default" Bluespec compiler builds are tested with GHC 9.4.8. diff --git a/src/Makefile b/src/Makefile index 13b36104b..e8826a89d 100644 --- a/src/Makefile +++ b/src/Makefile @@ -16,7 +16,7 @@ TOOLS=$(CC_TOOLS) \ $(YICES_TOOLS) \ $(STP_TOOLS) \ -GHC_PKGS=regex-compat syb old-time split +GHC_PKGS=regex-compat syb split SUBMODS=vendor/yices/v2.6/yices2 diff --git a/src/comp/ABin.hs b/src/comp/ABin.hs index 1dc6ce2b8..972891e6d 100644 --- a/src/comp/ABin.hs +++ b/src/comp/ABin.hs @@ -49,7 +49,6 @@ data ABinModInfo = -- the name of the BSV package which defined this module abmi_src_name :: String, -- time when BSC was called to compile the .ba - --abmi_time :: ClockTime, abmi_apkg :: APackage, abmi_aschedinfo :: AScheduleInfo, -- if this can be used prior to generating abin, diff --git a/src/comp/Depend.hs b/src/comp/Depend.hs index c4a9eeeb0..b93f44045 100644 --- a/src/comp/Depend.hs +++ b/src/comp/Depend.hs @@ -7,10 +7,9 @@ import Control.Monad(when) import System.Process(system) import System.Exit(ExitCode(..)) import System.Directory(getModificationTime) -import System.Time -- XXX: in old-time package import System.IO.Error(ioeGetErrorType) import GHC.IO.Exception(IOErrorType(..)) -import Data.Time.Clock.POSIX(utcTimeToPOSIXSeconds) +import Data.Time import qualified Control.Exception as CE import qualified Data.Map as DM @@ -49,13 +48,11 @@ type PkgName = Id type ModName = Id type ForeignName = Id -type MClockTime = Maybe ClockTime - data PkgInfo = PkgInfo { pkgName :: PkgName, fileName :: FileName, - srcMod :: MClockTime, - lastMod :: MClockTime, + srcMod :: Maybe UTCTime, + lastMod :: Maybe UTCTime, imports :: [PkgName], includes :: [FileName], gens :: [ModName], @@ -65,12 +62,6 @@ data PkgInfo = PkgInfo { } deriving (Show) -getModificationTime' :: FilePath -> IO ClockTime -getModificationTime' file = - do utcTime <- getModificationTime file - let s = (floor . utcTimeToPOSIXSeconds) utcTime - return (TOD s 0) - -- returns a list of Bluespec source files which need recompiling. -- (This used to also return a list of all generated files which would -- result from codegen, so that a later stage could link them. But this @@ -294,15 +285,15 @@ isPreludePkg flags n = -- Check if out-of-date with respect to an imported module. -- Recompilation is needed if the imported file will be -- recompiled or if it has a later date stamp. -needsUpd :: MClockTime -> [PkgInfo] -> PkgName -> Bool +needsUpd :: Maybe UTCTime -> [PkgInfo] -> PkgName -> Bool needsUpd myMod pis n = case findInfo n pis of Nothing -> internalError ("needsUpd " ++ pfpString n) Just pi -> recompile pi || lastMod pi > myMod -getModTime :: String -> IO MClockTime -getModTime f = CE.catch (getModificationTime' f >>= return . Just) handler - where handler :: CE.SomeException -> IO MClockTime +getModTime :: String -> IO (Maybe UTCTime) +getModTime f = CE.catch (getModificationTime f >>= return . Just) handler + where handler :: CE.SomeException -> IO (Maybe UTCTime) handler _ = return Nothing ----- diff --git a/src/comp/GenABin.hs b/src/comp/GenABin.hs index de7264716..a2d72e9e0 100644 --- a/src/comp/GenABin.hs +++ b/src/comp/GenABin.hs @@ -6,7 +6,6 @@ module GenABin(genABinFile, readABinFile) where import Error(internalError, ErrMsg(..), ErrorHandle, bsErrorUnsafe) import Position ---import Time(ClockTime) import Backend import Wires import ASyntax diff --git a/src/comp/IExpandUtils.hs b/src/comp/IExpandUtils.hs index 443a40b8c..f516fdf96 100644 --- a/src/comp/IExpandUtils.hs +++ b/src/comp/IExpandUtils.hs @@ -66,16 +66,16 @@ import Control.Monad(when, liftM) import Control.Monad.State(StateT, runStateT, evalStateT, lift, liftIO, gets, get, put, modify) import Data.IORef -import System.IO.Unsafe +import Data.Time import Data.List import Data.Maybe import Data.Char(isAlphaNum) -import System.Time -- XXX: from old-time package -import Debug.Trace(traceM) import qualified Data.Array as Array import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Generics as Generic +import Debug.Trace(traceM) +import System.IO.Unsafe import Eval import PPrint @@ -2072,9 +2072,9 @@ newIStateLocForRule id hide [] = internalError "newIStateLocForRule: Empty loc" traceProgress :: String -> G () traceProgress str = liftIO $ do - ct <- getClockTime - now <- toCalendarTime ct - traceM ("[" ++ calendarTimeToString now ++ "] elab progress: " ++ str) + ct <- getCurrentTime + tz <- getCurrentTimeZone + traceM ("[" ++ show (utcToLocalTime tz ct) ++ "] elab progress: " ++ str) showTopProgress :: String -> G () showTopProgress str = do diff --git a/src/comp/Makefile b/src/comp/Makefile index ac57e3e55..a3ce17be5 100644 --- a/src/comp/Makefile +++ b/src/comp/Makefile @@ -92,7 +92,7 @@ $(warning Building unoptimized to work around a bug in GHC 9.2.1) GHCOPTLEVEL ?= -O0 endif -GHC += -Wtabs -fmax-pmcheck-models=800 +GHC += -Wtabs -fmax-pmcheck-models=800 -freverse-errors # end ifeq ($(GHCMAJOR),9) else @@ -134,8 +134,6 @@ PACKAGES = \ -package process \ -package filepath \ -package time \ - -package old-time \ - -package old-locale \ -package split \ -package syb \ -package integer-gmp \ diff --git a/src/comp/SimBlocksToC.hs b/src/comp/SimBlocksToC.hs index 94a05704d..b6c4c57b3 100644 --- a/src/comp/SimBlocksToC.hs +++ b/src/comp/SimBlocksToC.hs @@ -7,8 +7,9 @@ import Data.List(nub, (\\), find, genericLength, sortBy, groupBy) import Data.List.Split(wordsBy) import Data.Maybe(catMaybes, isJust, fromJust) import Data.Function(on) +import Data.Time +import Data.Time.Clock.POSIX import Control.Monad.State(runState) -import System.Time -- XXX: in old-time package import qualified Data.Map as M import ErrorUtil(internalError) @@ -26,7 +27,6 @@ import VModInfo(vName_to_id) import PPrint(ppReadable) -- hiding (int, char) import Util(concatMapM, mapFst, mapSnd) import SimFileUtils(codeGenOptionDescr) -import TopUtils(TimeInfo(..)) import Version(versionname) import BuildVersion(buildVersion) @@ -35,13 +35,13 @@ import BuildVersion(buildVersion) -- Create many .cxx and .h files from the entire list of SimCCBlocks -- and SimCCScheds. The blocks are grouped by module, the schedules -- cut across all modules. -simBlocksToC :: Flags -> TimeInfo -> SBId -> +simBlocksToC :: Flags -> Maybe UTCTime -> SBId -> (Maybe String) -> (Maybe String) -> SBMap -> ForeignFuncMap -> [String] -> [SimCCBlock] -> [SimCCSched] -> [SimCCClockGroup] -> SimCCGateInfo -> (String -> String -> IO String) -> IO [String] -simBlocksToC flags time top_block def_clk def_rst +simBlocksToC flags mcreation_time top_block def_clk def_rst sb_map ff_map reused mod_blocks scheds clk_groups gate_info writeFileC = do let sub_ids = [ i | sb <- M.elems sb_map, (i, _, _) <- sb_state sb ] @@ -95,7 +95,7 @@ simBlocksToC flags time top_block def_clk def_rst let cvtModBlock = convertModuleBlock flags sb_map ff_map clk_map wdef_mod_map reused top_block module_names <- concatMapM (cvtModBlock writeFileC) mod_blocks - schedule_names <- convertSchedules flags time top_block def_clk def_rst sb_map ff_map + schedule_names <- convertSchedules flags mcreation_time top_block def_clk def_rst sb_map ff_map wdef_inst_map scheds clk_groups gate_info writeFileC return $ module_names ++ schedule_names @@ -207,12 +207,12 @@ convertModuleBlock flags sb_map ff_map clk_map wdef_mod_map reused top_blk write writeFileC -- Convert the schedule and reset functions into .cxx and .h files -convertSchedules :: Flags -> TimeInfo -> SBId -> +convertSchedules :: Flags -> Maybe UTCTime -> SBId -> (Maybe String) -> (Maybe String) -> SBMap -> ForeignFuncMap -> M.Map String [AId] -> [SimCCSched] -> [SimCCClockGroup] -> SimCCGateInfo -> (String -> String -> IO String) -> IO [String] -convertSchedules flags creation_time top_id def_clk def_rst sb_map ff_map +convertSchedules flags mcreation_time top_id def_clk def_rst sb_map ff_map wdef_map scheds clk_groups gate_info writeFileC = do let ids = [] top_blk = lookupSB sb_map top_id @@ -489,12 +489,15 @@ convertSchedules flags creation_time top_id def_clk def_rst sb_map ff_map get_creation_time = function (userType "time_t") (mkScopedVar "get_creation_time") [] - (TimeInfo _ clock_time@(TOD t _)) = if (timeStamps flags) - then creation_time - else TimeInfo 0 (TOD 0 0) - time_str = calendarTimeToString (toUTCTime clock_time) + + ( time_str, time_secs ) = case mcreation_time of + Nothing -> ( "1970-01-01 00:00:00 UTC", 0 ) + Just clock_time -> ( show clock_time + , floor $ nominalDiffTimeToSeconds (utcTimeToPOSIXSeconds clock_time) + ) + gct_def = define get_creation_time - (comment time_str (ret (Just (mkUInt64 t)))) + (comment time_str (ret (Just (mkUInt64 time_secs)))) version_methods = [ comment "Fill in version numbers" gv_def , comment "Get the model creation time" gct_def ] diff --git a/src/comp/TopUtils.hs b/src/comp/TopUtils.hs index 042618580..01acb79ff 100644 --- a/src/comp/TopUtils.hs +++ b/src/comp/TopUtils.hs @@ -5,12 +5,12 @@ module TopUtils where #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 804) import Prelude hiding ((<>)) #endif +import Data.Time import Text.Printf(printf) import System.IO(hFlush, stdout) import System.CPUTime(getCPUTime) import Control.Monad(when, unless) import Control.Monad.Trans(MonadIO(..)) -import System.Time -- XXX: from old-time package -- hbc libs import PFPrint -- utility libs @@ -189,24 +189,18 @@ commentC ls = unlines (["/*"] ++ map (" * " ++) ls ++ [" */"]) commentV ls = unlines (["//"] ++ map ("// " ++) ls ++ ["//"]) ----- - -getCPUTimeDoublePortable :: IO Double -getCPUTimeDoublePortable = do - t <- getCPUTime - return (fromInteger t * 1.0e-12) - -data TimeInfo = TimeInfo Double ClockTime +data TimeInfo = TimeInfo Double UTCTime deriving (Show) getNow :: IO TimeInfo getNow = do - t <- getCPUTimeDoublePortable - ct <- getClockTime + -- get portable cpu time + t <- fmap (\t -> fromInteger t * 1.0e-12) getCPUTime + ct <- getCurrentTime return (TimeInfo t ct) diffTimeInfo :: TimeInfo -> TimeInfo -> (Double, Double) -diffTimeInfo (TimeInfo t ct) (TimeInfo t' ct') = (t'-t, tdToDouble (diffClockTimes ct' ct)) - where tdToDouble d = fromIntegral ((tdHour d * 60 + tdMin d) * 60 + tdSec d) + fromInteger (tdPicosec d) * 1.0e-12 +diffTimeInfo (TimeInfo t ct) (TimeInfo t' ct') = (t' - t, realToFrac (diffUTCTime ct' ct)) putStrLnF :: String -> IO () putStrLnF s = do putStrLn s; hFlush stdout @@ -294,7 +288,7 @@ showCnt cnt s = text $ itos cnt ++ " " ++ s -- | Makes a timestamp string for generated code, respecting the timeStamps flag mkTimestampComment :: Flags -> IO String mkTimestampComment flags - | timeStamps flags = getClockTime >>= return . ("On " ++) . show + | timeStamps flags = getCurrentTime >>= return . ("On " ++) . show | otherwise = return "" mkGenFileHeader :: Flags -> IO [String] diff --git a/src/comp/bsc.hs b/src/comp/bsc.hs index 2014b763c..50ef825fb 100644 --- a/src/comp/bsc.hs +++ b/src/comp/bsc.hs @@ -12,7 +12,6 @@ import System.IO(hFlush, stdout, hPutStr, stderr, hGetContents, hClose, hSetBuff import System.IO(hSetEncoding, utf8) import System.Posix.Files(fileMode, unionFileModes, ownerExecuteMode, groupExecuteMode, setFileMode, getFileStatus, fileAccess) import System.Directory(getDirectoryContents, doesFileExist, getCurrentDirectory) -import System.Time(getClockTime, ClockTime(TOD)) -- XXX: from old-time package import Data.Char(isSpace, toLower, ord) import Data.List(intersect, nub, partition, intersperse, sort, isPrefixOf, isSuffixOf, unzip5, intercalate) @@ -20,6 +19,7 @@ import Data.Time.Clock.POSIX(getPOSIXTime) import Data.Maybe(isJust, isNothing) import Numeric(showOct) +import Data.Time import Control.Monad(when, unless, filterM, liftM, foldM) import Control.Monad.Except(runExceptT) import Control.Concurrent(forkIO) @@ -354,7 +354,7 @@ compilePackage name -- String -- min@(CPackage pkgId _ _ _ _ _) = do - clkTime <- getClockTime + clkTime <- getCurrentTime epochTime <- getPOSIXTime -- Values needed for the Environment module @@ -1279,7 +1279,7 @@ genModuleC :: ErrorHandle -> TimeInfo -> String -> [(String, ABin)] - -> IO (TimeInfo, [String], [String], TimeInfo) + -> IO (TimeInfo, [String], [String], Maybe UTCTime) genModuleC errh flags dumpnames time0 toplevel abis = do pwd <- getCurrentDirectory @@ -1339,10 +1339,14 @@ genModuleC errh flags dumpnames time0 toplevel abis = start flags DFsimBlocksToC let sb_map = M.fromList $ map (\sb -> (sb_id sb,sb)) (simblocks_opt ++ primBlocks) - creation_time = time + + time' <- getCurrentTime + let mcreation_time + | timeStamps flags = Just time' + | otherwise = Nothing block_names <- simBlocksToC flags - creation_time + mcreation_time top_id (ssys_default_clk sim_system_opt) (ssys_default_rst sim_system_opt) @@ -1389,7 +1393,7 @@ genModuleC errh flags dumpnames time0 toplevel abis = -- XXX return the headers separate from the files which need to be -- XXX compiled - return (time, names, reused_names, creation_time) + return (time, names, reused_names, mcreation_time) -- =============== -- SimLink @@ -1423,7 +1427,7 @@ simLink errh flags toplevel afilenames cfilenames = do -- generate the files, get back a list of files to be compiled -- and a list of files which have already been compiled - (t, to_compile, to_reuse, creation_time) + (t, to_compile, to_reuse, mcreation_time) <- genModuleC errh flags dumpnames t toplevel abis let t_before_compilations = t @@ -1465,7 +1469,7 @@ simLink errh flags toplevel afilenames cfilenames = do -- if not generating a SystemC model, link to a Bluesim executable start flags DFbluesimlink when (not (genSysC flags)) $ - cxxLink errh flags toplevel ofiles creation_time + cxxLink errh flags toplevel ofiles mcreation_time t <- dump errh flags t DFbluesimlink dumpnames toplevel -- final verbose message @@ -1760,8 +1764,8 @@ execCmd errh flags cmd = do -- link object files into a shared library -cxxLink :: ErrorHandle -> Flags -> String -> [String] -> TimeInfo -> IO () -cxxLink errh flags toplevel names creation_time = do +cxxLink :: ErrorHandle -> Flags -> String -> [String] -> Maybe UTCTime -> IO () +cxxLink errh flags toplevel names mcreation_time = do -- Construct the Bluesim object names let bsimLibDir = (bluespecDir flags) ++ "/Bluesim/" bsim_names = [ bsimLibDir ++ "lib" ++ name ++ ".a" @@ -1806,10 +1810,8 @@ cxxLink errh flags toplevel names creation_time = do unless (quiet flags) $ putStrLnF ("Simulation shared library created: " ++ soFile) -- Write a script to execute bluesim.tcl with the .so file argument let bluesim_cmd = "$BLUESPECDIR/tcllib/bluespec/bluesim.tcl" - (TimeInfo _ (TOD t _)) = creation_time - time_flags = if (timeStamps flags) - then [ "--creation_time", show t] - else [] + time_flags = maybe [] (\t -> ["--creation_time", show t]) mcreation_time + writeFileCatch errh outFile $ unlines [ "#!/bin/sh" , "" diff --git a/src/comp/showrules.hs b/src/comp/showrules.hs index cccb3be13..2e9758bb1 100644 --- a/src/comp/showrules.hs +++ b/src/comp/showrules.hs @@ -39,7 +39,7 @@ import System.Environment(getArgs) import System.Console.GetOpt import System.IO import System.IO.Unsafe(unsafePerformIO) -import System.Time +import System.Time() import Control.Monad(when, msum, foldM) import Control.Exception(bracket) import Data.List( partition, intercalate, genericLength @@ -528,8 +528,7 @@ setupProgress :: Bool -> Handle -> ConvState -> IO ConvState setupProgress False hIn st = return st setupProgress True hIn st = do -- record the start time - (TOD s ps) <- getClockTime - let now = (fromInteger s) + (fromInteger ps / (10.0^(12 :: Int))) + now <- (floor . nominalDiffTimeToSeconds . utcTimeToPOSIXSeconds) <$> getCurrentTime -- record the total input file size file_sz <- hFileSize hIn @@ -780,8 +779,8 @@ doProgress st bytes = Just tgt -> new_bytes >= tgt Nothing -> False in if (show_it) - then do (TOD s ps) <- getClockTime - let now = (fromInteger s) + (fromInteger ps / (10.0^(12 :: Int))) + then do now <- (floor . nominalDiffTimeToSeconds . utcTimeToPOSIXSeconds) <$> getCurrentTime + let bytes_per_sec = (fromInteger (new_bytes - (prev_bytes st))) / (now - (prev_time st)) percentage = ((100 * new_bytes) + ((total_bytes st) `div` 4)) `div` (total_bytes st) next_progress = ((percentage + 1) * (total_bytes st)) `div` 100 diff --git a/util/vagrant/provision.sh b/util/vagrant/provision.sh index 55f0f41c6..806677496 100755 --- a/util/vagrant/provision.sh +++ b/util/vagrant/provision.sh @@ -12,7 +12,6 @@ apt-get install -y \ git \ gperf \ iverilog \ - libghc-old-time-dev \ libghc-regex-compat-dev \ libghc-syb-dev \ libghc-split-dev \