Fix the non-Linux build
authorErik de Castro Lopo <erikd@mega-nerd.com>
Fri, 22 Jul 2016 12:59:44 +0000 (14:59 +0200)
committerMatthew Pickering <matthewtpickering@gmail.com>
Fri, 22 Jul 2016 15:19:17 +0000 (17:19 +0200)
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

compiler/simplStg/UnariseStg.hs
compiler/stgSyn/CoreToStg.hs
rts/sm/CNF.c

index af2928d..24c0ce8 100644 (file)
@@ -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))
index cba139a..d130b74 100644 (file)
@@ -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
index 3c681c2..4689b46 100644 (file)
@@ -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