2 % (c) The AQUA Project, Glasgow University, 1994-1995
4 \section[AlphaDesc]{The Alpha Machine Description}
7 #include "HsVersions.h"
12 -- and assorted nonsense referenced by the class methods
14 PprStyle, SMRep, MagicId, RegLoc, StixTree, PrimKind, SwitchResult
19 import AbsPrel ( PrimOp(..)
20 IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
21 IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
23 import AsmRegAlloc ( Reg, MachineCode(..), MachineRegisters(..),
24 RegUsage(..), RegLiveness(..), FutureLive(..)
26 import CLabelInfo ( CLabel )
27 import CmdLineOpts ( GlobalSwitch(..), stringSwitchSet,
28 switchIsOn, SwitchResult(..)
30 import HeapOffs ( hpRelToInt )
32 import Maybes ( Maybe(..) )
35 import PrimKind ( PrimKind(..) )
36 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
38 import AlphaGen ( alphaCodeGen )
48 Header sizes depend only on command-line options, not on the target
49 architecture. (I think.)
53 fhs :: (GlobalSwitch -> SwitchResult) -> Int
55 fhs switches = 1 + profFHS + ageFHS
57 profFHS = if switchIsOn switches SccProfilingOn then 1 else 0
58 ageFHS = if switchIsOn switches SccProfilingOn then 1 else 0
60 vhs :: (GlobalSwitch -> SwitchResult) -> SMRep -> Int
62 vhs switches sm = case sm of
64 SpecialisedRep _ _ _ _ -> 0
67 MuTupleRep _ -> 2 {- (1 + GC_MUT_RESERVED_WORDS) -}
71 PhantomRep -> panic "vhs:phantom"
75 Here we map STG registers onto appropriate Stix Trees. First, we
76 handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
77 The rest are either in real machine registers or stored as offsets
82 alphaReg :: (GlobalSwitch -> SwitchResult) -> MagicId -> RegLoc
86 Just reg -> Save nonReg
87 Nothing -> Always nonReg
88 where nonReg = case x of
89 StkStubReg -> sStLitLbl SLIT("STK_STUB_closure")
90 StdUpdRetVecReg -> sStLitLbl SLIT("vtbl_StdUpdFrame")
91 BaseReg -> sStLitLbl SLIT("MainRegTable")
92 Hp -> StInd PtrKind (sStLitLbl SLIT("StorageMgrInfo"))
93 HpLim -> StInd PtrKind (sStLitLbl SLIT("StorageMgrInfo+8"))
94 TagReg -> StInd IntKind (StPrim IntSubOp [infoptr, StInt (1*8)])
96 r2 = VanillaReg PtrKind ILIT(2)
97 infoptr = case alphaReg switches r2 of
99 Save _ -> StReg (StixMagicId r2)
100 _ -> StInd (kindFromMagicId x)
101 (StPrim IntAddOp [baseLoc, StInt (toInteger (offset*8))])
102 baseLoc = case stgRegMap BaseReg of
103 Just _ -> StReg (StixMagicId BaseReg)
104 Nothing -> sStLitLbl SLIT("MainRegTable")
105 offset = baseRegOffset x
113 size pk = case kindToSize pk of
114 {B -> 1; BU -> 1; W -> 2; WU -> 2; L -> 4; FF -> 4; SF -> 4; _ -> 8}
118 Now the volatile saves and restores. We add the basic guys to the list of ``user''
119 registers provided. Note that there are more basic registers on the restore list,
120 because some are reloaded from constants.
124 vsaves switches vols =
125 map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg{-,ActivityReg-}] ++ vols))
127 save x = StAssign (kindFromMagicId x) loc reg
128 where reg = StReg (StixMagicId x)
129 loc = case alphaReg switches x of
131 Always loc -> panic "vsaves"
133 vrests switches vols =
134 map restore ((filter callerSaves)
135 ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,{-ActivityReg,-}StkStubReg,StdUpdRetVecReg] ++ vols))
137 restore x = StAssign (kindFromMagicId x) reg loc
138 where reg = StReg (StixMagicId x)
139 loc = case alphaReg switches x of
141 Always loc -> panic "vrests"
145 Static closure sizes.
149 charLikeSize, intLikeSize :: Target -> Int
151 charLikeSize target =
152 size PtrKind * (fixedHeaderSize target + varHeaderSize target charLikeRep + 1)
153 where charLikeRep = SpecialisedRep CharLikeRep 0 1 SMNormalForm
156 size PtrKind * (fixedHeaderSize target + varHeaderSize target intLikeRep + 1)
157 where intLikeRep = SpecialisedRep IntLikeRep 0 1 SMNormalForm
159 mhs, dhs :: (GlobalSwitch -> SwitchResult) -> StixTree
161 mhs switches = StInt (toInteger words)
163 words = fhs switches + vhs switches (MuTupleRep 0)
165 dhs switches = StInt (toInteger words)
167 words = fhs switches + vhs switches (DataRep 0)
171 Setting up a alpha target.
175 mkAlpha :: (GlobalSwitch -> SwitchResult)
177 (PprStyle -> [[StixTree]] -> SUniqSM Unpretty), -- codeGen
179 (String -> String)) -- fmtAsmLbl
185 alphaReg' = alphaReg switches
186 vsaves' = vsaves switches
187 vrests' = vrests switches
188 hprel = hpRelToInt target
189 as = amodeCode target
190 as' = amodeCode' target
191 csz = charLikeSize target
192 isz = intLikeSize target
195 ps = genPrimCode target
196 mc = genMacroCode target
197 hc = doHeapCheck --UNUSED NOW: target
198 target = mkTarget {-switches-} fhs' vhs' alphaReg' {-id-} size
200 (vsaves', vrests', csz, isz, mhs', dhs', ps, mc, hc)
201 {-alphaCodeGen False mungeLabel-}
203 (target, alphaCodeGen, False, mungeLabel)
206 The alpha assembler likes temporary labels to look like \tr{$L123}
207 instead of \tr{L123}. (Don't toss the \tr{L}, because then \tr{Lf28}
208 turns into \tr{$f28}.)
210 mungeLabel :: String -> String
211 mungeLabel xs = '$' : xs