David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/Cmm/CLabel.hs
    ... ... @@ -106,6 +106,7 @@ module GHC.Cmm.CLabel (
    106 106
             labelDynamic,
    
    107 107
             isLocalCLabel,
    
    108 108
             mayRedirectTo,
    
    109
    +        isSRTInfoLabel,
    
    109 110
             isInfoTableLabel,
    
    110 111
             isCmmInfoTableLabel,
    
    111 112
             isConInfoTableLabel,
    
    ... ... @@ -730,6 +731,27 @@ mkOutOfBoundsAccessLabel = mkForeignLabel (fsLit "rtsOutOfBoundsAccess")
    730 731
     mkMemcpyRangeOverlapLabel       = mkForeignLabel (fsLit "rtsMemcpyRangeOverlap") ForeignLabelInExternalPackage ForeignLabelIsFunction
    
    731 732
     mkMUT_VAR_CLEAN_infoLabel       = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN")     CmmInfo
    
    732 733
     
    
    734
    +isSRTInfoLabel :: CLabel -> Bool
    
    735
    +isSRTInfoLabel clbl = case clbl of
    
    736
    +  CmmLabel _ _ lbl CmmInfo -> 
    
    737
    +    lbl == fsLit "stg_SRT_1"
    
    738
    +    || lbl == fsLit "stg_SRT_2"
    
    739
    +    || lbl == fsLit "stg_SRT_3"
    
    740
    +    || lbl == fsLit "stg_SRT_4"
    
    741
    +    || lbl == fsLit "stg_SRT_5"
    
    742
    +    || lbl == fsLit "stg_SRT_6"
    
    743
    +    || lbl == fsLit "stg_SRT_7"
    
    744
    +    || lbl == fsLit "stg_SRT_8"
    
    745
    +    || lbl == fsLit "stg_SRT_9"
    
    746
    +    || lbl == fsLit "stg_SRT_10"
    
    747
    +    || lbl == fsLit "stg_SRT_11"
    
    748
    +    || lbl == fsLit "stg_SRT_12"
    
    749
    +    || lbl == fsLit "stg_SRT_13"
    
    750
    +    || lbl == fsLit "stg_SRT_14"
    
    751
    +    || lbl == fsLit "stg_SRT_15"
    
    752
    +    || lbl == fsLit "stg_SRT_16"
    
    753
    +  _ -> False
    
    754
    +
    
    733 755
     mkSRTInfoLabel :: Int -> CLabel
    
    734 756
     mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo
    
    735 757
      where
    

  • compiler/GHC/CmmToAsm/X86/Ppr.hs
    ... ... @@ -33,7 +33,7 @@ import GHC.CmmToAsm.Ppr
    33 33
     import GHC.Cmm              hiding (topInfoTable)
    
    34 34
     import GHC.Cmm.Dataflow.Label
    
    35 35
     import GHC.Cmm.BlockId
    
    36
    -import GHC.Cmm.CLabel
    
    36
    +import GHC.Cmm.CLabel as CLabel
    
    37 37
     import GHC.Cmm.InitFini
    
    38 38
     import GHC.Cmm.DebugBlock (pprUnwindTable)
    
    39 39
     
    
    ... ... @@ -96,10 +96,15 @@ pprNatCmmDecl config proc@(CmmProc top_info entry_lbl _ (ListGraph blocks)) =
    96 96
               )
    
    97 97
             | otherwise = (empty,empty)
    
    98 98
     
    
    99
    +      section = if platformOS platform == OSMinGW32
    
    100
    +                  && treatAsFunction platform proc_lbl
    
    101
    +                then ReadOnlyData
    
    102
    +                else Text
    
    103
    +
    
    99 104
       in vcat
    
    100 105
         [ -- section directive. Requires proc_lbl when split-section is enabled to
    
    101 106
           -- use as a subsection name.
    
    102
    -      pprSectionAlign config (Section Text proc_lbl)
    
    107
    +      pprSectionAlign config (Section section proc_lbl)
    
    103 108
     
    
    104 109
           -- section alignment. Note that when there is an info table, we align the
    
    105 110
           -- info table and not the entry code!
    
    ... ... @@ -234,7 +239,7 @@ pprGloblDecl platform lbl
    234 239
     
    
    235 240
     pprLabelType' :: IsLine doc => Platform -> CLabel -> doc
    
    236 241
     pprLabelType' platform lbl =
    
    237
    -  if isCFunctionLabel lbl || functionOkInfoTable then
    
    242
    +  if treatAsFunction platform lbl then
    
    238 243
         text "@function"
    
    239 244
       else
    
    240 245
         text "@object"
    
    ... ... @@ -286,10 +291,15 @@ pprLabelType' platform lbl =
    286 291
         every code-like thing to give the needed information for to the tools
    
    287 292
         but mess up with the relocation. https://phabricator.haskell.org/D4730
    
    288 293
         -}
    
    294
    +
    
    295
    +treatAsFunction :: Platform -> CLabel -> Bool
    
    296
    +treatAsFunction platform lbl = isCFunctionLabel lbl || functionOkInfoTable
    
    297
    +  where
    
    289 298
         functionOkInfoTable = platformTablesNextToCode platform &&
    
    290 299
           isInfoTableLabel lbl && not (isCmmInfoTableLabel lbl) && not (isConInfoTableLabel lbl)
    
    291 300
     
    
    292 301
     
    
    302
    +
    
    293 303
     pprTypeDecl :: IsDoc doc => Platform -> CLabel -> doc
    
    294 304
     pprTypeDecl platform lbl
    
    295 305
         = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl