|
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: 28420 (0x6f04)
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 Text_Io, Octet, Mot, Periph, Erreur,
Acia_Out, Ihm, Bus, System, Verif_Input;
use Periph;
package body Acia_Pack is
Rdr_Full : constant Octet.Num_Bit := 0;
Tdr_Empty : constant Octet.Num_Bit := 1;
Overrun : constant Octet.Num_Bit := 5;
Int_Request : constant Octet.Num_Bit := 7;
Cr0 : constant Octet.Num_Bit := 0;
Cr1 : constant Octet.Num_Bit := 1;
Cr2 : constant Octet.Num_Bit := 2;
Cr3 : constant Octet.Num_Bit := 3;
Cr4 : constant Octet.Num_Bit := 4;
Cr5 : constant Octet.Num_Bit := 5;
Cr6 : constant Octet.Num_Bit := 6;
Int_Enable : constant Octet.Num_Bit := 7;
Not_Available : constant Natural := 30;
Unknown_Id : constant Natural := 31;
Unknown_Event : constant Natural := 32;
Window_Already_Open : constant Natural := 33;
Bad_Value : constant Natural := 34;
Identifier_Field : constant String := "BB.Number";
Vector_Field : constant String := "BB.F1.Vector";
Address_Field : constant String := "BB.F1.Base";
Mem_Mapped_Field : constant String := "BB.F1.Memory";
It_Connect_Field : constant String := "BB.F1.It";
Status_Field : constant String := "BB.F2.Status";
Control_Field : constant String := "BB.F2.Control";
Transmit_Field : constant String := "BB.F2.Send";
Recept_Field : constant String := "BB.F2.Receive";
Close_Window : constant String := "Cancel";
Window_Name : constant String := "ACIA";
type Mode is (Put, Get);
task type Acia_Task is
entry Init (Periph_Id : Periph.T_Periph_Number;
It_Vector : Octet.T_Octet;
Basic_Address : Mot.T_Mot;
Memory_Mapped : Boolean;
It_Connected : Boolean;
Identifier : T_Acia_Number;
Number_Of_Register : out Natural);
entry Access_Register (Mode) (Register_Number : Natural;
Value : in out Octet.T_Octet);
entry Reset;
entry Ack_Transmit;
entry Kill;
entry Open_Window (Wid : Ihm.Window_Id);
entry Do_Event (What_Kind : Ihm.Event.Kind;
Field_Name : String;
Value : String);
end Acia_Task;
type P_Acia_Task is access Acia_Task;
type Object is
record
Task_Access : P_Acia_Task;
Window : Boolean := False;
end record;
type Object_Table is array (T_Acia_Number) of Object;
type Object_Manager is
record
Table : Object_Table;
Last : T_Acia_Number := T_Acia_Number'First;
end record;
type Acia_Config is
record
Identifier : T_Acia_Number;
Periph_Id : Periph.T_Periph_Number;
Vector : Octet.T_Octet;
Address : Mot.T_Mot;
Mem_Mapped : Boolean;
It_Connect : Boolean;
Status : Octet.T_Octet;
Control : Octet.T_Octet;
Transmit : Octet.T_Octet;
Recept : Octet.T_Octet;
Seven_Bits : Boolean;
Trans_Parity : Acia_Out.Parity;
Two_Stop : Boolean;
end record;
Acia_Manager : Object_Manager;
------------------------------ exports -------------------------------------
procedure Init (Periph_Id : T_Periph_Number;
It_Vector : Octet.T_Octet;
Basic_Address : Mot.T_Mot;
Memory_Mapped : Boolean;
It_Connected : Boolean;
Number_Of_Register : out Natural;
Identifier : out T_Acia_Number) is
begin
if Acia_Manager.Last >= T_Acia_Number'Last then
Erreur.Detectee (Not_Available);
Identifier := T_Acia_Number'First;
Number_Of_Register := 0;
else
Acia_Manager.Last := Acia_Manager.Last + 1;
Acia_Manager.Table (Acia_Manager.Last).Task_Access := new Acia_Task;
Acia_Manager.Table (Acia_Manager.Last).Task_Access.Init
(Periph_Id, It_Vector, Basic_Address, Memory_Mapped,
It_Connected, Acia_Manager.Last, Number_Of_Register);
Identifier := Acia_Manager.Last;
Acia_Out.Creer (Natural (Acia_Manager.Last));
end if;
end Init;
procedure Put_Register (Identifier : T_Acia_Number;
Register_Number : Natural;
Value : Octet.T_Octet) is
Register_Value : Octet.T_Octet;
begin
if Identifier > Acia_Manager.Last or
Identifier = T_Acia_Number'First then
Erreur.Detectee (Unknown_Id);
else
Register_Value := Value;
Acia_Manager.Table (Identifier).Task_Access.Access_Register (Put)
(Register_Number, Register_Value);
end if;
end Put_Register;
function Get_Register (Identifier : T_Acia_Number;
Register_Number : Natural) return Octet.T_Octet is
Register_Value : Octet.T_Octet := 0;
begin
if Identifier > Acia_Manager.Last or
Identifier = T_Acia_Number'First then
Erreur.Detectee (Unknown_Id);
else
Acia_Manager.Table (Identifier).Task_Access.Access_Register (Get)
(Register_Number, Register_Value);
end if;
return Register_Value;
end Get_Register;
procedure Reset (Identifier : T_Acia_Number) is
begin
if Identifier > Acia_Manager.Last or
Identifier = T_Acia_Number'First then
Erreur.Detectee (Unknown_Id);
else
Acia_Manager.Table (Identifier).Task_Access.Reset;
end if;
end Reset;
procedure Ack_Transmit (Identifier : Natural) is
Identifier1 : T_Acia_Number;
begin
Identifier1 := T_Acia_Number (Identifier);
if Identifier1 > Acia_Manager.Last or
Identifier1 = T_Acia_Number'First then
Erreur.Detectee (Unknown_Id);
else
Acia_Manager.Table (Identifier1).Task_Access.Ack_Transmit;
end if;
end Ack_Transmit;
procedure Receive (Value : Octet.T_Octet; Identifier : Natural) is
Identifier1 : T_Acia_Number;
Control_Value : Octet.T_Octet;
begin
Identifier1 := T_Acia_Number (Identifier);
Control_Value := Value;
if Identifier1 > Acia_Manager.Last or
Identifier1 = T_Acia_Number'First then
Erreur.Detectee (Unknown_Id);
else
Acia_Manager.Table (Identifier1).Task_Access.Access_Register (Put)
(3, Control_Value);
end if;
end Receive;
procedure Kill is
begin
for I in 1 .. Acia_Manager.Last loop
Acia_Out.Detruire (Natural (I));
Acia_Manager.Table (I).Window := False;
Acia_Manager.Table (I).Task_Access.Kill;
end loop;
Acia_Manager.Last := T_Acia_Number'First;
end Kill;
function Open_Window (Identifier : Natural) return Boolean is
Id : T_Acia_Number;
begin
Id := T_Acia_Number (Identifier);
if Id > Acia_Manager.Last or Id = T_Acia_Number'First then
Erreur.Detectee (Unknown_Id);
return False;
elsif Acia_Manager.Table (Id).Window then
Erreur.Detectee (Window_Already_Open);
return False;
else
return True;
end if;
end Open_Window;
procedure Open_Window (Identifier : Natural; Window_Id : Ihm.Window_Id) is
Id : T_Acia_Number;
begin
Id := T_Acia_Number (Identifier);
Acia_Manager.Table (Id).Window := True;
Acia_Manager.Table (Id).Task_Access.Open_Window (Window_Id);
end Open_Window;
procedure Dispatch_Event (Identifier : Natural;
What_Kind : Ihm.Event.Kind;
Field_Name : String;
Value : String) is
Id : T_Acia_Number;
begin
Id := T_Acia_Number (Identifier);
if Id > Acia_Manager.Last or Id = T_Acia_Number'First then
Erreur.Detectee (Unknown_Id);
else
if Ihm.Event."=" (What_Kind, Ihm.Event.Pushbutton) and
Field_Name = Close_Window then
Acia_Manager.Table (Id).Window := False;
end if;
Acia_Manager.Table (Id).Task_Access.Do_Event
(What_Kind, Field_Name, Value);
end if;
end Dispatch_Event;
------------------------------ internals ------------------------------------
procedure Write_Window (Configuration : Acia_Config;
Window_Id : Ihm.Window_Id;
Window_Enable : Boolean;
Identifier_Show, Vector_Show, Address_Show,
Mem_Mapped_Show, It_Connect_Show, Status_Show,
Control_Show, Transmit_Show, Recept_Show :
Boolean := False) is
begin
if Window_Enable then
if Identifier_Show then
Ihm.Window.Put_Field
(Window_Id, Identifier_Field,
T_Acia_Number'Image (Configuration.Identifier));
end if;
if Vector_Show then
Ihm.Window.Put_Field (Window_Id, Vector_Field,
Octet.Convert_Octet_String
(Configuration.Vector));
end if;
if Address_Show then
Ihm.Window.Put_Field (Window_Id, Address_Field,
Mot.Convert_Mot_String
(Configuration.Address));
end if;
if Mem_Mapped_Show then
if Configuration.Mem_Mapped then
Ihm.Window.Put_Field (Window_Id, Mem_Mapped_Field, " On");
else
Ihm.Window.Put_Field (Window_Id, Mem_Mapped_Field, "Off");
end if;
end if;
if It_Connect_Show then
if Configuration.It_Connect then
Ihm.Window.Put_Field (Window_Id, It_Connect_Field, " On");
else
Ihm.Window.Put_Field (Window_Id, It_Connect_Field, "Off");
end if;
end if;
if Status_Show then
Ihm.Window.Put_Field (Window_Id, Status_Field,
Octet.Convert_Binaire_String
(Configuration.Status));
end if;
if Control_Show then
Ihm.Window.Put_Field (Window_Id, Control_Field,
Octet.Convert_Binaire_String
(Configuration.Control));
end if;
if Transmit_Show then
Ihm.Window.Put_Field (Window_Id, Transmit_Field,
Octet.Convert_Octet_String
(Configuration.Transmit));
end if;
if Recept_Show then
Ihm.Window.Put_Field (Window_Id, Recept_Field,
Octet.Convert_Octet_String
(Configuration.Recept));
end if;
end if;
end Write_Window;
procedure Reset_Acia (Configuration : in out Acia_Config;
Window_Id : Ihm.Window_Id;
Window_Enable : Boolean) is
begin
Configuration.Status := 2;
Configuration.Control := 0;
Configuration.Transmit := 0;
Configuration.Recept := 0;
Configuration.Seven_Bits := True;
Configuration.Trans_Parity := Acia_Out.Even;
Configuration.Two_Stop := True;
Write_Window (Configuration, Window_Id, Window_Enable,
Identifier_Show => True,
Vector_Show => True,
Address_Show => True,
Mem_Mapped_Show => True,
It_Connect_Show => True,
Status_Show => True,
Control_Show => True,
Transmit_Show => True,
Recept_Show => True);
end Reset_Acia;
procedure Display (Configuration : Acia_Config) is
use Text_Io;
Carac1, Carac2 : Character;
begin
Put_Line ("===================================================");
Put_Line ("ACIA " & T_Acia_Number'Image (Configuration.Identifier));
Put (" V:");
Octet.Afficher_Octet_Binaire (Configuration.Vector);
Put (" ADR: ");
Mot.Afficher_Mot_Hexa (Configuration.Address);
Put (" MAP:" & Boolean'Image (Configuration.Mem_Mapped));
Put (" ITC:" & Boolean'Image (Configuration.It_Connect));
New_Line;
Put ("SR:");
Octet.Afficher_Octet_Binaire (Configuration.Status);
Put (" CR:");
Octet.Afficher_Octet_Binaire (Configuration.Control);
New_Line;
Put ("TDR:");
Octet.Afficher_Octet_Binaire (Configuration.Transmit);
Put (" RDR:");
Octet.Afficher_Octet_Binaire (Configuration.Recept);
New_Line;
Put ("7 bits:" & Boolean'Image (Configuration.Seven_Bits));
Put (" Parite:" & Acia_Out.Parity'Image (Configuration.Trans_Parity));
Put (" 2 stops:" & Boolean'Image (Configuration.Two_Stop));
New_Line;
end Display;
procedure Change_Configuration (Configuration : in out Acia_Config;
Window_Id : Ihm.Window_Id;
Window_Enable : Boolean) is
use Octet;
Transmit_Conf : T_Octet;
Mask : T_Octet := 28;
begin
if Test_Bit (Configuration.Control, Cr0) and
Test_Bit (Configuration.Control, Cr1) then
Reset_Acia (Configuration, Window_Id, Window_Enable);
else
Transmit_Conf := "and" (Configuration.Control, Mask);
case Transmit_Conf is
when 0 =>
Configuration.Seven_Bits := True;
Configuration.Trans_Parity := Acia_Out.Even;
Configuration.Two_Stop := True;
when 4 =>
Configuration.Seven_Bits := True;
Configuration.Trans_Parity := Acia_Out.Odd;
Configuration.Two_Stop := True;
when 8 =>
Configuration.Seven_Bits := True;
Configuration.Trans_Parity := Acia_Out.Even;
Configuration.Two_Stop := False;
when 12 =>
Configuration.Seven_Bits := True;
Configuration.Trans_Parity := Acia_Out.Odd;
Configuration.Two_Stop := False;
when 16 =>
Configuration.Seven_Bits := False;
Configuration.Trans_Parity := Acia_Out.None;
Configuration.Two_Stop := True;
when 20 =>
Configuration.Seven_Bits := False;
Configuration.Trans_Parity := Acia_Out.None;
Configuration.Two_Stop := False;
when 24 =>
Configuration.Seven_Bits := False;
Configuration.Trans_Parity := Acia_Out.Even;
Configuration.Two_Stop := False;
when 28 =>
Configuration.Seven_Bits := False;
Configuration.Trans_Parity := Acia_Out.Odd;
Configuration.Two_Stop := False;
when others =>
null;
end case;
if Configuration.It_Connect and
Test_Bit (Configuration.Status, Tdr_Empty) and
Test_Bit (Configuration.Control, Cr5) and
not Test_Bit (Configuration.Control, Cr6) then
Set_Bit (Configuration.Status, Int_Request);
Bus.It_From_Periph (Configuration.Periph_Id,
Configuration.Vector);
end if;
Write_Window (Configuration, Window_Id, Window_Enable,
Control_Show => True,
Status_Show => True);
end if;
end Change_Configuration;
procedure Do_Int (Configuration : in out Acia_Config;
Direction : Mode;
Window_Id : Ihm.Window_Id;
Window_Enable : Boolean) is
begin
if Configuration.It_Connect then
if Direction = Get and Octet.Test_Bit
(Configuration.Control, Int_Enable) and
not Octet.Test_Bit (Configuration.Status, Overrun) then
Octet.Set_Bit (Configuration.Status, Int_Request);
Write_Window (Configuration, Window_Id, Window_Enable,
Status_Show => True);
if Configuration.It_Connect then
Bus.It_From_Periph (Configuration.Periph_Id,
Configuration.Vector);
end if;
elsif Direction = Put then
if Octet.Test_Bit (Configuration.Control, Cr5) and
not Octet.Test_Bit (Configuration.Control, Cr6) then
Octet.Set_Bit (Configuration.Status, Int_Request);
Write_Window (Configuration, Window_Id, Window_Enable,
Status_Show => True);
if Configuration.It_Connect then
Bus.It_From_Periph (Configuration.Periph_Id,
Configuration.Vector);
end if;
end if;
end if;
end if;
end Do_Int;
procedure Transmission (Configuration : in out Acia_Config;
Window_Id : Ihm.Window_Id;
Window_Enable : Boolean) is
begin
Octet.Res_Bit (Configuration.Status, Tdr_Empty);
Octet.Res_Bit (Configuration.Status, Int_Request);
Write_Window (Configuration, Window_Id, Window_Enable,
Status_Show => True,
Transmit_Show => True);
Acia_Out.Transmit_Byte (Configuration.Transmit,
Natural (Configuration.Identifier),
Configuration.Seven_Bits,
Configuration.Trans_Parity,
Configuration.Two_Stop);
Octet.Set_Bit (Configuration.Status, Tdr_Empty);
Do_Int (Configuration, Put, Window_Id, Window_Enable);
Write_Window (Configuration, Window_Id, Window_Enable,
Status_Show => True);
end Transmission;
procedure Do_Event_Window (Configuration : in out Acia_Config;
Window_Id : Ihm.Window_Id;
Window_Enable : in out Boolean;
What_Kind : Ihm.Event.Kind;
Field_Name : String;
Str_Value : String) is
Value : Octet.T_Octet;
begin
case What_Kind is
when Ihm.Event.Pushbutton =>
if Field_Name = Close_Window then
Window_Enable := False;
end if;
when Ihm.Event.Fieldenter =>
if Field_Name = Control_Field then
if Verif_Input.Is_Binary_Byte_Value (Str_Value) then
Configuration.Control :=
Octet.Convert_String_Binaire (Str_Value);
Change_Configuration
(Configuration, Window_Id, Window_Enable);
else
Erreur.Detectee (Bad_Value);
Write_Window (Configuration, Window_Id, Window_Enable,
Control_Show => True);
end if;
end if;
if Field_Name = Status_Field then
if Verif_Input.Is_Binary_Byte_Value (Str_Value) then
Value := Octet.Convert_String_Binaire (Str_Value);
if Octet.Test_Bit (Value, Tdr_Empty) then
Octet.Set_Bit (Configuration.Status, Tdr_Empty);
Write_Window (Configuration, Window_Id,
Window_Enable,
Status_Show => True);
Do_Int (Configuration, Put,
Window_Id, Window_Enable);
else
Octet.Res_Bit (Configuration.Status, Tdr_Empty);
Write_Window (Configuration, Window_Id,
Window_Enable,
Status_Show => True);
end if;
else
Erreur.Detectee (Bad_Value);
Write_Window (Configuration, Window_Id, Window_Enable,
Status_Show => True);
end if;
end if;
if Field_Name = Recept_Field then
if Verif_Input.Is_Hexadecimal_Byte_Value (Str_Value) then
Value := Octet.Convert_String_Octet (Str_Value);
if Octet.Test_Bit (Configuration.Status, Rdr_Full) then
Octet.Set_Bit (Configuration.Status, Overrun);
else
Configuration.Recept := Value;
Octet.Set_Bit (Configuration.Status, Rdr_Full);
end if;
Do_Int (Configuration, Get, Window_Id, Window_Enable);
Write_Window (Configuration, Window_Id, Window_Enable,
Status_Show => True,
Recept_Show => True);
else
Erreur.Detectee (Bad_Value);
Write_Window (Configuration, Window_Id, Window_Enable,
Recept_Show => True);
end if;
end if;
when others =>
Erreur.Detectee (Unknown_Event);
end case;
end Do_Event_Window;
task body Acia_Task is
Configuration : Acia_Config;
Register_Type : Natural;
Window_Enable : Boolean := False;
Window_Id : Ihm.Window_Id;
begin
select
accept Init (Periph_Id : Periph.T_Periph_Number;
It_Vector : Octet.T_Octet;
Basic_Address : Mot.T_Mot;
Memory_Mapped : Boolean;
It_Connected : Boolean;
Identifier : T_Acia_Number;
Number_Of_Register : out Natural) do
Number_Of_Register := 2;
Configuration.Vector := It_Vector;
Configuration.Address := Basic_Address;
Configuration.Mem_Mapped := Memory_Mapped;
Configuration.It_Connect := It_Connected;
Configuration.Identifier := Identifier;
Configuration.Periph_Id := Periph_Id;
end Init;
Reset_Acia (Configuration, Window_Id, Window_Enable);
or
terminate;
end select;
loop
select
accept Reset do
Reset_Acia (Configuration, Window_Id, Window_Enable);
end Reset;
or
accept Access_Register (Put) (Register_Number : Natural;
Value : in out Octet.T_Octet) do
Register_Type := Register_Number;
case Register_Type is
when 1 =>
Configuration.Control := Value;
when 2 =>
Configuration.Transmit := Value;
when 3 =>
if Octet.Test_Bit
(Configuration.Status, Rdr_Full) then
Octet.Set_Bit (Configuration.Status, Overrun);
else
Configuration.Recept := Value;
Octet.Set_Bit (Configuration.Status, Rdr_Full);
end if;
when others =>
null;
end case;
null;
end Access_Register;
case Register_Type is
when 1 =>
Change_Configuration
(Configuration, Window_Id, Window_Enable);
when 2 =>
Transmission (Configuration, Window_Id, Window_Enable);
when 3 =>
Do_Int (Configuration, Get, Window_Id, Window_Enable);
Write_Window (Configuration, Window_Id, Window_Enable,
Status_Show => True,
Recept_Show => True);
when others =>
null;
end case;
or
accept Access_Register (Get) (Register_Number : Natural;
Value : in out Octet.T_Octet) do
Register_Type := Register_Number;
case Register_Type is
when 1 =>
Value := Configuration.Status;
when 2 =>
Value := Configuration.Recept;
Octet.Res_Bit (Configuration.Status, Rdr_Full);
Octet.Res_Bit (Configuration.Status, Overrun);
Octet.Res_Bit (Configuration.Status, Int_Request);
when others =>
null;
end case;
end Access_Register;
if Register_Type = 2 then
Write_Window (Configuration, Window_Id, Window_Enable,
Status_Show => True);
end if;
or
accept Ack_Transmit do
Octet.Set_Bit (Configuration.Status, Tdr_Empty);
end Ack_Transmit;
Do_Int (Configuration, Put, Window_Id, Window_Enable);
or
accept Kill;
exit;
or
accept Open_Window (Wid : Ihm.Window_Id) do
Window_Id := Wid;
Window_Enable := True;
end Open_Window;
Write_Window (Configuration, Window_Id, Window_Enable,
Identifier_Show => True,
Vector_Show => True,
Address_Show => True,
Mem_Mapped_Show => True,
It_Connect_Show => True,
Status_Show => True,
Control_Show => True,
Transmit_Show => True,
Recept_Show => True);
or
accept Do_Event (What_Kind : Ihm.Event.Kind;
Field_Name : String;
Value : String) do
if Window_Enable then
Do_Event_Window (Configuration, Window_Id,
Window_Enable, What_Kind,
Field_Name, Value);
end if;
end Do_Event;
or
terminate;
end select;
end loop;
end Acia_Task;
end Acia_Pack;