|
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: 38912 (0x9800) Types: Ada Source Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Acia_Pack, seg_02769a, seg_027d91, seg_027e5c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000 └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« └─⟦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;
nblk1=25 nid=25 hdr6=46 [0x00] rec0=19 rec1=00 rec2=01 rec3=01c [0x01] rec0=02 rec1=00 rec2=1c rec3=01a [0x02] rec0=16 rec1=00 rec2=02 rec3=01c [0x03] rec0=1d rec1=00 rec2=03 rec3=004 [0x04] rec0=1c rec1=00 rec2=04 rec3=088 [0x05] rec0=1a rec1=00 rec2=05 rec3=04c [0x06] rec0=01 rec1=00 rec2=23 rec3=052 [0x07] rec0=1d rec1=00 rec2=06 rec3=014 [0x08] rec0=1b rec1=00 rec2=07 rec3=046 [0x09] rec0=05 rec1=00 rec2=1f rec3=054 [0x0a] rec0=1b rec1=00 rec2=1d rec3=01a [0x0b] rec0=02 rec1=00 rec2=08 rec3=030 [0x0c] rec0=15 rec1=00 rec2=09 rec3=04a [0x0d] rec0=16 rec1=00 rec2=0a rec3=02e [0x0e] rec0=15 rec1=00 rec2=0b rec3=040 [0x0f] rec0=17 rec1=00 rec2=0c rec3=04a [0x10] rec0=17 rec1=00 rec2=0d rec3=020 [0x11] rec0=19 rec1=00 rec2=0e rec3=030 [0x12] rec0=05 rec1=00 rec2=24 rec3=00c [0x13] rec0=14 rec1=00 rec2=10 rec3=068 [0x14] rec0=15 rec1=00 rec2=11 rec3=01c [0x15] rec0=15 rec1=00 rec2=1e rec3=004 [0x16] rec0=12 rec1=00 rec2=21 rec3=01e [0x17] rec0=15 rec1=00 rec2=12 rec3=030 [0x18] rec0=0f rec1=00 rec2=13 rec3=00a [0x19] rec0=13 rec1=00 rec2=14 rec3=05e [0x1a] rec0=12 rec1=00 rec2=22 rec3=006 [0x1b] rec0=10 rec1=00 rec2=16 rec3=062 [0x1c] rec0=18 rec1=00 rec2=15 rec3=020 [0x1d] rec0=17 rec1=00 rec2=17 rec3=026 [0x1e] rec0=15 rec1=00 rec2=18 rec3=052 [0x1f] rec0=13 rec1=00 rec2=19 rec3=068 [0x20] rec0=04 rec1=00 rec2=20 rec3=048 [0x21] rec0=18 rec1=00 rec2=1a rec3=008 [0x22] rec0=18 rec1=00 rec2=1b rec3=000 [0x23] rec0=18 rec1=00 rec2=1b rec3=001 [0x24] rec0=cc rec1=c4 rec2=42 rec3=400 tail 0x21721992a83ac45c157cb 0x42a00088462060003 Free Block Chain: 0x25: 0000 00 0f 01 9c 80 3c 20 20 20 20 20 20 20 20 20 20 ┆ < ┆ 0xf: 0000 00 00 03 fc 80 16 2e 53 74 61 74 75 73 2c 20 49 ┆ .Status, I┆