DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - metrics - download

⟦1e18ce739⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body V_I_Mbox, seg_0509c5

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with System;
with Ada_Krn_Defs;
with Ada_Krn_I;
with Unchecked_Deallocation;
package body V_I_Mbox is

    pragma Suppress (All_Checks);
    pragma Suppress (Exception_Tables);

    function Create (Slots_Cnt : Positive;
                     Slot_Len : Natural;
                     Intr_Flag : Boolean := False;
                     Intr_Status : Intr_Status_T := Disable_Intr_Status)
                    return A_Mbox_T is
        M : Ada_Krn_Defs.A_Mailbox_T := new Ada_Krn_Defs.Mailbox_T;
    begin
        if Intr_Flag then
            declare
                Attr_Rec : Ada_Krn_Defs.Mailbox_Attr_T;
            begin
                Ada_Krn_Defs.Mailbox_Intr_Attr_Init
                   (Ada_Krn_Defs.To_A_Mailbox_Attr_T (Attr_Rec'Address),
                    Ada_Krn_Defs.Intr_Status_T (Intr_Status));
                if not Ada_Krn_I.Mailbox_Init (M, Slots_Cnt, Slot_Len,
                                               Ada_Krn_Defs.To_A_Mailbox_Attr_T
                                                  (Attr_Rec'Address)) then
                    raise Storage_Error;
                end if;
            end;
        else
            if not Ada_Krn_I.Mailbox_Init
                      (M, Slots_Cnt, Slot_Len, Ada_Krn_Defs.
                                                  Default_Mailbox_Attr) then
                raise Storage_Error;
            end if;
        end if;
        return A_Mbox_T (M);
    end Create;

    procedure Free is new Unchecked_Deallocation
                             (Ada_Krn_Defs.Mailbox_T, Ada_Krn_Defs.A_Mailbox_T);

    function Delete (Mbox : A_Mbox_T; Conditional_Delete_Flag : Boolean)
                    return Boolean is
        M : Ada_Krn_Defs.A_Mailbox_T := Ada_Krn_Defs.A_Mailbox_T (Mbox);
    begin
        if Conditional_Delete_Flag and then
           (Ada_Krn_I.Mailbox_Get_In_Use (M) or else
            (Ada_Krn_I.Mailbox_Get_Count (M) > 0)) then
            return False;
        end if;
        Ada_Krn_I.Mailbox_Destroy (M);
        Free (M);
        return True;
    end Delete;

    function Read_Write (Access_Type : Access_T;
                         Mbox : A_Mbox_T;
                         Msg_Addr : System.Address;
                         Msg_Len : Natural;
                         Wait_Time : Duration) return Boolean is
    begin
        case Access_Type is
            when Read_A =>
                return Ada_Krn_I.Mailbox_Read (Ada_Krn_Defs.A_Mailbox_T (Mbox),
                                               Msg_Addr, Wait_Time);
            when Write_A =>
                return Ada_Krn_I.Mailbox_Write
                          (Ada_Krn_Defs.A_Mailbox_T (Mbox), Msg_Addr);
        end case;
    end Read_Write;

    function Get_Message_Count (Mbox : A_Mbox_T) return Natural is
    begin
        return Ada_Krn_I.Mailbox_Get_Count (Ada_Krn_Defs.A_Mailbox_T (Mbox));
    end Get_Message_Count;

    function Disable_Intr_Status return Intr_Status_T is
    begin
        return Intr_Status_T (Ada_Krn_Defs.Disable_Intr_Status);
    end Disable_Intr_Status;
end V_I_Mbox;

    nblk1=4
    nid=0
    hdr6=8
        [0x00] rec0=1b rec1=00 rec2=01 rec3=004
        [0x01] rec0=18 rec1=00 rec2=02 rec3=030
        [0x02] rec0=1c rec1=00 rec2=03 rec3=01c
        [0x03] rec0=05 rec1=00 rec2=04 rec3=000
    tail 0x217580648878e79e809ef 0x42a00088462060003