!  File  NMOUSE:CLOCK

! Clock handler process and user interface

%option "-low-nons-half-nodiag-nocheck"
%include "mouse.inc"

! Maintains system and process timers.
! Helps the scheduler deal with time slicing.
! Handles timer requests from processes.

! Timer requests take the form of messages.  These messages are
! never returned to the sender (hence no error replies are possible),
! instead they are inserted into a timer queue sorted by due-time.
! Entries may be removed from the timer queue at user's request.
! The interrupt handler transfers entries from the timer queue to
! the alarm queue, leaving it to the main timer process either to
! re-schedule the request (if it is a "standing order") or to
! return the message buffer to the system pool (if it is a once-only
! request).

%recordformat timer request fm(%record(messagefm)m %or -
   %bytearray b(1:message header size),
   %integer code,when,interval,id, %record(semaphore fm)%name s)

%conststring mailbox name = "Clock handler"

%constinteger -
  cancel one = 1,
  cancel all = 2,
  once only  = 3,
  regularly = 4

%ownrecord(interrupt handler fm)ih
%ownrecord(semaphore fm)%name se
%ownrecord(mailbox fm)%name mailbox == nil
%ownrecord(timer request fm)%name req, head
%ownrecord(queue fm)timer queue, alarm

%routine send request(%record(semaphorefm)%name s,%integer id,when,int,code)
%record(timer request fm)%name r
  mailbox == lookup mailbox(mailbox name) %if mailbox==nil
  r == record(addr(acquire message buffer))
  r_code = code; r_when = when; r_interval = int; r_id = id; r_s == s
  send message(r_m,mailbox)
%end

! User interface

%externalroutine submit timer request -
  (%record(semaphore fm)%name s,%integer id,when)
  send request(s,id,when,0,once only)
%end

%externalroutine submit regular timer request -
  (%record(semaphore fm)%name s,%integer id,interval)
  send request(s,id,systemelapsedtime+interval,interval,regularly)
%end

%externalroutine cancel timer request(%integer id)
  send request(nil,id,0,0,cancel one)
%end

%externalroutine cancel all timer requests
  send request(nil,0,0,0,cancel all)
%end

%externalroutine wait(%integer ms)
%record(semaphorefm)%name s
  s == create semaphore("",0)
  submit timer request(s,0,systemelapsedtime+ms)
  semaphorewait(s)
  delete semaphore(s)
%end

! End of user interface

%recordformat ptm -
  (%byte cr1 %or %byte cr3,*,cr2,*,
         ct1h,*,ct1l,*, ct2h,*,ct2l,*, ct3h,*,ct3l,*)
@16_400100 %record(ptm)timer
@16_ff2003 %byte level1 interrupt register

%constinteger tick size = 10 {milliseconds}

%routine schedule
! Insert request REQ into the timer queue at the appropriate place.
! We do this by transferring all requests from the timer queue to
! a temporary queue, slotting REQ in before any request the due-time
! of which is after REQ's, then transferring them all back again.
%record(queue fm)temp
%record(timer request fm)%name c
  setup queue(temp)
  %cycle
    c == dequeue(timer queue)
    %exitif c==nil %or c_when>req_when
    enqueue(c_m_header,temp)
  %repeat
  enqueue(req_m_header,temp)
  %unless c==nil %start
    %cycle
      enqueue(c_m_header,temp); c == dequeue(timer queue)
    %repeatuntil c==nil
  %finish
  %cycle
    c == dequeue(temp); %exitif c==nil; enqueue(c_m_header,timer queue)
  %repeat
%end

%routine cancel
  %routine cancel(%record(queue fm)%name q)
  ! Scan a timer queue, removing all entries specified in REQ.
  %record(queue fm)temp
  %record(timer request fm)%name c
    setup queue(temp)
    %cycle
      c == dequeue(q); %exitif c==nil
      %if c_m_owner==req_m_owner -
      %and (req_code=cancel all %or c_id=req_id) %start
        return message buffer(c_m)
      %else
        enqueue(c_m_header,temp)
      %finish
    %repeat
    %cycle
      c == dequeue(temp); %exitif c==nil; enqueue(c_m_header,q)
    %repeat
  %end
  cancel(timer queue)
  cancel(alarm)
%end

%routine start timer
  timer_cr2 = 1      {select cr1
  timer_cr1 = 1      {stop timers
  timer_ct3h = 9     {divide 1kHz to 100Hz
  timer_ct3l = 124   {divide 125kHz to 1kHz
  timer_cr2 = 0      {select cr3
  timer_cr3 = 16_47  {appropriate mode
  timer_cr2 = 1      {select cr1
  timer_cr1 = 0      {start timers
%end

%begin
%record(message fm)%name msg
%label int
  setup queue(alarm)
  setup queue(timer queue)
  se == create semaphore("",0)
  mailbox == create mailbox(mailbox name,se)
  ih_pc = addr(int)
  add interrupt handler(6)
  start timer
  becomeprocess(2000)
  movetosr(16_700)
  %cycle
    semaphore wait(se)
    req == dequeue(alarm)
    %unless req==nil %start    {Alarm: reschedule or discard}
      %if req_interval#0 %start
        schedule
      %else
        return message buffer(req_m)
      %finish
    %else                      {No alarm: probably message}
      msg == get message(mailbox)
      %continueif msg==nil     {No message - must be cancelled alarm}
      req == record(addr(msg))
      %if req_code=once only %start
        req_interval = 0
        schedule
      %elseif req_code=regularly
        req_interval = tick size %if req_interval=0
        schedule
      %else
        cancel %if req_code=cancel one %or req_code=cancel all
        return message buffer(req_m)
      %finish
    %finish
  %repeat
  
  *temp d0-d1/a0-a1

  %routine bump(%integername i)
    i = (i+ticksize)&maxint
  %end

int:
  %if timer_cr2&4#0 %start
    *otsr #16_700
    *lea timer_ct3h,a0
    *movep.w 0(a0),d0
    bump(system elapsed time)
    %if currentprocess==nil %start
      bump(idletime)
    %else
      bump(current process_cputime)
      %if currentprocess_timeslicesize#0 -
      %and currentprocess_timesliceleft>=0 %start
        currentprocess_timesliceleft = currentprocess_timesliceleft-1
        level1 interrupt register = 255 %if currentprocess_timesliceleft<0
      %finish
    %finish
    head == dequeue(timer queue)
    %unless head==nil %start
      %if system elapsed time>=head_when %start
        head_when = head_when+head_interval
        enqueue(head_m_header,alarm)
        int signal semaphore(se)
        int signal semaphore(head_s)
      %else
        requeue(head_m_header,timer queue)
      %finish
    %finish
  %finish
  return from interrupt
  *nop
%end