1 (* TimerHandler.mod provides a simple timer handler for the Executive.
3 Copyright (C) 2002-2022 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
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)
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.
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.
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/>. *)
27 IMPLEMENTATION MODULE TimerHandler[MAX(PROTECTION)] ;
30 FROM COROUTINES IMPORT PROTECTION ;
31 FROM SysStorage IMPORT ALLOCATE ;
32 FROM NumberIO IMPORT CardToStr ;
33 FROM Debug IMPORT Halt, DebugString ;
34 FROM KeyBoardLEDs IMPORT SwitchScroll ;
35 FROM RTint IMPORT ReArmTimeVector, GetTimeVector, InitTimeVector ;
36 FROM Executive IMPORT DESCRIPTOR, Suspend, Resume, GetCurrentProcess,
37 WaitForIO, InitProcess, RotateRunQueue,
41 MaxQuantum = 4 ; (* Maximum ticks a process may consume *)
42 (* before being rescheduled. *)
43 BaseTicks = 1000000 ; (* Max resolution of clock ticks per sec *)
44 TimerStackSize = 100000H ; (* Reasonable sized stack for a process *)
45 Debugging = FALSE ; (* Do you want lots of debugging info? *)
48 EVENT = POINTER TO RECORD
51 Process : DESCRIPTOR ;
52 NoOfTicks : CARDINAL ;
53 WasCancelled: BOOLEAN ;
56 (* the queue types are either:
58 active queue which has a list of outstanding events
59 dead queue which is essentially the free list
60 solo which is no queue and the event is in limbo
63 QueueType = (active, dead, solo) ;
71 TotalTicks : CARDINAL ; (* System up time tick count *)
72 CurrentQuanta : CARDINAL ; (* Currentprocess time quanta allowance *)
73 ActiveQueue, (* Queue of outstanding timer requests *)
74 DeadQueue : EVENT ; (* Free list of events. *)
78 GetTicks - returns the number of ticks since boottime.
81 PROCEDURE GetTicks () : CARDINAL ;
83 ToOldState : PROTECTION ;
84 CopyOfTicks: CARDINAL ;
86 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
87 CopyOfTicks := TotalTicks ;
88 (* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
94 Sleep - suspends the current process for a time, t.
95 The time is measured in ticks.
98 PROCEDURE Sleep (t: CARDINAL) ;
100 ToOldState: PROTECTION ;
103 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
108 (* ToOldState := TurnInterrupts(ToOldState) (* restore interrupts *) *)
113 More lower system calls to the timer procedures follow,
114 they are necessary to allow handling multiple events.
119 ArmEvent - initializes an event, e, to occur at time, t.
120 The time, t, is measured in ticks.
121 The event is NOT placed onto the event queue.
124 PROCEDURE ArmEvent (t: CARDINAL) : EVENT ;
127 ToOldState: PROTECTION ;
130 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
133 (* your code needs to go here *)
134 WITH e^ DO (* remove for student *)
135 InitQueue(EventQ) ; (* not on a queue yet *) (* remove for student *)
136 WhichQ := solo ; (* and set the queue state accordingly *) (* remove for student *)
137 Process := NIL ; (* no process waiting event yet *) (* remove for student *)
138 NoOfTicks := t ; (* absolute number of ticks *) (* remove for student *)
139 WasCancelled := FALSE ; (* has not been cancelled *) (* remove for student *)
140 END ; (* remove for student *)
142 (* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
148 WaitOn - places event, e, onto the event queue and then the calling
149 process suspends. It is resumed up by either the event
150 expiring or the event, e, being cancelled.
151 TRUE is returned if the event was cancelled
152 FALSE is returned if the event expires.
153 The event, e, is always assigned to NIL when the function
157 PROCEDURE WaitOn (VAR e: EVENT) : BOOLEAN ;
159 ToOldState: PROTECTION ;
160 Cancelled : BOOLEAN ;
162 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
165 Halt(__FILE__, __LINE__, __FUNCTION__,
166 'event should never be NIL')
169 (* we will just check to see whether someone has cancelled this *)
170 (* event before it ever got to the queue... *)
173 (* right so it wasn't cancelled. Lets place it on the queue and *)
175 Process := GetCurrentProcess() ; (* so we know who is waiting *)
176 OnActiveQueue(e) ; (* add to the queue and then *)
180 DisplayActive ; (* debugging *)
183 Suspend (* wait for Resume (we sleep) *)
185 (* At this point we have either been cancelled or not. We must *)
186 (* check the event again as we might have been sleeping (Suspend) *)
187 Cancelled := WasCancelled
190 OnDeadQueue(e) ; (* now it is safe to throw this event away *)
192 (* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
198 Cancel - cancels the event, e, on the event queue and makes
199 the appropriate process runnable again.
200 TRUE is returned if the event was cancelled and
201 FALSE is returned is the event was not found or
202 no process was waiting on this event.
205 PROCEDURE Cancel (e: EVENT) : BOOLEAN ;
207 ToOldState: PROTECTION ;
208 Cancelled : BOOLEAN ;
209 Private : DESCRIPTOR ;
211 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
212 IF IsOnActiveQueue(e)
215 Cancelled := NOT WasCancelled ;
218 Halt(__FILE__, __LINE__, __FUNCTION__,
219 'inconsistancy event has been cancelled and it is on queue')
222 WasCancelled := TRUE ;
223 IF Process#NIL (* double check that it has not *)
224 (* already been cancelled *)
226 Private := Process ; (* we use our own Private variable *)
227 Process := NIL ; (* as we need to set Process to NIL *)
228 Process := Resume(Private) (* before we Resume. Otherwise *)
229 (* there is the possibility that it *)
230 (* might be reused before we := NIL *)
231 (* (because when we touch Resume *)
232 (* another process could run and..) *)
238 (* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
244 ReArmEvent - removes an event, e, from the event queue. A new time
245 is given to this event and it is then re-inserted onto the
246 event queue in the correct place.
247 TRUE is returned if this occurred
248 FALSE is returned if the event was not found.
251 PROCEDURE ReArmEvent (e: EVENT; t: CARDINAL) : BOOLEAN ;
253 ToOldState: PROTECTION ;
256 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
261 ELSIF IsOnActiveQueue(e) OR IsOnSoloQueue(e)
264 OnSoloQueue(e) ; (* remove from queue *)
265 NoOfTicks := t ; (* give it a new time *)
266 OnActiveQueue(e) (* back on queue *)
268 Halt(__FILE__, __LINE__, __FUNCTION__,
269 'ReArm should not be asked to ReArm a dead event')
272 (* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
278 StartClock - ticks is milli seconds.
281 PROCEDURE StartClock (vec: CARDINAL; ticks: CARDINAL) ;
283 ReArmTimeVector (vec, ticks MOD BaseTicks, ticks DIV BaseTicks)
288 LoadClock - returns the number of milli seconds.
291 PROCEDURE LoadClock (vec: CARDINAL) : CARDINAL ;
293 micro, secs: CARDINAL ;
295 GetTimeVector (vec, micro, secs) ;
296 RETURN secs * BaseTicks + micro
301 Timer - is a process which serves the clock interrupt.
302 Its function is fourfold:
304 (i) to maintain the timer event queue
305 (ii) to give some fairness to processes via round robin scheduling
306 (iii) to keep a count of the total ticks so far (time of day)
307 (iv) provide a heartbeat sign of life via the scroll lock LED
312 CurrentCount: CARDINAL ;
313 ToOldState : PROTECTION ;
314 ScrollLED : BOOLEAN ;
315 TimerIntNo : CARDINAL ;
318 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
320 TimerIntNo := InitTimeVector ((BaseTicks DIV TicksPerSecond) MOD BaseTicks,
321 (BaseTicks DIV TicksPerSecond) DIV BaseTicks,
324 WaitForIO (TimerIntNo) ;
326 (* Get current clock count *)
327 CurrentCount := (* LoadClock(TimerIntNo) ; *) 0 ;
328 (* Now compenstate for lost ticks *)
329 StartClock (TimerIntNo, CurrentCount + (BaseTicks DIV TicksPerSecond)) ;
331 (* your code needs to go here *)
332 INC (TotalTicks) ; (* (iii) *) (* remove for student *)
333 (* now pulse scroll LED *) (* remove for student *)
334 IF (TotalTicks MOD TicksPerSecond) = 0 (* remove for student *)
335 THEN (* remove for student *)
336 ScrollLED := NOT ScrollLED ; (* remove for student *)
337 (* r := printf("<scroll %d>", TotalTicks); *)
338 SwitchScroll(ScrollLED) (* (iv) *) (* remove for student *)
339 END ; (* remove for student *)
340 IF (TotalTicks MOD MaxQuantum) = 0 (* remove for student *)
341 THEN (* remove for student *)
342 RotateRunQueue (* (ii) *) (* remove for student *)
343 END ; (* remove for student *)
345 CheckActiveQueue (* (i) *) (* remove for student *)
351 CheckActiveQueue - purpose is:
353 (i) to remove all events which have expired
354 (ii) resume all processes waiting on these events
355 (iii) decrement the first event with a non zero NoOfTicks
358 PROCEDURE CheckActiveQueue ;
361 Private: DESCRIPTOR ;
365 DebugString('inside CheckActiveQueue\n') ;
368 WHILE (ActiveQueue#NIL) AND (ActiveQueue^.NoOfTicks=0) DO (* (i) *)
371 (* note we do not put it onto the dead queue. The process
372 waiting for the event will place, e, onto the dead queue *)
374 IF (NOT WasCancelled) AND (Process#NIL)
376 Private := Process ; (* we use our own Private variable *)
377 Process := NIL ; (* as we might context switch in *)
378 Process := Resume(Private) ; (* resume. (ii) *)
388 DEC(ActiveQueue^.NoOfTicks) (* (iii) *)
392 DebugString('after CheckActiveQueue\n') ;
395 END CheckActiveQueue ;
399 CreateSolo - create a new event. It does this by either getting an event from
400 the dead queue or (if the dead queue is empty) an event is created
404 PROCEDURE CreateSolo () : EVENT ;
413 SubFrom(DeadQueue, e)
421 RemoveFromDead - removes event, e, from the dead queue.
424 PROCEDURE RemoveFromDead (e: EVENT) ;
426 SubFrom(DeadQueue, e)
431 OnDeadQueue - places an event onto the dead queue.
434 PROCEDURE OnDeadQueue (e: EVENT) ;
438 OnSoloQueue(e) ; (* put on solo queue first *)
439 AddTo(DeadQueue, e) ; (* now safe to put on dead queue *)
446 OnSoloQueue - places an event onto the solo queue.
449 PROCEDURE OnSoloQueue (e: EVENT) ;
453 IF IsOnActiveQueue(e)
456 ELSIF IsOnDeadQueue(e)
466 OnActiveQueue - places an event onto the active queue.
469 PROCEDURE OnActiveQueue (e: EVENT) ;
475 Halt(__FILE__, __LINE__, __FUNCTION__, 'illegal state change')
476 ELSIF IsOnSoloQueue(e)
478 RelativeAddToActive(e) ;
486 IsOnSoloQueue - returns TRUE if event, e, is on the solo queue.
489 PROCEDURE IsOnSoloQueue (e: EVENT) : BOOLEAN ;
491 RETURN( (e#NIL) AND (e^.WhichQ=solo) )
496 IsOnDeadQueue - returns TRUE if event, e, is on the dead queue.
499 PROCEDURE IsOnDeadQueue (e: EVENT) : BOOLEAN ;
501 RETURN( (e#NIL) AND (e^.WhichQ=dead) )
506 IsOnActiveQueue - returns TRUE if event, e, is on the active queue.
509 PROCEDURE IsOnActiveQueue (e: EVENT) : BOOLEAN ;
511 RETURN( (e#NIL) AND (e^.WhichQ=active) )
512 END IsOnActiveQueue ;
516 RemoveFromActive - removes an event, e, from the active queue.
519 PROCEDURE RemoveFromActive (e: EVENT) ;
523 SubFrom(ActiveQueue, e) ;
524 (* providing that the ActiveQueue is non empty we need to
525 modify first event ticks as we have removed the first event, e. *)
528 INC(ActiveQueue^.NoOfTicks, e^.NoOfTicks)
531 (* providing that event, e, is not the last event on the list then
532 update the next event by the time of, e. *)
533 IF e^.EventQ.Right#ActiveQueue
535 INC(e^.EventQ.Right^.NoOfTicks, e^.NoOfTicks)
537 SubFrom(ActiveQueue, e)
539 END RemoveFromActive ;
543 InsertBefore - insert an event, new, on a circular event queue BEFORE
547 PROCEDURE InsertBefore (VAR Head: EVENT; pos, new: EVENT) ;
553 new^.EventQ.Right := new ;
554 new^.EventQ.Left := new
557 (* insert before the first element on the queue *)
558 new^.EventQ.Right := pos ;
559 new^.EventQ.Left := pos^.EventQ.Left ;
560 pos^.EventQ.Left^.EventQ.Right := new ;
561 pos^.EventQ.Left := new ;
564 (* insert before any other element *)
565 new^.EventQ.Right := pos ;
566 new^.EventQ.Left := pos^.EventQ.Left ;
567 pos^.EventQ.Left^.EventQ.Right := new ;
568 pos^.EventQ.Left := new
574 InsertAfter - place an event, new, AFTER the event pos on any circular event queue.
577 PROCEDURE InsertAfter (pos, new: EVENT) ;
579 new^.EventQ.Right := pos^.EventQ.Right ;
580 new^.EventQ.Left := pos ;
581 pos^.EventQ.Right^.EventQ.Left := new ;
582 pos^.EventQ.Right := new
587 RelativeAddToActive - the active event queue is an ordered queue of
588 relative time events.
589 The event, e, is inserted at the appropriate
590 position in the queue. The event, e, enters
591 this routine with an absolute NoOfTicks field which
592 is then used to work out the relative position
593 of the event. After the position is found then
594 the absolute NoOfTicks field is altered to a
595 relative value and inserted on the queue.
598 PROCEDURE RelativeAddToActive (e: EVENT) ;
605 (* simple as the queue is empty (relative=absolute) *)
606 InsertBefore (ActiveQueue, ActiveQueue, e)
608 (* at the end of the while loop sum will contain the total of all
609 events up to but not including, t.
610 If the value of sum is < e^.NoOfTicks then e must be placed at the end
611 >= e^.NoOfTicks then e needs to be placed in the middle
614 sum := ActiveQueue^.NoOfTicks ;
615 t := ActiveQueue^.EventQ.Right ; (* second event *)
616 WHILE (sum < e^.NoOfTicks) AND (t # ActiveQueue) DO
617 INC (sum, t^.NoOfTicks) ;
620 IF sum < e^.NoOfTicks
622 (* e will occur after all the current ActiveQueue has expired therefore
623 we must add it to the end of the ActiveQueue. *)
624 DEC (e^.NoOfTicks, sum) ;
625 InsertAfter (ActiveQueue^.EventQ.Left, e)
627 (* as sum >= e^.NoOfTicks we know that e is scheduled to occur
628 in the middle of the queue but before t^.Left
630 DEC (e^.NoOfTicks, sum-t^.EventQ.Left^.NoOfTicks) ;
631 InsertBefore (ActiveQueue, t^.EventQ.Left, e)
633 (* the first event after e must have its relative NoOfTicks altered *)
634 IF e^.EventQ.Right # ActiveQueue
636 DEC (e^.EventQ.Right^.NoOfTicks, e^.NoOfTicks)
639 END RelativeAddToActive ;
643 AddTo - adds an event to a specified queue.
646 PROCEDURE AddTo (VAR Head: EVENT; e: EVENT) ;
651 e^.EventQ.Left := e ;
654 e^.EventQ.Right := Head ;
655 e^.EventQ.Left := Head^.EventQ.Left ;
656 Head^.EventQ.Left^.EventQ.Right := e ;
657 Head^.EventQ.Left := e
663 SubFrom - removes an event from a queue.
666 PROCEDURE SubFrom (VAR Head: EVENT; e: EVENT) ;
668 IF (e^.EventQ.Left = Head) AND (e = Head)
674 Head := Head^.EventQ.Right
676 e^.EventQ.Left^.EventQ.Right := e^.EventQ.Right ;
677 e^.EventQ.Right^.EventQ.Left := e^.EventQ.Left
683 DisplayActive - display the active queue.
686 PROCEDURE DisplayActive ;
702 DisplayEvent - display a single event, e.
705 PROCEDURE DisplayEvent (e: EVENT) ;
707 a: ARRAY [0..20] OF CHAR ;
710 CardToStr(NoOfTicks, 6, a) ;
712 DebugString(' process (') ;
715 DebugString('is NIL') ;
722 DebugString(' has been cancelled')
733 PROCEDURE InitQueue (VAR q: Queue) ;
741 Init - starts the timer process and initializes some queues.
752 d := Resume(InitProcess(Timer, TimerStackSize, 'Timer'))