[commit: ghc] wip/erikd-build: Fix the non-Linux build (0f6c935)
git at git.haskell.org
git at git.haskell.org
Fri Jul 22 11:46:13 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/erikd-build
Link : http://ghc.haskell.org/trac/ghc/changeset/0f6c93506008f85fbfbba9199ec86cbe7f637033/ghc
>---------------------------------------------------------------
commit 0f6c93506008f85fbfbba9199ec86cbe7f637033
Author: Erik de Castro Lopo <erikd at mega-nerd.com>
Date: Thu Jul 21 20:42:22 2016 +1000
Fix the non-Linux build
The recent Compact Regions commit (cf989ffe49) builds fine on Linux
but doesn't build on OS X r Windows.
* rts/sm/CNF.c: Drop un-needed #includes.
* Fix parenthesis usage with CPP ASSERT macro.
* Fix format string in debugBelch messages.
* Use stg_max instead.
>---------------------------------------------------------------
0f6c93506008f85fbfbba9199ec86cbe7f637033
compiler/simplStg/UnariseStg.hs | 16 ++++++++--------
compiler/stgSyn/CoreToStg.hs | 2 +-
rts/sm/CNF.c | 16 +++-------------
3 files changed, 12 insertions(+), 22 deletions(-)
diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index af2928d..24c0ce8 100644
--- a/compiler/simplStg/UnariseStg.hs
+++ b/compiler/simplStg/UnariseStg.hs
@@ -241,10 +241,10 @@ instance Outputable UnariseVal where
-- | Extend the environment, checking the UnariseEnv invariant.
extendRho :: UnariseEnv -> Id -> UnariseVal -> UnariseEnv
extendRho rho x (MultiVal args)
- = ASSERT (all (isNvUnaryType . stgArgType) args)
+ = ASSERT(all (isNvUnaryType . stgArgType) args)
extendVarEnv rho x (MultiVal args)
extendRho rho x (UnaryVal val)
- = ASSERT (isNvUnaryType (stgArgType val))
+ = ASSERT(isNvUnaryType (stgArgType val))
extendVarEnv rho x (UnaryVal val)
--------------------------------------------------------------------------------
@@ -273,7 +273,7 @@ unariseRhs rho (StgRhsClosure ccs b_info fvs update_flag args expr)
return (StgRhsClosure ccs b_info fvs' update_flag args1 expr')
unariseRhs rho (StgRhsCon ccs con args)
- = ASSERT (not (isUnboxedTupleCon con || isUnboxedSumCon con))
+ = ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con))
return (StgRhsCon ccs con (unariseConArgs rho args))
--------------------------------------------------------------------------------
@@ -356,7 +356,7 @@ unariseMulti_maybe rho dc args ty_args
= Just (unariseConArgs rho args)
| isUnboxedSumCon dc
- , let args1 = ASSERT (isSingleton args) (unariseConArgs rho args)
+ , let args1 = ASSERT(isSingleton args) (unariseConArgs rho args)
= Just (mkUbxSum dc ty_args args1)
| otherwise
@@ -374,7 +374,7 @@ elimCase rho args bndr (MultiValAlt _) [(_, bndrs, rhs)]
| isUnboxedTupleBndr bndr
= mapTupleIdBinders bndrs args rho1
| otherwise
- = ASSERT (isUnboxedSumBndr bndr)
+ = ASSERT(isUnboxedSumBndr bndr)
if null bndrs then rho1
else mapSumIdBinders bndrs args rho1
@@ -480,7 +480,7 @@ mapTupleIdBinders
-> UnariseEnv
-> UnariseEnv
mapTupleIdBinders ids args0 rho0
- = ASSERT (not (any (isVoidTy . stgArgType) args0))
+ = ASSERT(not (any (isVoidTy . stgArgType) args0))
let
ids_unarised :: [(Id, RepType)]
ids_unarised = map (\id -> (id, repType (idType id))) ids
@@ -498,7 +498,7 @@ mapTupleIdBinders ids args0 rho0
| isMultiRep x_rep
= extendRho rho x (MultiVal x_args)
| otherwise
- = ASSERT (x_args `lengthIs` 1)
+ = ASSERT(x_args `lengthIs` 1)
extendRho rho x (UnaryVal (head x_args))
in
map_ids rho' xs args'
@@ -514,7 +514,7 @@ mapSumIdBinders
-> UnariseEnv
mapSumIdBinders [id] args rho0
- = ASSERT (not (any (isVoidTy . stgArgType) args))
+ = ASSERT(not (any (isVoidTy . stgArgType) args))
let
arg_slots = concatMap (repTypeSlots . repType . stgArgType) args
id_slots = repTypeSlots (repType (idType id))
diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs
index cba139a..d130b74 100644
--- a/compiler/stgSyn/CoreToStg.hs
+++ b/compiler/stgSyn/CoreToStg.hs
@@ -774,7 +774,7 @@ mkStgRhs' con_updateable rhs_fvs bndr binder_info rhs
| StgConApp con args _ <- unticked_rhs
, not (con_updateable con args)
= -- CorePrep does this right, but just to make sure
- ASSERT (not (isUnboxedTupleCon con || isUnboxedSumCon con))
+ ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con))
StgRhsCon noCCS con args
| otherwise
= StgRhsClosure noCCS binder_info
diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c
index 3c681c2..a24697f 100644
--- a/rts/sm/CNF.c
+++ b/rts/sm/CNF.c
@@ -29,8 +29,6 @@
#ifdef HAVE_LIMITS_H
#include <limits.h>
#endif
-#include <dlfcn.h>
-#include <endian.h>
/**
* Note [Compact Normal Forms]
@@ -433,14 +431,6 @@ block_is_full (StgCompactNFDataBlock *block)
return (bd->free + sizeW > top);
}
-static inline StgWord max(StgWord a, StgWord b)
-{
- if (a > b)
- return a;
- else
- return b;
-}
-
static rtsBool
allocate_loop (Capability *cap,
StgCompactNFData *str,
@@ -471,7 +461,7 @@ allocate_loop (Capability *cap,
}
}
- next_size = max(str->autoBlockW * sizeof(StgWord),
+ next_size = stg_max(str->autoBlockW * sizeof(StgWord),
BLOCK_ROUND_UP(sizeW * sizeof(StgWord)));
if (next_size >= BLOCKS_PER_MBLOCK * BLOCK_SIZE)
next_size = BLOCKS_PER_MBLOCK * BLOCK_SIZE;
@@ -977,7 +967,7 @@ spew_failing_pointer(StgWord *fixup_table, uint32_t count, StgWord address)
bdescr *bd;
StgWord size;
- debugBelch("Failed to adjust 0x%lx. Block dump follows...\n",
+ debugBelch("Failed to adjust 0x%" FMT_HexWord ". Block dump follows...\n",
address);
for (i = 0; i < count; i++) {
@@ -988,7 +978,7 @@ spew_failing_pointer(StgWord *fixup_table, uint32_t count, StgWord address)
bd = Bdescr((P_)block);
size = (W_)bd->free - (W_)bd->start;
- debugBelch("%d: was 0x%lx-0x%lx, now 0x%lx-0x%lx\n", i,
+ debugBelch("%" FMT_Word32 ": was 0x%" FMT_HexWord "-0x%" FMT_HexWord ", now 0x%" FMT_HexWord "-0x%" FMT_HexWord "\n", i,
key, key+size, value, value+size);
}
}
More information about the ghc-commits
mailing list