Commit 821bece9 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot

Minor refactoring in deriveConstants

Mainly we now generate this

    data PlatformConstants = PlatformConstants {
          pc_CONTROL_GROUP_CONST_291 :: Int,
          pc_STD_HDR_SIZE :: Int,
          pc_PROF_HDR_SIZE :: Int,
          pc_BLOCK_SIZE :: Int,
      }

instead of

    data PlatformConstants = PlatformConstants {
        pc_platformConstants :: ()
        , pc_CONTROL_GROUP_CONST_291 :: Int
        , pc_STD_HDR_SIZE :: Int
        , pc_PROF_HDR_SIZE :: Int
        , pc_BLOCK_SIZE :: Int
        ...
      }

The first field has no use and according to (removed) comments it was to
make code generator's work easier.. if anything this version is simpler
because it has less repetition (the commas in strings are gone).
parent b55ee979
Pipeline #9945 passed with stages
in 674 minutes and 47 seconds
...@@ -28,10 +28,10 @@ needing to run the program, by inspecting the object file using 'nm'. ...@@ -28,10 +28,10 @@ needing to run the program, by inspecting the object file using 'nm'.
import Control.Monad (when, unless) import Control.Monad (when, unless)
import Data.Bits (shiftL) import Data.Bits (shiftL)
import Data.Char (toLower) import Data.Char (toLower)
import Data.List (stripPrefix) import Data.List (stripPrefix, intercalate)
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes, mapMaybe, fromMaybe)
import Numeric (readHex) import Numeric (readHex)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.Exit (ExitCode(ExitSuccess), exitFailure) import System.Exit (ExitCode(ExitSuccess), exitFailure)
...@@ -697,7 +697,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram ...@@ -697,7 +697,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
let ls = lines xs let ls = lines xs
m = Map.fromList $ case os of m = Map.fromList $ case os of
"aix" -> parseAixObjdump ls "aix" -> parseAixObjdump ls
_ -> catMaybes $ map parseNmLine ls _ -> mapMaybe parseNmLine ls
case Map.lookup "CONTROL_GROUP_CONST_291" m of case Map.lookup "CONTROL_GROUP_CONST_291" m of
Just 292 -> return () -- OK Just 292 -> return () -- OK
...@@ -709,8 +709,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram ...@@ -709,8 +709,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
++ "to 'configure'.\n" ++ "to 'configure'.\n"
Just x -> die ("unexpected value round-tripped for CONTROL_GROUP_CONST_291: " ++ show x) Just x -> die ("unexpected value round-tripped for CONTROL_GROUP_CONST_291: " ++ show x)
rs <- mapM (lookupResult m) (wanteds os) mapM (lookupResult m) (wanteds os)
return rs
where headers = ["#define IN_STG_CODE 0", where headers = ["#define IN_STG_CODE 0",
"", "",
"/*", "/*",
...@@ -739,7 +738,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram ...@@ -739,7 +738,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
"#pragma GCC poison sizeof" "#pragma GCC poison sizeof"
] ]
objdumpProgam = maybe (error "no objdump program given") id mobjdumpProgram objdumpProgam = fromMaybe (error "no objdump program given") mobjdumpProgram
prefix = "derivedConstant" prefix = "derivedConstant"
mkFullName name = prefix ++ name mkFullName name = prefix ++ name
...@@ -874,20 +873,17 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram ...@@ -874,20 +873,17 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
writeHaskellType :: FilePath -> [What Fst] -> IO () writeHaskellType :: FilePath -> [What Fst] -> IO ()
writeHaskellType fn ws = writeFile fn xs writeHaskellType fn ws = writeFile fn xs
where xs = unlines (headers ++ body ++ footers) where xs = unlines [header, body, footer]
headers = ["data PlatformConstants = PlatformConstants {" header = "data PlatformConstants = PlatformConstants {"
-- Now a kludge that allows the real entries to footer = " } deriving Read"
-- all start with a comma, which makes life a body = intercalate ",\n" (concatMap doWhat ws)
-- little easier
," pc_platformConstants :: ()"] doWhat (GetClosureSize name _) = [" pc_" ++ name ++ " :: Int"]
footers = [" } deriving Read"] doWhat (GetFieldType name _) = [" pc_" ++ name ++ " :: Int"]
body = concatMap doWhat ws doWhat (GetWord name _) = [" pc_" ++ name ++ " :: Int"]
doWhat (GetClosureSize name _) = [" , pc_" ++ name ++ " :: Int"] doWhat (GetInt name _) = [" pc_" ++ name ++ " :: Int"]
doWhat (GetFieldType name _) = [" , pc_" ++ name ++ " :: Int"] doWhat (GetNatural name _) = [" pc_" ++ name ++ " :: Integer"]
doWhat (GetWord name _) = [" , pc_" ++ name ++ " :: Int"] doWhat (GetBool name _) = [" pc_" ++ name ++ " :: Bool"]
doWhat (GetInt name _) = [" , pc_" ++ name ++ " :: Int"]
doWhat (GetNatural name _) = [" , pc_" ++ name ++ " :: Integer"]
doWhat (GetBool name _) = [" , pc_" ++ name ++ " :: Bool"]
doWhat (StructFieldMacro {}) = [] doWhat (StructFieldMacro {}) = []
doWhat (ClosureFieldMacro {}) = [] doWhat (ClosureFieldMacro {}) = []
doWhat (ClosurePayloadMacro {}) = [] doWhat (ClosurePayloadMacro {}) = []
...@@ -895,17 +891,16 @@ writeHaskellType fn ws = writeFile fn xs ...@@ -895,17 +891,16 @@ writeHaskellType fn ws = writeFile fn xs
writeHaskellValue :: FilePath -> [What Snd] -> IO () writeHaskellValue :: FilePath -> [What Snd] -> IO ()
writeHaskellValue fn rs = writeFile fn xs writeHaskellValue fn rs = writeFile fn xs
where xs = unlines (headers ++ body ++ footers) where xs = unlines [header, body, footer]
headers = ["PlatformConstants {" header = "PlatformConstants {"
," pc_platformConstants = ()"] footer = " }"
footers = [" }"] body = intercalate ",\n" (concatMap doWhat rs)
body = concatMap doWhat rs doWhat (GetClosureSize name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v]
doWhat (GetClosureSize name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] doWhat (GetFieldType name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v]
doWhat (GetFieldType name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] doWhat (GetWord name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v]
doWhat (GetWord name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] doWhat (GetInt name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v]
doWhat (GetInt name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] doWhat (GetNatural name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v]
doWhat (GetNatural name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] doWhat (GetBool name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v]
doWhat (GetBool name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v]
doWhat (StructFieldMacro {}) = [] doWhat (StructFieldMacro {}) = []
doWhat (ClosureFieldMacro {}) = [] doWhat (ClosureFieldMacro {}) = []
doWhat (ClosurePayloadMacro {}) = [] doWhat (ClosurePayloadMacro {}) = []
...@@ -949,21 +944,21 @@ writeHeader :: FilePath -> [What Snd] -> IO () ...@@ -949,21 +944,21 @@ writeHeader :: FilePath -> [What Snd] -> IO ()
writeHeader fn rs = writeFile fn xs writeHeader fn rs = writeFile fn xs
where xs = unlines (headers ++ body) where xs = unlines (headers ++ body)
headers = ["/* This file is created automatically. Do not edit by hand.*/", ""] headers = ["/* This file is created automatically. Do not edit by hand.*/", ""]
body = concatMap doWhat rs body = map doWhat rs
doWhat (GetFieldType name (Snd v)) = ["#define " ++ name ++ " b" ++ show (v * 8)] doWhat (GetFieldType name (Snd v)) = "#define " ++ name ++ " b" ++ show (v * 8)
doWhat (GetClosureSize name (Snd v)) = ["#define " ++ name ++ " (SIZEOF_StgHeader+" ++ show v ++ ")"] doWhat (GetClosureSize name (Snd v)) = "#define " ++ name ++ " (SIZEOF_StgHeader+" ++ show v ++ ")"
doWhat (GetWord name (Snd v)) = ["#define " ++ name ++ " " ++ show v] doWhat (GetWord name (Snd v)) = "#define " ++ name ++ " " ++ show v
doWhat (GetInt name (Snd v)) = ["#define " ++ name ++ " " ++ show v] doWhat (GetInt name (Snd v)) = "#define " ++ name ++ " " ++ show v
doWhat (GetNatural name (Snd v)) = ["#define " ++ name ++ " " ++ show v] doWhat (GetNatural name (Snd v)) = "#define " ++ name ++ " " ++ show v
doWhat (GetBool name (Snd v)) = ["#define " ++ name ++ " " ++ show (fromEnum v)] doWhat (GetBool name (Snd v)) = "#define " ++ name ++ " " ++ show (fromEnum v)
doWhat (StructFieldMacro nameBase) = doWhat (StructFieldMacro nameBase) =
["#define " ++ nameBase ++ "(__ptr__) REP_" ++ nameBase ++ "[__ptr__+OFFSET_" ++ nameBase ++ "]"] "#define " ++ nameBase ++ "(__ptr__) REP_" ++ nameBase ++ "[__ptr__+OFFSET_" ++ nameBase ++ "]"
doWhat (ClosureFieldMacro nameBase) = doWhat (ClosureFieldMacro nameBase) =
["#define " ++ nameBase ++ "(__ptr__) REP_" ++ nameBase ++ "[__ptr__+SIZEOF_StgHeader+OFFSET_" ++ nameBase ++ "]"] "#define " ++ nameBase ++ "(__ptr__) REP_" ++ nameBase ++ "[__ptr__+SIZEOF_StgHeader+OFFSET_" ++ nameBase ++ "]"
doWhat (ClosurePayloadMacro nameBase) = doWhat (ClosurePayloadMacro nameBase) =
["#define " ++ nameBase ++ "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" ++ nameBase ++ " + WDS(__ix__)]"] "#define " ++ nameBase ++ "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" ++ nameBase ++ " + WDS(__ix__)]"
doWhat (FieldTypeGcptrMacro nameBase) = doWhat (FieldTypeGcptrMacro nameBase) =
["#define REP_" ++ nameBase ++ " gcptr"] "#define REP_" ++ nameBase ++ " gcptr"
die :: String -> IO a die :: String -> IO a
die err = do hPutStrLn stderr err die err = do hPutStrLn stderr err
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment