|
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: 20965 (0x51e5)
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«
└─⟦0b11539c1⟧
└─⟦this⟧
-- Copyright 1991,1992,1993 Verdix Corporation
with system; use system;
with krn_cpu_defs;
with link_block;
with v_i_types;
with unchecked_conversion;
package krn_defs is
pragma suppress(ALL_CHECKS);
pragma suppress(EXCEPTION_TABLES);
pragma not_elaborated;
pragma local_access;
-- The Kernel's type definitions
type a_boolean is access boolean;
function to_a_boolean is new unchecked_conversion(address, a_boolean);
-- Forward references
type krn_tcb_t;
type a_krn_tcb_t is access krn_tcb_t;
type krn_pcb_t;
type a_krn_pcb_t is access krn_pcb_t;
-- SPORADIC_TASK
type krn_sporadic_t;
type a_krn_sporadic_t is access krn_sporadic_t;
-- SPORADIC_TASK
-- Returned kernel service status
NO_MEMORY : constant := -1;
SUCCESS : constant := 0;
DELTA_TIME: constant day_t := -1;
-- Record types
type record_type_t is (
R_INVALID,
R_FIFO_COND,
R_PRIO_COND,
R_FIFO_COND_ATTR,
R_PRIO_COND_ATTR,
R_FIFO_MUTEX,
R_PRIO_MUTEX,
R_PRIO_INHERIT_MUTEX,
R_PRIO_CEILING_MUTEX,
R_INTR_MUTEX,
R_FIFO_MUTEX_ATTR,
R_PRIO_MUTEX_ATTR,
R_PRIO_INHERIT_MUTEX_ATTR,
R_PRIO_CEILING_MUTEX_ATTR,
R_INTR_MUTEX_ATTR,
R_SEMAPHORE,
R_SEMAPHORE_ATTR,
R_COUNT_SEMAPHORE,
R_MAILBOX
);
-- Values corresponding to a zero/non-zero for the CPU specific
-- test-and-set instruction
type test_and_set_t is new v_i_types.test_and_set_t;
TEST_AND_SET_FALSE: constant test_and_set_t :=
test_and_set_t(v_i_types.TEST_AND_SET_FALSE);
TEST_AND_SET_TRUE: constant test_and_set_t :=
test_and_set_t(v_i_types.TEST_AND_SET_TRUE);
--------------------------------------------------------------------------
-- Interrupt types (OS DEPENDENT)
--------------------------------------------------------------------------
-- Exception vector table ID's
subtype intr_vector_id_t is natural;
-- Interrupt enable/disable status: Interrupt Priority Level (IPL)
-- mask stored in Status Register
subtype intr_status_t is integer;
DISABLE_INTR_STATUS: constant intr_status_t := 16#0700#;
ENABLE_INTR_STATUS: constant intr_status_t := 16#0000#;
LEVEL_0_INTR_STATUS: constant intr_status_t := 16#0000#;
LEVEL_1_INTR_STATUS: constant intr_status_t := 16#0100#;
LEVEL_2_INTR_STATUS: constant intr_status_t := 16#0200#;
LEVEL_3_INTR_STATUS: constant intr_status_t := 16#0300#;
LEVEL_4_INTR_STATUS: constant intr_status_t := 16#0400#;
LEVEL_5_INTR_STATUS: constant intr_status_t := 16#0500#;
LEVEL_6_INTR_STATUS: constant intr_status_t := 16#0600#;
LEVEL_7_INTR_STATUS: constant intr_status_t := 16#0700#;
-- Value return for a bad intr_vector passed to the interrupt
-- service routines
BAD_INTR_VECTOR: constant address := memory_address(16#FFFF_FFFF#);
--------------------------------------------------------------------------
-- Condition variable and mutex types
--------------------------------------------------------------------------
type cond_attr_t is record
rec_type : record_type_t;
-- valid rec_type are: R_FIFO_COND_ATTR | R_PRIO_COND_ATTR
end record;
type a_cond_attr_t is access cond_attr_t;
function to_a_cond_attr_t is
new unchecked_conversion(address, a_cond_attr_t);
function to_address is new unchecked_conversion(a_cond_attr_t, address);
-- DEFAULT_COND_ATTR: constant a_cond_attr_t := null;
function DEFAULT_COND_ATTR return a_cond_attr_t;
pragma inline_only(DEFAULT_COND_ATTR);
type cond_t is record
rec_type : record_type_t;
-- valid rec_type are: R_FIFO_COND | R_PRIO_COND
t_head : a_krn_tcb_t;
t_tail : a_krn_tcb_t;
end record;
type a_cond_t is access cond_t;
function to_a_cond_t is new unchecked_conversion(address, a_cond_t);
function to_address is new unchecked_conversion(a_cond_t, address);
type mutex_attr_t is record
rec_type : record_type_t;
-- valid rec_type are: R_FIFO_MUTEX_ATTR | R_PRIO_MUTEX_ATTR
-- also for PRIORITY_INHERITANCE: R_PRIO_INHERIT_MUTEX_ATTR
pad : intr_status_t; -- must be large enough
-- to accommodate space needed
-- by other mutex attribute
-- record types
end record;
type a_mutex_attr_t is access mutex_attr_t;
function to_a_mutex_attr_t is
new unchecked_conversion(address, a_mutex_attr_t);
function to_address is
new unchecked_conversion(a_mutex_attr_t, address);
-- DEFAULT_MUTEX_ATTR: constant a_mutex_attr_t := null;
function DEFAULT_MUTEX_ATTR return a_mutex_attr_t;
pragma inline_only(DEFAULT_MUTEX_ATTR);
type intr_attr_t is record
rec_type : record_type_t;
-- only valid rec_type is: R_INTR_MUTEX_ATTR
disable_status : intr_status_t;
end record;
type a_intr_attr_t is access intr_attr_t;
function to_a_intr_attr_t is new unchecked_conversion(address,
a_intr_attr_t);
function to_a_intr_attr_t is new unchecked_conversion(a_mutex_attr_t,
a_intr_attr_t);
function to_a_mutex_attr_t is
new unchecked_conversion(a_intr_attr_t, a_mutex_attr_t);
function to_address is
new unchecked_conversion(a_intr_attr_t, address);
-- DEFAULT_INTR_ATTR: constant a_mutex_attr_t :=
-- to_a_mutex_attr_t(memory_address(1));
function DEFAULT_INTR_ATTR return a_mutex_attr_t;
pragma inline_only(DEFAULT_INTR_ATTR);
type prio_ceiling_attr_t is record
rec_type : record_type_t;
-- only valid rec_type is: R_PRIO_CEILING_MUTEX_ATTR
ceiling_prio : priority;
end record;
type a_prio_ceiling_attr_t is access prio_ceiling_attr_t;
function to_a_prio_ceiling_attr_t is
new unchecked_conversion(address, a_prio_ceiling_attr_t);
function to_a_prio_ceiling_attr_t is
new unchecked_conversion(a_mutex_attr_t, a_prio_ceiling_attr_t);
function to_a_mutex_attr_t is
new unchecked_conversion(a_prio_ceiling_attr_t, a_mutex_attr_t);
function to_address is
new unchecked_conversion(a_prio_ceiling_attr_t, address);
type mutex_pad_t is array(1..2) of intr_status_t;
type mutex_t;
type a_mutex_t is access mutex_t;
type mutex_t is record
rec_type : record_type_t;
-- valid rec_type are: R_FIFO_MUTEX | R_PRIO_MUTEX
-- also for PRIORITY_INHERITANCE: R_PRIO_INHERIT_MUTEX
-- also for PRIORITY_CEILING: R_PRIO_CEILING_MUTEX
t_head : a_krn_tcb_t;
t_tail : a_krn_tcb_t;
flag : test_and_set_t;
others_waiting : boolean;
owner : a_krn_tcb_t; -- for INHERITANCE or CEILING
q_next : a_mutex_t; -- " "
ceiling_prio : integer; -- for R_PRIO_CEILING_MUTEX
pad : mutex_pad_t; -- must be large enough
-- to accommodate space needed
-- by other mutex record types
end record;
function to_a_mutex_t is new unchecked_conversion(address, a_mutex_t);
function to_address is new unchecked_conversion(a_mutex_t, address);
type intr_mutex_t is record
rec_type : record_type_t;
-- only valid rec_type is: R_INTR_MUTEX
disable_status : intr_status_t;
restore_status : intr_status_t;
end record;
type a_intr_mutex_t is access intr_mutex_t;
function to_a_intr_mutex_t is
new unchecked_conversion(a_mutex_t, a_intr_mutex_t);
function to_a_mutex_t is
new unchecked_conversion(a_intr_mutex_t, a_mutex_t);
function to_address is
new unchecked_conversion(a_intr_mutex_t, address);
--------------------------------------------------------------------------
-- Semaphore types (Only FIFO queuing)
--------------------------------------------------------------------------
type semaphore_t is record
rec_type : record_type_t;
-- only valid rec_type is: R_SEMAPHORE
t_head : a_krn_tcb_t;
t_tail : a_krn_tcb_t;
flag : test_and_set_t;
others_waiting : boolean;
end record;
type a_semaphore_t is access semaphore_t;
function to_a_semaphore_t is new unchecked_conversion(address,
a_semaphore_t);
function to_address is new unchecked_conversion(a_semaphore_t, address);
type semaphore_attr_t is record
rec_type : record_type_t := R_SEMAPHORE_ATTR;
-- only valid rec_type is: R_SEMAPHORE_ATTR
end record;
type a_semaphore_attr_t is access semaphore_attr_t;
function to_a_semaphore_attr_t is new unchecked_conversion(address,
a_semaphore_attr_t);
function to_address is new unchecked_conversion(a_semaphore_attr_t,
address);
-- DEFAULT_SEMAPHORE_ATTR: constant a_semaphore_attr_t := null;
function DEFAULT_SEMAPHORE_ATTR return a_semaphore_attr_t;
pragma inline_only(DEFAULT_SEMAPHORE_ATTR);
--------------------------------------------------------------------------
-- Counting semaphore types
--------------------------------------------------------------------------
type count_semaphore_t is record
rec_type : record_type_t;
-- only valid rec_type is: R_COUNT_SEMAPHORE
mutex : mutex_t;
cond : cond_t;
count : integer;
end record;
type a_count_semaphore_t is access count_semaphore_t;
function to_a_count_semaphore_t is new unchecked_conversion(address,
a_count_semaphore_t);
function to_address is
new unchecked_conversion(a_count_semaphore_t, address);
subtype count_semaphore_attr_t is mutex_attr_t;
subtype a_count_semaphore_attr_t is a_mutex_attr_t;
function to_a_count_semaphore_attr_t is new unchecked_conversion(address,
a_count_semaphore_attr_t);
-- DEFAULT_COUNT_SEMAPHORE_ATTR: constant a_count_semaphore_attr_t := null;
function DEFAULT_COUNT_SEMAPHORE_ATTR return a_count_semaphore_attr_t;
pragma inline_only(DEFAULT_COUNT_SEMAPHORE_ATTR);
subtype count_intr_attr_t is intr_attr_t;
subtype a_count_intr_attr_t is a_intr_attr_t;
function to_a_count_intr_attr_t is new unchecked_conversion(address,
a_count_intr_attr_t);
function to_a_count_semaphore_attr_t is
new unchecked_conversion(a_count_intr_attr_t, a_count_semaphore_attr_t);
-- DEFAULT_COUNT_INTR_ATTR: constant a_count_semaphore_attr_t :=
-- to_a_count_semaphore_attr_t(memory_address(1));
function DEFAULT_COUNT_INTR_ATTR return a_count_semaphore_attr_t;
pragma inline_only(DEFAULT_COUNT_INTR_ATTR);
--------------------------------------------------------------------------
-- Mailbox types
--------------------------------------------------------------------------
type unit_t is range -2**(storage_unit-1) .. 2**(storage_unit-1)-1;
for unit_t'size use storage_unit;
type slots_t is array(positive range <>, positive range <>) of unit_t;
type a_slots_t is access slots_t;
function to_a_slots_t is new unchecked_conversion(address, a_slots_t);
function to_address is new unchecked_conversion(a_slots_t, address);
type mailbox_t is record
rec_type : record_type_t;
-- only valid rec_type is: R_MAILBOX
mutex : mutex_t;
read_cond : cond_t;
slots_cnt : natural;
slot_len : natural;
msg_cnt : natural;
bottom : address;
top : address;
read_addr : address;
write_addr : address;
end record;
type a_mailbox_t is access mailbox_t;
function to_a_mailbox_t is new unchecked_conversion(address,
a_mailbox_t);
function to_address is
new unchecked_conversion(a_mailbox_t, address);
subtype mailbox_attr_t is mutex_attr_t;
subtype a_mailbox_attr_t is a_mutex_attr_t;
function to_a_mailbox_attr_t is new unchecked_conversion(address,
a_mailbox_attr_t);
-- DEFAULT_MAILBOX_ATTR: constant a_mailbox_attr_t := null;
function DEFAULT_MAILBOX_ATTR return a_mailbox_attr_t;
pragma inline_only(DEFAULT_MAILBOX_ATTR);
subtype mailbox_intr_attr_t is intr_attr_t;
subtype a_mailbox_intr_attr_t is a_intr_attr_t;
function to_a_mailbox_intr_attr_t is new unchecked_conversion(address,
a_mailbox_intr_attr_t);
function to_a_mailbox_attr_t is
new unchecked_conversion(a_mailbox_intr_attr_t, a_mailbox_attr_t);
-- DEFAULT_MAILBOX_INTR_ATTR: constant a_mailbox_attr_t :=
-- to_a_mailbox_attr_t(memory_address(1));
function DEFAULT_MAILBOX_INTR_ATTR return a_mailbox_attr_t;
pragma inline_only(DEFAULT_MAILBOX_INTR_ATTR);
--------------------------------------------------------------------------
-- Callout and task storage types
--------------------------------------------------------------------------
-- Callout events
type callout_event_t is (
EXIT_EVENT,
UNEXPECTED_EXIT_EVENT,
IDLE_EVENT,
PROGRAM_SWITCH_EVENT, -- stack limit checking must be suppressed
TASK_CREATE_EVENT,
TASK_SWITCH_EVENT,
TASK_COMPLETE_EVENT);
for callout_event_t'size use integer'size;
-- Id for accessing user defined storage in the task control block
type task_storage_id is new integer;
NO_TASK_STORAGE_ID: constant task_storage_id := task_storage_id(0);
-- Callout Control Block
type callout_t;
type a_callout_t is access callout_t;
type a_a_callout_t is access a_callout_t;
type callout_t is record
q_next : a_callout_t;
proc : address;
parent_program : a_krn_pcb_t; -- needed for program switch callout
end record;
function to_a_callout_t is
new unchecked_conversion(address, a_callout_t);
function to_a_a_callout_t is
new unchecked_conversion(address, a_a_callout_t);
type calloutq_heads_t is
array (callout_event_t) of a_callout_t;
--------------------------------------------------------------------------
-- Time event types
--------------------------------------------------------------------------
type time_state_t is (
TIME_STOPPED,
TIME_COUNTING,
TIME_OVERRUN,
TIME_CANCELED
);
type time_event_t;
type a_time_event_t is access time_event_t;
type time_event_t is record
q_next : a_time_event_t;
q_prev : a_time_event_t;
time_state : time_state_t;
delay_until_flag: boolean;
day : day_t;
sec : duration;
proc : address;
arg : address;
end record;
function to_a_time_event_t is
new unchecked_conversion(address, a_time_event_t);
-- Program Control Block
type krn_pcb_t is record
q_next : a_krn_pcb_t;
t_head : a_krn_tcb_t;
user_link_block : link_block.a_link_block_t;
terminated : boolean; -- program is terminated,
-- but, waiting to be freed
prio_inherit_support : boolean; -- TRUE if kernel supports
-- PRIORITY_INHERITANCE
prio_ceiling_support : boolean; -- TRUE if kernel supports
-- PRIORITY_CEILING
sporadic_task_support : boolean; -- TRUE if kernel supports
-- SPORADIC_TASK
is_server : boolean; -- set via
-- program_is_server()
-- when program contains
-- procedures called from
-- other programs. Inhibits
-- program termination.
-- Allows kernel exit
-- when no other programs
-- are still active.
my_creator : a_krn_pcb_t; -- parent program
terminate_callout : address; -- defined at
-- program create
exit_status : integer; -- passed at program_exit
alloc_head : address; -- krn_alloc.prog_new
-- allocations
key : address; -- user defined at
-- program create, main
-- is predefined as NO_ADDR
sequence_num : integer; -- eventhough newly created
-- programs may share the
-- same program control
-- block, they have a
-- unique sequence number
task_storage_avail : integer; -- index into next avail
-- user storage in tcb
calloutq_heads : calloutq_heads_t;
Ada_program_id : program_id;
exception_stack_size : natural;
end record;
function to_a_krn_pcb_t is new unchecked_conversion(address, a_krn_pcb_t);
type a_a_krn_pcb_t is access a_krn_pcb_t;
function to_a_a_krn_pcb_t is
new unchecked_conversion(address, a_a_krn_pcb_t);
type tstate_t is (
T_CREATED,
T_READY,
T_EXECUTING,
T_WAITING,
T_SUSPENDED_AT_COND,
T_SUSPENDED_AT_MUTEX,
T_SUSPENDED_AT_SEMAPHORE,
T_SUSPENDED_AT_DELAY,
T_SUSPENDED_AT_NAME_RESOLVE,
T_SUSPENDED_IDLE_TASK,
T_IN_TRANSITION,
T_TERMINATED
);
CPU_NUMBER_DONT_CARE : constant := -1;
CPU_NUMBER_THIS_CPU : constant := -2;
-- Task control block
type krn_tcb_t is record
cpu_state : krn_cpu_defs.cpu_state_t;
tstate : tstate_t;
task_suspended_flag : boolean; -- when set, a READY task isn't
-- on the runq
q_next : a_krn_tcb_t;
q_prev : a_krn_tcb_t;
t_link : a_krn_tcb_t;
parent_program : a_krn_pcb_t;
-- The following changes during a usr_prog.program_inter_call().
-- Otherwise, current_program = parent_program and
-- current_stack_limit_p =
-- parent_program.user_link_block.stack_limit_p.
current_program : a_krn_pcb_t;
current_stack_limit_p: address;
cond_mutex : a_mutex_t;
suspended_queue : address;
preemption_depth : natural;
signaled : boolean;
cur_prio : integer;
delay_event : time_event_t;
time_slice : duration;
start_address : address;
stack_size : natural;
stack_area : address;
Ada_task_id : task_id;
-- PRIORITY_INHERITANCE or PRIORITY_CEILING or SPORADIC_TASK
mutex_head : a_mutex_t;
static_prio : integer;
-- PRIORITY_INHERITANCE or PRIORITY_CEILING or SPORADIC_TASK
-- SPORADIC_TASK
sporadic : a_krn_sporadic_t;
-- SPORADIC_TASK
sequence_num : integer; -- task's unique sequence number
-- Storage available for the user follows the last field in the
-- krn_tcb_t record. The size is specified by the configuration
-- parameter, TASK_STORAGE_SIZE. The task's
-- parent_program.task_storage_avail points to the next avail slot.
end record;
type a_a_krn_tcb_t is access a_krn_tcb_t;
function to_a_a_krn_tcb_t is
new unchecked_conversion(address, a_a_krn_tcb_t);
-- SPORADIC_TASK begin
type krn_replenishment_t;
type a_krn_replenishment_t is access krn_replenishment_t;
-- Sporadic task control block
type krn_sporadic_t is record
my_tcb : a_krn_tcb_t;
low_prio : priority;
replenish_period : duration;
initial_budget : duration;
min_replenishment : duration;
replenishment_count : natural;
s_link : a_krn_sporadic_t;
avail_exec_time : duration;
rep_addr : address;
rep_head : a_krn_replenishment_t;
rep_tail : a_krn_replenishment_t;
free_rep_head : a_krn_replenishment_t;
rep_event : time_event_t;
force_high_prio : boolean;
-- SPORADIC_TASK_STATISTICS_ENABLED
-- Statistics
exec_cnt : natural;
background_exec_cnt : natural;
exec_timeout_cnt : natural;
rep_timeout_cnt : natural;
-- SPORADIC_TASK_STATISTICS_ENABLED
end record;
ZERO_AVAIL_EXEC_TIME : constant duration := 0.0;
-- Sporadic task replenishment
type krn_replenishment_t is record
next : a_krn_replenishment_t;
rep_day : day_t;
rep_sec : duration;
rep_amount : duration;
end record;
-- SPORADIC_TASK end
-- Ring for pending interrupt queue.
type ring_entry_t is record
proc : address;
arg : address;
end record;
type a_ring_entry_t is access ring_entry_t;
-- Name services entry
type name_entry_t;
type a_name_entry_t is access name_entry_t;
type name_entry_t is record
next : a_name_entry_t;
name_len : natural;
name_addr : address;
prg : a_krn_pcb_t;
addr : address;
end record;
function to_a_name_entry_t is
new unchecked_conversion(address, a_name_entry_t);
end krn_defs;
package body krn_defs is
function DEFAULT_COND_ATTR return a_cond_attr_t is
begin
return null;
end;
function DEFAULT_MUTEX_ATTR return a_mutex_attr_t is
begin
return null;
end;
function DEFAULT_INTR_ATTR return a_mutex_attr_t is
begin
return to_a_mutex_attr_t(memory_address(1));
end;
function DEFAULT_SEMAPHORE_ATTR return a_semaphore_attr_t is
begin
return null;
end;
function DEFAULT_COUNT_SEMAPHORE_ATTR return a_count_semaphore_attr_t is
begin
return null;
end;
function DEFAULT_COUNT_INTR_ATTR return a_count_semaphore_attr_t is
begin
return to_a_count_semaphore_attr_t(memory_address(1));
end;
function DEFAULT_MAILBOX_ATTR return a_mailbox_attr_t is
begin
return null;
end;
function DEFAULT_MAILBOX_INTR_ATTR return a_mailbox_attr_t is
begin
return to_a_mailbox_attr_t(memory_address(1));
end;
end krn_defs