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: 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;