compiler/codeGen/CgExpr.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 \begin{code}
   7 module CgExpr ( cgExpr ) where
   8
   9 #include "HsVersions.h"
  10
  11 import Constants
  12 import StgSyn
  13 import CgMonad
  14
  15 import CostCentre
  16 import SMRep
  17 import CoreSyn
  18 import CgProf
  19 import CgHeapery
  20 import CgBindery
  21 import CgCase
  22 import CgClosure
  23 import CgCon
  24 import CgLetNoEscape
  25 import CgTailCall
  26 import CgInfoTbls
  27 import CgForeignCall
  28 import CgPrimOp
  29 import CgHpc
  30 import CgUtils
  31 import ClosureInfo
  32 import Cmm
  33 import CmmUtils
  34 import VarSet
  35 import Literal
  36 import PrimOp
  37 import Id
  38 import TyCon
  39 import Type
  40 import Maybes
  41 import ListSetOps
  42 import BasicTypes
  43 import Util
  44 import Outputable
  45 \end{code}
  46
  47 This module provides the support code for @StgToAbstractC@ to deal
  48 with STG {\em expressions}.  See also @CgClosure@, which deals
  49 with closures, and @CgCon@, which deals with constructors.
  50
  51 \begin{code}
  52 cgExpr  :: StgExpr              -- input
  53         -> Code                 -- output
  54 \end{code}
  55
  56 %********************************************************
  57 %*                                                      *
  58 %*              Tail calls                              *
  59 %*                                                      *
  60 %********************************************************
  61
  62 ``Applications'' mean {\em tail calls}, a service provided by module
  63 @CgTailCall@.  This includes literals, which show up as
  64 @(STGApp (StgLitArg 42) [])@.
  65
  66 \begin{code}
  67 cgExpr (StgApp fun args) = cgTailCall fun args
  68 \end{code}
  69
  70 %********************************************************
  71 %*                                                      *
  72 %*              STG ConApps  (for inline versions)      *
  73 %*                                                      *
  74 %********************************************************
  75
  76 \begin{code}
  77 cgExpr (StgConApp con args)
  78   = do  { amodes <- getArgAmodes args
  79         ; cgReturnDataCon con amodes }
  80 \end{code}
  81
  82 Literals are similar to constructors; they return by putting
  83 themselves in an appropriate register and returning to the address on
  84 top of the stack.
  85
  86 \begin{code}
  87 cgExpr (StgLit lit)
  88   = do  { cmm_lit <- cgLit lit
  89         ; performPrimReturn rep (CmmLit cmm_lit) }
  90   where
  91     rep = (typeCgRep) (literalType lit)
  92 \end{code}
  93
  94
  95 %********************************************************
  96 %*                                                      *
  97 %*      PrimOps and foreign calls.
  98 %*                                                      *
  99 %********************************************************
 100
 101 NOTE about "safe" foreign calls: a safe foreign call is never compiled
 102 inline in a case expression.  When we see
 103
 104         case (ccall ...) of { ... }
 105
 106 We generate a proper return address for the alternatives and push the
 107 stack frame before doing the call, so that in the event that the call
 108 re-enters the RTS the stack is in a sane state.
 109
 110 \begin{code}
 111 cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
 112     {-
 113         First, copy the args into temporaries.  We're going to push
 114         a return address right before doing the call, so the args
 115         must be out of the way.
 116     -}
 117     reps_n_amodes <- getArgAmodes stg_args
 118     let
 119         -- Get the *non-void* args, and jiggle them with shimForeignCall
 120         arg_exprs = [ (shimForeignCallArg stg_arg expr, stg_arg)
 121                     | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
 122                       nonVoidArg rep]
 123
 124     arg_tmps <- sequence [ assignTemp arg
 125                          | (arg, _) <- arg_exprs]
 126     let arg_hints = zipWith CmmHinted arg_tmps (map (typeForeignHint.stgArgType) stg_args)
 127     {-
 128         Now, allocate some result regs.
 129     -}
 130     (res_reps,res_regs,res_hints)  <- newUnboxedTupleRegs res_ty
 131     ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
 132         emitForeignCall (zipWith CmmHinted res_regs res_hints) fcall
 133            arg_hints emptyVarSet{-no live vars-}
 134
 135 -- tagToEnum# is special: we need to pull the constructor out of the table,
 136 -- and perform an appropriate return.
 137
 138 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
 139   = ASSERT(isEnumerationTyCon tycon)
 140     do  { (_rep,amode) <- getArgAmode arg
 141         ; amode' <- assignTemp amode    -- We're going to use it twice,
 142                                         -- so save in a temp if non-trivial
 143         ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
 144         ; performReturn emitReturnInstr }
 145    where
 146           -- If you're reading this code in the attempt to figure
 147           -- out why the compiler panic'ed here, it is probably because
 148           -- you used tagToEnum# in a non-monomorphic setting, e.g.,
 149           --         intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
 150           -- That won't work.
 151         tycon = tyConAppTyCon res_ty
 152
 153
 154 cgExpr (StgOpApp (StgPrimOp primop) args res_ty)
 155   | primOpOutOfLine primop
 156         = tailCallPrimOp primop args
 157
 158   | ReturnsPrim VoidRep <- result_info
 159         = do cgPrimOp [] primop args emptyVarSet
 160              performReturn emitReturnInstr
 161
 162   | ReturnsPrim rep <- result_info
 163         = do res <- newTemp (typeCmmType res_ty)
 164              cgPrimOp [res] primop args emptyVarSet
 165              performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
 166
 167   | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
 168         = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
 169              cgPrimOp regs primop args emptyVarSet{-no live vars-}
 170              returnUnboxedTuple (zip reps (map (CmmReg . CmmLocal) regs))
 171
 172   | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
 173         -- c.f. cgExpr (...TagToEnumOp...)
 174         = do tag_reg <- newTemp bWord   -- The tag is a word
 175              cgPrimOp [tag_reg] primop args emptyVarSet
 176              stmtC (CmmAssign nodeReg
 177                     (tagToClosure tycon
 178                      (CmmReg (CmmLocal tag_reg))))
 179              performReturn emitReturnInstr
 180   where
 181         result_info = getPrimOpResultInfo primop
 182
 183 cgExpr (StgOpApp (StgPrimCallOp primcall) args _res_ty)
 184   = tailCallPrimCall primcall args
 185 \end{code}
 186
 187 %********************************************************
 188 %*                                                      *
 189 %*              Case expressions                        *
 190 %*                                                      *
 191 %********************************************************
 192 Case-expression conversion is complicated enough to have its own
 193 module, @CgCase@.
 194 \begin{code}
 195
 196 cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
 197   = setSRT srt $ cgCase expr live_vars save_vars bndr alt_type alts
 198 \end{code}
 199
 200
 201 %********************************************************
 202 %*                                                      *
 203 %*              Let and letrec                          *
 204 %*                                                      *
 205 %********************************************************
 206 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
 207
 208 \begin{code}
 209 cgExpr (StgLet (StgNonRec name rhs) expr)
 210   = cgRhs name rhs      `thenFC` \ (name, info) ->
 211     addBindC name info  `thenC`
 212     cgExpr expr
 213
 214 cgExpr (StgLet (StgRec pairs) expr)
 215   = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
 216                             listFCs [ cgRhs b e | (b,e) <- pairs ]
 217     ) `thenFC` \ new_bindings ->
 218
 219     addBindsC new_bindings `thenC`
 220     cgExpr expr
 221 \end{code}
 222
 223 \begin{code}
 224 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
 225   = do  {       -- Figure out what volatile variables to save
 226         ; nukeDeadBindings live_in_whole_let
 227         ; (save_assts, rhs_eob_info, maybe_cc_slot)
 228                 <- saveVolatileVarsAndRegs live_in_rhss
 229
 230         -- Save those variables right now!
 231         ; emitStmts save_assts
 232
 233         -- Produce code for the rhss
 234         -- and add suitable bindings to the environment
 235         ; cgLetNoEscapeBindings live_in_rhss rhs_eob_info
 236                                 maybe_cc_slot bindings
 237
 238         -- Do the body
 239         ; setEndOfBlockInfo rhs_eob_info (cgExpr body) }
 240 \end{code}
 241
 242
 243 %********************************************************
 244 %*                                                      *
 245 %*              SCC Expressions                         *
 246 %*                                                      *
 247 %********************************************************
 248
 249 SCC expressions are treated specially. They set the current cost
 250 centre.
 251
 252 \begin{code}
 253 cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
 254 \end{code}
 255
 256 %********************************************************
 257 %*                                                     *
 258 %*             Hpc Tick Boxes                          *
 259 %*                                                     *
 260 %********************************************************
 261
 262 \begin{code}
 263 cgExpr (StgTick m n expr) = do cgTickBox m n; cgExpr expr
 264 \end{code}
 265
 266 %********************************************************
 267 %*                                                     *
 268 %*             Anything else                           *
 269 %*                                                     *
 270 %********************************************************
 271
 272 \begin{code}
 273 cgExpr _ = panic "cgExpr"
 274 \end{code}
 275
 276 %********************************************************
 277 %*                                                      *
 278 %*              Non-top-level bindings                  *
 279 %*                                                      *
 280 %********************************************************
 281 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
 282
 283 We rely on the support code in @CgCon@ (to do constructors) and
 284 in @CgClosure@ (to do closures).
 285
 286 \begin{code}
 287 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
 288         -- the Id is passed along so a binding can be set up
 289
 290 cgRhs name (StgRhsCon maybe_cc con args)
 291   = do  { amodes <- getArgAmodes args
 292         ; idinfo <- buildDynCon name maybe_cc con amodes
 293         ; returnFC (name, idinfo) }
 294
 295 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
 296   = setSRT srt $ mkRhsClosure name cc bi fvs upd_flag args body
 297 \end{code}
 298
 299 mkRhsClosure looks for two special forms of the right-hand side:
 300         a) selector thunks.
 301         b) AP thunks
 302
 303 If neither happens, it just calls mkClosureLFInfo.  You might think
 304 that mkClosureLFInfo should do all this, but it seems wrong for the
 305 latter to look at the structure of an expression
 306
 307 Selectors
 308 ~~~~~~~~~
 309 We look at the body of the closure to see if it's a selector---turgid,
 310 but nothing deep.  We are looking for a closure of {\em exactly} the
 311 form:
 312
 313 ...  = [the_fv] \ u [] ->
 314          case the_fv of
 315            con a_1 ... a_n -> a_i
 316
 317
 318 \begin{code}
 319 mkRhsClosure :: Id -> CostCentreStack -> StgBinderInfo
 320              -> [Id] -> UpdateFlag -> [Id] -> GenStgExpr Id Id
 321              -> FCode (Id, CgIdInfo)
 322 mkRhsClosure    bndr cc bi
 323                 [the_fv]                -- Just one free var
 324                 upd_flag                -- Updatable thunk
 325                 []                      -- A thunk
 326                 body@(StgCase (StgApp scrutinee [{-no args-}])
 327                       _ _ _ srt   -- ignore uniq, etc.
 328                       (AlgAlt _)
 329                       [(DataAlt con, params, _use_mask,
 330                             (StgApp selectee [{-no args-}]))])
 331   |  the_fv == scrutinee                -- Scrutinee is the only free variable
 332   && maybeToBool maybe_offset           -- Selectee is a component of the tuple
 333   && offset_into_int <= mAX_SPEC_SELECTEE_SIZE  -- Offset is small enough
 334   = -- NOT TRUE: ASSERT(is_single_constructor)
 335     -- The simplifier may have statically determined that the single alternative
 336     -- is the only possible case and eliminated the others, even if there are
 337     -- other constructors in the datatype.  It's still ok to make a selector
 338     -- thunk in this case, because we *know* which constructor the scrutinee
 339     -- will evaluate to.
 340     setSRT srt $ cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
 341   where
 342     lf_info               = mkSelectorLFInfo bndr offset_into_int
 343                                  (isUpdatable upd_flag)
 344     (_, params_w_offsets) = layOutDynConstr con (addIdReps params)
 345                         -- Just want the layout
 346     maybe_offset          = assocMaybe params_w_offsets selectee
 347     Just the_offset       = maybe_offset
 348     offset_into_int       = the_offset - fixedHdrSize
 349 \end{code}
 350
 351 Ap thunks
 352 ~~~~~~~~~
 353
 354 A more generic AP thunk of the form
 355
 356         x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
 357
 358 A set of these is compiled statically into the RTS, so we just use
 359 those.  We could extend the idea to thunks where some of the x_i are
 360 global ids (and hence not free variables), but this would entail
 361 generating a larger thunk.  It might be an option for non-optimising
 362 compilation, though.
 363
 364 We only generate an Ap thunk if all the free variables are pointers,
 365 for semi-obvious reasons.
 366
 367 \begin{code}
 368 mkRhsClosure    bndr cc bi
 369                 fvs
 370                 upd_flag
 371                 []                      -- No args; a thunk
 372                 body@(StgApp fun_id args)
 373
 374   | args `lengthIs` (arity-1)
 375         && all isFollowableArg (map idCgRep fvs)
 376         && isUpdatable upd_flag
 377         && arity <= mAX_SPEC_AP_SIZE
 378
 379                    -- Ha! an Ap thunk
 380         = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
 381
 382    where
 383         lf_info = mkApLFInfo bndr upd_flag arity
 384         -- the payload has to be in the correct order, hence we can't
 385         -- just use the fvs.
 386         payload = StgVarArg fun_id : args
 387         arity   = length fvs
 388 \end{code}
 389
 390 The default case
 391 ~~~~~~~~~~~~~~~~
 392 \begin{code}
 393 mkRhsClosure bndr cc bi fvs upd_flag args body
 394   = cgRhsClosure bndr cc bi fvs upd_flag args body
 395 \end{code}
 396
 397
 398 %********************************************************
 399 %*                                                      *
 400 %*              Let-no-escape bindings
 401 %*                                                      *
 402 %********************************************************
 403 \begin{code}
 404 cgLetNoEscapeBindings :: StgLiveVars -> EndOfBlockInfo
 405                       -> Maybe VirtualSpOffset -> GenStgBinding Id Id
 406                       -> Code
 407 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
 408         (StgNonRec binder rhs)
 409   = do  { (binder,info) <- cgLetNoEscapeRhs live_in_rhss rhs_eob_info
 410                                             maybe_cc_slot
 411                                             NonRecursive binder rhs
 412         ; addBindC binder info }
 413
 414 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
 415   = do  { new_bindings <- fixC (\ new_bindings -> do
 416                 { addBindsC new_bindings
 417                 ; listFCs [ cgLetNoEscapeRhs full_live_in_rhss
 418                                 rhs_eob_info maybe_cc_slot Recursive b e
 419                           | (b,e) <- pairs ] })
 420
 421         ; addBindsC new_bindings }
 422   where
 423     -- We add the binders to the live-in-rhss set so that we don't
 424     -- delete the bindings for the binder from the environment!
 425     full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,_) <- pairs])
 426
 427 cgLetNoEscapeRhs
 428     :: StgLiveVars      -- Live in rhss
 429     -> EndOfBlockInfo
 430     -> Maybe VirtualSpOffset
 431     -> RecFlag
 432     -> Id
 433     -> StgRhs
 434     -> FCode (Id, CgIdInfo)
 435
 436 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
 437                  (StgRhsClosure cc bi _ _upd_flag srt args body)
 438   = -- We could check the update flag, but currently we don't switch it off
 439     -- for let-no-escaped things, so we omit the check too!
 440     -- case upd_flag of
 441     --     Updatable -> panic "cgLetNoEscapeRhs"        -- Nothing to update!
 442     --     other     -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
 443     setSRT srt $ cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info
 444         maybe_cc_slot rec args body
 445
 446 -- For a constructor RHS we want to generate a single chunk of code which
 447 -- can be jumped to from many places, which will return the constructor.
 448 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
 449 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
 450                  (StgRhsCon cc con args)
 451   = setSRT NoSRT $ cgLetNoEscapeClosure binder cc noBinderInfo{-safe-}
 452                          full_live_in_rhss rhs_eob_info maybe_cc_slot rec
 453         []      --No args; the binder is data structure, not a function
 454         (StgConApp con args)
 455 \end{code}
 456
 457 Little helper for primitives that return unboxed tuples.
 458
 459 \begin{code}
 460 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [ForeignHint])
 461 newUnboxedTupleRegs res_ty =
 462    let
 463         ty_args = tyConAppArgs (repType res_ty)
 464         (reps,hints) = unzip [ (rep, typeForeignHint ty) | ty <- ty_args,
 465                                                     let rep = typeCgRep ty,
 466                                                     nonVoidArg rep ]
 467         make_new_temp rep = newTemp (argMachRep rep)
 468    in do
 469    regs <- mapM make_new_temp reps
 470    return (reps,regs,hints)
 471 \end{code}