! Clock module for Mouse-based filestores, GDMR.
! This version uses the new raw-mode ether handler.

%externalstring(47) copyright %alias "GDMR_(C)_CLOCK" = %c
   "Copyright (C) 1987 George D.M. Ross"

%option "-low-nonstandard-nocheck-nodiag-noline-nostack"
!%option "-low-nonstandard"

%include "Moose:Mouse.Inc"
%include "GDMR_E:2Meg.Inc"

%systemroutinespec phex(%integer i)

%externalintegerfnspec free store

%conststring(31) dt counter   = "DATE_AND_TIME_COUNTER"
%conststring(31) stamp sem    = "DATESTAMP_SEMAPHORE"
%conststring(31) date set sem = "DATE_SET_SEMAPHORE"

%externalpredicatespec FS lookup(%string(31) what, %integername where)
%externalroutinespec FS insert(%string(31) what, %integer where)

%externalroutinespec unpack date(%integer w date,
                                 %string(*)%name u date, u time)
%externalintegerfnspec pack VAX date(%string(255) d)

%constinteger clock priority = 6

%constinteger init partial = 10

%owninteger clock = 0
%owninteger partial = 0

%ownrecord(semaphore fm) clock semaphore = 0

%routine start ticking
   %ownrecord(interrupt handler fm) handler = 0
   %label h, x
      setup interrupt handler(handler, addr(h))
      add interrupt handler(handler, clock priority)
      !! printstring("Clock handler inserted");  newline
      partial = init partial
      %return

h:    *lea partial, A0
      *subq.l #1, (A0)
      *ble x
      return from interrupt

x:    ! Current second has expired
      *move.l #init partial, (A0)
      *lea clock, A0
      *addq.l #1, (A0)
      !! int signal semaphore(clock semaphore)
      return from interrupt
      *move.l D0, D0;  ! HMD-proof it
%end


! Initialise/set new time

%routine get VAX time(%string(31)%name s)
   %ownrecord(semaphore fm) sem = 0
   %ownrecord(mailbox fm) reply box = 0
   %ownrecord(ether request fm) r = 0
   %ownrecord(ether request fm)%name a
   %ownrecord(mailbox fm)%name ether mailbox == nil
   %integer l, i
   %byteinteger six = 6
      %if ether mailbox == nil %start
         setup semaphore(sem)
         setup mailbox(reply box, sem)
         setup message(r, size of(r))
         %if FS lookup(ether mailbox name, i) %start
            ether mailbox == record(i)
         %else
            printstring("No 2meg mailbox?");  newline
            s = ""
            %return
         %finish
      %finish
      s = "?"
      r_code = ether old define
      r_ra = 16_72;  r_rp = 0
      send message(r, ether mailbox, reply box)
      a == receive message(reply box)
      -> error %if r_status # ether success
      r_code = ether old write
      r_buffer == six
      r_bytes = 1
      send message(r, ether mailbox, reply box)
      a == receive message(reply box)
      -> error %if r_status # ether success
      r_code = ether old read
      r_timeout = 40;  ! Deciseconds
      r_buffer == charno(s, 1)
      send message(r, ether mailbox, reply box)
      a == receive message(reply box)
      -> error %if r_status # ether success
      length(s) = r_bytes
      r_code = ether old undefine
      send message(r, ether mailbox, reply box)
      a == receive message(reply box)
      -> error %if r_status # ether success
      {} printstring("ECSVAX date and time: ");  printstring(s);  newline
      %return

error:printstring("Ether error: ")
      printstring(ether errors(r_status));  newline
      s = ""
%end

%routine read line(%string(*)%name s)
   %integer ch
      s = ""
      %cycle
         read symbol(ch)
         %return %if ch = NL
         s = s . to string(ch)
      %repeat
%end

%routine get time
   %string(31) s
      get VAX time(s)
      %if s # "" %start
         clock = pack VAX date(s)
         %return
      %finish
      ! If we get here it hasn't been set
      %cycle
         printstring("Enter date and time in the format DD-MMM-YYYY  HH:MM:SS")
         newline
         printstring("Note that the month must be in UPPER case and there must")
         newline
         printstring("be exactly TWO spaces between the date and the time.")
         newline
         printstring("For example 01-FEB-1989  13:07:00");  newline
         prompt("Date and time: ");  read line(s) %until s # ""
         clock = pack VAX date(s)
      %repeat %until clock > 0;  ! Should always be after 01/01/86
%end

%ownrecord(semaphore fm) set semaphore = 0

%begin
   %string(31) date, time
      open input(3, ":T");  select input(3)
      open output(3, ":T");  select output(3)
      FS insert(dt counter, addr(clock))
      setup semaphore(clock semaphore)
      FS insert(stamp sem, addr(clock semaphore))
      setup semaphore(set semaphore)
      FS insert(date set sem, addr(set semaphore))
      {} printstring("Set sem at ");  phex(addr(set semaphore));  newline
      get time
      signal semaphore(set semaphore)
      start ticking
      %cycle
         semaphore wait(clock semaphore)
         ! Print out the date & time here....
         {} unpack date(clock, date, time)
         {} printstring("Clock wakened at ");  printstring(date)
         {} spaces(2);  printstring(time)
         {} printstring(", ");  write(free store, 0)
         {} printstring(" free");  newline
      %repeat
%end %of %program