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