|
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: 16458 (0x404a)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦a6a2caa56⟧
└─⟦this⟧
with My_Functions;
with Defined_Type;
with Vme;
with System;
-- *********************************
-- **** instanced object : VSIP ****
-- *********************************
package body Vsip 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;
-- **** build the VSIP register 1 configuration word ****
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;
-- **** calculate the VSIP real address ****
Base_Address_Vsip := System."+"
(Base_Address, Vme.Addressing (Vme_Position));
Initialize (Vsip_Mask_Register1);
end Setup;
-- ***************************************
-- **** return the VSIP configuration ****
-- ***************************************
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
case Number is
when 1 =>
return Register_1;
when 2 =>
return Register_2;
when others =>
raise Default_Reference_Register;
return 0;
end case;
end Status;
-- ***********************************
-- **** instanced 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
-- **** set the MOD101 board address ****
Base_Address_Mod101 :=
System."+" (Base_Address_Module, Vme.Addressing (Vme_Position));
Base_Address_Mod101_1 := System."+" (Base_Address_Mod101, 1);
Initialize_Connector;
end Setup;
-- ***************************************************
-- **** enable the pin I/O type control operation ****
-- ***************************************************
procedure Protection_On is
begin
Protection := True;
end Protection_On;
-- ****************************************************
-- **** disable the pin I/O type control operation ****
-- ****************************************************
procedure Protection_Off is
begin
Protection := False;
end Protection_Off;
-- **********************************
-- **** initialize the connector ****
-- **********************************
procedure Initialize_Connector is
Tampon : Data;
begin
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;
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_Connector;
-- ****************************************************************
-- **** are we working with an pin I/O type control operation? ****
-- ****************************************************************
function Is_Protection_On return Boolean is
begin
return Protection;
end Is_Protection_On;
-- ***************************************
-- **** set the wished pin as a input ****
-- ***************************************
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;
-- ****************************************
-- **** set the wished pin as a output ****
-- ****************************************
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;
-- ********************************
-- **** turn the MOD101 led on ****
-- ********************************
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;
-- *********************************
-- **** turn the MOD101 led off ****
-- *********************************
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;
-- *************************************
-- **** read a pin of the connector ****
-- *************************************
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;
-- ***************************************
-- **** read a group of the connector ****
-- ***************************************
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
case Gp is
when No_Group =>
raise Group_Error;
when Group0 =>
Pointer_1 := 0;
when Group1 =>
Pointer_1 := 1;
when Group2 =>
Pointer_1 := 2;
when Group3 =>
Pointer_1 := 3;
when Group4 =>
Pointer_1 := 4;
end case;
return Pointer_2;
end Read_Group;
-- ********************************
-- **** internal group writing ****
-- ********************************
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
case To_Group is
when No_Group =>
raise Group_Error;
when Group0 =>
Pointer_1 := 0;
when Group1 =>
Pointer_1 := 1;
when Group2 =>
Pointer_1 := 2;
when Group3 =>
Pointer_1 := 3;
when Group4 =>
Pointer_1 := 4;
end case;
Pointer_2 := Value_Gp;
-- **** output enabled ****
Pointer_1 := 16#90#;
-- **** for the following group ****
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;
-- *****************************************
-- **** write to a pin of the connector ****
-- *****************************************
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;
-- *******************************************
-- **** write to a group of the connector ****
-- *******************************************
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_1'Range and Authorized loop
Authorized := (Connector (Pointer_Group_1 (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 Vsip