CgInfoTbls.hs 14.9 KB
Newer Older
1 2 3 4
-----------------------------------------------------------------------------
--
-- Building info tables.
--
Simon Marlow's avatar
Simon Marlow committed
5
-- (c) The University of Glasgow 2004-2006
6 7 8 9 10 11 12 13
--
-----------------------------------------------------------------------------

module CgInfoTbls (
	emitClosureCodeAndInfoTable,
	emitInfoTableAndCode,
	dataConTagZ,
	getSRTInfo,
Simon Marlow's avatar
Simon Marlow committed
14 15
	emitReturnTarget, emitAlgReturnTarget,
	emitReturnInstr,
16 17
	mkRetInfoTable,
	mkStdInfoTable,
18
	stdInfoTableSizeB,
19 20 21
	mkFunGenInfoExtraBits,
	entryCode, closureInfoPtr,
	getConstrTag,
Simon Marlow's avatar
Simon Marlow committed
22
	infoTable, infoTableClosureType,
23
	infoTablePtrs, infoTableNonPtrs,
24
	funInfoTable, makeRelativeRefTo
25 26 27 28 29
  ) where


#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
30 31 32 33 34
import ClosureInfo
import SMRep
import CgBindery
import CgCallConv
import CgUtils
35 36
import CgMonad

Simon Marlow's avatar
Simon Marlow committed
37 38
import CmmUtils
import Cmm
39
import MachOp
40
import CLabel
Simon Marlow's avatar
Simon Marlow committed
41 42 43 44 45
import StgSyn
import Name
import DataCon
import Unique
import StaticFlags
46 47 48
import FastString
import Packages
import Module
49

Simon Marlow's avatar
Simon Marlow committed
50 51
import Maybes
import Constants
52

53 54
import Outputable 

55 56 57
import Data.Char
import Data.Word

58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
-------------------------------------------------------------------------
--
--	Generating the info table and code for a closure
--
-------------------------------------------------------------------------

-- Here we make a concrete info table, represented as a list of CmmAddr
-- (it can't be simply a list of Word, because the SRT field is
-- represented by a label+offset expression).

-- With tablesNextToCode, the layout is
--	<reversed variable part>
--	<normal forward StgInfoTable, but without 
--		an entry point at the front>
--	<code>
--
-- Without tablesNextToCode, the layout of an info table is
--	<entry label>
--	<normal forward rest of StgInfoTable>
--	<forward variable part>
--
--	See includes/InfoTables.h

emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
emitClosureCodeAndInfoTable cl_info args body
 = do	{ ty_descr_lit <- 
		if opt_SccProfilingOn 
		   then mkStringCLit (closureTypeDescr cl_info)
		   else return (mkIntCLit 0)
  	; cl_descr_lit <- 
		if opt_SccProfilingOn 
		   then mkStringCLit cl_descr_string
		   else return (mkIntCLit 0)
	; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit 
					cl_type srt_len layout_lit

	; blks <- cgStmtsToBlocks body
95 96 97

        ; conName <-  
             if is_con
98
                then do cstr <- mkByteStringCLit $ fromJust conIdentity
99
                        return (makeRelativeRefTo info_lbl cstr)
100 101 102
                else return (mkIntCLit 0)

	; emitInfoTableAndCode info_lbl std_info (extra_bits conName) args blks }
103 104 105 106 107 108 109 110 111 112 113 114
  where
    info_lbl  = infoTableLabelFromCI cl_info

    cl_descr_string = closureValDescr cl_info
    cl_type = smRepClosureTypeInt (closureSMRep cl_info)

    srt = closureSRT cl_info	     
    needs_srt = needsSRT srt

    mb_con = isConstrClosure_maybe  cl_info
    is_con = isJust mb_con

115
    (srt_label,srt_len,conIdentity)
116 117 118 119
	= case mb_con of
	    Just con -> -- Constructors don't have an SRT
			-- We keep the *zero-indexed* tag in the srt_len
			-- field of the info table. 
120 121
			(mkIntCLit 0, fromIntegral (dataConTagZ con), 
                         Just $ dataConIdentity con) 
122 123

	    Nothing  -> -- Not a constructor
124 125
                        let (label, len) = srtLabelAndLength srt info_lbl
                        in (label, len, Nothing)
126 127 128 129 130 131

    ptrs       = closurePtrsSize cl_info
    nptrs      = size - ptrs
    size       = closureNonHdrSize cl_info
    layout_lit = packHalfWordsCLit ptrs nptrs

132
    extra_bits conName 
133
	| is_fun    = fun_extra_bits
134
	| is_con    = [conName]
135 136 137 138 139 140 141 142 143 144 145
	| needs_srt = [srt_label]
 	| otherwise = []

    maybe_fun_stuff = closureFunInfo cl_info
    is_fun = isJust maybe_fun_stuff
    (Just (arity, arg_descr)) = maybe_fun_stuff

    fun_extra_bits
	| ArgGen liveness <- arg_descr
	= [ fun_amode,
	    srt_label,
146 147
	    makeRelativeRefTo info_lbl $ mkLivenessCLit liveness, 
	    slow_entry ]
148 149 150
	| needs_srt = [fun_amode, srt_label]
	| otherwise = [fun_amode]

151 152 153
    slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
    slow_entry_label = mkSlowEntryLabel (closureName cl_info)

154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
    fun_amode = packHalfWordsCLit fun_type arity
    fun_type  = argDescrType arg_descr

-- We keep the *zero-indexed* tag in the srt_len field of the info
-- table of a data constructor.
dataConTagZ :: DataCon -> ConTagZ
dataConTagZ con = dataConTag con - fIRST_TAG

-- A low-level way to generate the variable part of a fun-style info table.
-- (must match fun_extra_bits above).  Used by the C-- parser.
mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
  = [ packHalfWordsCLit fun_type arity,
      srt_label,
      liveness,
      slow_entry ]

-------------------------------------------------------------------------
--
--	Generating the info table and code for a return point
--
-------------------------------------------------------------------------

--	Here's the layout of a return-point info table
--
-- Tables next to code:
--
--			<srt slot>
--			<standard info table>
--  	ret-addr -->	<entry code (if any)>
--
-- Not tables-next-to-code:
--
--	ret-addr -->	<ptr to entry code>
--			<standard info table>
--			<srt slot>
--
Simon Marlow's avatar
Simon Marlow committed
191
--  * The SRT slot is only there is SRT info to record
192

193 194 195 196 197
emitReturnTarget
   :: Name
   -> CgStmts			-- The direct-return code (if any)
   -> SRT
   -> FCode CLabel
Simon Marlow's avatar
Simon Marlow committed
198
emitReturnTarget name stmts srt
199 200 201 202 203
  = do	{ live_slots <- getLiveStackSlots
	; liveness   <- buildContLiveness name live_slots
	; srt_info   <- getSRTInfo name srt

	; let
Simon Marlow's avatar
Simon Marlow committed
204 205
	      cl_type | isBigLiveness liveness = rET_BIG
                      | otherwise              = rET_SMALL
206 207
 
	      (std_info, extra_bits) = 
Simon Marlow's avatar
Simon Marlow committed
208
		   mkRetInfoTable info_lbl liveness srt_info cl_type
209 210 211 212 213

	; blks <- cgStmtsToBlocks stmts
	; emitInfoTableAndCode info_lbl std_info extra_bits args blks
	; return info_lbl }
  where
Simon Marlow's avatar
Simon Marlow committed
214
    args      = {- trace "emitReturnTarget: missing args" -} []
215 216 217 218 219
    uniq      = getUnique name
    info_lbl  = mkReturnInfoLabel uniq


mkRetInfoTable
220 221
  :: CLabel             -- info label
  -> Liveness		-- liveness
222 223 224
  -> C_SRT		-- SRT Info
  -> Int		-- type (eg. rET_SMALL)
  -> ([CmmLit],[CmmLit])
Simon Marlow's avatar
Simon Marlow committed
225 226
mkRetInfoTable info_lbl liveness srt_info cl_type
  =  (std_info, srt_slot)
227
  where
228
	(srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
229
 
Simon Marlow's avatar
Simon Marlow committed
230 231
	srt_slot | needsSRT srt_info = [srt_label]
	         | otherwise         = []
232
 
233
	liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
234 235 236 237 238 239 240
	std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit

emitAlgReturnTarget
	:: Name				-- Just for its unique
	-> [(ConTagZ, CgStmts)]		-- Tagged branches
	-> Maybe CgStmts		-- Default branch (if any)
	-> SRT				-- Continuation's SRT
Simon Marlow's avatar
Simon Marlow committed
241
	-> Int                          -- family size
242 243
	-> FCode (CLabel, SemiTaggingStuff)

Simon Marlow's avatar
Simon Marlow committed
244 245
emitAlgReturnTarget name branches mb_deflt srt fam_sz
  = do  { blks <- getCgStmts $
246 247
		    emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
		-- NB: tag_expr is zero-based
Simon Marlow's avatar
Simon Marlow committed
248
	; lbl <- emitReturnTarget name blks srt 
249 250 251 252 253 254 255
	; return (lbl, Nothing) }
		-- Nothing: the internal branches in the switch don't have
		-- global labels, so we can't use them at the 'call site'
  where
    tag_expr = getConstrTag (CmmReg nodeReg)

--------------------------------
Simon Marlow's avatar
Simon Marlow committed
256 257
emitReturnInstr :: Code
emitReturnInstr 
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289
  = do 	{ info_amode <- getSequelAmode
	; stmtC (CmmJump (entryCode info_amode) []) }

-------------------------------------------------------------------------
--
--	Generating a standard info table
--
-------------------------------------------------------------------------

-- The standard bits of an info table.  This part of the info table
-- corresponds to the StgInfoTable type defined in InfoTables.h.
--
-- Its shape varies with ticky/profiling/tables next to code etc
-- so we can't use constant offsets from Constants

mkStdInfoTable
   :: CmmLit		-- closure type descr (profiling)
   -> CmmLit		-- closure descr (profiling)
   -> Int		-- closure type
   -> StgHalfWord	-- SRT length
   -> CmmLit		-- layout field
   -> [CmmLit]

mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 = 	-- Parallel revertible-black hole field
    prof_info
	-- Ticky info (none at present)
	-- Debug info (none at present)
 ++ [layout_lit, type_lit]

 where  
    prof_info 
290
	| opt_SccProfilingOn = [type_descr, closure_descr]
291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385
	| otherwise	     = []

    type_lit = packHalfWordsCLit cl_type srt_len
	
stdInfoTableSizeW :: WordOff
-- The size of a standard info table varies with profiling/ticky etc,
-- so we can't get it from Constants
-- It must vary in sync with mkStdInfoTable
stdInfoTableSizeW
  = size_fixed + size_prof
  where
    size_fixed = 2	-- layout, type
    size_prof | opt_SccProfilingOn = 2
	      | otherwise	   = 0

stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff

stdSrtBitmapOffset :: ByteOff
-- Byte offset of the SRT bitmap half-word which is 
-- in the *higher-addressed* part of the type_lit
stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE

stdClosureTypeOffset :: ByteOff
-- Byte offset of the closure type half-word 
stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE

stdPtrsOffset, stdNonPtrsOffset :: ByteOff
stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE

-------------------------------------------------------------------------
--
--	Accessing fields of an info table
--
-------------------------------------------------------------------------

closureInfoPtr :: CmmExpr -> CmmExpr
-- Takes a closure pointer and returns the info table pointer
closureInfoPtr e = CmmLoad e wordRep

entryCode :: CmmExpr -> CmmExpr
-- Takes an info pointer (the first word of a closure)
-- and returns its entry code
entryCode e | tablesNextToCode = e
	    | otherwise	       = CmmLoad e wordRep

getConstrTag :: CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the *zero-indexed*
-- constructor tag obtained from the info table
-- This lives in the SRT field of the info table
-- (constructors don't need SRTs).
getConstrTag closure_ptr 
  = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
  where
    info_table = infoTable (closureInfoPtr closure_ptr)

infoTable :: CmmExpr -> CmmExpr
-- Takes an info pointer (the first word of a closure)
-- and returns a pointer to the first word of the standard-form
-- info table, excluding the entry-code word (if present)
infoTable info_ptr
  | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
  | otherwise	     = cmmOffsetW info_ptr 1	-- Past the entry code pointer

infoTableConstrTag :: CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the constr tag
-- field of the info table (same as the srt_bitmap field)
infoTableConstrTag = infoTableSrtBitmap

infoTableSrtBitmap :: CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the srt_bitmap
-- field of the info table
infoTableSrtBitmap info_tbl
  = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep

infoTableClosureType :: CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the closure type
-- field of the info table.
infoTableClosureType info_tbl 
  = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep

infoTablePtrs :: CmmExpr -> CmmExpr
infoTablePtrs info_tbl 
  = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep

infoTableNonPtrs :: CmmExpr -> CmmExpr
infoTableNonPtrs info_tbl 
  = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep

funInfoTable :: CmmExpr -> CmmExpr
-- Takes the info pointer of a function,
-- and returns a pointer to the first word of the StgFunInfoExtra struct
-- in the info table.
funInfoTable info_ptr
  | tablesNextToCode
386
  = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456
  | otherwise
  = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
				-- Past the entry code pointer

-------------------------------------------------------------------------
--
--	Emit the code for a closure (or return address)
--	and its associated info table
--
-------------------------------------------------------------------------

-- The complication here concerns whether or not we can
-- put the info table next to the code

emitInfoTableAndCode 
	:: CLabel 		-- Label of info table
	-> [CmmLit]		-- ...its invariant part
	-> [CmmLit] 		-- ...and its variant part
	-> [LocalReg]		-- ...args
	-> [CmmBasicBlock]	-- ...and body
	-> Code

emitInfoTableAndCode info_lbl std_info extra_bits args blocks
  | tablesNextToCode 	-- Reverse the extra_bits; and emit the top-level proc
  = emitProc (reverse extra_bits ++ std_info) 
	     entry_lbl args blocks
	-- NB: the info_lbl is discarded

  | null blocks -- No actual code; only the info table is significant
  =		-- Use a zero place-holder in place of the 
		-- entry-label in the info table
    emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)

  | otherwise	-- Separately emit info table (with the function entry 
  =		-- point as first entry) and the entry code 
    do	{ emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
	; emitProc [] entry_lbl args blocks }

  where
	entry_lbl = infoLblToEntryLbl info_lbl

-------------------------------------------------------------------------
--
--	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 :: Name -> SRT -> FCode C_SRT
getSRTInfo id NoSRT = return NoC_SRT
getSRTInfo id (SRT off len bmp)
  | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
  = do	{ srt_lbl <- getSRTLabel
	; let srt_desc_lbl = mkSRTDescLabel id
	; emitRODataLits srt_desc_lbl
		   ( cmmLabelOffW srt_lbl off
		   : mkWordCLit (fromIntegral len)
		   : map mkWordCLit bmp)
	; return (C_SRT srt_desc_lbl 0 srt_escape) }

  | otherwise 
  = do	{ srt_lbl <- getSRTLabel
	; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
		-- The fromIntegral converts to StgHalfWord

srt_escape = (-1) :: StgHalfWord

457 458 459 460 461
srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
srtLabelAndLength NoC_SRT _		
  = (zeroCLit, 0)
srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
  = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
462

463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484
-------------------------------------------------------------------------
--
--	Position independent code
--
-------------------------------------------------------------------------
-- In order to support position independent code, we mustn't put absolute
-- references into read-only space. Info tables in the tablesNextToCode
-- case must be in .text, which is read-only, so we doctor the CmmLits
-- to use relative offsets instead.

-- Note that this is done even when the -fPIC flag is not specified,
-- as we want to keep binary compatibility between PIC and non-PIC.

makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
        
makeRelativeRefTo info_lbl (CmmLabel lbl)
  | tablesNextToCode
  = CmmLabelDiffOff lbl info_lbl 0
makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
  | tablesNextToCode
  = CmmLabelDiffOff lbl info_lbl off
makeRelativeRefTo _ lit = lit