Google
 

Trailing-Edge - PDP-10 Archives - BB-P363B-SM_1985 - mcb/nml/nmuskd.bli
There are 3 other files named nmuskd.bli in the archive. Click here to see a list.
! <BRANDT.DEVELOPMENT>NMUSKD.BLI.1 22-Jun-82 15:50:31, Edit by BRANDT
!
!   Ident 19.
!     Clean up some problems introduced in last edit.
!     1) Have SCHED_FLAG unlock the semaphore when the event
!        occurs only if no tasks are moved to run queue
!     2) Don't have SCHED_WAIT lock the semaphore when a task
!	 resumes.
!     3) Make sure TABLE_INDEX has a value when TABLE_DELETE is
!        called.
!     4) When a task resumes after sleeping, use the table
!	 entry for the tasks queued to this event to determine
!	 if the event has happened or if the sleep time has expired.
!
! <BRANDT.DEVELOPMENT>NMUSKD.BLI.1 25-May-82 12:05:13, Edit by BRANDT
!
!   Ident 18.
!   Make network function timeouts work.
!     1) In NMU$SCHED_WAIT make calls to SCHED_SLEEP if a wait time
!        is specified.
!     2) Remove routine NMU$TIMEOUT_CHECK.
!     3) Always have SCHED_FLAG unlock the semaphore when the event
!        occurs

! NET:<PECKHAM.DEVELOPMENT>NMUSKD.BLI.2 22-Apr-82 09:50:31, Edit by PECKHAM
!
! Ident 17.
! Make stack sizes larger for TOPS10/20 in NMU$SCHED_CREATE.
!
! NET:<GROSSMAN.NML-SOURCES>NMUSKD.BLI.3 24-Feb-82 10:24:00, Edit by GROSSMAN
!
! Make NMU$SCHED_DESCHEDULE put NML to sleep forever if it has nothing to do.
! This is for Tops-10 only.
!
! NET:<GROSSMAN>NMUSKD.BLI.2 16-Feb-82 15:16:52, Edit by GROSSMAN
!
! Make NMU$SCHED_FLAG call the table deallocator after it is done reading
! all the tasks from the event block. This should prevent some free space
! lossage problems.
!
! NET:<GROSSMAN.NML-SOURCES>NMUSKD.BLI.4 13-Feb-82 22:54:00, Edit by GROSSMAN
!
! Remove EXTERNAL ROUTINE of DETACH from this file. Put it into the macro
! INIT_GLOBALS in NMINI.REQ. Also change the name of the second formal
! parameter (WAIT) for the routine NMU$TIMEOUT_CHECK to WAIT_FLAG. This is
! to avoid conflict with a Tops-10 monitor call of the same name. (Oddly
! enough, the parameter is never used!?!).
!
! NET:<PECKHAM.DEVELOPMENT>NMUSKD.BLI.2  7-Feb-82 18:21:00, Edit by PECKHAM
!
! Ident 16.
! Fix code in NMU$SCHED_WAIT to avoid generating INFO message.
!
! NET:<PECKHAM.DEVELOPMENT>NMUSKD.BLI.2  5-Feb-82 09:11:11, Edit by GROSSMAN
!								for PECKHAM
! Ident 15.
! Initialize RUN_QUEUE (its really just a table now). And, fix ..._EVENT so
! that the resetting of an EVENT_QUEUE (which is really a table) calls
! NMU$TABLE_CLEAR which will collect its own garbage thus alleviating some
! memory problems.
!
! NET:<GROSSMAN>NMUSKD.BLI.11 26-Jan-82 06:42:16, Edit by GROSSMAN
!
! Ident 14.
! Install many changes so that counter timers work. Some of them are:
! 1) Make all events not use a queued data structure. They now use a list
! in order to pointer to all waiting tasks.
! 2) Turn the RUN_QUEUE into a run_list. It is now a list of all runnable
! tasks. This keep it from interfering with the TIME_QUEUE.
! 3) Make NMU$SCHED_SLEEP accept the same task multiple times. (It actually
! just does nothing if the task is already scheduled to be woken up later).
! I hope thats all...
!
! NET:<PECKHAM.DEVELOPMENT>NMUSKD.BLI.2 23-Jan-82 23:48:34, Edit by PECKHAM
!
! Ident 13.
! Fix ref bug in NMU$TIMEOUT_CHECK.
! Comment out call to NMU$TIMEOUT_CHECK in NMU$SCHED_DESCHEDULE.
!
! NET:<DECNET20-V3P1.NMLLIB>NMUSKD.BLI 02-Dec-81 09:49:20, Edit by THIGPEN
!
! Ident 12.
! Merge changes made by Stu Grossman (see below) with changes in ident 11.
!
! NET:<DECNET20-V3P1.NMLLIB>NMUSKD.BLI 02-Dec-81 09:49:20, Edit by THIGPEN
!
! Ident 11.
! Changes to allow timing out calls to NMU$SCHED_WAIT:
!   Add routine NMU$TIMEOUT_CHECK
!   Change NMU$SCHED_WAIT and NMU$SCHED_DESCHEDULE
!   Change calls to NMU$SCHED_WAIT in NMU$SQUEUE_REMOVE, NMU$QQUEUE_INSERT,
!                             and SCHEDULER_TASK.
!
! NET:<GROSSMAN>NMUSKD.BLI.2  8-Dec-81 17:17:47, Edit by GROSSMAN
!
! Install a call to DETACH if we're running under Tops-10. This should be the
! first thing done in the program, because there are probably several things
! waiting to for us to get off the Force Line.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUSKD.BLI.44  2-Oct-81 15:06:29, Edit by GUNN
!
! Ident 10.
! Change NML version number to 3.0.0 from 2.1.0.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUSKD.BLI.42 12-Aug-81 10:43:40, Edit by JENNESS
!
!    Ident 09.
!    Add NMU$QQUEUE_EXTRACT routine.  Needed to handle REMOTE/LOCAL NML
!    request queues.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUSKD.BLI.41  6-Aug-81 13:46:31, Edit by JENNESS
!
!    Add routine NMU$SCHED_ERROR.  Change NMU$SCHED_COMPLETE to look at
!    the error message stored in the task block only.  NMU$SCHED_ERROR
!    puts the supplied error message in the task block error buffer and
!    then calls NMU$SCHED_COMPLETE.  (Makes panic interrupts easier).
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUSKD.BLI.40  5-Aug-81 15:26:20, Edit by JENNESS
!
!    Fix ch$movasciz call in NMU$SCHED_COMPLETE so that it has the
!    correct arguments (addresses instead of immediate pointers).
!
! NET:<DECNET20-V3P1.NMU.LIBRARY>NMUSKD.BLI.2 30-Jun-81 10:36:28, Edit by JENNESS
!    Make TIMEOUT_SIGNAL clear TIME_OUT.  This solves multiple tasks
!    waiting for timeout race problem.
!
!NET:<DECNET20-V3P1.NMU>NMUSKD.BLI.2 16-Jun-81 13:21:51, Edit by JENNESS
!
!    Readability improvements.  Add TB_ERROR_PC to task block for recording
!    PC of exception failures.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.MCB>NMUSKD.BLI.1 10-Jun-81 09:37:45, Edit by SROBINSON
!
!    Add Quota Queue Support
!
!<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUSKD.BLI.31 23-Mar-81 11:17:02, Edit by SROBINSON
!
!    Fix NMU$SCHED_EVENT to set event block EB_NOINT flags correctly
!
!NET:<DECNET20-V3P1.NMU>NMUSKD.BLI.42 14-Mar-81 15:15:38, Edit by JENNESS
!
!    Add trace code for debugging.
!
!<DECNET20-V3P1.BASELEVEL-2.MCB>NMUSKD.BLI.2 13-Mar-81 14:32:46, Edit by SROBINSON
!    Fix NMU$SCHED_FLAG to clear out the queue on any EVENT
module NMUSKD (					! Scheduler
		ident = 'X00.19',
		main = TOPMOST
		) =
begin
!
!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     This software is furnished under a license and may  be  used
!     and copied only in accordance with the terms of such license
!     and with the inclusion of the above copyright notice.   This
!     software  or any other copies thereof may not be provided or
!     otherwise made available to any other person.  No  title  to
!     and ownership of the software is hereby transferred.
!
!     The information  in  this  software  is  subject  to  change
!     without  notice  and should not be construed as a commitment
!     by DIGITAL EQUIPMENT CORPORATION.
!
!     DIGITAL assumes no responsibility for the use or reliability
!     of  its  software  on  equipment  which  is  not supplied by
!     DIGITAL.
!

!++
! Facility: LSG DECnet Network Management
!
! Abstract:
!
!       This module provides the scheduling code for multi-tasking.
!	The main routine (start) for any program using this scheduler
!	is contained here also.
!
!       Scheduling is done on two entities:
!
!       (1)  Queues   when a queue becomes non-empty all
!                     tasks waiting are scheduled.
!
!       (2)  Events   when an event occurs the first task waiting for
!                     the event is scheduled.
!
!
! Environment: TOPS10 and TOPS20 user mode, MCB RSX task mode
!
! Author: Steven M. Jenness, Creation date: 20 August 1980
!
!--
!
! Include files
!

library 'NMULIB';				! All needed definitions

!
! Global routines
!

forward routine
    NMU$SCHED_MANAGER;				! Global entry definitions

!
! Local routines
!

forward routine
    TOPMOST : novalue,				! Starting routine
    SCHEDULER_TASK : novalue,			! Scheduler task co-routine
    TIMEOUT_SIGNAL : TIMER_INTERRUPT_LINKAGE novalue,	! Signal SKD_EVENT
    TT_SCAN;					! Scan TIME_QUEUE

!
! Global literals
!

global literal
    %name ('TB.SKD') = %fieldexpand (TB_SCHED_QUEUE, 0) * %UPVAL,
    %name ('TB.QUE') = %fieldexpand (TB_TASK_QUEUE, 0) * %UPVAL,
    %name ('TB.STR') = %fieldexpand (TB_START, 0) * %UPVAL,
    %name ('TB.ABT') = %fieldexpand (TB_ABORT, 0) * %UPVAL,
    %name ('TB.RSC') = %fieldexpand (TB_RESOURCE, 0) * %UPVAL,
    %name ('TB.ERR') = %fieldexpand (TB_ERROR_PC, 0) * %UPVAL,
    %name ('TB.NAM') = %fieldexpand (TB_NAME, 0) * %UPVAL,
%if $TOPS10 or $TOPS20
%then
    %name ('TB.BUF') = %fieldexpand (TB_ERROR_BUFFER, 0) * %UPVAL,
%fi
    %name ('TB.EVW') = %fieldexpand (TB_EVENT_WAIT, 0) * %UPVAL,
    %name ('TB.SEM') = %fieldexpand (TB_SEMAPHORE, 0) * %UPVAL,
    %name ('TB.TIM') = %fieldexpand (TB_TIME, 0) * %UPVAL,
    %name ('TB.CTX') = %fieldexpand (TB_CONTEXT, 0) * %UPVAL,
    %name ('TB.STK') = %fieldexpand (TB_STACK, 0) * %UPVAL;

!
! Own storage
!

!
! Make something have an initial value so $OWN$ PSECT for NMUSKD
! shows up in TKB36 map.
!

own
    RUN_QUEUE : initial (0),            ! Queue of runnable tasks
    TASK_QUEUE : Q_HEADER,              ! Queue of all tasks
    SKD_EVENT : EVENT_BLOCK,            ! Event for scheduler wakeup
    SKD_TASK : ref TASK_BLOCK,          ! Task block for scheduler
    TIME_OUT : TIME_BLOCK;

global
    TIME_QUEUE : Q_HEADER,              ! Queue of tasks waiting for timeouts
    NMLVER : initial (3),
    DECECO : initial (0),
    USRECO : initial (0);

%master_debug_data_base;                ! Debugging data base

!
! Structures
!
! Timer queue scanning data block
!

    $field
    TQUEUE_SCAN_FIELDS =
	set
	TT_NOW = [$sub_block (TIME_BLOCK_SIZE)], ! Current time
	TT_TIME = [$sub_block (TIME_BLOCK_SIZE)] ! Least of wakeup times found
	tes;

literal
    TQUEUE_SCAN_SIZE = $field_set_size;

macro
    TIMER_SCAN_BLOCK = block [TQUEUE_SCAN_SIZE] field (TQUEUE_SCAN_FIELDS) %;

!
! External references
!

external
    CURTSK;					! Current task pointer

external routine
    NMU$TABLE_ROUTINES,				! Table manipulation routines
    NMU$QUEUE_MANAGER,				! Queue manager routines
    NMU$MEMORY_MANAGER,				! Memory management routines
    INIT_GLOBALS;				! Other global routines for initialization
%routine ('TOPMOST') : novalue =

!++
! Functional description:
!
!       This is the "main" routine for the program using this
!	scheduler.
!
!	It initializes the memory management system, scheduler and
!	any other system that requires initialization (defined in
!	NMINI.REQ).
!
!
! Note that interlocks need to be developed to allow multi-streaming
! of initialization code.
!
!--

    begin

!
! Detach the job from the Force Line if necessary. (Tops-10 only)
!
    %if $TOPS10 %then DETACH (); %fi

!
! Setup the debugging data base (if needed)
!
    %debug_setup;

!
! Reset memory manager
!
    NMU$MEMORY_RESET ();
    NMU$MEMORY_INITIALIZE (BASIC_MEMORY);
!
! Reset the scheduler.
!
! Reset master task queue and queue of runnable tasks.
!
    NMU$QUEUE_RESET (TASK_QUEUE);
    RUN_QUEUE = 0;
!
! Create null task using the current stack.
!
    NMU$QUEUE_RESET (TIME_QUEUE);    
    NMU$SCHED_EVENT (SKD_EVENT, $true);

    SKD_TASK = NMU$MEMORY_GET (TASK_BLOCK_ALLOCATION);
    CURTSK = .SKD_TASK;

    begin

    local
	TASK_NAME_POINTER, NAME_LITERAL;

    TASK_NAME_POINTER = ch$ptr (SKD_TASK [TB_NAME]);
    NAME_LITERAL = ch$asciz ('SCHEDULER');
    ch$movasciz (TASK_NAME_POINTER, .NAME_LITERAL);
    end;

!
! Initialize all other systems.
!
    MASTER_INITIALIZATION;
!
! Start scheduling by calling scheduler co-routine
!
    SCHEDULER_TASK ();
!
! If return here ... NML has crashed.
!
    end;					! End of TOPMOST
%global_routine ('NMU$SCHED_CREATE', CODE, STACK_SIZE, ABORT_RTN, NAME_PTR) =

!++
! Functional description:
!
!       This routine allocates a task state block and sets the task
!       up for execution.  The code specified is started when the
!       task comes up in the runnable task queue.
!
! Formal parameters:
!
!       .CODE         Address of routine to execute as the task
!       .STACK_SIZE   Number of fullwords to allocate for stack
!	.ABORT_RTN    Address of a routine to call when the task
!		       is aborted
!	.NAME_PTR     Byte pointer to a ASCIZ task name string
!
! Routine value:
!
!       The returned value is the address of the task's state
!       block.  This value is used whenever the task is to
!       be affected by such routines as NMU$SCHED_ABORT.
!
! Side effects:
!
!       The runnable task queue gets another task.
!
!--

    begin

    local
	TASK : ref TASK_BLOCK,
	TASK_NAME;

    %debug (SCHEDULER_TRACE, (TRACE_INFO ('Creating %A (%O)', .NAME_PTR, .CODE)));

%if $TOPS10 or $TOPS20
%then
    STACK_SIZE = .STACK_SIZE*2;
%fi

!
! Get memory for a task block
!
    TASK = NMU$MEMORY_GET (TASK_BLOCK_ALLOCATION + (.STACK_SIZE*%upval));
!
! Initialize start address, error routine, task name and
! stack.
!
    TASK [TB_START] = .CODE;
    TASK_INITIALIZE (.TASK, .STACK_SIZE);
    TASK [TB_ABORT] = .ABORT_RTN;
    TASK_NAME = ch$ptr (TASK [TB_NAME]);
    ch$movasciz (TASK_NAME, .NAME_PTR);
!
! Insert entry into master task queue and
! runnable task queue.
!
    NMU$QUEUE_INSERT (TASK_QUEUE, TASK [TB_TASK_QUEUE]);
    NMU$TABLE_INSERT (RUN_QUEUE, TASK [TB_SCHED_QUEUE]);
!
! Return address of the task block.
!
    .TASK
    end;					! End of NMU$SCHED_CREATE
%global_routine ('NMU$SCHED_ABORT', TASK : ref TASK_BLOCK) : novalue =

!++
! Functional description:
!
!       This routine aborts a task and calls it's clean up routine.
!
! Formal parameters:
!
!       .TASK   Address of task block for task to abort.
!
! Routine value: none
! Side effects:
!
!       The specified task will be aborted, it's cleanup routine
!       will be called (if it exists) and all traces of the task
!       will disappear.
!
!--

    begin

    bind routine
	A_ROUTINE = .TASK [TB_ABORT];		! Abort routine address

    %debug (SCHEDULER_TRACE, (TRACE_INFO ('Aborting task %A (%O)',
					   ch$ptr (TASK [TB_NAME]), .TASK)));

    if A_ROUTINE neq 0 then A_ROUTINE (.TASK);

!*****
! If task is completely aborted ... delete the task and resources
!*****

    end;					! End of NMU$SCHED_ABORT
%global_routine ('NMU$SCHED_FINI') : novalue =

!++
! Functional description:
!
!	This routine is called whenever a task "exits".  This means
!	that the routine comprising the main routine of the task
!	attempts to return.
!
! Formal parameters: none
!
! Routine value: none
! Side effects:
!
!--

    begin

    TASK_INFO ('Task has exited');

    NMU$SCHED_DESCHEDULE ();
    end;					! End of NMU$SCHED_FINI
%global_routine ('NMU$SCHED_ERROR', ERROR_PTR) : novalue =

!++
! Functional description:
!
!        This routine is called in a task's context to abnormally
!        complete it's execution.  It puts the supplied error message
!        into the task's task block error buffer and then calls
!        NMU$SCHED_COMPLETE to abort the task.
!
! Formal parameters:
!
!    .ERROR_PTR    Pointer to ASCIZ string to be put into the
!                   task block error buffer.
!
! Routine value: none
! Side effects: none
!
!--

    begin

%if not $MCB
%then
    local
         TASK : ref TASK_BLOCK,
         TB_POINTER;

    TASK = CURRENT_TASK;

    TB_POINTER = ch$ptr (TASK [TB_ERROR_BUFFER]);

    if .ERROR_PTR neq 0
    then ch$movasciz (TB_POINTER, .ERROR_PTR);
%fi

    NMU$SCHED_COMPLETE ();
    end;                                ! End of NMU$SCHED_ERROR
%global_routine ('NMU$SCHED_COMPLETE') : novalue =

!++
! Functional description:
!
!        This routine is called in a task's context to abnormally
!        complete it's execution.  It outputs the message that is
!        stored in the task block's error buffer, aborts the task
!        and deschedules it forever.
!
! Formal parameters: none
!
! Routine value: none
! Side effects: none
!
!--

    begin
    local
         TASK : ref TASK_BLOCK;

    TASK = CURRENT_TASK;

%if not $MCB
%then
    TASK_INFO (ch$ptr (TASK [TB_ERROR_BUFFER]));
%fi

    NMU$SCHED_ABORT (.TASK);
    NMU$SCHED_DESCHEDULE ();
    end;                                ! End of NMU$SCHED_COMPLETE
%global_routine ('NMU$SQUEUE_RESET', QUEUE : ref SQ_HEADER) : novalue =

!++
! Functional description:
!
!       This routine resets a "scheduling" type queue.  Any queue
!       that can have scheduling done on it contains extra information
!       in the queue header that should be reset any time the queue
!       is reset.
!
! Formal parameters:
!
!       .QUEUE   Address of queue header
!
! Routine value: none
! Side effects:
!
!      Any entries on the queue are lost
!      Any tasks that are waiting on this queue have
!       their entries on the task wait list deleted.
!
!--

    begin

!
! Reset data queue.
!
    NMU$QUEUE_RESET (QUEUE [Q_QUEUE]);
!
! Reset queue non-empty event.
! Don't allow SQUEUE operations at interrupt level.
!
    NMU$SCHED_EVENT (QUEUE [Q_EVENT], $false);
    end;					! End of NMU$SQUEUE_RESET
%global_routine ('NMU$SQUEUE_INSERT', QUEUE : ref SQ_HEADER, ENTRY) : novalue =

!++
! Functional description:
!
!       This routine inserts an entry into a queue.  If a task is
!       waiting for this queue to become non-empty, it is scheduled
!       for execution.
!
! Formal parameters:
!
!       .QUEUE   Address of a queue header block
!       .ENTRY   Address of a entry to be inserted to queue
!
! Routine value: none
! Side effects:
!
!       If the queue becomes non-empty the queue of tasks waiting
!       for this to happen is checked.  If a task is waiting, it
!       is put onto the queue of runnable tasks.
!
!--

    begin

    NMU$QUEUE_INSERT (QUEUE [Q_QUEUE], .ENTRY);
    NMU$SCHED_FLAG (QUEUE [Q_EVENT]);
    end;					! End of NMU$SQUEUE_INSERT
%global_routine ('NMU$SQUEUE_REMOVE', QUEUE : ref SQ_HEADER) =

!++
! Functional description:
!
!       This routine removes an entry from a queue.  If the queue
!       is empty, the calling task is descheduled and a new task
!       is selected for running.  If no task is runnable, the null
!       task is executed.
!
! Formal parameters:
!
!       .QUEUE   Address of a queue header block
!
! Routine value:
!
!       Address of entry from queue
!
! Side effects: none
!
!--

    begin

    local
	ENTRY;

    while (ENTRY = NMU$QUEUE_REMOVE (QUEUE [Q_QUEUE])) eql 0 do
	NMU$SCHED_WAIT (QUEUE [Q_EVENT],0);

    .ENTRY
    end;					! End of NMU$SQUEUE_REMOVE
%global_routine ('NMU$QQUEUE_RESET', QUEUE : ref QQ_HEADER, QUOTA) : novalue =

!++
! Functional description:
!
!       This routine resets a "quota scheduling" type queue.  Any queue
!       that can have scheduling done on it contains extra information
!       in the queue header that should be reset any time the queue
!       is reset.
!
! Formal parameters:
!
!       .QUEUE   Address of queue header
!       .QUOTA   Number of Entries in queue before insert waits
!
! Routine value: none
! Side effects:
!
!      Any entries on the queue are lost
!      Any tasks that are waiting on this queue have
!       their entries on the task wait list deleted.
!
!--

    begin

!
! Reset the scheduler queue portion of this entry.
!
    NMU$SQUEUE_RESET (QUEUE [QQ_SQUEUE]);
!
! Reset insert queue resume event.
! Don't allow SQUEUE operations at interrupt level.
!
    NMU$SCHED_EVENT (QUEUE [QQ_IEVENT], $false);
    QUEUE [QQ_QUOTA] = .QUOTA;
    QUEUE [QQ_CURRENT] = 0;
    end;					! End of NMU$QQUEUE_RESET
%global_routine ('NMU$QQUEUE_INSERT', QUEUE : ref QQ_HEADER, ENTRY) : novalue =

!++
! Functional description:
!
!       This routine inserts an entry into a queue.  If a task is
!       waiting for this queue to become non-empty, it is scheduled
!       for execution. If this insert would exceed the insert quota
!       the current task is suspended.
!
! Formal parameters:
!
!       .QUEUE   Address of a queue header block
!       .ENTRY   Address of a entry to be inserted to queue
!
! Routine value: none
! Side effects:
!
!       If the queue becomes non-empty the queue of tasks waiting
!       for this to happen is checked.  If a task is waiting, it
!       is put onto the queue of runnable tasks.
!
!--

    begin

    while .QUEUE [QQ_CURRENT] geq .QUEUE [QQ_QUOTA]
    do NMU$SCHED_WAIT (QUEUE [QQ_IEVENT],0);

    QUEUE [QQ_CURRENT] = .QUEUE [QQ_CURRENT] + 1;
    NMU$SQUEUE_INSERT (QUEUE [QQ_SQUEUE], .ENTRY);
    end;					! End of NMU$QQUEUE_INSERT
%global_routine ('NMU$QQUEUE_REMOVE', QUEUE : ref QQ_HEADER) =

!++
! Functional description:
!
!       This routine removes an entry from a queue.  If the queue
!       is empty, the calling task is descheduled and a new task
!       is selected for running.  If no task is runnable, the null
!       task is executed. When a remove has dropped the number of
!       queue entries to less than the quota the queue inserter is
!       resumed.
!
! Formal parameters:
!
!       .QUEUE   Address of a queue header block
!
! Routine value:
!
!       Address of entry from queue
!
! Side effects: none
!
!--

    begin

    local
        ENTRY;

    ENTRY = NMU$SQUEUE_REMOVE (QUEUE [QQ_SQUEUE]);
    QUEUE [QQ_CURRENT] = .QUEUE [QQ_CURRENT] - 1;

    if .QUEUE [QQ_CURRENT] lss .QUEUE [QQ_QUOTA]
    then NMU$SCHED_FLAG ( QUEUE [QQ_IEVENT]);

    .ENTRY
    end;					! End of NMU$QQUEUE_REMOVE
%global_routine ('NMU$QQUEUE_EXTRACT', QUEUE : ref QQ_HEADER, ENTRY) =

!++
! Functional description:
!
!       This routine removes an explicit entry from a queue.  The
!       quota for the queue is adjusted to reflect the entry's
!       extraction.
!
! Formal parameters:
!
!       .QUEUE   Address of a queue header block
!       .ENTRY   Address of entry on queue
!
! Routine value:
!
!	$true	Entry was found on the queue and extracted
!	$false	Entry was not found on the queue
!
! Side effects: none
!
!--

    begin

    if NMU$QUEUE_EXTRACT (QUEUE [QQ_SQUEUE], .ENTRY)
    then
        begin
        QUEUE [QQ_CURRENT] = .QUEUE [QQ_CURRENT] - 1;
        $true
        end
    else
        $false

    end;					! End of NMU$QQUEUE_EXTRACT
%global_routine ('NMU$SCHED_EVENT', EVENT : ref EVENT_BLOCK, INT_OFF) : novalue =

!++
! Functional description:
!
!       This routine resets the data base associated with a
!       particular event.
!
! Formal parameters:
!
!       .EVENT		Address of event block (EVENT_BLOCK)
!	.INT_OFF	Boolean flag indicating if interrupts
!			are to be turned off when this event
!			is being signalled. (i.e. this flag is
!			$true if the event can be signalled from
!			interrupt level.)
!
! Routine value: none
! Side effects:
!
!       The queue of tasks waiting for the event is cleared.
!       The count of event occurances is cleared.
!
!--

    begin

    %debug (EVENT_TRACE, (TRACE_INFO ('Event reset (%O)', .EVENT)));

!
! Reset queue of tasks waiting for this event.
!
    NMU$TABLE_CLEAR (EVENT [EB_TASKS]);
!    EVENT [EB_TASKS] = 0;
!
! Lock the event semaphore, indicating is hasn't
! happened yet.
!
    LOCK (EVENT [EB_SEMAPHORE]);
!
! Set the interrupt suppression flag (if event
! can be signalled from interrupt level.
!
    EVENT [EB_NOINT] = .INT_OFF;
    end;					! End of NMU$SCHED_EVENT
%global_routine ('NMU$SCHED_FLAG', EVENT : ref EVENT_BLOCK) : novalue =

!++
! Functional description:
!
!       This routine flags an "event" occurance.  Any task that
!       is waiting for the event will be put onto the RUNNABLE
!       task queue.
!
! Formal parameters:
!
!       .EVENT    Address of selected event queue header
!
! Routine value: none
! Side effects:
!
!       Tasks may be put onto the runnable queue.
!       The queue associated with the EVENT will be emptied.
!
!--

    begin

    local
	TASK : ref TASK_BLOCK;

    %debug (EVENT_TRACE, (TRACE_INFO ('Event flagged (%O)', .EVENT)));

!
! If can be flagged from interrupt level .. turn
! interrupts off for a moment.
!

    if .EVENT [EB_NOINT] then INTERRUPT_OFF;

!
! Signal that the event has happened by  scheduling  all  the
! tasks  queued  to the event.  If no tasks are queued to the
! event, unlock the semaphore to indicate the event has occurred.
!

    TASK = 0;
    incr INDEX from 1 to NMU$TABLE_MAX (EVENT [EB_TASKS]) do
	if NMU$TABLE_FETCH (EVENT [EB_TASKS], .INDEX, TASK) then
	begin
	NMU$TABLE_INSERT (RUN_QUEUE, TASK [TB_SCHED_QUEUE]);
	NMU$TABLE_DELETE (EVENT [EB_TASKS], .INDEX);
	end;

    if .TASK eql 0 then UNLOCK (EVENT [EB_SEMAPHORE]);

!
! Now  we  clear  the table pointed to by the event block, so
! that people who just deallocate the block  without  calling
! NMU$SCHED_EVENT,  won't make us lose the memory taken up by
! the table.  (At this point all of the useful  info  in  the
! table has been extracted.)
!

    NMU$TABLE_CLEAR (EVENT [EB_TASKS]);

!
! Turn interrupts back on it they were turned off.
!

    if .EVENT [EB_NOINT] then INTERRUPT_ON;

    end;					! End of NMU$SCHED_FLAG
%global_routine ('NMU$SCHED_WAIT', EVENT: ref EVENT_BLOCK, SECONDS) :  =

!++
! Functional description:
!
!       This routine blocks a process until it is woken up on
!       any event (or queue non-empty) that it is waiting for,
!       or until the timeout interval (if specified) passes.
!
! Formal parameters:
!
!	.EVENT	Address of event block on which to wait
!	SECONDS	Number of seconds to wait before timing out
!		0 means no timeout
!
! Routine value:
!
!	 $TRUE if the awaited event happened or if no timeout requested
!        $FALSE if it timed out
!
! Side effects: none
!
!--

    begin

    local
	TASK : ref TASK_BLOCK,
	EVENT_OCCURRED;

    stacklocal
        TABLE_INDEX;			! Ensure our own private copy

    %debug (EVENT_TRACE, (TRACE_INFO ('Event wait (%O)', .EVENT)));

!
! Turn the interrupts off if this event can be signaled from
! interrupt level.
!

    if .EVENT [EB_NOINT] then INTERRUPT_OFF;

    EVENT_OCCURRED = LOCK (EVENT [EB_SEMAPHORE]);

    if not .EVENT_OCCURRED		! If event has not yet occurred,
    then				! add current task to task list
	begin				! for this event.
	TABLE_INDEX = NMU$TABLE_INSERT (EVENT [EB_TASKS], CURRENT_TASK);
	if .EVENT [EB_NOINT] then INTERRUPT_ON; ! Enable interrupts
        if .SECONDS eql 0		! If no time specified,
	then				!  just suspend task.
	    begin
	    NMU$SCHED_DESCHEDULE ();	! When task resumes...
	    return $TRUE;	 	!  Return
	    end
        else				! If a wait time was specified,
	    NMU$SCHED_SLEEP (.SECONDS);	!  suspend task by sleeping.

	!
	! Task will resume here if sleep time expires or event occurs.
	! If it timed out, task needs to be removed from event task
	! list; if event occurred, task needs to be removed from
	! TIME_QUEUE.  We try to do both -- no ill side effects.
	!

	if .EVENT [EB_NOINT] then INTERRUPT_OFF; ! Interrupts off again

	EVENT_OCCURRED = (.EVENT [EB_TASKS] eql 0);

	NMU$TABLE_DELETE (EVENT [EB_TASKS], .TABLE_INDEX);

	TASK = CURRENT_TASK;
        NMU$QUEUE_EXTRACT(TIME_QUEUE, TASK [TB_SCHED_QUEUE]);

	if .EVENT [EB_NOINT] then INTERRUPT_ON;

	return .EVENT_OCCURRED;
	end
    else				! If event has already occurred,
        begin				!  do not even suspend task.
	if .EVENT [EB_NOINT] then INTERRUPT_ON;
        return $TRUE;
        end;
    end;					! End of NMU$SCHED_WAIT
%global_routine ('NMU$SCHED_DESCHEDULE') : novalue =

!++
! Functional description:
!
!	This routine deschedules the currently running task.
!	If no other task wants to run, the null task is run.
!
! Formal parameters: none
!
! Routine value: none
! Side effects: none
!
!--

    begin

    local
	TASK : ref TASK_BLOCK;

    TASK = 0;

!
! Wait until a task is found and scheduled
!
    while .TASK eql 0
    do
	begin

!
! Turn interrupts off so that the scheduler is not
! interrupted while working on the run queue.
!
	INTERRUPT_OFF;
!
! Get the next entry from the run queue.
!
	incr INDEX from 1 to NMU$TABLE_MAX (RUN_QUEUE) do
	    if NMU$TABLE_FETCH (RUN_QUEUE, .INDEX, TASK) then
	    begin
		NMU$TABLE_DELETE (RUN_QUEUE, .INDEX);
		exitloop;
	    end;


!	TASK = NMU$QUEUE_REMOVE (RUN_QUEUE);
!
! Turn the interrupts back on now.
!
	INTERRUPT_ON;
!
! Switch context to either the new task (if
! one was removed from the queue or the the
! null task.
!

	if .TASK neq 0
	then
	    if .TASK neq CURRENT_TASK
	    then
		begin
		%debug (SCHEDULER_TRACE,
			(TRACE_INFO ('Switch to (%O) %A',
				 .TASK, ch$ptr (TASK [TB_NAME]))));

		CONTEXT_SWITCH (.TASK);
	        end
	    else
		begin
		%debug (SCHEDULER_TRACE,
			(TRACE_INFO ('Continuing current task')));
		1;
		end
	else
	    begin
	    %debug (SCHEDULER_TRACE,
		    (TRACE_INFO ('No runnable task .. sleeping')));

	    %if not $TOPS10 %then PROCESS_SLEEP (60);
                            %else PROCESS_SLEEP (0); %fi

	    %debug (SCHEDULER_TRACE,
		    (TRACE_INFO ('Program woken up')));
	    end;
	end;
!
! When context switched back to this task...
! this routine will return.
!
    end;					! End of NMU$SCHED_DESCHEDULE
%global_routine ('NMU$SCHED_SLEEP', TIME) : novalue =

!++
! Functional description:
!
!	This routine is called by any task that wishes to go
!	to sleep for a short while.  The task will block until
!	the specified number of seconds elapses.
!
! Formal parameters:
!
!	.TIME	Number of seconds to wait.
!
! Routine value: none
! Side effects: none
!
!--

    begin

    local
	TASK : ref TASK_BLOCK;

    %debug (SCHEDULER_TRACE, (TRACE_INFO ('Task sleeping for %D seconds', .TIME)));

!
! Get address of currently running task's task block.
!
    TASK = CURRENT_TASK;
!
! Set the time to wake this task up, clear the wakeup
! event and queue it to the time wakeup queue.
!
    TIME_CURRENT (.TIME, TASK [TB_TIME]);
!First extract the item from the queu if it was in there already. This will
!insure that an item never get in there twice.
    NMU$QUEUE_EXTRACT(TIME_QUEUE, TASK [TB_SCHED_QUEUE]);
    NMU$QUEUE_INSERT (TIME_QUEUE, TASK [TB_SCHED_QUEUE]);
!
! Signal to the TIMER TASK that someone has modified it's
! data base.  Then wait for the TIMER TASK to put this task
! back onto the run queue.
!
    NMU$SCHED_FLAG (SKD_EVENT);
    NMU$SCHED_DESCHEDULE ();

    %debug (SCHEDULER_TRACE,
	    (TRACE_INFO ('Task woken up')));
    end;					! End of NMU$SCHED_SLEEP
%routine ('SCHEDULER_TASK') : novalue =

!++
! Functional description:
!
!	This task handles timeouts for other tasks.  Other
!	tasks queue themselves to this task to be woken up
!	after the time specified in the TIME_OUT block in
!	their respective task blocks.
!
! Formal parameters: none
!
! Routine value: none
! Side effects: none
!
!--

    begin

    local
	TT_SBLK : TIMER_SCAN_BLOCK;

!
! Flag that no time out interrupt is currently defined.
!
    TIME_SET_NULL (TIME_OUT);
!
! Loop doing this task's work forever.
!

    while $true do
	begin
!
! Get current time.
!
	TIME_CURRENT (0, TT_SBLK [TT_NOW]);
	TIME_SET_NULL (TT_SBLK [TT_TIME]);
!
! Scan timer queue, scheduling any task that needs
! to be scheduled.  Also find the next time to have
! a time out interrupt generated.
!
	NMU$QUEUE_SCAN (TIME_QUEUE, TT_SBLK, TT_SCAN);
!
! The time returned in TT_TIME is the time of the closest
! task wakeup.  If it is greater than zero, a task is
! waiting for wakeup.  If no task is waiting, then clear
! any pending interrupts.
!
! Set a new time out interrupt if needed.
!

	if TIME_NULL (TT_SBLK [TT_TIME])
	then
	    begin
	    TIME_INTERRUPT_CLEAR;
	    TIME_SET_NULL (TIME_OUT);
	    end
	else

	    if TIME_TEST (TT_SBLK [TT_TIME], lss, TIME_OUT)
	       or TIME_NULL (TIME_OUT)
	    then
		begin
		TIME_COPY (TIME_OUT, TT_SBLK [TT_TIME]);
		TIME_INTERRUPT_CLEAR;
		TIME_INTERRUPT_SET (TIME_OUT, TIMEOUT_SIGNAL);
		end;

!
! Wait until the next scheduler event occurs.  The scheduler
! event includes both time interrupts and another task
! queueing itself to be woken up in the future.
!
	NMU$SCHED_WAIT (SKD_EVENT,0);
	end;

    end;					! End of SCHEDULER_TASK
%routine ('TIMEOUT_SIGNAL') TIMER_INTERRUPT_ROUTINE novalue =

!++
! Functional description:
!
!	This routine is called at interrupt level when
!	a timer interrupt occurs.  It signals the SKD_EVENT
!	so that the scheduler task will start again.
!
! Formal parameters: none
!
! Routine value: none
! Side effects: none
!
!--

    begin
        TIME_SET_NULL (TIME_OUT);
	NMU$SCHED_FLAG (SKD_EVENT);
	PROCESS_WAKE;
    end;					! End of TIMEOUT_SIGNAL
%routine ('TT_SCAN', TASK : ref TASK_BLOCK, DATA : ref TIMER_SCAN_BLOCK) =

!++
! Functional description:
!
!	This routine performs the timer queue scaning for the
!	scheduler task.
!
!	When a task is found that has a wakeup time less than
!	the current time, a wakeup event is generated for it.
!
!	The closest wakeup time to the current time is kept
!	so that a wake up interrupt can be set.
!
! Formal parameters:
!
!	.TASK	Address of task from time queue
!	.DATA	Address of timer queue scanning data block
!
! Routine value: none
! Side effects: none
!
!--

    begin
!
! Check to see if the task needs to be woken up.
!

    if TIME_TEST (TASK [TB_TIME], leq, DATA [TT_NOW])
    then
	begin
	NMU$QUEUE_SCAN_EXTRACT (TASK [TB_SCHED_QUEUE]);
	NMU$TABLE_INSERT (RUN_QUEUE, TASK [TB_SCHED_QUEUE]);
	%debug (SCHEDULER_TRACE,
		(TRACE_INFO ('Task (%O) %A scheduled for wakeup',
			 .TASK, ch$ptr (TASK [TB_NAME]))));
	end
    else
!
! Check if wakeup time of task is the closest future
! time.
!

	if TIME_TEST (DATA [TT_TIME], gtr, TASK [TB_TIME])
	   or TIME_NULL (DATA [TT_TIME])
	then TIME_COPY (DATA [TT_TIME], TASK [TB_TIME]);

!
! Return value indicating that queue scan should continue to
! the end of the queue.
!
    0
    end;					! End of TT_SCAN
%global_routine ('NMU$SCHED_CURRENT') =

!++
! Functional description:
!
!	This routine returns the current task block address.
!
! Formal parameters: none
!
! Routine value:
!
!	A task block address
!
! Side effects: none
!
!--

    begin
    CURRENT_TASK
    end;					! End of NMU$SCHED_CURRENT

end						! End of module SCHED

eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! End: