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

Ian Lynagh's avatar
Ian Lynagh committed
9
10
11
12
13
14
15
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

16
17
18
module CgInfoTbls (
	emitClosureCodeAndInfoTable,
	emitInfoTableAndCode,
Simon Marlow's avatar
Simon Marlow committed
19
20
	emitReturnTarget, emitAlgReturnTarget,
	emitReturnInstr,
21
	stdInfoTableSizeB,
22
23
	entryCode, closureInfoPtr,
	getConstrTag,
Simon Marlow's avatar
Simon Marlow committed
24
        cmmGetClosureType,
Simon Marlow's avatar
Simon Marlow committed
25
	infoTable, infoTableClosureType,
26
	infoTablePtrs, infoTableNonPtrs,
dterei's avatar
dterei committed
27
	funInfoTable
28
29
30
31
32
  ) where


#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
33
34
35
36
37
import ClosureInfo
import SMRep
import CgBindery
import CgCallConv
import CgUtils
38
import CgMonad
39
import CmmBuildInfoTables
40

41
import OldCmm
42
import CLabel
Simon Marlow's avatar
Simon Marlow committed
43
44
45
import Name
import Unique
import StaticFlags
46

Simon Marlow's avatar
Simon Marlow committed
47
import Constants
48
import DynFlags
49
50
import Util
import Outputable
51
52
53
54
55
56
57

-------------------------------------------------------------------------
--
--	Generating the info table and code for a closure
--
-------------------------------------------------------------------------

58
59
60
-- Here we make an info table of type 'CmmInfo'.  The concrete
-- representation as a list of 'CmmAddr' is handled later
-- in the pipeline by 'cmmToRawCmm'.
61

62
emitClosureCodeAndInfoTable :: ClosureInfo -> [CmmFormal] -> CgStmts -> Code
63
emitClosureCodeAndInfoTable cl_info args body
64
65
 = do	{ blks <- cgStmtsToBlocks body
        ; info <- mkCmmInfo cl_info
66
        ; emitInfoTableAndCode (entryLabelFromCI cl_info) info args blks }
67

68
69
70
-- Convert from 'ClosureInfo' to 'CmmInfo'.
-- Not used for return points.  (The 'smRepClosureTypeInt' call would panic.)
mkCmmInfo :: ClosureInfo -> FCode CmmInfo
71
72
73
74
75
76
mkCmmInfo cl_info
  = return (CmmInfo gc_target Nothing $
            CmmInfoTable { cit_lbl  = infoTableLabelFromCI cl_info,
                   	   cit_rep  = closureSMRep cl_info,
                   	   cit_prof = prof,
                   	   cit_srt  = closureSRT cl_info })
77
  where
78
79
80
81
    prof | not opt_SccProfilingOn = NoProfilingInfo
         | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
    ty_descr_w8  = stringToWord8s (closureTypeDescr cl_info)
    val_descr_w8 = stringToWord8s (closureValDescr cl_info)
82
83
84
85
86
87
88
89

    -- The gc_target is to inform the CPS pass when it inserts a stack check.
    -- Since that pass isn't used yet we'll punt for now.
    -- When the CPS pass is fully integrated, this should
    -- be replaced by the label that any heap check jumped to,
    -- so that branch can be shared by both the heap (from codeGen)
    -- and stack checks (from the CPS pass).
    gc_target = panic "TODO: gc_target"
90
91
92
93
94
95
96

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

97
98
-- The concrete representation as a list of 'CmmAddr' is handled later
-- in the pipeline by 'cmmToRawCmm'.
99

100
101
102
103
emitReturnTarget
   :: Name
   -> CgStmts			-- The direct-return code (if any)
   -> FCode CLabel
104
emitReturnTarget name stmts
105
  = do	{ srt_info   <- getSRTInfo
106
	; blks <- cgStmtsToBlocks stmts
107
        ; frame <- mkStackLayout
108
109
110
111
112
113
        ; let smrep    = mkStackRep (mkLiveness frame)
              info     = CmmInfo gc_target Nothing info_tbl
              info_tbl = CmmInfoTable { cit_lbl  = info_lbl
                                      , cit_prof = NoProfilingInfo
                                      , cit_rep  = smrep
                                      , cit_srt  = srt_info }
114
        ; emitInfoTableAndCode entry_lbl info args blks
115
116
	; return info_lbl }
  where
Simon Marlow's avatar
Simon Marlow committed
117
    args      = {- trace "emitReturnTarget: missing args" -} []
118
119
    uniq      = getUnique name
    info_lbl  = mkReturnInfoLabel uniq
120
    entry_lbl = mkReturnPtLabel uniq
121

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
    -- The gc_target is to inform the CPS pass when it inserts a stack check.
    -- Since that pass isn't used yet we'll punt for now.
    -- When the CPS pass is fully integrated, this should
    -- be replaced by the label that any heap check jumped to,
    -- so that branch can be shared by both the heap (from codeGen)
    -- and stack checks (from the CPS pass).
    gc_target = panic "TODO: gc_target"

-- Build stack layout information from the state of the 'FCode' monad.
-- Should go away once 'codeGen' starts using the CPS conversion
-- pass to handle the stack.  Until then, this is really just
-- here to convert from the 'codeGen' representation of the stack
-- to the 'CmmInfo' representation of the stack.
--
-- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.

{-
This seems to be a very error prone part of the code.
It is surprisingly prone to off-by-one errors, because
it converts between offset form (codeGen) and list form (CmmInfo).
Thus a bit of explanation is in order.
Fortunately, this code should go away once the code generator
starts using the CPS conversion pass to handle the stack.

The stack looks like this:

             |             |
             |-------------|
frame_sp --> | return addr |
             |-------------|
             | dead slot   |
             |-------------|
             | live ptr b  |
             |-------------|
             | live ptr a  |
             |-------------|
real_sp  --> | return addr |
             +-------------+

Both 'frame_sp' and 'real_sp' are measured downwards
(i.e. larger frame_sp means smaller memory address).

For that frame we want a result like: [Just a, Just b, Nothing]
Note that the 'head' of the list is the top
of the stack, and that the return address
is not present in the list (it is always assumed).
-}
mkStackLayout :: FCode [Maybe LocalReg]
mkStackLayout = do
171
172
  dflags <- getDynFlags
  let platform = targetPlatform dflags
173
174
175
176
177
178
179
180
181
  StackUsage { realSp = real_sp,
               frameSp = frame_sp } <- getStkUsage
  binds <- getLiveStackBindings
  let frame_size = real_sp - frame_sp - retAddrSizeW
      rel_binds = reverse $ sortWith fst
                    [(offset - frame_sp - retAddrSizeW, b)
                    | (offset, b) <- binds]

  WARN( not (all (\bind -> fst bind >= 0) rel_binds),
182
        pprPlatform platform binds $$ pprPlatform platform rel_binds $$
183
184
185
186
187
188
189
190
191
192
193
        ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
    return $ stack_layout rel_binds frame_size

stack_layout :: [(VirtualSpOffset, CgIdInfo)]
             -> WordOff
             -> [Maybe LocalReg]
stack_layout [] sizeW = replicate sizeW Nothing
stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
  (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
  where
    rep_size = cgRepSizeW (cgIdInfoArgRep bind)
194
    stack_bind = LocalReg unique machRep
195
196
    unique = getUnique (cgIdInfoId bind)
    machRep = argMachRep (cgIdInfoArgRep bind)
Ian Lynagh's avatar
Ian Lynagh committed
197
stack_layout binds@(_:_) sizeW | otherwise =
198
199
200
201
  Nothing : (stack_layout binds (sizeW - 1))

{- Another way to write the function that might be less error prone (untested)
stack_layout offsets sizeW = result
202
  where
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
    y = map (flip lookup offsets) [0..]
      -- offsets -> nothing and just (each slot is one word)
    x = take sizeW y -- set the frame size
    z = clip x -- account for multi-word slots
    result = map mk_reg z

    clip [] = []
    clip list@(x : _) = x : clip (drop count list)
      ASSERT(all isNothing (tail (take count list)))
    
    count Nothing = 1
    count (Just x) = cgRepSizeW (cgIdInfoArgRep x)

    mk_reg Nothing = Nothing
    mk_reg (Just x) = LocalReg unique machRep kind
      where
        unique = getUnique (cgIdInfoId x)
        machRep = argMachrep (cgIdInfoArgRep bind)
        kind = if isFollowableArg (cgIdInfoArgRep bind)
222
223
           then GCKindPtr
           else GCKindNonPtr
224
-}
225
226
227
228
229

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

233
emitAlgReturnTarget name branches mb_deflt fam_sz
Simon Marlow's avatar
Simon Marlow committed
234
  = do  { blks <- getCgStmts $
Simon Marlow's avatar
Simon Marlow committed
235
236
237
238
239
240
241
242
243
244
245
246
                    -- is the constructor tag in the node reg?
                    if isSmallFamily fam_sz
                        then do -- yes, node has constr. tag
                          let tag_expr = cmmConstrTag1 (CmmReg nodeReg)
                              branches' = [(tag+1,branch)|(tag,branch)<-branches]
                          emitSwitch tag_expr branches' mb_deflt 1 fam_sz
                        else do -- no, get tag from info table
                          let -- Note that ptr _always_ has tag 1
                              -- when the family size is big enough
                              untagged_ptr = cmmRegOffB nodeReg (-1)
                              tag_expr = getConstrTag (untagged_ptr)
                          emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
247
	; lbl <- emitReturnTarget name blks
248
249
250
251
252
	; 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'

--------------------------------
Simon Marlow's avatar
Simon Marlow committed
253
254
emitReturnInstr :: Code
emitReturnInstr 
255
256
257
  = do 	{ info_amode <- getSequelAmode
	; stmtC (CmmJump (entryCode info_amode) []) }

258
-----------------------------------------------------------------------------
259
--
260
--	Info table offsets
261
--
262
-----------------------------------------------------------------------------
263
264
265
266
267
268
269
270
271
272
273
274
	
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

Ian Lynagh's avatar
Ian Lynagh committed
275
276
stdInfoTableSizeB :: ByteOff
stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298

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
299
closureInfoPtr e = CmmLoad e bWord
300
301
302
303
304

entryCode :: CmmExpr -> CmmExpr
-- Takes an info pointer (the first word of a closure)
-- and returns its entry code
entryCode e | tablesNextToCode = e
305
	    | otherwise	       = CmmLoad e bWord
306
307
308
309
310
311
312

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 
313
  = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag info_table]
314
315
316
  where
    info_table = infoTable (closureInfoPtr closure_ptr)

Simon Marlow's avatar
Simon Marlow committed
317
318
319
320
cmmGetClosureType :: CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the closure type
-- obtained from the info table
cmmGetClosureType closure_ptr 
321
  = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType info_table]
Simon Marlow's avatar
Simon Marlow committed
322
323
324
  where
    info_table = infoTable (closureInfoPtr closure_ptr)

325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
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
342
  = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) bHalfWord
343
344
345
346
347

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

infoTablePtrs :: CmmExpr -> CmmExpr
infoTablePtrs info_tbl 
352
  = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) bHalfWord
353
354
355

infoTableNonPtrs :: CmmExpr -> CmmExpr
infoTableNonPtrs info_tbl 
356
  = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) bHalfWord
357
358
359
360
361
362
363

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
364
  = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
365
366
367
368
369
370
371
372
373
374
375
376
377
378
  | 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

379
emitInfoTableAndCode 
Ian Lynagh's avatar
Ian Lynagh committed
380
	:: CLabel 		-- Label of entry or ret
381
	-> CmmInfo 		-- ...the info table
382
	-> [CmmFormal]	-- ...args
383
384
385
	-> [CmmBasicBlock]	-- ...and body
	-> Code

Ian Lynagh's avatar
Ian Lynagh committed
386
387
emitInfoTableAndCode entry_ret_lbl info args blocks
  = emitProc info entry_ret_lbl args blocks
388