From: Ian Lynagh Date: Mon, 4 Apr 2011 20:59:04 +0000 (+0100) Subject: Remove dead code, now that -fvia-c is a no-op X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=9be618cdf99b04ce7eef6eeabc168b59174bb843 Remove dead code, now that -fvia-c is a no-op --- diff --git a/aclocal.m4 b/aclocal.m4 index 691fd45..23e6bc0 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1069,18 +1069,9 @@ AC_SUBST([GhcPkgCmd]) # Determine which extra flags we need to pass gcc when we invoke it # to compile .hc code. # -# Some OSs (Mandrake Linux, in particular) configure GCC with -# -momit-leaf-frame-pointer on by default. If this is the case, we -# need to turn it off for mangling to work. The test is currently a -# bit crude, using only the version number of gcc. -# # -fwrapv is needed for gcc to emit well-behaved code in the presence of # integer wrap around. (Trac #952) # -# -fno-unit-at-a-time or -fno-toplevel-reoder is necessary to avoid gcc -# reordering things in the module and confusing the manger and/or splitter. -# (eg. Trac #1427) -# AC_DEFUN([FP_GCC_EXTRA_FLAGS], [AC_REQUIRE([FP_HAVE_GCC]) AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts], @@ -1088,24 +1079,6 @@ AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_ FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-ge], [3.4], [fp_cv_gcc_extra_opts="$fp_cv_gcc_extra_opts -fwrapv"], []) - case $TargetPlatform in - i386-*|x86_64-*) - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-ge], [3.2], - [fp_cv_gcc_extra_opts="$fp_cv_gcc_extra_opts -mno-omit-leaf-frame-pointer"], - []) - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-ge], [3.4], - [FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-ge], [4.2], - [fp_cv_gcc_extra_opts="$fp_cv_gcc_extra_opts -fno-toplevel-reorder"], - [fp_cv_gcc_extra_opts="$fp_cv_gcc_extra_opts -fno-unit-at-a-time"] - )], - []) - ;; - sparc-*-solaris2) - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-ge], [4.2], - [fp_cv_gcc_extra_opts="$fp_cv_gcc_extra_opts -fno-toplevel-reorder"], - []) - ;; - esac ]) AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) ]) diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 0def1c1..357b51c 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -152,10 +152,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo 'cGHC_UNLIT_PGM = "$(GHC_UNLIT_PGM)"' >> $@ @echo 'cGHC_UNLIT_DIR :: String' >> $@ @echo 'cGHC_UNLIT_DIR = "$(GHC_UNLIT_DIR)"' >> $@ - @echo 'cGHC_MANGLER_PGM :: String' >> $@ - @echo 'cGHC_MANGLER_PGM = "$(GHC_MANGLER_PGM)"' >> $@ - @echo 'cGHC_MANGLER_DIR :: String' >> $@ - @echo 'cGHC_MANGLER_DIR = "$(GHC_MANGLER_DIR)"' >> $@ @echo 'cGHC_SPLIT_PGM :: String' >> $@ @echo 'cGHC_SPLIT_PGM = "$(GHC_SPLIT_PGM)"' >> $@ @echo 'cGHC_SPLIT_DIR :: String' >> $@ diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index d85335f..5b00261 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -76,7 +76,6 @@ data Phase | Ccpp | Cc | HCc -- Haskellised C (as opposed to vanilla C) compilation - | Mangle -- assembly mangling, now done by a separate script. | SplitMangle -- after mangler if splitting | SplitAs | As @@ -111,7 +110,6 @@ eqPhase (Hsc _) (Hsc _) = True eqPhase Ccpp Ccpp = True eqPhase Cc Cc = True eqPhase HCc HCc = True -eqPhase Mangle Mangle = True eqPhase SplitMangle SplitMangle = True eqPhase SplitAs SplitAs = True eqPhase As As = True @@ -138,8 +136,6 @@ nextPhase (Unlit sf) = Cpp sf nextPhase (Cpp sf) = HsPp sf nextPhase (HsPp sf) = Hsc sf nextPhase (Hsc _) = HCc -nextPhase HCc = Mangle -nextPhase Mangle = SplitMangle nextPhase SplitMangle = As nextPhase As = SplitAs nextPhase LlvmOpt = LlvmLlc @@ -154,6 +150,7 @@ nextPhase Ccpp = As nextPhase Cc = As nextPhase CmmCpp = Cmm nextPhase Cmm = HCc +nextPhase HCc = As nextPhase StopLn = panic "nextPhase: nothing after StopLn" -- the first compilation phase for a given file is determined @@ -172,7 +169,6 @@ startPhase "cpp" = Ccpp startPhase "C" = Cc startPhase "cc" = Ccpp startPhase "cxx" = Ccpp -startPhase "raw_s" = Mangle startPhase "split_s" = SplitMangle startPhase "s" = As startPhase "S" = As @@ -200,7 +196,6 @@ phaseInputExt (Hsc _) = "hspp" -- intermediate only phaseInputExt HCc = "hc" phaseInputExt Ccpp = "cpp" phaseInputExt Cc = "c" -phaseInputExt Mangle = "raw_s" phaseInputExt SplitMangle = "split_s" -- not really generated phaseInputExt As = "s" phaseInputExt LlvmOpt = "ll" diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 9b3eb6a..e015876 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -141,7 +141,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler) hsc_env = hsc_env0 {hsc_dflags = dflags} -- Figure out what lang we're generating - let hsc_lang = hscMaybeAdjustTarget dflags StopLn src_flavour (hscTarget dflags) + let hsc_lang = hscTarget dflags -- ... and what the next phase should be let next_phase = hscNextPhase dflags src_flavour hsc_lang -- ... and what file to generate the output into @@ -585,7 +585,6 @@ getOutputFilename stop_phase output basename odir = objectDir dflags osuf = objectSuf dflags keep_hc = dopt Opt_KeepHcFiles dflags - keep_raw_s = dopt Opt_KeepRawSFiles dflags keep_s = dopt Opt_KeepSFiles dflags keep_bc = dopt Opt_KeepLlvmFiles dflags @@ -599,7 +598,6 @@ getOutputFilename stop_phase output basename keep_this_output = case next_phase of StopLn -> True - Mangle | keep_raw_s -> True As | keep_s -> True LlvmOpt | keep_bc -> True HCc | keep_hc -> True @@ -809,7 +807,7 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma src_timestamp <- getModificationTime (basename <.> suff) let force_recomp = dopt Opt_ForceRecomp dflags - hsc_lang = hscMaybeAdjustTarget dflags stop src_flavour (hscTarget dflags) + hsc_lang = hscTarget dflags source_unchanged <- if force_recomp || not (isStopLn stop) -- Set source_unchanged to False unconditionally if @@ -884,10 +882,10 @@ runPhase CmmCpp _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn return (Cmm, dflags, maybe_loc, output_fn) -runPhase Cmm stop hsc_env basename _ input_fn get_output_fn maybe_loc +runPhase Cmm _ hsc_env basename _ input_fn get_output_fn maybe_loc = do let dflags = hsc_dflags hsc_env - let hsc_lang = hscMaybeAdjustTarget dflags stop HsSrcFile (hscTarget dflags) + let hsc_lang = hscTarget dflags let next_phase = hscNextPhase dflags HsSrcFile hsc_lang output_fn <- get_output_fn dflags next_phase maybe_loc @@ -929,7 +927,7 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc let include_paths = foldr (\ x xs -> "-I" : x : xs) [] (cmdline_include_paths ++ pkg_include_dirs) - let (md_c_flags, md_regd_c_flags) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags gcc_extra_viac_flags <- getExtraViaCOpts dflags let pic_c_flags = picCCOpts dflags @@ -959,10 +957,7 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- Decide next phase - let mangle = dopt Opt_DoAsmMangling dflags - next_phase - | hcc && mangle = Mangle - | otherwise = As + let next_phase = As output_fn <- get_output_fn dflags next_phase maybe_loc let @@ -1019,18 +1014,8 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- This is a temporary hack. ++ ["-mcpu=v9"] #endif - ++ (if hcc && mangle - then md_regd_c_flags - else []) - ++ (if hcc - then if mangle - then gcc_extra_viac_flags - else filter (=="-fwrapv") - gcc_extra_viac_flags - -- still want -fwrapv even for unreg'd - else []) ++ (if hcc - then more_hcc_opts + then gcc_extra_viac_flags ++ more_hcc_opts else []) ++ [ verb, "-S", "-Wimplicit", cc_opt ] ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ] @@ -1048,33 +1033,6 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- ToDo: postprocess the output from gcc ----------------------------------------------------------------------------- --- Mangle phase - -runPhase Mangle _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc - = do let dflags = hsc_dflags hsc_env - let mangler_opts = getOpts dflags opt_m - -#if i386_TARGET_ARCH - machdep_opts <- return [ show (stolen_x86_regs dflags) ] -#else - machdep_opts <- return [] -#endif - - let split = dopt Opt_SplitObjs dflags - next_phase - | split = SplitMangle - | otherwise = As - output_fn <- get_output_fn dflags next_phase maybe_loc - - SysTools.runMangle dflags (map SysTools.Option mangler_opts - ++ [ SysTools.FileOption "" input_fn - , SysTools.FileOption "" output_fn - ] - ++ map SysTools.Option machdep_opts) - - return (next_phase, dflags, maybe_loc, output_fn) - ------------------------------------------------------------------------------ -- Splitting phase runPhase SplitMangle _stop hsc_env _basename _suff input_fn _get_output_fn maybe_loc @@ -1116,7 +1074,7 @@ runPhase As _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc -- might be a hierarchical module. createDirectoryHierarchy (takeDirectory output_fn) - let (md_c_flags, _) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags SysTools.runAs dflags (map SysTools.Option as_opts ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] @@ -1166,7 +1124,7 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc split_obj n = split_odir takeFileName base_o ++ "__" ++ show n <.> osuf - let (md_c_flags, _) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags let assemble_file n = SysTools.runAs dflags (map SysTools.Option as_opts ++ @@ -1312,7 +1270,7 @@ mkExtraCObj dflags xs oFile <- newTempName dflags "o" writeFile cFile $ unlines xs let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId - (md_c_flags, _) = machdepCCOpts dflags + md_c_flags = machdepCCOpts dflags SysTools.runCc dflags ([Option "-c", FileOption "" cFile, @@ -1504,7 +1462,7 @@ linkBinary dflags o_files dep_packages = do rc_objs <- maybeCreateManifest dflags output_fn - let (md_c_flags, _) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags SysTools.runLink dflags ( [ SysTools.Option verb , SysTools.Option "-o" @@ -1657,7 +1615,7 @@ linkDynLib dflags o_files dep_packages = do -- probably _stub.o files extra_ld_inputs <- readIORef v_Ld_inputs - let (md_c_flags, _) = machdepCCOpts dflags + let md_c_flags = machdepCCOpts dflags let extra_ld_opts = getOpts dflags opt_l rtsEnabledObj <- mkRtsOptionsLevelObj dflags @@ -1804,7 +1762,7 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do | otherwise = (optc ++ md_c_flags) where optc = getOpts dflags opt_c - (md_c_flags, _) = machdepCCOpts dflags + md_c_flags = machdepCCOpts dflags let cpp_prog args | raw = SysTools.runCpp dflags args | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args) @@ -1860,7 +1818,7 @@ joinObjectFiles dflags o_files output_fn = do ld_x_flag | null cLD_X = "" | otherwise = "-Wl,-x" - (md_c_flags, _) = machdepCCOpts dflags + md_c_flags = machdepCCOpts dflags if cLdIsGNULd == "YES" then do @@ -1885,19 +1843,3 @@ hscNextPhase dflags _ hsc_lang = HscInterpreted -> StopLn _other -> StopLn - -hscMaybeAdjustTarget :: DynFlags -> Phase -> HscSource -> HscTarget -> HscTarget -hscMaybeAdjustTarget dflags stop _ current_hsc_lang - = hsc_lang - where - keep_hc = dopt Opt_KeepHcFiles dflags - hsc_lang - -- don't change the lang if we're interpreting - | current_hsc_lang == HscInterpreted = current_hsc_lang - - -- force -fvia-C if we are being asked for a .hc file - | HCc <- stop = HscC - | keep_hc = HscC - -- otherwise, stick to the plan - | otherwise = current_hsc_lang - diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 706ded8..7c0fd46 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -252,7 +252,6 @@ data DynFlag | Opt_Pp | Opt_ForceRecomp | Opt_DryRun - | Opt_DoAsmMangling | Opt_ExcessPrecision | Opt_EagerBlackHoling | Opt_ReadUserPackageConf @@ -289,7 +288,6 @@ data DynFlag | Opt_KeepHiDiffs | Opt_KeepHcFiles | Opt_KeepSFiles - | Opt_KeepRawSFiles | Opt_KeepTmpFiles | Opt_KeepRawTokenStream | Opt_KeepLlvmFiles @@ -398,7 +396,6 @@ data DynFlags = DynFlags { #ifndef OMIT_NATIVE_CODEGEN targetPlatform :: Platform, -- ^ The platform we're compiling for. Used by the NCG. #endif - stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], mainModIs :: Module, @@ -469,7 +466,6 @@ data DynFlags = DynFlags { pgm_P :: (String,[Option]), pgm_F :: String, pgm_c :: (String,[Option]), - pgm_m :: (String,[Option]), pgm_s :: (String,[Option]), pgm_a :: (String,[Option]), pgm_l :: (String,[Option]), @@ -668,7 +664,6 @@ defaultDynFlags = #ifndef OMIT_NATIVE_CODEGEN targetPlatform = defaultTargetPlatform, #endif - stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], mainModIs = mAIN, @@ -733,7 +728,6 @@ defaultDynFlags = pgm_P = panic "defaultDynFlags: No pgm_P", pgm_F = panic "defaultDynFlags: No pgm_F", pgm_c = panic "defaultDynFlags: No pgm_c", - pgm_m = panic "defaultDynFlags: No pgm_m", pgm_s = panic "defaultDynFlags: No pgm_s", pgm_a = panic "defaultDynFlags: No pgm_a", pgm_l = panic "defaultDynFlags: No pgm_l", @@ -1106,7 +1100,7 @@ dynamic_flags = [ , Flag "pgmP" (hasArg setPgmP) , Flag "pgmF" (hasArg (\f d -> d{ pgm_F = f})) , Flag "pgmc" (hasArg (\f d -> d{ pgm_c = (f,[])})) - , Flag "pgmm" (hasArg (\f d -> d{ pgm_m = (f,[])})) + , Flag "pgmm" (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release")) , Flag "pgms" (hasArg (\f d -> d{ pgm_s = (f,[])})) , Flag "pgma" (hasArg (\f d -> d{ pgm_a = (f,[])})) , Flag "pgml" (hasArg (\f d -> d{ pgm_l = (f,[])})) @@ -1177,8 +1171,8 @@ dynamic_flags = [ , Flag "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles)) , Flag "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles)) , Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles)) - , Flag "keep-raw-s-file" (NoArg (setDynFlag Opt_KeepRawSFiles)) - , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles)) + , Flag "keep-raw-s-file" (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release")) + , Flag "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release")) , Flag "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles)) , Flag "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles)) -- This only makes sense as plural @@ -1289,9 +1283,9 @@ dynamic_flags = [ ------ Machine dependant (-m) stuff --------------------------- - , Flag "monly-2-regs" (noArg (\s -> s{stolen_x86_regs = 2})) - , Flag "monly-3-regs" (noArg (\s -> s{stolen_x86_regs = 3})) - , Flag "monly-4-regs" (noArg (\s -> s{stolen_x86_regs = 4})) + , Flag "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release")) + , Flag "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release")) + , Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release")) , Flag "msse2" (NoArg (setDynFlag Opt_SSE2)) ------ Warning opts ------------------------------------------------- @@ -1478,7 +1472,6 @@ fFlags = [ ( "dicts-cheap", Opt_DictsCheap, nop ), ( "excess-precision", Opt_ExcessPrecision, nop ), ( "eager-blackholing", Opt_EagerBlackHoling, nop ), - ( "asm-mangling", Opt_DoAsmMangling, nop ), ( "print-bind-result", Opt_PrintBindResult, nop ), ( "force-recomp", Opt_ForceRecomp, nop ), ( "hpc-no-auto", Opt_Hpc_No_Auto, nop ), @@ -1650,8 +1643,6 @@ defaultFlags = [ Opt_AutoLinkPackages, Opt_ReadUserPackageConf, - Opt_DoAsmMangling, - Opt_SharedImplib, Opt_GenManifest, @@ -2153,20 +2144,17 @@ setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg} -- The options below are not dependent on the version of gcc, only the -- platform. -machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations - [String]) -- for registerised HC compilations -machdepCCOpts dflags = let (flagsAll, flagsRegHc) = machdepCCOpts' dflags - in (cCcOpts ++ flagsAll, flagsRegHc) +machdepCCOpts :: DynFlags -> [String] -- flags for all C compilations +machdepCCOpts dflags = cCcOpts ++ machdepCCOpts' -machdepCCOpts' :: DynFlags -> ([String], -- flags for all C compilations - [String]) -- for registerised HC compilations -machdepCCOpts' _dflags +machdepCCOpts' :: [String] -- flags for all C compilations +machdepCCOpts' #if alpha_TARGET_ARCH - = ( ["-w", "-mieee" + = ["-w", "-mieee" #ifdef HAVE_THREADED_RTS_SUPPORT , "-D_REENTRANT" #endif - ], [] ) + ] -- For now, to suppress the gcc warning "call-clobbered -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. @@ -2174,71 +2162,17 @@ machdepCCOpts' _dflags #elif hppa_TARGET_ARCH -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! -- (very nice, but too bad the HP /usr/include files don't agree.) - = ( ["-D_HPUX_SOURCE"], [] ) - -#elif m68k_TARGET_ARCH - -- -fno-defer-pop : for the .hc files, we want all the pushing/ - -- popping of args to routines to be explicit; if we let things - -- be deferred 'til after an STGJUMP, imminent death is certain! - -- - -- -fomit-frame-pointer : *don't* - -- It's better to have a6 completely tied up being a frame pointer - -- rather than let GCC pick random things to do with it. - -- (If we want to steal a6, then we would try to do things - -- as on iX86, where we *do* steal the frame pointer [%ebp].) - = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] ) + = ["-D_HPUX_SOURCE"] #elif i386_TARGET_ARCH -- -fno-defer-pop : basically the same game as for m68k -- -- -fomit-frame-pointer : *must* in .hc files; because we're stealing -- the fp (%ebp) for our register maps. - = let n_regs = stolen_x86_regs _dflags - in - ( - [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" - ], - [ "-fno-defer-pop", - "-fomit-frame-pointer", - -- we want -fno-builtin, because when gcc inlines - -- built-in functions like memcpy() it tends to - -- run out of registers, requiring -monly-n-regs - "-fno-builtin", - "-DSTOLEN_X86_REGS="++show n_regs ] - ) - -#elif ia64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer", "-G0"] ) - -#elif x86_64_TARGET_ARCH - = ( - [], - ["-fomit-frame-pointer", - "-fno-asynchronous-unwind-tables", - -- the unwind tables are unnecessary for HC code, - -- and get in the way of -split-objs. Another option - -- would be to throw them away in the mangler, but this - -- is easier. - "-fno-builtin" - -- calling builtins like strlen() using the FFI can - -- cause gcc to run out of regs, so use the external - -- version. - ] ) - -#elif sparc_TARGET_ARCH - = ( [], ["-w"] ) - -- For now, to suppress the gcc warning "call-clobbered - -- register used for global register variable", we simply - -- disable all warnings altogether using the -w flag. Oh well. + = if opt_Static then ["-DDONT_WANT_WIN32_DLL_SUPPORT"] else [] -#elif powerpc_apple_darwin_TARGET - -- -no-cpp-precomp: - -- Disable Apple's precompiling preprocessor. It's a great thing - -- for "normal" programs, but it doesn't support register variable - -- declarations. - = ( [], ["-no-cpp-precomp"] ) #else - = ( [], [] ) + = [] #endif picCCOpts :: DynFlags -> [String] diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index d33fd6c..3eb5744 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -14,7 +14,7 @@ module SysTools ( -- Interface to system tools runUnlit, runCpp, runCc, -- [Option] -> IO () runPp, -- [Option] -> IO () - runMangle, runSplit, -- [Option] -> IO () + runSplit, -- [Option] -> IO () runAs, runLink, -- [Option] -> IO () runMkDLL, runWindres, @@ -171,9 +171,8 @@ initSysTools mbMinusB dflags0 -- architecture-specific stuff is done when building Config.hs unlit_path = installed cGHC_UNLIT_PGM - -- split and mangle are Perl scripts + -- split is a Perl script split_script = installed cGHC_SPLIT_PGM - mangle_script = installed cGHC_MANGLER_PGM windres_path = installed_mingw_bin "windres" @@ -194,7 +193,7 @@ initSysTools mbMinusB dflags0 | isWindowsHost = installed cGHC_TOUCHY_PGM | otherwise = "touch" -- On Win32 we don't want to rely on #!/bin/perl, so we prepend - -- a call to Perl to get the invocation of split and mangle. + -- a call to Perl to get the invocation of split. -- On Unix, scripts are invoked using the '#!' method. Binary -- installations of GHC on Unix place the correct line on the -- front of the script at installation time, so we don't want @@ -202,9 +201,6 @@ initSysTools mbMinusB dflags0 (split_prog, split_args) | isWindowsHost = (perl_path, [Option split_script]) | otherwise = (split_script, []) - (mangle_prog, mangle_args) - | isWindowsHost = (perl_path, [Option mangle_script]) - | otherwise = (mangle_script, []) (mkdll_prog, mkdll_args) | not isWindowsHost = panic "Can't build DLLs on a non-Win32 system" @@ -234,7 +230,6 @@ initSysTools mbMinusB dflags0 pgm_P = cpp_path, pgm_F = "", pgm_c = (gcc_prog,[]), - pgm_m = (mangle_prog,mangle_args), pgm_s = (split_prog,split_args), pgm_a = (as_prog,[]), pgm_l = (ld_prog,[]), @@ -372,11 +367,6 @@ getGccEnv opts = = (path, '\"' : head b_dirs ++ "\";" ++ paths) mangle_path other = other -runMangle :: DynFlags -> [Option] -> IO () -runMangle dflags args = do - let (p,args0) = pgm_m dflags - runSomething dflags "Mangler" p (args0++args) - runSplit :: DynFlags -> [Option] -> IO () runSplit dflags args = do let (p,args0) = pgm_s dflags diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index ad219cf..ccd3e6c 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -325,13 +325,6 @@ - - or - - retain intermediate .raw_s files - dynamic - - - - retain all intermediate temporary files dynamic @@ -1999,12 +1992,6 @@ phase n - cmd - Use cmd as the mangler - dynamic - - - - cmd Use cmd as the splitter dynamic @@ -2595,12 +2582,6 @@ phase n - - - Turn off assembly mangling (use instead) - dynamic - - - - Turn off the GHCi sandbox. Means computations are run in teh main thread, rather than a forked thread. dynamic diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml index 6ed8de1..dfa10a5 100644 --- a/docs/users_guide/phases.xml +++ b/docs/users_guide/phases.xml @@ -71,17 +71,6 @@ - cmd - - - - Use cmd as the - mangler. - - - - - cmd diff --git a/docs/users_guide/separate_compilation.xml b/docs/users_guide/separate_compilation.xml index ae0e80c..099a91f 100644 --- a/docs/users_guide/separate_compilation.xml +++ b/docs/users_guide/separate_compilation.xml @@ -496,22 +496,6 @@ $ ghc -c parse/Foo.hs parse/Bar.hs gurgle/Bumble.hs -odir `uname -m` - , - - - - - - Keep intermediate .raw-s files. - These are the direct output from the C compiler, before - GHC does “assembly mangling” to produce the - .s file. Again, these are not produced - when using the native code generator. - - - - - temporary fileskeeping diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 05f1de4..8b08d9d 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -2203,27 +2203,6 @@ f "2" = 2 - - : - - (x86 only)-monly-N-regs - option (iX86 only) GHC tries to - “steal” four registers from GCC, for performance - reasons; it almost always works. However, when GCC is - compiling some modules with four stolen registers, it will - crash, probably saying: - - -Foo.hc:533: fixed or forbidden register was spilled. -This may be due to a compiler bug or to impossible asm -statements or clauses. - - - Just give some registers back with - . Try `3' first, then `2'. - If `2' doesn't work, please report the bug to us. - - diff --git a/driver/mangler/Makefile b/driver/mangler/Makefile deleted file mode 100644 index 58a1761..0000000 --- a/driver/mangler/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# http://hackage.haskell.org/trac/ghc/wiki/Building/Architecture -# http://hackage.haskell.org/trac/ghc/wiki/Building/Modifying -# -# ----------------------------------------------------------------------------- - -dir = driver/mangler -TOP = ../.. -include $(TOP)/mk/sub-makefile.mk diff --git a/driver/mangler/ghc-asm.lprl b/driver/mangler/ghc-asm.lprl deleted file mode 100644 index 4bac756..0000000 --- a/driver/mangler/ghc-asm.lprl +++ /dev/null @@ -1,2061 +0,0 @@ -%************************************************************************ -%* * -\section[Driver-asm-fiddling]{Fiddling with assembler files} -%* * -%************************************************************************ - -Tasks: -\begin{itemize} -\item -Utterly stomp out C functions' prologues and epilogues; i.e., the -stuff to do with the C stack. -\item -Any other required tidying up. -\end{itemize} - -General note [chak]: Many regexps are very fragile because they rely on white -space being in the right place. This caused trouble with gcc 2.95 (at least -on Linux), where the use of white space in .s files generated by gcc suddenly -changed. To guarantee compatibility across different versions of gcc, make -sure (at least on i386-.*-linux) that regexps tolerate varying amounts of white -space between an assembler statement and its arguments as well as after a the -comma separating multiple arguments. - -\emph{For the time being, I have corrected the regexps for i386-.*-linux. I -didn't touch all the regexps for other i386 platforms, as I don't have -a box to test these changes.} - -HPPA specific notes: -\begin{itemize} -\item -The HP linker is very picky about symbols being in the appropriate -space (code vs. data). When we mangle the threaded code to put the -info tables just prior to the code, they wind up in code space -rather than data space. This means that references to *_info from -un-mangled parts of the RTS (e.g. unthreaded GC code) get -unresolved symbols. Solution: mini-mangler for .c files on HP. I -think this should really be triggered in the driver by a new -rts -option, so that user code doesn't get mangled inappropriately. -\item -With reversed tables, jumps are to the _info label rather than to -the _entry label. The _info label is just an address in code -space, rather than an entry point with the descriptive blob we -talked about yesterday. As a result, you can't use the call-style -JMP_ macro. However, some JMP_ macros take _info labels as targets -and some take code entry points within the RTS. The latter won't -work with the goto-style JMP_ macro. Sigh. Solution: Use the goto -style JMP_ macro, and mangle some more assembly, changing all -"RP'literal" and "LP'literal" references to "R'literal" and -"L'literal," so that you get the real address of the code, rather -than the descriptive blob. Also change all ".word P%literal" -entries in info tables and vector tables to just ".word literal," -for the same reason. Advantage: No more ridiculous call sequences. -\end{itemize} - -%************************************************************************ -%* * -\subsection{Top-level code} -%* * -%************************************************************************ - -\begin{code} -$TargetPlatform = $TARGETPLATFORM; - -($Pgm = $0) =~ s|.*/||m; -$ifile = $ARGV[0]; -$ofile = $ARGV[1]; - -if ( $TargetPlatform =~ /^i386-/m ) { - if ($ARGV[2] eq '') { - $StolenX86Regs = 4; - } else { - $StolenX86Regs = $ARGV[2]; - } -} - -&mangle_asm($ifile,$ofile); - -exit(0); -\end{code} - -%************************************************************************ -%* * -\subsection{Constants for various architectures} -%* * -%************************************************************************ - -\begin{code} -sub init_TARGET_STUFF { - - #--------------------------------------------------------# - if ( $TargetPlatform =~ /^alpha-.*-.*/m ) { - - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^\$L?C(\d+):$'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*(\$.*\.\.ng:|\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)'; - $T_COPY_DIRVS = '^\s*(\$.*\.\.ng:|\#|\.(file|globl|ent|loc))'; - - $T_DOT_WORD = '\.(long|quad|byte|word)'; - $T_DOT_GLOBAL = '^\t\.globl'; - $T_HDR_literal = "\.rdata\n\t\.align 3\n"; - $T_HDR_misc = "\.text\n\t\.align 3\n"; - $T_HDR_data = "\.data\n\t\.align 3\n"; - $T_HDR_rodata = "\.rdata\n\t\.align 3\n"; - $T_HDR_closure = "\.data\n\t\.align 3\n"; - $T_HDR_info = "\.text\n\t\.align 3\n"; - $T_HDR_entry = "\.text\n\t\.align 3\n"; - $T_HDR_vector = "\.text\n\t\.align 3\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^hppa/m ) { - - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^L\$C(\d+)$'; # regexp for what such a lbl looks like - $T_POST_LBL = ''; - - $T_MOVE_DIRVS = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)'; - $T_COPY_DIRVS = '^\s+\.(IMPORT|EXPORT)'; - - $T_DOT_WORD = '\.(blockz|word|half|byte)'; - $T_DOT_GLOBAL = '^\s+\.EXPORT'; - $T_HDR_literal = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n"; - $T_HDR_misc = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n"; - $T_HDR_data = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n"; - $T_HDR_rodata = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n"; - $T_HDR_closure = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n"; - $T_HDR_info = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n"; - $T_HDR_entry = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n"; - $T_HDR_vector = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd2|nextstep3|cygwin32|mingw32)$/m ) { - # NeXT added but not tested. CaS - - $T_STABBY = 1; # 1 iff .stab things (usually if a.out format) - $T_US = '_'; # _ if symbols have an underscore on the front - $T_PRE_APP = '^#'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^LC(\d+):$'; - $T_POST_LBL = ':'; - $T_X86_PRE_LLBL_PAT = 'L'; - $T_X86_PRE_LLBL = 'L'; - $T_X86_BADJMP = '^\tjmp [^L\*]'; - - $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s.*|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*|\.lcomm.*)\n)'; - $T_COPY_DIRVS = '\.(globl|stab|lcomm)'; - $T_DOT_WORD = '\.(long|word|value|byte|space)'; - $T_DOT_GLOBAL = '\.globl'; - $T_HDR_literal = "\.text\n\t\.align 4\n"; - $T_HDR_misc = "\.text\n\t\.align 4,0x90\n"; - $T_HDR_data = "\.data\n\t\.align 4\n"; - $T_HDR_rodata = "\.text\n\t\.align 4\n"; - $T_HDR_closure = "\.data\n\t\.align 4\n"; - $T_HDR_info = "\.text\n\t\.align 4\n"; # NB: requires padding - $T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?) - $T_HDR_vector = "\.text\n\t\.align 4\n"; # NB: requires padding - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|gnu|freebsd|dragonfly|netbsd|openbsd|kfreebsdgnu)$/m ) { - - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = # regexp that says what comes before APP/NO_APP - ($TargetPlatform =~ /-(linux|gnu|freebsd|dragonfly|netbsd|openbsd)$/m) ? '#' : '/' ; - $T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - $T_X86_PRE_LLBL_PAT = '\.L'; - $T_X86_PRE_LLBL = '.L'; - $T_X86_BADJMP = '^\tjmp\s+[^\.\*]'; - - $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s.*|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)'; - if ( $TargetPlatform =~ /solaris2/m ) { - # newer Solaris linkers are picky about .size information, so - # omit it (see #1421) - $T_COPY_DIRVS = '^\s*\.(globl|local)'; - } else { - $T_COPY_DIRVS = '^\s*\.(globl|type|size|local)'; - } - - $T_DOT_WORD = '\.(long|value|word|byte|zero)'; - $T_DOT_GLOBAL = '\.globl'; - $T_HDR_literal = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11) - $T_HDR_misc = "\.text\n\t\.align 4\n"; - $T_HDR_data = "\.data\n\t\.align 4\n"; - $T_HDR_rodata = "\.section\t\.rodata\n\t\.align 4\n"; - $T_HDR_closure = "\.data\n\t\.align 4\n"; - $T_HDR_info = "\.text\n\t\.align 4\n"; - $T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?) - $T_HDR_vector = "\.text\n\t\.align 4\n"; # NB: requires padding - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^ia64-.*-linux$/m ) { - - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = '#'; - $T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*\.(global|proc|pred\.safe_across_calls|text|data|section|subsection|align|size|type|ident)\s+.*\n)'; - $T_COPY_DIRVS = '\.(global|proc)'; - - $T_DOT_WORD = '\.(long|value|byte|zero)'; - $T_DOT_GLOBAL = '\.global'; - $T_HDR_literal = "\.section\t\.rodata\n"; - $T_HDR_misc = "\.text\n\t\.align 16\n"; # May contain code; align like 'entry' - $T_HDR_data = "\.data\n\t\.align 8\n"; - $T_HDR_rodata = "\.section\t\.rodata\n\t\.align 8\n"; - $T_HDR_closure = "\.data\n\t\.align 8\n"; - $T_HDR_info = "\.text\n\t\.align 8\n"; - $T_HDR_entry = "\.text\n\t\.align 16\n"; - $T_HDR_vector = "\.text\n\t\.align 8\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^x86_64-.*-(linux|openbsd|freebsd|dragonfly|netbsd|kfreebsdgnu)$/m ) { - - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = '#'; - $T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*\.(globl|text|data|section|align|size|type|ident|local)([ \t].*)?\n)'; - $T_COPY_DIRVS = '\.(globl|type|size|local)'; - - $T_DOT_WORD = '\.(quad|long|value|byte|zero)'; - $T_DOT_GLOBAL = '\.global'; - - $T_HDR_literal16 = "\.section\t\.rodata.cst16\n\t.align 16\n"; - $T_HDR_literal = "\.section\t\.rodata\n"; - - $T_HDR_misc = "\.text\n\t\.align 8\n"; - $T_HDR_data = "\.data\n\t\.align 8\n"; - $T_HDR_rodata = "\.section\t\.rodata\n\t\.align 8\n"; - - # the assembler on x86_64/Linux refuses to generate code for - # .quad x - y - # where x is in the text section and y in the rodata section. - # It works if y is in the text section, though. This is probably - # going to cause difficulties for PIC, I imagine. - # - # See Note [x86-64-relative] in includes/InfoTables.h - $T_HDR_relrodata= "\.text\n\t\.align 8\n"; - - $T_HDR_closure = "\.data\n\t\.align 8\n"; - $T_HDR_info = "\.text\n\t\.align 8\n"; - $T_HDR_entry = "\.text\n\t\.align 8\n"; - $T_HDR_vector = "\.text\n\t\.align 8\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/m ) { - - $T_STABBY = 1; # 1 iff .stab things (usually if a.out format) - $T_US = '_'; # _ if symbols have an underscore on the front - $T_PRE_APP = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^LC(\d+):$'; - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)'; - $T_COPY_DIRVS = '\.(globl|proc|stab)'; - - $T_DOT_WORD = '\.long'; - $T_DOT_GLOBAL = '\.globl'; - $T_HDR_literal = "\.text\n\t\.even\n"; - $T_HDR_misc = "\.text\n\t\.even\n"; - $T_HDR_data = "\.data\n\t\.even\n"; - $T_HDR_rodata = "\.text\n\t\.even\n"; - $T_HDR_closure = "\.data\n\t\.even\n"; - $T_HDR_info = "\.text\n\t\.even\n"; - $T_HDR_entry = "\.text\n\t\.even\n"; - $T_HDR_vector = "\.text\n\t\.even\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^mips-.*/m ) { - - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = '^\s*#'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^\$LC(\d+):$'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)'; - $T_COPY_DIRVS = '\.(globl|ent)'; - - $T_DOT_WORD = '\.word'; - $T_DOT_GLOBAL = '^\t\.globl'; - $T_HDR_literal = "\t\.rdata\n\t\.align 2\n"; - $T_HDR_misc = "\t\.text\n\t\.align 2\n"; - $T_HDR_data = "\t\.data\n\t\.align 2\n"; - $T_HDR_rodata = "\t\.rdata\n\t\.align 2\n"; - $T_HDR_closure = "\t\.data\n\t\.align 2\n"; - $T_HDR_info = "\t\.text\n\t\.align 2\n"; - $T_HDR_entry = "\t\.text\n\t\.align 2\n"; - $T_HDR_vector = "\t\.text\n\t\.align 2\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^powerpc-apple-darwin.*/m ) { - # Apple PowerPC Darwin/MacOS X. - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = '_'; # _ if symbols have an underscore on the front - $T_PRE_APP = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^\LC\d+:'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s.*|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)'; - $T_COPY_DIRVS = '\.(globl|lcomm)'; - - $T_DOT_WORD = '\.(long|short|byte|fill|space)'; - $T_DOT_GLOBAL = '\.globl'; - $T_HDR_toc = "\.toc\n"; - $T_HDR_literal = "\t\.const\n\t\.align 2\n"; - $T_HDR_misc = "\t\.text\n\t\.align 2\n"; - $T_HDR_data = "\t\.data\n\t\.align 2\n"; - $T_HDR_rodata = "\t\.const\n\t\.align 2\n"; - $T_HDR_relrodata= "\t\.const_data\n\t\.align 2\n"; - $T_HDR_closure = "\t\.data\n\t\.align 2\n"; - $T_HDR_info = "\t\.text\n\t\.align 2\n"; - $T_HDR_entry = "\t\.text\n\t\.align 2\n"; - $T_HDR_vector = "\t\.text\n\t\.align 2\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^i386-apple-darwin.*/m ) { - # Apple i386 Darwin/MacOS X. - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = '_'; # _ if symbols have an underscore on the front - $T_PRE_APP = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^\LC\d+:'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - $T_X86_PRE_LLBL_PAT = 'L'; - $T_X86_PRE_LLBL = 'L'; - $T_X86_BADJMP = '^\tjmp [^L\*]'; - - $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s.*|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)'; - $T_COPY_DIRVS = '\.(globl|lcomm)'; - - $T_DOT_WORD = '\.(long|short|byte|fill|space)'; - $T_DOT_GLOBAL = '\.globl'; - $T_HDR_toc = "\.toc\n"; - $T_HDR_literal16= "\t\.literal8\n\t\.align 4\n"; - $T_HDR_literal = "\t\.const\n\t\.align 4\n"; - $T_HDR_misc = "\t\.text\n\t\.align 2\n"; - $T_HDR_data = "\t\.data\n\t\.align 2\n"; - $T_HDR_rodata = "\t\.const\n\t\.align 2\n"; - $T_HDR_relrodata= "\t\.const_data\n\t\.align 2\n"; - $T_HDR_closure = "\t\.data\n\t\.align 2\n"; - $T_HDR_info = "\t\.text\n\t\.align 2\n"; - $T_HDR_entry = "\t\.text\n\t\.align 2\n"; - $T_HDR_vector = "\t\.text\n\t\.align 2\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^x86_64-apple-darwin.*/m ) { - # Apple amd64 Darwin/MacOS X. - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = '_'; # _ if symbols have an underscore on the front - $T_PRE_APP = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^\LC\d+:'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)'; - $T_COPY_DIRVS = '\.(globl|lcomm)'; - - $T_DOT_WORD = '\.(quad|long|short|byte|fill|space)'; - $T_DOT_GLOBAL = '\.globl'; - $T_HDR_toc = "\.toc\n"; - $T_HDR_literal16= "\t\.literal8\n\t\.align 4\n"; - $T_HDR_literal = "\t\.const\n\t\.align 4\n"; - $T_HDR_misc = "\t\.text\n\t\.align 2\n"; - $T_HDR_data = "\t\.data\n\t\.align 2\n"; - $T_HDR_rodata = "\t\.const\n\t\.align 2\n"; - $T_HDR_relrodata= "\t\.const_data\n\t\.align 2\n"; - $T_HDR_closure = "\t\.data\n\t\.align 2\n"; - $T_HDR_info = "\t\.text\n\t\.align 2\n"; - $T_HDR_entry = "\t\.text\n\t\.align 2\n"; - $T_HDR_vector = "\t\.text\n\t\.align 2\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/m ) { - # PowerPC Linux - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = '^#'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^\.LC\d+:'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)'; - $T_COPY_DIRVS = '^\s*\.(globl|type|size|local)'; - - $T_DOT_WORD = '\.(long|short|byte|fill|space)'; - $T_DOT_GLOBAL = '\.globl'; - $T_HDR_toc = "\.toc\n"; - $T_HDR_literal = "\t\.section\t.rodata\n\t\.align 2\n"; - $T_HDR_misc = "\t\.text\n\t\.align 2\n"; - $T_HDR_data = "\t\.data\n\t\.align 2\n"; - $T_HDR_rodata = "\t\.section\t.rodata\n\t\.align 2\n"; - $T_HDR_closure = "\t\.data\n\t\.align 2\n"; - $T_HDR_info = "\t\.text\n\t\.align 2\n"; - $T_HDR_entry = "\t\.text\n\t\.align 2\n"; - $T_HDR_vector = "\t\.text\n\t\.align 2\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^powerpc64-.*-linux/m ) { - # PowerPC 64 Linux - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = '\.'; # _ if symbols have an underscore on the front - $T_PRE_APP = '^#'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^\.LC\d+:'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)'; - $T_COPY_DIRVS = '^\s*\.(globl|type|size|local)'; - - $T_DOT_WORD = '\.(long|short|byte|fill|space)'; - $T_DOT_GLOBAL = '\.globl'; - $T_HDR_toc = "\.toc\n"; - $T_HDR_literal = "\t\.section\t\".toc\",\"aw\"\n"; - $T_HDR_misc = "\t\.text\n\t\.align 2\n"; - $T_HDR_data = "\t\.data\n\t\.align 2\n"; - $T_HDR_rodata = "\t\.section\t.rodata\n\t\.align 2\n"; - $T_HDR_closure = "\t\.data\n\t\.align 2\n"; - $T_HDR_info = "\t\.text\n\t\.align 2\n"; - $T_HDR_entry = "\t\.text\n\t\.align 2\n"; - $T_HDR_vector = "\t\.text\n\t\.align 2\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^sparc-.*-(solaris2|openbsd)/m ) { - - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\s+\.local\s+\S+|\.text|\.data|\.stab.*|\s*\.section.*|\s+\.type.*|\s+\.size.*)\n)'; - $T_COPY_DIRVS = '\.(global|local|proc|stab)'; - - $T_DOT_WORD = '\.(long|word|byte|half|skip|uahalf|uaword)'; - $T_DOT_GLOBAL = '^\t\.global'; - $T_HDR_literal = "\.text\n\t\.align 8\n"; - $T_HDR_misc = "\.text\n\t\.align 4\n"; - $T_HDR_data = "\.data\n\t\.align 8\n"; - $T_HDR_rodata = "\.text\n\t\.align 4\n"; - $T_HDR_closure = "\.data\n\t\.align 4\n"; - $T_HDR_info = "\.text\n\t\.align 4\n"; - $T_HDR_entry = "\.text\n\t\.align 4\n"; - $T_HDR_vector = "\.text\n\t\.align 4\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/m ) { - - $T_STABBY = 1; # 1 iff .stab things (usually if a.out format) - $T_US = '_'; # _ if symbols have an underscore on the front - $T_PRE_APP = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP - $T_CONST_LBL = '^LC(\d+):$'; - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)'; - $T_COPY_DIRVS = '\.(global|proc|stab)'; - - $T_DOT_WORD = '\.word'; - $T_DOT_GLOBAL = '^\t\.global'; - $T_HDR_literal = "\.text\n\t\.align 8\n"; - $T_HDR_misc = "\.text\n\t\.align 4\n"; - $T_HDR_data = "\.data\n\t\.align 8\n"; - $T_HDR_rodata = "\.text\n\t\.align 4\n"; - $T_HDR_closure = "\.data\n\t\.align 4\n"; - $T_HDR_info = "\.text\n\t\.align 4\n"; - $T_HDR_entry = "\.text\n\t\.align 4\n"; - $T_HDR_vector = "\.text\n\t\.align 4\n"; - - #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^sparc-.*-linux/m ) { - $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) - $T_US = ''; # _ if symbols have an underscore on the front - $T_PRE_APP = '#'; # regexp that says what comes before APP/NO_APP - # Probably doesn't apply anyway - $T_CONST_LBL = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like - $T_POST_LBL = ':'; - - $T_MOVE_DIRVS = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\s+\.local\s+\S+|\.text|\.data|\.seg|\.stab.*|\s+?\.section.*|\s+\.type.*|\s+\.size.*)\n)'; - $T_COPY_DIRVS = '\.(global|local|globl|proc|stab)'; - - $T_DOT_WORD = '\.(long|word|nword|xword|byte|half|short|skip|uahalf|uaword)'; - $T_DOT_GLOBAL = '^\t\.global'; - $T_HDR_literal = "\.text\n\t\.align 8\n"; - $T_HDR_misc = "\.text\n\t\.align 4\n"; - $T_HDR_data = "\.data\n\t\.align 8\n"; - $T_HDR_rodata = "\.text\n\t\.align 4\n"; - $T_HDR_closure = "\.data\n\t\.align 4\n"; - $T_HDR_info = "\.text\n\t\.align 4\n"; - $T_HDR_entry = "\.text\n\t\.align 4\n"; - $T_HDR_vector = "\.text\n\t\.align 4\n"; - - #--------------------------------------------------------# - } else { - print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n"; - exit 1; - } - - if($T_HDR_relrodata eq "") { - # default values: - # relrodata defaults to rodata. - $T_HDR_relrodata = $T_HDR_rodata; - } - -if ( 0 ) { -print STDERR "T_STABBY: $T_STABBY\n"; -print STDERR "T_US: $T_US\n"; -print STDERR "T_PRE_APP: $T_PRE_APP\n"; -print STDERR "T_CONST_LBL: $T_CONST_LBL\n"; -print STDERR "T_POST_LBL: $T_POST_LBL\n"; -if ( $TargetPlatform =~ /^i386-/m ) { - print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n"; - print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n"; - print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n"; -} -print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n"; -print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n"; -print STDERR "T_DOT_WORD: $T_DOT_WORD\n"; -print STDERR "T_HDR_literal: $T_HDR_literal\n"; -print STDERR "T_HDR_misc: $T_HDR_misc\n"; -print STDERR "T_HDR_data: $T_HDR_data\n"; -print STDERR "T_HDR_rodata: $T_HDR_rodata\n"; -print STDERR "T_HDR_closure: $T_HDR_closure\n"; -print STDERR "T_HDR_info: $T_HDR_info\n"; -print STDERR "T_HDR_entry: $T_HDR_entry\n"; -print STDERR "T_HDR_vector: $T_HDR_vector\n"; -} - -} -\end{code} - -%************************************************************************ -%* * -\subsection{Mangle away} -%* * -%************************************************************************ - -\begin{code} -sub mangle_asm { - local($in_asmf, $out_asmf) = @_; - local($i, $c); - - # ia64-specific information for code chunks - my $ia64_locnum; - my $ia64_outnum; - - &init_TARGET_STUFF(); - &init_FUNNY_THINGS(); - - open(INASM, "< $in_asmf") - || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n"); - open(OUTASM,"> $out_asmf") - || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n"); - - # read whole file, divide into "chunks": - # record some info about what we've found... - - @chk = (); # contents of the chunk - $numchks = 0; # number of them - @chkcat = (); # what category of thing in each chunk - @chksymb = (); # what symbol(base) is defined in this chunk - %entrychk = (); # ditto, its entry code - %closurechk = (); # ditto, the (static) closure - %srtchk = (); # ditto, its SRT (for top-level things) - %infochk = (); # given a symbol base, say what chunk its info tbl is in - %vectorchk = (); # ditto, return vector table - $EXTERN_DECLS = ''; # .globl .text (MIPS only) - - $i = 0; $chkcat[0] = 'misc'; $chk[0] = ''; - - while () { - tr/\r//d if $TargetPlatform =~ /-mingw32$/m; # In case Perl doesn't convert line endings - next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/om; - next if $T_STABBY && /^\.stab.*ghc.*c_ID/m; - next if /^\t\.def.*endef$/m; - next if /${T_PRE_APP}(NO_)?APP/om; - next if /^;/m && $TargetPlatform =~ /^hppa/m; - - next if /(^$|^\t\.file\t|^ # )/m && $TargetPlatform =~ /(^mips-|^ia64-|-mingw32$)/m; - - if ( $TargetPlatform =~ /^mips-/m - && /^\t\.(globl\S+\.text|comm\t)/m ) { - $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/m; - # Treat .comm variables as data. These show up in two (known) places: - # - # - the module_registered variable used in the __stginit fragment. - # even though these are declared static and initialised, gcc 3.3 - # likes to make them .comm, presumably to save space in the - # object file. - # - # - global variables used to pass arguments from C to STG in - # a foreign export. (is this still true? --SDM) - # - } elsif ( /^\t\.comm.*$/m ) { - $chk[++$i] = $_; - $chkcat[$i] = 'data'; - $chksymb[$i] = ''; - - # Labels ending "_str": these are literal strings. - } elsif ( /^${T_US}([A-Za-z0-9_]+)_str${T_POST_LBL}$/m ) { - $chk[++$i] = $_; - $chkcat[$i] = 'relrodata'; - $chksymb[$i] = ''; - } elsif ( $TargetPlatform =~ /-darwin/m - && (/^\s*\.subsections_via_symbols/m - ||/^\s*\.no_dead_strip.*/m)) { - # Don't allow Apple's linker to do any dead-stripping of symbols - # in this file, because it will mess up info-tables in mangled - # code. - # The .no_dead_strip directives are actually put there by - # the gcc3 "used" attribute on entry points. - - } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/m && ( - /^\s*\.picsymbol_stub/m - || /^\s*\.section __TEXT,__picsymbol_stub\d,.*/m - || /^\s*\.section __TEXT,__picsymbolstub\d,.*/m - || /^\s*\.symbol_stub/m - || /^\s*\.section __TEXT,__symbol_stub\d,.*/m - || /^\s*\.section __TEXT,__symbolstub\d,.*/m - || /^\s*\.lazy_symbol_pointer/m - || /^\s*\.non_lazy_symbol_pointer/m - || /^\s*\.section __IMPORT.*/m)) - { - $chk[++$i] = $_; - $chkcat[$i] = 'dyld'; - $chksymb[$i] = ''; - $dyld_section = $_; - - } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/m && $chkcat[$i] eq 'dyld' && /^\s*\.data/m) - { # non_lazy_symbol_ptrs that point to local symbols - $chk[++$i] = $_; - $chkcat[$i] = 'dyld'; - $chksymb[$i] = ''; - $dyld_section = $_; - } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/m && $chkcat[$i] eq 'dyld' && /^\s*\.align/m) - { # non_lazy_symbol_ptrs that point to local symbols - $dyld_section .= $_; - } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/m && $chkcat[$i] eq 'dyld' && /^L_.*:$/m) - { # non_lazy_symbol_ptrs that point to local symbols - $chk[++$i] = $dyld_section . $_; - $chkcat[$i] = 'dyld'; - $chksymb[$i] = ''; - - } elsif ( /^\s+/m ) { # most common case first -- a simple line! - # duplicated from the bottom - - $chk[$i] .= $_; - - } elsif ( /\.\.ng:$/m && $TargetPlatform =~ /^alpha-/m ) { - # Alphas: Local labels not to be confused with new chunks - $chk[$i] .= $_; - # NB: all the rest start with a non-space - - } elsif ( $TargetPlatform =~ /^mips-/m - && /^\d+:/m ) { # a funny-looking very-local label - $chk[$i] .= $_; - - } elsif ( /$T_CONST_LBL/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'literal'; - $chksymb[$i] = $1; - - } elsif ( /^${T_US}__stg_split_marker(\d*)${T_POST_LBL}$/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'splitmarker'; - $chksymb[$i] = $1; - - } elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/om ) { - $symb = $1; - $chk[++$i] = $_; - $chkcat[$i] = 'infotbl'; - $chksymb[$i] = $symb; - - die "Info table already? $symb; $i\n" if defined($infochk{$symb}); - - $infochk{$symb} = $i; - - } elsif ( /^${T_US}([A-Za-z0-9_]+)_(entry|ret)${T_POST_LBL}$/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'entry'; - $chksymb[$i] = $1; - - $entrychk{$1} = $i; - - } elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'closure'; - $chksymb[$i] = $1; - - $closurechk{$1} = $i; - - } elsif ( /^${T_US}([A-Za-z0-9_]+)_srt${T_POST_LBL}$/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'srt'; - $chksymb[$i] = $1; - - $srtchk{$1} = $i; - - } elsif ( /^${T_US}([A-Za-z0-9_]+)_ct${T_POST_LBL}$/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'data'; - $chksymb[$i] = ''; - - } elsif ( /^${T_US}(stg_ap_stack_entries|stg_stack_save_entries|stg_arg_bitmaps)${T_POST_LBL}$/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'data'; - $chksymb[$i] = ''; - - } elsif ( /^(${T_US}__gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/om ) { - ; # toss it - - } elsif ( /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/om - || /^${T_US}.*_CAT${T_POST_LBL}$/om # PROF: _entryname_CAT - || /^${T_US}.*_done${T_POST_LBL}$/om # PROF: _module_done - || /^${T_US}_module_registered${T_POST_LBL}$/om # PROF: _module_registered - ) { - $chk[++$i] = $_; - $chkcat[$i] = 'data'; - $chksymb[$i] = ''; - - } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/m && $TargetPlatform =~ /^hppa/m ) { - $chk[++$i] = $_; - $chkcat[$i] = 'bss'; - $chksymb[$i] = ''; - - } elsif ( /^${T_US}([A-Za-z0-9_]+)_cc(s)?${T_POST_LBL}$/om ) { - # all CC_ symbols go in the data section... - $chk[++$i] = $_; - $chkcat[$i] = 'data'; - $chksymb[$i] = ''; - - } elsif ( /^${T_US}([A-Za-z0-9_]+)_hpc${T_POST_LBL}$/om ) { - # hpc shares tick boxes across modules - $chk[++$i] = $_; - $chkcat[$i] = 'data'; - $chksymb[$i] = ''; - - } elsif ( /^${T_US}([A-Za-z0-9_]+)_(alt|dflt)${T_POST_LBL}$/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'misc'; - $chksymb[$i] = ''; - } elsif ( /^${T_US}([A-Za-z0-9_]+)_vtbl${T_POST_LBL}$/om ) { - $chk[++$i] = $_; - $chkcat[$i] = 'vector'; - $chksymb[$i] = $1; - - $vectorchk{$1} = $i; - - } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/m - && /^[A-Za-z0-9][A-Za-z0-9_]*:/m ) { - # Some Solaris system headers contain function definitions (as - # opposed to mere prototypes), which end up in the .hc file when - # a Haskell module foreign imports the corresponding system - # functions (most notably stat()). We put them into the text - # segment. Note that this currently does not extend to function - # names starting with an underscore. - # - chak 7/2001 - $chk[++$i] = $_; - $chkcat[$i] = 'misc'; - $chksymb[$i] = $1; - - } elsif ( $TargetPlatform =~ /^i386-apple-darwin/m && /^(___i686\.get_pc_thunk\.[abcd]x):/om) { - # To handle PIC on Darwin/x86, we need to appropriately pass through - # the get_pc_thunk functions. The need to be put into a special section - # marked as coalesced (otherwise the .weak_definition doesn't work - # on Darwin). - $chk[++$i] = $_; - $chkcat[$i] = 'get_pc_thunk'; - $chksymb[$i] = $1; - - } elsif ( /^${T_US}[A-Za-z0-9_]/om - && ( $TargetPlatform !~ /^hppa/m # need to avoid local labels in this case - || ! /^L\$\d+$/m ) - && ( $TargetPlatform !~ /^powerpc64/m # we need to avoid local labels in this case - || ! /^\.L\d+:$/m ) ) { - local($thing); - chop($thing = $_); - $thing =~ s/:$//m; - $chk[++$i] = $_; - $chksymb[$i] = ''; - if ( - /^${T_US}stg_.*${T_POST_LBL}$/om # RTS internals - || /^${T_US}__stg_.*${T_POST_LBL}$/om # more RTS internals - || /^${T_US}__fexp_.*${T_POST_LBL}$/om # foreign export - || /^${T_US}.*_slow${T_POST_LBL}$/om # slow entry - || /^${T_US}__stginit.*${T_POST_LBL}$/om # __stginit - || /^${T_US}.*_btm${T_POST_LBL}$/om # large bitmaps - || /^${T_US}.*_fast${T_POST_LBL}$/om # primops - || /^_uname:/om # x86/Solaris2 - ) - { - $chkcat[$i] = 'misc'; - } elsif ( - /^${T_US}.*_srtd${T_POST_LBL}$/om # large bitmaps - || /^${T_US}.*_closure_tbl${T_POST_LBL}$/om # closure tables - ) - { - $chkcat[$i] = 'relrodata'; - } else - { - print STDERR "Warning: retaining unknown function \`$thing' in output from C compiler\n"; - $chkcat[$i] = 'unknown'; - } - - } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/m && /^\.LCTOC1 = /om ) { - # PowerPC Linux's large-model PIC (-fPIC) generates a gobal offset - # table "by hand". Be sure to copy it over. - # Note that this label and all entries in the table should actually - # go into the .got2 section, but it isn't easy to distinguish them - # from other constant literals (.LC\d+), so we just put everything - # in .rodata. - $chk[++$i] = $_; - $chkcat[$i] = 'literal'; - $chksymb[$i] = 'LCTOC1'; - } else { # simple line (duplicated at the top) - - $chk[$i] .= $_; - } - } - $numchks = $#chk + 1; - $chk[$numchks] = ''; # We might push .note.GNU-stack into this - $chkcat[$numchks] = 'verbatim'; # If we do, write it straight back out - - # open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n"; - # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] } - # close CHUNKS; - - # the division into chunks is imperfect; - # we throw some things over the fence into the next - # chunk. - # - # also, there are things we would like to know - # about the whole module before we start spitting - # output. - - local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/m) ? 1 : 0; - local($FIRST_TOSSABLE ) = ($TargetPlatform =~ /^(hppa|mips-)/m) ? 1 : 0; - -# print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n"; - - # Alphas: NB: we start meddling at chunk 1, not chunk 0 - # The first ".rdata" is quite magical; as of GCC 2.7.x, it - # spits a ".quad 0" in after the very first ".rdata"; we - # detect this special case (tossing the ".quad 0")! - local($magic_rdata_seen) = 0; - - # HPPAs, MIPSen: also start medding at chunk 1 - - for ($i = $FIRST_TOSSABLE; $i < $numchks; $i++) { - $c = $chk[$i]; # convenience copy - -# print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c; - - # toss all prologue stuff; HPPA is pretty weird - # (see elsewhere) - $c = &hppa_mash_prologue($c) if $TargetPlatform =~ /^hppa-/m; - - undef $ia64_locnum; - undef $ia64_outnum; - - # be slightly paranoid to make sure there's - # nothing surprising in there - if ( $c =~ /--- BEGIN ---/m ) { - if (($p, $r) = split(/--- BEGIN ---/m, $c)) { - - # remove junk whitespace around the split point - $p =~ s/\t+$//m; - $r =~ s/^\s*\n//m; - - if ($TargetPlatform =~ /^i386-/m) { - if ($p =~ /^\tsubl\s+\$(\d+),\s*\%esp\n/m) { - if ($1 >= 8192) { - die "Error: reserved stack space exceeded!\n Possible workarounds: compile with -fasm, or try another version of gcc.\n" - } - } - - # gcc 3.4.3 puts this kind of stuff in the prologue, eg. - # when compiling PrimOps.cmm with -optc-O2: - # xorl %ecx, %ecx - # xorl %edx, %edx - # movl %ecx, 16(%esp) - # movl %edx, 20(%esp) - # but then the code of the function doesn't assume - # anything about the contnets of these stack locations. - # I think it's to do with the use of inline functions for - # PK_Word64() and friends, where gcc is initialising the - # contents of the struct to zero, and failing to optimise - # away the initialisation. Let's live dangerously and - # discard these initalisations. - - $p =~ s/^\tpushl\s+\%e(di|si|bx)\n//gm; - $p =~ s/^\txorl\s+\%e(ax|cx|dx),\s*\%e(ax|cx|dx)\n//gm; - $p =~ s/^\tmovl\s+\%e(ax|cx|dx|si|di),\s*\d*\(\%esp\)\n//gm; - $p =~ s/^\tmovl\s+\$\d+,\s*\d*\(\%esp\)\n//gm; - $p =~ s/^\tsubl\s+\$\d+,\s*\%esp\n//m; - $p =~ s/^\tmovl\s+\$\d+,\s*\%eax\n\tcall\s+__alloca\n//m if ($TargetPlatform =~ /^.*-(cygwin32|mingw32)/m); - - if ($TargetPlatform =~ /^i386-apple-darwin/m) { - $pcrel_label = $p; - $pcrel_label =~ s/(.|\n)*^(\"?L\d+\$pb\"?):\n(.|\n)*/$2/m or $pcrel_label = ""; - $pcrel_reg = $p; - $pcrel_reg =~ s/(.|\n)*.*___i686\.get_pc_thunk\.([abcd]x)\n(.|\n)*/$2/m or $pcrel_reg = ""; - $p =~ s/^\s+call\s+___i686\.get_pc_thunk\..x//m; - $p =~ s/^\"?L\d+\$pb\"?:\n//m; - - if ($pcrel_reg eq "bx") { - # Bad gcc. Goes and uses %ebx, our BaseReg, for PIC. Bad gcc. - die "Darwin/x86: -fPIC -via-C doesn't work yet, use -fasm. Aborting." - } - } - - } elsif ($TargetPlatform =~ /^x86_64-/m) { - $p =~ s/^\tpushq\s+\%r(bx|bp|12|13|14)\n//gm; - $p =~ s/^\tmovq\s+\%r(bx|bp|12|13|14),\s*\d*\(\%rsp\)\n//gm; - $p =~ s/^\tsubq\s+\$\d+,\s*\%rsp\n//m; - - } elsif ($TargetPlatform =~ /^ia64-/m) { - $p =~ s/^\t\.prologue .*\n//m; - - # Record the number of local and out registers for register relocation later - $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, (\d+), (\d+), 0\n//m; - $ia64_locnum = $1; - $ia64_outnum = $2; - - $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//m; - $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//m; - - # Ignore save/restore of these registers; they're taken - # care of in StgRun() - $p =~ s/^\t\.save ar\.lc, r\d+\n//m; - $p =~ s/^\t\.save pr, r\d+\n//m; - $p =~ s/^\tmov r\d+ = ar\.lc\n//m; - $p =~ s/^\tmov r\d+ = pr\n//m; - - # Remove .proc and .body directives - $p =~ s/^\t\.proc [a-zA-Z0-9_.]+#\n//m; - $p =~ s/^\t\.body\n//m; - - # If there's a label, move it to the body - if ($p =~ /^[a-zA-Z0-9.]+:\n/m) { - $p = $` . $'; - $r = $& . $r; - } - - # Remove floating-point spill instructions. - # Only fp registers 2-5 and 16-23 are saved by the runtime. - if ($p =~ s/^\tstf\.spill \[r1[4-9]\] = f([2-5]|1[6-9]|2[0-3])(, [0-9]+)?\n//gm) { - # Being paranoid, only try to remove these if we saw a - # spill operation. - $p =~ s/^\tmov r1[4-9] = r12\n//m; - $p =~ s/^\tadds r1[4-9] = -[0-9]+, r12\n//gm; - $p =~ s/^\t\.save\.f 0x[0-9a-fA-F]\n//gm; - $p =~ s/^\t\.save\.gf 0x0, 0x[0-9a-fA-F]+\n//gm; - } - - $p =~ s/^\tnop(?:\.[mifb])?\s+\d+\n//gm; # remove nop instructions - $p =~ s/^\t\.(mii|mmi|mfi)\n//gm; # bundling is no longer sensible - $p =~ s/^\t;;\n//gm; # discard stops - $p =~ s/^\t\/\/.*\n//gm; # gcc inserts timings in // comments - - # GCC 3.3 saves r1 in the prologue, move this to the body - # (Does this register get restored anywhere?) - if ($p =~ /^\tmov r\d+ = r1\n/m) { - $p = $` . $'; - $r = $& . $r; - } - } elsif ($TargetPlatform =~ /^m68k-/m) { - $p =~ s/^\tlink a6,#-?\d.*\n//m; - $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//m; - # The above showed up in the asm code, - # so I added it here. - # I hope it's correct. - # CaS - $p =~ s/^\tmovel d2,sp\@-\n//m; - $p =~ s/^\tmovel d5,sp\@-\n//m; # SMmark.* only? - $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//m; # SMmark.* only? - } elsif ($TargetPlatform =~ /^mips-/m) { - # the .frame/.mask/.fmask that we use is the same - # as that produced by GCC for miniInterpret; this - # gives GDB some chance of figuring out what happened - $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n"; - $p =~ s/^\t\.(frame).*\n/__FRAME__/gm; - $p =~ s/^\t\.(mask|fmask).*\n//gm; - $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/m; # 16 + 100 4-byte args - $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//m; - $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//m; - $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//m; - $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//m; - $p =~ s/__FRAME__/$FRAME/m; - } elsif ($TargetPlatform =~ /^powerpc-apple-darwin.*/m) { - $pcrel_label = $p; - $pcrel_label =~ s/(.|\n)*^(\"?L\d+\$pb\"?):\n(.|\n)*/$2/m or $pcrel_label = ""; - - $p =~ s/^\tmflr r0\n//m; - $p =~ s/^\tbl saveFP # f\d+\n//m; - $p =~ s/^\tbl saveFP ; save f\d+-f\d+\n//m; - $p =~ s/^\"?L\d+\$pb\"?:\n//m; - $p =~ s/^\tstmw r\d+,-\d+\(r1\)\n//m; - $p =~ s/^\tstfd f\d+,-\d+\(r1\)\n//gm; - $p =~ s/^\tstw r0,\d+\(r1\)\n//gm; - $p =~ s/^\tstwu r1,-\d+\(r1\)\n//m; - $p =~ s/^\tstw r\d+,-\d+\(r1\)\n//gm; - $p =~ s/^\tbcl 20,31,\"?L\d+\$pb\"?\n//m; - $p =~ s/^\"?L\d+\$pb\"?:\n//m; - $p =~ s/^\tmflr r31\n//m; - - # This is bad: GCC 3 seems to zero-fill some local variables in the prologue - # under some circumstances, only when generating position dependent code. - # I have no idea why, and I don't think it is necessary, so let's toss it. - $p =~ s/^\tli r\d+,0\n//gm; - $p =~ s/^\tstw r\d+,\d+\(r1\)\n//gm; - } elsif ($TargetPlatform =~ /^powerpc-.*-linux/m) { - $p =~ s/^\tmflr 0\n//m; - $p =~ s/^\tstmw \d+,\d+\(1\)\n//m; - $p =~ s/^\tstfd \d+,\d+\(1\)\n//gm; - $p =~ s/^\tstw r0,8\(1\)\n//m; - $p =~ s/^\tstwu 1,-\d+\(1\)\n//m; - $p =~ s/^\tstw \d+,\d+\(1\)\n//gm; - - # GCC's "large-model" PIC (-fPIC) - $pcrel_label = $p; - $pcrel_label =~ s/(.|\n)*^.LCF(\d+):\n(.|\n)*/$2/m or $pcrel_label = ""; - - $p =~ s/^\tbcl 20,31,.LCF\d+\n//m; - $p =~ s/^.LCF\d+:\n//m; - $p =~ s/^\tmflr 30\n//m; - $p =~ s/^\tlwz 0,\.LCL\d+-\.LCF\d+\(30\)\n//m; - $p =~ s/^\tadd 30,0,30\n//m; - - # This is bad: GCC 3 seems to zero-fill some local variables in the prologue - # under some circumstances, only when generating position dependent code. - # I have no idea why, and I don't think it is necessary, so let's toss it. - $p =~ s/^\tli \d+,0\n//gm; - $p =~ s/^\tstw \d+,\d+\(1\)\n//gm; - } elsif ($TargetPlatform =~ /^powerpc64-.*-linux/m) { - $p =~ s/^\tmr 31,1\n//m; - $p =~ s/^\tmflr 0\n//m; - $p =~ s/^\tstmw \d+,\d+\(1\)\n//m; - $p =~ s/^\tstfd \d+,-?\d+\(1\)\n//gm; - $p =~ s/^\tstd r0,8\(1\)\n//m; - $p =~ s/^\tstdu 1,-\d+\(1\)\n//m; - $p =~ s/^\tstd \d+,-?\d+\(1\)\n//gm; - - # This is bad: GCC 3 seems to zero-fill some local variables in the prologue - # under some circumstances, only when generating position dependent code. - # I have no idea why, and I don't think it is necessary, so let's toss it. - $p =~ s/^\tli \d+,0\n//gm; - $p =~ s/^\tstd \d+,\d+\(1\)\n//gm; - } else { - print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n"; - } - - # HWL HACK: dont die, just print a warning - #print stderr "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/; - die "Prologue junk?: $p\n" if $p =~ /^\s+[^\s\.]/m; - - # For PIC, we want to keep part of the prologue - if ($TargetPlatform =~ /^powerpc-apple-darwin.*/m && $pcrel_label ne "") { - # Darwin: load the current instruction pointer into register r31 - $p .= "bcl 20,31,$pcrel_label\n"; - $p .= "$pcrel_label:\n"; - $p .= "\tmflr r31\n"; - } elsif ($TargetPlatform =~ /^powerpc-.*-linux/m && $pcrel_label ne "") { - # Linux: load the GOT pointer into register 30 - $p .= "\tbcl 20,31,.LCF$pcrel_label\n"; - $p .= ".LCF$pcrel_label:\n"; - $p .= "\tmflr 30\n"; - $p .= "\tlwz 0,.LCL$pcrel_label-.LCF$pcrel_label(30)\n"; - $p .= "\tadd 30,0,30\n"; - } elsif ($TargetPlatform =~ /^i386-apple-darwin.*/m && $pcrel_label ne "") { - $p .= "\tcall ___i686.get_pc_thunk.$pcrel_reg\n"; - $p .= "$pcrel_label:\n"; - } - - # glue together what's left - $c = $p . $r; - } - } - - if ( $TargetPlatform =~ /^mips-/m ) { - # MIPS: first, this basic sequence may occur "--- END ---" or not - $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/m; - } - - # toss all epilogue stuff; again, paranoidly - if ( $c =~ /--- END ---/m ) { - # Gcc may decide to replicate the function epilogue. We want - # to process all epilogues, so we split the function and then - # loop here. - @fragments = split(/--- END ---/m, $c); - $r = shift(@fragments); - - # Rebuild `c'; processed fragments will be appended to `c' - $c = $r; - - foreach $e (@fragments) { - # etail holds code that is after the epilogue in the assembly-code - # layout and should not be filtered as part of the epilogue. - $etail = ""; - if ($TargetPlatform =~ /^i386-/m) { - $e =~ s/^\tret\n//m; - $e =~ s/^\tpopl\s+\%edi\n//m; - $e =~ s/^\tpopl\s+\%esi\n//m; - $e =~ s/^\tpopl\s+\%edx\n//m; - $e =~ s/^\tpopl\s+\%ecx\n//m; - $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//m; - $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//m; - } elsif ($TargetPlatform =~ /^ia64-/m) { - # The epilogue is first split into: - # $e, the epilogue code (up to the return instruction) - # $etail, non-epilogue code (after the return instruction) - # The return instruction is stripped in the process. - if (!(($e, $etail) = split(/^\tbr\.ret\.sptk\.many b0\n/m, $e))) { - die "Epilogue doesn't seem to have one return instruction: $e\n"; - } - # Remove 'endp' directive from the tail - $etail =~ s/^\t\.endp [a-zA-Z0-9_.]+#\n//m; - - # If a return value is saved here, discard it - $e =~ s/^\tmov r8 = r14\n//m; - - # Remove floating-point fill instructions. - # Only fp registers 2-5 and 16-23 are saved by the runtime. - if ($e =~ s/^\tldf\.fill f([2-5]|1[6-9]|2[0-3]) = \[r1[4-9]\](, [0-9]+)?\n//gm) { - # Being paranoid, only try to remove this if we saw a fill - # operation. - $e =~ s/^\tadds r1[4-9] = [0-9]+, r12//gm; - } - - $e =~ s/^\tnop(?:\.[mifb])?\s+\d+\n//gm; # remove nop instructions - $e =~ s/^\tmov ar\.pfs = r\d+\n//m; - $e =~ s/^\tmov ar\.lc = r\d+\n//m; - $e =~ s/^\tmov pr = r\d+, -1\n//m; - $e =~ s/^\tmov b0 = r\d+\n//m; - $e =~ s/^\t\.restore sp\n\tadds r12 = \d+, r12\n//m; - #$e =~ s/^\tbr\.ret\.sptk\.many b0\n//; # already removed - $e =~ s/^\t\.(mii|mmi|mfi|mib)\n//gm; # bundling is no longer sensible - $e =~ s/^\t;;\n//gm; # discard stops - stop at end of body is sufficient - $e =~ s/^\t\/\/.*\n//gm; # gcc inserts timings in // comments - } elsif ($TargetPlatform =~ /^m68k-/m) { - $e =~ s/^\tunlk a6\n//m; - $e =~ s/^\trts\n//m; - } elsif ($TargetPlatform =~ /^mips-/m) { - $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//m; - $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//m; - $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//m; - $e =~ s/^\tj\t\$31\n//m; - } elsif ($TargetPlatform =~ /^powerpc-apple-darwin.*/m) { - $e =~ s/^\taddi r1,r1,\d+\n//m; - $e =~ s/^\tlwz r\d+,\d+\(r1\)\n//m; - $e =~ s/^\tlmw r\d+,-\d+\(r1\)\n//m; - $e =~ s/^\tmtlr r0\n//m; - $e =~ s/^\tblr\n//m; - $e =~ s/^\tb restFP ;.*\n//m; - } elsif ($TargetPlatform =~ /^powerpc64-.*-linux/m) { - $e =~ s/^\tmr 3,0\n//m; - $e =~ s/^\taddi 1,1,\d+\n//m; - $e =~ s/^\tld 0,16\(1\)\n//m; - $e =~ s/^\tmtlr 0\n//m; - - # callee-save registers - $e =~ s/^\tld \d+,-?\d+\(1\)\n//gm; - $e =~ s/^\tlfd \d+,-?\d+\(1\)\n//gm; - - # get rid of the debug junk along with the blr - $e =~ s/^\tblr\n\t.long .*\n\t.byte .*\n//m; - - # incase we missed it with the last one get the blr alone - $e =~ s/^\tblr\n//m; - } else { - print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n"; - } - - print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/m; - - # glue together what's left - $c .= $e . $etail; - } - $c =~ s/\n\t\n/\n/m; # junk blank line - } - else { - if ($TargetPlatform =~ /^ia64-/m) { - # On IA64, remove an .endp directive even if no epilogue was found. - # Code optimizations may have removed the "--- END ---" token. - $c =~ s/^\t\.endp [a-zA-Z0-9_.]+#\n//m; - } - } - - # On SPARCs, we don't do --- BEGIN/END ---, we just - # toss the register-windowing save/restore/ret* instructions - # directly unless they've been generated by function definitions in header - # files on Solaris: - if ( $TargetPlatform =~ /^sparc-/m ) { - if ( ! ( $TargetPlatform =~ /solaris2$/m && $chkcat[$i] eq 'unknown' )) { - $c =~ s/^\t(save.*|restore.*|ret|retl)\n//gm; - } - # throw away PROLOGUE comments - $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//m; - } - - # On Alphas, the prologue mangling is done a little later (below) - - # toss all calls to __DISCARD__ - $c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//gom; - $c =~ s/^\tjsr\s+\$26\s*,\s*${T_US}__DISCARD__\n//gom if $TargetPlatform =~ /^alpha-/m; - $c =~ s/^\tbl\s+L___DISCARD__\$stub\n//gom if $TargetPlatform =~ /^powerpc-apple-darwin.*/m; - $c =~ s/^\tbl\s+__DISCARD__(\@plt)?\n//gom if $TargetPlatform =~ /^powerpc-.*-linux/m; - $c =~ s/^\tbl\s+\.__DISCARD__\n\s+nop\n//gom if $TargetPlatform =~ /^powerpc64-.*-linux/m; - $c =~ s/^\tcall\s+L___DISCARD__\$stub\n//gom if $TargetPlatform =~ /i386-apple-darwin.*/m; - - # IA64: fix register allocation; mangle tailcalls into jumps - if ($TargetPlatform =~ /^ia64-/m) { - ia64_rename_registers($ia64_locnum, $ia64_outnum) if (defined($ia64_locnum)); - ia64_mangle_tailcalls(); - } - - # MIPS: that may leave some gratuitous asm macros around - # (no harm done; but we get rid of them to be tidier) - $c =~ s/^\t\.set\tnoreorder\n\t\.set\tnomacro\n\taddu\t(\S+)\n\t\.set\tmacro\n\t\.set\treorder\n/\taddu\t$1\n/m - if $TargetPlatform =~ /^mips-/m; - - # toss stack adjustment after DoSparks - $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/gm - if $TargetPlatform =~ /^m68k-/m; # this looks old... - - if ( $TargetPlatform =~ /^alpha-/m && - ! $magic_rdata_seen && - $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/m ) { - $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/m; - $magic_rdata_seen = 1; - } - - # pick some end-things and move them to the next chunk - - # pin a funny end-thing on (for easier matching): - $c .= 'FUNNY#END#THING'; - - while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/om ) { - - $to_move = $1; - - # on x86 we try not to copy any directives into a literal - # chunk, rather we keep looking for the next real chunk. This - # is because we get things like - # - # .globl blah_closure - # .LC32 - # .string "..." - # blah_closure: - # ... - # - if ( $TargetPlatform =~ /^(i386|sparc|powerpc)/m && $to_move =~ /${T_COPY_DIRVS}/m ) { - $j = $i + 1; - while ( $j < $numchks && $chk[$j] =~ /$T_CONST_LBL/m) { - $j++; - } - if ( $j < $numchks ) { - $chk[$j] = $to_move . $chk[$j]; - } - } - - elsif ( ( $i < ($numchks - 1) - && ( $to_move =~ /${T_COPY_DIRVS}/m - || ( $TargetPlatform =~ /^hppa/m - && $to_move =~ /align/m - && $chkcat[$i+1] eq 'literal') - ) - ) - || ($to_move =~ /^[ \t]*\.section[ \t]+\.note\.GNU-stack,/m) - ) { - $chk[$i + 1] = $to_move . $chk[$i + 1]; - # otherwise they're tossed - } - - $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/om; - } - - if ( $TargetPlatform =~ /^alpha-/m && $c =~ /^\t\.ent\s+(\S+)/m ) { - $ent = $1; - # toss all prologue stuff, except for loading gp, and the ..ng address - unless ($c =~ /\.ent.*\n\$.*\.\.ng:/m) { - if (($p, $r) = split(/^\t\.prologue/m, $c)) { - # use vars '$junk'; # Unused? - if (($keep, $junk) = split(/\.\.ng:/m, $p)) { - $keep =~ s/^\t\.frame.*\n/\t.frame \$30,0,\$26,0\n/m; - $keep =~ s/^\t\.(mask|fmask).*\n//gm; - $c = $keep . "..ng:\n"; - } else { - print STDERR "malformed code block ($ent)?\n" - } - } - $c .= "\t.prologue" . $r; - } - } - - $c =~ s/FUNNY#END#THING//m; - -# print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c; - - $chk[$i] = $c; # update w/ convenience copy - } - - # open CHUNKS, ">/tmp/chunks2" or die "Cannot open /tmp/chunks2: $!\n"; - # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] } - # close CHUNKS; - - if ( $TargetPlatform =~ /^alpha-/m ) { - # print out the header stuff first - $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/m; - print OUTASM $chk[0]; - - } elsif ( $TargetPlatform =~ /^hppa/m ) { - print OUTASM $chk[0]; - - } elsif ( $TargetPlatform =~ /^mips-/m ) { - $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0]; - - # get rid of horrible "Revision: .*$" strings - local(@lines0) = split(/\n/m, $chk[0]); - local($z) = 0; - while ( $z <= $#lines0 ) { - if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/m ) { - undef($lines0[$z]); - $z++; - while ( $z <= $#lines0 ) { - undef($lines0[$z]); - last if $lines0[$z] =~ /[,\t]0x0$/m; - $z++; - } - } - $z++; - } - $chk[0] = join("\n", @lines0); - $chk[0] =~ s/\n\n+/\n/m; - print OUTASM $chk[0]; - } - - # print out all the literal strings next - for ($i = 0; $i < $numchks; $i++) { - if ( $chkcat[$i] eq 'literal' ) { - - # HACK: try to detect 16-byte constants and align them - # on a 16-byte boundary. x86_64 sometimes needs 128-bit - # aligned constants, and so does Darwin/x86. - if ( $TargetPlatform =~ /^x86_64/m - || $TargetPlatform =~ /^i386-apple-darwin/m ) { - $z = $chk[$i]; - if ($z =~ /(\.long.*\n.*\.long.*\n.*\.long.*\n.*\.long|\.quad.*\n.*\.quad)/m) { - print OUTASM $T_HDR_literal16; - } else { - print OUTASM $T_HDR_literal; - } - } else { - print OUTASM $T_HDR_literal; - } - - print OUTASM $chk[$i]; - print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/m; # for the splitter - - $chkcat[$i] = 'DONE ALREADY'; - } - } - - # on the HPPA, print out all the bss next - if ( $TargetPlatform =~ /^hppa/m ) { - for ($i = 1; $i < $numchks; $i++) { - if ( $chkcat[$i] eq 'bss' ) { - print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n"; - print OUTASM $chk[$i]; - - $chkcat[$i] = 'DONE ALREADY'; - } - } - } - - # $numchks + 1 as we have the extra one for .note.GNU-stack - for ($i = $FIRST_MANGLABLE; $i < $numchks + 1; $i++) { -# print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n"; - - next if $chkcat[$i] eq 'DONE ALREADY'; - - if ( $chkcat[$i] eq 'misc' || $chkcat[$i] eq 'unknown' ) { - if ($chk[$i] ne '') { - print OUTASM $T_HDR_misc; - &print_doctored($chk[$i], 0); - } - - } elsif ( $chkcat[$i] eq 'verbatim' ) { - print OUTASM $chk[$i]; - - } elsif ( $chkcat[$i] eq 'toss' ) { - print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n"; - - } elsif ( $chkcat[$i] eq 'data' ) { - if ($chk[$i] ne '') { - print OUTASM $T_HDR_data; - print OUTASM $chk[$i]; - } - - } elsif ( $chkcat[$i] eq 'splitmarker' ) { - # we can just re-constitute this one... - # NB: we emit _three_ underscores no matter what, - # so ghc-split doesn't have to care. - print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n"; - - } elsif ( $chkcat[$i] eq 'closure' - || $chkcat[$i] eq 'srt' - || $chkcat[$i] eq 'infotbl' - || $chkcat[$i] eq 'entry') { # do them in that order - $symb = $chksymb[$i]; - - # CLOSURE - if ( defined($closurechk{$symb}) ) { - print OUTASM $T_HDR_closure; - print OUTASM $chk[$closurechk{$symb}]; - $chkcat[$closurechk{$symb}] = 'DONE ALREADY'; - } - - # SRT - if ( defined($srtchk{$symb}) ) { - print OUTASM $T_HDR_relrodata; - print OUTASM $chk[$srtchk{$symb}]; - $chkcat[$srtchk{$symb}] = 'DONE ALREADY'; - } - - # INFO TABLE - if ( defined($infochk{$symb}) ) { - - print OUTASM $T_HDR_info; - print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1); - - # entry code will be put here! - - $chkcat[$infochk{$symb}] = 'DONE ALREADY'; - } - - # ENTRY POINT - if ( defined($entrychk{$symb}) ) { - - $c = $chk[$entrychk{$symb}]; - - # If this is an entry point with an info table, - # eliminate the entry symbol and all directives involving it. - if (defined($infochk{$symb}) && $TargetPlatform !~ /^ia64-/m - && $TABLES_NEXT_TO_CODE eq "YES") { - @o = (); - foreach $l (split(/\n/m,$c)) { - next if $l =~ /^.*$symb_(entry|ret)${T_POST_LBL}/m; - - # If we have .type/.size direrctives involving foo_entry, - # then make them refer to foo_info instead. The information - # in these directives is used by the cachegrind annotator, - # so it is worthwhile keeping. - if ($l =~ /^\s*\.(type|size).*$symb_(entry|ret)/m) { - $l =~ s/$symb(_entry|_ret)/${symb}_info/gm; - push(@o,$l); - next; - } - next if $l =~ /^\s*\..*$symb.*\n?/m; - push(@o,$l); - } - $c = join("\n",@o) . "\n"; - } - - print OUTASM $T_HDR_entry; - - &print_doctored($c, 1); # NB: the 1!!! - - $chkcat[$entrychk{$symb}] = 'DONE ALREADY'; - } - - } elsif ( $chkcat[$i] eq 'vector' ) { - $symb = $chksymb[$i]; - - # VECTOR TABLE - if ( defined($vectorchk{$symb}) ) { - print OUTASM $T_HDR_vector; - print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0); - - # direct return code will be put here! - $chkcat[$vectorchk{$symb}] = 'DONE ALREADY'; - - } elsif ( $TargetPlatform =~ /^alpha-/m ) { - # Alphas: the commented nop is for the splitter, to ensure - # that no module ends with a label as the very last - # thing. (The linker will adjust the label to point - # to the first code word of the next module linked in, - # even if alignment constraints cause the label to move!) - - print OUTASM "\t# nop\n"; - } - - } elsif ( $chkcat[$i] eq 'rodata' ) { - print OUTASM $T_HDR_rodata; - print OUTASM $chk[$i]; - $chkcat[$i] = 'DONE ALREADY'; - } elsif ( $chkcat[$i] eq 'relrodata' ) { - print OUTASM $T_HDR_relrodata; - print OUTASM $chk[$i]; - $chkcat[$i] = 'DONE ALREADY'; - } elsif ( $chkcat[$i] eq 'toc' ) { - # silly optimisation to print tocs, since they come in groups... - print OUTASM $T_HDR_toc; - local($j) = $i; - while ($chkcat[$j] eq 'toc') - { if ( $chk[$j] !~ /\.tc UpdatePAP\[TC\]/m # not needed: always turned into a jump. - ) - { - print OUTASM $chk[$j]; - } - $chkcat[$j] = 'DONE ALREADY'; - $j++; - } - - } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/m && $chkcat[$i] eq 'dyld' ) { - # apple-darwin: dynamic linker stubs - if($chk[$i] !~ /\.indirect_symbol ___DISCARD__/m) - { # print them out unchanged, but remove the stubs for __DISCARD__ - print OUTASM $chk[$i]; - } - } elsif ( $TargetPlatform =~ /^i386-apple-darwin.*/m && $chkcat[$i] eq 'get_pc_thunk' ) { - # i386-apple-darwin: __i686.get_pc_thunk.[abcd]x - print OUTASM ".section __TEXT,__textcoal_nt,coalesced,no_toc\n"; - print OUTASM $chk[$i]; - } else { - &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n"); - } - } - - print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/m; - - # finished - close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n"); - close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n"); -} -\end{code} - -On IA64, tail calls are converted to branches at this point. The mangler -searches for function calls immediately followed by a '--- TAILCALL ---' -token. Since the compiler can put various combinations of labels, bundling -directives, nop instructions, stops, and a move of the return value -between the branch and the tail call, proper matching of the tail call -gets a little hairy. This subroutine does the mangling. - -Here is an example of a tail call before mangling: - -\begin{verbatim} - br.call.sptk.many b0 = b6 -.L211 - ;; - .mmi - mov r1 = r32 - ;; - nop.m 0 - nop.i 0 - ;; - --- TAILCALL -- - ;; -.L123 -\end{verbatim} - -\begin{code} -sub ia64_mangle_tailcalls { - # Function input and output are in $c - - # Construct the tailcall-mangling expression the first time this function - # is called. - if (!defined($IA64_MATCH_TAILCALL)) { - # One-line pattern matching constructs. None of these - # should bind references; all parenthesized terms - # should be (?:) terms. - my $stop = q/(?:\t;;\n)/; - my $bundle = q/(?:\t\.(?:mii|mib|mmi|mmb|mfi|mfb|mbb|bbb)\n)/; - my $nop = q/(?:\tnop(?:\.[mifb])?\s+\d+\n)/; - my $movgp = q/(?:\tmov r1 = r\d+\n)/; - my $postbr = q/(?:\tbr \.L\d+\n)/; - - my $noeffect = "(?:$stop$bundle?|$nop)*"; - my $postbundle = "(?:$bundle?$nop?$nop?$postbr)?"; - - # Important parts of the pattern match. The branch target - # and subsequent jump label are bound to $1 and $2 - # respectively. Sometimes there is no label. - my $callbr = q/^\tbr\.call\.sptk\.many b0 = (.*)\n/; - my $label = q/(?:^\.L([0-9]*):\n)/; - my $tailcall = q/\t--- TAILCALL ---\n/; - - $IA64_MATCH_TAILCALL = - $callbr . $label . '?' . $noeffect . $movgp . '?' . $noeffect . - $tailcall . $stop . '?' . '(?:' . $postbundle . ')?'; - } - - # Find and mangle tailcalls - while ($c =~ s/$IA64_MATCH_TAILCALL/\tbr\.few $1\n/om) { - # Eek, the gcc optimiser is getting smarter... if we see a jump to the - # --- TAILCALL --- marker then we reapply the substitution at the source sites - $c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/gm if ($2); - } - - # Verify that all instances of TAILCALL were processed - if ($c =~ /^\t--- TAILCALL ---\n/m) { - die "Unmangled TAILCALL tokens remain after mangling" - } -} -\end{code} - -The number of registers allocated on the IA64 register stack is set -upon entry to the runtime with an `alloc' instruction at the entry -point of \verb+StgRun()+. Gcc uses its own `alloc' to allocate -however many registers it likes in each function. When we discard -gcc's alloc, we have to reconcile its register assignment with what -the STG uses. - -There are three stack areas: fixed registers, input/local registers, -and output registers. We move the output registers to the output -register space and leave the other registers where they are. - -\begin{code} -sub ia64_rename_registers() { - # The text to be mangled is in $c - # Find number of registers in each stack area - my ($loc, $out) = @_; - my $cout; - my $first_out_reg; - my $regnum; - my $fragment; - - # These are the register numbers used in the STG runtime - my $STG_FIRST_OUT_REG = 32 + 34; - my $STG_LAST_OUT_REG = $STG_FIRST_OUT_REG + 7; - - $first_out_reg = 32 + $loc; - - if ($first_out_reg > $STG_FIRST_OUT_REG) { - die "Too many local registers allocated by gcc"; - } - - # Split the string into fragments containing one register name each. - # Rename the register in each fragment and concatenate. - $cout = ""; - foreach $fragment (split(/(?=r\d+[^a-zA-Z0-9_.])/sm, $c)) { - if ($fragment =~ /^r(\d+)((?:[^a-zA-Z0-9_.].*)?)$/sm) { - $regnum = $1; - - if ($regnum < $first_out_reg) { - # This is a local or fixed register - - # Local registers 32 and 33 (r64 and r65) are - # used to hold saved state; they shouldn't be touched - if ($regnum == 64 || $regnum == 65) { - die "Reserved register $regnum is in use"; - } - } - else { - # This is an output register - $regnum = $regnum - $first_out_reg + $STG_FIRST_OUT_REG; - if ($regnum > $STG_LAST_OUT_REG) { - die "Register number ($regnum) is out of expected range"; - } - } - - # Update this fragment - $fragment = "r" . $regnum . $2; - } - $cout .= $fragment; - } - - $c = $cout; -} - -\end{code} - -\begin{code} -sub hppa_mash_prologue { # OK, epilogue, too - local($_) = @_; - - # toss all prologue stuff - s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/m; - - # Lie about our .CALLINFO - s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/m; - - # Get rid of P' - - s/LP'/L'/gm; - s/RP'/R'/gm; - - # toss all epilogue stuff - s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/m; - - # Sorry; we moved the _info stuff to the code segment. - s/_info,DATA/_info,CODE/gm; - - return($_); -} -\end{code} - -\begin{code} -sub print_doctored { - local($_, $need_fallthru_patch) = @_; - - if ( $TargetPlatform =~ /^x86_64-/m ) { - # Catch things like - # - # movq -4(%ebp), %rax - # jmp *%rax - # - # and optimise: - # - s/^\tmovq\s+(-?\d*\(\%r(bx|bp|13)\)),\s*(\%r(ax|cx|dx|10|11))\n\tjmp\s+\*\3/\tjmp\t\*$1/gm; - s/^\tmovl\s+\$${T_US}(.*),\s*(\%e(ax|cx|si|di))\n\tjmp\s+\*\%r\3/\tjmp\t$T_US$1/gm; - } - - if ( $TargetPlatform !~ /^i386-/m - || ! /^\t[a-z]/m # no instructions in here, apparently - || /^${T_US}__stginit_[A-Za-z0-9_]+${T_POST_LBL}/m) { - print OUTASM $_; - return; - } - - # OK, must do some x86 **HACKING** - - local($entry_patch) = ''; - local($exit_patch) = ''; - - # gotta watch out for weird instructions that - # invisibly smash various regs: - # rep* %ecx used for counting - # scas* %edi used for destination index - # cmps* %e[sd]i used for indices - # loop* %ecx used for counting - # - # SIGH. - - # We cater for: - # * use of STG reg [ nn(%ebx) ] where no machine reg avail - # - # * GCC used an "STG reg" for its own purposes - # - # * some secret uses of machine reg, requiring STG reg - # to be saved/restored - - # The most dangerous "GCC uses" of an "STG reg" are when - # the reg holds the target of a jmp -- it's tricky to - # insert the patch-up code before we get to the target! - # So here we change the jmps: - - # -------------------------------------------------------- - # it can happen that we have jumps of the form... - # jmp * - # or - # jmp - # - # a reasonably-common case is: - # - # movl $_blah, - # jmp * - # - s/^\tmovl\s+\$${T_US}(.*),\s*(\%e[acd]x)\n\tjmp\s+\*\2/\tjmp $T_US$1/gm; - - # Catch things like - # - # movl -4(%ebx), %eax - # jmp *%eax - # - # and optimise: - # - s/^\tmovl\s+(-?\d*\(\%e(bx|si)\)),\s*(\%e[acd]x)\n\tjmp\s+\*\3/\tjmp\t\*$1/gm; - - if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi? - s/^\tmovl\s+(.*),\s*\%esi\n\tjmp\s+\*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/gm; - s/^\tjmp\s+\*(.*\(.*\%esi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/gm; - s/^\tjmp\s+\*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/gm; - die "$Pgm: (mangler) still have jump involving \%esi!\n$_" - if /(jmp|call)\s+.*\%esi/m; - } - if ($StolenX86Regs <= 3 ) { # spurious uses of edi? - s/^\tmovl\s+(.*),\s*\%edi\n\tjmp\s+\*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/gm; - s/^\tjmp\s+\*(.*\(.*\%edi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/gm; - s/^\tjmp\s+\*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/gm; - die "$Pgm: (mangler) still have jump involving \%edi!\n$_" - if /(jmp|call)\s+.*\%edi/m; - } - - # OK, now we can decide what our patch-up code is going to - # be: - - # Offsets into register table - you'd better update these magic - # numbers should you change its contents! - # local($OFFSET_R1)=0; No offset for R1 in new RTS. - local($OFFSET_Hp)=88; - - # Note funky ".=" stuff; we're *adding* to these _patch guys - if ( $StolenX86Regs <= 2 - && ( /[^0-9]\(\%ebx\)/m || /\%esi/m || /^\tcmps/m ) ) { # R1 (esi) - $entry_patch .= "\tmovl \%esi,(\%ebx)\n"; - $exit_patch .= "\tmovl (\%ebx),\%esi\n"; - - # nothing for call_{entry,exit} because %esi is callee-save - } - if ( $StolenX86Regs <= 3 - && ( /${OFFSET_Hp}\(\%ebx\)/m || /\%edi/m || /^\t(scas|cmps)/m ) ) { # Hp (edi) - $entry_patch .= "\tmovl \%edi,${OFFSET_Hp}(\%ebx)\n"; - $exit_patch .= "\tmovl ${OFFSET_Hp}(\%ebx),\%edi\n"; - - # nothing for call_{entry,exit} because %edi is callee-save - } - - # -------------------------------------------------------- - # next, here we go with non-%esp patching! - # - s/^(\t[a-z])/$entry_patch$1/m; # before first instruction - -# Before calling GC we must set up the exit condition before the call -# and entry condition when we come back - - # fix _all_ non-local jumps: - - if ( $TargetPlatform =~ /^.*-apple-darwin.*/m ) { - # On Darwin, we've got local-looking jumps that are - # actually global (i.e. jumps to Lfoo$stub or via - # Lfoo$non_lazy_ptr), so we fix those first. - # In fact, we just fix everything that contains a dollar - # because false positives don't hurt here. - - s/^(\tjmp\s+\*?L.*\$.*\n)/$exit_patch$1/gm; - } - - s/^\tjmp\s+\*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/gom; - s/^\tjmp\s+${T_X86_PRE_LLBL_PAT}/\tJMP___L/gom; - - s/^(\tjmp\s+.*\n)/$exit_patch$1/gm; # here's the fix... - - s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/gom; - s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/gom; - - if ($StolenX86Regs == 2 ) { - die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_" - if /^\t(jmp|call)\s+.*\%e(si|di)/m; - } elsif ($StolenX86Regs == 3 ) { - die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_" - if /^\t(jmp|call)\s+.*\%edi/m; - } - - # -------------------------------------------------------- - # that's it -- print it - # - #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia - - print OUTASM $_; - - if ( $need_fallthru_patch ) { # exit patch for end of slow entry code - print OUTASM $exit_patch; - # ToDo: make it not print if there is a "jmp" at the end - } -} -\end{code} - -\begin{code} -sub init_FUNNY_THINGS { - # use vars '%KNOWN_FUNNY_THING'; # Unused? - %KNOWN_FUNNY_THING = ( - # example - # "${T_US}stg_.*{T_POST_LBL}", 1, - ); -} -\end{code} - -The following table reversal is used for both info tables and return -vectors. In both cases, we remove the first entry from the table, -reverse the table, put the label at the end, and paste some code -(that which is normally referred to by the first entry in the table) -right after the table itself. (The code pasting is done elsewhere.) - -\begin{code} -sub rev_tbl { - # use vars '$discard1'; # Unused? - local($symb, $tbl, $discard1) = @_; - - return ($tbl) if ($TargetPlatform =~ /^ia64-/m - || $TABLES_NEXT_TO_CODE eq "NO"); - - local($before) = ''; - local($label) = ''; - local(@imports) = (); # hppa only - local(@words) = (); - local($after) = ''; - local(@lines) = split(/\n/m, $tbl); - local($i, $j); - - # Deal with the header... - for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t?${T_DOT_WORD}\s+/om; $i++) { - $label .= $lines[$i] . "\n", - next if $lines[$i] =~ /^[A-Za-z0-9_]+_info${T_POST_LBL}$/om - || $lines[$i] =~ /${T_DOT_GLOBAL}/om - || $lines[$i] =~ /^${T_US}\S+_vtbl${T_POST_LBL}$/om; - - $before .= $lines[$i] . "\n"; # otherwise... - } - - $infoname = $label; - $infoname =~ s/(.|\n)*^([A-Za-z0-9_]+_info)${T_POST_LBL}$(.|\n)*/$2/m; - - # Grab the table data... - if ( $TargetPlatform !~ /^hppa/m ) { - for ( ; $i <= $#lines && $lines[$i] =~ /^\t?${T_DOT_WORD}\s+/om; $i++) { - $line = $lines[$i]; - # Convert addresses of SRTs, slow entrypoints and large bitmaps - # to offsets (relative to the info label), - # in order to support position independent code. - $line =~ s/$infoname/0/m - || $line =~ s/([A-Za-z0-9_]+_srtd)$/$1 - $infoname/m - || $line =~ s/([A-Za-z0-9_]+_srt(\+\d+)?)$/$1 - $infoname/m - || $line =~ s/([A-Za-z0-9_]+_str)$/$1 - $infoname/m - || $line =~ s/([A-Za-z0-9_]+_slow)$/$1 - $infoname/m - || $line =~ s/([A-Za-z0-9_]+_btm)$/$1 - $infoname/m - || $line =~ s/([A-Za-z0-9_]+_alt)$/$1 - $infoname/m - || $line =~ s/([A-Za-z0-9_]+_dflt)$/$1 - $infoname/m - || $line =~ s/([A-Za-z0-9_]+_ret)$/$1 - $infoname/m; - push(@words, $line); - } - } else { # hppa weirdness - for ( ; $i <= $#lines && $lines[$i] =~ /^\s+(${T_DOT_WORD}|\.IMPORT)/m; $i++) { - # FIXME: the RTS now expects offsets instead of addresses - # for all labels in info tables. - if ($lines[$i] =~ /^\s+\.IMPORT/m) { - push(@imports, $lines[$i]); - } else { - # We don't use HP's ``function pointers'' - # We just use labels in code space, like normal people - $lines[$i] =~ s/P%//m; - push(@words, $lines[$i]); - } - } - } - - # Now throw away any initial zero word from the table. This is a hack - # that lets us reduce the size of info tables when the SRT field is not - # needed: see comments StgFunInfoTable in InfoTables.h. - # - # The .zero business is for Linux/ELF. - # The .skip business is for Sparc/Solaris/ELF. - # The .blockz business is for HPPA. -# if ($discard1) { -# if ($words[0] =~ /^\t?(${T_DOT_WORD}\s+0|\.zero\s+4|\.skip\s+4|\.blockz\s+4)/) { -# shift(@words); -# } -# } - - for (; $i <= $#lines; $i++) { - $after .= $lines[$i] . "\n"; - } - - # Alphas: If we have anonymous text (not part of a procedure), the - # linker may complain about missing exception information. Bleh. - # To suppress this, we place a .ent/.end pair around the code. - # At the same time, we have to be careful and not enclose any leading - # .file/.loc directives. - if ( $TargetPlatform =~ /^alpha-/m && $label =~ /^([A-Za-z0-9_]+):$/m) { - local ($ident) = $1; - $before =~ s/^((\s*\.(file|loc)\s+[^\n]*\n)*)/$1\t.ent $ident\n/m; - $after .= "\t.end $ident\n"; - } - - # Alphas: The heroic Simon Marlow found a bug in the Digital UNIX - # assembler (!) wherein .quad constants inside .text sections are - # first narrowed to 32 bits then sign-extended back to 64 bits. - # This obviously screws up our 64-bit bitmaps, so we work around - # the bug by replacing .quad with .align 3 + .long + .long [ccshan] - if ( $TargetPlatform =~ /^alpha-/m ) { - foreach (@words) { - if (/^\s*\.quad\s+([-+0-9].*\S)\s*$/m && length $1 >= 10) { - local ($number) = $1; - if ($number =~ /^([-+])?(0x?)?([0-9]+)$/m) { - local ($sign, $base, $digits) = ($1, $2, $3); - $base = (10, 8, 16)[length $base]; - local ($hi, $lo) = (0, 0); - foreach $i (split(//, $digits)) { - $j = $lo * $base + $i; - $lo = $j % 4294967296; - $hi = $hi * $base + ($j - $lo) / 4294967296; - } - ($hi, $lo) = (4294967295 - $hi, 4294967296 - $lo) - if $sign eq "-"; - $_ = "\t.align 3\n\t.long $lo\n\t.long $hi\n"; - # printf STDERR "TURNING %s into 0x %08x %08x\n", $number, $hi, $lo; - } else { - print STDERR "Cannot handle \".quad $number\" in info table\n"; - exit 1; - } - } - } - } - - if ( $TargetPlatform =~ /x86_64-apple-darwin/m ) { - # Tack a label to the front of the info table, too. - # For now, this just serves to work around a crash in Apple's new - # 64-bit linker (it seems to assume that there is no data before the - # first label in a section). - - # The plan for the future is to do this on all Darwin platforms, and - # to add a reference to this label after the entry code, just as the - # NCG does, so we can enable dead-code-stripping in the linker without - # losing our info tables. (Hence the name _dsp, for dead-strip preventer) - - $before .= "\n${infoname}_dsp:\n"; - } - - $tbl = $before - . (($TargetPlatform !~ /^hppa/m) ? '' : join("\n", @imports) . "\n") - . join("\n", @words) . "\n" - . $label . $after; - -# print STDERR "before=$before\n"; -# print STDERR "label=$label\n"; -# print STDERR "words=",(reverse @words),"\n"; -# print STDERR "after=$after\n"; - - $tbl; -} -\end{code} - -The HP is a major nuisance. The threaded code mangler moved info -tables from data space to code space, but unthreaded code in the RTS -still has references to info tables in data space. Since the HP -linker is very precise about where symbols live, we need to patch the -references in the unthreaded RTS as well. - -\begin{code} -sub mini_mangle_asm_hppa { - local($in_asmf, $out_asmf) = @_; - - open(INASM, "< $in_asmf") - || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n"); - open(OUTASM,"> $out_asmf") - || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n"); - - while () { - s/_info,DATA/_info,CODE/m; # Move _info references to code space - s/P%_PR/_PR/m; - print OUTASM; - } - - # finished: - close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n"); - close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n"); -} - -\end{code} - -\begin{code} -sub tidy_up_and_die { - local($return_val, $msg) = @_; - print STDERR $msg; - exit (($return_val == 0) ? 0 : 1); -} -\end{code} diff --git a/driver/mangler/ghc.mk b/driver/mangler/ghc.mk deleted file mode 100644 index c5e3bdf..0000000 --- a/driver/mangler/ghc.mk +++ /dev/null @@ -1,19 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# http://hackage.haskell.org/trac/ghc/wiki/Building/Architecture -# http://hackage.haskell.org/trac/ghc/wiki/Building/Modifying -# -# ----------------------------------------------------------------------------- - -driver/mangler_PERL_SRC = ghc-asm.lprl -driver/mangler_dist_PROG = $(GHC_MANGLER_PGM) -driver/mangler_dist_TOPDIR = YES -driver/mangler_dist_INSTALL_IN = $(DESTDIR)$(topdir) - -$(eval $(call build-perl,driver/mangler,dist)) - diff --git a/ghc.mk b/ghc.mk index a41537f..863ddc2 100644 --- a/ghc.mk +++ b/ghc.mk @@ -544,7 +544,6 @@ BUILD_DIRS += \ ifneq "$(GhcUnregisterised)" "YES" BUILD_DIRS += \ - $(GHC_MANGLER_DIR) \ $(GHC_SPLIT_DIR) endif diff --git a/ghc/ghc.mk b/ghc/ghc.mk index cd2a027..8776566 100644 --- a/ghc/ghc.mk +++ b/ghc/ghc.mk @@ -113,9 +113,9 @@ $(INPLACE_LIB)/extra-gcc-opts : extra-gcc-opts # The GHC programs need to depend on all the helper programs they might call ifeq "$(GhcUnregisterised)" "NO" -$(GHC_STAGE1) : $(MANGLER) $(SPLIT) -$(GHC_STAGE2) : $(MANGLER) $(SPLIT) -$(GHC_STAGE3) : $(MANGLER) $(SPLIT) +$(GHC_STAGE1) : $(SPLIT) +$(GHC_STAGE2) : $(SPLIT) +$(GHC_STAGE3) : $(SPLIT) endif $(GHC_STAGE1) : $(INPLACE_LIB)/extra-gcc-opts diff --git a/mk/config.mk.in b/mk/config.mk.in index b478997..4de412e 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -425,7 +425,6 @@ GHC_HP2PS_PGM = hp2ps$(exeext) GHC_GHCTAGS_PGM = ghctags$(exeext) GHC_HSC2HS_PGM = hsc2hs$(exeext) GHC_TOUCHY_PGM = touchy$(exeext) -GHC_MANGLER_PGM = ghc-asm GHC_SPLIT_PGM = ghc-split GHC_SYSMAN_PGM = SysMan GHC_GENPRIMOP_PGM = genprimopcode$(exeext) @@ -445,7 +444,6 @@ GHC_PERL = $(PERL) endif HP2PS = $(GHC_HP2PS_DIR)/$(GHC_HP2PS_PGM) -MANGLER = $(INPLACE_LIB)/$(GHC_MANGLER_PGM) SPLIT = $(INPLACE_LIB)/$(GHC_SPLIT_PGM) SYSMAN = $(GHC_SYSMAN_DIR)/$(GHC_SYSMAN_PGM) LTX = $(GHC_LTX_DIR)/$(GHC_LTX_PGM) diff --git a/mk/tree.mk b/mk/tree.mk index 3aa8527..2010c36 100644 --- a/mk/tree.mk +++ b/mk/tree.mk @@ -36,7 +36,6 @@ GHC_PKG_DIR = $(GHC_UTILS_DIR)/ghc-pkg GHC_GENPRIMOP_DIR = $(GHC_UTILS_DIR)/genprimopcode GHC_GENAPPLY_DIR = $(GHC_UTILS_DIR)/genapply GHC_CABAL_DIR = $(GHC_UTILS_DIR)/ghc-cabal -GHC_MANGLER_DIR = $(GHC_DRIVER_DIR)/mangler GHC_SPLIT_DIR = $(GHC_DRIVER_DIR)/split GHC_SYSMAN_DIR = $(GHC_RTS_DIR)/parallel