|
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 - metrics - downloadIndex: B T
Length: 11364 (0x2c64)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦24d1ddd49⟧
└─⟦this⟧
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1988 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054-3197
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1988. ALL RIGHTS RESERVED.
--
--
with Storage_Management;
with Unchecked_Conversion;
separate (Task_Management)
package body Storage_Manager is
pragma Suppress_All;
package Sm renames Storage_Management;
function Convert is new Unchecked_Conversion (System_Address, Task_Id);
function Convert is new Unchecked_Conversion
(System_Address, Wait_List_Link);
function Convert is new Unchecked_Conversion
(System_Address, Branch_Table_Link);
function Convert is new Unchecked_Conversion (System_Address, Buffer_List);
function Convert is new Unchecked_Conversion (System_Address, Address_Ref);
function "=" (L, R : Mq.Upper_Part) return Boolean renames Mq."=";
function "=" (L, R : Mq.Lower_Part) return Boolean renames Mq."=";
function "=" (L, R : Tt.Wait_List_Link) return Boolean renames Tt."=";
function "=" (L, R : Tt.Branch_Table_Link) return Boolean renames Tt."=";
Tcb_Size : constant Integer := Task_Control_Block'Size / 8;
Buffer_Item_Size : constant Integer := Tt.Buffer_Item'Size / 8;
Accept_List_Size : constant Integer := 20; -- (2 * 8) + 4;
type Wait_List_Skin_Init is
record
Max_Index : Mq.Wait_List_Index;
end record;
type For_Wait_List_Skin_Init is access Wait_List_Skin_Init;
for For_Wait_List_Skin_Init'Storage_Size use 0;
function Convert is new Unchecked_Conversion
(Wait_List_Link, For_Wait_List_Skin_Init);
type Branch_Table_Skin_Init is
record
Max_Entry : Entry_Id;
end record;
type For_Branch_Table_Skin_Init is access Branch_Table_Skin_Init;
for For_Branch_Table_Skin_Init'Storage_Size use 0;
function Convert is new Unchecked_Conversion
(Branch_Table_Link, For_Branch_Table_Skin_Init);
function Wait_List_Size (Max_Index : Entry_Number) return Integer is
pragma Routine_Number (Runtime_Ids.Internal);
Element_Size : constant := 8;
Discrim_Size : constant := 4;
begin
return (Element_Size * (Integer (Max_Index) + 1)) + Discrim_Size;
end Wait_List_Size;
function Branch_Table_Size (Max_Index : Entry_Number) return Integer is
pragma Routine_Number (Runtime_Ids.Internal);
Element_Size : constant := 2;
Discrim_Size : constant := 2;
begin
return (Element_Size * (Integer (Max_Index) + 1)) + Discrim_Size;
end Branch_Table_Size;
function New_Task_Control_Block return Task_Id is
pragma Routine_Number (Runtime_Ids.Internal);
The_Task : Task_Id;
begin
The_Task := Convert (Sm.Allocate_Fixed_Cell
(Units => Tcb_Size,
Collection => Tt.Tcb_Collection));
The_Task.Queues.Wait_List := null;
The_Task.Queues.Accept_List := null;
The_Task.Queues.Branch_Table := null;
return The_Task;
end New_Task_Control_Block;
procedure Free_Tcb (A_Tcb : in out Task_Id) is
pragma Routine_Number (Runtime_Ids.Internal);
begin
A_Tcb.Checksum := A_Tcb.Checksum / 2; -- trash the checksum
Sm.Deallocate_Fixed_Cell (Units => Tcb_Size,
Collection => Tt.Tcb_Collection,
Cell => Convert (A_Tcb'Address));
end Free_Tcb;
function New_Queues (Entries : Entry_Number; Current_Task : Task_Id)
return Queue_Info is
pragma Routine_Number (Runtime_Ids.Internal);
Result : Queue_Info;
Status : Mq.Stratus;
Last_Q : Mq.Wait_List_Index := Mq.Wait_List_Index (Entries);
begin
Result.Wait_List := Convert
(Sm.Allocate_Fixed_Cell
(Units => Wait_List_Size (Entries),
Collection => Tt.Wait_List_Collection));
Convert (Result.Wait_List).Max_Index := Mq.Wait_List_Index (Entries);
Result.Branch_Table :=
Convert (Sm.Allocate_Fixed_Cell
(Units => Branch_Table_Size (Entries),
Collection => Tt.Branch_Table_Collection));
Convert (Result.Branch_Table).Max_Entry := Entries;
Result.Accept_List := Convert
(Sm.Allocate_Fixed_Cell
(Units => Accept_List_Size,
Collection => Tt.Wait_List_Collection));
Convert (Result.Accept_List).Max_Index := 1;
declare
Result_Wait_List : Wait_List_Skin renames Result.Wait_List.all;
Result_Accept_List : Wait_List_Skin renames Result.Accept_List.all;
begin
Mq.Create (Max_Message_Size => Reply_Message_Size,
Max_Message_Count => 3,
Result => Status,
New_Queue =>
Result_Wait_List.List (Reply_Queue_Index).Wait_Queue);
if Status = Mq.Q_Quesiz then
Debugging.Put_Message ("Unable to create utility queue");
-- already released the lock, so just raise
raise Storage_Error;
else
if Safety_Check then
Checking.Check_Message_Queue_Status
(Status, Err.Bad_Status_From_Create,
Current_Task => Current_Task);
end if;
end if;
Result_Wait_List.List (Reply_Queue_Index).Not_Active := False;
Result_Wait_List.List (Reply_Queue_Index).Ipc_Queue := False;
Result_Accept_List.List (Reply_Queue_Index) :=
Result_Wait_List.List (Reply_Queue_Index);
-- Result_Accept_List.List (1).Wait_Queue := Message_Queue.Null_Id;
Result_Accept_List.List (1).Wait_Queue.Upper := 0;
Result_Accept_List.List (1).Wait_Queue.Lower := 0;
Result_Accept_List.List (1).Not_Active := False;
Result_Accept_List.List (1).Ipc_Queue := False;
for I in First_Entry_Index .. Mq.Wait_List_Index (Entries) loop
Mq.Create (Max_Message_Size => Entry_Call_Message_Size,
Max_Message_Count => 64, -- ??
Result => Status,
New_Queue => Result_Wait_List.List (I).Wait_Queue);
if Status = Mq.Q_Quesiz then
-- create failed; note last succeeded queue
Last_Q := I - 1;
exit;
else
if Safety_Check then
Checking.Check_Message_Queue_Status
(Status, Err.Bad_Status_From_Create,
Current_Task => Current_Task);
end if;
end if;
Result_Wait_List.List (I).Not_Active := True;
Result_Wait_List.List (I).Ipc_Queue := False;
end loop;
if Last_Q /= Mq.Wait_List_Index (Entries) then
-- create did not succeed
for I in Last_Q .. Mq.Wait_List_Index (Entries) loop
Result_Wait_List.List (I).Wait_Queue.Upper := 0;
Result_Wait_List.List (I).Wait_Queue.Lower := 0;
end loop;
Debugging.Put_Message ("Unable to create new queues");
Free_Queues (Result, Current_Task);
-- already released the lock, so just raise
raise Storage_Error;
end if;
end;
return Result;
end New_Queues;
procedure Free_Queues (Queues : in out Queue_Info;
Current_Task : Task_Id) is
pragma Routine_Number (Runtime_Ids.Internal);
Status : Mq.Stratus;
begin
if Queues.Wait_List /= null then
for I in Queues.Wait_List.List'Range loop
declare
The_Queue : Mq.Id
renames Queues.Wait_List.List (I).Wait_Queue;
begin
-- if The_Queue /= Mq.Null_Id then
if The_Queue.Upper /= 0 or else The_Queue.Lower /= 0 then
Mq.Delete (The_Queue, Status);
end if;
end;
end loop;
Sm.Deallocate_Fixed_Cell
(Units => Wait_List_Size
(Entry_Number (Queues.Wait_List.Max_Index)),
Collection => Tt.Wait_List_Collection,
Cell => Convert (Queues.Wait_List'Address));
end if;
if Queues.Branch_Table /= null then
Sm.Deallocate_Fixed_Cell
(Units => Branch_Table_Size (Queues.Branch_Table.Max_Entry),
Collection => Tt.Branch_Table_Collection,
Cell => Convert (Queues.Branch_Table'Address));
end if;
if Queues.Accept_List /= null then
Sm.Deallocate_Fixed_Cell
(Units => Accept_List_Size,
Collection => Tt.Wait_List_Collection,
Cell => Convert (Queues.Accept_List'Address));
end if;
end Free_Queues;
function New_Buffer_Item (With_Buffer : Integer;
Slot_Data : Integer;
Next_Item : Buffer_List) return Buffer_List is
-- Called with lock; lock is released before return;
pragma Routine_Number (Runtime_Ids.Internal);
Result : Buffer_List;
begin
if Buffer_Free_List = null then
Release_Lock;
Result := Convert (Sm.Allocate_Fixed_Cell
(Units => Buffer_Item_Size,
Collection => Tt.Buffer_Item_Collection));
else
Result := Buffer_Free_List;
Buffer_Free_List := Result.Next;
Release_Lock;
end if;
Result.Buffer := With_Buffer;
Result.Slot_Data := Slot_Data;
Result.Next := Next_Item;
return Result;
end New_Buffer_Item;
end Storage_Manager;
pragma Runtime_Unit (Unit_Number => Runtime_Ids.Runtime_Compunit,
Elab_Routine_Number => Runtime_Ids.Internal);