diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -204,6 +204,7 @@ import GhcPrelude import qualified Prelude +import qualified Prelude -- for happy-generated code import GHC.StgToCmm.ExtCode import CmmCallConv diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -86,15 +86,16 @@ dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (dL->L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -667,8 +668,8 @@ ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -677,14 +678,24 @@ -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = pprModuleName (moduleName mod) + ctor_symbol = text "stginit_export_" <> mod_str + list_symbol = text "stg_exports_" <> mod_str + export_list = braces $ pprWithCommas closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -913,20 +913,22 @@ ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, @@ -1132,14 +1134,15 @@ where unloadObjs :: Linkable -> IO () unloadObjs lnk + -- The RTS's PEi386 linker currently doesn't support unloading. + | isWindowsHost = return () + | dynamicGhc = return () -- We don't do any cleanup when linking objects with the -- dynamic linker. Doing so introduces extra complexity for -- not much benefit. - -- Code unloading currently disabled due to instability. - -- See #16841. - | False -- otherwise + | otherwise = mapM_ (unloadObj hsc_env) [f | DotO f <- linkableUnlinked lnk] -- The components of a BCO linkable may contain -- dot-o files. Which is very confusing. @@ -1147,7 +1150,6 @@ -- But the BCO parts can be unlinked just by -- letting go of them (plus of course depopulating -- the symbol table which is done in the main body) - | otherwise = return () -- see #16841 {- ********************************************************************** @@ -1677,6 +1679,38 @@ -- ---------------------------------------------------------------------------- -- Loading a dynamic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32) +{- +Note [macOS Big Sur dynamic libraries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +macOS Big Sur makes the following change to how frameworks are shipped +with the OS: + +> New in macOS Big Sur 11 beta, the system ships with a built-in +> dynamic linker cache of all system-provided libraries. As part of +> this change, copies of dynamic libraries are no longer present on +> the filesystem. Code that attempts to check for dynamic library +> presence by looking for a file at a path or enumerating a directory +> will fail. Instead, check for library presence by attempting to +> dlopen() the path, which will correctly check for the library in the +> cache. (62986286) + +(https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/) + +Therefore, the previous method of checking whether a library exists +before attempting to load it makes GHC.Runtime.Linker.loadFramework +fail to find frameworks installed at /System/Library/Frameworks. +Instead, any attempt to load a framework at runtime, such as by +passing -framework OpenGL to runghc or running code loading such a +framework with GHCi, fails with a 'not found' message. + +GHC.Runtime.Linker.loadFramework now opportunistically loads the +framework libraries without checking for their existence first, +failing only if all attempts to load a given framework from any of the +various possible locations fail. See also #18446, which this change +addresses. +-} + -- Darwin / MacOS X only: load a framework -- a framework is a dynamic library packaged inside a directory of the same -- name. They are searched for in different paths than normal libraries. @@ -1687,16 +1721,28 @@ Left _ -> [] Right dir -> [dir "Library/Frameworks"] ps = extraPaths ++ homeFrameworkPath ++ defaultFrameworkPaths - ; mb_fwk <- findFile ps fwk_file - ; case mb_fwk of - Just fwk_path -> loadDLL hsc_env fwk_path - Nothing -> return (Just "not found") } - -- Tried all our known library paths, but dlopen() - -- has no built-in paths for frameworks: give up + ; errs <- findLoadDLL ps [] + ; return $ fmap (intercalate ", ") errs + } where fwk_file = rootname <.> "framework" rootname - -- sorry for the hardcoded paths, I hope they won't change anytime soon: + + -- sorry for the hardcoded paths, I hope they won't change anytime soon: defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"] + + -- Try to call loadDLL for each candidate path. + -- + -- See Note [macOS Big Sur dynamic libraries] + findLoadDLL [] errs = + -- Tried all our known library paths, but dlopen() + -- has no built-in paths for frameworks: give up + return $ Just errs + findLoadDLL (p:ps) errs = + do { dll <- loadDLL hsc_env (p fwk_file) + ; case dll of + Nothing -> return Nothing + Just err -> findLoadDLL ps ((p ++ ": " ++ err):errs) + } {- ********************************************************************** diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -475,13 +475,16 @@ ghcInternalFunctions :: LlvmM () ghcInternalFunctions = do dflags <- getDynFlags - mk "memcpy" i8Ptr [i8Ptr, i8Ptr, llvmWord dflags] - mk "memmove" i8Ptr [i8Ptr, i8Ptr, llvmWord dflags] - mk "memset" i8Ptr [i8Ptr, llvmWord dflags, llvmWord dflags] - mk "newSpark" (llvmWord dflags) [i8Ptr, i8Ptr] + let w = llvmWord dflags + cint = LMInt $ widthInBits $ cIntWidth dflags + mk "memcmp" cint [i8Ptr, i8Ptr, w] + mk "memcpy" i8Ptr [i8Ptr, i8Ptr, w] + mk "memmove" i8Ptr [i8Ptr, i8Ptr, w] + mk "memset" i8Ptr [i8Ptr, w, w] + mk "newSpark" w [i8Ptr, i8Ptr] where mk n ret args = do - let n' = llvmDefLabel $ fsLit n + let n' = fsLit n decl = LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret FixedArgs (tysToParams args) Nothing renderLlvm $ ppLlvmFunctionDecl decl @@ -538,7 +541,10 @@ let mkGlbVar lbl ty = LMGlobalVar lbl (LMPointer ty) Private Nothing Nothing case m_ty of -- Directly reference if we have seen it already - Just ty -> return $ mkGlbVar (llvmDefLabel llvmLbl) ty Global + Just ty -> do + if llvmLbl `elem` (map fsLit ["newSpark", "memmove", "memcpy", "memcmp", "memset"]) + then return $ mkGlbVar (llvmLbl) ty Global + else return $ mkGlbVar (llvmDefLabel llvmLbl) ty Global -- Otherwise use a forward alias of it Nothing -> do saveAlias llvmLbl diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -382,7 +382,56 @@ -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1769,9 +1818,12 @@ rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then SysTools.runLibtool - else SysTools.runLink + let link dflags args | staticLink = SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = SysTools.runLink dflags args >> SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = SysTools.runLink dflags args + link dflags ( map SysTools.Option verbFlags ++ [ SysTools.Option "-o" @@ -1838,7 +1890,13 @@ ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -2185,7 +2185,7 @@ where condition ms = unboxed_tuples_or_sums (ms_hspp_opts ms) && - not (gopt Opt_ByteCode (ms_hspp_opts ms)) && + not (gopt Opt_ByteCodeIfUnboxed (ms_hspp_opts ms)) && not (isBootSummary ms) unboxed_tuples_or_sums d = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -254,7 +254,10 @@ | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `elem` ways dflags + -- Only if we want dynamic libraries + WayDyn `elem` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -377,8 +380,15 @@ ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO diff --git a/compiler/main/SysTools/Settings.hs b/compiler/main/SysTools/Settings.hs --- a/compiler/main/SysTools/Settings.hs +++ b/compiler/main/SysTools/Settings.hs @@ -119,6 +119,8 @@ windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -141,7 +143,7 @@ as_args = map Option cc_args ld_prog = cc_prog ld_args = map Option (cc_args ++ words cc_link_args_str) - ld_r_prog <- getSetting "Merge objects command" + ld_r_prog <- getToolSetting "Merge objects command" ld_r_args <- getSetting "Merge objects flags" llvmTarget <- getSetting "LLVM target" @@ -210,6 +212,8 @@ , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) diff --git a/compiler/main/SysTools/Tasks.hs b/compiler/main/SysTools/Tasks.hs --- a/compiler/main/SysTools/Tasks.hs +++ b/compiler/main/SysTools/Tasks.hs @@ -28,6 +28,10 @@ import SysTools.Process import SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,41 @@ return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath@. +-- +-- See Note [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = concatMap f info + where f ("path":p:_) = [p] + f _ = [] + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -334,6 +373,17 @@ let ar = pgm_ar dflags runSomethingWith dflags "Ar" ar args $ \real_args -> readCreateProcessWithExitCode' (proc ar real_args){ cwd = mb_cwd } + +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1804,7 +1804,36 @@ codes are set according to the supplied comparison operation. -} +{- Note [64-bit integer comparisons on 32-bit] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + When doing these comparisons there are 2 kinds of + comparisons. + + * Comparison for equality (or lack thereof) + + We use xor to check if high/low bits are + equal. Then combine the results using or and + perform a single conditional jump based on the + result. + + * Other comparisons: + + We map all other comparisons to the >= operation. + Why? Because it's easy to encode it with a single + conditional jump. + + We do this by first computing [r1_lo - r2_lo] + and use the carry flag to compute + [r1_high - r2_high - CF]. + + At which point if r1 >= r2 then the result will be + positive. Otherwise negative so we can branch on this + condition. + +-} + + genCondBranch :: BlockId -- the source of the jump -> BlockId -- the true branch target @@ -1821,22 +1850,63 @@ -> NatM InstrBlock -- 64-bit integer comparisons on 32-bit +-- See Note [64-bit integer comparisons on 32-bit] genCondBranch' is32Bit _bid true false (CmmMachOp mop [e1,e2]) | is32Bit, Just W64 <- maybeIntComparison mop = do - ChildCode64 code1 r1_lo <- iselExpr64 e1 - ChildCode64 code2 r2_lo <- iselExpr64 e2 - let r1_hi = getHiVRegFromLo r1_lo - r2_hi = getHiVRegFromLo r2_lo - cond = machOpToCond mop - Just cond' = maybeFlipCond cond - --TODO: Update CFG for x86 - let code = code1 `appOL` code2 `appOL` toOL [ - CMP II32 (OpReg r2_hi) (OpReg r1_hi), - JXX cond true, - JXX cond' false, - CMP II32 (OpReg r2_lo) (OpReg r1_lo), - JXX cond true] `appOL` genBranch false - return code + + -- The resulting registers here are both the lower part of + -- the register as well as a way to get at the higher part. + ChildCode64 code1 r1 <- iselExpr64 e1 + ChildCode64 code2 r2 <- iselExpr64 e2 + let cond = machOpToCond mop :: Cond + + let cmpCode = intComparison cond true false r1 r2 + return $ code1 `appOL` code2 `appOL` cmpCode + + where + intComparison :: Cond -> BlockId -> BlockId -> Reg -> Reg -> InstrBlock + intComparison cond true false r1_lo r2_lo = + case cond of + -- Impossible results of machOpToCond + ALWAYS -> panic "impossible" + NEG -> panic "impossible" + POS -> panic "impossible" + CARRY -> panic "impossible" + OFLO -> panic "impossible" + PARITY -> panic "impossible" + NOTPARITY -> panic "impossible" + -- Special case #1 x == y and x != y + EQQ -> cmpExact + NE -> cmpExact + -- [x >= y] + GE -> cmpGE + GEU -> cmpGE + -- [x > y] <==> ![y >= x] + GTT -> intComparison GE false true r2_lo r1_lo + GU -> intComparison GEU false true r2_lo r1_lo + -- [x <= y] <==> [y >= x] + LE -> intComparison GE true false r2_lo r1_lo + LEU -> intComparison GEU true false r2_lo r1_lo + -- [x < y] <==> ![x >= x] + LTT -> intComparison GE false true r1_lo r2_lo + LU -> intComparison GEU false true r1_lo r2_lo + where + r1_hi = getHiVRegFromLo r1_lo + r2_hi = getHiVRegFromLo r2_lo + cmpExact :: OrdList Instr + cmpExact = + toOL + [ XOR II32 (OpReg r2_hi) (OpReg r1_hi) + , XOR II32 (OpReg r2_lo) (OpReg r1_lo) + , OR II32 (OpReg r1_hi) (OpReg r1_lo) + , JXX cond true + , JXX ALWAYS false + ] + cmpGE = toOL + [ CMP II32 (OpReg r2_lo) (OpReg r1_lo) + , SBB II32 (OpReg r2_hi) (OpReg r1_hi) + , JXX cond true + , JXX ALWAYS false ] genCondBranch' _ bid id false bool = do CondCode is_float cond cond_code <- getCondCode bool diff --git a/compiler/nativeGen/X86/Cond.hs b/compiler/nativeGen/X86/Cond.hs --- a/compiler/nativeGen/X86/Cond.hs +++ b/compiler/nativeGen/X86/Cond.hs @@ -13,22 +13,22 @@ data Cond = ALWAYS -- What's really used? ToDo - | EQQ - | GE - | GEU - | GTT - | GU - | LE - | LEU - | LTT - | LU - | NE - | NEG - | POS - | CARRY - | OFLO - | PARITY - | NOTPARITY + | EQQ -- je/jz -> zf = 1 + | GE -- jge + | GEU -- ae + | GTT -- jg + | GU -- ja + | LE -- jle + | LEU -- jbe + | LTT -- jl + | LU -- jb + | NE -- jne + | NEG -- js + | POS -- jns + | CARRY -- jc + | OFLO -- jo + | PARITY -- jp + | NOTPARITY -- jnp deriving Eq condUnsigned :: Cond -> Bool diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -819,13 +819,14 @@ -- In essense each allocation larger than a page size needs to be chunked and -- a probe emitted after each page allocation. You have to hit the guard -- page so the kernel can map in the next page, otherwise you'll segfault. +-- See Note [Windows stack allocations]. -- needs_probe_call :: Platform -> Int -> Bool needs_probe_call platform amount = case platformOS platform of OSMinGW32 -> case platformArch platform of ArchX86 -> amount > (4 * 1024) - ArchX86_64 -> amount > (8 * 1024) + ArchX86_64 -> amount > (4 * 1024) _ -> False _ -> False @@ -849,7 +850,7 @@ -- -- We emit a call because the stack probes are quite involved and -- would bloat code size a lot. GHC doesn't really have an -Os. - -- __chkstk is guaranteed to leave all nonvolatile registers and AX + -- ___chkstk is guaranteed to leave all nonvolatile registers and AX -- untouched. It's part of the standard prologue code for any Windows -- function dropping the stack more than a page. -- See Note [Windows stack layout] diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs --- a/compiler/typecheck/TcSigs.hs +++ b/compiler/typecheck/TcSigs.hs @@ -818,9 +818,13 @@ tcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag] tcImpSpec (name, prag) = do { id <- tcLookupId name - ; unless (isAnyInlinePragma (idInlinePragma id)) - (addWarnTc NoReason (impSpecErr name)) - ; tcSpecPrag id prag } + ; if isAnyInlinePragma (idInlinePragma id) + then tcSpecPrag id prag + else do { addWarnTc NoReason (impSpecErr name) + ; return [] } } + -- If there is no INLINE/INLINABLE pragma there will be no unfolding. In + -- that case, just delete the SPECIALISE pragma altogether, lest the + -- desugarer fall over because it can't find the unfolding. See #18118. impSpecErr :: Name -> SDoc impSpecErr name diff --git a/ghc-lib.cabal b/ghc-lib.cabal --- a/ghc-lib.cabal +++ b/ghc-lib.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib -version: 8.10.2.20200916 +version: 8.10.3.20201220 license: BSD3 license-file: LICENSE category: Development @@ -80,7 +80,7 @@ transformers == 0.5.*, process >= 1 && < 1.7, hpc == 0.6.*, - ghc-lib-parser == 8.10.2.20200916 + ghc-lib-parser == 8.10.3.20201220 build-tools: alex >= 3.1, happy >= 1.19.4 other-extensions: BangPatterns @@ -143,7 +143,6 @@ compiler/ghci compiler/main compiler/cmm - compiler/. compiler autogen-modules: Paths_ghc_lib diff --git a/ghc-lib/stage0/lib/ghcversion.h b/ghc-lib/stage0/lib/ghcversion.h --- a/ghc-lib/stage0/lib/ghcversion.h +++ b/ghc-lib/stage0/lib/ghcversion.h @@ -5,7 +5,7 @@ # define __GLASGOW_HASKELL__ 810 #endif -#define __GLASGOW_HASKELL_PATCHLEVEL1__ 2 +#define __GLASGOW_HASKELL_PATCHLEVEL1__ 3 #define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\ ((ma)*100+(mi)) < __GLASGOW_HASKELL__ || \ diff --git a/ghc-lib/stage0/lib/settings b/ghc-lib/stage0/lib/settings --- a/ghc-lib/stage0/lib/settings +++ b/ghc-lib/stage0/lib/settings @@ -18,6 +18,8 @@ ,("ar flags", "qcls") ,("ar supports at file", "NO") ,("ranlib command", "ranlib") +,("otool command", "otool") +,("install_name_tool command", "install_name_tool") ,("touch command", "touch") ,("dllwrap command", "/bin/false") ,("windres command", "/bin/false")