with Unchecked_Conversion;
package body System.Scalar_Values is
procedure Initialize (Mode1 : Character; Mode2 : Character) is
C1 : Character := Mode1;
C2 : Character := Mode2;
procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
pragma Import (C, Get_Env_Value_Ptr, "__gnat_get_env_value_ptr");
subtype String2 is String (1 .. 2);
type String2_Ptr is access all String2;
Env_Value_Ptr : aliased String2_Ptr;
Env_Value_Length : aliased Integer;
EV_Val : aliased constant String :=
"GNAT_INIT_SCALARS" & ASCII.NUL;
B : Byte1;
EFloat : constant Boolean := Long_Long_Float'Size > Long_Float'Size;
type ByteLF is array (0 .. 7 + 4 * Boolean'Pos (EFloat)) of Byte1;
IV_Isf : aliased Byte4; IV_Ifl : aliased Byte4; IV_Ilf : aliased Byte8; IV_Ill : aliased ByteLF;
for IV_Isf'Address use IS_Isf'Address;
for IV_Ifl'Address use IS_Ifl'Address;
for IV_Ilf'Address use IS_Ilf'Address;
for IV_Ill'Address use IS_Ill'Address;
pragma Import (Ada, IV_Isf);
pragma Import (Ada, IV_Ifl);
pragma Import (Ada, IV_Ilf);
pragma Import (Ada, IV_Ill);
begin
if C1 = 'E' and then C2 = 'V' then
Get_Env_Value_Ptr
(EV_Val'Address, Env_Value_Length'Address, Env_Value_Ptr'Address);
if Env_Value_Length /= 2 then
C1 := 'I';
C2 := 'N';
else
C1 := Env_Value_Ptr (1);
C2 := Env_Value_Ptr (2);
if C1 in 'a' .. 'z' then
C1 := Character'Val (Character'Pos (C1) - 32);
end if;
if C2 in 'a' .. 'z' then
C2 := Character'Val (Character'Pos (C2) - 32);
end if;
if (C1 = 'I' and then C2 = 'N')
or else
(C1 = 'L' and then C2 = 'O')
or else
(C1 = 'H' and then C2 = 'I')
then
null;
elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'Z')
or else
(C2 in '0' .. '9' or else C2 in 'A' .. 'Z')
then
null;
else
C1 := 'I';
C2 := 'N';
end if;
end if;
end if;
if C1 = 'I' and then C2 = 'N' then
IS_Is1 := 16#80#;
IS_Is2 := 16#8000#;
IS_Is4 := 16#8000_0000#;
IS_Is8 := 16#8000_0000_0000_0000#;
IS_Iu1 := 16#FF#;
IS_Iu2 := 16#FFFF#;
IS_Iu4 := 16#FFFF_FFFF#;
IS_Iu8 := 16#FFFF_FFFF_FFFF_FFFF#;
IS_Iz1 := 16#00#;
IS_Iz2 := 16#0000#;
IS_Iz4 := 16#0000_0000#;
IS_Iz8 := 16#0000_0000_0000_0000#;
IV_Isf := IS_Iu4;
IV_Ifl := IS_Iu4;
IV_Ilf := IS_Iu8;
if EFloat then
IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#C0#, 16#FF#, 16#FF#, 0, 0);
end if;
elsif C1 = 'L' and then C2 = 'O' then
IS_Is1 := 16#80#;
IS_Is2 := 16#8000#;
IS_Is4 := 16#8000_0000#;
IS_Is8 := 16#8000_0000_0000_0000#;
IS_Iu1 := 16#00#;
IS_Iu2 := 16#0000#;
IS_Iu4 := 16#0000_0000#;
IS_Iu8 := 16#0000_0000_0000_0000#;
IS_Iz1 := 16#00#;
IS_Iz2 := 16#0000#;
IS_Iz4 := 16#0000_0000#;
IS_Iz8 := 16#0000_0000_0000_0000#;
IV_Isf := 16#FF80_0000#;
IV_Ifl := 16#FF80_0000#;
IV_Ilf := 16#FFF0_0000_0000_0000#;
if EFloat then
IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#80#, 16#FF#, 16#FF#, 0, 0);
end if;
elsif C1 = 'H' and then C2 = 'I' then
IS_Is1 := 16#7F#;
IS_Is2 := 16#7FFF#;
IS_Is4 := 16#7FFF_FFFF#;
IS_Is8 := 16#7FFF_FFFF_FFFF_FFFF#;
IS_Iu1 := 16#FF#;
IS_Iu2 := 16#FFFF#;
IS_Iu4 := 16#FFFF_FFFF#;
IS_Iu8 := 16#FFFF_FFFF_FFFF_FFFF#;
IS_Iz1 := 16#FF#;
IS_Iz2 := 16#FFFF#;
IS_Iz4 := 16#FFFF_FFFF#;
IS_Iz8 := 16#FFFF_FFFF_FFFF_FFFF#;
IV_Isf := 16#7F80_0000#;
IV_Ifl := 16#7F80_0000#;
IV_Ilf := 16#7FF0_0000_0000_0000#;
if EFloat then
IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#80#, 16#FF#, 16#7F#, 0, 0);
end if;
else
if C1 in '0' .. '9' then
B := Character'Pos (C1) - Character'Pos ('0');
else
B := Character'Pos (C1) - (Character'Pos ('A') - 10);
end if;
if C2 in '0' .. '9' then
B := B * 16 + Character'Pos (C2) - Character'Pos ('0');
else
B := B * 16 + Character'Pos (C2) - (Character'Pos ('A') - 10);
end if;
IS_Is1 := B;
IS_Is2 := 2**8 * Byte2 (IS_Is1) + Byte2 (IS_Is1);
IS_Is4 := 2**16 * Byte4 (IS_Is2) + Byte4 (IS_Is2);
IS_Is8 := 2**32 * Byte8 (IS_Is4) + Byte8 (IS_Is4);
IS_Iu1 := IS_Is1;
IS_Iu2 := IS_Is2;
IS_Iu4 := IS_Is4;
IS_Iu8 := IS_Is8;
IS_Iz1 := IS_Is1;
IS_Iz2 := IS_Is2;
IS_Iz4 := IS_Is4;
IS_Iz8 := IS_Is8;
IV_Isf := IS_Is4;
IV_Ifl := IS_Is4;
IV_Ilf := IS_Is8;
if EFloat then
IV_Ill := (B, B, B, B, B, B, B, B, B, B, B, B);
end if;
end if;
if not EFloat then
declare
pragma Warnings (Off);
function To_ByteLF is new Unchecked_Conversion (Byte8, ByteLF);
pragma Warnings (On);
begin
IV_Ill := To_ByteLF (IV_Ilf);
end;
end if;
end Initialize;
end System.Scalar_Values;