! Clock module for Mouse-based filestores.

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

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

%include "Moose:Mouse.Inc"
%include "Sys:Ether.Inc"

%externalintegerfnspec free store

%conststring(31) dt counter = "DATE_AND_TIME_COUNTER"
%conststring(31) stamp sem  = "DATESTAMP_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;  ! For 8MHz

%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)
   %integer l, p = 0
   %byteinteger six = 6
      %on 3, 15 %start
         printstring("Get VAX time failed: ");  printstring(event_message)
         newline
         ether close port(p) %and ether free port(p) %if p # 0
         s = ""
         %return
      %finish
      p = ether allocate port
      ether open port(p, 16_72, 0)
      ether transmit block(p, 1, six)
      s = ".";  ! Keeps length check happy
      ether receive block(p, 31, l, charno(s, 1))
      length(s) = l
      {} printstring("VAX date and time: ");  printstring(s);  newline
      ether close port(p)
      ether free port(p)
%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
      %cycle
         get VAX time(s)
         %if s = "" %start
            prompt("Date and time: ");  read line(s) %until s # ""
         %finish
         clock = pack VAX date(s)
      %repeat %until clock > 0;  ! Should always be after 01/01/86
%end

%begin
   %string(31) date, time
      open input(0, ":T");  select input(0)
      open output(0, ":T");  select output(0)
      FS insert(dt counter, addr(clock))
      setup semaphore(clock semaphore)
      FS insert(stamp sem, addr(clock semaphore))
      get time
      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