summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorErik de Castro Lopo <erikd@mega-nerd.com>2016-07-21 20:42:22 +1000
committerErik de Castro Lopo <erikd@mega-nerd.com>2016-07-22 21:48:42 +1000
commit4178c4196fd39b0a4e49cc1ddf0d832d03ee3ec5 (patch)
treeaff5a2dac9d798f3196897d8d0abbea123c39c6f
parentbfef2eb1898641f250a1b39fe67c18963a709534 (diff)
downloadhaskell-wip/erikd-build.tar.gz
Fix the non-Linux buildwip/erikd-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 hand rolled inline max() function.
-rw-r--r--compiler/simplStg/UnariseStg.hs16
-rw-r--r--compiler/stgSyn/CoreToStg.hs2
-rw-r--r--rts/sm/CNF.c16
3 files changed, 12 insertions, 22 deletions
diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index af2928d770..24c0ce84a8 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 cba139a532..d130b74ea2 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 3c681c2ee2..a24697f1e3 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);
}
}