-- $Source: /commtar/monoBANK/RTS/tKtsktsk.bdy,v $ -- $Revision: 1.2 $ -- $Date: 88/07/01 08:33:05 $ -- $Author: stt $ --##stt CICS version -- with System; with RTS_TGT_Debug_Pkg; with RTS_TaskingSupport; with RTS_Queue; with RTS_OSDependency; with RTS_TGT_Tasking_Assembler; with RTS_TGT_Tasking_Types; with temp_io; with RTS_Debug; with RTS_Task_Scope; with RTS_Lock_Package; with RTS_Indivisible_Ops; with Unchecked_Conversion; with RTS_CICS_Processor_Ops_Pkg; pragma ELABORATE ( System); pragma ELABORATE ( RTS_TGT_Debug_Pkg); pragma ELABORATE ( RTS_TGT_Tasking_Types); pragma ELABORATE ( RTS_TaskingSupport); pragma ELABORATE ( RTS_Queue); pragma ELABORATE ( RTS_OSDependency); pragma ELABORATE ( RTS_TGT_Tasking_Assembler); pragma ELABORATE ( temp_io); pragma ELABORATE ( RTS_Debug); pragma ELABORATE ( RTS_Task_Scope); pragma ELABORATE ( RTS_Lock_Package); pragma ELABORATE ( RTS_Indivisible_Ops); pragma ELABORATE ( RTS_CICS_Processor_Ops_Pkg); package body RTS_Tasks is --| Ada Tasking Primitives. package Queue renames RTS_Queue; package Debug renames RTS_Debug; package DBG renames RTS_TGT_Debug_Pkg; package ASM renames RTS_TGT_Tasking_Assembler; package PROC renames RTS_CICS_Processor_Ops_Pkg; use RTS_TaskingSupport; use temp_io; --| OVERVIEW --| TUNING --| NOTES -- Local declarations -------------------------------------------- task_counter : Integer := 0; -- Local subprogram specs ---------------------------------------- procedure Print_Dependents (Task_To_Check : TCBHandle); ------------------------------------------------------------------ -- Visible subprogram bodies ------------------------------------- ------------------------------------------------------------------ function RTS_Caller_Count --| Attribute E'Count. ( EntryId: in EntryIndex ) return TaskCount is --| Algorithm --| --| Check the validity of the EntryId and, if it is invalid, --| abort the task. Otherwise return the count of callers that --| have called the entry. Don't count interrupt tasks! --| NA: Modifies, Raises. begin return (ASM.Current_TCB.tcb_entry(EntryId).pei_queue.tq_count); end RTS_Caller_Count; ------------------------------------------------------------------ function RTS_Is_Callable --| Attribute T'Callable. ( CheckTask: in TCBhandle --| Task to be checked. ) return Boolean --| Returns TRUE if task callable. is --| Algorithm --| --| Test whether task status = terminated, or wakeup indicates --| abnormal or terminating. Return False if so. begin return CheckTask.tcb_the_real_one.tcb_status /= Terminated and then CheckTask.tcb_the_real_one.tcb_wakeup not in Uncallable; end RTS_Is_Callable; ------------------------------------------------------------------ function RTS_Task_Storage_Size --| Attribute T'Storage_Size. ( CheckTask: in TCBhandle --| Task of interest ) return Integer --| Returns Task stack size in SUs. is --| Algorithm --| --| Return task stack size in SUs. --?stt? NYI --| NA: Modifies, Raises. begin return (5000); --?stt? Should query its state end RTS_Task_Storage_Size; ------------------------------------------------------------------ function RTS_Is_Terminated --| Attribute T'Terminated. ( CheckTask: in TCBhandle --| Task to be checked. ) return Boolean --| TRUE if task terminated. is --| Algorithm --| --| Return TRUE if the task is terminated or --| abnormal and unactivated, otherwise FALSE. Real_Task : constant TCBHandle := CheckTask.tcb_the_real_one; --| Get the "real" TCB in case was copied. begin return Real_Task.tcb_status = Terminated or else (Real_Task.tcb_status = Unactivated and then Real_Task.tcb_wakeup in Uncallable) or else (Real_Task.tcb_wakeup = Continue_Termination and then Real_Task.tcb_innermost_submaster = Real_Task.tcb_master); end RTS_Is_Terminated; procedure Print_TCB (TCBToPrint : TCBHandle) is begin if DBG.Tasks_Debug then put_line (" --- Task Control Block: " & Integer'Image (TCBToPrint.tcb_id)); put_line (" tcb_status: " & Task_Status'Image (TCBToPrint.tcb_status)); put_line (" tcb_priority: " & PriorityNumber'IMAGE(TCBToPrint.tcb_priority)); put_line (" tcb_expired: " & boolean'IMAGE(TCBToPrint.tcb_expired)); end if; exception when others => put_line (" -- Error printing TCB"); end Print_TCB; --------------------------------------------------------------------- procedure RTS_Initialize_Task --| Initialize a task control block. ( NewTask: in TCBHandle; --| TCB to be initialized. Number_Of_Entries : in EntryCount; --| number of entries in --| this task. List: in ActivationListHandle;--| Ptr. to activation list. Master: in TaskMasterHandle; --| Ptr. to the task's master. UDA: in System.Address; --| UDA for task. StaticLink: in System.Address; --| static link for task. Priority: in PriorityNumber; --| The task's priority. Elab_Bit: in Elab_Bit_Ptr --| Elab-bit for task body ) is --| Algorithm --| Initialize all fields of TCB --| Some by copying from default-init'ed TCB --| Others from parameters. type Encloser_Record is record --| Record containing a single TCB like the one passed in --| NOTE: This must be layed out without ANY hidden fields --| or else the unchecked conversion won't do the desired thing The_TCB : TCB(Number_Of_Entries); end record; type Encloser_Ptr is access Encloser_Record; --| Pointer to TCB like the one passed in Initialized_Task : Encloser_Record; --| Create a TCB instance, properly initialized function To_Encloser is new Unchecked_Conversion( Source => TCBHandle, Target => Encloser_Ptr ); --| function to convert caller's TCB to encloser-ptr begin if DBG.Tasks_Debug then temp_io.put_line ("Entered Initialize Task"); end if; -- Initialize the caller's TCB record -- Initialize from default-init'ed task To_Encloser(NewTask).all := Initialized_Task; -- Initialize from parameters NewTask.tcb_priority := Priority; NewTask.tcb_uda := UDA; NewTask.tcb_staticlink := StaticLink; NewTask.tcb_elab_bit := Elab_Bit; NewTask.tcb_activator:= List; task_counter := task_counter + 1; NewTask.tcb_id := task_counter; NewTask.tcb_the_real_one := NewTask; RTS_TGT_Tasking_Types.Initialize_Task_State_Info ( NewTask.tcb_state_info); RTS_Lock_Package.Initialize_Lock_Chain ( NewTask.tcb_lock_chain); if Master /= null then NewTask.tcb_master := Master; elsif The_Default_Master = null then -- Must be init'ing the main task NewTask.tcb_processor_info := null; --##stt for CICS -- if DBG.Tasks_Debug then temp_io.put_line ("Left Initialize Task, tcb_id=" & Integer'Image(NewTask.tcb_id)); end if; return; else -- Use default master if master not specified NewTask.tcb_master := The_Default_Master; end if; --##stt for CICS -- Init processor info from proc of master task NewTask.tcb_processor_info := NewTask.tcb_master.tm_enclosing_task.tcb_processor_info; PROC.Set_Proc_Info(NewTask); --##stt for CICS -- fill in proc-info field of state info NewTask.tcb_innermost_submaster := NewTask.tcb_master; if List /= null then -- Add the task to an activation list; -- al_count is incremented when task is -- actually put on runnable queue. Queue.AddToCurrent (List.al_tasks, NewTask); if NewTask.tcb_master.tm_enclosing_task = ASM.Current_TCB then --##stt for CICS only done if activation list /= null --##stt OK for other targets as well, I suspect. --##stt Probably desirable for interrupt tasks, e.g. -- Activator is same task as master, so add to -- list of dependents now, rather than when activated. -- This allows us to terminate tasks which are never -- activated due to exceptions raised in the declarative -- part in which they are declared. -- N.B. The nonterminable count is incremented when the -- task is actually put on the runnable queue. RTS_Indivisible_Ops.Add_To_Dependency( NewTask.tcb_master, NewTask ); end if; end if; if DBG.Tasks_Debug then temp_io.put_line ("Left Initialize Task, tcb_id=" & Integer'Image(NewTask.tcb_id)); end if; end RTS_Initialize_Task; ------------------------------------------------------------------ procedure RTS_Abort_Task --| Ada ABORT statement. ( Aborting: in TCBHandle --| Task to abort. ) is begin -- Check whether running task has already been aborted RTS_Indivisible_Ops.Check_For_Abort; -- Abort specified task and its dependents RTS_Indivisible_Ops.Abort_Task(Aborting.tcb_the_real_one); -- Reschedule in any case (so aborted tasks get a chance -- to terminate themselves). RTS_Indivisible_Ops.Schedule_Point; end RTS_Abort_Task; ---------------------------------------------------------------- procedure RTS_Delay_Task ( Delay_Amount : in Standard.Duration ) is begin --| Algorithm --| --| Add the running task to the delay queue. Reset the --| alarm if necessary (i.e. this was added at the head --| of the delay queue. Suspend this task (it will be --| awakened at the end of the rendezvous). if Delay_Amount > 0.0 then RTS_Indivisible_Ops.Delay_Task(Delay_Amount); end if; end RTS_Delay_Task; ------------------------------------------------------------- procedure Rundown_Tasking --| wrap up procedure called by supermain -- formerly: Default_Task_Wait is --| Overview --| This procedure is called by the assembly code "supermain." --| This procedure performs rundown activities, in particular --| doing task-wait on the default master (waiting for library --| tasks to complete), and removing the delay handler. --| Algorithm --| begin RTS_Task_Scope.RTS_Task_Wait (The_Default_Master); -- Now all library tasks have terminated. RTS_OSDependency.Remove_Delay_Handler; -- The delay task is a dependent of the default master end Rundown_Tasking; pragma link_name (Rundown_Tasking,"TSK$WAIT"); ------------------------------------------------------------- function RTS_Expired return Boolean is begin return (ASM.Current_TCB.tcb_expired); end RTS_Expired; --------------------------------------------------------------- -- Local Subprogram Bodies --------------------------------------------------------------- procedure Print_Dependents (Task_To_Check : TCBHandle) is begin null; end Print_Dependents; --------------------------------------------------------------- -- PACKAGE INITIALIZATION --------------------------------------------------------------- procedure Elab_This_Package is -- This is a separate procedure because large -- elaboration procedures have caused problems in the past. begin -- Initialize the runtime system so that programs can run THE_MAIN_PROGRAM := new TCB(0); THE_DEFAULT_MASTER := null; -- Until main task initialized ASM.Set_Current_TCB (THE_MAIN_PROGRAM); RTS_Initialize_Task( NewTask => THE_MAIN_PROGRAM, Number_Of_Entries => 0, List => null, Master => null, UDA => System.Null_Address, StaticLink => System.Null_Address, Priority => PriorityNumber(ASM.Get_Main_Priority), -- fetch prio from UDA Elab_Bit => null ); RTS_TGT_Tasking_Types.Set_Global (THE_MAIN_PROGRAM.tcb_processor_info); THE_MAIN_PROGRAM.tcb_state_inited := TRUE; -- was inited by the startup routine. THE_MAIN_PROGRAM.tcb_status := Running; -- Initialize the default task master, now that the main task is -- created. THE_DEFAULT_MASTER := new TaskMasterRecord; RTS_Task_Scope.RTS_Initialize_Task_Master(THE_DEFAULT_MASTER); -- Start up the delay handler RTS_OSDependency.Establish_Delay_Handler ; end Elab_This_Package; ----------------------------------------------------------------- begin Elab_This_Package; end RTS_Tasks; ------------------------------------------------------------------------ -- $Cprt start$ -- -- Copyright (C) 1988 by Intermetrics, Inc. -- -- This material may be used duplicated or disclosed by or for the -- U.S. Government pursuant to the copyright license under DAR clause -- 7-104.9(a) (May 1981). -- -- This project was spnsored by the STARS Foundation -- Naval Research Laboratory, Washington DC -- -- $Cprt end$