Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC

Commits:

11 changed files:

Changes:

  • compiler/GHC/CmmToAsm/AArch64/Instr.hs
    ... ... @@ -114,7 +114,7 @@ regUsageOfInstr platform instr = case instr of
    114 114 
       LSL dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
    115 115 
       LSR dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
    116 116 
       MOV dst src              -> usage (regOp src, regOp dst)
    117 
    -  MOVK dst src             -> usage (regOp src, regOp dst)
    117 
    +  MOVK dst src             -> usage (regOp src ++ regOp dst, regOp dst)
    118 118 
       MOVZ dst src             -> usage (regOp src, regOp dst)
    119 119 
       MVN dst src              -> usage (regOp src, regOp dst)
    120 120 
       ORR dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)

  • compiler/GHC/HsToCore/Foreign/C.hs
    ... ... @@ -328,37 +328,68 @@ dsFCall fn_id co fcall mDeclHeader = do
    328 328 
     toCName :: Id -> String
    329 329 
     toCName i = showSDocOneLine defaultSDocContext (pprCode (ppr (idName i)))
    330 330
    331 
    +{- Note [Collapsing void pointer chains]
    332 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    333 
    +When translating Haskell types like (Ptr (Ptr Abstract)) to C types for capi
    334 
    +wrappers, where Abstract has no CType annotation, naively we would produce
    335 
    +"void**". This is problematic because in C, only void* has implicit conversion
    336 
    +to any pointer type.
    337 
    +Modern compilers (gcc, clang) treat -Wincompatible-pointer-types as an error
    338 
    +by default (#26852), causing compilation failures for capi wrappers.
    339 
    +
    340 
    +The fix is to collapse void pointer chains: whenever the inner type of a
    341 
    +Ptr/FunPtr resolves to void (i.e. the Haskell type has no known C
    342 
    +representation), we return void* instead of void**, void***, etc.
    343 
    +This works because void* implicitly converts to any pointer type in C.
    344 
    +
    345 
    +Examples:
    346 
    +  Ptr Abstract              => void*
    347 
    +  Ptr (Ptr Abstract)        => void*   (used to be void**)
    348 
    +  Ptr (Ptr (Ptr Abstract))  => void*
    349 
    +  Ptr (Ptr CInt)            => int**   (CInt has CType "int", don't collapse)
    350 
    +-}
    351 
    +
    352 
    +-- | See Note [Collapsing void pointer chains]
    331 353 
     toCType :: Type -> (Maybe Header, SDoc)
    332 
    -toCType = f False
    333 
    -    where f voidOK t
    334 
    -           -- First, if we have (Ptr t) of (FunPtr t), then we need to
    354 
    +toCType t = case f False t of
    355 
    +              (mh, _, cType) -> (mh, cType)
    356 
    +    where
    357 
    +      -- The Bool in the return type indicates whether the C type is
    358 
    +      -- "void" due to an unknown Haskell type (True = void-based).
    359 
    +      f :: Bool -> Type -> (Maybe Header, Bool, SDoc)
    360 
    +      f voidOK t
    361 
    +           -- First, if we have (Ptr t) or (FunPtr t), then we need to
    335 362 
                -- convert t to a C type and put a * after it. If we don't
    336 363 
                -- know a type for t, then "void" is fine, though.
    364 
    +           -- If the inner type is void-based, we collapse the pointer
    365 
    +           -- chain to just "void*". See Note [Collapsing void pointer chains].
    337 366 
                | Just (ptr, [t']) <- splitTyConApp_maybe t
    338 367 
                , tyConName ptr `elem` [ptrTyConName, funPtrTyConName]
    339 368 
                   = case f True t' of
    340 
    -                (mh, cType') ->
    341 
    -                    (mh, cType' <> char '*')
    369 
    +                (mh, True, _) ->
    370 
    +                    (mh, True, text "void*")
    371 
    +                (mh, False, cType') ->
    372 
    +                    (mh, False, cType' <> char '*')
    342 373 
                -- Otherwise, if we have a type constructor application, then
    343 374 
                -- see if there is a C type associated with that constructor.
    344 375 
                -- Note that we aren't looking through type synonyms or
    345 376 
                -- anything, as it may be the synonym that is annotated.
    346 377 
                | Just tycon <- tyConAppTyConPicky_maybe t
    347 
    -           , Just (CType _ mHeader (_,cType)) <- tyConCType_maybe tycon
    348 
    -              = (mHeader, ftext cType)
    378 
    +           , Just (CType _ mHeader (_, cType)) <- tyConCType_maybe tycon
    379 
    +              = (mHeader, False, ftext cType)
    349 380 
                -- If we don't know a C type for this type, then try looking
    350 381 
                -- through one layer of type synonym etc.
    351 382 
                | Just t' <- coreView t
    352 383 
                   = f voidOK t'
    353 
    -          -- Handle 'UnliftedFFITypes' argument
    384 
    +           -- Handle 'UnliftedFFITypes' argument
    354 385 
                | Just tyCon <- tyConAppTyConPicky_maybe t
    355 386 
                , isPrimTyCon tyCon
    356 387 
                , Just cType <- ppPrimTyConStgType tyCon
    357 
    -           = (Nothing, text cType)
    388 
    +           = (Nothing, False, text cType)
    358 389
    359 390 
                -- Otherwise we don't know the C type. If we are allowing
    360 391 
                -- void then return that; otherwise something has gone wrong.
    361 
    -           | voidOK = (Nothing, text "void")
    392 
    +           | voidOK = (Nothing, True, text "void")
    362 393 
                | otherwise
    363 394 
                   = pprPanic "toCType" (ppr t)
    364 395

  • hadrian/bindist/Makefile
    ... ... @@ -252,7 +252,7 @@ update_package_db: install_bin install_lib
    252 252 
     	$(INSTALL_DATA) mk/system-cxx-std-lib-1.0.conf "$(DESTDIR)$(ActualLibsDir)/package.conf.d"
    253 253 
     	@echo "Updating the package DB"
    254 254 
     	$(foreach p, $(PKG_CONFS),\
    255 
    -		$(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-[0-9.]*-[0-9a-zA-Z]*\.conf//g'),$(shell echo "$p" | sed 's:\0xxx\0:   :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)"),$(shell echo $(notdir $p) | sed 's/.conf//g')))
    255 
    +		$(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-[0-9.]*-[0-9a-zA-Z]*\.conf//g'),$(shell echo "$p" | sed 's:\0xxx\0:   :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)"),$(shell echo $(notdir $p) | sed 's/-[0-9a-zA-Z]*\.conf$$//')))
    256 256 
     	'$(DESTDIR)$(ActualBinsDir)/$(CrossCompilePrefix)ghc-pkg' --global-package-db "$(DESTDIR)$(ActualLibsDir)/package.conf.d" recache
    257 257
    258 258 
     .PHONY: install_mingw

  • hadrian/src/CommandLine.hs
    ... ... @@ -113,7 +113,7 @@ data DocArgs = DocArgs
    113 113 
       } deriving (Eq, Show)
    114 114
    115 115 
     defaultDocArgs :: DocArgs
    116 
    -defaultDocArgs = DocArgs { docsBaseUrl = "../%pkgid%" }
    116 
    +defaultDocArgs = DocArgs { docsBaseUrl = "../%pkg%" }
    117 117
    118 118 
     readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
    119 119 
     readConfigure = Left "hadrian --configure has been deprecated (see #20167). Please run ./boot; ./configure manually"

  • hadrian/src/Context.hs
    ... ... @@ -128,7 +128,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config")
    128 128 
     pkgHaddockFile :: Context -> Action FilePath
    129 129 
     pkgHaddockFile Context {..} = do
    130 130 
         root <- buildRoot
    131 
    -    version <- pkgUnitId stage package
    131 
    +    -- We don't want to use the hash in the html documentation because it
    132 
    +    -- makes it harder for non-boot packages to link to boot packages, see #26635
    133 
    +    version <- pkgSimpleIdentifier package
    132 134 
         return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock"
    133 135
    134 136 
     -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:

  • hadrian/src/Settings/Builders/Cabal.hs
    ... ... @@ -85,6 +85,9 @@ commonCabalArgs :: Stage -> Args
    85 85 
     commonCabalArgs stage = do
    86 86 
       pkg       <- getPackage
    87 87 
       package_id <- expr $ pkgUnitId stage pkg
    88 
    +  -- We don't want to use the hash in the html documentation because it
    89 
    +  -- makes it harder for non-boot packages to link to boot packages, see #26635
    90 
    +  package_simple_id <- expr $ pkgSimpleIdentifier pkg
    88 91 
       let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..")
    89 92 
       mconcat [ -- Don't strip libraries when cross compiling.
    90 93 
                 -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@,
    ... ... @@ -112,7 +115,7 @@ commonCabalArgs stage = do
    112 115 
                 --
    113 116 
                 -- This doesn't hold if we move the @doc@ folder anywhere else.
    114 117 
                 , arg "--htmldir"
    115 
    -            , arg $ "${pkgroot}/../../doc/html/libraries/" ++ package_id
    118 
    +            , arg $ "${pkgroot}/../../doc/html/libraries/" ++ package_simple_id
    116 119
    117 120 
                 -- These trigger a need on each dependency, so every important to need
    118 121 
                 -- them in parallel or  it linearises the build of Ghc and GhcPkg

  • m4/fp_prog_cc_linker_target.m4
    ... ... @@ -8,7 +8,7 @@
    8 8 
     #      a linker
    9 9 
     AC_DEFUN([FP_PROG_CC_LINKER_TARGET],
    10 10 
     [
    11 
    -    AC_MSG_CHECKING([whether $CC used as a linker understands --target])
    11 
    +    AC_MSG_CHECKING([whether $1 used as a linker understands --target])
    12 12
    13 13 
         echo 'int foo() { return 0; }' > conftest1.c
    14 14 
         echo 'int main() { return 0; }' > conftest2.c
    ... ... @@ -20,7 +20,7 @@ AC_DEFUN([FP_PROG_CC_LINKER_TARGET],
    20 20 
             # See Note [Don't pass --target to emscripten toolchain] in GHC.Toolchain.Program
    21 21 
             CONF_CC_SUPPORTS_TARGET=NO
    22 22 
             AC_MSG_RESULT([no])
    23 
    -    elif "$CC" $$3 --target=$LlvmTarget -o conftest conftest1.o conftest2.o;
    23 
    +    elif "$1" $$3 --target=$LlvmTarget -o conftest conftest1.o conftest2.o;
    24 24 
         then
    25 25 
             $3="--target=$LlvmTarget $$3"
    26 26 
             AC_MSG_RESULT([yes])

  • testsuite/tests/ffi/should_compile/T26852.h
    1 
    +typedef struct abstract abstract;
    2 
    +
    3 
    +void blah(abstract** x);
    4 
    +abstract** get_abstract(void);
    5 
    +abstract*** get_abstract3(void);
    6 
    +abstract* get_simple(void);
    7 
    +int** get_int_pp(void);

  • testsuite/tests/ffi/should_compile/T26852.hs
    1 
    +{-# LANGUAGE CApiFFI #-}
    2 
    +module T26852 where
    3 
    +
    4 
    +import Foreign.Ptr
    5 
    +import Foreign.C.Types
    6 
    +
    7 
    +data Abstract
    8 
    +
    9 
    +foreign import capi "T26852.h blah"
    10 
    +    c_blah :: Ptr (Ptr Abstract) -> IO ()
    11 
    +
    12 
    +foreign import capi "T26852.h get_abstract"
    13 
    +    c_get_abstract :: IO (Ptr (Ptr Abstract))
    14 
    +
    15 
    +foreign import capi "T26852.h get_abstract3"
    16 
    +    c_get_abstract3 :: IO (Ptr (Ptr (Ptr Abstract)))
    17 
    +
    18 
    +foreign import capi "T26852.h get_simple"
    19 
    +    c_get_simple :: IO (Ptr Abstract)
    20 
    +
    21 
    +foreign import capi "T26852.h get_int_pp"
    22 
    +    c_get_int_pp :: IO (Ptr (Ptr CInt))

  • testsuite/tests/ffi/should_compile/T26852.stderr
    1 
    +
    2 
    +==================== Foreign export header file ====================
    3 
    +
    4 
    +
    5 
    +
    6 
    +==================== Foreign export stubs ====================
    7 
    +#include "T26852.h"
    8 
    +int** ghczuwrapperZC0ZCmainZCT26852ZCgetzuintzupp(void) {return get_int_pp();}
    9 
    +#include "T26852.h"
    10 
    +void* ghczuwrapperZC1ZCmainZCT26852ZCgetzusimple(void) {return get_simple();}
    11 
    +#include "T26852.h"
    12 
    +void* ghczuwrapperZC2ZCmainZCT26852ZCgetzuabstract3(void) {return get_abstract3();}
    13 
    +#include "T26852.h"
    14 
    +void* ghczuwrapperZC3ZCmainZCT26852ZCgetzuabstract(void) {return get_abstract();}
    15 
    +#include "T26852.h"
    16 
    +void ghczuwrapperZC4ZCmainZCT26852ZCblah(void* a1) {blah(a1);}
    17 
    +
    18 
    +

  • testsuite/tests/ffi/should_compile/all.T
    ... ... @@ -43,3 +43,4 @@ test('T22774', unless(js_arch() or arch('wasm32'), expect_fail), compile, [''])
    43 43
    44 44 
     test('T24034', normal, compile, [''])
    45 45 
     test('T25255', normal, compile, ['-dppr-debug'])
    46 
    +test('T26852', [when(js_arch(), skip), filter_stdout_lines(r'.*ghczuwrapper.*')], compile, ['-ddump-foreign'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help