gcc/testsuite/gm2/examples/map/pass/Chance.mod

(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
                 Free Software Foundation, Inc. *)
(* This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.

GNU Modula-2 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 General Public License
for more details.

You should have received a copy of the GNU General Public License along
with gm2; see the file COPYING.  If not, write to the Free Software
Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
IMPLEMENTATION MODULE Chance ;


FROM Args IMPORT GetArg ;
FROM NumberIO IMPORT StrToCard ;

FROM StrIO IMPORT WriteString, WriteLn ;

(* FROM Random IMPORT RandomCard ; *)


CONST
   MaxCard   = 65535 ;
   MaxRandom =  8000 ;
   MaxIndex  =   500 ;

TYPE
   Index  = RECORD
               Start,               (* Start of the Random list *)
               End  : CARDINAL ;    (* End of the Random list   *)
            END ;

VAR
   RandomIndex: ARRAY [0..MaxIndex] OF Index ;
   Random     : ARRAY [1..MaxRandom] OF CARDINAL ;
   NoOfRandom : CARDINAL ;   (* Number of random numbers in array Coords *)
   NoOfIndices: CARDINAL ;   (* Number of indices in RandomIndex         *)


(*
   InitRandom - Initializes a potential list of random numbers.
                An index to this potential random number list is returned.
*)

PROCEDURE InitRandom () : CARDINAL ;
BEGIN
   IF NoOfIndices=MaxIndex
   THEN
      WriteString('Too many random list indices in Module Chance') ;
      WriteLn ;
      HALT
   ELSE
      INC(NoOfIndices) ;
      WITH RandomIndex[NoOfIndices] DO
         Start := NoOfRandom+1 ;
         End := 0
      END ;
      Add(NoOfIndices, 0) ;     (* Dummy random no. that we keep *)
      RETURN(NoOfIndices)       (* for the life of this list.    *)
   END
END InitRandom ;


(*
   KillRandom - Kills a complete list of random numbers.
*)

PROCEDURE KillRandom (RandomListIndex: CARDINAL) ;
BEGIN
   IF NoOfIndices>0
   THEN
      (* Destroy index to Random list *)
      WITH RandomIndex[RandomListIndex] DO
         Start := 0 ;
         End := 0
      END ;
      (*
         If killed last Random index list see if we can garbage collect
         previously killed middle indices.
      *)
      IF NoOfIndices=RandomListIndex
      THEN
         REPEAT
            DEC(NoOfIndices)
         UNTIL (NoOfIndices=0) OR (RandomIndex[NoOfIndices].Start#0)
      END ;
      NoOfRandom := RandomIndex[NoOfIndices].End
   ELSE
      WriteString('All Random lists have been killed - Module Chance') ;
      WriteLn ;
      HALT
   END
END KillRandom ;


(*
   AddRandom - places a list of numbers 1..n into the specified list.
*)

PROCEDURE AddRandom (RandomListIndex: CARDINAL; n: CARDINAL) ;
BEGIN
   WHILE n>0 DO
      Add(RandomListIndex, n) ;
      DEC(n)
   END
END AddRandom ;


PROCEDURE Add (RandomListIndex: CARDINAL; i: CARDINAL) ;
BEGIN
   IF NoOfRandom=MaxRandom
   THEN
      WriteString('Too many random numbers in a list in Module Chance') ;
      WriteLn ;
      HALT
   ELSE
      INC(NoOfRandom) ;
      Random[NoOfRandom] := i ;
      WITH RandomIndex[RandomListIndex] DO
         End := NoOfRandom
      END
   END
END Add ;


(*
   GetAndDeleteRandom - Returns a random number from the
                        list and then it is deleted.
*)

PROCEDURE GetAndDeleteRandom (RandomListIndex: CARDINAL) : CARDINAL ;
VAR
   i, j: CARDINAL ;
BEGIN
   WITH RandomIndex[RandomListIndex] DO
      i := Start+GetRand(End-Start+1) ;  (* +1 for GetRand *)
      j := i ;
      REPEAT
         IF Random[j]=0
         THEN
            INC(j) ;
            IF j>End
            THEN
               j := Start
            END
         END
      UNTIL (j=i) OR (Random[j]#0) ;
      i := Random[j] ;
      Random[j] := 0        (* Now delete this box *)
   END ;
   RETURN( i )
END GetAndDeleteRandom ;


(*
   GetRand - returns a number between 0..n-1.
             This routine is independant of the above routines.
*)

VAR
   RandomSeed: CARDINAL ;
   Num       : ARRAY [0..9] OF CHAR ;

PROCEDURE GetRand (n: CARDINAL) : CARDINAL ;
BEGIN
   (* $R- *)
   RandomSeed := (RandomSeed*257 + 0ABCDH) MOD MaxCard ;
   (* $R= *)
   RETURN( RandomSeed MOD n )
(*
   IF n<2
   THEN
      RETURN( 0 )  (* return 0  if n=0  or n=1 *)
   ELSE
      RETURN( RandomCard(n) )
   END
*)
END GetRand ;


PROCEDURE Init ;
BEGIN
   NoOfRandom := 0 ;
   NoOfIndices := 0 ;
   WITH RandomIndex[NoOfIndices] DO
      End := 0
   END
END Init ;


BEGIN
   Init
   ; IF GetArg(Num, 1)
   THEN
      StrToCard(Num, RandomSeed)
   ELSE
      RandomSeed := 3
   END
END Chance.