[project @ 2005-01-23 18:50:40 by wolfgang]

[ghc-hetmet.git] / ghc / compiler / nativeGen / PprMach.hs

diff --git a/ghc/compiler/nativeGen/PprMach.hs b/ghc/compiler/nativeGen/PprMach.hs
index a807cc2..0f33ca3 100644 (file)
--- a/ghc/compiler/nativeGen/PprMach.hs
+++ b/ghc/compiler/nativeGen/PprMach.hs
@@ -27,6 +27,9 @@ import MachInstrs
 
 import CLabel          ( CLabel, pprCLabel, externallyVisibleCLabel,
                          labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
+#if HAVE_SUBSECTIONS_VIA_SYMBOLS
+import CLabel       ( mkDeadStripPreventer )
+#endif
 
 import Panic           ( panic )
 import Unique          ( pprUnique )
@@ -68,8 +71,13 @@ pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
 pprNatCmmTop (CmmProc info lbl params blocks) = 
   pprSectionHeader Text $$
   (if not (null info)
-       then vcat (map pprData info) 
-               $$ pprLabel (entryLblToInfoLbl lbl)
+       then
+#if HAVE_SUBSECTIONS_VIA_SYMBOLS
+            pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
+                <> char ':' $$
+#endif
+            vcat (map pprData info) $$
+            pprLabel (entryLblToInfoLbl lbl)
        else empty) $$
   (case blocks of
        [] -> empty
@@ -77,7 +85,22 @@ pprNatCmmTop (CmmProc info lbl params blocks) =
                (if null info then pprLabel lbl else empty) $$
                -- the first block doesn't get a label:
                vcat (map pprInstr instrs) $$
-               vcat (map pprBasicBlock rest))
+               vcat (map pprBasicBlock rest)
+  )
+#if HAVE_SUBSECTIONS_VIA_SYMBOLS
+        -- If we are using the .subsections_via_symbols directive
+        -- (available on recent versions of Darwin),
+        -- we have to make sure that there is some kind of reference
+        -- from the entry code to a label on the _top_ of of the info table,
+        -- so that the linker will not think it is unreferenced and dead-strip
+        -- it. That's why the label is called a DeadStripPreventer (_dsp).
+  $$ if not (null info)
+                   then text "\t.long "
+                     <+> pprCLabel_asm (entryLblToInfoLbl lbl)
+                     <+> char '-'
+                     <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
+                   else empty
+#endif
 
 
 pprBasicBlock :: NatBasicBlock -> Doc
@@ -512,15 +535,6 @@ pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
 -- -----------------------------------------------------------------------------
 -- pprData: print a 'CmmStatic'
 
-#if defined(linux_TARGET_OS)
-#if defined(powerpc_TARGET_ARCH) || defined(i386_TARGET_ARCH)
-    -- Hack to make dynamic linking work
-pprSectionHeader ReadOnlyData
-    | not opt_PIC && not opt_Static
-    = pprSectionHeader Data
-#endif
-#endif
-
 pprSectionHeader Text
     = ptext
        IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
@@ -540,9 +554,17 @@ pprSectionHeader ReadOnlyData
         IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
        ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
        ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
-        ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
+        ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
                                       SLIT(".section .rodata\n\t.align 2"))
        ,))))
+pprSectionHeader RelocatableReadOnlyData
+    = ptext
+        IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
+       ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
+       ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
+        ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
+                                      SLIT(".data\n\t.align 2"))
+       ,))))
 pprSectionHeader UninitialisedData
     = ptext
         IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
@@ -1335,6 +1357,12 @@ pprInstr GFREE
             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)") 
           ]
 
+pprInstr (FETCHGOT reg)
+   = vcat [ ptext SLIT("\tcall 1f"),
+            hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
+            hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
+                   pprReg I32 reg ]
+          ]
 
 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
 pprInstr_imul64 hi_reg lo_reg