OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-interr.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 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
      function State
371
        (Int : System.Interrupt_Management.Interrupt_ID) return Character;
372
      pragma Import (C, State, "__gnat_get_interrupt_state");
373
      --  Get interrupt state for interrupt number Int. Defined in init.c
374
 
375
      Default : constant Character := 's';
376
      --    's'   Interrupt_State pragma set state to System (use "default"
377
      --           system handler)
378
 
379
   begin
380
      --  ??? loop to be executed only when we're not doing library level
381
      --  finalization, since in this case all interrupt tasks are gone.
382
 
383
      --  If the Abort_Task signal is set to system, it means that we cannot
384
      --  reset interrupt handlers since this would require sending the abort
385
      --  signal to the Server_Task
386
 
387
      if not Interrupt_Manager'Terminated
388
        and then State (System.Interrupt_Management.Abort_Task_Interrupt)
389
                  /= Default
390
      then
391
         for N in reverse Object.Previous_Handlers'Range loop
392
            Interrupt_Manager.Attach_Handler
393
              (New_Handler => Object.Previous_Handlers (N).Handler,
394
               Interrupt   => Object.Previous_Handlers (N).Interrupt,
395
               Static      => Object.Previous_Handlers (N).Static,
396
               Restoration => True);
397
         end loop;
398
      end if;
399
 
400
      Tasking.Protected_Objects.Entries.Finalize
401
        (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
402
   end Finalize;
403
 
404
   -------------------------------------
405
   -- Has_Interrupt_Or_Attach_Handler --
406
   -------------------------------------
407
 
408
   --  Need comments as to why these always return True ???
409
 
410
   function Has_Interrupt_Or_Attach_Handler
411
     (Object : access Dynamic_Interrupt_Protection) return Boolean
412
   is
413
      pragma Unreferenced (Object);
414
   begin
415
      return True;
416
   end Has_Interrupt_Or_Attach_Handler;
417
 
418
   function Has_Interrupt_Or_Attach_Handler
419
     (Object : access Static_Interrupt_Protection) return Boolean
420
   is
421
      pragma Unreferenced (Object);
422
   begin
423
      return True;
424
   end Has_Interrupt_Or_Attach_Handler;
425
 
426
   ----------------------
427
   -- Ignore_Interrupt --
428
   ----------------------
429
 
430
   procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
431
   begin
432
      if Is_Reserved (Interrupt) then
433
         raise Program_Error with
434
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
435
      end if;
436
 
437
      Interrupt_Manager.Ignore_Interrupt (Interrupt);
438
   end Ignore_Interrupt;
439
 
440
   ----------------------
441
   -- Install_Handlers --
442
   ----------------------
443
 
444
   procedure Install_Handlers
445
     (Object       : access Static_Interrupt_Protection;
446
      New_Handlers : New_Handler_Array)
447
   is
448
   begin
449
      for N in New_Handlers'Range loop
450
 
451
         --  We need a lock around this ???
452
 
453
         Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
454
         Object.Previous_Handlers (N).Static    := User_Handler
455
           (New_Handlers (N).Interrupt).Static;
456
 
457
         --  We call Exchange_Handler and not directly Interrupt_Manager.
458
         --  Exchange_Handler so we get the Is_Reserved check.
459
 
460
         Exchange_Handler
461
           (Old_Handler => Object.Previous_Handlers (N).Handler,
462
            New_Handler => New_Handlers (N).Handler,
463
            Interrupt   => New_Handlers (N).Interrupt,
464
            Static      => True);
465
      end loop;
466
   end Install_Handlers;
467
 
468
   ---------------------------------
469
   -- Install_Restricted_Handlers --
470
   ---------------------------------
471
 
472
   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
473
   begin
474
      for N in Handlers'Range loop
475
         Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
476
      end loop;
477
   end Install_Restricted_Handlers;
478
 
479
   ----------------
480
   -- Is_Blocked --
481
   ----------------
482
 
483
   function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
484
   begin
485
      if Is_Reserved (Interrupt) then
486
         raise Program_Error with
487
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
488
      end if;
489
 
490
      return Blocked (Interrupt);
491
   end Is_Blocked;
492
 
493
   -----------------------
494
   -- Is_Entry_Attached --
495
   -----------------------
496
 
497
   function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
498
   begin
499
      if Is_Reserved (Interrupt) then
500
         raise Program_Error with
501
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
502
      end if;
503
 
504
      return User_Entry (Interrupt).T /= Null_Task;
505
   end Is_Entry_Attached;
506
 
507
   -------------------------
508
   -- Is_Handler_Attached --
509
   -------------------------
510
 
511
   function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
512
   begin
513
      if Is_Reserved (Interrupt) then
514
         raise Program_Error with
515
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
516
      end if;
517
 
518
      return User_Handler (Interrupt).H /= null;
519
   end Is_Handler_Attached;
520
 
521
   ----------------
522
   -- Is_Ignored --
523
   ----------------
524
 
525
   function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
526
   begin
527
      if Is_Reserved (Interrupt) then
528
         raise Program_Error with
529
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
530
      end if;
531
 
532
      return Ignored (Interrupt);
533
   end Is_Ignored;
534
 
535
   -------------------
536
   -- Is_Registered --
537
   -------------------
538
 
539
   function Is_Registered (Handler : Parameterless_Handler) return Boolean is
540
 
541
      type Fat_Ptr is record
542
         Object_Addr  : System.Address;
543
         Handler_Addr : System.Address;
544
      end record;
545
 
546
      function To_Fat_Ptr is new Ada.Unchecked_Conversion
547
        (Parameterless_Handler, Fat_Ptr);
548
 
549
      Ptr : R_Link;
550
      Fat : Fat_Ptr;
551
 
552
   begin
553
      if Handler = null then
554
         return True;
555
      end if;
556
 
557
      Fat := To_Fat_Ptr (Handler);
558
 
559
      Ptr := Registered_Handler_Head;
560
 
561
      while Ptr /= null loop
562
         if Ptr.H = Fat.Handler_Addr then
563
            return True;
564
         end if;
565
 
566
         Ptr := Ptr.Next;
567
      end loop;
568
 
569
      return False;
570
   end Is_Registered;
571
 
572
   -----------------
573
   -- Is_Reserved --
574
   -----------------
575
 
576
   function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
577
   begin
578
      return IMNG.Reserve (IMNG.Interrupt_ID (Interrupt));
579
   end Is_Reserved;
580
 
581
   ---------------
582
   -- Reference --
583
   ---------------
584
 
585
   function Reference (Interrupt : Interrupt_ID) return System.Address is
586
   begin
587
      if Is_Reserved (Interrupt) then
588
         raise Program_Error with
589
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
590
      end if;
591
 
592
      return Storage_Elements.To_Address
593
        (Storage_Elements.Integer_Address (Interrupt));
594
   end Reference;
595
 
596
   ---------------------------------
597
   -- Register_Interrupt_Handler  --
598
   ---------------------------------
599
 
600
   procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
601
      New_Node_Ptr : R_Link;
602
 
603
   begin
604
      --  This routine registers the Handler as usable for Dynamic Interrupt
605
      --  Handler. Routines attaching and detaching Handler dynamically should
606
      --  first consult if the Handler is registered. A Program Error should
607
      --  be raised if it is not registered.
608
 
609
      --  The pragma Interrupt_Handler can only appear in the library level PO
610
      --  definition and instantiation. Therefore, we do not need to implement
611
      --  Unregistering operation. Neither we need to protect the queue
612
      --  structure using a Lock.
613
 
614
      pragma Assert (Handler_Addr /= System.Null_Address);
615
 
616
      New_Node_Ptr := new Registered_Handler;
617
      New_Node_Ptr.H := Handler_Addr;
618
 
619
      if Registered_Handler_Head = null then
620
         Registered_Handler_Head := New_Node_Ptr;
621
         Registered_Handler_Tail := New_Node_Ptr;
622
 
623
      else
624
         Registered_Handler_Tail.Next := New_Node_Ptr;
625
         Registered_Handler_Tail := New_Node_Ptr;
626
      end if;
627
   end Register_Interrupt_Handler;
628
 
629
   -----------------------
630
   -- Unblock_Interrupt --
631
   -----------------------
632
 
633
   procedure Unblock_Interrupt (Interrupt : Interrupt_ID) 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
      Interrupt_Manager.Unblock_Interrupt (Interrupt);
641
   end Unblock_Interrupt;
642
 
643
   ------------------
644
   -- Unblocked_By --
645
   ------------------
646
 
647
   function Unblocked_By
648
     (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
649
   is
650
   begin
651
      if Is_Reserved (Interrupt) then
652
         raise Program_Error with
653
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
654
      end if;
655
 
656
      return Last_Unblocker (Interrupt);
657
   end Unblocked_By;
658
 
659
   ------------------------
660
   -- Unignore_Interrupt --
661
   ------------------------
662
 
663
   procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
664
   begin
665
      if Is_Reserved (Interrupt) then
666
         raise Program_Error with
667
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
668
      end if;
669
 
670
      Interrupt_Manager.Unignore_Interrupt (Interrupt);
671
   end Unignore_Interrupt;
672
 
673
   -----------------------
674
   -- Interrupt_Manager --
675
   -----------------------
676
 
677
   task body Interrupt_Manager is
678
 
679
      ---------------------
680
      -- Local Variables --
681
      ---------------------
682
 
683
      Intwait_Mask  : aliased IMNG.Interrupt_Mask;
684
      Ret_Interrupt : Interrupt_ID;
685
      Old_Mask      : aliased IMNG.Interrupt_Mask;
686
      Old_Handler   : Parameterless_Handler;
687
 
688
      --------------------
689
      -- Local Routines --
690
      --------------------
691
 
692
      procedure Bind_Handler (Interrupt : Interrupt_ID);
693
      --  This procedure does not do anything if the Interrupt is blocked.
694
      --  Otherwise, we have to interrupt Server_Task for status change through
695
      --  Wakeup interrupt.
696
 
697
      procedure Unbind_Handler (Interrupt : Interrupt_ID);
698
      --  This procedure does not do anything if the Interrupt is blocked.
699
      --  Otherwise, we have to interrupt Server_Task for status change
700
      --  through abort interrupt.
701
 
702
      procedure Unprotected_Exchange_Handler
703
        (Old_Handler : out Parameterless_Handler;
704
         New_Handler : Parameterless_Handler;
705
         Interrupt   : Interrupt_ID;
706
         Static      : Boolean;
707
         Restoration : Boolean := False);
708
 
709
      procedure Unprotected_Detach_Handler
710
        (Interrupt   : Interrupt_ID;
711
         Static      : Boolean);
712
 
713
      ------------------
714
      -- Bind_Handler --
715
      ------------------
716
 
717
      procedure Bind_Handler (Interrupt : Interrupt_ID) is
718
      begin
719
         if not Blocked (Interrupt) then
720
 
721
            --  Mask this task for the given Interrupt so that all tasks
722
            --  are masked for the Interrupt and the actual delivery of the
723
            --  Interrupt will be caught using "sigwait" by the
724
            --  corresponding Server_Task.
725
 
726
            IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
727
 
728
            --  We have installed a Handler or an Entry before we called
729
            --  this procedure. If the Handler Task is waiting to be awakened,
730
            --  do it here. Otherwise, the interrupt will be discarded.
731
 
732
            POP.Wakeup (Server_ID (Interrupt), Interrupt_Server_Idle_Sleep);
733
         end if;
734
      end Bind_Handler;
735
 
736
      --------------------
737
      -- Unbind_Handler --
738
      --------------------
739
 
740
      procedure Unbind_Handler (Interrupt : Interrupt_ID) is
741
         Server : System.Tasking.Task_Id;
742
      begin
743
         if not Blocked (Interrupt) then
744
            --  Currently, there is a Handler or an Entry attached and
745
            --  corresponding Server_Task is waiting on "sigwait."
746
            --  We have to wake up the Server_Task and make it
747
            --  wait on condition variable by sending an
748
            --  Abort_Task_Interrupt
749
 
750
            Server := Server_ID (Interrupt);
751
 
752
            case Server.Common.State is
753
               when Interrupt_Server_Idle_Sleep |
754
                    Interrupt_Server_Blocked_Interrupt_Sleep
755
               =>
756
                  POP.Wakeup (Server, Server.Common.State);
757
 
758
               when Interrupt_Server_Blocked_On_Event_Flag =>
759
                  POP.Abort_Task (Server);
760
 
761
                  --  Make sure corresponding Server_Task is out of its
762
                  --  own sigwait state.
763
 
764
                  Ret_Interrupt :=
765
                    Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
766
                  pragma Assert
767
                    (Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt));
768
 
769
               when Runnable =>
770
                  null;
771
 
772
               when others =>
773
                  pragma Assert (False);
774
                  null;
775
            end case;
776
 
777
            IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
778
 
779
            --  Unmake the Interrupt for this task in order to allow default
780
            --  action again.
781
 
782
            IMOP.Thread_Unblock_Interrupt (IMNG.Interrupt_ID (Interrupt));
783
 
784
         else
785
            IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
786
         end if;
787
      end Unbind_Handler;
788
 
789
      --------------------------------
790
      -- Unprotected_Detach_Handler --
791
      --------------------------------
792
 
793
      procedure Unprotected_Detach_Handler
794
        (Interrupt   : Interrupt_ID;
795
         Static      : Boolean)
796
      is
797
         Old_Handler : Parameterless_Handler;
798
 
799
      begin
800
         if User_Entry (Interrupt).T /= Null_Task then
801
 
802
            --  In case we have an Interrupt Entry installed.
803
            --  raise a program error. (propagate it to the caller).
804
 
805
            raise Program_Error with
806
              "An interrupt entry is already installed";
807
         end if;
808
 
809
         --  Note : Static = True will pass the following check. That is the
810
         --  case when we want to detach a handler regardless of the static
811
         --  status of the current_Handler.
812
 
813
         if not Static and then User_Handler (Interrupt).Static then
814
 
815
            --  Tries to detach a static Interrupt Handler.
816
            --  raise a program error.
817
 
818
            raise Program_Error with
819
              "Trying to detach a static Interrupt Handler";
820
         end if;
821
 
822
         --  The interrupt should no longer be ignored if
823
         --  it was ever ignored.
824
 
825
         Ignored (Interrupt) := False;
826
 
827
         Old_Handler := User_Handler (Interrupt).H;
828
 
829
         --  The new handler
830
 
831
         User_Handler (Interrupt).H := null;
832
         User_Handler (Interrupt).Static := False;
833
 
834
         if Old_Handler /= null then
835
            Unbind_Handler (Interrupt);
836
         end if;
837
      end Unprotected_Detach_Handler;
838
 
839
      ----------------------------------
840
      -- Unprotected_Exchange_Handler --
841
      ----------------------------------
842
 
843
      procedure Unprotected_Exchange_Handler
844
        (Old_Handler : out Parameterless_Handler;
845
         New_Handler : Parameterless_Handler;
846
         Interrupt   : Interrupt_ID;
847
         Static      : Boolean;
848
         Restoration : Boolean := False)
849
      is
850
      begin
851
         if User_Entry (Interrupt).T /= Null_Task then
852
 
853
            --  In case we have an Interrupt Entry already installed.
854
            --  raise a program error. (propagate it to the caller).
855
 
856
            raise Program_Error with
857
              "An interrupt is already installed";
858
         end if;
859
 
860
         --  Note : A null handler with Static = True will pass the
861
         --  following check. That is the case when we want to Detach a
862
         --  handler regardless of the Static status of the current_Handler.
863
 
864
         --  We don't check anything if Restoration is True, since we
865
         --  may be detaching a static handler to restore a dynamic one.
866
 
867
         if not Restoration and then not Static
868
 
869
            --  Tries to overwrite a static Interrupt Handler with a
870
            --  dynamic Handler
871
 
872
           and then (User_Handler (Interrupt).Static
873
 
874
                        --  The new handler is not specified as an
875
                        --  Interrupt Handler by a pragma.
876
 
877
                        or else not Is_Registered (New_Handler))
878
         then
879
            raise Program_Error with
880
              "Trying to overwrite a static Interrupt Handler with a " &
881
              "dynamic Handler";
882
         end if;
883
 
884
         --  The interrupt should no longer be ignored if
885
         --  it was ever ignored.
886
 
887
         Ignored (Interrupt) := False;
888
 
889
         --  Save the old handler
890
 
891
         Old_Handler := User_Handler (Interrupt).H;
892
 
893
         --  The new handler
894
 
895
         User_Handler (Interrupt).H := New_Handler;
896
 
897
         if New_Handler = null then
898
 
899
            --  The null handler means we are detaching the handler
900
 
901
            User_Handler (Interrupt).Static := False;
902
 
903
         else
904
            User_Handler (Interrupt).Static := Static;
905
         end if;
906
 
907
         --  Invoke a corresponding Server_Task if not yet created.
908
         --  Place Task_Id info in Server_ID array.
909
 
910
         if Server_ID (Interrupt) = Null_Task then
911
 
912
            --  When a new Server_Task is created, it should have its
913
            --  signal mask set to the All_Tasks_Mask.
914
 
915
            IMOP.Set_Interrupt_Mask
916
              (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
917
            Access_Hold := new Server_Task (Interrupt);
918
            IMOP.Set_Interrupt_Mask (Old_Mask'Access);
919
 
920
            Server_ID (Interrupt) := To_System (Access_Hold.all'Identity);
921
         end if;
922
 
923
         if New_Handler = null then
924
            if Old_Handler /= null then
925
               Unbind_Handler (Interrupt);
926
            end if;
927
 
928
            return;
929
         end if;
930
 
931
         if Old_Handler = null then
932
            Bind_Handler (Interrupt);
933
         end if;
934
      end Unprotected_Exchange_Handler;
935
 
936
   --  Start of processing for Interrupt_Manager
937
 
938
   begin
939
      --  By making this task independent of master, when the process
940
      --  goes away, the Interrupt_Manager will terminate gracefully.
941
 
942
      System.Tasking.Utilities.Make_Independent;
943
 
944
      --  Environment task gets its own interrupt mask, saves it,
945
      --  and then masks all interrupts except the Keep_Unmasked set.
946
 
947
      --  During rendezvous, the Interrupt_Manager receives the old
948
      --  interrupt mask of the environment task, and sets its own
949
      --  interrupt mask to that value.
950
 
951
      --  The environment task will call the entry of Interrupt_Manager some
952
      --  during elaboration of the body of this package.
953
 
954
      accept Initialize (Mask : IMNG.Interrupt_Mask) do
955
         declare
956
            The_Mask : aliased IMNG.Interrupt_Mask;
957
 
958
         begin
959
            IMOP.Copy_Interrupt_Mask (The_Mask, Mask);
960
            IMOP.Set_Interrupt_Mask (The_Mask'Access);
961
         end;
962
      end Initialize;
963
 
964
      --  Note: All tasks in RTS will have all the Reserve Interrupts
965
      --  being masked (except the Interrupt_Manager) and Keep_Unmasked
966
      --  unmasked when created.
967
 
968
      --  Abort_Task_Interrupt is one of the Interrupt unmasked
969
      --  in all tasks. We mask the Interrupt in this particular task
970
      --  so that "sigwait" is possible to catch an explicitly sent
971
      --  Abort_Task_Interrupt from the Server_Tasks.
972
 
973
      --  This sigwaiting is needed so that we make sure a Server_Task is
974
      --  out of its own sigwait state. This extra synchronization is
975
      --  necessary to prevent following scenarios.
976
 
977
      --   1) Interrupt_Manager sends an Abort_Task_Interrupt to the
978
      --      Server_Task then changes its own interrupt mask (OS level).
979
      --      If an interrupt (corresponding to the Server_Task) arrives
980
      --      in the mean time we have the Interrupt_Manager unmasked and
981
      --      the Server_Task waiting on sigwait.
982
 
983
      --   2) For unbinding handler, we install a default action in the
984
      --      Interrupt_Manager. POSIX.1c states that the result of using
985
      --      "sigwait" and "sigaction" simultaneously on the same interrupt
986
      --      is undefined. Therefore, we need to be informed from the
987
      --      Server_Task of the fact that the Server_Task is out of its
988
      --      sigwait stage.
989
 
990
      IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
991
      IMOP.Add_To_Interrupt_Mask
992
        (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
993
      IMOP.Thread_Block_Interrupt
994
        (IMNG.Abort_Task_Interrupt);
995
 
996
      loop
997
         --  A block is needed to absorb Program_Error exception
998
 
999
         begin
1000
            select
1001
               accept Attach_Handler
1002
                  (New_Handler : Parameterless_Handler;
1003
                   Interrupt   : Interrupt_ID;
1004
                   Static      : Boolean;
1005
                   Restoration : Boolean := False)
1006
               do
1007
                  Unprotected_Exchange_Handler
1008
                    (Old_Handler, New_Handler, Interrupt, Static, Restoration);
1009
               end Attach_Handler;
1010
 
1011
            or
1012
               accept Exchange_Handler
1013
                  (Old_Handler : out Parameterless_Handler;
1014
                   New_Handler : Parameterless_Handler;
1015
                   Interrupt   : Interrupt_ID;
1016
                   Static      : Boolean)
1017
               do
1018
                  Unprotected_Exchange_Handler
1019
                    (Old_Handler, New_Handler, Interrupt, Static);
1020
               end Exchange_Handler;
1021
 
1022
            or
1023
               accept Detach_Handler
1024
                 (Interrupt   : Interrupt_ID;
1025
                  Static      : Boolean)
1026
               do
1027
                  Unprotected_Detach_Handler (Interrupt, Static);
1028
               end Detach_Handler;
1029
 
1030
            or
1031
               accept Bind_Interrupt_To_Entry
1032
                 (T       : Task_Id;
1033
                  E       : Task_Entry_Index;
1034
                  Interrupt : Interrupt_ID)
1035
               do
1036
                  --  if there is a binding already (either a procedure or an
1037
                  --  entry), raise Program_Error (propagate it to the caller).
1038
 
1039
                  if User_Handler (Interrupt).H /= null
1040
                    or else User_Entry (Interrupt).T /= Null_Task
1041
                  then
1042
                     raise Program_Error with
1043
                       "A binding for this interrupt is already present";
1044
                  end if;
1045
 
1046
                  --  The interrupt should no longer be ignored if
1047
                  --  it was ever ignored.
1048
 
1049
                  Ignored (Interrupt) := False;
1050
                  User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
1051
 
1052
                  --  Indicate the attachment of Interrupt Entry in ATCB.
1053
                  --  This is need so that when an Interrupt Entry task
1054
                  --  terminates the binding can be cleaned. The call to
1055
                  --  unbinding must be made by the task before it terminates.
1056
 
1057
                  T.Interrupt_Entry := True;
1058
 
1059
                  --  Invoke a corresponding Server_Task if not yet created.
1060
                  --  Place Task_Id info in Server_ID array.
1061
 
1062
                  if Server_ID (Interrupt) = Null_Task then
1063
 
1064
                     --  When a new Server_Task is created, it should have its
1065
                     --  signal mask set to the All_Tasks_Mask.
1066
 
1067
                     IMOP.Set_Interrupt_Mask
1068
                       (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
1069
                     Access_Hold := new Server_Task (Interrupt);
1070
                     IMOP.Set_Interrupt_Mask (Old_Mask'Access);
1071
                     Server_ID (Interrupt) :=
1072
                       To_System (Access_Hold.all'Identity);
1073
                  end if;
1074
 
1075
                  Bind_Handler (Interrupt);
1076
               end Bind_Interrupt_To_Entry;
1077
 
1078
            or
1079
               accept Detach_Interrupt_Entries (T : Task_Id) do
1080
                  for J in Interrupt_ID'Range loop
1081
                     if not Is_Reserved (J) then
1082
                        if User_Entry (J).T = T then
1083
 
1084
                           --  The interrupt should no longer be ignored if
1085
                           --  it was ever ignored.
1086
 
1087
                           Ignored (J) := False;
1088
                           User_Entry (J) := Entry_Assoc'
1089
                             (T => Null_Task, E => Null_Task_Entry);
1090
                           Unbind_Handler (J);
1091
                        end if;
1092
                     end if;
1093
                  end loop;
1094
 
1095
                  --  Indicate in ATCB that no Interrupt Entries are attached
1096
 
1097
                  T.Interrupt_Entry := False;
1098
               end Detach_Interrupt_Entries;
1099
 
1100
            or
1101
               accept Block_Interrupt (Interrupt : Interrupt_ID) do
1102
                  if Blocked (Interrupt) then
1103
                     return;
1104
                  end if;
1105
 
1106
                  Blocked (Interrupt) := True;
1107
                  Last_Unblocker (Interrupt) := Null_Task;
1108
 
1109
                  --  Mask this task for the given Interrupt so that all tasks
1110
                  --  are masked for the Interrupt.
1111
 
1112
                  IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
1113
 
1114
                  if User_Handler (Interrupt).H /= null
1115
                    or else User_Entry (Interrupt).T /= Null_Task
1116
                  then
1117
                     --  This is the case where the Server_Task is waiting
1118
                     --  on "sigwait." Wake it up by sending an
1119
                     --  Abort_Task_Interrupt so that the Server_Task
1120
                     --  waits on Cond.
1121
 
1122
                     POP.Abort_Task (Server_ID (Interrupt));
1123
 
1124
                     --  Make sure corresponding Server_Task is out of its own
1125
                     --  sigwait state.
1126
 
1127
                     Ret_Interrupt := Interrupt_ID
1128
                       (IMOP.Interrupt_Wait (Intwait_Mask'Access));
1129
                     pragma Assert
1130
                       (Ret_Interrupt =
1131
                        Interrupt_ID (IMNG.Abort_Task_Interrupt));
1132
                  end if;
1133
               end Block_Interrupt;
1134
 
1135
            or
1136
               accept Unblock_Interrupt (Interrupt : Interrupt_ID) do
1137
                  if not Blocked (Interrupt) then
1138
                     return;
1139
                  end if;
1140
 
1141
                  Blocked (Interrupt) := False;
1142
                  Last_Unblocker (Interrupt) :=
1143
                    To_System (Unblock_Interrupt'Caller);
1144
 
1145
                  if User_Handler (Interrupt).H = null
1146
                    and then User_Entry (Interrupt).T = Null_Task
1147
                  then
1148
                     --  No handler is attached. Unmask the Interrupt so that
1149
                     --  the default action can be carried out.
1150
 
1151
                     IMOP.Thread_Unblock_Interrupt
1152
                       (IMNG.Interrupt_ID (Interrupt));
1153
 
1154
                  else
1155
                     --  The Server_Task must be waiting on the Cond variable
1156
                     --  since it was being blocked and an Interrupt Hander or
1157
                     --  an Entry was there. Wake it up and let it change
1158
                     --  it place of waiting according to its new state.
1159
 
1160
                     POP.Wakeup (Server_ID (Interrupt),
1161
                       Interrupt_Server_Blocked_Interrupt_Sleep);
1162
                  end if;
1163
               end Unblock_Interrupt;
1164
 
1165
            or
1166
               accept Ignore_Interrupt (Interrupt : Interrupt_ID) do
1167
                  if Ignored (Interrupt) then
1168
                     return;
1169
                  end if;
1170
 
1171
                  Ignored (Interrupt) := True;
1172
 
1173
                  --  If there is a handler associated with the Interrupt,
1174
                  --  detach it first. In this way we make sure that the
1175
                  --  Server_Task is not on sigwait. This is legal since
1176
                  --  Unignore_Interrupt is to install the default action.
1177
 
1178
                  if User_Handler (Interrupt).H /= null then
1179
                     Unprotected_Detach_Handler
1180
                       (Interrupt => Interrupt, Static => True);
1181
 
1182
                  elsif User_Entry (Interrupt).T /= Null_Task then
1183
                     User_Entry (Interrupt) := Entry_Assoc'
1184
                       (T => Null_Task, E => Null_Task_Entry);
1185
                     Unbind_Handler (Interrupt);
1186
                  end if;
1187
 
1188
                  IMOP.Install_Ignore_Action (IMNG.Interrupt_ID (Interrupt));
1189
               end Ignore_Interrupt;
1190
 
1191
            or
1192
               accept Unignore_Interrupt (Interrupt : Interrupt_ID) do
1193
                  Ignored (Interrupt) := False;
1194
 
1195
                  --  If there is a handler associated with the Interrupt,
1196
                  --  detach it first. In this way we make sure that the
1197
                  --  Server_Task is not on sigwait. This is legal since
1198
                  --  Unignore_Interrupt is to install the default action.
1199
 
1200
                  if User_Handler (Interrupt).H /= null then
1201
                     Unprotected_Detach_Handler
1202
                       (Interrupt => Interrupt, Static => True);
1203
 
1204
                  elsif User_Entry (Interrupt).T /= Null_Task then
1205
                     User_Entry (Interrupt) := Entry_Assoc'
1206
                       (T => Null_Task, E => Null_Task_Entry);
1207
                     Unbind_Handler (Interrupt);
1208
                  end if;
1209
 
1210
                  IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
1211
               end Unignore_Interrupt;
1212
            end select;
1213
 
1214
         exception
1215
            --  If there is a program error we just want to propagate it to
1216
            --  the caller and do not want to stop this task.
1217
 
1218
            when Program_Error =>
1219
               null;
1220
 
1221
            when others =>
1222
               pragma Assert (False);
1223
               null;
1224
         end;
1225
      end loop;
1226
   end Interrupt_Manager;
1227
 
1228
   -----------------
1229
   -- Server_Task --
1230
   -----------------
1231
 
1232
   task body Server_Task is
1233
      Intwait_Mask    : aliased IMNG.Interrupt_Mask;
1234
      Ret_Interrupt   : Interrupt_ID;
1235
      Self_ID         : constant Task_Id := Self;
1236
      Tmp_Handler     : Parameterless_Handler;
1237
      Tmp_ID          : Task_Id;
1238
      Tmp_Entry_Index : Task_Entry_Index;
1239
 
1240
   begin
1241
      --  By making this task independent of master, when the process
1242
      --  goes away, the Server_Task will terminate gracefully.
1243
 
1244
      System.Tasking.Utilities.Make_Independent;
1245
 
1246
      --  Install default action in system level
1247
 
1248
      IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
1249
 
1250
      --  Note: All tasks in RTS will have all the Reserve Interrupts being
1251
      --  masked (except the Interrupt_Manager) and Keep_Unmasked unmasked when
1252
      --  created.
1253
 
1254
      --  Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
1255
      --  We mask the Interrupt in this particular task so that "sigwait" is
1256
      --  possible to catch an explicitly sent Abort_Task_Interrupt from the
1257
      --  Interrupt_Manager.
1258
 
1259
      --  There are two Interrupt interrupts that this task catch through
1260
      --  "sigwait." One is the Interrupt this task is designated to catch
1261
      --  in order to execute user handler or entry. The other one is the
1262
      --  Abort_Task_Interrupt. This interrupt is being sent from the
1263
      --  Interrupt_Manager to inform status changes (e.g: become Blocked,
1264
      --  Handler or Entry is to be detached).
1265
 
1266
      --  Prepare a mask to used for sigwait
1267
 
1268
      IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
1269
 
1270
      IMOP.Add_To_Interrupt_Mask
1271
        (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt));
1272
 
1273
      IMOP.Add_To_Interrupt_Mask
1274
        (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
1275
 
1276
      IMOP.Thread_Block_Interrupt
1277
        (IMNG.Abort_Task_Interrupt);
1278
 
1279
      PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID);
1280
 
1281
      loop
1282
         System.Tasking.Initialization.Defer_Abort (Self_ID);
1283
 
1284
         if Single_Lock then
1285
            POP.Lock_RTS;
1286
         end if;
1287
 
1288
         POP.Write_Lock (Self_ID);
1289
 
1290
         if User_Handler (Interrupt).H = null
1291
           and then User_Entry (Interrupt).T = Null_Task
1292
         then
1293
            --  No Interrupt binding. If there is an interrupt,
1294
            --  Interrupt_Manager will take default action.
1295
 
1296
            Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
1297
            POP.Sleep (Self_ID, Interrupt_Server_Idle_Sleep);
1298
            Self_ID.Common.State := Runnable;
1299
 
1300
         elsif Blocked (Interrupt) then
1301
 
1302
            --  Interrupt is blocked. Stay here, so we won't catch
1303
            --  the Interrupt.
1304
 
1305
            Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
1306
            POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep);
1307
            Self_ID.Common.State := Runnable;
1308
 
1309
         else
1310
            --  A Handler or an Entry is installed. At this point all tasks
1311
            --  mask for the Interrupt is masked. Catch the Interrupt using
1312
            --  sigwait.
1313
 
1314
            --  This task may wake up from sigwait by receiving an interrupt
1315
            --  (Abort_Task_Interrupt) from the Interrupt_Manager for unbinding
1316
            --  a Procedure Handler or an Entry. Or it could be a wake up
1317
            --  from status change (Unblocked -> Blocked). If that is not
1318
            --  the case, we should execute the attached Procedure or Entry.
1319
 
1320
            Self_ID.Common.State := Interrupt_Server_Blocked_On_Event_Flag;
1321
            POP.Unlock (Self_ID);
1322
 
1323
            if Single_Lock then
1324
               POP.Unlock_RTS;
1325
            end if;
1326
 
1327
            --  Avoid race condition when terminating application and
1328
            --  System.Parameters.No_Abort is True.
1329
 
1330
            if Parameters.No_Abort and then Self_ID.Pending_Action then
1331
               Initialization.Do_Pending_Action (Self_ID);
1332
            end if;
1333
 
1334
            Ret_Interrupt :=
1335
              Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
1336
            Self_ID.Common.State := Runnable;
1337
 
1338
            if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then
1339
 
1340
               --  Inform the Interrupt_Manager of wakeup from above sigwait
1341
 
1342
               POP.Abort_Task (Interrupt_Manager_ID);
1343
 
1344
               if Single_Lock then
1345
                  POP.Lock_RTS;
1346
               end if;
1347
 
1348
               POP.Write_Lock (Self_ID);
1349
 
1350
            else
1351
               if Single_Lock then
1352
                  POP.Lock_RTS;
1353
               end if;
1354
 
1355
               POP.Write_Lock (Self_ID);
1356
 
1357
               if Ret_Interrupt /= Interrupt then
1358
 
1359
                  --  On some systems (e.g. recent linux kernels), sigwait
1360
                  --  may return unexpectedly (with errno set to EINTR).
1361
 
1362
                  null;
1363
 
1364
               else
1365
                  --  Even though we have received an Interrupt the status may
1366
                  --  have changed already before we got the Self_ID lock above
1367
                  --  Therefore we make sure a Handler or an Entry is still
1368
                  --  there and make appropriate call.
1369
 
1370
                  --  If there is no calls to make we need to regenerate the
1371
                  --  Interrupt in order not to lose it.
1372
 
1373
                  if User_Handler (Interrupt).H /= null then
1374
                     Tmp_Handler := User_Handler (Interrupt).H;
1375
 
1376
                     --  RTS calls should not be made with self being locked
1377
 
1378
                     POP.Unlock (Self_ID);
1379
 
1380
                     if Single_Lock then
1381
                        POP.Unlock_RTS;
1382
                     end if;
1383
 
1384
                     Tmp_Handler.all;
1385
 
1386
                     if Single_Lock then
1387
                        POP.Lock_RTS;
1388
                     end if;
1389
 
1390
                     POP.Write_Lock (Self_ID);
1391
 
1392
                  elsif User_Entry (Interrupt).T /= Null_Task then
1393
                     Tmp_ID := User_Entry (Interrupt).T;
1394
                     Tmp_Entry_Index := User_Entry (Interrupt).E;
1395
 
1396
                     --  RTS calls should not be made with self being locked
1397
 
1398
                     if Single_Lock then
1399
                        POP.Unlock_RTS;
1400
                     end if;
1401
 
1402
                     POP.Unlock (Self_ID);
1403
 
1404
                     System.Tasking.Rendezvous.Call_Simple
1405
                       (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
1406
 
1407
                     POP.Write_Lock (Self_ID);
1408
 
1409
                     if Single_Lock then
1410
                        POP.Lock_RTS;
1411
                     end if;
1412
 
1413
                  else
1414
                     --  This is a situation that this task wakes up receiving
1415
                     --  an Interrupt and before it gets the lock the Interrupt
1416
                     --  is blocked. We do not want to lose the interrupt in
1417
                     --  this case so we regenerate the Interrupt to process
1418
                     --  level.
1419
 
1420
                     IMOP.Interrupt_Self_Process
1421
                       (IMNG.Interrupt_ID (Interrupt));
1422
                  end if;
1423
               end if;
1424
            end if;
1425
         end if;
1426
 
1427
         POP.Unlock (Self_ID);
1428
 
1429
         if Single_Lock then
1430
            POP.Unlock_RTS;
1431
         end if;
1432
 
1433
         System.Tasking.Initialization.Undefer_Abort (Self_ID);
1434
 
1435
         if Self_ID.Pending_Action then
1436
            Initialization.Do_Pending_Action (Self_ID);
1437
         end if;
1438
 
1439
         --  Undefer abort here to allow a window for this task to be aborted
1440
         --  at the time of system shutdown. We also explicitly test for
1441
         --  Pending_Action in case System.Parameters.No_Abort is True.
1442
 
1443
      end loop;
1444
   end Server_Task;
1445
 
1446
--  Elaboration code for package System.Interrupts
1447
 
1448
begin
1449
   --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
1450
 
1451
   Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
1452
 
1453
   --  During the elaboration of this package body we want the RTS
1454
   --  to inherit the interrupt mask from the Environment Task.
1455
 
1456
   IMOP.Setup_Interrupt_Mask;
1457
 
1458
   --  The environment task should have gotten its mask from the enclosing
1459
   --  process during the RTS start up. (See processing in s-inmaop.adb). Pass
1460
   --  the Interrupt_Mask of the environment task to the Interrupt_Manager.
1461
 
1462
   --  Note: At this point we know that all tasks are masked for non-reserved
1463
   --  signals. Only the Interrupt_Manager will have masks set up differently
1464
   --  inheriting the original environment task's mask.
1465
 
1466
   Interrupt_Manager.Initialize (IMOP.Environment_Mask);
1467
end System.Interrupts;

powered by: WebSVN 2.1.0

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