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 SMRep
  16 import CoreSyn
  17 import CgProf
  18 import CgHeapery
  19 import CgBindery
  20 import CgCase
  21 import CgClosure
  22 import CgCon
  23 import CgLetNoEscape
  24 import CgCallConv
  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 MachOp
  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 [
 125                  if isFollowableArg (typeCgRep (stgArgType stg_arg))
 126                  then assignPtrTemp arg
 127                  else assignNonPtrTemp arg
 128                      | (arg, stg_arg) <- arg_exprs]
 129     let arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
 130     {-
 131         Now, allocate some result regs.
 132     -}
 133     (res_reps,res_regs,res_hints)  <- newUnboxedTupleRegs res_ty
 134     ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
 135         emitForeignCall (zip res_regs res_hints) fcall
 136            arg_hints emptyVarSet{-no live vars-}
 137
 138 -- tagToEnum# is special: we need to pull the constructor out of the table,
 139 -- and perform an appropriate return.
 140
 141 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
 142   = ASSERT(isEnumerationTyCon tycon)
 143     do  { (rep,amode) <- getArgAmode arg
 144         ; amode' <- if isFollowableArg rep
 145                     then assignPtrTemp amode
 146                     else assignNonPtrTemp amode
 147                                         -- We're going to use it twice,
 148                                         -- so save in a temp if non-trivial
 149         ; this_pkg <- getThisPackage
 150         ; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
 151         ; performReturn emitReturnInstr }
 152    where
 153           -- If you're reading this code in the attempt to figure
 154           -- out why the compiler panic'ed here, it is probably because
 155           -- you used tagToEnum# in a non-monomorphic setting, e.g.,
 156           --         intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
 157           -- That won't work.
 158         tycon = tyConAppTyCon res_ty
 159
 160
 161 cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
 162   | primOpOutOfLine primop
 163         = tailCallPrimOp primop args
 164
 165   | ReturnsPrim VoidRep <- result_info
 166         = do cgPrimOp [] primop args emptyVarSet
 167              performReturn emitReturnInstr
 168
 169   | ReturnsPrim rep <- result_info
 170         = do res <- if isFollowableArg (typeCgRep res_ty)
 171                         then newPtrTemp (argMachRep (typeCgRep res_ty))
 172                         else newNonPtrTemp (argMachRep (typeCgRep res_ty))
 173              cgPrimOp [res] primop args emptyVarSet
 174              performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
 175
 176   | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
 177         = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
 178              cgPrimOp regs primop args emptyVarSet{-no live vars-}
 179              returnUnboxedTuple (zip reps (map (CmmReg . CmmLocal) regs))
 180
 181   | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
 182         -- c.f. cgExpr (...TagToEnumOp...)
 183         = do tag_reg <- if isFollowableArg (typeCgRep res_ty)
 184                         then newPtrTemp wordRep
 185                         else newNonPtrTemp wordRep
 186              this_pkg <- getThisPackage
 187              cgPrimOp [tag_reg] primop args emptyVarSet
 188              stmtC (CmmAssign nodeReg
 189                     (tagToClosure this_pkg tycon
 190                      (CmmReg (CmmLocal tag_reg))))
 191              performReturn emitReturnInstr
 192   where
 193         result_info = getPrimOpResultInfo primop
 194 \end{code}
 195
 196 %********************************************************
 197 %*                                                      *
 198 %*              Case expressions                        *
 199 %*                                                      *
 200 %********************************************************
 201 Case-expression conversion is complicated enough to have its own
 202 module, @CgCase@.
 203 \begin{code}
 204
 205 cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
 206   = cgCase expr live_vars save_vars bndr srt alt_type alts
 207 \end{code}
 208
 209
 210 %********************************************************
 211 %*                                                      *
 212 %*              Let and letrec                          *
 213 %*                                                      *
 214 %********************************************************
 215 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
 216
 217 \begin{code}
 218 cgExpr (StgLet (StgNonRec name rhs) expr)
 219   = cgRhs name rhs      `thenFC` \ (name, info) ->
 220     addBindC name info  `thenC`
 221     cgExpr expr
 222
 223 cgExpr (StgLet (StgRec pairs) expr)
 224   = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
 225                             listFCs [ cgRhs b e | (b,e) <- pairs ]
 226     ) `thenFC` \ new_bindings ->
 227
 228     addBindsC new_bindings `thenC`
 229     cgExpr expr
 230 \end{code}
 231
 232 \begin{code}
 233 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
 234   = do  {       -- Figure out what volatile variables to save
 235         ; nukeDeadBindings live_in_whole_let
 236         ; (save_assts, rhs_eob_info, maybe_cc_slot)
 237                 <- saveVolatileVarsAndRegs live_in_rhss
 238
 239         -- Save those variables right now!
 240         ; emitStmts save_assts
 241
 242         -- Produce code for the rhss
 243         -- and add suitable bindings to the environment
 244         ; cgLetNoEscapeBindings live_in_rhss rhs_eob_info
 245                                 maybe_cc_slot bindings
 246
 247         -- Do the body
 248         ; setEndOfBlockInfo rhs_eob_info (cgExpr body) }
 249 \end{code}
 250
 251
 252 %********************************************************
 253 %*                                                      *
 254 %*              SCC Expressions                         *
 255 %*                                                      *
 256 %********************************************************
 257
 258 SCC expressions are treated specially. They set the current cost
 259 centre.
 260
 261 \begin{code}
 262 cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
 263 \end{code}
 264
 265 %********************************************************
 266 %*                                                     *
 267 %*             Hpc Tick Boxes                          *
 268 %*                                                     *
 269 %********************************************************
 270
 271 \begin{code}
 272 cgExpr (StgTick m n expr) = do cgTickBox m n; cgExpr expr
 273 \end{code}
 274
 275 %********************************************************
 276 %*                                                      *
 277 %*              Non-top-level bindings                  *
 278 %*                                                      *
 279 %********************************************************
 280 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
 281
 282 We rely on the support code in @CgCon@ (to do constructors) and
 283 in @CgClosure@ (to do closures).
 284
 285 \begin{code}
 286 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
 287         -- the Id is passed along so a binding can be set up
 288
 289 cgRhs name (StgRhsCon maybe_cc con args)
 290   = do  { amodes <- getArgAmodes args
 291         ; idinfo <- buildDynCon name maybe_cc con amodes
 292         ; returnFC (name, idinfo) }
 293
 294 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
 295   = do this_pkg <- getThisPackage
 296        mkRhsClosure this_pkg name cc bi srt 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    this_pkg bndr cc bi srt
 320                 [the_fv]                -- Just one free var
 321                 upd_flag                -- Updatable thunk
 322                 []                      -- A thunk
 323                 body@(StgCase (StgApp scrutinee [{-no args-}])
 324                       _ _ _ _   -- ignore uniq, etc.
 325                       (AlgAlt tycon)
 326                       [(DataAlt con, params, use_mask,
 327                             (StgApp selectee [{-no args-}]))])
 328   |  the_fv == scrutinee                -- Scrutinee is the only free variable
 329   && maybeToBool maybe_offset           -- Selectee is a component of the tuple
 330   && offset_into_int <= mAX_SPEC_SELECTEE_SIZE  -- Offset is small enough
 331   = -- NOT TRUE: ASSERT(is_single_constructor)
 332     -- The simplifier may have statically determined that the single alternative
 333     -- is the only possible case and eliminated the others, even if there are
 334     -- other constructors in the datatype.  It's still ok to make a selector
 335     -- thunk in this case, because we *know* which constructor the scrutinee
 336     -- will evaluate to.
 337     cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
 338   where
 339     lf_info               = mkSelectorLFInfo bndr offset_into_int
 340                                  (isUpdatable upd_flag)
 341     (_, params_w_offsets) = layOutDynConstr this_pkg con (addIdReps params)
 342                         -- Just want the layout
 343     maybe_offset          = assocMaybe params_w_offsets selectee
 344     Just the_offset       = maybe_offset
 345     offset_into_int       = the_offset - fixedHdrSize
 346 \end{code}
 347
 348 Ap thunks
 349 ~~~~~~~~~
 350
 351 A more generic AP thunk of the form
 352
 353         x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
 354
 355 A set of these is compiled statically into the RTS, so we just use
 356 those.  We could extend the idea to thunks where some of the x_i are
 357 global ids (and hence not free variables), but this would entail
 358 generating a larger thunk.  It might be an option for non-optimising
 359 compilation, though.
 360
 361 We only generate an Ap thunk if all the free variables are pointers,
 362 for semi-obvious reasons.
 363
 364 \begin{code}
 365 mkRhsClosure    this_pkg bndr cc bi srt
 366                 fvs
 367                 upd_flag
 368                 []                      -- No args; a thunk
 369                 body@(StgApp fun_id args)
 370
 371   | args `lengthIs` (arity-1)
 372         && all isFollowableArg (map idCgRep fvs)
 373         && isUpdatable upd_flag
 374         && arity <= mAX_SPEC_AP_SIZE
 375
 376                    -- Ha! an Ap thunk
 377         = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
 378
 379    where
 380         lf_info = mkApLFInfo bndr upd_flag arity
 381         -- the payload has to be in the correct order, hence we can't
 382         -- just use the fvs.
 383         payload = StgVarArg fun_id : args
 384         arity   = length fvs
 385 \end{code}
 386
 387 The default case
 388 ~~~~~~~~~~~~~~~~
 389 \begin{code}
 390 mkRhsClosure this_pkg bndr cc bi srt fvs upd_flag args body
 391   = cgRhsClosure bndr cc bi srt fvs upd_flag args body
 392 \end{code}
 393
 394
 395 %********************************************************
 396 %*                                                      *
 397 %*              Let-no-escape bindings
 398 %*                                                      *
 399 %********************************************************
 400 \begin{code}
 401 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
 402         (StgNonRec binder rhs)
 403   = do  { (binder,info) <- cgLetNoEscapeRhs live_in_rhss rhs_eob_info
 404                                             maybe_cc_slot
 405                                             NonRecursive binder rhs
 406         ; addBindC binder info }
 407
 408 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
 409   = do  { new_bindings <- fixC (\ new_bindings -> do
 410                 { addBindsC new_bindings
 411                 ; listFCs [ cgLetNoEscapeRhs full_live_in_rhss
 412                                 rhs_eob_info maybe_cc_slot Recursive b e
 413                           | (b,e) <- pairs ] })
 414
 415         ; addBindsC new_bindings }
 416   where
 417     -- We add the binders to the live-in-rhss set so that we don't
 418     -- delete the bindings for the binder from the environment!
 419     full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
 420
 421 cgLetNoEscapeRhs
 422     :: StgLiveVars      -- Live in rhss
 423     -> EndOfBlockInfo
 424     -> Maybe VirtualSpOffset
 425     -> RecFlag
 426     -> Id
 427     -> StgRhs
 428     -> FCode (Id, CgIdInfo)
 429
 430 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
 431                  (StgRhsClosure cc bi _ upd_flag srt args body)
 432   = -- We could check the update flag, but currently we don't switch it off
 433     -- for let-no-escaped things, so we omit the check too!
 434     -- case upd_flag of
 435     --     Updatable -> panic "cgLetNoEscapeRhs"        -- Nothing to update!
 436     --     other     -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
 437     cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
 438         maybe_cc_slot rec args body
 439
 440 -- For a constructor RHS we want to generate a single chunk of code which
 441 -- can be jumped to from many places, which will return the constructor.
 442 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
 443 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
 444                  (StgRhsCon cc con args)
 445   = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
 446                          full_live_in_rhss rhs_eob_info maybe_cc_slot rec
 447         []      --No args; the binder is data structure, not a function
 448         (StgConApp con args)
 449 \end{code}
 450
 451 Little helper for primitives that return unboxed tuples.
 452
 453 \begin{code}
 454 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [MachHint])
 455 newUnboxedTupleRegs res_ty =
 456    let
 457         ty_args = tyConAppArgs (repType res_ty)
 458         (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
 459                                                     let rep = typeCgRep ty,
 460                                                     nonVoidArg rep ]
 461         make_new_temp rep = if isFollowableArg rep
 462                             then newPtrTemp (argMachRep rep)
 463                             else newNonPtrTemp (argMachRep rep)
 464    in do
 465    regs <- mapM make_new_temp reps
 466    return (reps,regs,hints)
 467 \end{code}