module CgUtils (
addIdReps,
cgLit,
- emitDataLits, emitRODataLits, emitIf, emitIfThenElse,
+ emitDataLits, mkDataLits,
+ emitRODataLits, mkRODataLits,
+ emitIf, emitIfThenElse,
emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
assignNonPtrTemp, newNonPtrTemp,
assignPtrTemp, newPtrTemp,
mkWordCLit,
mkStringCLit, mkByteStringCLit,
packHalfWordsCLit,
- blankWord
+ blankWord,
+
+ getSRTInfo
) where
#include "HsVersions.h"
import CmmUtils
import MachOp
import ForeignCall
+import ClosureInfo
+import StgSyn (SRT(..))
import Literal
import Digraph
import ListSetOps
-> Maybe [GlobalReg]
-> Code
emitRtsCall' res fun args vols = do
+ srt <- getSRTInfo
stmtsC caller_save
- stmtC (CmmCall target res args)
+ stmtC (CmmCall target res args srt)
stmtsC caller_load
where
(caller_save, caller_load) = callerSaveVolatileRegs vols
emitDataLits lbl lits
= emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+-- Emit a data-segment data block
+mkDataLits lbl lits
+ = CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+
emitRODataLits :: CLabel -> [CmmLit] -> Code
-- Emit a read-only data block
emitRODataLits lbl lits
needsRelocation (CmmLabelOff _ _) = True
needsRelocation _ = False
+mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkRODataLits lbl lits
+ = CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
+ where section | any needsRelocation lits = RelocatableReadOnlyData
+ | otherwise = ReadOnlyData
+ needsRelocation (CmmLabel _) = True
+ needsRelocation (CmmLabelOff _ _) = True
+ needsRelocation _ = False
+
mkStringCLit :: String -> FCode CmmLit
-- Make a global definition for the string,
-- and return its label
possiblySameLoc l1 rep1 (CmmLit _) rep2 = False
possiblySameLoc l1 rep1 l2 rep2 = True -- Conservative
+
+-------------------------------------------------------------------------
+--
+-- Static Reference Tables
+--
+-------------------------------------------------------------------------
+
+-- There is just one SRT for each top level binding; all the nested
+-- bindings use sub-sections of this SRT. The label is passed down to
+-- the nested bindings via the monad.
+
+getSRTInfo :: FCode C_SRT
+getSRTInfo = do
+ srt_lbl <- getSRTLabel
+ srt <- getSRT
+ case srt of
+ -- TODO: Should we panic in this case?
+ -- Someone obviously thinks there should be an SRT
+ NoSRT -> return NoC_SRT
+ SRT off len bmp
+ | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
+ -> do id <- newUnique
+ let srt_desc_lbl = mkLargeSRTLabel id
+ emitRODataLits srt_desc_lbl
+ ( cmmLabelOffW srt_lbl off
+ : mkWordCLit (fromIntegral len)
+ : map mkWordCLit bmp)
+ return (C_SRT srt_desc_lbl 0 srt_escape)
+
+ SRT off len bmp
+ | otherwise
+ -> return (C_SRT srt_lbl off (fromIntegral (head bmp)))
+ -- The fromIntegral converts to StgHalfWord
+
+srt_escape = (-1) :: StgHalfWord