|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Alu_16_Bit, seg_00f4ce
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
nblk1=b
nid=9
hdr6=e
[0x00] rec0=2c rec1=00 rec2=01 rec3=028
[0x01] rec0=27 rec1=00 rec2=07 rec3=01e
[0x02] rec0=23 rec1=00 rec2=02 rec3=030
[0x03] rec0=26 rec1=00 rec2=06 rec3=008
[0x04] rec0=00 rec1=00 rec2=03 rec3=028
[0x05] rec0=29 rec1=00 rec2=05 rec3=064
[0x06] rec0=17 rec1=00 rec2=0a rec3=000
[0x07] rec0=28 rec1=00 rec2=02 rec3=032
[0x08] rec0=26 rec1=00 rec2=07 rec3=01e
[0x09] rec0=13 rec1=00 rec2=0a rec3=001
[0x0a] rec0=b9 rec1=70 rec2=00 rec3=000
tail 0x2150b5612822b4fde2a77 0x42a00088462060003
Free Block Chain:
0x9: 0000 00 04 03 f9 80 3b 74 69 6f 6e 20 45 78 65 63 75 ┆ ;tion Execu┆
0x4: 0000 00 0b 03 fc 80 01 65 01 00 09 20 20 20 20 62 65 ┆ e be┆
0xb: 0000 00 08 01 21 80 17 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ┆ ! ----------┆
0x8: 0000 00 00 01 1b 80 23 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ┆ #----------┆