mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 07:32:24 +00:00
Add check that double and long long (both 64 bit) have same alignment.
This commit is contained in:
David Brown
parent
0ea077814f
commit
20a97bb570
2 changed files with 84 additions and 81 deletions
|
|
@ -1,21 +1,23 @@
|
|||
(* $Id: LowLReal.Mod,v 1.6 1999/09/02 13:15:35 acken Exp $ *)
|
||||
MODULE oocLowLReal;
|
||||
|
||||
(* ToDo. support 64 bit builds *)
|
||||
|
||||
(*
|
||||
LowLReal - Gives access to the underlying properties of the type LONGREAL
|
||||
for IEEE double-precision numbers.
|
||||
LowLReal - Gives access to the underlying properties of the type LONGREAL
|
||||
for IEEE double-precision numbers.
|
||||
Copyright (C) 1996 Michael Griebling
|
||||
|
||||
|
||||
This module is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU Lesser General Public License as
|
||||
it under the terms of the GNU Lesser General Public License as
|
||||
published by the Free Software Foundation; either version 2 of the
|
||||
License, or (at your option) any later version.
|
||||
|
||||
|
||||
This module 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 program; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
|
|
@ -26,7 +28,7 @@ MODULE oocLowLReal;
|
|||
IMPORT Low := oocLowReal, S := SYSTEM;
|
||||
|
||||
(*
|
||||
|
||||
|
||||
Real number properties are defined as follows:
|
||||
|
||||
radix--The whole number value of the radix used to represent the
|
||||
|
|
@ -44,50 +46,50 @@ IMPORT Low := oocLowReal, S := SYSTEM;
|
|||
small--The smallest positive value of the corresponding real number
|
||||
type, represented to maximal precision.
|
||||
|
||||
IEC559--A Boolean value that is TRUE if and only if the implementation
|
||||
of the corresponding real number type conforms to IEC 559:1989
|
||||
IEC559--A Boolean value that is TRUE if and only if the implementation
|
||||
of the corresponding real number type conforms to IEC 559:1989
|
||||
(IEEE 754:1987) in all regards.
|
||||
|
||||
NOTES
|
||||
6 -- If `IEC559' is TRUE, the value of `radix' is 2.
|
||||
7 -- If LowReal.IEC559 is TRUE, the 32-bit format of IEC 559:1989
|
||||
7 -- If LowReal.IEC559 is TRUE, the 32-bit format of IEC 559:1989
|
||||
is used for the type REAL.
|
||||
7 -- If LowLong.IEC559 is TRUE, the 64-bit format of IEC 559:1989
|
||||
7 -- If LowLong.IEC559 is TRUE, the 64-bit format of IEC 559:1989
|
||||
is used for the type REAL.
|
||||
|
||||
LIA1--A Boolean value that is TRUE if and only if the implementation of
|
||||
the corresponding real number type conforms to ISO/IEC 10967-1:199x
|
||||
(LIA-1) in all regards: parameters, arithmetic, exceptions, and
|
||||
LIA1--A Boolean value that is TRUE if and only if the implementation of
|
||||
the corresponding real number type conforms to ISO/IEC 10967-1:199x
|
||||
(LIA-1) in all regards: parameters, arithmetic, exceptions, and
|
||||
notification.
|
||||
|
||||
rounds--A Boolean value that is TRUE if and only if each operation produces
|
||||
a result that is one of the values of the corresponding real number
|
||||
rounds--A Boolean value that is TRUE if and only if each operation produces
|
||||
a result that is one of the values of the corresponding real number
|
||||
type nearest to the mathematical result.
|
||||
|
||||
gUnderflow--A Boolean value that is TRUE if and only if there are values of
|
||||
the corresponding real number type between 0.0 and `small'.
|
||||
gUnderflow--A Boolean value that is TRUE if and only if there are values of
|
||||
the corresponding real number type between 0.0 and `small'.
|
||||
|
||||
exception--A Boolean value that is TRUE if and only if every operation that
|
||||
exception--A Boolean value that is TRUE if and only if every operation that
|
||||
attempts to produce a real value out of range raises an exception.
|
||||
|
||||
extend--A Boolean value that is TRUE if and only if expressions of the
|
||||
corresponding real number type are computed to higher precision than
|
||||
extend--A Boolean value that is TRUE if and only if expressions of the
|
||||
corresponding real number type are computed to higher precision than
|
||||
the stored values.
|
||||
|
||||
nModes--The whole number value giving the number of bit positions needed for
|
||||
nModes--The whole number value giving the number of bit positions needed for
|
||||
the status flags for mode control.
|
||||
|
||||
|
||||
*)
|
||||
|
||||
CONST
|
||||
radix*= 2;
|
||||
places*= 53;
|
||||
expoMax*= 1023;
|
||||
places*= 53;
|
||||
expoMax*= 1023;
|
||||
expoMin*= 1-expoMax;
|
||||
large*= MAX(LONGREAL); (*1.7976931348623157D+308;*) (* MAX(LONGREAL) *)
|
||||
(*small*= 2.2250738585072014D-308;*)
|
||||
small*= 2.2250738585072014/9.9999999999999981D307(*/10^308)*);
|
||||
IEC559*= TRUE;
|
||||
IEC559*= TRUE;
|
||||
LIA1*= FALSE;
|
||||
rounds*= FALSE;
|
||||
gUnderflow*= TRUE; (* there are IEEE numbers smaller than `small' *)
|
||||
|
|
@ -97,23 +99,23 @@ CONST
|
|||
ONE=1.0D0; (* some commonly-used constants *)
|
||||
ZERO=0.0D0;
|
||||
TEN=1.0D1;
|
||||
|
||||
|
||||
DEBUG = TRUE;
|
||||
|
||||
expOffset=expoMax;
|
||||
hiBit=19;
|
||||
expOffset=expoMax;
|
||||
hiBit=19;
|
||||
expBit=hiBit+1;
|
||||
nMask={0..hiBit,31}; (* number mask *)
|
||||
expMask={expBit..30}; (* exponent mask *)
|
||||
|
||||
|
||||
TYPE
|
||||
Modes*= SET;
|
||||
LongInt=ARRAY 2 OF LONGINT;
|
||||
LongSet=ARRAY 2 OF SET;
|
||||
|
||||
LongSet=ARRAY 2 OF SET;
|
||||
|
||||
VAR
|
||||
(*sml* : LONGREAL; tmp: LONGREAL;*) (* this was a test to get small as a variable at runtime. obviously, compile time preferred; -- noch *)
|
||||
isBigEndian-: BOOLEAN; (* set when target is big endian *)
|
||||
isBigEndian-: BOOLEAN; (* set when target is big endian *)
|
||||
(*
|
||||
PROCEDURE power0(i, j : INTEGER) : LONGREAL; (* used to calculate sml at runtime; -- noch *)
|
||||
VAR k : INTEGER;
|
||||
|
|
@ -139,7 +141,7 @@ END err;
|
|||
PROCEDURE ClearError*;
|
||||
BEGIN
|
||||
Low.ClearError
|
||||
END ClearError;
|
||||
END ClearError;
|
||||
|
||||
PROCEDURE ErrorHandler*(err: INTEGER);
|
||||
BEGIN
|
||||
|
|
@ -185,26 +187,26 @@ BEGIN
|
|||
RETURN x
|
||||
END ToReal;
|
||||
(*<* POP *> *)
|
||||
|
||||
|
||||
PROCEDURE exponent*(x: LONGREAL): INTEGER;
|
||||
(*
|
||||
(*
|
||||
The value of the call exponent(x) shall be the exponent value of `x'
|
||||
that lies between `expoMin' and `expoMax'. An exception shall occur
|
||||
and may be raised if `x' is equal to 0.0.
|
||||
*)
|
||||
*)
|
||||
VAR ra: LongInt;
|
||||
BEGIN
|
||||
(* NOTE: x=0.0 should raise exception *)
|
||||
IF x=ZERO THEN RETURN 0
|
||||
ELSE Move(x, ra);
|
||||
RETURN SHORT(S.LSH(ra[0],-expBit) MOD 2048)-expOffset
|
||||
ELSE Move(x, ra);
|
||||
RETURN SHORT(S.LSH(ra[0],-expBit) MOD 2048)-expOffset
|
||||
END
|
||||
END exponent;
|
||||
|
||||
PROCEDURE exponent10*(x: LONGREAL): INTEGER;
|
||||
(*
|
||||
The value of the call exponent10(x) shall be the base 10 exponent
|
||||
value of `x'. An exception shall occur and may be raised if `x' is
|
||||
(*
|
||||
The value of the call exponent10(x) shall be the base 10 exponent
|
||||
value of `x'. An exception shall occur and may be raised if `x' is
|
||||
equal to 0.0.
|
||||
*)
|
||||
VAR exp: INTEGER;
|
||||
|
|
@ -215,19 +217,19 @@ BEGIN
|
|||
WHILE x<1 DO x:=x*TEN; DEC(exp) END;
|
||||
RETURN exp
|
||||
END exponent10;
|
||||
|
||||
|
||||
PROCEDURE fraction*(x: LONGREAL): LONGREAL;
|
||||
(*
|
||||
The value of the call fraction(x) shall be the significand (or
|
||||
significant) part of `x'. Hence the following relationship shall
|
||||
hold: x = scale(fraction(x), exponent(x)).
|
||||
hold: x = scale(fraction(x), exponent(x)).
|
||||
*)
|
||||
CONST eZero={(hiBit+2)..29};
|
||||
VAR ra: LongInt;
|
||||
BEGIN
|
||||
IF x=ZERO THEN RETURN ZERO
|
||||
IF x=ZERO THEN RETURN ZERO
|
||||
ELSE Move(x, ra);
|
||||
ra[0]:=S.VAL(LONGINT, S.VAL(SET,ra[0])*nMask+eZero);
|
||||
ra[0]:=S.VAL(LONGINT, S.VAL(SET,ra[0])*nMask+eZero);
|
||||
RETURN Real(ra)*2.0D0
|
||||
END
|
||||
END fraction;
|
||||
|
|
@ -246,13 +248,13 @@ PROCEDURE IsNaN * (real: LONGREAL) : BOOLEAN;
|
|||
BEGIN
|
||||
MoveSet(real, ra);
|
||||
RETURN (ra[0]*expMask=expMask) & ((ra[1]#{}) OR (ra[0]*fracMask#{}))
|
||||
END IsNaN;
|
||||
END IsNaN;
|
||||
|
||||
PROCEDURE sign*(x: LONGREAL): LONGREAL;
|
||||
(*
|
||||
The value of the call sign(x) shall be 1.0 if `x' is greater than 0.0,
|
||||
or shall be -1.0 if `x' is less than 0.0, or shall be either 1.0 or
|
||||
-1.0 if `x' is equal to 0.0.
|
||||
-1.0 if `x' is equal to 0.0.
|
||||
*)
|
||||
BEGIN
|
||||
IF x<ZERO THEN RETURN -ONE ELSE RETURN ONE END
|
||||
|
|
@ -275,17 +277,17 @@ BEGIN
|
|||
ra[0]:=S.VAL(LONGINT, S.VAL(SET,ra[0])*nMask+lexp); (* insert new exponent *)
|
||||
RETURN Real(ra)
|
||||
END scale;
|
||||
|
||||
|
||||
PROCEDURE ulp*(x: LONGREAL): LONGREAL;
|
||||
(*
|
||||
The value of the call ulp(x) shall be the value of the corresponding
|
||||
real number type equal to a unit in the last place of `x', if such a
|
||||
value exists; otherwise an exception shall occur and may be raised.
|
||||
value exists; otherwise an exception shall occur and may be raised.
|
||||
*)
|
||||
BEGIN
|
||||
RETURN scale(ONE, exponent(x)-places+1)
|
||||
END ulp;
|
||||
|
||||
|
||||
PROCEDURE succ*(x: LONGREAL): LONGREAL;
|
||||
(*
|
||||
The value of the call succ(x) shall be the next value of the
|
||||
|
|
@ -295,7 +297,7 @@ PROCEDURE succ*(x: LONGREAL): LONGREAL;
|
|||
BEGIN
|
||||
RETURN x+ulp(x)*sign(x)
|
||||
END succ;
|
||||
|
||||
|
||||
PROCEDURE pred*(x: LONGREAL): LONGREAL;
|
||||
(*
|
||||
The value of the call pred(x) shall be the next value of the
|
||||
|
|
@ -309,36 +311,36 @@ END pred;
|
|||
PROCEDURE MaskReal(x: LONGREAL; lo: INTEGER): LONGREAL;
|
||||
VAR ra: LongSet;
|
||||
BEGIN
|
||||
MoveSet(x, ra); (* type-cast into sets for masking *)
|
||||
IF lo<32 THEN ra[1]:=ra[1]*{lo..31} (* just need to mask lower word *)
|
||||
ELSE ra[0]:=ra[0]*{lo-32..31}; ra[1]:={} (* mask upper word & clear lower word *)
|
||||
MoveSet(x, ra); (* type-cast into sets for masking *)
|
||||
IF lo<32 THEN ra[1]:=ra[1]*{lo..31} (* just need to mask lower word *)
|
||||
ELSE ra[0]:=ra[0]*{lo-32..31}; ra[1]:={} (* mask upper word & clear lower word *)
|
||||
END;
|
||||
RETURN ToReal(ra)
|
||||
RETURN ToReal(ra)
|
||||
END MaskReal;
|
||||
|
||||
PROCEDURE intpart*(x: LONGREAL): LONGREAL;
|
||||
(*
|
||||
The value of the call intpart(x) shall be the integral part of `x'.
|
||||
For negative values, this shall be -intpart(abs(x)).
|
||||
For negative values, this shall be -intpart(abs(x)).
|
||||
*)
|
||||
VAR lo, hi: INTEGER;
|
||||
VAR lo, hi: INTEGER;
|
||||
BEGIN hi:=hiBit+32; (* account for low 32-bits as well *)
|
||||
lo:=(hi+1)-exponent(x);
|
||||
lo:=(hi+1)-exponent(x);
|
||||
IF lo<=0 THEN RETURN x (* no fractional part *)
|
||||
ELSIF lo<=hi+1 THEN RETURN MaskReal(x, lo) (* integer part is extracted *)
|
||||
ELSIF lo<=hi+1 THEN RETURN MaskReal(x, lo) (* integer part is extracted *)
|
||||
ELSE RETURN 0 (* no whole part *)
|
||||
END
|
||||
END intpart;
|
||||
|
||||
|
||||
PROCEDURE fractpart*(x: LONGREAL): LONGREAL;
|
||||
(*
|
||||
(*
|
||||
The value of the call fractpart(x) shall be the fractional part of
|
||||
`x'. This satifies the relationship fractpart(x)+intpart(x)=x.
|
||||
*)
|
||||
BEGIN
|
||||
RETURN x-intpart(x)
|
||||
END fractpart;
|
||||
|
||||
|
||||
PROCEDURE trunc*(x: LONGREAL; n: INTEGER): LONGREAL;
|
||||
(*
|
||||
The value of the call trunc(x,n) shall be the value of the most
|
||||
|
|
@ -348,7 +350,7 @@ PROCEDURE trunc*(x: LONGREAL; n: INTEGER): LONGREAL;
|
|||
VAR loBit: INTEGER;
|
||||
BEGIN loBit:=places-n;
|
||||
IF n<=0 THEN RETURN ZERO (* exception should be raised *)
|
||||
ELSIF loBit<=0 THEN RETURN x (* nothing was truncated *)
|
||||
ELSIF loBit<=0 THEN RETURN x (* nothing was truncated *)
|
||||
ELSE RETURN MaskReal(x, loBit) (* clear all lower bits *)
|
||||
END
|
||||
END trunc;
|
||||
|
|
@ -357,13 +359,13 @@ PROCEDURE In (bit: INTEGER; x: LONGREAL): BOOLEAN;
|
|||
VAR ra: LongSet;
|
||||
BEGIN
|
||||
MoveSet(x, ra); (* type-cast into sets for masking *)
|
||||
IF bit<32 THEN RETURN bit IN ra[1] (* check bit in lower word *)
|
||||
ELSE RETURN bit-32 IN ra[0] (* check bit in upper word *)
|
||||
END
|
||||
IF bit<32 THEN RETURN bit IN ra[1] (* check bit in lower word *)
|
||||
ELSE RETURN bit-32 IN ra[0] (* check bit in upper word *)
|
||||
END
|
||||
END In;
|
||||
|
||||
|
||||
PROCEDURE round*(x: LONGREAL; n: INTEGER): LONGREAL;
|
||||
(*
|
||||
(*
|
||||
The value of the call round(x,n) shall be the value of `x' rounded to
|
||||
the most significant `n' places. An exception shall occur and may be
|
||||
raised if such a value does not exist, or if `n' is less than or equal
|
||||
|
|
@ -372,7 +374,7 @@ PROCEDURE round*(x: LONGREAL; n: INTEGER): LONGREAL;
|
|||
VAR loBit: INTEGER; t, r: LONGREAL;
|
||||
BEGIN loBit:=places-n;
|
||||
IF n<=0 THEN RETURN ZERO (* exception should be raised *)
|
||||
ELSIF loBit<=0 THEN RETURN x (* nothing was rounded *)
|
||||
ELSIF loBit<=0 THEN RETURN x (* nothing was rounded *)
|
||||
ELSE t:=MaskReal(x, loBit); (* truncated result *)
|
||||
IF In(loBit-1, x) THEN (* check if result should be rounded *)
|
||||
r:=scale(ONE,exponent(x)-n+1); (* rounding fraction *)
|
||||
|
|
@ -383,7 +385,7 @@ BEGIN loBit:=places-n;
|
|||
END
|
||||
END
|
||||
END round;
|
||||
|
||||
|
||||
PROCEDURE synthesize*(expart: INTEGER; frapart: LONGREAL): LONGREAL;
|
||||
(*
|
||||
The value of the call synthesize(expart,frapart) shall be a value of
|
||||
|
|
@ -399,8 +401,8 @@ PROCEDURE setMode*(m: Modes);
|
|||
(*
|
||||
The call setMode(m) shall set status flags from the value of `m',
|
||||
appropriate to the underlying implementation of the corresponding real
|
||||
number type.
|
||||
|
||||
number type.
|
||||
|
||||
NOTES
|
||||
3 -- Many implementations of floating point provide options for
|
||||
setting flags within the system which control details of the handling
|
||||
|
|
@ -418,12 +420,12 @@ PROCEDURE setMode*(m: Modes);
|
|||
4 -- The effects of `setMode' on operation on values of the
|
||||
corresponding real number type in coroutines other than the calling
|
||||
coroutine is not defined. Implementations are not require to preserve
|
||||
the status flags (if any) with the coroutine state.
|
||||
the status flags (if any) with the coroutine state.
|
||||
*)
|
||||
BEGIN
|
||||
(* hardware dependent mode setting of coprocessor *)
|
||||
END setMode;
|
||||
|
||||
|
||||
PROCEDURE currentMode*(): Modes;
|
||||
(*
|
||||
The value of the call currentMode() shall be the current status flags
|
||||
|
|
@ -437,7 +439,7 @@ PROCEDURE currentMode*(): Modes;
|
|||
BEGIN
|
||||
RETURN {}
|
||||
END currentMode;
|
||||
|
||||
|
||||
PROCEDURE IsLowException*(): BOOLEAN;
|
||||
(* Returns TRUE if the current coroutine is in the exceptional execution state
|
||||
because of the raising of the LowReal exception; otherwise returns FALSE.
|
||||
|
|
@ -462,22 +464,22 @@ BEGIN
|
|||
n:=fraction(n1); n:=fraction(n2);
|
||||
n:=scale(ONE, -8); n:=scale(ONE, 8);
|
||||
n:=succ(10);
|
||||
n:=intpart(n3);
|
||||
n:=intpart(n3);
|
||||
n:=trunc(n3, 5); (* n=120 *)
|
||||
n:=trunc(n3, 7); (* n=123 *)
|
||||
n:=trunc(n3, 12); (* n=123.4375 *)
|
||||
n:=round(n3, 5); (* n=124 *)
|
||||
n:=round(n3, 7); (* n=123 *)
|
||||
n:=round(n3, 7); (* n=123 *)
|
||||
n:=round(n3, 12); (* n=123.46875 *)
|
||||
END Test;
|
||||
END Test;
|
||||
|
||||
BEGIN
|
||||
BEGIN
|
||||
InitEndian; (* check whether target is big endian *)
|
||||
(*
|
||||
tmp := power0(10,308); (* this is test to calculate small as a variable at runtime; -- noch *)
|
||||
sml := 2.2250738585072014/tmp;
|
||||
sml := 2.2250738585072014/power0(10, 308);
|
||||
*)
|
||||
*)
|
||||
|
||||
|
||||
IF DEBUG THEN Test END
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue