|
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 - metrics - download
Length: 22528 (0x5800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Clone, package body Mod101, seg_0503f1
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with My_Functions;
with Simple_Io;
with Defined_Type;
with Vme;
with System;
-- **********************************
-- **** Instanced object : VSIP ****
-- **********************************
package body Clone is
Base_Address_Vsip : System.Address;
Plugged_Module : array (1 .. 4) of Defined_Type.Module_Vsip;
-- **************************************************
-- **** Internal procedure : Vsip register setup ****
-- **************************************************
procedure Initialize (Mask_Register1 : in Defined_Type.Octet) is
Register_1 : Defined_Type.Octet;
Register_2 : Defined_Type.Octet;
Address_Register_1 : constant System.Address :=
System."+" (Base_Address_Vsip, 1);
Address_Register_2 : constant System.Address :=
System."+" (Base_Address_Vsip, 3);
for Register_1 use at Address_Register_1;
for Register_2 use at Address_Register_2;
begin
Register_1 := Mask_Register1; -- module initializing
Register_2 := 0;
end Initialize;
-- ********************
-- **** Vsip setup ****
-- ********************
procedure Setup is
Vsip_Mask_Register1 : Defined_Type.Octet;
Index : My_Functions.Data;
use Defined_Type;
begin
-- **** Vsip Initialization **** --
Plugged_Module (1) := Scim_0;
Plugged_Module (2) := Scim_1;
Plugged_Module (3) := Scim_2;
Plugged_Module (4) := Scim_3;
Vsip_Mask_Register1 := 0;
-- search the good mask for register 1 of Vsip --
Index := My_Functions.Data'First;
for I in Plugged_Module'Range loop
if Defined_Type."/=" (Plugged_Module (I), No_Module) then
Vsip_Mask_Register1 := My_Functions.Set_Bit
(Vsip_Mask_Register1, Index);
Index := My_Functions.Data'Succ (Index);
end if;
end loop;
-- search the finish Vsip address --
Base_Address_Vsip := System."+"
(Base_Address, Vme.Addressing (Vme_Position));
Initialize (Vsip_Mask_Register1);
end Setup;
-- **************************************
-- **** return configuration of Vsip ****
-- **************************************
function Status (Register : Integer; Number : Positive)
return Defined_Type.Octet is
Register_1 : Defined_Type.Octet;
Register_2 : Defined_Type.Octet;
Address_Register_1 : constant System.Address :=
System."+" (Base_Address_Vsip, 1);
Address_Register_2 : constant System.Address :=
System."+" (Base_Address_Vsip, 3);
for Register_1 use at Address_Register_1;
for Register_2 use at Address_Register_2;
begin
if Number > 2 then
raise Default_Reference_Register;
return 0;
if Number = 1 then
return Register_1;
else
return Register_2;
end if;
end if;
end Status;
-- ************************************
-- **** instancied object : MOD101 ****
-- ************************************
package body Mod101 is
Base_Address_Mod101 : System.Address;
Base_Address_Mod101_1 : System.Address;
Protection : Boolean := False;
type Fonction is (Input, Output, Other);
type Pin is
record
Groupe_Number : Group := No_Group;
Signal_Title : My_Functions.Data;
Pin_Function : Fonction := Other;
end record;
Connector : array (1 .. 50) of Pin;
Pointer_Group_0 : array (1 .. 8) of Pin_No;
Pointer_Group_1 : array (1 .. 8) of Pin_No;
Pointer_Group_2 : array (1 .. 8) of Pin_No;
Pointer_Group_3 : array (1 .. 8) of Pin_No;
Pointer_Group_4 : array (1 .. 8) of Pin_No;
use My_Functions;
-- **************************************
-- **** configure the instanced Vsip ****
-- **************************************
procedure Setup is
begin
--- configure address board Mod101 ---
Base_Address_Mod101 :=
System."+" (Base_Address_Module, Vme.Addressing (Vme_Position));
Base_Address_Mod101_1 := System."+" (Base_Address_Mod101, 1);
for I in Pointer_Group_0'Range loop
Pointer_Group_0 (I) := (I + 2);
end loop;
for I in Pointer_Group_1'Range loop
Pointer_Group_1 (I) := (I + 12);
end loop;
for I in Pointer_Group_2'Range loop
Pointer_Group_2 (I) := (I + 22);
end loop;
for I in Pointer_Group_3'Range loop
Pointer_Group_3 (I) := (I + 32);
end loop;
for I in 4 .. Pointer_Group_4'Last loop
Pointer_Group_4 (I) := (I + 38);
end loop;
Pointer_Group_4 (1) := 12;
Pointer_Group_4 (2) := 22;
Pointer_Group_4 (3) := 32;
Initialize_Protection;
end Setup;
-- **********************************************
-- **** Have a control of the pin Type until ****
-- **** use it like a output !!! ****
-- **********************************************
procedure Protection_On is
begin
Protection := True;
end Protection_On;
-- **********************************************
-- **** Not Have a control of the pin Type ****
-- **** until use it like a output !! ****
-- **********************************************
procedure Protection_Off is
begin
Protection := False;
end Protection_Off;
procedure Initialize_Protection is
Tampon : Data;
begin
Tampon := Data'First;
for Index in Pointer_Group_0'Range loop
Connector (Pointer_Group_0 (Index)) := (Group0, Tampon, Input);
if Tampon /= Data'Last then
Tampon := Data'Succ (Tampon);
end if;
end loop;
Tampon := Data'First;
for Index in Pointer_Group_1'Range loop
Connector (Pointer_Group_1 (Index)) := (Group1, Tampon, Input);
if Tampon /= Data'Last then
Tampon := Data'Succ (Tampon);
end if;
end loop;
Tampon := Data'First;
for Index in Pointer_Group_2'Range loop
Connector (Pointer_Group_2 (Index)) := (Group2, Tampon, Input);
if Tampon /= Data'Last then
Tampon := Data'Succ (Tampon);
end if;
end loop;
Tampon := Data'First;
for Index in Pointer_Group_3'Range loop
Connector (Pointer_Group_3 (Index)) := (Group3, Tampon, Input);
if Tampon /= Data'Last then
Tampon := Data'Succ (Tampon);
end if;
end loop;
Tampon := Data'First;
for Index in Pointer_Group_4'Range loop
Connector (Pointer_Group_4 (Index)) := (Group4, Tampon, Input);
if Tampon /= Data'Last then
Tampon := Data'Succ (Tampon);
end if;
end loop;
end Initialize_Protection;
function Is_Protection_On return Boolean is
begin
return Protection;
end Is_Protection_On;
procedure Set_Input_Pin (Pin : in Pin_No) is
begin
if (Connector (Pin).Pin_Function /= Other) then
Connector (Pin).Pin_Function := Input;
else
raise Pin_Error;
end if;
end Set_Input_Pin;
procedure Set_Output_Pin (Pin : in Pin_No) is
begin
if (Connector (Pin).Pin_Function /= Other) then
Connector (Pin).Pin_Function := Output;
else
raise Pin_Error;
end if;
end Set_Output_Pin;
function Is_Pin_Output (Pin : Pin_No) return Boolean is
begin
return (Connector (Pin).Pin_Function = Output);
end Is_Pin_Output;
procedure Led_On is
Pointer_1 : Defined_Type.Octet;
for Pointer_1 use at Base_Address_Mod101;
begin
Pointer_1 := 16#81#;
end Led_On;
procedure Led_Off is
Pointer_1 : Defined_Type.Octet;
for Pointer_1 use at Base_Address_Mod101;
begin
Pointer_1 := 16#80#;
end Led_Off;
function Is_Led_On return Boolean is
begin
return False;
end Is_Led_On;
function Read_Pin (Pin : Pin_No) return Boolean is
Value_Group : Defined_Type.Octet;
Pin_Type : Data;
begin
if (Connector (Pin).Pin_Function /= Other) then
Value_Group := Read_Group (Gp =>
(Connector (Pin).Groupe_Number));
return My_Functions.Test_Bit (Value_Group,
Connector (Pin).Signal_Title);
else
raise Pin_Error;
end if;
end Read_Pin;
function Read_Group (Gp : Group) return Defined_Type.Octet is Pointer_1 : Defined_Type.Octet;
for Pointer_1 use at Base_Address_Mod101;
Pointer_2 : Defined_Type.Octet;
for Pointer_2 use at Base_Address_Mod101_1;
begin
if Gp = No_Group then
raise Group_Error;
else
Pointer_1 := Group'Pos (Gp);
return Pointer_2;
end if;
end Read_Group;
-- *******************************************
-- ************ internal procedure *********
-- *******************************************
procedure Write (To_Group : Group; Value_Gp : Defined_Type.Octet) is
Pointer_1 : Defined_Type.Octet;
for Pointer_1 use at Base_Address_Mod101;
Pointer_2 : Defined_Type.Octet;
for Pointer_2 use at Base_Address_Mod101_1;
begin
Pointer_1 := Group'Pos (To_Group);
Pointer_2 := Value_Gp;
-- enable for group --
Pointer_1 := 16#90#; -- output enable --
case To_Group is
when No_Group =>
raise Group_Error;
when Group0 =>
Pointer_2 := 1;
when Group1 =>
Pointer_2 := 2;
when Group2 =>
Pointer_2 := 4;
when Group3 =>
Pointer_2 := 8;
when Group4 =>
Pointer_2 := 16;
end case;
end Write;
-- ***********************************
-- ***** procedure Write Pin *********
-- ***********************************
procedure Write_Pin (Pin : in Pin_No; Status : in Boolean) is
Value_Group : Defined_Type.Octet;
begin
if (Connector (Pin).Pin_Function = Output) or not Protection then
Value_Group := Read_Group (Gp => Connector (Pin).Groupe_Number);
if Status then
Value_Group :=
My_Functions.Set_Bit
(Value_Group, Connector (Pin).Signal_Title);
else
Value_Group :=
My_Functions.Reset_Bit
(Value_Group, Connector (Pin).Signal_Title);
end if;
Write (To_Group => Connector (Pin).Groupe_Number,
Value_Gp => Value_Group);
else
raise Pin_Error;
end if;
end Write_Pin;
-- **********************************
-- ***** procedure write group *****
-- **********************************
procedure Write_Group (Gp : in Group; Value : in Defined_Type.Octet) is
Authorized : Boolean;
Index : Positive;
begin
Authorized := True;
if Protection then
Index := 1;
case Gp is
when No_Group =>
raise Group_Error;
when Group0 =>
while Index in Pointer_Group_0'Range and Authorized loop
Authorized := (Connector (Pointer_Group_0 (Index)).
Pin_Function = Output);
Index := Index + 1;
end loop;
when Group1 =>
while Index in Pointer_Group_0'Range and Authorized loop
Authorized := (Connector (Pointer_Group_0 (Index)).
Pin_Function = Output);
Index := Index + 1;
end loop;
when Group2 =>
while Index in Pointer_Group_2'Range and Authorized loop
Authorized := (Connector (Pointer_Group_2 (Index)).
Pin_Function = Output);
Index := Index + 1;
end loop;
when Group3 =>
while Index in Pointer_Group_3'Range and Authorized loop
Authorized := (Connector (Pointer_Group_3 (Index)).
Pin_Function = Output);
Index := Index + 1;
end loop;
when Group4 =>
while Index in Pointer_Group_4'Range and Authorized loop
Authorized := (Connector (Pointer_Group_4 (Index)).
Pin_Function = Output);
Index := Index + 1;
end loop;
end case;
end if;
if Authorized then
Write (To_Group => Gp, Value_Gp => Value);
else
raise Group_Error;
end if;
end Write_Group;
end Mod101;
end Clone;
nblk1=15
nid=11
hdr6=20
[0x00] rec0=1d rec1=00 rec2=01 rec3=012
[0x01] rec0=1a rec1=00 rec2=09 rec3=06c
[0x02] rec0=15 rec1=00 rec2=0f rec3=048
[0x03] rec0=1e rec1=00 rec2=03 rec3=01a
[0x04] rec0=17 rec1=00 rec2=05 rec3=040
[0x05] rec0=19 rec1=00 rec2=06 rec3=072
[0x06] rec0=1c rec1=00 rec2=0b rec3=012
[0x07] rec0=1b rec1=00 rec2=12 rec3=008
[0x08] rec0=22 rec1=00 rec2=0d rec3=020
[0x09] rec0=21 rec1=00 rec2=0e rec3=002
[0x0a] rec0=1a rec1=00 rec2=15 rec3=006
[0x0b] rec0=1a rec1=00 rec2=08 rec3=05e
[0x0c] rec0=1b rec1=00 rec2=07 rec3=012
[0x0d] rec0=0e rec1=00 rec2=02 rec3=042
[0x0e] rec0=11 rec1=00 rec2=10 rec3=07a
[0x0f] rec0=0e rec1=00 rec2=0c rec3=000
[0x10] rec0=1b rec1=00 rec2=11 rec3=030
[0x11] rec0=0a rec1=00 rec2=07 rec3=042
[0x12] rec0=11 rec1=00 rec2=10 rec3=07a
[0x13] rec0=0e rec1=00 rec2=0c rec3=000
[0x14] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21757abec877f58318426 0x42a00088462060003
Free Block Chain:
0x11: 0000 00 13 01 cc 80 40 20 20 20 20 20 20 20 20 20 20 ┆ @ ┆
0x13: 0000 00 04 00 46 80 04 3a 22 29 3b 04 00 3c 20 20 20 ┆ F :"); < ┆
0x4: 0000 00 14 03 9b 80 31 2d 2d 20 2a 2a 2a 2a 20 75 6e ┆ 1-- **** un┆
0x14: 0000 00 0a 03 fc 80 37 20 20 20 20 20 20 20 53 69 6d ┆ 7 Sim┆
0xa: 0000 00 00 00 04 80 01 20 01 20 20 20 20 20 20 20 20 ┆ ┆