mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-05 23:22:25 +00:00
ported ulmConclusions, ulmRandomGenerators
This commit is contained in:
Norayr Chilingarian
parent
7b7c968aac
commit
d5a6f185c6
9 changed files with 602 additions and 0 deletions
2
makefile
2
makefile
|
|
@ -210,6 +210,8 @@ stage6:
|
|||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||
|
||||
#pow32 libs
|
||||
$(VOCSTATIC) -sP powStrings.Mod
|
||||
|
|
|
|||
|
|
@ -209,6 +209,8 @@ stage6:
|
|||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||
|
||||
#pow32 libs
|
||||
$(VOCSTATIC) -sP powStrings.Mod
|
||||
|
|
|
|||
|
|
@ -209,6 +209,8 @@ stage6:
|
|||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||
|
||||
#pow32 libs
|
||||
$(VOCSTATIC) -sP powStrings.Mod
|
||||
|
|
|
|||
|
|
@ -209,6 +209,8 @@ stage6:
|
|||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||
|
||||
#pow32 libs
|
||||
$(VOCSTATIC) -sP powStrings.Mod
|
||||
|
|
|
|||
|
|
@ -209,6 +209,8 @@ stage6:
|
|||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||
|
||||
#pow32 libs
|
||||
$(VOCSTATIC) -sP powStrings.Mod
|
||||
|
|
|
|||
|
|
@ -209,6 +209,8 @@ stage6:
|
|||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||
|
||||
#pow32 libs
|
||||
$(VOCSTATIC) -sP powStrings.Mod
|
||||
|
|
|
|||
|
|
@ -209,6 +209,8 @@ stage6:
|
|||
$(VOCSTATIC) -sP ulmCipherOps.Mod
|
||||
$(VOCSTATIC) -sP ulmBlockCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmAsymmetricCiphers.Mod
|
||||
$(VOCSTATIC) -sP ulmConclusions.Mod
|
||||
$(VOCSTATIC) -sP ulmRandomGenerators.Mod
|
||||
|
||||
#pow32 libs
|
||||
$(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