Commit 995e8c1c authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Drop old integer-gmp-0.5 from GHC source tree

This completes what c774b28f (#9281)
started.  `integer-gmp-1.0` was added as an additional
`libraries/integer-gmp2` folder while retaining the ability to configure
GHC w/ the old `integer-gmp-0.5` to have a way back, and or the ability
to easily switch between old/new `integer-gmp` for benchmark/debugging
purposes.

This commit removes the old `libraries/integer-gmp` folder and moves
`libraries/integer-gmp2` into its place, while removing any mentions of
"gmp2" as well as the to support two different `integer-gmp` packages in
GHC's source-tree.

Reviewed By: austin

Differential Revision: https://phabricator.haskell.org/D769
parent 1f69f37f
......@@ -383,7 +383,6 @@ integerPackageKey = fsToPackageKey (fsLit n)
where
n = case cIntegerLibraryType of
IntegerGMP -> "integer-gmp"
IntegerGMP2 -> "integer-gmp"
IntegerSimple -> "integer-simple"
basePackageKey = fsToPackageKey (fsLit "base")
rtsPackageKey = fsToPackageKey (fsLit "rts")
......
......@@ -1159,8 +1159,6 @@ lookupIntegerSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon)
lookupIntegerSDataConName dflags hsc_env = case cIntegerLibraryType of
IntegerGMP -> guardIntegerUse dflags $ liftM Just $
initTcForLookup hsc_env (tcLookupDataCon integerSDataConName)
IntegerGMP2-> guardIntegerUse dflags $ liftM Just $
initTcForLookup hsc_env (tcLookupDataCon integerSDataConName)
IntegerSimple -> return Nothing
-- | Helper for 'lookupMkIntegerName' and 'lookupIntegerSDataConName'
......
......@@ -54,7 +54,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
@echo '#include "ghc_boot_platform.h"' >> $@
@echo >> $@
@echo 'data IntegerLibrary = IntegerGMP' >> $@
@echo ' | IntegerGMP2' >> $@
@echo ' | IntegerSimple' >> $@
@echo ' deriving Eq' >> $@
@echo >> $@
......@@ -88,8 +87,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
@echo 'cIntegerLibraryType :: IntegerLibrary' >> $@
ifeq "$(INTEGER_LIBRARY)" "integer-gmp"
@echo 'cIntegerLibraryType = IntegerGMP' >> $@
else ifeq "$(INTEGER_LIBRARY)" "integer-gmp2"
@echo 'cIntegerLibraryType = IntegerGMP2' >> $@
else ifeq "$(INTEGER_LIBRARY)" "integer-simple"
@echo 'cIntegerLibraryType = IntegerSimple' >> $@
else ifneq "$(CLEANING)" "YES"
......
......@@ -371,7 +371,6 @@ basicKnownKeyNames
] ++ case cIntegerLibraryType of
IntegerGMP -> [integerSDataConName]
IntegerGMP2 -> [integerSDataConName]
IntegerSimple -> []
genericTyConNames :: [Name]
......@@ -964,7 +963,6 @@ integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") int
integerSDataConName = conName gHC_INTEGER_TYPE (fsLit n) integerSDataConKey
where n = case cIntegerLibraryType of
IntegerGMP -> "S#"
IntegerGMP2 -> "S#"
IntegerSimple -> panic "integerSDataConName evaluated for integer-simple"
mkIntegerName = varQual gHC_INTEGER_TYPE (fsLit "mkInteger") mkIntegerIdKey
integerToWord64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToWord64") integerToWord64IdKey
......
......@@ -587,8 +587,6 @@ libraries/ghc-prim_dist-install_EXTRA_HADDOCK_SRCS = libraries/ghc-prim/dist-ins
ifneq "$(CLEANING)" "YES"
ifeq "$(INTEGER_LIBRARY)" "integer-gmp"
libraries/base_dist-install_CONFIGURE_OPTS += --flags=integer-gmp
else ifeq "$(INTEGER_LIBRARY)" "integer-gmp2"
libraries/base_dist-install_CONFIGURE_OPTS += --flags=integer-gmp2
else ifeq "$(INTEGER_LIBRARY)" "integer-simple"
libraries/base_dist-install_CONFIGURE_OPTS += --flags=integer-simple
else
......@@ -649,16 +647,8 @@ endif
ifeq "$(INTEGER_LIBRARY)" "integer-gmp"
BUILD_DIRS += libraries/integer-gmp/gmp
BUILD_DIRS += libraries/integer-gmp/mkGmpDerivedConstants
else ifneq "$(findstring clean,$(MAKECMDGOALS))" ""
BUILD_DIRS += libraries/integer-gmp/gmp
BUILD_DIRS += libraries/integer-gmp/mkGmpDerivedConstants
endif
ifeq "$(INTEGER_LIBRARY)" "integer-gmp2"
BUILD_DIRS += libraries/integer-gmp2/gmp
else ifneq "$(findstring clean,$(MAKECMDGOALS))" ""
BUILD_DIRS += libraries/integer-gmp2/gmp
endif
ifeq "$(HADDOCK_DOCS)" "YES"
......@@ -1233,9 +1223,7 @@ sdist_%:
.PHONY: clean
CLEAN_FILES += libraries/integer-gmp/cbits/GmpDerivedConstants.h
CLEAN_FILES += libraries/integer-gmp/include/HsIntegerGmp.h
CLEAN_FILES += libraries/integer-gmp2/include/HsIntegerGmp.h
CLEAN_FILES += libraries/base/include/EventConfig.h
CLEAN_FILES += mk/config.mk.old
CLEAN_FILES += mk/project.mk.old
......
......@@ -52,11 +52,6 @@ Flag integer-gmp
Manual: True
Default: False
Flag integer-gmp2
Description: Use integer-gmp2
Manual: True
Default: False
Library
default-language: Haskell2010
other-extensions:
......@@ -103,10 +98,6 @@ Library
build-depends: integer-simple >= 0.1.1 && < 0.2
if flag(integer-gmp)
build-depends: integer-gmp >= 0.5.1 && < 0.6
cpp-options: -DOPTIMISE_INTEGER_GCD_LCM
if flag(integer-gmp2)
build-depends: integer-gmp >= 1.0 && < 1.1
cpp-options: -DOPTIMISE_INTEGER_GCD_LCM
......
/GNUmakefile
/autom4te.cache/
/cbits/GmpDerivedConstants.h
/cbits/mkGmpDerivedConstants
/config.log
/config.status
/configure
/dist-install/
/ghc.mk
/gmp/config.mk
/GNUmakefile
/include/HsIntegerGmp.h
/integer-gmp.buildinfo
/mkGmpDerivedConstants/dist/
/gmp/gmp.h
/gmp/gmpbuild
/include/ghc-gmp.h
\begin{code}
{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Integer
-- Copyright : (c) The University of Glasgow 1994-2008
-- License : see libraries/integer-gmp/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- The 'Integer' type.
--
-- This module exposes the /portable/ 'Integer' API. See
-- "GHC.Integer.GMP.Internals" for the GMP-specific internal
-- representation of 'Integer' as well as optimized GMP-specific
-- operations.
-----------------------------------------------------------------------------
#include "MachDeps.h"
module GHC.Integer (
Integer,
-- * Construct 'Integer's
mkInteger, smallInteger, wordToInteger,
#if WORD_SIZE_IN_BITS < 64
word64ToInteger, int64ToInteger,
#endif
-- * Conversion to other integral types
integerToWord, integerToInt,
#if WORD_SIZE_IN_BITS < 64
integerToWord64, integerToInt64,
#endif
-- * Helpers for 'RealFloat' type-class operations
encodeFloatInteger, floatFromInteger,
encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
-- * Arithmetic operations
plusInteger, minusInteger, timesInteger, negateInteger,
absInteger, signumInteger,
divModInteger, divInteger, modInteger,
quotRemInteger, quotInteger, remInteger,
-- * Comparison predicates
eqInteger, neqInteger,
leInteger, gtInteger, ltInteger, geInteger, compareInteger,
eqInteger#, neqInteger#,
leInteger#, gtInteger#, ltInteger#, geInteger#,
-- * Bit-operations
andInteger, orInteger, xorInteger, complementInteger,
shiftLInteger, shiftRInteger, testBitInteger,
-- * Hashing
hashInteger,
) where
import GHC.Integer.Type
default ()
\end{code}
{-# LANGUAGE NoImplicitPrelude #-}
-- | This modules provides access to the 'Integer' constructors and
-- exposes some highly optimized GMP-operations.
--
-- Note that since @integer-gmp@ does not depend on `base`, error
-- reporting via exceptions, 'error', or 'undefined' is not
-- available. Instead, the low-level functions will crash the runtime
-- if called with invalid arguments.
--
-- See also
-- <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer GHC Commentary: Libraries/Integer>.
module GHC.Integer.GMP.Internals
( -- * The 'Integer' type
Integer(..)
-- * Number theoretic functions
, gcdInt
, gcdInteger
, gcdExtInteger
, lcmInteger
, nextPrimeInteger
, testPrimeInteger
-- * Exponentiation functions
, powInteger
, powModInteger
, powModSecInteger
, recipModInteger
-- * Import/export functions
, sizeInBaseInteger
, importIntegerFromByteArray
, importIntegerFromAddr
, exportIntegerToMutableByteArray
, exportIntegerToAddr
) where
import GHC.Integer.Type
This diff is collapsed.
{-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-}
module GHC.Integer.Logarithms
( integerLogBase#
, integerLog2#
, wordLog2#
) where
import GHC.Prim
import GHC.Integer
import qualified GHC.Integer.Logarithms.Internals as I
-- | Calculate the integer logarithm for an arbitrary base.
-- The base must be greater than 1, the second argument, the number
-- whose logarithm is sought, should be positive, otherwise the
-- result is meaningless.
--
-- > base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
--
-- for @base > 1@ and @m > 0@.
integerLogBase# :: Integer -> Integer -> Int#
integerLogBase# b m = case step b of
(# _, e #) -> e
where
step pw =
if m `ltInteger` pw
then (# m, 0# #)
else case step (pw `timesInteger` pw) of
(# q, e #) ->
if q `ltInteger` pw
then (# q, 2# *# e #)
else (# q `quotInteger` pw, 2# *# e +# 1# #)
-- | Calculate the integer base 2 logarithm of an 'Integer'.
-- The calculation is more efficient than for the general case,
-- on platforms with 32- or 64-bit words much more efficient.
--
-- The argument must be strictly positive, that condition is /not/ checked.
integerLog2# :: Integer -> Int#
integerLog2# = I.integerLog2#
-- | This function calculates the integer base 2 logarithm of a 'Word#'.
wordLog2# :: Word# -> Int#
wordLog2# = I.wordLog2#
{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}
#include "MachDeps.h"
-- Fast integer logarithms to base 2.
-- integerLog2# and wordLog2# are of general usefulness,
-- the others are only needed for a fast implementation of
-- fromRational.
-- Since they are needed in GHC.Float, we must expose this
-- module, but it should not show up in the docs.
module GHC.Integer.Logarithms.Internals
( integerLog2#
, integerLog2IsPowerOf2#
, wordLog2#
, roundingMode#
) where
import GHC.Prim
import GHC.Types (isTrue#)
import GHC.Integer.Type
-- When larger word sizes become common, add support for those,
-- it is not hard, just tedious.
#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)
-- Less than ideal implementations for strange word sizes
import GHC.Integer
default ()
-- We do not know whether the word has 30 bits or 128 or even more,
-- so we cannot start from the top, although that would be much more
-- efficient.
-- Count the bits until the highest set bit is found.
wordLog2# :: Word# -> Int#
wordLog2# w = go 8# w
where
go acc u = case u `uncheckedShiftRL#` 8# of
0## -> case leadingZeros of
BA ba -> acc -# indexInt8Array# ba (word2Int# u)
v -> go (acc +# 8#) v
-- Assumption: Integer is strictly positive
integerLog2# :: Integer -> Int#
integerLog2# (S# i) = wordLog2# (int2Word# i) -- that is easy
integerLog2# m = case step m (smallInteger 2#) 1# of
(# _, l #) -> l
where
-- Invariants:
-- pw = 2 ^ lg
-- case step n pw lg of
-- (q, e) -> pw^(2*e) <= n < pw^(2*e+2)
-- && q <= n/pw^(2*e) < (q+1)
-- && q < pw^2
step n pw lg =
if n `ltInteger` pw
then (# n, 0# #)
else case step n (shiftLInteger pw lg) (2# *# lg) of
(# q, e #) ->
if q `ltInteger` pw
then (# q, 2# *# e #)
else (# q `shiftRInteger` lg, 2# *# e +# 1# #)
-- Calculate the log2 of a positive integer and check
-- whether it is a power of 2.
-- By coincidence, the presence of a power of 2 is
-- signalled by zero and not one.
integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
integerLog2IsPowerOf2# m =
case integerLog2# m of
lg -> if m `eqInteger` (smallInteger 1# `shiftLInteger` lg)
then (# lg, 0# #)
else (# lg, 1# #)
-- Detect the rounding mode,
-- 0# means round to zero,
-- 1# means round to even,
-- 2# means round away from zero
roundingMode# :: Integer -> Int# -> Int#
roundingMode# m h =
case smallInteger 1# `shiftLInteger` h of
c -> case m `andInteger`
((c `plusInteger` c) `minusInteger` smallInteger 1#) of
r ->
if c `ltInteger` r
then 2#
else if c `gtInteger` r
then 0#
else 1#
#else
default ()
-- We have a nice word size, we can do much better now.
#if WORD_SIZE_IN_BITS == 32
#define WSHIFT 5
#define MMASK 31
#else
#define WSHIFT 6
#define MMASK 63
#endif
-- Assumption: Integer is strictly positive
-- For small integers, use wordLog#,
-- in the general case, check words from the most
-- significant down, once a nonzero word is found,
-- calculate its log2 and add the number of following bits.
integerLog2# :: Integer -> Int#
integerLog2# (S# i) = wordLog2# (int2Word# i)
integerLog2# (J# s ba) = check (s -# 1#)
where
check i = case indexWordArray# ba i of
0## -> check (i -# 1#)
w -> wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
-- Assumption: Integer is strictly positive
-- First component is log2 n, second is 0# iff n is a power of two
integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
-- The power of 2 test is n&(n-1) == 0, thus powers of 2
-- are indicated bythe second component being zero.
integerLog2IsPowerOf2# (S# i) =
case int2Word# i of
w -> (# wordLog2# w, word2Int# (w `and#` (w `minusWord#` 1##)) #)
-- Find the log2 as above, test whether that word is a power
-- of 2, if so, check whether only zero bits follow.
integerLog2IsPowerOf2# (J# s ba) = check (s -# 1#)
where
check :: Int# -> (# Int#, Int# #)
check i = case indexWordArray# ba i of
0## -> check (i -# 1#)
w -> (# wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
, case w `and#` (w `minusWord#` 1##) of
0## -> test (i -# 1#)
_ -> 1# #)
test :: Int# -> Int#
test i = if isTrue# (i <# 0#)
then 0#
else case indexWordArray# ba i of
0## -> test (i -# 1#)
_ -> 1#
-- Assumption: Integer and Int# are strictly positive, Int# is less
-- than logBase 2 of Integer, otherwise havoc ensues.
-- Used only for the numerator in fromRational when the denominator
-- is a power of 2.
-- The Int# argument is log2 n minus the number of bits in the mantissa
-- of the target type, i.e. the index of the first non-integral bit in
-- the quotient.
--
-- 0# means round down (towards zero)
-- 1# means we have a half-integer, round to even
-- 2# means round up (away from zero)
roundingMode# :: Integer -> Int# -> Int#
roundingMode# (S# i) t =
case int2Word# i `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) of
k -> case uncheckedShiftL# 1## t of
c -> if isTrue# (c `gtWord#` k)
then 0#
else if isTrue# (c `ltWord#` k)
then 2#
else 1#
roundingMode# (J# _ ba) t =
case word2Int# (int2Word# t `and#` MMASK##) of
j -> -- index of relevant bit in word
case uncheckedIShiftRA# t WSHIFT# of
k -> -- index of relevant word
case indexWordArray# ba k `and#`
((uncheckedShiftL# 2## j) `minusWord#` 1##) of
r ->
case uncheckedShiftL# 1## j of
c -> if isTrue# (c `gtWord#` r)
then 0#
else if isTrue# (c `ltWord#` r)
then 2#
else test (k -# 1#)
where
test i = if isTrue# (i <# 0#)
then 1#
else case indexWordArray# ba i of
0## -> test (i -# 1#)
_ -> 2#
-- wordLog2# 0## = -1#
{-# INLINE wordLog2# #-}
wordLog2# :: Word# -> Int#
wordLog2# w =
case leadingZeros of
BA lz ->
let zeros u = indexInt8Array# lz (word2Int# u) in
#if WORD_SIZE_IN_BITS == 64
case uncheckedShiftRL# w 56# of
a ->
if isTrue# (a `neWord#` 0##)
then 64# -# zeros a
else
case uncheckedShiftRL# w 48# of
b ->
if isTrue# (b `neWord#` 0##)
then 56# -# zeros b
else
case uncheckedShiftRL# w 40# of
c ->
if isTrue# (c `neWord#` 0##)
then 48# -# zeros c
else
case uncheckedShiftRL# w 32# of
d ->
if isTrue# (d `neWord#` 0##)
then 40# -# zeros d
else
#endif
case uncheckedShiftRL# w 24# of
e ->
if isTrue# (e `neWord#` 0##)
then 32# -# zeros e
else
case uncheckedShiftRL# w 16# of
f ->
if isTrue# (f `neWord#` 0##)
then 24# -# zeros f
else
case uncheckedShiftRL# w 8# of
g ->
if isTrue# (g `neWord#` 0##)
then 16# -# zeros g
else 8# -# zeros w
#endif
-- Lookup table
data BA = BA ByteArray#
leadingZeros :: BA
leadingZeros =
let mkArr s =
case newByteArray# 256# s of
(# s1, mba #) ->
case writeInt8Array# mba 0# 9# s1 of
s2 ->
let fillA lim val idx st =
if isTrue# (idx ==# 256#)
then st
else if isTrue# (idx <# lim)
then case writeInt8Array# mba idx val st of
nx -> fillA lim val (idx +# 1#) nx
else fillA (2# *# lim) (val -# 1#) idx st
in case fillA 2# 8# 1# s2 of
s3 -> case unsafeFreezeByteArray# mba s3 of
(# _, ba #) -> ba
in case mkArr realWorld# of
b -> BA b
This diff is collapsed.
This library (libraries/integer(-gmp)) is derived from code from several
sources:
Copyright (c) 2014, Herbert Valerio Riedel
* Code from the GHC project which is largely (c) The University of
Glasgow, and distributable under a BSD-style license (see below),
* Code from the Haskell 98 Report which is (c) Simon Peyton Jones
and freely redistributable (but see the full license for
restrictions).
The full text of these licenses is reproduced below. All of the
licenses are BSD-style or compatible.
-----------------------------------------------------------------------------
The Glasgow Haskell Compiler License
Copyright 2004, The University Court of the University of Glasgow.
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.
-----------------------------------------------------------------------------
Code derived from the document "Report on the Programming Language
Haskell 98", is distributed under the following license:
Copyright (c) 2002 Simon Peyton Jones
The authors intend this Report to belong to the entire Haskell
community, and so we grant permission to copy and distribute it for
any purpose, provided that it is reproduced in its entirety,
including this Notice. Modified versions of this Report may also be
copied and distributed for any purpose, provided that the modified
version is clearly presented as such, and that it does not claim to
be a definition of the Haskell 98 Language.
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Herbert Valerio Riedel nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
......@@ -3,4 +3,4 @@ module Main (main) where
import Distribution.Simple
main :: IO ()
main = defaultMain
main = defaultMainWithHooks autoconfUserHooks
/* -----------------------------------------------------------------------------
*
* (c) The GHC Team, 1998-2012
*
* ---------------------------------------------------------------------------*/
#include <string.h>
#include "Rts.h"
#include "gmp.h"
void * stgAllocForGMP (size_t size_in_bytes);
void * stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
void stgDeallocForGMP (void *ptr STG_UNUSED, size_t size STG_UNUSED);
static void initAllocForGMP( void ) __attribute__((constructor));
/* -----------------------------------------------------------------------------
Tell GMP to use our custom heap allocation functions.
Our allocation strategy is to use GHC heap allocations rather than malloc
and co. The heap objects we use are ByteArray#s which of course have their
usual header word or two. But gmp doesn't know about ghc heap objects and
header words. So our allocator has to make a ByteArray# and return a pointer
to its interior! When the gmp function returns we receive that interior
pointer. Then we look back a couple words to get the proper ByteArray#
pointer (which then gets returned as a ByteArray# and thus get tracked
properly by the GC).
WARNING!! WARNING!! WARNING!!
It is absolutely vital that this initialisation function be called before
any of the gmp functions are called. We'd still be looking back a couple
words for the ByteArray# header, but if we were accidentally using malloc
then it'd all go wrong because of course there would be no ByteArray#
header, just malloc's own internal book keeping info. To make things worse
we would not notice immediately, it'd only be when the GC comes round to
inspect things... BANG!
> Program received signal SIGSEGV, Segmentation fault.
> [Switching to Thread 0x7f5a9ebc76f0 (LWP 17838)]
> evacuate1 (p=0x7f5a99acd2e0) at rts/sm/Evac.c:375
> 375 switch (info->type) {
-------------------------------------------------------------------------- */
static void initAllocForGMP( void )
{
mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
}
/* -----------------------------------------------------------------------------
Allocation functions for GMP.
These all use the allocate() interface - we can't have any garbage
collection going on during a gmp operation, so we use allocate()
which always succeeds. The gmp operations which might need to
allocate will ask the storage manager (via doYouWantToGC()) whether
a garbage collection is required, in case we get into a loop doing
only allocate() style allocation.
-------------------------------------------------------------------------- */
void *
stgAllocForGMP (size_t size_in_bytes)
{