|
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: 21504 (0x5400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Simu, seg_02751d
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Ihm, Bus, Memoire, Z80, Erreur, Z80_Scr, Verif_Input, Text_Io;
with Acia_Pack, Ppi_Pack, Ptm_Pack, Point_D_Arret, Mot;
package body Simu is
Err_Badvalue : constant Natural := 2;
--TYPES---------
type T_Kind_Win is (Z80_Main, Acia, Ppi, Ptm, Mem, None);
type Win is
record
Kind_Win : T_Kind_Win := None;
No : Natural := 0;
end record;
--VARIABLES-----
Main_Wid : Ihm.Window_Id;
Fin : Boolean := False;
Tab_Win : array (1 .. Ihm.Window.Nb_Wid) of Win;
Win_Mem_Open : Boolean := False;
--PROCEDURES-------
procedure Pushbutton is
Wid : Ihm.Window_Id;
begin
if Ihm.Event.Get_Field (Main_Wid) = "Quit" then
Z80.Detruire;
Bus.Detruire;
Memoire.Detruire;
Fin := True;
elsif Ihm.Event.Get_Field (Main_Wid) = "Stop" then
Z80.Stopper;
elsif Ihm.Event.Get_Field (Main_Wid) = "Reset" then
Z80.Reset;
elsif Ihm.Event.Get_Field (Main_Wid) = "Go" then
Z80.Lancer;
elsif Ihm.Event.Get_Field (Main_Wid) = "Step" then
Z80.Pas_A_Pas;
elsif Ihm.Event.Get_Field (Main_Wid) = "Memory" then
if not Win_Mem_Open then
Win_Mem_Open := True;
Wid := Ihm.Window.Open ("MEM");
Memoire.Open_Window (Wid);
Tab_Win (Wid).Kind_Win := Mem;
Tab_Win (Wid).No := 0;
else
Ihm.Window.Put_Field (Main_Wid, "MW.BB.Message",
"MEMORY ERROR : Memory already opened");
end if;
elsif Ihm.Event.Get_Field (Main_Wid) = "DeleteAllBrk" then
Point_D_Arret.Reset;
else
Text_Io.Put_Line ("ERROR Pushbutton invalid");
end if;
end Pushbutton;
procedure Close_Periph_Window is
begin
for I in Tab_Win'Range loop
if Tab_Win (I).Kind_Win in Acia .. Ptm then
Ihm.Window.Close (I);
Tab_Win (I).Kind_Win := None;
end if;
end loop;
end Close_Periph_Window;
procedure Fieldenter is
Wid : Ihm.Window_Id;
Int : Integer;
begin
if Ihm.Event.Get_Field (Main_Wid) = "ConfigFile" then
Z80.Stopper;
Close_Periph_Window;
Bus.Initialisation (Ihm.Event.Get_Value (Main_Wid));
if not Erreur.Presente then
Ihm.Window.Put_Field (Main_Wid, "MW.BB.Message",
"Config File loaded");
end if;
elsif Ihm.Event.Get_Field (Main_Wid) = "LoadFile" then
Z80.Stopper;
Memoire.Charger_Fichier (Ihm.Event.Get_Value (Main_Wid));
if not Erreur.Presente then
Ihm.Window.Put_Field (Main_Wid, "MW.BB.Message",
"Executable File loaded");
end if;
elsif Ihm.Event.Get_Field (Main_Wid) = "ACIA_Number" then
if Verif_Input.Is_Digit (Ihm.Event.Get_Value (Main_Wid)) then
Int := Natural'Value (Ihm.Event.Get_Value (Main_Wid));
if Acia_Pack.Open_Window (Int) then
Wid := Ihm.Window.Open ("ACIA");
Acia_Pack.Open_Window (Int, Wid);
Tab_Win (Wid).Kind_Win := Acia;
Tab_Win (Wid).No := Int;
end if;
else
Erreur.Detectee (Err_Badvalue);
end if;
elsif Ihm.Event.Get_Field (Main_Wid) = "PPI_Number" then
if Verif_Input.Is_Digit (Ihm.Event.Get_Value (Main_Wid)) then
Int := Natural'Value (Ihm.Event.Get_Value (Main_Wid));
if Ppi_Pack.Open_Window (Int) then
Wid := Ihm.Window.Open ("PPI");
Ppi_Pack.Open_Window (Int, Wid);
Tab_Win (Wid).Kind_Win := Ppi;
Tab_Win (Wid).No := Int;
end if;
else
Erreur.Detectee (Err_Badvalue);
end if;
elsif Ihm.Event.Get_Field (Main_Wid) = "TIMER_Number" then
if Verif_Input.Is_Digit (Ihm.Event.Get_Value (Main_Wid)) then
Int := Natural'Value (Ihm.Event.Get_Value (Main_Wid));
if Ptm_Pack.Open_Window (Int) then
Wid := Ihm.Window.Open ("PTM");
Ptm_Pack.Open_Window (Int, Wid);
Tab_Win (Wid).Kind_Win := Ptm;
Tab_Win (Wid).No := Int;
end if;
else
Erreur.Detectee (Err_Badvalue);
end if;
elsif Ihm.Event.Get_Field (Main_Wid) = "AddBrk" then
Point_D_Arret.Set (Mot.Convert_String_Mot
(Ihm.Event.Get_Value (Main_Wid)));
elsif Ihm.Event.Get_Field (Main_Wid) = "DeleteBrk" then
Point_D_Arret.Remove (Mot.Convert_String_Mot
(Ihm.Event.Get_Value (Main_Wid)));
else
Z80_Scr.Lecture_Ecran_Reg (Ihm.Event.Get_Field (Main_Wid),
Ihm.Event.Get_Value (Main_Wid));
end if;
end Fieldenter;
procedure Lancer is
begin
Main_Wid := Ihm.Window.Open ("Z80");
Tab_Win (Main_Wid).Kind_Win := Z80_Main;
Tab_Win (Main_Wid).No := 1;
Memoire.Creer;
Bus.Creer;
Z80.Creer (Main_Wid);
Ihm.Window.Put_Field (Main_Wid, "MW.BB.Message",
"Simulateur Z80, Copyright BMS Avril 1993");
while not Fin loop
delay (Duration'Small);
Ihm.Xt.Process_Event;
for I in Tab_Win'Range loop
if not Ihm.Event.Empty (I) then
if Ihm.Event."=" (Ihm.Event.Get_Event (I),
Ihm.Event.Putfield) then
Ihm.Window.Display_Field (I, Ihm.Event.Get_Field (I),
Ihm.Event.Get_Value (I));
else
case Tab_Win (I).Kind_Win is
when Z80_Main =>
case Ihm.Event.Get_Event (I) is
when Ihm.Event.Pushbutton =>
Pushbutton;
when Ihm.Event.Fieldenter =>
Fieldenter;
when others =>
Text_Io.Put_Line
("*** Event received is unknown");
end case;
when Acia =>
Acia_Pack.Dispatch_Event
(Tab_Win (I).No, Ihm.Event.Get_Event (I),
Ihm.Event.Get_Field (I),
Ihm.Event.Get_Value (I));
if Ihm.Event."=" (Ihm.Event.Get_Event (I),
Ihm.Event.Pushbutton) and then
Ihm.Event.Get_Field (I) = "Cancel" then
Ihm.Window.Close (I);
Tab_Win (I).Kind_Win := None;
end if;
when Ppi =>
Ppi_Pack.Dispatch_Event
(Tab_Win (I).No, Ihm.Event.Get_Event (I),
Ihm.Event.Get_Field (I),
Ihm.Event.Get_Value (I));
if Ihm.Event."=" (Ihm.Event.Get_Event (I),
Ihm.Event.Pushbutton) and then
Ihm.Event.Get_Field (I) = "Cancel" then
Ihm.Window.Close (I);
Tab_Win (I).Kind_Win := None;
end if;
when Ptm =>
Ptm_Pack.Dispatch_Event (Tab_Win (I).No, Ihm.Event.Get_Event (I),
Ihm.Event.Get_Field (I),
Ihm.Event.Get_Value (I));
if Ihm.Event."=" (Ihm.Event.Get_Event (I),
Ihm.Event.Pushbutton) and then
Ihm.Event.Get_Field (I) = "Cancel" then
Ihm.Window.Close (I);
Tab_Win (I).Kind_Win := None;
end if;
when Mem =>
Memoire.Dispatch_Event
(Ihm.Event.Get_Event (I),
Ihm.Event.Get_Field (I),
Ihm.Event.Get_Value (I));
if Ihm.Event."=" (Ihm.Event.Get_Event (I),
Ihm.Event.Pushbutton) and then
Ihm.Event.Get_Field (I) = "Cancel" then
Ihm.Window.Close (I);
Tab_Win (I).Kind_Win := None;
Win_Mem_Open := False;
end if;
when None =>
Text_Io.Put_Line
("*** Event received apart to none window");
end case;
end if;
Ihm.Event.Next (I);
end if;
end loop;
end loop;
end Lancer;
end Simu;
nblk1=14
nid=11
hdr6=18
[0x00] rec0=22 rec1=00 rec2=01 rec3=052
[0x01] rec0=00 rec1=00 rec2=03 rec3=024
[0x02] rec0=1a rec1=00 rec2=02 rec3=036
[0x03] rec0=19 rec1=00 rec2=05 rec3=030
[0x04] rec0=13 rec1=00 rec2=10 rec3=03a
[0x05] rec0=15 rec1=00 rec2=13 rec3=074
[0x06] rec0=1b rec1=00 rec2=0a rec3=016
[0x07] rec0=07 rec1=00 rec2=06 rec3=04e
[0x08] rec0=10 rec1=00 rec2=09 rec3=058
[0x09] rec0=11 rec1=00 rec2=14 rec3=002
[0x0a] rec0=0f rec1=00 rec2=0f rec3=04e
[0x0b] rec0=12 rec1=00 rec2=0b rec3=000
[0x0c] rec0=12 rec1=00 rec2=10 rec3=000
[0x0d] rec0=1d rec1=00 rec2=07 rec3=002
[0x0e] rec0=17 rec1=00 rec2=0a rec3=06a
[0x0f] rec0=18 rec1=00 rec2=06 rec3=066
[0x10] rec0=19 rec1=00 rec2=10 rec3=030
[0x11] rec0=12 rec1=00 rec2=0f rec3=000
[0x12] rec0=12 rec1=00 rec2=0f rec3=000
[0x13] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21721074e83aa70a9f3af 0x42a00088462060003
Free Block Chain:
0x11: 0000 00 0e 01 8a 00 3e 20 20 20 20 20 20 20 20 20 20 ┆ > ┆
0xe: 0000 00 0d 00 04 80 01 20 01 02 03 04 05 06 49 68 6d ┆ Ihm┆
0xd: 0000 00 08 00 29 80 26 20 20 20 20 22 20 20 76 61 6c ┆ ) & " val┆
0x8: 0000 00 0c 03 fc 80 12 20 20 20 65 6e 64 20 46 69 65 ┆ end Fie┆
0xc: 0000 00 04 00 32 80 06 57 69 64 29 29 3b 06 00 10 20 ┆ 2 Wid)); ┆
0x4: 0000 00 07 00 04 80 01 20 01 49 68 6d 2e 57 69 6e 64 ┆ Ihm.Wind┆
0x7: 0000 00 12 01 1f 80 40 20 20 20 20 20 20 20 20 20 20 ┆ @ ┆
0x12: 0000 00 00 01 64 80 13 3d 20 22 50 75 73 68 42 75 74 ┆ d = "PushBut┆