|
|
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 - metrics - downloadIndex: B T
Length: 5249 (0x1481)
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 Binaire;
with Registres;
with Z80_Defs;
package body Alu_16_Bit is
-- TYPES -------------------------------------------------------
package Bin_8 is new Binaire (Nb_De_Bit => 8);
subtype T_Bit_Octet is Bin_8.Val_Binaire;
use Bin_8;
package Bin_16 is new Binaire (Nb_De_Bit => 16);
subtype T_Bit_Mot is Bin_16.Val_Binaire;
use Bin_16;
-- PROCEDURES --------------------------------------------------
procedure Add_F;
procedure Adc_F;
procedure Sbc_F;
procedure Inc_F;
procedure Dec_F;
-- VARIABLES --------------------------------------------------
Mot_Bit_1, Mot_Bit_2 : T_Bit_Mot;
Flag : T_Bit_Octet;
---------------------------------------------------------------
-- INTERFACE
---------------------------------------------------------------
function Executer (Operation : T_Operation) return Mot.T_Mot is
use Registres;
begin
Flag := Convert_Bit (Lire_Simple (Le_Registre => Z80_Defs.F));
case Operation is
when Desassembleur.Inc =>
Inc_F;
when Desassembleur.Dec =>
Dec_F;
when Desassembleur.Add =>
Add_F;
when Desassembleur.Adc =>
Adc_F;
when Desassembleur.Sbc =>
Sbc_F;
end case;
Ecrire_Simple (Le_Registre => Z80_Defs.F,
Un_Octet => Convert_Val (Flag));
return Convert_Val (La_Valeur_Binaire => Mot_Bit_1);
end Executer;
procedure Fournir_Operande_1 (Op_1 : Mot.T_Mot) is
begin
Mot_Bit_1 := Convert_Bit (La_Valeur => Op_1);
end Fournir_Operande_1;
procedure Fournir_Operande_2 (Op_2 : Mot.T_Mot) is
begin
Mot_Bit_2 := Convert_Bit (La_Valeur => Op_2);
end Fournir_Operande_2;
--------------------------------------------------
-- PROCEDURES INTERNES (privees)
--------------------------------------------------
procedure Adc (Le_Bit_Mot_1 : in out T_Bit_Mot;
Le_Bit_Mot_2 : T_Bit_Mot;
C : in out Boolean) is
H, V : Boolean;
begin
Add_H_V_C (Le_Bit_Mot_1, Le_Bit_Mot_2, H, V, C);
end Adc;
--------------------------------------------------
procedure Add (Le_Bit_Mot_1 : in out T_Bit_Mot; Le_Bit_Mot_2 : T_Bit_Mot) is
H, V : Boolean;
C : Boolean := False;
begin
Add_H_V_C (Le_Bit_Mot_1, Le_Bit_Mot_2, H, V, C);
end Add;
--------------------------------------------------
procedure Inc (Le_Bit_Mot : in out T_Bit_Mot) is
Un : T_Bit_Mot := (True, others => False);
begin
Add (Le_Bit_Mot, Un);
end Inc;
--------------------------------------------------
procedure Dec (Le_Bit_Mot : in out T_Bit_Mot) is
Moins_Un : T_Bit_Mot := (others => True);
begin
Add (Le_Bit_Mot, Moins_Un);
end Dec;
--------------------------------------------------
procedure Sbc (Le_Bit_Mot_1 : in out T_Bit_Mot;
Le_Bit_Mot_2 : T_Bit_Mot;
C : in out Boolean;
V : out Boolean) is
Le_Bit_Mot : T_Bit_Mot := Le_Bit_Mot_2;
Zero : T_Bit_Mot := (others => False);
H : Boolean;
begin
Adc (Le_Bit_Mot, Zero, C);
Le_Bit_Mot := not Le_Bit_Mot;
Inc (Le_Bit_Mot);
C := False;
Add_H_V_C (Le_Bit_Mot_1, Le_Bit_Mot, H, V, C);
C := not C;
end Sbc;
--------------------------------------------------
--------------------------------------------------
procedure Positionne_Flag_S_Z is
begin
Positionne_Flag (Mot_Bit_1, S => Flag (7), Z => Flag (6));
end Positionne_Flag_S_Z;
--------------------------------------------------
procedure Add_F is
C : Boolean := False;
V : Boolean;
begin
Add_H_V_C (Mot_Bit_1, Mot_Bit_2, H => Flag (4), V => V, C => C);
----------------------- Half Carry modifiee
Flag (1) := False; -- N = 0
Flag (0) := C; -- Carry modifiee
end Add_F;
--------------------------------------------------
procedure Adc_F is
begin
Add_H_V_C (Mot_Bit_1, Mot_Bit_2,
H => Flag (4),
V => Flag (2),
C => Flag (0));
------------------------- Carry ,Half Carry et Overflow modifies
Flag (1) := False; -- N = 0
Positionne_Flag_S_Z; -- S et Z modifies
end Adc_F;
--------------------------------------------------
procedure Sbc_F is
begin
Sbc (Mot_Bit_1, Mot_Bit_2, C => Flag (0), V => Flag (2));
-------------------------- Carry et Overflow modifies
Flag (1) := True; -- N = 1
Positionne_Flag_S_Z; -- S et Z modifoes
end Sbc_F;
--------------------------------------------------
procedure Inc_F is
begin
Inc (Mot_Bit_1); -- Aucun flag de modifie
end Inc_F;
--------------------------------------------------
procedure Dec_F is
begin
Dec (Mot_Bit_1); -- Aucun flag de modifie
end Dec_F;
end Alu_16_Bit;