ghc/compiler/nativeGen/MachDesc.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1995
   3 %
   4
   5 Machine- and flag- specific bits that the abstract code generator has to know about.
   6
   7 No doubt there will be more...
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module MachDesc (
  13         Target(..){-(..) for target_STRICT only-}, mkTarget, RegLoc(..),
  14
  15         saveLoc,
  16
  17 --      targetSwitches, UNUSED FOR NOW
  18         fixedHeaderSize, varHeaderSize, stgReg,
  19 --      nativeOpt, UNUSED FOR NOW
  20         sizeof, volatileSaves, volatileRestores, hpRel,
  21         amodeToStix, amodeToStix', charLikeClosureSize,
  22         intLikeClosureSize, mutHS, dataHS, primToStix, macroCode,
  23         heapCheck,
  24 --      codeGen, underscore, fmtAsmLbl, UNUSED FOR NOW (done a diff way)
  25
  26         -- and, for self-sufficiency...
  27         AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId,
  28         RegRelative, CSeq, BasicLit, CLabel, GlobalSwitch,
  29         SwitchResult, HeapOffset, PrimOp, PprStyle,
  30         PrimKind, SMRep, StixTree, Unique, SplitUniqSupply,
  31         StixTreeList(..), SUniqSM(..), Unpretty(..)
  32     ) where
  33
  34 import AbsCSyn
  35 import CmdLineOpts  ( GlobalSwitch(..), stringSwitchSet, switchIsOn, SwitchResult(..) )
  36 import Outputable
  37 import OrdList      ( OrdList )
  38 import PrimKind     ( PrimKind )
  39 import SMRep        ( SMRep )
  40 import Stix
  41 import SplitUniq
  42 import Unique
  43 import Unpretty     ( PprStyle, CSeq )
  44 import Util
  45
  46 data RegLoc = Save (StixTree) | Always (StixTree)
  47
  48 \end{code}
  49
  50 Think of this as a big runtime class dictionary
  51
  52 \begin{code}
  53
  54 data Target = Target
  55 --  (GlobalSwitch -> SwitchResult)      -- switches
  56     Int                                 -- fixedHeaderSize
  57     (SMRep -> Int)                      -- varHeaderSize
  58     (MagicId -> RegLoc)                 -- stgReg
  59 --  (StixTree -> StixTree)              -- nativeOpt
  60     (PrimKind -> Int)                   -- sizeof
  61     (HeapOffset -> Int)                 -- hpRel
  62     (CAddrMode -> StixTree)             -- amodeToStix
  63     (CAddrMode -> StixTree)             -- amodeToStix'
  64     (
  65     ([MagicId] -> [StixTree]),          -- volatileSaves
  66     ([MagicId] -> [StixTree]),          -- volatileRestores
  67     Int,                                -- charLikeClosureSize
  68     Int,                                -- intLikeClosureSize
  69     StixTree,                           -- mutHS
  70     StixTree,                           -- dataHS
  71     ([CAddrMode] -> PrimOp -> [CAddrMode] -> SUniqSM StixTreeList),
  72                                         -- primToStix
  73     (CStmtMacro -> [CAddrMode] -> SUniqSM StixTreeList),
  74                                         -- macroCode
  75     (StixTree -> StixTree -> StixTree -> SUniqSM StixTreeList)
  76                                         -- heapCheck
  77     )
  78 {- UNUSED: done a diff way:
  79     (PprStyle -> [[StixTree]] -> SUniqSM Unpretty)
  80                                         -- codeGen
  81
  82     Bool                                -- underscore
  83     (String -> String)                  -- fmtAsmLbl
  84 -}
  85
  86 mkTarget = Target
  87
  88 {- UNUSED FOR NOW:
  89 targetSwitches (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = {-sw-} x
  90 -}
  91 fixedHeaderSize (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = fhs
  92 varHeaderSize (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = vhs x
  93 stgReg (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = reg x
  94 {- UNUSED FOR NOW:
  95 nativeOpt (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = {-opt-} x
  96 -}
  97 sizeof (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = size x
  98 -- used only for wrapper-hungry PrimOps:
  99 hpRel (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = hprel x
 100 amodeToStix (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = am x
 101 amodeToStix' (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' ~(vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = am' x
 102
 103 volatileSaves (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = vsave x
 104 -- used only for wrapper-hungry PrimOps:
 105 volatileRestores (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = vrest x
 106 charLikeClosureSize (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = csz
 107 intLikeClosureSize (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = isz
 108 mutHS (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = mhs
 109 dataHS (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = dhs
 110 primToStix (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x y z = ps x y z
 111 macroCode (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x y = mc x y
 112 heapCheck (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x y z = hc x y z
 113 {- UNUSED: done a diff way:
 114 codeGen (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x y = cg x y
 115 underscore (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) = us
 116 fmtAsmLbl (Target {-sw-} fhs vhs reg {-opt-} size hprel am am' (vsave, vrest, csz, isz, mhs, dhs, ps, mc, hc) {-cg us fmt-}) x = fmt x
 117 -}
 118 \end{code}
 119
 120 Trees for register save locations
 121
 122 \begin{code}
 123
 124 saveLoc :: Target -> MagicId -> StixTree
 125 saveLoc target reg = case stgReg target reg of {Always loc -> loc; Save loc -> loc}
 126
 127 \end{code}
 128