]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/s-interr.adb
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
2003-10-21 Arnaud Charlet <charlet@act-europe.fr>
[thirdparty/gcc.git] / gcc / ada / s-interr.adb
CommitLineData
c32d0452 1------------------------------------------------------------------------------
2-- --
3-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
4-- --
5-- S Y S T E M . I N T E R R U P T S --
6-- --
7-- B o d y --
8-- --
9dfe12ae 9-- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
c32d0452 10-- --
11-- GNARL is free software; you can redistribute it and/or modify it under --
12-- terms of the GNU General Public License as published by the Free Soft- --
13-- ware Foundation; either version 2, or (at your option) any later ver- --
14-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17-- for more details. You should have received a copy of the GNU General --
18-- Public License distributed with GNARL; see file COPYING. If not, write --
19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20-- MA 02111-1307, USA. --
21-- --
22-- As a special exception, if other files instantiate generics from this --
23-- unit, or you link this unit with other files to produce an executable, --
24-- this unit does not by itself cause the resulting executable to be --
25-- covered by the GNU General Public License. This exception does not --
26-- however invalidate any other reasons why the executable file might be --
27-- covered by the GNU Public License. --
28-- --
e78e8c8e 29-- GNARL was developed by the GNARL team at Florida State University. --
9dfe12ae 30-- Extensive contributions were provided by Ada Core Technologies, Inc. --
c32d0452 31-- --
32------------------------------------------------------------------------------
33
34-- Invariants:
35
36-- All user-handleable interrupts are masked at all times in all
37-- tasks/threads except possibly for the Interrupt_Manager task.
38
39-- When a user task wants to have the effect of masking/unmasking an
40-- interrupt, it must call Block_Interrupt/Unblock_Interrupt, which
41-- will have the effect of unmasking/masking the interrupt in the
42-- Interrupt_Manager task.
43
44-- Note : Direct calls to sigaction, sigprocmask, pthread_sigsetmask or any
45-- other low-level interface that changes the interrupt action or
46-- interrupt mask needs a careful thought.
47-- One may acheive the effect of system calls first masking RTS blocked
48-- (by calling Block_Interrupt) for the interrupt under consideration.
49-- This will make all the tasks in RTS blocked for the Interrupt.
50
51-- Once we associate a Server_Task with an interrupt, the task never
52-- goes away, and we never remove the association.
53
54-- There is no more than one interrupt per Server_Task and no more than
55-- one Server_Task per interrupt.
56
c32d0452 57with Ada.Task_Identification;
58-- used for Task_ID type
59
60with Ada.Exceptions;
61-- used for Raise_Exception
62
63with System.Task_Primitives;
64-- used for RTS_Lock
65-- Self
66
67with System.Interrupt_Management;
68-- used for Reserve
69-- Interrupt_ID
70-- Interrupt_Mask
71-- Abort_Task_Interrupt
72
73with System.Interrupt_Management.Operations;
74-- used for Thread_Block_Interrupt
75-- Thread_Unblock_Interrupt
76-- Install_Default_Action
77-- Install_Ignore_Action
78-- Copy_Interrupt_Mask
79-- Set_Interrupt_Mask
80-- Empty_Interrupt_Mask
81-- Fill_Interrupt_Mask
82-- Add_To_Interrupt_Mask
83-- Delete_From_Interrupt_Mask
84-- Interrupt_Wait
85-- Interrupt_Self_Process
86-- Get_Interrupt_Mask
87-- Set_Interrupt_Mask
88-- IS_Member
89-- Environment_Mask
90-- All_Tasks_Mask
91pragma Elaborate_All (System.Interrupt_Management.Operations);
92
c32d0452 93with System.Task_Primitives.Operations;
94-- used for Write_Lock
95-- Unlock
96-- Abort
97-- Wakeup_Task
98-- Sleep
99-- Initialize_Lock
100
101with System.Task_Primitives.Interrupt_Operations;
102-- used for Set_Interrupt_ID
103
104with System.Storage_Elements;
105-- used for To_Address
106-- To_Integer
107-- Integer_Address
108
109with System.Tasking;
110-- used for Task_ID
111-- Task_Entry_Index
112-- Null_Task
113-- Self
114-- Interrupt_Manager_ID
115
116with System.Tasking.Utilities;
117-- used for Make_Independent
118
119with System.Tasking.Rendezvous;
120-- used for Call_Simple
121pragma Elaborate_All (System.Tasking.Rendezvous);
122
123with System.Tasking.Initialization;
124-- used for Defer_Abort
125-- Undefer_Abort
126
f15731c4 127with System.Parameters;
128-- used for Single_Lock
129
c32d0452 130with Unchecked_Conversion;
131
132package body System.Interrupts is
133
f15731c4 134 use Parameters;
c32d0452 135 use Tasking;
c32d0452 136 use Ada.Exceptions;
137
c32d0452 138 package POP renames System.Task_Primitives.Operations;
139 package PIO renames System.Task_Primitives.Interrupt_Operations;
140 package IMNG renames System.Interrupt_Management;
141 package IMOP renames System.Interrupt_Management.Operations;
142
143 function To_System is new Unchecked_Conversion
144 (Ada.Task_Identification.Task_Id, Task_ID);
145
146 -----------------
147 -- Local Tasks --
148 -----------------
149
f15731c4 150 -- WARNING: System.Tasking.Stages performs calls to this task
c32d0452 151 -- with low-level constructs. Do not change this spec without synchro-
152 -- nizing it.
153
154 task Interrupt_Manager is
f15731c4 155 entry Detach_Interrupt_Entries (T : Task_ID);
156
c32d0452 157 entry Initialize (Mask : IMNG.Interrupt_Mask);
158
159 entry Attach_Handler
160 (New_Handler : in Parameterless_Handler;
161 Interrupt : in Interrupt_ID;
162 Static : in Boolean;
163 Restoration : in Boolean := False);
164
165 entry Exchange_Handler
166 (Old_Handler : out Parameterless_Handler;
167 New_Handler : in Parameterless_Handler;
168 Interrupt : in Interrupt_ID;
169 Static : in Boolean);
170
171 entry Detach_Handler
172 (Interrupt : in Interrupt_ID;
173 Static : in Boolean);
174
175 entry Bind_Interrupt_To_Entry
176 (T : Task_ID;
177 E : Task_Entry_Index;
178 Interrupt : Interrupt_ID);
179
c32d0452 180 entry Block_Interrupt (Interrupt : Interrupt_ID);
181
182 entry Unblock_Interrupt (Interrupt : Interrupt_ID);
183
184 entry Ignore_Interrupt (Interrupt : Interrupt_ID);
185
186 entry Unignore_Interrupt (Interrupt : Interrupt_ID);
187
188 pragma Interrupt_Priority (System.Interrupt_Priority'Last);
189 end Interrupt_Manager;
190
191 task type Server_Task (Interrupt : Interrupt_ID) is
192 pragma Priority (System.Interrupt_Priority'Last);
9dfe12ae 193 -- Note: the above pragma Priority is strictly speaking improper
194 -- since it is outside the range of allowed priorities, but the
195 -- compiler treats system units specially and does not apply
196 -- this range checking rule to system units.
197
c32d0452 198 end Server_Task;
199
200 type Server_Task_Access is access Server_Task;
201
f15731c4 202 -------------------------------
203 -- Local Types and Variables --
204 -------------------------------
c32d0452 205
206 type Entry_Assoc is record
207 T : Task_ID;
208 E : Task_Entry_Index;
209 end record;
210
211 type Handler_Assoc is record
212 H : Parameterless_Handler;
213 Static : Boolean; -- Indicates static binding;
214 end record;
215
216 User_Handler : array (Interrupt_ID'Range) of Handler_Assoc :=
217 (others => (null, Static => False));
218 pragma Volatile_Components (User_Handler);
219 -- Holds the protected procedure handler (if any) and its Static
220 -- information for each interrupt. A handler is a Static one if
221 -- it is specified through the pragma Attach_Handler.
222 -- Attach_Handler. Otherwise, not static)
223
224 User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
225 (others => (T => Null_Task, E => Null_Task_Entry));
226 pragma Volatile_Components (User_Entry);
227 -- Holds the task and entry index (if any) for each interrupt
228
229 Blocked : array (Interrupt_ID'Range) of Boolean := (others => False);
230 pragma Volatile_Components (Blocked);
231 -- True iff the corresponding interrupt is blocked in the process level
232
233 Ignored : array (Interrupt_ID'Range) of Boolean := (others => False);
234 pragma Volatile_Components (Ignored);
235 -- True iff the corresponding interrupt is blocked in the process level
236
237 Last_Unblocker :
238 array (Interrupt_ID'Range) of Task_ID := (others => Null_Task);
239 pragma Volatile_Components (Last_Unblocker);
240 -- Holds the ID of the last Task which Unblocked this Interrupt.
241 -- It contains Null_Task if no tasks have ever requested the
242 -- Unblocking operation or the Interrupt is currently Blocked.
243
244 Server_ID : array (Interrupt_ID'Range) of Task_ID :=
245 (others => Null_Task);
246 pragma Atomic_Components (Server_ID);
247 -- Holds the Task_ID of the Server_Task for each interrupt.
248 -- Task_ID is needed to accomplish locking per Interrupt base. Also
249 -- is needed to decide whether to create a new Server_Task.
250
251 -- Type and Head, Tail of the list containing Registered Interrupt
252 -- Handlers. These definitions are used to register the handlers
253 -- specified by the pragma Interrupt_Handler.
254
255 type Registered_Handler;
256 type R_Link is access all Registered_Handler;
257
258 type Registered_Handler is record
259 H : System.Address := System.Null_Address;
260 Next : R_Link := null;
261 end record;
262
263 Registered_Handler_Head : R_Link := null;
264 Registered_Handler_Tail : R_Link := null;
265
266 Access_Hold : Server_Task_Access;
267 -- variable used to allocate Server_Task using "new".
268
c32d0452 269 -----------------------
270 -- Local Subprograms --
271 -----------------------
272
c32d0452 273 function Is_Registered (Handler : Parameterless_Handler) return Boolean;
f15731c4 274 -- See if the Handler has been "pragma"ed using Interrupt_Handler.
275 -- Always consider a null handler as registered.
c32d0452 276
277 --------------------
278 -- Attach_Handler --
279 --------------------
280
281 -- Calling this procedure with New_Handler = null and Static = True
282 -- means we want to detach the current handler regardless of the
283 -- previous handler's binding status (ie. do not care if it is a
284 -- dynamic or static handler).
285
286 -- This option is needed so that during the finalization of a PO, we
287 -- can detach handlers attached through pragma Attach_Handler.
288
289 procedure Attach_Handler
290 (New_Handler : in Parameterless_Handler;
291 Interrupt : in Interrupt_ID;
292 Static : in Boolean := False)
293 is
294 begin
295 if Is_Reserved (Interrupt) then
296 Raise_Exception (Program_Error'Identity, "Interrupt" &
297 Interrupt_ID'Image (Interrupt) & " is reserved");
298 end if;
299
300 Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
301
302 end Attach_Handler;
303
304 -----------------------------
305 -- Bind_Interrupt_To_Entry --
306 -----------------------------
307
308 -- This procedure raises a Program_Error if it tries to
309 -- bind an interrupt to which an Entry or a Procedure is
310 -- already bound.
311
312 procedure Bind_Interrupt_To_Entry
313 (T : Task_ID;
314 E : Task_Entry_Index;
315 Int_Ref : System.Address)
316 is
317 Interrupt : constant Interrupt_ID :=
318 Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
319
320 begin
321 if Is_Reserved (Interrupt) then
322 Raise_Exception (Program_Error'Identity, "Interrupt" &
323 Interrupt_ID'Image (Interrupt) & " is reserved");
324 end if;
325
326 Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
327
328 end Bind_Interrupt_To_Entry;
329
330 ---------------------
331 -- Block_Interrupt --
332 ---------------------
333
334 procedure Block_Interrupt (Interrupt : Interrupt_ID) is
335 begin
336 if Is_Reserved (Interrupt) then
337 Raise_Exception (Program_Error'Identity, "Interrupt" &
338 Interrupt_ID'Image (Interrupt) & " is reserved");
339 end if;
340
341 Interrupt_Manager.Block_Interrupt (Interrupt);
342 end Block_Interrupt;
343
344 ---------------------
345 -- Current_Handler --
346 ---------------------
347
348 function Current_Handler
349 (Interrupt : Interrupt_ID)
350 return Parameterless_Handler
351 is
352 begin
353 if Is_Reserved (Interrupt) then
354 Raise_Exception (Program_Error'Identity, "Interrupt" &
355 Interrupt_ID'Image (Interrupt) & " is reserved");
356 end if;
357
358 -- ??? Since Parameterless_Handler is not Atomic, the
359 -- current implementation is wrong. We need a new service in
360 -- Interrupt_Manager to ensure atomicity.
361
362 return User_Handler (Interrupt).H;
363 end Current_Handler;
364
365 --------------------
366 -- Detach_Handler --
367 --------------------
368
369 -- Calling this procedure with Static = True means we want to Detach the
370 -- current handler regardless of the previous handler's binding status
371 -- (i.e. do not care if it is a dynamic or static handler).
372
373 -- This option is needed so that during the finalization of a PO, we can
374 -- detach handlers attached through pragma Attach_Handler.
375
376 procedure Detach_Handler
9dfe12ae 377 (Interrupt : Interrupt_ID;
378 Static : Boolean := False)
c32d0452 379 is
380 begin
381 if Is_Reserved (Interrupt) then
382 Raise_Exception (Program_Error'Identity, "Interrupt" &
383 Interrupt_ID'Image (Interrupt) & " is reserved");
384 end if;
385
386 Interrupt_Manager.Detach_Handler (Interrupt, Static);
387
388 end Detach_Handler;
389
390 ------------------------------
391 -- Detach_Interrupt_Entries --
392 ------------------------------
393
394 procedure Detach_Interrupt_Entries (T : Task_ID) is
395 begin
396 Interrupt_Manager.Detach_Interrupt_Entries (T);
397 end Detach_Interrupt_Entries;
398
399 ----------------------
400 -- Exchange_Handler --
401 ----------------------
402
403 -- Calling this procedure with New_Handler = null and Static = True
404 -- means we want to detach the current handler regardless of the
405 -- previous handler's binding status (ie. do not care if it is a
406 -- dynamic or static handler).
407
408 -- This option is needed so that during the finalization of a PO, we
409 -- can detach handlers attached through pragma Attach_Handler.
410
411 procedure Exchange_Handler
412 (Old_Handler : out Parameterless_Handler;
9dfe12ae 413 New_Handler : Parameterless_Handler;
414 Interrupt : Interrupt_ID;
415 Static : Boolean := False)
c32d0452 416 is
417 begin
418 if Is_Reserved (Interrupt) then
419 Raise_Exception (Program_Error'Identity, "Interrupt" &
420 Interrupt_ID'Image (Interrupt) & " is reserved");
421 end if;
422
423 Interrupt_Manager.Exchange_Handler
424 (Old_Handler, New_Handler, Interrupt, Static);
425
426 end Exchange_Handler;
427
428 ----------------
429 -- Finalize --
430 ----------------
431
432 procedure Finalize (Object : in out Static_Interrupt_Protection) is
433 begin
434 -- ??? loop to be executed only when we're not doing library level
435 -- finalization, since in this case all interrupt tasks are gone.
9dfe12ae 436
c32d0452 437 if not Interrupt_Manager'Terminated then
438 for N in reverse Object.Previous_Handlers'Range loop
439 Interrupt_Manager.Attach_Handler
440 (New_Handler => Object.Previous_Handlers (N).Handler,
441 Interrupt => Object.Previous_Handlers (N).Interrupt,
442 Static => Object.Previous_Handlers (N).Static,
443 Restoration => True);
444 end loop;
445 end if;
446
447 Tasking.Protected_Objects.Entries.Finalize
448 (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
449 end Finalize;
450
451 -------------------------------------
452 -- Has_Interrupt_Or_Attach_Handler --
453 -------------------------------------
454
9dfe12ae 455 -- Need comments as to why these always return True
456
c32d0452 457 function Has_Interrupt_Or_Attach_Handler
9dfe12ae 458 (Object : access Dynamic_Interrupt_Protection)
459 return Boolean
460 is
461 pragma Unreferenced (Object);
462
c32d0452 463 begin
464 return True;
465 end Has_Interrupt_Or_Attach_Handler;
466
467 function Has_Interrupt_Or_Attach_Handler
468 (Object : access Static_Interrupt_Protection)
469 return Boolean
470 is
9dfe12ae 471 pragma Unreferenced (Object);
472
c32d0452 473 begin
474 return True;
475 end Has_Interrupt_Or_Attach_Handler;
476
477 ----------------------
478 -- Ignore_Interrupt --
479 ----------------------
480
481 procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
482 begin
483 if Is_Reserved (Interrupt) then
484 Raise_Exception (Program_Error'Identity, "Interrupt" &
485 Interrupt_ID'Image (Interrupt) & " is reserved");
486 end if;
487
488 Interrupt_Manager.Ignore_Interrupt (Interrupt);
489 end Ignore_Interrupt;
490
491 ----------------------
492 -- Install_Handlers --
493 ----------------------
494
495 procedure Install_Handlers
496 (Object : access Static_Interrupt_Protection;
9dfe12ae 497 New_Handlers : New_Handler_Array)
c32d0452 498 is
499 begin
500 for N in New_Handlers'Range loop
501
502 -- We need a lock around this ???
503
504 Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
505 Object.Previous_Handlers (N).Static := User_Handler
506 (New_Handlers (N).Interrupt).Static;
507
508 -- We call Exchange_Handler and not directly Interrupt_Manager.
509 -- Exchange_Handler so we get the Is_Reserved check.
510
511 Exchange_Handler
512 (Old_Handler => Object.Previous_Handlers (N).Handler,
513 New_Handler => New_Handlers (N).Handler,
514 Interrupt => New_Handlers (N).Interrupt,
515 Static => True);
516 end loop;
517 end Install_Handlers;
518
519 ----------------
520 -- Is_Blocked --
521 ----------------
522
523 function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
524 begin
525 if Is_Reserved (Interrupt) then
526 Raise_Exception (Program_Error'Identity, "Interrupt" &
527 Interrupt_ID'Image (Interrupt) & " is reserved");
528 end if;
529
530 return Blocked (Interrupt);
531 end Is_Blocked;
532
533 -----------------------
534 -- Is_Entry_Attached --
535 -----------------------
536
537 function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
538 begin
539 if Is_Reserved (Interrupt) then
540 Raise_Exception (Program_Error'Identity, "Interrupt" &
541 Interrupt_ID'Image (Interrupt) & " is reserved");
542 end if;
543
544 return User_Entry (Interrupt).T /= Null_Task;
545 end Is_Entry_Attached;
546
547 -------------------------
548 -- Is_Handler_Attached --
549 -------------------------
550
551 function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
552 begin
553 if Is_Reserved (Interrupt) then
554 Raise_Exception (Program_Error'Identity, "Interrupt" &
555 Interrupt_ID'Image (Interrupt) & " is reserved");
556 end if;
557
558 return User_Handler (Interrupt).H /= null;
559 end Is_Handler_Attached;
560
561 ----------------
562 -- Is_Ignored --
563 ----------------
564
565 function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
566 begin
567 if Is_Reserved (Interrupt) then
568 Raise_Exception (Program_Error'Identity, "Interrupt" &
569 Interrupt_ID'Image (Interrupt) & " is reserved");
570 end if;
571
572 return Ignored (Interrupt);
573 end Is_Ignored;
574
575 -------------------
576 -- Is_Registered --
577 -------------------
578
c32d0452 579 function Is_Registered (Handler : Parameterless_Handler) return Boolean is
580
581 type Fat_Ptr is record
582 Object_Addr : System.Address;
583 Handler_Addr : System.Address;
584 end record;
585
586 function To_Fat_Ptr is new Unchecked_Conversion
587 (Parameterless_Handler, Fat_Ptr);
588
589 Ptr : R_Link;
590 Fat : Fat_Ptr;
591
592 begin
593 if Handler = null then
594 return True;
595 end if;
596
597 Fat := To_Fat_Ptr (Handler);
598
599 Ptr := Registered_Handler_Head;
600
601 while (Ptr /= null) loop
602 if Ptr.H = Fat.Handler_Addr then
603 return True;
604 end if;
605
606 Ptr := Ptr.Next;
607 end loop;
608
609 return False;
610
611 end Is_Registered;
612
613 -----------------
614 -- Is_Reserved --
615 -----------------
616
617 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
618 begin
619 return IMNG.Reserve (IMNG.Interrupt_ID (Interrupt));
620 end Is_Reserved;
621
c32d0452 622 ---------------
623 -- Reference --
624 ---------------
625
626 function Reference (Interrupt : Interrupt_ID) return System.Address is
627 begin
628 if Is_Reserved (Interrupt) then
629 Raise_Exception (Program_Error'Identity, "Interrupt" &
630 Interrupt_ID'Image (Interrupt) & " is reserved");
631 end if;
632
633 return Storage_Elements.To_Address
634 (Storage_Elements.Integer_Address (Interrupt));
635 end Reference;
636
637 ---------------------------------
638 -- Register_Interrupt_Handler --
639 ---------------------------------
640
641 procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
642 New_Node_Ptr : R_Link;
643
644 begin
645 -- This routine registers the Handler as usable for Dynamic
646 -- Interrupt Handler. Routines attaching and detaching Handler
647 -- dynamically should first consult if the Handler is rgistered.
648 -- A Program Error should be raised if it is not registered.
649
650 -- The pragma Interrupt_Handler can only appear in the library
651 -- level PO definition and instantiation. Therefore, we do not need
652 -- to implement Unregistering operation. Neither we need to
653 -- protect the queue structure using a Lock.
654
655 pragma Assert (Handler_Addr /= System.Null_Address);
656
657 New_Node_Ptr := new Registered_Handler;
658 New_Node_Ptr.H := Handler_Addr;
659
660 if Registered_Handler_Head = null then
661 Registered_Handler_Head := New_Node_Ptr;
662 Registered_Handler_Tail := New_Node_Ptr;
663
664 else
665 Registered_Handler_Tail.Next := New_Node_Ptr;
666 Registered_Handler_Tail := New_Node_Ptr;
667 end if;
668 end Register_Interrupt_Handler;
669
670 -----------------------
671 -- Unblock_Interrupt --
672 -----------------------
673
674 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
675 begin
676 if Is_Reserved (Interrupt) then
677 Raise_Exception (Program_Error'Identity, "Interrupt" &
678 Interrupt_ID'Image (Interrupt) & " is reserved");
679 end if;
680
681 Interrupt_Manager.Unblock_Interrupt (Interrupt);
682 end Unblock_Interrupt;
683
684 ------------------
685 -- Unblocked_By --
686 ------------------
687
688 function Unblocked_By
689 (Interrupt : Interrupt_ID)
690 return System.Tasking.Task_ID
691 is
692 begin
693 if Is_Reserved (Interrupt) then
694 Raise_Exception (Program_Error'Identity, "Interrupt" &
695 Interrupt_ID'Image (Interrupt) & " is reserved");
696 end if;
697
698 return Last_Unblocker (Interrupt);
699 end Unblocked_By;
700
701 ------------------------
702 -- Unignore_Interrupt --
703 ------------------------
704
705 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
706 begin
707 if Is_Reserved (Interrupt) then
708 Raise_Exception (Program_Error'Identity, "Interrupt" &
709 Interrupt_ID'Image (Interrupt) & " is reserved");
710 end if;
711
712 Interrupt_Manager.Unignore_Interrupt (Interrupt);
713 end Unignore_Interrupt;
714
c32d0452 715 -----------------------
716 -- Interrupt_Manager --
717 -----------------------
718
719 task body Interrupt_Manager is
720
721 ----------------------
722 -- Local Variables --
723 ----------------------
724
725 Intwait_Mask : aliased IMNG.Interrupt_Mask;
726 Ret_Interrupt : Interrupt_ID;
727 Old_Mask : aliased IMNG.Interrupt_Mask;
f15731c4 728 Old_Handler : Parameterless_Handler;
c32d0452 729
730 ---------------------
731 -- Local Routines --
732 ---------------------
733
734 procedure Bind_Handler (Interrupt : Interrupt_ID);
735 -- This procedure does not do anything if the Interrupt is blocked.
736 -- Otherwise, we have to interrupt Server_Task for status change through
737 -- Wakeup interrupt.
738
739 procedure Unbind_Handler (Interrupt : Interrupt_ID);
740 -- This procedure does not do anything if the Interrupt is blocked.
741 -- Otherwise, we have to interrupt Server_Task for status change
742 -- through abort interrupt.
743
c32d0452 744 procedure Unprotected_Exchange_Handler
745 (Old_Handler : out Parameterless_Handler;
9dfe12ae 746 New_Handler : Parameterless_Handler;
747 Interrupt : Interrupt_ID;
748 Static : Boolean;
749 Restoration : Boolean := False);
c32d0452 750
751 procedure Unprotected_Detach_Handler
9dfe12ae 752 (Interrupt : Interrupt_ID;
753 Static : Boolean);
c32d0452 754
755 ------------------
756 -- Bind_Handler --
757 ------------------
758
759 procedure Bind_Handler (Interrupt : Interrupt_ID) is
760 begin
761 if not Blocked (Interrupt) then
762
763 -- Mask this task for the given Interrupt so that all tasks
764 -- are masked for the Interrupt and the actuall delivery of the
765 -- Interrupt will be caught using "sigwait" by the
766 -- corresponding Server_Task.
767
768 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
769
770 -- We have installed a Handler or an Entry before we called
771 -- this procedure. If the Handler Task is waiting to be awakened,
772 -- do it here. Otherwise, the interrupt will be discarded.
773
774 POP.Wakeup (Server_ID (Interrupt), Interrupt_Server_Idle_Sleep);
775 end if;
776 end Bind_Handler;
777
778 --------------------
779 -- Unbind_Handler --
780 --------------------
781
782 procedure Unbind_Handler (Interrupt : Interrupt_ID) is
783 begin
784 if not Blocked (Interrupt) then
785
786 -- Currently, there is a Handler or an Entry attached and
787 -- corresponding Server_Task is waiting on "sigwait."
788 -- We have to wake up the Server_Task and make it
789 -- wait on condition variable by sending an
790 -- Abort_Task_Interrupt
791
792 POP.Abort_Task (Server_ID (Interrupt));
793
794 -- Make sure corresponding Server_Task is out of its own
795 -- sigwait state.
796
797 Ret_Interrupt :=
798 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
799
800 pragma Assert
801 (Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt));
802
803 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
804
805 -- Unmake the Interrupt for this task in order to allow default
806 -- action again.
807
808 IMOP.Thread_Unblock_Interrupt (IMNG.Interrupt_ID (Interrupt));
809
810 else
811 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
812 end if;
813
814 end Unbind_Handler;
815
816 --------------------------------
817 -- Unprotected_Detach_Handler --
818 --------------------------------
819
820 procedure Unprotected_Detach_Handler
9dfe12ae 821 (Interrupt : Interrupt_ID;
822 Static : Boolean)
c32d0452 823 is
824 Old_Handler : Parameterless_Handler;
825
826 begin
827 if User_Entry (Interrupt).T /= Null_Task then
828
829 -- In case we have an Interrupt Entry installed.
830 -- raise a program error. (propagate it to the caller).
831
c32d0452 832 Raise_Exception (Program_Error'Identity,
833 "An interrupt entry is already installed");
834 end if;
835
836 -- Note : Static = True will pass the following check. That is the
837 -- case when we want to detach a handler regardless of the static
838 -- status of the current_Handler.
839
840 if not Static and then User_Handler (Interrupt).Static then
c32d0452 841 -- Tries to detach a static Interrupt Handler.
842 -- raise a program error.
843
c32d0452 844 Raise_Exception (Program_Error'Identity,
845 "Trying to detach a static Interrupt Handler");
846 end if;
847
848 -- The interrupt should no longer be ignored if
849 -- it was ever ignored.
850
851 Ignored (Interrupt) := False;
852
853 Old_Handler := User_Handler (Interrupt).H;
854
855 -- The new handler
856
857 User_Handler (Interrupt).H := null;
858 User_Handler (Interrupt).Static := False;
859
860 if Old_Handler /= null then
861 Unbind_Handler (Interrupt);
862 end if;
863
864 end Unprotected_Detach_Handler;
865
866 ----------------------------------
867 -- Unprotected_Exchange_Handler --
868 ----------------------------------
869
870 procedure Unprotected_Exchange_Handler
871 (Old_Handler : out Parameterless_Handler;
9dfe12ae 872 New_Handler : Parameterless_Handler;
873 Interrupt : Interrupt_ID;
874 Static : Boolean;
875 Restoration : Boolean := False) is
c32d0452 876 begin
877 if User_Entry (Interrupt).T /= Null_Task then
9dfe12ae 878
c32d0452 879 -- In case we have an Interrupt Entry already installed.
880 -- raise a program error. (propagate it to the caller).
881
c32d0452 882 Raise_Exception (Program_Error'Identity,
883 "An interrupt is already installed");
884 end if;
885
9dfe12ae 886 -- Note : A null handler with Static = True will pass the
887 -- following check. That is the case when we want to Detach a
888 -- handler regardless of the Static status of the current_Handler.
889
c32d0452 890 -- We don't check anything if Restoration is True, since we
891 -- may be detaching a static handler to restore a dynamic one.
892
893 if not Restoration and then not Static
894
895 -- Tries to overwrite a static Interrupt Handler with a
896 -- dynamic Handler
897
898 and then (User_Handler (Interrupt).Static
899
900 -- The new handler is not specified as an
901 -- Interrupt Handler by a pragma.
902
903 or else not Is_Registered (New_Handler))
904 then
c32d0452 905 Raise_Exception (Program_Error'Identity,
906 "Trying to overwrite a static Interrupt Handler with a " &
907 "dynamic Handler");
908 end if;
909
910 -- The interrupt should no longer be ingnored if
911 -- it was ever ignored.
912
913 Ignored (Interrupt) := False;
914
915 -- Save the old handler
916
917 Old_Handler := User_Handler (Interrupt).H;
918
919 -- The new handler
920
921 User_Handler (Interrupt).H := New_Handler;
922
923 if New_Handler = null then
924
925 -- The null handler means we are detaching the handler.
926
927 User_Handler (Interrupt).Static := False;
928
929 else
930 User_Handler (Interrupt).Static := Static;
931 end if;
932
933 -- Invoke a corresponding Server_Task if not yet created.
934 -- Place Task_ID info in Server_ID array.
935
936 if Server_ID (Interrupt) = Null_Task then
937
938 -- When a new Server_Task is created, it should have its
939 -- signal mask set to the All_Tasks_Mask.
940
941 IMOP.Set_Interrupt_Mask
942 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
943 Access_Hold := new Server_Task (Interrupt);
944 IMOP.Set_Interrupt_Mask (Old_Mask'Access);
945
946 Server_ID (Interrupt) := To_System (Access_Hold.all'Identity);
947 end if;
948
949 if (New_Handler = null) then
950 if Old_Handler /= null then
951 Unbind_Handler (Interrupt);
952 end if;
953
954 return;
955 end if;
956
957 if Old_Handler = null then
958 Bind_Handler (Interrupt);
959 end if;
960
961 end Unprotected_Exchange_Handler;
962
963 -- Start of processing for Interrupt_Manager
964
965 begin
966 -- By making this task independent of master, when the process
967 -- goes away, the Interrupt_Manager will terminate gracefully.
968
969 System.Tasking.Utilities.Make_Independent;
970
f15731c4 971 -- Environment task gets its own interrupt mask, saves it,
c32d0452 972 -- and then masks all interrupts except the Keep_Unmasked set.
973
974 -- During rendezvous, the Interrupt_Manager receives the old
975 -- interrupt mask of the environment task, and sets its own
976 -- interrupt mask to that value.
977
978 -- The environment task will call the entry of Interrupt_Manager some
979 -- during elaboration of the body of this package.
980
981 accept Initialize (Mask : IMNG.Interrupt_Mask) do
982 declare
983 The_Mask : aliased IMNG.Interrupt_Mask;
984
985 begin
986 IMOP.Copy_Interrupt_Mask (The_Mask, Mask);
987 IMOP.Set_Interrupt_Mask (The_Mask'Access);
988 end;
989 end Initialize;
990
991 -- Note: All tasks in RTS will have all the Reserve Interrupts
992 -- being masked (except the Interrupt_Manager) and Keep_Unmasked
993 -- unmasked when created.
994
995 -- Abort_Task_Interrupt is one of the Interrupt unmasked
996 -- in all tasks. We mask the Interrupt in this particular task
9dfe12ae 997 -- so that "sigwait" is possible to catch an explicitely sent
c32d0452 998 -- Abort_Task_Interrupt from the Server_Tasks.
999
1000 -- This sigwaiting is needed so that we make sure a Server_Task is
1001 -- out of its own sigwait state. This extra synchronization is
1002 -- necessary to prevent following senarios.
1003
1004 -- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the
1005 -- Server_Task then changes its own interrupt mask (OS level).
1006 -- If an interrupt (corresponding to the Server_Task) arrives
1007 -- in the nean time we have the Interrupt_Manager umnasked and
1008 -- the Server_Task waiting on sigwait.
1009
1010 -- 2) For unbinding handler, we install a default action in the
1011 -- Interrupt_Manager. POSIX.1c states that the result of using
1012 -- "sigwait" and "sigaction" simaltaneously on the same interrupt
1013 -- is undefined. Therefore, we need to be informed from the
1014 -- Server_Task of the fact that the Server_Task is out of its
1015 -- sigwait stage.
1016
1017 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
1018 IMOP.Add_To_Interrupt_Mask
1019 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
1020 IMOP.Thread_Block_Interrupt
1021 (IMNG.Abort_Task_Interrupt);
1022
1023 loop
1024 -- A block is needed to absorb Program_Error exception
1025
c32d0452 1026 begin
1027 select
f15731c4 1028 accept Attach_Handler
1029 (New_Handler : in Parameterless_Handler;
1030 Interrupt : in Interrupt_ID;
1031 Static : in Boolean;
1032 Restoration : in Boolean := False)
1033 do
1034 Unprotected_Exchange_Handler
1035 (Old_Handler, New_Handler, Interrupt, Static, Restoration);
1036 end Attach_Handler;
1037
1038 or
1039 accept Exchange_Handler
1040 (Old_Handler : out Parameterless_Handler;
1041 New_Handler : in Parameterless_Handler;
1042 Interrupt : in Interrupt_ID;
1043 Static : in Boolean)
1044 do
1045 Unprotected_Exchange_Handler
1046 (Old_Handler, New_Handler, Interrupt, Static);
1047 end Exchange_Handler;
1048
1049 or
1050 accept Detach_Handler
1051 (Interrupt : in Interrupt_ID;
1052 Static : in Boolean)
1053 do
1054 Unprotected_Detach_Handler (Interrupt, Static);
1055 end Detach_Handler;
1056
1057 or
1058 accept Bind_Interrupt_To_Entry
1059 (T : Task_ID;
1060 E : Task_Entry_Index;
1061 Interrupt : Interrupt_ID)
1062 do
1063 -- if there is a binding already (either a procedure or an
1064 -- entry), raise Program_Error (propagate it to the caller).
1065
1066 if User_Handler (Interrupt).H /= null
1067 or else User_Entry (Interrupt).T /= Null_Task
1068 then
1069 Raise_Exception (Program_Error'Identity,
1070 "A binding for this interrupt is already present");
c32d0452 1071 end if;
c32d0452 1072
f15731c4 1073 -- The interrupt should no longer be ingnored if
1074 -- it was ever ignored.
c32d0452 1075
f15731c4 1076 Ignored (Interrupt) := False;
9dfe12ae 1077 User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
c32d0452 1078
f15731c4 1079 -- Indicate the attachment of Interrupt Entry in ATCB.
1080 -- This is need so that when an Interrupt Entry task
1081 -- terminates the binding can be cleaned. The call to
1082 -- unbinding must be made by the task before it terminates.
c32d0452 1083
f15731c4 1084 T.Interrupt_Entry := True;
c32d0452 1085
f15731c4 1086 -- Invoke a corresponding Server_Task if not yet created.
1087 -- Place Task_ID info in Server_ID array.
c32d0452 1088
f15731c4 1089 if Server_ID (Interrupt) = Null_Task then
1090 -- When a new Server_Task is created, it should have its
1091 -- signal mask set to the All_Tasks_Mask.
c32d0452 1092
f15731c4 1093 IMOP.Set_Interrupt_Mask
1094 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
1095 Access_Hold := new Server_Task (Interrupt);
1096 IMOP.Set_Interrupt_Mask (Old_Mask'Access);
1097 Server_ID (Interrupt) :=
1098 To_System (Access_Hold.all'Identity);
1099 end if;
c32d0452 1100
f15731c4 1101 Bind_Handler (Interrupt);
1102 end Bind_Interrupt_To_Entry;
1103
1104 or
1105 accept Detach_Interrupt_Entries (T : Task_ID) do
1106 for J in Interrupt_ID'Range loop
1107 if not Is_Reserved (J) then
1108 if User_Entry (J).T = T then
1109 -- The interrupt should no longer be ingnored if
1110 -- it was ever ignored.
1111
1112 Ignored (J) := False;
1113 User_Entry (J) := Entry_Assoc'
1114 (T => Null_Task, E => Null_Task_Entry);
1115 Unbind_Handler (J);
1116 end if;
1117 end if;
1118 end loop;
c32d0452 1119
f15731c4 1120 -- Indicate in ATCB that no Interrupt Entries are attached.
c32d0452 1121
f15731c4 1122 T.Interrupt_Entry := False;
1123 end Detach_Interrupt_Entries;
c32d0452 1124
f15731c4 1125 or
1126 accept Block_Interrupt (Interrupt : Interrupt_ID) do
1127 if Blocked (Interrupt) then
1128 return;
1129 end if;
c32d0452 1130
f15731c4 1131 Blocked (Interrupt) := True;
1132 Last_Unblocker (Interrupt) := Null_Task;
c32d0452 1133
f15731c4 1134 -- Mask this task for the given Interrupt so that all tasks
1135 -- are masked for the Interrupt.
c32d0452 1136
f15731c4 1137 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
c32d0452 1138
f15731c4 1139 if User_Handler (Interrupt).H /= null
1140 or else User_Entry (Interrupt).T /= Null_Task
1141 then
1142 -- This is the case where the Server_Task is waiting on
1143 -- "sigwait." Wake it up by sending an
1144 -- Abort_Task_Interrupt so that the Server_Task waits on
1145 -- Cond.
c32d0452 1146
f15731c4 1147 POP.Abort_Task (Server_ID (Interrupt));
c32d0452 1148
f15731c4 1149 -- Make sure corresponding Server_Task is out of its own
1150 -- sigwait state.
c32d0452 1151
f15731c4 1152 Ret_Interrupt := Interrupt_ID
1153 (IMOP.Interrupt_Wait (Intwait_Mask'Access));
1154 pragma Assert
1155 (Ret_Interrupt =
1156 Interrupt_ID (IMNG.Abort_Task_Interrupt));
1157 end if;
1158 end Block_Interrupt;
c32d0452 1159
f15731c4 1160 or
1161 accept Unblock_Interrupt (Interrupt : Interrupt_ID) do
1162 if not Blocked (Interrupt) then
1163 return;
1164 end if;
c32d0452 1165
f15731c4 1166 Blocked (Interrupt) := False;
1167 Last_Unblocker (Interrupt) :=
1168 To_System (Unblock_Interrupt'Caller);
1169
1170 if User_Handler (Interrupt).H = null
1171 and then User_Entry (Interrupt).T = Null_Task
1172 then
1173 -- No handler is attached. Unmask the Interrupt so that
1174 -- the default action can be carried out.
1175 IMOP.Thread_Unblock_Interrupt
1176 (IMNG.Interrupt_ID (Interrupt));
1177
1178 else
1179 -- The Server_Task must be waiting on the Cond variable
1180 -- since it was being blocked and an Interrupt Hander or
1181 -- an Entry was there. Wake it up and let it change
1182 -- it place of waiting according to its new state.
1183 POP.Wakeup (Server_ID (Interrupt),
1184 Interrupt_Server_Blocked_Interrupt_Sleep);
1185 end if;
1186 end Unblock_Interrupt;
c32d0452 1187
f15731c4 1188 or
1189 accept Ignore_Interrupt (Interrupt : Interrupt_ID) do
1190 if Ignored (Interrupt) then
1191 return;
1192 end if;
c32d0452 1193
f15731c4 1194 Ignored (Interrupt) := True;
c32d0452 1195
f15731c4 1196 -- If there is a handler associated with the Interrupt,
1197 -- detach it first. In this way we make sure that the
1198 -- Server_Task is not on sigwait. This is legal since
1199 -- Unignore_Interrupt is to install the default action.
c32d0452 1200
f15731c4 1201 if User_Handler (Interrupt).H /= null then
1202 Unprotected_Detach_Handler
1203 (Interrupt => Interrupt, Static => True);
c32d0452 1204
f15731c4 1205 elsif User_Entry (Interrupt).T /= Null_Task then
1206 User_Entry (Interrupt) := Entry_Assoc'
1207 (T => Null_Task, E => Null_Task_Entry);
1208 Unbind_Handler (Interrupt);
1209 end if;
c32d0452 1210
f15731c4 1211 IMOP.Install_Ignore_Action (IMNG.Interrupt_ID (Interrupt));
1212 end Ignore_Interrupt;
c32d0452 1213
f15731c4 1214 or
1215 accept Unignore_Interrupt (Interrupt : Interrupt_ID) do
1216 Ignored (Interrupt) := False;
c32d0452 1217
f15731c4 1218 -- If there is a handler associated with the Interrupt,
1219 -- detach it first. In this way we make sure that the
1220 -- Server_Task is not on sigwait. This is legal since
1221 -- Unignore_Interrupt is to install the default action.
c32d0452 1222
f15731c4 1223 if User_Handler (Interrupt).H /= null then
1224 Unprotected_Detach_Handler
1225 (Interrupt => Interrupt, Static => True);
c32d0452 1226
f15731c4 1227 elsif User_Entry (Interrupt).T /= Null_Task then
1228 User_Entry (Interrupt) := Entry_Assoc'
1229 (T => Null_Task, E => Null_Task_Entry);
1230 Unbind_Handler (Interrupt);
1231 end if;
c32d0452 1232
f15731c4 1233 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
1234 end Unignore_Interrupt;
c32d0452 1235 end select;
1236
1237 exception
c32d0452 1238 -- If there is a program error we just want to propagate it to
1239 -- the caller and do not want to stop this task.
1240
1241 when Program_Error =>
1242 null;
1243
1244 when others =>
f15731c4 1245 pragma Assert (False);
c32d0452 1246 null;
1247 end;
c32d0452 1248 end loop;
c32d0452 1249 end Interrupt_Manager;
1250
1251 -----------------
1252 -- Server_Task --
1253 -----------------
1254
1255 task body Server_Task is
1256 Intwait_Mask : aliased IMNG.Interrupt_Mask;
1257 Ret_Interrupt : Interrupt_ID;
1258 Self_ID : Task_ID := Self;
1259 Tmp_Handler : Parameterless_Handler;
1260 Tmp_ID : Task_ID;
1261 Tmp_Entry_Index : Task_Entry_Index;
1262
1263 begin
1264 -- By making this task independent of master, when the process
1265 -- goes away, the Server_Task will terminate gracefully.
1266
1267 System.Tasking.Utilities.Make_Independent;
1268
1269 -- Install default action in system level.
1270
1271 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
1272
1273 -- Note: All tasks in RTS will have all the Reserve Interrupts
1274 -- being masked (except the Interrupt_Manager) and Keep_Unmasked
1275 -- unmasked when created.
1276
1277 -- Abort_Task_Interrupt is one of the Interrupt unmasked
1278 -- in all tasks. We mask the Interrupt in this particular task
9dfe12ae 1279 -- so that "sigwait" is possible to catch an explicitely sent
c32d0452 1280 -- Abort_Task_Interrupt from the Interrupt_Manager.
1281
1282 -- There are two Interrupt interrupts that this task catch through
1283 -- "sigwait." One is the Interrupt this task is designated to catch
1284 -- in order to execure user handler or entry. The other one is the
1285 -- Abort_Task_Interrupt. This interrupt is being sent from the
1286 -- Interrupt_Manager to inform status changes (e.g: become Blocked,
1287 -- Handler or Entry is to be detached).
1288
1289 -- Prepare a mask to used for sigwait.
1290
1291 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
1292
1293 IMOP.Add_To_Interrupt_Mask
1294 (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt));
1295
1296 IMOP.Add_To_Interrupt_Mask
1297 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
1298
1299 IMOP.Thread_Block_Interrupt
1300 (IMNG.Abort_Task_Interrupt);
1301
1302 PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID);
1303
1304 loop
1305 System.Tasking.Initialization.Defer_Abort (Self_ID);
f15731c4 1306
1307 if Single_Lock then
1308 POP.Lock_RTS;
1309 end if;
1310
c32d0452 1311 POP.Write_Lock (Self_ID);
1312
1313 if User_Handler (Interrupt).H = null
1314 and then User_Entry (Interrupt).T = Null_Task
1315 then
1316 -- No Interrupt binding. If there is an interrupt,
1317 -- Interrupt_Manager will take default action.
1318
1319 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
1320 POP.Sleep (Self_ID, Interrupt_Server_Idle_Sleep);
1321 Self_ID.Common.State := Runnable;
1322
1323 elsif Blocked (Interrupt) then
1324
1325 -- Interrupt is blocked. Stay here, so we won't catch
1326 -- the Interrupt.
1327
1328 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
1329 POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep);
1330 Self_ID.Common.State := Runnable;
1331
1332 else
1333 -- A Handler or an Entry is installed. At this point all tasks
1334 -- mask for the Interrupt is masked. Catch the Interrupt using
1335 -- sigwait.
1336
1337 -- This task may wake up from sigwait by receiving an interrupt
1338 -- (Abort_Task_Interrupt) from the Interrupt_Manager for unbinding
1339 -- a Procedure Handler or an Entry. Or it could be a wake up
1340 -- from status change (Unblocked -> Blocked). If that is not
1341 -- the case, we should exceute the attached Procedure or Entry.
1342
1343 POP.Unlock (Self_ID);
1344
f15731c4 1345 if Single_Lock then
1346 POP.Unlock_RTS;
1347 end if;
1348
c32d0452 1349 Ret_Interrupt :=
1350 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
1351
1352 if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then
1353
1354 -- Inform the Interrupt_Manager of wakeup from above sigwait.
1355
1356 POP.Abort_Task (Interrupt_Manager_ID);
f15731c4 1357
1358 if Single_Lock then
1359 POP.Lock_RTS;
1360 end if;
1361
c32d0452 1362 POP.Write_Lock (Self_ID);
1363
1364 else
1365 pragma Assert (Ret_Interrupt = Interrupt);
1366
f15731c4 1367 if Single_Lock then
1368 POP.Lock_RTS;
1369 end if;
1370
c32d0452 1371 POP.Write_Lock (Self_ID);
1372
1373 -- Even though we have received an Interrupt the status may
1374 -- have changed already before we got the Self_ID lock above.
1375 -- Therefore we make sure a Handler or an Entry is still
1376 -- there and make appropriate call.
1377 -- If there is no calls to make we need to regenerate the
1378 -- Interrupt in order not to lose it.
1379
1380 if User_Handler (Interrupt).H /= null then
1381 Tmp_Handler := User_Handler (Interrupt).H;
1382
1383 -- RTS calls should not be made with self being locked.
1384
1385 POP.Unlock (Self_ID);
1386
f15731c4 1387 if Single_Lock then
1388 POP.Unlock_RTS;
1389 end if;
1390
c32d0452 1391 Tmp_Handler.all;
f15731c4 1392
1393 if Single_Lock then
1394 POP.Lock_RTS;
1395 end if;
1396
c32d0452 1397 POP.Write_Lock (Self_ID);
1398
1399 elsif User_Entry (Interrupt).T /= Null_Task then
1400 Tmp_ID := User_Entry (Interrupt).T;
1401 Tmp_Entry_Index := User_Entry (Interrupt).E;
1402
1403 -- RTS calls should not be made with self being locked.
1404
f15731c4 1405 if Single_Lock then
1406 POP.Unlock_RTS;
1407 end if;
1408
c32d0452 1409 POP.Unlock (Self_ID);
1410
1411 System.Tasking.Rendezvous.Call_Simple
1412 (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
1413
1414 POP.Write_Lock (Self_ID);
f15731c4 1415
1416 if Single_Lock then
1417 POP.Lock_RTS;
1418 end if;
1419
c32d0452 1420 else
1421 -- This is a situation that this task wake up
1422 -- receiving an Interrupt and before it get the lock
1423 -- the Interrupt is blocked. We do not
1424 -- want to lose the interrupt in this case so that
1425 -- regenerate the Interrupt to process level;
1426
1427 IMOP.Interrupt_Self_Process (IMNG.Interrupt_ID (Interrupt));
1428 end if;
1429 end if;
c32d0452 1430 end if;
1431
1432 POP.Unlock (Self_ID);
f15731c4 1433
1434 if Single_Lock then
1435 POP.Unlock_RTS;
1436 end if;
1437
c32d0452 1438 System.Tasking.Initialization.Undefer_Abort (Self_ID);
1439
1440 -- Undefer abort here to allow a window for this task
1441 -- to be aborted at the time of system shutdown.
1442 end loop;
c32d0452 1443 end Server_Task;
1444
1445-- Elaboration code for package System.Interrupts
1446
1447begin
1448
1449 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
1450
1451 Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
1452
c32d0452 1453 -- During the elaboration of this package body we want RTS to
1454 -- inherit the interrupt mask from the Environment Task.
1455
1456 -- The Environment Task should have gotten its mask from
1457 -- the enclosing process during the RTS start up. (See
1458 -- in s-inmaop.adb). Pass the Interrupt_Mask of the Environment
1459 -- task to the Interrupt_Manager.
1460
1461 -- Note : At this point we know that all tasks (including
1462 -- RTS internal servers) are masked for non-reserved signals
1463 -- (see s-taprop.adb). Only the Interrupt_Manager will have
1464 -- masks set up differently inheriting the original Environment
1465 -- Task's mask.
1466
1467 Interrupt_Manager.Initialize (IMOP.Environment_Mask);
1468end System.Interrupts;
Mirror of https://gcc.gnu.org/git/gcc.git