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 - download

⟦56368a9e4⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body V_I_Tasks, seg_04ce1a

Derivation

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

with System;
use System;
with Ada_Krn_I;
with V_I_Types;
package body V_I_Tasks is
    pragma Suppress (All_Checks);
    pragma Suppress (Exception_Tables);

    function Get_User_Universal_Field (Tsk : Task_Id)
                                      return V_I_Types.Universal_Scalar;
    pragma Interface (Ada, Get_User_Universal_Field);
    pragma Interface_Name (Get_User_Universal_Field,
                           "__GET_USER_UNIVERSAL_FIELD");

    procedure Set_User_Universal_Field (Tsk : Task_Id;
                                        New_Value : V_I_Types.Universal_Scalar);
    pragma Interface (Ada, Set_User_Universal_Field);
    pragma Interface_Name (Set_User_Universal_Field,
                           "__SET_USER_UNIVERSAL_FIELD");

    function Get_User_Field (Tsk : Task_Id) return Integer is
    begin
        return V_I_Types.From_Universal_Scalar (Get_User_Universal_Field (Tsk));
    end Get_User_Field;

    function Get_User_Field (Tsk : Task_Id) return Address is
    begin
        return V_I_Types.From_Universal_Scalar (Get_User_Universal_Field (Tsk));
    end Get_User_Field;

    procedure Set_User_Field (Tsk : Task_Id; New_Value : Integer) is
    begin
        Set_User_Universal_Field (Tsk,
                                  V_I_Types.To_Universal_Scalar (New_Value));
    end Set_User_Field;

    procedure Set_User_Field (Tsk : Task_Id; New_Value : Address) is
    begin
        Set_User_Universal_Field (Tsk,
                                  V_I_Types.To_Universal_Scalar (New_Value));
    end Set_User_Field;

    function Get_Task (Id : System.Task_Id) return Task_Id is
    begin
        return Id;
    end Get_Task;

    function Get_Current_Program return Program_Id is
    begin
        return Ada_Krn_I.Program_Self;
    end Get_Current_Program;

    function Get_Program (Tsk : Task_Id) return Program_Id is
    begin
        if Task_Is_Completed (Tsk) then
            return Get_Current_Program;
        else
            return Ada_Krn_I.Program_Get (Tsk);
        end if;
    end Get_Program;

    procedure Terminate_Program (Status : Integer;  -- exit status
                                 Prg : Program_Id := Get_Current_Program) is
    begin
        Ada_Krn_I.Program_Terminate (Prg, Status);
    end Terminate_Program;

    function Get_Program_Key (Prg : Program_Id := Get_Current_Program)
                             return System.Address is
    begin
        return Ada_Krn_I.Program_Get_Key (Prg);
    end Get_Program_Key;

    function Suspend_Task (Tsk : Task_Id) return Boolean is
    begin
        if Task_Is_Completed (Tsk) then
            return False;
        else
            return Ada_Krn_I.Task_Suspend (Tsk);
        end if;
    end Suspend_Task;

    function Resume_Task (Tsk : Task_Id) return Boolean is
    begin
        if Task_Is_Completed (Tsk) then
            return False;
        else
            return Ada_Krn_I.Task_Resume (Tsk);
        end if;
    end Resume_Task;

    function Get_Time_Slice (Tsk : Task_Id) return Duration is
    begin
        if Task_Is_Completed (Tsk) then
            return 0.0;
        else
            return Ada_Krn_I.Task_Get_Time_Slice (Tsk);
        end if;
    end Get_Time_Slice;
    procedure Set_Time_Slice (Tsk : Task_Id; New_Time_Slice : Duration) is
    begin
        if not Task_Is_Completed (Tsk) then
            Ada_Krn_I.Task_Set_Time_Slice (Tsk, New_Time_Slice);
        end if;
    end Set_Time_Slice;

    function Get_Time_Slicing return Boolean is
    begin
        return Ada_Krn_I.Kernel_Get_Time_Slicing_Enabled;
    end Get_Time_Slicing;
    procedure Set_Time_Slicing (Enabled : Boolean) is
    begin
        Ada_Krn_I.Kernel_Set_Time_Slicing_Enabled (Enabled);
    end Set_Time_Slicing;

    procedure Disable_Preemption is
    begin
        Ada_Krn_I.Task_Disable_Preemption;
    end Disable_Preemption;
    procedure Enable_Preemption is
    begin
        Ada_Krn_I.Task_Enable_Preemption;
    end Enable_Preemption;
end V_I_Tasks;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=1b rec1=00 rec2=01 rec3=042
        [0x01] rec0=1e rec1=00 rec2=02 rec3=01e
        [0x02] rec0=20 rec1=00 rec2=03 rec3=004
        [0x03] rec0=1f rec1=00 rec2=04 rec3=00e
        [0x04] rec0=06 rec1=00 rec2=05 rec3=000
    tail 0x21754240a874f7c2091ca 0x42a00088462060003