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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-- This is the module to import to be able to build C-- programs.
-- It should not be necessary to import MkZipCfg or ZipCfgCmmRep.
-- If you find it necessary to import these other modules, please
-- complain to Norman Ramsey.
module MkZipCfgCmm
( mkNop, mkAssign, mkStore, mkCall, mkCmmCall, mkUnsafeCall, mkFinalCall
, mkJump, mkCbranch, mkSwitch, mkReturn, mkComment
, mkCmmIfThenElse, mkCmmIfThen, mkCmmWhileDo
, mkAddToContext
, (<*>), catAGraphs, mkLabel, mkBranch
, emptyAGraph, withFreshLabel, withUnique, outOfLine
, lgraphOfAGraph, graphOfAGraph, labelAGraph
, CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..)
)
where
#include "HsVersions.h"
import CmmExpr
import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
, CmmCallTarget(..), CmmActuals, CmmFormals
)
import ZipCfgCmmRep hiding (CmmGraph, CmmAGraph, CmmBlock, CmmZ, CmmTopZ)
-- ^ to make this module more self-contained, these definitions are duplicated below
import PprCmm()
import ClosureInfo
import FastString
import ForeignCall
import ZipCfg
import MkZipCfg
type CmmGraph = LGraph Middle Last
type CmmAGraph = AGraph Middle Last
type CmmBlock = Block Middle Last
type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
---------- No-ops
mkNop :: CmmAGraph
mkComment :: FastString -> CmmAGraph
---------- Assignment and store
mkAssign :: CmmReg -> CmmExpr -> CmmAGraph
mkStore :: CmmExpr -> CmmExpr -> CmmAGraph
---------- Calls
mkCall :: CmmExpr -> CCallConv -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
mkCmmCall :: CmmExpr -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
-- Native C-- calling convention
mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
-- Never returns; like exit() or barf()
---------- Context manipulation ('return via')
mkAddToContext :: CmmExpr -> [CmmExpr] -> CmmAGraph
---------- Control transfer
mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
mkReturn :: CmmActuals -> CmmAGraph
mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
mkCmmIfThen :: CmmExpr -> CmmAGraph -> CmmAGraph
mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph
-- Not to be forgotten, but exported by MkZipCfg:
-- mkBranch :: BlockId -> CmmAGraph
-- mkLabel :: BlockId -> CmmAGraph
-- outOfLine :: CmmAGraph -> CmmAGraph
-- withUnique :: (Unique -> CmmAGraph) -> CmmAGraph
-- withFreshLabel :: String -> (BlockId -> CmmAGraph) -> CmmAGraph
--------------------------------------------------------------------------
mkCmmWhileDo e = mkWhileDo (mkCbranch e)
mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
mkCmmIfThen e tbranch
= withFreshLabel "end of if" $ \endif ->
withFreshLabel "start of then" $ \tid ->
mkCbranch e tid endif <*>
mkLabel tid <*> tbranch <*> mkBranch endif <*>
mkLabel endif
-- ================ IMPLEMENTATION ================--
mkNop = emptyAGraph
mkComment fs = mkMiddle $ MidComment fs
mkAssign l r = mkMiddle $ MidAssign l r
mkStore l r = mkMiddle $ MidStore l r
mkCbranch pred ifso ifnot = mkLast $ LastCondBranch pred ifso ifnot
mkSwitch e tbl = mkLast $ LastSwitch e tbl
mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
mkAddToContext ra actuals = mkMiddle $ MidAddToContext ra actuals
cmmArgConv, cmmResConv :: Convention
cmmArgConv = ConventionStandard CmmCallConv Arguments
cmmResConv = ConventionStandard CmmCallConv Arguments
mkJump e actuals = mkMiddle (CopyOut cmmArgConv actuals) <*> mkLast (LastJump e)
mkReturn actuals = mkMiddle (CopyOut cmmResConv actuals) <*> mkLast LastReturn
mkFinalCall f conv actuals =
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
mkLast (LastCall f Nothing)
mkCmmCall f results actuals srt = mkCall f CmmCallConv results actuals srt
mkCall f conv results actuals srt =
withFreshLabel "call successor" $ \k ->
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
mkLast (LastCall f (Just k)) <*>
mkLabel k <*>
mkMiddle (CopyIn (ConventionStandard conv Results) results srt)
|
