X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPositionIndependentCode.hs;h=edb884677f764605f86119a2f73e2f9c37b05fc2;hb=9de520b7194c9d759147db98deb3cd8d47d0de76;hp=1411bbc6b1dee3e1cee50c6de362485334c42fd6;hpb=81b2276ff9434d97aff683218c34c86479a8d868;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/PositionIndependentCode.hs b/compiler/nativeGen/PositionIndependentCode.hs
index 1411bbc..edb8846 100644
--- a/compiler/nativeGen/PositionIndependentCode.hs
+++ b/compiler/nativeGen/PositionIndependentCode.hs
@@ -1,3 +1,10 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module PositionIndependentCode (
         cmmMakeDynamicReference,
         ReferenceKind(..),
@@ -7,6 +14,8 @@ module PositionIndependentCode (
         initializePicBase
      ) where
 
+#include "HsVersions.h"
+
 {-
   This module handles generation of position independent code and
   dynamic-linking related issues for the native code generator.
@@ -43,12 +52,10 @@ module PositionIndependentCode (
       by GCC are left intact by the mangler (so far only on ppc-darwin
       and ppc-linux).
 -}
-     
-#include "HsVersions.h"
+
 #include "nativeGen/NCG.h"
 
 import Cmm
-import MachOp           ( MachOp(MO_Add), wordRep, MachRep(..) )
 import CLabel           ( CLabel, pprCLabel,
                           mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
                           dynamicLinkerLabelInfo, mkPicBaseLabel,
@@ -69,6 +76,7 @@ import qualified Outputable
 
 import Panic            ( panic )
 import DynFlags
+import FastString
 
 
 -- The most important function here is cmmMakeDynamicReference.
@@ -109,7 +117,7 @@ cmmMakeDynamicReference dflags addImport referenceKind lbl
         AccessViaSymbolPtr -> do
               let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
               addImport symbolPtr
-              return $ CmmLoad (cmmMakePicReference symbolPtr) wordRep
+              return $ CmmLoad (cmmMakePicReference symbolPtr) bWord
         AccessDirectly -> case referenceKind of
                 -- for data, we might have to make some calculations:
               DataReference -> return $ cmmMakePicReference lbl  
@@ -133,7 +141,7 @@ cmmMakePicReference :: CLabel -> CmmExpr
         -- everything gets relocated at runtime
 
 cmmMakePicReference lbl
-    | (opt_PIC || not opt_Static) && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [
+    | (opt_PIC || not opt_Static) && absoluteLabel lbl = CmmMachOp (MO_Add wordWidth) [
             CmmReg (CmmGlobal PicBaseReg),
             CmmLit $ picRelative lbl
         ]
@@ -359,12 +367,12 @@ needImportedSymbols = True
 pprGotDeclaration
     | opt_PIC
     = vcat [
-        ptext SLIT(".section __TEXT,__textcoal_nt,coalesced,no_toc"),
-        ptext SLIT(".weak_definition ___i686.get_pc_thunk.ax"),
-        ptext SLIT(".private_extern ___i686.get_pc_thunk.ax"),
-        ptext SLIT("___i686.get_pc_thunk.ax:"),
-            ptext SLIT("\tmovl (%esp), %eax"),
-            ptext SLIT("\tret")
+        ptext (sLit ".section __TEXT,__textcoal_nt,coalesced,no_toc"),
+        ptext (sLit ".weak_definition ___i686.get_pc_thunk.ax"),
+        ptext (sLit ".private_extern ___i686.get_pc_thunk.ax"),
+        ptext (sLit "___i686.get_pc_thunk.ax:"),
+            ptext (sLit "\tmovl (%esp), %eax"),
+            ptext (sLit "\tret")
     ]
     | otherwise = Pretty.empty
 #else
@@ -383,94 +391,94 @@ pprImportedSymbol importedLbl
     = case opt_PIC of
         False ->
             vcat [
-                ptext SLIT(".symbol_stub"),
-                ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
-                    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-                    ptext SLIT("\tlis r11,ha16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr)"),
-                    ptext SLIT("\tlwz r12,lo16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr)(r11)"),
-                    ptext SLIT("\tmtctr r12"),
-                    ptext SLIT("\taddi r11,r11,lo16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr)"),
-                    ptext SLIT("\tbctr")
+                ptext (sLit ".symbol_stub"),
+                ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"),
+                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+                    ptext (sLit "\tlis r11,ha16(L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr)"),
+                    ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr)(r11)"),
+                    ptext (sLit "\tmtctr r12"),
+                    ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr)"),
+                    ptext (sLit "\tbctr")
             ]
         True ->
             vcat [
-                ptext SLIT(".section __TEXT,__picsymbolstub1,")
-                  <> ptext SLIT("symbol_stubs,pure_instructions,32"),
-                ptext SLIT("\t.align 2"),
-                ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
-                    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-                    ptext SLIT("\tmflr r0"),
-                    ptext SLIT("\tbcl 20,31,L0$") <> pprCLabel_asm lbl,
-                ptext SLIT("L0$") <> pprCLabel_asm lbl <> char ':',
-                    ptext SLIT("\tmflr r11"),
-                    ptext SLIT("\taddis r11,r11,ha16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl <> char ')',
-                    ptext SLIT("\tmtlr r0"),
-                    ptext SLIT("\tlwzu r12,lo16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl
-                        <> ptext SLIT(")(r11)"),
-                    ptext SLIT("\tmtctr r12"),
-                    ptext SLIT("\tbctr")
+                ptext (sLit ".section __TEXT,__picsymbolstub1,")
+                  <> ptext (sLit "symbol_stubs,pure_instructions,32"),
+                ptext (sLit "\t.align 2"),
+                ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"),
+                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+                    ptext (sLit "\tmflr r0"),
+                    ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel_asm lbl,
+                ptext (sLit "L0$") <> pprCLabel_asm lbl <> char ':',
+                    ptext (sLit "\tmflr r11"),
+                    ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm lbl <> char ')',
+                    ptext (sLit "\tmtlr r0"),
+                    ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm lbl
+                        <> ptext (sLit ")(r11)"),
+                    ptext (sLit "\tmtctr r12"),
+                    ptext (sLit "\tbctr")
             ]
     $+$ vcat [
-        ptext SLIT(".lazy_symbol_pointer"),
-        ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"),
-            ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-            ptext SLIT("\t.long dyld_stub_binding_helper")
+        ptext (sLit ".lazy_symbol_pointer"),
+        ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$lazy_ptr:"),
+            ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+            ptext (sLit "\t.long dyld_stub_binding_helper")
     ]
 #elif i386_TARGET_ARCH
     | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
     = case opt_PIC of
         False ->
             vcat [
-                ptext SLIT(".symbol_stub"),
-                ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
-                    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-                    ptext SLIT("\tjmp *L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr"),
-                ptext SLIT("L") <> pprCLabel_asm lbl
-                    <> ptext SLIT("$stub_binder:"),
-                    ptext SLIT("\tpushl $L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr"),
-                    ptext SLIT("\tjmp dyld_stub_binding_helper")
+                ptext (sLit ".symbol_stub"),
+                ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"),
+                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+                    ptext (sLit "\tjmp *L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr"),
+                ptext (sLit "L") <> pprCLabel_asm lbl
+                    <> ptext (sLit "$stub_binder:"),
+                    ptext (sLit "\tpushl $L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr"),
+                    ptext (sLit "\tjmp dyld_stub_binding_helper")
             ]
         True ->
             vcat [
-                ptext SLIT(".section __TEXT,__picsymbolstub2,")
-                    <> ptext SLIT("symbol_stubs,pure_instructions,25"),
-                ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
-                    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-                    ptext SLIT("\tcall ___i686.get_pc_thunk.ax"),
-                ptext SLIT("1:"),
-                    ptext SLIT("\tmovl L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr-1b(%eax),%edx"),
-                    ptext SLIT("\tjmp *%edx"),
-                ptext SLIT("L") <> pprCLabel_asm lbl
-                    <> ptext SLIT("$stub_binder:"),
-                    ptext SLIT("\tlea L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr-1b(%eax),%eax"),
-                    ptext SLIT("\tpushl %eax"),
-                    ptext SLIT("\tjmp dyld_stub_binding_helper")
+                ptext (sLit ".section __TEXT,__picsymbolstub2,")
+                    <> ptext (sLit "symbol_stubs,pure_instructions,25"),
+                ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"),
+                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+                    ptext (sLit "\tcall ___i686.get_pc_thunk.ax"),
+                ptext (sLit "1:"),
+                    ptext (sLit "\tmovl L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr-1b(%eax),%edx"),
+                    ptext (sLit "\tjmp *%edx"),
+                ptext (sLit "L") <> pprCLabel_asm lbl
+                    <> ptext (sLit "$stub_binder:"),
+                    ptext (sLit "\tlea L") <> pprCLabel_asm lbl
+                        <> ptext (sLit "$lazy_ptr-1b(%eax),%eax"),
+                    ptext (sLit "\tpushl %eax"),
+                    ptext (sLit "\tjmp dyld_stub_binding_helper")
             ]
-    $+$ vcat [        ptext SLIT(".section __DATA, __la_sym_ptr")
+    $+$ vcat [        ptext (sLit ".section __DATA, __la_sym_ptr")
                     <> (if opt_PIC then int 2 else int 3)
-                    <> ptext SLIT(",lazy_symbol_pointers"),
-        ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"),
-            ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-            ptext SLIT("\t.long L") <> pprCLabel_asm lbl
-                    <> ptext SLIT("$stub_binder")
+                    <> ptext (sLit ",lazy_symbol_pointers"),
+        ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$lazy_ptr:"),
+            ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+            ptext (sLit "\t.long L") <> pprCLabel_asm lbl
+                    <> ptext (sLit "$stub_binder")
     ]
 #endif
 -- We also have to declare our symbol pointers ourselves:
     | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
     = vcat [
-        ptext SLIT(".non_lazy_symbol_pointer"),
-        char 'L' <> pprCLabel_asm lbl <> ptext SLIT("$non_lazy_ptr:"),
-	    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-            ptext SLIT("\t.long\t0")
+        ptext (sLit ".non_lazy_symbol_pointer"),
+        char 'L' <> pprCLabel_asm lbl <> ptext (sLit "$non_lazy_ptr:"),
+	    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl,
+            ptext (sLit "\t.long\t0")
     ]
 
     | otherwise = empty
@@ -517,7 +525,7 @@ needImportedSymbols = not opt_Static && not opt_PIC
 -- The label used to refer to our "fake GOT" from
 -- position-independent code.
 gotLabel = mkForeignLabel -- HACK: it's not really foreign
-                           FSLIT(".LCTOC1") Nothing False
+                           (fsLit ".LCTOC1") Nothing False
 
 -- pprGotDeclaration
 -- Output whatever needs to be output once per .s file.
@@ -528,8 +536,8 @@ gotLabel = mkForeignLabel -- HACK: it's not really foreign
 pprGotDeclaration
     | not opt_PIC = Pretty.empty
     | otherwise = vcat [
-        ptext SLIT(".section \".got2\",\"aw\""),
-        ptext SLIT(".LCTOC1 = .+32768")
+        ptext (sLit ".section \".got2\",\"aw\""),
+        ptext (sLit ".LCTOC1 = .+32768")
     ]
 
 -- We generate one .long/.quad literal for every symbol we import;
@@ -538,17 +546,17 @@ pprGotDeclaration
 pprImportedSymbol importedLbl
     | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
     = vcat [
-        ptext SLIT(".section \".got2\", \"aw\""),
-        ptext SLIT(".LC_") <> pprCLabel_asm lbl <> char ':',
+        ptext (sLit ".section \".got2\", \"aw\""),
+        ptext (sLit ".LC_") <> pprCLabel_asm lbl <> char ':',
         ptext symbolSize <+> pprCLabel_asm lbl
     ]
 
--- PLT code stubs are generated automatically be the dynamic linker.
+-- PLT code stubs are generated automatically by the dynamic linker.
     | otherwise = empty
     where
-      symbolSize = case wordRep of
-		     I32 -> SLIT("\t.long")
-		     I64 -> SLIT("\t.quad")
+      symbolSize = case wordWidth of
+		     W32 -> sLit "\t.long"
+		     W64 -> sLit "\t.quad"
 		     _ -> panic "Unknown wordRep in pprImportedSymbol"
 
 #else
@@ -589,8 +597,8 @@ initializePicBase :: Reg -> [NatCmmTop] -> NatM [NatCmmTop]
 --          call 1f
 --      1:  popl %picReg
 
-initializePicBase picReg (CmmProc info lab params blocks : statics)
-    = return (CmmProc info lab params (b':tail blocks) : statics)
+initializePicBase picReg (CmmProc info lab params (ListGraph blocks) : statics)
+    = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics)
     where BasicBlock bID insns = head blocks
           b' = BasicBlock bID (FETCHPC picReg : insns)
 
@@ -604,10 +612,10 @@ initializePicBase picReg (CmmProc info lab params blocks : statics)
 -- the (32-bit) offset from our local label to our global offset table
 -- (.LCTOC1 aka gotOffLabel).
 initializePicBase picReg
-    (CmmProc info lab params blocks : statics)
+    (CmmProc info lab params (ListGraph blocks) : statics)
     = do
         gotOffLabel <- getNewLabelNat
-        tmp <- getNewRegNat wordRep
+        tmp <- getNewRegNat $ intSize wordWidth
         let 
             gotOffset = CmmData Text [
                             CmmDataLabel gotOffLabel,
@@ -619,11 +627,11 @@ initializePicBase picReg
                                              (ImmCLbl mkPicBaseLabel)
             BasicBlock bID insns = head blocks
             b' = BasicBlock bID (FETCHPC picReg
-                               : LD wordRep tmp
+                               : LD wordSize tmp
                                     (AddrRegImm picReg offsetToOffset)
                                : ADD picReg picReg (RIReg tmp)
                                : insns)
-        return (CmmProc info lab params (b' : tail blocks) : gotOffset : statics)
+        return (CmmProc info lab params (ListGraph (b' : tail blocks)) : gotOffset : statics)
 #elif i386_TARGET_ARCH && linux_TARGET_OS
 
 -- We cheat a bit here by defining a pseudo-instruction named FETCHGOT
@@ -633,8 +641,8 @@ initializePicBase picReg
 --              addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg
 -- (See PprMach.lhs)
 
-initializePicBase picReg (CmmProc info lab params blocks : statics)
-    = return (CmmProc info lab params (b':tail blocks) : statics)
+initializePicBase picReg (CmmProc info lab params (ListGraph blocks) : statics)
+    = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics)
     where BasicBlock bID insns = head blocks
           b' = BasicBlock bID (FETCHGOT picReg : insns)