Add weak symbol support to Cmmwip/andreask/weak_symbols

9 files changed, 98 insertions, 8 deletions

diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index 893ca556db..6b7b28d02a 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -23,6 +23,7 @@ module GHC.Cmm (
      ListGraph(..), pprBBlock,
 
      -- * Info Tables
+     updateInfoTabelLabel,
      CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,
      ClosureTypeInfo(..),
      ProfilingInfo(..), ConstrDescription,
@@ -173,6 +174,10 @@ data ProfilingInfo
   = NoProfilingInfo
   | ProfilingInfo ByteString ByteString -- closure_type, closure_desc
   deriving Eq
+
+updateInfoTabelLabel :: (CLabel -> CLabel) -> CmmInfoTable -> CmmInfoTable
+updateInfoTabelLabel f tbl = tbl { cit_lbl = f (cit_lbl tbl) }
+
 -----------------------------------------------------------------------------
 --              Static Data
 -----------------------------------------------------------------------------
@@ -216,7 +221,10 @@ do so would end up in segfaults at execution when using linkers that do not
 enforce writability of those sections, such as the gold linker.
 -}
 
-data Section = Section SectionType CLabel
+data Section = Section
+  { section_type :: SectionType
+  , section_label :: CLabel -- ^ E.g. "foo" for .text.foo
+  }
 
 data CmmStatic
   = CmmStaticLit CmmLit
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 723970e520..38ca8f3097 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -86,6 +86,8 @@ module GHC.Cmm.CLabel (
         mkIPELabel,
         InfoProvEnt(..),
 
+        mkWeakLabel,
+        isWeakLabel,
         mkDynamicLinkerLabel,
         mkPicBaseLabel,
         mkDeadStripPreventer,
@@ -152,6 +154,8 @@ import GHC.Utils.Misc
 import GHC.Core.Ppr ( {- instances -} )
 import GHC.CmmToAsm.Config
 import GHC.Types.SrcLoc
+import GHC.Utils.Constants (debugIsOn)
+import GHC.Weak (Weak(Weak))
 
 -- -----------------------------------------------------------------------------
 -- The CLabel type
@@ -261,6 +265,7 @@ data CLabel
   -- | These labels are generated and used inside the NCG only.
   --    They are special variants of a label used for dynamic linking
   --    see module "GHC.CmmToAsm.PIC" for details.
+  --    They are access-only.
   | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
 
   -- | This label is generated and used inside the NCG only.
@@ -285,6 +290,8 @@ data CLabel
   | LargeBitmapLabel
         {-# UNPACK #-} !Unique
 
+  -- | Define label weakly
+  | WeakLabel  CLabel
   deriving Eq
 
 instance Show CLabel where
@@ -365,6 +372,8 @@ instance Ord CLabel where
     compare a1 a2
   compare (HpcTicksLabel a1) (HpcTicksLabel a2) =
     compare a1 a2
+  compare (WeakLabel a1) (WeakLabel a2) =
+    compare a1 a2
   compare (SRTLabel u1) (SRTLabel u2) =
     nonDetCmpUnique u1 u2
   compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =
@@ -401,6 +410,9 @@ instance Ord CLabel where
   compare _ SRTLabel{} = GT
   compare (IPE_Label {}) _ = LT
   compare  _ (IPE_Label{}) = GT
+  compare (WeakLabel {}) _ = LT
+  compare  _ (WeakLabel{}) = GT
+
 
 -- | Record where a foreign label is stored.
 data ForeignLabelSource
@@ -545,7 +557,7 @@ data DynamicLinkerLabelInfo
   | GotSymbolPtr                -- ELF: foo@got
   | GotSymbolOffset             -- ELF: foo@gotoff
 
-  deriving (Eq, Ord)
+  deriving (Eq, Ord,Show)
 
 
 -- -----------------------------------------------------------------------------
@@ -588,6 +600,14 @@ mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
 mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable
                                -- See Note [Proc-point local block entry-point].
 
+mkWeakLabel :: CLabel -> CLabel
+-- We should never need to make weak labels of things not visible externally.
+mkWeakLabel l = assert (externallyVisibleCLabel l) $ WeakLabel l
+
+isWeakLabel :: CLabel -> Bool
+isWeakLabel (WeakLabel _l) = True
+isWeakLabel _              = False
+
 -- Constructing Cmm Labels
 mkDirty_MUT_VAR_Label,
     mkNonmovingWriteBarrierEnabledLabel,
@@ -817,7 +837,7 @@ mkPicBaseLabel                  = PicBaseLabel
 
 -- Constructing miscellaneous other labels
 mkDeadStripPreventer :: CLabel -> CLabel
-mkDeadStripPreventer lbl        = DeadStripPreventer lbl
+mkDeadStripPreventer lbl = DeadStripPreventer lbl
 
 mkStringLitLabel :: Unique -> CLabel
 mkStringLitLabel                = StringLitLabel
@@ -946,6 +966,7 @@ needsCDecl (CC_Label _)                 = True
 needsCDecl (CCS_Label _)                = True
 needsCDecl (IPE_Label {})               = True
 needsCDecl (HpcTicksLabel _)            = True
+needsCDecl (WeakLabel l)                = needsCDecl l
 needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
 needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
 needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
@@ -1074,6 +1095,7 @@ externallyVisibleCLabel (LargeBitmapLabel _)    = False
 externallyVisibleCLabel (SRTLabel _)            = False
 externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
 externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
+externallyVisibleCLabel (WeakLabel lbl)         = True -- We assert all weak labels are also global
 
 externallyVisibleIdLabel :: IdLabelInfo -> Bool
 externallyVisibleIdLabel LocalInfoTable  = False
@@ -1128,11 +1150,12 @@ labelType (StringLitLabel _)                    = DataLabel
 labelType (CC_Label _)                          = DataLabel
 labelType (CCS_Label _)                         = DataLabel
 labelType (IPE_Label {})                        = DataLabel
-labelType (DynamicLinkerLabel _ _)              = DataLabel -- Is this right?
+labelType (DynamicLinkerLabel _ _)              = DataLabel -- Is this right? I think it should be the same as the wrapped label.
 labelType PicBaseLabel                          = DataLabel
 labelType (DeadStripPreventer _)                = DataLabel
 labelType (HpcTicksLabel _)                     = DataLabel
 labelType (LargeBitmapLabel _)                  = DataLabel
+labelType (WeakLabel l)                         = labelType l
 
 idInfoLabelType :: IdLabelInfo -> CLabelType
 idInfoLabelType info =
@@ -1375,6 +1398,9 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
       -}
       maybe_underscore $ text "dsp_" <> pprCLabel platform sty lbl <> text "_dsp"
 
+   WeakLabel lbl
+      -> pprCLabel platform sty lbl -- We only check for weak labels at definition sites.
+
    StringLitLabel u
       -> maybe_underscore $ pprUniqueAlways u <> text "_str"
 
diff --git a/compiler/GHC/Cmm/Lexer.x b/compiler/GHC/Cmm/Lexer.x
index bf379ec7da..ada8f6f3d2 100644
--- a/compiler/GHC/Cmm/Lexer.x
+++ b/compiler/GHC/Cmm/Lexer.x
@@ -98,6 +98,7 @@ $white_no_nl+           ;
   "True"                { kw CmmT_True  }
   "False"               { kw CmmT_False }
   "likely"              { kw CmmT_likely}
+  "attribute_weak"      { kw CmmT_attribute_weak }
 
   P@decimal             { global_regN (\n -> VanillaReg n VGcPtr) }
   R@decimal             { global_regN (\n -> VanillaReg n VNonGcPtr) }
@@ -183,6 +184,7 @@ data CmmToken
   | CmmT_False
   | CmmT_True
   | CmmT_likely
+  | CmmT_attribute_weak
   deriving (Show)
 
 -- -----------------------------------------------------------------------------
@@ -272,7 +274,9 @@ reservedWordsFM = listToUFM $
         ( "gcptr",              CmmT_gcptr ),
         ( "likely",             CmmT_likely),
         ( "True",               CmmT_True  ),
-        ( "False",              CmmT_False )
+        ( "False",              CmmT_False ),
+-- Attribute
+        ( "attribute_weak",     CmmT_attribute_weak )
         ]
 
 tok_decimal span buf len
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 712a7a5e8a..4c37cebbff 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -315,6 +315,7 @@ import qualified Data.ByteString.Char8 as BS8
         'True'  { L _ (CmmT_True ) }
         'False' { L _ (CmmT_False) }
         'likely'{ L _ (CmmT_likely)}
+        'attribute_weak' { L _ (CmmT_attribute_weak)}
 
         'CLOSURE'       { L _ (CmmT_CLOSURE) }
         'INFO_TABLE'    { L _ (CmmT_INFO_TABLE) }
@@ -409,11 +410,14 @@ cmmdata :: { CmmParse () }
                      code (emitDecl (CmmData (Section (section $2) lbl) (CmmStaticsRaw lbl (concat ss)))) }
 
 data_label :: { CmmParse CLabel }
-    : NAME ':'
+    : maybe_weak NAME ':'
                 {% do
                    home_unit_id <- getHomeUnitId
                    liftP $ pure $ do
-                     pure (mkCmmDataLabel home_unit_id (NeedExternDecl False) $1) }
+                     if $1
+                        then pure $ mkWeakLabel (mkCmmDataLabel home_unit_id (NeedExternDecl False) $2)
+                        else pure (mkCmmDataLabel home_unit_id (NeedExternDecl False) $2)
+                         }
 
 statics :: { [CmmParse [CmmStatic]] }
         : {- empty -}                   { [] }
@@ -445,7 +449,7 @@ lits    :: { [CmmParse CmmExpr] }
         | ',' expr lits         { $2 : $3 }
 
 cmmproc :: { CmmParse () }
-        : info maybe_conv maybe_formals maybe_body
+        : info_weak maybe_conv maybe_formals maybe_body
                 { do ((entry_ret_label, info, stk_formals, formals), agraph) <-
                        getCodeScoped $ loopDecls $ do {
                          (entry_ret_label, info, stk_formals) <- $1;
@@ -468,6 +472,20 @@ maybe_body :: { CmmParse () }
            : ';'                { return () }
            | '{' body '}'       { withSourceNote $1 $3 $2 }
 
+maybe_weak :: { Bool }
+           : {- empty -}        { False }
+           | 'attribute_weak'   { True }
+
+info_weak       :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
+                : maybe_weak info
+                        {% return $ do
+                                info@(lbl,tbl,regs) <- $2 :: CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg])
+                                return $ if $1
+                                        then (mkWeakLabel lbl,fmap (updateInfoTabelLabel mkWeakLabel) tbl,regs)
+                                        else info
+
+                        }
+
 info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
         : NAME
                 {% do
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index b06e7f0596..59cb758d30 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -267,10 +267,18 @@ pprTypeDecl platform lbl
       then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl
       else empty
 
+-- Are there assemblers that we support that don't support .weak?
+pprWeakDecl :: Platform -> CLabel -> SDoc
+pprWeakDecl platform lbl =
+   if isWeakLabel lbl
+         then text ".weak" <+> pdoc platform lbl
+         else empty
+
 pprLabel :: Platform -> CLabel -> SDoc
 pprLabel platform lbl =
    pprGloblDecl platform lbl
    $$ pprTypeDecl platform lbl
+   $$ pprWeakDecl platform lbl
    $$ (pdoc platform lbl <> colon)
 
 pprAlign :: Platform -> Alignment -> SDoc
diff --git a/testsuite/tests/cmm/should_compile/Makefile b/testsuite/tests/cmm/should_compile/Makefile
index 6ee7fae2e0..ec977e26d9 100644
--- a/testsuite/tests/cmm/should_compile/Makefile
+++ b/testsuite/tests/cmm/should_compile/Makefile
@@ -13,3 +13,9 @@ T16930:
 	grep -rl "after setInfoTableStackMap" `ls T16930.*`
 	grep -rl "Layout Stack" `ls T16930.*`
 	grep -rl "Post switch plan" `ls T16930.*`
+
+## weak1 and weak2 define the same symbol. Without weak symbols we would get linker errors.
+cmm_weak:
+	'$(TEST_HC)' cmm_weak1.cmm -c
+	'$(TEST_HC)' cmm_weak2.cmm -c
+	'$(TEST_HC)' cmm_weak1.o cmm_weak2.o -o cmm_weak -no-hs-main
diff --git a/testsuite/tests/cmm/should_compile/all.T b/testsuite/tests/cmm/should_compile/all.T
index 5ae7c51726..55262dea76 100644
--- a/testsuite/tests/cmm/should_compile/all.T
+++ b/testsuite/tests/cmm/should_compile/all.T
@@ -1,4 +1,5 @@
 #
 test('selfloop', [cmm_src], compile, ['-no-hs-main'])
 test('T16930', normal, makefile_test, ['T16930'])
+test('cmm_weak', normal, makefile_test, ['cmm_weak'])
 test('T17442', normal, compile, [''])
diff --git a/testsuite/tests/cmm/should_compile/cmm_weak1.cmm b/testsuite/tests/cmm/should_compile/cmm_weak1.cmm
new file mode 100644
index 0000000000..8931889b2e
--- /dev/null
+++ b/testsuite/tests/cmm/should_compile/cmm_weak1.cmm
@@ -0,0 +1,6 @@
+#include "Cmm.h"
+
+attribute_weak weak_thing (W_ counter)
+{
+  return (counter);
+}
diff --git a/testsuite/tests/cmm/should_compile/cmm_weak2.cmm b/testsuite/tests/cmm/should_compile/cmm_weak2.cmm
new file mode 100644
index 0000000000..3b298659b6
--- /dev/null
+++ b/testsuite/tests/cmm/should_compile/cmm_weak2.cmm
@@ -0,0 +1,13 @@
+#include "Cmm.h"
+
+attribute_weak weak_thing (W_ counter)
+{
+  return (counter+1);
+}
+
+//So we can use ghc for linking without complaints
+main (W_ counter)
+{
+  return (counter+1);
+}
+