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

⟦762380d59⟧ Ada Source

    Length: 44032 (0xac00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package Ada_Krn_I, seg_04b91b

Derivation

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

E3 Source Code



-- Copyright 1991 Verdix Corporation

with System;
use System;
with Ada_Krn_Defs;
use Ada_Krn_Defs;
with Link_Block;
package Ada_Krn_I is
    pragma Suppress (All_Checks);
    pragma Suppress (Exception_Tables);
    pragma Not_Elaborated;
    pragma Local_Access;

    --------------------------------------------------------------------------
    -- Interface to the Ada kernel services for VADS_MICRO/RS6000
    --------------------------------------------------------------------------

    -------------------------------------------------------------------------
    -- Program services
    -------------------------------------------------------------------------
    --
    -- Note: type program_id is defined in system. Its the address of
    -- the program's Ada PCB (Program Control Block).
    --

    -- If program_init returns, then, the program is ready to exit and
    -- it returns the exit status.
    function Program_Init
                (Usr_Link_Block : Link_Block.A_Link_Block_T;
                 -- link_block has pointers to stack_limit, raise_exception,
                 -- predefined Ada exceptions, configuration table.
                 Init_Continue : Address;
                 -- If we create a new task for the main program, start
                 -- it at init_continue and return when the program is
                 -- ready to exit. Otherwise, simply call init_continue and
                 -- never return.
                 --
                 -- init_continue has the following interface:
                 --
                 --\x09procedure init_continue(prg: program_id);
                 --
                 Ada_Tcb_Size : Natural;
                 Idle_Callout : Address;
                 -- Decides when it is time to exit
                 --
                 -- The idle_callout has the following call interface:
                 --
                 --\x09procedure idle_callout(prg: program_id);
                 --
                 Idle_Stack_Size : Natural;

                 Ada_Pcb_Size : Natural;
                 -- Size of Ada's program control block
                 Init_Ada_Pcb : Address;
                 -- Points to the initial values to be copied into the
                 -- Ada program control block. The Ada pcb must be initialized
                 -- from here before init_continue or idle_callout is called.

                 -- Values for the following parameters were extracted from the
                 -- user's configuration table or were set by pragmas in the
                 -- main procedure.
                 Main_Stack_Size : Natural;
                 Main_Prio : Priority;
                 Exception_Stack_Size : Natural;
                 Priority_Inheritance_Enabled : Boolean) return Integer;
    pragma Interface (Ada, Program_Init);
    pragma Interface_Name (Program_Init, "__ADA_PROGRAM_INIT");

    procedure Program_Exit (Status : Integer);
    pragma Interface (Ada, Program_Exit);
    pragma Interface_Name (Program_Exit, "__ADA_PROGRAM_EXIT");

    procedure Program_Diagnostic (S : String);
    pragma Interface (Ada, Program_Diagnostic);
    pragma Interface_Name (Program_Diagnostic, "__ADA_PROGRAM_DIAGNOSTIC");

    procedure Panic_Exit (S : String; Status : Integer := -1);
    pragma Interface (Ada, Panic_Exit);
    pragma Interface_Name (Panic_Exit, "__ADA_PANIC_EXIT");

    -- Returns TRUE if the program has already been started
    function Program_Is_Active
                (Usr_Link_Block : Link_Block.A_Link_Block_T) return Boolean;
    pragma Interface (Ada, Program_Is_Active);
    pragma Interface_Name (Program_Is_Active, "__ADA_PROGRAM_IS_ACTIVE");

    function Program_Self return Program_Id;
    pragma Interface (Ada, Program_Self);
    pragma Interface_Name (Program_Self, "__ADA_PROGRAM_SELF");

    -------------------------------------------------------------------------
    -- Program services (VADS EXEC augmentation)
    -------------------------------------------------------------------------
    function Program_Get (Tsk : Task_Id) return Program_Id;
    pragma Interface (Ada, Program_Get);
    pragma Interface_Name (Program_Get, "__ADA_PROGRAM_GET");

    -- Returns NO_PROGRAM_ID if not supported or unable to start program
    function Program_Start (Usr_Link_Block : Link_Block.A_Link_Block_T;
                            Key : Address;
                            Terminate_Callout : Address) return Program_Id;
    pragma Interface (Ada, Program_Start);
    pragma Interface_Name (Program_Start, "__ADA_PROGRAM_START");

    -- This procedure is called to mark the current program as a
    -- server program containing procedures called via
    -- ada_krn_i.program_inter_call().
    --
    -- A server program has the following attributes:
    --  - Its automatically terminated when no non-server program is
    --    active.
    --  - Its inhibited from exiting prematurely or being terminated.
    procedure Program_Set_Is_Server;
    pragma Interface (Ada, Program_Set_Is_Server);
    pragma Interface_Name (Program_Set_Is_Server,
                           "__ADA_PROGRAM_SET_IS_SERVER");

    procedure Program_Terminate (Prg : Program_Id; Status : Integer);
    pragma Interface (Ada, Program_Terminate);
    pragma Interface_Name (Program_Terminate, "__ADA_PROGRAM_TERMINATE");

    function Program_Get_Key (Prg : Program_Id) return Address;
    pragma Interface (Ada, Program_Get_Key);
    pragma Interface_Name (Program_Get_Key, "__ADA_PROGRAM_GET_KEY");

    -- Returns NO_PROGRAM_ID if the kernel program isn't also an Ada program
    function Program_Get_Ada_Id (Krn_Prg : Krn_Program_Id) return Program_Id;
    pragma Interface (Ada, Program_Get_Ada_Id);
    pragma Interface_Name (Program_Get_Ada_Id, "__ADA_PROGRAM_GET_ADA_ID");

    function Program_Get_Krn_Id (Prg : Program_Id) return Krn_Program_Id;
    pragma Interface (Ada, Program_Get_Krn_Id);
    pragma Interface_Name (Program_Get_Krn_Id, "__ADA_PROGRAM_GET_KRN_ID");

    -- Call a procedure in another program.
    --
    -- Normally, program_inter_call()
    -- is used in conjunction with the ada_krn_i.name_bind() and
    -- ada_krn_i.name_resolve() services where a name has been bound
    -- to the procedure to be called. Also, the program containing
    -- the procedure should be marked as a server via
    -- ada_krn_i.program_set_is_server().
    --
    -- program_inter_call()'s arg parameter is passed as the only argument
    -- to the called procedure. The called procedure has the following
    -- interface:
    --\x09\x09procedure called_proc(arg: address);
    --\x09\x09for called_proc use at proc_addr;
    --
    -- Before doing the call, the current program is switched.
    -- Also, the stack_limit in the program containing the called
    -- procedure is switched. Before returning, everything is restored.
    --
    -- Note: the PROGRAM_SWITCH_EVENT callouts aren't called. The task's
    -- parent program isn't switched. The PROGRAM_SWITCH_EVENT callouts
    -- are only called when the parent program switches (i.e. when we switch
    -- to another task that is in another parent program).
    --
    -- If the called procedure does any task creates or kernel memory
    -- allocations, then, the program containing the called procedure is the
    -- parent or owner.
    --
    -- Ada exceptions can be raised and handled in the called procedure.
    -- However, program_inter_call() doesn't handle the propogation of Ada
    -- exceptions across inter_program calls. Therefore, the called procedure
    -- must have a handler for all possible Ada exceptions. An Ada exception
    -- raised in the called procedure can have an outer handler that
    -- maps the exception to error status returned to the calling program.
    -- The calling program can then, decode the error status and reraise the
    -- Ada exception.
    --
    -- If the proc_prg argument is NO_PROGRAM_ID or program_self(), then,
    -- the procedure is called directly without switching the current
    -- program or stack_limit. If proc_prg is set to NO_PROGRAM_ID and
    -- the called_proc is in another program, then, the called procedure
    -- must use "pragma suppress(ALL_CHECKS)" and it can't raise any Ada
    -- exceptions. Also, if it calls any kernel services, the calling
    -- program will still be the parent and owner of any created objects.
    procedure Program_Inter_Call
                 (Proc_Prg : Program_Id; Proc_Addr : Address; Arg : Address);
    pragma Interface (Ada, Program_Inter_Call);
    pragma Interface_Name (Program_Inter_Call, "__ADA_PROGRAM_INTER_CALL");


    -------------------------------------------------------------------------
    -- Kernel scheduling services (VADS EXEC augmentation)
    -------------------------------------------------------------------------
    function Kernel_Get_Time_Slicing_Enabled return Boolean;
    pragma Interface (Ada, Kernel_Get_Time_Slicing_Enabled);
    pragma Interface_Name (Kernel_Get_Time_Slicing_Enabled,
                           "__ADA_KERNEL_GET_TIME_SLICING_ENABLED");

    procedure Kernel_Set_Time_Slicing_Enabled (New_Value : Boolean);
    pragma Interface (Ada, Kernel_Set_Time_Slicing_Enabled);
    pragma Interface_Name (Kernel_Set_Time_Slicing_Enabled,
                           "__ADA_KERNEL_SET_TIME_SLICING_ENABLED");


    -------------------------------------------------------------------------
    -- Task management services
    -------------------------------------------------------------------------
    --
    -- Note: type task_id is defined in system. Its the address of
    -- the task's Ada TCB (Task Control Block).
    --

    function Task_Self return Task_Id;
    pragma Inline_Only (Task_Self);

    procedure Task_Set_Priority (Tsk : Task_Id; Prio : Priority);
    pragma Interface (Ada, Task_Set_Priority);
    pragma Interface_Name (Task_Set_Priority, "__ADA_TASK_SET_PRIORITY");

    function Task_Get_Priority (Tsk : Task_Id) return Priority;
    pragma Interface (Ada, Task_Get_Priority);
    pragma Interface_Name (Task_Get_Priority, "__ADA_TASK_GET_PRIORITY");

    -- Returns NO_TASK_ID if task create is unsuccessful.
    function Task_Create (Prio : Priority;
                          Stack_Size : Natural;
                          Start : Address;
                          Task_Attr : A_Task_Attr_T) return Task_Id;
    pragma Interface (Ada, Task_Create);
    pragma Interface_Name (Task_Create, "__ADA_TASK_CREATE");
    --
    -- Upon entry/exit: the masters' mutex is locked. This inhibits
    -- task_self from being stopped.

    procedure Task_Activate (Tsk : Task_Id);
    pragma Interface (Ada, Task_Activate);
    pragma Interface_Name (Task_Activate, "__ADA_TASK_ACTIVATE");
    --
    -- Upon entry/exit: task_self is locked. This inhibits
    -- task_self from being stopped.

    function Task_Stop (Tsk : Task_Id) return Boolean;
    -- Returns TRUE if the task was stopped.
    -- Not applicable to current task.
    --
    -- Upon entry/exit: the task is locked. Also, masters' mutex is locked.
    --
    -- NOTE: need to be able to stop a task that has been created
    -- but not yet activated. Also need to be able to stop a task
    -- that is blocked at a task_wait.
    --
    -- Implementation guideline: return FALSE if the task can't be stopped
    -- asynchronously. At the next Ada synch point (delay, rendezvous, ...)
    -- the task will call task_stop_self(). However, must signal a task
    -- that is doing a task_wait().
    pragma Interface (Ada, Task_Stop);
    pragma Interface_Name (Task_Stop, "__ADA_TASK_STOP");

    procedure Task_Destroy (Tsk : Task_Id);
    pragma Interface (Ada, Task_Destroy);
    pragma Interface_Name (Task_Destroy, "__ADA_TASK_DESTROY");
    -- A previous call has been made to task_stop or task_stop_self for the
    -- task to be destroyed.
    -- Not applicable to current task
    --
    -- Upon entry/exit: the task is locked. Also, masters' mutex is locked.

    procedure Task_Stop_Self;
    pragma Interface (Ada, Task_Stop_Self);
    pragma Interface_Name (Task_Stop_Self, "__ADA_TASK_STOP_SELF");
    -- A subsequent call will be made to task_destroy from another
    -- task.
    --
    -- Upon entry: the task is locked. It should be unlocked
    -- before switching to another task. Note, after the task is
    -- unlocked, no fields may be referenced in the task control block.
    -- A higher priority task may immediately acquire the task's lock
    -- and do a task_destroy().
    --
    -- No return.

    procedure Task_Destroy_Self;
    pragma Interface (Ada, Task_Destroy_Self);
    pragma Interface_Name (Task_Destroy_Self, "__ADA_TASK_DESTROY_SELF");
    --
    -- Upon entry the task is locked
    --
    -- No return.

    -------------------------------------------------------------------------
    -- Task management services (VADS EXEC augmentation)
    -------------------------------------------------------------------------
    procedure Task_Disable_Preemption;
    pragma Interface (Ada, Task_Disable_Preemption);
    pragma Interface_Name (Task_Disable_Preemption,
                           "__ADA_TASK_DISABLE_PREEMPTION");

    procedure Task_Enable_Preemption;
    pragma Interface (Ada, Task_Enable_Preemption);
    pragma Interface_Name (Task_Enable_Preemption,
                           "__ADA_TASK_ENABLE_PREEMPTION");

    -- Returns NO_TASK_ID if the kernel task isn't also an Ada task
    function Task_Get_Ada_Id (Krn_Tsk : Krn_Task_Id) return Task_Id;
    pragma Interface (Ada, Task_Get_Ada_Id);
    pragma Interface_Name (Task_Get_Ada_Id, "__ADA_TASK_GET_ADA_ID");

    function Task_Get_Krn_Id (Tsk : Task_Id) return Krn_Task_Id;
    pragma Interface (Ada, Task_Get_Krn_Id);
    pragma Interface_Name (Task_Get_Krn_Id, "__ADA_TASK_GET_KRN_ID");

    -- Returns TRUE if the suspend was sucessful.
    function Task_Suspend (Tsk : Task_Id) return Boolean;
    pragma Interface (Ada, Task_Suspend);
    pragma Interface_Name (Task_Suspend, "__ADA_TASK_SUSPEND");

    -- Returns TRUE if the resume was sucessful.
    function Task_Resume (Tsk : Task_Id) return Boolean;
    pragma Interface (Ada, Task_Resume);
    pragma Interface_Name (Task_Resume, "__ADA_TASK_RESUME");

    function Task_Get_Time_Slice (Tsk : Task_Id) return Duration;
    pragma Interface (Ada, Task_Get_Time_Slice);
    pragma Interface_Name (Task_Get_Time_Slice, "__ADA_TASK_GET_TIME_SLICE");

    procedure Task_Set_Time_Slice (Tsk : Task_Id; New_Interval : Duration);
    pragma Interface (Ada, Task_Set_Time_Slice);
    pragma Interface_Name (Task_Set_Time_Slice, "__ADA_TASK_SET_TIME_SLICE");

    -- Returns TRUE if current task is in supervisor state
    function Task_Get_Supervisor_State return Boolean;
    pragma Interface (Ada, Task_Get_Supervisor_State);
    pragma Interface_Name (Task_Get_Supervisor_State,
                           "__ADA_TASK_GET_SUPERVISOR_STATE");

    procedure Task_Enter_Supervisor_State;
    pragma Interface (Ada, Task_Enter_Supervisor_State);
    pragma Interface_Name (Task_Enter_Supervisor_State,
                           "__ADA_TASK_ENTER_SUPERVISOR_STATE");

    procedure Task_Leave_Supervisor_State;
    pragma Interface (Ada, Task_Leave_Supervisor_State);
    pragma Interface_Name (Task_Leave_Supervisor_State,
                           "__ADA_TASK_LEAVE_SUPERVISOR_STATE");

    -------------------------------------------------------------------------
    -- Task masters synchronization services
    -------------------------------------------------------------------------
    procedure Masters_Lock;
    -- masters' mutex is locked before any task's mutex is locked
    -- except for the case where masters_trylock() is called.
    --
    -- A nested masters_lock() from the same task is erroneous.
    pragma Interface (Ada, Masters_Lock);
    pragma Interface_Name (Masters_Lock, "__ADA_MASTERS_LOCK");

    function Masters_Trylock return Boolean;
    -- If not supported, simply return FALSE. When FALSE is returned
    -- the task's mutex is unlocked and then the above masters_lock()
    -- is called
    pragma Interface (Ada, Masters_Trylock);
    pragma Interface_Name (Masters_Trylock, "__ADA_MASTERS_TRYLOCK");

    procedure Masters_Unlock;
    pragma Interface (Ada, Masters_Unlock);
    pragma Interface_Name (Masters_Unlock, "__ADA_MASTERS_UNLOCK");

    -------------------------------------------------------------------------
    -- Task synchronization services
    -------------------------------------------------------------------------
    procedure Task_Lock (Tsk : Task_Id);
    pragma Interface (Ada, Task_Lock);
    pragma Interface_Name (Task_Lock, "__ADA_TASK_LOCK");

    procedure Task_Unlock (Tsk : Task_Id);
    pragma Interface (Ada, Task_Unlock);
    pragma Interface_Name (Task_Unlock, "__ADA_TASK_UNLOCK");

    procedure Task_Wait (Locked_Tsk : Task_Id);
    -- locked_tsk may be the current or another task. locked_tsk is unlocked
    -- while the current task waits and relocked before task_wait()
    -- returns
    --
    -- Note: only return after task_self has been signaled. task_self
    -- is only signaled once after another task locks the locked_tsk's mutex.
    -- This differs from waiting on a POSIX condition variable.
    --
    -- Implementation guideline: if locked_tsk /= task_self(), then,
    -- Ada tasking RTS inhibits task_self from being stopped.
    pragma Interface (Ada, Task_Wait);
    pragma Interface_Name (Task_Wait, "__ADA_TASK_WAIT");

    procedure Task_Wait_Locked_Masters;   -- The masters' mutex has already been locked. The masters'
    -- mutex is unlocked while the current task waits and is relocked
    -- before task_wait_locked_masters() returns.
    pragma Interface (Ada, Task_Wait_Locked_Masters);
    pragma Interface_Name (Task_Wait_Locked_Masters,
                           "__ADA_TASK_WAIT_LOCKED_MASTERS");
    --
    -- Upon entry: task_self's mutex isn't locked.
    --
    -- Note: only return after task_self has been signaled. task_self
    -- is only signaled once after another task locks the masters' mutex.
    -- This differs from waiting on a POSIX condition variable.

    function Task_Timed_Wait
                (Locked_Tsk : Task_Id; Sec : Duration) return Boolean;
    pragma Interface (Ada, Task_Timed_Wait);
    pragma Interface_Name (Task_Timed_Wait, "__ADA_TASK_TIMED_WAIT");
    --
    -- Implementation guideline: if locked_tsk /= task_self(), then,
    -- Ada tasking RTS inhibits task_self from being stopped.

    procedure Task_Signal (Tsk : Task_Id);
    pragma Interface (Ada, Task_Signal);
    pragma Interface_Name (Task_Signal, "__ADA_TASK_SIGNAL");

    -- task_wait, task_unlock
    procedure Task_Wait_Unlock (Locked_Tsk : Task_Id);
    pragma Interface (Ada, Task_Wait_Unlock);
    pragma Interface_Name (Task_Wait_Unlock, "__ADA_TASK_WAIT_UNLOCK");

    -- task_signal, task_unlock
    procedure Task_Signal_Unlock
                 (Tsk_To_Signal : Task_Id; Locked_Tsk : Task_Id);
    pragma Interface (Ada, Task_Signal_Unlock);
    pragma Interface_Name (Task_Signal_Unlock, "__ADA_TASK_SIGNAL_UNLOCK");

    -- task_signal, task_wait, task_unlock
    procedure Task_Signal_Wait_Unlock
                 (Tsk_To_Signal : Task_Id; Locked_Tsk : Task_Id);
    pragma Interface (Ada, Task_Signal_Wait_Unlock);
    pragma Interface_Name (Task_Signal_Wait_Unlock,
                           "__ADA_TASK_SIGNAL_WAIT_UNLOCK");

    -------------------------------------------------------------------------
    -- Sporadic task services (CIFO augmentation)
    -------------------------------------------------------------------------
    -- Returns TRUE for a sporadic task
    function Task_Is_Sporadic (Tsk : Task_Id) return Boolean;
    pragma Interface (Ada, Task_Is_Sporadic);
    pragma Interface_Name (Task_Is_Sporadic, "__ADA_TASK_IS_SPORADIC");

    -- For a sporadic task: eventhough it might have already consumed all
    -- of its available execution time for the replenishment period, force it
    -- to use its normal high priority instead of its background low priority.
    --
    -- This routine is called by Ada tasking to force the high priority
    -- if another task does a rendezvous with the sporadic task. This
    -- routine is called when the rendezvous completes with the flag
    -- set to FALSE to no longer force the high priority.
    --
    -- Upon entry/exit: tsk is locked
    procedure Task_Set_Force_High_Priority (Tsk : Task_Id; Flag : Boolean);
    pragma Interface (Ada, Task_Set_Force_High_Priority);
    pragma Interface_Name (Task_Set_Force_High_Priority,
                           "__ADA_TASK_SET_FORCE_HIGH_PRIORITY");

    -------------------------------------------------------------------------
    -- Interrupt services
    -------------------------------------------------------------------------
    procedure Interrupts_Get_Status (Status : out Intr_Status_T);
    pragma Interface (Ada, Interrupts_Get_Status);
    pragma Interface_Name (Interrupts_Get_Status,
                           "__ADA_INTERRUPTS_GET_STATUS");
    procedure Interrupts_Set_Status
                 (Old_Status : out Intr_Status_T; New_Status : Intr_Status_T);
    pragma Interface (Ada, Interrupts_Set_Status);
    pragma Interface_Name (Interrupts_Set_Status,
                           "__ADA_INTERRUPTS_SET_STATUS");
    function Isr_Attach (Iv : Intr_Vector_Id_T; Isr : Address) return Address;
    -- Returns address of previously attached isr.
    -- ada_krn_defs.BAD_INTR_VECTOR is returned for a bad intr_vector
    -- parameter.
    pragma Interface (Ada, Isr_Attach);
    pragma Interface_Name (Isr_Attach, "__ADA_ISR_ATTACH");
    function Isr_Detach (Iv : Intr_Vector_Id_T) return Address;
    -- Returns address of previously attached isr.
    -- ada_krn_defs.BAD_INTR_VECTOR is returned for a bad intr_vector
    -- parameter.
    pragma Interface (Ada, Isr_Detach);
    pragma Interface_Name (Isr_Detach, "__ADA_ISR_DETACH");

    function Isr_In_Check return Boolean;
    pragma Inline_Only (Isr_In_Check);

    -------------------------------------------------------------------------
    -- Time services
    -------------------------------------------------------------------------
    procedure Time_Set (Day : Day_T;
                        Sec : Duration;
                        Timer_Support_Arg : Address := No_Addr);
    pragma Interface (Ada, Time_Set);
    pragma Interface_Name (Time_Set, "__ADA_TIME_SET");
    --
    -- timer_support_arg - on self-hosts, if not NO_ADDR, then,
    -- the address of the OS's time record. This allows, time_set()
    -- to be atomically set with the OS's current time. For an
    -- example, see how v_i_time.set_time() is called in calendar_s.a.

    -- Returned time is normalized, sec < 86400.0
    procedure Time_Get (Day : out Day_T; Sec : out Duration);
    pragma Interface (Ada, Time_Get);
    pragma Interface_Name (Time_Get, "__ADA_TIME_GET");

    procedure Time_Delay (Sec : Duration);
    pragma Interface (Ada, Time_Delay);
    pragma Interface_Name (Time_Delay, "__ADA_TIME_DELAY");
    --
    -- Implementation guideline: this service can be implemented via:
    --  task_lock(task_self);
    --  task_timed_wait(task_self, sec);
    --  task_unlock(task_self);
    --
    --  after, task_self is locked, you might need to check if it has
    --  been stopped.

    -- Upon entry time has already been normalized (sec < 86400.0)
    procedure Time_Delay_Until (Day : Day_T; Sec : Duration);
    pragma Interface (Ada, Time_Delay_Until);
    pragma Interface_Name (Time_Delay_Until, "__ADA_TIME_DELAY_UNTIL");

    -------------------------------------------------------------------------
    -- Allocation services
    -------------------------------------------------------------------------
    -- Returns NO_ADDR if alloc is unsuccessful.
    function Alloc (Size : Natural) return Address;
    pragma Interface (Ada, Alloc);
    pragma Interface_Name (Alloc, "__ADA_ALLOC");

    procedure Free (A : Address);
    pragma Interface (Ada, Free);
    pragma Interface_Name (Free, "__ADA_FREE");

    -------------------------------------------------------------------------
    -- Mutex services
    -------------------------------------------------------------------------
    -- Returns TRUE if mutex was successfully initialized.
    function Mutex_Init
                (Mutex : A_Mutex_T; Attr : A_Mutex_Attr_T) return Boolean;
    pragma Interface (Ada, Mutex_Init);
    pragma Interface_Name (Mutex_Init, "__ADA_MUTEX_INIT");

    procedure Mutex_Destroy (Mutex : A_Mutex_T);
    pragma Interface (Ada, Mutex_Destroy);
    pragma Interface_Name (Mutex_Destroy, "__ADA_MUTEX_DESTROY");

    procedure Mutex_Lock (Mutex : A_Mutex_T);
    pragma Interface (Ada, Mutex_Lock);
    pragma Interface_Name (Mutex_Lock, "__ADA_MUTEX_LOCK");

    function Mutex_Trylock (Mutex : A_Mutex_T) return Boolean;
    pragma Interface (Ada, Mutex_Trylock);
    pragma Interface_Name (Mutex_Trylock, "__ADA_MUTEX_TRYLOCK");

    procedure Mutex_Unlock (Mutex : A_Mutex_T);
    pragma Interface (Ada, Mutex_Unlock);
    pragma Interface_Name (Mutex_Unlock, "__ADA_MUTEX_UNLOCK");

    -- Returns TRUE if cond variable was successfully initialized.
    function Cond_Init (Cond : A_Cond_T; Attr : A_Cond_Attr_T) return Boolean;
    pragma Interface (Ada, Cond_Init);
    pragma Interface_Name (Cond_Init, "__ADA_COND_INIT");

    procedure Cond_Destroy (Cond : A_Cond_T);
    pragma Interface (Ada, Cond_Destroy);
    pragma Interface_Name (Cond_Destroy, "__ADA_COND_DESTROY");

    procedure Cond_Wait (Cond : A_Cond_T; Mutex : A_Mutex_T);
    pragma Interface (Ada, Cond_Wait);
    pragma Interface_Name (Cond_Wait, "__ADA_COND_WAIT");

    function Cond_Timed_Wait
                (Cond : A_Cond_T; Mutex : A_Mutex_T; Sec : Duration)
                return Boolean;
    pragma Interface (Ada, Cond_Timed_Wait);
    pragma Interface_Name (Cond_Timed_Wait, "__ADA_COND_TIMED_WAIT");

    procedure Cond_Signal (Cond : A_Cond_T);
    pragma Interface (Ada, Cond_Signal);
    pragma Interface_Name (Cond_Signal, "__ADA_COND_SIGNAL");

    procedure Cond_Broadcast (Cond : A_Cond_T);
    pragma Interface (Ada, Cond_Broadcast);
    pragma Interface_Name (Cond_Broadcast, "__ADA_COND_BROADCAST");

    procedure Cond_Signal_Unlock (Cond : A_Cond_T; Mutex : A_Mutex_T);
    pragma Interface (Ada, Cond_Signal_Unlock);
    pragma Interface_Name (Cond_Signal_Unlock, "__ADA_COND_SIGNAL_UNLOCK");

    -------------------------------------------------------------------------
    -- ISR mutex services
    -------------------------------------------------------------------------
    -- Returns TRUE if mutex can be locked from an ISR
    function Isr_Mutex_Lockable (Mutex : A_Mutex_T) return Boolean;
    pragma Interface (Ada, Isr_Mutex_Lockable);
    pragma Interface_Name (Isr_Mutex_Lockable, "__ADA_ISR_MUTEX_LOCKABLE");

    procedure Isr_Mutex_Lock (Mutex : A_Mutex_T);
    pragma Interface (Ada, Isr_Mutex_Lock);
    pragma Interface_Name (Isr_Mutex_Lock, "__ADA_ISR_MUTEX_LOCK");

    procedure Isr_Mutex_Unlock (Mutex : A_Mutex_T);
    pragma Inline_Only (Isr_Mutex_Unlock);

    procedure Isr_Cond_Signal (Cond : A_Cond_T);
    pragma Interface (Ada, Isr_Cond_Signal);
    pragma Interface_Name (Isr_Cond_Signal, "__ADA_ISR_COND_SIGNAL");


    -------------------------------------------------------------------------
    -- Priority ceiling mutex services (CIFO augmentation)
    -------------------------------------------------------------------------
    -- Returns TRUE if underlying threads supports priority ceiling
    -- protocol and the mutex was successfully initialized.
    function Ceiling_Mutex_Init
                (Mutex : A_Mutex_T;
                 Attr : A_Mutex_Attr_T;
                 Ceiling_Prio : Priority := Priority'Last) return Boolean;
    pragma Interface (Ada, Ceiling_Mutex_Init);
    pragma Interface_Name (Ceiling_Mutex_Init, "__ADA_CEILING_MUTEX_INIT");

    -- Returns FALSE if not a priority ceiling mutex
    function Ceiling_Mutex_Set_Priority
                (Mutex : A_Mutex_T; Ceiling_Prio : Priority) return Boolean;
    pragma Interface (Ada, Ceiling_Mutex_Set_Priority);
    pragma Interface_Name (Ceiling_Mutex_Set_Priority,
                           "__ADA_CEILING_MUTEX_SET_PRIORITY");

    -- Returns -1 if not a priority ceiling mutex
    function Ceiling_Mutex_Get_Priority (Mutex : A_Mutex_T) return Integer;
    pragma Interface (Ada, Ceiling_Mutex_Get_Priority);
    pragma Interface_Name (Ceiling_Mutex_Get_Priority,
                           "__ADA_CEILING_MUTEX_GET_PRIORITY");


    -------------------------------------------------------------------------
    -- Semaphore services
    -------------------------------------------------------------------------
    -- Returns TRUE if semaphore was successfully initialized.
    function Semaphore_Init (S : A_Semaphore_T;
                             Init_State : Semaphore_State_T;
                             Attr : A_Semaphore_Attr_T) return Boolean;
    pragma Interface (Ada, Semaphore_Init);
    pragma Interface_Name (Semaphore_Init, "__ADA_SEMAPHORE_INIT");

    procedure Semaphore_Destroy (S : A_Semaphore_T);
    pragma Interface (Ada, Semaphore_Destroy);
    pragma Interface_Name (Semaphore_Destroy, "__ADA_SEMAPHORE_DESTROY");

    procedure Semaphore_Wait (S : A_Semaphore_T);
    pragma Interface (Ada, Semaphore_Wait);
    pragma Interface_Name (Semaphore_Wait, "__ADA_SEMAPHORE_WAIT");

    function Semaphore_Trywait (S : A_Semaphore_T) return Boolean;
    pragma Interface (Ada, Semaphore_Trywait);
    pragma Interface_Name (Semaphore_Trywait, "__ADA_SEMAPHORE_TRYWAIT");

    function Semaphore_Timed_Wait
                (S : A_Semaphore_T; Sec : Duration) return Boolean;
    pragma Interface (Ada, Semaphore_Timed_Wait);
    pragma Interface_Name (Semaphore_Timed_Wait, "__ADA_SEMAPHORE_TIMED_WAIT");

    procedure Semaphore_Signal (S : A_Semaphore_T);
    pragma Interface (Ada, Semaphore_Signal);
    pragma Interface_Name (Semaphore_Signal, "__ADA_SEMAPHORE_SIGNAL");

    -- The following is called by the VADS EXEC delete_semaphore() service
    -- (for a binary semaphore).  It should return TRUE if any task is waiting
    -- on the semaphore.  If you are unable to detect this condition, then,
    -- return TRUE.  By returning TRUE, you cause the delete_semaphore()
    -- service to do a dummy semaphore signal and then wait a few seconds
    -- before freeing the semaphore resources.
    function Semaphore_Get_In_Use (S : A_Semaphore_T) return Boolean;
    pragma Interface (Ada, Semaphore_Get_In_Use);
    pragma Interface_Name (Semaphore_Get_In_Use, "__ADA_SEMAPHORE_GET_IN_USE");

    -------------------------------------------------------------------------
    -- Count semaphore services (VADS EXEC augmentation)
    -------------------------------------------------------------------------
    -- Returns TRUE if semaphore was successfully initialized.
    function Count_Semaphore_Init
                (S : A_Count_Semaphore_T;
                 Init_Count : Integer;
                 Attr : A_Count_Semaphore_Attr_T) return Boolean;
    pragma Interface (Ada, Count_Semaphore_Init);
    pragma Interface_Name (Count_Semaphore_Init, "__ADA_COUNT_SEMAPHORE_INIT");

    procedure Count_Semaphore_Destroy (S : A_Count_Semaphore_T);
    pragma Interface (Ada, Count_Semaphore_Destroy);
    pragma Interface_Name (Count_Semaphore_Destroy,
                           "__ADA_COUNT_SEMAPHORE_DESTROY");

    -- Waits on a counting semaphore.
    --
    -- Returns TRUE, if semaphore count > 0. The count is decremented
    -- before returning.
    --
    -- If count <= 0, then, returns according to the wait_time parameter:
    --  < 0.0    \x09    - returns when count > 0. This may necessitate
    --                    suspension of current task until another task
    --                    signals.
    --  = 0.0     \x09    - returns FALSE immediately if count <= 0.
    --  > 0.0           - if count doesn't become positive
    --                    within "wait_time" amount of time, returns FALSE.
    function Count_Semaphore_Wait
                (S : A_Count_Semaphore_T; Wait_Time : Duration) return Boolean;
    pragma Interface (Ada, Count_Semaphore_Wait);
    pragma Interface_Name (Count_Semaphore_Wait, "__ADA_COUNT_SEMAPHORE_WAIT");

    -- Signals a counting semaphore.
    --
    -- Increments the semphore's count. If count > 0, resumes next
    -- task waiting on semaphore.
    procedure Count_Semaphore_Signal (S : A_Count_Semaphore_T);
    pragma Interface (Ada, Count_Semaphore_Signal);
    pragma Interface_Name (Count_Semaphore_Signal,
                           "__ADA_COUNT_SEMAPHORE_SIGNAL");

    -- The following is called by the VADS EXEC delete_semaphore() service
    -- (for a count semaphore).  It should return TRUE if any task is waiting
    -- on the semaphore.  If you are unable to detect this condition, then,
    -- return TRUE.  By returning TRUE, you cause the delete_semaphore()
    -- service to do a dummy semaphore signal and then wait a few seconds
    -- before freeing the semaphore resources.
    function Count_Semaphore_Get_In_Use
                (S : A_Count_Semaphore_T) return Boolean;
    pragma Interface (Ada, Count_Semaphore_Get_In_Use);
    pragma Interface_Name (Count_Semaphore_Get_In_Use,
                           "__ADA_COUNT_SEMAPHORE_GET_IN_USE");


    -------------------------------------------------------------------------
    -- Mailbox services (VADS EXEC augmentation)
    -------------------------------------------------------------------------
    -- Returns TRUE if mailbox was successfully initialized.
    function Mailbox_Init (M : A_Mailbox_T;
                           Slots_Cnt : Positive;
                           Slot_Len : Natural;
                           Attr : A_Mailbox_Attr_T) return Boolean;
    pragma Interface (Ada, Mailbox_Init);
    pragma Interface_Name (Mailbox_Init, "__ADA_MAILBOX_INIT");

    procedure Mailbox_Destroy (M : A_Mailbox_T);
    pragma Interface (Ada, Mailbox_Destroy);
    pragma Interface_Name (Mailbox_Destroy, "__ADA_MAILBOX_DESTROY");

    -- Reads a message from a mailbox. Returns TRUE if message was
    -- successfully read.
    --
    -- If no message is available for reading, then, returns according to
    -- the wait_time parameter:
    --  < 0.0           - returns when message was successfully read.
    --                    This may necessitate suspension of current task
    --                    until another task does mailbox write.
    --  = 0.0           - returns FALSE immediately if unable to do
    --                    mailbox read
    --  > 0.0           - if the mailbox read cannot be completed
    --                    within "wait_time" amount of time, returns FALSE.
    function Mailbox_Read
                (M : A_Mailbox_T; Msg_Addr : Address; Wait_Time : Duration)
                return Boolean;
    pragma Interface (Ada, Mailbox_Read);
    pragma Interface_Name (Mailbox_Read, "__ADA_MAILBOX_READ");

    -- Writes a message to a mailbox. Returns FALSE if no slot is
    -- available for writing.
    function Mailbox_Write (M : A_Mailbox_T; Msg_Addr : Address) return Boolean;
    pragma Interface (Ada, Mailbox_Write);
    pragma Interface_Name (Mailbox_Write, "__ADA_MAILBOX_WRITE");

    -- Returns number of unread messages in mailbox
    function Mailbox_Get_Count (M : A_Mailbox_T) return Natural;
    pragma Interface (Ada, Mailbox_Get_Count);
    pragma Interface_Name (Mailbox_Get_Count, "__ADA_MAILBOX_GET_COUNT");

    -- The following is called by the VADS EXEC delete_mailbox() service.
    -- It should return TRUE if any task is waiting to read from the mailbox.
    -- If you are unable to detect this condition, then, return TRUE.
    -- By returning TRUE, you cause the delete_mailbox() service to
    -- do a dummy mailbox write and wait a few seconds before freeing
    -- the mailbox resources.
    function Mailbox_Get_In_Use (M : A_Mailbox_T) return Boolean;
    pragma Interface (Ada, Mailbox_Get_In_Use);
    pragma Interface_Name (Mailbox_Get_In_Use, "__ADA_MAILBOX_GET_IN_USE");

    -------------------------------------------------------------------------
    -- Callout and task storage services (VADS EXEC augmentation)
    -------------------------------------------------------------------------
    -- Service to install a callout. Returns FALSE if service isn't
    -- supported or unable to do the install.
    function Callout_Install
                (Event : Callout_Event_T; Proc : Address) return Boolean;
    pragma Interface (Ada, Callout_Install);
    pragma Interface_Name (Callout_Install, "__ADA_CALLOUT_INSTALL");

    -- Service to allocate storage in the task control block. Returns
    -- NO_TASK_STORAGE_ID if service isn't supported or unable to
    -- allocate memory.
    function Task_Storage_Alloc (Size : Natural) return Task_Storage_Id;
    pragma Interface (Ada, Task_Storage_Alloc);
    pragma Interface_Name (Task_Storage_Alloc, "__ADA_TASK_STORAGE_ALLOC");

    function Task_Storage_Get
                (Tsk : Task_Id; Storage : Task_Storage_Id) return Address;
    pragma Interface (Ada, Task_Storage_Get);
    pragma Interface_Name (Task_Storage_Get, "__ADA_TASK_STORAGE_GET");

    function Task_Storage_Get2
                (Krn_Tsk : Krn_Task_Id; Storage : Task_Storage_Id)
                return Address;
    pragma Interface (Ada, Task_Storage_Get2);
    pragma Interface_Name (Task_Storage_Get2, "__ADA_TASK_STORAGE_GET2");


    -------------------------------------------------------------------------
    -- Name services (VADS EXEC augmentation)
    -------------------------------------------------------------------------
    -- Bind a name to the program_id and address of a procedure or object.
    --
    -- The name parameter can be any sequence of characters. An exact
    -- match is done for all name searches. ("MY_NAME" diffs from "my_name".)
    --
    -- The prg parameter should be set to NO_PROGRAM_ID if the name
    -- isn't bound to a particular program or if the current program and
    -- stack limit switch logic are to be eliminated for an
    -- ada_krn_i.program_inter_call(). All procedures and objects in the kernel
    -- program are bound with prg implicitly set to NO_PROGRAM_ID.
    --
    -- If successful, name_bind returns ada_krn_defs.NAME_BIND_OK. Otherwise,
    -- it returns one of the following error codes also found in ada_krn_defs:
    -- \x09NAME_BIND_NOT_SUPPORTED
    --\x09NAME_BIND_BAD_ARG
    --\x09NAME_BIND_OUT_OF_MEMORY
    --\x09NAME_BIND_ALREADY_BOUND
    function Name_Bind (Name : String; Prg : Program_Id; Addr : Address)
                       return Name_Bind_Status_T;
    pragma Interface (Ada, Name_Bind);
    pragma Interface_Name (Name_Bind, "__ADA_NAME_BIND");

    -- Resolve the name of a procedure or object into its program_id and
    -- address.
    --
    -- name_resolve first attempts to find an already bound name that
    -- exactly matches the name parameter. For a match, it returns
    -- immediately with the prg and addr out parameters updated and
    -- status set to ada_krn_defs.NAME_RESOLVE_OK. Otherwise, it
    -- returns according to the wait_time parameter:
    --  < 0.0           - waits indefinitely until the name is bound
    --  = 0.0           - returns immediately with status set to
    --                    NAME_RESOLVE_FAILED
    --  > 0.0           - if the name isn't bound within "wait_time",
    --                    returns with status set to NAME_RESOLVE_TIMED_OUT
    --
    -- If name services aren't supported or name_resolve was called with
    -- a bad argument, then, status is set to NAME_RESOLVE_NOT_SUPPORTED
    -- or NAME_RESOLVE_BAD_ARG.
    procedure Name_Resolve (Name : String;
                            Wait_Time : Duration;
                            Prg : out Program_Id;
                            Addr : out Address;
                            Status : out Name_Resolve_Status_T);
    pragma Interface (Ada, Name_Resolve);
    pragma Interface_Name (Name_Resolve, "__ADA_NAME_RESOLVE");

end Ada_Krn_I;

E3 Meta Data

    nblk1=2a
    nid=0
    hdr6=54
        [0x00] rec0=1e rec1=00 rec2=01 rec3=022
        [0x01] rec0=14 rec1=00 rec2=02 rec3=004
        [0x02] rec0=14 rec1=00 rec2=03 rec3=054
        [0x03] rec0=17 rec1=00 rec2=04 rec3=006
        [0x04] rec0=14 rec1=00 rec2=05 rec3=010
        [0x05] rec0=13 rec1=00 rec2=06 rec3=086
        [0x06] rec0=15 rec1=00 rec2=07 rec3=07e
        [0x07] rec0=11 rec1=00 rec2=08 rec3=06c
        [0x08] rec0=12 rec1=00 rec2=09 rec3=064
        [0x09] rec0=17 rec1=00 rec2=0a rec3=048
        [0x0a] rec0=16 rec1=00 rec2=0b rec3=008
        [0x0b] rec0=17 rec1=00 rec2=0c rec3=02a
        [0x0c] rec0=17 rec1=00 rec2=0d rec3=084
        [0x0d] rec0=18 rec1=00 rec2=0e rec3=022
        [0x0e] rec0=14 rec1=00 rec2=0f rec3=08a
        [0x0f] rec0=16 rec1=00 rec2=10 rec3=006
        [0x10] rec0=15 rec1=00 rec2=11 rec3=026
        [0x11] rec0=17 rec1=00 rec2=12 rec3=002
        [0x12] rec0=13 rec1=00 rec2=13 rec3=07a
        [0x13] rec0=18 rec1=00 rec2=14 rec3=062
        [0x14] rec0=12 rec1=00 rec2=15 rec3=066
        [0x15] rec0=12 rec1=00 rec2=16 rec3=018
        [0x16] rec0=16 rec1=00 rec2=17 rec3=006
        [0x17] rec0=18 rec1=00 rec2=18 rec3=018
        [0x18] rec0=15 rec1=00 rec2=19 rec3=01e
        [0x19] rec0=17 rec1=00 rec2=1a rec3=00c
        [0x1a] rec0=19 rec1=00 rec2=1b rec3=00c
        [0x1b] rec0=15 rec1=00 rec2=1c rec3=004
        [0x1c] rec0=13 rec1=00 rec2=1d rec3=040
        [0x1d] rec0=14 rec1=00 rec2=1e rec3=05e
        [0x1e] rec0=16 rec1=00 rec2=1f rec3=01c
        [0x1f] rec0=10 rec1=00 rec2=20 rec3=074
        [0x20] rec0=15 rec1=00 rec2=21 rec3=00c
        [0x21] rec0=12 rec1=00 rec2=22 rec3=086
        [0x22] rec0=15 rec1=00 rec2=23 rec3=020
        [0x23] rec0=13 rec1=00 rec2=24 rec3=04e
        [0x24] rec0=13 rec1=00 rec2=25 rec3=04a
        [0x25] rec0=12 rec1=00 rec2=26 rec3=04e
        [0x26] rec0=15 rec1=00 rec2=27 rec3=074
        [0x27] rec0=15 rec1=00 rec2=28 rec3=00c
        [0x28] rec0=12 rec1=00 rec2=29 rec3=00c
        [0x29] rec0=07 rec1=00 rec2=2a rec3=000
    tail 0x21750b7d086843486776a 0x42a00088462060003