[commit: ghc] master: Fix the non-Linux build (d068220)

git at git.haskell.org git at git.haskell.org
Fri Jul 22 15:19:29 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d068220f4249cce66ed5b6cc5504f79e7c8c0184/ghc

>---------------------------------------------------------------

commit d068220f4249cce66ed5b6cc5504f79e7c8c0184
Author: Erik de Castro Lopo <erikd at mega-nerd.com>
Date:   Fri Jul 22 14:59:44 2016 +0200

    Fix the non-Linux build
    
    Summary:
    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.
    
    Test Plan: Build on Linux, OS X and Windows
    
    Reviewers: gcampax, simonmar, austin, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2421


>---------------------------------------------------------------

d068220f4249cce66ed5b6cc5504f79e7c8c0184
 compiler/simplStg/UnariseStg.hs | 16 ++++++++--------
 compiler/stgSyn/CoreToStg.hs    |  2 +-
 rts/sm/CNF.c                    | 19 +++++--------------
 3 files changed, 14 insertions(+), 23 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..4689b46 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,8 +978,9 @@ 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,
-                   key, key+size, value, value+size);
+        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);
     }
 }
 #endif



More information about the ghc-commits mailing list