|
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: 24576 (0x6000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Bus, seg_02795e, seg_027d92, seg_027e67
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Z80, Z80_Defs, Memoire, Adresse, Octet, Erreur, Periph, Mot, Text_Io, Lex;
package body Bus is
-- CONSTANTES -----------------------------------------------------------
Taille_Bloc_Mem : constant Positive := 256;
Nb_De_Blocs : constant Natural := 256;
Nb_Max_Iomem : constant Natural := 300;
Err_Memnullreadacces : constant Natural := 10;
Err_Memnullwriteacces : constant Natural := 11;
Err_Memromwriteacces : constant Natural := 12;
Err_Ioport : constant Natural := 13;
Err_Iomem : constant Natural := 14;
Err_Configfilenotfound : constant Natural := 15;
Err_Configfile : constant Natural := 16;
-- TYPES -----------------------------------------------------------------
type T_Descripteur_Periph is
record
Vector : Octet.T_Octet;
It_Demandee : Boolean := False;
end record;
type T_Ioport is
record
Id_Periph : Periph.T_Periph_Number;
No_Reg : Natural := 0;
end record;
type T_Iomem is
record
Ad : Adresse.T_Adresse;
Id_Periph : Periph.T_Periph_Number;
No_Reg : Natural := 0;
end record;
type T_Mem is (Rien, Ram, Rom, Io_Periph);
subtype Num_Bloc is Natural range 0 .. (Nb_De_Blocs - 1);
type T_Descripteur_Memoire is
record
Bloc_Physique : Num_Bloc := 0;
Type_De_Mem : T_Mem := Rien;
end record;
task type T_Bus is
entry Acces_Octet (Quelle_Operation : Z80.T_Operation;
Ad : Adresse.T_Adresse;
Donnee : in out Octet.T_Octet);
entry Reset;
end T_Bus;
task type T_It is
entry It_From_Periph (Id_Periph : Periph.T_Periph_Number;
Vector : Octet.T_Octet);
entry It_Ack (Vector : out Octet.T_Octet);
entry Reset;
end T_It;
type Pt_Tache_Bus is access T_Bus;
type Pt_Tache_It is access T_It;
-- VARIABLES -------------------------------------------------------------
It_En_Trait : Boolean := False;
Id_Periph_It_En_Trait : Periph.T_Periph_Number;
Descr_Memoire : array (Num_Bloc) of T_Descripteur_Memoire;
Descr_Periph : array (Periph.T_Periph_Number) of T_Descripteur_Periph;
Ioport : array (0 .. 255) of T_Ioport;
Iomem : array (1 .. Nb_Max_Iomem) of T_Iomem;
Nb_Iomem : Natural := 0;
Tache_Bus : Pt_Tache_Bus;
Tache_It : Pt_Tache_It;
-- PROCEDURES avec vue exterieur----------------------------------
procedure Creer is
begin
Tache_Bus := new T_Bus;
Tache_It := new T_It;
end Creer;
------------------------------------
procedure Initialisation (Nom_De_Fichier : String) is
Fin : Boolean := False;
procedure Init_Memoire is
begin
for I in Num_Bloc loop
Descr_Memoire (I).Bloc_Physique := I;
Descr_Memoire (I).Type_De_Mem := Rien;
end loop;
for I in Ioport'Range loop
Ioport (I).Id_Periph := 0;
Ioport (I).No_Reg := 0;
end loop;
for I in 1 .. Nb_Iomem loop
Iomem (I).Id_Periph := 0;
Iomem (I).No_Reg := 0;
end loop;
Nb_Iomem := 0;
end Init_Memoire;
------------------------------------------------------
procedure Init_Bloc (Adr_Begin, Adr_End : Integer; Config : T_Mem) is
Bloc_Depart, Bloc_Fin : Num_Bloc := 0;
begin
Bloc_Depart := Adr_Begin / Taille_Bloc_Mem;
Bloc_Fin := Adr_End / Taille_Bloc_Mem;
for I in Bloc_Depart .. Bloc_Fin loop
Descr_Memoire (I).Type_De_Mem := Config;
end loop;
end Init_Bloc;
function Init_Blocs_Mem return Boolean is
Adr_Depart, Adr_Fin : Integer;
Config : T_Mem;
begin
if Lex.Getvalue = "RAM" then
Config := Ram;
else
Config := Rom;
end if;
Lex.Getnext;
if Lex."/=" (Lex.Gettoken, Lex.Number) then
return False;
end if;
Adr_Depart := Lex.Getvalue;
Lex.Getnext;
if Lex."/=" (Lex.Gettoken, Lex.Number) then
return False;
end if;
Adr_Fin := Lex.Getvalue;
Lex.Getnext;
Init_Bloc (Adr_Depart, Adr_Fin, Config);
return True;
end Init_Blocs_Mem;
------------------------------------------------------
function Periphe return Boolean is
Periph_Type : constant String := Lex.Getvalue;
It_Vector : Integer;
Basic_Address : Integer;
Memory_Mapped : Boolean := False;
It_Connected : Boolean := False;
Number_Of_Register : Natural := 0;
Id_Periph : Periph.T_Periph_Number;
begin
Lex.Getnext;
if Lex."/=" (Lex.Gettoken, Lex.Str) or else
(Lex.Getvalue /= "M" and Lex.Getvalue /= "P") then
return False;
end if;
if Lex.Getvalue = "M" then
Memory_Mapped := True;
end if;
Lex.Getnext;
if Lex."/=" (Lex.Gettoken, Lex.Number) then
return False;
end if;
Basic_Address := Lex.Getvalue;
Lex.Getnext;
if Lex."/=" (Lex.Gettoken, Lex.Str) or else
(Lex.Getvalue /= "C" and Lex.Getvalue /= "N") then
return False;
end if;
if Lex.Getvalue = "C" then
It_Connected := True;
end if;
Lex.Getnext;
if Lex."/=" (Lex.Gettoken, Lex.Number) then
return False;
end if;
It_Vector := Lex.Getvalue;
Lex.Getnext;
Periph.Init (Periph_Type, It_Vector, Basic_Address, Memory_Mapped,
It_Connected, Number_Of_Register, Id_Periph);
if Periph."/=" (Id_Periph, 0) then
if Memory_Mapped then
for I in 1 .. Number_Of_Register loop
Iomem (Nb_Iomem + 1).Ad := Basic_Address + I - 1;
Iomem (Nb_Iomem + 1).Id_Periph := Id_Periph;
Iomem (Nb_Iomem + 1).No_Reg := I;
Nb_Iomem := Nb_Iomem + 1;
end loop;
Init_Bloc (Basic_Address,
Basic_Address + Number_Of_Register, Io_Periph);
else
for I in 1 .. Number_Of_Register loop
Ioport (Basic_Address + I - 1).Id_Periph := Id_Periph;
Ioport (Basic_Address + I - 1).No_Reg := I;
end loop;
end if;
return True;
else
return False;
end if;
end Periphe;
------------------------------------------------------
begin
Periph.Kill;
Init_Memoire;
if Lex.Open (Nom_De_Fichier) then
Lex.Getnext;
while not Fin loop
case Lex.Gettoken is
when Lex.Number =>
Erreur.Detectee (Err_Configfile);
Fin := True;
when Lex.Str =>
if Lex.Getvalue = "ROM" or Lex.Getvalue = "RAM" then
Fin := not Init_Blocs_Mem;
else
Fin := not Periphe;
end if;
if Fin then
Erreur.Detectee (Err_Configfile);
end if;
when Lex.File_End =>
Fin := True;
when Lex.Unknown =>
Erreur.Detectee (Err_Configfile);
Fin := True;
end case;
end loop;
Lex.Close;
else
Erreur.Detectee (Err_Configfilenotfound);
end if;
end Initialisation;
------------------------------------
procedure Acces_Octet (Quelle_Operation : Z80.T_Operation;
Ad : Adresse.T_Adresse;
Donnee : in out Octet.T_Octet) is
begin
Tache_Bus.Acces_Octet (Quelle_Operation, Ad, Donnee);
end Acces_Octet;
------------------------------------
procedure It_From_Periph (Id_Periph : Periph.T_Periph_Number;
Vector : Octet.T_Octet) is
begin
Tache_It.It_From_Periph (Id_Periph, Vector);
end It_From_Periph;
-----------------------------------
procedure It_Ack (Vector : out Octet.T_Octet) is
begin
Tache_It.It_Ack (Vector);
end It_Ack;
------------------------------------
procedure Detruire is
begin
Periph.Kill;
abort Tache_Bus.all;
abort Tache_It.all;
end Detruire;
-------------------------------
procedure Reset is
begin
Tache_Bus.Reset;
Tache_It.Reset;
end Reset;
-- PROCEDURES POUR LECTURE ECRITURE MEMOIRE procedures internes----------
procedure Search_Periph (Ad : Adresse.T_Adresse;
Id_Periph : out Periph.T_Periph_Number;
No_Reg : out Natural) is
I : Natural := 1;
begin
while (Iomem (I).Ad /= Ad or Iomem (I).No_Reg = 0) and I < Nb_Iomem loop
I := I + 1;
end loop;
if Iomem (I).Ad /= Ad or Iomem (I).No_Reg = 0 then
No_Reg := 0;
else
Id_Periph := Iomem (I).Id_Periph;
No_Reg := Iomem (I).No_Reg;
end if;
end Search_Periph;
-----------------------------------------
procedure Decode_Adresse (Ad : in out Adresse.T_Adresse; Mem : out T_Mem) is
Bloc_Log, Bloc_Phy : Num_Bloc := 0;
Offset : Adresse.T_Adresse := 0;
begin
Bloc_Log := Ad / Taille_Bloc_Mem;
Bloc_Phy := Descr_Memoire (Bloc_Log).Bloc_Physique;
Mem := Descr_Memoire (Bloc_Phy).Type_De_Mem;
Offset := Ad mod Taille_Bloc_Mem;
Ad := Bloc_Phy * Taille_Bloc_Mem + Offset;
end Decode_Adresse;
---------------------------------
procedure Lecture_Ioport (No_Port : Octet.T_Octet;
Donnee : in out Octet.T_Octet) is
begin
if Ioport (No_Port).No_Reg = 0 then
--Erreur: Acces a un periph non implemente
Erreur.Detectee (Err_Ioport);
else
Donnee := Periph.Get_Register
(Ioport (No_Port).Id_Periph, Ioport (No_Port).No_Reg);
end if;
end Lecture_Ioport;
---------------------------------
procedure Ecriture_Ioport (No_Port : Octet.T_Octet;
Donnee : Octet.T_Octet) is
Id_Periph : Periph.T_Periph_Number;
No_Reg : Natural;
begin
if Ioport (No_Port).No_Reg = 0 then
--Erreur: Acces a un periph non implemente
Erreur.Detectee (Err_Ioport);
else
Periph.Put_Register (Ioport (No_Port).Id_Periph,
Ioport (No_Port).No_Reg, Donnee);
end if;
end Ecriture_Ioport;
------------------------------------
procedure Lecture_Iomem (Ad : Adresse.T_Adresse;
Donnee : in out Octet.T_Octet) is
Id_Periph : Periph.T_Periph_Number;
No_Reg : Natural;
begin
Search_Periph (Ad, Id_Periph, No_Reg);
if No_Reg = 0 then
--Erreur: Acces a un periph non mappe en memoire
Erreur.Detectee (Err_Iomem);
else
Donnee := Periph.Get_Register (Id_Periph, No_Reg);
end if;
end Lecture_Iomem;
---------------------------------
procedure Ecriture_Iomem (Ad : Adresse.T_Adresse; Donnee : Octet.T_Octet) is
Id_Periph : Periph.T_Periph_Number;
No_Reg : Natural;
begin
Search_Periph (Ad, Id_Periph, No_Reg);
if No_Reg = 0 then
--Erreur: Acces a un periph non mappe en memoire
Erreur.Detectee (Err_Iomem);
else
Periph.Put_Register (Id_Periph, No_Reg, Donnee);
end if;
end Ecriture_Iomem;
--------------------------------
procedure Lecture_Donnee (Ad : Adresse.T_Adresse;
Un_Octet : in out Octet.T_Octet) is
Ad_Donnee : Adresse.T_Adresse := Ad;
Mem : T_Mem := Rien;
begin
Decode_Adresse (Ad_Donnee, Mem);
case Mem is
when Ram | Rom =>
Memoire.Acces_Octet (Memoire.Lire, Ad_Donnee, Un_Octet);
when Rien =>
--Erreur: Lecture a un emplacement memoire non defini !!!
Erreur.Detectee (Err_Memnullreadacces);
Memoire.Acces_Octet (Memoire.Lire, Ad_Donnee, Un_Octet);
when Io_Periph =>
Lecture_Iomem (Ad_Donnee, Un_Octet);
end case;
end Lecture_Donnee;
-----------------------------------------------------------
procedure Ecriture_Donnee (Ad : Adresse.T_Adresse;
Donnee : Octet.T_Octet) is
Un_Octet : Octet.T_Octet := Donnee;
Ad_Donnee : Adresse.T_Adresse := Ad;
Mem : T_Mem := Rien;
begin
Decode_Adresse (Ad_Donnee, Mem);
case Mem is
when Ram =>
Memoire.Acces_Octet (Memoire.Ecrire, Ad_Donnee, Un_Octet);
when Rom =>
--Erreur: Ecriture en ROM !!!
Erreur.Detectee (Err_Memromwriteacces);
when Rien =>
--Erreur: Ecriture a un emplacement memoire non defini !!!
Erreur.Detectee (Err_Memnullwriteacces);
when Io_Periph =>
Ecriture_Iomem (Ad_Donnee, Un_Octet);
end case;
end Ecriture_Donnee;
-- TACHES ----------------------------------------------------------------
task body T_It is
Nb_It_Demandee : Integer := 0;
procedure Generate_It is
I : Periph.T_Periph_Number := Periph.T_Periph_Number'First;
use Periph;
begin
while not Descr_Periph (I).It_Demandee and
I < Periph.T_Periph_Number'Last loop
I := I + 1;
end loop;
if Descr_Periph (I).It_Demandee and then
Z80.Signaler (Z80_Defs.Int) then
It_En_Trait := True;
Id_Periph_It_En_Trait := I;
Nb_It_Demandee := Nb_It_Demandee - 1;
end if;
end Generate_It;
use Periph;
begin
while True loop
select
accept It_Ack (Vector : out Octet.T_Octet) do
Vector := Descr_Periph (Id_Periph_It_En_Trait).Vector;
It_En_Trait := False;
Descr_Periph (Id_Periph_It_En_Trait).It_Demandee := False;
end It_Ack;
or
accept It_From_Periph (Id_Periph : Periph.T_Periph_Number;
Vector : Octet.T_Octet) do
if not It_En_Trait or else
Id_Periph_It_En_Trait /= Id_Periph then
Descr_Periph (Id_Periph).It_Demandee := True;
Descr_Periph (Id_Periph).Vector := Vector;
Nb_It_Demandee := Nb_It_Demandee + 1;
end if;
end It_From_Periph;
if Nb_It_Demandee > 0 and then not It_En_Trait then
Generate_It;
end if;
or
accept Reset do
for I in Periph.T_Periph_Number loop
Descr_Periph (I).It_Demandee := False;
end loop;
It_En_Trait := False;
Nb_It_Demandee := 0;
end Reset;
--else
-- delay (Duration'Small);
--if Nb_It_Demandee > 0 and then not It_En_Trait then
-- Generate_It;
--end if;
end select;
end loop;
end T_It;
task body T_Bus is
begin
while True loop
select
accept Acces_Octet (Quelle_Operation : Z80.T_Operation;
Ad : Adresse.T_Adresse;
Donnee : in out Octet.T_Octet) do
case Quelle_Operation is
when Z80.Fetch | Z80.Memory_Read =>
Lecture_Donnee (Ad, Donnee);
when Z80.Memory_Write =>
Ecriture_Donnee (Ad, Donnee);
when Z80.Io_Read =>
Lecture_Ioport (Mot.Poids_Faible (Ad), Donnee);
when Z80.Io_Write =>
Ecriture_Ioport (Mot.Poids_Faible (Ad), Donnee);
end case;
end Acces_Octet;
or
accept Reset do
Periph.Reset;
end Reset;
end select;
end loop;
end T_Bus;
end Bus;
nblk1=17
nid=4
hdr6=28
[0x00] rec0=1d rec1=00 rec2=01 rec3=05a
[0x01] rec0=1d rec1=00 rec2=17 rec3=01a
[0x02] rec0=21 rec1=00 rec2=03 rec3=02e
[0x03] rec0=00 rec1=00 rec2=0b rec3=008
[0x04] rec0=1b rec1=00 rec2=13 rec3=020
[0x05] rec0=1d rec1=00 rec2=08 rec3=03c
[0x06] rec0=1a rec1=00 rec2=05 rec3=01e
[0x07] rec0=14 rec1=00 rec2=02 rec3=072
[0x08] rec0=1c rec1=00 rec2=0c rec3=016
[0x09] rec0=1c rec1=00 rec2=0a rec3=082
[0x0a] rec0=26 rec1=00 rec2=06 rec3=052
[0x0b] rec0=1c rec1=00 rec2=07 rec3=004
[0x0c] rec0=1c rec1=00 rec2=0d rec3=04a
[0x0d] rec0=1d rec1=00 rec2=12 rec3=022
[0x0e] rec0=18 rec1=00 rec2=0f rec3=056
[0x0f] rec0=1e rec1=00 rec2=14 rec3=01a
[0x10] rec0=18 rec1=00 rec2=15 rec3=02c
[0x11] rec0=16 rec1=00 rec2=11 rec3=024
[0x12] rec0=19 rec1=00 rec2=09 rec3=006
[0x13] rec0=06 rec1=00 rec2=0e rec3=000
[0x14] rec0=18 rec1=00 rec2=13 rec3=040
[0x15] rec0=19 rec1=00 rec2=17 rec3=006
[0x16] rec0=0a rec1=00 rec2=0e rec3=000
tail 0x21721bb7083ac6e68ec2d 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 16 00 09 80 01 3b 01 00 02 20 20 02 54 5f 41 ┆ ; T_A┆
0x16: 0000 00 10 00 84 80 1f 72 65 75 72 2e 44 65 74 65 63 ┆ reur.Detec┆
0x10: 0000 00 00 03 fc 80 09 20 22 4d 22 20 74 68 65 6e 09 ┆ "M" then ┆