|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 7168 (0x1c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, function Kf_Atncy, seg_0130cb, separate Generic_Elementary_Functions
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
separate (Generic_Elementary_Functions)
function Kf_Atncy (Y, X : Float_Type; Cycle : Float_Type) return Float_Type is
U, V, Sign_X, Sign_Y, Buffer, Z1, Z2 : Common_Float;
Cy, Cy_Lead, Cy_Trail, Result : Common_Float;
Swap_Flag : Boolean;
Zero : constant := 0.0;
One : constant := 1.0;
Pi : constant := 3.14159_26535_89793_23846_26433_83279_50288_4197;
Two_Pi : constant := 6.28318_53071_79586_47692_52867_66559_00576_8394;
Two_Pi_Inv : constant := 0.15915_49430_91895_33576_88837_63372_51436_2034;
begin
-- Filter out exceptional cases.
Cy := Common_Float (Cycle);
if Cy <= Zero then
raise Argument_Error;
end if;
U := Common_Float (X);
Sign_X := Copy_Sign (One, U);
U := abs (U);
V := Common_Float (Y);
Sign_Y := Copy_Sign (One, V);
V := abs (V);
if V = Zero then
if U = Zero then
raise Argument_Error;
else
if Sign_X = One then
return (Float_Type (Copy_Sign (Zero, Sign_Y)));
else
return (Float_Type (Sign_Y * Cy * 0.5));
end if;
end if;
end if;
if U = Zero then
return (Float_Type (Sign_Y * Cy * 0.25));
end if;
if U = V then
if Sign_X = One then
return (Float_Type (Sign_Y * Cy * 0.125));
else
return (Float_Type (Sign_Y * Cy * 0.375));
end if;
end if;
-- Step 1. Argument Reduction.
if U < V then
Swap_Flag := True;
Buffer := U;
U := V;
V := Buffer;
else
Swap_Flag := False;
end if;
-- Step 2. Approximation. Obtain atan(V/U). This is performed by KP_Atn
-- which returns atan(V/U) as Z1 + Z2. Moreover, whenever Z1 is non-zero,
-- it has at most 4 hex digits and satisfies |Z1| >= 1/16.
Kp_Atn (V, U, Z1, Z2);
Z1 := (Z1 * Two_Pi_Inv) * Cy;
Z2 := (Z2 * Two_Pi_Inv) * Cy;
Cy_Lead := Leading_Part (Cy, Common_Float'Machine_Mantissa / 2);
Cy_Trail := Cy - Cy_Lead;
-- Step 3. Reconstruction. Obtain atan(Y,X) via Sign_X, Sign_Y, Swap_Flag,
-- and atan(V/U). The reconstruction is based on three relations:
-- atan(Y,X,Cycle) = sign(Y) * atan(|Y|,X,Cycle),
-- atan(|Y|,X,Cycle) = Cycle/2 - atan(|Y|,-X,Cycle),
-- atan(|Y|,|X|,Cycle) = Cycle/4 - atan(|X|,|Y|,Cycle).
if Swap_Flag = False then
if Sign_X = One then
-- atan(|Y|,X,Cycle) = atan(V,U,Cycle)
Result := Z1 + Z2;
else
-- atan(|Y|,X,Cycle) = atan(V,-U,Cycle) = Cycle/2 - atan(V,U,Cycle)
Result := (Cy_Lead * 0.5 - Z1) + (Cy_Trail * 0.5 - Z2);
end if;
else
if Sign_X = One then
-- atan(|Y|,X,Cycle) = atan(U,V,Cycle) = Cycle/4 - atan(V,U,Cycle)
Result := (Cy_Lead * 0.25 - Z1) + (Cy_Trail * 0.25 - Z2);
else
-- atan(|Y|,X,Cycle) = atan(U,-V,Cycle)
-- = Cycle/2 - atan(U,V,Cycle)
-- = Cycle/2 - (Cycle/4 - atan(V,U,Cycle))
Result := (Cy_Lead * 0.25 + Z1) + (Cy_Trail * 0.25 + Z2);
end if;
end if;
return (Float_Type (Copy_Sign (Result, Sign_Y)));
end Kf_Atncy;
nblk1=6
nid=0
hdr6=c
[0x00] rec0=23 rec1=00 rec2=01 rec3=00a
[0x01] rec0=00 rec1=00 rec2=05 rec3=030
[0x02] rec0=2c rec1=00 rec2=06 rec3=002
[0x03] rec0=00 rec1=00 rec2=02 rec3=04c
[0x04] rec0=1b rec1=00 rec2=03 rec3=062
[0x05] rec0=0d rec1=00 rec2=04 rec3=000
tail 0x2170e743282b1518329a9 0x42a00066462061e03