! Schedule execution of system components

! The entire filestore system is based around a number of cooperating
! processes.  These wait for various events to occur, and kick the event
! queues on which other processes are waiting to notify them that particular
! events have happened.  In addition the scheduler recognises a number of
! special events (related to the disc and the ether) and kicks the queues
! related to these events as special cases.  Note that while scheduling IS
! done on a priority basis, so that, for example, ether reads are given the
! highest priority while console log stamps are given the lowest priority, it
! is NOT the case that scheduling is pre-emptive.  ALL processes are allowed
! to run to completion, only being removed from the CPU when they explicitly
! wait for an event to happen -- this avoids some messy locking and
! synchronisation problems in the file system, particularly when dealing
! with directories.  The file system will choose to block all non-essential
! processes when doing a directory disc transfer -- this is to ensure that
! the consistency of the directory cache is maintained.
!
! This version uses unsigned comparisons for timeouts (assuming that the
! overflow checking is disabled!!).

%option "-nocheck-nostack-noline-low"

%constinteger toggle keyboard = '_' - '@'

%constinteger disc  timeout period = 20 000   { Milliseconds }
%constinteger ether timeout period = 30 000   { Milliseconds }

%constinteger PC lower = 16_800000     { Validity check on PC being restored }
%constinteger PC upper = 16_900000     {          .... ditto ....            }

%include "Config.Inc"

%include "System:Common"
%include "System:Schedule.Inc"
%include "System:Utility.Inc"

%include "Inc:FS.Imp"
%include "Inc:Util.Imp"

%ownrecord(common fm)%name common
%externalrecord(common fm)%mapspec common area

%externalroutinespec show disq status
%externalroutinespec kick disq
%externalroutinespec show system status
%externalroutinespec show ether status
%externalroutinespec show buffer info
%externalroutinespec show proc last
%externalroutinespec FSx display directory

%externalroutinespec proc main entry
%externalroutinespec ether TX main entry
%externalroutinespec ether RX main entry
%externalroutinespec packet main entry
%externalroutinespec stamp main entry
! despooler main entry is declared in CONFIG.INC

%externalinteger schedule mask   = 0
%externalinteger schedule cutoff = last event

%externalintegerspec file system writeable


! Process save areas and wait queues.  The wait queues are arranged as
! circular lists of register save areas, each list being sufficiently
! large to accommodate all the processes on the one queue.  This is,
! of course, rather wasteful of space......

%recordformat register save fm(%integer d2, d3, d4, d5, d6, d7,
                               %integer a2, a3, a4, a5, a6, a7,
                               %integer pc)

%recordformat queue fm(%integer head, tail,
                       %record(register save fm)%array q(0 : schedule queue))
%ownrecord(register save fm) scheduler context = 0
%ownrecord(queue fm)%array queues(0 : last event) = 0(*)

%externalinteger diagnostics = 0


! Print out the state of the wait queues on the console

%routine show waitq
   %integer i
   %record(queue fm)%name q
      printstring("WaitQ:")
      %for i = 0, 1, last event %cycle
         q == queues(i)
         %if q_head # q_tail %start
            write(i, 1)
            print symbol(':')
            write((q_tail - q_head + schedule queue + 1) & schedule queue, 0)
         %finish
      %repeat
      newline
%end


! Directory disc transfers require that other file system operations be
! inhibited for the duration for reasons of consistency.  These routines
! block and unblock the scheduling of processes of a lower priority than
! a particular (predefined) level.  <Inhibit count> should only ever
! take the values 0 or 1....??

%externalinteger inhibit count = 0

%externalroutine inhibit noncritical
   inhibit count = inhibit count + 1
   schedule cutoff = inhibit limit
%end

%externalroutine uninhibit all
   inhibit count = inhibit count - 1
   %if inhibit count = 0 %start
      schedule cutoff = last event
   %else %if inhibit count < 0
      pdate
      printstring("*** Inhibit count negative")
      newline
   %finish
%end


! Now the scheduler proper.  Sit in a loop looking for events which have
! happened.  These will be caused either by an explicit kick or by an
! implicit one caused by the disc or ether changing state.

%recordformat disc done fm(%integername x);  ! Oh for %external %names.....
%externalrecord(disc done fm) disc done = 0

%owninteger kick despoolers = 0
%owninteger despooler kick mask = 0

%externalroutine despooler ready(%integer which)
   %unless despooler base < which <= despooler base + despoolers %start
      pdate
      printstring("*** Despooler ready -- bad despooler number")
      newline
      %return
   %finish
   despooler kick mask = despooler kick mask ! (1 << which)
%end

%owninteger saved stack = 0

! There may be a number of ether TX processes, each waiting for a separate
! port to complete its transfer.  These arrays hold the wait states
! of each of these processes.
%ownintegerarray      ether timeout(0 : ether TX procs - 1) = infinity(*)
%externalintegerarray ack wait mask(0 : ether TX procs - 1) = 0(*)

%externalroutine schedule
   %owninteger keyboard enabled = 0
   %record(queue fm)%name q
   %integer i, x, new context, now
   %owninteger last time = -1
   %label next
      common == common area
!!    pdate
!!    printstring("Starting scheduler, diagnostics at ")
!!    phex(addr(diagnostics));  newline
      ! First of all we save our own context in a known location,
      ! so that we can be called back when a process decides to wait.
      *lea     scheduler context, A0
      *movem.l D2-D7/A2-A7, (A0)
      *lea     next, A1
      *move.l  A1, 48(A0)
      ! Evaluate how much free space is left
      *move.l  D6, i
      i = saved stack - i - stack gap
      pdate
      write(i, 0);  printstring(" bytes of free store")
      newline
      kick despoolers = CPU time + 240 000;  ! Hold off despoolers for a while
      ! Now comes the main scheduler loop.  We look for any events
      ! which may have happened since the last time we came by here....
next: 
      now = CPU time;  ! for timeout checking, etc
      %if common_disc twait # 0 %and now - common_disc twait >= 0 %start
         pdate
         printstring("*** Disc timeout");  newline
         show disq status
         kick disq
         common_disc twait = now + disc timeout period
      %finish
      %for i = 0, 1, ether TX procs - 1 %cycle
         ! First of all, check to see if any of the ACKs being
         ! waited for have arrived or have timed out.
         %if ack & ack wait mask(i) # 0 %start
            ! ACK has arrived.  Kick the process waiting for it.
            iof
            schedule mask = schedule mask ! (1 << (ether ack wait + i))
            ion
            ack wait mask(i) = 0
            ether timeout(i) <- now + (infinity >> 2)  {allow for arithmetic}
         %else %if ack wait mask(i) # 0 %and now - ether timeout(i) >= 0
            ! Time out the ACK -- this should never happen??
            pdate
            printstring("*** Ether timeout (");  write(i, 0)
            print symbol(')');  newline
            show ether status
            iof
            schedule mask = schedule mask ! (1 << (ether ack wait + i))
            ! Now kid on that a NAK has arrived for that port.  We shouldn't
            ! really do this, but if we don't the process will hang
            ! indefinitely.....
            nak = nak ! ack wait mask(i)
            ack = ack ! ack wait mask(i)
            ion
            ack wait mask(i) = 0
            ether timeout(i) = now + (infinity >> 2)
         %finish
      %repeat
      ! Call the QSARTs once a second (approx)
      %if (now - last time) // 1024 > 0 %start
         qsart tick(now)
         last time = now
      %finish
      ! Now check the console keyboard, in case someone has typed
      ! something on it.  It has to be enabled before we act on it.
      x = test symbol
      %if x = toggle keyboard %start
         ! Enable/disable keyboard
         keyboard enabled = \keyboard enabled
         pdate
         printstring("Keyboard ")
         %if keyboard enabled = 0 %then printstring("dis") %c
                                  %else printstring("en")
         printstring("abled")
         newline
      %else %if keyboard enabled # 0
         %if x = '?' %start
            ! Query system status
            show system status
            show waitq
            show proc last
            show disq status
            !! show qsart status
         %else %if x = 's'
            show buffer info
         %else %if x = 'q'
            show qsart status
         %else %if x = 'b'
            set qsart baud rate
         %else %if x = 'o'
            ! Set open state of the system
            prompt("Open state: ")
            read(common_system open)
         %else %if x = 't'
            ! Turn on/off diagnostic tracing on the console.
            prompt("Trace: ")
            read(common_diags)
         %else %if x = 'w'
            ! Set writeability of file system
            prompt("Write mode: ")
            read(file system writeable)
   !!    %else %if x = 'd'
   !!       ! Dump a directory on the console
   !!       FSx display directory
         %else %if x >= 0
            print symbol(7)
         %finish
      %else %if x >= 0
         print symbol(7)
      %finish
      ! Now kick the ether receiver or any process waiting for the disc
      ! if there is something for them to do.
      iof
      schedule mask = schedule mask ! (1 << packet arrived) %if dtx         # 0
      schedule mask = schedule mask ! (1 << disc transfer)  %if disc done_x # 0
      ! Kick the dedespoolers
      %if despoolers # 0 %start
         %if now - kick despoolers > 0%start
            kick despoolers = now + despooler wait interval
            schedule mask = schedule mask ! despooler kick mask
            despooler kick mask = 0
         %finish
      %finish
      ion
      ! All the implicit kicks have been done, so have a look around to see
      ! if any processes can be scheduled
      %if schedule mask # 0 %start
         %for i = 0, 1, schedule cutoff %cycle
            ! Check all uninhibited processes
            x = 1 << i
            %if schedule mask & x # 0 %start
               ! A queue has been kicked
               q == queues(i)
               %if q_head # q_tail %start
                  ! Something is waiting on the queue.  Unkick it and
                  ! context switch.
                  iof
                  schedule mask = schedule mask !! x
                  ion
                  new context = addr(q_q(q_head))
                  q_head = (q_head + 1) & schedule queue
                  %unless PC lower <= integer(new context + 48) < PC upper %start
                     ! Basic check on the validity of the restored context
                     pdate
                     printstring("Schedule: dubious PC ")
                     phex(integer(new context + 48))
                     newline
                     show system status
                     show waitq
                     show proc last
                     show disq status
                     show qsart status
                     %stop
                  %finish
                  ! Load process context and jump into it....
                  *move.l  new context, A0
                  *movem.l (A0), D2-D7/A2-A7
                  *move.l  48(A0), A0
                  *jmp     (A0)
                  ! Shouldn't ever come back here!
               %finish
            %finish
         %repeat
      %finish
      -> next
%end


! Wait for an event to occur.  Deschedule ourselves and reschedule the
! scheduler loop.

%externalroutine wait for(%integer event)
   %record(queue fm)%name q
   %integer saved context
   %label out
      %unless 0 <= event <= last event %start
         printstring("*** Wait for -- bad event ")
         write(event, 0)
         %stop
      %finish
      ! Get next slot in queue
      q == queues(event)
      saved context = addr(q_q(q_tail))
      q_tail = (q_tail + 1) & schedule queue
      ! Save our own context.  Fiddle saved PC so we get
      ! restored at the bottom of the routine ready to return.
      *move.l  saved context, A0
      *movem.l D2-D7/A2-A7, (A0)
      *lea     out, A1
      *move.l  A1, 48(A0)
      ! Reload the scheduler context and dive in....
      *lea     scheduler context, A0
      *movem.l (A0), D2-D7/A2-A7
      *move.l  48(A0), A0
      *jmp     (A0)
out:
%end


! Called by an ether TX process to indicate that it is expecting an
! ACK from a particular port.  Set up the wait mask and timeout
! value and then wait for the (implicit) kick when the ACK arrives.

%externalroutine wait for ack(%integer port, proc)
   %if common_diags & ether diags # 0 %start
      pdate
      printstring("ACK wait ");  write(port, 0)
      printstring(", ");  write(proc, 0)
      newline
   %finish
   %unless 0 <= port <= ports %start
      pdate
      printstring("ACK wait -- bad port ")
      write(port, 0)
      newline
      %stop
   %finish
   %unless 0 <= proc < ether TX procs %start
      pdate
      printstring("ACK wait -- bad proc ")
      write(proc, 0)
      newline
      %stop
   %finish
   ether timeout(proc) = CPU time + ether timeout period
   ack wait mask(proc) = 1 << port
   wait for(ether ack wait + proc)
%end


! Kick an event queue.  The first process on the queue will then
! be scheduled at the earliest opportunity.

%externalroutine kick(%integer target)
   %unless 0 <= target <= last event %start
      printstring("*** Kick -- bad target ")
      write(target, 0)
      newline
      %stop
   %finish
   iof
   schedule mask = schedule mask ! (1 << target)
   ion
%end


! Start one process going.  Fake the context of the scheduler so that
! we get called back when the process being started does its first
! wait.  Grab some stack for the process, use our own context as the
! initial context for the new process, and then dive in at the address
! specified.  NB this routine must be called ONLY during the initialisation
! phase of the system.

%routine start one(%integer routine, stack gap)
   %label out
      %if saved stack = 0 %start
         *move.l SP, saved stack
      %finish
      saved stack = saved stack - stack gap - 512
      ! Fake up the scheduler's context, so that when the
      ! process waits we will be called back at the end of
      ! this routine, ready to return to the initialisation
      ! code of the filestore.
      *lea     scheduler context, A0
      *movem.l D2-D7/A2-A7, (A0)
      *lea     out, A1
      *move.l  A1, 48(A0)
      ! Set up the stack for the starting process and
      ! dive in.....
      *move.l  routine, A0
      *move.l  saved stack, SP
      *move.l  SP, A5
      *clr.l   (A5)
      *jmp     (A0)
out:
%end


! Start all the filestore processes.  This routine, and the one above,
! are in the scheduler module so that we don't have to take account of
! any changes in GLAbase which might be required in the machine code
! context-switching sections.  Essentially we just call the above routine
! for each process in turn, passing the address of a (local) label pointing
! to an external call to the main entry for each process, thereby ensuring
! that any register shuffling is done correctly by conpiler-generated code.

%externalroutine start processes
   %integer i
   %label ether TX   start
   %label ether RX   start
   %label packet     start
   %label proc       start
   %label stamp      start
   %label despooler  start
      start one(addr(packet start), stack gap)
      start one(addr(ether RX start), stack gap)
      start one(addr(ether TX start), stack gap) %for i = 1, 1, ether TX procs
      start one(addr(proc start), stack gap) %for i = 1, 1, procs
      start one(addr(stamp start), stack gap)
      %if despoolers # 0 %start
         start one(addr(despooler start), stack gap) %for i = 1, 1, despoolers
      %finish
      start qsart
      %return
proc start:
      proc main entry
      pdate
      printstring("*** Returned from proc ***");  newline
      %stop
ether RX start:
      ether RX main entry
      pdate
      printstring("*** Returned from ether RX ***");  newline
      %stop
ether TX start:
      ether TX main entry
      pdate
      printstring("*** Returned from ether TX ***");  newline
      %stop
packet start:
      packet main entry
      pdate
      printstring("*** Returned from packet ***");  newline
      %stop
stamp start:
      stamp main entry
      pdate
      printstring("*** Returned from stamp ***");  newline
      %stop
despooler start:
      despooler main entry
      pdate
      printstring("*** Returned from despooler ***");  newline
      %stop
%end

%end %of %file