Add data type information to VectInfo
[ghc-hetmet.git] / compiler / codeGen / CgCon.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP Project, Glasgow University, 1992-1998
4 %
5 \section[CgCon]{Code generation for constructors}
6
7 This module provides the support code for @StgToAbstractC@ to deal
8 with {\em constructors} on the RHSs of let(rec)s.  See also
9 @CgClosure@, which deals with closures.
10
11 \begin{code}
12 module CgCon (
13         cgTopRhsCon, buildDynCon,
14         bindConArgs, bindUnboxedTupleComponents,
15         cgReturnDataCon,
16         cgTyCon
17     ) where
18
19 #include "HsVersions.h"
20
21 import CgMonad
22 import StgSyn
23
24 import CgBindery
25 import CgStackery
26 import CgUtils
27 import CgCallConv
28 import CgHeapery
29 import CgTailCall
30 import CgProf
31 import CgTicky
32 import CgInfoTbls
33 import CLabel
34 import ClosureInfo
35 import CmmUtils
36 import Cmm
37 import SMRep
38 import CostCentre
39 import Constants
40 import TyCon
41 import DataCon
42 import Id
43 import Type
44 import PrelInfo
45 import Outputable
46 import Util
47 import ListSetOps
48 \end{code}
49
50
51 %************************************************************************
52 %*                                                                      *
53 \subsection[toplevel-constructors]{Top-level constructors}
54 %*                                                                      *
55 %************************************************************************
56
57 \begin{code}
58 cgTopRhsCon :: Id               -- Name of thing bound to this RHS
59             -> DataCon          -- Id
60             -> [StgArg]         -- Args
61             -> FCode (Id, CgIdInfo)
62 cgTopRhsCon id con args
63   = do { 
64         ; this_pkg <- getThisPackage
65 #if mingw32_TARGET_OS
66         -- Windows DLLs have a problem with static cross-DLL refs.
67         ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
68 #endif
69         ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
70
71         -- LAY IT OUT
72         ; amodes <- getArgAmodes args
73
74         ; let
75             name          = idName id
76             lf_info       = mkConLFInfo con
77             closure_label = mkClosureLabel this_pkg name
78             caffy         = any stgArgHasCafRefs args
79             (closure_info, amodes_w_offsets) = layOutStaticConstr this_pkg con amodes
80             closure_rep = mkStaticClosureFields
81                              closure_info
82                              dontCareCCS                -- Because it's static data
83                              caffy                      -- Has CAF refs
84                              payload
85
86             payload = map get_lit amodes_w_offsets      
87             get_lit (CmmLit lit, _offset) = lit
88             get_lit other = pprPanic "CgCon.get_lit" (ppr other)
89                 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
90                 -- NB2: all the amodes should be Lits!
91
92                 -- BUILD THE OBJECT
93         ; emitDataLits closure_label closure_rep
94
95                 -- RETURN
96         ; returnFC (id, stableIdInfo id (mkLblExpr closure_label) lf_info) }
97 \end{code}
98
99 %************************************************************************
100 %*                                                                      *
101 %* non-top-level constructors                                           *
102 %*                                                                      *
103 %************************************************************************
104 \subsection[code-for-constructors]{The code for constructors}
105
106 \begin{code}
107 buildDynCon :: Id                 -- Name of the thing to which this constr will
108                                   -- be bound
109             -> CostCentreStack    -- Where to grab cost centre from;
110                                   -- current CCS if currentOrSubsumedCCS
111             -> DataCon            -- The data constructor
112             -> [(CgRep,CmmExpr)] -- Its args
113             -> FCode CgIdInfo     -- Return details about how to find it
114
115 -- We used to pass a boolean indicating whether all the
116 -- args were of size zero, so we could use a static
117 -- construtor; but I concluded that it just isn't worth it.
118 -- Now I/O uses unboxed tuples there just aren't any constructors
119 -- with all size-zero args.
120 --
121 -- The reason for having a separate argument, rather than looking at
122 -- the addr modes of the args is that we may be in a "knot", and
123 -- premature looking at the args will cause the compiler to black-hole!
124 \end{code}
125
126 First we deal with the case of zero-arity constructors.  Now, they
127 will probably be unfolded, so we don't expect to see this case much,
128 if at all, but it does no harm, and sets the scene for characters.
129
130 In the case of zero-arity constructors, or, more accurately, those
131 which have exclusively size-zero (VoidRep) args, we generate no code
132 at all.
133
134 \begin{code}
135 buildDynCon binder cc con []
136   = do this_pkg <- getThisPackage
137        returnFC (stableIdInfo binder
138                            (mkLblExpr (mkClosureLabel this_pkg (dataConName con)))
139                            (mkConLFInfo con))
140 \end{code}
141
142 The following three paragraphs about @Char@-like and @Int@-like
143 closures are obsolete, but I don't understand the details well enough
144 to properly word them, sorry. I've changed the treatment of @Char@s to
145 be analogous to @Int@s: only a subset is preallocated, because @Char@
146 has now 31 bits. Only literals are handled here. -- Qrczak
147
148 Now for @Char@-like closures.  We generate an assignment of the
149 address of the closure to a temporary.  It would be possible simply to
150 generate no code, and record the addressing mode in the environment,
151 but we'd have to be careful if the argument wasn't a constant --- so
152 for simplicity we just always asssign to a temporary.
153
154 Last special case: @Int@-like closures.  We only special-case the
155 situation in which the argument is a literal in the range
156 @mIN_INTLIKE@..@mAX_INTLILKE@.  NB: for @Char@-like closures we can
157 work with any old argument, but for @Int@-like ones the argument has
158 to be a literal.  Reason: @Char@ like closures have an argument type
159 which is guaranteed in range.
160
161 Because of this, we use can safely return an addressing mode.
162
163 \begin{code}
164 buildDynCon binder cc con [arg_amode]
165   | maybeIntLikeCon con 
166   , (_, CmmLit (CmmInt val _)) <- arg_amode
167   , let val_int = (fromIntegral val) :: Int
168   , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
169   = do  { let intlike_lbl   = mkRtsDataLabel SLIT("stg_INTLIKE_closure")
170               offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
171                 -- INTLIKE closures consist of a header and one word payload
172               intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
173         ; returnFC (stableIdInfo binder intlike_amode (mkConLFInfo con)) }
174
175 buildDynCon binder cc con [arg_amode]
176   | maybeCharLikeCon con 
177   , (_, CmmLit (CmmInt val _)) <- arg_amode
178   , let val_int = (fromIntegral val) :: Int
179   , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
180   = do  { let charlike_lbl   = mkRtsDataLabel SLIT("stg_CHARLIKE_closure")
181               offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
182                 -- CHARLIKE closures consist of a header and one word payload
183               charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
184         ; returnFC (stableIdInfo binder charlike_amode (mkConLFInfo con)) }
185 \end{code}
186
187 Now the general case.
188
189 \begin{code}
190 buildDynCon binder ccs con args
191   = do  { 
192         ; this_pkg <- getThisPackage
193         ; let
194             (closure_info, amodes_w_offsets) = layOutDynConstr this_pkg con args
195
196         ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
197         ; returnFC (heapIdInfo binder hp_off lf_info) }
198   where
199     lf_info = mkConLFInfo con
200
201     use_cc      -- cost-centre to stick in the object
202       | currentOrSubsumedCCS ccs = curCCS
203       | otherwise                = CmmLit (mkCCostCentreStack ccs)
204
205     blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
206 \end{code}
207
208
209 %************************************************************************
210 %*                                                                      *
211 %* constructor-related utility function:                                *
212 %*              bindConArgs is called from cgAlt of a case              *
213 %*                                                                      *
214 %************************************************************************
215 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
216
217 @bindConArgs@ $con args$ augments the environment with bindings for the
218 binders $args$, assuming that we have just returned from a @case@ which
219 found a $con$.
220
221 \begin{code}
222 bindConArgs :: DataCon -> [Id] -> Code
223 bindConArgs con args
224   = do this_pkg <- getThisPackage
225        let
226           bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
227           (_, args_w_offsets)    = layOutDynConstr this_pkg con (addIdReps args)
228         --
229        ASSERT(not (isUnboxedTupleCon con)) return ()
230        mapCs bind_arg args_w_offsets
231 \end{code}
232
233 Unboxed tuples are handled slightly differently - the object is
234 returned in registers and on the stack instead of the heap.
235
236 \begin{code}
237 bindUnboxedTupleComponents
238         :: [Id]                         -- Args
239         -> FCode ([(Id,GlobalReg)],     -- Regs assigned
240                   WordOff,              -- Number of pointer stack slots
241                   WordOff,              -- Number of non-pointer stack slots
242                   VirtualSpOffset)      -- Offset of return address slot
243                                         -- (= realSP on entry)
244
245 bindUnboxedTupleComponents args
246  =  do  {   
247           vsp <- getVirtSp
248         ; rsp <- getRealSp
249
250            -- Assign as many components as possible to registers
251         ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
252
253                 -- Separate the rest of the args into pointers and non-pointers
254               (ptr_args, nptr_args) = separateByPtrFollowness stk_args
255   
256                 -- Allocate the rest on the stack
257                 -- The real SP points to the return address, above which any 
258                 -- leftover unboxed-tuple components will be allocated
259               (ptr_sp,  ptr_offsets)  = mkVirtStkOffsets rsp    ptr_args
260               (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
261               ptrs  = ptr_sp  - rsp
262               nptrs = nptr_sp - ptr_sp
263
264             -- The stack pointer points to the last stack-allocated component
265         ; setRealAndVirtualSp nptr_sp
266
267             -- We have just allocated slots starting at real SP + 1, and set the new
268             -- virtual SP to the topmost allocated slot.  
269             -- If the virtual SP started *below* the real SP, we've just jumped over
270             -- some slots that won't be in the free-list, so put them there
271             -- This commonly happens because we've freed the return-address slot
272             -- (trimming back the virtual SP), but the real SP still points to that slot
273         ; freeStackSlots [vsp+1,vsp+2 .. rsp]
274
275         ; bindArgsToRegs reg_args
276         ; bindArgsToStack ptr_offsets
277         ; bindArgsToStack nptr_offsets
278
279         ; returnFC (reg_args, ptrs, nptrs, rsp) }
280 \end{code}
281
282 %************************************************************************
283 %*                                                                      *
284         Actually generate code for a constructor return
285 %*                                                                      *
286 %************************************************************************
287
288
289 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
290 sure the @amodes@ passed don't conflict with each other.
291 \begin{code}
292 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
293
294 cgReturnDataCon con amodes
295   = ASSERT( amodes `lengthIs` dataConRepArity con )
296     do  { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
297         ; case sequel of
298             CaseAlts _ (Just (alts, deflt_lbl)) bndr
299               ->    -- Ho! We know the constructor so we can
300                     -- go straight to the right alternative
301                  case assocMaybe alts (dataConTagZ con) of {
302                     Just join_lbl -> build_it_then (jump_to join_lbl);
303                     Nothing
304                         -- Special case!  We're returning a constructor to the default case
305                         -- of an enclosing case.  For example:
306                         --
307                         --      case (case e of (a,b) -> C a b) of
308                         --        D x -> ...
309                         --        y   -> ...<returning here!>...
310                         --
311                         -- In this case,
312                         --      if the default is a non-bind-default (ie does not use y),
313                         --      then we should simply jump to the default join point;
314     
315                         | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
316                         | otherwise         -> build_it_then (jump_to deflt_lbl) }
317     
318             other_sequel        -- The usual case
319               | isUnboxedTupleCon con -> returnUnboxedTuple amodes
320               | otherwise -> build_it_then emitReturnInstr
321         }
322   where
323     jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
324     build_it_then return_code
325       = do {    -- BUILD THE OBJECT IN THE HEAP
326                 -- The first "con" says that the name bound to this
327                 -- closure is "con", which is a bit of a fudge, but it only
328                 -- affects profiling
329
330                 -- This Id is also used to get a unique for a
331                 -- temporary variable, if the closure is a CHARLIKE.
332                 -- funnily enough, this makes the unique always come
333                 -- out as '54' :-)
334              tickyReturnNewCon (length amodes)
335            ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
336            ; amode <- idInfoToAmode idinfo
337            ; checkedAbsC (CmmAssign nodeReg amode)
338            ; performReturn return_code }
339 \end{code}
340
341
342 %************************************************************************
343 %*                                                                      *
344         Generating static stuff for algebraic data types
345 %*                                                                      *
346 %************************************************************************
347
348         [These comments are rather out of date]
349
350 \begin{tabular}{lll}
351 Info tbls &      Macro  &            Kind of constructor \\
352 \hline
353 info & @CONST_INFO_TABLE@&    Zero arity (no info -- compiler uses static closure)\\
354 info & @CHARLIKE_INFO_TABLE@& Charlike   (no info -- compiler indexes fixed array)\\
355 info & @INTLIKE_INFO_TABLE@&  Intlike; the one macro generates both info tbls\\
356 info & @SPEC_INFO_TABLE@&     SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
357 info & @GEN_INFO_TABLE@&      GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
358 \end{tabular}
359
360 Possible info tables for constructor con:
361
362 \begin{description}
363 \item[@_con_info@:]
364 Used for dynamically let(rec)-bound occurrences of
365 the constructor, and for updates.  For constructors
366 which are int-like, char-like or nullary, when GC occurs,
367 the closure tries to get rid of itself.
368
369 \item[@_static_info@:]
370 Static occurrences of the constructor
371 macro: @STATIC_INFO_TABLE@.
372 \end{description}
373
374 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
375 it's place is taken by the top level defn of the constructor.
376
377 For charlike and intlike closures there is a fixed array of static
378 closures predeclared.
379
380 \begin{code}
381 cgTyCon :: TyCon -> FCode [Cmm]  -- each constructor gets a separate Cmm
382 cgTyCon tycon
383   = do  { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
384
385             -- Generate a table of static closures for an enumeration type
386             -- Put the table after the data constructor decls, because the
387             -- datatype closure table (for enumeration types)
388             -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
389         ; extra <- 
390            if isEnumerationTyCon tycon then do
391                 tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel 
392                                                 (tyConName tycon))
393                            [ CmmLabel (mkLocalClosureLabel (dataConName con))
394                            | con <- tyConDataCons tycon])
395                 return [tbl]
396            else
397                 return []
398
399         ; return (extra ++ constrs)
400     }
401 \end{code}
402
403 Generate the entry code, info tables, and (for niladic constructor) the
404 static closure, for a constructor.
405
406 \begin{code}
407 cgDataCon :: DataCon -> Code
408 cgDataCon data_con
409   = do  {     -- Don't need any dynamic closure code for zero-arity constructors
410           this_pkg <- getThisPackage
411
412         ; let
413             -- To allow the debuggers, interpreters, etc to cope with
414             -- static data structures (ie those built at compile
415             -- time), we take care that info-table contains the
416             -- information we need.
417             (static_cl_info, _) = 
418                 layOutStaticConstr this_pkg data_con arg_reps
419
420             (dyn_cl_info, arg_things) = 
421                 layOutDynConstr    this_pkg data_con arg_reps
422
423             emit_info cl_info ticky_code
424                 = do { code_blks <- getCgStmts the_code
425                      ; emitClosureCodeAndInfoTable cl_info [] code_blks }
426                 where
427                   the_code = do { ticky_code
428                                 ; ldvEnter (CmmReg nodeReg)
429                                 ; body_code }
430
431             arg_reps :: [(CgRep, Type)]
432             arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
433
434             body_code = do {    
435                         -- NB: We don't set CC when entering data (WDP 94/06)
436                              tickyReturnOldCon (length arg_things)
437                            ; performReturn emitReturnInstr }
438                                 -- noStmts: Ptr to thing already in Node
439
440         ; whenC (not (isNullaryRepDataCon data_con))
441                 (emit_info dyn_cl_info tickyEnterDynCon)
442
443                 -- Dynamic-Closure first, to reduce forward references
444         ; emit_info static_cl_info tickyEnterStaticCon }
445 \end{code}