|
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: 15360 (0x3c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Test_Octet, seg_00f561
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Octet;
with Text_Io;
use Octet;
package body Test_Octet is
-- TYPES --------------------------------------------------------------
type T_Bit_Octet is array (Num_Bit) of Boolean;
-- VARIABLES ----------------------------------------------------------
Fin : Boolean := False;
Octet_1, Octet_2, Flag, Num_Bit, Choix : T_Octet := 0;
-- PROCEDURES ---------------------------------------------------------
function Lire_Choix return T_Octet;
procedure Lire_1_Octet_Bit;
procedure Lire_1_Octet_Flag;
procedure Lire_1_Octet;
procedure Lire_2_Octets_Flag;
procedure Lire_2_Octets;
procedure Afficher_Resultat;
function Convert_Bit (Octet_1 : T_Octet) return T_Bit_Octet;
-----------------------------------------------------------------------
procedure Je_Teste_Octet is
begin
while not Fin loop
Choix := Lire_Choix;
case Choix is
when 1 | 2 | 3 =>
Lire_1_Octet_Bit;
case Choix is
when 1 =>
if (Octet.Test_Bit (Octet_1, Num_Bit)) then
Octet_1 := 1;
else
Octet_1 := 0;
end if;
when 2 =>
Octet.Set (Octet_1, Num_Bit);
when 3 =>
Octet.Res (Octet_1, Num_Bit);
when others =>
null;
end case;
when 4 | 5 | 6 | 8 | 9 =>
Lire_2_Octets;
case Choix is
when 4 =>
Octet_1 := Octet."and" (Octet_1, Octet_2);
when 5 =>
Octet_1 := Octet."or" (Octet_1, Octet_2);
when 6 =>
Octet_1 := Octet."xor" (Octet_1, Octet_2);
when 8 =>
Octet_1 := Octet.Add (Octet_1, Octet_2);
when 9 =>
Octet_1 := Octet.Sub (Octet_1, Octet_2);
when others =>
null;
end case;
when 7 | 10 =>
Lire_1_Octet;
case Choix is
when 7 =>
Octet_1 := Octet."not" (Octet_1);
when 10 =>
Octet_1 := Octet.Neg (Octet_1);
when others =>
null;
end case;
when 11 | 12 | 16 | 22 | 23 | 24 | 25 | 26 | 27 | 28 =>
Lire_1_Octet_Flag;
case Choix is
when 11 =>
Octet.Inc_F (Octet_1, Flag);
when 12 =>
Octet.Dec_F (Octet_1, Flag);
when 16 =>
Octet.Neg_F (Octet_1, Flag);
when 22 =>
Octet.Rl_F (Octet_1, Flag);
when 23 =>
Octet.Rlc_F (Octet_1, Flag);
when 24 =>
Octet.Rr_F (Octet_1, Flag);
when 25 =>
Octet.Rrc_F (Octet_1, Flag);
when 26 =>
Octet.Sla_F (Octet_1, Flag);
when 27 =>
Octet.Sra_F (Octet_1, Flag);
when 28 =>
Octet.Srl_F (Octet_1, Flag);
when others =>
null;
end case;
when 13 | 14 | 15 | 17 | 18 | 19 | 20 | 21 =>
Lire_2_Octets_Flag;
case Choix is
when 13 =>
Octet.And_F (Octet_1, Octet_2, Flag);
when 14 =>
Octet.Or_F (Octet_1, Octet_2, Flag);
when 15 =>
Octet.Xor_F (Octet_1, Octet_2, Flag);
when 17 =>
Octet.Adc_F (Octet_1, Octet_2, Flag);
when 18 =>
Octet.Add_F (Octet_1, Octet_2, Flag);
when 19 =>
Octet.Sbc_F (Octet_1, Octet_2, Flag);
when 20 =>
Octet.Sub_F (Octet_1, Octet_2, Flag);
when 21 =>
Octet.Cp_F (Octet_1, Octet_2, Flag);
when others =>
null;
end case;
when others =>
Text_Io.Put_Line ("tu t'es plante minable !!!");
end case;
Afficher_Resultat;
end loop;
end Je_Teste_Octet;
----------------------------------------------------------------------
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 =>
Fin := True;
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 =>
Fin := True;
end case;
Text_Io.Put_Line ("");
return Resultat;
end Lire_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;
----------------------------------------------------------------------
procedure Lire_2_Octets is
begin
Text_Io.Put ("octet_1> ");
Octet_1 := Lire_Octet_Hexa;
Text_Io.Put ("octet_2> ");
Octet_2 := Lire_Octet_Hexa;
end Lire_2_Octets;
----------------------------------------------------------------------
procedure Lire_2_Octets_Flag is
begin
Lire_2_Octets;
Text_Io.Put ("flag > ");
Flag := Lire_Octet_Binaire;
end Lire_2_Octets_Flag;
----------------------------------------------------------------------
procedure Lire_1_Octet is
begin
Text_Io.Put ("octet_1> ");
Octet_1 := Lire_Octet_Hexa;
end Lire_1_Octet;
----------------------------------------------------------------------
procedure Lire_1_Octet_Flag is
begin
Text_Io.Put ("octet_1> ");
Octet_1 := Lire_Octet_Hexa;
Text_Io.Put ("flag > ");
Flag := Lire_Octet_Binaire;
end Lire_1_Octet_Flag;
----------------------------------------------------------------------
procedure Lire_1_Octet_Bit is
begin
Text_Io.Put ("octet_1> ");
Octet_1 := Lire_Octet_Hexa;
Text_Io.Put ("num bit> ");
Num_Bit := Lire_Octet_Hexa;
end Lire_1_Octet_Bit;
----------------------------------------------------------------------
function Lire_Choix return T_Octet is
begin
Text_Io.Put_Line ("");
Text_Io.Put_Line ("------------------------------------------");
Text_Io.Put_Line ("");
Text_Io.Put ("choix > ");
return Lire_Octet_Hexa;
end Lire_Choix;
----------------------------------------------------------------------
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;
----------------------------------------------------------------------
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_Resultat is
begin
Text_Io.Put_Line ("");
Text_Io.Put ("resultat = ");
Afficher_Octet_Hexa (Octet_1);
Text_Io.Put_Line ("");
Text_Io.Put ("flag = ");
Afficher_Octet_Binaire (Flag);
Text_Io.Put_Line ("");
end Afficher_Resultat;
--------------------------------------------------
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 0 .. 7 loop
Bit_Oct (I) := ((Octet mod 2) /= 0);
Octet := Octet / 2;
end loop;
return Bit_Oct;
end Convert_Bit;
end Test_Octet;
nblk1=e
nid=9
hdr6=18
[0x00] rec0=28 rec1=00 rec2=01 rec3=028
[0x01] rec0=17 rec1=00 rec2=03 rec3=06e
[0x02] rec0=18 rec1=00 rec2=02 rec3=042
[0x03] rec0=16 rec1=00 rec2=0b rec3=024
[0x04] rec0=16 rec1=00 rec2=07 rec3=060
[0x05] rec0=27 rec1=00 rec2=04 rec3=020
[0x06] rec0=1d rec1=00 rec2=0c rec3=00c
[0x07] rec0=26 rec1=00 rec2=05 rec3=018
[0x08] rec0=26 rec1=00 rec2=0e rec3=036
[0x09] rec0=1d rec1=00 rec2=0a rec3=008
[0x0a] rec0=26 rec1=00 rec2=06 rec3=028
[0x0b] rec0=05 rec1=00 rec2=0d rec3=000
[0x0c] rec0=05 rec1=00 rec2=0d rec3=000
[0x0d] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2150b56da822b501b4938 0x42a00088462060003
Free Block Chain:
0x9: 0000 00 08 00 68 80 0d 74 65 74 5f 32 2c 20 46 6c 61 ┆ h tet_2, Fla┆
0x8: 0000 00 00 00 04 80 01 7c 01 02 03 73 05 2d 2d 2d 2d ┆ | s ----┆