|
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 - download
Length: 9130 (0x23aa)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦97b266e22⟧
└─⟦this⟧
-- Copyright 1989, 1991, 1992 Verdix Corporation
------------------------------------------------------------------------------
-- User interface to the program / task callout services
--
-- Provides backward compatibility with earlier releases of VADS.
--
-- The interface to ALL the low kernel services is now provided in
-- ada_krn_i.a. Types used by these services is defined in ada_krn_defs.a.
--
-- This package simply layers upon the callout data structures and
-- subprograms found in ada_krn_defs.a and ada_krn_i.a.
--
-- Differences from earlier releases:
-- [1] Only the callout events, EXIT_EVENT and UNEXPECTED_EXIT_EVENT
-- are supported by all the underlying RTS kernels. The
-- VADS_MICRO RTS continues to support the events:
-- PROGRAM_SWITCH_EVENT, TASK_CREATE_EVENT, TASK_SWITCH_EVENT
-- and TASK_COMPLETE_EVENT. The event, IDLE_EVENT has been
-- added for the VADS_MICRO RTS.
-- [2] For VADS_MICRO: the task events are called with a pointer to
-- the micro kernel's task control block, not the Ada task_id as was
-- done in earlier releases.
-- [3] For VADS_MICRO: the program events are called with a pointer to
-- the micro kernel's program control block, not the Ada program_id as was
-- done in earlier releases.
-- [4] Added the service, get_task_storage2() to get the address of
-- task storage using the underlying kernel's task_id (not the
-- Ada task_id as is used for get_task_storage()). This was added
-- because the task callouts are called with the kernel's task_id
-- and not the Ada task_id.
------------------------------------------------------------------------------
with system; use system;
with ada_krn_defs;
package v_i_callout is
pragma suppress(ALL_CHECKS);
pragma suppress(EXCEPTION_TABLES);
pragma not_elaborated;
-- Underlying kernel task and program id's
type krn_task_id is new ada_krn_defs.krn_task_id;
type krn_program_id is new ada_krn_defs.krn_task_id;
-- Callout events
type callout_event_t is new ada_krn_defs.callout_event_t;
-- Id for accessing user defined storage in the task control block
type task_storage_id is new ada_krn_defs.task_storage_id;
-- NO_TASK_STORAGE_ID: constant task_storage_id :=
-- task_storage_id(ada_krn_defs.NO_TASK_STORAGE_ID);
function NO_TASK_STORAGE_ID return task_storage_id;
pragma inline_only(NO_TASK_STORAGE_ID);
-- Service to install a program or task callout.
procedure install_callout(
event: callout_event_t;
proc: address);
pragma inline_only(install_callout);
-- The following information is only applicable to the
-- VADS_MICRO kernel.
--
-- If not enough memory in the kernel for the callout control
-- block, then, the STORAGE_ERROR exception is raised.
--
-- For EXIT_EVENT or UNEXPECTED_EXIT_EVENT, the callout procedures
-- are called LIFO. They are called in FIFO order for the other
-- events.
--
-- The callouts reside in the user program's
-- space. The EXIT_EVENT and UNEXPECTED_EXIT_EVENT callouts are
-- called in the context of the main program's task. The IDLE_EVENT
-- callouts are called in the context of the idle task. The remaining
-- callouts are called directly from kernel logic (use the kernel's
-- stack) and can only call kernel services that are re-entrant, the
-- same services callable from ISR's. The service of most interest is
-- TS_CURRENT_TIME which would be called for time stamping.
--
-- Before any non-PROGRAM_SWITCH_EVENT callout procedure is
-- invoked, the STACK_LIMIT in the user program is set to 0 to
-- negate any stack limit checking. Therefore, the callout
-- procedures don't need to be compiled with stack limit checking
-- suppressed. However, the STACK_LIMIT isn't zeroed before calling
-- the PROGRAM_SWITCH_EVENT callout. It needs to be compiled with
-- stack checking suppressed.
--
-- Except for the PROGRAM_SWITCH_EVENT, the callouts are only
-- installed and called for the program where they reside.
--
-- An overview of each callout follows:
--
-- EXIT_EVENT
-- Called when the program exits or terminates itself. Not
-- called when the program is terminated from another program.
-- Still called when the UNEXPECTED_EXIT_EVENT callout is called.
--
-- UNEXPECTED_EXIT_EVENT
-- Called when the program is abandoned due to an unhandled Ada
-- exception.
--
-- IDLE_EVENT
-- Called repetitively whenever the idle task is executing.
--
-- PROGRAM_SWITCH_EVENT
-- Called before switching to a task that resides in a
-- program different from the current program. Called for
-- all program switches, not just switches to and from the
-- program containing the callout.
--
-- TASK_CREATE_EVENT
-- Called whenever a task is created in the program containing
-- the callout. Since the TASK_CREATE_EVENT callout can be
-- called after numerous tasks have already been created, the
-- install_callout service loops through all existing tasks
-- invoking the just installed TASK_CREATE_EVENT callout before
-- returning.
--
-- TASK_SWITCH_EVENT
-- Called before switching to a different task in the same
-- program. For a program switch, the TASK_SWITCH_EVENT
-- callout is called with the tsk parameter set to
-- system.NO_TASK_ID.
--
-- TASK_SWITCH_COMPLETE
-- Called whenever any task in the callout's program completes or
-- is aborted.
--
--
-- An EXIT_EVENT or UNEXPECTED_EXIT_EVENT callout procedure
-- is called as follows:
-- procedure exit_callout_proc(
-- status: integer); -- main subprogram
-- -- return status
--
-- An IDLE_EVENT callout procedure is called as follows:
-- procedure idle_callout_proc;
--
-- A PROGRAM_SWITCH_EVENT callout procedure is called as follows:
-- procedure program_switch_callout_proc(
-- new_prg: krn_program_id;
-- -- NOTE: in earlier releases, new_prg was of
-- -- type, system.program_id.
-- new_key: address);
--
-- A TASK_CREATE_EVENT, TASK_SWITCH_EVENT or TASK_COMPLETE_EVENT
-- callout procedure is called as follows:
-- procedure task_callout_proc(
-- tsk: krn_task_id);
-- -- NOTE: in earlier releases, tsk was of
-- -- type, system.task_id.
-- Service to allocate storage in the task control block
function allocate_task_storage(
size: integer) return task_storage_id;
pragma inline_only(allocate_task_storage);
-- If not enough memory in the task control block for the
-- task storage, then, the STORAGE_ERROR exception is raised.
-- The configuration parameter, TASK_STORAGE_SIZE, defines
-- the size of the storage area set aside in the
-- control block for each task.
-- Each allocation from this area is aligned on a 4 or 8
-- byte boundary (the alignment is CPU dependent).
-- The task storage allocation is only applicable to tasks in the
-- current program.
-- This service returns the starting address of the task storage area
-- given the Ada task_id.
function get_task_storage(
Ada_tsk: system.task_id;
storage_id: task_storage_id) return address;
pragma inline_only(get_task_storage);
-- The storage_id parameter, contains the value returned by
-- a previous call to allocate_task_storage. Its only
-- applicable to tasks in the program where the
-- allocate_task_storage service was called from.
-- This service is called using the task's underlying kernel id
-- instead of its Ada task_id as is done for the above get_task_storage().
-- Normally, get_task_storage2() is called from the task_callouts.
function get_task_storage2(
krn_tsk: krn_task_id;
storage_id: task_storage_id) return address;
pragma inline_only(get_task_storage2);
end v_i_callout;
with system; use system;
with ada_krn_defs;
with ada_krn_i;
package body v_i_callout is
pragma suppress(ALL_CHECKS);
pragma suppress(EXCEPTION_TABLES);
procedure install_callout(
event: callout_event_t;
proc: address)
is
begin
if not ada_krn_i.callout_install(
ada_krn_defs.callout_event_t(event), proc)
then
raise STORAGE_ERROR;
end if;
end;
function allocate_task_storage(
size: integer) return task_storage_id
is
id: task_storage_id;
begin
id := task_storage_id(ada_krn_i.task_storage_alloc(size));
if id = NO_TASK_STORAGE_ID then
raise STORAGE_ERROR;
end if;
return id;
end;
function get_task_storage(
Ada_tsk: system.task_id;
storage_id: task_storage_id) return address
is
begin
return ada_krn_i.task_storage_get(Ada_tsk,
ada_krn_defs.task_storage_id(storage_id));
end;
function get_task_storage2(
krn_tsk: krn_task_id;
storage_id: task_storage_id) return address
is
begin
return ada_krn_i.task_storage_get2(ada_krn_defs.krn_task_id(krn_tsk),
ada_krn_defs.task_storage_id(storage_id));
end;
function NO_TASK_STORAGE_ID return task_storage_id is
begin
return task_storage_id(ada_krn_defs.NO_TASK_STORAGE_ID);
end;
end v_i_callout