ghc/compiler/codeGen/CgExpr.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CgExpr.lhs,v 1.31 2000/03/23 17:45:19 simonpj Exp $
   5 %
   6 %********************************************************
   7 %*                                                      *
   8 \section[CgExpr]{Converting @StgExpr@s}
   9 %*                                                      *
  10 %********************************************************
  11
  12 \begin{code}
  13 module CgExpr ( cgExpr ) where
  14
  15 #include "HsVersions.h"
  16
  17 import Constants        ( mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE )
  18 import StgSyn
  19 import CgMonad
  20 import AbsCSyn
  21 import AbsCUtils        ( mkAbstractCs )
  22 import CLabel           ( mkClosureTblLabel )
  23
  24 import SMRep            ( fixedHdrSize )
  25 import CgBindery        ( getArgAmodes, getArgAmode, CgIdInfo,
  26                           nukeDeadBindings, addBindC, addBindsC )
  27 import CgCase           ( cgCase, saveVolatileVarsAndRegs,
  28                           restoreCurrentCostCentre )
  29 import CgClosure        ( cgRhsClosure, cgStdRhsClosure )
  30 import CgCon            ( buildDynCon, cgReturnDataCon )
  31 import CgLetNoEscape    ( cgLetNoEscapeClosure )
  32 import CgRetConv        ( dataReturnConvPrim )
  33 import CgTailCall       ( cgTailCall, performReturn, performPrimReturn,
  34                           mkDynamicAlgReturnCode, mkPrimReturnCode,
  35                           tailCallPrimOp, returnUnboxedTuple
  36                         )
  37 import ClosureInfo      ( mkClosureLFInfo, mkSelectorLFInfo,
  38                           mkApLFInfo, layOutDynCon )
  39 import CostCentre       ( sccAbleCostCentre, isSccCountCostCentre )
  40 import Id               ( idPrimRep, idType, Id )
  41 import VarSet
  42 import DataCon          ( DataCon, dataConTyCon )
  43 import IdInfo           ( ArityInfo(..) )
  44 import PrimOp           ( primOpOutOfLine, ccallMayGC,
  45                           getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..)
  46                         )
  47 import PrimRep          ( getPrimRepSize, PrimRep(..), isFollowableRep )
  48 import TyCon            ( maybeTyConSingleCon,
  49                           isUnboxedTupleTyCon, isEnumerationTyCon )
  50 import Type             ( Type, typePrimRep, splitTyConApp_maybe, repType )
  51 import Maybes           ( assocMaybe, maybeToBool )
  52 import Unique           ( mkBuiltinUnique )
  53 import BasicTypes       ( TopLevelFlag(..), RecFlag(..) )
  54 import Outputable
  55 \end{code}
  56
  57 This module provides the support code for @StgToAbstractC@ to deal
  58 with STG {\em expressions}.  See also @CgClosure@, which deals
  59 with closures, and @CgCon@, which deals with constructors.
  60
  61 \begin{code}
  62 cgExpr  :: StgExpr              -- input
  63         -> Code                 -- output
  64 \end{code}
  65
  66 %********************************************************
  67 %*                                                      *
  68 %*              Tail calls                              *
  69 %*                                                      *
  70 %********************************************************
  71
  72 ``Applications'' mean {\em tail calls}, a service provided by module
  73 @CgTailCall@.  This includes literals, which show up as
  74 @(STGApp (StgLitArg 42) [])@.
  75
  76 \begin{code}
  77 cgExpr (StgApp fun args) = cgTailCall fun args
  78 \end{code}
  79
  80 %********************************************************
  81 %*                                                      *
  82 %*              STG ConApps  (for inline versions)      *
  83 %*                                                      *
  84 %********************************************************
  85
  86 \begin{code}
  87 cgExpr (StgConApp con args)
  88   = getArgAmodes args `thenFC` \ amodes ->
  89     cgReturnDataCon con amodes
  90 \end{code}
  91
  92 Literals are similar to constructors; they return by putting
  93 themselves in an appropriate register and returning to the address on
  94 top of the stack.
  95
  96 \begin{code}
  97 cgExpr (StgLit lit)
  98   = performPrimReturn (text "literal" <+> ppr lit) (CLit lit)
  99 \end{code}
 100
 101
 102 %********************************************************
 103 %*                                                      *
 104 %*              STG PrimApps  (unboxed primitive ops)   *
 105 %*                                                      *
 106 %********************************************************
 107
 108 Here is where we insert real live machine instructions.
 109
 110 NOTE about _ccall_GC_:
 111
 112 A _ccall_GC_ is treated as an out-of-line primop (returns True
 113 for primOpOutOfLine) so that when we see the call in case context
 114         case (ccall ...) of { ... }
 115 we get a proper stack frame on the stack when we perform it.  When we
 116 get in a tail-call position, however, we need to actually perform the
 117 call, so we treat it as an inline primop.
 118
 119 \begin{code}
 120 cgExpr (StgPrimApp op@(CCallOp ccall) args res_ty)
 121   = primRetUnboxedTuple op args res_ty
 122
 123 -- tagToEnum# is special: we need to pull the constructor out of the table,
 124 -- and perform an appropriate return.
 125
 126 cgExpr (StgPrimApp TagToEnumOp [arg] res_ty)
 127   = ASSERT(isEnumerationTyCon tycon)
 128     getArgAmode arg `thenFC` \amode ->
 129         -- save the tag in a temporary in case amode overlaps
 130         -- with node.
 131     absC (CAssign dyn_tag amode)        `thenC`
 132     performReturn (
 133                 CAssign (CReg node)
 134                         (CVal (CIndex
 135                           (CLbl (mkClosureTblLabel tycon) PtrRep)
 136                           dyn_tag PtrRep) PtrRep))
 137             (\ sequel -> mkDynamicAlgReturnCode tycon dyn_tag sequel)
 138    where
 139         dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
 140           --
 141           -- if you're reading this code in the attempt to figure
 142           -- out why the compiler panic'ed here, it is probably because
 143           -- you used tagToEnum# in a non-monomorphic setting, e.g.,
 144           --         intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
 145           --
 146           -- That won't work.
 147           --
 148         (Just (tycon,_)) = splitTyConApp_maybe res_ty
 149
 150
 151 cgExpr x@(StgPrimApp op args res_ty)
 152   | primOpOutOfLine op = tailCallPrimOp op args
 153   | otherwise
 154   = ASSERT(op /= SeqOp) -- can't handle SeqOp
 155
 156     getArgAmodes args   `thenFC` \ arg_amodes ->
 157
 158     case (getPrimOpResultInfo op) of
 159
 160         ReturnsPrim kind ->
 161             let result_amode = CReg (dataReturnConvPrim kind) in
 162             performReturn
 163               (COpStmt [result_amode] op arg_amodes [{-no vol_regs-}])
 164               (mkPrimReturnCode (text "primapp)" <+> ppr x))
 165
 166         -- otherwise, must be returning an enumerated type (eg. Bool).
 167         -- we've only got the tag in R2, so we have to load the constructor
 168         -- itself into R1.
 169
 170         ReturnsAlg tycon
 171             | isUnboxedTupleTyCon tycon -> primRetUnboxedTuple op args res_ty
 172
 173             | isEnumerationTyCon  tycon ->
 174                 performReturn
 175                      (COpStmt [dyn_tag] op arg_amodes [{-no vol_regs-}])
 176                           (\ sequel ->
 177                           absC (CAssign (CReg node) closure_lbl) `thenC`
 178                           mkDynamicAlgReturnCode tycon dyn_tag sequel)
 179
 180             where
 181                -- Pull a unique out of thin air to put the tag in.
 182                -- It shouldn't matter if this overlaps with anything - we're
 183                -- about to return anyway.
 184                dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
 185
 186                closure_lbl = CVal (CIndex
 187                                (CLbl (mkClosureTblLabel tycon) PtrRep)
 188                                dyn_tag PtrRep) PtrRep
 189
 190 \end{code}
 191
 192 %********************************************************
 193 %*                                                      *
 194 %*              Case expressions                        *
 195 %*                                                      *
 196 %********************************************************
 197 Case-expression conversion is complicated enough to have its own
 198 module, @CgCase@.
 199 \begin{code}
 200
 201 cgExpr (StgCase expr live_vars save_vars bndr srt alts)
 202   = cgCase expr live_vars save_vars bndr srt alts
 203 \end{code}
 204
 205
 206 %********************************************************
 207 %*                                                      *
 208 %*              Let and letrec                          *
 209 %*                                                      *
 210 %********************************************************
 211 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
 212
 213 \begin{code}
 214 cgExpr (StgLet (StgNonRec name rhs) expr)
 215   = cgRhs name rhs      `thenFC` \ (name, info) ->
 216     addBindC name info  `thenC`
 217     cgExpr expr
 218
 219 cgExpr (StgLet (StgRec pairs) expr)
 220   = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
 221                             listFCs [ cgRhs b e | (b,e) <- pairs ]
 222     ) `thenFC` \ new_bindings ->
 223
 224     addBindsC new_bindings `thenC`
 225     cgExpr expr
 226 \end{code}
 227
 228 \begin{code}
 229 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
 230   =     -- Figure out what volatile variables to save
 231     nukeDeadBindings live_in_whole_let  `thenC`
 232     saveVolatileVarsAndRegs live_in_rhss
 233             `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->
 234     -- ToDo: cost centre???
 235     restoreCurrentCostCentre maybe_cc_slot `thenFC` \ restore_cc ->
 236
 237         -- Save those variables right now!
 238     absC save_assts                             `thenC`
 239
 240         -- Produce code for the rhss
 241         -- and add suitable bindings to the environment
 242     cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`
 243
 244         -- Do the body
 245     setEndOfBlockInfo rhs_eob_info (cgExpr body)
 246 \end{code}
 247
 248
 249 %********************************************************
 250 %*                                                      *
 251 %*              SCC Expressions                         *
 252 %*                                                      *
 253 %********************************************************
 254
 255 SCC expressions are treated specially. They set the current cost
 256 centre.
 257 \begin{code}
 258 cgExpr (StgSCC cc expr)
 259   = ASSERT(sccAbleCostCentre cc)
 260     costCentresC
 261         SLIT("SET_CCC")
 262         [mkCCostCentre cc, mkIntCLit (if isSccCountCostCentre cc then 1 else 0)]
 263     `thenC`
 264     cgExpr expr
 265 \end{code}
 266
 267 ToDo: counting of dict sccs ...
 268
 269 %********************************************************
 270 %*                                                      *
 271 %*              Non-top-level bindings                  *
 272 %*                                                      *
 273 %********************************************************
 274 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
 275
 276 We rely on the support code in @CgCon@ (to do constructors) and
 277 in @CgClosure@ (to do closures).
 278
 279 \begin{code}
 280 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
 281         -- the Id is passed along so a binding can be set up
 282
 283 cgRhs name (StgRhsCon maybe_cc con args)
 284   = getArgAmodes args                           `thenFC` \ amodes ->
 285     buildDynCon name maybe_cc con amodes        `thenFC` \ idinfo ->
 286     returnFC (name, idinfo)
 287
 288 cgRhs name (StgRhsClosure cc bi srt@(NoSRT) fvs upd_flag args body)
 289   = mkRhsClosure name cc bi srt fvs upd_flag args body
 290 cgRhs name (StgRhsClosure cc bi srt@(SRT _ _) fvs upd_flag args body)
 291   = mkRhsClosure name cc bi srt fvs upd_flag args body
 292 \end{code}
 293
 294 mkRhsClosure looks for two special forms of the right-hand side:
 295         a) selector thunks.
 296         b) AP thunks
 297
 298 If neither happens, it just calls mkClosureLFInfo.  You might think
 299 that mkClosureLFInfo should do all this, but it seems wrong for the
 300 latter to look at the structure of an expression
 301
 302 Selectors
 303 ~~~~~~~~~
 304 We look at the body of the closure to see if it's a selector---turgid,
 305 but nothing deep.  We are looking for a closure of {\em exactly} the
 306 form:
 307
 308 ...  = [the_fv] \ u [] ->
 309          case the_fv of
 310            con a_1 ... a_n -> a_i
 311
 312
 313 \begin{code}
 314 mkRhsClosure    bndr cc bi srt
 315                 [the_fv]                -- Just one free var
 316                 upd_flag                -- Updatable thunk
 317                 []                      -- A thunk
 318                 body@(StgCase (StgApp scrutinee [{-no args-}])
 319                       _ _ _ _   -- ignore uniq, etc.
 320                       (StgAlgAlts case_ty
 321                          [(con, params, use_mask,
 322                             (StgApp selectee [{-no args-}]))]
 323                          StgNoDefault))
 324   |  the_fv == scrutinee                        -- Scrutinee is the only free variable
 325   && maybeToBool maybe_offset                   -- Selectee is a component of the tuple
 326   && offset_into_int <= mAX_SPEC_SELECTEE_SIZE  -- Offset is small enough
 327   = ASSERT(is_single_constructor)
 328     cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
 329   where
 330     lf_info               = mkSelectorLFInfo (idType bndr) offset_into_int
 331                                 (isUpdatable upd_flag)
 332     (_, params_w_offsets) = layOutDynCon con idPrimRep params
 333     maybe_offset          = assocMaybe params_w_offsets selectee
 334     Just the_offset       = maybe_offset
 335     offset_into_int       = the_offset - fixedHdrSize
 336     is_single_constructor = maybeToBool (maybeTyConSingleCon tycon)
 337     tycon                 = dataConTyCon con
 338 \end{code}
 339
 340
 341 Ap thunks
 342 ~~~~~~~~~
 343
 344 A more generic AP thunk of the form
 345
 346         x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
 347
 348 A set of these is compiled statically into the RTS, so we just use
 349 those.  We could extend the idea to thunks where some of the x_i are
 350 global ids (and hence not free variables), but this would entail
 351 generating a larger thunk.  It might be an option for non-optimising
 352 compilation, though.
 353
 354 We only generate an Ap thunk if all the free variables are pointers,
 355 for semi-obvious reasons.
 356
 357 \begin{code}
 358 mkRhsClosure    bndr cc bi srt
 359                 fvs
 360                 upd_flag
 361                 []                      -- No args; a thunk
 362                 body@(StgApp fun_id args)
 363
 364   | length args + 1 == arity
 365         && all isFollowableRep (map idPrimRep fvs)
 366         && isUpdatable upd_flag
 367         && arity <= mAX_SPEC_AP_SIZE
 368
 369                    -- Ha! an Ap thunk
 370         = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
 371
 372    where
 373         lf_info = mkApLFInfo (idType bndr) upd_flag arity
 374         -- the payload has to be in the correct order, hence we can't
 375         -- just use the fvs.
 376         payload    = StgVarArg fun_id : args
 377         arity      = length fvs
 378 \end{code}
 379
 380 The default case
 381 ~~~~~~~~~~~~~~~~
 382 \begin{code}
 383 mkRhsClosure bndr cc bi srt fvs upd_flag args body
 384   = getSRTLabel         `thenFC` \ srt_label ->
 385     let lf_info =
 386           mkClosureLFInfo bndr NotTopLevel fvs upd_flag args srt_label srt
 387     in
 388     cgRhsClosure bndr cc bi fvs args body lf_info
 389 \end{code}
 390
 391
 392 %********************************************************
 393 %*                                                      *
 394 %*              Let-no-escape bindings
 395 %*                                                      *
 396 %********************************************************
 397 \begin{code}
 398 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs)
 399   = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot
 400                         NonRecursive binder rhs
 401                                 `thenFC` \ (binder, info) ->
 402     addBindC binder info
 403
 404 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
 405   = fixC (\ new_bindings ->
 406                 addBindsC new_bindings  `thenC`
 407                 listFCs [ cgLetNoEscapeRhs full_live_in_rhss
 408                                 rhs_eob_info maybe_cc_slot Recursive b e
 409                         | (b,e) <- pairs ]
 410     ) `thenFC` \ new_bindings ->
 411
 412     addBindsC new_bindings
 413   where
 414     -- We add the binders to the live-in-rhss set so that we don't
 415     -- delete the bindings for the binder from the environment!
 416     full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
 417
 418 cgLetNoEscapeRhs
 419     :: StgLiveVars      -- Live in rhss
 420     -> EndOfBlockInfo
 421     -> Maybe VirtualSpOffset
 422     -> RecFlag
 423     -> Id
 424     -> StgRhs
 425     -> FCode (Id, CgIdInfo)
 426
 427 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
 428                  (StgRhsClosure cc bi srt _ upd_flag args body)
 429   = -- We could check the update flag, but currently we don't switch it off
 430     -- for let-no-escaped things, so we omit the check too!
 431     -- case upd_flag of
 432     --     Updatable -> panic "cgLetNoEscapeRhs"        -- Nothing to update!
 433     --     other     -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
 434     cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info maybe_cc_slot rec args body
 435
 436 -- For a constructor RHS we want to generate a single chunk of code which
 437 -- can be jumped to from many places, which will return the constructor.
 438 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
 439 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
 440                  (StgRhsCon cc con args)
 441   = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} NoSRT full_live_in_rhss rhs_eob_info maybe_cc_slot rec
 442         []      --No args; the binder is data structure, not a function
 443         (StgConApp con args)
 444 \end{code}
 445
 446 Little helper for primitives that return unboxed tuples.
 447
 448
 449 \begin{code}
 450 primRetUnboxedTuple :: PrimOp -> [StgArg] -> Type -> Code
 451 primRetUnboxedTuple op args res_ty
 452   = getArgAmodes args       `thenFC` \ arg_amodes ->
 453     {-
 454       put all the arguments in temporaries so they don't get stomped when
 455       we push the return address.
 456     -}
 457     let
 458       n_args              = length args
 459       arg_uniqs           = map mkBuiltinUnique [0 .. n_args-1]
 460       arg_reps            = map getArgPrimRep args
 461       arg_temps           = zipWith CTemp arg_uniqs arg_reps
 462     in
 463     absC (mkAbstractCs (zipWith CAssign arg_temps arg_amodes)) `thenC`
 464     {-
 465       allocate some temporaries for the return values.
 466     -}
 467     let
 468       (tc,ty_args)      = case splitTyConApp_maybe (repType res_ty) of
 469                             Nothing -> pprPanic "primRetUnboxedTuple" (ppr res_ty)
 470                             Just pr -> pr
 471       prim_reps          = map typePrimRep ty_args
 472       temp_uniqs         = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1]
 473       temp_amodes        = zipWith CTemp temp_uniqs prim_reps
 474     in
 475     returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps []))
 476 \end{code}