|
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: 51051 (0xc76b)
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 Adresse;
with Alu_8_Bit;
with Alu_16_Bit;
with Bus;
with Desassembleur;
with Mot;
with Octet;
with Registres;
with Text_Io;
with Z_Debug;
with Z80;
with Z80_Defs;
package body Sequenceur is
-- TYPES --------------------------------------------------------------
type Gauche_Ou_Droit is (Gauche, Droit);
--VARIABLES -----------------------------------------------------------
Le_Pc : Mot.T_Mot := 0;
Op_G_16_Bit, Op_D_16_Bit, Resultat_16_Bit, Une_Adresse : Mot.T_Mot := 0;
Code_Op, Op_G_8_Bit, Op_D_8_Bit, Resultat_8_Bit, Flag : Octet.T_Octet := 0;
Le_Bit : Octet.Num_Bit := 0;
Le_Mode : Z80_Defs.Mode := 1;
Num_Restart : Octet.T_Octet := 0;
Trouvee, Operation_8_Bit, Operation_16_Bit,
Code_Condition, Op_Gauche_A_Determiner : Boolean := False;
Une_Instruction : Desassembleur.Instruction :=
(Desassembleur.Inconnu, Z80_Defs.Aucun, Z80_Defs.Aucun, 0);
-- PROCEDURES ----------------------------------------------------------
procedure Recherche_Operande (Position : Gauche_Ou_Droit;
Un_Operande : Z80_Defs.Operande);
procedure Recherche_Operande_8_Bit (Un_Operande : Z80_Defs.Operande;
Un_Octet : in out Octet.T_Octet);
procedure Recherche_Operande_16_Bit
(Un_Operande : Z80_Defs.Operande; Un_Mot : in out Mot.T_Mot);
procedure Prologue;
procedure Recherche_Instruction;
procedure Recherche_Des_Operandes;
procedure Executer_Instruction;
procedure Addition_Soustraction;
procedure Operation_Logique;
procedure Operation_Sur_Bit;
procedure Retour_Spgm;
procedure Operation_Sur_Carry;
procedure Comparaison;
procedure Ajustement_Decimal;
procedure Complementer_Accu;
procedure Operation_Dec_Inc;
procedure Validation_Devalidation_It;
procedure Operation_Djnz;
procedure Echange_Registre;
procedure Operation_Halt;
procedure Changement_Mode;
procedure Entree_Donnee;
procedure Saut_Branchement;
procedure Charger;
procedure Sortie_Donnee;
procedure Operation_Sur_Pile;
procedure Decalage_Droite_Gauche;
procedure Restart;
procedure Afficher_Instruction (Instruc : Desassembleur.Instruction);
------------------------------------------------------------------------
procedure Lancer is
begin
Prologue;
Recherche_Instruction;
Recherche_Des_Operandes;
Executer_Instruction;
end Lancer;
----------------------------------------------------------------------
procedure Prologue is
begin
-- prologue
Trouvee := False;
Operation_8_Bit := False;
Operation_16_Bit := False;
Le_Pc := Registres.Lire_Double (Z80_Defs.Pc);
end Prologue;
----------------------------------------------------------------------
procedure Recherche_Instruction is
use Z_Debug;
begin
-- recherche d'une instruction
while not Trouvee loop
Tache_Bus.Acces_Octet (Z80.Memory_Read, Le_Pc, Code_Op);
Le_Pc := Mot.Add (Le_Pc, 1);
Trouvee := Desassembleur.Traiter_Code (Code_Op);
end loop;
Une_Instruction := Desassembleur.Instruction_Trouvee;
Registres.Ecrire_Double (Z80_Defs.Pc, Le_Pc);
Afficher_Instruction (Une_Instruction);
end Recherche_Instruction;
---------------------------------------------------------------------
procedure Recherche_Des_Operandes is
begin
Recherche_Operande (Gauche, Une_Instruction.Op_Gauche);
Recherche_Operande (Droit, Une_Instruction.Op_Droit);
end Recherche_Des_Operandes;
----------------------------------------------------------------------
procedure Recherche_Operande (Position : Gauche_Ou_Droit;
Un_Operande : Z80_Defs.Operande) is
use Z80_Defs;
use Desassembleur;
Un_Octet : Octet.T_Octet := 0;
Un_Mot : Mot.T_Mot := 0;
begin
if ((Position = Gauche) and then
((Une_Instruction.Mnemo in Ld .. Ldir) or else
(Une_Instruction.Mnemo in Otdr .. Outi) or else
(Une_Instruction.Mnemo in Z80_In .. Inir))) then
Op_Gauche_A_Determiner := False;
else
Op_Gauche_A_Determiner := True;
end if;
case Un_Operande is
--------------------
when A .. R | N | Offset_E | N_Indirect .. Iy_Plus_D_Indirect =>
Operation_8_Bit := True;
Recherche_Operande_8_Bit (Un_Operande, Un_Octet);
--------------------
when Af_Prime .. Hl_Prime | Af .. Sp | Nn | Sp_Indirect =>
Operation_16_Bit := True;
Recherche_Operande_16_Bit (Un_Operande, Un_Mot);
--------------------
when Nn_Indirect =>
if Une_Instruction.Op_Gauche = Z80_Defs.A then
Operation_8_Bit := True;
Recherche_Operande_8_Bit (Un_Operande, Un_Octet);
else
Operation_16_Bit := True;
Recherche_Operande_16_Bit (Un_Operande, Un_Mot);
end if;
--------------------
when Nz .. M =>
Flag := Registres.Lire_Simple (F);
case Un_Operande is
when Z =>
Code_Condition := Octet.Test_Bit (Flag, 6);
when Nz =>
Code_Condition := not Octet.Test_Bit (Flag, 6);
when Cy =>
Code_Condition := Octet.Test_Bit (Flag, 0);
when Nc =>
Code_Condition := not Octet.Test_Bit (Flag, 0);
when M =>
Code_Condition := Octet.Test_Bit (Flag, 7);
when P =>
Code_Condition := not Octet.Test_Bit (Flag, 7);
when Pe =>
Code_Condition := Octet.Test_Bit (Flag, 2);
when Po =>
Code_Condition := not Octet.Test_Bit (Flag, 2);
when others =>
null;
end case;
--------------------
when Bit_0 .. Bit_7 =>
case Un_Operande is
when Bit_0 =>
Le_Bit := 0;
when Bit_1 =>
Le_Bit := 1;
when Bit_2 =>
Le_Bit := 2;
when Bit_3 =>
Le_Bit := 3;
when Bit_4 =>
Le_Bit := 4;
when Bit_5 =>
Le_Bit := 5;
when Bit_6 =>
Le_Bit := 6;
when Bit_7 =>
Le_Bit := 7;
when others =>
null;
end case;
--------------------
when Z80_0 .. Z80_2 =>
case Un_Operande is
when Z80_0 =>
Le_Mode := 0;
when Z80_1 =>
Le_Mode := 1;
when Z80_2 =>
Le_Mode := 2;
when others =>
null;
end case;
--------------------
when Z80_00h .. Z80_38h =>
case Un_Operande is
when Z80_00h =>
Num_Restart := 16#00#;
when Z80_08h =>
Num_Restart := 16#08#;
when Z80_10h =>
Num_Restart := 16#10#;
when Z80_18h =>
Num_Restart := 16#18#;
when Z80_20h =>
Num_Restart := 16#20#;
when Z80_28h =>
Num_Restart := 16#28#;
when Z80_30h =>
Num_Restart := 16#30#;
when Z80_38h =>
Num_Restart := 16#38#;
when others =>
null;
end case;
--------------------
when Pc =>
null;
--------------------
when Aucun =>
null;
end case;
---------------------------------------------------
case Position is
when Gauche =>
if Operation_8_Bit then
Op_G_8_Bit := Un_Octet;
elsif Operation_16_Bit then
Op_G_16_Bit := Un_Mot;
end if;
when Droit =>
if Operation_8_Bit then
Op_D_8_Bit := Un_Octet;
elsif Operation_16_Bit then
Op_D_16_Bit := Un_Mot;
end if;
end case;
end Recherche_Operande;
----------------------------------------------------------------------
procedure Recherche_Operande_8_Bit (Un_Operande : Z80_Defs.Operande;
Un_Octet : in out Octet.T_Octet) is
use Z80_Defs;
use Desassembleur;
use Z_Debug;
begin
case Un_Operande is
when A .. R =>
if Op_Gauche_A_Determiner then
Un_Octet := Registres.Lire_Simple (Un_Operande);
end if;
when N | Offset_E =>
Un_Octet := Mot.Poids_Faible (Une_Instruction.Donnee);
when N_Indirect =>
Une_Adresse := Une_Instruction.Donnee;
if ((Une_Instruction.Mnemo = Z80_In) or else
(Une_Instruction.Mnemo = Ini) or else
(Une_Instruction.Mnemo = Inir) or else
(Une_Instruction.Mnemo = Ind) or else
(Une_Instruction.Mnemo = Indr)) then
Tache_Bus.Acces_Octet (Z80.Io_Read, Une_Adresse, Un_Octet);
elsif Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when C_Indirect =>
Une_Adresse := Mot.T_Mot (Registres.Lire_Simple (C));
if ((Une_Instruction.Mnemo = Z80_In) or else
(Une_Instruction.Mnemo = Ini) or else
(Une_Instruction.Mnemo = Inir) or else
(Une_Instruction.Mnemo = Ind) or else
(Une_Instruction.Mnemo = Indr)) then
Tache_Bus.Acces_Octet (Z80.Io_Read, Une_Adresse, Un_Octet);
elsif Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when Bc_Indirect =>
Une_Adresse := Registres.Lire_Double (Bc);
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when De_Indirect =>
Une_Adresse := Registres.Lire_Double (De);
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when Hl_Indirect =>
Une_Adresse := Registres.Lire_Double (Hl);
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when Ix_Indirect =>
Une_Adresse := Registres.Lire_Double (Ix);
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when Iy_Indirect =>
Une_Adresse := Registres.Lire_Double (Iy);
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when Iy_Plus_D_Indirect =>
if Une_Instruction.Op_Droit = N then
Une_Adresse :=
Mot.Add (Registres.Lire_Double (Iy),
Mot.Construire
(0, Mot.Poids_Fort
(Une_Instruction.Donnee)));
else
Une_Adresse := Mot.Add (Registres.Lire_Double (Iy),
Une_Instruction.Donnee);
end if;
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when Ix_Plus_D_Indirect =>
if Une_Instruction.Op_Droit = N then
Une_Adresse :=
Mot.Add (Registres.Lire_Double (Ix),
Mot.Construire
(0, Mot.Poids_Fort
(Une_Instruction.Donnee)));
else
Une_Adresse := Mot.Add (Registres.Lire_Double (Ix),
Une_Instruction.Donnee);
end if;
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when Nn_Indirect =>
Une_Adresse := Une_Instruction.Donnee;
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read,
Une_Adresse, Un_Octet);
end if;
when others =>
null;
end case;
end Recherche_Operande_8_Bit;
----------------------------------------------------------------------
procedure Recherche_Operande_16_Bit
(Un_Operande : Z80_Defs.Operande; Un_Mot : in out Mot.T_Mot) is
use Z80_Defs;
use Z_Debug;
Msb, Lsb : Octet.T_Octet;
begin
case Un_Operande is
when Af_Prime .. Hl_Prime | Af .. Sp =>
if Op_Gauche_A_Determiner then
Un_Mot := Registres.Lire_Double (Un_Operande);
end if;
when Nn =>
Msb := Mot.Poids_Faible (Une_Instruction.Donnee);
Lsb := Mot.Poids_Fort (Une_Instruction.Donnee);
Un_Mot := Mot.Construire (Msb, Lsb);
when Nn_Indirect =>
Msb := Mot.Poids_Faible (Une_Instruction.Donnee);
Lsb := Mot.Poids_Fort (Une_Instruction.Donnee);
Une_Adresse := Mot.Construire (Msb, Lsb);
if Op_Gauche_A_Determiner then
Tache_Bus.Acces_Octet (Z80.Memory_Read, Une_Adresse, Lsb);
Tache_Bus.Acces_Octet (Z80.Memory_Read, Une_Adresse, Msb);
Un_Mot := Mot.Construire (Msb, Lsb);
end if;
when Sp_Indirect =>
Une_Adresse := Registres.Lire_Double (Sp);
Tache_Bus.Acces_Octet (Z80.Memory_Read, Une_Adresse, Lsb);
Tache_Bus.Acces_Octet (Z80.Memory_Read, Une_Adresse, Msb);
Un_Mot := Mot.Construire (Msb, Lsb);
when others =>
null;
end case;
end Recherche_Operande_16_Bit;
----------------------------------------------------------------------
procedure Executer_Instruction is
use Desassembleur;
begin
case Une_Instruction.Mnemo is
when Adc | Add | Sbc | Sub =>
Addition_Soustraction;
when Z80_And | Z80_Or | Z80_Xor | Neg =>
Operation_Logique;
when Bit | Res | Set =>
Operation_Sur_Bit;
when Ret | Reti | Retn =>
Retour_Spgm;
when Ccf | Scf =>
Operation_Sur_Carry;
when Cp | Cpd | Cpdr | Cpi | Cpir =>
Comparaison;
when Cpl =>
Complementer_Accu;
when Daa =>
Ajustement_Decimal;
when Dec | Inc =>
Operation_Dec_Inc;
when Di | Ei =>
Validation_Devalidation_It;
when Djnz =>
Operation_Djnz;
when Ex | Exx =>
Echange_Registre;
when Halt =>
Operation_Halt;
when Im =>
Changement_Mode;
when Z80_In | Ind | Indr | Ini | Inir =>
Entree_Donnee;
when Call | Jp | Jr =>
Saut_Branchement;
when Ld | Ldd | Lddr | Ldi | Ldir =>
Charger;
when Nop =>
null;
when Otdr | Otir | Z80_Out | Outd | Outi =>
Sortie_Donnee;
when Pop | Push =>
Operation_Sur_Pile;
when Rl | Rla | Rlc | Rlca | Rld | Rr | Rra |
Rrc | Rrca | Rrd | Sla | Sra | Srl =>
Decalage_Droite_Gauche;
when Rst =>
Restart;
when Inconnu =>
null;
end case;
end Executer_Instruction;
----------------------------------------------------------------------
procedure Addition_Soustraction is -- adc | add | sbc | sub
use Desassembleur;
use Z80_Defs;
begin
if Operation_8_Bit then
if (Une_Instruction.Mnemo = Sub) then
Alu_8_Bit.Fournir_Operande_1 (Registres.Lire_Simple (A));
Alu_8_Bit.Fournir_Operande_2 (Op_G_8_Bit);
else
Alu_8_Bit.Fournir_Operande_1 (Op_G_8_Bit);
Alu_8_Bit.Fournir_Operande_2 (Op_D_8_Bit);
end if;
Resultat_8_Bit := Alu_8_Bit.Executer (Une_Instruction.Mnemo);
Registres.Ecrire_Simple (A, Resultat_8_Bit);
elsif Operation_16_Bit then
Alu_16_Bit.Fournir_Operande_1 (Op_G_16_Bit);
Alu_16_Bit.Fournir_Operande_2 (Op_D_16_Bit);
Resultat_16_Bit := Alu_16_Bit.Executer (Une_Instruction.Mnemo);
Registres.Ecrire_Double
(Une_Instruction.Op_Gauche, Resultat_16_Bit);
end if;
end Addition_Soustraction;
------------------------------------------------------------------------
procedure Operation_Logique is -- Z80_And | Z80_Or | Z80_Xor | Neg
use Desassembleur;
use Z80_Defs;
begin
Alu_8_Bit.Fournir_Operande_1 (Registres.Lire_Simple (A));
Alu_8_Bit.Fournir_Operande_2 (Op_G_8_Bit);
Resultat_8_Bit := Alu_8_Bit.Executer (Une_Instruction.Mnemo);
Registres.Ecrire_Simple (A, Resultat_8_Bit);
end Operation_Logique;
------------------------------------------------------------------------
procedure Operation_Sur_Bit is -- Bit | Res | Set
use Desassembleur;
use Z80_Defs;
use Z_Debug;
Val_Bit : Boolean := False;
begin
case Une_Instruction.Mnemo is
when Bit =>
Flag := Registres.Lire_Simple (F);
Val_Bit := Octet.Test_Bit (Op_D_8_Bit, Le_Bit);
if Val_Bit then
Octet.Res_Bit (Flag, 6);
else
Octet.Set_Bit (Flag, 6);
end if;
Octet.Res_Bit (Flag, 1);
if not (Une_Instruction.Op_Droit in A .. L) then
Octet.Set_Bit (Flag, 4);
end if;
Registres.Ecrire_Simple (F, Flag);
when Res | Set =>
if (Une_Instruction.Mnemo = Res) then
Octet.Res_Bit (Op_D_8_Bit, Le_Bit);
else
Octet.Set_Bit (Op_D_8_Bit, Le_Bit);
end if;
if (Une_Instruction.Op_Droit in A .. L) then
Registres.Ecrire_Simple
(Une_Instruction.Op_Droit, Op_D_8_Bit);
else
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Une_Adresse, Op_D_8_Bit);
end if;
when others =>
null;
end case;
end Operation_Sur_Bit;
------------------------------------------------------------------------
procedure Retour_Spgm is -- Ret | Reti | Retn
use Desassembleur;
use Z80_Defs;
use Z_Debug;
Ret_A_Effectuer : Boolean := False;
Adresse_Pile : Adresse.T_Adresse;
Msb, Lsb : Octet.T_Octet;
begin
case Une_Instruction.Op_Gauche is
when Aucun =>
Ret_A_Effectuer := True;
when Nz .. M =>
Ret_A_Effectuer := Code_Condition;
when others =>
null;
end case;
if Ret_A_Effectuer then
-- lecture adrsse de retour a partir de la pile
Adresse_Pile := Registres.Lire_Double (Sp);
Tache_Bus.Acces_Octet (Z80.Memory_Read, Adresse_Pile, Lsb);
Adresse_Pile := Mot.Add (Adresse_Pile, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Read, Adresse_Pile, Msb);
-- modif de sp
Adresse_Pile := Mot.Add (Adresse_Pile, 1);
Registres.Ecrire_Double (Sp, Adresse_Pile);
-- modif de pc
Registres.Ecrire_Double (Pc, Mot.Construire (Msb, Lsb));
--
if Une_Instruction.Mnemo = Reti then
null;
-- indiquer au bus que lon sort d'une IT
elsif Une_Instruction.Mnemo = Retn then
Z80.Iff_1 := Z80.Iff_2;
end if;
end if;
end Retour_Spgm;
------------------------------------------------------------------------
procedure Operation_Sur_Carry is -- Ccf | Scf
use Desassembleur;
use Z80_Defs;
Val_Bit : Boolean;
begin
Flag := Registres.Lire_Simple (F);
if Une_Instruction.Mnemo = Ccf then
Octet.Res_Bit (Flag, 1);
Val_Bit := Octet.Test_Bit (Flag, 0);
if Val_Bit then
Octet.Res_Bit (Flag, 0);
else
Octet.Set_Bit (Flag, 0);
end if;
elsif Une_Instruction.Mnemo = Scf then
Octet.Set_Bit (Flag, 0);
Octet.Res_Bit (Flag, 1);
Octet.Res_Bit (Flag, 4);
end if;
Registres.Ecrire_Simple (F, Flag);
end Operation_Sur_Carry;
------------------------------------------------------------------------
procedure Proc_Cp is
use Desassembleur;
use Z80_Defs;
Reg_A : Octet.T_Octet;
begin
Reg_A := Registres.Lire_Simple (A);
Alu_8_Bit.Fournir_Operande_1 (Reg_A);
Alu_8_Bit.Fournir_Operande_2 (Op_G_8_Bit);
Reg_A := Alu_8_Bit.Executer (Sub);
end Proc_Cp;
------------------------------------------------------------------------
procedure Proc_Cpd_Cpi is
use Desassembleur;
use Z80_Defs;
Reg_Hl, Reg_Bc : Mot.T_Mot;
Carry : Boolean;
begin
-- sauvegarde carry
Flag := Registres.Lire_Simple (F);
Carry := Octet.Test_Bit (Flag, 0);
Proc_Cp;
-- modif des registres BC, HL
Reg_Hl := Registres.Lire_Double (Hl);
Reg_Bc := Registres.Lire_Double (Bc);
if ((Une_Instruction.Mnemo = Cpi) or else
(Une_Instruction.Mnemo = Cpir)) then
Reg_Hl := Mot.Add (Reg_Hl, 1);
else
Reg_Hl := Mot.Sub (Reg_Hl, 1);
end if;
Reg_Bc := Mot.Sub (Reg_Bc, 1);
Registres.Ecrire_Double (Hl, Reg_Hl);
Registres.Ecrire_Double (Bc, Reg_Bc);
-- modif des flags
Flag := Registres.Lire_Simple (F);
if Carry then
Octet.Set_Bit (Flag, 0);
else
Octet.Res_Bit (Flag, 0);
end if;
if Reg_Bc = 0 then
Octet.Res_Bit (Flag, 2);
else
Octet.Set_Bit (Flag, 2);
end if;
Registres.Ecrire_Simple (F, Flag);
end Proc_Cpd_Cpi;
------------------------------------------------------------------------
procedure Comparaison is -- Cp | Cpd | Cpdr | Cpi | Cpir
use Desassembleur;
use Z80_Defs;
begin
case Une_Instruction.Mnemo is
when Cp =>
Proc_Cp;
when Cpd | Cpi =>
Proc_Cpd_Cpi;
when Cpdr | Cpir =>
loop
Proc_Cpd_Cpi;
exit when ((not Octet.Test_Bit (Flag, 2)) or else
(Octet.Test_Bit (Flag, 6)));
Recherche_Des_Operandes;
end loop;
when others =>
null;
end case;
end Comparaison;
------------------------------------------------------------------------
procedure Complementer_Accu is
use Desassembleur;
use Z80_Defs;
Reg_A : Octet.T_Octet;
begin
Reg_A := Registres.Lire_Simple (A);
Reg_A := Octet."not" (Reg_A);
Registres.Ecrire_Simple (A, Reg_A);
Flag := Registres.Lire_Simple (F);
Octet.Set_Bit (Flag, 1);
Octet.Set_Bit (Flag, 4);
Registres.Ecrire_Simple (F, Flag);
end Complementer_Accu;
------------------------------------------------------------------------
procedure Ajustement_Decimal is -- Daa
use Desassembleur;
use Z80_Defs;
Operation_Precedente_Est_Une_Addition : Boolean;
Addition_A_Realiser : Boolean := True;
Flag_N : Boolean;
Reg_A, Valeur_A_Ajouter, Quatre_Bits_Poids_Fort,
Quatre_Bits_Poids_Faible : Octet.T_Octet;
begin
Flag := Registres.Lire_Simple (F);
Flag_N := Octet.Test_Bit (Flag, 1);
Operation_Precedente_Est_Une_Addition := not Flag_N;
Reg_A := Registres.Lire_Simple (A);
Quatre_Bits_Poids_Faible := Octet."and" (Reg_A, 16#0F#);
Quatre_Bits_Poids_Fort := Octet."and" (Reg_A, 16#F0#);
if Operation_Precedente_Est_Une_Addition then
if ((Quatre_Bits_Poids_Fort > 16#90#) and
(Quatre_Bits_Poids_Faible > 9)) then
Valeur_A_Ajouter := 16#66#;
elsif ((Quatre_Bits_Poids_Fort <= 16#90#) and
(Quatre_Bits_Poids_Faible > 9)) then
Valeur_A_Ajouter := 16#06#;
elsif ((Quatre_Bits_Poids_Fort > 16#90#) and
(Quatre_Bits_Poids_Faible <= 9)) then
Valeur_A_Ajouter := 16#60#;
else
Addition_A_Realiser := False;
end if;
else
if ((Quatre_Bits_Poids_Fort > 16#90#) and
(Quatre_Bits_Poids_Faible > 9)) then
Valeur_A_Ajouter := 16#9A#;
elsif ((Quatre_Bits_Poids_Fort <= 16#90#) and
(Quatre_Bits_Poids_Faible > 9)) then
Valeur_A_Ajouter := 16#FA#;
elsif ((Quatre_Bits_Poids_Fort > 16#90#) and
(Quatre_Bits_Poids_Faible <= 9)) then
Valeur_A_Ajouter := 16#A0#;
else
Addition_A_Realiser := False;
end if;
end if;
if Addition_A_Realiser then
Reg_A := Registres.Lire_Simple (A);
Alu_8_Bit.Fournir_Operande_1 (Reg_A);
Alu_8_Bit.Fournir_Operande_2 (Valeur_A_Ajouter);
Reg_A := Alu_8_Bit.Executer (Add);
Registres.Ecrire_Simple (A, Reg_A);
-- modif flag (restitution du flag n d'avant)
Flag := Registres.Lire_Simple (F);
if Flag_N then
Octet.Set_Bit (Flag, 1);
else
Octet.Res_Bit (Flag, 1);
end if;
Registres.Ecrire_Simple (F, Flag);
end if;
end Ajustement_Decimal;
------------------------------------------------------------------------
procedure Operation_Dec_Inc is -- dec | inc
use Desassembleur;
use Z80_Defs;
use Z_Debug;
begin
if Operation_8_Bit then
Alu_8_Bit.Fournir_Operande_1 (Op_G_8_Bit);
Resultat_8_Bit := Alu_8_Bit.Executer (Une_Instruction.Mnemo);
if (Une_Instruction.Op_Gauche in A .. L) then
Registres.Ecrire_Simple
(Une_Instruction.Op_Gauche, Resultat_8_Bit);
else
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Une_Adresse, Resultat_8_Bit);
end if;
elsif Operation_16_Bit then
Alu_16_Bit.Fournir_Operande_1 (Op_G_16_Bit);
Resultat_16_Bit := Alu_16_Bit.Executer (Une_Instruction.Mnemo);
Registres.Ecrire_Double
(Une_Instruction.Op_Gauche, Resultat_16_Bit);
end if;
end Operation_Dec_Inc;
------------------------------------------------------------------------
procedure Validation_Devalidation_It is -- ei | di
use Desassembleur;
begin
case Une_Instruction.Mnemo is
when Ei =>
Z80.Iff_1 := True;
Z80.Iff_2 := True;
when Di =>
Z80.Iff_1 := False;
Z80.Iff_2 := False;
when others =>
null;
end case;
end Validation_Devalidation_It;
------------------------------------------------------------------------
procedure Operation_Djnz is -- djnz
use Z80_Defs;
use Desassembleur;
Reg_B : Octet.T_Octet;
Adresse_Dest, Valeur_Pc : Adresse.T_Adresse;
begin
Reg_B := Registres.Lire_Simple (B);
Alu_8_Bit.Fournir_Operande_1 (Reg_B);
Reg_B := Alu_8_Bit.Executer (Dec);
Registres.Ecrire_Simple (B, Reg_B);
Flag := Registres.Lire_Simple (F);
if (not Octet.Test_Bit (Flag, 6)) then
Valeur_Pc := Registres.Lire_Double (Pc);
if Octet.Test_Bit (Op_G_8_Bit, 7) then
Adresse_Dest := Mot.Construire (16#FF#, Op_G_8_Bit);
else
Adresse_Dest := Mot.Construire (0, Op_G_8_Bit);
end if;
Adresse_Dest := Mot.Add (Valeur_Pc, Adresse_Dest);
Registres.Ecrire_Double (Pc, Adresse_Dest);
end if;
end Operation_Djnz;
------------------------------------------------------------------------
procedure Echange_Registre is -- Ex | Exx
use Z80_Defs;
use Desassembleur;
use Z_Debug;
Reg_Temp : Mot.T_Mot := 0;
Msb_Reg_Temp, Lsb_Reg_Temp : Octet.T_Octet;
begin
case Une_Instruction.Mnemo is
when Ex =>
if Une_Instruction.Op_Gauche = Af and
Une_Instruction.Op_Droit = Af_Prime then
Registres.Echange_Af_Reg_Prime;
elsif Une_Instruction.Op_Gauche = De and
Une_Instruction.Op_Droit = Hl then
Registres.Echange_De_Hl;
else
Reg_Temp := Registres.Lire_Double
(Une_Instruction.Op_Droit);
Msb_Reg_Temp := Mot.Poids_Fort (Reg_Temp);
Lsb_Reg_Temp := Mot.Poids_Faible (Reg_Temp);
Registres.Ecrire_Double
(Une_Instruction.Op_Droit, Op_G_16_Bit);
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Une_Adresse, Lsb_Reg_Temp);
Une_Adresse := Mot.Add (Une_Adresse, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Une_Adresse, Msb_Reg_Temp);
end if;
when Exx =>
Registres.Echange_Bc_De_Hl_Reg_Prime;
when others =>
null;
end case;
end Echange_Registre;
------------------------------------------------------------------------
procedure Operation_Halt is -- halt
begin
Z80.Halt := True;
end Operation_Halt;
------------------------------------------------------------------------
procedure Changement_Mode is -- im
begin
Z80.Son_Mode := Le_Mode;
end Changement_Mode;
------------------------------------------------------------------------
procedure Proc_In is
use Desassembleur;
use Z80_Defs;
use Z_Debug;
begin
case Une_Instruction.Op_Gauche is
when A .. L =>
Registres.Ecrire_Simple (Une_Instruction.Op_Gauche, Op_D_8_Bit);
when Hl_Indirect =>
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Registres.Lire_Double (Hl), Op_D_8_Bit);
when others =>
null;
end case;
end Proc_In;
------------------------------------------------------------------------
procedure Proc_Ind_Ini is
use Desassembleur;
use Z80_Defs;
Reg_B : Octet.T_Octet;
Reg_Hl : Mot.T_Mot;
begin
Proc_In;
-- modif des registres B, HL
Reg_Hl := Registres.Lire_Double (Hl);
Reg_B := Registres.Lire_Simple (B);
if ((Une_Instruction.Mnemo = Ini) or else
(Une_Instruction.Mnemo = Inir)) then
Reg_Hl := Mot.Add (Reg_Hl, 1);
else
Reg_Hl := Mot.Sub (Reg_Hl, 1);
end if;
Reg_B := Octet.Sub (Reg_B, 1);
Registres.Ecrire_Double (Hl, Reg_Hl);
Registres.Ecrire_Simple (B, Reg_B);
-- modif des flags
Flag := Registres.Lire_Simple (F);
Octet.Set_Bit (Flag, 1);
if (Reg_B = 0) then
Octet.Set_Bit (Flag, 6);
else
Octet.Res_Bit (Flag, 6);
end if;
Registres.Ecrire_Simple (F, Flag);
end Proc_Ind_Ini;
------------------------------------------------------------------------
procedure Entree_Donnee is -- Z80_In | Ind | Indr | Ini | Inir
use Desassembleur;
use Z80_Defs;
begin
case Une_Instruction.Mnemo is
when Z80_In =>
Proc_In;
when Ind | Ini =>
Proc_Ind_Ini;
when Indr | Inir =>
loop
Proc_Ind_Ini;
exit when Octet.Test_Bit (Flag, 6);
Recherche_Des_Operandes;
end loop;
when others =>
null;
end case;
end Entree_Donnee;
------------------------------------------------------------------------
procedure Saut_Branchement is -- call | jp | jr
use Desassembleur;
use Z80_Defs;
use Z_Debug;
Adresse_Dest, Adresse_Pile, Valeur_Pc : Adresse.T_Adresse;
Call_A_Effectuer, Jp_A_Effectuer, Jr_A_Effectuer : Boolean := False;
Msb_Valeur_Pc, Lsb_Valeur_Pc : Octet.T_Octet;
begin
case Une_Instruction.Mnemo is
-------------------------
when Call =>
case Une_Instruction.Op_Gauche is
when Nn =>
Adresse_Dest := Op_G_16_Bit;
Call_A_Effectuer := True;
when Nz .. M =>
if Code_Condition then
Adresse_Dest := Op_D_16_Bit;
Call_A_Effectuer := True;
else
Call_A_Effectuer := False;
end if;
when others =>
null;
end case;
if Call_A_Effectuer then
-- sauvegarde PC
Valeur_Pc := Registres.Lire_Double (Pc);
Msb_Valeur_Pc := Mot.Poids_Fort (Valeur_Pc);
Lsb_Valeur_Pc := Mot.Poids_Faible (Valeur_Pc);
Adresse_Pile := Registres.Lire_Double (Sp);
Adresse_Pile := Mot.Sub (Adresse_Pile, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Adresse_Pile, Msb_Valeur_Pc);
Adresse_Pile := Mot.Sub (Adresse_Pile, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Adresse_Pile, Lsb_Valeur_Pc);
Registres.Ecrire_Double (Sp, Adresse_Pile);
-- modif du PC
Registres.Ecrire_Double (Pc, Adresse_Dest);
end if;
--------------------------
when Jr =>
Valeur_Pc := Registres.Lire_Double (Pc);
Flag := Registres.Lire_Simple (F);
case Une_Instruction.Op_Gauche is
when Offset_E =>
Adresse_Dest := Mot.Construire (0, Op_G_8_Bit);
if Octet.Test_Bit (Op_G_8_Bit, 7) then
Adresse_Dest := Mot.Sub (Valeur_Pc, Adresse_Dest);
else
Adresse_Dest := Mot.Add (Valeur_Pc, Adresse_Dest);
end if;
Jr_A_Effectuer := True;
when Nz .. M =>
if Code_Condition then
if Octet.Test_Bit (Op_D_8_Bit, 7) then
Adresse_Dest := Mot.Construire
(16#FF#, Op_D_8_Bit);
else
Adresse_Dest := Mot.Construire (0, Op_D_8_Bit);
end if;
Adresse_Dest := Mot.Add (Valeur_Pc, Adresse_Dest);
Jr_A_Effectuer := True;
else
Jr_A_Effectuer := False;
end if;
when others =>
null;
end case;
if Jr_A_Effectuer then -- modif du PC
Registres.Ecrire_Double (Pc, Adresse_Dest);
end if;
--------------------------
when Jp =>
case Une_Instruction.Op_Gauche is
when Nn | Hl | Ix | Iy =>
Adresse_Dest := Op_G_16_Bit;
Jp_A_Effectuer := True;
when Nz .. M =>
if Code_Condition then
Adresse_Dest := Op_D_16_Bit;
Jp_A_Effectuer := True;
else
Jp_A_Effectuer := False;
end if;
when others =>
null;
end case;
if Jp_A_Effectuer then -- modif du PC
Registres.Ecrire_Double (Pc, Adresse_Dest);
end if;
--------------------------
when others =>
null;
end case;
end Saut_Branchement;
------------------------------------------------------------------------
procedure Proc_Ld is
use Desassembleur;
use Z80_Defs;
use Z_Debug;
Msb, Lsb : Octet.T_Octet;
begin
if Operation_8_Bit then
case Une_Instruction.Op_Gauche is
when A .. R =>
Registres.Ecrire_Simple
(Une_Instruction.Op_Gauche, Op_D_8_Bit);
when others =>
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Une_Adresse, Op_D_8_Bit);
end case;
else -- operation sur 16 bit
case Une_Instruction.Op_Gauche is
when Bc .. Sp =>
Registres.Ecrire_Double
(Une_Instruction.Op_Gauche, Op_D_16_Bit);
when Nn_Indirect =>
Msb := Mot.Poids_Fort (Op_D_16_Bit);
Lsb := Mot.Poids_Faible (Op_D_16_Bit);
Tache_Bus.Acces_Octet (Z80.Memory_Write, Une_Adresse, Lsb);
Une_Adresse := Mot.Add (Une_Adresse, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Write, Une_Adresse, Msb);
when others =>
null;
end case;
end if;
end Proc_Ld;
------------------------------------------------------------------------
procedure Proc_Ldd_Ldi is
use Desassembleur;
use Z80_Defs;
Reg_Bc, Reg_De, Reg_Hl : Adresse.T_Adresse;
begin
Une_Adresse := Registres.Lire_Double (De);
Proc_Ld;
-- modif des registres BC, DE, HL
Reg_De := Registres.Lire_Double (De);
Reg_Hl := Registres.Lire_Double (Hl);
Reg_Bc := Registres.Lire_Double (Bc);
if ((Une_Instruction.Mnemo = Ldi) or else
(Une_Instruction.Mnemo = Ldir)) then
Reg_De := Mot.Add (Reg_De, 1);
Reg_Hl := Mot.Add (Reg_Hl, 1);
else
Reg_De := Mot.Sub (Reg_De, 1);
Reg_Hl := Mot.Sub (Reg_Hl, 1);
end if;
Reg_Bc := Mot.Sub (Reg_Bc, 1);
Registres.Ecrire_Double (De, Reg_De);
Registres.Ecrire_Double (Hl, Reg_Hl);
Registres.Ecrire_Double (Bc, Reg_Bc);
-- modif des flags
Flag := Registres.Lire_Simple (F);
Octet.Res_Bit (Flag, 1);
Octet.Res_Bit (Flag, 4);
if (Reg_Bc = 0) then
Octet.Res_Bit (Flag, 2);
else
Octet.Set_Bit (Flag, 2);
end if;
Registres.Ecrire_Simple (F, Flag);
end Proc_Ldd_Ldi;
------------------------------------------------------------------------
procedure Charger is -- Ld | Ldd | Lddr | Ldi | Ldir
use Desassembleur;
use Z80_Defs;
begin
case Une_Instruction.Mnemo is
when Ld =>
Proc_Ld;
when Ldd | Ldi =>
Proc_Ldd_Ldi;
when Lddr | Ldir =>
loop
Proc_Ldd_Ldi;
exit when not Octet.Test_Bit (Flag, 2);
Recherche_Des_Operandes;
end loop;
when others =>
null;
end case;
end Charger;
------------------------------------------------------------------------
procedure Proc_Out is
use Desassembleur;
use Z80_Defs;
use Z_Debug;
begin
if Une_Instruction.Op_Droit = Hl_Indirect then
Une_Adresse := Mot.Construire (0, Registres.Lire_Simple (C));
end if;
Tache_Bus.Acces_Octet (Z80.Io_Write, Une_Adresse, Op_D_8_Bit);
end Proc_Out;
------------------------------------------------------------------------
procedure Proc_Outd_Outi is
use Desassembleur;
use Z80_Defs;
Reg_B : Octet.T_Octet;
Reg_Hl : Mot.T_Mot;
begin
Proc_Out;
-- modif des registres B, HL
Reg_Hl := Registres.Lire_Double (Hl);
Reg_B := Registres.Lire_Simple (B);
if ((Une_Instruction.Mnemo = Outi) or else
(Une_Instruction.Mnemo = Otir)) then
Reg_Hl := Mot.Add (Reg_Hl, 1);
else
Reg_Hl := Mot.Sub (Reg_Hl, 1);
end if;
Reg_B := Octet.Sub (Reg_B, 1);
Registres.Ecrire_Double (Hl, Reg_Hl);
Registres.Ecrire_Simple (B, Reg_B);
-- modif des flags
Flag := Registres.Lire_Simple (F);
Octet.Set_Bit (Flag, 1);
if (Reg_B = 0) then
Octet.Set_Bit (Flag, 6);
else
Octet.Res_Bit (Flag, 6);
end if;
Registres.Ecrire_Simple (F, Flag);
end Proc_Outd_Outi;
------------------------------------------------------------------------
procedure Sortie_Donnee is -- Z80_Out | Outd | Outi| Otdr | Otir
use Desassembleur;
use Z80_Defs;
begin
case Une_Instruction.Mnemo is
when Z80_Out =>
Proc_Out;
when Outd | Outi =>
Proc_Outd_Outi;
when Otdr | Otir =>
loop
Proc_Outd_Outi;
exit when Octet.Test_Bit (Flag, 6);
Recherche_Des_Operandes;
end loop;
when others =>
null;
end case;
end Sortie_Donnee;
------------------------------------------------------------------------
procedure Operation_Sur_Pile is -- pop | push
use Desassembleur;
use Z80_Defs;
use Z_Debug;
Adresse_Pile : Adresse.T_Adresse;
Msb, Lsb : Octet.T_Octet;
begin
Adresse_Pile := Registres.Lire_Double (Sp);
if Une_Instruction.Mnemo = Push then
Adresse_Pile := Mot.Sub (Adresse_Pile, 1);
Msb := Mot.Poids_Fort (Op_G_16_Bit);
Lsb := Mot.Poids_Faible (Op_G_16_Bit);
Tache_Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Msb);
Adresse_Pile := Mot.Sub (Adresse_Pile, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Lsb);
Registres.Ecrire_Double (Sp, Adresse_Pile);
else
Tache_Bus.Acces_Octet (Z80.Memory_Read, Adresse_Pile, Lsb);
Adresse_Pile := Mot.Add (Adresse_Pile, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Read, Adresse_Pile, Msb);
Adresse_Pile := Mot.Add (Adresse_Pile, 1);
Registres.Ecrire_Double (Sp, Adresse_Pile);
Registres.Ecrire_Double (Une_Instruction.Op_Gauche,
Mot.Construire (Msb, Lsb));
end if;
end Operation_Sur_Pile;
------------------------------------------------------------------------
procedure Decalage_Droite_Gauche is -- Rl | Rla | Rlc | Rlca | Rld | Rr
-- Rra | Rrc | Rrca | Rrd | Sla |
-- Sra | Srl
use Desassembleur;
use Z80_Defs;
use Z_Debug;
Nb_Bit_A_1 : Octet.T_Octet := 0;
begin
case Une_Instruction.Mnemo is
when Rrd | Rld =>
if Une_Instruction.Mnemo = Rrd then
Octet.Rrd (Op_G_8_Bit, Op_D_8_Bit);
else
Octet.Rld (Op_G_8_Bit, Op_D_8_Bit);
end if;
-- sauvegarde dans l'accu
Registres.Ecrire_Simple (A, Op_G_8_Bit);
-- sauvegarde en memoire
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Une_Adresse, Op_D_8_Bit);
-- modification des flags
Flag := Registres.Lire_Simple (F);
Octet.Res_Bit (Flag, 1);
Octet.Res_Bit (Flag, 4);
if (Octet.Test_Bit (Op_G_8_Bit, 7)) then
Octet.Set_Bit (Flag, 7);
else
Octet.Res_Bit (Flag, 7);
end if;
for I in 0 .. 7 loop
if (Octet.Test_Bit (Op_G_8_Bit, I)) then
Nb_Bit_A_1 := Nb_Bit_A_1 + 1;
end if;
end loop;
if Nb_Bit_A_1 = 0 then
Octet.Set_Bit (Flag, 6);
else
Octet.Res_Bit (Flag, 6);
end if;
if ((Nb_Bit_A_1 mod 2) = 0) then
Octet.Set_Bit (Flag, 2);
else
Octet.Res_Bit (Flag, 2);
end if;
Registres.Ecrire_Simple (F, Flag);
when others =>
Alu_8_Bit.Fournir_Operande_1 (Op_G_8_Bit);
Resultat_8_Bit := Alu_8_Bit.Executer (Une_Instruction.Mnemo);
-- sauvegarde du resultat obtenu
if (Une_Instruction.Op_Gauche in A .. L) then
Registres.Ecrire_Simple
(Une_Instruction.Op_Gauche, Resultat_8_Bit);
else
Tache_Bus.Acces_Octet (Z80.Memory_Write,
Une_Adresse, Resultat_8_Bit);
end if;
end case;
end Decalage_Droite_Gauche;
------------------------------------------------------------------------
procedure Restart is -- rst
use Desassembleur;
use Z80_Defs;
use Z_Debug;
Valeur_Pc, Adresse_Pile, Adresse_Dest : Adresse.T_Adresse;
Msb_Valeur_Pc, Lsb_Valeur_Pc : Octet.T_Octet;
begin
Adresse_Dest := Mot.Construire (0, Num_Restart);
-- sauvegarde PC
Valeur_Pc := Registres.Lire_Double (Pc);
Msb_Valeur_Pc := Mot.Poids_Fort (Valeur_Pc);
Lsb_Valeur_Pc := Mot.Poids_Faible (Valeur_Pc);
Adresse_Pile := Registres.Lire_Double (Sp);
Adresse_Pile := Mot.Sub (Adresse_Pile, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Msb_Valeur_Pc);
Adresse_Pile := Mot.Sub (Adresse_Pile, 1);
Tache_Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Lsb_Valeur_Pc);
Registres.Ecrire_Double (Sp, Adresse_Pile);
-- modif du PC
Registres.Ecrire_Double (Pc, Adresse_Dest);
end Restart;
------------------------------------------------------------------------
procedure Afficher_Instruction (Instruc : Desassembleur.Instruction) is
begin
Text_Io.Put_Line ("");
Text_Io.Put (Desassembleur.Mnemonic'Image (Instruc.Mnemo));
Text_Io.Put (" ");
Text_Io.Put (Z80_Defs.Operande'Image (Instruc.Op_Gauche));
Text_Io.Put (" , ");
Text_Io.Put (Z80_Defs.Operande'Image (Instruc.Op_Droit));
Text_Io.Put (" ");
Mot.Afficher_Mot_Hexa (Instruc.Donnee);
Text_Io.Put_Line ("");
end Afficher_Instruction;
end Sequenceur;