1 -----------------------------------------------------------------------------
3 -- Building info tables.
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
13 emitClosureProcAndInfoTable,
14 emitClosureAndInfoTable,
18 mkVirtHeapOffsets, getHpRelOffset, hpRel,
21 entryCode, closureInfoPtr,
24 infoTable, infoTableClosureType,
25 infoTablePtrs, infoTableNonPtrs,
26 funInfoTable, makeRelativeRefTo
30 #include "HsVersions.h"
48 import TyCon ( PrimRep(..) )
50 import BasicTypes ( Arity )
60 import FastString ( mkFastString, FastString, fsLit )
62 ------------------------------------------------------------------------
63 -- Call and return sequences
64 ------------------------------------------------------------------------
66 emitReturn :: [CmmExpr] -> FCode ()
67 -- Return multiple values to the sequel
69 -- If the sequel is Return
71 -- If the sequel is AssignTo [p,q]
74 = do { sequel <- getSequel;
75 ; updfr_off <- getUpdFrameOff
76 ; emit $ mkComment $ mkFastString ("emitReturn: " ++ show sequel)
79 do { adjustHpBackwards
80 ; emit (mkReturnSimple results updfr_off) }
81 AssignTo regs adjust ->
82 do { if adjust then adjustHpBackwards else return ()
83 ; emit (mkMultiAssign regs results) }
86 emitCall :: (Convention, Convention) -> CmmExpr -> [CmmExpr] -> FCode ()
87 -- (cgCall fun args) makes a call to the entry-code of 'fun',
88 -- passing 'args', and returning the results to the current sequel
89 emitCall convs@(callConv, _) fun args
90 = do { adjustHpBackwards
92 ; updfr_off <- getUpdFrameOff
93 ; emit $ mkComment $ mkFastString ("emitCall: " ++ show sequel)
95 Return _ -> emit (mkForeignJump callConv fun args updfr_off)
96 AssignTo res_regs _ -> emit (mkCall fun convs res_regs args updfr_off)
99 adjustHpBackwards :: FCode ()
100 -- This function adjusts and heap pointers just before a tail call or
101 -- return. At a call or return, the virtual heap pointer may be less
102 -- than the real Hp, because the latter was advanced to deal with
103 -- the worst-case branch of the code, and we may be in a better-case
104 -- branch. In that case, move the real Hp *back* and retract some
105 -- ticky allocation count.
107 -- It *does not* deal with high-water-mark adjustment.
108 -- That's done by functions which allocate heap.
110 = do { hp_usg <- getHpUsage
111 ; let rHp = realHp hp_usg
113 adjust_words = vHp -rHp
114 ; new_hp <- getHpRelOffset vHp
116 ; emit (if adjust_words == 0
118 else mkAssign hpReg new_hp) -- Generates nothing when vHp==rHp
120 ; tickyAllocHeap adjust_words -- ...ditto
126 -------------------------------------------------------------------------
127 -- Making calls: directCall and slowCall
128 -------------------------------------------------------------------------
130 directCall :: CLabel -> Arity -> [StgArg] -> FCode ()
131 -- (directCall f n args)
132 -- calls f(arg1, ..., argn), and applies the result to the remaining args
133 -- The function f has arity n, and there are guaranteed at least n args
134 -- Both arity and args include void args
135 directCall lbl arity stg_args
136 = do { cmm_args <- getNonVoidArgAmodes stg_args
137 ; direct_call "directCall" lbl arity cmm_args (argsLReps stg_args) }
139 slowCall :: CmmExpr -> [StgArg] -> FCode ()
140 -- (slowCall fun args) applies fun to args, returning the results to Sequel
141 slowCall fun stg_args
142 = do { cmm_args <- getNonVoidArgAmodes stg_args
143 ; slow_call fun cmm_args (argsLReps stg_args) }
146 direct_call :: String -> CLabel -> Arity -> [CmmExpr] -> [LRep] -> FCode ()
147 -- NB1: (length args) may be less than (length reps), because
148 -- the args exclude the void ones
149 -- NB2: 'arity' refers to the *reps*
150 direct_call caller lbl arity args reps
151 | debugIsOn && arity > length reps -- Too few args
152 = -- Caller should ensure that there enough args!
153 pprPanic "direct_call" (text caller <+> ppr arity <+> ppr lbl <+> ppr (length reps)
154 <+> ppr args <+> ppr reps )
156 | null rest_reps -- Precisely the right number of arguments
157 = emitCall (NativeDirectCall, NativeReturn) target args
159 | otherwise -- Over-saturated call
160 = ASSERT( arity == length initial_reps )
161 do { pap_id <- newTemp gcWord
162 ; withSequel (AssignTo [pap_id] True)
163 (emitCall (NativeDirectCall, NativeReturn) target fast_args)
164 ; slow_call (CmmReg (CmmLocal pap_id))
165 rest_args rest_reps }
167 target = CmmLit (CmmLabel lbl)
168 (initial_reps, rest_reps) = splitAt arity reps
169 arg_arity = count isNonV initial_reps
170 (fast_args, rest_args) = splitAt arg_arity args
173 slow_call :: CmmExpr -> [CmmExpr] -> [LRep] -> FCode ()
174 slow_call fun args reps
175 = do call <- getCode $ direct_call "slow_call" (mkRtsApFastLabel rts_fun) arity args reps
176 emit $ mkComment $ mkFastString ("slow_call for " ++ showSDoc (ppr fun) ++
177 " with pat " ++ showSDoc (ftext rts_fun))
178 emit (mkAssign nodeReg fun <*> call)
180 (rts_fun, arity) = slowCallPattern reps
182 -- These cases were found to cover about 99% of all slow calls:
183 slowCallPattern :: [LRep] -> (FastString, Arity)
184 -- Returns the generic apply function and arity
185 slowCallPattern (P: P: P: P: P: P: _) = (fsLit "stg_ap_pppppp", 6)
186 slowCallPattern (P: P: P: P: P: _) = (fsLit "stg_ap_ppppp", 5)
187 slowCallPattern (P: P: P: P: _) = (fsLit "stg_ap_pppp", 4)
188 slowCallPattern (P: P: P: V: _) = (fsLit "stg_ap_pppv", 4)
189 slowCallPattern (P: P: P: _) = (fsLit "stg_ap_ppp", 3)
190 slowCallPattern (P: P: V: _) = (fsLit "stg_ap_ppv", 3)
191 slowCallPattern (P: P: _) = (fsLit "stg_ap_pp", 2)
192 slowCallPattern (P: V: _) = (fsLit "stg_ap_pv", 2)
193 slowCallPattern (P: _) = (fsLit "stg_ap_p", 1)
194 slowCallPattern (V: _) = (fsLit "stg_ap_v", 1)
195 slowCallPattern (N: _) = (fsLit "stg_ap_n", 1)
196 slowCallPattern (F: _) = (fsLit "stg_ap_f", 1)
197 slowCallPattern (D: _) = (fsLit "stg_ap_d", 1)
198 slowCallPattern (L: _) = (fsLit "stg_ap_l", 1)
199 slowCallPattern [] = (fsLit "stg_ap_0", 0)
202 -------------------------------------------------------------------------
203 -- Classifying arguments: LRep
204 -------------------------------------------------------------------------
206 -- LRep is not exported (even abstractly)
207 -- It's a local helper type for classification
209 data LRep = P -- GC Ptr
210 | N -- One-word non-ptr
211 | L -- Two-word non-ptr (long)
215 instance Outputable LRep where
223 toLRep :: PrimRep -> LRep
234 isNonV :: LRep -> Bool
238 argsLReps :: [StgArg] -> [LRep]
239 argsLReps = map (toLRep . argPrimRep)
241 lRepSizeW :: LRep -> WordOff -- Size in words
245 lRepSizeW L = wORD64_SIZE `quot` wORD_SIZE
246 lRepSizeW D = dOUBLE_SIZE `quot` wORD_SIZE
249 -------------------------------------------------------------------------
250 ---- Laying out objects on the heap and stack
251 -------------------------------------------------------------------------
253 -- The heap always grows upwards, so hpRel is easy
254 hpRel :: VirtualHpOffset -- virtual offset of Hp
255 -> VirtualHpOffset -- virtual offset of The Thing
256 -> WordOff -- integer word offset
257 hpRel hp off = off - hp
259 getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
260 getHpRelOffset virtual_offset
261 = do { hp_usg <- getHpUsage
262 ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) }
265 :: Bool -- True <=> is a thunk
266 -> [(PrimRep,a)] -- Things to make offsets for
267 -> (WordOff, -- _Total_ number of words allocated
268 WordOff, -- Number of words allocated for *pointers*
269 [(NonVoid a, VirtualHpOffset)])
271 -- Things with their offsets from start of object in order of
272 -- increasing offset; BUT THIS MAY BE DIFFERENT TO INPUT ORDER
273 -- First in list gets lowest offset, which is initial offset + 1.
275 -- Void arguments are removed, so output list may be shorter than
278 -- mkVirtHeapOffsets always returns boxed things with smaller offsets
279 -- than the unboxed things
281 mkVirtHeapOffsets is_thunk things
282 = let non_void_things = filterOut (isVoidRep . fst) things
283 (ptrs, non_ptrs) = partition (isGcPtrRep . fst) non_void_things
284 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
285 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
287 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
289 hdr_size | is_thunk = thunkHdrSize
290 | otherwise = fixedHdrSize
292 computeOffset wds_so_far (rep, thing)
293 = (wds_so_far + lRepSizeW (toLRep rep),
294 (NonVoid thing, hdr_size + wds_so_far))
297 -------------------------------------------------------------------------
299 -- Making argument descriptors
301 -- An argument descriptor describes the layout of args on the stack,
302 -- both for * GC (stack-layout) purposes, and
303 -- * saving/restoring registers when a heap-check fails
305 -- Void arguments aren't important, therefore (contrast constructSlowCall)
307 -------------------------------------------------------------------------
309 -- bring in ARG_P, ARG_N, etc.
310 #include "../includes/rts/storage/FunTypes.h"
312 -------------------------
313 -- argDescrType :: ArgDescr -> StgHalfWord
314 -- -- The "argument type" RTS field type
315 -- argDescrType (ArgSpec n) = n
316 -- argDescrType (ArgGen liveness)
317 -- | isBigLiveness liveness = ARG_GEN_BIG
318 -- | otherwise = ARG_GEN
321 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
323 = case stdPattern arg_reps of
324 Just spec_id -> return (ArgSpec spec_id)
325 Nothing -> do { liveness <- mkLiveness nm size bitmap
326 ; return (ArgGen liveness) }
328 arg_reps = filter isNonV (map (toLRep . idPrimRep) args)
329 -- Getting rid of voids eases matching of standard patterns
331 bitmap = mkBitmap arg_bits
332 arg_bits = argBits arg_reps
333 size = length arg_bits
335 argBits :: [LRep] -> [Bool] -- True for non-ptr, False for ptr
337 argBits (P : args) = False : argBits args
338 argBits (arg : args) = take (lRepSizeW arg) (repeat True) ++ argBits args
340 ----------------------
341 stdPattern :: [LRep] -> Maybe StgHalfWord
344 [] -> Just ARG_NONE -- just void args, probably
356 [N,N,N] -> Just ARG_NNN
357 [N,N,P] -> Just ARG_NNP
358 [N,P,N] -> Just ARG_NPN
359 [N,P,P] -> Just ARG_NPP
360 [P,N,N] -> Just ARG_PNN
361 [P,N,P] -> Just ARG_PNP
362 [P,P,N] -> Just ARG_PPN
363 [P,P,P] -> Just ARG_PPP
365 [P,P,P,P] -> Just ARG_PPPP
366 [P,P,P,P,P] -> Just ARG_PPPPP
367 [P,P,P,P,P,P] -> Just ARG_PPPPPP
371 -------------------------------------------------------------------------
375 -------------------------------------------------------------------------
377 -- TODO: This along with 'mkArgDescr' should be unified
378 -- with 'CmmInfo.mkLiveness'. However that would require
379 -- potentially invasive changes to the 'ClosureInfo' type.
380 -- For now, 'CmmInfo.mkLiveness' handles only continuations and
381 -- this one handles liveness everything else. Another distinction
382 -- between these two is that 'CmmInfo.mkLiveness' information
383 -- about the stack layout, and this one is information about
384 -- the heap layout of PAPs.
385 mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
386 mkLiveness name size bits
387 | size > mAX_SMALL_BITMAP_SIZE -- Bitmap does not fit in one word
388 = do { let lbl = mkBitmapLabel (getUnique name)
389 ; emitRODataLits lbl ( mkWordCLit (fromIntegral size)
390 : map mkWordCLit bits)
391 ; return (BigLiveness lbl) }
393 | otherwise -- Bitmap fits in one word
395 small_bits = case bits of
398 _ -> panic "livenessToAddrMode"
400 return (smallLiveness size small_bits)
402 smallLiveness :: Int -> StgWord -> Liveness
403 smallLiveness size small_bits = SmallLiveness bits
404 where bits = fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
407 -- isBigLiveness :: Liveness -> Bool
408 -- isBigLiveness (BigLiveness _) = True
409 -- isBigLiveness (SmallLiveness _) = False
412 -- mkLivenessCLit :: Liveness -> CmmLit
413 -- mkLivenessCLit (BigLiveness lbl) = CmmLabel lbl
414 -- mkLivenessCLit (SmallLiveness bits) = mkWordCLit bits
417 -------------------------------------------------------------------------
419 -- Bitmap describing register liveness
420 -- across GC when doing a "generic" heap check
421 -- (a RET_DYN stack frame).
423 -- NB. Must agree with these macros (currently in StgMacros.h):
424 -- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
425 -------------------------------------------------------------------------
427 {- Not used in new code gen
428 mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
429 mkRegLiveness regs ptrs nptrs
430 = (fromIntegral nptrs `shiftL` 16) .|.
431 (fromIntegral ptrs `shiftL` 24) .|.
432 all_non_ptrs `xor` reg_bits regs
437 reg_bits ((id, VanillaReg i) : regs) | isGcPtrRep (idPrimRep id)
438 = (1 `shiftL` (i - 1)) .|. reg_bits regs
443 -------------------------------------------------------------------------
445 -- Generating the info table and code for a closure
447 -------------------------------------------------------------------------
449 -- Here we make an info table of type 'CmmInfo'. The concrete
450 -- representation as a list of 'CmmAddr' is handled later
451 -- in the pipeline by 'cmmToRawCmm'.
452 -- When loading the free variables, a function closure pointer may be tagged,
453 -- so we must take it into account.
455 emitClosureProcAndInfoTable :: Bool -- top-level?
456 -> Id -- name of the closure
457 -> ClosureInfo -- lots of info abt the closure
458 -> [NonVoid Id] -- incoming arguments
459 -> ((Int, LocalReg, [LocalReg]) -> FCode ()) -- function body
461 emitClosureProcAndInfoTable top_lvl bndr cl_info args body
462 = do { let lf_info = closureLFInfo cl_info
463 -- Bind the binder itself, but only if it's not a top-level
464 -- binding. We need non-top let-bindings to refer to the
465 -- top-level binding, which this binding would incorrectly shadow.
466 ; node <- if top_lvl then return $ idToReg (NonVoid bndr)
467 else bindToReg (NonVoid bndr) lf_info
468 ; let node_points = nodeMustPointToIt lf_info
469 ; arg_regs <- bindArgsToRegs args
470 ; let args' = if node_points then (node : arg_regs) else arg_regs
471 conv = if nodeMustPointToIt lf_info then NativeNodeCall
472 else NativeDirectCall
473 (offset, _) = mkCallEntry conv args'
474 ; emitClosureAndInfoTable cl_info conv args' $ body (offset, node, arg_regs)
477 -- Data constructors need closures, but not with all the argument handling
478 -- needed for functions. The shared part goes here.
479 emitClosureAndInfoTable ::
480 ClosureInfo -> Convention -> [LocalReg] -> FCode () -> FCode ()
481 emitClosureAndInfoTable cl_info conv args body
482 = do { info <- mkCmmInfo cl_info
483 ; blks <- getCode body
484 ; emitProcWithConvention conv info (infoLblToEntryLbl info_lbl) args blks
487 info_lbl = infoTableLabelFromCI cl_info
489 -- Convert from 'ClosureInfo' to 'CmmInfoTable'.
490 -- Not used for return points. (The 'smRepClosureTypeInt' call would panic.)
491 mkCmmInfo :: ClosureInfo -> FCode CmmInfoTable
493 = do { info <- closureTypeInfo cl_info k_with_con_name return
494 ; prof <- if opt_SccProfilingOn then
495 do fd_lit <- mkStringCLit (closureTypeDescr cl_info)
496 ad_lit <- mkStringCLit (closureValDescr cl_info)
497 return $ ProfilingInfo fd_lit ad_lit
498 else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
499 ; return (CmmInfoTable (isStaticClosure cl_info) prof cl_type info) }
501 k_with_con_name con_info con info_lbl =
502 do cstr <- mkByteStringCLit $ dataConIdentity con
503 return $ con_info $ makeRelativeRefTo info_lbl cstr
504 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
506 -----------------------------------------------------------------------------
508 -- Info table offsets
510 -----------------------------------------------------------------------------
512 stdInfoTableSizeW :: WordOff
513 -- The size of a standard info table varies with profiling/ticky etc,
514 -- so we can't get it from Constants
515 -- It must vary in sync with mkStdInfoTable
517 = size_fixed + size_prof
519 size_fixed = 2 -- layout, type
520 size_prof | opt_SccProfilingOn = 2
523 stdInfoTableSizeB :: ByteOff
524 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
526 stdSrtBitmapOffset :: ByteOff
527 -- Byte offset of the SRT bitmap half-word which is
528 -- in the *higher-addressed* part of the type_lit
529 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
531 stdClosureTypeOffset :: ByteOff
532 -- Byte offset of the closure type half-word
533 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
535 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
536 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
537 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
539 -------------------------------------------------------------------------
541 -- Accessing fields of an info table
543 -------------------------------------------------------------------------
545 closureInfoPtr :: CmmExpr -> CmmExpr
546 -- Takes a closure pointer and returns the info table pointer
547 closureInfoPtr e = CmmLoad e bWord
549 entryCode :: CmmExpr -> CmmExpr
550 -- Takes an info pointer (the first word of a closure)
551 -- and returns its entry code
552 entryCode e | tablesNextToCode = e
553 | otherwise = CmmLoad e bWord
555 getConstrTag :: CmmExpr -> CmmExpr
556 -- Takes a closure pointer, and return the *zero-indexed*
557 -- constructor tag obtained from the info table
558 -- This lives in the SRT field of the info table
559 -- (constructors don't need SRTs).
560 getConstrTag closure_ptr
561 = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag info_table]
563 info_table = infoTable (closureInfoPtr closure_ptr)
565 cmmGetClosureType :: CmmExpr -> CmmExpr
566 -- Takes a closure pointer, and return the closure type
567 -- obtained from the info table
568 cmmGetClosureType closure_ptr
569 = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType info_table]
571 info_table = infoTable (closureInfoPtr closure_ptr)
573 infoTable :: CmmExpr -> CmmExpr
574 -- Takes an info pointer (the first word of a closure)
575 -- and returns a pointer to the first word of the standard-form
576 -- info table, excluding the entry-code word (if present)
578 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
579 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
581 infoTableConstrTag :: CmmExpr -> CmmExpr
582 -- Takes an info table pointer (from infoTable) and returns the constr tag
583 -- field of the info table (same as the srt_bitmap field)
584 infoTableConstrTag = infoTableSrtBitmap
586 infoTableSrtBitmap :: CmmExpr -> CmmExpr
587 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
588 -- field of the info table
589 infoTableSrtBitmap info_tbl
590 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) bHalfWord
592 infoTableClosureType :: CmmExpr -> CmmExpr
593 -- Takes an info table pointer (from infoTable) and returns the closure type
594 -- field of the info table.
595 infoTableClosureType info_tbl
596 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) bHalfWord
598 infoTablePtrs :: CmmExpr -> CmmExpr
599 infoTablePtrs info_tbl
600 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) bHalfWord
602 infoTableNonPtrs :: CmmExpr -> CmmExpr
603 infoTableNonPtrs info_tbl
604 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) bHalfWord
606 funInfoTable :: CmmExpr -> CmmExpr
607 -- Takes the info pointer of a function,
608 -- and returns a pointer to the first word of the StgFunInfoExtra struct
609 -- in the info table.
610 funInfoTable info_ptr
612 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
614 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
615 -- Past the entry code pointer
617 -------------------------------------------------------------------------
619 -- Static reference tables
621 -------------------------------------------------------------------------
623 -- srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
624 -- srtLabelAndLength NoC_SRT _
626 -- srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
627 -- = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
629 -------------------------------------------------------------------------
631 -- Position independent code
633 -------------------------------------------------------------------------
634 -- In order to support position independent code, we mustn't put absolute
635 -- references into read-only space. Info tables in the tablesNextToCode
636 -- case must be in .text, which is read-only, so we doctor the CmmLits
637 -- to use relative offsets instead.
639 -- Note that this is done even when the -fPIC flag is not specified,
640 -- as we want to keep binary compatibility between PIC and non-PIC.
642 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
644 makeRelativeRefTo info_lbl (CmmLabel lbl)
646 = CmmLabelDiffOff lbl info_lbl 0
647 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
649 = CmmLabelDiffOff lbl info_lbl off
650 makeRelativeRefTo _ lit = lit