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
16 import PrelInfo ( PrimOp(..)
17 IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
18 IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
20 import AsmRegAlloc ( Reg, MachineCode(..), MachineRegisters(..),
21 RegUsage(..), RegLiveness(..), FutureLive(..)
23 import CLabel ( CLabel )
24 import CmdLineOpts ( GlobalSwitch(..), stringSwitchSet,
25 switchIsOn, SwitchResult(..)
27 import HeapOffs ( hpRelToInt )
29 import Maybes ( Maybe(..) )
32 import PrimRep ( PrimRep(..) )
33 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
35 import AlphaGen ( alphaCodeGen )
44 Header sizes depend only on command-line options, not on the target
45 architecture. (I think.)
49 fhs :: (GlobalSwitch -> SwitchResult) -> Int
51 fhs switches = 1 + profFHS + ageFHS
53 profFHS = if switchIsOn switches SccProfilingOn then 1 else 0
54 ageFHS = if switchIsOn switches SccProfilingOn then 1 else 0
56 vhs :: (GlobalSwitch -> SwitchResult) -> SMRep -> Int
58 vhs switches sm = case sm of
60 SpecialisedRep _ _ _ _ -> 0
63 MuTupleRep _ -> 2 {- (1 + GC_MUT_RESERVED_WORDS) -}
67 PhantomRep -> panic "vhs:phantom"
71 Here we map STG registers onto appropriate Stix Trees. First, we
72 handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
73 The rest are either in real machine registers or stored as offsets
78 alphaReg :: (GlobalSwitch -> SwitchResult) -> MagicId -> RegLoc
82 Just reg -> Save nonReg
83 Nothing -> Always nonReg
84 where nonReg = case x of
85 StkStubReg -> sStLitLbl SLIT("STK_STUB_closure")
86 StdUpdRetVecReg -> sStLitLbl SLIT("vtbl_StdUpdFrame")
87 BaseReg -> sStLitLbl SLIT("MainRegTable")
88 Hp -> StInd PtrRep (sStLitLbl SLIT("StorageMgrInfo"))
89 HpLim -> StInd PtrRep (sStLitLbl SLIT("StorageMgrInfo+8"))
90 TagReg -> StInd IntRep (StPrim IntSubOp [infoptr, StInt (1*8)])
92 r2 = VanillaReg PtrRep ILIT(2)
93 infoptr = case alphaReg switches r2 of
95 Save _ -> StReg (StixMagicId r2)
96 _ -> StInd (kindFromMagicId x)
97 (StPrim IntAddOp [baseLoc, StInt (toInteger (offset*8))])
98 baseLoc = case stgRegMap BaseReg of
99 Just _ -> StReg (StixMagicId BaseReg)
100 Nothing -> sStLitLbl SLIT("MainRegTable")
101 offset = baseRegOffset x
109 size pk = case kindToSize pk of
110 {B -> 1; BU -> 1; W -> 2; WU -> 2; L -> 4; FF -> 4; SF -> 4; _ -> 8}
114 Now the volatile saves and restores. We add the basic guys to the list of ``user''
115 registers provided. Note that there are more basic registers on the restore list,
116 because some are reloaded from constants.
120 vsaves switches vols =
121 map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg{-,ActivityReg-}] ++ vols))
123 save x = StAssign (kindFromMagicId x) loc reg
124 where reg = StReg (StixMagicId x)
125 loc = case alphaReg switches x of
127 Always loc -> panic "vsaves"
129 vrests switches vols =
130 map restore ((filter callerSaves)
131 ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,{-ActivityReg,-}StkStubReg,StdUpdRetVecReg] ++ vols))
133 restore x = StAssign (kindFromMagicId x) reg loc
134 where reg = StReg (StixMagicId x)
135 loc = case alphaReg switches x of
137 Always loc -> panic "vrests"
141 Static closure sizes.
145 charLikeSize, intLikeSize :: Target -> Int
147 charLikeSize target =
148 size PtrRep * (fixedHeaderSize target + varHeaderSize target charLikeRep + 1)
149 where charLikeRep = SpecialisedRep CharLikeRep 0 1 SMNormalForm
152 size PtrRep * (fixedHeaderSize target + varHeaderSize target intLikeRep + 1)
153 where intLikeRep = SpecialisedRep IntLikeRep 0 1 SMNormalForm
155 mhs, dhs :: (GlobalSwitch -> SwitchResult) -> StixTree
157 mhs switches = StInt (toInteger words)
159 words = fhs switches + vhs switches (MuTupleRep 0)
161 dhs switches = StInt (toInteger words)
163 words = fhs switches + vhs switches (DataRep 0)
167 Setting up a alpha target.
171 mkAlpha :: (GlobalSwitch -> SwitchResult)
173 (PprStyle -> [[StixTree]] -> UniqSM Unpretty), -- codeGen
175 (String -> String)) -- fmtAsmLbl
181 alphaReg' = alphaReg switches
182 vsaves' = vsaves switches
183 vrests' = vrests switches
184 hprel = hpRelToInt target
185 as = amodeCode target
186 as' = amodeCode' target
187 csz = charLikeSize target
188 isz = intLikeSize target
191 ps = genPrimCode target
192 mc = genMacroCode target
194 target = mkTarget {-switches-} fhs' vhs' alphaReg' {-id-} size
196 (vsaves', vrests', csz, isz, mhs', dhs', ps, mc, hc)
197 {-alphaCodeGen False mungeLabel-}
199 (target, alphaCodeGen, False, mungeLabel)
202 The alpha assembler likes temporary labels to look like \tr{$L123}
203 instead of \tr{L123}. (Don't toss the \tr{L}, because then \tr{Lf28}
204 turns into \tr{$f28}.)
206 mungeLabel :: String -> String
207 mungeLabel xs = '$' : xs