diff --git a/basis/PackReal.sml b/basis/PackReal.sml
index ae1a3106..951a4470 100644
--- a/basis/PackReal.sml
+++ b/basis/PackReal.sml
@@ -1,155 +1,150 @@
(*
Title: Standard Basis Library: Pack Real structures and signatures
Author: David Matthews
- Copyright David Matthews 2000, 2015, 2021
+ Copyright David Matthews 2000, 2015, 2021, 2023
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
signature PACK_REAL =
sig
type real
val bytesPerElem : int
val isBigEndian : bool
val toBytes : real -> Word8Vector.vector
val fromBytes : Word8Vector.vector -> real
val subVec : Word8Vector.vector * int -> real
val subArr : Word8Array.array * int -> real
val update : Word8Array.array * int * real -> unit
end;
(* (Un)Pack a boxed real value. This is used for double precision
and also for single precision (Real32.real) on 32-bit platforms. *)
functor PackRealBoxed(
type realType
val isBigEndian: bool
val realSize: word
) : PACK_REAL where type real = realType =
struct
open LibrarySupport
open LibrarySupport.Word8Array
type real = realType
val bytesPerElem: int = Word.toInt realSize
val isBigEndian = isBigEndian
local
val System_move_bytes: address*address*word*word*word->unit = RunCall.moveBytes
(* Move bytes, reversing the order. *)
fun swapOrder(src: address, srcOff: word,
dest: address, destOff: word,
length: word) =
if length = 0w0 then ()
else
(
RunCall.storeByte(dest, destOff+length-0w1, RunCall.loadByte(src, srcOff));
swapOrder(src, srcOff+0w1, dest, destOff, length-0w1)
)
in
fun doMove(src: address, srcOff: word,
dest: address, destOff: word, wantBigEndian: bool) =
if wantBigEndian = bigEndian (* Host byte order = required byte order *)
then System_move_bytes(src, dest, srcOff, destOff, realSize)
else (* Host byte order is reverse of required byte order. *)
swapOrder(src, srcOff, dest, destOff, realSize)
end
fun toBytes r =
let
val v = allocString realSize
(* r is actually represented by a pointer to a vector. *)
val addr: address = RunCall.unsafeCast r
in
doMove(addr, 0w0, stringAsAddress v, wordSize, isBigEndian);
RunCall.clearMutableBit v;
w8vectorFromString v
end
fun fromBytes v =
(* Raises an exception if the vector is too small and takes the first
few elements if it's larger. *)
if Word8Vector.length v < bytesPerElem
then raise Subscript
else
let
val r = allocBytes realSize
in
doMove(w8vectorAsAddress v, wordSize, r, 0w0, isBigEndian);
RunCall.clearMutableBit r;
(RunCall.unsafeCast r): real
end
fun subVec(v, i) =
let
val iW = unsignedShortOrRaiseSubscript i * realSize
in
if iW >= Word.fromInt(Word8Vector.length v)
then raise Subscript (* This IS defined. *)
else
let
val r = allocBytes realSize
in
doMove(w8vectorAsAddress v, wordSize + iW, r, 0w0, isBigEndian);
RunCall.clearMutableBit r;
(RunCall.unsafeCast r): real
end
end
fun subArr(Array(l, v), i) =
let
val iW = unsignedShortOrRaiseSubscript i * realSize
in
if iW >= l
then raise Subscript (* This IS defined. *)
else
let
val r = allocBytes realSize
in
doMove(v, iW, r, 0w0, isBigEndian);
RunCall.clearMutableBit r;
(RunCall.unsafeCast r): real
end
end
fun update(Array(l, v), i, r) =
let
val iW = unsignedShortOrRaiseSubscript i * realSize
in
if iW >= l
then raise Subscript (* This IS defined. *)
else
let
(* r is actually represented by a pointer to a vector. *)
val addr: address = RunCall.unsafeCast r
in
doMove(addr, 0w0, v, iW, isBigEndian)
end
end
end;
-local
- val realSizeCall: unit -> word = RunCall.rtsCallFast1 "PolyRealSize"
- val realSize: word = realSizeCall ()
-in
- structure PackRealBig: PACK_REAL =
- PackRealBoxed(type realType = real val isBigEndian = true val realSize = realSize)
- and PackRealLittle: PACK_REAL =
- PackRealBoxed(type realType = real val isBigEndian = false val realSize = realSize)
-end;
+structure PackRealBig: PACK_REAL =
+ PackRealBoxed(type realType = real val isBigEndian = true val realSize = 0w8)
+and PackRealLittle: PACK_REAL =
+ PackRealBoxed(type realType = real val isBigEndian = false val realSize = 0w8);
diff --git a/basis/Real.sml b/basis/Real.sml
index 05f10004..108a77c1 100644
--- a/basis/Real.sml
+++ b/basis/Real.sml
@@ -1,608 +1,1065 @@
(*
- Title: Standard Basis Library: Real Signature and structure.
+ Title: Standard Basis Library: Real and Real32 structures.
Author: David Matthews
- Copyright David Matthews 2000, 2005, 2008, 2016-18
+ Copyright David Matthews 2000, 2005, 2008, 2016-18, 2023
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
+local
+ (* Functions common to Real and Real32 *)
+ local
+ open StringCvt
+ in
+ (* Zero padding. Handle some of the shorter case to avoid too much concatentation. *)
+ fun padZero 0 = ""
+ | padZero 1 = "0"
+ | padZero 2 = "00"
+ | padZero 3 = "000"
+ | padZero 4 = "0000"
+ | padZero 5 = "00000"
+ | padZero 6 = "000000"
+ | padZero 7 = "0000000"
+ | padZero 8 = "00000000"
+ | padZero n = if n < 0 then raise Size else "00000000" ^ padZero(n-8)
+
+ (* How many digits will the mantissa take? It's possible
+ to unroll this loop since the maximum for float is 9 and for
+ double is 17. We want to avoid long-format arbitrary precision
+ arithmetic as much as possible so we stop at 10 digits which
+ is the maximum short-format power of ten in 32-bit mode. *)
+ fun ndigits (i: LargeInt.int) =
+ if i >= 1000000000 then ndigits(i div 1000000000) + 9
+ else if i >= 100000000 then 9
+ else if i >= 10000000 then 8
+ else if i >= 1000000 then 7
+ else if i >= 100000 then 6
+ else if i >= 10000 then 5
+ else if i >= 1000 then 4
+ else if i >= 100 then 3
+ else if i >= 10 then 2
+ else 1
+
+ (* Power of ten - unroll a few values. *)
+ fun powerTen 0 = 1
+ | powerTen 1 = 10
+ | powerTen 2 = 100
+ | powerTen 3 = 1000
+ | powerTen 4 = 10000
+ | powerTen 5 = 100000
+ | powerTen 6 = 1000000
+ | powerTen n = if n < 0 then raise Size else 1000000 * powerTen(n-6)
+
+ local
+ (* PolyRealDoubleToDecimal returns an arbitrary precision number for
+ the mantissa because it could be greater than 31 bits. In 64-bit
+ mode it will always be short and we want to use fixed int
+ arithmetic if we can. *)
+ fun fixedDigitList (0, r) = r
+ | fixedDigitList (n, r) =
+ fixedDigitList (FixedInt.quot(n, 10), FixedInt.toInt(FixedInt.rem(n, 10)) :: r)
+ in
+ fun digitList(n, r) =
+ if LibrarySupport.largeIntIsSmall n then fixedDigitList (FixedInt.fromLarge n, r)
+ else
+ let
+ val (qu, rm) = IntInf.quotRem(n, 10)
+ in
+ digitList (qu, (Int.fromLarge rm) :: r)
+ end
+ end
+
+ datatype realConv = RCSpecial of string | RCNormal of bool * int * LargeInt.int
+
+ (* Common functions to convert real/Real32.real to strings *)
+ (* "ndigs" is the number of digits after the decimal point.
+ For sciFmt that means that "ndigs+1" digits are produced.
+ For fixFmt at least "ndigs+1" digits are produced. If
+ "ndigs" is 0 the value is printed as an integer without
+ any ".0".
+ In both cases ndigs > 0. *)
+ (* These functions start with the exact representation and round if necessary by
+ adding 0.5 to the last digit. Since the exact representation is itself a
+ rounded value it's possible that this could result in double rounding. *)
+ fun exactFmt convert r =
+ case convert r of
+ RCSpecial s => s
+ | RCNormal (sign, exponent, mantissa) =>
+ let
+ val s = if sign then "~" else ""
+ val (e, exp) =
+ if exponent = 0 then ("", "") else ("E", Int.toString exponent)
+ in
+ String.concat[s, "0.", LargeInt.toString mantissa, e, exp]
+ end
+
+ and fixFmt convert ndigs r =
+ case convert r of
+ RCSpecial s => s
+ | RCNormal (sign, expo, mant) =>
+ let
+ val signString = if sign then "~" else ""
+ val digits = ndigits mant
+
+ val (roundedMantissa, exp) =
+ if digits-expo <= ndigs
+ then (* No rounding necessary *) (mant, expo)
+ else
+ let
+ val tens = powerTen(digits-expo-ndigs)
+ val rounded = (mant + tens div 2) div tens
+ in
+ (* If we have rounded to zero the exponent is zero.
+ We may also have rounded up a value of 9.999
+ to add an extra digit. *)
+ if rounded = 0
+ then (0, 0)
+ else (rounded, ndigits rounded - ndigs)
+ end
+
+ val mantissa = LargeInt.toString roundedMantissa
+ val mantLength = String.size mantissa
+ in
+ if ndigs = 0
+ then (* No decimal point or anything after. *)
+ (
+ if exp >= mantLength
+ then String.concat[signString, mantissa, padZero(exp-mantLength)]
+ else if exp <= 0
+ then String.concat[signString, "0"]
+ else String.concat[signString, String.substring(mantissa, 0, exp)]
+ )
+ else if exp >= mantLength
+ then String.concat[signString, mantissa, padZero(exp-mantLength), ".", padZero ndigs]
+ else if exp <= 0
+ then String.concat[signString, "0.", padZero(~exp), mantissa,
+ padZero(ndigs-mantLength+exp)]
+ else String.concat[signString, String.substring(mantissa, 0, exp), ".",
+ String.substring(mantissa, exp, mantLength-exp), padZero(ndigs-mantLength+exp)]
+ end
+
+ (* sciFmt - always produces ndigs+1 significant digits *)
+ and sciFmt convert ndigs r =
+ case convert r of
+ RCSpecial s => s
+ | RCNormal (sign, expo, mant) =>
+ let
+ val signString = if sign then "~" else ""
+ val digits = ndigits mant
+ val (roundedMantissa, exp) =
+ if digits <= ndigs+1
+ then (* No rounding necessary *) (mant, expo-1)
+ else
+ let
+ val tens = powerTen(digits-ndigs-1)
+ val rounded = mant + tens div 2
+ (* It's possible that this could increase the number of
+ digits and hence the exponent. e.g. 9.9999 -> 10.0 *)
+ in
+ (rounded, expo + ndigits rounded - digits - 1)
+ end
+ val mantissa = LargeInt.toString roundedMantissa
+ val mantLength = String.size mantissa
+ in
+ if ndigs = 0
+ then (* No decimal point or anything after. *)
+ String.concat[signString, String.substring(mantissa, 0, 1), "E", Int.toString exp]
+ else String.concat[signString, String.substring(mantissa, 0, 1), ".",
+ String.substring(mantissa, 1, Int.min(mantLength-1, ndigs)),
+ padZero(Int.max(0, ndigs-mantLength+1)), "E", Int.toString exp]
+ end
+
+ (* General format - produces up to ndigs of output. No trailing zeros are
+ produced except for any zeros before the DP. We also produce one ".0" if
+ necessary so that the result looks like a real number rather than an int. *)
+ and genFmt convert ndigs r =
+ case convert r of
+ RCSpecial s => s
+ | RCNormal (sign, expo, mant) =>
+ let
+ val signString = if sign then "~" else ""
+ val digits = ndigits mant
+
+ val (mantissa, exp) =
+ if digits <= ndigs
+ then (* No rounding necessary *) (LargeInt.toString mant, expo-1)
+ else
+ let
+ val tens = powerTen(digits-ndigs)
+ val rounded = mant + tens div 2
+ (* It's possible that this could increase the number of
+ digits and hence the exponent. e.g. 9.9999 -> 10.0
+ We need to remove any trailing zeros produced. *)
+ val asString = LargeInt.toString rounded
+ fun stripZeros 0 = 1
+ | stripZeros n =
+ if String.sub(asString, n-1) = #"0"
+ then stripZeros(n-1) else n
+ val sLength = stripZeros ndigs
+ in
+ (String.substring(asString, 0, sLength), expo + ndigits rounded - digits - 1)
+ end
+ val mantLength = String.size mantissa (* <= ndigs *)
+ in
+ if exp > ndigs orelse exp < ~5 (* Use E format. No zero padding. *)
+ then
+ (
+ if mantLength = 1
+ then String.concat[signString, String.substring(mantissa, 0, 1), "E", Int.toString exp]
+ else String.concat[signString, String.substring(mantissa, 0, 1), ".",
+ String.substring(mantissa, 1, mantLength-1), "E", Int.toString exp]
+ )
+ else (* Fixed format *)
+ if exp >= mantLength
+ then String.concat[signString, mantissa, padZero(exp+1-mantLength), ".0"]
+ else if exp+1 <= 0
+ then String.concat[signString, "0.", padZero(~exp-1), mantissa]
+ else String.concat[signString, String.substring(mantissa, 0, exp+1), ".",
+ if mantLength = exp+1 then "0" else String.substring(mantissa, exp+1, mantLength-exp-1)]
+ end
+
+ (* Note: The definition says, reasonably, that negative values
+ for the number of digits raises Size. The tests also check
+ for a very large value for the number of digits and seem to
+ expect Size to be raised in that case. Note that the exception
+ is raised when fmt spec is evaluated and before it is applied
+ to an actual real argument. *)
+ fun fmtFunction {sciFmt, ...} (SCI NONE) = sciFmt 6
+ | fmtFunction {sciFmt, ...} (SCI (SOME d) ) =
+ if d < 0 orelse d > 200 then raise General.Size
+ else sciFmt d
+ | fmtFunction {fixFmt, ...} (FIX NONE) = fixFmt 6
+ | fmtFunction {fixFmt, ...} (FIX (SOME d) ) =
+ if d < 0 orelse d > 200 then raise General.Size
+ else fixFmt d
+ | fmtFunction {genFmt, ...}(GEN NONE) = genFmt 12
+ | fmtFunction {genFmt, ...} (GEN (SOME d) ) =
+ if d < 1 orelse d > 200 then raise General.Size
+ else genFmt d
+ | fmtFunction {exactFmt, ...} EXACT = exactFmt
+
+ end
+
+ open RealNumbersAsBits
+
+ val floatMaxFiniteExp: FixedInt.int = 254
+ and doubleMaxFiniteExp: FixedInt.int = 2046
+in
+
structure Real: REAL =
struct
open IEEEReal
val fromLargeInt: LargeInt.int -> real = Real.rtsCallFastI_R "PolyFloatArbitraryPrecision"
val fromInt: int -> real =
(* We have to select the appropriate conversion. This will be
reduced down to the appropriate function but has to be
type-correct whether int is arbitrary precision or fixed
precision. Hence the "o Large/FixedInt.fromInt". *)
if Bootstrap.intIsArbitraryPrecision
then fromLargeInt o LargeInt.fromInt
else Real.fromFixedInt o FixedInt.fromInt
(* These are needed because we don't yet have conversion from string
to real. They are filtered out by the signature. *)
val zero = fromInt 0 and one = fromInt 1 and four = fromInt 4
type real = real (* Pick up from globals. *)
structure Math: MATH =
struct
type real = real (* Pick up from globals. *)
val sqrt = Real.rtsCallFastR_R "PolyRealSqrt"
and sin = Real.rtsCallFastR_R "PolyRealSin"
and cos = Real.rtsCallFastR_R "PolyRealCos"
and atan = Real.rtsCallFastR_R "PolyRealArctan"
and exp = Real.rtsCallFastR_R "PolyRealExp"
and ln = Real.rtsCallFastR_R "PolyRealLog"
and tan = Real.rtsCallFastR_R "PolyRealTan"
and asin = Real.rtsCallFastR_R "PolyRealArcSin"
and acos = Real.rtsCallFastR_R "PolyRealArcCos"
and log10 = Real.rtsCallFastR_R "PolyRealLog10"
and sinh = Real.rtsCallFastR_R "PolyRealSinh"
and cosh = Real.rtsCallFastR_R "PolyRealCosh"
and tanh = Real.rtsCallFastR_R "PolyRealTanh"
val atan2 = Real.rtsCallFastRR_R "PolyRealAtan2"
val pow = Real.rtsCallFastRR_R "PolyRealPow"
(* Derived values. *)
val e = exp one
val pi = four * atan one
end;
-
infix 4 == != ?=;
val op == = Real.==
val op != : real * real -> bool = not o op ==
- local
- (* The General call is now only used to get constants. *)
- val doRealReal : int*unit->real = RunCall.rtsCallFull2 "PolyRealGeneral"
- and doRealInt : int*unit->int = RunCall.rtsCallFull2 "PolyRealGeneral"
- fun callReal n x = doRealReal(n, x)
- and callRealToInt n x = doRealInt(n, x)
- in
- val radix : int = callRealToInt 11 ()
- val precision : int = callRealToInt 12 ()
- val maxFinite : real = callReal 13 ()
- val minNormalPos : real = callReal 14 ()
- val minPos: real = callReal 15 ()
- end
+ val radix = 2
+ val precision = 53
+ val maxFinite = doubleFromBinary{sign=false, exp=doubleMaxFiniteExp, mantissa = 0xFFFFFFFFFFFFF}
+ val minNormalPos = doubleFromBinary{sign=false, exp=1, mantissa = 0}
+ val minPos = doubleFromBinary{sign=false, exp=0, mantissa = 1}
- val posInf : real = one/zero;
- val negInf : real = ~one/zero;
+ val posInf : real = one/zero
+ val negInf : real = ~one/zero
(* Real is LargeReal. *)
fun toLarge (x: real) : (*LargeReal.*)real =x
fun fromLarge (_ : IEEEReal.rounding_mode) (x: (*LargeReal.*)real): real = x
- local
- open Real
- in
- (* isNan can be defined in terms of unordered. *)
- fun isNan x = unordered(x, x)
-
- (* NAN values do not match and infinities when multiplied by 0 produce NAN. *)
- fun isFinite x = x * zero == zero
-
- val copySign : (real * real) -> real = Real.rtsCallFastRR_R "PolyRealCopySign"
-
- (* Get the sign bit by copying the sign onto a finite value and then
- testing. This works for non-finite values and zeros. *)
- fun signBit r = copySign(one, r) < zero
-
- (* If we assume that all functions produce normalised results where
- possible, the only subnormal values will be those smaller than
- minNormalPos. *)
- fun isNormal x = isFinite x andalso abs x >= minNormalPos
-
- fun class x =
- if isFinite x then if x == zero then ZERO
- else if abs x >= minNormalPos then NORMAL
- else SUBNORMAL
- else if isNan x then NAN
- else (* not finite and not Nan *) INF
+ (* isNan can be defined in terms of unordered. *)
+ fun isNan x = Real.unordered(x, x)
+
+ fun isFinite x = doubleExponent x <= doubleMaxFiniteExp
+
+ (* This could be implemented using signBit and doubleFromBinary *)
+ val copySign : (real * real) -> real = Real.rtsCallFastRR_R "PolyRealCopySign"
- fun sign x =
- if isNan x then raise General.Domain
- else if x == zero then 0 else if x < zero then ~1 else 1
+ val signBit = doubleSignBit
+
+ fun isNormal x =
+ let val exp = doubleExponent x in exp > 0 andalso exp <= doubleMaxFiniteExp end
+
+ fun class x =
+ let
+ val exp = doubleExponent x
+ in
+ if exp > doubleMaxFiniteExp
+ then
+ (
+ if doubleMantissa x <> 0
+ then NAN
+ else INF
+ )
+ else if exp = 0
+ then
+ (
+ if doubleMantissa x = 0
+ then ZERO
+ else SUBNORMAL
+ )
+ else NORMAL
end
-
+
+ fun sign x =
+ if isNan x then raise General.Domain
+ else if x == zero then 0 else if x < zero then ~1 else 1
+
fun sameSign (x, y) = signBit x = signBit y
(* Returns the minimum. In the case where one is a NaN it returns the
other. In that case the comparison will be false. *)
fun min (a: real, b: real): real = if a < b orelse isNan b then a else b
(* Similarly for max. *)
fun max (a: real, b: real): real = if a > b orelse isNan b then a else b
fun checkFloat x =
if isFinite x then x
else if isNan x then raise General.Div else raise General.Overflow
local
val frExp: real -> int * real = RunCall.rtsCallFull1 "PolyRealFrexp"
val fromManAndExp: real*int -> real = Real.rtsCallFastRI_R "PolyRealLdexp"
open Real
in
fun toManExp r =
if not (isFinite r) orelse r == zero
(* Nan, infinities and +/-0 all return r in the mantissa.
We include 0 to preserve its sign. *)
then {man=r, exp=0}
else
let
val (exp, man) = frExp r
in
{man=man, exp=exp}
end
fun fromManExp {man, exp} =
if not (isFinite man) orelse man == zero
(* Nan, infinities and +/-0 in the mantissa all return
their argument. *)
then man
else if LibrarySupport.isShortInt exp
then fromManAndExp(man, exp)
else (* Long arbitrary precision *)
copySign(if Int.>(exp, 0) then posInf else zero, man)
end
(* Convert to integer. *)
local
(* The RTS function converts to at most a 64-bit value (even on
32-bits). That will convert all the bits of the mantissa
but if the exponent is large we may have to multiply by
some power of two. *)
val realToInt: real -> LargeInt.int = RunCall.rtsCallFull1 "PolyRealBoxedToLongInt"
(* These are defined to raise Domain rather than Overflow on Nans. *)
fun checkNan x = if isNan x then raise Domain else x
in
val realFloor = Real.rtsCallFastR_R "PolyRealFloor"
and realCeil = Real.rtsCallFastR_R "PolyRealCeil"
and realTrunc = Real.rtsCallFastR_R "PolyRealTrunc"
and realRound = Real.rtsCallFastR_R "PolyRealRound"
fun toArbitrary x =
if isNan x then raise General.Domain
else if not (isFinite x) then raise General.Overflow
else
let
val { man, exp } = toManExp x
in
if exp <= precision
then realToInt x
else IntInf.<< (realToInt(fromManExp{man=man, exp=precision}), Word.fromInt(exp - precision))
end
fun toLargeInt IEEEReal.TO_NEGINF = toArbitrary o realFloor
| toLargeInt IEEEReal.TO_POSINF = toArbitrary o realCeil
| toLargeInt IEEEReal.TO_ZERO = toArbitrary o realTrunc
| toLargeInt IEEEReal.TO_NEAREST = toArbitrary o realRound
(* Conversions to FixedInt are put in by the compiler. If int is fixed we can
use them otherwise we use the long versions.
N.B. FixedInt.toInt is a no-op but is needed so this is type-correct when
int is arbitrary. *)
val floor =
if Bootstrap.intIsArbitraryPrecision
then LargeInt.toInt o toArbitrary o realFloor else FixedInt.toInt o Real.floorFix o checkNan
and ceil =
if Bootstrap.intIsArbitraryPrecision
then LargeInt.toInt o toArbitrary o realCeil else FixedInt.toInt o Real.ceilFix o checkNan
and trunc =
if Bootstrap.intIsArbitraryPrecision
then LargeInt.toInt o toArbitrary o realTrunc else FixedInt.toInt o Real.truncFix o checkNan
and round =
if Bootstrap.intIsArbitraryPrecision
then LargeInt.toInt o toArbitrary o realRound else FixedInt.toInt o Real.roundFix o checkNan
fun toInt IEEEReal.TO_NEGINF = floor
| toInt IEEEReal.TO_POSINF = ceil
| toInt IEEEReal.TO_ZERO = trunc
| toInt IEEEReal.TO_NEAREST = round
end;
local
val realConv: string->real = RunCall.rtsCallFull1 "PolyRealBoxedFromString"
val posNan = abs(zero / zero)
val negNan = ~posNan
in
fun fromDecimal { class = INF, sign=true, ...} = SOME negInf
| fromDecimal { class = INF, sign=false, ...} = SOME posInf
| fromDecimal { class = ZERO, sign=true, ...} = SOME (~ zero)
| fromDecimal { class = ZERO, sign=false, ...} = SOME zero
(* Generate signed Nans ignoring the digits and mantissa. There
was code here to set the mantissa but there's no reference to
that in the current version of the Basis library. *)
| fromDecimal { class = NAN, sign=true, ... } = SOME negNan
| fromDecimal { class = NAN, sign=false, ... } = SOME posNan
| fromDecimal { class = _ (* NORMAL or SUBNORMAL *), sign, digits, exp} =
(let
fun toChar x =
if x < 0 orelse x > 9 then raise General.Domain
else Char.chr (x + Char.ord #"0")
(* Turn the number into a string. *)
val str = "0." ^ String.implode(List.map toChar digits) ^"E" ^
Int.toString exp
(* Convert it to a real using the RTS conversion function.
Change any Conversion exceptions into Domain. *)
val result = realConv str handle RunCall.Conversion _ => raise General.Domain
in
if sign then SOME (~result) else SOME result
end
handle General.Domain => NONE
)
end
local
- val dtoa: real*int*int -> string*int*int = RunCall.rtsCallFull3 "PolyRealBoxedToString"
- open StringCvt
-
- fun addZeros n =
- if n <= 0 then "" else "0" ^ addZeros (n-1)
-
- fun fixFmt ndigs r =
- if isNan r then "nan"
- else if not (isFinite r)
- then if r < zero then "~inf" else "inf"
- else
+ fun realToDecimal r =
let
- (* Try to get ndigs past the decimal point. *)
- val (str, exp, sign) = dtoa(r, 3, ndigs)
- val strLen = String.size str
- (* If the exponents is negative or zero we need to put a zero
- before the decimal point. If the exponent is positive and
- less than the number of digits we can take that
- many characters off, otherwise we have to pad with zeros. *)
- val numb =
- if exp <= 0
- then (* Exponent is zero or negative - all significant digits are
- after the decimal point. Put in any zeros before
- the significant digits, then the significant digits
- and then any trailing zeros. *)
- if ndigs = 0 then "0"
- else "0." ^ addZeros(~exp) ^ str ^ addZeros(ndigs-strLen+exp)
- else if strLen <= exp
- then (* Exponent is not less than the length of the string -
- all significant digits are before the decimal point. Add
- any extra zeros before the decimal point then zeros after it. *)
- str ^ addZeros(exp-strLen) ^
- (if ndigs = 0 then "" else "." ^ addZeros ndigs)
- else (* Significant digits straddle the decimal point - insert the
- decimal point and add any trailing zeros. *)
- String.substring(str, 0, exp) ^ "." ^
- String.substring(str, exp, strLen-exp) ^
- addZeros(ndigs-strLen+exp)
+ val {sign, exponent, mantissa} = RealToDecimalConversion.d2decimal r
in
- if sign <> 0 then "~" ^ numb else numb
- end
-
- fun sciFmt ndigs r =
- if isNan r then "nan"
- else if not (isFinite r)
- then if r < zero then "~inf" else "inf"
- else
- let
- (* Try to get ndigs+1 digits. 1 before the decimal point and ndigs after. *)
- val (str, exp, sign) = dtoa(r, 2, ndigs+1)
- val strLen = String.size str
- fun addZeros n =
- if n <= 0 then "" else "0" ^ addZeros (n-1)
- val numb =
- if strLen = 0
- then "0" ^ (if ndigs = 0 then "" else "." ^ addZeros ndigs) ^ "E0"
- else
- (if strLen = 1
- then str ^ (if ndigs = 0 then "" else "." ^ addZeros ndigs)
- else String.substring(str, 0, 1) ^ "." ^
- String.substring(str, 1, strLen-1) ^ addZeros (ndigs-strLen+1)
- ) ^ "E" ^ Int.toString (exp-1)
- in
- if sign <> 0 then "~" ^ numb else numb
- end
-
- fun genFmt ndigs r =
- if isNan r then "nan"
- else if not (isFinite r)
- then if r < zero then "~inf" else "inf"
- else
- let
- (* Try to get ndigs digits. *)
- val (str, exp, sign) = dtoa(r, 2, ndigs)
- val strLen = String.size str
- val numb =
- (* Have to use scientific notation if exp > ndigs. Also use it
- if the exponent is small (TODO: adjust this) *)
- if exp > ndigs orelse exp < ~5
- then (* Scientific format *)
- (if strLen = 1 then str
- else String.substring(str, 0, 1) ^ "." ^
- String.substring(str, 1, strLen-1)
- ) ^ "E" ^ Int.toString (exp-1)
-
- else (* Fixed format (N.B. no trailing zeros are added after the
- decimal point apart from one if necessary) *)
- if exp <= 0
- then (* Exponent is zero or negative - all significant digits are
- after the decimal point. Put in any zeros before
- the significant digits, then the significant digits
- and then any trailing zeros. *)
- "0." ^ addZeros(~exp) ^ str
- else if strLen <= exp
- then (* Exponent is not less than the length of the string -
- all significant digits are before the decimal point. Add
- any extra zeros before the decimal point. Insert .0 at the
- end to make it a valid real number. *)
- str ^ addZeros(exp-strLen) ^ ".0"
- else (* Significant digits straddle the decimal point - insert the
- decimal point. *)
- String.substring(str, 0, exp) ^ "." ^
- String.substring(str, exp, strLen-exp)
- in
- if sign <> 0 then "~" ^ numb else numb
+ (sign, exponent + ndigits mantissa, mantissa)
end
- fun strToDigitList str =
- let
- fun getDigs i l =
- if i < 0 then l
- else getDigs (i-1)
- ((Char.ord(String.sub(str, i)) - Char.ord #"0") :: l)
- in
- getDigs (String.size str - 1) []
- end
+ (* We need to treat "nan" specially because IEEEReal.toString
+ is defined to return ~nan for negative nans whereas Real.fmt is defined always
+ to return "nan". This looks like an inconsistency in the definition but we follow
+ it. *)
+ fun realToRealConvert r =
+ if isNan r then RCSpecial "nan"
+ else if not (isFinite r) then if signBit r then RCSpecial "~inf" else RCSpecial "inf"
+ else RCNormal(realToDecimal r)
in
fun toDecimal r =
let
val sign = signBit r
val kind = class r
in
case kind of
ZERO => { class = ZERO, sign = sign, digits=[], exp = 0 }
| INF => { class = INF, sign = sign, digits=[], exp = 0 }
| NAN => { class = NAN, sign = sign, digits=[], exp = 0 }
| _ => (* NORMAL/SUBNORMAL *)
- let
- val (str, exp, sign) = dtoa(r, 0, 0)
- val digits = strToDigitList str
- in
- { class = kind, sign = sign <> 0, digits = digits, exp = exp }
- end
+ let
+ val (sign, exponent, mantissa) = realToDecimal r
+ in
+ { class = kind, sign = sign, exp = exponent, digits = digitList(mantissa, []) }
+ end
end
- (* Note: The definition says, reasonably, that negative values
- for the number of digits raises Size. The tests also check
- for a very large value for the number of digits and seem to
- expect Size to be raised in that case. Note that the exception
- is raised when fmt spec is evaluated and before it is applied
- to an actual real argument.
- In all cases, even EXACT format, this should produce "nan" for a NaN
- and ignore the sign bit. *)
- fun fmt (SCI NONE) = sciFmt 6
- | fmt (SCI (SOME d) ) =
- if d < 0 orelse d > 200 then raise General.Size
- else sciFmt d
- | fmt (FIX NONE) = fixFmt 6
- | fmt (FIX (SOME d) ) =
- if d < 0 orelse d > 200 then raise General.Size
- else fixFmt d
- | fmt (GEN NONE) = genFmt 12
- | fmt (GEN (SOME d) ) =
- if d < 1 orelse d > 200 then raise General.Size
- else genFmt d
- | fmt EXACT = (fn r => if isNan r then "nan" else IEEEReal.toString(toDecimal r))
-
- val toString = fmt (GEN NONE)
+ val fmt = fmtFunction { sciFmt=sciFmt realToRealConvert, fixFmt=fixFmt realToRealConvert,
+ genFmt=genFmt realToRealConvert, exactFmt=exactFmt realToRealConvert }
+ val toString = fmt (StringCvt.GEN NONE)
end
fun scan getc src =
let
(* Return a list of digits. *)
fun getdigits inp src =
case getc src of
NONE => (List.rev inp, src)
| SOME(ch, src') =>
if ch >= #"0" andalso ch <= #"9"
then getdigits ((Char.ord ch - Char.ord #"0") :: inp) src'
else (List.rev inp, src)
(* Read an unsigned integer. Returns NONE if no digits have been read. *)
fun getNumber sign digits acc src =
case getc src of
NONE => if digits = 0 then NONE else SOME(if sign then ~acc else acc, src)
| SOME(ch, src') =>
if ch >= #"0" andalso ch <= #"9"
then getNumber sign (digits+1) (acc*10 + Char.ord ch - Char.ord #"0") src'
else if digits = 0 then NONE else SOME(if sign then ~acc else acc, src')
(* Return the signed exponent. *)
fun getExponent src =
case getc src of
NONE => NONE
| SOME(ch, src') =>
if ch = #"+"
then getNumber false 0 0 src'
else if ch = #"-" orelse ch = #"~"
then getNumber true 0 0 src'
else getNumber false 0 0 src
fun read_number sign src =
case getc src of
NONE => NONE
| SOME(ch, _) =>
if not (ch >= #"0" andalso ch <= #"9" orelse ch = #".")
then NONE (* Bad *)
else (* Digits or decimal. *)
let
(* Get the digits before the decimal point (if any) *)
val (intPart, srcAfterDigs) = getdigits [] src
(* Get the digits after the decimal point (if any).
If there is a decimal point we only accept it if
there is at least one digit after it. *)
val (decimals, srcAfterMant) =
case getc srcAfterDigs of
NONE => ([], srcAfterDigs)
| SOME (#".", srcAfterDP) =>
( (* Check that the next character is a digit. *)
case getc srcAfterDP of
NONE => ([], srcAfterDigs)
| SOME(ch, _) =>
if ch >= #"0" andalso ch <= #"9"
then getdigits [] srcAfterDP
else ([], srcAfterDigs)
)
| SOME (_, _) => ([], srcAfterDigs)
(* The exponent is optional. If it doesn't form a valid
exponent we return zero as the value and the
continuation is the beginning of the "exponent". *)
val (exponent, srcAfterExp) =
case getc srcAfterMant of
NONE => (0, srcAfterMant)
| SOME (ch, src'''') =>
if ch = #"e" orelse ch = #"E"
then
(
case getExponent src'''' of
NONE => (0, srcAfterMant)
| SOME x => x
)
else (0, srcAfterMant)
(* Generate a decimal representation ready for conversion.
We don't bother to strip off leading or trailing zeros. *)
val decimalRep = {class=NORMAL, sign=sign,
digits=List.@(intPart, decimals),
exp=exponent + List.length intPart}
in
case fromDecimal decimalRep of
SOME r => SOME(r, srcAfterExp)
| NONE => NONE
end
in
case getc src of
NONE => NONE
| SOME(ch, src') =>
if Char.isSpace ch (* Skip white space. *)
then scan getc src' (* Recurse *)
else if ch = #"+" (* Remove the + sign *)
then read_number false src'
else if ch = #"-" orelse ch = #"~"
then read_number true src'
else (* See if it's a valid digit. *)
read_number false src
end
val fromString = StringCvt.scanString scan
(* Converter to real values. This replaces the basic conversion
function for reals installed in the bootstrap process.
For more information see convInt in Int. *)
local
fun convReal (s: string) : real =
let
(* Set the rounding mode to TO_NEAREST whatever the current
rounding mode. Otherwise the result of compiling a piece of
code with a literal constant could depend on what the rounding
mode was set to.
We should always support TO_NEAREST. *)
val oldRounding = IEEEReal.getRoundingMode()
val () = IEEEReal.setRoundingMode IEEEReal.TO_NEAREST
val scanResult = StringCvt.scanString scan s
val () = IEEEReal.setRoundingMode oldRounding
in
case scanResult of
NONE => raise RunCall.Conversion "Invalid real constant"
| SOME res => res
end
in
(* Install this as a conversion function for real literals. *)
val (): unit = RunCall.addOverload convReal "convReal"
end
open Real (* Get the other definitions. *)
fun compare (r1, r2) =
if r1 == r2 then General.EQUAL
else if r1 < r2 then General.LESS
else if r1 > r2 then General.GREATER
else raise Unordered
fun compareReal (r1, r2) =
if r1 == r2 then EQUAL
else if r1 < r2 then LESS
else if r1 > r2 then GREATER
else UNORDERED
(* This seems to be similar to == except that where == always returns false
if either argument is a NaN this returns true. The implementation of ==
treats the unordered case specially so it would be possible to implement
this in the same way. *)
fun op ?= (x, y) = unordered(x, y) orelse x == y
(* Although these may be built in in some architectures it's
probably not worth treating them specially at the moment. *)
fun *+ (x: real, y: real, z: real): real = x*y+z
and *- (x: real, y: real, z: real): real = x*y-z
val rem = Real.rtsCallFastRR_R "PolyRealRem"
(* Split a real into whole and fractional parts. The fractional part must have
the same sign as the number even if it is zero. *)
fun split r =
let
val whole = realTrunc r
val frac = r - whole
in
{ whole = whole,
frac =
if not (isFinite r)
then if isNan r then r else (* Infinity *) if r < zero then ~zero else zero
else if frac == zero then if signBit r then ~zero else zero
else frac }
end
(* Get the fractional part of a real. *)
fun realMod r = #frac(split r)
(* nextAfter: This was previously implemented in ML but, at the very least,
needed to work with rounding to something other than TO_NEAREST. *)
val nextAfter = Real.rtsCallFastRR_R "PolyRealNextAfter"
+end (* Real *)
+
+
+structure Real32: REAL where type real = Real32.real =
+(* Real32 uses some definitions from the Real structure above. *)
+struct
+ open IEEEReal
+
+ (* On both the X86 and ARM there is only a single conversion from
+ double to float using the current rounding mode. If we want
+ a specific rounding mode we need to set the rounding. *)
+ fun fromLarge mode value =
+ let
+ val current = getRoundingMode()
+ val () = setRoundingMode mode
+ val result = Real32.fromReal value
+ val () = setRoundingMode current
+ in
+ result
+ end
+
+ val fromRealRound = fromLarge TO_NEAREST
+
+ (* Defined to use the current rounding mode. *)
+ val fromLargeInt = Real32.fromReal o Real.fromLargeInt
+
+ val fromInt: int -> Real32.real =
+ (* We have to select the appropriate conversion. This will be
+ reduced down to the appropriate function but has to be
+ type-correct whether int is arbitrary precision or fixed
+ precision. Hence the "o Large/FixedInt.fromInt". *)
+ if Bootstrap.intIsArbitraryPrecision
+ then fromLargeInt o LargeInt.fromInt
+ else Real32.fromFixedInt o FixedInt.fromInt
+
+ val zero = fromInt 0 and one = fromInt 1 and four = fromInt 4
+
+ val radix = 2
+ val precision = 24
+ val maxFinite = floatFromBinary{sign=false, exp=floatMaxFiniteExp, mantissa = 0x7FFFFF}
+ val minNormalPos = floatFromBinary{sign=false, exp=1, mantissa = 0}
+ val minPos = floatFromBinary{sign=false, exp=0, mantissa = 1}
+
+ local
+ open Real32
+ in
+ val posInf : real = one/zero
+ val negInf : real = ~one/zero
+
+ val op != : real * real -> bool = not o op ==
+ end
+
+ infix 4 == != ?=;
+
+ (* isNan can be defined in terms of unordered. *)
+ fun isNan x = Real32.unordered(x, x)
+
+ fun isFinite x = floatExponent x <= floatMaxFiniteExp
+
+ local
+ open Real32
+ in
+ val copySign : (real * real) -> real = rtsCallFastFF_F "PolyRealFCopySign"
+ end
+
+ val signBit = floatSignBit
+
+ fun isNormal x =
+ let val exp = floatExponent x in exp > 0 andalso exp <= floatMaxFiniteExp end
+
+ fun class x =
+ let
+ val exp = floatExponent x
+ in
+ if exp > floatMaxFiniteExp
+ then
+ (
+ if floatMantissa x <> 0
+ then NAN
+ else INF
+ )
+ else if exp = 0
+ then
+ (
+ if floatMantissa x = 0
+ then ZERO
+ else SUBNORMAL
+ )
+ else NORMAL
+ end
+
+ local
+ open Real32
+ in
+ fun sign x =
+ if isNan x then raise General.Domain
+ else if x == zero then 0 else if x < zero then ~1 else 1
+ end
+
+ fun sameSign (x, y) = signBit x = signBit y
+
+ local
+ open Real32
+ in
+ (* Returns the minimum. In the case where one is a NaN it returns the
+ other. In that case the comparison will be false. *)
+ fun min (a: real, b: real): real = if a < b orelse isNan b then a else b
+ (* Similarly for max. *)
+ fun max (a: real, b: real): real = if a > b orelse isNan b then a else b
+
+ fun checkFloat x =
+ if isFinite x then x
+ else if isNan x then raise General.Div else raise General.Overflow
+
+ (* On certain platforms e.g. mips, toLarge does not preserve
+ the sign on nans. We deal with the non-finite cases here. *)
+
+ (* Use the Real versions for the moment. *)
+ fun toManExp r =
+ if not (isFinite r) orelse r == zero
+ (* Nan, infinities and +/-0 all return r in the mantissa.
+ We include 0 to preserve its sign. *)
+ then {man=r, exp=0}
+ else
+ let
+ val {man, exp} = Real.toManExp(toLarge r)
+ in
+ {man = fromRealRound man, exp = exp }
+ end
+
+ and fromManExp {man, exp} =
+ if not (isFinite man) orelse man == zero
+ (* Nan, infinities and +/-0 in the mantissa all return
+ their argument. *)
+ then man
+ else fromRealRound(Real.fromManExp{man=toLarge man, exp=exp})
+
+ fun compare (r1, r2) =
+ if r1 == r2 then General.EQUAL
+ else if r1 < r2 then General.LESS
+ else if r1 > r2 then General.GREATER
+ else raise Unordered
+
+ fun compareReal (r1, r2) =
+ if r1 == r2 then EQUAL
+ else if r1 < r2 then LESS
+ else if r1 > r2 then GREATER
+ else UNORDERED
+
+ fun op ?= (x, y) = unordered(x, y) orelse x == y
+
+ (* Although these may be built in in some architectures it's
+ probably not worth treating them specially at the moment. *)
+ fun *+ (x: real, y: real, z: real): real = x*y+z
+ and *- (x: real, y: real, z: real): real = x*y-z
+
+ val realFloor = rtsCallFastF_F "PolyRealFFloor"
+ and realCeil = rtsCallFastF_F "PolyRealFCeil"
+ and realTrunc = rtsCallFastF_F "PolyRealFTrunc"
+ and realRound = rtsCallFastF_F "PolyRealFRound"
+
+ val rem = rtsCallFastFF_F "PolyRealFRem"
+
+ (* Split a real into whole and fractional parts. The fractional part must have
+ the same sign as the number even if it is zero. *)
+ fun split r =
+ let
+ val whole = realTrunc r
+ val frac = r - whole
+ in
+ { whole = whole,
+ frac =
+ if not (isFinite r)
+ then if isNan r then r else (* Infinity *) if r < zero then ~zero else zero
+ else if frac == zero then if signBit r then ~zero else zero
+ else frac }
+ end
+
+ (* Get the fractional part of a real. *)
+ fun realMod r = #frac(split r)
+
+ val nextAfter = rtsCallFastFF_F "PolyRealFNextAfter"
+
+ fun toLargeInt mode r = Real.toLargeInt mode (toLarge r)
+ end
+
+ local
+ open Real32
+ (* These are defined to raise Domain rather than Overflow on Nans. *)
+ fun checkNan x = if isNan x then raise Domain else x
+ (* If int is fixed we use the hardware conversions otherwise we convert
+ it to real and use the real to arbitrary conversions. *)
+ in
+ val floor =
+ if Bootstrap.intIsArbitraryPrecision
+ then LargeInt.toInt o toLargeInt IEEEReal.TO_NEGINF else FixedInt.toInt o floorFix o checkNan
+ and ceil =
+ if Bootstrap.intIsArbitraryPrecision
+ then LargeInt.toInt o toLargeInt IEEEReal.TO_POSINF else FixedInt.toInt o ceilFix o checkNan
+ and trunc =
+ if Bootstrap.intIsArbitraryPrecision
+ then LargeInt.toInt o toLargeInt IEEEReal.TO_ZERO else FixedInt.toInt o truncFix o checkNan
+ and round =
+ if Bootstrap.intIsArbitraryPrecision
+ then LargeInt.toInt o toLargeInt IEEEReal.TO_NEAREST else FixedInt.toInt o roundFix o checkNan
+
+ fun toInt IEEEReal.TO_NEGINF = floor
+ | toInt IEEEReal.TO_POSINF = ceil
+ | toInt IEEEReal.TO_ZERO = trunc
+ | toInt IEEEReal.TO_NEAREST = round
+ end
+
+ (* Scan input source for a valid number. The format is the same as
+ for double precision. Convert it using the current rounding mode. *)
+ fun scan getc src =
+ case Real.scan getc src of
+ NONE => NONE
+ | SOME (r, a) => SOME(Real32.fromReal r, a)
+
+ val fromString = StringCvt.scanString scan
+
+ (* toDecimal: This is defined to return the shortest sequence so converting
+ it to double and then using Real.toDecimal gives the wrong result.
+ This now uses Ryu code specifically for 32-bit floats. *)
+ local
+ fun floatToDecimal r =
+ let
+ val {sign, exponent, mantissa} = RealToDecimalConversion.f2decimal r
+ val mantAsLarge = LargeInt.fromInt mantissa
+ in
+ (sign, exponent + ndigits mantAsLarge, mantAsLarge)
+ end
+
+ fun floatToRealConvert r =
+ if isNan r then RCSpecial "nan"
+ else if not (isFinite r) then if signBit r then RCSpecial "~inf" else RCSpecial "inf"
+ else RCNormal(floatToDecimal r)
+ in
+ fun toDecimal r =
+ case class r of
+ ZERO => { class = ZERO, sign = signBit r, digits=[], exp = 0 }
+ | INF => { class = INF, sign = signBit r, digits=[], exp = 0 }
+ | NAN => { class = NAN, sign = signBit r, digits=[], exp = 0 }
+ | kind =>
+ let
+ val (sign, exponent, mantissa) = floatToDecimal r
+ in
+ { class = kind, sign = sign, exp = exponent, digits = digitList(mantissa, []) }
+ end
+
+ val fmt = fmtFunction { sciFmt=sciFmt floatToRealConvert, fixFmt=fixFmt floatToRealConvert,
+ genFmt=genFmt floatToRealConvert, exactFmt=exactFmt floatToRealConvert }
+ end
+
+ val toString = fmt (StringCvt.GEN NONE)
+
+ open Real32 (* Inherit the type and the built-in functions. *)
+
+ (* Convert from decimal. This is defined to use TO_NEAREST.
+ We need to handle NaNs specially because fromRealRound loses
+ the sign on a NaN. *)
+ local
+ val posNan = abs(zero / zero)
+ val negNan = ~posNan
+ in
+ fun fromDecimal { class = INF, sign=true, ...} = SOME negInf
+ | fromDecimal { class = INF, sign=false, ...} = SOME posInf
+ | fromDecimal { class = NAN, sign=true, ... } = SOME negNan
+ | fromDecimal { class = NAN, sign=false, ... } = SOME posNan
+ | fromDecimal arg = Option.map fromRealRound (Real.fromDecimal arg)
+ end
+
+ structure Math =
+ struct
+ type real = real
+
+ val sqrt = rtsCallFastF_F "PolyRealFSqrt"
+ and sin = rtsCallFastF_F "PolyRealFSin"
+ and cos = rtsCallFastF_F "PolyRealFCos"
+ and atan = rtsCallFastF_F "PolyRealFArctan"
+ and exp = rtsCallFastF_F "PolyRealFExp"
+ and ln = rtsCallFastF_F "PolyRealFLog"
+ and tan = rtsCallFastF_F "PolyRealFTan"
+ and asin = rtsCallFastF_F "PolyRealFArcSin"
+ and acos = rtsCallFastF_F "PolyRealFArcCos"
+ and log10 = rtsCallFastF_F "PolyRealFLog10"
+ and sinh = rtsCallFastF_F "PolyRealFSinh"
+ and cosh = rtsCallFastF_F "PolyRealFCosh"
+ and tanh = rtsCallFastF_F "PolyRealFTanh"
+
+ val atan2 = rtsCallFastFF_F "PolyRealFAtan2"
+ val pow = rtsCallFastFF_F "PolyRealFPow"
+
+ (* Derived values. *)
+ val e = exp one
+ val pi = four * atan one
+ end
+
+
+ (* Converter for literal constants. Copied from Real. *)
+ local
+ fun convReal (s: string) : real =
+ let
+ (* Set the rounding mode to TO_NEAREST whatever the current
+ rounding mode. Otherwise the result of compiling a piece of
+ code with a literal constant could depend on what the rounding
+ mode was set to. We should always support TO_NEAREST. *)
+ val oldRounding = IEEEReal.getRoundingMode()
+ val () = IEEEReal.setRoundingMode IEEEReal.TO_NEAREST
+ val scanResult = StringCvt.scanString scan s
+ val () = IEEEReal.setRoundingMode oldRounding
+ in
+ case scanResult of
+ NONE => raise RunCall.Conversion "Invalid real constant"
+ | SOME res => res
+ end
+ in
+ (* Install this as a conversion function for real literals. *)
+ val (): unit = RunCall.addOverload convReal "convReal"
+ end
+
+end (* Real32 *)
+
end;
structure Math = Real.Math;
structure LargeReal: REAL = Real;
(* Values available unqualified at the top-level. *)
val real : int -> real = Real.fromInt
val trunc : real -> int = Real.trunc
val floor : real -> int = Real.floor
val ceil : real -> int = Real.ceil
val round : real -> int =Real.round;
-(* Install print function. *)
+(* Overloads for Real32.real. The overloads for real were added in InitialBasis. *)
+val () = RunCall.addOverload Real32.>= ">="
+and () = RunCall.addOverload Real32.<= "<="
+and () = RunCall.addOverload Real32.> ">"
+and () = RunCall.addOverload Real32.< "<"
+and () = RunCall.addOverload Real32.+ "+"
+and () = RunCall.addOverload Real32.- "-"
+and () = RunCall.addOverload Real32.* "*"
+and () = RunCall.addOverload Real32.~ "~"
+and () = RunCall.addOverload Real32.abs "abs"
+and () = RunCall.addOverload Real32./ "/";
+
+
+(* Install print functions. *)
+local
+ fun print_real32 _ _ (r: Real32.real) =
+ PolyML.PrettyString(Real32.fmt (StringCvt.GEN(SOME 7)) r)
+in
+ val () = PolyML.addPrettyPrinter print_real32
+end;
local
fun print_real _ _ (r: real) =
PolyML.PrettyString(Real.fmt (StringCvt.GEN(SOME 10)) r)
in
val () = PolyML.addPrettyPrinter print_real;
end;
diff --git a/basis/Real32.sml b/basis/Real32.sml
deleted file mode 100644
index d3beba7a..00000000
--- a/basis/Real32.sml
+++ /dev/null
@@ -1,336 +0,0 @@
-(*
- Title: Real32 structure.
- Author: David Matthews
- Copyright David Matthews 2018, 2021
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License version 2.1 as published by the Free Software Foundation.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-*)
-
-(*
- This structure implements 32-bit real values, at least on X86. On other
- platforms it is whatever "float" is.
- N.B. This uses the X87 floating point instructions on X86/32. The precision
- on the X87 is set to 64-bits which is correct for the Real.real operations
- but involves an extra stage of rounding for Real32.real. That means that
- the results may not be strictly accurate.
-*)
-
-structure Real32: REAL where type real = Real32.real =
-struct
- open Real32 (* Inherit the type and the built-in functions. *)
- open IEEEReal
-
- (* On both the X86 and ARM there is only a single conversion from
- double to float using the current rounding mode. If we want
- a specific rounding mode we need to set the rounding. *)
- fun fromLarge mode value =
- let
- val current = getRoundingMode()
- val () = setRoundingMode mode
- val result = fromReal value
- val () = setRoundingMode current
- in
- result
- end
-
- val fromRealRound = fromLarge TO_NEAREST
-
- (* Defined to use the current rounding mode. *)
- val fromLargeInt = fromReal o Real.fromLargeInt
-
- val fromInt: int -> real =
- (* We have to select the appropriate conversion. This will be
- reduced down to the appropriate function but has to be
- type-correct whether int is arbitrary precision or fixed
- precision. Hence the "o Large/FixedInt.fromInt". *)
- if Bootstrap.intIsArbitraryPrecision
- then fromLargeInt o LargeInt.fromInt
- else fromFixedInt o FixedInt.fromInt
-
- val zero = fromInt 0 and one = fromInt 1 and four = fromInt 4
-
- local
- (* The General call is now only used to get constants. *)
- val doFloatFloat : int*unit->real = RunCall.rtsCallFull2 "PolyRealGeneral"
- and doFloatInt : int*unit->int = RunCall.rtsCallFull2 "PolyRealGeneral"
- fun callFloat n x = doFloatFloat(n, x)
- and callFloatToInt n x = doFloatInt(n, x)
- in
- val radix : int = callFloatToInt 30 ()
- val precision : int = callFloatToInt 31 ()
- val maxFinite : real = callFloat 32 ()
- val minNormalPos : real = callFloat 33 ()
- val minPos : real = callFloat 34()
- end
-
- val posInf : real = one/zero;
- val negInf : real = ~one/zero;
-
- infix 4 == != ?=;
-
- val op != : real * real -> bool = not o op ==
-
- local
- in
- (* isNan can be defined in terms of unordered. *)
- fun isNan x = unordered(x, x)
-
- (* NAN values do not match and infinities when multiplied by 0 produce NAN. *)
- fun isFinite x = x * zero == zero
-
- val copySign : (real * real) -> real = rtsCallFastFF_F "PolyRealFCopySign"
-
- (* Get the sign bit by copying the sign onto a finite value and then
- testing. This works for non-finite values and zeros. *)
- fun signBit r = copySign(one, r) < zero
-
- (* If we assume that all functions produce normalised results where
- possible, the only subnormal values will be those smaller than
- minNormalPos. *)
- fun isNormal x = isFinite x andalso abs x >= minNormalPos
-
- fun class x =
- if isFinite x then if x == zero then ZERO
- else if abs x >= minNormalPos then NORMAL
- else SUBNORMAL
- else if isNan x then NAN
- else (* not finite and not Nan *) INF
-
- fun sign x =
- if isNan x then raise General.Domain
- else if x == zero then 0 else if x < zero then ~1 else 1
- end
-
- fun sameSign (x, y) = signBit x = signBit y
-
- (* Returns the minimum. In the case where one is a NaN it returns the
- other. In that case the comparison will be false. *)
- fun min (a: real, b: real): real = if a < b orelse isNan b then a else b
- (* Similarly for max. *)
- fun max (a: real, b: real): real = if a > b orelse isNan b then a else b
-
- fun checkFloat x =
- if isFinite x then x
- else if isNan x then raise General.Div else raise General.Overflow
-
- (* On certain platforms e.g. mips, toLarge does not preserve
- the sign on nans. We deal with the non-finite cases here. *)
-
- (* Use the Real versions for the moment. *)
- fun toManExp r =
- if not (isFinite r) orelse r == zero
- (* Nan, infinities and +/-0 all return r in the mantissa.
- We include 0 to preserve its sign. *)
- then {man=r, exp=0}
- else
- let
- val {man, exp} = Real.toManExp(toLarge r)
- in
- {man = fromRealRound man, exp = exp }
- end
-
- and fromManExp {man, exp} =
- if not (isFinite man) orelse man == zero
- (* Nan, infinities and +/-0 in the mantissa all return
- their argument. *)
- then man
- else fromRealRound(Real.fromManExp{man=toLarge man, exp=exp})
-
- fun compare (r1, r2) =
- if r1 == r2 then General.EQUAL
- else if r1 < r2 then General.LESS
- else if r1 > r2 then General.GREATER
- else raise Unordered
-
- fun compareReal (r1, r2) =
- if r1 == r2 then EQUAL
- else if r1 < r2 then LESS
- else if r1 > r2 then GREATER
- else UNORDERED
-
- fun op ?= (x, y) = unordered(x, y) orelse x == y
-
- (* Although these may be built in in some architectures it's
- probably not worth treating them specially at the moment. *)
- fun *+ (x: real, y: real, z: real): real = x*y+z
- and *- (x: real, y: real, z: real): real = x*y-z
-
- val realFloor = rtsCallFastF_F "PolyRealFFloor"
- and realCeil = rtsCallFastF_F "PolyRealFCeil"
- and realTrunc = rtsCallFastF_F "PolyRealFTrunc"
- and realRound = rtsCallFastF_F "PolyRealFRound"
-
- val rem = rtsCallFastFF_F "PolyRealFRem"
-
- (* Split a real into whole and fractional parts. The fractional part must have
- the same sign as the number even if it is zero. *)
- fun split r =
- let
- val whole = realTrunc r
- val frac = r - whole
- in
- { whole = whole,
- frac =
- if not (isFinite r)
- then if isNan r then r else (* Infinity *) if r < zero then ~zero else zero
- else if frac == zero then if signBit r then ~zero else zero
- else frac }
- end
-
- (* Get the fractional part of a real. *)
- fun realMod r = #frac(split r)
-
- val nextAfter = rtsCallFastFF_F "PolyRealFNextAfter"
-
- fun toLargeInt mode r = Real.toLargeInt mode (toLarge r)
-
- local
- (* These are defined to raise Domain rather than Overflow on Nans. *)
- fun checkNan x = if isNan x then raise Domain else x
- (* If int is fixed we use the hardware conversions otherwise we convert
- it to real and use the real to arbitrary conversions. *)
- in
- val floor =
- if Bootstrap.intIsArbitraryPrecision
- then LargeInt.toInt o toLargeInt IEEEReal.TO_NEGINF else FixedInt.toInt o floorFix o checkNan
- and ceil =
- if Bootstrap.intIsArbitraryPrecision
- then LargeInt.toInt o toLargeInt IEEEReal.TO_POSINF else FixedInt.toInt o ceilFix o checkNan
- and trunc =
- if Bootstrap.intIsArbitraryPrecision
- then LargeInt.toInt o toLargeInt IEEEReal.TO_ZERO else FixedInt.toInt o truncFix o checkNan
- and round =
- if Bootstrap.intIsArbitraryPrecision
- then LargeInt.toInt o toLargeInt IEEEReal.TO_NEAREST else FixedInt.toInt o roundFix o checkNan
-
- fun toInt IEEEReal.TO_NEGINF = floor
- | toInt IEEEReal.TO_POSINF = ceil
- | toInt IEEEReal.TO_ZERO = trunc
- | toInt IEEEReal.TO_NEAREST = round
- end
-
- (* The order of evaluation here is important. See Test175. *)
- fun fmt fm =
- let val doFmt = Real.fmt fm in fn r => doFmt (toLarge r) end
-
- val toString = Real.toString o toLarge
-
- (* Scan input source for a valid number. The format is the same as
- for double precision. Convert it using the current rounding mode. *)
- fun scan getc src =
- case Real.scan getc src of
- NONE => NONE
- | SOME (r, a) => SOME(fromReal r, a)
-
- val fromString = StringCvt.scanString scan
-
- (* toDecimal: It's particularly important to handle the nan case
- here because toLarge loses the sign bit on some architectures. *)
- fun toDecimal r =
- let
- val sign = signBit r
- val kind = class r
- in
- case kind of
- ZERO => { class = ZERO, sign = sign, digits=[], exp = 0 }
- | INF => { class = INF, sign = sign, digits=[], exp = 0 }
- | NAN => { class = NAN, sign = sign, digits=[], exp = 0 }
- | _ => (* NORMAL/SUBNORMAL *) Real.toDecimal(toLarge r)
- end
-
- (* Convert from decimal. This is defined to use TO_NEAREST.
- We need to handle NaNs specially because fromRealRound loses
- the sign on a NaN. *)
- local
- val posNan = abs(zero / zero)
- val negNan = ~posNan
- in
- fun fromDecimal { class = INF, sign=true, ...} = SOME negInf
- | fromDecimal { class = INF, sign=false, ...} = SOME posInf
- | fromDecimal { class = NAN, sign=true, ... } = SOME negNan
- | fromDecimal { class = NAN, sign=false, ... } = SOME posNan
- | fromDecimal arg = Option.map fromRealRound (Real.fromDecimal arg)
- end
-
- structure Math =
- struct
- type real = real
-
- val sqrt = rtsCallFastF_F "PolyRealFSqrt"
- and sin = rtsCallFastF_F "PolyRealFSin"
- and cos = rtsCallFastF_F "PolyRealFCos"
- and atan = rtsCallFastF_F "PolyRealFArctan"
- and exp = rtsCallFastF_F "PolyRealFExp"
- and ln = rtsCallFastF_F "PolyRealFLog"
- and tan = rtsCallFastF_F "PolyRealFTan"
- and asin = rtsCallFastF_F "PolyRealFArcSin"
- and acos = rtsCallFastF_F "PolyRealFArcCos"
- and log10 = rtsCallFastF_F "PolyRealFLog10"
- and sinh = rtsCallFastF_F "PolyRealFSinh"
- and cosh = rtsCallFastF_F "PolyRealFCosh"
- and tanh = rtsCallFastF_F "PolyRealFTanh"
-
- val atan2 = rtsCallFastFF_F "PolyRealFAtan2"
- val pow = rtsCallFastFF_F "PolyRealFPow"
-
- (* Derived values. *)
- val e = exp one
- val pi = four * atan one
- end
-
-
- (* Converter for literal constants. Copied from Real. *)
- local
- fun convReal (s: string) : real =
- let
- (* Set the rounding mode to TO_NEAREST whatever the current
- rounding mode. Otherwise the result of compiling a piece of
- code with a literal constant could depend on what the rounding
- mode was set to. We should always support TO_NEAREST. *)
- val oldRounding = IEEEReal.getRoundingMode()
- val () = IEEEReal.setRoundingMode IEEEReal.TO_NEAREST
- val scanResult = StringCvt.scanString scan s
- val () = IEEEReal.setRoundingMode oldRounding
- in
- case scanResult of
- NONE => raise RunCall.Conversion "Invalid real constant"
- | SOME res => res
- end
- in
- (* Install this as a conversion function for real literals. *)
- val (): unit = RunCall.addOverload convReal "convReal"
- end
-
-end;
-
-
-val () = RunCall.addOverload Real32.>= ">="
-and () = RunCall.addOverload Real32.<= "<="
-and () = RunCall.addOverload Real32.> ">"
-and () = RunCall.addOverload Real32.< "<"
-and () = RunCall.addOverload Real32.+ "+"
-and () = RunCall.addOverload Real32.- "-"
-and () = RunCall.addOverload Real32.* "*"
-and () = RunCall.addOverload Real32.~ "~"
-and () = RunCall.addOverload Real32.abs "abs"
-and () = RunCall.addOverload Real32./ "/";
-
-
-(* Install print function. *)
-local
- fun print_real _ _ (r: Real32.real) =
- PolyML.PrettyString(Real32.fmt (StringCvt.GEN(SOME 10)) r)
-in
- val () = PolyML.addPrettyPrinter print_real;
-end;
diff --git a/basis/build.sml b/basis/build.sml
index f601b8e8..9933f5d9 100644
--- a/basis/build.sml
+++ b/basis/build.sml
@@ -1,242 +1,241 @@
(*
Title: Standard Basis Library: Commands to build the library
- Copyright David C.J. Matthews 2000, 2005, 2015-16, 2018-21
+ Copyright David C.J. Matthews 2000, 2005, 2015-16, 2018-21, 2023
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
(* Thread, Weak and Signal are Poly/ML extensions. *)
val () = Bootstrap.use "basis/InitialBasis.ML";
val () = Bootstrap.use "basis/Universal.ML";
val () = Bootstrap.use "basis/General.sml";
val () = Bootstrap.use "basis/LibrarySupport.sml";
val () = Bootstrap.use "basis/PolyMLException.sml";
val () = Bootstrap.use "basis/Option.sml";
val () = Bootstrap.use "basis/ListSignature.sml";
val () = Bootstrap.use "basis/List.sml";
val () = Bootstrap.use "basis/VectorOperations.sml";
val () = Bootstrap.use "basis/PolyVectorOperations.sml";
val () = Bootstrap.use "basis/VectorSliceOperations.sml";
val () = Bootstrap.use "basis/MONO_VECTOR.sml";
val () = Bootstrap.use "basis/MONO_VECTOR_SLICE.sml";
val () = Bootstrap.use "basis/MONO_ARRAY.sml";
val () = Bootstrap.use "basis/MONO_ARRAY_SLICE.sml";
val () = Bootstrap.use "basis/StringSignatures.sml";
val () = Bootstrap.use "basis/String.sml";
structure Int = struct type int = int end;
val () = Bootstrap.use "basis/INTEGER.sml";
val () = Bootstrap.use "basis/Int.sml";
val () = Bootstrap.use (if Bootstrap.intIsArbitraryPrecision then "basis/IntAsLargeInt.sml" else "basis/IntAsFixedInt.sml");
val () =
case FixedInt.precision of SOME 31 => Bootstrap.use "basis/Int31.sml" | SOME 63 => Bootstrap.use "basis/Int63.sml" | _ => ();
val () = Bootstrap.use "basis/WordSignature.sml";
val () = Bootstrap.use "basis/LargeWord.sml";
val () = Bootstrap.use "basis/VectorSignature.sml";
val () = Bootstrap.use "basis/VectorSliceSignature.sml";
val () = Bootstrap.use "basis/Vector.sml";
val () = Bootstrap.use "basis/ArraySignature.sml";
val () = Bootstrap.use "basis/ArraySliceSignature.sml"; (* Depends on VectorSlice. *)
val () = Bootstrap.use "basis/Array.sml";
val () = Bootstrap.use "basis/Text.sml"; (* Declares Char, String, CharArray, CharVector *)
val () = Bootstrap.use "basis/Bool.sml";
val () = Bootstrap.use "basis/ListPair.sml";
(* Declare the appropriate additional structures. *)
(* The version of Word32 we use depends on whether this is
32-bit or 64-bit. *)
val () =
if LargeWord.wordSize = 32
then Bootstrap.use "basis/Word32.sml"
else if Word.wordSize >= 32
then Bootstrap.use "basis/Word32In64.sml"
else if LargeWord.wordSize = 64
then Bootstrap.use "basis/Word32InLargeWord64.sml"
else ();
val () = Bootstrap.use "basis/Word16.sml";
val () = Bootstrap.use "basis/Word8.sml";
val () = Bootstrap.use "basis/IntInf.sml";
val () = Bootstrap.use "basis/Int32.sml";
val () = Bootstrap.use "basis/Word8Array.sml";
val () = Bootstrap.use "basis/Byte.sml";
val () = Bootstrap.use "basis/BoolArray.sml";
val () = Bootstrap.use "basis/IntArray.sml";
val () = Bootstrap.use "basis/RealArray.sml";
val () = Bootstrap.use "basis/IEEE_REAL.sml";
val () = Bootstrap.use "basis/IEEEReal.sml";
-val () = Bootstrap.use "basis/RealNumbersAsBits.ML"; (* Support library. *)
-val () = Bootstrap.use "basis/RealToDecimalConversion.ML"; (* Support library. *)
val () = Bootstrap.use "basis/MATH.sig";
structure LargeReal = struct type real = real end;
+val () = Bootstrap.use "basis/RealNumbersAsBits.ML";
+val () = Bootstrap.use "basis/RealToDecimalConversion.ML";
val () = Bootstrap.use "basis/REAL.sig";
-val () = Bootstrap.use "basis/Real.sml";
-val () = Bootstrap.use "basis/Real32.sml";
+val () = Bootstrap.use "basis/Real.sml"; (* Includes Real32. *)
val () = Bootstrap.use "basis/Time.sml";
val () = Bootstrap.use "basis/DATE.sig";
val () = Bootstrap.use "basis/Date.sml";
val () = Bootstrap.use "basis/Thread.sml"; (* Non-standard. *)
val () = Bootstrap.use "basis/ThreadLib.sml"; (* Non-standard. *)
val () = Bootstrap.use "basis/Timer.sml";
val () = Bootstrap.use "basis/CommandLine.sml";
val () = Bootstrap.use "basis/ExnPrinter.sml";
val () = Bootstrap.use "basis/ForeignConstants.sml";
val () = Bootstrap.use "basis/ForeignMemory.sml";
val () = Bootstrap.useWithParms [Bootstrap.Universal.tagInject Bootstrap.maxInlineSizeTag 1000] "basis/Foreign.sml";
val () = Bootstrap.use "basis/IO.sml";
val () = Bootstrap.use "basis/OS.sml";
val () = Bootstrap.use "basis/PRIM_IO.sml";
val () = Bootstrap.use "basis/PrimIO.sml";
val () = Bootstrap.use "basis/LibraryIOSupport.sml";
val () = Bootstrap.use "basis/STREAM_IO.sml";
val () = Bootstrap.use "basis/BasicStreamIO.sml";
val () = Bootstrap.use "basis/IMPERATIVE_IO.sml";
val () = Bootstrap.use "basis/ImperativeIO.sml";
val () = Bootstrap.use "basis/TextIO.sml";
val () = Bootstrap.use "basis/BinIO.sml";
val () = Bootstrap.use "basis/Socket.sml";
val () = Bootstrap.use "basis/NetProtDB.sml";
val () = Bootstrap.use "basis/NetServDB.sml";
val () = Bootstrap.use "basis/GenericSock.sml";
val () = Bootstrap.use "basis/INetSock.sml";
val () = Bootstrap.use "basis/INet6Sock.sml";
val () = Bootstrap.use "basis/PackReal.sml";
val () =
if Word.wordSize = 31
then Bootstrap.use "basis/PackReal32Boxed.sml"
else Bootstrap.use "basis/PackReal32Tagged.sml";
val () = Bootstrap.use "basis/PackWord.sml";
val () = Bootstrap.use "basis/Array2Signature.sml";
val () = Bootstrap.use "basis/Array2.sml";
val () = Bootstrap.use "basis/IntArray2.sml";
val () = Bootstrap.use "basis/SML90.sml";
val () = Bootstrap.use "basis/Weak.sml";
val () = Bootstrap.use "basis/Signal.sml";
val () = Bootstrap.use "basis/BIT_FLAGS.sml";
val () = Bootstrap.use "basis/SingleAssignment.sml";
(* Build Windows or Unix structure as appropriate. *)
local
val getOS: int = LibrarySupport.getOSType()
in
val () =
if getOS = 0
then
(
Bootstrap.use "basis/Posix.sml";
Bootstrap.use "basis/Unix.sml";
Bootstrap.use "basis/UnixSock.sml"
)
else if getOS = 1 then (Bootstrap.use "basis/Windows.sml")
else ()
end;
val () = Bootstrap.use "basis/HashArray.ML";
val () = Bootstrap.use "basis/UniversalArray.ML";
val () = Bootstrap.use "basis/PrettyPrinter.sml"; (* Add PrettyPrinter to PolyML structure. *)
val () = Bootstrap.use "basis/ASN1.sml";
val () = Bootstrap.use "basis/Statistics.ML"; (* Add Statistics to PolyML structure. *)
val () = Bootstrap.use "basis/InitialPolyML.ML"; (* Relies on OS. *)
val () = Bootstrap.use "basis/FinalPolyML.sml";
val () = Bootstrap.use "basis/TopLevelPolyML.sml"; (* Add rootFunction to Poly/ML. *)
val use = PolyML.use;
(* Copy everything out of the original name space. *)
(* Do this AFTER we've finished compiling PolyML and after adding "use". *)
local
val values =
["!", "*", "+", "-", "/", "::", ":=", "<", "<=", "<>", "=", ">", ">=",
"@", "Bind", "Chr", "Div", "Domain", "EQUAL", "Empty", "Fail", "GREATER",
"LESS", "Match", "NONE", "Option", "Overflow", "SOME", "Size", "Span",
"Subscript", "^", "abs", "app", "before", "ceil", "chr", "concat", "div",
"exnMessage", "exnName", "explode", "false", "floor", "foldl", "foldr",
"getOpt", "hd", "ignore", "implode", "isSome", "length", "map",
"mod", "nil", "not", "null", "o", "ord", "print", "quickSort", "real",
"ref", "rev", "round", "size", "sort", "str", "substring", "tl", "true",
"trunc", "use", "valOf", "vector", "~"]
val fixes =
["*", "+", "-", "/", "::", ":=", "<", "<=", "<>", "=", ">", ">=", "@",
"^", "before", "div", "mod", "o"]
val sigs =
["ARRAY", "ARRAY2", "ARRAY_SLICE", "BIN_IO", "BIT_FLAGS", "BOOL", "BYTE",
"CHAR", "COMMAND_LINE", "DATE", "GENERAL", "GENERIC_SOCK", "IEEE_REAL",
"IMPERATIVE_IO", "INET6_SOCK", "INET_SOCK", "INTEGER", "INT_INF", "IO",
"LIST", "LIST_PAIR", "MATH", "MONO_ARRAY", "MONO_ARRAY2",
"MONO_ARRAY_SLICE", "MONO_VECTOR", "MONO_VECTOR_SLICE", "NET_HOST_DB",
"NET_PROT_DB", "NET_SERV_DB", "OPTION", "OS", "OS_FILE_SYS", "OS_IO",
"OS_PATH", "OS_PROCESS", "PACK_REAL", "PACK_WORD", "POSIX",
"POSIX_ERROR", "POSIX_FILE_SYS", "POSIX_IO", "POSIX_PROCESS",
"POSIX_PROC_ENV", "POSIX_SIGNAL", "POSIX_SYS_DB", "POSIX_TTY", "PRIM_IO",
"REAL", "SIGNAL", "SML90", "SOCKET", "STREAM_IO", "STRING", "STRING_CVT",
"SUBSTRING", "TEXT", "TEXT_IO", "TEXT_STREAM_IO", "THREAD", "TIME",
"TIMER", "UNIX", "UNIX_SOCK", "VECTOR", "VECTOR_SLICE", "WEAK", "WINDOWS", "WORD"]
val types =
["array", "bool", "char", "exn", "int", "list", "option", "order", "real",
"ref", "string", "substring", "unit", "vector", "word"]
val functs = ["ImperativeIO", "PrimIO", "StreamIO"]
val structs =
["Array", "Array2", "ArraySlice", "Asn1", "BinIO", "BinPrimIO", "Bool",
"BoolArray", "BoolArray2", "BoolVector", "Byte", "Char", "CharArray",
"CharArray2", "CharArraySlice", "CharVector", "CharVectorSlice",
"CommandLine", "Date", "FixedInt", "Foreign", "General", "GenericSock",
"HashArray", "IEEEReal", "INet6Sock", "INetSock", "IO", "Int", "Int32",
"Int63", "IntArray", "IntArray2", "IntArraySlice", "IntInf", "IntVector",
"IntVectorSlice", "LargeInt", "LargeReal", "LargeWord", "List",
"ListPair", "Math", "Net6HostDB", "NetHostDB", "NetProtDB", "NetServDB",
"OS", "Option", "PackRealBig", "PackRealLittle", "PackReal32Big",
"PackReal32Little", "PackWord16Big",
"PackWord16Little", "PackWord32Big", "PackWord32Little", "PackWord8Big",
"PackWord8Little", "PolyML", "Position", "Posix", "Real", "Real32",
"RealArray", "RealArray2", "RealArraySlice", "RealVector",
"RealVectorSlice", "RunCall", "SML90", "Signal", "SingleAssignment",
"Socket", "String", "StringCvt", "Substring", "SysWord", "Text",
"TextIO", "TextPrimIO", "Thread", "ThreadLib", "Time", "Timer",
"Universal", "UniversalArray", "Unix", "UnixSock", "Vector",
"VectorSlice", "Weak", "Windows", "Word", "Word16", "Word32", "Word64",
"Word8", "Word8Array", "Word8Array2", "Word8ArraySlice", "Word8Vector",
"Word8VectorSlice"]
fun copyOver (enter, lookup) =
let
(* Copy over everything in the list if possible. Some items e.g. the Posix
structure, may not be present. *)
fun copy s =
enter PolyML.globalNameSpace (s, valOf(lookup Bootstrap.globalSpace s))
handle Option => ()
in
List.app copy
end
in
val () = copyOver(#enterVal, #lookupVal) values
val () = copyOver(#enterFix, #lookupFix) fixes
val () = copyOver(#enterType, #lookupType) types
val () = copyOver(#enterSig, #lookupSig) sigs
val () = copyOver(#enterStruct, #lookupStruct) structs
val () = copyOver(#enterFunct, #lookupFunct) functs
end;
(* Now we've created the new name space we must use PolyML.make/use. N.B. Unlike Bootstrap.use
these don't automatically look at the -I option. *)
diff --git a/libpolyml/Makefile.am b/libpolyml/Makefile.am
index e6ebcafb..98485ecd 100644
--- a/libpolyml/Makefile.am
+++ b/libpolyml/Makefile.am
@@ -1,154 +1,152 @@
AUTOMAKE_OPTIONS=foreign
moduledir = @moduledir@
AM_CPPFLAGS = $(CFLAGS) $(OSFLAG) $(GIT_VERSION) -Wall -DMODULEDIR=\"$(moduledir)\"
AM_CFLAGS = $(CFLAGS) $(OSFLAG) $(GIT_VERSION) -Wall -fno-strict-aliasing
AM_ASFLAGS = $(OSFLAG)
AM_CCASFLAGS = $(OSFLAG)
lib_LTLIBRARIES = libpolyml.la
-libpolyml_la_LDFLAGS = -version-info 14:0:0
+libpolyml_la_LDFLAGS = -version-info 15:0:0
if NO_UNDEFINED
# Force all references to be defined to build the DLL.
libpolyml_la_LDFLAGS += -no-undefined
endif
# Select the architecture-specific modules
if ARCHI386
ARCHSOURCE = x86_dep.cpp x86assembly_gas32.S
else
if ARCHX86_64
ARCHSOURCE = x86_dep.cpp x86assembly_gas64.S
else
if ARCHARM_64
ARCHSOURCE = arm64.cpp arm64assembly.S
else
ARCHSOURCE = interpreter.cpp
AM_CPPFLAGS += -DCODEISNOTEXECUTABLE
endif
endif
endif
# Select the object-format-specific modules
if EXPPECOFF
EXPORTSOURCE = pecoffexport.cpp
else
if EXPELF
EXPORTSOURCE = elfexport.cpp
else
if EXPMACHO
EXPORTSOURCE = machoexport.cpp
endif
endif
endif
if NATIVE_WINDOWS
OSSOURCE = winstartup.cpp winbasicio.cpp winguiconsole.cpp windows_specific.cpp osmemwin.cpp
else
OSSOURCE = basicio.cpp unix_specific.cpp osmemunix.cpp
endif
noinst_HEADERS = \
arb.h \
basicio.h \
bitmap.h \
bytecode.h \
check_objects.h \
diagnostics.h \
elfexport.h \
errors.h \
exporter.h \
gc.h \
gctaskfarm.h \
- gc_progress.h \
+ gc_progress.h \
globals.h \
- heapsizing.h \
+ heapsizing.h \
int_opcodes.h \
io_internal.h \
locking.h \
machine_dep.h \
machoexport.h \
memmgr.h \
mpoly.h \
network.h \
noreturn.h \
objsize.h \
osmem.h \
os_specific.h \
pecoffexport.h \
pexport.h \
PolyControl.h \
poly_specific.h \
polyffi.h \
polystring.h \
process_env.h \
processes.h \
profiling.h \
- realconv.h \
reals.h \
rts_module.h \
rtsentry.h \
run_time.h \
savestate.h \
save_vec.h \
scanaddrs.h \
sharedata.h \
sighandler.h \
statistics.h \
sys.h \
timing.h \
version.h \
winguiconsole.h \
- winstartup.h \
+ winstartup.h \
xcall_numbers.h \
xwindows.h
libpolyml_la_SOURCES = \
arb.cpp \
bitmap.cpp \
bytecode.cpp \
check_objects.cpp \
diagnostics.cpp \
errors.cpp \
exporter.cpp \
gc.cpp \
gc_check_weak_ref.cpp \
gc_copy_phase.cpp \
gc_mark_phase.cpp \
gc_progress.cpp \
gc_share_phase.cpp \
gc_update_phase.cpp \
gctaskfarm.cpp \
heapsizing.cpp \
locking.cpp \
memmgr.cpp \
mpoly.cpp \
network.cpp \
objsize.cpp \
pexport.cpp \
poly_specific.cpp \
polyffi.cpp \
polystring.cpp \
process_env.cpp \
processes.cpp \
profiling.cpp \
quick_gc.cpp \
- realconv.cpp \
reals.cpp \
rts_module.cpp \
rtsentry.cpp \
run_time.cpp \
save_vec.cpp \
savestate.cpp \
scanaddrs.cpp \
sharedata.cpp \
sighandler.cpp \
statistics.cpp \
timing.cpp \
xwindows.cpp \
$(ARCHSOURCE) $(EXPORTSOURCE) $(OSSOURCE)
pkgconfigdir = $(libdir)/pkgconfig
pkgconfig_DATA = polyml.pc
diff --git a/libpolyml/Makefile.in b/libpolyml/Makefile.in
index 446a5b54..ff7c0f70 100644
--- a/libpolyml/Makefile.in
+++ b/libpolyml/Makefile.in
@@ -1,1126 +1,1121 @@
# Makefile.in generated by automake 1.16.5 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2021 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = { \
if test -z '$(MAKELEVEL)'; then \
false; \
elif test -n '$(MAKE_HOST)'; then \
true; \
elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
true; \
else \
false; \
fi; \
}
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
# Force all references to be defined to build the DLL.
@NO_UNDEFINED_TRUE@am__append_1 = -no-undefined
@ARCHARM_64_FALSE@@ARCHI386_FALSE@@ARCHX86_64_FALSE@am__append_2 = -DCODEISNOTEXECUTABLE
subdir = libpolyml
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/libtool.m4 \
$(top_srcdir)/m4/ltdl.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/m4/pkg.m4 \
$(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
DIST_COMMON = $(srcdir)/Makefile.am $(noinst_HEADERS) \
$(am__DIST_COMMON)
mkinstalldirs = $(install_sh) -d
CONFIG_HEADER = $(top_builddir)/config.h
CONFIG_CLEAN_FILES = polyml.pc
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__installdirs = "$(DESTDIR)$(libdir)" "$(DESTDIR)$(pkgconfigdir)"
LTLIBRARIES = $(lib_LTLIBRARIES)
libpolyml_la_LIBADD =
am__libpolyml_la_SOURCES_DIST = arb.cpp bitmap.cpp bytecode.cpp \
check_objects.cpp diagnostics.cpp errors.cpp exporter.cpp \
gc.cpp gc_check_weak_ref.cpp gc_copy_phase.cpp \
gc_mark_phase.cpp gc_progress.cpp gc_share_phase.cpp \
gc_update_phase.cpp gctaskfarm.cpp heapsizing.cpp locking.cpp \
memmgr.cpp mpoly.cpp network.cpp objsize.cpp pexport.cpp \
poly_specific.cpp polyffi.cpp polystring.cpp process_env.cpp \
- processes.cpp profiling.cpp quick_gc.cpp realconv.cpp \
- reals.cpp rts_module.cpp rtsentry.cpp run_time.cpp \
- save_vec.cpp savestate.cpp scanaddrs.cpp sharedata.cpp \
- sighandler.cpp statistics.cpp timing.cpp xwindows.cpp \
- interpreter.cpp arm64.cpp arm64assembly.S x86_dep.cpp \
- x86assembly_gas64.S x86assembly_gas32.S machoexport.cpp \
- elfexport.cpp pecoffexport.cpp basicio.cpp unix_specific.cpp \
- osmemunix.cpp winstartup.cpp winbasicio.cpp winguiconsole.cpp \
+ processes.cpp profiling.cpp quick_gc.cpp reals.cpp \
+ rts_module.cpp rtsentry.cpp run_time.cpp save_vec.cpp \
+ savestate.cpp scanaddrs.cpp sharedata.cpp sighandler.cpp \
+ statistics.cpp timing.cpp xwindows.cpp interpreter.cpp \
+ arm64.cpp arm64assembly.S x86_dep.cpp x86assembly_gas64.S \
+ x86assembly_gas32.S machoexport.cpp elfexport.cpp \
+ pecoffexport.cpp basicio.cpp unix_specific.cpp osmemunix.cpp \
+ winstartup.cpp winbasicio.cpp winguiconsole.cpp \
windows_specific.cpp osmemwin.cpp
@ARCHARM_64_FALSE@@ARCHI386_FALSE@@ARCHX86_64_FALSE@am__objects_1 = interpreter.lo
@ARCHARM_64_TRUE@@ARCHI386_FALSE@@ARCHX86_64_FALSE@am__objects_1 = \
@ARCHARM_64_TRUE@@ARCHI386_FALSE@@ARCHX86_64_FALSE@ arm64.lo \
@ARCHARM_64_TRUE@@ARCHI386_FALSE@@ARCHX86_64_FALSE@ arm64assembly.lo
@ARCHI386_FALSE@@ARCHX86_64_TRUE@am__objects_1 = x86_dep.lo \
@ARCHI386_FALSE@@ARCHX86_64_TRUE@ x86assembly_gas64.lo
@ARCHI386_TRUE@am__objects_1 = x86_dep.lo x86assembly_gas32.lo
@EXPELF_FALSE@@EXPMACHO_TRUE@@EXPPECOFF_FALSE@am__objects_2 = \
@EXPELF_FALSE@@EXPMACHO_TRUE@@EXPPECOFF_FALSE@ machoexport.lo
@EXPELF_TRUE@@EXPPECOFF_FALSE@am__objects_2 = elfexport.lo
@EXPPECOFF_TRUE@am__objects_2 = pecoffexport.lo
@NATIVE_WINDOWS_FALSE@am__objects_3 = basicio.lo unix_specific.lo \
@NATIVE_WINDOWS_FALSE@ osmemunix.lo
@NATIVE_WINDOWS_TRUE@am__objects_3 = winstartup.lo winbasicio.lo \
@NATIVE_WINDOWS_TRUE@ winguiconsole.lo windows_specific.lo \
@NATIVE_WINDOWS_TRUE@ osmemwin.lo
am_libpolyml_la_OBJECTS = arb.lo bitmap.lo bytecode.lo \
check_objects.lo diagnostics.lo errors.lo exporter.lo gc.lo \
gc_check_weak_ref.lo gc_copy_phase.lo gc_mark_phase.lo \
gc_progress.lo gc_share_phase.lo gc_update_phase.lo \
gctaskfarm.lo heapsizing.lo locking.lo memmgr.lo mpoly.lo \
network.lo objsize.lo pexport.lo poly_specific.lo polyffi.lo \
polystring.lo process_env.lo processes.lo profiling.lo \
- quick_gc.lo realconv.lo reals.lo rts_module.lo rtsentry.lo \
- run_time.lo save_vec.lo savestate.lo scanaddrs.lo sharedata.lo \
+ quick_gc.lo reals.lo rts_module.lo rtsentry.lo run_time.lo \
+ save_vec.lo savestate.lo scanaddrs.lo sharedata.lo \
sighandler.lo statistics.lo timing.lo xwindows.lo \
$(am__objects_1) $(am__objects_2) $(am__objects_3)
libpolyml_la_OBJECTS = $(am_libpolyml_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
libpolyml_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \
$(CXXFLAGS) $(libpolyml_la_LDFLAGS) $(LDFLAGS) -o $@
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
depcomp = $(SHELL) $(top_srcdir)/depcomp
am__maybe_remake_depfiles = depfiles
am__depfiles_remade = ./$(DEPDIR)/arb.Plo ./$(DEPDIR)/arm64.Plo \
./$(DEPDIR)/arm64assembly.Plo ./$(DEPDIR)/basicio.Plo \
./$(DEPDIR)/bitmap.Plo ./$(DEPDIR)/bytecode.Plo \
./$(DEPDIR)/check_objects.Plo ./$(DEPDIR)/diagnostics.Plo \
./$(DEPDIR)/elfexport.Plo ./$(DEPDIR)/errors.Plo \
./$(DEPDIR)/exporter.Plo ./$(DEPDIR)/gc.Plo \
./$(DEPDIR)/gc_check_weak_ref.Plo \
./$(DEPDIR)/gc_copy_phase.Plo ./$(DEPDIR)/gc_mark_phase.Plo \
./$(DEPDIR)/gc_progress.Plo ./$(DEPDIR)/gc_share_phase.Plo \
./$(DEPDIR)/gc_update_phase.Plo ./$(DEPDIR)/gctaskfarm.Plo \
./$(DEPDIR)/heapsizing.Plo ./$(DEPDIR)/interpreter.Plo \
./$(DEPDIR)/locking.Plo ./$(DEPDIR)/machoexport.Plo \
./$(DEPDIR)/memmgr.Plo ./$(DEPDIR)/mpoly.Plo \
./$(DEPDIR)/network.Plo ./$(DEPDIR)/objsize.Plo \
./$(DEPDIR)/osmemunix.Plo ./$(DEPDIR)/osmemwin.Plo \
./$(DEPDIR)/pecoffexport.Plo ./$(DEPDIR)/pexport.Plo \
./$(DEPDIR)/poly_specific.Plo ./$(DEPDIR)/polyffi.Plo \
./$(DEPDIR)/polystring.Plo ./$(DEPDIR)/process_env.Plo \
./$(DEPDIR)/processes.Plo ./$(DEPDIR)/profiling.Plo \
- ./$(DEPDIR)/quick_gc.Plo ./$(DEPDIR)/realconv.Plo \
- ./$(DEPDIR)/reals.Plo ./$(DEPDIR)/rts_module.Plo \
- ./$(DEPDIR)/rtsentry.Plo ./$(DEPDIR)/run_time.Plo \
- ./$(DEPDIR)/save_vec.Plo ./$(DEPDIR)/savestate.Plo \
- ./$(DEPDIR)/scanaddrs.Plo ./$(DEPDIR)/sharedata.Plo \
- ./$(DEPDIR)/sighandler.Plo ./$(DEPDIR)/statistics.Plo \
- ./$(DEPDIR)/timing.Plo ./$(DEPDIR)/unix_specific.Plo \
- ./$(DEPDIR)/winbasicio.Plo ./$(DEPDIR)/windows_specific.Plo \
- ./$(DEPDIR)/winguiconsole.Plo ./$(DEPDIR)/winstartup.Plo \
- ./$(DEPDIR)/x86_dep.Plo ./$(DEPDIR)/x86assembly_gas32.Plo \
+ ./$(DEPDIR)/quick_gc.Plo ./$(DEPDIR)/reals.Plo \
+ ./$(DEPDIR)/rts_module.Plo ./$(DEPDIR)/rtsentry.Plo \
+ ./$(DEPDIR)/run_time.Plo ./$(DEPDIR)/save_vec.Plo \
+ ./$(DEPDIR)/savestate.Plo ./$(DEPDIR)/scanaddrs.Plo \
+ ./$(DEPDIR)/sharedata.Plo ./$(DEPDIR)/sighandler.Plo \
+ ./$(DEPDIR)/statistics.Plo ./$(DEPDIR)/timing.Plo \
+ ./$(DEPDIR)/unix_specific.Plo ./$(DEPDIR)/winbasicio.Plo \
+ ./$(DEPDIR)/windows_specific.Plo ./$(DEPDIR)/winguiconsole.Plo \
+ ./$(DEPDIR)/winstartup.Plo ./$(DEPDIR)/x86_dep.Plo \
+ ./$(DEPDIR)/x86assembly_gas32.Plo \
./$(DEPDIR)/x86assembly_gas64.Plo ./$(DEPDIR)/xwindows.Plo
am__mv = mv -f
CPPASCOMPILE = $(CCAS) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CCASFLAGS) $(CCASFLAGS)
LTCPPASCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(CCAS) $(DEFS) \
$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
$(AM_CCASFLAGS) $(CCASFLAGS)
AM_V_CPPAS = $(am__v_CPPAS_@AM_V@)
am__v_CPPAS_ = $(am__v_CPPAS_@AM_DEFAULT_V@)
am__v_CPPAS_0 = @echo " CPPAS " $@;
am__v_CPPAS_1 =
CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS)
LTCXXCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) \
$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
$(AM_CXXFLAGS) $(CXXFLAGS)
AM_V_CXX = $(am__v_CXX_@AM_V@)
am__v_CXX_ = $(am__v_CXX_@AM_DEFAULT_V@)
am__v_CXX_0 = @echo " CXX " $@;
am__v_CXX_1 =
CXXLD = $(CXX)
CXXLINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \
$(CXXFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_CXXLD = $(am__v_CXXLD_@AM_V@)
am__v_CXXLD_ = $(am__v_CXXLD_@AM_DEFAULT_V@)
am__v_CXXLD_0 = @echo " CXXLD " $@;
am__v_CXXLD_1 =
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
$(AM_CFLAGS) $(CFLAGS)
AM_V_CC = $(am__v_CC_@AM_V@)
am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
am__v_CC_0 = @echo " CC " $@;
am__v_CC_1 =
CCLD = $(CC)
LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_CCLD = $(am__v_CCLD_@AM_V@)
am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
am__v_CCLD_0 = @echo " CCLD " $@;
am__v_CCLD_1 =
SOURCES = $(libpolyml_la_SOURCES)
DIST_SOURCES = $(am__libpolyml_la_SOURCES_DIST)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
DATA = $(pkgconfig_DATA)
HEADERS = $(noinst_HEADERS)
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
am__DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/polyml.pc.in \
$(top_srcdir)/depcomp
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
ALLOCA = @ALLOCA@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
CC = @CC@
CCAS = @CCAS@
CCASDEPMODE = @CCASDEPMODE@
CCASFLAGS = @CCASFLAGS@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CSCOPE = @CSCOPE@
CTAGS = @CTAGS@
CXX = @CXX@
CXXCPP = @CXXCPP@
CXXDEPMODE = @CXXDEPMODE@
CXXFLAGS = @CXXFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
ETAGS = @ETAGS@
EXEEXT = @EXEEXT@
FGREP = @FGREP@
FILECMD = @FILECMD@
GIT_VERSION = @GIT_VERSION@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OSFLAG = @OSFLAG@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
PKG_CONFIG = @PKG_CONFIG@
PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@
PKG_CONFIG_PATH = @PKG_CONFIG_PATH@
POW_LIB = @POW_LIB@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
WINDRES = @WINDRES@
XMKMF = @XMKMF@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_CXX = @ac_ct_CXX@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
dependentlibs = @dependentlibs@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
gitinstalled = @gitinstalled@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
moduledir = @moduledir@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
polyc_CFLAGS = @polyc_CFLAGS@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
runstatedir = @runstatedir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sys_symbol_underscore = @sys_symbol_underscore@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
AUTOMAKE_OPTIONS = foreign
AM_CPPFLAGS = $(CFLAGS) $(OSFLAG) $(GIT_VERSION) -Wall \
-DMODULEDIR=\"$(moduledir)\" $(am__append_2)
AM_CFLAGS = $(CFLAGS) $(OSFLAG) $(GIT_VERSION) -Wall -fno-strict-aliasing
AM_ASFLAGS = $(OSFLAG)
AM_CCASFLAGS = $(OSFLAG)
lib_LTLIBRARIES = libpolyml.la
-libpolyml_la_LDFLAGS = -version-info 14:0:0 $(am__append_1)
+libpolyml_la_LDFLAGS = -version-info 15:0:0 $(am__append_1)
@ARCHARM_64_FALSE@@ARCHI386_FALSE@@ARCHX86_64_FALSE@ARCHSOURCE = interpreter.cpp
@ARCHARM_64_TRUE@@ARCHI386_FALSE@@ARCHX86_64_FALSE@ARCHSOURCE = arm64.cpp arm64assembly.S
@ARCHI386_FALSE@@ARCHX86_64_TRUE@ARCHSOURCE = x86_dep.cpp x86assembly_gas64.S
# Select the architecture-specific modules
@ARCHI386_TRUE@ARCHSOURCE = x86_dep.cpp x86assembly_gas32.S
@EXPELF_FALSE@@EXPMACHO_TRUE@@EXPPECOFF_FALSE@EXPORTSOURCE = machoexport.cpp
@EXPELF_TRUE@@EXPPECOFF_FALSE@EXPORTSOURCE = elfexport.cpp
# Select the object-format-specific modules
@EXPPECOFF_TRUE@EXPORTSOURCE = pecoffexport.cpp
@NATIVE_WINDOWS_FALSE@OSSOURCE = basicio.cpp unix_specific.cpp osmemunix.cpp
@NATIVE_WINDOWS_TRUE@OSSOURCE = winstartup.cpp winbasicio.cpp winguiconsole.cpp windows_specific.cpp osmemwin.cpp
noinst_HEADERS = \
arb.h \
basicio.h \
bitmap.h \
bytecode.h \
check_objects.h \
diagnostics.h \
elfexport.h \
errors.h \
exporter.h \
gc.h \
gctaskfarm.h \
- gc_progress.h \
+ gc_progress.h \
globals.h \
- heapsizing.h \
+ heapsizing.h \
int_opcodes.h \
io_internal.h \
locking.h \
machine_dep.h \
machoexport.h \
memmgr.h \
mpoly.h \
network.h \
noreturn.h \
objsize.h \
osmem.h \
os_specific.h \
pecoffexport.h \
pexport.h \
PolyControl.h \
poly_specific.h \
polyffi.h \
polystring.h \
process_env.h \
processes.h \
profiling.h \
- realconv.h \
reals.h \
rts_module.h \
rtsentry.h \
run_time.h \
savestate.h \
save_vec.h \
scanaddrs.h \
sharedata.h \
sighandler.h \
statistics.h \
sys.h \
timing.h \
version.h \
winguiconsole.h \
- winstartup.h \
+ winstartup.h \
xcall_numbers.h \
xwindows.h
libpolyml_la_SOURCES = \
arb.cpp \
bitmap.cpp \
bytecode.cpp \
check_objects.cpp \
diagnostics.cpp \
errors.cpp \
exporter.cpp \
gc.cpp \
gc_check_weak_ref.cpp \
gc_copy_phase.cpp \
gc_mark_phase.cpp \
gc_progress.cpp \
gc_share_phase.cpp \
gc_update_phase.cpp \
gctaskfarm.cpp \
heapsizing.cpp \
locking.cpp \
memmgr.cpp \
mpoly.cpp \
network.cpp \
objsize.cpp \
pexport.cpp \
poly_specific.cpp \
polyffi.cpp \
polystring.cpp \
process_env.cpp \
processes.cpp \
profiling.cpp \
quick_gc.cpp \
- realconv.cpp \
reals.cpp \
rts_module.cpp \
rtsentry.cpp \
run_time.cpp \
save_vec.cpp \
savestate.cpp \
scanaddrs.cpp \
sharedata.cpp \
sighandler.cpp \
statistics.cpp \
timing.cpp \
xwindows.cpp \
$(ARCHSOURCE) $(EXPORTSOURCE) $(OSSOURCE)
pkgconfigdir = $(libdir)/pkgconfig
pkgconfig_DATA = polyml.pc
all: all-am
.SUFFIXES:
.SUFFIXES: .S .cpp .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign libpolyml/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign libpolyml/Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
polyml.pc: $(top_builddir)/config.status $(srcdir)/polyml.pc.in
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@
install-libLTLIBRARIES: $(lib_LTLIBRARIES)
@$(NORMAL_INSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
list2=; for p in $$list; do \
if test -f $$p; then \
list2="$$list2 $$p"; \
else :; fi; \
done; \
test -z "$$list2" || { \
echo " $(MKDIR_P) '$(DESTDIR)$(libdir)'"; \
$(MKDIR_P) "$(DESTDIR)$(libdir)" || exit 1; \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \
}
uninstall-libLTLIBRARIES:
@$(NORMAL_UNINSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
for p in $$list; do \
$(am__strip_dir) \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \
done
clean-libLTLIBRARIES:
-test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES)
@list='$(lib_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libpolyml.la: $(libpolyml_la_OBJECTS) $(libpolyml_la_DEPENDENCIES) $(EXTRA_libpolyml_la_DEPENDENCIES)
$(AM_V_CXXLD)$(libpolyml_la_LINK) -rpath $(libdir) $(libpolyml_la_OBJECTS) $(libpolyml_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/arb.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/arm64.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/arm64assembly.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/basicio.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bitmap.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bytecode.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/check_objects.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/diagnostics.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/elfexport.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/errors.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exporter.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc_check_weak_ref.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc_copy_phase.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc_mark_phase.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc_progress.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc_share_phase.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc_update_phase.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gctaskfarm.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/heapsizing.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/interpreter.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/locking.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/machoexport.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/memmgr.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpoly.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/network.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/objsize.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/osmemunix.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/osmemwin.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pecoffexport.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pexport.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/poly_specific.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/polyffi.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/polystring.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/process_env.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/processes.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/profiling.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/quick_gc.Plo@am__quote@ # am--include-marker
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/realconv.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reals.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rts_module.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rtsentry.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/run_time.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/save_vec.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/savestate.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scanaddrs.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sharedata.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sighandler.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/statistics.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timing.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unix_specific.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/winbasicio.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/windows_specific.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/winguiconsole.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/winstartup.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/x86_dep.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/x86assembly_gas32.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/x86assembly_gas64.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/xwindows.Plo@am__quote@ # am--include-marker
$(am__depfiles_remade):
@$(MKDIR_P) $(@D)
@echo '# dummy' >$@-t && $(am__mv) $@-t $@
am--depfiles: $(am__depfiles_remade)
.S.o:
@am__fastdepCCAS_TRUE@ $(AM_V_CPPAS)$(CPPASCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCCAS_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCCAS_FALSE@ $(AM_V_CPPAS)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCCAS_FALSE@ DEPDIR=$(DEPDIR) $(CCASDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCCAS_FALSE@ $(AM_V_CPPAS@am__nodep@)$(CPPASCOMPILE) -c -o $@ $<
.S.obj:
@am__fastdepCCAS_TRUE@ $(AM_V_CPPAS)$(CPPASCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
@am__fastdepCCAS_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCCAS_FALSE@ $(AM_V_CPPAS)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCCAS_FALSE@ DEPDIR=$(DEPDIR) $(CCASDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCCAS_FALSE@ $(AM_V_CPPAS@am__nodep@)$(CPPASCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.S.lo:
@am__fastdepCCAS_TRUE@ $(AM_V_CPPAS)$(LTCPPASCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCCAS_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
@AMDEP_TRUE@@am__fastdepCCAS_FALSE@ $(AM_V_CPPAS)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCCAS_FALSE@ DEPDIR=$(DEPDIR) $(CCASDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCCAS_FALSE@ $(AM_V_CPPAS@am__nodep@)$(LTCPPASCOMPILE) -c -o $@ $<
.cpp.o:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ $<
.cpp.obj:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.cpp.lo:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(LTCXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(LTCXXCOMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
install-pkgconfigDATA: $(pkgconfig_DATA)
@$(NORMAL_INSTALL)
@list='$(pkgconfig_DATA)'; test -n "$(pkgconfigdir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(pkgconfigdir)'"; \
$(MKDIR_P) "$(DESTDIR)$(pkgconfigdir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
echo "$$d$$p"; \
done | $(am__base_list) | \
while read files; do \
echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(pkgconfigdir)'"; \
$(INSTALL_DATA) $$files "$(DESTDIR)$(pkgconfigdir)" || exit $$?; \
done
uninstall-pkgconfigDATA:
@$(NORMAL_UNINSTALL)
@list='$(pkgconfig_DATA)'; test -n "$(pkgconfigdir)" || list=; \
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
dir='$(DESTDIR)$(pkgconfigdir)'; $(am__uninstall_files_from_dir)
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(BUILT_SOURCES)
$(MAKE) $(AM_MAKEFLAGS) distdir-am
distdir-am: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES) $(DATA) $(HEADERS)
installdirs:
for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(pkgconfigdir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f ./$(DEPDIR)/arb.Plo
-rm -f ./$(DEPDIR)/arm64.Plo
-rm -f ./$(DEPDIR)/arm64assembly.Plo
-rm -f ./$(DEPDIR)/basicio.Plo
-rm -f ./$(DEPDIR)/bitmap.Plo
-rm -f ./$(DEPDIR)/bytecode.Plo
-rm -f ./$(DEPDIR)/check_objects.Plo
-rm -f ./$(DEPDIR)/diagnostics.Plo
-rm -f ./$(DEPDIR)/elfexport.Plo
-rm -f ./$(DEPDIR)/errors.Plo
-rm -f ./$(DEPDIR)/exporter.Plo
-rm -f ./$(DEPDIR)/gc.Plo
-rm -f ./$(DEPDIR)/gc_check_weak_ref.Plo
-rm -f ./$(DEPDIR)/gc_copy_phase.Plo
-rm -f ./$(DEPDIR)/gc_mark_phase.Plo
-rm -f ./$(DEPDIR)/gc_progress.Plo
-rm -f ./$(DEPDIR)/gc_share_phase.Plo
-rm -f ./$(DEPDIR)/gc_update_phase.Plo
-rm -f ./$(DEPDIR)/gctaskfarm.Plo
-rm -f ./$(DEPDIR)/heapsizing.Plo
-rm -f ./$(DEPDIR)/interpreter.Plo
-rm -f ./$(DEPDIR)/locking.Plo
-rm -f ./$(DEPDIR)/machoexport.Plo
-rm -f ./$(DEPDIR)/memmgr.Plo
-rm -f ./$(DEPDIR)/mpoly.Plo
-rm -f ./$(DEPDIR)/network.Plo
-rm -f ./$(DEPDIR)/objsize.Plo
-rm -f ./$(DEPDIR)/osmemunix.Plo
-rm -f ./$(DEPDIR)/osmemwin.Plo
-rm -f ./$(DEPDIR)/pecoffexport.Plo
-rm -f ./$(DEPDIR)/pexport.Plo
-rm -f ./$(DEPDIR)/poly_specific.Plo
-rm -f ./$(DEPDIR)/polyffi.Plo
-rm -f ./$(DEPDIR)/polystring.Plo
-rm -f ./$(DEPDIR)/process_env.Plo
-rm -f ./$(DEPDIR)/processes.Plo
-rm -f ./$(DEPDIR)/profiling.Plo
-rm -f ./$(DEPDIR)/quick_gc.Plo
- -rm -f ./$(DEPDIR)/realconv.Plo
-rm -f ./$(DEPDIR)/reals.Plo
-rm -f ./$(DEPDIR)/rts_module.Plo
-rm -f ./$(DEPDIR)/rtsentry.Plo
-rm -f ./$(DEPDIR)/run_time.Plo
-rm -f ./$(DEPDIR)/save_vec.Plo
-rm -f ./$(DEPDIR)/savestate.Plo
-rm -f ./$(DEPDIR)/scanaddrs.Plo
-rm -f ./$(DEPDIR)/sharedata.Plo
-rm -f ./$(DEPDIR)/sighandler.Plo
-rm -f ./$(DEPDIR)/statistics.Plo
-rm -f ./$(DEPDIR)/timing.Plo
-rm -f ./$(DEPDIR)/unix_specific.Plo
-rm -f ./$(DEPDIR)/winbasicio.Plo
-rm -f ./$(DEPDIR)/windows_specific.Plo
-rm -f ./$(DEPDIR)/winguiconsole.Plo
-rm -f ./$(DEPDIR)/winstartup.Plo
-rm -f ./$(DEPDIR)/x86_dep.Plo
-rm -f ./$(DEPDIR)/x86assembly_gas32.Plo
-rm -f ./$(DEPDIR)/x86assembly_gas64.Plo
-rm -f ./$(DEPDIR)/xwindows.Plo
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am: install-pkgconfigDATA
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am: install-libLTLIBRARIES
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f ./$(DEPDIR)/arb.Plo
-rm -f ./$(DEPDIR)/arm64.Plo
-rm -f ./$(DEPDIR)/arm64assembly.Plo
-rm -f ./$(DEPDIR)/basicio.Plo
-rm -f ./$(DEPDIR)/bitmap.Plo
-rm -f ./$(DEPDIR)/bytecode.Plo
-rm -f ./$(DEPDIR)/check_objects.Plo
-rm -f ./$(DEPDIR)/diagnostics.Plo
-rm -f ./$(DEPDIR)/elfexport.Plo
-rm -f ./$(DEPDIR)/errors.Plo
-rm -f ./$(DEPDIR)/exporter.Plo
-rm -f ./$(DEPDIR)/gc.Plo
-rm -f ./$(DEPDIR)/gc_check_weak_ref.Plo
-rm -f ./$(DEPDIR)/gc_copy_phase.Plo
-rm -f ./$(DEPDIR)/gc_mark_phase.Plo
-rm -f ./$(DEPDIR)/gc_progress.Plo
-rm -f ./$(DEPDIR)/gc_share_phase.Plo
-rm -f ./$(DEPDIR)/gc_update_phase.Plo
-rm -f ./$(DEPDIR)/gctaskfarm.Plo
-rm -f ./$(DEPDIR)/heapsizing.Plo
-rm -f ./$(DEPDIR)/interpreter.Plo
-rm -f ./$(DEPDIR)/locking.Plo
-rm -f ./$(DEPDIR)/machoexport.Plo
-rm -f ./$(DEPDIR)/memmgr.Plo
-rm -f ./$(DEPDIR)/mpoly.Plo
-rm -f ./$(DEPDIR)/network.Plo
-rm -f ./$(DEPDIR)/objsize.Plo
-rm -f ./$(DEPDIR)/osmemunix.Plo
-rm -f ./$(DEPDIR)/osmemwin.Plo
-rm -f ./$(DEPDIR)/pecoffexport.Plo
-rm -f ./$(DEPDIR)/pexport.Plo
-rm -f ./$(DEPDIR)/poly_specific.Plo
-rm -f ./$(DEPDIR)/polyffi.Plo
-rm -f ./$(DEPDIR)/polystring.Plo
-rm -f ./$(DEPDIR)/process_env.Plo
-rm -f ./$(DEPDIR)/processes.Plo
-rm -f ./$(DEPDIR)/profiling.Plo
-rm -f ./$(DEPDIR)/quick_gc.Plo
- -rm -f ./$(DEPDIR)/realconv.Plo
-rm -f ./$(DEPDIR)/reals.Plo
-rm -f ./$(DEPDIR)/rts_module.Plo
-rm -f ./$(DEPDIR)/rtsentry.Plo
-rm -f ./$(DEPDIR)/run_time.Plo
-rm -f ./$(DEPDIR)/save_vec.Plo
-rm -f ./$(DEPDIR)/savestate.Plo
-rm -f ./$(DEPDIR)/scanaddrs.Plo
-rm -f ./$(DEPDIR)/sharedata.Plo
-rm -f ./$(DEPDIR)/sighandler.Plo
-rm -f ./$(DEPDIR)/statistics.Plo
-rm -f ./$(DEPDIR)/timing.Plo
-rm -f ./$(DEPDIR)/unix_specific.Plo
-rm -f ./$(DEPDIR)/winbasicio.Plo
-rm -f ./$(DEPDIR)/windows_specific.Plo
-rm -f ./$(DEPDIR)/winguiconsole.Plo
-rm -f ./$(DEPDIR)/winstartup.Plo
-rm -f ./$(DEPDIR)/x86_dep.Plo
-rm -f ./$(DEPDIR)/x86assembly_gas32.Plo
-rm -f ./$(DEPDIR)/x86assembly_gas64.Plo
-rm -f ./$(DEPDIR)/xwindows.Plo
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am: uninstall-libLTLIBRARIES uninstall-pkgconfigDATA
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am am--depfiles check check-am clean \
clean-generic clean-libLTLIBRARIES clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-libLTLIBRARIES install-man install-pdf \
install-pdf-am install-pkgconfigDATA install-ps install-ps-am \
install-strip installcheck installcheck-am installdirs \
maintainer-clean maintainer-clean-generic mostlyclean \
mostlyclean-compile mostlyclean-generic mostlyclean-libtool \
pdf pdf-am ps ps-am tags tags-am uninstall uninstall-am \
uninstall-libLTLIBRARIES uninstall-pkgconfigDATA
.PRECIOUS: Makefile
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
diff --git a/libpolyml/PolyLib.vcxproj b/libpolyml/PolyLib.vcxproj
index 25bc7201..db060042 100644
--- a/libpolyml/PolyLib.vcxproj
+++ b/libpolyml/PolyLib.vcxproj
@@ -1,1378 +1,1378 @@
Debug32in64
ARM64
Debug32in64
Win32
Debug32in64
x64
DebugInt32in64
ARM64
DebugInt32in64
Win32
DebugInt32in64
x64
DebugInterpreted
ARM64
Debug
ARM64
Debug
Win32
DebugInterpreted
Win32
DebugInterpreted
x64
Release32in64
ARM64
ReleaseInt32in64
ARM64
ReleaseInt32in64
Win32
ReleaseInt32in64
x64
ReleaseInterpreted
ARM64
ReleaseInterpreted
Win32
ReleaseInterpreted
x64
Release32in64
Win32
Release32in64
x64
Release
ARM64
Release
Win32
Debug
x64
Release
x64
{0BA5D5B5-F85B-4C49-8A27-67186FA68922}
PolyLib
10.0
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
true
v142
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
DynamicLibrary
false
v142
true
Unicode
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
.dll
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86_64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_AARCH64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
DebugFull
ws2_32.lib;%(AdditionalDependencies)
Windows
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
POLYML32IN64;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86_64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
POLYML32IN64;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_AARCH64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86_64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_AARCH64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
POLYML32IN64;CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86_64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
Disabled
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
POLYML32IN64;CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_AARCH64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreadedDebug
true
ws2_32.lib;%(AdditionalDependencies)
Windows
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86_64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_AARCH64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
POLYML32IN64;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86_64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
POLYML32IN64;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_AARCH64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86_64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_AARCH64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
POLYML32IN64;CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_X86_64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
6.0
false
Level3
MaxSpeed
true
true
true
..;libffi\include;libffi\msvc32include;libffi\src\x86;%(AdditionalIncludeDirectories)
POLYML32IN64;CODEISNOTEXECUTABLE;_CRT_SECURE_NO_WARNINGS;POLYLIB_EXPORTS;HOSTARCHITECTURE_AARCH64;LONG_LONG_MAX=_I64_MAX;%(PreprocessorDefinitions)
MultiThreaded
true
true
true
ws2_32.lib;%(AdditionalDependencies)
Windows
false
true
true
true
true
true
true
true
true
false
true
false
true
true
false
false
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
-
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
+
+
-
true
true
true
true
true
true
true
true
false
false
true
true
false
false
true
true
true
true
true
true
true
true
true
true
Document
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml /nologo /DWINDOWS /Fo $(IntDir)%(Filename).obj /c /coff "$(IntDir)%(Filename).asm"
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
true
Document
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER /DPOLYML32IN64 "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER /DPOLYML32IN64 "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER /DPOLYML32IN64 "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER /DPOLYML32IN64 "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
cl /nologo /EP /I. /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
ml64 /nologo /Fo $(IntDir)%(Filename).obj /c $(IntDir)%(Filename).asm
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
true
true
true
true
Document
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER /DPOLYML32IN64 "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER /DPOLYML32IN64 "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
cl /nologo /EP /I. /DARMASMSYNTAX /D_MSC_VER "%(FullPath)" > $(IntDir)%(Filename).asm
armasm64 -o $(IntDir)%(Filename).obj $(IntDir)%(Filename).asm
true
true
true
true
true
true
true
true
false
true
false
true
true
false
false
true
true
true
true
true
true
true
true
true
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
$(IntDir)%(Filename).obj
\ No newline at end of file
diff --git a/libpolyml/realconv.cpp b/libpolyml/realconv.cpp
deleted file mode 100644
index 8f1ff772..00000000
--- a/libpolyml/realconv.cpp
+++ /dev/null
@@ -1,4426 +0,0 @@
-/*
- Note: Although strtod and dtoa seem to be present on some systems
- they are not always included in the headers or in the libraries.
- DCJM 6/4/00
-
- To simplify all this strtod, dtoa and free_dtoa all have
- a poly_ prefix.
-*/
-/****************************************************************
- *
- * The author of this software is David M. Gay.
- *
- * Copyright (c) 1991, 2000, 2001 by Lucent Technologies.
- *
- * Permission to use, copy, modify, and distribute this software for any
- * purpose without fee is hereby granted, provided that this entire notice
- * is included in all copies of any software which is or includes a copy
- * or modification of this software and in all copies of the supporting
- * documentation for such software.
- *
- * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
- * WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY
- * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
- * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
- *
- ***************************************************************/
-
-/* Please send bug reports to David M. Gay (dmg at acm dot org,
- * with " at " changed at "@" and " dot " changed to "."). */
-
-/* On a machine with IEEE extended-precision registers, it is
- * necessary to specify double-precision (53-bit) rounding precision
- * before invoking strtod or dtoa. If the machine uses (the equivalent
- * of) Intel 80x87 arithmetic, the call
- * _control87(PC_53, MCW_PC);
- * does this with many compilers. Whether this or another call is
- * appropriate depends on the compiler; for this to work, it may be
- * necessary to #include "float.h" or another system-dependent header
- * file.
- */
-
-/* strtod for IEEE-, VAX-, and IBM-arithmetic machines.
- * (Note that IEEE arithmetic is disabled by gcc's -ffast-math flag.)
- *
- * This strtod returns a nearest machine number to the input decimal
- * string (or sets errno to ERANGE). With IEEE arithmetic, ties are
- * broken by the IEEE round-even rule. Otherwise ties are broken by
- * biased rounding (add half and chop).
- *
- * Inspired loosely by William D. Clinger's paper "How to Read Floating
- * Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101].
- *
- * Modifications:
- *
- * 1. We only require IEEE, IBM, or VAX double-precision
- * arithmetic (not IEEE double-extended).
- * 2. We get by with floating-point arithmetic in a case that
- * Clinger missed -- when we're computing d * 10^n
- * for a small integer d and the integer n is not too
- * much larger than 22 (the maximum integer k for which
- * we can represent 10^k exactly), we may be able to
- * compute (d*10^k) * 10^(e-k) with just one roundoff.
- * 3. Rather than a bit-at-a-time adjustment of the binary
- * result in the hard case, we use floating-point
- * arithmetic to determine the adjustment to within
- * one bit; only in really hard cases do we need to
- * compute a second residual.
- * 4. Because of 3., we don't need a large table of powers of 10
- * for ten-to-e (just some small tables, e.g. of 10^k
- * for 0 <= k <= 22).
- */
-
-/*
- * #define IEEE_8087 for IEEE-arithmetic machines where the least
- * significant byte has the lowest address.
- * #define IEEE_MC68k for IEEE-arithmetic machines where the most
- * significant byte has the lowest address.
- * #define Long int on machines with 32-bit ints and 64-bit longs.
- * #define IBM for IBM mainframe-style floating-point arithmetic.
- * #define VAX for VAX-style floating-point arithmetic (D_floating).
- * #define No_leftright to omit left-right logic in fast floating-point
- * computation of dtoa. This will cause dtoa modes 4 and 5 to be
- * treated the same as modes 2 and 3 for some inputs.
- * #define Honor_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3
- * and strtod and dtoa should round accordingly. Unless Trust_FLT_ROUNDS
- * is also #defined, fegetround() will be queried for the rounding mode.
- * Note that both FLT_ROUNDS and fegetround() are specified by the C99
- * standard (and are specified to be consistent, with fesetround()
- * affecting the value of FLT_ROUNDS), but that some (Linux) systems
- * do not work correctly in this regard, so using fegetround() is more
- * portable than using FLT_ROUNDS directly.
- * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3
- * and Honor_FLT_ROUNDS is not #defined.
- * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines
- * that use extended-precision instructions to compute rounded
- * products and quotients) with IBM.
- * #define ROUND_BIASED for IEEE-format with biased rounding and arithmetic
- * that rounds toward +Infinity.
- * #define ROUND_BIASED_without_Round_Up for IEEE-format with biased
- * rounding when the underlying floating-point arithmetic uses
- * unbiased rounding. This prevent using ordinary floating-point
- * arithmetic when the result could be computed with one rounding error.
- * #define Inaccurate_Divide for IEEE-format with correctly rounded
- * products but inaccurate quotients, e.g., for Intel i860.
- * #define NO_LONG_LONG on machines that do not have a "long long"
- * integer type (of >= 64 bits). On such machines, you can
- * #define Just_16 to store 16 bits per 32-bit Long when doing
- * high-precision integer arithmetic. Whether this speeds things
- * up or slows things down depends on the machine and the number
- * being converted. If long long is available and the name is
- * something other than "long long", #define Llong to be the name,
- * and if "unsigned Llong" does not work as an unsigned version of
- * Llong, #define #ULLong to be the corresponding unsigned type.
- * #define KR_headers for old-style C function headers.
- * #define Bad_float_h if your system lacks a float.h or if it does not
- * define some or all of DBL_DIG, DBL_MAX_10_EXP, DBL_MAX_EXP,
- * FLT_RADIX, FLT_ROUNDS, and DBL_MAX.
- * #define MALLOC your_malloc, where your_malloc(n) acts like malloc(n)
- * if memory is available and otherwise does something you deem
- * appropriate. If MALLOC is undefined, malloc will be invoked
- * directly -- and assumed always to succeed. Similarly, if you
- * want something other than the system's free() to be called to
- * recycle memory acquired from MALLOC, #define FREE to be the
- * name of the alternate routine. (FREE or free is only called in
- * pathological cases, e.g., in a dtoa call after a dtoa return in
- * mode 3 with thousands of digits requested.)
- * #define Omit_Private_Memory to omit logic (added Jan. 1998) for making
- * memory allocations from a private pool of memory when possible.
- * When used, the private pool is PRIVATE_MEM bytes long: 2304 bytes,
- * unless #defined to be a different length. This default length
- * suffices to get rid of MALLOC calls except for unusual cases,
- * such as decimal-to-binary conversion of a very long string of
- * digits. The longest string dtoa can return is about 751 bytes
- * long. For conversions by strtod of strings of 800 digits and
- * all dtoa conversions in single-threaded executions with 8-byte
- * pointers, PRIVATE_MEM >= 7400 appears to suffice; with 4-byte
- * pointers, PRIVATE_MEM >= 7112 appears adequate.
- * #define NO_INFNAN_CHECK if you do not wish to have INFNAN_CHECK
- * #defined automatically on IEEE systems. On such systems,
- * when INFNAN_CHECK is #defined, strtod checks
- * for Infinity and NaN (case insensitively). On some systems
- * (e.g., some HP systems), it may be necessary to #define NAN_WORD0
- * appropriately -- to the most significant word of a quiet NaN.
- * (On HP Series 700/800 machines, -DNAN_WORD0=0x7ff40000 works.)
- * When INFNAN_CHECK is #defined and No_Hex_NaN is not #defined,
- * strtod also accepts (case insensitively) strings of the form
- * NaN(x), where x is a string of hexadecimal digits and spaces;
- * if there is only one string of hexadecimal digits, it is taken
- * for the 52 fraction bits of the resulting NaN; if there are two
- * or more strings of hex digits, the first is for the high 20 bits,
- * the second and subsequent for the low 32 bits, with intervening
- * white space ignored; but if this results in none of the 52
- * fraction bits being on (an IEEE Infinity symbol), then NAN_WORD0
- * and NAN_WORD1 are used instead.
- * #define MULTIPLE_THREADS if the system offers preemptively scheduled
- * multiple threads. In this case, you must provide (or suitably
- * #define) two locks, acquired by ACQUIRE_DTOA_LOCK(n) and freed
- * by FREE_DTOA_LOCK(n) for n = 0 or 1. (The second lock, accessed
- * in pow5mult, ensures lazy evaluation of only one copy of high
- * powers of 5; omitting this lock would introduce a small
- * probability of wasting memory, but would otherwise be harmless.)
- * You must also invoke freedtoa(s) to free the value s returned by
- * dtoa. You may do so whether or not MULTIPLE_THREADS is #defined.
- * #define NO_IEEE_Scale to disable new (Feb. 1997) logic in strtod that
- * avoids underflows on inputs whose result does not underflow.
- * If you #define NO_IEEE_Scale on a machine that uses IEEE-format
- * floating-point numbers and flushes underflows to zero rather
- * than implementing gradual underflow, then you must also #define
- * Sudden_Underflow.
- * #define USE_LOCALE to use the current locale's decimal_point value.
- * #define SET_INEXACT if IEEE arithmetic is being used and extra
- * computation should be done to set the inexact flag when the
- * result is inexact and avoid setting inexact when the result
- * is exact. In this case, dtoa.c must be compiled in
- * an environment, perhaps provided by #include "dtoa.c" in a
- * suitable wrapper, that defines two functions,
- * int get_inexact(void);
- * void clear_inexact(void);
- * such that get_inexact() returns a nonzero value if the
- * inexact bit is already set, and clear_inexact() sets the
- * inexact bit to 0. When SET_INEXACT is #defined, strtod
- * also does extra computations to set the underflow and overflow
- * flags when appropriate (i.e., when the result is tiny and
- * inexact or when it is a numeric value rounded to +-infinity).
- * #define NO_ERRNO if strtod should not assign errno = ERANGE when
- * the result overflows to +-Infinity or underflows to 0.
- * #define NO_HEX_FP to omit recognition of hexadecimal floating-point
- * values by strtod.
- * #define NO_STRTOD_BIGCOMP (on IEEE-arithmetic systems only for now)
- * to disable logic for "fast" testing of very long input strings
- * to strtod. This testing proceeds by initially truncating the
- * input string, then if necessary comparing the whole string with
- * a decimal expansion to decide close cases. This logic is only
- * used for input more than STRTOD_DIGLIM digits long (default 40).
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#elif defined(_WIN32)
-#include "winconfig.h"
-#else
-#error "No configuration file"
-#endif
-
-#include "realconv.h"
-#include "locking.h"
-
-#ifdef WORDS_BIGENDIAN
-#define IEEE_MC68k // Big endian
-#else
-#define IEEE_8087 // Little endian
-#endif
-
-#if (SIZEOF_LONG == 8)
-// If "long" is the same size as "double" we need to define this.
-#define Long int
-#define ULong unsigned
-#endif
-
-#ifndef HAVE_LONG_LONG
-#define NO_LONG_LONG
-#endif
-
-#ifndef Long
-#define Long long
-#endif
-#ifndef ULong
-typedef unsigned Long ULong;
-#endif
-
-#ifdef DEBUG
-#include "stdio.h"
-#define Bug(x) {fprintf(stderr, "%s\n", x); exit(1);}
-#endif
-
-#include "stdlib.h"
-#include "string.h"
-
-#ifdef USE_LOCALE
-#include "locale.h"
-#endif
-
-#ifdef Honor_FLT_ROUNDS
-#ifndef Trust_FLT_ROUNDS
-#include
-#endif
-#endif
-
-#ifdef MALLOC
-#ifdef KR_headers
-extern char *MALLOC();
-#else
-extern void *MALLOC(size_t);
-#endif
-#else
-#define MALLOC malloc
-#endif
-
-#ifndef Omit_Private_Memory
-#ifndef PRIVATE_MEM
-#define PRIVATE_MEM 2304
-#endif
-#define PRIVATE_mem ((PRIVATE_MEM+sizeof(double)-1)/sizeof(double))
-static double private_mem[PRIVATE_mem], *pmem_next = private_mem;
-#endif
-
-#undef IEEE_Arith
-#undef Avoid_Underflow
-#ifdef IEEE_MC68k
-#define IEEE_Arith
-#endif
-#ifdef IEEE_8087
-#define IEEE_Arith
-#endif
-
-#ifdef IEEE_Arith
-#ifndef NO_INFNAN_CHECK
-#undef INFNAN_CHECK
-#define INFNAN_CHECK
-#endif
-#else
-#undef INFNAN_CHECK
-#define NO_STRTOD_BIGCOMP
-#endif
-
-#include "errno.h"
-
-#ifdef Bad_float_h
-
-#ifdef IEEE_Arith
-#define DBL_DIG 15
-#define DBL_MAX_10_EXP 308
-#define DBL_MAX_EXP 1024
-#define FLT_RADIX 2
-#endif /*IEEE_Arith*/
-
-#ifdef IBM
-#define DBL_DIG 16
-#define DBL_MAX_10_EXP 75
-#define DBL_MAX_EXP 63
-#define FLT_RADIX 16
-#define DBL_MAX 7.2370055773322621e+75
-#endif
-
-#ifdef VAX
-#define DBL_DIG 16
-#define DBL_MAX_10_EXP 38
-#define DBL_MAX_EXP 127
-#define FLT_RADIX 2
-#define DBL_MAX 1.7014118346046923e+38
-#endif
-
-#ifndef LONG_MAX
-#define LONG_MAX 2147483647
-#endif
-
-#else /* ifndef Bad_float_h */
-#include "float.h"
-#endif /* Bad_float_h */
-
-#ifndef __MATH_H__
-#include "math.h"
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-#ifndef CONST
-#ifdef KR_headers
-#define CONST /* blank */
-#else
-#define CONST const
-#endif
-#endif
-
-#if defined(IEEE_8087) + defined(IEEE_MC68k) + defined(VAX) + defined(IBM) != 1
-Exactly one of IEEE_8087, IEEE_MC68k, VAX, or IBM should be defined.
-#endif
-
-typedef union { double d; ULong L[2]; } U;
-
-#ifdef IEEE_8087
-#define word0(x) (x)->L[1]
-#define word1(x) (x)->L[0]
-#else
-#define word0(x) (x)->L[0]
-#define word1(x) (x)->L[1]
-#endif
-#define dval(x) (x)->d
-
-#ifndef STRTOD_DIGLIM
-#define STRTOD_DIGLIM 40
-#endif
-
-#ifdef DIGLIM_DEBUG
-extern int strtod_diglim;
-#else
-#define strtod_diglim STRTOD_DIGLIM
-#endif
-
-/* The following definition of Storeinc is appropriate for MIPS processors.
- * An alternative that might be better on some machines is
- * #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
- */
-#if defined(IEEE_8087) + defined(VAX)
-#define Storeinc(a,b,c) (((unsigned short *)a)[1] = (unsigned short)b, \
-((unsigned short *)a)[0] = (unsigned short)c, a++)
-#else
-#define Storeinc(a,b,c) (((unsigned short *)a)[0] = (unsigned short)b, \
-((unsigned short *)a)[1] = (unsigned short)c, a++)
-#endif
-
-/* #define P DBL_MANT_DIG */
-/* Ten_pmax = floor(P*log(2)/log(5)) */
-/* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
-/* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
-/* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
-
-#ifdef IEEE_Arith
-#define Exp_shift 20
-#define Exp_shift1 20
-#define Exp_msk1 0x100000
-#define Exp_msk11 0x100000
-#define Exp_mask 0x7ff00000
-#define P 53
-#define Nbits 53
-#define Bias 1023
-#define Emax 1023
-#define Emin (-1022)
-#define Exp_1 0x3ff00000
-#define Exp_11 0x3ff00000
-#define Ebits 11
-#define Frac_mask 0xfffff
-#define Frac_mask1 0xfffff
-#define Ten_pmax 22
-#define Bletch 0x10
-#define Bndry_mask 0xfffff
-#define Bndry_mask1 0xfffff
-#define LSB 1
-#define Sign_bit 0x80000000
-#define Log2P 1
-#define Tiny0 0
-#define Tiny1 1
-#define Quick_max 14
-#define Int_max 14
-#ifndef NO_IEEE_Scale
-#define Avoid_Underflow
-#ifdef Flush_Denorm /* debugging option */
-#undef Sudden_Underflow
-#endif
-#endif
-
-#ifndef Flt_Rounds
-#ifdef FLT_ROUNDS
-#define Flt_Rounds FLT_ROUNDS
-#else
-#define Flt_Rounds 1
-#endif
-#endif /*Flt_Rounds*/
-
-#ifdef Honor_FLT_ROUNDS
-#undef Check_FLT_ROUNDS
-#define Check_FLT_ROUNDS
-#else
-#define Rounding Flt_Rounds
-#endif
-
-#else /* ifndef IEEE_Arith */
-#undef Check_FLT_ROUNDS
-#undef Honor_FLT_ROUNDS
-#undef SET_INEXACT
-#undef Sudden_Underflow
-#define Sudden_Underflow
-#ifdef IBM
-#undef Flt_Rounds
-#define Flt_Rounds 0
-#define Exp_shift 24
-#define Exp_shift1 24
-#define Exp_msk1 0x1000000
-#define Exp_msk11 0x1000000
-#define Exp_mask 0x7f000000
-#define P 14
-#define Nbits 56
-#define Bias 65
-#define Emax 248
-#define Emin (-260)
-#define Exp_1 0x41000000
-#define Exp_11 0x41000000
-#define Ebits 8 /* exponent has 7 bits, but 8 is the right value in b2d */
-#define Frac_mask 0xffffff
-#define Frac_mask1 0xffffff
-#define Bletch 4
-#define Ten_pmax 22
-#define Bndry_mask 0xefffff
-#define Bndry_mask1 0xffffff
-#define LSB 1
-#define Sign_bit 0x80000000
-#define Log2P 4
-#define Tiny0 0x100000
-#define Tiny1 0
-#define Quick_max 14
-#define Int_max 15
-#else /* VAX */
-#undef Flt_Rounds
-#define Flt_Rounds 1
-#define Exp_shift 23
-#define Exp_shift1 7
-#define Exp_msk1 0x80
-#define Exp_msk11 0x800000
-#define Exp_mask 0x7f80
-#define P 56
-#define Nbits 56
-#define Bias 129
-#define Emax 126
-#define Emin (-129)
-#define Exp_1 0x40800000
-#define Exp_11 0x4080
-#define Ebits 8
-#define Frac_mask 0x7fffff
-#define Frac_mask1 0xffff007f
-#define Ten_pmax 24
-#define Bletch 2
-#define Bndry_mask 0xffff007f
-#define Bndry_mask1 0xffff007f
-#define LSB 0x10000
-#define Sign_bit 0x8000
-#define Log2P 1
-#define Tiny0 0x80
-#define Tiny1 0
-#define Quick_max 15
-#define Int_max 15
-#endif /* IBM, VAX */
-#endif /* IEEE_Arith */
-
-#ifndef IEEE_Arith
-#define ROUND_BIASED
-#else
-#ifdef ROUND_BIASED_without_Round_Up
-#undef ROUND_BIASED
-#define ROUND_BIASED
-#endif
-#endif
-
-#ifdef RND_PRODQUOT
-#define rounded_product(a,b) a = rnd_prod(a, b)
-#define rounded_quotient(a,b) a = rnd_quot(a, b)
-#ifdef KR_headers
-extern double rnd_prod(), rnd_quot();
-#else
-extern double rnd_prod(double, double), rnd_quot(double, double);
-#endif
-#else
-#define rounded_product(a,b) a *= b
-#define rounded_quotient(a,b) a /= b
-#endif
-
-#define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
-#define Big1 0xffffffff
-
-#ifndef Pack_32
-#define Pack_32
-#endif
-
-typedef struct BCinfo BCinfo;
- struct
-BCinfo { int dp0, dp1, dplen, dsign, e0, inexact, nd, nd0, rounding, scale, uflchk; };
-
-#ifdef KR_headers
-#define FFFFFFFF ((((unsigned long)0xffff)<<16)|(unsigned long)0xffff)
-#else
-#define FFFFFFFF 0xffffffffUL
-#endif
-
-#ifdef NO_LONG_LONG
-#undef ULLong
-#ifdef Just_16
-#undef Pack_32
-/* When Pack_32 is not defined, we store 16 bits per 32-bit Long.
- * This makes some inner loops simpler and sometimes saves work
- * during multiplications, but it often seems to make things slightly
- * slower. Hence the default is now to store 32 bits per Long.
- */
-#endif
-#else /* long long available */
-#ifndef Llong
-#define Llong long long
-#endif
-#ifndef ULLong
-#define ULLong unsigned Llong
-#endif
-#endif /* NO_LONG_LONG */
-
-#define MULTIPLE_THREADS
-static PLock dtoaLocks[2];
-#define ACQUIRE_DTOA_LOCK(n) { dtoaLocks[n].Lock(); }
-#define FREE_DTOA_LOCK(n) { dtoaLocks[n].Unlock(); }
-
-#ifndef MULTIPLE_THREADS
-#define ACQUIRE_DTOA_LOCK(n) /*nothing*/
-#define FREE_DTOA_LOCK(n) /*nothing*/
-#endif
-
-#define Kmax 7
-
-#ifdef __cplusplus
-extern "C" double strtod(const char *s00, char **se);
-extern "C" char *dtoa(double d, int mode, int ndigits,
- int *decpt, int *sign, char **rve);
-#endif
-
- struct
-Bigint {
- struct Bigint *next;
- int k, maxwds, sign, wds;
- ULong x[1];
- };
-
- typedef struct Bigint Bigint;
-
- static Bigint *freelist[Kmax+1];
-
- static Bigint *
-Balloc
-#ifdef KR_headers
- (k) int k;
-#else
- (int k)
-#endif
-{
- int x;
- Bigint *rv;
-#ifndef Omit_Private_Memory
- unsigned int len;
-#endif
-
- ACQUIRE_DTOA_LOCK(0);
- /* The k > Kmax case does not need ACQUIRE_DTOA_LOCK(0), */
- /* but this case seems very unlikely. */
- if (k <= Kmax && (rv = freelist[k]))
- freelist[k] = rv->next;
- else {
- x = 1 << k;
-#ifdef Omit_Private_Memory
- rv = (Bigint *)MALLOC(sizeof(Bigint) + (x-1)*sizeof(ULong));
-#else
- len = (sizeof(Bigint) + (x-1)*sizeof(ULong) + sizeof(double) - 1)
- /sizeof(double);
- if (k <= Kmax && pmem_next - private_mem + len <= PRIVATE_mem) {
- rv = (Bigint*)pmem_next;
- pmem_next += len;
- }
- else
- rv = (Bigint*)MALLOC(len*sizeof(double));
-#endif
- rv->k = k;
- rv->maxwds = x;
- }
- FREE_DTOA_LOCK(0);
- rv->sign = rv->wds = 0;
- return rv;
- }
-
- static void
-Bfree
-#ifdef KR_headers
- (v) Bigint *v;
-#else
- (Bigint *v)
-#endif
-{
- if (v) {
- if (v->k > Kmax)
-#ifdef FREE
- FREE((void*)v);
-#else
- free((void*)v);
-#endif
- else {
- ACQUIRE_DTOA_LOCK(0);
- v->next = freelist[v->k];
- freelist[v->k] = v;
- FREE_DTOA_LOCK(0);
- }
- }
- }
-
-#define Bcopy(x,y) memcpy((char *)&x->sign, (char *)&y->sign, \
-y->wds*sizeof(Long) + 2*sizeof(int))
-
- static Bigint *
-multadd
-#ifdef KR_headers
- (b, m, a) Bigint *b; int m, a;
-#else
- (Bigint *b, int m, int a) /* multiply by m and add a */
-#endif
-{
- int i, wds;
-#ifdef ULLong
- ULong *x;
- ULLong carry, y;
-#else
- ULong carry, *x, y;
-#ifdef Pack_32
- ULong xi, z;
-#endif
-#endif
- Bigint *b1;
-
- wds = b->wds;
- x = b->x;
- i = 0;
- carry = a;
- do {
-#ifdef ULLong
- y = *x * (ULLong)m + carry;
- carry = y >> 32;
- *x++ = y & FFFFFFFF;
-#else
-#ifdef Pack_32
- xi = *x;
- y = (xi & 0xffff) * m + carry;
- z = (xi >> 16) * m + (y >> 16);
- carry = z >> 16;
- *x++ = (z << 16) + (y & 0xffff);
-#else
- y = *x * m + carry;
- carry = y >> 16;
- *x++ = y & 0xffff;
-#endif
-#endif
- }
- while(++i < wds);
- if (carry) {
- if (wds >= b->maxwds) {
- b1 = Balloc(b->k+1);
- Bcopy(b1, b);
- Bfree(b);
- b = b1;
- }
- b->x[wds++] = carry;
- b->wds = wds;
- }
- return b;
- }
-
-#ifndef HAVE_STRTOD
- static Bigint *
-s2b
-#ifdef KR_headers
- (s, nd0, nd, y9, dplen) CONST char *s; int nd0, nd, dplen; ULong y9;
-#else
- (const char *s, int nd0, int nd, ULong y9, int dplen)
-#endif
-{
- Bigint *b;
- int i, k;
- Long x, y;
-
- x = (nd + 8) / 9;
- for(k = 0, y = 1; x > y; y <<= 1, k++) ;
-#ifdef Pack_32
- b = Balloc(k);
- b->x[0] = y9;
- b->wds = 1;
-#else
- b = Balloc(k+1);
- b->x[0] = y9 & 0xffff;
- b->wds = (b->x[1] = y9 >> 16) ? 2 : 1;
-#endif
-
- i = 9;
- if (9 < nd0) {
- s += 9;
- do b = multadd(b, 10, *s++ - '0');
- while(++i < nd0);
- s += dplen;
- }
- else
- s += dplen + 9;
- for(; i < nd; i++)
- b = multadd(b, 10, *s++ - '0');
- return b;
- }
-
-#endif // HAVE_STRTOD
-
- static int
-hi0bits
-#ifdef KR_headers
- (x) ULong x;
-#else
- (ULong x)
-#endif
-{
- int k = 0;
-
- if (!(x & 0xffff0000)) {
- k = 16;
- x <<= 16;
- }
- if (!(x & 0xff000000)) {
- k += 8;
- x <<= 8;
- }
- if (!(x & 0xf0000000)) {
- k += 4;
- x <<= 4;
- }
- if (!(x & 0xc0000000)) {
- k += 2;
- x <<= 2;
- }
- if (!(x & 0x80000000)) {
- k++;
- if (!(x & 0x40000000))
- return 32;
- }
- return k;
- }
-
- static int
-lo0bits
-#ifdef KR_headers
- (y) ULong *y;
-#else
- (ULong *y)
-#endif
-{
- int k;
- ULong x = *y;
-
- if (x & 7) {
- if (x & 1)
- return 0;
- if (x & 2) {
- *y = x >> 1;
- return 1;
- }
- *y = x >> 2;
- return 2;
- }
- k = 0;
- if (!(x & 0xffff)) {
- k = 16;
- x >>= 16;
- }
- if (!(x & 0xff)) {
- k += 8;
- x >>= 8;
- }
- if (!(x & 0xf)) {
- k += 4;
- x >>= 4;
- }
- if (!(x & 0x3)) {
- k += 2;
- x >>= 2;
- }
- if (!(x & 1)) {
- k++;
- x >>= 1;
- if (!x)
- return 32;
- }
- *y = x;
- return k;
- }
-
- static Bigint *
-i2b
-#ifdef KR_headers
- (i) int i;
-#else
- (int i)
-#endif
-{
- Bigint *b;
-
- b = Balloc(1);
- b->x[0] = i;
- b->wds = 1;
- return b;
- }
-
- static Bigint *
-mult
-#ifdef KR_headers
- (a, b) Bigint *a, *b;
-#else
- (Bigint *a, Bigint *b)
-#endif
-{
- Bigint *c;
- int k, wa, wb, wc;
- ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
- ULong y;
-#ifdef ULLong
- ULLong carry, z;
-#else
- ULong carry, z;
-#ifdef Pack_32
- ULong z2;
-#endif
-#endif
-
- if (a->wds < b->wds) {
- c = a;
- a = b;
- b = c;
- }
- k = a->k;
- wa = a->wds;
- wb = b->wds;
- wc = wa + wb;
- if (wc > a->maxwds)
- k++;
- c = Balloc(k);
- for(x = c->x, xa = x + wc; x < xa; x++)
- *x = 0;
- xa = a->x;
- xae = xa + wa;
- xb = b->x;
- xbe = xb + wb;
- xc0 = c->x;
-#ifdef ULLong
- for(; xb < xbe; xc0++) {
- if ((y = *xb++)) {
- x = xa;
- xc = xc0;
- carry = 0;
- do {
- z = *x++ * (ULLong)y + *xc + carry;
- carry = z >> 32;
- *xc++ = z & FFFFFFFF;
- }
- while(x < xae);
- *xc = carry;
- }
- }
-#else
-#ifdef Pack_32
- for(; xb < xbe; xb++, xc0++) {
- if (y = *xb & 0xffff) {
- x = xa;
- xc = xc0;
- carry = 0;
- do {
- z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
- carry = z >> 16;
- z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
- carry = z2 >> 16;
- Storeinc(xc, z2, z);
- }
- while(x < xae);
- *xc = carry;
- }
- if (y = *xb >> 16) {
- x = xa;
- xc = xc0;
- carry = 0;
- z2 = *xc;
- do {
- z = (*x & 0xffff) * y + (*xc >> 16) + carry;
- carry = z >> 16;
- Storeinc(xc, z, z2);
- z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
- carry = z2 >> 16;
- }
- while(x < xae);
- *xc = z2;
- }
- }
-#else
- for(; xb < xbe; xc0++) {
- if (y = *xb++) {
- x = xa;
- xc = xc0;
- carry = 0;
- do {
- z = *x++ * y + *xc + carry;
- carry = z >> 16;
- *xc++ = z & 0xffff;
- }
- while(x < xae);
- *xc = carry;
- }
- }
-#endif
-#endif
- for(xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc) ;
- c->wds = wc;
- return c;
- }
-
- static Bigint *p5s;
-
- static Bigint *
-pow5mult
-#ifdef KR_headers
- (b, k) Bigint *b; int k;
-#else
- (Bigint *b, int k)
-#endif
-{
- Bigint *b1, *p5, *p51;
- int i;
- static int p05[3] = { 5, 25, 125 };
-
- if ((i = k & 3))
- b = multadd(b, p05[i-1], 0);
-
- if (!(k >>= 2))
- return b;
- if (!(p5 = p5s)) {
- /* first time */
-#ifdef MULTIPLE_THREADS
- ACQUIRE_DTOA_LOCK(1);
- if (!(p5 = p5s)) {
- p5 = p5s = i2b(625);
- p5->next = 0;
- }
- FREE_DTOA_LOCK(1);
-#else
- p5 = p5s = i2b(625);
- p5->next = 0;
-#endif
- }
- for(;;) {
- if (k & 1) {
- b1 = mult(b, p5);
- Bfree(b);
- b = b1;
- }
- if (!(k >>= 1))
- break;
- if (!(p51 = p5->next)) {
-#ifdef MULTIPLE_THREADS
- ACQUIRE_DTOA_LOCK(1);
- if (!(p51 = p5->next)) {
- p51 = p5->next = mult(p5,p5);
- p51->next = 0;
- }
- FREE_DTOA_LOCK(1);
-#else
- p51 = p5->next = mult(p5,p5);
- p51->next = 0;
-#endif
- }
- p5 = p51;
- }
- return b;
- }
-
- static Bigint *
-lshift
-#ifdef KR_headers
- (b, k) Bigint *b; int k;
-#else
- (Bigint *b, int k)
-#endif
-{
- int i, k1, n, n1;
- Bigint *b1;
- ULong *x, *x1, *xe, z;
-
-#ifdef Pack_32
- n = k >> 5;
-#else
- n = k >> 4;
-#endif
- k1 = b->k;
- n1 = n + b->wds + 1;
- for(i = b->maxwds; n1 > i; i <<= 1)
- k1++;
- b1 = Balloc(k1);
- x1 = b1->x;
- for(i = 0; i < n; i++)
- *x1++ = 0;
- x = b->x;
- xe = x + b->wds;
-#ifdef Pack_32
- if (k &= 0x1f) {
- k1 = 32 - k;
- z = 0;
- do {
- *x1++ = *x << k | z;
- z = *x++ >> k1;
- }
- while(x < xe);
- if ((*x1 = z))
- ++n1;
- }
-#else
- if (k &= 0xf) {
- k1 = 16 - k;
- z = 0;
- do {
- *x1++ = *x << k & 0xffff | z;
- z = *x++ >> k1;
- }
- while(x < xe);
- if (*x1 = z)
- ++n1;
- }
-#endif
- else do
- *x1++ = *x++;
- while(x < xe);
- b1->wds = n1 - 1;
- Bfree(b);
- return b1;
- }
-
- static int
-cmp
-#ifdef KR_headers
- (a, b) Bigint *a, *b;
-#else
- (Bigint *a, Bigint *b)
-#endif
-{
- ULong *xa, *xa0, *xb, *xb0;
- int i, j;
-
- i = a->wds;
- j = b->wds;
-#ifdef DEBUG
- if (i > 1 && !a->x[i-1])
- Bug("cmp called with a->x[a->wds-1] == 0");
- if (j > 1 && !b->x[j-1])
- Bug("cmp called with b->x[b->wds-1] == 0");
-#endif
- if (i -= j)
- return i;
- xa0 = a->x;
- xa = xa0 + j;
- xb0 = b->x;
- xb = xb0 + j;
- for(;;) {
- if (*--xa != *--xb)
- return *xa < *xb ? -1 : 1;
- if (xa <= xa0)
- break;
- }
- return 0;
- }
-
- static Bigint *
-diff
-#ifdef KR_headers
- (a, b) Bigint *a, *b;
-#else
- (Bigint *a, Bigint *b)
-#endif
-{
- Bigint *c;
- int i, wa, wb;
- ULong *xa, *xae, *xb, *xbe, *xc;
-#ifdef ULLong
- ULLong borrow, y;
-#else
- ULong borrow, y;
-#ifdef Pack_32
- ULong z;
-#endif
-#endif
-
- i = cmp(a,b);
- if (!i) {
- c = Balloc(0);
- c->wds = 1;
- c->x[0] = 0;
- return c;
- }
- if (i < 0) {
- c = a;
- a = b;
- b = c;
- i = 1;
- }
- else
- i = 0;
- c = Balloc(a->k);
- c->sign = i;
- wa = a->wds;
- xa = a->x;
- xae = xa + wa;
- wb = b->wds;
- xb = b->x;
- xbe = xb + wb;
- xc = c->x;
- borrow = 0;
-#ifdef ULLong
- do {
- y = (ULLong)*xa++ - *xb++ - borrow;
- borrow = y >> 32 & (ULong)1;
- *xc++ = y & FFFFFFFF;
- }
- while(xb < xbe);
- while(xa < xae) {
- y = *xa++ - borrow;
- borrow = y >> 32 & (ULong)1;
- *xc++ = y & FFFFFFFF;
- }
-#else
-#ifdef Pack_32
- do {
- y = (*xa & 0xffff) - (*xb & 0xffff) - borrow;
- borrow = (y & 0x10000) >> 16;
- z = (*xa++ >> 16) - (*xb++ >> 16) - borrow;
- borrow = (z & 0x10000) >> 16;
- Storeinc(xc, z, y);
- }
- while(xb < xbe);
- while(xa < xae) {
- y = (*xa & 0xffff) - borrow;
- borrow = (y & 0x10000) >> 16;
- z = (*xa++ >> 16) - borrow;
- borrow = (z & 0x10000) >> 16;
- Storeinc(xc, z, y);
- }
-#else
- do {
- y = *xa++ - *xb++ - borrow;
- borrow = (y & 0x10000) >> 16;
- *xc++ = y & 0xffff;
- }
- while(xb < xbe);
- while(xa < xae) {
- y = *xa++ - borrow;
- borrow = (y & 0x10000) >> 16;
- *xc++ = y & 0xffff;
- }
-#endif
-#endif
- while(!*--xc)
- wa--;
- c->wds = wa;
- return c;
- }
-
-#ifndef HAVE_STRTOD
-
- static double
-ulp
-#ifdef KR_headers
- (x) U *x;
-#else
- (U *x)
-#endif
-{
- Long L;
- U u;
-
- L = (word0(x) & Exp_mask) - (P-1)*Exp_msk1;
-#ifndef Avoid_Underflow
-#ifndef Sudden_Underflow
- if (L > 0) {
-#endif
-#endif
-#ifdef IBM
- L |= Exp_msk1 >> 4;
-#endif
- word0(&u) = L;
- word1(&u) = 0;
-#ifndef Avoid_Underflow
-#ifndef Sudden_Underflow
- }
- else {
- L = -L >> Exp_shift;
- if (L < Exp_shift) {
- word0(&u) = 0x80000 >> L;
- word1(&u) = 0;
- }
- else {
- word0(&u) = 0;
- L -= Exp_shift;
- word1(&u) = L >= 31 ? 1 : 1 << 31 - L;
- }
- }
-#endif
-#endif
- return dval(&u);
- }
-
- static double
-b2d
-#ifdef KR_headers
- (a, e) Bigint *a; int *e;
-#else
- (Bigint *a, int *e)
-#endif
-{
- ULong *xa, *xa0, w, y, z;
- int k;
- U d;
-#ifdef VAX
- ULong d0, d1;
-#else
-#define d0 word0(&d)
-#define d1 word1(&d)
-#endif
-
- xa0 = a->x;
- xa = xa0 + a->wds;
- y = *--xa;
-#ifdef DEBUG
- if (!y) Bug("zero y in b2d");
-#endif
- k = hi0bits(y);
- *e = 32 - k;
-#ifdef Pack_32
- if (k < Ebits) {
- d0 = Exp_1 | y >> (Ebits - k);
- w = xa > xa0 ? *--xa : 0;
- d1 = y << ((32-Ebits) + k) | w >> (Ebits - k);
- goto ret_d;
- }
- z = xa > xa0 ? *--xa : 0;
- if (k -= Ebits) {
- d0 = Exp_1 | y << k | z >> (32 - k);
- y = xa > xa0 ? *--xa : 0;
- d1 = z << k | y >> (32 - k);
- }
- else {
- d0 = Exp_1 | y;
- d1 = z;
- }
-#else
- if (k < Ebits + 16) {
- z = xa > xa0 ? *--xa : 0;
- d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
- w = xa > xa0 ? *--xa : 0;
- y = xa > xa0 ? *--xa : 0;
- d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
- goto ret_d;
- }
- z = xa > xa0 ? *--xa : 0;
- w = xa > xa0 ? *--xa : 0;
- k -= Ebits + 16;
- d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
- y = xa > xa0 ? *--xa : 0;
- d1 = w << k + 16 | y << k;
-#endif
- ret_d:
-#ifdef VAX
- word0(&d) = d0 >> 16 | d0 << 16;
- word1(&d) = d1 >> 16 | d1 << 16;
-#else
-#undef d0
-#undef d1
-#endif
- return dval(&d);
- }
-
-#endif // HAVE_STRTOD
-
- static Bigint *
-d2b
-#ifdef KR_headers
- (d, e, bits) U *d; int *e, *bits;
-#else
- (U *d, int *e, int *bits)
-#endif
-{
- Bigint *b;
- int de, k;
- ULong *x, y, z;
-#ifndef Sudden_Underflow
- int i;
-#endif
-#ifdef VAX
- ULong d0, d1;
- d0 = word0(d) >> 16 | word0(d) << 16;
- d1 = word1(d) >> 16 | word1(d) << 16;
-#else
-#define d0 word0(d)
-#define d1 word1(d)
-#endif
-
-#ifdef Pack_32
- b = Balloc(1);
-#else
- b = Balloc(2);
-#endif
- x = b->x;
-
- z = d0 & Frac_mask;
- d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
-#ifdef Sudden_Underflow
- de = (int)(d0 >> Exp_shift);
-#ifndef IBM
- z |= Exp_msk11;
-#endif
-#else
- if ((de = (int)(d0 >> Exp_shift)))
- z |= Exp_msk1;
-#endif
-#ifdef Pack_32
- if ((y = d1)) {
- if ((k = lo0bits(&y))) {
- x[0] = y | z << (32 - k);
- z >>= k;
- }
- else
- x[0] = y;
-#ifndef Sudden_Underflow
- i =
-#endif
- b->wds = (x[1] = z) ? 2 : 1;
- }
- else {
- k = lo0bits(&z);
- x[0] = z;
-#ifndef Sudden_Underflow
- i =
-#endif
- b->wds = 1;
- k += 32;
- }
-#else
- if (y = d1) {
- if (k = lo0bits(&y))
- if (k >= 16) {
- x[0] = y | z << 32 - k & 0xffff;
- x[1] = z >> k - 16 & 0xffff;
- x[2] = z >> k;
- i = 2;
- }
- else {
- x[0] = y & 0xffff;
- x[1] = y >> 16 | z << 16 - k & 0xffff;
- x[2] = z >> k & 0xffff;
- x[3] = z >> k+16;
- i = 3;
- }
- else {
- x[0] = y & 0xffff;
- x[1] = y >> 16;
- x[2] = z & 0xffff;
- x[3] = z >> 16;
- i = 3;
- }
- }
- else {
-#ifdef DEBUG
- if (!z)
- Bug("Zero passed to d2b");
-#endif
- k = lo0bits(&z);
- if (k >= 16) {
- x[0] = z;
- i = 0;
- }
- else {
- x[0] = z & 0xffff;
- x[1] = z >> 16;
- i = 1;
- }
- k += 32;
- }
- while(!x[i])
- --i;
- b->wds = i + 1;
-#endif
-#ifndef Sudden_Underflow
- if (de) {
-#endif
-#ifdef IBM
- *e = (de - Bias - (P-1) << 2) + k;
- *bits = 4*P + 8 - k - hi0bits(word0(d) & Frac_mask);
-#else
- *e = de - Bias - (P-1) + k;
- *bits = P - k;
-#endif
-#ifndef Sudden_Underflow
- }
- else {
- *e = de - Bias - (P-1) + 1 + k;
-#ifdef Pack_32
- *bits = 32*i - hi0bits(x[i-1]);
-#else
- *bits = (i+2)*16 - hi0bits(x[i]);
-#endif
- }
-#endif
- return b;
- }
-#undef d0
-#undef d1
-
-#ifndef HAVE_STRTOD
- static double
-ratio
-#ifdef KR_headers
- (a, b) Bigint *a, *b;
-#else
- (Bigint *a, Bigint *b)
-#endif
-{
- U da, db;
- int k, ka, kb;
-
- dval(&da) = b2d(a, &ka);
- dval(&db) = b2d(b, &kb);
-#ifdef Pack_32
- k = ka - kb + 32*(a->wds - b->wds);
-#else
- k = ka - kb + 16*(a->wds - b->wds);
-#endif
-#ifdef IBM
- if (k > 0) {
- word0(&da) += (k >> 2)*Exp_msk1;
- if (k &= 3)
- dval(&da) *= 1 << k;
- }
- else {
- k = -k;
- word0(&db) += (k >> 2)*Exp_msk1;
- if (k &= 3)
- dval(&db) *= 1 << k;
- }
-#else
- if (k > 0)
- word0(&da) += k*Exp_msk1;
- else {
- k = -k;
- word0(&db) += k*Exp_msk1;
- }
-#endif
- return dval(&da) / dval(&db);
- }
-#endif // HAVE_STRTOD
-
- static CONST double
-tens[] = {
- 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
- 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
- 1e20, 1e21, 1e22
-#ifdef VAX
- , 1e23, 1e24
-#endif
- };
-
- static CONST double
-#ifdef IEEE_Arith
-bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 };
-static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128,
-#ifdef Avoid_Underflow
- 9007199254740992.*9007199254740992.e-256
- /* = 2^106 * 1e-256 */
-#else
- 1e-256
-#endif
- };
-/* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */
-/* flag unnecessarily. It leads to a song and dance at the end of strtod. */
-#define Scale_Bit 0x10
-#define n_bigtens 5
-#else
-#ifdef IBM
-bigtens[] = { 1e16, 1e32, 1e64 };
-static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 };
-#define n_bigtens 3
-#else
-bigtens[] = { 1e16, 1e32 };
-static CONST double tinytens[] = { 1e-16, 1e-32 };
-#define n_bigtens 2
-#endif
-#endif
-
-#undef Need_Hexdig
-#ifdef INFNAN_CHECK
-#ifndef No_Hex_NaN
-#define Need_Hexdig
-#endif
-#endif
-
-#ifndef Need_Hexdig
-#ifndef NO_HEX_FP
-#define Need_Hexdig
-#endif
-#endif
-
-#ifdef Need_Hexdig /*{*/
-#if 0
-static unsigned char hexdig[256];
-
- static void
-htinit(unsigned char *h, unsigned char *s, int inc)
-{
- int i, j;
- for(i = 0; (j = s[i]) !=0; i++)
- h[j] = i + inc;
- }
-
- static void
-hexdig_init(void) /* Use of hexdig_init omitted 20121220 to avoid a */
- /* race condition when multiple threads are used. */
-{
-#define USC (unsigned char *)
- htinit(hexdig, USC "0123456789", 0x10);
- htinit(hexdig, USC "abcdef", 0x10 + 10);
- htinit(hexdig, USC "ABCDEF", 0x10 + 10);
- }
-#else
-static unsigned char hexdig[256] = {
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 16,17,18,19,20,21,22,23,24,25,0,0,0,0,0,0,
- 0,26,27,28,29,30,31,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,26,27,28,29,30,31,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
- };
-#endif
-#endif /* } Need_Hexdig */
-
-#ifdef INFNAN_CHECK
-
-#ifndef NAN_WORD0
-#define NAN_WORD0 0x7ff80000
-#endif
-
-#ifndef NAN_WORD1
-#define NAN_WORD1 0
-#endif
-
-#ifndef HAVE_STRTOD
- static int
-match
-#ifdef KR_headers
- (sp, t) char **sp, *t;
-#else
- (const char **sp, const char *t)
-#endif
-{
- int c, d;
- CONST char *s = *sp;
-
- while((d = *t++)) {
- if ((c = *++s) >= 'A' && c <= 'Z')
- c += 'a' - 'A';
- if (c != d)
- return 0;
- }
- *sp = s + 1;
- return 1;
- }
-
-#ifndef No_Hex_NaN
- static void
-hexnan
-#ifdef KR_headers
- (rvp, sp) U *rvp; CONST char **sp;
-#else
- (U *rvp, const char **sp)
-#endif
-{
- ULong c, x[2];
- CONST char *s;
- int c1, havedig, udx0, xshift;
-
- /**** if (!hexdig['0']) hexdig_init(); ****/
- x[0] = x[1] = 0;
- havedig = xshift = 0;
- udx0 = 1;
- s = *sp;
- /* allow optional initial 0x or 0X */
- while((c = *(CONST unsigned char*)(s+1)) && c <= ' ')
- ++s;
- if (s[1] == '0' && (s[2] == 'x' || s[2] == 'X'))
- s += 2;
- while((c = *(CONST unsigned char*)++s)) {
- if ((c1 = hexdig[c]))
- c = c1 & 0xf;
- else if (c <= ' ') {
- if (udx0 && havedig) {
- udx0 = 0;
- xshift = 1;
- }
- continue;
- }
-#ifdef GDTOA_NON_PEDANTIC_NANCHECK
- else if (/*(*/ c == ')' && havedig) {
- *sp = s + 1;
- break;
- }
- else
- return; /* invalid form: don't change *sp */
-#else
- else {
- do {
- if (/*(*/ c == ')') {
- *sp = s + 1;
- break;
- }
- } while((c = *++s));
- break;
- }
-#endif
- havedig = 1;
- if (xshift) {
- xshift = 0;
- x[0] = x[1];
- x[1] = 0;
- }
- if (udx0)
- x[0] = (x[0] << 4) | (x[1] >> 28);
- x[1] = (x[1] << 4) | c;
- }
- if ((x[0] &= 0xfffff) || x[1]) {
- word0(rvp) = Exp_mask | x[0];
- word1(rvp) = x[1];
- }
- }
-#endif /*No_Hex_NaN*/
-#endif /* INFNAN_CHECK */
-
-#endif // HAVE_STRTOD
-
-#ifdef Pack_32
-#define ULbits 32
-#define kshift 5
-#define kmask 31
-#else
-#define ULbits 16
-#define kshift 4
-#define kmask 15
-#endif
-
-#if !defined(NO_HEX_FP) || defined(Honor_FLT_ROUNDS) /*{*/
- static Bigint *
-#ifdef KR_headers
-increment(b) Bigint *b;
-#else
-increment(Bigint *b)
-#endif
-{
- ULong *x, *xe;
- Bigint *b1;
-
- x = b->x;
- xe = x + b->wds;
- do {
- if (*x < (ULong)0xffffffffL) {
- ++*x;
- return b;
- }
- *x++ = 0;
- } while(x < xe);
- {
- if (b->wds >= b->maxwds) {
- b1 = Balloc(b->k+1);
- Bcopy(b1,b);
- Bfree(b);
- b = b1;
- }
- b->x[b->wds++] = 1;
- }
- return b;
- }
-
-#endif /*}*/
-
-#ifndef NO_HEX_FP /*{*/
-
- static void
-#ifdef KR_headers
-rshift(b, k) Bigint *b; int k;
-#else
-rshift(Bigint *b, int k)
-#endif
-{
- ULong *x, *x1, *xe, y;
- int n;
-
- x = x1 = b->x;
- n = k >> kshift;
- if (n < b->wds) {
- xe = x + b->wds;
- x += n;
- if (k &= kmask) {
- n = 32 - k;
- y = *x++ >> k;
- while(x < xe) {
- *x1++ = (y | (*x << n)) & 0xffffffff;
- y = *x++ >> k;
- }
- if ((*x1 = y) !=0)
- x1++;
- }
- else
- while(x < xe)
- *x1++ = *x++;
- }
- if ((b->wds = x1 - b->x) == 0)
- b->x[0] = 0;
- }
-
- static ULong
-#ifdef KR_headers
-any_on(b, k) Bigint *b; int k;
-#else
-any_on(Bigint *b, int k)
-#endif
-{
- int n, nwds;
- ULong *x, *x0, x1, x2;
-
- x = b->x;
- nwds = b->wds;
- n = k >> kshift;
- if (n > nwds)
- n = nwds;
- else if (n < nwds && (k &= kmask)) {
- x1 = x2 = x[n];
- x1 >>= k;
- x1 <<= k;
- if (x1 != x2)
- return 1;
- }
- x0 = x;
- x += n;
- while(x > x0)
- if (*--x)
- return 1;
- return 0;
- }
-
-enum { /* rounding values: same as FLT_ROUNDS */
- Round_zero = 0,
- Round_near = 1,
- Round_up = 2,
- Round_down = 3
- };
-
- void
-#ifdef KR_headers
-gethex(sp, rvp, rounding, sign)
- CONST char **sp; U *rvp; int rounding, sign;
-#else
-gethex( CONST char **sp, U *rvp, int rounding, int sign)
-#endif
-{
- Bigint *b;
- CONST unsigned char *decpt, *s0, *s, *s1;
- Long e, e1;
- ULong L, lostbits, *x;
- int big, denorm, esign, havedig, k, n, nbits, up, zret;
-#ifdef IBM
- int j;
-#endif
- enum {
-#ifdef IEEE_Arith /*{{*/
- emax = 0x7fe - Bias - P + 1,
- emin = Emin - P + 1
-#else /*}{*/
- emin = Emin - P,
-#ifdef VAX
- emax = 0x7ff - Bias - P + 1
-#endif
-#ifdef IBM
- emax = 0x7f - Bias - P
-#endif
-#endif /*}}*/
- };
-#ifdef USE_LOCALE
- int i;
-#ifdef NO_LOCALE_CACHE
- const unsigned char *decimalpoint = (unsigned char*)
- localeconv()->decimal_point;
-#else
- const unsigned char *decimalpoint;
- static unsigned char *decimalpoint_cache;
- if (!(s0 = decimalpoint_cache)) {
- s0 = (unsigned char*)localeconv()->decimal_point;
- if ((decimalpoint_cache = (unsigned char*)
- MALLOC(strlen((CONST char*)s0) + 1))) {
- strcpy((char*)decimalpoint_cache, (CONST char*)s0);
- s0 = decimalpoint_cache;
- }
- }
- decimalpoint = s0;
-#endif
-#endif
-
- /**** if (!hexdig['0']) hexdig_init(); ****/
- havedig = 0;
- s0 = *(CONST unsigned char **)sp + 2;
- while(s0[havedig] == '0')
- havedig++;
- s0 += havedig;
- s = s0;
- decpt = 0;
- zret = 0;
- e = 0;
- if (hexdig[*s])
- havedig++;
- else {
- zret = 1;
-#ifdef USE_LOCALE
- for(i = 0; decimalpoint[i]; ++i) {
- if (s[i] != decimalpoint[i])
- goto pcheck;
- }
- decpt = s += i;
-#else
- if (*s != '.')
- goto pcheck;
- decpt = ++s;
-#endif
- if (!hexdig[*s])
- goto pcheck;
- while(*s == '0')
- s++;
- if (hexdig[*s])
- zret = 0;
- havedig = 1;
- s0 = s;
- }
- while(hexdig[*s])
- s++;
-#ifdef USE_LOCALE
- if (*s == *decimalpoint && !decpt) {
- for(i = 1; decimalpoint[i]; ++i) {
- if (s[i] != decimalpoint[i])
- goto pcheck;
- }
- decpt = s += i;
-#else
- if (*s == '.' && !decpt) {
- decpt = ++s;
-#endif
- while(hexdig[*s])
- s++;
- }/*}*/
- if (decpt)
- e = -(((Long)(s-decpt)) << 2);
- pcheck:
- s1 = s;
- big = esign = 0;
- switch(*s) {
- case 'p':
- case 'P':
- switch(*++s) {
- case '-':
- esign = 1;
- /* no break */
- case '+':
- s++;
- }
- if ((n = hexdig[*s]) == 0 || n > 0x19) {
- s = s1;
- break;
- }
- e1 = n - 0x10;
- while((n = hexdig[*++s]) !=0 && n <= 0x19) {
- if (e1 & 0xf8000000)
- big = 1;
- e1 = 10*e1 + n - 0x10;
- }
- if (esign)
- e1 = -e1;
- e += e1;
- }
- *sp = (char*)s;
- if (!havedig)
- *sp = (char*)s0 - 1;
- if (zret)
- goto retz1;
- if (big) {
- if (esign) {
-#ifdef IEEE_Arith
- switch(rounding) {
- case Round_up:
- if (sign)
- break;
- goto ret_tiny;
- case Round_down:
- if (!sign)
- break;
- goto ret_tiny;
- }
-#endif
- goto retz;
-#ifdef IEEE_Arith
- ret_tinyf:
- Bfree(b);
- ret_tiny:
-#ifndef NO_ERRNO
- errno = ERANGE;
-#endif
- word0(rvp) = 0;
- word1(rvp) = 1;
- return;
-#endif /* IEEE_Arith */
- }
- switch(rounding) {
- case Round_near:
- goto ovfl1;
- case Round_up:
- if (!sign)
- goto ovfl1;
- goto ret_big;
- case Round_down:
- if (sign)
- goto ovfl1;
- goto ret_big;
- }
- ret_big:
- word0(rvp) = Big0;
- word1(rvp) = Big1;
- return;
- }
- n = s1 - s0 - 1;
- for(k = 0; n > (1 << (kshift-2)) - 1; n >>= 1)
- k++;
- b = Balloc(k);
- x = b->x;
- n = 0;
- L = 0;
-#ifdef USE_LOCALE
- for(i = 0; decimalpoint[i+1]; ++i);
-#endif
- while(s1 > s0) {
-#ifdef USE_LOCALE
- if (*--s1 == decimalpoint[i]) {
- s1 -= i;
- continue;
- }
-#else
- if (*--s1 == '.')
- continue;
-#endif
- if (n == ULbits) {
- *x++ = L;
- L = 0;
- n = 0;
- }
- L |= (hexdig[*s1] & 0x0f) << n;
- n += 4;
- }
- *x++ = L;
- b->wds = n = x - b->x;
- n = ULbits*n - hi0bits(L);
- nbits = Nbits;
- lostbits = 0;
- x = b->x;
- if (n > nbits) {
- n -= nbits;
- if (any_on(b,n)) {
- lostbits = 1;
- k = n - 1;
- if (x[k>>kshift] & 1 << (k & kmask)) {
- lostbits = 2;
- if (k > 0 && any_on(b,k))
- lostbits = 3;
- }
- }
- rshift(b, n);
- e += n;
- }
- else if (n < nbits) {
- n = nbits - n;
- b = lshift(b, n);
- e -= n;
- x = b->x;
- }
- if (e > Emax) {
- ovfl:
- Bfree(b);
- ovfl1:
-#ifndef NO_ERRNO
- errno = ERANGE;
-#endif
- word0(rvp) = Exp_mask;
- word1(rvp) = 0;
- return;
- }
- denorm = 0;
- if (e < emin) {
- denorm = 1;
- n = emin - e;
- if (n >= nbits) {
-#ifdef IEEE_Arith /*{*/
- switch (rounding) {
- case Round_near:
- if (n == nbits && (n < 2 || any_on(b,n-1)))
- goto ret_tinyf;
- break;
- case Round_up:
- if (!sign)
- goto ret_tinyf;
- break;
- case Round_down:
- if (sign)
- goto ret_tinyf;
- }
-#endif /* } IEEE_Arith */
- Bfree(b);
- retz:
-#ifndef NO_ERRNO
- errno = ERANGE;
-#endif
- retz1:
- rvp->d = 0.;
- return;
- }
- k = n - 1;
- if (lostbits)
- lostbits = 1;
- else if (k > 0)
- lostbits = any_on(b,k);
- if (x[k>>kshift] & 1 << (k & kmask))
- lostbits |= 2;
- nbits -= n;
- rshift(b,n);
- e = emin;
- }
- if (lostbits) {
- up = 0;
- switch(rounding) {
- case Round_zero:
- break;
- case Round_near:
- if (lostbits & 2
- && (lostbits & 1) | (x[0] & 1))
- up = 1;
- break;
- case Round_up:
- up = 1 - sign;
- break;
- case Round_down:
- up = sign;
- }
- if (up) {
- k = b->wds;
- b = increment(b);
- x = b->x;
- if (denorm) {
-#if 0
- if (nbits == Nbits - 1
- && x[nbits >> kshift] & 1 << (nbits & kmask))
- denorm = 0; /* not currently used */
-#endif
- }
- else if (b->wds > k
- || ((n = nbits & kmask) !=0
- && hi0bits(x[k-1]) < 32-n)) {
- rshift(b,1);
- if (++e > Emax)
- goto ovfl;
- }
- }
- }
-#ifdef IEEE_Arith
- if (denorm)
- word0(rvp) = b->wds > 1 ? b->x[1] & ~0x100000 : 0;
- else
- word0(rvp) = (b->x[1] & ~0x100000) | ((e + 0x3ff + 52) << 20);
- word1(rvp) = b->x[0];
-#endif
-#ifdef IBM
- if ((j = e & 3)) {
- k = b->x[0] & ((1 << j) - 1);
- rshift(b,j);
- if (k) {
- switch(rounding) {
- case Round_up:
- if (!sign)
- increment(b);
- break;
- case Round_down:
- if (sign)
- increment(b);
- break;
- case Round_near:
- j = 1 << (j-1);
- if (k & j && ((k & (j-1)) | lostbits))
- increment(b);
- }
- }
- }
- e >>= 2;
- word0(rvp) = b->x[1] | ((e + 65 + 13) << 24);
- word1(rvp) = b->x[0];
-#endif
-#ifdef VAX
- /* The next two lines ignore swap of low- and high-order 2 bytes. */
- /* word0(rvp) = (b->x[1] & ~0x800000) | ((e + 129 + 55) << 23); */
- /* word1(rvp) = b->x[0]; */
- word0(rvp) = ((b->x[1] & ~0x800000) >> 16) | ((e + 129 + 55) << 7) | (b->x[1] << 16);
- word1(rvp) = (b->x[0] >> 16) | (b->x[0] << 16);
-#endif
- Bfree(b);
- }
-#endif /*!NO_HEX_FP}*/
-
- static int
-#ifdef KR_headers
-dshift(b, p2) Bigint *b; int p2;
-#else
-dshift(Bigint *b, int p2)
-#endif
-{
- int rv = hi0bits(b->x[b->wds-1]) - 4;
- if (p2 > 0)
- rv -= p2;
- return rv & kmask;
- }
-
- static int
-quorem
-#ifdef KR_headers
- (b, S) Bigint *b, *S;
-#else
- (Bigint *b, Bigint *S)
-#endif
-{
- int n;
- ULong *bx, *bxe, q, *sx, *sxe;
-#ifdef ULLong
- ULLong borrow, carry, y, ys;
-#else
- ULong borrow, carry, y, ys;
-#ifdef Pack_32
- ULong si, z, zs;
-#endif
-#endif
-
- n = S->wds;
-#ifdef DEBUG
- /*debug*/ if (b->wds > n)
- /*debug*/ Bug("oversize b in quorem");
-#endif
- if (b->wds < n)
- return 0;
- sx = S->x;
- sxe = sx + --n;
- bx = b->x;
- bxe = bx + n;
- q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
-#ifdef DEBUG
-#ifdef NO_STRTOD_BIGCOMP
- /*debug*/ if (q > 9)
-#else
- /* An oversized q is possible when quorem is called from bigcomp and */
- /* the input is near, e.g., twice the smallest denormalized number. */
- /*debug*/ if (q > 15)
-#endif
- /*debug*/ Bug("oversized quotient in quorem");
-#endif
- if (q) {
- borrow = 0;
- carry = 0;
- do {
-#ifdef ULLong
- ys = *sx++ * (ULLong)q + carry;
- carry = ys >> 32;
- y = *bx - (ys & FFFFFFFF) - borrow;
- borrow = y >> 32 & (ULong)1;
- *bx++ = y & FFFFFFFF;
-#else
-#ifdef Pack_32
- si = *sx++;
- ys = (si & 0xffff) * q + carry;
- zs = (si >> 16) * q + (ys >> 16);
- carry = zs >> 16;
- y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
- borrow = (y & 0x10000) >> 16;
- z = (*bx >> 16) - (zs & 0xffff) - borrow;
- borrow = (z & 0x10000) >> 16;
- Storeinc(bx, z, y);
-#else
- ys = *sx++ * q + carry;
- carry = ys >> 16;
- y = *bx - (ys & 0xffff) - borrow;
- borrow = (y & 0x10000) >> 16;
- *bx++ = y & 0xffff;
-#endif
-#endif
- }
- while(sx <= sxe);
- if (!*bxe) {
- bx = b->x;
- while(--bxe > bx && !*bxe)
- --n;
- b->wds = n;
- }
- }
- if (cmp(b, S) >= 0) {
- q++;
- borrow = 0;
- carry = 0;
- bx = b->x;
- sx = S->x;
- do {
-#ifdef ULLong
- ys = *sx++ + carry;
- carry = ys >> 32;
- y = *bx - (ys & FFFFFFFF) - borrow;
- borrow = y >> 32 & (ULong)1;
- *bx++ = y & FFFFFFFF;
-#else
-#ifdef Pack_32
- si = *sx++;
- ys = (si & 0xffff) + carry;
- zs = (si >> 16) + (ys >> 16);
- carry = zs >> 16;
- y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
- borrow = (y & 0x10000) >> 16;
- z = (*bx >> 16) - (zs & 0xffff) - borrow;
- borrow = (z & 0x10000) >> 16;
- Storeinc(bx, z, y);
-#else
- ys = *sx++ + carry;
- carry = ys >> 16;
- y = *bx - (ys & 0xffff) - borrow;
- borrow = (y & 0x10000) >> 16;
- *bx++ = y & 0xffff;
-#endif
-#endif
- }
- while(sx <= sxe);
- bx = b->x;
- bxe = bx + n;
- if (!*bxe) {
- while(--bxe > bx && !*bxe)
- --n;
- b->wds = n;
- }
- }
- return q;
- }
-
-#ifndef HAVE_STRTOD
-
-#if defined(Avoid_Underflow) || !defined(NO_STRTOD_BIGCOMP) /*{*/
- static double
-sulp
-#ifdef KR_headers
- (x, bc) U *x; BCinfo *bc;
-#else
- (U *x, BCinfo *bc)
-#endif
-{
- U u;
- double rv;
- int i;
-
- rv = ulp(x);
- if (!bc->scale || (i = 2*P + 1 - ((word0(x) & Exp_mask) >> Exp_shift)) <= 0)
- return rv; /* Is there an example where i <= 0 ? */
- word0(&u) = Exp_1 + (i << Exp_shift);
- word1(&u) = 0;
- return rv * u.d;
- }
-#endif /*}*/
-
-#ifndef NO_STRTOD_BIGCOMP
- static void
-bigcomp
-#ifdef KR_headers
- (rv, s0, bc)
- U *rv; CONST char *s0; BCinfo *bc;
-#else
- (U *rv, const char *s0, BCinfo *bc)
-#endif
-{
- Bigint *b, *d;
- int b2, bbits, d2, dd, dig, dsign, i, j, nd, nd0, p2, p5, speccase;
-
- dsign = bc->dsign;
- nd = bc->nd;
- nd0 = bc->nd0;
- p5 = nd + bc->e0 - 1;
- speccase = 0;
-#ifndef Sudden_Underflow
- if (rv->d == 0.) { /* special case: value near underflow-to-zero */
- /* threshold was rounded to zero */
- b = i2b(1);
- p2 = Emin - P + 1;
- bbits = 1;
-#ifdef Avoid_Underflow
- word0(rv) = (P+2) << Exp_shift;
-#else
- word1(rv) = 1;
-#endif
- i = 0;
-#ifdef Honor_FLT_ROUNDS
- if (bc->rounding == 1)
-#endif
- {
- speccase = 1;
- --p2;
- dsign = 0;
- goto have_i;
- }
- }
- else
-#endif
- b = d2b(rv, &p2, &bbits);
-#ifdef Avoid_Underflow
- p2 -= bc->scale;
-#endif
- /* floor(log2(rv)) == bbits - 1 + p2 */
- /* Check for denormal case. */
- i = P - bbits;
- if (i > (j = P - Emin - 1 + p2)) {
-#ifdef Sudden_Underflow
- Bfree(b);
- b = i2b(1);
- p2 = Emin;
- i = P - 1;
-#ifdef Avoid_Underflow
- word0(rv) = (1 + bc->scale) << Exp_shift;
-#else
- word0(rv) = Exp_msk1;
-#endif
- word1(rv) = 0;
-#else
- i = j;
-#endif
- }
-#ifdef Honor_FLT_ROUNDS
- if (bc->rounding != 1) {
- if (i > 0)
- b = lshift(b, i);
- if (dsign)
- b = increment(b);
- }
- else
-#endif
- {
- b = lshift(b, ++i);
- b->x[0] |= 1;
- }
-#ifndef Sudden_Underflow
- have_i:
-#endif
- p2 -= p5 + i;
- d = i2b(1);
- /* Arrange for convenient computation of quotients:
- * shift left if necessary so divisor has 4 leading 0 bits.
- */
- if (p5 > 0)
- d = pow5mult(d, p5);
- else if (p5 < 0)
- b = pow5mult(b, -p5);
- if (p2 > 0) {
- b2 = p2;
- d2 = 0;
- }
- else {
- b2 = 0;
- d2 = -p2;
- }
- i = dshift(d, d2);
- if ((b2 += i) > 0)
- b = lshift(b, b2);
- if ((d2 += i) > 0)
- d = lshift(d, d2);
-
- /* Now b/d = exactly half-way between the two floating-point values */
- /* on either side of the input string. Compute first digit of b/d. */
-
- if (!(dig = quorem(b,d))) {
- b = multadd(b, 10, 0); /* very unlikely */
- dig = quorem(b,d);
- }
-
- /* Compare b/d with s0 */
-
- for(i = 0; i < nd0; ) {
- if ((dd = s0[i++] - '0' - dig))
- goto ret;
- if (!b->x[0] && b->wds == 1) {
- if (i < nd)
- dd = 1;
- goto ret;
- }
- b = multadd(b, 10, 0);
- dig = quorem(b,d);
- }
- for(j = bc->dp1; i++ < nd;) {
- if ((dd = s0[j++] - '0' - dig))
- goto ret;
- if (!b->x[0] && b->wds == 1) {
- if (i < nd)
- dd = 1;
- goto ret;
- }
- b = multadd(b, 10, 0);
- dig = quorem(b,d);
- }
- if (dig > 0 || b->x[0] || b->wds > 1)
- dd = -1;
- ret:
- Bfree(b);
- Bfree(d);
-#ifdef Honor_FLT_ROUNDS
- if (bc->rounding != 1) {
- if (dd < 0) {
- if (bc->rounding == 0) {
- if (!dsign)
- goto retlow1;
- }
- else if (dsign)
- goto rethi1;
- }
- else if (dd > 0) {
- if (bc->rounding == 0) {
- if (dsign)
- goto rethi1;
- goto ret1;
- }
- if (!dsign)
- goto rethi1;
- dval(rv) += 2.*sulp(rv,bc);
- }
- else {
- bc->inexact = 0;
- if (dsign)
- goto rethi1;
- }
- }
- else
-#endif
- if (speccase) {
- if (dd <= 0)
- rv->d = 0.;
- }
- else if (dd < 0) {
- if (!dsign) /* does not happen for round-near */
-retlow1:
- dval(rv) -= sulp(rv,bc);
- }
- else if (dd > 0) {
- if (dsign) {
- rethi1:
- dval(rv) += sulp(rv,bc);
- }
- }
- else {
- /* Exact half-way case: apply round-even rule. */
- if ((j = ((word0(rv) & Exp_mask) >> Exp_shift) - bc->scale) <= 0) {
- i = 1 - j;
- if (i <= 31) {
- if (word1(rv) & (0x1 << i))
- goto odd;
- }
- else if (word0(rv) & (0x1 << (i-32)))
- goto odd;
- }
- else if (word1(rv) & 1) {
- odd:
- if (dsign)
- goto rethi1;
- goto retlow1;
- }
- }
-
-#ifdef Honor_FLT_ROUNDS
- ret1:
-#endif
- return;
- }
-#endif /* NO_STRTOD_BIGCOMP */
-
- double
-poly_strtod
-#ifdef KR_headers
- (s00, se) CONST char *s00; char **se;
-#else
- (const char *s00, char **se)
-#endif
-{
- int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, e, e1;
- int esign, i, j, k, nd, nd0, nf, nz, nz0, nz1, sign;
- CONST char *s, *s0, *s1;
- double aadj, aadj1;
- Long L;
- U aadj2, adj, rv, rv0;
- ULong y, z;
- BCinfo bc;
- Bigint *bb, *bb1, *bd, *bd0, *bs, *delta;
-#ifdef Avoid_Underflow
- ULong Lsb, Lsb1;
-#endif
-#ifdef SET_INEXACT
- int oldinexact;
-#endif
-#ifndef NO_STRTOD_BIGCOMP
- int req_bigcomp = 0;
-#endif
-#ifdef Honor_FLT_ROUNDS /*{*/
-#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */
- bc.rounding = Flt_Rounds;
-#else /*}{*/
- bc.rounding = 1;
- switch(fegetround()) {
- case FE_TOWARDZERO: bc.rounding = 0; break;
- case FE_UPWARD: bc.rounding = 2; break;
- case FE_DOWNWARD: bc.rounding = 3;
- }
-#endif /*}}*/
-#endif /*}*/
-#ifdef USE_LOCALE
- CONST char *s2;
-#endif
-
- sign = nz0 = nz1 = nz = bc.dplen = bc.uflchk = 0;
- dval(&rv) = 0.;
- for(s = s00;;s++) switch(*s) {
- case '-':
- sign = 1;
- /* no break */
- case '+':
- if (*++s)
- goto break2;
- /* no break */
- case 0:
- goto ret0;
- case '\t':
- case '\n':
- case '\v':
- case '\f':
- case '\r':
- case ' ':
- continue;
- default:
- goto break2;
- }
- break2:
- if (*s == '0') {
-#ifndef NO_HEX_FP /*{*/
- switch(s[1]) {
- case 'x':
- case 'X':
-#ifdef Honor_FLT_ROUNDS
- gethex(&s, &rv, bc.rounding, sign);
-#else
- gethex(&s, &rv, 1, sign);
-#endif
- goto ret;
- }
-#endif /*}*/
- nz0 = 1;
- while(*++s == '0') ;
- if (!*s)
- goto ret;
- }
- s0 = s;
- y = z = 0;
- for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
- if (nd < 9)
- y = 10*y + c - '0';
- else if (nd < DBL_DIG + 2)
- z = 10*z + c - '0';
- nd0 = nd;
- bc.dp0 = bc.dp1 = s - s0;
- for(s1 = s; s1 > s0 && *--s1 == '0'; )
- ++nz1;
-#ifdef USE_LOCALE
- s1 = localeconv()->decimal_point;
- if (c == *s1) {
- c = '.';
- if (*++s1) {
- s2 = s;
- for(;;) {
- if (*++s2 != *s1) {
- c = 0;
- break;
- }
- if (!*++s1) {
- s = s2;
- break;
- }
- }
- }
- }
-#endif
- if (c == '.') {
- c = *++s;
- bc.dp1 = s - s0;
- bc.dplen = bc.dp1 - bc.dp0;
- if (!nd) {
- for(; c == '0'; c = *++s)
- nz++;
- if (c > '0' && c <= '9') {
- bc.dp0 = s0 - s;
- bc.dp1 = bc.dp0 + bc.dplen;
- s0 = s;
- nf += nz;
- nz = 0;
- goto have_dig;
- }
- goto dig_done;
- }
- for(; c >= '0' && c <= '9'; c = *++s) {
- have_dig:
- nz++;
- if (c -= '0') {
- nf += nz;
- for(i = 1; i < nz; i++)
- if (nd++ < 9)
- y *= 10;
- else if (nd <= DBL_DIG + 2)
- z *= 10;
- if (nd++ < 9)
- y = 10*y + c;
- else if (nd <= DBL_DIG + 2)
- z = 10*z + c;
- nz = nz1 = 0;
- }
- }
- }
- dig_done:
- e = 0;
- if (c == 'e' || c == 'E') {
- if (!nd && !nz && !nz0) {
- goto ret0;
- }
- s00 = s;
- esign = 0;
- switch(c = *++s) {
- case '-':
- esign = 1;
- case '+':
- c = *++s;
- }
- if (c >= '0' && c <= '9') {
- while(c == '0')
- c = *++s;
- if (c > '0' && c <= '9') {
- L = c - '0';
- s1 = s;
- while((c = *++s) >= '0' && c <= '9')
- L = 10*L + c - '0';
- if (s - s1 > 8 || L > 19999)
- /* Avoid confusion from exponents
- * so large that e might overflow.
- */
- e = 19999; /* safe for 16 bit ints */
- else
- e = (int)L;
- if (esign)
- e = -e;
- }
- else
- e = 0;
- }
- else
- s = s00;
- }
- if (!nd) {
- if (!nz && !nz0) {
-#ifdef INFNAN_CHECK
- /* Check for Nan and Infinity */
- if (!bc.dplen)
- switch(c) {
- case 'i':
- case 'I':
- if (match(&s,"nf")) {
- --s;
- if (!match(&s,"inity"))
- ++s;
- word0(&rv) = 0x7ff00000;
- word1(&rv) = 0;
- goto ret;
- }
- break;
- case 'n':
- case 'N':
- if (match(&s, "an")) {
- word0(&rv) = NAN_WORD0;
- word1(&rv) = NAN_WORD1;
-#ifndef No_Hex_NaN
- if (*s == '(') /*)*/
- hexnan(&rv, &s);
-#endif
- goto ret;
- }
- }
-#endif /* INFNAN_CHECK */
- ret0:
- s = s00;
- sign = 0;
- }
- goto ret;
- }
- bc.e0 = e1 = e -= nf;
-
- /* Now we have nd0 digits, starting at s0, followed by a
- * decimal point, followed by nd-nd0 digits. The number we're
- * after is the integer represented by those digits times
- * 10**e */
-
- if (!nd0)
- nd0 = nd;
- k = nd < DBL_DIG + 2 ? nd : DBL_DIG + 2;
- dval(&rv) = y;
- if (k > 9) {
-#ifdef SET_INEXACT
- if (k > DBL_DIG)
- oldinexact = get_inexact();
-#endif
- dval(&rv) = tens[k - 9] * dval(&rv) + z;
- }
- bd0 = 0;
- if (nd <= DBL_DIG
-#ifndef RND_PRODQUOT
-#ifndef Honor_FLT_ROUNDS
- && Flt_Rounds == 1
-#endif
-#endif
- ) {
- if (!e)
- goto ret;
-#ifndef ROUND_BIASED_without_Round_Up
- if (e > 0) {
- if (e <= Ten_pmax) {
-#ifdef VAX
- goto vax_ovfl_check;
-#else
-#ifdef Honor_FLT_ROUNDS
- /* round correctly FLT_ROUNDS = 2 or 3 */
- if (sign) {
- rv.d = -rv.d;
- sign = 0;
- }
-#endif
- /* rv = */ rounded_product(dval(&rv), tens[e]);
- goto ret;
-#endif
- }
- i = DBL_DIG - nd;
- if (e <= Ten_pmax + i) {
- /* A fancier test would sometimes let us do
- * this for larger i values.
- */
-#ifdef Honor_FLT_ROUNDS
- /* round correctly FLT_ROUNDS = 2 or 3 */
- if (sign) {
- rv.d = -rv.d;
- sign = 0;
- }
-#endif
- e -= i;
- dval(&rv) *= tens[i];
-#ifdef VAX
- /* VAX exponent range is so narrow we must
- * worry about overflow here...
- */
- vax_ovfl_check:
- word0(&rv) -= P*Exp_msk1;
- /* rv = */ rounded_product(dval(&rv), tens[e]);
- if ((word0(&rv) & Exp_mask)
- > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
- goto ovfl;
- word0(&rv) += P*Exp_msk1;
-#else
- /* rv = */ rounded_product(dval(&rv), tens[e]);
-#endif
- goto ret;
- }
- }
-#ifndef Inaccurate_Divide
- else if (e >= -Ten_pmax) {
-#ifdef Honor_FLT_ROUNDS
- /* round correctly FLT_ROUNDS = 2 or 3 */
- if (sign) {
- rv.d = -rv.d;
- sign = 0;
- }
-#endif
- /* rv = */ rounded_quotient(dval(&rv), tens[-e]);
- goto ret;
- }
-#endif
-#endif /* ROUND_BIASED_without_Round_Up */
- }
- e1 += nd - k;
-
-#ifdef IEEE_Arith
-#ifdef SET_INEXACT
- bc.inexact = 1;
- if (k <= DBL_DIG)
- oldinexact = get_inexact();
-#endif
-#ifdef Avoid_Underflow
- bc.scale = 0;
-#endif
-#ifdef Honor_FLT_ROUNDS
- if (bc.rounding >= 2) {
- if (sign)
- bc.rounding = bc.rounding == 2 ? 0 : 2;
- else
- if (bc.rounding != 2)
- bc.rounding = 0;
- }
-#endif
-#endif /*IEEE_Arith*/
-
- /* Get starting approximation = rv * 10**e1 */
-
- if (e1 > 0) {
- if ((i = e1 & 15))
- dval(&rv) *= tens[i];
- if (e1 &= ~15) {
- if (e1 > DBL_MAX_10_EXP) {
- ovfl:
- /* Can't trust HUGE_VAL */
-#ifdef IEEE_Arith
-#ifdef Honor_FLT_ROUNDS
- switch(bc.rounding) {
- case 0: /* toward 0 */
- case 3: /* toward -infinity */
- word0(&rv) = Big0;
- word1(&rv) = Big1;
- break;
- default:
- word0(&rv) = Exp_mask;
- word1(&rv) = 0;
- }
-#else /*Honor_FLT_ROUNDS*/
- word0(&rv) = Exp_mask;
- word1(&rv) = 0;
-#endif /*Honor_FLT_ROUNDS*/
-#ifdef SET_INEXACT
- /* set overflow bit */
- dval(&rv0) = 1e300;
- dval(&rv0) *= dval(&rv0);
-#endif
-#else /*IEEE_Arith*/
- word0(&rv) = Big0;
- word1(&rv) = Big1;
-#endif /*IEEE_Arith*/
- range_err:
- if (bd0) {
- Bfree(bb);
- Bfree(bd);
- Bfree(bs);
- Bfree(bd0);
- Bfree(delta);
- }
-#ifndef NO_ERRNO
- errno = ERANGE;
-#endif
- goto ret;
- }
- e1 >>= 4;
- for(j = 0; e1 > 1; j++, e1 >>= 1)
- if (e1 & 1)
- dval(&rv) *= bigtens[j];
- /* The last multiplication could overflow. */
- word0(&rv) -= P*Exp_msk1;
- dval(&rv) *= bigtens[j];
- if ((z = word0(&rv) & Exp_mask)
- > Exp_msk1*(DBL_MAX_EXP+Bias-P))
- goto ovfl;
- if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) {
- /* set to largest number */
- /* (Can't trust DBL_MAX) */
- word0(&rv) = Big0;
- word1(&rv) = Big1;
- }
- else
- word0(&rv) += P*Exp_msk1;
- }
- }
- else if (e1 < 0) {
- e1 = -e1;
- if ((i = e1 & 15))
- dval(&rv) /= tens[i];
- if (e1 >>= 4) {
- if (e1 >= 1 << n_bigtens)
- goto undfl;
-#ifdef Avoid_Underflow
- if (e1 & Scale_Bit)
- bc.scale = 2*P;
- for(j = 0; e1 > 0; j++, e1 >>= 1)
- if (e1 & 1)
- dval(&rv) *= tinytens[j];
- if (bc.scale && (j = 2*P + 1 - ((word0(&rv) & Exp_mask)
- >> Exp_shift)) > 0) {
- /* scaled rv is denormal; clear j low bits */
- if (j >= 32) {
- if (j > 54)
- goto undfl;
- word1(&rv) = 0;
- if (j >= 53)
- word0(&rv) = (P+2)*Exp_msk1;
- else
- word0(&rv) &= 0xffffffff << (j-32);
- }
- else
- word1(&rv) &= 0xffffffff << j;
- }
-#else
- for(j = 0; e1 > 1; j++, e1 >>= 1)
- if (e1 & 1)
- dval(&rv) *= tinytens[j];
- /* The last multiplication could underflow. */
- dval(&rv0) = dval(&rv);
- dval(&rv) *= tinytens[j];
- if (!dval(&rv)) {
- dval(&rv) = 2.*dval(&rv0);
- dval(&rv) *= tinytens[j];
-#endif
- if (!dval(&rv)) {
- undfl:
- dval(&rv) = 0.;
- goto range_err;
- }
-#ifndef Avoid_Underflow
- word0(&rv) = Tiny0;
- word1(&rv) = Tiny1;
- /* The refinement below will clean
- * this approximation up.
- */
- }
-#endif
- }
- }
-
- /* Now the hard part -- adjusting rv to the correct value.*/
-
- /* Put digits into bd: true value = bd * 10^e */
-
- bc.nd = nd - nz1;
-#ifndef NO_STRTOD_BIGCOMP
- bc.nd0 = nd0; /* Only needed if nd > strtod_diglim, but done here */
- /* to silence an erroneous warning about bc.nd0 */
- /* possibly not being initialized. */
- if (nd > strtod_diglim) {
- /* ASSERT(strtod_diglim >= 18); 18 == one more than the */
- /* minimum number of decimal digits to distinguish double values */
- /* in IEEE arithmetic. */
- i = j = 18;
- if (i > nd0)
- j += bc.dplen;
- for(;;) {
- if (--j < bc.dp1 && j >= bc.dp0)
- j = bc.dp0 - 1;
- if (s0[j] != '0')
- break;
- --i;
- }
- e += nd - i;
- nd = i;
- if (nd0 > nd)
- nd0 = nd;
- if (nd < 9) { /* must recompute y */
- y = 0;
- for(i = 0; i < nd0; ++i)
- y = 10*y + s0[i] - '0';
- for(j = bc.dp1; i < nd; ++i)
- y = 10*y + s0[j++] - '0';
- }
- }
-#endif
- bd0 = s2b(s0, nd0, nd, y, bc.dplen);
-
- for(;;) {
- bd = Balloc(bd0->k);
- Bcopy(bd, bd0);
- bb = d2b(&rv, &bbe, &bbbits); /* rv = bb * 2^bbe */
- bs = i2b(1);
-
- if (e >= 0) {
- bb2 = bb5 = 0;
- bd2 = bd5 = e;
- }
- else {
- bb2 = bb5 = -e;
- bd2 = bd5 = 0;
- }
- if (bbe >= 0)
- bb2 += bbe;
- else
- bd2 -= bbe;
- bs2 = bb2;
-#ifdef Honor_FLT_ROUNDS
- if (bc.rounding != 1)
- bs2++;
-#endif
-#ifdef Avoid_Underflow
- Lsb = LSB;
- Lsb1 = 0;
- j = bbe - bc.scale;
- i = j + bbbits - 1; /* logb(rv) */
- j = P + 1 - bbbits;
- if (i < Emin) { /* denormal */
- i = Emin - i;
- j -= i;
- if (i < 32)
- Lsb <<= i;
- else if (i < 52)
- Lsb1 = Lsb << (i-32);
- else
- Lsb1 = Exp_mask;
- }
-#else /*Avoid_Underflow*/
-#ifdef Sudden_Underflow
-#ifdef IBM
- j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
-#else
- j = P + 1 - bbbits;
-#endif
-#else /*Sudden_Underflow*/
- j = bbe;
- i = j + bbbits - 1; /* logb(rv) */
- if (i < Emin) /* denormal */
- j += P - Emin;
- else
- j = P + 1 - bbbits;
-#endif /*Sudden_Underflow*/
-#endif /*Avoid_Underflow*/
- bb2 += j;
- bd2 += j;
-#ifdef Avoid_Underflow
- bd2 += bc.scale;
-#endif
- i = bb2 < bd2 ? bb2 : bd2;
- if (i > bs2)
- i = bs2;
- if (i > 0) {
- bb2 -= i;
- bd2 -= i;
- bs2 -= i;
- }
- if (bb5 > 0) {
- bs = pow5mult(bs, bb5);
- bb1 = mult(bs, bb);
- Bfree(bb);
- bb = bb1;
- }
- if (bb2 > 0)
- bb = lshift(bb, bb2);
- if (bd5 > 0)
- bd = pow5mult(bd, bd5);
- if (bd2 > 0)
- bd = lshift(bd, bd2);
- if (bs2 > 0)
- bs = lshift(bs, bs2);
- delta = diff(bb, bd);
- bc.dsign = delta->sign;
- delta->sign = 0;
- i = cmp(delta, bs);
-#ifndef NO_STRTOD_BIGCOMP /*{*/
- if (bc.nd > nd && i <= 0) {
- if (bc.dsign) {
- /* Must use bigcomp(). */
- req_bigcomp = 1;
- break;
- }
-#ifdef Honor_FLT_ROUNDS
- if (bc.rounding != 1) {
- if (i < 0) {
- req_bigcomp = 1;
- break;
- }
- }
- else
-#endif
- i = -1; /* Discarded digits make delta smaller. */
- }
-#endif /*}*/
-#ifdef Honor_FLT_ROUNDS /*{*/
- if (bc.rounding != 1) {
- if (i < 0) {
- /* Error is less than an ulp */
- if (!delta->x[0] && delta->wds <= 1) {
- /* exact */
-#ifdef SET_INEXACT
- bc.inexact = 0;
-#endif
- break;
- }
- if (bc.rounding) {
- if (bc.dsign) {
- adj.d = 1.;
- goto apply_adj;
- }
- }
- else if (!bc.dsign) {
- adj.d = -1.;
- if (!word1(&rv)
- && !(word0(&rv) & Frac_mask)) {
- y = word0(&rv) & Exp_mask;
-#ifdef Avoid_Underflow
- if (!bc.scale || y > 2*P*Exp_msk1)
-#else
- if (y)
-#endif
- {
- delta = lshift(delta,Log2P);
- if (cmp(delta, bs) <= 0)
- adj.d = -0.5;
- }
- }
- apply_adj:
-#ifdef Avoid_Underflow /*{*/
- if (bc.scale && (y = word0(&rv) & Exp_mask)
- <= 2*P*Exp_msk1)
- word0(&adj) += (2*P+1)*Exp_msk1 - y;
-#else
-#ifdef Sudden_Underflow
- if ((word0(&rv) & Exp_mask) <=
- P*Exp_msk1) {
- word0(&rv) += P*Exp_msk1;
- dval(&rv) += adj.d*ulp(dval(&rv));
- word0(&rv) -= P*Exp_msk1;
- }
- else
-#endif /*Sudden_Underflow*/
-#endif /*Avoid_Underflow}*/
- dval(&rv) += adj.d*ulp(&rv);
- }
- break;
- }
- adj.d = ratio(delta, bs);
- if (adj.d < 1.)
- adj.d = 1.;
- if (adj.d <= 0x7ffffffe) {
- /* adj = rounding ? ceil(adj) : floor(adj); */
- y = adj.d;
- if (y != adj.d) {
- if (!((bc.rounding>>1) ^ bc.dsign))
- y++;
- adj.d = y;
- }
- }
-#ifdef Avoid_Underflow /*{*/
- if (bc.scale && (y = word0(&rv) & Exp_mask) <= 2*P*Exp_msk1)
- word0(&adj) += (2*P+1)*Exp_msk1 - y;
-#else
-#ifdef Sudden_Underflow
- if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) {
- word0(&rv) += P*Exp_msk1;
- adj.d *= ulp(dval(&rv));
- if (bc.dsign)
- dval(&rv) += adj.d;
- else
- dval(&rv) -= adj.d;
- word0(&rv) -= P*Exp_msk1;
- goto cont;
- }
-#endif /*Sudden_Underflow*/
-#endif /*Avoid_Underflow}*/
- adj.d *= ulp(&rv);
- if (bc.dsign) {
- if (word0(&rv) == Big0 && word1(&rv) == Big1)
- goto ovfl;
- dval(&rv) += adj.d;
- }
- else
- dval(&rv) -= adj.d;
- goto cont;
- }
-#endif /*}Honor_FLT_ROUNDS*/
-
- if (i < 0) {
- /* Error is less than half an ulp -- check for
- * special case of mantissa a power of two.
- */
- if (bc.dsign || word1(&rv) || word0(&rv) & Bndry_mask
-#ifdef IEEE_Arith /*{*/
-#ifdef Avoid_Underflow
- || (word0(&rv) & Exp_mask) <= (2*P+1)*Exp_msk1
-#else
- || (word0(&rv) & Exp_mask) <= Exp_msk1
-#endif
-#endif /*}*/
- ) {
-#ifdef SET_INEXACT
- if (!delta->x[0] && delta->wds <= 1)
- bc.inexact = 0;
-#endif
- break;
- }
- if (!delta->x[0] && delta->wds <= 1) {
- /* exact result */
-#ifdef SET_INEXACT
- bc.inexact = 0;
-#endif
- break;
- }
- delta = lshift(delta,Log2P);
- if (cmp(delta, bs) > 0)
- goto drop_down;
- break;
- }
- if (i == 0) {
- /* exactly half-way between */
- if (bc.dsign) {
- if ((word0(&rv) & Bndry_mask1) == Bndry_mask1
- && word1(&rv) == (
-#ifdef Avoid_Underflow
- (bc.scale && (y = word0(&rv) & Exp_mask) <= 2*P*Exp_msk1)
- ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
-#endif
- 0xffffffff)) {
- /*boundary case -- increment exponent*/
- if (word0(&rv) == Big0 && word1(&rv) == Big1)
- goto ovfl;
- word0(&rv) = (word0(&rv) & Exp_mask)
- + Exp_msk1
-#ifdef IBM
- | Exp_msk1 >> 4
-#endif
- ;
- word1(&rv) = 0;
-#ifdef Avoid_Underflow
- bc.dsign = 0;
-#endif
- break;
- }
- }
- else if (!(word0(&rv) & Bndry_mask) && !word1(&rv)) {
- drop_down:
- /* boundary case -- decrement exponent */
-#ifdef Sudden_Underflow /*{{*/
- L = word0(&rv) & Exp_mask;
-#ifdef IBM
- if (L < Exp_msk1)
-#else
-#ifdef Avoid_Underflow
- if (L <= (bc.scale ? (2*P+1)*Exp_msk1 : Exp_msk1))
-#else
- if (L <= Exp_msk1)
-#endif /*Avoid_Underflow*/
-#endif /*IBM*/
- {
- if (bc.nd >nd) {
- bc.uflchk = 1;
- break;
- }
- goto undfl;
- }
- L -= Exp_msk1;
-#else /*Sudden_Underflow}{*/
-#ifdef Avoid_Underflow
- if (bc.scale) {
- L = word0(&rv) & Exp_mask;
- if (L <= (2*P+1)*Exp_msk1) {
- if (L > (P+2)*Exp_msk1)
- /* round even ==> */
- /* accept rv */
- break;
- /* rv = smallest denormal */
- if (bc.nd >nd) {
- bc.uflchk = 1;
- break;
- }
- goto undfl;
- }
- }
-#endif /*Avoid_Underflow*/
- L = (word0(&rv) & Exp_mask) - Exp_msk1;
-#endif /*Sudden_Underflow}}*/
- word0(&rv) = L | Bndry_mask1;
- word1(&rv) = 0xffffffff;
-#ifdef IBM
- goto cont;
-#else
-#ifndef NO_STRTOD_BIGCOMP
- if (bc.nd > nd)
- goto cont;
-#endif
- break;
-#endif
- }
-#ifndef ROUND_BIASED
-#ifdef Avoid_Underflow
- if (Lsb1) {
- if (!(word0(&rv) & Lsb1))
- break;
- }
- else if (!(word1(&rv) & Lsb))
- break;
-#else
- if (!(word1(&rv) & LSB))
- break;
-#endif
-#endif
- if (bc.dsign)
-#ifdef Avoid_Underflow
- dval(&rv) += sulp(&rv, &bc);
-#else
- dval(&rv) += ulp(&rv);
-#endif
-#ifndef ROUND_BIASED
- else {
-#ifdef Avoid_Underflow
- dval(&rv) -= sulp(&rv, &bc);
-#else
- dval(&rv) -= ulp(&rv);
-#endif
-#ifndef Sudden_Underflow
- if (!dval(&rv)) {
- if (bc.nd >nd) {
- bc.uflchk = 1;
- break;
- }
- goto undfl;
- }
-#endif
- }
-#ifdef Avoid_Underflow
- bc.dsign = 1 - bc.dsign;
-#endif
-#endif
- break;
- }
- if ((aadj = ratio(delta, bs)) <= 2.) {
- if (bc.dsign)
- aadj = aadj1 = 1.;
- else if (word1(&rv) || word0(&rv) & Bndry_mask) {
-#ifndef Sudden_Underflow
- if (word1(&rv) == Tiny1 && !word0(&rv)) {
- if (bc.nd >nd) {
- bc.uflchk = 1;
- break;
- }
- goto undfl;
- }
-#endif
- aadj = 1.;
- aadj1 = -1.;
- }
- else {
- /* special case -- power of FLT_RADIX to be */
- /* rounded down... */
-
- if (aadj < 2./FLT_RADIX)
- aadj = 1./FLT_RADIX;
- else
- aadj *= 0.5;
- aadj1 = -aadj;
- }
- }
- else {
- aadj *= 0.5;
- aadj1 = bc.dsign ? aadj : -aadj;
-#ifdef Check_FLT_ROUNDS
- switch(bc.rounding) {
- case 2: /* towards +infinity */
- aadj1 -= 0.5;
- break;
- case 0: /* towards 0 */
- case 3: /* towards -infinity */
- aadj1 += 0.5;
- }
-#else
- if (Flt_Rounds == 0)
- aadj1 += 0.5;
-#endif /*Check_FLT_ROUNDS*/
- }
- y = word0(&rv) & Exp_mask;
-
- /* Check for overflow */
-
- if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) {
- dval(&rv0) = dval(&rv);
- word0(&rv) -= P*Exp_msk1;
- adj.d = aadj1 * ulp(&rv);
- dval(&rv) += adj.d;
- if ((word0(&rv) & Exp_mask) >=
- Exp_msk1*(DBL_MAX_EXP+Bias-P)) {
- if (word0(&rv0) == Big0 && word1(&rv0) == Big1)
- goto ovfl;
- word0(&rv) = Big0;
- word1(&rv) = Big1;
- goto cont;
- }
- else
- word0(&rv) += P*Exp_msk1;
- }
- else {
-#ifdef Avoid_Underflow
- if (bc.scale && y <= 2*P*Exp_msk1) {
- if (aadj <= 0x7fffffff) {
- if ((z = aadj) <= 0)
- z = 1;
- aadj = z;
- aadj1 = bc.dsign ? aadj : -aadj;
- }
- dval(&aadj2) = aadj1;
- word0(&aadj2) += (2*P+1)*Exp_msk1 - y;
- aadj1 = dval(&aadj2);
- adj.d = aadj1 * ulp(&rv);
- dval(&rv) += adj.d;
- if (rv.d == 0.)
-#ifdef NO_STRTOD_BIGCOMP
- goto undfl;
-#else
- {
- req_bigcomp = 1;
- break;
- }
-#endif
- }
- else {
- adj.d = aadj1 * ulp(&rv);
- dval(&rv) += adj.d;
- }
-#else
-#ifdef Sudden_Underflow
- if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) {
- dval(&rv0) = dval(&rv);
- word0(&rv) += P*Exp_msk1;
- adj.d = aadj1 * ulp(&rv);
- dval(&rv) += adj.d;
-#ifdef IBM
- if ((word0(&rv) & Exp_mask) < P*Exp_msk1)
-#else
- if ((word0(&rv) & Exp_mask) <= P*Exp_msk1)
-#endif
- {
- if (word0(&rv0) == Tiny0
- && word1(&rv0) == Tiny1) {
- if (bc.nd >nd) {
- bc.uflchk = 1;
- break;
- }
- goto undfl;
- }
- word0(&rv) = Tiny0;
- word1(&rv) = Tiny1;
- goto cont;
- }
- else
- word0(&rv) -= P*Exp_msk1;
- }
- else {
- adj.d = aadj1 * ulp(&rv);
- dval(&rv) += adj.d;
- }
-#else /*Sudden_Underflow*/
- /* Compute adj so that the IEEE rounding rules will
- * correctly round rv + adj in some half-way cases.
- * If rv * ulp(rv) is denormalized (i.e.,
- * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
- * trouble from bits lost to denormalization;
- * example: 1.2e-307 .
- */
- if (y <= (P-1)*Exp_msk1 && aadj > 1.) {
- aadj1 = (double)(int)(aadj + 0.5);
- if (!bc.dsign)
- aadj1 = -aadj1;
- }
- adj.d = aadj1 * ulp(&rv);
- dval(&rv) += adj.d;
-#endif /*Sudden_Underflow*/
-#endif /*Avoid_Underflow*/
- }
- z = word0(&rv) & Exp_mask;
-#ifndef SET_INEXACT
- if (bc.nd == nd) {
-#ifdef Avoid_Underflow
- if (!bc.scale)
-#endif
- if (y == z) {
- /* Can we stop now? */
- L = (Long)aadj;
- aadj -= L;
- /* The tolerances below are conservative. */
- if (bc.dsign || word1(&rv) || word0(&rv) & Bndry_mask) {
- if (aadj < .4999999 || aadj > .5000001)
- break;
- }
- else if (aadj < .4999999/FLT_RADIX)
- break;
- }
- }
-#endif
- cont:
- Bfree(bb);
- Bfree(bd);
- Bfree(bs);
- Bfree(delta);
- }
- Bfree(bb);
- Bfree(bd);
- Bfree(bs);
- Bfree(bd0);
- Bfree(delta);
-#ifndef NO_STRTOD_BIGCOMP
- if (req_bigcomp) {
- bd0 = 0;
- bc.e0 += nz1;
- bigcomp(&rv, s0, &bc);
- y = word0(&rv) & Exp_mask;
- if (y == Exp_mask)
- goto ovfl;
- if (y == 0 && rv.d == 0.)
- goto undfl;
- }
-#endif
-#ifdef SET_INEXACT
- if (bc.inexact) {
- if (!oldinexact) {
- word0(&rv0) = Exp_1 + (70 << Exp_shift);
- word1(&rv0) = 0;
- dval(&rv0) += 1.;
- }
- }
- else if (!oldinexact)
- clear_inexact();
-#endif
-#ifdef Avoid_Underflow
- if (bc.scale) {
- word0(&rv0) = Exp_1 - 2*P*Exp_msk1;
- word1(&rv0) = 0;
- dval(&rv) *= dval(&rv0);
-#ifndef NO_ERRNO
- /* try to avoid the bug of testing an 8087 register value */
-#ifdef IEEE_Arith
- if (!(word0(&rv) & Exp_mask))
-#else
- if (word0(&rv) == 0 && word1(&rv) == 0)
-#endif
- errno = ERANGE;
-#endif
- }
-#endif /* Avoid_Underflow */
-#ifdef SET_INEXACT
- if (bc.inexact && !(word0(&rv) & Exp_mask)) {
- /* set underflow bit */
- dval(&rv0) = 1e-300;
- dval(&rv0) *= dval(&rv0);
- }
-#endif
- ret:
- if (se)
- *se = (char *)s;
- return sign ? -dval(&rv) : dval(&rv);
- }
-
-#endif // HAVE_STRTOD
-
-#ifndef MULTIPLE_THREADS
- static char *dtoa_result;
-#endif
-
- static char *
-#ifdef KR_headers
-rv_alloc(i) int i;
-#else
-rv_alloc(int i)
-#endif
-{
- int j, k, *r;
-
- j = sizeof(ULong);
- for(k = 0;
- sizeof(Bigint) - sizeof(ULong) - sizeof(int) + j <= i;
- j <<= 1)
- k++;
- r = (int*)Balloc(k);
- *r = k;
- return
-#ifndef MULTIPLE_THREADS
- dtoa_result =
-#endif
- (char *)(r+1);
- }
-
- static char *
-#ifdef KR_headers
-nrv_alloc(s, rve, n) char *s, **rve; int n;
-#else
-nrv_alloc(const char *s, char **rve, int n)
-#endif
-{
- char *rv, *t;
-
- t = rv = rv_alloc(n);
- while((*t = *s++)) t++;
- if (rve)
- *rve = t;
- return rv;
- }
-
-/* freedtoa(s) must be used to free values s returned by dtoa
- * when MULTIPLE_THREADS is #defined. It should be used in all cases,
- * but for consistency with earlier versions of dtoa, it is optional
- * when MULTIPLE_THREADS is not defined.
- */
-
- void
-#ifdef KR_headers
-poly_freedtoa(s) char *s;
-#else
-poly_freedtoa(char *s)
-#endif
-{
- Bigint *b = (Bigint *)((int *)s - 1);
- b->maxwds = 1 << (b->k = *(int*)b);
- Bfree(b);
-#ifndef MULTIPLE_THREADS
- if (s == dtoa_result)
- dtoa_result = 0;
-#endif
- }
-
-/* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
- *
- * Inspired by "How to Print Floating-Point Numbers Accurately" by
- * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126].
- *
- * Modifications:
- * 1. Rather than iterating, we use a simple numeric overestimate
- * to determine k = floor(log10(d)). We scale relevant
- * quantities using O(log2(k)) rather than O(k) multiplications.
- * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
- * try to generate digits strictly left to right. Instead, we
- * compute with fewer bits and propagate the carry if necessary
- * when rounding the final digit up. This is often faster.
- * 3. Under the assumption that input will be rounded nearest,
- * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
- * That is, we allow equality in stopping tests when the
- * round-nearest rule will give the same floating-point value
- * as would satisfaction of the stopping test with strict
- * inequality.
- * 4. We remove common factors of powers of 2 from relevant
- * quantities.
- * 5. When converting floating-point integers less than 1e16,
- * we use floating-point arithmetic rather than resorting
- * to multiple-precision integers.
- * 6. When asked to produce fewer than 15 digits, we first try
- * to get by with floating-point arithmetic; we resort to
- * multiple-precision integer arithmetic only if we cannot
- * guarantee that the floating-point calculation has given
- * the correctly rounded result. For k requested digits and
- * "uniformly" distributed input, the probability is
- * something like 10^(k-15) that we must resort to the Long
- * calculation.
- */
-
- char *
-poly_dtoa
-#ifdef KR_headers
- (dd, mode, ndigits, decpt, sign, rve)
- double dd; int mode, ndigits, *decpt, *sign; char **rve;
-#else
- (double dd, int mode, int ndigits, int *decpt, int *sign, char **rve)
-#endif
-{
- /* Arguments ndigits, decpt, sign are similar to those
- of ecvt and fcvt; trailing zeros are suppressed from
- the returned string. If not null, *rve is set to point
- to the end of the return value. If d is +-Infinity or NaN,
- then *decpt is set to 9999.
-
- mode:
- 0 ==> shortest string that yields d when read in
- and rounded to nearest.
- 1 ==> like 0, but with Steele & White stopping rule;
- e.g. with IEEE P754 arithmetic , mode 0 gives
- 1e23 whereas mode 1 gives 9.999999999999999e22.
- 2 ==> max(1,ndigits) significant digits. This gives a
- return value similar to that of ecvt, except
- that trailing zeros are suppressed.
- 3 ==> through ndigits past the decimal point. This
- gives a return value similar to that from fcvt,
- except that trailing zeros are suppressed, and
- ndigits can be negative.
- 4,5 ==> similar to 2 and 3, respectively, but (in
- round-nearest mode) with the tests of mode 0 to
- possibly return a shorter string that rounds to d.
- With IEEE arithmetic and compilation with
- -DHonor_FLT_ROUNDS, modes 4 and 5 behave the same
- as modes 2 and 3 when FLT_ROUNDS != 1.
- 6-9 ==> Debugging modes similar to mode - 4: don't try
- fast floating-point estimate (if applicable).
-
- Values of mode other than 0-9 are treated as mode 0.
-
- Sufficient space is allocated to the return value
- to hold the suppressed trailing zeros.
- */
-
- int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1,
- j, j1=0, k, k0, k_check, leftright, m2, m5, s2, s5,
- spec_case, try_quick;
- Long L;
-#ifndef Sudden_Underflow
- int denorm;
- ULong x;
-#endif
- Bigint *b, *b1, *delta, *mlo=0, *mhi, *S;
- U d2, eps, u;
- double ds;
- char *s, *s0;
-#ifndef No_leftright
-#ifdef IEEE_Arith
- U eps1;
-#endif
-#endif
-#ifdef SET_INEXACT
- int inexact, oldinexact;
-#endif
-#ifdef Honor_FLT_ROUNDS /*{*/
- int Rounding;
-#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */
- Rounding = Flt_Rounds;
-#else /*}{*/
- Rounding = 1;
- switch(fegetround()) {
- case FE_TOWARDZERO: Rounding = 0; break;
- case FE_UPWARD: Rounding = 2; break;
- case FE_DOWNWARD: Rounding = 3;
- }
-#endif /*}}*/
-#endif /*}*/
-
-#ifndef MULTIPLE_THREADS
- if (dtoa_result) {
- freedtoa(dtoa_result);
- dtoa_result = 0;
- }
-#endif
-
- u.d = dd;
- if (word0(&u) & Sign_bit) {
- /* set sign for everything, including 0's and NaNs */
- *sign = 1;
- word0(&u) &= ~Sign_bit; /* clear sign bit */
- }
- else
- *sign = 0;
-
-#if defined(IEEE_Arith) + defined(VAX)
-#ifdef IEEE_Arith
- if ((word0(&u) & Exp_mask) == Exp_mask)
-#else
- if (word0(&u) == 0x8000)
-#endif
- {
- /* Infinity or NaN */
- *decpt = 9999;
-#ifdef IEEE_Arith
- if (!word1(&u) && !(word0(&u) & 0xfffff))
- return nrv_alloc("Infinity", rve, 8);
-#endif
- return nrv_alloc("NaN", rve, 3);
- }
-#endif
-#ifdef IBM
- dval(&u) += 0; /* normalize */
-#endif
- if (!dval(&u)) {
- *decpt = 1;
- return nrv_alloc("0", rve, 1);
- }
-
-#ifdef SET_INEXACT
- try_quick = oldinexact = get_inexact();
- inexact = 1;
-#endif
-#ifdef Honor_FLT_ROUNDS
- if (Rounding >= 2) {
- if (*sign)
- Rounding = Rounding == 2 ? 0 : 2;
- else
- if (Rounding != 2)
- Rounding = 0;
- }
-#endif
-
- b = d2b(&u, &be, &bbits);
-#ifdef Sudden_Underflow
- i = (int)(word0(&u) >> Exp_shift1 & (Exp_mask>>Exp_shift1));
-#else
- if ((i = (int)(word0(&u) >> Exp_shift1 & (Exp_mask>>Exp_shift1)))) {
-#endif
- dval(&d2) = dval(&u);
- word0(&d2) &= Frac_mask1;
- word0(&d2) |= Exp_11;
-#ifdef IBM
- if (j = 11 - hi0bits(word0(&d2) & Frac_mask))
- dval(&d2) /= 1 << j;
-#endif
-
- /* log(x) ~=~ log(1.5) + (x-1.5)/1.5
- * log10(x) = log(x) / log(10)
- * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
- * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
- *
- * This suggests computing an approximation k to log10(d) by
- *
- * k = (i - Bias)*0.301029995663981
- * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
- *
- * We want k to be too large rather than too small.
- * The error in the first-order Taylor series approximation
- * is in our favor, so we just round up the constant enough
- * to compensate for any error in the multiplication of
- * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
- * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
- * adding 1e-13 to the constant term more than suffices.
- * Hence we adjust the constant term to 0.1760912590558.
- * (We could get a more accurate k by invoking log10,
- * but this is probably not worthwhile.)
- */
-
- i -= Bias;
-#ifdef IBM
- i <<= 2;
- i += j;
-#endif
-#ifndef Sudden_Underflow
- denorm = 0;
- }
- else {
- /* d is denormalized */
-
- i = bbits + be + (Bias + (P-1) - 1);
- x = i > 32 ? word0(&u) << (64 - i) | word1(&u) >> (i - 32)
- : word1(&u) << (32 - i);
- dval(&d2) = x;
- word0(&d2) -= 31*Exp_msk1; /* adjust exponent */
- i -= (Bias + (P-1) - 1) + 1;
- denorm = 1;
- }
-#endif
- ds = (dval(&d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981;
- k = (int)ds;
- if (ds < 0. && ds != k)
- k--; /* want k = floor(ds) */
- k_check = 1;
- if (k >= 0 && k <= Ten_pmax) {
- if (dval(&u) < tens[k])
- k--;
- k_check = 0;
- }
- j = bbits - i - 1;
- if (j >= 0) {
- b2 = 0;
- s2 = j;
- }
- else {
- b2 = -j;
- s2 = 0;
- }
- if (k >= 0) {
- b5 = 0;
- s5 = k;
- s2 += k;
- }
- else {
- b2 -= k;
- b5 = -k;
- s5 = 0;
- }
- if (mode < 0 || mode > 9)
- mode = 0;
-
-#ifndef SET_INEXACT
-#ifdef Check_FLT_ROUNDS
- try_quick = Rounding == 1;
-#else
- try_quick = 1;
-#endif
-#endif /*SET_INEXACT*/
-
- if (mode > 5) {
- mode -= 4;
- try_quick = 0;
- }
- leftright = 1;
- ilim = ilim1 = -1; /* Values for cases 0 and 1; done here to */
- /* silence erroneous "gcc -Wall" warning. */
- switch(mode) {
- case 0:
- case 1:
- i = 18;
- ndigits = 0;
- break;
- case 2:
- leftright = 0;
- /* no break */
- case 4:
- if (ndigits <= 0)
- ndigits = 1;
- ilim = ilim1 = i = ndigits;
- break;
- case 3:
- leftright = 0;
- /* no break */
- case 5:
- i = ndigits + k + 1;
- ilim = i;
- ilim1 = i - 1;
- if (i <= 0)
- i = 1;
- }
- s = s0 = rv_alloc(i);
-
-#ifdef Honor_FLT_ROUNDS
- if (mode > 1 && Rounding != 1)
- leftright = 0;
-#endif
-
- if (ilim >= 0 && ilim <= Quick_max && try_quick) {
-
- /* Try to get by with floating-point arithmetic. */
-
- i = 0;
- dval(&d2) = dval(&u);
- k0 = k;
- ilim0 = ilim;
- ieps = 2; /* conservative */
- if (k > 0) {
- ds = tens[k&0xf];
- j = k >> 4;
- if (j & Bletch) {
- /* prevent overflows */
- j &= Bletch - 1;
- dval(&u) /= bigtens[n_bigtens-1];
- ieps++;
- }
- for(; j; j >>= 1, i++)
- if (j & 1) {
- ieps++;
- ds *= bigtens[i];
- }
- dval(&u) /= ds;
- }
- else if ((j1 = -k)) {
- dval(&u) *= tens[j1 & 0xf];
- for(j = j1 >> 4; j; j >>= 1, i++)
- if (j & 1) {
- ieps++;
- dval(&u) *= bigtens[i];
- }
- }
- if (k_check && dval(&u) < 1. && ilim > 0) {
- if (ilim1 <= 0)
- goto fast_failed;
- ilim = ilim1;
- k--;
- dval(&u) *= 10.;
- ieps++;
- }
- dval(&eps) = ieps*dval(&u) + 7.;
- word0(&eps) -= (P-1)*Exp_msk1;
- if (ilim == 0) {
- S = mhi = 0;
- dval(&u) -= 5.;
- if (dval(&u) > dval(&eps))
- goto one_digit;
- if (dval(&u) < -dval(&eps))
- goto no_digits;
- goto fast_failed;
- }
-#ifndef No_leftright
- if (leftright) {
- /* Use Steele & White method of only
- * generating digits needed.
- */
- dval(&eps) = 0.5/tens[ilim-1] - dval(&eps);
-#ifdef IEEE_Arith
- if (k0 < 0 && j1 >= 307) {
- eps1.d = 1.01e256; /* 1.01 allows roundoff in the next few lines */
- word0(&eps1) -= Exp_msk1 * (Bias+P-1);
- dval(&eps1) *= tens[j1 & 0xf];
- for(i = 0, j = (j1-256) >> 4; j; j >>= 1, i++)
- if (j & 1)
- dval(&eps1) *= bigtens[i];
- if (eps.d < eps1.d)
- eps.d = eps1.d;
- }
-#endif
- for(i = 0;;) {
- L = dval(&u);
- dval(&u) -= L;
- *s++ = '0' + (int)L;
- if (1. - dval(&u) < dval(&eps))
- goto bump_up;
- if (dval(&u) < dval(&eps))
- goto ret1;
- if (++i >= ilim)
- break;
- dval(&eps) *= 10.;
- dval(&u) *= 10.;
- }
- }
- else {
-#endif
- /* Generate ilim digits, then fix them up. */
- dval(&eps) *= tens[ilim-1];
- for(i = 1;; i++, dval(&u) *= 10.) {
- L = (Long)(dval(&u));
- if (!(dval(&u) -= L))
- ilim = i;
- *s++ = '0' + (int)L;
- if (i == ilim) {
- if (dval(&u) > 0.5 + dval(&eps))
- goto bump_up;
- else if (dval(&u) < 0.5 - dval(&eps)) {
- while(*--s == '0');
- s++;
- goto ret1;
- }
- break;
- }
- }
-#ifndef No_leftright
- }
-#endif
- fast_failed:
- s = s0;
- dval(&u) = dval(&d2);
- k = k0;
- ilim = ilim0;
- }
-
- /* Do we have a "small" integer? */
-
- if (be >= 0 && k <= Int_max) {
- /* Yes. */
- ds = tens[k];
- if (ndigits < 0 && ilim <= 0) {
- S = mhi = 0;
- if (ilim < 0 || dval(&u) <= 5*ds)
- goto no_digits;
- goto one_digit;
- }
- for(i = 1;; i++, dval(&u) *= 10.) {
- L = (Long)(dval(&u) / ds);
- dval(&u) -= L*ds;
-#ifdef Check_FLT_ROUNDS
- /* If FLT_ROUNDS == 2, L will usually be high by 1 */
- if (dval(&u) < 0) {
- L--;
- dval(&u) += ds;
- }
-#endif
- *s++ = '0' + (int)L;
- if (!dval(&u)) {
-#ifdef SET_INEXACT
- inexact = 0;
-#endif
- break;
- }
- if (i == ilim) {
-#ifdef Honor_FLT_ROUNDS
- if (mode > 1)
- switch(Rounding) {
- case 0: goto ret1;
- case 2: goto bump_up;
- }
-#endif
- dval(&u) += dval(&u);
-#ifdef ROUND_BIASED
- if (dval(&u) >= ds)
-#else
- if (dval(&u) > ds || (dval(&u) == ds && L & 1))
-#endif
- {
- bump_up:
- while(*--s == '9')
- if (s == s0) {
- k++;
- *s = '0';
- break;
- }
- ++*s++;
- }
- break;
- }
- }
- goto ret1;
- }
-
- m2 = b2;
- m5 = b5;
- mhi = mlo = 0;
- if (leftright) {
- i =
-#ifndef Sudden_Underflow
- denorm ? be + (Bias + (P-1) - 1 + 1) :
-#endif
-#ifdef IBM
- 1 + 4*P - 3 - bbits + ((bbits + be - 1) & 3);
-#else
- 1 + P - bbits;
-#endif
- b2 += i;
- s2 += i;
- mhi = i2b(1);
- }
- if (m2 > 0 && s2 > 0) {
- i = m2 < s2 ? m2 : s2;
- b2 -= i;
- m2 -= i;
- s2 -= i;
- }
- if (b5 > 0) {
- if (leftright) {
- if (m5 > 0) {
- mhi = pow5mult(mhi, m5);
- b1 = mult(mhi, b);
- Bfree(b);
- b = b1;
- }
- if ((j = b5 - m5))
- b = pow5mult(b, j);
- }
- else
- b = pow5mult(b, b5);
- }
- S = i2b(1);
- if (s5 > 0)
- S = pow5mult(S, s5);
-
- /* Check for special case that d is a normalized power of 2. */
-
- spec_case = 0;
- if ((mode < 2 || leftright)
-#ifdef Honor_FLT_ROUNDS
- && Rounding == 1
-#endif
- ) {
- if (!word1(&u) && !(word0(&u) & Bndry_mask)
-#ifndef Sudden_Underflow
- && word0(&u) & (Exp_mask & ~Exp_msk1)
-#endif
- ) {
- /* The special case */
- b2 += Log2P;
- s2 += Log2P;
- spec_case = 1;
- }
- }
-
- /* Arrange for convenient computation of quotients:
- * shift left if necessary so divisor has 4 leading 0 bits.
- *
- * Perhaps we should just compute leading 28 bits of S once
- * and for all and pass them and a shift to quorem, so it
- * can do shifts and ors to compute the numerator for q.
- */
- i = dshift(S, s2);
- b2 += i;
- m2 += i;
- s2 += i;
- if (b2 > 0)
- b = lshift(b, b2);
- if (s2 > 0)
- S = lshift(S, s2);
- if (k_check) {
- if (cmp(b,S) < 0) {
- k--;
- b = multadd(b, 10, 0); /* we botched the k estimate */
- if (leftright)
- mhi = multadd(mhi, 10, 0);
- ilim = ilim1;
- }
- }
- if (ilim <= 0 && (mode == 3 || mode == 5)) {
- if (ilim < 0 || cmp(b,S = multadd(S,5,0)) <= 0) {
- /* no digits, fcvt style */
- no_digits:
- k = -1 - ndigits;
- goto ret;
- }
- one_digit:
- *s++ = '1';
- k++;
- goto ret;
- }
- if (leftright) {
- if (m2 > 0)
- mhi = lshift(mhi, m2);
-
- /* Compute mlo -- check for special case
- * that d is a normalized power of 2.
- */
-
- mlo = mhi;
- if (spec_case) {
- mhi = Balloc(mhi->k);
- Bcopy(mhi, mlo);
- mhi = lshift(mhi, Log2P);
- }
-
- for(i = 1;;i++) {
- dig = quorem(b,S) + '0';
- /* Do we yet have the shortest decimal string
- * that will round to d?
- */
- j = cmp(b, mlo);
- delta = diff(S, mhi);
- j1 = delta->sign ? 1 : cmp(b, delta);
- Bfree(delta);
-#ifndef ROUND_BIASED
- if (j1 == 0 && mode != 1 && !(word1(&u) & 1)
-#ifdef Honor_FLT_ROUNDS
- && Rounding >= 1
-#endif
- ) {
- if (dig == '9')
- goto round_9_up;
- if (j > 0)
- dig++;
-#ifdef SET_INEXACT
- else if (!b->x[0] && b->wds <= 1)
- inexact = 0;
-#endif
- *s++ = dig;
- goto ret;
- }
-#endif
- if (j < 0 || (j == 0 && mode != 1
-#ifndef ROUND_BIASED
- && !(word1(&u) & 1)
-#endif
- )) {
- if (!b->x[0] && b->wds <= 1) {
-#ifdef SET_INEXACT
- inexact = 0;
-#endif
- goto accept_dig;
- }
-#ifdef Honor_FLT_ROUNDS
- if (mode > 1)
- switch(Rounding) {
- case 0: goto accept_dig;
- case 2: goto keep_dig;
- }
-#endif /*Honor_FLT_ROUNDS*/
- if (j1 > 0) {
- b = lshift(b, 1);
- j1 = cmp(b, S);
-#ifdef ROUND_BIASED
- if (j1 >= 0 /*)*/
-#else
- if ((j1 > 0 || (j1 == 0 && dig & 1))
-#endif
- && dig++ == '9')
- goto round_9_up;
- }
- accept_dig:
- *s++ = dig;
- goto ret;
- }
- if (j1 > 0) {
-#ifdef Honor_FLT_ROUNDS
- if (!Rounding)
- goto accept_dig;
-#endif
- if (dig == '9') { /* possible if i == 1 */
- round_9_up:
- *s++ = '9';
- goto roundoff;
- }
- *s++ = dig + 1;
- goto ret;
- }
-#ifdef Honor_FLT_ROUNDS
- keep_dig:
-#endif
- *s++ = dig;
- if (i == ilim)
- break;
- b = multadd(b, 10, 0);
- if (mlo == mhi)
- mlo = mhi = multadd(mhi, 10, 0);
- else {
- mlo = multadd(mlo, 10, 0);
- mhi = multadd(mhi, 10, 0);
- }
- }
- }
- else
- for(i = 1;; i++) {
- *s++ = dig = quorem(b,S) + '0';
- if (!b->x[0] && b->wds <= 1) {
-#ifdef SET_INEXACT
- inexact = 0;
-#endif
- goto ret;
- }
- if (i >= ilim)
- break;
- b = multadd(b, 10, 0);
- }
-
- /* Round off last digit */
-
-#ifdef Honor_FLT_ROUNDS
- switch(Rounding) {
- case 0: goto trimzeros;
- case 2: goto roundoff;
- }
-#endif
- b = lshift(b, 1);
- j = cmp(b, S);
-#ifdef ROUND_BIASED
- if (j >= 0)
-#else
- if (j > 0 || (j == 0 && dig & 1))
-#endif
- {
- roundoff:
- while(*--s == '9')
- if (s == s0) {
- k++;
- *s++ = '1';
- goto ret;
- }
- ++*s++;
- }
- else {
-#ifdef Honor_FLT_ROUNDS
- trimzeros:
-#endif
- while(*--s == '0');
- s++;
- }
- ret:
- Bfree(S);
- if (mhi) {
- if (mlo && mlo != mhi)
- Bfree(mlo);
- Bfree(mhi);
- }
- ret1:
-#ifdef SET_INEXACT
- if (inexact) {
- if (!oldinexact) {
- word0(&u) = Exp_1 + (70 << Exp_shift);
- word1(&u) = 0;
- dval(&u) += 1.;
- }
- }
- else if (!oldinexact)
- clear_inexact();
-#endif
- Bfree(b);
- *s = 0;
- *decpt = k + 1;
- if (rve)
- *rve = s;
- return s0;
- }
-#ifdef __cplusplus
-}
-#endif
diff --git a/libpolyml/realconv.h b/libpolyml/realconv.h
deleted file mode 100644
index 3ce9fe2d..00000000
--- a/libpolyml/realconv.h
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- Title: Real number conversion
- Author: Dave Matthews, Cambridge University Computer Laboratory
-
- Copyright (c) 2000
- Cambridge University Technical Services Limited
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-
-*/
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#elif defined(_WIN32)
-#include "winconfig.h"
-#else
-#error "No configuration file"
-#endif
-
-#ifndef REALCONV_H
-#define REALCONV_H
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-#ifndef HAVE_STRTOD
-extern double poly_strtod(const char *s00, char **se);
-#endif
-
-extern char *poly_dtoa(double d, int mode, int ndigits,
- int *decpt, int *sign, char **rve);
-extern void poly_freedtoa(char *s);
-
-#ifdef __cplusplus
-};
-#endif
-
-#endif
diff --git a/libpolyml/reals.cpp b/libpolyml/reals.cpp
index b0a7204c..d590b2ca 100644
--- a/libpolyml/reals.cpp
+++ b/libpolyml/reals.cpp
@@ -1,1070 +1,940 @@
/*
Title: Real number package.
Author: Dave Matthews, Cambridge University Computer Laboratory
Copyright (c) 2000
Cambridge University Technical Services Limited
- Further work copyright David C.J. Matthews 2011, 2016-19
+ Further work copyright David C.J. Matthews 2011, 2016-19, 2023
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*/
#ifdef HAVE_CONFIG_H
#include "config.h"
#elif defined(_WIN32)
#include "winconfig.h"
#else
#error "No configuration file"
#endif
#ifdef HAVE_IEEEFP_H
/* Other operating systems include "finite" in math.h, but Solaris doesn't? */
#include
#endif
#ifdef HAVE_FPU_CONTROL_H
#include
#endif
#ifdef HAVE_FENV_H
#include
#endif
#ifdef HAVE_FLOAT_H
#include
#endif
#ifdef HAVE_MATH_H
#include
#endif
#ifdef HAVE_STDIO_H
#include
#endif
#ifdef HAVE_STRING_H
#include
#endif
#ifdef HAVE_ERRNO_H
#include
#endif
#ifdef HAVE_STDLIB_H
#include
#endif
#ifdef HAVE_STDINT_H
#include
#endif
#ifdef HAVE_ASSERT_H
#include
#define ASSERT(x) assert(x)
#else
#define ASSERT(x)
#endif
#include // Currently just for isnan.
#include "globals.h"
#include "run_time.h"
#include "reals.h"
#include "arb.h"
#include "sys.h"
-#include "realconv.h"
#include "polystring.h"
#include "save_vec.h"
#include "rts_module.h"
#include "machine_dep.h"
#include "processes.h"
#include "rtsentry.h"
/*
The Standard Basis Library assumes IEEE representation for reals. Among other
things it does not permit equality on reals. That simplifies things
considerably since we don't have to worry about there being two different
representations of zero as 0 and ~0. We also don't need to check that the
result is finite since NaN is allowed as a result.
This code could do with being checked by someone who really understands
IEEE floating point arithmetic.
*/
extern "C" {
- POLYEXTERNALSYMBOL POLYUNSIGNED PolyRealBoxedToString(POLYUNSIGNED threadId, POLYUNSIGNED arg, POLYUNSIGNED mode, POLYUNSIGNED digits);
- POLYEXTERNALSYMBOL POLYUNSIGNED PolyRealGeneral(POLYUNSIGNED threadId, POLYUNSIGNED code, POLYUNSIGNED arg);
POLYEXTERNALSYMBOL POLYUNSIGNED PolyRealBoxedFromString(POLYUNSIGNED threadId, POLYUNSIGNED str);
POLYEXTERNALSYMBOL POLYUNSIGNED PolyRealBoxedToLongInt(POLYUNSIGNED threadId, POLYUNSIGNED arg);
POLYEXTERNALSYMBOL double PolyRealSqrt(double arg);
POLYEXTERNALSYMBOL double PolyRealSin(double arg);
POLYEXTERNALSYMBOL double PolyRealCos(double arg);
POLYEXTERNALSYMBOL double PolyRealArctan(double arg);
POLYEXTERNALSYMBOL double PolyRealExp(double arg);
POLYEXTERNALSYMBOL double PolyRealLog(double arg);
POLYEXTERNALSYMBOL double PolyRealTan(double arg);
POLYEXTERNALSYMBOL double PolyRealArcSin(double arg);
POLYEXTERNALSYMBOL double PolyRealArcCos(double arg);
POLYEXTERNALSYMBOL double PolyRealLog10(double arg);
POLYEXTERNALSYMBOL double PolyRealSinh(double arg);
POLYEXTERNALSYMBOL double PolyRealCosh(double arg);
POLYEXTERNALSYMBOL double PolyRealTanh(double arg);
POLYEXTERNALSYMBOL double PolyRealFloor(double arg);
POLYEXTERNALSYMBOL double PolyRealCeil(double arg);
POLYEXTERNALSYMBOL double PolyRealTrunc(double arg);
POLYEXTERNALSYMBOL double PolyRealRound(double arg);
POLYEXTERNALSYMBOL double PolyRealRem(double arg1, double arg2);
POLYEXTERNALSYMBOL double PolyFloatArbitraryPrecision(POLYUNSIGNED arg);
POLYEXTERNALSYMBOL POLYSIGNED PolyGetRoundingMode(POLYUNSIGNED);
POLYEXTERNALSYMBOL POLYSIGNED PolySetRoundingMode(POLYUNSIGNED);
- POLYEXTERNALSYMBOL POLYUNSIGNED PolyRealSize(POLYUNSIGNED);
POLYEXTERNALSYMBOL double PolyRealAtan2(double arg1, double arg2);
POLYEXTERNALSYMBOL double PolyRealPow(double arg1, double arg2);
POLYEXTERNALSYMBOL double PolyRealCopySign(double arg1, double arg2);
POLYEXTERNALSYMBOL double PolyRealNextAfter(double arg1, double arg2);
POLYEXTERNALSYMBOL double PolyRealLdexp(double arg1, POLYUNSIGNED arg2);
POLYEXTERNALSYMBOL POLYUNSIGNED PolyRealFrexp(POLYUNSIGNED threadId, POLYUNSIGNED arg);
POLYEXTERNALSYMBOL float PolyRealFSqrt(float arg);
POLYEXTERNALSYMBOL float PolyRealFSin(float arg);
POLYEXTERNALSYMBOL float PolyRealFCos(float arg);
POLYEXTERNALSYMBOL float PolyRealFArctan(float arg);
POLYEXTERNALSYMBOL float PolyRealFExp(float arg);
POLYEXTERNALSYMBOL float PolyRealFLog(float arg);
POLYEXTERNALSYMBOL float PolyRealFTan(float arg);
POLYEXTERNALSYMBOL float PolyRealFArcSin(float arg);
POLYEXTERNALSYMBOL float PolyRealFArcCos(float arg);
POLYEXTERNALSYMBOL float PolyRealFLog10(float arg);
POLYEXTERNALSYMBOL float PolyRealFSinh(float arg);
POLYEXTERNALSYMBOL float PolyRealFCosh(float arg);
POLYEXTERNALSYMBOL float PolyRealFTanh(float arg);
POLYEXTERNALSYMBOL float PolyRealFAtan2(float arg1, float arg2);
POLYEXTERNALSYMBOL float PolyRealFPow(float arg1, float arg2);
POLYEXTERNALSYMBOL float PolyRealFCopySign(float arg1, float arg2);
POLYEXTERNALSYMBOL float PolyRealFFloor(float arg);
POLYEXTERNALSYMBOL float PolyRealFCeil(float arg);
POLYEXTERNALSYMBOL float PolyRealFTrunc(float arg);
POLYEXTERNALSYMBOL float PolyRealFRound(float arg);
POLYEXTERNALSYMBOL float PolyRealFRem(float arg1, float arg2);
POLYEXTERNALSYMBOL float PolyRealFNextAfter(float arg1, float arg2);
}
-static Handle Real_strc(TaskData *mdTaskData, Handle hDigits, Handle hMode, Handle arg);
static Handle Real_convc(TaskData *mdTaskData, Handle str);
// Positive and negative infinities and (positive) NaN.
double posInf, negInf, notANumber;
float posInfF, negInfF, notANumberF;
/* Real numbers are represented by the address of the value. */
#define DBLE sizeof(double)/sizeof(POLYUNSIGNED)
union db { double dble; POLYUNSIGNED words[DBLE]; };
double real_arg(Handle x)
{
union db r_arg_x;
for (unsigned i = 0; i < DBLE; i++)
{
r_arg_x.words[i] = x->WordP()->Get(i).AsUnsigned();
}
return r_arg_x.dble;
}
Handle real_result(TaskData *mdTaskData, double x)
{
union db argx;
argx.dble = x;
PolyObject *v = alloc(mdTaskData, DBLE, F_BYTE_OBJ);
/* Copy as words in case the alignment is wrong. */
for(unsigned i = 0; i < DBLE; i++)
{
v->Set(i, PolyWord::FromUnsigned(argx.words[i]));
}
return mdTaskData->saveVec.push(v);
}
// We're using float for Real32 so it needs to be 32-bits.
// Assume that's true for the moment.
#if (SIZEOF_FLOAT != 4)
#error "Float is not 32-bits. Please report this"
#endif
union flt { float fl; int32_t i; };
#if (SIZEOF_FLOAT < SIZEOF_POLYWORD)
// Typically for 64-bit mode. Use a tagged representation.
// The code-generator on the X86/64 assumes the float is in the
// high order word.
#define FLT_SHIFT ((SIZEOF_POLYWORD-SIZEOF_FLOAT)*8)
float float_arg(Handle x)
{
union flt argx;
argx.i = x->Word().AsSigned() >> FLT_SHIFT;
return argx.fl;
}
Handle float_result(TaskData *mdTaskData, float x)
{
union flt argx;
argx.fl = x;
return mdTaskData->saveVec.push(PolyWord::FromSigned(((POLYSIGNED)argx.i << FLT_SHIFT) + 1));
}
#else
// Typically for 32-bit mode. Use a boxed representation.
float float_arg(Handle x)
{
union flt argx;
argx.i = (int32_t)x->WordP()->Get(0).AsSigned();
return argx.fl;
}
Handle float_result(TaskData *mdTaskData, float x)
{
union flt argx;
argx.fl = x;
PolyObject *v = alloc(mdTaskData, 1, F_BYTE_OBJ);
v->Set(0, PolyWord::FromSigned(argx.i));
return mdTaskData->saveVec.push(v);
}
#endif
POLYEXTERNALSYMBOL double PolyFloatArbitraryPrecision(POLYUNSIGNED arg)
{
return get_arbitrary_precision_as_real(PolyWord::FromUnsigned(arg));
}
// Convert a boxed real to a long precision int.
POLYUNSIGNED PolyRealBoxedToLongInt(POLYUNSIGNED threadId, POLYUNSIGNED arg)
{
TaskData *taskData = TaskData::FindTaskForId(threadId);
ASSERT(taskData != 0);
taskData->PreRTSCall();
Handle reset = taskData->saveVec.mark();
Handle pushedArg = taskData->saveVec.push(arg);
double dx = real_arg(pushedArg);
int64_t i = (int64_t)dx;
Handle result = Make_arbitrary_precision(taskData, i);
taskData->saveVec.reset(reset);
taskData->PostRTSCall();
if (result == 0) return TAGGED(0).AsUnsigned();
else return result->Word().AsUnsigned();
}
// RTS call for square-root.
double PolyRealSqrt(double arg)
{
return sqrt(arg);
}
// RTS call for sine.
double PolyRealSin(double arg)
{
return sin(arg);
}
// RTS call for cosine.
double PolyRealCos(double arg)
{
return cos(arg);
}
// RTS call for arctan.
double PolyRealArctan(double arg)
{
return atan(arg);
}
// RTS call for exp.
double PolyRealExp(double arg)
{
return exp(arg);
}
// RTS call for ln.
double PolyRealLog(double arg)
{
// Make sure the result conforms to the definition.
// If the argument is a Nan each of the first two tests will fail.
if (arg > 0.0)
return log(arg);
else if (arg == 0.0) // x may be +0.0 or -0.0
return negInf; // -infinity.
else return notANumber;
}
// These were handled by the general dispatch function
double PolyRealTan(double arg)
{
return tan(arg);
}
double PolyRealArcSin(double arg)
{
if (arg >= -1.0 && arg <= 1.0)
return asin(arg);
else return notANumber;
}
double PolyRealArcCos(double arg)
{
if (arg >= -1.0 && arg <= 1.0)
return acos(arg);
else return notANumber;
}
double PolyRealLog10(double arg)
{
// Make sure the result conforms to the definition.
// If the argument is a Nan each of the first two tests will fail.
if (arg > 0.0)
return log10(arg);
else if (arg == 0.0) // x may be +0.0 or -0.0
return negInf; // -infinity.
else return notANumber;
}
double PolyRealSinh(double arg)
{
return sinh(arg);
}
double PolyRealCosh(double arg)
{
return cosh(arg);
}
double PolyRealTanh(double arg)
{
return tanh(arg);
}
double PolyRealFloor(double arg)
{
return floor(arg);
}
double PolyRealCeil(double arg)
{
return ceil(arg);
}
double PolyRealTrunc(double arg)
{
// Truncate towards zero
if (arg >= 0.0) return floor(arg);
else return ceil(arg);
}
double PolyRealRound(double arg)
{
// Round to nearest integral value.
double drem = fmod(arg, 2.0);
if (drem == 0.5 || drem == -1.5)
// If the value was exactly positive even + 0.5 or
// negative odd -0.5 round it down, otherwise round it up.
return ceil(arg-0.5);
else return floor(arg+0.5);
}
double PolyRealRem(double arg1, double arg2)
{
return fmod(arg1, arg2);
}
double PolyRealAtan2(double arg1, double arg2)
{
return atan2(arg1, arg2);
}
double PolyRealPow(double x, double y)
{
/* Some of the special cases are defined and don't seem to match
the C pow function (at least as implemented in MS C). */
/* Maybe handle all this in ML? */
if (std::isnan(x))
{
if (y == 0.0) return 1.0;
else return notANumber;
}
else if (std::isnan(y)) return y; /* i.e. nan. */
else if (x == 0.0 && y < 0.0)
{
/* This case is not handled correctly in Solaris. It always
returns -infinity. */
int iy = (int)floor(y);
/* If x is -0.0 and y is an odd integer the result is -infinity. */
if (copysign(1.0, x) < 0.0 && (double)iy == y && (iy & 1))
return negInf; /* -infinity. */
else return posInf; /* +infinity. */
}
return pow(x, y);
}
double PolyRealCopySign(double arg1, double arg2)
{
return copysign(arg1, arg2);
}
double PolyRealNextAfter(double arg1, double arg2)
{
return nextafter(arg1, arg2);
}
double PolyRealLdexp(double arg1, POLYUNSIGNED arg2)
{
POLYSIGNED exponent = PolyWord::FromUnsigned(arg2).UnTagged();
#if (SIZEOF_POLYWORD > SIZEOF_INT)
// We've already checked for arbitrary precision values where necessary and
// for zero and non-finite mantissa. Check the exponent fits in an int.
if (exponent > 2 * DBL_MAX_EXP) return copysign(INFINITY, arg1);
if (exponent < -2 * DBL_MAX_EXP) return copysign(0.0, arg1);
#endif
return ldexp(arg1, (int)exponent);
}
// Return the normalised fraction and the exponent.
POLYUNSIGNED PolyRealFrexp(POLYUNSIGNED threadId, POLYUNSIGNED arg)
{
TaskData *taskData = TaskData::FindTaskForId(threadId);
ASSERT(taskData != 0);
taskData->PreRTSCall();
Handle reset = taskData->saveVec.mark();
Handle pushedArg = taskData->saveVec.push(arg);
Handle result = 0;
try {
int exp = 0; // The value of exp is not always defined.
Handle mantH = real_result(taskData, frexp(real_arg(pushedArg), &exp));
// Allocate a pair for the result
result = alloc_and_save(taskData, 2);
result->WordP()->Set(0, TAGGED(exp));
result->WordP()->Set(1, mantH->Word());
}
catch (...) {} // If an ML exception is raised
taskData->saveVec.reset(reset);
taskData->PostRTSCall();
if (result == 0) return TAGGED(0).AsUnsigned();
else return result->Word().AsUnsigned();
}
// RTS call for square-root.
float PolyRealFSqrt(float arg)
{
return sqrtf(arg);
}
// RTS call for sine.
float PolyRealFSin(float arg)
{
return sinf(arg);
}
// RTS call for cosine.
float PolyRealFCos(float arg)
{
return cosf(arg);
}
// RTS call for arctan.
float PolyRealFArctan(float arg)
{
return atanf(arg);
}
// RTS call for exp.
float PolyRealFExp(float arg)
{
return expf(arg);
}
// RTS call for ln.
float PolyRealFLog(float arg)
{
// Make sure the result conforms to the definition.
// If the argument is a Nan each of the first two tests will fail.
if (arg > 0.0)
return logf(arg);
else if (arg == 0.0) // x may be +0.0 or -0.0
return negInfF; // -infinity.
else return notANumberF;
}
float PolyRealFTan(float arg)
{
return tanf(arg);
}
float PolyRealFArcSin(float arg)
{
if (arg >= -1.0 && arg <= 1.0)
return asinf(arg);
else return notANumberF;
}
float PolyRealFArcCos(float arg)
{
if (arg >= -1.0 && arg <= 1.0)
return acosf(arg);
else return notANumberF;
}
float PolyRealFLog10(float arg)
{
// Make sure the result conforms to the definition.
// If the argument is a Nan each of the first two tests will fail.
if (arg > 0.0)
return log10f(arg);
else if (arg == 0.0) // x may be +0.0 or -0.0
return negInfF; // -infinity.
else return notANumberF;
}
float PolyRealFSinh(float arg)
{
return sinhf(arg);
}
float PolyRealFCosh(float arg)
{
return coshf(arg);
}
float PolyRealFTanh(float arg)
{
return tanhf(arg);
}
float PolyRealFAtan2(float arg1, float arg2)
{
return atan2f(arg1, arg2);
}
float PolyRealFPow(float x, float y)
{
/* Some of the special cases are defined and don't seem to match
the C pow function (at least as implemented in MS C). */
/* Maybe handle all this in ML? */
if (std::isnan(x))
{
if (y == 0.0) return 1.0;
else return notANumberF;
}
else if (std::isnan(y)) return y; /* i.e. nan. */
else if (x == 0.0 && y < 0.0)
{
/* This case is not handled correctly in Solaris. It always
returns -infinity. */
int iy = (int)floorf(y);
/* If x is -0.0 and y is an odd integer the result is -infinity. */
if (copysign(1.0, x) < 0.0 && (float)iy == y && (iy & 1))
return negInfF; /* -infinity. */
else return posInfF; /* +infinity. */
}
return powf(x, y);
}
float PolyRealFFloor(float arg)
{
return floorf(arg);
}
float PolyRealFCeil(float arg)
{
return ceilf(arg);
}
float PolyRealFTrunc(float arg)
{
// Truncate towards zero
if (arg >= 0.0) return floorf(arg);
else return ceilf(arg);
}
float PolyRealFRound(float arg)
{
// Round to nearest integral value.
float drem = fmodf(arg, 2.0);
if (drem == 0.5 || drem == -1.5)
// If the value was exactly positive even + 0.5 or
// negative odd -0.5 round it down, otherwise round it up.
return ceilf(arg - 0.5f);
else return floorf(arg + 0.5f);
}
float PolyRealFRem(float arg1, float arg2)
{
return fmodf(arg1, arg2);
}
float PolyRealFCopySign(float arg1, float arg2)
{
return copysignf(arg1, arg2);
}
float PolyRealFNextAfter(float arg1, float arg2)
{
return nextafterf(arg1, arg2);
}
/* CALL_IO1(Real_conv, REF, NOIND) */
Handle Real_convc(TaskData *mdTaskData, Handle str) /* string to real */
{
double result;
int i;
char *finish;
TempCString string_buffer(Poly_string_to_C_alloc(str->Word()));
/* Scan the string turning '~' into '-' */
for(i = 0; string_buffer[i] != '\0'; i ++)
{
if (string_buffer[i] == '~') string_buffer[i] = '-';
}
/* Now convert it */
-#ifdef HAVE_STRTOD
result = strtod(string_buffer, &finish);
-#else
- result = poly_strtod(string_buffer, &finish);
-#endif
// We no longer detect overflow and underflow and instead return
// (signed) zeros for underflow and (signed) infinities for overflow.
if (*finish != '\0') raise_exception_string(mdTaskData, EXC_conversion, "");
return real_result(mdTaskData, result);
}/* Real_conv */
// Convert a string to a boxed real. This should really return an unboxed real.
POLYUNSIGNED PolyRealBoxedFromString(POLYUNSIGNED threadId, POLYUNSIGNED str)
{
TaskData *taskData = TaskData::FindTaskForId(threadId);
ASSERT(taskData != 0);
taskData->PreRTSCall();
Handle reset = taskData->saveVec.mark();
Handle pushedString = taskData->saveVec.push(str);
Handle result = 0;
try {
result = Real_convc(taskData, pushedString);
} catch (...) { } // If an ML exception is raised
taskData->saveVec.reset(reset);
taskData->PostRTSCall();
if (result == 0) return TAGGED(0).AsUnsigned();
else return result->Word().AsUnsigned();
}
#if defined(__SOFTFP__)
// soft-float lacks proper rounding mode support
// While some systems will support fegetround/fesetround, it will have no
// effect on the actual rounding performed, as the software implementation only
// ever rounds to nearest.
int getrounding()
{
return POLY_ROUND_TONEAREST;
}
int setrounding(int rounding)
{
switch (rounding)
{
case POLY_ROUND_TONEAREST: return 0; // The only mode supported
}
return -1; // Error - unsupported
}
// It would be nice to be able to use autoconf to test for these as functions
// but they are frequently inlined
#elif defined(HAVE_FENV_H)
// C99 version. This is becoming the most common.
int getrounding()
{
switch (fegetround())
{
case FE_TONEAREST: return POLY_ROUND_TONEAREST;
#ifndef HOSTARCHITECTURE_SH
case FE_DOWNWARD: return POLY_ROUND_DOWNWARD;
case FE_UPWARD: return POLY_ROUND_UPWARD;
#endif
case FE_TOWARDZERO: return POLY_ROUND_TOZERO;
}
return POLY_ROUND_TONEAREST;
}
int setrounding(int rounding)
{
switch (rounding)
{
case POLY_ROUND_TONEAREST: fesetround(FE_TONEAREST); return 0; // Choose nearest
#ifndef HOSTARCHITECTURE_SH
case POLY_ROUND_DOWNWARD: fesetround(FE_DOWNWARD); return 0; // Towards negative infinity
case POLY_ROUND_UPWARD: fesetround(FE_UPWARD); return 0; // Towards positive infinity
#endif
case POLY_ROUND_TOZERO: fesetround(FE_TOWARDZERO); return 0; // Truncate towards zero
default: return -1;
}
}
#elif (defined(HAVE_IEEEFP_H) && ! defined(__CYGWIN__))
// Older FreeBSD. Cygwin has the ieeefp.h header but not the functions!
int getrounding()
{
switch (fpgetround())
{
case FP_RN: return POLY_ROUND_TONEAREST;
case FP_RM: return POLY_ROUND_DOWNWARD;
case FP_RP: return POLY_ROUND_UPWARD;
case FP_RZ: return POLY_ROUND_TOZERO;
default: return POLY_ROUND_TONEAREST; /* Shouldn't happen. */
}
}
int setrounding(int rounding)
{
switch (rounding)
{
case POLY_ROUND_TONEAREST: fpsetround(FP_RN); break; /* Choose nearest */
case POLY_ROUND_DOWNWARD: fpsetround(FP_RM); break; /* Towards negative infinity */
case POLY_ROUND_UPWARD: fpsetround(FP_RP); break; /* Towards positive infinity */
case POLY_ROUND_TOZERO: fpsetround(FP_RZ); break; /* Truncate towards zero */
}
return 0
}
#elif defined(_WIN32)
// Windows version
int getrounding()
{
switch (_controlfp(0,0) & _MCW_RC)
{
case _RC_NEAR: return POLY_ROUND_TONEAREST;
case _RC_DOWN: return POLY_ROUND_DOWNWARD;
case _RC_UP: return POLY_ROUND_UPWARD;
case _RC_CHOP: return POLY_ROUND_TOZERO;
}
return POLY_ROUND_TONEAREST;
}
int setrounding(int rounding)
{
switch (rounding)
{
case POLY_ROUND_TONEAREST: _controlfp(_RC_NEAR, _MCW_RC); return 0; // Choose nearest
case POLY_ROUND_DOWNWARD: _controlfp(_RC_DOWN, _MCW_RC); return 0; // Towards negative infinity
case POLY_ROUND_UPWARD: _controlfp(_RC_UP, _MCW_RC); return 0; // Towards positive infinity
case POLY_ROUND_TOZERO: _controlfp(_RC_CHOP, _MCW_RC); return 0; // Truncate towards zero
}
return -1;
}
#elif defined(_FPU_GETCW) && defined(_FPU_SETCW)
// Older Linux version
int getrounding()
{
fpu_control_t ctrl;
_FPU_GETCW(ctrl);
switch (ctrl & _FPU_RC_ZERO)
{
case _FPU_RC_NEAREST: return POLY_ROUND_TONEAREST;
case _FPU_RC_DOWN: return POLY_ROUND_DOWNWARD;
case _FPU_RC_UP: return POLY_ROUND_UPWARD;
case _FPU_RC_ZERO: return POLY_ROUND_TOZERO;
}
return POLY_ROUND_TONEAREST; /* Never reached but this avoids warning message. */
}
int setrounding(int rounding)
{
fpu_control_t ctrl;
_FPU_GETCW(ctrl);
ctrl &= ~_FPU_RC_ZERO; /* Mask off any existing rounding. */
switch (rounding)
{
case POLY_ROUND_TONEAREST: ctrl |= _FPU_RC_NEAREST;
case POLY_ROUND_DOWNWARD: ctrl |= _FPU_RC_DOWN;
case POLY_ROUND_UPWARD: ctrl |= _FPU_RC_UP;
case POLY_ROUND_TOZERO: ctrl |= _FPU_RC_ZERO;
}
_FPU_SETCW(ctrl);
return 0;
}
#else
// Give up. Assume that we only support TO_NEAREST
int getrounding()
{
return POLY_ROUND_TONEAREST;
}
int setrounding(int rounding)
{
if (rounding == POLY_ROUND_TONEAREST)
return 0;
else return -1;
}
#endif
POLYSIGNED PolyGetRoundingMode(POLYUNSIGNED)
{
// Get the rounding and turn the result into a tagged integer.
return TAGGED(getrounding()).AsSigned();
}
POLYSIGNED PolySetRoundingMode(POLYUNSIGNED arg)
{
return TAGGED(setrounding((int)PolyWord::FromUnsigned(arg).UnTagged())).AsSigned();
}
-Handle Real_strc(TaskData *mdTaskData, Handle hDigits, Handle hMode, Handle arg)
-{
- double dx = real_arg(arg);
- int decpt, sign;
- int mode = get_C_int(mdTaskData, hMode->Word());
- int digits = get_C_int(mdTaskData, hDigits->Word());
- /* Compute the shortest string which gives the required value. */
- /* */
- char *chars = poly_dtoa(dx, mode, digits, &decpt, &sign, NULL);
- /* We have to be careful in case an allocation causes a
- garbage collection. */
- PolyWord pStr = C_string_to_Poly(mdTaskData, chars);
- poly_freedtoa(chars);
- Handle ppStr = mdTaskData->saveVec.push(pStr);
- /* Allocate a triple for the results. */
- PolyObject *result = alloc(mdTaskData, 3);
- result->Set(0, ppStr->Word());
- result->Set(1, TAGGED(decpt));
- result->Set(2, TAGGED(sign));
- return mdTaskData->saveVec.push(result);
-}
-
-// Convert boxed real to string. This should be changed to use an unboxed real argument.
-POLYUNSIGNED PolyRealBoxedToString(POLYUNSIGNED threadId, POLYUNSIGNED arg, POLYUNSIGNED mode, POLYUNSIGNED digits)
-{
- TaskData *taskData = TaskData::FindTaskForId(threadId);
- ASSERT(taskData != 0);
- taskData->PreRTSCall();
- Handle reset = taskData->saveVec.mark();
- Handle pushedArg = taskData->saveVec.push(arg);
- Handle pushedMode = taskData->saveVec.push(mode);
- Handle pushedDigits = taskData->saveVec.push(digits);
- Handle result = 0;
-
- try {
- result = Real_strc(taskData, pushedDigits, pushedMode, pushedArg);
- } catch (...) { } // Can this raise an exception?
-
- taskData->saveVec.reset(reset);
- taskData->PostRTSCall();
- if (result == 0) return TAGGED(0).AsUnsigned();
- else return result->Word().AsUnsigned();
-}
-
-// This used to be used for all the functions. It now only contains calls
-// used when the Real structure is defined to get the values of constants.
-static Handle Real_dispatchc(TaskData *mdTaskData, Handle args, Handle code)
-{
- unsigned c = get_C_unsigned(mdTaskData, code->Word());
- switch (c)
- {
- /* Floating point representation queries. */
-#ifdef _DBL_RADIX
- case 11: /* Value of radix */ return mdTaskData->saveVec.push(TAGGED(_DBL_RADIX));
-#else
- case 11: /* Value of radix */ return mdTaskData->saveVec.push(TAGGED(FLT_RADIX));
-#endif
- case 12: /* Value of precision */ return mdTaskData->saveVec.push(TAGGED(DBL_MANT_DIG));
- case 13: /* Maximum number */ return real_result(mdTaskData, DBL_MAX);
- case 14: /* Minimum normalised number. */
- return real_result(mdTaskData, DBL_MIN);
-
- case 15: // Minimum number.
-#ifdef DBL_TRUE_MIN
- return real_result(mdTaskData, DBL_TRUE_MIN);
-#else
- return real_result(mdTaskData, DBL_MIN*DBL_EPSILON);
-#endif
-
- // Constants for float (Real32.real)
- case 30: /* Value of radix */ return mdTaskData->saveVec.push(TAGGED(FLT_RADIX));
- case 31: /* Value of precision */ return mdTaskData->saveVec.push(TAGGED(FLT_MANT_DIG));
- case 32: /* Maximum number */ return float_result(mdTaskData, FLT_MAX);
- case 33: /* Minimum normalised number. */
- return float_result(mdTaskData, FLT_MIN);
- case 34: // Minimum number.
-#ifdef FLT_TRUE_MIN
- return float_result(mdTaskData, FLT_TRUE_MIN);
-#else
- return float_result(mdTaskData, FLT_MIN*FLT_EPSILON);
-#endif
-
- default:
- {
- char msg[100];
- sprintf(msg, "Unknown real arithmetic function: %d", c);
- raise_exception_string(mdTaskData, EXC_Fail, msg);
- return 0;
- }
- }
-}
-
-POLYUNSIGNED PolyRealSize(POLYUNSIGNED)
-{
- // Return the number of bytes for a real. This is used in PackRealBig/Little.
- return TAGGED(sizeof(double)).AsUnsigned();
-}
-
-POLYUNSIGNED PolyRealGeneral(POLYUNSIGNED threadId, POLYUNSIGNED code, POLYUNSIGNED arg)
-{
- TaskData *taskData = TaskData::FindTaskForId(threadId);
- ASSERT(taskData != 0);
- taskData->PreRTSCall();
- Handle reset = taskData->saveVec.mark();
- Handle pushedCode = taskData->saveVec.push(code);
- Handle pushedArg = taskData->saveVec.push(arg);
- Handle result = 0;
-
- try {
- result = Real_dispatchc(taskData, pushedArg, pushedCode);
- } catch (...) { } // If an ML exception is raised
-
- taskData->saveVec.reset(reset);
- taskData->PostRTSCall();
- if (result == 0) return TAGGED(0).AsUnsigned();
- else return result->Word().AsUnsigned();
-}
-
struct _entrypts realsEPT[] =
{
- { "PolyRealBoxedToString", (polyRTSFunction)&PolyRealBoxedToString},
- { "PolyRealGeneral", (polyRTSFunction)&PolyRealGeneral},
{ "PolyRealBoxedFromString", (polyRTSFunction)&PolyRealBoxedFromString},
{ "PolyRealBoxedToLongInt", (polyRTSFunction)&PolyRealBoxedToLongInt},
{ "PolyRealSqrt", (polyRTSFunction)&PolyRealSqrt},
{ "PolyRealSin", (polyRTSFunction)&PolyRealSin},
{ "PolyRealCos", (polyRTSFunction)&PolyRealCos},
{ "PolyRealArctan", (polyRTSFunction)&PolyRealArctan},
{ "PolyRealExp", (polyRTSFunction)&PolyRealExp},
{ "PolyRealLog", (polyRTSFunction)&PolyRealLog},
{ "PolyRealTan", (polyRTSFunction)&PolyRealTan},
{ "PolyRealArcSin", (polyRTSFunction)&PolyRealArcSin},
{ "PolyRealArcCos", (polyRTSFunction)&PolyRealArcCos},
{ "PolyRealLog10", (polyRTSFunction)&PolyRealLog10},
{ "PolyRealSinh", (polyRTSFunction)&PolyRealSinh},
{ "PolyRealCosh", (polyRTSFunction)&PolyRealCosh},
{ "PolyRealTanh", (polyRTSFunction)&PolyRealTanh},
{ "PolyRealFloor", (polyRTSFunction)&PolyRealFloor},
{ "PolyRealCeil", (polyRTSFunction)&PolyRealCeil},
{ "PolyRealTrunc", (polyRTSFunction)&PolyRealTrunc},
{ "PolyRealRound", (polyRTSFunction)&PolyRealRound},
{ "PolyRealRem", (polyRTSFunction)&PolyRealRem },
{ "PolyFloatArbitraryPrecision", (polyRTSFunction)&PolyFloatArbitraryPrecision},
{ "PolyGetRoundingMode", (polyRTSFunction)&PolyGetRoundingMode},
{ "PolySetRoundingMode", (polyRTSFunction)&PolySetRoundingMode},
- { "PolyRealSize", (polyRTSFunction)&PolyRealSize},
{ "PolyRealAtan2", (polyRTSFunction)&PolyRealAtan2 },
{ "PolyRealPow", (polyRTSFunction)&PolyRealPow },
{ "PolyRealCopySign", (polyRTSFunction)&PolyRealCopySign },
{ "PolyRealNextAfter", (polyRTSFunction)&PolyRealNextAfter },
{ "PolyRealLdexp", (polyRTSFunction)&PolyRealLdexp },
{ "PolyRealFrexp", (polyRTSFunction)&PolyRealFrexp },
{ "PolyRealFSqrt", (polyRTSFunction)&PolyRealFSqrt },
{ "PolyRealFSin", (polyRTSFunction)&PolyRealFSin },
{ "PolyRealFCos", (polyRTSFunction)&PolyRealFCos },
{ "PolyRealFArctan", (polyRTSFunction)&PolyRealFArctan },
{ "PolyRealFExp", (polyRTSFunction)&PolyRealFExp },
{ "PolyRealFLog", (polyRTSFunction)&PolyRealFLog },
{ "PolyRealFTan", (polyRTSFunction)&PolyRealFTan },
{ "PolyRealFArcSin", (polyRTSFunction)&PolyRealFArcSin },
{ "PolyRealFArcCos", (polyRTSFunction)&PolyRealFArcCos },
{ "PolyRealFLog10", (polyRTSFunction)&PolyRealFLog10 },
{ "PolyRealFSinh", (polyRTSFunction)&PolyRealFSinh },
{ "PolyRealFCosh", (polyRTSFunction)&PolyRealFCosh },
{ "PolyRealFTanh", (polyRTSFunction)&PolyRealFTanh },
{ "PolyRealFAtan2", (polyRTSFunction)&PolyRealFAtan2 },
{ "PolyRealFPow", (polyRTSFunction)&PolyRealFPow },
{ "PolyRealFCopySign", (polyRTSFunction)&PolyRealFCopySign },
{ "PolyRealFFloor", (polyRTSFunction)&PolyRealFFloor },
{ "PolyRealFCeil", (polyRTSFunction)&PolyRealFCeil },
{ "PolyRealFTrunc", (polyRTSFunction)&PolyRealFTrunc },
{ "PolyRealFRound", (polyRTSFunction)&PolyRealFRound },
{ "PolyRealFRem", (polyRTSFunction)&PolyRealFRem },
{ "PolyRealFNextAfter", (polyRTSFunction)&PolyRealFNextAfter },
{ NULL, NULL} // End of list.
};
class RealArithmetic: public RtsModule
{
public:
virtual void Init(void);
};
// Declare this. It will be automatically added to the table.
static RealArithmetic realModule;
void RealArithmetic::Init(void)
{
/* Some compilers object to overflow in constants so
we compute the values here. */
#if (HAVE_DECL_FPSETMASK && ! defined(__CYGWIN__))
/* In FreeBSD 3.4 at least, we sometimes get floating point
exceptions if we don't clear the mask. Maybe need to do
this on other platforms as well just to be sure. */
// N.B. fpsetmask is defined in the headers on Cygwin but there's no function!
fpsetmask(0);
#endif
// NAN and INFINITY are defined in GCC but not in Visual C++.
#if (defined(INFINITY))
posInf = INFINITY;
negInf = -(INFINITY);
posInfF = INFINITY;
negInfF = -(INFINITY);
#else
{
double zero = 0.0;
posInf = 1.0 / zero;
negInf = -1.0 / zero;
float zeroF = 0.0;
posInfF = 1.0 / zeroF;
negInfF = -1.0 / zeroF;
}
#endif
#if (defined(NAN))
notANumber = NAN;
#else
{
double zero = 0.0;
notANumber = zero / zero;
float zeroF = 0.0;
notANumberF = zeroF / zeroF;
}
#endif
// Make sure this is a positive NaN since we return it from "abs".
// "Positive" in this context is copysign(1.0, x) > 0.0 because that's
// how we test the sign so we test it first and then try to change the
// sign if it's wrong.
if (copysign(1.0, notANumber) < 0)
notANumber = copysign(notANumber, 1.0);
if (copysignf(1.0, notANumberF) < 0)
notANumberF = copysignf(notANumberF, 1.0);
}
diff --git a/modules/IntInfAsInt/RealStringCvt.sml b/modules/IntInfAsInt/RealStringCvt.sml
index 431bacf3..1415da1d 100644
--- a/modules/IntInfAsInt/RealStringCvt.sml
+++ b/modules/IntInfAsInt/RealStringCvt.sml
@@ -1,108 +1,108 @@
(*
Title: Rebuild the basis library: Real and StringCvt
Copyright David C.J. Matthews 2016
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
(* Real *)
useBasis "IEEE_REAL.sml";
structure IEEEReal: IEEE_REAL =
struct
open IEEEReal
type decimal_approx =
{ class : float_class, sign : bool, digits : int list, exp : int }
local
fun toNewDA {class, sign, digits, exp } : decimal_approx =
{class=class, sign=sign, digits = map FixedInt.toLarge digits, exp = FixedInt.toLarge exp }
and fromNewDA ({class, sign, digits, exp } : decimal_approx) =
{class=class, sign=sign, digits = map FixedInt.fromLarge digits, exp = FixedInt.fromLarge exp }
in
val toString = toString o fromNewDA
val scan = fn getc => fn src => Option.map(fn (v, c) => (toNewDA v, c)) (scan getc src)
and fromString = (Option.map toNewDA) o fromString
end
end;
(* There's a complication. We need access to both the old and new versions of
the StringCvt.realfmt datatype. *)
local
structure OldStringCvt = StringCvt
in
structure StringCvt: STRING_CVT =
struct
open StringCvt
datatype realfmt
= SCI of int option
| FIX of int option
| GEN of int option
| EXACT
val padRight = fn c => fn i => padRight c (FixedInt.fromInt i)
and padLeft = fn c => fn i => padLeft c (FixedInt.fromInt i)
end;
structure Real =
struct
open Real
val radix = FixedInt.toLarge radix
val precision = FixedInt.toLarge precision
val sign = FixedInt.toLarge o sign
val toManExp = fn r => let val {man, exp} = toManExp r in {man=man, exp= FixedInt.toLarge exp} end
and fromManExp = fn {man, exp} => fromManExp{man=man, exp=FixedInt.fromLarge exp }
val toInt = toLargeInt
and fromInt = fromLargeInt
val floor = toLargeInt IEEEReal.TO_NEGINF
and ceil = toLargeInt IEEEReal.TO_POSINF
and trunc = toLargeInt IEEEReal.TO_ZERO
and round = toLargeInt IEEEReal.TO_NEAREST
val toDecimal =
fn r =>
let
val {class, sign, digits, exp } = toDecimal r
in
{class=class, sign=sign, digits = map FixedInt.toLarge digits, exp = FixedInt.toLarge exp }
end
val fromDecimal =
fn {class, sign, digits, exp } =>
fromDecimal {class=class, sign=sign, digits = map FixedInt.fromLarge digits, exp = FixedInt.fromLarge exp }
local
fun rfmt (StringCvt.SCI(SOME s)) r = fmt (OldStringCvt.SCI(SOME(FixedInt.fromLarge s))) r
| rfmt (StringCvt.SCI NONE) r = fmt (OldStringCvt.SCI NONE) r
| rfmt (StringCvt.FIX(SOME s)) r = fmt (OldStringCvt.FIX(SOME(FixedInt.fromLarge s))) r
| rfmt (StringCvt.FIX NONE) r = fmt (OldStringCvt.FIX NONE) r
| rfmt (StringCvt.GEN(SOME s)) r = fmt (OldStringCvt.GEN(SOME(FixedInt.fromLarge s))) r
| rfmt (StringCvt.GEN NONE) r = fmt (OldStringCvt.GEN NONE) r
| rfmt StringCvt.EXACT r = fmt OldStringCvt.EXACT r
in
val fmt = rfmt
end
end
end;
-useBasis "RealSignature.sml"; (* This uses IEEEReal and the new StringCvt and decimal_approx *)
+useBasis "REAL.sig"; (* This uses IEEEReal and the new StringCvt and decimal_approx *)
structure Real: REAL = Real;
structure LargeReal = Real;
val real : int -> real = Real.fromInt
val trunc : real -> int = Real.trunc
val floor : real -> int = Real.floor
val ceil : real -> int = Real.ceil
val round : real -> int =Real.round;
diff --git a/polyml.pyp b/polyml.pyp
index e3b998fd..ab4ad848 100644
--- a/polyml.pyp
+++ b/polyml.pyp
@@ -1,245 +1,244 @@
-