{-# LANGUAGE ScopedTypeVariables #-}--------------------------------------------------------------------------------- Tasks running external programs for SysTools---- (c) The GHC Team 2017-------------------------------------------------------------------------------moduleSysTools.TaskswhereimportException importErrUtils importDynFlags importOutputable importPlatform importUtil importData.CharimportData.ListimportSystem.IOimportSystem.ProcessimportGhcPrelude importLlvmCodeGen.Base (llvmVersionStr ,supportedLlvmVersion )importSysTools.Process importSysTools.Info {- ************************************************************************ * * \subsection{Running an external program} * * ************************************************************************ -}runUnlit::DynFlags ->[Option ]->IO()runUnlit dflags args =doletprog =pgm_L dflags opts =getOpts dflags opt_L runSomething dflags "Literate pre-processor"prog (mapOption opts ++args )runCpp::DynFlags ->[Option ]->IO()runCpp dflags args =dolet(p ,args0 )=pgm_P dflags args1 =mapOption (getOpts dflags opt_P )args2 =[Option "-Werror"|gopt Opt_WarnIsError dflags ]++[Option "-Wundef"|wopt Opt_WarnCPPUndef dflags ]mb_env <-getGccEnv args2 runSomethingFiltered dflags id"C pre-processor"p (args0 ++args1 ++args2 ++args )Nothingmb_env runPp::DynFlags ->[Option ]->IO()runPp dflags args =doletprog =pgm_F dflags opts =mapOption (getOpts dflags opt_F )runSomething dflags "Haskell pre-processor"prog (args ++opts )runCc::DynFlags ->[Option ]->IO()runCc dflags args =dolet(p ,args0 )=pgm_c dflags args1 =mapOption (getOpts dflags opt_c )args2 =args0 ++args ++args1 -- We take care to pass -optc flags in args1 last to ensure that the-- user can override flags passed by GHC. See #14452.mb_env <-getGccEnv args2 runSomethingResponseFile dflags cc_filter "C Compiler"p args2 mb_env where-- discard some harmless warnings from gcc that we can't turn offcc_filter =unlines.doFilter .lines{- gcc gives warnings in chunks like so: In file included from /foo/bar/baz.h:11, from /foo/bar/baz2.h:22, from wibble.c:33: /foo/flibble:14: global register variable ... /foo/flibble:15: warning: call-clobbered r... We break it up into its chunks, remove any call-clobbered register warnings from each chunk, and then delete any chunks that we have emptied of warnings. -}doFilter =unChunkWarnings .filterWarnings .chunkWarnings []-- We can't assume that the output will start with an "In file inc..."-- line, so we start off expecting a list of warnings rather than a-- location stack.chunkWarnings::[String]-- The location stack to use for the next-- list of warnings->[String]-- The remaining lines to look at->[([String],[String])]chunkWarnings loc_stack []=[(loc_stack ,[])]chunkWarningsloc_stack xs =casebreakloc_stack_start xs of(warnings ,lss :xs' )->casespanloc_start_continuation xs' of(lsc ,xs'' )->(loc_stack ,warnings ):chunkWarnings (lss :lsc )xs'' _->[(loc_stack ,xs )]filterWarnings::[([String],[String])]->[([String],[String])]filterWarnings []=[]-- If the warnings are already empty then we are probably doing-- something wrong, so don't delete anythingfilterWarnings((xs ,[]):zs )=(xs ,[]):filterWarnings zs filterWarnings((xs ,ys ):zs )=casefilterwantedWarning ys of[]->filterWarnings zs ys' ->(xs ,ys' ):filterWarnings zs unChunkWarnings::[([String],[String])]->[String]unChunkWarnings []=[]unChunkWarnings((xs ,ys ):zs )=xs ++ys ++unChunkWarnings zs loc_stack_start s ="In file included from "`isPrefixOf`s loc_start_continuation s =" from "`isPrefixOf`s wantedWarning w |"warning: call-clobbered register used"`isContainedIn `w =False|otherwise=TrueisContainedIn::String->String->Boolxs `isContainedIn `ys =any(xs `isPrefixOf`)(tailsys )-- | Run the linker with some arguments and return the outputaskLd::DynFlags ->[Option ]->IOStringaskLd dflags args =dolet(p ,args0 )=pgm_l dflags args1 =mapOption (getOpts dflags opt_l )args2 =args0 ++args1 ++args mb_env <-getGccEnv args2 runSomethingWith dflags "gcc"p args2 $\real_args ->readCreateProcessWithExitCode' (procp real_args ){env=mb_env }runSplit::DynFlags ->[Option ]->IO()runSplit dflags args =dolet(p ,args0 )=pgm_s dflags runSomething dflags "Splitter"p (args0 ++args )runAs::DynFlags ->[Option ]->IO()runAs dflags args =dolet(p ,args0 )=pgm_a dflags args1 =mapOption (getOpts dflags opt_a )args2 =args0 ++args1 ++args mb_env <-getGccEnv args2 runSomethingFiltered dflags id"Assembler"p args2 Nothingmb_env -- | Run the LLVM OptimiserrunLlvmOpt::DynFlags ->[Option ]->IO()runLlvmOpt dflags args =dolet(p ,args0 )=pgm_lo dflags args1 =mapOption (getOpts dflags opt_lo )-- We take care to pass -optlo flags (e.g. args0) last to ensure that the-- user can override flags passed by GHC. See #14821.runSomething dflags "LLVM Optimiser"p (args1 ++args ++args0 )-- | Run the LLVM CompilerrunLlvmLlc::DynFlags ->[Option ]->IO()runLlvmLlc dflags args =dolet(p ,args0 )=pgm_lc dflags args1 =mapOption (getOpts dflags opt_lc )runSomething dflags "LLVM Compiler"p (args0 ++args1 ++args )-- | Run the clang compiler (used as an assembler for the LLVM-- backend on OS X as LLVM doesn't support the OS X system-- assembler)runClang::DynFlags ->[Option ]->IO()runClang dflags args =dolet(clang ,_)=pgm_lcc dflags -- be careful what options we call clang with-- see #5903 and #7617 for bugs caused by this.(_,args0 )=pgm_a dflags args1 =mapOption (getOpts dflags opt_a )args2 =args0 ++args1 ++args mb_env <-getGccEnv args2 Exception.catch(dorunSomethingFiltered dflags id"Clang (Assembler)"clang args2 Nothingmb_env )(\(err ::SomeException)->doerrorMsg dflags $text ("Error running clang! you need clang installed to use the"++" LLVM backend")$+$ text "(or GHC tried to execute clang incorrectly)"throwIOerr )-- | Figure out which version of LLVM we are running this sessionfigureLlvmVersion::DynFlags ->IO(Maybe(Int,Int))figureLlvmVersion dflags =dolet(pgm ,opts )=pgm_lc dflags args =filternotNull (mapshowOpt opts )-- we grab the args even though they should be useless just in-- case the user is using a customised 'llc' that requires some-- of the options they've specified. llc doesn't care what other-- options are specified when '-version' is used.args' =args ++["-version"]ver <-catchIO (do(pin ,pout ,perr ,_)<-runInteractiveProcesspgm args' NothingNothing{- > llc -version LLVM (http://llvm.org/): LLVM version 3.5.2 ... -}hSetBinaryModepout False_<-hGetLinepout vline <-dropWhile(not.isDigit)`fmap`hGetLinepout v <-casespan(/='.')vline of("",_)->fail"no digits!"(x ,y )->return(readx ,read$takeWhileisDigit$drop1y )hClosepin hClosepout hCloseperr return$Justv )(\err ->dodebugTraceMsg dflags 2(text "Error (figuring out LLVM version):"<+> text (showerr ))errorMsg dflags $vcat [text "Warning:",nest 9$text "Couldn't figure out LLVM version!"$$ text ("Make sure you have installed LLVM "++llvmVersionStr supportedLlvmVersion )]returnNothing)returnver runLink::DynFlags ->[Option ]->IO()runLink dflags args =do-- See Note [Run-time linker info]linkargs <-neededLinkArgs `fmap`getLinkerInfo dflags let(p ,args0 )=pgm_l dflags args1 =mapOption (getOpts dflags opt_l )args2 =args0 ++linkargs ++args1 ++args mb_env <-getGccEnv args2 runSomethingResponseFile dflags ld_filter "Linker"p args2 mb_env whereld_filter =case(platformOS(targetPlatform dflags ))ofOSSolaris2 ->sunos_ld_filter _->id{- SunOS/Solaris ld emits harmless warning messages about unresolved symbols in case of compiling into shared library when we do not link against all the required libs. That is the case of GHC which does not link against RTS library explicitly in order to be able to choose the library later based on binary application linking parameters. The warnings look like: Undefined first referenced symbol in file stg_ap_n_fast ./T2386_Lib.o stg_upd_frame_info ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o newCAF ./T2386_Lib.o stg_bh_upd_frame_info ./T2386_Lib.o stg_ap_ppp_fast ./T2386_Lib.o templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o stg_ap_p_fast ./T2386_Lib.o stg_ap_pp_fast ./T2386_Lib.o ld: warning: symbol referencing errors this is actually coming from T2386 testcase. The emitting of those warnings is also a reason why so many TH testcases fail on Solaris. Following filter code is SunOS/Solaris linker specific and should filter out only linker warnings. Please note that the logic is a little bit more complex due to the simple reason that we need to preserve any other linker emitted messages. If there are any. Simply speaking if we see "Undefined" and later "ld: warning:..." then we omit all text between (including) the marks. Otherwise we copy the whole output. -}sunos_ld_filter::String->Stringsunos_ld_filter =unlines.sunos_ld_filter' .linessunos_ld_filter' x =if(undefined_found x &&ld_warning_found x )then(ld_prefix x )++(ld_postfix x )elsex breakStartsWith x y =break(isPrefixOfx )y ld_prefix =fst.breakStartsWith "Undefined"undefined_found =not.null.snd.breakStartsWith "Undefined"ld_warn_break =breakStartsWith "ld: warning: symbol referencing errors"ld_postfix =tail.snd.ld_warn_break ld_warning_found =not.null.snd.ld_warn_break runLibtool::DynFlags ->[Option ]->IO()runLibtool dflags args =dolinkargs <-neededLinkArgs `fmap`getLinkerInfo dflags letargs1 =mapOption (getOpts dflags opt_l )args2 =[Option "-static"]++args1 ++args ++linkargs libtool =pgm_libtool dflags mb_env <-getGccEnv args2 runSomethingFiltered dflags id"Linker"libtool args2 Nothingmb_env runAr::DynFlags ->MaybeFilePath->[Option ]->IO()runAr dflags cwd args =doletar =pgm_ar dflags runSomethingFiltered dflags id"Ar"ar args cwd NothingaskAr::DynFlags ->MaybeFilePath->[Option ]->IOStringaskAr dflags mb_cwd args =doletar =pgm_ar dflags runSomethingWith dflags "Ar"ar args $\real_args ->readCreateProcessWithExitCode' (procar real_args ){cwd=mb_cwd }runRanlib::DynFlags ->[Option ]->IO()runRanlib dflags args =doletranlib =pgm_ranlib dflags runSomethingFiltered dflags id"Ranlib"ranlib args NothingNothingrunMkDLL::DynFlags ->[Option ]->IO()runMkDLL dflags args =dolet(p ,args0 )=pgm_dll dflags args1 =args0 ++args mb_env <-getGccEnv (args0 ++args )runSomethingFiltered dflags id"Make DLL"p args1 Nothingmb_env runWindres::DynFlags ->[Option ]->IO()runWindres dflags args =dolet(gcc ,gcc_args )=pgm_c dflags windres =pgm_windres dflags opts =mapOption (getOpts dflags opt_windres )quote x ="\""++x ++"\""args' =-- If windres.exe and gcc.exe are in a directory containing-- spaces then windres fails to run gcc. We therefore need-- to tell it what command to use...Option ("--preprocessor="++unwords(mapquote (gcc :mapshowOpt gcc_args ++mapshowOpt opts ++["-E","-xc","-DRC_INVOKED"])))-- ...but if we do that then if windres calls popen then-- it can't understand the quoting, so we have to use-- --use-temp-file so that it interprets it correctly.-- See #1828.:Option "--use-temp-file":args mb_env <-getGccEnv gcc_args runSomethingFiltered dflags id"Windres"windres args' Nothingmb_env touch::DynFlags ->String->String->IO()touch dflags purpose arg =runSomething dflags purpose (pgm_T dflags )[FileOption ""arg ]