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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
%
% (c) The AQUA Project, Glasgow University, 1994-1995
%
\section[AlphaDesc]{The Alpha Machine Description}
\begin{code}
#include "HsVersions.h"
module AlphaDesc (
mkAlpha
-- and assorted nonsense referenced by the class methods
) where
import AbsCSyn
import PrelInfo ( PrimOp(..)
IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
)
import AsmRegAlloc ( Reg, MachineCode(..), MachineRegisters(..),
RegUsage(..), RegLiveness(..), FutureLive(..)
)
import CLabel ( CLabel )
import CmdLineOpts ( GlobalSwitch(..), stringSwitchSet,
switchIsOn, SwitchResult(..)
)
import HeapOffs ( hpRelToInt )
import MachDesc
import Maybes ( Maybe(..) )
import OrdList
import Outputable
import PrimRep ( PrimRep(..) )
import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
import AlphaCode
import AlphaGen ( alphaCodeGen )
import Stix
import StixMacro
import StixPrim
import UniqSupply
import Util
\end{code}
Header sizes depend only on command-line options, not on the target
architecture. (I think.)
\begin{code}
fhs :: (GlobalSwitch -> SwitchResult) -> Int
fhs switches = 1 + profFHS + ageFHS
where
profFHS = if switchIsOn switches SccProfilingOn then 1 else 0
ageFHS = if switchIsOn switches SccProfilingOn then 1 else 0
vhs :: (GlobalSwitch -> SwitchResult) -> SMRep -> Int
vhs switches sm = case sm of
StaticRep _ _ -> 0
SpecialisedRep _ _ _ _ -> 0
GenericRep _ _ _ -> 0
BigTupleRep _ -> 1
MuTupleRep _ -> 2 {- (1 + GC_MUT_RESERVED_WORDS) -}
DataRep _ -> 1
DynamicRep -> 2
BlackHoleRep -> 0
PhantomRep -> panic "vhs:phantom"
\end{code}
Here we map STG registers onto appropriate Stix Trees. First, we
handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
The rest are either in real machine registers or stored as offsets
from BaseReg.
\begin{code}
alphaReg :: (GlobalSwitch -> SwitchResult) -> MagicId -> RegLoc
alphaReg switches x =
case stgRegMap x of
Just reg -> Save nonReg
Nothing -> Always nonReg
where nonReg = case x of
StkStubReg -> sStLitLbl SLIT("STK_STUB_closure")
StdUpdRetVecReg -> sStLitLbl SLIT("vtbl_StdUpdFrame")
BaseReg -> sStLitLbl SLIT("MainRegTable")
Hp -> StInd PtrRep (sStLitLbl SLIT("StorageMgrInfo"))
HpLim -> StInd PtrRep (sStLitLbl SLIT("StorageMgrInfo+8"))
TagReg -> StInd IntRep (StPrim IntSubOp [infoptr, StInt (1*8)])
where
r2 = VanillaReg PtrRep ILIT(2)
infoptr = case alphaReg switches r2 of
Always tree -> tree
Save _ -> StReg (StixMagicId r2)
_ -> StInd (kindFromMagicId x)
(StPrim IntAddOp [baseLoc, StInt (toInteger (offset*8))])
baseLoc = case stgRegMap BaseReg of
Just _ -> StReg (StixMagicId BaseReg)
Nothing -> sStLitLbl SLIT("MainRegTable")
offset = baseRegOffset x
\end{code}
Sizes in bytes.
\begin{code}
size pk = case kindToSize pk of
{B -> 1; BU -> 1; W -> 2; WU -> 2; L -> 4; FF -> 4; SF -> 4; _ -> 8}
\end{code}
Now the volatile saves and restores. We add the basic guys to the list of ``user''
registers provided. Note that there are more basic registers on the restore list,
because some are reloaded from constants.
\begin{code}
vsaves switches vols =
map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg{-,ActivityReg-}] ++ vols))
where
save x = StAssign (kindFromMagicId x) loc reg
where reg = StReg (StixMagicId x)
loc = case alphaReg switches x of
Save loc -> loc
Always loc -> panic "vsaves"
vrests switches vols =
map restore ((filter callerSaves)
([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,{-ActivityReg,-}StkStubReg,StdUpdRetVecReg] ++ vols))
where
restore x = StAssign (kindFromMagicId x) reg loc
where reg = StReg (StixMagicId x)
loc = case alphaReg switches x of
Save loc -> loc
Always loc -> panic "vrests"
\end{code}
Static closure sizes.
\begin{code}
charLikeSize, intLikeSize :: Target -> Int
charLikeSize target =
size PtrRep * (fixedHeaderSize target + varHeaderSize target charLikeRep + 1)
where charLikeRep = SpecialisedRep CharLikeRep 0 1 SMNormalForm
intLikeSize target =
size PtrRep * (fixedHeaderSize target + varHeaderSize target intLikeRep + 1)
where intLikeRep = SpecialisedRep IntLikeRep 0 1 SMNormalForm
mhs, dhs :: (GlobalSwitch -> SwitchResult) -> StixTree
mhs switches = StInt (toInteger words)
where
words = fhs switches + vhs switches (MuTupleRep 0)
dhs switches = StInt (toInteger words)
where
words = fhs switches + vhs switches (DataRep 0)
\end{code}
Setting up a alpha target.
\begin{code}
mkAlpha :: (GlobalSwitch -> SwitchResult)
-> (Target,
(PprStyle -> [[StixTree]] -> UniqSM Unpretty), -- codeGen
Bool, -- underscore
(String -> String)) -- fmtAsmLbl
mkAlpha switches =
let
fhs' = fhs switches
vhs' = vhs switches
alphaReg' = alphaReg switches
vsaves' = vsaves switches
vrests' = vrests switches
hprel = hpRelToInt target
as = amodeCode target
as' = amodeCode' target
csz = charLikeSize target
isz = intLikeSize target
mhs' = mhs switches
dhs' = dhs switches
ps = genPrimCode target
mc = genMacroCode target
hc = doHeapCheck
target = mkTarget {-switches-} fhs' vhs' alphaReg' {-id-} size
hprel as as'
(vsaves', vrests', csz, isz, mhs', dhs', ps, mc, hc)
{-alphaCodeGen False mungeLabel-}
in
(target, alphaCodeGen, False, mungeLabel)
\end{code}
The alpha assembler likes temporary labels to look like \tr{$L123}
instead of \tr{L123}. (Don't toss the \tr{L}, because then \tr{Lf28}
turns into \tr{$f28}.)
\begin{code}
mungeLabel :: String -> String
mungeLabel xs = '$' : xs
\end{code}
|
