+
+-- First we try to detect a few common cases and produce better code for
+-- these then the default case. We are mostly trying to detect Cmm code
+-- like I32[Sp + n] and use 'getelementptr' operations instead of the
+-- generic case that uses casts and pointer arithmetic
+genStore env addr@(CmmReg (CmmGlobal r)) val
+ = genStore_fast env addr r 0 val
+
+genStore env addr@(CmmRegOff (CmmGlobal r) n) val
+ = genStore_fast env addr r n val
+
+genStore env addr@(CmmMachOp (MO_Add _) [
+ (CmmReg (CmmGlobal r)),
+ (CmmLit (CmmInt n _))])
+ val
+ = genStore_fast env addr r (fromInteger n) val
+
+genStore env addr@(CmmMachOp (MO_Sub _) [
+ (CmmReg (CmmGlobal r)),
+ (CmmLit (CmmInt n _))])
+ val
+ = genStore_fast env addr r (negate $ fromInteger n) val
+
+-- generic case
+genStore env addr val = genStore_slow env addr val
+
+-- | CmmStore operation
+-- This is a special case for storing to a global register pointer
+-- offset such as I32[Sp+8].
+genStore_fast :: LlvmEnv -> CmmExpr -> GlobalReg -> Int -> CmmExpr
+ -> UniqSM StmtData
+genStore_fast env addr r n val
+ = let gr = lmGlobalRegVar r
+ grt = (pLower . getVarType) gr
+ ix = n `div` ((llvmWidthInBits . pLower) grt `div` 8)
+ in case isPointer grt of
+ True -> do
+ (env', vval, stmts, top) <- exprToVar env val
+ (gv, s1) <- doExpr grt $ Load gr
+ (ptr, s2) <- doExpr grt $ GetElemPtr gv [ix]
+ -- We might need a different pointer type, so check
+ case pLower grt == getVarType vval of
+ -- were fine
+ True -> do
+ let s3 = Store vval ptr
+ return (env', stmts `snocOL` s1 `snocOL` s2
+ `snocOL` s3, top)
+
+ -- cast to pointer type needed
+ False -> do
+ let ty = (pLift . getVarType) vval
+ (ptr', s3) <- doExpr ty $ Cast LM_Bitcast ptr ty
+ let s4 = Store vval ptr'
+ return (env', stmts `snocOL` s1 `snocOL` s2
+ `snocOL` s3 `snocOL` s4, top)
+
+ -- If its a bit type then we use the slow method since
+ -- we can't avoid casting anyway.
+ False -> genStore_slow env addr val
+
+
+-- | CmmStore operation
+-- Generic case. Uses casts and pointer arithmetic if needed.
+genStore_slow :: LlvmEnv -> CmmExpr -> CmmExpr -> UniqSM StmtData
+genStore_slow env addr val = do