OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [ada/] [s-interr.adb] - Blame information for rev 384

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.