|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 9653 (0x25b5)
Types: TextFile
Names: »B«
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
with As;
with Devices;
with Files;
with Mac_Types;
with Memory;
with Resources;
with Resource_Constants;
with Serial;
with System;
with Toolutils;
with Unchecked_Conversion;
package body Serial_Communication is
type Ports is (Port_A, Port_B);
type Resource_Communication_Info is
record
Link_Info : Mac_Types.Integer;
Buffer_Size : Mac_Types.Integer;
Port : Ports;
Xon : Boolean;
Cts : Boolean;
Dtr : Boolean;
end record;
type Resource_Communication_Info_Ptr is access Resource_Communication_Info;
type Resource_Communication_Info_Handle is
access Resource_Communication_Info_Ptr;
Communication_Info : Resource_Communication_Info_Handle := null;
-- Communication tasks
task Receiver is
entry Start;
entry Available (Avail : out Boolean);
entry Get (Entity : out Frame.Message);
end Receiver;
task Sender is
entry Start;
entry Put (Entities : Frame.Message_Array);
end Sender;
-- Communication methods
procedure Initialize_From_Resource (Resource_Number : Mac_Types.Integer) is
Resource_Type : constant Mac_Types.Restype := 16#43494E46#; -- CINF
function As_Resource_Communication_Info_Handle is
new Unchecked_Conversion
(Source => Mac_Types.Handle,
Target => Resource_Communication_Info_Handle);
function As_Handle is
new Unchecked_Conversion
(Source => Resource_Communication_Info_Handle,
Target => Mac_Types.Handle);
Resource_Name : Mac_Types.Str255;
begin
Communication_Info := As_Resource_Communication_Info_Handle
(Resources.Getresource
(Resource_Type, Resource_Number));
if Communication_Info = null then
Communication_Info :=
As_Resource_Communication_Info_Handle
(Memory.Newhandle (Resource_Communication_Info'Size / 8));
Communication_Info.all.Link_Info :=
Serial.Baud9600 + Serial.Data8 + Serial.Stop20 + Serial.Noparity;
Communication_Info.all.Buffer_Size := 64;
Communication_Info.all.Port := Port_A;
Communication_Info.all.Xon := False;
Communication_Info.all.Cts := False;
Communication_Info.all.Dtr := False;
Resource_Name (0) := Mac_Types.Nul;
Resources.Addresource
(As_Handle (Communication_Info), Resource_Type,
Resource_Number, Resource_Name);
end if;
Receiver.Start;
Sender.Start;
end Initialize_From_Resource;
procedure Open is
Err : Mac_Types.Oserr;
Name : Mac_Types.Str255;
In_Refnum : Mac_Types.Integer;
Out_Refnum : Mac_Types.Integer;
Serial_Buffer_Ptr : Mac_Types.Ptr;
Flags : Serial.Sershk;
begin
case Communication_Info.all.Port is
when Port_A =>
Toolutils.Getindstring
(Name, Resource_Constants.String_List_Device_Names_Id,
Resource_Constants.String_List_Device_Name_Ain);
Err := Devices.Opendriver
(Name, As.As_Varinteger (In_Refnum'Address));
Toolutils.Getindstring
(Name, Resource_Constants.String_List_Device_Names_Id,
Resource_Constants.String_List_Device_Name_Aout);
Err := Devices.Opendriver
(Name, As.As_Varinteger (In_Refnum'Address));
when Port_B =>
Toolutils.Getindstring
(Name, Resource_Constants.String_List_Device_Names_Id,
Resource_Constants.String_List_Device_Name_Bin);
Err := Devices.Opendriver
(Name, As.As_Varinteger (In_Refnum'Address));
Toolutils.Getindstring
(Name, Resource_Constants.String_List_Device_Names_Id,
Resource_Constants.String_List_Device_Name_Bout);
Err := Devices.Opendriver
(Name, As.As_Varinteger (In_Refnum'Address));
end case;
if Err /= Mac_Types.Noerr then
raise Device_Error;
end if;
Serial_Buffer_Ptr :=
Memory.Newptrclear (Memory.Size
(Communication_Info.all.Buffer_Size));
if Mac_Types."=" (Serial_Buffer_Ptr, null) then
raise Device_Error;
end if;
Err := Serial.Sersetbuf (In_Refnum, Serial_Buffer_Ptr,
Communication_Info.all.Buffer_Size);
Err := Serial.Serreset (In_Refnum, Communication_Info.all.Link_Info);
Err := Serial.Serreset (Out_Refnum, Communication_Info.all.Link_Info);
if Communication_Info.all.Xon then
Flags.Fxon := 1;
else
Flags.Fxon := 0;
end if;
if Communication_Info.all.Cts then
Flags.Fcts := 1;
else
Flags.Fcts := 0;
end if;
Flags.Xon := Mac_Types.Dc1;
Flags.Xoff := Mac_Types.Dc3;
Flags.Errs := 0;
Flags.Evts := 0;
if Communication_Info.all.Xon then
Flags.Finx := 1;
else
Flags.Finx := 0;
end if;
if Communication_Info.all.Dtr then
Flags.Fdtr := 1;
else
Flags.Fdtr := 0;
end if;
if Err = Mac_Types.Noerr then
Err := Serial.Serhshake (In_Refnum, Flags);
end if;
if Err = Mac_Types.Noerr then
Err := Serial.Serhshake (Out_Refnum, Flags);
end if;
if Err /= Mac_Types.Noerr then
raise Device_Error;
end if;
end Open;
function Entity_Available return Boolean is
Avail : Boolean;
begin
Receiver.Available (Avail);
return Avail;
end Entity_Available;
procedure Get (Entity : out Frame.Message) is
begin
Receiver.Get (Entity);
end Get;
procedure Put (Entity : Frame.Message) is
Entities : Frame.Message_Array (0 .. 0) := (0 => Entity);
begin
Sender.Put (Entities);
end Put;
procedure Put (Entities : Frame.Message_Array) is
begin
Sender.Put (Entities);
end Put;
procedure Close is
Err : Mac_Types.Oserr;
begin
case Communication_Info.all.Port is
when Port_A =>
Err := Devices.Closedriver (Serial.Ainrefnum);
Err := Devices.Closedriver (Serial.Aoutrefnum);
when Port_B =>
Err := Devices.Closedriver (Serial.Binrefnum);
Err := Devices.Closedriver (Serial.Boutrefnum);
end case;
end Close;
-- Private methods
function Get_In_Port_Refnum return Mac_Types.Integer is
begin
case Communication_Info.all.Port is
when Port_A =>
return Serial.Ainrefnum;
when Port_B =>
return Serial.Binrefnum;
end case;
end Get_In_Port_Refnum;
function Get_Out_Port_Refnum return Mac_Types.Integer is
begin
case Communication_Info.all.Port is
when Port_A =>
return Serial.Aoutrefnum;
when Port_B =>
return Serial.Boutrefnum;
end case;
end Get_Out_Port_Refnum;
task body Receiver is
Sleep_Time : constant Duration := 0.5;
Empty : Boolean := True;
procedure Read (Entity : out Frame.Message) is
Err : Mac_Types.Oserr;
Count : Mac_Types.Longint := 1;
Buffer : Frame.Message_Array (0 .. 1);
begin
Err := Files.Fsread (Get_In_Port_Refnum,
As.As_Varlongint (Count'Address),
As.As_Ptr (Buffer (Buffer'First)'Address));
-- Treat Error ?
Entity := Buffer (0);
end Read;
function Is_In_Port_Empty return Boolean is
Err : Mac_Types.Oserr;
Count : Mac_Types.Longint;
begin
Err := Serial.Sergetbuf (Get_In_Port_Refnum,
As.As_Varlongint (Count'Address));
return Err /= Mac_Types.Noerr or else Count = 0;
end Is_In_Port_Empty;
begin
accept Start;
loop
Empty := Is_In_Port_Empty;
select
accept Available (Avail : out Boolean) do
Avail := not Empty;
end Available;
or
when not Empty =>
accept Get (Entity : out Frame.Message) do
Read (Entity);
end Get;
or
delay Sleep_Time;
end select;
end loop;
end Receiver;
task body Sender is
procedure Write (Entities : Frame.Message_Array) is
Err : Mac_Types.Oserr;
Count : Mac_Types.Longint := Entities'Length;
begin
Err := Files.Fswrite
(Get_Out_Port_Refnum, As.As_Varlongint (Count'Address),
As.As_Ptr (Entities (Entities'First)'Address));
-- Treat Error ?
end Write;
begin
accept Start;
loop
accept Put (Entities : Frame.Message_Array) do
Write (Entities);
end Put;
end loop;
end Sender;
end Serial_Communication;