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