gcc/testsuite/gm2/pimcoroutines/run/pass/testtime.mod

   1 (* Copyright (C) 2005-2020
   2                  Free Software Foundation, Inc. *)
   3 (* This file is part of GNU Modula-2.
   4
   5 This library is free software; you can redistribute it and/or
   6 modify it under the terms of the GNU Lesser General Public
   7 License as published by the Free Software Foundation; either
   8 version 2.1 of the License, or (at your option) any later version.
   9
  10 This library is distributed in the hope that it will be useful,
  11 but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 Lesser General Public License for more details.
  14
  15 You should have received a copy of the GNU Lesser General Public
  16 License along with this library; if not, write to the Free Software
  17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *)
  18
  19 MODULE testtime ;
  20
  21
  22 FROM Debug IMPORT Halt ;
  23 FROM StdIO IMPORT PushOutput ;
  24 FROM StrIO IMPORT WriteString, WriteLn ;
  25 FROM TimerHandler IMPORT EVENT, TicksPerSecond, Sleep, ArmEvent,
  26                          Cancel, WaitOn, ReArmEvent ;
  27 FROM SYSTEM IMPORT TurnInterrupts ;
  28 FROM COROUTINES IMPORT PROTECTION ;
  29 FROM Executive IMPORT DESCRIPTOR, InitProcess, Resume, Ps ;
  30 FROM SYSTEM IMPORT ADR ;
  31 FROM libc IMPORT write, printf ;
  32
  33
  34 (*
  35    OneSecond -
  36 *)
  37
  38 PROCEDURE OneSecond ;
  39 VAR
  40    n: CARDINAL ;
  41 BEGIN
  42    OldInts := TurnInterrupts (MIN (PROTECTION)) ;
  43    printf ("1 second process has come to life\n");
  44    n := 0 ;
  45    LOOP
  46       Sleep (1*TicksPerSecond) ;
  47       INC (n) ;
  48       printf ("%d seconds\n", n);
  49    END
  50 END OneSecond ;
  51
  52
  53 (*
  54    FourSeconds -
  55 *)
  56
  57 PROCEDURE FourSeconds ;
  58 VAR
  59    n: CARDINAL ;
  60 BEGIN
  61    OldInts := TurnInterrupts (MIN (PROTECTION)) ;
  62    printf ("4 seconds process has come to life\n");
  63    n := 0 ;
  64    LOOP
  65       Sleep (4*TicksPerSecond) ;
  66       INC (n) ;
  67       printf ("4 second alarm (%d occurance)\n", n);
  68    END
  69 END FourSeconds ;
  70
  71
  72 (*
  73    SixSeconds -
  74 *)
  75
  76 PROCEDURE SixSeconds ;
  77 VAR
  78    n: CARDINAL ;
  79 BEGIN
  80    OldInts := TurnInterrupts (MAX (PROTECTION)) ;
  81    printf ("6 seconds process has come to life\n");
  82    n := 0 ;
  83    LOOP
  84       Timeout := ArmEvent (6*TicksPerSecond) ;
  85       IF WaitOn (Timeout)
  86       THEN
  87          WriteString ('...someone cancelled it...')
  88       ELSE
  89          INC (n) ;
  90          printf ("6 second alarm (%d occurance)\n", n)
  91       END
  92    END
  93 END SixSeconds ;
  94
  95
  96 CONST
  97    StackSize = 0100000H ;
  98
  99 VAR
 100    p1, p4,
 101    p6      : DESCRIPTOR ;
 102    OldInts : PROTECTION ;
 103    Timeout : EVENT ;
 104 BEGIN
 105    OldInts := TurnInterrupts (MIN (PROTECTION)) ;
 106    printf ("got to OS\n") ;
 107
 108    printf ("now to create three processes...\n") ;
 109
 110    p1 := Resume (InitProcess (OneSecond  , StackSize, '1')) ;
 111    p4 := Resume (InitProcess (FourSeconds, StackSize, '4')) ;
 112    p6 := Resume (InitProcess (SixSeconds , StackSize, '6')) ;
 113
 114    Sleep (20*TicksPerSecond) ;
 115    printf ("successfully completed, finishing now.\n")
 116 END testtime.