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: 17307 (0x439b) 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 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; 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;