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