(* Ulm's Oberon Library
   Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
   ----------------------------------------------------------------------------
   Ulm's Oberon Library is free software; you can redistribute it
   and/or modify it under the terms of the GNU Library General Public
   License as published by the Free Software Foundation; either version
   2 of the License, or (at your option) any later version.

   Ulm's Oberon Library is distributed in the hope that it will be
   useful, but WITHOUT ANY WARRANTY; without even the implied warranty
   of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Library General Public License for more details.

   You should have received a copy of the GNU Library General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   ----------------------------------------------------------------------------
   E-mail contact: oberon@mathematik.uni-ulm.de
   ----------------------------------------------------------------------------
   $Id: Times.om,v 1.3 2001/04/30 14:54:44 borchert Exp $
   ----------------------------------------------------------------------------
   $Log: Times.om,v $
   Revision 1.3  2001/04/30 14:54:44  borchert
   bug fix: base type is TimeRec instead of Times.TimeRec
            (invalid self-reference)

   Revision 1.2  1995/04/07 13:25:07  borchert
   fixes due to changed if of PersistentObjects

   Revision 1.1  1994/02/22  20:12:02  borchert
   Initial revision

   ----------------------------------------------------------------------------
   AFB 12/91
   ----------------------------------------------------------------------------
*)

MODULE ulmTimes;

   IMPORT NetIO := ulmNetIO, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects, Scales := ulmScales,
      Services := ulmServices, Streams := ulmStreams, SYSTEM;

   CONST
      relative* = Scales.relative;
      absolute* = Scales.absolute;
   TYPE
      (* the common base type of all time measures *)
      Time* = POINTER TO TimeRec;
      TimeRec* = RECORD (Scales.MeasureRec) END;

   CONST
      usecsPerSec = 1000000; (* 10^6 *)
   TYPE
      (* units of the reference implementation:
	 epoch, second and usec
      *)
      TimeValueRec* =
	 RECORD
	    (Objects.ObjectRec)
	    (* epoch 0: Jan. 1, 1970;
	       each epoch has a length of MAX(Scales.Value) + 1 seconds;
	       epoch may be negative:
	       -1 is the epoch just before 1970
	    *)
	    epoch*: Scales.Value;
	    (* seconds and ... *)
	    second*: Scales.Value;
	    (* ... microseconds since the beginning of the epoch *)
	    usec*: Scales.Value; 
	 END;

   (* ==== private datatypes for the reference scale *)
   TYPE
      ReferenceTime = POINTER TO ReferenceTimeRec;
      ReferenceTimeRec =
	 RECORD
	    (TimeRec)
	    timeval: TimeValueRec;
	 END;
   VAR
      absType, relType: Services.Type;
   CONST
      epochUnit = 0; secondUnit = 1; usecUnit = 2;
   TYPE
      Unit = POINTER TO UnitRec;
      UnitRec =
	 RECORD
	    (Scales.UnitRec)
	    index: SHORTINT; (* epochUnit..usecUnit *)
	 END;

   VAR
      scale*: Scales.Scale; (* reference scale *)
      family*: Scales.Family; (* family of time scales *)
      if: Scales.Interface;

   PROCEDURE Create*(VAR time: Time; type: SHORTINT);
      (* type = absolute or relative *)
      VAR
	 m: Scales.Measure;
   BEGIN
      Scales.CreateMeasure(scale, m, type);
      time := m(Time);
   END Create;

   PROCEDURE Normalize(VAR timeval: TimeValueRec);
      (* make sure that second and usec >= 0 *)
      VAR
	 toomanysecs: Scales.Value;
	 secs: Scales.Value;
   BEGIN
      IF timeval.second < 0 THEN
	 INC(timeval.second, 1);
	 INC(timeval.second, MAX(Scales.Value));
	 DEC(timeval.epoch);
      END;
      IF timeval.usec < 0 THEN
	 toomanysecs := timeval.usec DIV usecsPerSec;
	 IF toomanysecs > timeval.second THEN
	    timeval.second := - toomanysecs + MAX(Scales.Value) + 1 +
			      timeval.second;
	    DEC(timeval.epoch);
	 ELSE
	    DEC(timeval.second, toomanysecs);
	 END;
	 timeval.usec := timeval.usec MOD usecsPerSec;
      ELSIF timeval.usec >= usecsPerSec THEN
	 secs := timeval.usec DIV usecsPerSec;
	 IF MAX(Scales.Value) - timeval.second <= secs THEN
	    INC(timeval.second, secs);
	 ELSE
	    timeval.second := secs - (MAX(Scales.Value) - timeval.second);
	    INC(timeval.epoch);
	 END;
	 timeval.usec := timeval.usec MOD usecsPerSec;
      END;
   END Normalize;

   PROCEDURE SetValue*(time: Time; value: TimeValueRec);
      VAR
	 refTime: Time;
	 scaleOfTime: Scales.Scale;
   BEGIN
      Normalize(value);
      IF time IS ReferenceTime THEN
	 WITH time: ReferenceTime DO
	    time.timeval := value;
	 END;
      ELSE
	 Create(refTime, Scales.MeasureType(time));
	 refTime(ReferenceTime).timeval := value;
	 Scales.GetScale(time, scaleOfTime);
	 Scales.ConvertMeasure(scaleOfTime, SYSTEM.VAL(Scales.Measure, refTime));
	 Operations.Copy(refTime, time);
      END;
   END SetValue;

   PROCEDURE CreateAndSet*(VAR time: Time; type: SHORTINT;
			  epoch, second, usec: Scales.Value);
      VAR
	 timeval: TimeValueRec;
   BEGIN
      Create(time, type);
      timeval.epoch := epoch; timeval.second := second; timeval.usec := usec;
      SetValue(time, timeval);
   END CreateAndSet;

   PROCEDURE GetValue*(time: Time; VAR value: TimeValueRec);
   BEGIN
      IF ~(time IS ReferenceTime) THEN
	 Scales.ConvertMeasure(scale, SYSTEM.VAL(Scales.Measure, time));
      END;
      value := time(ReferenceTime).timeval;
   END GetValue;

   (* ===== interface procedures =================================== *)

   PROCEDURE InternalCreate(scale: Scales.Scale;
			    VAR measure: Scales.Measure; abs: BOOLEAN);
      VAR
	 time: ReferenceTime;
   BEGIN
      NEW(time);
      time.timeval.epoch := 0;
      time.timeval.second := 0;
      time.timeval.usec := 0;
      IF abs THEN
	 PersistentObjects.Init(time, absType);
      ELSE
	 PersistentObjects.Init(time, relType);
      END;
      measure := time;
   END InternalCreate;

   PROCEDURE InternalGetValue(measure: Scales.Measure; unit: Scales.Unit;
                              VAR value: Scales.Value);
   BEGIN
      WITH measure: ReferenceTime DO WITH unit: Unit DO
	 CASE unit.index OF
	 | epochUnit:  value := measure.timeval.epoch;
	 | secondUnit:  value := measure.timeval.second;
	 | usecUnit:    value := measure.timeval.usec;
	 END;
      END; END;
   END InternalGetValue;

   PROCEDURE InternalSetValue(measure: Scales.Measure; unit: Scales.Unit;
		              value: Scales.Value);
   BEGIN
      WITH measure: ReferenceTime DO WITH unit: Unit DO
	 CASE unit.index OF
	 | epochUnit:   measure.timeval.epoch := value;
	 | secondUnit:  measure.timeval.second := value;
	 | usecUnit:    measure.timeval.usec := value;
	 END;
	 Normalize(measure.timeval);
      END; END;
   END InternalSetValue;

   PROCEDURE Assign(target: Scales.Measure; source: Scales.Measure);
   BEGIN
      WITH target: ReferenceTime DO WITH source: ReferenceTime DO
	 target.timeval := source.timeval;
      END; END;
   END Assign;

   PROCEDURE Op(op: Scales.Operation; op1, op2, result: Scales.Measure);

      PROCEDURE Add(op1, op2: TimeValueRec; VAR result: TimeValueRec);
      BEGIN
	 result.epoch := op1.epoch + op2.epoch;
	 IF op1.second > MAX(Scales.Value) - op2.second THEN
	    INC(result.epoch);
	    result.second := op1.second - MAX(Scales.Value) - 1 +
			     op2.second;
	 ELSE
	    result.second := op1.second + op2.second;
	 END;
	 result.usec := op1.usec + op2.usec;
	 IF result.usec > usecsPerSec THEN
	    DEC(result.usec, usecsPerSec);
	    IF result.second = MAX(Scales.Value) THEN
	       result.second := 0; INC(result.epoch);
	    ELSE
	       INC(result.second);
	    END;
	 END;
      END Add;

      PROCEDURE Sub(op1, op2: TimeValueRec; VAR result: TimeValueRec);
      BEGIN
	 result.epoch := op1.epoch - op2.epoch;
	 IF op1.second >= op2.second THEN
	    result.second := op1.second - op2.second;
	 ELSE
	    DEC(result.epoch);
	    result.second := - op2.second + MAX(Scales.Value) + 1 + op1.second;
	 END;
	 result.usec := op1.usec - op2.usec;
	 IF result.usec < 0 THEN
	    INC(result.usec, usecsPerSec);
	    IF result.second = 0 THEN
	       result.second := MAX(Scales.Value);
	       DEC(result.epoch);
	    ELSE
	       DEC(result.second);
	    END;
	 END;
      END Sub;

   BEGIN
      WITH op1: ReferenceTime DO WITH op2: ReferenceTime DO
	 WITH result: ReferenceTime DO
	    CASE op OF
	    | Scales.add:  Add(op1.timeval, op2.timeval, result.timeval);
	    | Scales.sub:  Sub(op1.timeval, op2.timeval, result.timeval);
	    END;
	 END;
      END; END;
   END Op;

   PROCEDURE Compare(op1, op2: Scales.Measure) : INTEGER;

      PROCEDURE ReturnVal(val1, val2: Scales.Value) : INTEGER;
      BEGIN
	 IF val1 < val2 THEN
	    RETURN -1
	 ELSIF val1 > val2 THEN
	    RETURN 1
	 ELSE
	    RETURN 0
	 END;
      END ReturnVal;

   BEGIN
      WITH op1: ReferenceTime DO WITH op2: ReferenceTime DO
	 IF op1.timeval.epoch # op2.timeval.epoch THEN
	    RETURN ReturnVal(op1.timeval.epoch, op2.timeval.epoch)
	 ELSIF op1.timeval.second # op2.timeval.second THEN
	    RETURN ReturnVal(op1.timeval.second, op2.timeval.second)
	 ELSE
	    RETURN ReturnVal(op1.timeval.usec, op2.timeval.usec)
	 END;
      END; END;
   END Compare;

   (* ========= initialization procedures ========================== *)

   PROCEDURE InitInterface;
      VAR
	 timeType: Services.Type;
   BEGIN
      NEW(if);
      if.create := InternalCreate;
      if.getvalue := InternalGetValue; if.setvalue := InternalSetValue;
      if.assign := Assign; if.op := Op; if.compare := Compare;
      (* conversion procedures are not necessary *)

      PersistentObjects.RegisterType(timeType, "Times.Time", "Scales.Measure",
				     NIL);
   END InitInterface;

   PROCEDURE CreateAbs(VAR object: PersistentObjects.Object);
      VAR
	 measure: Scales.Measure;
   BEGIN
      Scales.CreateAbsMeasure(scale, measure);
      object := measure;
   END CreateAbs;

   PROCEDURE CreateRel(VAR object: PersistentObjects.Object);
      VAR
	 measure: Scales.Measure;
   BEGIN
      Scales.CreateRelMeasure(scale, measure);
      object := measure;
   END CreateRel;

   PROCEDURE Write(s: Streams.Stream;
		   object: PersistentObjects.Object) : BOOLEAN;
   BEGIN
      WITH object: ReferenceTime DO
	 RETURN NetIO.WriteLongInt(s, object.timeval.epoch) &
		NetIO.WriteLongInt(s, object.timeval.second) &
		NetIO.WriteLongInt(s, object.timeval.usec)
      END;
   END Write;

   PROCEDURE Read(s: Streams.Stream;
		  object: PersistentObjects.Object) : BOOLEAN;
   BEGIN
      WITH object: ReferenceTime DO
	 RETURN NetIO.ReadLongInt(s, object.timeval.epoch) &
		NetIO.ReadLongInt(s, object.timeval.second) &
		NetIO.ReadLongInt(s, object.timeval.usec)
      END;
   END Read;

   PROCEDURE InitRefScale;

      VAR
	 poif: PersistentObjects.Interface;

      PROCEDURE InitUnit(unitIndex: SHORTINT; name: Scales.UnitName);
	 VAR
	    unit: Unit;
      BEGIN
	 NEW(unit); unit.index := unitIndex;
	 Scales.InitUnit(scale, unit, name);
      END InitUnit;

   BEGIN
      NEW(scale); Scales.Init(scale, NIL, if);
      InitUnit(epochUnit, "epoch");
      InitUnit(secondUnit, "second");
      InitUnit(usecUnit, "usec");

      NEW(poif); poif.read := Read; poif.write := Write;
      poif.create := CreateAbs; poif.createAndRead := NIL;
      PersistentObjects.RegisterType(absType,
		  "Times.AbsReferenceTime", "Times.Time", poif);
      NEW(poif); poif.read := Read; poif.write := Write;
      poif.create := CreateRel; poif.createAndRead := NIL;
      PersistentObjects.RegisterType(relType,
		  "Times.RelReferenceTime", "Times.Time", poif);
   END InitRefScale;

BEGIN
   InitInterface;
   InitRefScale;
   NEW(family); Scales.InitFamily(family, scale);
END ulmTimes.