CgInfoTbls.hs 15 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

Simon Marlow's avatar
Simon Marlow committed
47
48
import Maybes
import Constants
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

-------------------------------------------------------------------------
--
--	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

73
emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
74
75
76
emitClosureCodeAndInfoTable cl_info args body
 = do	{ ty_descr_lit <- 
		if opt_SccProfilingOn 
Simon Marlow's avatar
Simon Marlow committed
77
78
		   then do lit <- mkStringCLit (closureTypeDescr cl_info)
                           return (makeRelativeRefTo info_lbl lit)
79
80
81
		   else return (mkIntCLit 0)
  	; cl_descr_lit <- 
		if opt_SccProfilingOn 
Simon Marlow's avatar
Simon Marlow committed
82
83
		   then do lit <- mkStringCLit cl_descr_string
                           return (makeRelativeRefTo info_lbl lit)
84
85
86
87
88
		   else return (mkIntCLit 0)
	; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit 
					cl_type srt_len layout_lit

	; blks <- cgStmtsToBlocks body
89
90
91

        ; conName <-  
             if is_con
92
                then do cstr <- mkByteStringCLit $ fromJust conIdentity
93
                        return (makeRelativeRefTo info_lbl cstr)
94
95
96
                else return (mkIntCLit 0)

	; emitInfoTableAndCode info_lbl std_info (extra_bits conName) args blks }
97
98
99
100
101
102
103
104
105
106
107
108
  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

109
    (srt_label,srt_len,conIdentity)
110
111
112
113
	= 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. 
114
115
			(mkIntCLit 0, fromIntegral (dataConTagZ con), 
                         Just $ dataConIdentity con) 
116
117

	    Nothing  -> -- Not a constructor
118
119
                        let (label, len) = srtLabelAndLength srt info_lbl
                        in (label, len, Nothing)
120
121
122
123
124
125

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

126
    extra_bits conName 
127
	| is_fun    = fun_extra_bits
128
	| is_con    = [conName]
129
130
131
132
133
134
135
136
137
138
139
	| 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,
140
141
	    makeRelativeRefTo info_lbl $ mkLivenessCLit liveness, 
	    slow_entry ]
142
143
144
	| needs_srt = [fun_amode, srt_label]
	| otherwise = [fun_amode]

145
146
147
    slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
    slow_entry_label = mkSlowEntryLabel (closureName cl_info)

148
149
150
151
152
153
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
    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
185
--  * The SRT slot is only there is SRT info to record
186

187
188
189
190
191
emitReturnTarget
   :: Name
   -> CgStmts			-- The direct-return code (if any)
   -> SRT
   -> FCode CLabel
Simon Marlow's avatar
Simon Marlow committed
192
emitReturnTarget name stmts srt
193
194
195
196
197
  = do	{ live_slots <- getLiveStackSlots
	; liveness   <- buildContLiveness name live_slots
	; srt_info   <- getSRTInfo name srt

	; let
Simon Marlow's avatar
Simon Marlow committed
198
199
	      cl_type | isBigLiveness liveness = rET_BIG
                      | otherwise              = rET_SMALL
200
201
 
	      (std_info, extra_bits) = 
Simon Marlow's avatar
Simon Marlow committed
202
		   mkRetInfoTable info_lbl liveness srt_info cl_type
203
204
205
206
207

	; blks <- cgStmtsToBlocks stmts
	; emitInfoTableAndCode info_lbl std_info extra_bits args blks
	; return info_lbl }
  where
Simon Marlow's avatar
Simon Marlow committed
208
    args      = {- trace "emitReturnTarget: missing args" -} []
209
210
211
212
213
    uniq      = getUnique name
    info_lbl  = mkReturnInfoLabel uniq


mkRetInfoTable
214
215
  :: CLabel             -- info label
  -> Liveness		-- liveness
216
217
218
  -> C_SRT		-- SRT Info
  -> Int		-- type (eg. rET_SMALL)
  -> ([CmmLit],[CmmLit])
Simon Marlow's avatar
Simon Marlow committed
219
220
mkRetInfoTable info_lbl liveness srt_info cl_type
  =  (std_info, srt_slot)
221
  where
222
	(srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
223
 
Simon Marlow's avatar
Simon Marlow committed
224
225
	srt_slot | needsSRT srt_info = [srt_label]
	         | otherwise         = []
226
 
227
	liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
228
229
230
231
232
233
234
	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
235
	-> Int                          -- family size
236
237
	-> FCode (CLabel, SemiTaggingStuff)

Simon Marlow's avatar
Simon Marlow committed
238
239
emitAlgReturnTarget name branches mb_deflt srt fam_sz
  = do  { blks <- getCgStmts $
240
241
		    emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
		-- NB: tag_expr is zero-based
Simon Marlow's avatar
Simon Marlow committed
242
	; lbl <- emitReturnTarget name blks srt 
243
244
245
246
247
248
249
	; 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
250
251
emitReturnInstr :: Code
emitReturnInstr 
252
253
254
255
256
257
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
  = 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 
284
	| opt_SccProfilingOn = [type_descr, closure_descr]
285
286
287
288
289
290
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
	| 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
380
  = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
  | 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
399
	-> CmmFormals		-- ...args
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
	-> [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

451
452
453
454
455
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)
456

457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
-------------------------------------------------------------------------
--
--	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