1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
module Main where
import DynFlags
import RepType
import SMRep
import GHC.StgToCmm.Layout
import GHC.StgToCmm.Closure
import GHC
import GhcMonad
import System.Environment
import GHC.Platform
main :: IO ()
main = do
[libdir] <- getArgs
runGhc (Just libdir) tests
-- How to read tests:
-- F(a,8) = field a at offset 8
-- P(4,8) = 4 bytes of padding at offset 8
tests :: Ghc ()
tests = do
(_, _, off) <- runTest [("a", FloatRep), ("b", DoubleRep)]
assert_32_64 (map fmt off)
["F(a,4)", "F(b,8)"]
["F(a,8)", "P(4,12)", "F(b,16)"]
(_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep)]
assert_32_64 (map fmt off)
["F(a,4)", "F(b,8)"]
["F(a,8)", "F(b,12)"]
(_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep), ("c", FloatRep)]
assert_32_64 (map fmt off)
["F(a,4)", "F(b,8)", "F(c,12)"]
["F(a,8)", "F(b,12)", "F(c,16)", "P(4,20)"]
(_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep), ("c", Int64Rep)]
assert_32_64 (map fmt off)
["F(a,4)", "F(b,8)", "F(c,12)"]
["F(a,8)", "F(b,12)", "F(c,16)"]
(_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", FloatRep)]
assert_32_64 (map fmt off)
["F(a,4)", "F(b,12)", "F(c,16)"]
["F(a,8)", "F(b,16)", "F(c,20)"]
(_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", Int64Rep)]
assert_32_64 (map fmt off)
["F(a,4)", "F(b,12)", "F(c,16)"]
["F(a,8)", "F(b,16)", "P(4,20)", "F(c,24)"]
assert_32_64 :: (Eq a, Show a) => a -> a -> a -> Ghc ()
assert_32_64 actual expected32 expected64 = do
dflags <- getDynFlags
let
expected
| word_size == 4 = expected32
| word_size == 8 = expected64
word_size = wORD_SIZE dflags
case actual == expected of
True -> return ()
False ->
error $ "Expected:\n" ++ show expected
++ "\nBut got:\n" ++ show actual
runTest :: [(a, PrimRep)] -> Ghc (WordOff , WordOff, [FieldOffOrPadding a])
runTest prim_reps = do
dflags <- getDynFlags
return $ mkVirtHeapOffsetsWithPadding dflags StdHeader (mkNonVoids prim_reps)
where
mkNonVoids = map (\(a, prim_rep) -> NonVoid (prim_rep, a))
fmt :: FieldOffOrPadding String -> String
fmt (FieldOff (NonVoid id) off) = "F(" ++ id ++ "," ++ show off ++ ")"
fmt (Padding len off) = "P(" ++ show len ++ "," ++ show off ++ ")"
|
