|
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: 24576 (0x6000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Ll_Vect_60, seg_05c25a, seg_05c29f
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with System;
with Unsigned_Types;
with Unchecked_Conversion;
with Duart_2661;
with Pic_68155;
with Ada_Krn_Defs;
package body Ll_Vect_60 is
Base_Vector : constant := 16#15#;
First_Call : Boolean := True;
type Pic_Acc is access Pic_68155.Objet;
Pic : Pic_Acc;
type Io_8_Objet is array (Port_Nb) of Duart_2661.Objet;
for Io_8_Objet'Size use 8 * Duart_2661.Taille;
type Io_8_Acc is access Io_8_Objet;
Io_8 : Io_8_Acc;
function To_Pic is new Unchecked_Conversion
(Unsigned_Types.Unsigned_Integer, Pic_Acc);
function To_Io_8 is new Unchecked_Conversion
(Unsigned_Types.Unsigned_Integer, Io_8_Acc);
task It1 is
entry Go (P : in Object);
entry Rx (C : out Duart_2661.Byte);
entry Tx (C : in Duart_2661.Byte);
entry It;
for It use at System.Address'Ref (Base_Vector);
pragma Passive (Abort_Unsafe, Ada_Krn_Defs.Default_Intr_Attr);
end It1;
procedure Init_It (P : in Port_Nb; Rx, Tx : in Boolean := True) is
begin
if Rx and Tx then
Io_8 (P).Cr := Duart_2661.Activer_It_Rx_Tx;
elsif Rx then
Io_8 (P).Cr := Duart_2661.Activer_It_Rx;
elsif Tx then
Io_8 (P).Cr := Duart_2661.Activer_It_Tx;
else
Io_8 (P).Cr := Duart_2661.Desactiver_It;
end if;
end Init_It;
function It_Rx (Reg : in Duart_2661.Byte) return Boolean is
Rg : Duart_2661.Loc_Byte;
for Rg use at Reg'Address;
begin
return Rg (7);
end It_Rx;
function It_Tx (Reg : in Duart_2661.Byte) return Boolean is
Rg : Duart_2661.Loc_Byte;
for Rg use at Reg'Address;
begin
return Rg (8);
end It_Tx;
procedure Incremente (Index : in out Index_Infos) is
begin
if Index = Max_Index_Infos then
Index := 1;
else
Index := Index + 1;
end if;
end Incremente;
procedure Do_It (Port : in Object) is
Sr : Duart_2661.Byte;
begin
Sr := Io_8 (Port.Nb).Sr;
if It_Rx (Reg => Sr) then
Port.Buffer (Port.Index_In) := Io_8 (Port.Nb).Tx_Rx;
Incremente (Port.Index_In);
if Port.Index_In = Port.Index_Out then
Incremente (Port.Index_Out);
end if;
Port.Rx_Ready := True;
end if;
if It_Tx (Reg => Sr) then
Port.Tx_Ready := True;
Init_It (P => Port.Nb, Tx => False, Rx => True);
end if;
end Do_It;
procedure Do_Tx (Port : in Object; Car : in Duart_2661.Byte) is
begin
Init_It (P => Port.Nb, Tx => True, Rx => False);
Io_8 (Port.Nb).Tx_Rx := Car;
Port.Tx_Ready := False;
end Do_Tx;
procedure Do_Rx (Port : in Object; Car : out Duart_2661.Byte) is
begin
Car := Port.Buffer (Port.Index_Out);
Incremente (Port.Index_Out);
if Port.Index_In = Port.Index_Out then
Port.Rx_Ready := False;
else
Port.Rx_Ready := True;
end if;
end Do_Rx;
task body It1 is
Port : Object;
Init_Done : Boolean := False;
begin
loop
select
accept Go (P : in Object) do
Port := P;
Init_Done := True;
end Go;
or
accept It do
Do_It (Port => Port);
end It;
or
when Init_Done and then Port.Tx_Ready =>
accept Tx (C : in Duart_2661.Byte) do
Do_Tx (Port => Port, Car => C);
end Tx;
or
when Init_Done and then Port.Rx_Ready =>
accept Rx (C : out Duart_2661.Byte) do
Do_Rx (Port => Port, Car => C);
end Rx;
end select;
end loop;
end It1;
procedure Initialize is
Pic_Add : constant Unsigned_Types.Unsigned_Integer := 16#0301_0020#;
Io_8_Add : constant Unsigned_Types.Unsigned_Integer := 16#F400_0000#;
begin
Pic := To_Pic (Pic_Add);
Io_8 := To_Io_8 (Io_8_Add);
end Initialize;
function Open (Nb : in Port_Nb;
S : in Duart_2661.Stop_Bit := Duart_2661.Stop_Bit_1;
P : in Duart_2661.Parity := Duart_2661.Parity_None;
C : in Duart_2661.Car_Length := Duart_2661.Car_Length_8_Bit;
B : in Duart_2661.Baud_Rate := Duart_2661.Baud_Rate_9600)
return Object is
Port : Object := new Port_Infos;
begin
if First_Call then
Initialize;
First_Call := False;
end if;
Port.Nb := Nb;
-- case Port.Nb is
-- when 1 =>
It1.Go (P => Port);
-- when 2 =>
-- It2.Go (P => Port);
-- when 3 =>
-- It3.Go (P => Port);
-- when 4 =>
-- It4.Go (P => Port);
-- when 5 =>
-- It5.Go (P => Port);
-- when 6 =>
-- It6.Go (P => Port);
-- when 7 =>
-- It7.Go (P => Port);
-- when 8 =>
-- It8.Go (P => Port);
-- end case;
Io_8 (Port.Nb).Mr := Duart_2661.Get_Mr1 (S => S, P => P, C => C);
Io_8 (Port.Nb).Mr := Duart_2661.Get_Mr2 (B => B);
Init_It (P => Port.Nb, Tx => False, Rx => True);
Pic.R5 := Pic_68155.Activer_Irq1;
return Port;
end Open;
function Receive (Port : in Object) return Duart_2661.Byte is
C : Duart_2661.Byte;
begin
-- case Port.Nb is
-- when 1 =>
It1.Rx (C);
-- when 2 =>
-- It2.Rx (C);
-- when 3 =>
-- It3.Rx (C);
-- when 4 =>
-- It4.Rx (C);
-- when 5 =>
-- It5.Rx (C);
-- when 6 =>
-- It6.Rx (C);
-- when 7 =>
-- It7.Rx (C);
-- when 8 =>
-- It8.Rx (C);
-- end case;
return C;
end Receive;
procedure Send (Port : in Object; Car : in Duart_2661.Byte) is
begin
-- case Port.Nb is
-- when 1 =>
It1.Tx (Car);
-- when 2 =>
-- It2.Tx (Car);
-- when 3 =>
-- It3.Tx (Car);
-- when 4 =>
-- It4.Tx (Car);
-- when 5 =>
-- It5.Tx (Car);
-- when 6 =>
-- It6.Tx (Car);
-- when 7 =>
-- It7.Tx (Car);
-- when 8 =>
-- It8.Tx (Car);
-- end case;
end Send;
function Byte_Available (Port : in Object) return Boolean is
begin
if Port.Index_In /= Port.Index_Out then
return True;
else
return False;
end if;
end Byte_Available;
procedure Close (Port : in Object) is
begin
Init_It (P => Port.Nb, Tx => False, Rx => False);
end Close;
end Ll_Vect_60;
nblk1=17
nid=8
hdr6=12
[0x00] rec0=1f rec1=00 rec2=01 rec3=056
[0x01] rec0=09 rec1=00 rec2=17 rec3=01a
[0x02] rec0=23 rec1=00 rec2=10 rec3=06e
[0x03] rec0=20 rec1=00 rec2=09 rec3=00e
[0x04] rec0=1d rec1=00 rec2=07 rec3=024
[0x05] rec0=1b rec1=00 rec2=05 rec3=03c
[0x06] rec0=1f rec1=00 rec2=16 rec3=02a
[0x07] rec0=25 rec1=00 rec2=02 rec3=012
[0x08] rec0=09 rec1=00 rec2=03 rec3=000
[0x09] rec0=1f rec1=00 rec2=12 rec3=00a
[0x0a] rec0=1e rec1=00 rec2=0e rec3=030
[0x0b] rec0=1e rec1=00 rec2=14 rec3=002
[0x0c] rec0=1e rec1=00 rec2=02 rec3=062
[0x0d] rec0=19 rec1=00 rec2=05 rec3=02e
[0x0e] rec0=20 rec1=00 rec2=03 rec3=002
[0x0f] rec0=25 rec1=00 rec2=08 rec3=03a
[0x10] rec0=14 rec1=00 rec2=16 rec3=000
[0x11] rec0=1f rec1=00 rec2=0d rec3=000
[0x12] rec0=21 rec1=00 rec2=07 rec3=04a
[0x13] rec0=0c rec1=00 rec2=05 rec3=000
[0x14] rec0=00 rec1=00 rec2=00 rec3=000
[0x15] rec0=00 rec1=00 rec2=00 rec3=000
[0x16] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2176b917e895b3c949fe8 0x42a00088462060003
Free Block Chain:
0x8: 0000 00 14 00 c9 00 0f 20 20 20 20 20 20 20 20 65 6e ┆ en┆
0x14: 0000 00 0e 03 fc 80 21 70 74 20 54 78 20 28 43 20 3a ┆ !pt Tx (C :┆
0xe: 0000 00 12 03 fc 80 09 20 20 20 20 20 20 20 6f 72 09 ┆ or ┆
0x12: 0000 00 06 03 fc 80 11 20 20 20 20 20 61 63 63 65 70 ┆ accep┆
0x6: 0000 00 15 03 fc 00 26 20 20 20 20 20 20 20 20 20 20 ┆ & ┆
0x15: 0000 00 0c 03 f9 80 0c 20 20 20 20 73 65 6c 65 63 74 ┆ select┆
0xc: 0000 00 0f 03 fc 80 18 65 66 20 28 49 6e 74 65 72 72 ┆ ef (Interr┆
0xf: 0000 00 0d 03 fc 80 02 29 3b 02 00 11 20 20 20 20 20 ┆ ); ┆
0xd: 0000 00 13 01 eb 80 0f 20 20 20 20 20 20 77 68 65 6e ┆ when┆
0x13: 0000 00 11 03 f7 80 1c 20 69 73 20 6e 65 77 20 55 6e ┆ is new Un┆
0x11: 0000 00 04 03 fc 80 03 49 74 3b 03 00 0e 20 20 20 20 ┆ It; ┆
0x4: 0000 00 0b 00 11 80 0e 20 20 20 20 20 20 20 20 20 20 ┆ ┆
0xb: 0000 00 0a 00 04 80 01 20 01 02 28 50 29 3b 07 00 09 ┆ (P); ┆
0xa: 0000 00 00 00 08 80 05 74 65 5f 41 70 05 06 20 08 0e ┆ te_Ap ┆