FastMutInt: fix Int and Ptr sizes when crosscompiling

Similar to
  https://ghc.haskell.org/trac/ghc/ticket/13491
  https://phabricator.haskell.org/D3122

SIZEOF_HSINT and SIZEOF_VOID_P are sizes of
target platform. These values are usually
not correct when stage1 is built.

It means the code

```haskell
  newFastMutInt = IO $ \s ->
   case newByteArray# size s of { (# s, arr #) ->
   (# s, FastMutInt arr #) }
   where !(I# size) = SIZEOF_HSINT
```
would try to allocate only 4 bytes on 64-bit-host
targeting 32-bit system.

It does not matter in practice as newByteArray#
implementation rounds up passed value to host's
word size. But one day it might not.

To prevent this class of problems in compiler/
directory 'MachDeps.h' contents is hidden when
ghc-stage1 (-DSTAGE=1) is built.

Signed-off-by: Sergei Trofimovich <slyfox@gentoo.org>

Reviewers: austin, rwbarton, simonmar, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3405

2 files changed, 33 insertions, 10 deletions

diff --git a/compiler/utils/FastMutInt.hs b/compiler/utils/FastMutInt.hs
index 4cde1216ed..2a6e7b83aa 100644
--- a/compiler/utils/FastMutInt.hs
+++ b/compiler/utils/FastMutInt.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, BangPatterns, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
@@ -15,12 +15,7 @@ module FastMutInt(
         readFastMutPtr, writeFastMutPtr
   ) where
 
-
-#include "../includes/MachDeps.h"
-#ifndef SIZEOF_HSINT
-#define SIZEOF_HSINT  INT_SIZE_IN_BYTES
-#endif
-
+import Data.Bits
 import GHC.Base
 import GHC.Ptr
 
@@ -37,7 +32,7 @@ data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
 newFastMutInt = IO $ \s ->
   case newByteArray# size s of { (# s, arr #) ->
   (# s, FastMutInt arr #) }
-  where !(I# size) = SIZEOF_HSINT
+  where !(I# size) = finiteBitSize (0 :: Int)
 
 readFastMutInt (FastMutInt arr) = IO $ \s ->
   case readIntArray# arr 0# s of { (# s, i #) ->
@@ -52,7 +47,8 @@ data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
 newFastMutPtr = IO $ \s ->
   case newByteArray# size s of { (# s, arr #) ->
   (# s, FastMutPtr arr #) }
-  where !(I# size) = SIZEOF_VOID_P
+  -- GHC assumes 'sizeof (Int) == sizeof (Ptr a)'
+  where !(I# size) = finiteBitSize (0 :: Int)
 
 readFastMutPtr (FastMutPtr arr) = IO $ \s ->
   case readAddrArray# arr 0# s of { (# s, i #) ->
diff --git a/includes/MachDeps.h b/includes/MachDeps.h
index 3a8371b111..380b3fb061 100644
--- a/includes/MachDeps.h
+++ b/includes/MachDeps.h
@@ -3,7 +3,7 @@
  * (c) The University of Glasgow 2002
  *
  * Definitions that characterise machine specific properties of basic
- * types (C & Haskell).
+ * types (C & Haskell) of a target platform.
  *
  * NB: Keep in sync with HsFFI.h and StgTypes.h.
  * NB: THIS FILE IS INCLUDED IN HASKELL SOURCE!
@@ -16,6 +16,31 @@
 #ifndef MACHDEPS_H
 #define MACHDEPS_H
 
+/* Don't allow stage1 (cross-)compiler embed assumptions about target
+ * platform. When ghc-stage1 is being built by ghc-stage0 is should not
+ * refer to target defines. A few past examples:
+ *  - https://ghc.haskell.org/trac/ghc/ticket/13491
+ *  - https://phabricator.haskell.org/D3122
+ *  - https://phabricator.haskell.org/D3405
+ *
+ * In those cases code change assumed target defines like SIZEOF_HSINT
+ * are applied to host platform, not target platform.
+ *
+ * So what should be used instead in STAGE=1?
+ *
+ * To get host's equivalent of SIZEOF_HSINT you can use Bits instances:
+ *    Data.Bits.finiteBitSize (0 :: Int)
+ *
+ * To get target's values it is preferred to use runtime target
+ * configuration from 'targetPlatform :: DynFlags -> Platform'
+ * record. A few wrappers are already defined and used throughout GHC:
+ *    wORD_SIZE :: DynFlags -> Int
+ *    wORD_SIZE dflags = pc_WORD_SIZE (sPlatformConstants (settings dflags))
+ *
+ * Hence we hide these macros from -DSTAGE=1
+ */
+#if !defined(STAGE) || STAGE >= 2
+
 /* Sizes of C types come from here... */
 #include "ghcautoconf.h"
 
@@ -96,4 +121,6 @@
 
 #define TAG_MASK ((1 << TAG_BITS) - 1)
 
+#endif /* !defined(STAGE) || STAGE >= 2 */
+
 #endif /* MACHDEPS_H */