|
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: 21882 (0x557a)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦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.
------------------------------------------------------------------------------
--\f
-- 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.)
--\f
------------------------------------------------------------------------------
-- 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;
--\f
------------------------------------------------------------------------------
-- 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;
--\f
------------------------------------------------------------------------------
-- 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;
--\f
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;
--\f
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;
--\f
-- 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;
--
-- --\f
-- 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;
--
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
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;
--\f
end Xlbmt_Numeric_Types;