|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 24253 (0x5ebd)
Types: TextFile
Names: »B«
└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS
└─ ⟦91c658230⟧ »DATA«
└─⟦458657fb6⟧
└─⟦1472c4407⟧
└─⟦this⟧
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
└─ ⟦fc9b38f02⟧ »DATA«
└─⟦9b46a407a⟧
└─⟦2e03b931c⟧
└─⟦this⟧
with System, Generic_Primitive_Functions;
package body Generic_Elementary_Functions is
-- ====================================================================
-- This implementation disallows Float_Type with range constraints.
-- (See beginning of sequence of statements below). However, to
-- accommodate Float_Type with range constraints, simply delcare the
-- type Common_Float as
-- type Common_Float is digits System.Max_Digits;
-- Note that this was the original intention of Common_Float when the
-- proposed standard required all implementations to accept Float_Type
-- with possible range constraints.
-- ====================================================================
subtype Common_Float is Float_Type;
type Common_Int is range System.Min_Int .. System.Max_Int;
type Position is (Lead, Trail);
type Hex_Digit is (X0, X1, X2, X3, X4, X5, X6, X7,
X8, X9, Xa, Xb, Xc, Xd, Xe, Xf);
type Quadrant_Flag is range 0 .. 3;
package Primitive_Functions is
new Generic_Primitive_Functions (Common_Float, Common_Int);
use Primitive_Functions;
function "rem" (X, Y : Float_Type) return Float_Type
renames Primitive_Functions.Remainder;
Radix : Common_Int;
-- =======================================================================--
-- DECLARATION RELATED TO TRIGONOMETRIC FUNCTIONS --
-- =======================================================================--
-- The following declarations are needed for our trigonometric argument
-- reduction scheme, which needs many digits of the transcendental number
-- pi/2. That value is represented by the sum
-- Piby2_Piece(1) + Piby2_Piece(2) + ...
-- ... + Piby2_Piece( N_Pieces_of_Piby2 ).
-- Each piece is a Common_Float type with the lesser significant half of
-- its mantissa being zero. Since we cannot determine a priori the mantissa
-- length of Common_Float, the value of the Piby2_Pieces are initialized by
-- a sequence of statements.
N_Hex_Digits_Of_Piby2 : constant := 90;
N_Digits_Per_Piece : constant Integer := Common_Float'Mantissa / 8;
N_Bits_Per_Piece : constant Integer := 4 * N_Digits_Per_Piece;
N_Pieces_Of_Piby2 : constant Integer :=
N_Hex_Digits_Of_Piby2 / N_Digits_Per_Piece;
Digit_Pointer : Integer;
Weight : Common_Float;
Piby2_Piece : array (Integer range 1 .. N_Pieces_Of_Piby2) of Common_Float;
Value_Of : array (Hex_Digit) of Common_Float :=
(0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0,
9.0, 10.0, 11.0, 12.0, 13.0, 14.0, 15.0);
Piby2_In_Hex :
array (Integer range 1 .. N_Hex_Digits_Of_Piby2) of Hex_Digit :=
(X3, X2, X4, X3, Xf, X6, Xa, X8, X8, X8, X5, Xa, X3, X0, X8, Xd, X3, X1,
X3, X1, X9, X8, Xa, X2, Xe, X0, X3, X7, X0, X7, X3, X4, X4, Xa, X4, X0,
X9, X3, X8, X2, X2, X2, X9, X9, Xf, X3, X1, Xd, X0, X0, X8, X2, Xe, Xf,
Xa, X9, X8, Xe, Xc, X4, Xe, X6, Xc, X8, X9, X4, X5, X2, X8, X2, X1, Xe,
X6, X3, X8, Xd, X0, X1, X3, X7, X7, Xb, Xe, X5, X4, X6, X6, Xc, Xf, X3);
-- =======================================================================--
-- DECLARATION RELATED TO EXPONENTIAL FUNCTIONS --
-- =======================================================================--
Log2_By_32_Lead, Log2_By_32_Trail : Common_Float;
Pow_Log2_Lead, Pow_Log2_Trail : Common_Float;
-- Two_to_Jby32 is an array of 32 pairs of Common_Float numbers
-- representing 2**(j/32) for j = 0, 1, 2, ..., 31. Each such value
-- is represented by Lead + Trail. The leading parts contain 13 bits
-- of information and are consequently model numbers as long as
-- System.Max_Digits is >= 4. The trailing parts contain roughly
-- Common_Float'Mantissa bits of information, under the assumption
-- that System.Max_Digits is <= 35. So, when the assumptions are met,
-- Lead + Trail represents 2**(j/32) to roughly 13 extra bits.
Two_To_Jby32 : constant array (Common_Int range 0 .. 31, Position) of
Common_Float :=
((16#1.000#, 16#0.000000000000000000000000000000000#),
(16#1.059#, 16#0.000B0D31585743AE7C548EB68CA417FE5#),
(16#1.0B5#, 16#0.000586CF9890F6298B92B71842A983642#),
(16#1.113#, 16#0.00001D0125B50A4EBBF1AED9318CEAC5C#),
(16#1.172#, 16#0.000B83C7D517ADCDF7C8C50EB14A79203#),
(16#1.1D4#, 16#0.000873168B9AA7805B8028990F07A98B4#),
(16#1.238#, 16#0.0007A6E75623866C1FADB1C15CB593B03#),
(16#1.29E#, 16#0.0009DF51FDEE12C25D15F5A24AA3BCA88#),
(16#1.306#, 16#0.000FE0A31B7152DE8D5A46305C85EDECB#),
(16#1.371#, 16#0.000A7373AA9CAA7145502F4547987E3E1#),
(16#1.3DE#, 16#0.000A64C12342235B41223E13D773FBA2C#),
(16#1.44E#, 16#0.000086061892D03136F409DF019FBD4F3#),
(16#1.4BF#, 16#0.000DAD5362A271D4397AFEC42E20E0363#),
(16#1.534#, 16#0.0002B569D4F81DF0A83C49D86A63F4E67#),
(16#1.5AB#, 16#0.00007DD48542958C93015191EB345D88D#),
(16#1.624#, 16#0.0007EB03A5584B1F0FA06FD2DA42BB1CE#),
(16#1.6A0#, 16#0.0009E667F3BCC908B2FB1366EA957D3E3#),
(16#1.71F#, 16#0.00075E8EC5F73DD2370F2EF0ACD6CB434#),
(16#1.7A1#, 16#0.0001473EB0186D7D51023F6CDA1F5EF42#),
(16#1.825#, 16#0.00089994CCE128ACF88AFAB34A010F6AD#),
(16#1.8AC#, 16#0.000E5422AA0DB5BA7C55A192C9BB3E6ED#),
(16#1.937#, 16#0.00037B0CDC5E4F4501C3F2540A22D2FC4#),
(16#1.9C4#, 16#0.0009182A3F0901C7C46B071F2BE58DDAD#),
(16#1.A55#, 16#0.00003B23E255C8B424491CAF87BC8050A#),
(16#1.AE8#, 16#0.0009F995AD3AD5E8734D1773205A7FBC3#),
(16#1.B7F#, 16#0.00076F2FB5E46EAA7B081AB53C5354C88#),
(16#1.C19#, 16#0.0009BDD85529C2220CB12A091BA667944#),
(16#1.CB7#, 16#0.00020DCEF90691503CBD1E949DB761D95#),
(16#1.D58#, 16#0.00018DCFBA48725DA05AEB66E0DCA9F58#),
(16#1.DFC#, 16#0.00097337B9B5EB968CAC39ED291B7225A#),
(16#1.EA4#, 16#0.000AFA2A490D9858F73A18F5DB301F86D#),
(16#1.F50#, 16#0.000765B6E4540674F84B762862BAFF98F#));
Log_Of_Jby64 : constant array (Common_Int range 64 .. 128, Position) of
Common_Float :=
((0.0, 0.0), (16#0.03F#, 16#0.000815161F807C79F3DB4E9A6F57AADBEA#),
(16#0.07E#, 16#0.0000A6C39E0CC0133E3F04F1EF229FAEAE#),
(16#0.0BB#, 16#0.000A2C7B196E7E231A7950F7252C163C9B#),
(16#0.0F8#, 16#0.0005186008B15330BE64B8B775997898D3#),
(16#0.134#, 16#0.0001D7961BD1D092998376104D1375021A#),
(16#0.16F#, 16#0.0000D28AE56B4B9BE499B9ED19B640CE50#),
(16#0.1A9#, 16#0.00026D3A4AD563650BD22A9C3AA4C79A9F#),
(16#0.1E2#, 16#0.0007076E2AF2E5E9EA87FFE1FE9E155DB9#),
(16#0.21A#, 16#0.000EFCF9A11CB2CD2EE2F481855D1C484C#),
(16#0.252#, 16#0.000AA5F03FEA46980BB8E203EDF4D109FB#),
(16#0.289#, 16#0.000A56D996FA3CCFA7B2A1F0FC3C1882CA#),
(16#0.2BF#, 16#0.000E60E14F27A790E7C4140E424775FCD5#),
(16#0.2F5#, 16#0.0007120421B21237C6D65AD40C100C8FFC#),
(16#0.32A#, 16#0.0004B539E8AD68EC8260EA71712CEC4CA0#),
(16#0.35E#, 16#0.0007929D017FE5B19CC0326F99EB976769#),
(16#0.391#, 16#0.000FEF8F353443584BB03DE5FF734495C7#),
(16#0.3C4#, 16#0.000E0EDC55E5CBD3D50FFFC3FD3C2ABB72#),
(16#0.3F7#, 16#0.000230DABC7C551AAA8CD86F29A5941240#),
(16#0.428#, 16#0.000C9389CE438D7DCFDE8061C030E28DE0#),
(16#0.459#, 16#0.000D72AEAE98380E731F55C41B8B823F06#),
(16#0.48A#, 16#0.000507EF3DE596890A14F69D750CBD2E9A#),
(16#0.4BA#, 16#0.00038AEB8474C270B3246A14206CF37B77#),
(16#0.4E9#, 16#0.00093155A517A71CBCD735D034237D6F47#),
(16#0.518#, 16#0.00062F08717B09F42DECDECCF1CD105772#),
(16#0.546#, 16#0.000AB61CB7E0B42724F5833EABC623A9E9#),
(16#0.574#, 16#0.0006F6FD6027294236383DC7FE1159F380#),
(16#0.5A1#, 16#0.000B207A6C52BB110AF840538E1A592DED#),
(16#0.5CE#, 16#0.00075FDAEF401A7389314FEB4FBDE5AADD#),
(16#0.5FA#, 16#0.000BE0EE0ABF0D92CE979ED2950437160C#),
(16#0.626#, 16#0.0008CE1B05096AD69C620440F055B3FFC6#),
(16#0.651#, 16#0.000E5070845BEAE9337451F441BABA929C#),
(16#0.67C#, 16#0.000C8FB2FE612FCADA35D9BD014886067D#),
(16#0.6A7#, 16#0.0003B26A68212635213FD4BC950D7BE11F#),
(16#0.6D1#, 16#0.0003DDEF323D8A32FBB6ABA63878EF2053#),
(16#0.6FA#, 16#0.000D36769C6DEFDE1874DEAEF06B25B52C#),
(16#0.723#, 16#0.000FDF1E6A6886B097607BCBFEE6892B8E#),
(16#0.74C#, 16#0.000BF9F803AF55877B232FAFA36FD18AB4#),
(16#0.775#, 16#0.0001A813071282FB989A927476E1FE9F50#),
(16#0.79D#, 16#0.000109875A1E1F8DF68DBCF2ED1BB404A1#),
(16#0.7C4#, 16#0.000A3D7EBC1BB2CD720EC44C73D75CF564#),
(16#0.7EB#, 16#0.000D623DE3CC7B66BECF93AA1AFEC6D4CD#),
(16#0.812#, 16#0.000A952D2E87F634E34AEBF73FFE346E4B#),
(16#0.839#, 16#0.0001F2E0E6FA0272BCB1C488B755B2B7A5#),
(16#0.85F#, 16#0.00039721295415B4C4BDD99EFFE69B6436#),
(16#0.884#, 16#0.000F9CF16A64B7EF1F64D85BC8C5F24163#),
(16#0.8AA#, 16#0.00061E97A6AF4D4C799D1CB2F14054ED3A#),
(16#0.8CF#, 16#0.000735A33E4B7662E5EEBBC0EF3D571078#),
(16#0.8F4#, 16#0.0002FAF3820681EF62CD2F9F1E35F2E7CA#),
(16#0.918#, 16#0.000986BDF5FA1416F1B439165240A471BC#),
(16#0.93C#, 16#0.000AF0944D88D75BC1F9EDCB438FFC0352#),
(16#0.960#, 16#0.00074F6A24745DCBD4E18DD14F312A40A5#),
(16#0.983#, 16#0.000EB99A7885F0FDAC850FAB36CDEE180B#),
(16#0.9A7#, 16#0.000144ECE70E98B75C96C42E727572531D#),
(16#0.9C9#, 16#0.000F069AB150CD4E221301B6F8C38F6217#),
(16#0.9EC#, 16#0.000813538AB7D5202131E85693CF6B809D#),
(16#0.A0E#, 16#0.000C7F423395732325E617A300BBCA9C44#),
(16#0.A30#, 16#0.000C5E10E2F613E85BD9BD99E39A20AEE5#),
(16#0.A52#, 16#0.0007C2ED81F5D8113DFA3D3761B6316E6F#),
(16#0.A73#, 16#0.000EC08DBADD84E584C2B22C2AEE1A18BD#),
(16#0.A95#, 16#0.00016932DE2D5773BE4578AD97AEA7BED0#),
(16#0.AB5#, 16#0.000FCEAD9F9CCA08E310B9B1FE59CDC156#),
(16#0.AD6#, 16#0.000A0261ACF967D94D552F811CD4084583#),
(16#0.AF7#, 16#0.0000154920B3AB86B04AFE92103EF4C629#),
(16#0.B17#, 16#0.000217F7D1CF79ABC9E3B39803F2F6AF40#));
Pow_Log_Of_Jby64 :
constant array (Common_Int range 64 .. 128, Position) of Common_Float :=
((0.0, 0.0), (16#0.03F8151#,
16#0.61F807C79F3DB4E9A6F57AADBEB03BE903DDC50#E-7),
(16#0.07E0A6C#, 16#0.39E0CC0133E3F04F1EF229FAEAEFAE14CDDF350#E-7),
(16#0.0BBA2C7#, 16#0.B196E7E231A7950F7252C163C9BF701B2A89D80#E-7),
(16#0.0F85186#, 16#0.008B15330BE64B8B775997898D3474D3375B520#E-7),
(16#0.1341D7#, 16#0.961BD1D092998376104D1375021A0ECA5B78467#E-6),
(16#0.16F0D2#, 16#0.8AE56B4B9BE499B9ED19B640CE50C1EF65087FD#E-6),
(16#0.1A926D#, 16#0.3A4AD563650BD22A9C3AA4C79A9F67E22ED398C#E-6),
(16#0.1E2707#, 16#0.6E2AF2E5E9EA87FFE1FE9E155DB94EBC4017F6F#E-6),
(16#0.21AEFC#, 16#0.F9A11CB2CD2EE2F481855D1C484CB4FD8D03860#E-6),
(16#0.252AA5#, 16#0.F03FEA46980BB8E203EDF4D109FBC9070F7E29F#E-6),
(16#0.289A56#, 16#0.D996FA3CCFA7B2A1F0FC3C1882CAF99174F60AA#E-6),
(16#0.2BFE60#, 16#0.E14F27A790E7C4140E424775FCD55C7355FDF3E#E-6),
(16#0.2F5712#, 16#0.0421B21237C6D65AD40C100C8FFC2929B102165#E-6),
(16#0.32A4B5#, 16#0.39E8AD68EC8260EA71712CEC4CA0BED3CF71766#E-6),
(16#0.35E792#, 16#0.9D017FE5B19CC0326F99EB976769B8B9A5D50C9#E-6),
(16#0.391FEF#, 16#0.8F353443584BB03DE5FF734495C765EA7411ADB#E-6),
(16#0.3C4E0E#, 16#0.DC55E5CBD3D50FFFC3FD3C2ABB729D78802FEDF#E-6),
(16#0.3F7230#, 16#0.DABC7C551AAA8CD86F29A5941240584455B22C8#E-6),
(16#0.428C93#, 16#0.89CE438D7DCFDE8061C030E28DE035AFBE0972D#E-6),
(16#0.459D72#, 16#0.AEAE98380E731F55C41B8B823F067D04A43C19F#E-6),
(16#0.48A507#, 16#0.EF3DE596890A14F69D750CBD2E9AAD37A78762E#E-6),
(16#0.4BA38A#, 16#0.EB8474C270B3246A14206CF37B77AD6FB226F14#E-6),
(16#0.4E9931#, 16#0.55A517A71CBCD735D034237D6F479DCFC053C8D#E-6),
(16#0.51862F#, 16#0.08717B09F42DECDECCF1CD105772CD24C00B443#E-6),
(16#0.546AB6#, 16#0.1CB7E0B42724F5833EABC623A9E9E6AF97F5C12#E-6),
(16#0.5746F6#, 16#0.FD6027294236383DC7FE1159F380B4A6B429A4B#E-6),
(16#0.5A1B20#, 16#0.7A6C52BB110AF840538E1A592DEDED1C3395996#E-6),
(16#0.5CE75F#, 16#0.DAEF401A7389314FEB4FBDE5AADDE10DCEA5975#E-6),
(16#0.5FABE0#, 16#0.EE0ABF0D92CE979ED2950437160CBFCBF71EE8D#E-6),
(16#0.6268CE#, 16#0.1B05096AD69C620440F055B3FFC63281B40515A#E-6),
(16#0.651E50#, 16#0.70845BEAE9337451F441BABA929CC25DCA0FA1A#E-6),
(16#0.67CC8F#, 16#0.B2FE612FCADA35D9BD014886067D20FFB34547D#E-6),
(16#0.6A73B2#, 16#0.6A68212635213FD4BC950D7BE11FC8EE26768C4#E-6),
(16#0.6D13DD#, 16#0.EF323D8A32FBB6ABA63878EF2053AB4D08603CF#E-6),
(16#0.6FAD36#, 16#0.769C6DEFDE1874DEAEF06B25B52C1BE100233B3#E-6),
(16#0.723FDF#, 16#0.1E6A6886B097607BCBFEE6892B8ECBD4E8235B8#E-6),
(16#0.74CBF9#, 16#0.F803AF55877B232FAFA36FD18AB4DFF5EFD6E58#E-6),
(16#0.7751A8#, 16#0.13071282FB989A927476E1FE9F50684CE6BAFCF#E-6),
(16#0.79D109#, 16#0.875A1E1F8DF68DBCF2ED1BB404A18E2AA5EE014#E-6),
(16#0.7C4A3D#, 16#0.7EBC1BB2CD720EC44C73D75CF5649117429EC74#E-6),
(16#0.7EBD62#, 16#0.3DE3CC7B66BECF93AA1AFEC6D4CDE2EF184DC7B#E-6),
(16#0.812A95#, 16#0.2D2E87F634E34AEBF73FFE346E4B8B8C4C34EBB#E-6),
(16#0.8391F2#, 16#0.E0E6FA0272BCB1C488B755B2B7A5D75211210F7#E-6),
(16#0.85F397#, 16#0.21295415B4C4BDD99EFFE69B64366FBBF35D3ED#E-6),
(16#0.884F9C#, 16#0.F16A64B7EF1F64D85BC8C5F24163E6F9907E4AD#E-6),
(16#0.8AA61E#, 16#0.97A6AF4D4C799D1CB2F14054ED3A330F341CF1F#E-6),
(16#0.8CF735#, 16#0.A33E4B7662E5EEBBC0EF3D571078EA06C2C371D#E-6),
(16#0.8F42FA#, 16#0.F3820681EF62CD2F9F1E35F2E7CA4F4817696AD#E-6),
(16#0.918986#, 16#0.BDF5FA1416F1B439165240A471BCDFCC1F5B0C6#E-6),
(16#0.93CAF0#, 16#0.944D88D75BC1F9EDCB438FFC03527D7309433BB#E-6),
(16#0.96074F#, 16#0.6A24745DCBD4E18DD14F312A40A546F842B7451#E-6),
(16#0.983EB9#, 16#0.9A7885F0FDAC850FAB36CDEE180B7013338119B#E-6),
(16#0.9A7144#, 16#0.ECE70E98B75C96C42E727572531DDFD382B6BE3#E-6),
(16#0.9C9F06#, 16#0.9AB150CD4E221301B6F8C38F621717C9E700413#E-6),
(16#0.9EC813#, 16#0.538AB7D5202131E85693CF6B809D96954ADF1FF#E-6),
(16#0.A0EC7F#, 16#0.423395732325E617A300BBCA9C4486EA2756F59#E-6),
(16#0.A30C5E#, 16#0.10E2F613E85BD9BD99E39A20AEE59A498016887#E-6),
(16#0.A527C2#, 16#0.ED81F5D8113DFA3D3761B6316E6F7191D8AF47E#E-6),
(16#0.A73EC0#, 16#0.8DBADD84E584C2B22C2AEE1A18BD794408F7745#E-6),
(16#0.A95169#, 16#0.32DE2D5773BE4578AD97AEA7BED0920F6A4C39B#E-6),
(16#0.AB5FCE#, 16#0.AD9F9CCA08E310B9B1FE59CDC15631BF5C35094#E-6),
(16#0.AD6A02#, 16#0.61ACF967D94D552F811CD40845839E04578161C#E-6),
(16#0.AF7015#, 16#0.4920B3AB86B04AFE92103EF4C629F04AE4E7A29#E-6),
(16#0.B17217#, 16#0.F7D1CF79ABC9E3B39803F2F6AF40F343267298B#E-6));
--=====================================================================--
-- DECLARATION OF KERNEL FUNCTIONS AND PROCEDURES --
--=====================================================================--
-----------------------------------------------------------------------------
-- Kernel functions and procedures for the exp/log/hyp family. --
-----------------------------------------------------------------------------
function Kf_R1psm (Y : Common_Float) return Common_Float is separate;
function Kf_Sqrt (Y : Common_Float) return Common_Float is separate;
function Kf_L1psm (Y : Common_Float) return Common_Float is separate;
function Kf_Atanh (Y : Common_Float) return Common_Float is separate;
procedure Kp_Log (Y : in Common_Float;
M, Z1, Z2 : out Common_Float) is separate;
function Kf_L1p (Y : Common_Float) return Common_Float is separate;
function Kf_Em1sm (Y1, Y2 : Common_Float) return Common_Float is separate;
procedure Kp_Exp (Y : in Common_Float;
M : out Common_Int;
Z1, Z2 : out Common_Float) is separate;
function Kf_Em1 (Y : Common_Float) return Common_Float is separate;
procedure Kp_Logpw (X : in Common_Float;
Z1, Z2 : out Common_Float) is separate;
-----------------------------------------------------------------------------
-- Kernel functions and procedures for the trigonometric family. --
-----------------------------------------------------------------------------
procedure Kp_Pi2rd (Y : in Common_Float;
R1, R2 : out Common_Float;
I_Flag : out Quadrant_Flag) is separate;
function Kf_Sin (Y1, Y2 : Common_Float) return Common_Float is separate;
function Kf_Cos (Y1, Y2 : Common_Float) return Common_Float is separate;
function Kf_Atnsm (Y : Common_Float) return Common_Float is separate;
procedure Kp_Atn (Y, X : in Common_Float;
Z1, Z2 : out Common_Float) is separate;
--=====================================================================--
-- DECLARATION OF THE ELEMENTARY FUNCTIONS --
--=====================================================================--
function Sqrt (X : Float_Type) return Float_Type is separate;
function Log (X : Float_Type) return Float_Type is separate;
function Kf_Logb (X, Base : Float_Type) return Float_Type is separate;
function Log (X, Base : Float_Type) return Float_Type is
begin
return (Kf_Logb (X, Base));
end Log;
function Exp (X : Float_Type) return Float_Type is separate;
function Kf_Power (X, Y : Float_Type) return Float_Type is separate;
function "**" (X, Y : Float_Type) return Float_Type is
begin
return (Kf_Power (X, Y));
end "**";
-----------------------------------------------------------------------
function Sin (X : Float_Type) return Float_Type is separate;
function Kf_Sincy (X, Cycle : Float_Type) return Float_Type is separate;
function Sin (X, Cycle : Float_Type) return Float_Type is
begin
return (Kf_Sincy (X, Cycle));
end Sin;
function Cos (X : Float_Type) return Float_Type is separate;
function Kf_Coscy (X, Cycle : Float_Type) return Float_Type is separate;
function Cos (X, Cycle : Float_Type) return Float_Type is
begin
return (Kf_Coscy (X, Cycle));
end Cos;
function Tan (X : Float_Type) return Float_Type is separate;
function Kf_Tancy (X, Cycle : Float_Type) return Float_Type is separate;
function Tan (X, Cycle : Float_Type) return Float_Type is
begin
return (Kf_Tancy (X, Cycle));
end Tan;
function Cot (X : Float_Type) return Float_Type is separate;
function Kf_Cotcy (X, Cycle : Float_Type) return Float_Type is separate;
function Cot (X, Cycle : Float_Type) return Float_Type is
begin
return (Kf_Cotcy (X, Cycle));
end Cot;
-----------------------------------------------------------------------
function Arcsin (X : Float_Type) return Float_Type is separate;
function Kf_Asncy (X, Cycle : Float_Type) return Float_Type is separate;
function Arcsin (X, Cycle : Float_Type) return Float_Type is
begin
return (Kf_Asncy (X, Cycle));
end Arcsin;
function Arccos (X : Float_Type) return Float_Type is separate;
function Kf_Acocy (X, Cycle : Float_Type) return Float_Type is separate;
function Arccos (X, Cycle : Float_Type) return Float_Type is
begin
return (Kf_Acocy (X, Cycle));
end Arccos;
function Arctan (Y : Float_Type; X : Float_Type := 1.0)
return Float_Type is separate;
function Kf_Atncy (Y, X : Float_Type; Cycle : Float_Type)
return Float_Type is separate;
function Arctan (Y : Float_Type; X : Float_Type := 1.0; Cycle : Float_Type)
return Float_Type is
begin
return (Kf_Atncy (Y, X, Cycle));
end Arctan;
function Arccot (X : Float_Type; Y : Float_Type := 1.0) return Float_Type is
begin
return (Arctan (Y, X));
end Arccot;
function Arccot (X : Float_Type; Y : Float_Type := 1.0; Cycle : Float_Type)
return Float_Type is
begin
return (Arctan (Y, X, Cycle));
end Arccot;
-----------------------------------------------------------------------
function Sinh (X : Float_Type) return Float_Type is separate;
function Cosh (X : Float_Type) return Float_Type is separate;
function Tanh (X : Float_Type) return Float_Type is separate;
function Coth (X : Float_Type) return Float_Type is separate;
function Arcsinh (X : Float_Type) return Float_Type is separate;
function Arccosh (X : Float_Type) return Float_Type is separate;
function Arctanh (X : Float_Type) return Float_Type is separate;
function Arccoth (X : Float_Type) return Float_Type is separate;
----------------------------------------------------------------------
--=====================================================================--
-- SEQUENCE OF STATEMENTS INITIALIZING SOME USEFUL CONSTANTS --
--=====================================================================--
begin
-- Check and reject Float_Type with range constraints
if (Float_Type'First > Float_Type'Base'First or
Float_Type'Last < Float_Type'Base'Last) then
raise Program_Error;
end if;
-- The following case analysis chooses the appropriate
-- representation of log2/32, depending of the number of
-- digits in Common_Float.
case Common_Float'Base'Digits is
when 6 =>
Log2_By_32_Lead := 16#5.8B8#E-2; --12 bits
Log2_By_32_Trail :=
16#0.0010B_FBE8E_7BCD5_E4F1D_9CC01_F97B5_7A079_A1933_94C#E-2;
when 7 .. 8 =>
Log2_By_32_Lead := 16#5.8B9#E-2; --15 bits
Log2_By_32_Trail :=
16#0.0000B_FBE8E_7BCD5_E4F1D_9CC01_F97B5_7A079_A1933_94C#E-2;
when 9 .. 11 =>
Log2_By_32_Lead := 16#5.8B908#E-2; --17 bits
Log2_By_32_Trail :=
16#0.00003_FBE8E_7BCD5_E4F1D_9CC01_F97B5_7A079_A1933_94C#E-2;
when 12 .. 14 =>
Log2_By_32_Lead := 16#5.8B90A#E-2; --22 bits
Log2_By_32_Trail :=
16#0.00001_FBE8E_7BCD5_E4F1D_9CC01_F97B5_7A079_A1933_94C#E-2;
when 15 .. 19 =>
Log2_By_32_Lead := 16#5.8B90B_F8#E-2; --28 bits
Log2_By_32_Trail :=
16#0.00000_03E8E_7BCD5_E4F1D_9CC01_F97B5_7A079_A1933_94C#E-2;
when 20 .. 27 =>
Log2_By_32_Lead := 16#5.8B90B_FBE8#E-2; --37 bits
Log2_By_32_Trail :=
16#0.00000_0000E_7BCD5_E4F1D_9CC01_F97B5_7A079_A1933_94C#E-2;
when 28 .. 33 =>
Log2_By_32_Lead := 16#5.8B90B_FBE8E_7A#E-2; --50 bits
Log2_By_32_Trail :=
16#0.00000_00000_01CD5_E4F1D_9CC01_F97B5_7A079_A1933_94C#E-2;
when others =>
raise Program_Error; -- assumption (1) is violated.
end case;
declare
Tmp : Common_Float;
L : Common_Int;
begin
Tmp := 16#0.B17217#;
Pow_Log2_Trail := 16#0.F7D1C_F79AB_C9E3B_39803_F2F6A_F40F34#E-6;
L := Common_Float'Machine_Mantissa;
L := L - (L / 2);
Pow_Log2_Lead := Leading_Part (Tmp, Positive (L));
Pow_Log2_Trail := Pow_Log2_Trail + (Tmp - Pow_Log2_Lead);
end;
Radix := Float_Type'Machine_Radix;
if ((Radix /= 2) and (Radix /= 16)) then
raise Program_Error;
end if;
-- The following is a sequence of statements that initializes
-- an array that contains a number of digits of PI/2.
Digit_Pointer := 1;
Weight := 2#1.0#E-1;
for Piece_Cnt in 1 .. N_Pieces_Of_Piby2 loop
Piby2_Piece (Piece_Cnt) := 0.0;
for Digit_Cnt in 1 .. N_Digits_Per_Piece loop
Piby2_Piece (Piece_Cnt) :=
Piby2_Piece (Piece_Cnt) +
Weight * Value_Of (Piby2_In_Hex (Digit_Pointer));
Digit_Pointer := Digit_Pointer + 1;
Weight := Weight * 16#1.0#E-1;
end loop;
end loop;
end Generic_Elementary_Functions;