% (c) The AQUA Project, Glasgow University, 1993-1995
%
-Machine- and flag- specific bits that the abstract code generator has to know about.
+Machine- and flag- specific bits that the abstract code generator has
+to know about.
No doubt there will be more...
#include "HsVersions.h"
module MachDesc (
- Target, mkTarget, RegLoc(..),
+ Target(..){-(..) for target_STRICT only-}, mkTarget, RegLoc(..),
saveLoc,
- targetSwitches, fixedHeaderSize, varHeaderSize, stgReg,
- nativeOpt, sizeof, volatileSaves, volatileRestores, hpRel,
+ fixedHeaderSize, varHeaderSize, stgReg,
+ sizeof, volatileSaves, volatileRestores, hpRel,
amodeToStix, amodeToStix', charLikeClosureSize,
intLikeClosureSize, mutHS, dataHS, primToStix, macroCode,
- heapCheck, codeGen, underscore, fmtAsmLbl,
+ heapCheck
-- and, for self-sufficiency...
- AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId,
- RegRelative, CSeq, BasicLit, CLabel, GlobalSwitch,
- SwitchResult, HeapOffset, PrimOp, PprStyle,
- PrimKind, SMRep, StixTree, Unique, SplitUniqSupply,
- StixTreeList(..), SUniqSM(..), Unpretty(..)
) where
import AbsCSyn
import CmdLineOpts ( GlobalSwitch(..), stringSwitchSet, switchIsOn, SwitchResult(..) )
import Outputable
import OrdList ( OrdList )
-import PrimKind ( PrimKind )
import SMRep ( SMRep )
import Stix
-import SplitUniq
+import UniqSupply
import Unique
import Unpretty ( PprStyle, CSeq )
import Util
-data RegLoc = Save (StixTree) | Always (StixTree)
-
+data RegLoc = Save StixTree | Always StixTree
\end{code}
-Think of this as a big runtime class dictionary
-
+Think of this as a big runtime class dictionary:
\begin{code}
-
data Target = Target
- (GlobalSwitch -> SwitchResult) -- switches
Int -- fixedHeaderSize
(SMRep -> Int) -- varHeaderSize
(MagicId -> RegLoc) -- stgReg
- (StixTree -> StixTree) -- nativeOpt
- (PrimKind -> Int) -- sizeof
- ([MagicId] -> [StixTree]) -- volatileSaves
- ([MagicId] -> [StixTree]) -- volatileRestores
+ (PrimRep -> Int) -- sizeof
(HeapOffset -> Int) -- hpRel
(CAddrMode -> StixTree) -- amodeToStix
(CAddrMode -> StixTree) -- amodeToStix'
- Int -- charLikeClosureSize
- Int -- intLikeClosureSize
- StixTree -- mutHS
- StixTree -- dataHS
- ([CAddrMode] -> PrimOp -> [CAddrMode] -> SUniqSM StixTreeList)
+ (
+ ([MagicId] -> [StixTree]), -- volatileSaves
+ ([MagicId] -> [StixTree]), -- volatileRestores
+ Int, -- charLikeClosureSize
+ Int, -- intLikeClosureSize
+ StixTree, -- mutHS
+ StixTree, -- dataHS
+ ([CAddrMode] -> PrimOp -> [CAddrMode] -> UniqSM StixTreeList),
-- primToStix
- (CStmtMacro -> [CAddrMode] -> SUniqSM StixTreeList)
+ (CStmtMacro -> [CAddrMode] -> UniqSM StixTreeList),
-- macroCode
- (StixTree -> StixTree -> StixTree -> SUniqSM StixTreeList)
+ (StixTree -> StixTree -> StixTree -> UniqSM StixTreeList)
-- heapCheck
-
- (PprStyle -> [[StixTree]] -> SUniqSM Unpretty)
- -- codeGen
-
- Bool -- underscore
- (String -> String) -- fmtAsmLbl
+ )
mkTarget = Target
-targetSwitches (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = sw
-fixedHeaderSize (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = fhs
-varHeaderSize (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = vhs
-stgReg (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = reg
-nativeOpt (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = opt
-sizeof (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = size
-volatileSaves (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = vsave
-volatileRestores (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = vrest
-hpRel (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = hprel
-amodeToStix (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = am
-amodeToStix' (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = am'
-charLikeClosureSize (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = csz
-intLikeClosureSize (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = isz
-mutHS (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = mhs
-dataHS (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = dhs
-primToStix (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = ps
-macroCode (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = mc
-heapCheck (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = hc
-codeGen (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = cg
-underscore (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = us
-fmtAsmLbl (Target sw fhs vhs reg opt size vsave vrest hprel am am' csz isz mhs dhs ps mc hc cg us fmt) = fmt
+fixedHeaderSize (Target fhs vhs reg size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) = fhs
+varHeaderSize (Target fhs vhs reg size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x = vhs x
+stgReg (Target fhs vhs reg size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x = reg x
+sizeof (Target fhs vhs reg size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x = size x
+-- used only for wrapper-hungry PrimOps:
+hpRel (Target fhs vhs reg size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x = hprel x
+amodeToStix (Target fhs vhs reg size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x = am x
+amodeToStix' (Target fhs vhs reg size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x = am' x
+
+volatileSaves (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x = vsave x
+-- used only for wrapper-hungry PrimOps:
+volatileRestores (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x = vrest x
+charLikeClosureSize (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) = csz
+intLikeClosureSize (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) = isz
+mutHS (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) = mhs
+dataHS (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) = dhs
+primToStix (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x y z = ps x y z
+macroCode (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x y = mc x y
+heapCheck (Target fhs vhs reg size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) ) x y z = hc x y z
\end{code}
Trees for register save locations
-
\begin{code}
-
saveLoc :: Target -> MagicId -> StixTree
-saveLoc target reg = case stgReg target reg of {Always loc -> loc; Save loc -> loc}
+saveLoc target reg = case stgReg target reg of {Always loc -> loc; Save loc -> loc}
\end{code}
projects / ghc-hetmet.git / blobdiff