diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | compiler/main/ErrUtils.lhs | 15 | ||||
| -rw-r--r-- | compiler/simplCore/SimplCore.lhs | 2 | ||||
| -rw-r--r-- | compiler/simplCore/Simplify.lhs | 19 | ||||
| -rw-r--r-- | compiler/specialise/Rules.lhs | 2 | ||||
| -rw-r--r-- | compiler/utils/Outputable.lhs | 10 | ||||
| -rw-r--r-- | ghc.mk | 6 | ||||
| -rw-r--r-- | ghc/ghc-cross.wrapper | 1 | ||||
| -rw-r--r-- | includes/Cmm.h | 4 | ||||
| -rw-r--r-- | includes/mkDerivedConstants.cross.awk | 350 | ||||
| -rw-r--r-- | includes/mkSizeMacros.cross.awk | 82 | ||||
| -rw-r--r-- | includes/rts/prof/CCS.h | 4 | ||||
| -rw-r--r-- | includes/stg/Regs.h | 10 | ||||
| -rw-r--r-- | rules/cross-compiling.mk | 24 | ||||
| -rw-r--r-- | utils/genapply/GenApply.hs | 6 | ||||
| -rw-r--r-- | utils/ghc-pkg/Main.hs | 2 |
16 files changed, 500 insertions, 39 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index b5ad8d11ce..6634efdca1 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1017,7 +1017,7 @@ defaultLogAction :: LogAction defaultLogAction dflags severity srcSpan style msg = case severity of SevOutput -> printSDoc msg style - SevDump -> hPrintDump dflags stdout msg + SevDump -> printSDoc (msg $$ blankLine) style SevInfo -> printErrs msg style SevFatal -> printErrs msg style _ -> do hPutChar stderr '\n' diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index daa66f9d2f..1643128eb7 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -230,6 +230,9 @@ mkDumpDoc hdr doc -- | Write out a dump. -- If --dump-to-file is set then this goes to a file. -- otherwise emit to stdout. +-- +-- When hdr is empty, we print in a more compact format (no separators and +-- blank lines) dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO () dumpSDoc dflags dflag hdr doc = do let mFile = chooseDumpFile dflags dflag @@ -247,12 +250,18 @@ dumpSDoc dflags dflag hdr doc writeIORef gdref (Set.insert fileName gd) createDirectoryIfMissing True (takeDirectory fileName) handle <- openFile fileName mode - hPrintDump dflags handle doc + let doc' + | null hdr = doc + | otherwise = doc $$ blankLine + defaultLogActionHPrintDoc dflags handle doc' defaultDumpStyle hClose handle -- write the dump to stdout - Nothing - -> log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (mkDumpDoc hdr doc) + Nothing -> do + let (doc', severity) + | null hdr = (doc, SevOutput) + | otherwise = (mkDumpDoc hdr doc, SevDump) + log_action dflags dflags severity noSrcSpan defaultDumpStyle doc' -- | Choose where to put a dump file based on DynFlags diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index d8c6732c34..731f55128c 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -586,7 +586,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) -- about to begin, with '1' for the first | iteration_no > max_iterations -- Stop if we've run out of iterations = WARN( debugIsOn && (max_iterations > 2) - , hang (ptext (sLit "Simplifier baling out after") <+> int max_iterations + , hang (ptext (sLit "Simplifier bailing out after") <+> int max_iterations <+> ptext (sLit "iterations") <+> (brackets $ hsep $ punctuate comma $ map (int . simplCountN) (reverse counts_so_far))) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index df9013cd08..f2ed224df4 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -1571,21 +1571,22 @@ tryRules env rules fn args call_cont where trace_dump dflags rule rule_rhs | dopt Opt_D_dump_rule_rewrites dflags - = liftIO . dumpSDoc dflags Opt_D_dump_rule_rewrites "" $ - vcat [text "Rule fired", - text "Rule:" <+> ftext (ru_name rule), - text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)), - text "After: " <+> pprCoreExpr rule_rhs, - text "Cont: " <+> ppr call_cont] + = log_rule dflags Opt_D_dump_rule_rewrites "Rule fired" $ vcat + [ text "Rule:" <+> ftext (ru_name rule) + , text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)) + , text "After: " <+> pprCoreExpr rule_rhs + , text "Cont: " <+> ppr call_cont ] | dopt Opt_D_dump_rule_firings dflags - = liftIO . dumpSDoc dflags Opt_D_dump_rule_firings "" $ - vcat [text "Rule fired", - ftext (ru_name rule)] + = log_rule dflags Opt_D_dump_rule_firings "Rule fired:" $ + ftext (ru_name rule) | otherwise = return () + log_rule dflags dflag hdr details = liftIO . dumpSDoc dflags dflag "" $ + sep [text hdr, nest 4 details] + \end{code} Note [Rules for recursive functions] diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index 498302a5e9..0cf858e7b5 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -726,7 +726,7 @@ match_co :: RuleEnv match_co renv subst (CoVarCo cv) co = match_var renv subst cv (Coercion co) match_co _ _ co1 _ - = pprTrace "match_co baling out" (ppr co1) Nothing + = pprTrace "match_co bailing out" (ppr co1) Nothing ------------- rnMatchBndr2 :: RuleEnv -> RuleSubst -> Var -> Var -> RuleEnv diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index f74aaa84fe..710780062a 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -38,7 +38,6 @@ module Outputable ( colBinder, bold, keyword, -- * Converting 'SDoc' into strings and outputing it - hPrintDump, printForC, printForAsm, printForUser, printForUserPartWay, pprCode, mkCodeStyle, showSDoc, showSDocOneLine, @@ -91,7 +90,7 @@ import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set import Data.Word -import System.IO ( Handle, hFlush ) +import System.IO ( Handle ) import System.FilePath @@ -330,13 +329,6 @@ ifPprDebug d = SDoc $ \ctx -> \end{code} \begin{code} -hPrintDump :: DynFlags -> Handle -> SDoc -> IO () -hPrintDump dflags h doc = do - Pretty.printDoc PageMode (pprCols dflags) h - (runSDoc better_doc (initSDocContext dflags defaultDumpStyle)) - hFlush h - where - better_doc = doc $$ blankLine printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO () printForUser dflags handle unqual doc @@ -402,13 +402,13 @@ $(eval $(call addPackage,array)) $(eval $(call addPackage,deepseq)) $(eval $(call addPackage,bytestring)) $(eval $(call addPackage,containers)) +$(eval $(call addPackage,old-locale)) +$(eval $(call addPackage,old-time)) +$(eval $(call addPackage,time)) $(eval $(call addPackage,Win32,($$(Windows),YES))) $(eval $(call addPackage,unix,($$(Windows),NO))) -$(eval $(call addPackage,old-locale)) -$(eval $(call addPackage,old-time)) -$(eval $(call addPackage,time)) $(eval $(call addPackage,directory)) $(eval $(call addPackage,process)) $(eval $(call addPackage,haskell98)) diff --git a/ghc/ghc-cross.wrapper b/ghc/ghc-cross.wrapper new file mode 100644 index 0000000000..56564e589d --- /dev/null +++ b/ghc/ghc-cross.wrapper @@ -0,0 +1 @@ +exec "$executablename" -B"$topdir" ${1+"$@"} -pgma "$pgmgcc" -pgmc "$pgmgcc" -pgml "$pgmgcc" diff --git a/includes/Cmm.h b/includes/Cmm.h index bfac1ee2f0..1788122f29 100644 --- a/includes/Cmm.h +++ b/includes/Cmm.h @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The University of Glasgow 2004 + * (c) The University of Glasgow 2004-2012 * * This file is included at the top of all .cmm source files (and * *only* .cmm files). It defines a collection of useful macros for @@ -50,7 +50,7 @@ * StgTSO_what_next(CurrentTSO) = x * * where the StgTSO_what_next() macro is automatically generated by - * mkDerivedConstnants.c. If you need to access a field that doesn't + * mkDerivedConstants.c. If you need to access a field that doesn't * already have a macro, edit that file (it's pretty self-explanatory). * * -------------------------------------------------------------------------- */ diff --git a/includes/mkDerivedConstants.cross.awk b/includes/mkDerivedConstants.cross.awk new file mode 100644 index 0000000000..c66655e922 --- /dev/null +++ b/includes/mkDerivedConstants.cross.awk @@ -0,0 +1,350 @@ +## This script rewrites normal C structs into successively +## greater ones so that field offset computation becomes a +## sizeof lookup and thus amenable to compile-time computations. + +## Usage: pipe stg/Regs.h into 'awk' running this script +## to obtain a .c file that can be compiled to .o +## with the gcc from the cross toolchain. Then +## use another 'awk' script to process the 'nm' +## output of the object file. + +## Motivation: since in general we can not run executables +## created by the cross toolchain, we need another +## way of finding out field offsets and type sizes +## of the target platform. + +BEGIN { + interesting = 0 + seed = 0 + print "/* this file is generated by mkDerivedConstants.cross.awk, do not touch */" + print "/* needs to be compiled with the target gcc */" + print "" + print "#include \"Rts.h\"" + print "#include \"Capability.h\"" + print "" + ## these do not have a proper typedef; supply them here + print "#define FLAG_STRUCT_TYPE(IT) typedef struct IT ## _FLAGS IT ## _FLAGS" + print "FLAG_STRUCT_TYPE(GC);" + print "FLAG_STRUCT_TYPE(DEBUG);" + print "FLAG_STRUCT_TYPE(COST_CENTRE);" + print "FLAG_STRUCT_TYPE(PROFILING);" + print "FLAG_STRUCT_TYPE(TRACE);" + print "FLAG_STRUCT_TYPE(CONCURRENT);" + print "FLAG_STRUCT_TYPE(MISC);" + print "FLAG_STRUCT_TYPE(PAR);" + print "FLAG_STRUCT_TYPE(TICKY);" + ## these we do know how to get the field size, + ## so do not bother mining it + print "#define DO_NOT_MINE_UNION_MEMBER(STRUCT, NESTED_MEMBER, ID) char nestedfieldsize$ ## STRUCT ## $ ## ID [sizeof ((STRUCT*)0)->NESTED_MEMBER]" + print "DO_NOT_MINE_UNION_MEMBER(StgHeader, prof.hp.ldvw, prof_hp_ldvw);" + print "DO_NOT_MINE_UNION_MEMBER(StgFunInfoExtraFwd, b.bitmap, b_bitmap);" + print "DO_NOT_MINE_UNION_MEMBER(StgFunInfoExtraRev, b.bitmap, b_bitmap);" +} + +## pass through embedded unions +eat_union && /^[ \t]*}[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t]*;[ \t]*$/ { + sub(/^[ \t]*}[ \t]*/, "") + sub(/[ \t]*;[ \t]*$/, "") + new_offset_struct_name = struct_name $0 + print "" + + eat_union = 0 + + if (!offset_struct_name) + { + print "char starting" new_offset_struct_name "[2];" + } + else + { + assumptions = assumptions "\n" "char sizeof" new_offset_struct_name "[offsetof(^^^, " $0 ")];" + assumptions = assumptions "\n" "typedef char verify_size" new_offset_struct_name "[sizeof sizeof" new_offset_struct_name " == offsetof(^^^, " $0 ") ? 1 : -1];" + } + + offset_struct_name = new_offset_struct_name + next +} + +eat_union { + next +} + +/# [0-9]* "rts\// { + ours = 1 + next +} + +/# [0-9]* "includes\// { + ours = 1 + next +} + +## filter out non-ghc headers +/# [0-9]* "/ { + ours = 0 + next +} + +!ours { + next +} + +!interesting { + struct_name = "$" seed "$" + offset_struct_name = "" + known_struct_name = "" + eat_union = 0 + assumptions = "" +} + +## kill empty line +/^[ \t]*$/ { + next +} + +/^# [0-9]/ { + print + next +} + +/^typedef struct[ \t][ \t]*[_0-9a-zA-Z]*[ \t]*{[ \t]*$/ { + if (interesting) error "previous struct not closed?" + interesting = 1 + print "" + print "/* ### Creating offset structs for " $3 " ### */" + next +} + +/^struct[ \t][ \t]*[_0-9a-zA-Z]*[ \t]*{[ \t]*$/ { + if (interesting) error "previous struct not closed?" + interesting = 1 + known_struct_name = $2 + sub(/_$/, "", known_struct_name); + print "" + print "/* ### Creating offset structs for " known_struct_name " ### */" + print "char associate$" known_struct_name "$" seed ";" + next +} + +## end of struct +## +interesting && /^[ \t]*}[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t]*;[ \t]*$/{ + sub(/;$/, "", $2) + + print "char associate$" $2 "$" seed ";" + print "char SIZEOF$" seed "[sizeof(" $2 ")];" + print "" + print "" + gsub(/\^\^\^/, $2, assumptions); + print assumptions + ++seed + interesting = 0 + next +} + +## Ptr-typedef +interesting && /^[ \t]*}[ \t]*\*[_0-9a-zA-Z][_0-9a-zA-Z]*Ptr[ \t]*;[ \t]*$/{ + sub(/Ptr;$/, "", $2) + sub(/^\*/, "", $2) + + print "char associate$" $2 "$" seed ";" + print "char SIZEOF$" seed "[sizeof(" $2 ")];" + print "" + print "" + gsub(/\^\^\^/, $2, assumptions); + print assumptions + ++seed + interesting = 0 + next +} + +interesting && /^[ \t]*}[; \t]*$/ { + print "char SIZEOF$" seed "[sizeof(" known_struct_name ")];" + print "" + print "" + gsub(/\^\^\^/, known_struct_name, assumptions); + print assumptions + ++seed + interesting = 0 +} + +# collapse whitespace after '*' +interesting { + # normalize some types + sub(/struct StgClosure_[ \t]*\*/, "StgClosure *") + gsub(/\*[ \t]*volatile/, "*") + # group stars together + gsub(/\*[ \t]*/, "*") + sub(/\*/, " *") + print "// " $0 + # remove volatile + sub(/[ \t]volatile[ \t]/, " ") + # remove const + sub(/[ \t]const[ \t]/, " ") +} + +## (pointer to struct) member of struct +## +interesting && /^[ \t]*struct[ \t][ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t]*\*[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t]*;[ \t]*$/ { + if (!$4) { + sub(/^\*/, "", $3) + $4 = $3 + } + sub(/;$/, "", $4) + + new_offset_struct_name = struct_name $4 + print "" + + if (!offset_struct_name) + { + print "char starting" new_offset_struct_name "[2];" + } + else + { + assumptions = assumptions "\n" "char sizeof" new_offset_struct_name "[offsetof(^^^, " $4 ")];" + assumptions = assumptions "\n" "typedef char verify_size" new_offset_struct_name "[sizeof sizeof" new_offset_struct_name " == offsetof(^^^, " $4 ") ? 1 : -1];" + } + print "char fieldsize" new_offset_struct_name "[sizeof(struct " $2 "*)];" + print "" + print "" + offset_struct_name = new_offset_struct_name + next +} + +## (simple pointer) member of struct +## +interesting && /^[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t][ \t]*\*\**[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t]*;[ \t]*$/ { + sub(/;$/, "", $2) + sub(/^\**/, "", $2) + + new_offset_struct_name = struct_name $2 + print "" + + if (!offset_struct_name) + { + print "char starting" new_offset_struct_name "[2];" + } + else + { + assumptions = assumptions "\n" "char sizeof" new_offset_struct_name "[offsetof(^^^, " $2 ")];" + assumptions = assumptions "\n" "typedef char verify_size" new_offset_struct_name "[sizeof sizeof" new_offset_struct_name " == offsetof(^^^, " $2 ") ? 1 : -1];" + } + print "char fieldsize" new_offset_struct_name "[sizeof(" $1 "*)];" + print "" + print "" + offset_struct_name = new_offset_struct_name + next +} + +## member of struct +## +interesting && /^[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t][ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*;[ \t]*$/ { + sub(/;$/, "", $2) + + new_offset_struct_name = struct_name $2 + print "" + + if (!offset_struct_name) + { + print "char starting" new_offset_struct_name "[2];" + } + else + { + assumptions = assumptions "\n" "char sizeof" new_offset_struct_name "[offsetof(^^^, " $2 ")];" + assumptions = assumptions "\n" "typedef char verify_size" new_offset_struct_name "[sizeof sizeof" new_offset_struct_name " == offsetof(^^^, " $2 ") ? 1 : -1];" + } + print "char fieldsize" new_offset_struct_name "[sizeof(" $1 ")];" + print "" + print "" + offset_struct_name = new_offset_struct_name + next +} + +## struct member of struct +## +interesting && /^[ \t]*struct[ \t][ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t][ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*;[ \t]*$/ { + sub(/;$/, "", $3) + + new_offset_struct_name = struct_name $3 + print "" + + if (!offset_struct_name) + { + print "char starting" new_offset_struct_name "[2];" + } + else + { + assumptions = assumptions "\n" "char sizeof" new_offset_struct_name "[offsetof(^^^, " $3 ")];" + assumptions = assumptions "\n" "typedef char verify_size" new_offset_struct_name "[sizeof sizeof" new_offset_struct_name " == offsetof(^^^, " $3 ") ? 1 : -1];" + } + print "char fieldsize" new_offset_struct_name "[sizeof(struct " $2 ")];" + print "" + print "" + offset_struct_name = new_offset_struct_name + next +} + +## embedded union +interesting && /^[ \t]*union[ \t]*{[ \t]*$/ { + eat_union = 1 + next +} + +## array member +interesting && /^[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t][ \t]*\**[_0-9a-zA-Z][_0-9a-zA-Z]*\[.*\];[ \t]*$/ { + sub(/;[ \t]*$/, "", $0) + + full = $0 + sub(/^[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t][ \t]*/, "", full) + split(full, parts, "[") + mname = parts[1] + sub(/^\**/, "", mname) + + new_offset_struct_name = struct_name mname + print "" + + if (!offset_struct_name) + { + print "char starting" new_offset_struct_name "[2];" + } + else + { + assumptions = assumptions "\n" "char sizeof" new_offset_struct_name "[offsetof(^^^, " mname ")];" + assumptions = assumptions "\n" "typedef char verify_size" new_offset_struct_name "[sizeof sizeof" new_offset_struct_name " == offsetof(^^^, " mname ") ? 1 : -1];" + } + + print "" + print "" + offset_struct_name = new_offset_struct_name + next +} + + +## padded member of struct +## of this form: StgHalfInt slow_apply_offset; StgHalfWord __pad_slow_apply_offset;; +## +interesting && /^[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t][ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*;[ \t]*[_0-9a-zA-Z][_0-9a-zA-Z]*[ \t][ \t]*__pad_[a-zA-Z][_0-9a-zA-Z]*;;*[ \t]*$/ { + mname = $2 + sub(/;$/, "", mname) + + new_offset_struct_name = struct_name mname + print "" + + if (!offset_struct_name) + { + print "char starting" new_offset_struct_name "[2];" + } + else + { + assumptions = assumptions "\n" "char sizeof" new_offset_struct_name "[offsetof(^^^, " mname ")];" + assumptions = assumptions "\n" "typedef char verify_size" new_offset_struct_name "[sizeof sizeof" new_offset_struct_name " == offsetof(^^^, " mname ") ? 1 : -1];" + } + print "" + print "" + offset_struct_name = new_offset_struct_name + next +} + +interesting && /;[ \t]*$/ { + print "Member not recognized: " $0 > "/dev/stderr" + exit 1 +}
\ No newline at end of file diff --git a/includes/mkSizeMacros.cross.awk b/includes/mkSizeMacros.cross.awk new file mode 100644 index 0000000000..e33e4ff4e5 --- /dev/null +++ b/includes/mkSizeMacros.cross.awk @@ -0,0 +1,82 @@ +BEGIN { + print "#define OFFSET(s_type, field) OFFSET_ ## s_type ## _ ## field" + print "#define FIELD_SIZE(s_type, field) FIELD_SIZE_ ## s_type ## _ ## field" + print "#define TYPE_SIZE(type) TYPE_SIZE_ ## type" + print "" +} + +/^0[0-9a-zA-Z]* C _*associate\$/ { + sub(/_*associate\$/, "", $3) + split($3, arr, "$") + assoc[arr[2]] = arr[1] + next +} + +/^00*2 C _*starting\$[0-9]*\$[_0-9a-zA-Z]*$/ { + sub(/_*starting\$/, "", $3) + split($3, arr, "$") + sub(/^0*/, "", $1) + print "#define OFFSET_" assoc[arr[1]] "_" arr[2] " 0x0" + next +} + +/^0[0-9a-zA-Z]* C _*sizeof\$[0-9]*\$[_0-9a-zA-Z]*$/ { + sub(/_*sizeof\$/, "", $3) + split($3, arr, "$") + sub(/^0*/, "", $1) + print "#define OFFSET_" assoc[arr[1]] "_" arr[2] " 0x" $1 + next +} + +/^0[0-9a-zA-Z]* C _*fieldsize\$[0-9]*\$[_0-9a-zA-Z]*$/ { + sub(/_*fieldsize\$/, "", $3) + split($3, arr, "$") + sub(/^0*/, "", $1) + print "#define FIELD_SIZE_" assoc[arr[1]] "_" arr[2] " 0x" $1 "UL" + next +} + +/^0[0-9a-zA-Z]* C _*nestedfieldsize\$[_0-9a-zA-Z]*\$[_0-9a-zA-Z]*$/ { + sub(/_*nestedfieldsize\$/, "", $3) + split($3, arr, "$") + sub(/^0*/, "", $1) + print "#define FIELD_SIZE_" arr[1] "_" arr[2] " 0x" $1 "UL" + next +} + +/^0[0-9a-zA-Z]* C _*SIZEOF\$[0-9]*$/ { + sub(/_*SIZEOF\$/, "", $3) + sub(/^0*/, "", $1) + print "#define TYPE_SIZE_" assoc[$3] " 0x" $1 + next +} + +{ print "// " $0 } + +END { + ## some indirect offsets + print "#define OFFSET_StgHeader_prof_ccs (OFFSET_StgHeader_prof + OFFSET_StgProfHeader_ccs)" + print "#define OFFSET_StgHeader_prof_hp_ldvw (OFFSET_StgHeader_prof + OFFSET_StgProfHeader_hp + 0)" + print "#define OFFSET_StgTSO_prof_cccs (OFFSET_StgTSO_prof + OFFSET_StgTSOProfInfo_cccs)" + print "#define OFFSET_RTS_FLAGS_ProfFlags_showCCSOnException (OFFSET_RTS_FLAGS_ProfFlags + OFFSET_PROFILING_FLAGS_showCCSOnException)" + + + print "#define OFFSET_RTS_FLAGS_DebugFlags_apply (OFFSET_RTS_FLAGS_DebugFlags + OFFSET_DEBUG_FLAGS_apply)" + print "#define OFFSET_RTS_FLAGS_DebugFlags_sanity (OFFSET_RTS_FLAGS_DebugFlags + OFFSET_DEBUG_FLAGS_sanity)" + print "#define OFFSET_RTS_FLAGS_DebugFlags_weak (OFFSET_RTS_FLAGS_DebugFlags + OFFSET_DEBUG_FLAGS_weak)" + print "#define OFFSET_RTS_FLAGS_GcFlags_initialStkSize (OFFSET_RTS_FLAGS_GcFlags + OFFSET_GC_FLAGS_initialStkSize)" + print "#define OFFSET_RTS_FLAGS_MiscFlags_tickInterval (OFFSET_RTS_FLAGS_MiscFlags + OFFSET_MISC_FLAGS_tickInterval)" + + print "#define OFFSET_StgFunInfoExtraFwd_b_bitmap (OFFSET_StgFunInfoExtraFwd_b + 0)" + print "#define OFFSET_StgFunInfoExtraRev_b_bitmap (OFFSET_StgFunInfoExtraRev_b + 0)" + + ## some indirect field sizes + print "#define FIELD_SIZE_StgHeader_prof_ccs FIELD_SIZE_StgProfHeader_ccs" + print "#define FIELD_SIZE_StgTSO_prof_cccs FIELD_SIZE_StgTSOProfInfo_cccs" + print "#define FIELD_SIZE_RTS_FLAGS_ProfFlags_showCCSOnException FIELD_SIZE_PROFILING_FLAGS_showCCSOnException" + print "#define FIELD_SIZE_RTS_FLAGS_DebugFlags_apply FIELD_SIZE_DEBUG_FLAGS_apply" + print "#define FIELD_SIZE_RTS_FLAGS_DebugFlags_sanity FIELD_SIZE_DEBUG_FLAGS_sanity" + print "#define FIELD_SIZE_RTS_FLAGS_DebugFlags_weak FIELD_SIZE_DEBUG_FLAGS_weak" + print "#define FIELD_SIZE_RTS_FLAGS_GcFlags_initialStkSize FIELD_SIZE_GC_FLAGS_initialStkSize" + print "#define FIELD_SIZE_RTS_FLAGS_MiscFlags_tickInterval FIELD_SIZE_MISC_FLAGS_tickInterval" +} diff --git a/includes/rts/prof/CCS.h b/includes/rts/prof/CCS.h index 2492bb3bc1..e6c746b4bc 100644 --- a/includes/rts/prof/CCS.h +++ b/includes/rts/prof/CCS.h @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team, 2009 + * (c) The GHC Team, 2009-2012 * * Macros for profiling operations in STG code * @@ -107,7 +107,7 @@ typedef struct IndexTable_ { CostCentre *cc; CostCentreStack *ccs; struct IndexTable_ *next; - unsigned int back_edge; + nat back_edge; } IndexTable; diff --git a/includes/stg/Regs.h b/includes/stg/Regs.h index bfc3d4b04d..bf17b7e825 100644 --- a/includes/stg/Regs.h +++ b/includes/stg/Regs.h @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team, 1998-2009 + * (c) The GHC Team, 1998-2012 * * Registers in the STG machine. * @@ -21,7 +21,7 @@ * * The register set is backed by a table in memory (struct * StgRegTable). If a particular STG register is not mapped to a - * machine register, then the apprpriate slot in this table is used + * machine register, then the appropriate slot in this table is used * instead. * * This table is itself pointed to by another register, BaseReg. If @@ -58,7 +58,7 @@ typedef union { * register, probably because there's a shortage of real registers. * 2) caller-saves registers are saved across a CCall */ -typedef struct StgRegTable_ { +typedef struct { StgUnion rR1; StgUnion rR2; StgUnion rR3; @@ -80,13 +80,13 @@ typedef struct StgRegTable_ { StgPtr rSpLim; StgPtr rHp; StgPtr rHpLim; - struct CostCentreStack_ * rCCCS; // current cost-centre-stack + struct CostCentreStack_ * rCCCS; /* current cost-centre-stack */ struct StgTSO_ * rCurrentTSO; struct nursery_ * rNursery; struct bdescr_ * rCurrentNursery; /* Hp/HpLim point into this block */ struct bdescr_ * rCurrentAlloc; /* for allocation using allocate() */ StgWord rHpAlloc; /* number of *bytes* being allocated in heap */ - StgWord rRet; // holds the return code of the thread + StgWord rRet; /* holds the return code of the thread */ } StgRegTable; #if IN_STG_CODE diff --git a/rules/cross-compiling.mk b/rules/cross-compiling.mk new file mode 100644 index 0000000000..9f9ec6f542 --- /dev/null +++ b/rules/cross-compiling.mk @@ -0,0 +1,24 @@ +# ----------------------------------------------------------------------------- +# +# (c) 2012 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 +# +# ----------------------------------------------------------------------------- + +define cross-compiling # $1 = then, $2 = else, $3 = then, ... +ifneq "$(TARGETPLATFORM)" "$(HOSTPLATFORM)" +ifneq "$(BUILDPLATFORM)" "$(HOSTPLATFORM)" +$(warning When cross-compiling, the build and host platforms must be equal (--build=$(BUILDPLATFORM) --host=$(HOSTPLATFORM) --target=$(TARGETPLATFORM))) +endif +$1 +$3 +else +$2 +$4 +endif +endef diff --git a/utils/genapply/GenApply.hs b/utils/genapply/GenApply.hs index d00324f173..e39f42ec5f 100644 --- a/utils/genapply/GenApply.hs +++ b/utils/genapply/GenApply.hs @@ -1,6 +1,6 @@ {-# OPTIONS -cpp -fglasgow-exts #-} {-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. +-- The above warning suppression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings @@ -179,7 +179,7 @@ mb_tag_node arity | Just tag <- tagForArity arity = mkTagStmt tag <> semi mkTagStmt tag = text ("R1 = R1 + "++ show tag) genMkPAP regstatus macro jump ticker disamb - no_load_regs -- don't load argumnet regs before jumping + no_load_regs -- don't load argument regs before jumping args_in_regs -- arguments are already in regs is_pap args all_args_size fun_info_label is_fun_case @@ -223,7 +223,7 @@ genMkPAP regstatus macro jump ticker disamb else shuffle_extra_args, -- for a PAP, we have to arrange that the stack contains a - -- return address in the even that stg_PAP_entry fails its + -- return address in the event that stg_PAP_entry fails its -- heap check. See stg_PAP_entry in Apply.hc for details. if is_pap then text "R2 = " <> mkApplyInfoName this_call_args <> semi diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index ddc4821a07..d992b5405f 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -137,6 +137,8 @@ flags = [ "location of the global package database", Option [] ["no-user-package-db"] (NoArg FlagNoUserDb) "never read the user package database", + Option [] ["no-user-package-conf"] (NoArg FlagNoUserDb) + "never read the user package database (DEPRECATED)", Option [] ["force"] (NoArg FlagForce) "ignore missing dependencies, directories, and libraries", Option [] ["force-files"] (NoArg FlagForceFiles) |