|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 45056 (0xb000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package Ada_Krn_I, seg_04cded
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-- 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/MC68020
--------------------------------------------------------------------------
-------------------------------------------------------------------------
-- 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.
--\x09- When its main procedure returns (at end of server's elaboration),
-- the main task's stack is freed and its micro-kernel thread is
-- stopped/freed.
procedure Program_Set_Is_Server;
pragma Interface (Ada, Program_Set_Is_Server);
pragma Interface_Name (Program_Set_Is_Server,
"__ADA_PROGRAM_SET_IS_SERVER");
-- Returns true if the program is a server
function Program_Is_Server (Prg : Program_Id) return Boolean;
pragma Interface (Ada, Program_Is_Server);
pragma Interface_Name (Program_Is_Server, "__ADA_PROGRAM_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.
-- Returns the task's unique sequence number. This number is >= 0.
--
-- For multiple programs, these sequence numbers are unique
-- across all programs.
function Task_Get_Sequence_Number (Tsk : Task_Id) return Integer;
pragma Interface (Ada, Task_Get_Sequence_Number);
pragma Interface_Name (Task_Get_Sequence_Number,
"__ADA_TASK_GET_SEQUENCE_NUMBER");
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_Get (Iv : Intr_Vector_Id_T) return Address;
-- Returns the address of the currently attached isr.
-- ada_krn_defs.BAD_INTR_VECTOR is returned for a bad intr_vector
-- parameter.
pragma Interface (Ada, Isr_Get);
pragma Interface_Name (Isr_Get, "__ADA_ISR_GET");
function Isr_Get_Ivt return Address;
-- Returns address of the Interrupt Vector Table (IVT). Normally, the
-- IVT is an array of ISR addresses. However, the IVT representation
-- is CPU dependent (for 386 cross, its the IDT).
pragma Interface (Ada, Isr_Get_Ivt);
pragma Interface_Name (Isr_Get_Ivt, "__ADA_ISR_GET_IVT");
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. If it has been stopped, then, return to allow
-- the Ada tasking software to complete itself.
-- 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;
nblk1=2b
nid=0
hdr6=56
[0x00] rec0=1e rec1=00 rec2=01 rec3=020
[0x01] rec0=14 rec1=00 rec2=02 rec3=002
[0x02] rec0=14 rec1=00 rec2=03 rec3=052
[0x03] rec0=17 rec1=00 rec2=04 rec3=004
[0x04] rec0=14 rec1=00 rec2=05 rec3=00e
[0x05] rec0=14 rec1=00 rec2=06 rec3=010
[0x06] rec0=14 rec1=00 rec2=07 rec3=054
[0x07] rec0=14 rec1=00 rec2=08 rec3=01c
[0x08] rec0=0f rec1=00 rec2=09 rec3=020
[0x09] rec0=14 rec1=00 rec2=0a rec3=038
[0x0a] rec0=17 rec1=00 rec2=0b rec3=04e
[0x0b] rec0=17 rec1=00 rec2=0c rec3=06c
[0x0c] rec0=16 rec1=00 rec2=0d rec3=016
[0x0d] rec0=1a rec1=00 rec2=0e rec3=096
[0x0e] rec0=14 rec1=00 rec2=0f rec3=088
[0x0f] rec0=16 rec1=00 rec2=10 rec3=042
[0x10] rec0=15 rec1=00 rec2=11 rec3=036
[0x11] rec0=16 rec1=00 rec2=12 rec3=04a
[0x12] rec0=15 rec1=00 rec2=13 rec3=038
[0x13] rec0=17 rec1=00 rec2=14 rec3=00a
[0x14] rec0=14 rec1=00 rec2=15 rec3=09a
[0x15] rec0=13 rec1=00 rec2=16 rec3=022
[0x16] rec0=12 rec1=00 rec2=17 rec3=03c
[0x17] rec0=13 rec1=00 rec2=18 rec3=032
[0x18] rec0=16 rec1=00 rec2=19 rec3=020
[0x19] rec0=16 rec1=00 rec2=1a rec3=072
[0x1a] rec0=18 rec1=00 rec2=1b rec3=004
[0x1b] rec0=16 rec1=00 rec2=1c rec3=060
[0x1c] rec0=17 rec1=00 rec2=1d rec3=034
[0x1d] rec0=15 rec1=00 rec2=1e rec3=05a
[0x1e] rec0=16 rec1=00 rec2=1f rec3=002
[0x1f] rec0=13 rec1=00 rec2=20 rec3=048
[0x20] rec0=12 rec1=00 rec2=21 rec3=086
[0x21] rec0=14 rec1=00 rec2=22 rec3=02e
[0x22] rec0=15 rec1=00 rec2=23 rec3=014
[0x23] rec0=12 rec1=00 rec2=24 rec3=082
[0x24] rec0=15 rec1=00 rec2=25 rec3=024
[0x25] rec0=13 rec1=00 rec2=26 rec3=03a
[0x26] rec0=11 rec1=00 rec2=27 rec3=02c
[0x27] rec0=14 rec1=00 rec2=28 rec3=06a
[0x28] rec0=14 rec1=00 rec2=29 rec3=01c
[0x29] rec0=14 rec1=00 rec2=2a rec3=00c
[0x2a] rec0=12 rec1=00 rec2=2b rec3=000
tail 0x21754201c874f7bc3a609 0x42a00088462060003