[commit: ghc] master: There can be several blocks in a PPC/ELF cmm proc add FETCHPC to all of them (this fixes #7814). (9e46066)

[Gabor Greif]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/9e460664f3179c53f2f439238929b501691ddf24

>---------------------------------------------------------------

commit 9e460664f3179c53f2f439238929b501691ddf24
Author: Gabor Greif <ggreif at gmail.com>
Date:   Mon Apr 8 02:15:09 2013 +0200

    There can be several blocks in a PPC/ELF cmm proc
    add FETCHPC to all of them (this fixes #7814).

>---------------------------------------------------------------

 compiler/nativeGen/PIC.hs | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index e346e7b..b9aa8be 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -710,16 +710,23 @@ initializePicBase_ppc ArchPPC os picReg
                                 (PPC.ImmCLbl gotOffLabel)
                                 (PPC.ImmCLbl mkPicBaseLabel)
 
-            BasicBlock bID insns
-                        = head blocks
+            blocks' = case blocks of
+                       [] -> []
+                       (b:bs) -> fetchPC b : map maybeFetchPC bs
 
-            b' = BasicBlock bID (PPC.FETCHPC picReg
-                               : PPC.LD PPC.archWordSize tmp
-                                    (PPC.AddrRegImm picReg offsetToOffset)
-                               : PPC.ADD picReg picReg (PPC.RIReg tmp)
-                               : insns)
+            maybeFetchPC b@(BasicBlock bID _)
+              | bID `mapMember` info = fetchPC b
+              | otherwise            = b
+
+            fetchPC (BasicBlock bID insns) =
+              BasicBlock bID (PPC.FETCHPC picReg
+                              : PPC.LD PPC.archWordSize tmp
+                                   (PPC.AddrRegImm picReg offsetToOffset)
+                              : PPC.ADD picReg picReg (PPC.RIReg tmp)
+                              : insns)
+
+        return (CmmProc info lab live (ListGraph blocks') : gotOffset : statics)
 
-        return (CmmProc info lab live (ListGraph (b' : tail blocks)) : gotOffset : statics)
 
 initializePicBase_ppc ArchPPC OSDarwin picReg
         (CmmProc info lab live (ListGraph blocks) : statics)