diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index ade39430c028ca011ca20e6e569165e6ec513a14..89709a2bc431a8244548f2d0b89ed46ac0ae4ac4 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -87,11 +87,21 @@ ppc_mkStackDeallocInstr platform amount
 
 ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr]
 ppc_mkStackAllocInstr' platform amount
-  = case platformArch platform of
-    ArchPPC      -> [UPDATE_SP II32 (ImmInt amount)]
-    ArchPPC_64 _ -> [UPDATE_SP II64 (ImmInt amount)]
-    _            -> panic $ "ppc_mkStackAllocInstr' "
-                            ++ show (platformArch platform)
+  | fits16Bits amount
+  = [ LD fmt r0 (AddrRegImm sp zero)
+    , STU fmt r0 (AddrRegImm sp immAmount)
+    ]
+  | otherwise
+  = [ LD fmt r0 (AddrRegImm sp zero)
+    , ADDIS tmp sp (HA immAmount)
+    , ADD tmp tmp (RIImm (LO immAmount))
+    , STU fmt r0 (AddrRegReg sp tmp)
+    ]
+  where
+    fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8)
+    zero = ImmInt 0
+    tmp = tmpReg platform
+    immAmount = ImmInt amount
 
 --
 -- See note [extra spill slots] in X86/Instr.hs
@@ -289,8 +299,6 @@ data Instr
     | NOP                       -- no operation, PowerPC 64 bit
                                 -- needs this as place holder to
                                 -- reload TOC pointer
-    | UPDATE_SP Format Imm      -- expand/shrink spill area on C stack
-                                -- pseudo-instruction
 
 -- | Get the registers that are being used by this instruction.
 -- regUsage doesn't need to do any trickery for jumps and such.
@@ -370,7 +378,6 @@ ppc_regUsageOfInstr platform instr
     MFCR    reg             -> usage ([], [reg])
     MFLR    reg             -> usage ([], [reg])
     FETCHPC reg             -> usage ([], [reg])
-    UPDATE_SP _ _           -> usage ([], [sp])
     _                       -> noUsage
   where
     usage (src, dst) = RU (filter (interesting platform) src)
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 3d9077df1973850a7bf9d1170f30e68f4139222e..ad6c205d877bee59bfa0b82ea3f6eaee18a22d01 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -967,24 +967,6 @@ pprInstr LWSYNC = text "\tlwsync"
 
 pprInstr NOP = text "\tnop"
 
-pprInstr (UPDATE_SP fmt amount@(ImmInt offset))
-   | fits16Bits offset = vcat [
-       pprInstr (LD fmt r0 (AddrRegImm sp (ImmInt 0))),
-       pprInstr (STU fmt r0 (AddrRegImm sp amount))
-     ]
-
-pprInstr (UPDATE_SP fmt amount)
-   = sdocWithPlatform $ \platform ->
-       let tmp = tmpReg platform in
-         vcat [
-           pprInstr (LD fmt r0 (AddrRegImm sp (ImmInt 0))),
-           pprInstr (ADDIS tmp sp (HA amount)),
-           pprInstr (ADD tmp tmp (RIImm (LO amount))),
-           pprInstr (STU fmt r0 (AddrRegReg sp tmp))
-         ]
-
--- pprInstr _ = panic "pprInstr (ppc)"
-
 
 pprLogic :: PtrString -> Reg -> Reg -> RI -> SDoc
 pprLogic op reg1 reg2 ri = hcat [