|
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: 11042 (0x2b22)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Text_Io;
package body Octet is
-- VARIABLES -------------------------------------------------------------
Bit_Octet_1, Bit_Octet_2, Bit_Flag : T_Bit_Octet :=
(False, False, False, False, False, False, False, False);
-- PROCEDURES ------------------------------------------------------------
--------------------------------------------------------------------------
-- PROCEDURES D'AFFICHAGE ET DE LECTURE
--------------------------------------------------------------------------
procedure Afficher_Octet_Binaire (Un_Octet : T_Octet) is
Bit_Octet : T_Bit_Octet;
begin
Bit_Octet := Convert_Bit (Un_Octet);
for I in reverse Octet.Num_Bit loop
if Bit_Octet (I) then
Text_Io.Put (" 1");
else
Text_Io.Put (" 0");
end if;
end loop;
end Afficher_Octet_Binaire;
----------------------------------------------------------------------
procedure Afficher_Octet_Hexa (Un_Octet : T_Octet) is
Tab_Hexa : constant array (Integer range 0 .. 15) of Character :=
('0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
begin
Text_Io.Put (Tab_Hexa (Un_Octet / 16));
Text_Io.Put (Tab_Hexa (Un_Octet mod 16));
end Afficher_Octet_Hexa;
----------------------------------------------------------------------
function Lire_Octet_Binaire return T_Octet is
Resultat : T_Octet := 0;
Chaine_Lue : String (1 .. 8);
begin
Text_Io.Get (Chaine_Lue);
for I in reverse 1 .. 8 loop
if (Chaine_Lue (I) = '1') then
Resultat := Resultat + 2 ** (8 - I);
end if;
end loop;
return Resultat;
end Lire_Octet_Binaire;
----------------------------------------------------------------------
function Lire_Octet_Hexa return T_Octet is
Resultat : T_Octet := 0;
Chaine_Lue : String (1 .. 2);
begin
Text_Io.Get (Chaine_Lue);
case Chaine_Lue (1) is
when '0' .. '9' =>
Resultat := Character'Pos (Chaine_Lue (1)) -
Character'Pos ('0');
when 'a' .. 'f' =>
Resultat := Character'Pos (Chaine_Lue (1)) -
Character'Pos ('a') + 10;
when 'A' .. 'F' =>
Resultat := Character'Pos (Chaine_Lue (1)) -
Character'Pos ('A') + 10;
when others =>
Text_Io.Put_Line ("Valeur non hexa");
raise Constraint_Error;
end case;
Resultat := Resultat * 16;
case Chaine_Lue (2) is
when '0' .. '9' =>
Resultat := Resultat + Character'Pos (Chaine_Lue (2)) -
Character'Pos ('0');
when 'a' .. 'f' =>
Resultat := Resultat + Character'Pos (Chaine_Lue (2)) -
Character'Pos ('a') + 10;
when 'A' .. 'F' =>
Resultat := Resultat + Character'Pos (Chaine_Lue (2)) -
Character'Pos ('A') + 10;
when others =>
Text_Io.Put_Line ("Valeur non hexa");
raise Constraint_Error;
end case;
Text_Io.Put_Line ("");
return Resultat;
end Lire_Octet_Hexa;
--------------------------------------------------
-- PROCEDURES NE MODIFIANT PAS LES FLAGS
--------------------------------------------------
function Test_Bit (Octet_1 : T_Octet; Bit : Num_Bit) return Boolean is
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
return Bit_Octet_1 (Bit);
end Test_Bit;
--------------------------------------------------
procedure Set_Bit (Octet_1 : in out T_Octet; Bit : Num_Bit) is
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
Bit_Octet_1 (Bit) := True;
Octet_1 := Convert_Octet (Bit_Octet_1);
end Set_Bit;
--------------------------------------------------
procedure Res_Bit (Octet_1 : in out T_Octet; Bit : Num_Bit) is
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
Bit_Octet_1 (Bit) := False;
Octet_1 := Convert_Octet (Bit_Octet_1);
end Res_Bit;
--------------------------------------------------
function "and" (Octet_1, Octet_2 : T_Octet) return T_Octet is
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
Bit_Octet_2 := Convert_Bit (Octet_2);
Bit_Octet_1 := Bit_Octet_1 and Bit_Octet_2;
return (Convert_Octet (Bit_Octet_1));
end "and";
--------------------------------------------------
function "or" (Octet_1, Octet_2 : T_Octet) return T_Octet is
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
Bit_Octet_2 := Convert_Bit (Octet_2);
Bit_Octet_1 := Bit_Octet_1 or Bit_Octet_2;
return (Convert_Octet (Bit_Octet_1));
end "or";
--------------------------------------------------
function "xor" (Octet_1, Octet_2 : T_Octet) return T_Octet is
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
Bit_Octet_2 := Convert_Bit (Octet_2);
Bit_Octet_1 := Bit_Octet_1 xor Bit_Octet_2;
return (Convert_Octet (Bit_Octet_1));
end "xor";
--------------------------------------------------
function "not" (Octet_1 : T_Octet) return T_Octet is
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
return (Convert_Octet (not Bit_Octet_1));
end "not";
--------------------------------------------------
function Neg (Octet_1 : T_Octet) return T_Octet is
Oct : T_Octet;
begin
Oct := not Octet_1;
Oct := Add (Oct, 1);
return (Oct);
end Neg;
--------------------------------------------------
function Add (Octet_1, Octet_2 : T_Octet) return T_Octet is
La_Carry : Boolean := False;
Oct : T_Octet;
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
Bit_Octet_2 := Convert_Bit (Octet_2);
for I in Num_Bit loop
Add_Bit_C (Bit_Octet_1 (I), Bit_Octet_2 (I), La_Carry);
end loop;
return Convert_Octet (Bit_Octet_1);
end Add;
--------------------------------------------------
function Sub (Octet_1, Octet_2 : T_Octet) return T_Octet is
begin
return (Add (Octet_1, Neg (Octet_2)));
end Sub;
--------------------------------------------------------------------------
-- PROCEDURES D'ADDITION ENTRE 2 BITS (avec carry)
--------------------------------------------------------------------------
procedure Add_Bit_C (Bit_1 : in out Boolean;
Bit_2 : Boolean;
Carry : in out Boolean) is
-- ajoute 2 bits entre eux en tenant compte et en modifiant la carry
-- passee en parametre
begin
case Carry is
when False =>
Carry := Bit_1 and Bit_2;
Bit_1 := Bit_1 xor Bit_2;
when True =>
Carry := Bit_1 or Bit_2;
Bit_1 := not (Bit_1 xor Bit_2);
end case;
end Add_Bit_C;
--------------------------------------------------------------------------
-- PROCEDURES DE CONVERSION octet <--> tableau de bits
--------------------------------------------------------------------------
function Convert_Bit (Octet_1 : T_Octet) return T_Bit_Octet is
Bit_Oct : T_Bit_Octet;
Octet : T_Octet := Octet_1;
begin
for I in Num_Bit loop
Bit_Oct (I) := ((Octet mod 2) /= 0);
Octet := Octet / 2;
end loop;
return Bit_Oct;
end Convert_Bit;
------------------------------------------------------------------------
procedure Convert_Octet_Ascii (Un_Octet : Octet.T_Octet;
Car_1, Car_2 : in out Character) is
Tab_Hexa : constant array (Integer range 0 .. 15) of Character :=
('0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
begin
Car_1 := Tab_Hexa (Un_Octet / 16);
Car_2 := Tab_Hexa (Un_Octet mod 16);
end Convert_Octet_Ascii;
-----------------------------------------------
function Convert_Car_Ascii (Car : Character) return Octet.T_Octet is
Resultat : T_Octet := 0;
begin
case Car is
when '0' .. '9' =>
Resultat := Character'Pos (Car) - Character'Pos ('0');
when 'A' .. 'F' =>
Resultat := Character'Pos (Car) - Character'Pos ('A') + 10;
when others =>
Resultat := 0;
end case;
return Resultat;
end Convert_Car_Ascii;
---------------
function Convert_Ascii_Octet
(Car_1, Car_2 : Character) return Octet.T_Octet is
Resultat : T_Octet := 0;
begin
Resultat := Convert_Car_Ascii (Car_1);
Resultat := (Resultat * 16) + Convert_Car_Ascii (Car_2);
return Resultat;
end Convert_Ascii_Octet;
------------------------------------------------------------------------
function Convert_Octet (Bit_Octet : T_Bit_Octet) return T_Octet is
Oct : T_Octet := 0;
Val_Add : T_Octet := 1;
begin
for I in Num_Bit loop
if Bit_Octet (I) then
Oct := Oct + 2 ** I;
end if;
end loop;
return Oct;
end Convert_Octet;
------------------------------------------------------------------------
procedure Rld (Octet_1, Octet_2 : in out T_Octet) is
Bit_Octet_Temp : T_Bit_Octet :=
(False, False, False, False, False, False, False, False);
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
Bit_Octet_2 := Convert_Bit (Octet_2);
for I in 0 .. 3 loop
Bit_Octet_Temp (I) := Bit_Octet_1 (I);
Bit_Octet_1 (I) := Bit_Octet_2 (I + 4);
Bit_Octet_2 (I + 4) := Bit_Octet_2 (I);
Bit_Octet_2 (I) := Bit_Octet_Temp (I);
end loop;
Octet_1 := Convert_Octet (Bit_Octet_1);
Octet_2 := Convert_Octet (Bit_Octet_2);
end Rld;
------------------------------------------------------------------------
procedure Rrd (Octet_1, Octet_2 : in out T_Octet) is
Bit_Octet_Temp : T_Bit_Octet :=
(False, False, False, False, False, False, False, False);
begin
Bit_Octet_1 := Convert_Bit (Octet_1);
Bit_Octet_2 := Convert_Bit (Octet_2);
for I in 0 .. 3 loop
Bit_Octet_Temp (I) := Bit_Octet_1 (I);
Bit_Octet_1 (I) := Bit_Octet_2 (I);
Bit_Octet_2 (I) := Bit_Octet_2 (I + 4);
Bit_Octet_2 (I + 4) := Bit_Octet_Temp (I);
end loop;
Octet_1 := Convert_Octet (Bit_Octet_1);
Octet_2 := Convert_Octet (Bit_Octet_2);
end Rrd;
end Octet;