?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Program Management - System Time Computation' ??
MODULE pmm$system_time_computation;


{  PURPOSE:
{    This module contains the routines for computing system time:
{
{    pmp$compute_date_time
{    pmp$compute_day_of_week
{    pmp$compute_local_date_time
{    pmp$compute_time_dif_in_seconds
{    pmp$compute_universal_date_time

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*IF NOT $true(osv$unix)
*copyc osd$integer_limits
*IFEND
*copyc oss$job_paged_literal
*copyc ost$date_time
*copyc ost$day_of_week
*copyc ost$time_zone
*copyc pme$system_time_exceptions
*copyc pmt$time_increment
?? POP ??
*IF NOT $true(osv$unix)
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*IFEND
*copyc osp$set_status_condition
*IF NOT $true(osv$unix)
*copyc pmp$continue_to_cause
*IFEND
*copyc pmp$get_compact_date_time
*copyc pmp$this_is_a_leap_year
*copyc pmp$verify_compact_date
*copyc pmp$verify_compact_time
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    max_years = 2235, { 1980 + 255 }
    local_clock = 0;

  VAR
    leap_year: [STATIC, READ, oss$job_paged_literal] array [1 .. 12] of
          1 .. 31 := [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31],

    non_leap_year: [STATIC, READ, oss$job_paged_literal] array [1 .. 12] of
          1 .. 31 := [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31];

  VAR
    leap_year_cummulative_days: [STATIC, READ, oss$job_paged_literal] array [0 .. 12] of
          0 .. 366 := [0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366],

    non_leap_year_cummulative_days: [STATIC, READ, oss$job_paged_literal] array [0 .. 12] of
          0 .. 366 := [0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365];

  VAR
    weekday_offsets: [STATIC, READ, oss$job_paged_literal] array [1 .. 12] of
          0 .. 6 := [0, 3, 3, 6, 1, 4, 6, 2, 5, 0, 3, 5];

?? OLDTITLE ??
*IF NOT $true(osv$unix)
?? NEWTITLE := 'compute_seconds_since_1980', EJECT ??

  PROCEDURE compute_seconds_since_1980
    (    date_time: ost$date_time;
     VAR seconds: ost$non_negative_integers);

    CONST
      seconds_in_a_day = 24 * 60 * 60,
      seconds_in_a_leap_year = 366 * seconds_in_a_day,
      seconds_in_a_non_leap_year = 365 * seconds_in_a_day;

    VAR
      this_year: 1900 .. 2155,
      year: 1900 .. 2155;

    this_year := date_time.year + 1900;
    seconds := 0;

    FOR year := 1980 TO (this_year - 1) DO
      IF pmp$this_is_a_leap_year (year) THEN
        seconds := seconds + seconds_in_a_leap_year;
      ELSE
        seconds := seconds + seconds_in_a_non_leap_year;
      IFEND;
    FOREND;

    IF pmp$this_is_a_leap_year (this_year) THEN
      seconds := seconds + (leap_year_cummulative_days [date_time.month - 1] * seconds_in_a_day);
    ELSE
      seconds := seconds + (non_leap_year_cummulative_days [date_time.month - 1] * seconds_in_a_day);
    IFEND;

    seconds := seconds + ((date_time.day - 1) * seconds_in_a_day);

    seconds := seconds + (((date_time.hour * 60 + date_time.minute) * 60) + date_time.second);

    IF date_time.millisecond > 500 THEN
      seconds := seconds + 1;
    IFEND;
  PROCEND compute_seconds_since_1980;
?? OLDTITLE ??
*IFEND
?? NEWTITLE := '[INLINE] verify_time_zone', EJECT ??

  PROCEDURE [INLINE] verify_time_zone
    (    time_zone: ost$time_zone;
     VAR status: ost$status);

    status.normal := TRUE;

    IF (time_zone.hours_from_gmt < -12) OR (time_zone.hours_from_gmt > 12) OR
          (time_zone.minutes_offset < -30) OR (time_zone.minutes_offset > 30) THEN
      osp$set_status_condition (pme$invalid_time_zone, status);
    IFEND;

  PROCEND verify_time_zone;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$compute_date_time', EJECT ??
*copyc pmh$compute_date_time

  PROCEDURE [XDCL, #GATE] pmp$compute_date_time
    (    base: ost$date_time;
         increment: pmt$time_increment;
     VAR result: ost$date_time;
     VAR status: ost$status);

*IF NOT $true(osv$unix)
    VAR
      established_handler: pmt$established_handler;


?? NEWTITLE := 'arithmetic_overflow_handler', EJECT ??

    PROCEDURE arithmetic_overflow_handler
      (    conditions: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      IF (conditions.selector = pmc$system_conditions) AND (conditions.system_conditions =
            $pmt$system_conditions [pmc$arithmetic_overflow]) THEN
        osp$set_status_condition (pme$compute_overflow, status);
        EXIT pmp$compute_date_time;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      IFEND;

    PROCEND arithmetic_overflow_handler;
?? OLDTITLE, EJECT ??
*IFEND


    VAR
      local_status: ost$status,

      temp: integer,
      millisecond: integer,
      second: integer,
      minute: integer,
      hour: integer,
      day: integer,
      month: integer,
      year: integer,

      days_in_the_month: ^array [1 .. 12] of 1 .. 31;

    local_status.normal := TRUE;

*IF NOT $true(osv$unix)
    osp$establish_condition_handler (^arithmetic_overflow_handler, FALSE);
*IFEND

    pmp$verify_compact_time (base, local_status);

    IF local_status.normal THEN
      pmp$verify_compact_date (base, local_status);

      IF local_status.normal THEN
        millisecond := base.millisecond + increment.millisecond;

        temp {ms} := millisecond MOD 1000 {ms} ;
        second := (base.second + increment.second) + (millisecond DIV 1000 {ms/sec} );
        IF temp {ms} < 0 THEN
          result.millisecond := temp {ms} + 1000 {ms} ;
          second := second - 1 {sec} ;
        ELSE
          result.millisecond := temp {ms} ;
        IFEND;

        temp {sec} := second MOD 60 {sec} ;
        minute := (base.minute + increment.minute) + (second DIV 60 {sec/hr} );
        IF temp {sec} < 0 THEN
          result.second := temp {sec} + 60 {sec} ;
          minute := minute - 1 {min} ;
        ELSE
          result.second := temp {sec} ;
        IFEND;

        temp {min} := minute MOD 60 {min} ;
        hour := (base.hour + increment.hour) + (minute DIV 60 {min/hr} );
        IF temp < 0 THEN
          result.minute := temp {min} + 60 {min} ;
          hour := hour - 1 {hr} ;
        ELSE
          result.minute := temp {min} ;
        IFEND;

        temp {hr} := hour MOD 24 {hr} ;
        day := (base.day + increment.day) + (hour DIV 24 {hr/day} );
        IF temp < 0 THEN
          result.hour := temp {hr} + 24 {hr} ;
          day := day - 1 {day} ;
        ELSE
          result.hour := temp {hr} ;
        IFEND;

        month := base.month + increment.month;
        year := base.year + increment.year + 1900 {yr} ;

        IF month < 1 THEN
          year := year - 1 - (-month) DIV 12;
          month := 12 - (-month) MOD 12;
        ELSEIF month > 12 THEN
          year := year + (month - 1) DIV 12;
          month := (month - 1) MOD 12 + 1;
        IFEND;

        IF pmp$this_is_a_leap_year (year) THEN
          days_in_the_month := ^leap_year;
        ELSE
          days_in_the_month := ^non_leap_year;
        IFEND;

        IF day > 0 THEN
          WHILE day > days_in_the_month^ [month] DO
            day := day - days_in_the_month^ [month];
            month := month + 1 {mo} ;

            IF month > 12 {mo} THEN
              month := 1 {mo} ;
              year := year + 1 {yr} ;

              IF pmp$this_is_a_leap_year (year) THEN
                days_in_the_month := ^leap_year;
              ELSE
                days_in_the_month := ^non_leap_year;
              IFEND;
            IFEND;
          WHILEND;
        ELSE
          WHILE day <= 0 DO
            month := month - 1 {mo} ;

            IF month < 1 {mo} THEN
              month := 12 {mo} ;
              year := year - 1 {yr} ;

              IF pmp$this_is_a_leap_year (year) THEN
                days_in_the_month := ^leap_year;
              ELSE
                days_in_the_month := ^non_leap_year;
              IFEND;
            IFEND;

            day := day + days_in_the_month^ [month];
          WHILEND;
        IFEND;

        result.day := day;
        result.month := month;

        year := year - 1900 {yr} ;

        IF (year < LOWERVALUE (result.year)) OR (year > UPPERVALUE (result.year)) THEN
          osp$set_status_condition (pme$computed_year_out_of_range, status);
          RETURN;
        IFEND;

        result.year := year;
      IFEND;
    IFEND;

    status := local_status;

  PROCEND pmp$compute_date_time;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$compute_date_time_increment', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$compute_date_time_increment
    (    old: ost$date_time;
         new: ost$date_time;
     VAR increment: pmt$time_increment;
     VAR status: ost$status);

*IF NOT $true(osv$unix)
    VAR
      established_descriptor: pmt$established_handler;

?? NEWTITLE := 'arithmetic_overflow_handler', EJECT ??

    PROCEDURE arithmetic_overflow_handler
      (    conditions: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      IF conditions.system_conditions = $pmt$system_conditions [pmc$arithmetic_overflow] THEN
        osp$set_status_condition (pme$compute_overflow, status);
        EXIT pmp$compute_date_time_increment;
      IFEND;

    PROCEND arithmetic_overflow_handler;
?? OLDTITLE, EJECT ??
*IFEND


    VAR
      local_status: ost$status,

      switch_values: boolean,

      temp: ost$date_time,
      old_val: ost$date_time,
      new_val: ost$date_time,

      millisecond: integer,
      second: integer,
      minute: integer,
      hour: integer,
      day: integer,
      month: integer,
      year: integer,

      days_in_month: ^array [1 .. 12] of 1 .. 31,

      old_year: integer;

    local_status.normal := TRUE;

*IF NOT $true(osv$unix)
    osp$establish_condition_handler (^arithmetic_overflow_handler, FALSE);
    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;
*IFEND

    pmp$verify_compact_time (old, local_status);

    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;

    pmp$verify_compact_date (old, local_status);

    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;

    pmp$verify_compact_time (new, local_status);

    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;

    pmp$verify_compact_date (new, local_status);

    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;

    old_val := old;
    new_val := new;

    switch_values := FALSE;

    IF new_val.year <> old_val.year THEN
      IF new_val.year < old_val.year THEN
        switch_values := TRUE;
      IFEND;
    ELSE
      IF new_val.month <> old_val.month THEN
        IF new_val.month < old_val.month THEN
          switch_values := TRUE;
        IFEND;
      ELSE
        IF new_val.day <> old_val.day THEN
          IF new_val.day < old_val.day THEN
            switch_values := TRUE;
          IFEND;
        ELSE
          IF new_val.hour <> old_val.hour THEN
            IF new_val.hour < old_val.hour THEN
              switch_values := TRUE;
            IFEND;
          ELSE
            IF new_val.minute <> old_val.minute THEN
              IF new_val.minute < old_val.minute THEN
                switch_values := TRUE;
              IFEND;
            ELSE
              IF new_val.second <> old_val.second THEN
                IF new_val.second < old_val.second THEN
                  switch_values := TRUE;
                IFEND;
              ELSE
                IF new_val.millisecond <> old_val.millisecond THEN
                  IF new_val.millisecond < old_val.millisecond THEN
                    switch_values := TRUE;
                  IFEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    IF switch_values THEN
      temp := old_val;
      old_val := new_val;
      new_val := temp;
    IFEND;

    millisecond := new_val.millisecond - old_val.millisecond;

    second := new_val.second - old_val.second;
    IF millisecond < 0 THEN
      increment.millisecond := millisecond + 1000;
      second := second - 1;
    ELSE
      increment.millisecond := millisecond;
    IFEND;

    minute := new_val.minute - old_val.minute;
    IF second < 0 THEN
      increment.second := second + 60;
      minute := minute - 1;
    ELSE
      increment.second := second;
    IFEND;
    hour := new_val.hour - old_val.hour;
    IF minute < 0 THEN
      increment.minute := minute + 60;
      hour := hour - 1;
    ELSE
      increment.minute := minute;
    IFEND;

    day := new_val.day - old_val.day;
    IF hour < 0 THEN
      increment.hour := hour + 24;
      day := day - 1;
    ELSE
      increment.hour := hour;
    IFEND;

    old_year := old_val.year + 1900;

    IF pmp$this_is_a_leap_year (old_year) THEN
      days_in_month := ^leap_year;
    ELSE
      days_in_month := ^non_leap_year;
    IFEND;

    month := new_val.month - old_val.month;
    IF day < 0 THEN
      month := month - 1;
      increment.day := days_in_month^ [old_val.month] + day;
    ELSE
      increment.day := day;
    IFEND;

    year := new_val.year - old_val.year;
    IF month < 0 THEN
      increment.month := month + 12;
      year := year - 1;
    ELSE
      increment.month := month;
    IFEND;

    increment.year := year;


    IF (year < LOWERVALUE (increment.year)) OR (year > UPPERVALUE (increment.year)) THEN
      osp$set_status_condition (pme$computed_year_out_of_range, status);
      RETURN;
    IFEND;

    IF switch_values THEN
      increment.millisecond := -increment.millisecond;
      increment.second := -increment.second;
      increment.minute := -increment.minute;
      increment.hour := -increment.hour;
      increment.day := -increment.day;
      increment.month := -increment.month;
      increment.year := -increment.year;
    IFEND;

*IF NOT $true(osv$unix)
    osp$disestablish_cond_handler;
*IFEND

    status := local_status;

  PROCEND pmp$compute_date_time_increment;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$compute_day_of_week', EJECT ??
*copyc pmh$compute_day_of_week

  PROCEDURE [XDCL, #GATE] pmp$compute_day_of_week
    (    date: ost$date_time;
     VAR day_of_week: ost$day_of_week;
     VAR status: ost$status);

    VAR
      year_mod_400: integer,
      day_index: 0 .. 6;

    pmp$verify_compact_date (date, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    year_mod_400 := ((date.year + 1900) MOD 400);
    day_index := ((year_mod_400 + ((year_mod_400 + 3) DIV 4) - ((year_mod_400 - 1) DIV
          100) + date.day + $INTEGER (pmp$this_is_a_leap_year (year_mod_400)) * $INTEGER (date.month >=
          3) + weekday_offsets [date.month] + 4) MOD 7);

    #UNCHECKED_CONVERSION (day_index, day_of_week);

  PROCEND pmp$compute_day_of_week;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$compute_local_date_time', EJECT ??
*copyc pmh$compute_local_date_time

  PROCEDURE [XDCL, #GATE] pmp$compute_local_date_time
    (    universal_date_time: ost$date_time;
         time_zone: ost$time_zone;
     VAR local_date_time: ost$date_time;
     VAR status: ost$status);

    VAR
      time_zone_increment: pmt$time_increment;

    status.normal := TRUE;
    pmp$verify_compact_date (universal_date_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    pmp$verify_compact_time (universal_date_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    verify_time_zone (time_zone, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF time_zone.daylight_saving_time THEN
      time_zone_increment.hour := 1;
    ELSE
      time_zone_increment.hour := 0;
    IFEND;

    time_zone_increment.hour := (time_zone.hours_from_gmt + time_zone_increment.hour);
    time_zone_increment.minute := time_zone.minutes_offset;
    time_zone_increment.second := 0;
    time_zone_increment.millisecond := 0;
    time_zone_increment.year := 0;
    time_zone_increment.month := 0;
    time_zone_increment.day := 0;

    pmp$compute_date_time (universal_date_time, time_zone_increment, local_date_time, status);

  PROCEND pmp$compute_local_date_time;

?? OLDTITLE ??
*IF NOT $true(osv$unix)
?? NEWTITLE := '[XDCL, #GATE] pmp$compute_time_dif_in_seconds', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$compute_time_dif_in_seconds
    (    old: ost$date_time;
         new: ost$date_time;
     VAR seconds: integer;
     VAR status: ost$status);

{ PURPOSE:
{ The purpose of this procedure is to compute the number of seconds that have
{ elapsed between the two dates given.  If the "old" date is greater than the
{ "new" date, the number of seconds returned is a negative value.

    VAR
      new_seconds: ost$non_negative_integers,
      old_seconds: ost$non_negative_integers;

    status.normal := TRUE;

    pmp$verify_compact_time (old, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$verify_compact_date (old, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$verify_compact_time (new, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$verify_compact_date (new, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    compute_seconds_since_1980 (old, old_seconds);
    compute_seconds_since_1980 (new, new_seconds);

    seconds := new_seconds - old_seconds;

    IF seconds = 0 THEN
      seconds := 1;
    IFEND;

  PROCEND pmp$compute_time_dif_in_seconds;
?? OLDTITLE ??
*IFEND
?? NEWTITLE := '[XDCL, #GATE] pmp$compute_universal_date_time', EJECT ??
*copyc pmh$compute_universal_date_time

  PROCEDURE [XDCL, #GATE] pmp$compute_universal_date_time
    (    local_date_time: ost$date_time;
         time_zone: ost$time_zone;
     VAR universal_date_time: ost$date_time;
     VAR status: ost$status);

    VAR
      time_zone_increment: pmt$time_increment;

    status.normal := TRUE;
    pmp$verify_compact_date (local_date_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    pmp$verify_compact_time (local_date_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    verify_time_zone (time_zone, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF time_zone.daylight_saving_time THEN
      time_zone_increment.hour := 1;
    ELSE
      time_zone_increment.hour := 0;
    IFEND;

    time_zone_increment.hour := -(time_zone.hours_from_gmt + time_zone_increment.hour);
    time_zone_increment.minute := -time_zone.minutes_offset;
    time_zone_increment.second := 0;
    time_zone_increment.millisecond := 0;
    time_zone_increment.year := 0;
    time_zone_increment.month := 0;
    time_zone_increment.day := 0;

    pmp$compute_date_time (local_date_time, time_zone_increment, universal_date_time, status);

  PROCEND pmp$compute_universal_date_time;

?? OLDTITLE ??
MODEND pmm$system_time_computation;
