+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Code generator utilities; mostly monadic
) where
#include "HsVersions.h"
-#include "MachRegs.h"
+#include "../includes/MachRegs.h"
import CgMonad
import TyCon
import DynFlags
import FastString
import PackageConfig
-#ifdef DEBUG
import Outputable
-#endif
import Data.Char
import Data.Bits
--
-------------------------------------------------------------------------
-tagToClosure :: PackageId -> TyCon -> CmmExpr -> CmmExpr
-tagToClosure this_pkg tycon tag
+tagToClosure :: TyCon -> CmmExpr -> CmmExpr
+tagToClosure tycon tag
= CmmLoad (cmmOffsetExprW closure_tbl tag) wordRep
where closure_tbl = CmmLit (CmmLabel lbl)
- lbl = mkClosureTableLabel this_pkg (tyConName tycon)
+ lbl = mkClosureTableLabel (tyConName tycon)
-------------------------------------------------------------------------
--
; labelC join_id
}
-emitRtsCall :: LitString -> [(CmmExpr,MachHint)] -> Bool -> Code
+emitRtsCall :: LitString -> [CmmHinted CmmExpr] -> Bool -> Code
emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
-- The 'Nothing' says "save all global registers"
-emitRtsCallWithVols :: LitString -> [(CmmExpr,MachHint)] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols :: LitString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
emitRtsCallWithVols fun args vols safe
= emitRtsCall' [] fun args (Just vols) safe
emitRtsCallWithResult :: LocalReg -> MachHint -> LitString
- -> [(CmmExpr,MachHint)] -> Bool -> Code
+ -> [CmmHinted CmmExpr] -> Bool -> Code
emitRtsCallWithResult res hint fun args safe
- = emitRtsCall' [(res,hint)] fun args Nothing safe
+ = emitRtsCall' [CmmHinted res hint] fun args Nothing safe
-- Make a call to an RTS C procedure
emitRtsCall'
- :: CmmHintFormals
+ :: CmmFormals
-> LitString
- -> [(CmmExpr,MachHint)]
+ -> [CmmHinted CmmExpr]
-> Maybe [GlobalReg]
-> Bool -- True <=> CmmSafe call
-> Code
then getSRTInfo >>= (return . CmmSafe)
else return CmmUnsafe
stmtsC caller_save
- stmtC (CmmCall target res args safety)
+ stmtC (CmmCall target res args safety CmmMayReturn)
stmtsC caller_load
where
(caller_save, caller_load) = callerSaveVolatileRegs vols
- target = CmmForeignCall fun_expr CCallConv
+ target = CmmCallee fun_expr CCallConv
fun_expr = mkLblExpr (mkRtsCodeLabel fun)
-----------------------------------------------------------------------------
emitDataLits lbl lits
= emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
-mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
-- Emit a data-segment data block
mkDataLits lbl lits
= CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
needsRelocation (CmmLabelOff _ _) = True
needsRelocation _ = False
-mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
mkRODataLits lbl lits
= CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
where section | any needsRelocation lits = RelocatableReadOnlyData
; return (CmmReg (CmmLocal reg)) }
newNonPtrTemp :: MachRep -> FCode LocalReg
-newNonPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep KindNonPtr) }
+newNonPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep GCKindNonPtr) }
newPtrTemp :: MachRep -> FCode LocalReg
-newPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep KindPtr) }
+newPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep GCKindPtr) }
-------------------------------------------------------------------------
-- TODO: Should we panic in this case?
-- Someone obviously thinks there should be an SRT
NoSRT -> return NoC_SRT
+ SRTEntries {} -> panic "getSRTInfo: SRTEntries. Perhaps you forgot to run SimplStg?"
SRT off len bmp
| len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
-> do id <- newUnique