mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 07:32:24 +00:00
ported ulmConclusions, ulmRandomGenerators
Former-commit-id: d5a6f185c6
This commit is contained in:
Norayr Chilingarian
parent
1f46569693
commit
39c37311ee
9 changed files with 602 additions and 0 deletions
2
makefile
2
makefile
|
|
@ -210,6 +210,8 @@ stage6:
|
||||||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||||
|
|
||||||
#pow32 libs
|
#pow32 libs
|
||||||
$(VOCSTATIC) -sP powStrings.Mod
|
$(VOCSTATIC) -sP powStrings.Mod
|
||||||
|
|
|
||||||
|
|
@ -209,6 +209,8 @@ stage6:
|
||||||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||||
|
|
||||||
#pow32 libs
|
#pow32 libs
|
||||||
$(VOCSTATIC) -sP powStrings.Mod
|
$(VOCSTATIC) -sP powStrings.Mod
|
||||||
|
|
|
||||||
|
|
@ -209,6 +209,8 @@ stage6:
|
||||||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||||
|
|
||||||
#pow32 libs
|
#pow32 libs
|
||||||
$(VOCSTATIC) -sP powStrings.Mod
|
$(VOCSTATIC) -sP powStrings.Mod
|
||||||
|
|
|
||||||
|
|
@ -209,6 +209,8 @@ stage6:
|
||||||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||||
|
|
||||||
#pow32 libs
|
#pow32 libs
|
||||||
$(VOCSTATIC) -sP powStrings.Mod
|
$(VOCSTATIC) -sP powStrings.Mod
|
||||||
|
|
|
||||||
|
|
@ -209,6 +209,8 @@ stage6:
|
||||||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||||
|
|
||||||
#pow32 libs
|
#pow32 libs
|
||||||
$(VOCSTATIC) -sP powStrings.Mod
|
$(VOCSTATIC) -sP powStrings.Mod
|
||||||
|
|
|
||||||
|
|
@ -209,6 +209,8 @@ stage6:
|
||||||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||||
|
|
||||||
#pow32 libs
|
#pow32 libs
|
||||||
$(VOCSTATIC) -sP powStrings.Mod
|
$(VOCSTATIC) -sP powStrings.Mod
|
||||||
|
|
|
||||||
|
|
@ -209,6 +209,8 @@ stage6:
|
||||||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||||
|
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||||
|
|
||||||
#pow32 libs
|
#pow32 libs
|
||||||
$(VOCSTATIC) -sP powStrings.Mod
|
$(VOCSTATIC) -sP powStrings.Mod
|
||||||
|
|
|
||||||
169
src/lib/ulm/ulmConclusions.Mod
Normal file
169
src/lib/ulm/ulmConclusions.Mod
Normal file
|
|
@ -0,0 +1,169 @@
|
||||||
|
(* 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: Conclusions.om,v 1.2 1994/07/05 12:50:01 borchert Exp $
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
$Log: Conclusions.om,v $
|
||||||
|
Revision 1.2 1994/07/05 12:50:01 borchert
|
||||||
|
formatting of error messages depends now on the indentation width
|
||||||
|
of StreamDisciplines
|
||||||
|
|
||||||
|
Revision 1.1 1994/02/23 07:46:17 borchert
|
||||||
|
Initial revision
|
||||||
|
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
AFB 11/91
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
*)
|
||||||
|
|
||||||
|
MODULE ulmConclusions;
|
||||||
|
|
||||||
|
(* convert errors and events into conclusions,
|
||||||
|
i.e. a final message and reaction
|
||||||
|
*)
|
||||||
|
|
||||||
|
IMPORT Errors := ulmErrors, Events := ulmEvents, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines,
|
||||||
|
Streams := ulmStreams, Strings := ulmStrings, Write := ulmWrite;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
handlerSet*: Errors.HandlerSet;
|
||||||
|
errors*: INTEGER; (* number of errors *)
|
||||||
|
fatalcode*: INTEGER; (* exit code on fatal events *)
|
||||||
|
|
||||||
|
(* private variables *)
|
||||||
|
cmdName: Process.Name; (* should be sufficient for a base name *)
|
||||||
|
cmdNameLen: INTEGER; (* Strings.Len(cmdName) *)
|
||||||
|
|
||||||
|
(* private procedures *)
|
||||||
|
|
||||||
|
PROCEDURE GeneralHandler(event: Events.Event; kind: Errors.Kind);
|
||||||
|
VAR
|
||||||
|
width: INTEGER;
|
||||||
|
BEGIN
|
||||||
|
IF event # NIL THEN
|
||||||
|
Write.IndentS(Streams.stderr);
|
||||||
|
Write.StringS(Streams.stderr, cmdName);
|
||||||
|
Write.StringS(Streams.stderr, ": ");
|
||||||
|
width := SHORT(Strings.Len(cmdName) + 2);
|
||||||
|
StreamDisciplines.IncrIndentationWidth(Streams.stderr, width);
|
||||||
|
IF kind # Errors.message THEN
|
||||||
|
Write.StringS(Streams.stderr, Errors.kindText[kind]);
|
||||||
|
Write.StringS(Streams.stderr, ": ");
|
||||||
|
END;
|
||||||
|
Errors.Write(Streams.stderr, event); Write.LnS(Streams.stderr);
|
||||||
|
StreamDisciplines.IncrIndentationWidth(Streams.stderr, -width);
|
||||||
|
END;
|
||||||
|
CASE kind OF
|
||||||
|
| Errors.error: INC(errors);
|
||||||
|
| Errors.fatal: Process.Exit(fatalcode);
|
||||||
|
| Errors.bug: Process.Abort;
|
||||||
|
ELSE
|
||||||
|
(* no further actions *)
|
||||||
|
END;
|
||||||
|
END GeneralHandler;
|
||||||
|
|
||||||
|
PROCEDURE AbortHandler(event: Events.Event);
|
||||||
|
BEGIN
|
||||||
|
GeneralHandler(event, Errors.bug);
|
||||||
|
END AbortHandler;
|
||||||
|
|
||||||
|
PROCEDURE Init;
|
||||||
|
VAR
|
||||||
|
messageKind: Errors.Kind;
|
||||||
|
BEGIN
|
||||||
|
fatalcode := 1;
|
||||||
|
errors := 0;
|
||||||
|
|
||||||
|
cmdName := Process.name;
|
||||||
|
cmdNameLen := SHORT(Strings.Len(cmdName));
|
||||||
|
|
||||||
|
messageKind := 0;
|
||||||
|
Errors.CreateHandlerSet(handlerSet);
|
||||||
|
WHILE messageKind < Errors.nkinds DO
|
||||||
|
Errors.InstallHandler(handlerSet, messageKind, GeneralHandler);
|
||||||
|
INC(messageKind);
|
||||||
|
END;
|
||||||
|
Events.AbortHandler(AbortHandler);
|
||||||
|
END Init;
|
||||||
|
|
||||||
|
(* public procedures *)
|
||||||
|
|
||||||
|
PROCEDURE CatchEvent*(type: Events.EventType; kind: Errors.Kind);
|
||||||
|
BEGIN
|
||||||
|
Errors.CatchEvent(handlerSet, kind, type);
|
||||||
|
END CatchEvent;
|
||||||
|
|
||||||
|
PROCEDURE ConcludeS*(s: Streams.Stream;
|
||||||
|
object: RelatedEvents.Object; kind: Errors.Kind;
|
||||||
|
text: ARRAY OF CHAR);
|
||||||
|
VAR
|
||||||
|
queue: RelatedEvents.Queue;
|
||||||
|
width: INTEGER;
|
||||||
|
|
||||||
|
PROCEDURE ReverseQueue(VAR queue: RelatedEvents.Queue);
|
||||||
|
VAR
|
||||||
|
ptr, prev, next: RelatedEvents.Queue;
|
||||||
|
BEGIN
|
||||||
|
ptr := queue; prev := NIL;
|
||||||
|
WHILE ptr # NIL DO
|
||||||
|
next := ptr.next;
|
||||||
|
ptr.next := prev;
|
||||||
|
prev := ptr;
|
||||||
|
ptr := next;
|
||||||
|
END;
|
||||||
|
queue := prev;
|
||||||
|
END ReverseQueue;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
RelatedEvents.GetQueue(object, queue);
|
||||||
|
Write.IndentS(s);
|
||||||
|
Write.StringS(s, cmdName); Write.StringS(s, ": ");
|
||||||
|
IF kind # Errors.message THEN
|
||||||
|
Write.StringS(s, Errors.kindText[kind]); Write.StringS(s, ": ");
|
||||||
|
END;
|
||||||
|
IF text # "" THEN
|
||||||
|
Write.StringS(s, text); Write.StringS(s, ": ");
|
||||||
|
END;
|
||||||
|
IF queue = NIL THEN
|
||||||
|
Write.StringS(s, "*no error messages found*"); Write.LnS(s);
|
||||||
|
ELSE
|
||||||
|
width := cmdNameLen + (* ": " *) 2;
|
||||||
|
StreamDisciplines.IncrIndentationWidth(s, width);
|
||||||
|
(* convert FIFO into LIFO *)
|
||||||
|
ReverseQueue(queue);
|
||||||
|
LOOP
|
||||||
|
Errors.Write(s, queue.event); Write.LnS(s);
|
||||||
|
queue := queue.next;
|
||||||
|
(**)IF queue = NIL THEN EXIT END;
|
||||||
|
Write.IndentS(s);
|
||||||
|
END;
|
||||||
|
StreamDisciplines.IncrIndentationWidth(s, -width);
|
||||||
|
END;
|
||||||
|
GeneralHandler(NIL, kind);
|
||||||
|
END ConcludeS;
|
||||||
|
|
||||||
|
PROCEDURE Conclude*(object: RelatedEvents.Object; kind: Errors.Kind;
|
||||||
|
text: ARRAY OF CHAR);
|
||||||
|
BEGIN
|
||||||
|
ConcludeS(Streams.stderr, object, kind, text);
|
||||||
|
END Conclude;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
Init;
|
||||||
|
END ulmConclusions.
|
||||||
419
src/lib/ulm/ulmRandomGenerators.Mod
Normal file
419
src/lib/ulm/ulmRandomGenerators.Mod
Normal file
|
|
@ -0,0 +1,419 @@
|
||||||
|
(* 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: RandomGener.om,v 1.9 2004/03/09 21:44:12 borchert Exp $
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
$Log: RandomGener.om,v $
|
||||||
|
Revision 1.9 2004/03/09 21:44:12 borchert
|
||||||
|
unpredictable added to the standard set of PRNGs
|
||||||
|
|
||||||
|
Revision 1.8 2004/03/06 07:22:09 borchert
|
||||||
|
Init asserts that the sequence has been registered at Services
|
||||||
|
|
||||||
|
Revision 1.7 1998/02/14 22:04:09 martin
|
||||||
|
Missing calls of Services.Init and Services.CreateType added.
|
||||||
|
|
||||||
|
Revision 1.6 1997/10/11 21:22:03 martin
|
||||||
|
assertion in ValS added, obsolete variable removed
|
||||||
|
|
||||||
|
Revision 1.5 1997/10/10 16:26:49 martin
|
||||||
|
RestartSequence added, range conversions improved,
|
||||||
|
default implementation replaced.
|
||||||
|
|
||||||
|
Revision 1.4 1997/04/01 16:33:41 borchert
|
||||||
|
major revision of Random:
|
||||||
|
- module renamed to RandomGenerators
|
||||||
|
- abstraction instead of simple implementation (work by Frank Fischer)
|
||||||
|
|
||||||
|
Revision 1.3 1994/09/01 18:15:41 borchert
|
||||||
|
bug fix: avoid arithmetic overflow in ValS
|
||||||
|
|
||||||
|
Revision 1.2 1994/08/30 09:48:00 borchert
|
||||||
|
sequences added
|
||||||
|
|
||||||
|
Revision 1.1 1994/02/23 07:25:30 borchert
|
||||||
|
Initial revision
|
||||||
|
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
original implementation by AFB 2/90
|
||||||
|
conversion to abstraction by Frank B.J. Fischer 3/97
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
*)
|
||||||
|
|
||||||
|
MODULE ulmRandomGenerators;
|
||||||
|
|
||||||
|
(* Anyone who considers arithmetical
|
||||||
|
methods of producing random digits
|
||||||
|
is, of course, in a state of sin.
|
||||||
|
- John von Neumann (1951)
|
||||||
|
*)
|
||||||
|
|
||||||
|
IMPORT
|
||||||
|
Clocks := ulmClocks, Disciplines := ulmDisciplines, Objects := ulmObjects, Operations := ulmOperations, Process := ulmProcess, Services := ulmServices, Times := ulmTimes,
|
||||||
|
Types := ulmTypes, S := SYSTEM;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
Sequence* = POINTER TO SequenceRec;
|
||||||
|
|
||||||
|
Int32ValSProc* = PROCEDURE (sequence: Sequence): Types.Int32;
|
||||||
|
LongRealValSProc* = PROCEDURE (sequence: Sequence): LONGREAL;
|
||||||
|
RewindSequenceProc* = PROCEDURE (sequence: Sequence);
|
||||||
|
RestartSequenceProc* = PROCEDURE (sequence, seed: Sequence);
|
||||||
|
SetValSProc* = PROCEDURE (sequence: Sequence; value: Operations.Operand);
|
||||||
|
|
||||||
|
CONST
|
||||||
|
int32ValS* = 0; longRealValS* = 1; rewindSequence* = 2; restartSequence* = 3;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
CapabilitySet* = SET; (* of [int32ValS..restartSequence] *)
|
||||||
|
Interface* = POINTER TO InterfaceRec;
|
||||||
|
InterfaceRec* =
|
||||||
|
RECORD
|
||||||
|
(Objects.ObjectRec)
|
||||||
|
int32ValS* : Int32ValSProc; (* at least one of ... *)
|
||||||
|
longRealValS* : LongRealValSProc; (* ... these required *)
|
||||||
|
rewindSequence* : RewindSequenceProc; (* optional *)
|
||||||
|
restartSequence*: RestartSequenceProc; (* optional *)
|
||||||
|
END;
|
||||||
|
|
||||||
|
SequenceRec* =
|
||||||
|
RECORD
|
||||||
|
(Services.ObjectRec)
|
||||||
|
(* private components *)
|
||||||
|
if : Interface;
|
||||||
|
caps: CapabilitySet;
|
||||||
|
END;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
std* : Sequence; (* default sequence *)
|
||||||
|
seed*: Sequence; (* sequence of seed values *)
|
||||||
|
unpredictable*: Sequence;
|
||||||
|
(* reasonably fast sequence of unpredictable values;
|
||||||
|
is initially NIL
|
||||||
|
*)
|
||||||
|
|
||||||
|
(* ----- private definitions ----- *)
|
||||||
|
|
||||||
|
CONST
|
||||||
|
modulus1 = 2147483647; (* a Mersenne prime *)
|
||||||
|
factor1 = 48271; (* passes spectral test *)
|
||||||
|
quotient1 = modulus1 DIV factor1; (* 44488 *)
|
||||||
|
remainder1 = modulus1 MOD factor1; (* 3399; must be < quotient1 *)
|
||||||
|
modulus2 = 2147483399; (* a non-Mersenne prime *)
|
||||||
|
factor2 = 40692; (* also passes spectral test *)
|
||||||
|
quotient2 = modulus2 DIV factor2; (* 52774 *)
|
||||||
|
remainder2 = modulus2 MOD factor2; (* 3791; must be < quotient2 *)
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
DefaultSequence = POINTER TO DefaultSequenceRec;
|
||||||
|
DefaultSequenceRec =
|
||||||
|
RECORD
|
||||||
|
(SequenceRec)
|
||||||
|
seed1, seed2: LONGINT;
|
||||||
|
value1, value2: LONGINT;
|
||||||
|
END;
|
||||||
|
|
||||||
|
ServiceDiscipline = POINTER TO ServiceDisciplineRec;
|
||||||
|
ServiceDisciplineRec =
|
||||||
|
RECORD
|
||||||
|
(Disciplines.DisciplineRec)
|
||||||
|
setValS: SetValSProc;
|
||||||
|
END;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
service : Services.Service;
|
||||||
|
serviceDiscID: Disciplines.Identifier;
|
||||||
|
sequenceType,
|
||||||
|
defaultSequenceType: Services.Type;
|
||||||
|
|
||||||
|
(* ----- bug workaround ----- *)
|
||||||
|
|
||||||
|
PROCEDURE Entier(value: LONGREAL): LONGINT;
|
||||||
|
VAR
|
||||||
|
result: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
result := ENTIER(value);
|
||||||
|
IF result > value THEN
|
||||||
|
DEC(result);
|
||||||
|
END;
|
||||||
|
RETURN result
|
||||||
|
END Entier;
|
||||||
|
|
||||||
|
(* ----- exported procedures ----- *)
|
||||||
|
|
||||||
|
PROCEDURE Init*(sequence: Sequence; if: Interface; caps: CapabilitySet);
|
||||||
|
(* initialize sequence *)
|
||||||
|
VAR
|
||||||
|
type: Services.Type;
|
||||||
|
BEGIN
|
||||||
|
ASSERT((if.int32ValS # NIL) OR (if.longRealValS # NIL));
|
||||||
|
ASSERT(~(int32ValS IN caps) OR (if.int32ValS # NIL));
|
||||||
|
ASSERT(~(longRealValS IN caps) OR (if.longRealValS # NIL));
|
||||||
|
ASSERT(~(rewindSequence IN caps) OR (if.rewindSequence # NIL));
|
||||||
|
Services.GetType(sequence, type); ASSERT(type # NIL);
|
||||||
|
sequence.if := if;
|
||||||
|
sequence.caps := caps;
|
||||||
|
END Init;
|
||||||
|
|
||||||
|
PROCEDURE Capabilities*(sequence: Sequence): CapabilitySet;
|
||||||
|
(* tell which procedures are implemented *)
|
||||||
|
BEGIN
|
||||||
|
RETURN sequence.caps
|
||||||
|
END Capabilities;
|
||||||
|
|
||||||
|
PROCEDURE RewindSequence*(sequence: Sequence);
|
||||||
|
(* re-examine sequence *)
|
||||||
|
BEGIN
|
||||||
|
ASSERT(rewindSequence IN sequence.caps);
|
||||||
|
sequence.if.rewindSequence(sequence);
|
||||||
|
END RewindSequence;
|
||||||
|
|
||||||
|
PROCEDURE RestartSequence*(sequence, seed: Sequence);
|
||||||
|
(* restart sequence with new seed values *)
|
||||||
|
BEGIN
|
||||||
|
ASSERT(restartSequence IN sequence.caps);
|
||||||
|
sequence.if.restartSequence(sequence, seed);
|
||||||
|
END RestartSequence;
|
||||||
|
|
||||||
|
PROCEDURE ^ LongRealValS*(sequence: Sequence): LONGREAL;
|
||||||
|
|
||||||
|
PROCEDURE Int32ValS*(sequence: Sequence): Types.Int32;
|
||||||
|
(* get random 32-bit value from sequence *)
|
||||||
|
VAR
|
||||||
|
real: LONGREAL;
|
||||||
|
BEGIN
|
||||||
|
IF int32ValS IN sequence.caps THEN
|
||||||
|
RETURN sequence.if.int32ValS(sequence)
|
||||||
|
ELSE
|
||||||
|
real := LongRealValS(sequence);
|
||||||
|
RETURN SHORT(Entier( (1. - real - real) * MIN(Types.Int32) ))
|
||||||
|
END;
|
||||||
|
END Int32ValS;
|
||||||
|
|
||||||
|
PROCEDURE Int32Val*(): Types.Int32;
|
||||||
|
(* get random 32-bit value from std sequence *)
|
||||||
|
BEGIN
|
||||||
|
RETURN Int32ValS(std);
|
||||||
|
END Int32Val;
|
||||||
|
|
||||||
|
PROCEDURE LongRealValS*(sequence: Sequence): LONGREAL;
|
||||||
|
(* get a uniformly distributed longreal value in [0..1) *)
|
||||||
|
BEGIN
|
||||||
|
IF longRealValS IN sequence.caps THEN
|
||||||
|
RETURN sequence.if.longRealValS(sequence)
|
||||||
|
ELSE
|
||||||
|
RETURN 0.5 +
|
||||||
|
Int32ValS(sequence) / (0. - MIN(Types.Int32) - MIN(Types.Int32))
|
||||||
|
END;
|
||||||
|
END LongRealValS;
|
||||||
|
|
||||||
|
PROCEDURE LongRealVal*(): LONGREAL;
|
||||||
|
(* get a uniformly distributed longreal value in [0..1) *)
|
||||||
|
BEGIN
|
||||||
|
RETURN LongRealValS(std)
|
||||||
|
END LongRealVal;
|
||||||
|
|
||||||
|
PROCEDURE RealValS*(sequence: Sequence): REAL;
|
||||||
|
(* get a uniformly distributed real value in [0..1) *)
|
||||||
|
BEGIN
|
||||||
|
RETURN SHORT(LongRealValS(sequence))
|
||||||
|
END RealValS;
|
||||||
|
|
||||||
|
PROCEDURE RealVal*(): REAL;
|
||||||
|
(* get a uniformly distributed real value in [0..1) *)
|
||||||
|
BEGIN
|
||||||
|
RETURN SHORT(LongRealValS(std))
|
||||||
|
END RealVal;
|
||||||
|
|
||||||
|
PROCEDURE ValS*(sequence: Sequence; low, high: LONGINT): LONGINT;
|
||||||
|
(* get a uniformly distributed integer in [low..high] *)
|
||||||
|
BEGIN
|
||||||
|
ASSERT(low <= high);
|
||||||
|
RETURN Entier( low + LongRealValS(sequence) * (1. + high - low) )
|
||||||
|
END ValS;
|
||||||
|
|
||||||
|
PROCEDURE Val*(low, high: LONGINT): LONGINT;
|
||||||
|
(* get a uniformly distributed integer in [low..high] *)
|
||||||
|
BEGIN
|
||||||
|
RETURN ValS(std, low, high)
|
||||||
|
END Val;
|
||||||
|
|
||||||
|
PROCEDURE FlipS*(sequence: Sequence): BOOLEAN;
|
||||||
|
(* return TRUE or FALSE *)
|
||||||
|
BEGIN
|
||||||
|
IF int32ValS IN sequence.caps THEN
|
||||||
|
RETURN sequence.if.int32ValS(sequence) >= 0
|
||||||
|
ELSE
|
||||||
|
RETURN sequence.if.longRealValS(sequence) >= 0.5
|
||||||
|
END;
|
||||||
|
END FlipS;
|
||||||
|
|
||||||
|
PROCEDURE Flip*(): BOOLEAN;
|
||||||
|
(* return TRUE or FALSE *)
|
||||||
|
BEGIN
|
||||||
|
RETURN FlipS(std)
|
||||||
|
END Flip;
|
||||||
|
|
||||||
|
PROCEDURE Support*(type: Services.Type; setValS: SetValSProc);
|
||||||
|
(* support service for type *)
|
||||||
|
VAR
|
||||||
|
serviceDisc: ServiceDiscipline;
|
||||||
|
BEGIN
|
||||||
|
NEW(serviceDisc);
|
||||||
|
serviceDisc.id := serviceDiscID;
|
||||||
|
serviceDisc.setValS := setValS;
|
||||||
|
Disciplines.Add(type, serviceDisc);
|
||||||
|
Services.Define(type, service, NIL);
|
||||||
|
END Support;
|
||||||
|
|
||||||
|
PROCEDURE SetValS*(sequence: Sequence; value: Operations.Operand);
|
||||||
|
(* store random value from sequence into already initialized value *)
|
||||||
|
VAR
|
||||||
|
baseType : Services.Type;
|
||||||
|
serviceDisc: ServiceDiscipline;
|
||||||
|
ok : BOOLEAN;
|
||||||
|
BEGIN
|
||||||
|
Services.GetSupportedBaseType(value, service, baseType);
|
||||||
|
ok := Disciplines.Seek(baseType, serviceDiscID, S.VAL(Disciplines.Discipline, serviceDisc));
|
||||||
|
ASSERT(ok);
|
||||||
|
serviceDisc.setValS(sequence, value);
|
||||||
|
END SetValS;
|
||||||
|
|
||||||
|
PROCEDURE SetVal*(value: Operations.Operand);
|
||||||
|
(* store random value from std sequence into already initialized value *)
|
||||||
|
BEGIN
|
||||||
|
SetValS(std, value);
|
||||||
|
END SetVal;
|
||||||
|
|
||||||
|
(* ----- DefaultSequence ----- *)
|
||||||
|
|
||||||
|
PROCEDURE CongruentialStep(VAR value1, value2: LONGINT);
|
||||||
|
BEGIN
|
||||||
|
value1 :=
|
||||||
|
factor1 * (value1 MOD quotient1) - remainder1 * (value1 DIV quotient1);
|
||||||
|
IF value1 < 0 THEN
|
||||||
|
INC(value1, modulus1);
|
||||||
|
END;
|
||||||
|
value2 :=
|
||||||
|
factor2 * (value2 MOD quotient2) - remainder2 * (value2 DIV quotient2);
|
||||||
|
IF value2 < 0 THEN
|
||||||
|
INC(value2, modulus2);
|
||||||
|
END;
|
||||||
|
END CongruentialStep;
|
||||||
|
|
||||||
|
PROCEDURE DefaultSequenceValue(sequence: Sequence): LONGREAL;
|
||||||
|
VAR
|
||||||
|
value: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
WITH sequence: DefaultSequence DO
|
||||||
|
CongruentialStep(sequence.value1, sequence.value2);
|
||||||
|
value := sequence.value1 - sequence.value2;
|
||||||
|
IF value <= 0 THEN
|
||||||
|
INC(value, modulus1);
|
||||||
|
END;
|
||||||
|
RETURN (value - 1.) / (modulus1 - 1.)
|
||||||
|
END;
|
||||||
|
END DefaultSequenceValue;
|
||||||
|
|
||||||
|
PROCEDURE DefaultSequenceRewind(sequence: Sequence);
|
||||||
|
BEGIN
|
||||||
|
WITH sequence: DefaultSequence DO
|
||||||
|
sequence.value1 := sequence.seed1;
|
||||||
|
sequence.value2 := sequence.seed2;
|
||||||
|
END;
|
||||||
|
END DefaultSequenceRewind;
|
||||||
|
|
||||||
|
PROCEDURE DefaultSequenceRestart(sequence, seed: Sequence);
|
||||||
|
BEGIN
|
||||||
|
WITH sequence: DefaultSequence DO
|
||||||
|
sequence.seed1 := ValS(seed, 1, modulus1-1);
|
||||||
|
sequence.seed2 := ValS(seed, 1, modulus2-1);
|
||||||
|
sequence.value1 := sequence.seed1;
|
||||||
|
sequence.value2 := sequence.seed2;
|
||||||
|
END;
|
||||||
|
END DefaultSequenceRestart;
|
||||||
|
|
||||||
|
PROCEDURE CreateDefaultSequences;
|
||||||
|
VAR
|
||||||
|
mySeed, myStd: DefaultSequence;
|
||||||
|
if: Interface;
|
||||||
|
daytime: Times.Time;
|
||||||
|
timeval: Times.TimeValueRec;
|
||||||
|
count: LONGINT;
|
||||||
|
|
||||||
|
PROCEDURE Hash(str: ARRAY OF CHAR): LONGINT;
|
||||||
|
VAR
|
||||||
|
index,
|
||||||
|
val: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
val := 27567352;
|
||||||
|
index := 0;
|
||||||
|
WHILE str[index] # 0X DO
|
||||||
|
val := (val MOD 16777216) * 128 +
|
||||||
|
(val DIV 16777216 + ORD(str[index])) MOD 128;
|
||||||
|
INC(index);
|
||||||
|
END; (*WHILE*)
|
||||||
|
RETURN val
|
||||||
|
END Hash;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
(* define interface for all default sequences *)
|
||||||
|
NEW(if);
|
||||||
|
if.longRealValS := DefaultSequenceValue;
|
||||||
|
if.rewindSequence := DefaultSequenceRewind;
|
||||||
|
if.restartSequence := DefaultSequenceRestart;
|
||||||
|
|
||||||
|
(* fake initial randomness using some portably accessible sources *)
|
||||||
|
NEW(mySeed);
|
||||||
|
Services.Init(mySeed, defaultSequenceType);
|
||||||
|
Init(mySeed, if, {longRealValS});
|
||||||
|
Clocks.GetTime(Clocks.system, daytime);
|
||||||
|
Times.GetValue(daytime, timeval);
|
||||||
|
(* extract those 31 bits from daytime that are most likely to vary *)
|
||||||
|
mySeed.value1 := timeval.usec * 2048 + timeval.second MOD 65536 + 1;
|
||||||
|
(* generate 31 more bits from the process name *)
|
||||||
|
mySeed.value2 := Hash(Process.name) MOD (modulus2 - 1) + 1;
|
||||||
|
(* scramble these values *)
|
||||||
|
count := 0;
|
||||||
|
WHILE count < 4 DO
|
||||||
|
CongruentialStep(mySeed.value1, mySeed.value2);
|
||||||
|
INC(count);
|
||||||
|
END;
|
||||||
|
(* mix them together *)
|
||||||
|
DefaultSequenceRestart(mySeed, mySeed);
|
||||||
|
seed := mySeed;
|
||||||
|
|
||||||
|
(* now use our seed to initialize std sequence *)
|
||||||
|
NEW(myStd);
|
||||||
|
Services.Init(myStd, defaultSequenceType);
|
||||||
|
Init(myStd, if, {longRealValS, rewindSequence, restartSequence});
|
||||||
|
DefaultSequenceRestart(myStd, mySeed);
|
||||||
|
std := myStd;
|
||||||
|
|
||||||
|
unpredictable := NIL;
|
||||||
|
END CreateDefaultSequences;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
serviceDiscID := Disciplines.Unique();
|
||||||
|
Services.Create(service, "RandomGenerators");
|
||||||
|
Services.CreateType(sequenceType, "RandomGenerators.Sequence", "");
|
||||||
|
Services.CreateType(defaultSequenceType, "RandomGenerators.DefaultSequence",
|
||||||
|
"RandomGenerators.Sequence");
|
||||||
|
CreateDefaultSequences;
|
||||||
|
END ulmRandomGenerators.
|
||||||
Loading…
Add table
Add a link
Reference in a new issue