|
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: 6144 (0x1800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Binaire, seg_020ed7
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
package body Binaire is
-- PROCEDURES INTERNES ----------------------------------
procedure Add_Bit_C (Bit_1 : in out Boolean;
Bit_2 : Boolean;
Carry : in out Boolean);
---------------------------------------------------------
-- INTERFACE
---------------------------------------------------------
function Convert_Bit (La_Valeur : Natural) return Val_Binaire is
Bit_Resultat : Val_Binaire;
Valeur_A_Convertir : Natural := La_Valeur;
begin
for I in Bit_Resultat'Range loop
Bit_Resultat (I) := (Valeur_A_Convertir mod 2) = 1;
Valeur_A_Convertir := Valeur_A_Convertir / 2;
end loop;
return Bit_Resultat;
end Convert_Bit;
---------------------------------------------------------
function Convert_Val (La_Valeur_Binaire : Val_Binaire) return Natural is
Resultat : Natural := 0;
begin
for I in La_Valeur_Binaire'Range loop
if La_Valeur_Binaire (I) then
Resultat := Resultat + 2 ** I;
end if;
end loop;
return Resultat;
end Convert_Val;
---------------------------------------------------------
procedure Add_H_V_C (La_Valeur_Binaire_1 : in out Val_Binaire;
La_Valeur_Binaire_2 : Val_Binaire;
H, V : out Boolean;
C : in out Boolean) is
Avant_Derniere_Retenue : Boolean;
begin
for I in La_Valeur_Binaire_1'Range loop
Add_Bit_C (Bit_1 => La_Valeur_Binaire_1 (I),
Bit_2 => La_Valeur_Binaire_2 (I),
Carry => C);
if I = (La_Valeur_Binaire_1'Last - 4) then
H := C;
elsif I = (La_Valeur_Binaire_1'Last - 1) then
Avant_Derniere_Retenue := C;
end if;
end loop;
V := Avant_Derniere_Retenue xor C;
end Add_H_V_C;
---------------------------------------------------------
procedure Positionne_Flag
(La_Valeur_Binaire : Val_Binaire; S, Z, P : out Boolean) is
Nb_De_Bit_A_1 : Natural := 0;
begin
for I in La_Valeur_Binaire'Range loop
if La_Valeur_Binaire (I) then
Nb_De_Bit_A_1 := Nb_De_Bit_A_1 + 1;
end if;
end loop;
S := La_Valeur_Binaire (La_Valeur_Binaire'Last);
Z := Nb_De_Bit_A_1 = 0;
P := (Nb_De_Bit_A_1 mod 2) = 0; -- Parite paire
end Positionne_Flag;
---------------------------------------------------------
procedure Positionne_Flag
(La_Valeur_Binaire : Val_Binaire; S, Z : out Boolean) is
P : Boolean;
begin
Positionne_Flag (La_Valeur_Binaire, S, Z, P);
end Positionne_Flag;
---------------------------------------------------------
-- PROCEDURES INTERNES
---------------------------------------------------------
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;
end Binaire;
nblk1=5
nid=3
hdr6=8
[0x00] rec0=25 rec1=00 rec2=01 rec3=010
[0x01] rec0=1d rec1=00 rec2=02 rec3=056
[0x02] rec0=25 rec1=00 rec2=04 rec3=000
[0x03] rec0=22 rec1=00 rec2=05 rec3=000
[0x04] rec0=22 rec1=00 rec2=05 rec3=001
tail 0x2150b5a1e822b5463bfff 0x42a00088462062803
Free Block Chain:
0x3: 0000 00 00 00 04 80 01 20 01 02 02 20 20 02 02 02 02 ┆ ┆