|
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: 34816 (0x8800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Octet, seg_020ef1
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
nblk1=21
nid=16
hdr6=1c
[0x00] rec0=14 rec1=00 rec2=01 rec3=03a
[0x01] rec0=1f rec1=00 rec2=21 rec3=014
[0x02] rec0=23 rec1=00 rec2=17 rec3=01c
[0x03] rec0=19 rec1=00 rec2=1f rec3=014
[0x04] rec0=22 rec1=00 rec2=1e rec3=008
[0x05] rec0=0e rec1=00 rec2=0e rec3=046
[0x06] rec0=1f rec1=00 rec2=08 rec3=014
[0x07] rec0=20 rec1=00 rec2=03 rec3=018
[0x08] rec0=1f rec1=00 rec2=18 rec3=028
[0x09] rec0=1d rec1=00 rec2=09 rec3=04a
[0x0a] rec0=2b rec1=00 rec2=06 rec3=026
[0x0b] rec0=0c rec1=00 rec2=0d rec3=04a
[0x0c] rec0=1d rec1=00 rec2=1b rec3=018
[0x0d] rec0=03 rec1=00 rec2=12 rec3=000
[0x0e] rec0=02 rec1=00 rec2=0b rec3=00a
[0x0f] rec0=22 rec1=00 rec2=10 rec3=05a
[0x10] rec0=20 rec1=00 rec2=13 rec3=03a
[0x11] rec0=20 rec1=00 rec2=0c rec3=00a
[0x12] rec0=23 rec1=00 rec2=1d rec3=03a
[0x13] rec0=02 rec1=00 rec2=1c rec3=014
[0x14] rec0=26 rec1=00 rec2=15 rec3=03c
[0x15] rec0=14 rec1=00 rec2=0a rec3=02c
[0x16] rec0=23 rec1=00 rec2=02 rec3=04e
[0x17] rec0=22 rec1=00 rec2=04 rec3=04e
[0x18] rec0=28 rec1=00 rec2=16 rec3=038
[0x19] rec0=24 rec1=00 rec2=18 rec3=026
[0x1a] rec0=1a rec1=00 rec2=06 rec3=080
[0x1b] rec0=16 rec1=00 rec2=0d rec3=014
[0x1c] rec0=2d rec1=00 rec2=12 rec3=012
[0x1d] rec0=25 rec1=00 rec2=09 rec3=000
[0x1e] rec0=2d rec1=00 rec2=12 rec3=012
[0x1f] rec0=25 rec1=00 rec2=09 rec3=000
[0x20] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2150b8c7a822c756c0873 0x42a00088462060003
Free Block Chain:
0x16: 0000 00 04 01 e4 00 09 20 20 20 20 62 65 67 69 6e 09 ┆ begin ┆
0x4: 0000 00 02 03 fc 80 08 63 74 65 74 5f 31 29 3b 08 00 ┆ ctet_1); ┆
0x2: 0000 00 0a 03 fc 80 17 20 43 6f 6e 76 65 72 74 5f 42 ┆ Convert_B┆
0xa: 0000 00 15 01 4a 80 06 65 74 5f 31 29 3b 06 00 00 00 ┆ J et_1); ┆
0x15: 0000 00 1c 03 fc 80 25 64 69 66 5f 46 6c 61 67 5f 5a ┆ %dif_Flag_Z┆
0x1c: 0000 00 1d 00 d8 80 4c 20 20 20 20 20 2d 2d 20 66 6c ┆ L -- fl┆
0x1d: 0000 00 0c 03 fa 80 18 20 20 20 42 69 74 5f 46 6c 61 ┆ Bit_Fla┆
0xc: 0000 00 13 02 c2 80 05 74 5f 32 29 3b 05 00 27 20 20 ┆ t_2); ' ┆
0x13: 0000 00 10 03 fc 80 09 2d 2d 2d 2d 2d 2d 2d 2d 2d 09 ┆ --------- ┆
0x10: 0000 00 0b 01 4a 80 13 63 74 65 74 20 28 42 69 74 5f ┆ J ctet (Bit_┆
0xb: 0000 00 14 00 55 80 47 2d 20 66 6c 61 67 20 20 72 71 ┆ U G- flag rq┆
0x14: 0000 00 07 03 fc 80 16 3a 3d 20 43 6f 6e 76 65 72 74 ┆ := Convert┆
0x7: 0000 00 19 03 fc 80 0d 29 20 3a 3d 20 46 61 6c 73 65 ┆ ) := False┆
0x19: 0000 00 05 01 a0 00 36 20 20 20 20 2d 2d 2d 2d 2d 2d ┆ 6 ------┆
0x5: 0000 00 11 03 f9 80 32 74 5f 4f 63 74 65 74 5f 31 2c ┆ 2t_Octet_1,┆
0x11: 0000 00 1a 00 6a 80 16 3a 3d 20 43 6f 6e 76 65 72 74 ┆ j := Convert┆
0x1a: 0000 00 0f 00 13 80 10 20 41 66 66 69 63 68 65 72 5f ┆ Afficher_┆
0xf: 0000 00 20 03 fc 80 3e 20 20 66 75 6e 63 74 69 6f 6e ┆ > function┆
0x20: 0000 00 00 00 06 80 03 65 67 69 03 00 00 00 00 1f ff ┆ egi ┆