gcc/m2/gm2-libs-iso/Preemptive.mod

   1 (* Premptive.mod provides the Processes module with a premptive scheduler.
   2
   3 Copyright (C) 2020-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE Preemptive ;
  28
  29 FROM COROUTINES IMPORT TurnInterrupts, PROTECTION ;
  30 FROM Processes IMPORT Wait, Attach, Detach, Create, ProcessId, Urgency, Activate, SuspendMe ;
  31 FROM RTint IMPORT InitTimeVector, ReArmTimeVector, IncludeVector, ExcludeVector ;
  32 FROM libc IMPORT printf ;
  33
  34 CONST
  35    debugging = FALSE ;
  36    (* The space we request becomes part of a stack request, which generally
  37       has constraints on size and alignment.  *)
  38    extraWorkSpace = 10 * 1024 * 1024 ;
  39
  40 (*
  41    timer - the timer process which runs at maximum scheduling priority with
  42            interrupts off.  It sleeps for a time quantum, performs a Wait
  43            which will rotate the ready queue and then Waits again.
  44 *)
  45
  46 PROCEDURE timer ;
  47 VAR
  48    vec,
  49    currentUsec,
  50    currentSec : CARDINAL ;
  51    old        : PROTECTION ;
  52 BEGIN
  53    IF debugging
  54    THEN
  55       printf ("timer\n");
  56    END ;
  57    old := TurnInterrupts (MAX (PROTECTION)) ;
  58    vec := InitTimeVector (timeSliceUsec, timeSliceSec, MAX (PROTECTION)) ;
  59    IF debugging
  60    THEN
  61       printf ("attach\n");
  62    END ;
  63    Attach (vec) ;  (* attach vector to this process.  *)
  64    IF debugging
  65    THEN
  66       printf ("include vec\n");
  67    END ;
  68    IncludeVector (vec) ;
  69    LOOP
  70       currentSec := timeSliceSec ;
  71       currentUsec := timeSliceUsec ;
  72       IF debugging
  73       THEN
  74          printf ("timer process about to Wait\n");
  75       END ;
  76       Wait ;
  77       (*
  78       printf ("yes 2 seconds elapsed, suspending\n");
  79       SuspendMe ;
  80       *)
  81       IF debugging
  82       THEN
  83          printf ("timer process wakes up, now calling ReArmTimeVector\n");
  84       END ;
  85       ReArmTimeVector (vec, timeSliceUsec, timeSliceSec) ;
  86       IF debugging
  87       THEN
  88          printf ("ReArmTimeVector complete\n");
  89          printf ("attach\n");
  90       END ;
  91       Attach (vec) ;  (* attach vector to this process.  *)
  92       IF debugging
  93       THEN
  94          printf ("finished attach, now include vec\n");
  95       END ;
  96       IncludeVector (vec) ;
  97    END
  98 END timer ;
  99
 100
 101 (*
 102    initPreemptive - if millisecs > 0 then turn on preemptive scheduling.
 103                     if millisecs = 0 then preemptive scheduling is turned off.
 104 *)
 105
 106 PROCEDURE initPreemptive (seconds, microsecs: CARDINAL) ;
 107 BEGIN
 108    timeSliceUsec := microsecs ;
 109    timeSliceSec := seconds ;
 110    IF NOT init
 111    THEN
 112       init := TRUE ;
 113       Create (timer, extraWorkSpace, MAX (Urgency), NIL, timerId) ;
 114       Activate (timerId)
 115    END
 116 END initPreemptive ;
 117
 118
 119 VAR
 120    init        : BOOLEAN ;
 121    timerId     : ProcessId ;
 122    timeSliceSec,
 123    timeSliceUsec: CARDINAL ;
 124 BEGIN
 125    init := FALSE ;
 126    timeSliceSec := 0 ;
 127    timeSliceUsec := 0
 128 END Preemptive.