|
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: 19636 (0x4cb4)
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«
└─⟦c4a0b842d⟧
└─⟦this⟧
--with My_Functions;
with Bit_Utilities;
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
procedure Initialize (Mask_Register1 : in Defined_Type.Byte) is
-- Register_1 : Defined_Type.Octet;
Register_1 : Defined_Type.Byte;
-- Register_2 : Defined_Type.Octet;
Register_2 : Defined_Type.Byte;
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;
Vsip_Mask_Register1 : Bit_Utilities.Byte;
-- Index : My_Functions.Data;
Index : Bit_Utilities.Bit_Number;
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;
Vsip_Mask_Register1 := Bit_Utilities.Null_Byte;
-- **** build the VSIP register 1 configuration word ****
-- Index := My_Functions.Data'First;
Index := Bit_Utilities.Bit_Number'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);
Bit_Utilities.Set_Bit_To_1
(Of_Byte => Vsip_Mask_Register1, The_Bit => Index);
-- Index := My_Functions.Data'Succ (Index);
Index := Bit_Utilities.Bit_Number'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);
Initialize (Bit_Utilities.To_Number (The_Array => Vsip_Mask_Register1));
end Setup;
-- ***************************************
-- **** return the VSIP configuration ****
-- ***************************************
function Status (Register : Integer; Number : Positive)
return Defined_Type.Byte is
-- return Defined_Type.Octet is
-- Register_1 : Defined_Type.Octet;
Register_1 : Defined_Type.Byte;
-- Register_2 : Defined_Type.Octet;
Register_2 : Defined_Type.Byte;
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;
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;
Signal_Title : Bit_Utilities.Bit_Number;
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;
use Bit_Utilities;
-- **************************************
-- **** 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;
Tampon : Bit_Utilities.Bit_Number;
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;
Tampon := Bit_Utilities.Bit_Number'First;
for Index in Pointer_Group_0'Range loop
Connector (Pointer_Group_0 (Index)) := (Group0, Tampon, Input);
-- if Tampon /= Data'Last then
if Tampon /= Bit_Utilities.Bit_Number'Last then
-- Tampon := Data'Succ (Tampon);
Tampon := Bit_Utilities.Bit_Number'Succ (Tampon);
end if;
end loop;
-- Tampon := Data'First;
Tampon := Bit_Utilities.Bit_Number'First;
for Index in Pointer_Group_1'Range loop
Connector (Pointer_Group_1 (Index)) := (Group1, Tampon, Input);
-- if Tampon /= Data'Last then
if Tampon /= Bit_Utilities.Bit_Number'Last then
-- Tampon := Data'Succ (Tampon);
Tampon := Bit_Utilities.Bit_Number'Succ (Tampon);
end if;
end loop;
-- Tampon := Data'First;
Tampon := Bit_Utilities.Bit_Number'First;
for Index in Pointer_Group_2'Range loop
Connector (Pointer_Group_2 (Index)) := (Group2, Tampon, Input);
-- if Tampon /= Data'Last then
if Tampon /= Bit_Utilities.Bit_Number'Last then
-- Tampon := Data'Succ (Tampon);
Tampon := Bit_Utilities.Bit_Number'Succ (Tampon);
end if;
end loop;
-- Tampon := Data'First;
Tampon := Bit_Utilities.Bit_Number'First;
for Index in Pointer_Group_3'Range loop
Connector (Pointer_Group_3 (Index)) := (Group3, Tampon, Input);
-- if Tampon /= Data'Last then
if Tampon /= Bit_Utilities.Bit_Number'Last then
-- Tampon := Data'Succ (Tampon);
Tampon := Bit_Utilities.Bit_Number'Succ (Tampon);
end if;
end loop;
-- Tampon := Data'First;
Tampon := Bit_Utilities.Bit_Number'First;
for Index in Pointer_Group_4'Range loop
Connector (Pointer_Group_4 (Index)) := (Group4, Tampon, Input);
-- if Tampon /= Data'Last then
if Tampon /= Bit_Utilities.Bit_Number'Last then
-- Tampon := Data'Succ (Tampon);
Tampon := Bit_Utilities.Bit_Number'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.Byte;
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.Byte;
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;
Value_Group : Defined_Type.Byte;
-- Pin_Type : Data;
Pin_Type : Bit_Number;
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);
return Bit_Utilities.Test_Bit
(Number => Connector (Pin).Signal_Title,
Of_Byte => Bit_Utilities.To_Array (Value_Group));
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
function Read_Group (Gp : Group) return Defined_Type.Byte is
-- Pointer_1 : Defined_Type.Octet;
Pointer_1 : Defined_Type.Byte;
for Pointer_1 use at Base_Address_Mod101;
-- Pointer_2 : Defined_Type.Octet;
Pointer_2 : Defined_Type.Byte;
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
procedure Write (To_Group : Group; Value_Gp : Defined_Type.Byte) is
-- Pointer_1 : Defined_Type.Octet;
Pointer_1 : Defined_Type.Byte;
for Pointer_1 use at Base_Address_Mod101;
-- Pointer_2 : Defined_Type.Octet;
Pointer_2 : Defined_Type.Byte;
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;
Pointer_2 := 16#1F#;
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;
Value_Group : Defined_Type.Byte;
Array_Group : Bit_Utilities.Byte;
begin
if (Connector (Pin).Pin_Function = Output) or not Protection then
Value_Group := Read_Group (Gp => Connector (Pin).Groupe_Number);
Array_Group := Bit_Utilities.To_Array (The_Byte => Value_Group);
if Status then
-- Value_Group :=
-- My_Functions.Set_Bit
-- (Value_Group, Connector (Pin).Signal_Title);
Set_Bit_To_1 (Of_Byte => Array_Group,
The_Bit => Connector (Pin).Signal_Title);
else
-- Value_Group :=
-- My_Functions.Reset_Bit
-- (Value_Group, Connector (Pin).Signal_Title);
Set_Bit_To_0 (Of_Byte => Array_Group,
The_Bit => Connector (Pin).Signal_Title);
end if;
Value_Group := Bit_Utilities.To_Number
(The_Array => Array_Group);
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
procedure Write_Group (Gp : in Group; Value : in Defined_Type.Byte) 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