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: 53555 (0xd133) 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 Z80; with Z80_Defs; with Z80_Scr; with Erreur; package body Sequenceur is Err_Codeopint : constant Natural := 1; -- 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); Flag_Interrupt : Boolean := False; -- 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 Trait_Interuption; procedure Save_Pc; 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; Trait_Interuption; end Lancer; ---------------------------------------------------------------------- procedure Trait_Interuption is use Z80_Defs; use Desassembleur; Vector : Octet.T_Octet; Adresse_Dest, Adr_Vector : Adresse.T_Adresse; Msb, Lsb : Octet.T_Octet; begin if Z80.Iff_1 then if Flag_Interrupt then if Z80.Interrupt then Z80.Iff_1 := False; Z80.Iff_2 := False; Flag_Interrupt := False; Z80.Interrupt := False; Z80_Scr.Afficher_Ecran_Reg (Z80_Scr.Iff); Z80_Scr.Afficher_Ecran_Reg (Z80_Scr.Int); Bus.It_Ack (Vector); case Z80.Son_Mode is when 0 => Prologue; if Desassembleur.Traiter_Code (Vector) then Une_Instruction := Desassembleur. Instruction_Trouvee; if Une_Instruction.Mnemo = Rst then Recherche_Des_Operandes; Executer_Instruction; else Erreur.Detectee (Err_Codeopint); end if; else Erreur.Detectee (Err_Codeopint); end if; when 1 => Save_Pc; Adresse_Dest := Mot.Construire (0, 16#38#); Registres.Ecrire_Double (Pc, Adresse_Dest); when 2 => Save_Pc; Adr_Vector := Mot.Construire (Registres.Lire_Simple (I), Vector); Bus.Acces_Octet (Z80.Memory_Read, Adr_Vector, Lsb); Bus.Acces_Octet (Z80.Memory_Read, Adr_Vector + 1, Msb); Adresse_Dest := Mot.Construire (Msb, Lsb); Registres.Ecrire_Double (Pc, Adresse_Dest); end case; end if; else Flag_Interrupt := True; end if; else Flag_Interrupt := False; end if; end Trait_Interuption; procedure Save_Pc is use Z80_Defs; Valeur_Pc, Adresse_Pile : Adresse.T_Adresse; Msb_Valeur_Pc, Lsb_Valeur_Pc : Octet.T_Octet; begin 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); Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Msb_Valeur_Pc); Adresse_Pile := Mot.Sub (Adresse_Pile, 1); Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Lsb_Valeur_Pc); Registres.Ecrire_Double (Sp, Adresse_Pile); end Save_Pc; procedure Prologue is begin 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 Desassembleur; begin while not Trouvee loop 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; if Une_Instruction.Mnemo /= Halt then Registres.Ecrire_Double (Z80_Defs.Pc, Le_Pc); end if; --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 .. L_Prime | 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; 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 Bus.Acces_Octet (Z80.Io_Read, Une_Adresse, Un_Octet); elsif Op_Gauche_A_Determiner then 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 Bus.Acces_Octet (Z80.Io_Read, Une_Adresse, Un_Octet); elsif Op_Gauche_A_Determiner then 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 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 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 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 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 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 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 Bus.Acces_Octet (Z80.Memory_Read, Une_Adresse, Un_Octet); end if; when Nn_Indirect => Une_Adresse := Mot.Construire (Mot.Poids_Faible (Une_Instruction.Donnee), Mot.Poids_Fort (Une_Instruction.Donnee)); if Op_Gauche_A_Determiner then 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; 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 Bus.Acces_Octet (Z80.Memory_Read, Une_Adresse, Lsb); 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); Bus.Acces_Octet (Z80.Memory_Read, Une_Adresse, Lsb); 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; 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 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; 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); Bus.Acces_Octet (Z80.Memory_Read, Adresse_Pile, Lsb); Adresse_Pile := Mot.Add (Adresse_Pile, 1); 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; 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; 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 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; Z80_Scr.Afficher_Ecran_Reg (Z80_Scr.Iff); when Di => Z80.Iff_1 := False; Z80.Iff_2 := False; Z80_Scr.Afficher_Ecran_Reg (Z80_Scr.Iff); 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; 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); Bus.Acces_Octet (Z80.Memory_Write, Une_Adresse, Lsb_Reg_Temp); Une_Adresse := Mot.Add (Une_Adresse, 1); 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; Z80_Scr.Afficher_Ecran_Reg (Z80_Scr.Im); end Changement_Mode; ------------------------------------------------------------------------ procedure Proc_In is use Desassembleur; use Z80_Defs; begin case Une_Instruction.Op_Gauche is when A .. L => Registres.Ecrire_Simple (Une_Instruction.Op_Gauche, Op_D_8_Bit); when Hl_Indirect => 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; 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); Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Msb_Valeur_Pc); Adresse_Pile := Mot.Sub (Adresse_Pile, 1); 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; 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 => 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); Bus.Acces_Octet (Z80.Memory_Write, Une_Adresse, Lsb); Une_Adresse := Mot.Add (Une_Adresse, 1); 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; begin if Une_Instruction.Op_Droit = Hl_Indirect then Une_Adresse := Mot.Construire (0, Registres.Lire_Simple (C)); end if; 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; 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); Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Msb); Adresse_Pile := Mot.Sub (Adresse_Pile, 1); Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Lsb); Registres.Ecrire_Double (Sp, Adresse_Pile); else Bus.Acces_Octet (Z80.Memory_Read, Adresse_Pile, Lsb); Adresse_Pile := Mot.Add (Adresse_Pile, 1); 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; 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 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 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; 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); Bus.Acces_Octet (Z80.Memory_Write, Adresse_Pile, Msb_Valeur_Pc); Adresse_Pile := Mot.Sub (Adresse_Pile, 1); 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;