|
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: 24576 (0x6000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Xlbmt_Numeric_Types, seg_004f14
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
--/ if R1000 then
with Bit_Operations;
use Bit_Operations;
--/ elsif Cdf_Hpux then
--// with Generic_Bit_Operations;
--/ end if;
with Xlbt_Exceptions;
use Xlbt_Exceptions;
package body Xlbmt_Numeric_Types is
------------------------------------------------------------------------------
-- X Library Machine Types
--
-- Xlbmt_Numeric_Types - Machine/Compiler dependent numeric types.
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
--
-- All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------
--\x0c
-- Logical operations:
--
-- "and" - for each of the 8/16/32 bits; Result(i) := A(i) and B(i)
-- "or" - for each of the 8/16/32 bits; Result(i) := A(i) or B(i)
-- "xor" - for each of the 8/16/32 bits; Result(i) := A(i) xor B(i)
-- "not" - for each of the 8/16/32 bits; Result(i) := not A(i)
-- Shift - if B >= 0 then Result := (A * 2**B) rem (1+Type'Last)
-- if B < 0 then Result := A / 2**B
-- (Shift "up" for positive and "down" for negative and only keep
-- the "bottom" 8/16/32 bits of the result.)
--\x0c
------------------------------------------------------------------------------
-- Perform bit operations on S_Long values.
------------------------------------------------------------------------------
--/ if R1000 then
function "and" (A : Thirty_Two_Bits_Signed;
B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
begin
return Thirty_Two_Bits_Signed (Logical_And (Long_Integer (A),
Long_Integer (B)));
end "and";
function "or" (A : Thirty_Two_Bits_Signed;
B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
begin
return Thirty_Two_Bits_Signed (Logical_Or (Long_Integer (A),
Long_Integer (B)));
end "or";
function "xor" (A : Thirty_Two_Bits_Signed;
B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
begin
return Thirty_Two_Bits_Signed (Logical_Xor (Long_Integer (A),
Long_Integer (B)));
end "xor";
function "not" (A : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
begin
return Thirty_Two_Bits_Signed (Logical_Not (Long_Integer (A)));
end "not";
function Shift (A : Thirty_Two_Bits_Signed;
B : Integer) return Thirty_Two_Bits_Signed is
C : Long_Integer;
begin
if abs B >= 32 then
return 0;
end if;
C := Logical_Shift (Logical_And (Long_Integer (A), 16#FF_FF_FF_FF#),
B);
if Test_Bit (C, 32) then
return Thirty_Two_Bits_Signed'First +
Thirty_Two_Bits_Signed (Logical_And (C, 16#7F_FF_FF_FF#));
else
return Thirty_Two_Bits_Signed (Logical_And (C, 16#7F_FF_FF_FF#));
end if;
end Shift;
--/ elsif Cdf_Hpux then
--// package Bit_Operations is
--// new Generic_Bit_Operations (Thirty_Two_Bits_Signed);
--//
--// function "and" (A : Thirty_Two_Bits_Signed;
--// B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
--// begin
--// return Bit_Operations.Logical_And (A, B);
--// end "and";
--//
--// function "or" (A : Thirty_Two_Bits_Signed;
--// B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
--// begin
--// return Bit_Operations.Logical_Or (A, B);
--// end "or";
--//
--// function "xor" (A : Thirty_Two_Bits_Signed;
--// B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
--// begin
--// return Bit_Operations.Logical_Xor (A, B);
--// end "xor";
--//
--// function "not" (A : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
--// begin
--// return Bit_Operations.Logical_Not (A);
--//
--// end "not";
--//
--// function Shift (A : Thirty_Two_Bits_Signed;
--// B : Integer) return Thirty_Two_Bits_Signed is
--// begin
--// if abs B >= 32 then
--// return 0;
--// end if;
--//
--// return Bit_Operations.Logical_Shift (A, B);
--// end Shift;
--//
--/ elsif TeleGen2 and then Unix then
--//
--// function And_32 (A : Thirty_Two_Bits_Signed; B : Thirty_Two_Bits_Signed)
--// return Thirty_Two_Bits_Signed;
--// pragma Interface (Assembly, And_32);
--// pragma Linkname (And_32, "_Xlbmt_And_32");
--//
--// function Or_32 (A : Thirty_Two_Bits_Signed; B : Thirty_Two_Bits_Signed)
--// return Thirty_Two_Bits_Signed;
--// pragma Interface (Assembly, Or_32);
--// pragma Linkname (Or_32, "_Xlbmt_Or_32");
--//
--// function Xor_32 (A : Thirty_Two_Bits_Signed; B : Thirty_Two_Bits_Signed)
--// return Thirty_Two_Bits_Signed;
--// pragma Interface (Assembly, Xor_32);
--// pragma Linkname (Xor_32, "_Xlbmt_Xor_32");
--//
--// function Not_32 (A : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed;
--// pragma Interface (Assembly, Not_32);
--// pragma Linkname (Not_32, "_Xlbmt_Not_32");
--//
--// function Shift_32 (A : Thirty_Two_Bits_Signed; B : Integer)
--// return Thirty_Two_Bits_Signed;
--// pragma Interface (Assembly, Shift_32);
--// pragma Linkname (Shift_32, "_Xlbmt_Shift_32");
--//
--// function "and" (A : Thirty_Two_Bits_Signed;
--// B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
--// begin
--// return And_32 (A, B);
--// end "and";
--//
--// function "or" (A : Thirty_Two_Bits_Signed;
--// B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
--// begin
--// return Or_32 (A, B);
--// end "or";
--//
--// function "xor" (A : Thirty_Two_Bits_Signed;
--// B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
--// begin
--// return Xor_32 (A, B);
--// end "xor";
--//
--// function "not" (A : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
--// begin
--// return Not_32 (A);
--//
--// end "not";
--//
--// function Shift (A : Thirty_Two_Bits_Signed;
--// B : Integer) return Thirty_Two_Bits_Signed is
--// begin
--// return Shift_32 (A, B);
--// end Shift;
--//
--/ else
--//
--// Need_Something : Here;
--//
--/ end if;
--\x0c
------------------------------------------------------------------------------
-- Perform bit operations on U_Short values.
------------------------------------------------------------------------------
--/ if R1000 then
function "and" (A : Sixteen_Bits_Unsigned;
B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
begin
return Sixteen_Bits_Unsigned (Logical_And (Long_Integer (A),
Long_Integer (B)));
end "and";
function "or" (A : Sixteen_Bits_Unsigned;
B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
begin
return Sixteen_Bits_Unsigned (Logical_Or (Long_Integer (A),
Long_Integer (B)));
end "or";
function "xor" (A : Sixteen_Bits_Unsigned;
B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
begin
return Sixteen_Bits_Unsigned (Logical_Xor (Long_Integer (A),
Long_Integer (B)));
end "xor";
function "not" (A : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
begin
return Sixteen_Bits_Unsigned
(Logical_And (Logical_Not (Long_Integer (A)),
Long_Integer (16#FF_FF#)));
end "not";
function Shift (A : Sixteen_Bits_Unsigned;
B : Integer) return Sixteen_Bits_Unsigned is
begin
if abs B >= 32 then
return 0;
elsif B > 0 then
return Sixteen_Bits_Unsigned
(Logical_And (Logical_Shift (Long_Integer (A), B),
Long_Integer (16#FF_FF#)));
else
return Sixteen_Bits_Unsigned (Logical_Shift (Long_Integer (A), B));
end if;
end Shift;
--/ elsif Cdf_Hpux then
--// package Bit_Ops_16 is new Generic_Bit_Operations (Sixteen_Bits_Unsigned);
--//
--// function "and" (A : Sixteen_Bits_Unsigned;
--// B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
--// begin
--// return Bit_Ops_16.Logical_And (A, B);
--// end "and";
--//
--// function "or" (A : Sixteen_Bits_Unsigned;
--// B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
--// begin
--// return Bit_Ops_16.Logical_Or (A, B);
--// end "or";
--//
--// function "xor" (A : Sixteen_Bits_Unsigned;
--// B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
--// begin
--// return Bit_Ops_16.Logical_Xor (A, B);
--// end "xor";
--//
--// function "not" (A : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
--// begin
--// return Bit_Ops_16.Logical_Not (A);
--// end "not";
--//
--// function Shift (A : Sixteen_Bits_Unsigned;
--// B : Integer) return Sixteen_Bits_Unsigned is
--// begin
--// return Bit_Ops_16.Logical_Shift (A, B);
--// end Shift;
--//
--/ elsif TeleGen2 and then Unix then
--//
--// function And_16 (A : Sixteen_Bits_Unsigned; B : Sixteen_Bits_Unsigned)
--// return Sixteen_Bits_Unsigned;
--// pragma Interface (Assembly, And_16);
--// pragma Linkname (And_16, "_Xlbmt_And_16");
--//
--// function Or_16 (A : Sixteen_Bits_Unsigned; B : Sixteen_Bits_Unsigned)
--// return Sixteen_Bits_Unsigned;
--// pragma Interface (Assembly, Or_16);
--// pragma Linkname (Or_16, "_Xlbmt_Or_16");
--//
--// function Xor_16 (A : Sixteen_Bits_Unsigned; B : Sixteen_Bits_Unsigned)
--// return Sixteen_Bits_Unsigned;
--// pragma Interface (Assembly, Xor_16);
--// pragma Linkname (Xor_16, "_Xlbmt_Xor_16");
--//
--// function Not_16 (A : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned;
--// pragma Interface (Assembly, Not_16);
--// pragma Linkname (Not_16, "_Xlbmt_Not_16");
--//
--// function Shift_16 (A : Sixteen_Bits_Unsigned; B : Integer)
--// return Sixteen_Bits_Unsigned;
--// pragma Interface (Assembly, Shift_16);
--// pragma Linkname (Shift_16, "_Xlbmt_Shift_16");
--//
--// function "and" (A : Sixteen_Bits_Unsigned;
--// B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
--// begin
--// return And_16 (A, B);
--// end "and";
--//
--// function "or" (A : Sixteen_Bits_Unsigned;
--// B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
--// begin
--// return Or_16 (A, B);
--// end "or";
--//
--// function "xor" (A : Sixteen_Bits_Unsigned;
--// B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
--// begin
--// return Xor_16 (A, B);
--// end "xor";
--//
--// function "not" (A : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
--// begin
--// return Not_16 (A);
--//
--// end "not";
--//
--// function Shift (A : Sixteen_Bits_Unsigned;
--// B : Integer) return Sixteen_Bits_Unsigned is
--// begin
--// return Shift_16 (A, B);
--// end Shift;
--//
--/ else
--// "The code for doing logical operations on unsigned 16-bit values is"
--// "missing for this target?"
--/ end if;
--\x0c
------------------------------------------------------------------------------
-- Perform bit operations on U_Char values.
------------------------------------------------------------------------------
--/ if R1000 then
function "and" (A : Eight_Bits_Unsigned;
B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
begin
return Eight_Bits_Unsigned (Logical_And (Long_Integer (A),
Long_Integer (B)));
end "and";
function "or" (A : Eight_Bits_Unsigned;
B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
begin
return Eight_Bits_Unsigned (Logical_Or (Long_Integer (A),
Long_Integer (B)));
end "or";
function "xor" (A : Eight_Bits_Unsigned;
B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
begin
return Eight_Bits_Unsigned (Logical_Xor (Long_Integer (A),
Long_Integer (B)));
end "xor";
function "not" (A : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
begin
return Eight_Bits_Unsigned
(Logical_And (Logical_Not (Long_Integer (A)),
Long_Integer (16#FF#)));
end "not";
function Shift (A : Eight_Bits_Unsigned;
B : Integer) return Eight_Bits_Unsigned is
begin
if abs B >= 32 then
return 0;
elsif B > 0 then
return Eight_Bits_Unsigned
(Logical_And (Logical_Shift (Long_Integer (A), B),
Long_Integer (16#FF#)));
else
return Eight_Bits_Unsigned (Logical_Shift (Long_Integer (A), B));
end if;
end Shift;
--/ elsif Cdf_Hpux then
--// package Bit_Ops_8 is new Generic_Bit_Operations (Eight_Bits_Unsigned);
--//
--// function "and" (A : Eight_Bits_Unsigned;
--// B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
--// begin
--// return Bit_Ops_8.Logical_And (A, B);
--// end "and";
--//
--// function "or" (A : Eight_Bits_Unsigned;
--// B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
--// begin
--// return Bit_Ops_8.Logical_Or (A, B);
--// end "or";
--//
--// function "xor" (A : Eight_Bits_Unsigned;
--// B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
--// begin
--// return Bit_Ops_8.Logical_Xor (A, B);
--// end "xor";
--//
--// function "not" (A : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
--// begin
--// return Bit_Ops_8.Logical_Not (A);
--// end "not";
--//
--// function Shift (A : Eight_Bits_Unsigned;
--// B : Integer) return Eight_Bits_Unsigned is
--// begin
--// return Bit_Ops_8.Logical_Shift (A, B);
--// end Shift;
--//
--/ elsif TeleGen2 and then Unix then
--//
--// function And_8 (A : Eight_Bits_Unsigned; B : Eight_Bits_Unsigned)
--// return Eight_Bits_Unsigned;
--// pragma Interface (Assembly, And_8);
--// pragma Linkname (And_8, "_Xlbmt_And_8");
--//
--// function Or_8 (A : Eight_Bits_Unsigned; B : Eight_Bits_Unsigned)
--// return Eight_Bits_Unsigned;
--// pragma Interface (Assembly, Or_8);
--// pragma Linkname (Or_8, "_Xlbmt_Or_8");
--//
--// function Xor_8 (A : Eight_Bits_Unsigned; B : Eight_Bits_Unsigned)
--// return Eight_Bits_Unsigned;
--// pragma Interface (Assembly, Xor_8);
--// pragma Linkname (Xor_8, "_Xlbmt_Xor_8");
--//
--// function Not_8 (A : Eight_Bits_Unsigned) return Eight_Bits_Unsigned;
--// pragma Interface (Assembly, Not_8);
--// pragma Linkname (Not_8, "_Xlbmt_Not_8");
--//
--// function Shift_8 (A : Eight_Bits_Unsigned; B : Integer)
--// return Eight_Bits_Unsigned;
--// pragma Interface (Assembly, Shift_8);
--// pragma Linkname (Shift_8, "_Xlbmt_Shift_8");
--//
--// function "and" (A : Eight_Bits_Unsigned;
--// B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
--// begin
--// return And_8 (A, B);
--// end "and";
--//
--// function "or" (A : Eight_Bits_Unsigned;
--// B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
--// begin
--// return Or_8 (A, B);
--// end "or";
--//
--// function "xor" (A : Eight_Bits_Unsigned;
--// B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
--// begin
--// return Xor_8 (A, B);
--// end "xor";
--//
--// function "not" (A : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
--// begin
--// return Not_8 (A);
--//
--// end "not";
--//
--// function Shift (A : Eight_Bits_Unsigned;
--// B : Integer) return Eight_Bits_Unsigned is
--// begin
--// return Shift_8 (A, B);
--// end Shift;
--//
--/ else
--// "The code for doing logical operations on unsigned 8-bit values is"
--// "missing for this target?"
--/ end if;
--\x0c
function Max (A : Thirty_Two_Bits_Signed;
B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
----Simple MAX function.
begin
if A > B then
return A;
else
return B;
end if;
end Max;
--\x0c
function Min (A : Thirty_Two_Bits_Signed;
B : Thirty_Two_Bits_Signed) return Thirty_Two_Bits_Signed is
----Simple MIN function.
begin
if A < B then
return A;
else
return B;
end if;
end Min;
--\x0c
-- function Max (A : Thirty_Two_Bits_Unsigned;
-- B : Thirty_Two_Bits_Unsigned)
-- return Thirty_Two_Bits_Unsigned is
-- ----Simple MAX function.
-- begin
-- if A > B then
-- return A;
-- else
-- return B;
-- end if;
-- end Max;
--
-- --\x0c
-- function Min (A : Thirty_Two_Bits_Unsigned;
-- B : Thirty_Two_Bits_Unsigned)
-- return Thirty_Two_Bits_Unsigned is
-- ----Simple MIN function.
-- begin
-- if A < B then
-- return A;
-- else
-- return B;
-- end if;
-- end Min;
--
--\x0c
function Max (A : Sixteen_Bits_Signed;
B : Sixteen_Bits_Signed) return Sixteen_Bits_Signed is
----Simple MAX function.
begin
if A > B then
return A;
else
return B;
end if;
end Max;
--\x0c
function Min (A : Sixteen_Bits_Signed;
B : Sixteen_Bits_Signed) return Sixteen_Bits_Signed is
----Simple MIN function.
begin
if A < B then
return A;
else
return B;
end if;
end Min;
--\x0c
function Max (A : Sixteen_Bits_Unsigned;
B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
----Simple MAX function.
begin
if A > B then
return A;
else
return B;
end if;
end Max;
--\x0c
function Min (A : Sixteen_Bits_Unsigned;
B : Sixteen_Bits_Unsigned) return Sixteen_Bits_Unsigned is
----Simple MIN function.
begin
if A < B then
return A;
else
return B;
end if;
end Min;
--\x0c
function Max (A : Eight_Bits_Signed;
B : Eight_Bits_Signed) return Eight_Bits_Signed is
----Simple MAX function.
begin
if A > B then
return A;
else
return B;
end if;
end Max;
--\x0c
function Min (A : Eight_Bits_Signed;
B : Eight_Bits_Signed) return Eight_Bits_Signed is
----Simple MIN function.
begin
if A < B then
return A;
else
return B;
end if;
end Min;
--\x0c
function Max (A : Eight_Bits_Unsigned;
B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
----Simple MAX function.
begin
if A > B then
return A;
else
return B;
end if;
end Max;
--\x0c
function Min (A : Eight_Bits_Unsigned;
B : Eight_Bits_Unsigned) return Eight_Bits_Unsigned is
----Simple MIN function.
begin
if A < B then
return A;
else
return B;
end if;
end Min;
--\x0c
end Xlbmt_Numeric_Types;
nblk1=17
nid=0
hdr6=2e
[0x00] rec0=1b rec1=00 rec2=01 rec3=02e
[0x01] rec0=12 rec1=00 rec2=02 rec3=048
[0x02] rec0=17 rec1=00 rec2=03 rec3=00c
[0x03] rec0=1a rec1=00 rec2=04 rec3=01c
[0x04] rec0=18 rec1=00 rec2=05 rec3=092
[0x05] rec0=1c rec1=00 rec2=06 rec3=09e
[0x06] rec0=15 rec1=00 rec2=07 rec3=01c
[0x07] rec0=23 rec1=00 rec2=08 rec3=042
[0x08] rec0=17 rec1=00 rec2=09 rec3=048
[0x09] rec0=1a rec1=00 rec2=0a rec3=022
[0x0a] rec0=19 rec1=00 rec2=0b rec3=05e
[0x0b] rec0=17 rec1=00 rec2=0c rec3=066
[0x0c] rec0=18 rec1=00 rec2=0d rec3=03e
[0x0d] rec0=1f rec1=00 rec2=0e rec3=006
[0x0e] rec0=18 rec1=00 rec2=0f rec3=04e
[0x0f] rec0=1a rec1=00 rec2=10 rec3=026
[0x10] rec0=1b rec1=00 rec2=11 rec3=054
[0x11] rec0=16 rec1=00 rec2=12 rec3=024
[0x12] rec0=21 rec1=00 rec2=13 rec3=032
[0x13] rec0=25 rec1=00 rec2=14 rec3=040
[0x14] rec0=26 rec1=00 rec2=15 rec3=016
[0x15] rec0=25 rec1=00 rec2=16 rec3=032
[0x16] rec0=23 rec1=00 rec2=17 rec3=000
tail 0x215009564819780894e61 0x42a00088462063203