From 5e4d059db016dc374a84178a56e47871b202df08 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Tue, 29 Oct 2013 19:41:23 +0400 Subject: [PATCH] Scales fixed, Times added. Former-commit-id: dda22584da384ed4ad13fc2f2c3e16c6d601599c --- makefile | 29 ++- src/lib/ulm/ulmSYSTEM.Mod | 29 +++ src/lib/ulm/ulmScales.Mod | 2 +- src/lib/ulm/ulmTimes.Mod | 392 ++++++++++++++++++++++++++++++++++++++ src/lib/ulm/ulmWrite.Mod | 18 +- 5 files changed, 453 insertions(+), 17 deletions(-) create mode 100644 src/lib/ulm/ulmTimes.Mod diff --git a/makefile b/makefile index 340e21ec..84ecdebb 100644 --- a/makefile +++ b/makefile @@ -154,17 +154,30 @@ stage6: #Ulm's Oberon system libs $(VOCSTATIC) -sP ulmSys.Mod $(VOCSTATIC) -sP ulmSYSTEM.Mod - $(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod - $(VOCSTATIC) -sP ulmObjects.Mod ulmDisciplines.Mod - $(VOCSTATIC) -sP ulmPriorities.Mod ulmServices.Mod ulmEvents.Mod ulmResources.Mod ulmForwarders.Mod ulmRelatedEvents.Mod - $(VOCSTATIC) -sP ulmIO.Mod ulmProcess.Mod ulmTypes.Mod ulmStreams.Mod + $(VOCSTATIC) -sP ulmASCII.Mod + $(VOCSTATIC) -sP ulmSets.Mod + $(VOCSTATIC) -sP ulmObjects.Mod + $(VOCSTATIC) -sP ulmDisciplines.Mod + $(VOCSTATIC) -sP ulmPriorities.Mod + $(VOCSTATIC) -sP ulmServices.Mod + $(VOCSTATIC) -sP ulmEvents.Mod + $(VOCSTATIC) -sP ulmResources.Mod + $(VOCSTATIC) -sP ulmForwarders.Mod + $(VOCSTATIC) -sP ulmRelatedEvents.Mod + $(VOCSTATIC) -sP ulmIO.Mod + $(VOCSTATIC) -sP ulmProcess.Mod + $(VOCSTATIC) -sP ulmTypes.Mod + $(VOCSTATIC) -sP ulmStreams.Mod $(VOCSTATIC) -sP ulmAssertions.Mod - $(VOCSTATIC) -sP ulmIndirectDisciplines.Mod ulmStreamDisciplines.Mod - $(VOCSTATIC) -sP ulmIEEE.Mod ulmMC68881.Mod ulmReals.Mod + $(VOCSTATIC) -sP ulmIndirectDisciplines.Mod + $(VOCSTATIC) -sP ulmStreamDisciplines.Mod + $(VOCSTATIC) -sP ulmIEEE.Mod + $(VOCSTATIC) -sP ulmMC68881.Mod + $(VOCSTATIC) -sP ulmReals.Mod $(VOCSTATIC) -sP ulmPrint.Mod $(VOCSTATIC) -sP ulmWrite.Mod $(VOCSTATIC) -sP ulmTexts.Mod - $(VOCSTATIC) -sP ulmStrings.Mod ulmConstStrings.Mod + $(VOCSTATIC) -sP ulmStrings.Mod $(VOCSTATIC) -sP ulmConstStrings.Mod $(VOCSTATIC) -sP ulmPlotters.Mod $(VOCSTATIC) -sP ulmSysTypes.Mod @@ -177,6 +190,8 @@ stage6: $(VOCSTATIC) -sP ulmPersistentObjects.Mod $(VOCSTATIC) -sP ulmPersistentDisciplines.Mod $(VOCSTATIC) -sP ulmOperations.Mod + $(VOCSTATIC) -sP ulmScales.Mod + $(VOCSTATIC) -sP ulmTimes.Mod #pow32 libs diff --git a/src/lib/ulm/ulmSYSTEM.Mod b/src/lib/ulm/ulmSYSTEM.Mod index 2f2eb2f2..b55043e2 100644 --- a/src/lib/ulm/ulmSYSTEM.Mod +++ b/src/lib/ulm/ulmSYSTEM.Mod @@ -3,6 +3,35 @@ IMPORT SYSTEM, Unix, Sys := ulmSys; TYPE pchar = POINTER TO ARRAY 1 OF CHAR; pstring = POINTER TO ARRAY 1024 OF CHAR; + + TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) + pbytearray* = POINTER TO bytearray; + TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) + plongrealarray* = POINTER TO bytearray; + + PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *) + VAR b : SYSTEM.BYTE; + p : pbytearray; + i : LONGINT; + BEGIN + p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l)); + FOR i := 0 TO SIZE(LONGINT) -1 DO + b := p^[i]; bar[i] := b; + END + END LongToByteArr; + + PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *) + VAR b : SYSTEM.BYTE; + p : plongrealarray; + i : LONGINT; + BEGIN + p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l)); + FOR i := 0 TO SIZE(LONGREAL) -1 DO + b := p^[i]; lar[i] := b; + END + END LRealToByteArr; + + (* PROCEDURE -Write(adr, n: LONGINT): LONGINT "write(1/*stdout*/, adr, n)"; diff --git a/src/lib/ulm/ulmScales.Mod b/src/lib/ulm/ulmScales.Mod index 71bcda28..8b60d48a 100644 --- a/src/lib/ulm/ulmScales.Mod +++ b/src/lib/ulm/ulmScales.Mod @@ -59,7 +59,7 @@ MODULE ulmScales; unit: Unit; next: UnitList; END; - Interface = POINTER TO InterfaceRec; + Interface* = POINTER TO InterfaceRec; ScaleRec* = RECORD (Disciplines.ObjectRec) diff --git a/src/lib/ulm/ulmTimes.Mod b/src/lib/ulm/ulmTimes.Mod new file mode 100644 index 00000000..00f0cd0c --- /dev/null +++ b/src/lib/ulm/ulmTimes.Mod @@ -0,0 +1,392 @@ +(* 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. diff --git a/src/lib/ulm/ulmWrite.Mod b/src/lib/ulm/ulmWrite.Mod index 7f5fa302..0867b2bc 100644 --- a/src/lib/ulm/ulmWrite.Mod +++ b/src/lib/ulm/ulmWrite.Mod @@ -33,8 +33,8 @@ MODULE ulmWrite; - IMPORT ASCII := ulmASCII, Print := ulmPrint, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, SYSTEM; - + IMPORT ASCII := ulmASCII, Print := ulmPrint, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, SYSTEM, SYS := ulmSYSTEM; + (* TYPE barr = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) pbarr = POINTER TO barr; TYPE lrarr = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) @@ -63,21 +63,21 @@ MODULE ulmWrite; END LRealToByteArr; - +*) PROCEDURE IntS*(s: Streams.Stream; int: LONGINT; width: LONGINT); - VAR b, b0 : barr; + VAR b, b0 : SYS.bytearray; BEGIN - LongToByteArr(int, b); - LongToByteArr(width, b0); + SYS.LongToByteArr(int, b); + SYS.LongToByteArr(width, b0); Print.S2(s, "%*d", b0, b); END IntS; PROCEDURE RealS*(s: Streams.Stream; real: LONGREAL; width: LONGINT); - VAR b : barr; lr : lrarr; + VAR b : SYS.bytearray; lr : SYS.longrealarray; BEGIN - LRealToByteArr(real, lr); - LongToByteArr(width, b); + SYS.LRealToByteArr(real, lr); + SYS.LongToByteArr(width, b); Print.S2(s, "%*e", b, lr); END RealS;