! Date and time conversion routines, plus timestamp lookup.

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

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

%conststring(31) dt counter = "DATE_AND_TIME_COUNTER"
!conststring(31) stamp sem  = "DATESTAMP_SEMAPHORE"

%constinteger seconds per day = 60 * 60 * 24
%constinteger base date = 31353

%externalroutinespec phex(%integer i)

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

! First of all, we have the datestamp enquiry stuff

%externalintegerfn get datestamp
   %ownintegername stamp == nil
   %owninteger dummy = 0
   %integer i
      %if stamp == nil %start
         %if FS lookup(dt counter, i) %start
            !! printstring("Datestamp at ");  phex(integer(i));  newline
            stamp == integer(i)
         %else
            !! printstring("No timer, using dummy");  newline
            stamp == dummy
         %finish
      %finish
      %result = stamp
%end


! Now comes the date & time conversion stuff

%externalroutine unpack date(%integer w date, %string(*)%name u date, u time)
   ! Last date unpacked optimisation removed, as concurrently-unpacking
   ! processes could be confused if unpacking different dates.
   !%owninteger last unpacked = -1
   {%own}%bytearray db, tb(0 : 8)
   %integer d, m, y, h, s, date, time
      date = w date // seconds per day
      time = w date - date * seconds per day
      !%if date # last unpacked %start
      !   last unpacked = date
         d = (date + base date) << 2 - 1
         y = d // 1461 + 1
         d = rem(d, 1461)
         d = ((d + 4) >> 2) * 5 - 3
         m = d // 153 - 9
         %if m <= 0 %start
            m = m + 12;  y = y - 1
         %finish
         d = (rem(d, 153) + 5) // 5
         db(0) = 8
         db(1) = d // 10 + '0'
         db(2) = rem(d, 10) + '0'
         db(3) = '/'
         db(4) = m // 10 + '0'
         db(5) = rem(m, 10) + '0'
         db(6) = '/'
         db(7) = y // 10 + '0'
         db(8) = rem(y, 10) + '0'
      !%finish
      u date = string(addr(db(0)))
      m = time // 60;  s = time - 60 * m;  time = m
      h = time // 60;  m = time - 60 * h
      tb(0) = 8
      tb(1) = h // 10 + '0';  tb(2) = rem(h, 10) + '0'
      tb(3) = '.'
      tb(4) = m // 10 + '0';  tb(5) = rem(m, 10) + '0'
      tb(6) = '.'
      tb(7) = s // 10 + '0';  tb(8) = rem(s, 10) + '0'
      u time = string(addr(tb(0)))
%end


%externalintegerfn pack date(%string(255) date)
   %integer y, m
      m = charno(date, 4) * 10 + charno(date, 5) - '0' * 11
      y = charno(date, 7) * 10 + charno(date, 8) - '0' * 11
      m = m - 3
      m = m + 12 %and y = y - 1 %if m < 0
      %result = ((charno(date, 1) ! 16) * 10 + charno(date, 2) - '0' * 11 %c
                 + (y * 1461) >> 2     %c
                 + (m * 153 + 2) // 5  %c
                 - base date) * seconds per day
%end


! Same as <pack date>, but takes a different input format.

%conststring(3)%array months(1 : 12) =
      "JAN", "FEB", "MAR", "APR",
      "MAY", "JUN", "JUL", "AUG",
      "SEP", "OCT", "NOV", "DEC"

%externalintegerfn pack VAX date(%string(255) date and time)
   %integer y, m, n, h, s
   %string(3) nn
      %result = 0 %if length(date and time) # 21;  ! With 2 spaces
      m = 13
      n = charno(date and time, 1)
      nn = sub string(date and time, 4, 6)
      %cycle
         m = m - 1;  %result = 0 %if m = 0
         %exit %if months(m) = nn
      %repeat
      y = charno(date and time, 10) * 10 + charno(date and time, 11) - '0' * 11
      m = m - 3
      m = m + 12 %and y = y - 1 %if m < 0
      n = (n ! 16) * 10 + charno(date and time, 2) - '0' * 11 %c
          + (y * 1461) >> 2 %c
          + (m * 153 + 2) // 5 %c
          - base date
      h = charno(date and time, 14) * 10 + charno(date and time, 15) - '0' * 11
      m = charno(date and time, 17) * 10 + charno(date and time, 18) - '0' * 11
      s = charno(date and time, 20) * 10 + charno(date and time, 21) - '0' * 11
      %result = n * seconds per day + h * 60 * 60 + m * 60 + s
%end

!%externalstring(15)%fn unpack VAX date(%integer date)
!   %ownbytearray s(0 : 11)
!   %integer d, m, y
!      date = date // seconds per day
!      d = (date + base date) << 2 - 1
!      y = d // 1461 + 1
!      d = rem(d, 1461)
!      d = ((d + 4) >> 2) * 5 - 3
!      m = d // 153 - 9
!      %if m <= 0 %start
!         m = m + 12;  y = y - 1
!      %finish
!      d = (rem(d, 153) + 5) // 5
!      s(0) = 11
!      s(1) = d // 10 + '0'
!      s(2) = rem(d, 10) + '0'
!      string(addr(s(3))) = months(m)
!      s(3) = '-'
!      s(7) = '-'
!      s(8) = '1'
!      s(9) = '9'
!      s(10) = y // 10 + '0'
!      s(11) = rem(y, 10) + '0'
!      %result = string(addr(s(0)))
!%end


%constinteger day fiddle factor = 2
%conststring(11)%array days of week(0 : 6) =
      "Monday", "Tuesday", "Wednesday", "Thursday",
      "Friday", "Saturday", "Sunday"

%externalstring(11)%fn day of week(%integer date)
   %integer i
      i = rem(date // seconds per day + day fiddle factor, 7)
      i = i + 7 %if i < 0
      %result = days of week(i)
%end
      

%externalstring(15)%fn date
   %string(15) date, time
      unpack date(get datestamp, date, time)
      %result = date
%end

%externalstring(15)%fn time
   %string(15) date, time
      unpack date(get datestamp, date, time)
      %result = time
%end

%externalstring(31)%fn datetime
   %string(15) date, time
      unpack date(get datestamp, date, time)
      %result = date . "  " . time
%end

%end %of %file