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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [s-interr-hwint.adb] - Blame information for rev 281

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 signals are masked at all times in all tasks/threads
35
--  except possibly for the Interrupt_Manager task.
36
 
37
--  When a user task wants to have the effect of masking/unmasking an signal,
38
--  it must call Block_Interrupt/Unblock_Interrupt, which will have the effect
39
--  of unmasking/masking the signal in the Interrupt_Manager task. These
40
--  comments do not apply to vectored hardware interrupts, which may be masked
41
--  or unmasked using routined interfaced to the relevant embedded RTOS system
42
--  calls.
43
 
44
--  Once we associate a Signal_Server_Task with an signal, the task never goes
45
--  away, and we never remove the association. On the other hand, it is more
46
--  convenient to terminate an associated Interrupt_Server_Task for a vectored
47
--  hardware interrupt (since we use a binary semaphore for synchronization
48
--  with the umbrella handler).
49
 
50
--  There is no more than one signal per Signal_Server_Task and no more than
51
--  one Signal_Server_Task per signal. The same relation holds for hardware
52
--  interrupts and Interrupt_Server_Task's at any given time. That is, only
53
--  one non-terminated Interrupt_Server_Task exists for a give interrupt at
54
--  any time.
55
 
56
--  Within this package, the lock L is used to protect the various status
57
--  tables. If there is a Server_Task associated with a signal or interrupt, we
58
--  use the per-task lock of the Server_Task instead so that we protect the
59
--  status between Interrupt_Manager and Server_Task. Protection among service
60
--  requests are ensured via user calls to the Interrupt_Manager entries.
61
 
62
--  This is reasonably generic version of this package, supporting vectored
63
--  hardware interrupts using non-RTOS specific adapter routines which
64
--  should easily implemented on any RTOS capable of supporting GNAT.
65
 
66
with Ada.Unchecked_Conversion;
67
with Ada.Task_Identification;
68
 
69
with Interfaces.C; use Interfaces.C;
70
with System.OS_Interface; use System.OS_Interface;
71
with System.Interrupt_Management;
72
with System.Task_Primitives.Operations;
73
with System.Storage_Elements;
74
with System.Tasking.Utilities;
75
 
76
with System.Tasking.Rendezvous;
77
pragma Elaborate_All (System.Tasking.Rendezvous);
78
 
79
package body System.Interrupts is
80
 
81
   use Tasking;
82
 
83
   package POP renames System.Task_Primitives.Operations;
84
 
85
   function To_Ada is new Ada.Unchecked_Conversion
86
     (System.Tasking.Task_Id, Ada.Task_Identification.Task_Id);
87
 
88
   function To_System is new Ada.Unchecked_Conversion
89
     (Ada.Task_Identification.Task_Id, Task_Id);
90
 
91
   -----------------
92
   -- Local Tasks --
93
   -----------------
94
 
95
   --  WARNING: System.Tasking.Stages performs calls to this task with
96
   --  low-level constructs. Do not change this spec without synchronizing it.
97
 
98
   task Interrupt_Manager is
99
      entry Detach_Interrupt_Entries (T : Task_Id);
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
      pragma Interrupt_Priority (System.Interrupt_Priority'First);
123
   end Interrupt_Manager;
124
 
125
   task type Interrupt_Server_Task
126
     (Interrupt : Interrupt_ID; Int_Sema : Binary_Semaphore_Id) is
127
      --  Server task for vectored hardware interrupt handling
128
      pragma Interrupt_Priority (System.Interrupt_Priority'First + 2);
129
   end Interrupt_Server_Task;
130
 
131
   type Interrupt_Task_Access is access Interrupt_Server_Task;
132
 
133
   -------------------------------
134
   -- Local Types and Variables --
135
   -------------------------------
136
 
137
   type Entry_Assoc is record
138
      T : Task_Id;
139
      E : Task_Entry_Index;
140
   end record;
141
 
142
   type Handler_Assoc is record
143
      H      : Parameterless_Handler;
144
      Static : Boolean;   --  Indicates static binding;
145
   end record;
146
 
147
   User_Handler : array (Interrupt_ID) of Handler_Assoc :=
148
     (others => (null, Static => False));
149
   pragma Volatile_Components (User_Handler);
150
   --  Holds the protected procedure handler (if any) and its Static
151
   --  information  for each interrupt or signal. A handler is static
152
   --  iff it is specified through the pragma Attach_Handler.
153
 
154
   User_Entry : array (Interrupt_ID) of Entry_Assoc :=
155
     (others => (T => Null_Task, E => Null_Task_Entry));
156
   pragma Volatile_Components (User_Entry);
157
   --  Holds the task and entry index (if any) for each interrupt / signal
158
 
159
   --  Type and Head, Tail of the list containing Registered Interrupt
160
   --  Handlers. These definitions are used to register the handlers
161
   --  specified by the pragma Interrupt_Handler.
162
 
163
   type Registered_Handler;
164
   type R_Link is access all Registered_Handler;
165
 
166
   type Registered_Handler is record
167
      H    : System.Address := System.Null_Address;
168
      Next : R_Link := null;
169
   end record;
170
 
171
   Registered_Handler_Head : R_Link := null;
172
   Registered_Handler_Tail : R_Link := null;
173
 
174
   Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id :=
175
     (others => System.Tasking.Null_Task);
176
   pragma Atomic_Components (Server_ID);
177
   --  Holds the Task_Id of the Server_Task for each interrupt / signal.
178
   --  Task_Id is needed to accomplish locking per interrupt base. Also
179
   --  is needed to determine whether to create a new Server_Task.
180
 
181
   Semaphore_ID_Map : array
182
     (Interrupt_ID range 0 .. System.OS_Interface.Max_HW_Interrupt)
183
      of Binary_Semaphore_Id := (others => 0);
184
   --  Array of binary semaphores associated with vectored interrupts
185
   --  Note that the last bound should be Max_HW_Interrupt, but this will raise
186
   --  Storage_Error if Num_HW_Interrupts is null, so use an extra 4 bytes
187
   --  instead.
188
 
189
   Interrupt_Access_Hold : Interrupt_Task_Access;
190
   --  Variable for allocating an Interrupt_Server_Task
191
 
192
   Handler_Installed : array (HW_Interrupt) of Boolean := (others => False);
193
   --  True if Notify_Interrupt was connected to the interrupt.  Handlers
194
   --  can be connected but disconnection is not possible on VxWorks.
195
   --  Therefore we ensure Notify_Installed is connected at most once.
196
 
197
   -----------------------
198
   -- Local Subprograms --
199
   -----------------------
200
 
201
   procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID);
202
   --  Check if Id is a reserved interrupt, and if so raise Program_Error
203
   --  with an appropriate message, otherwise return.
204
 
205
   procedure Finalize_Interrupt_Servers;
206
   --  Unbind the handlers for hardware interrupt server tasks at program
207
   --  termination.
208
 
209
   function Is_Registered (Handler : Parameterless_Handler) return Boolean;
210
   --  See if Handler has been "pragma"ed using Interrupt_Handler.
211
   --  Always consider a null handler as registered.
212
 
213
   procedure Notify_Interrupt (Param : System.Address);
214
   pragma Convention (C, Notify_Interrupt);
215
   --  Umbrella handler for vectored interrupts (not signals)
216
 
217
   procedure Install_Umbrella_Handler
218
     (Interrupt : HW_Interrupt;
219
      Handler   : System.OS_Interface.Interrupt_Handler);
220
   --  Install the runtime umbrella handler for a vectored hardware
221
   --  interrupt
222
 
223
   procedure Unimplemented (Feature : String);
224
   pragma No_Return (Unimplemented);
225
   --  Used to mark a call to an unimplemented function. Raises Program_Error
226
   --  with an appropriate message noting that Feature is unimplemented.
227
 
228
   --------------------
229
   -- Attach_Handler --
230
   --------------------
231
 
232
   --  Calling this procedure with New_Handler = null and Static = True
233
   --  means we want to detach the current handler regardless of the
234
   --  previous handler's binding status (i.e. do not care if it is a
235
   --  dynamic or static handler).
236
 
237
   --  This option is needed so that during the finalization of a PO, we
238
   --  can detach handlers attached through pragma Attach_Handler.
239
 
240
   procedure Attach_Handler
241
     (New_Handler : Parameterless_Handler;
242
      Interrupt   : Interrupt_ID;
243
      Static      : Boolean := False) is
244
   begin
245
      Check_Reserved_Interrupt (Interrupt);
246
      Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
247
   end Attach_Handler;
248
 
249
   -----------------------------
250
   -- Bind_Interrupt_To_Entry --
251
   -----------------------------
252
 
253
   --  This procedure raises a Program_Error if it tries to
254
   --  bind an interrupt to which an Entry or a Procedure is
255
   --  already bound.
256
 
257
   procedure Bind_Interrupt_To_Entry
258
     (T       : Task_Id;
259
      E       : Task_Entry_Index;
260
      Int_Ref : System.Address)
261
   is
262
      Interrupt : constant Interrupt_ID :=
263
        Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
264
 
265
   begin
266
      Check_Reserved_Interrupt (Interrupt);
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
      Unimplemented ("Block_Interrupt");
277
   end Block_Interrupt;
278
 
279
   ------------------------------
280
   -- Check_Reserved_Interrupt --
281
   ------------------------------
282
 
283
   procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is
284
   begin
285
      if Is_Reserved (Interrupt) then
286
         raise Program_Error with
287
           "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
288
      else
289
         return;
290
      end if;
291
   end Check_Reserved_Interrupt;
292
 
293
   ---------------------
294
   -- Current_Handler --
295
   ---------------------
296
 
297
   function Current_Handler
298
     (Interrupt : Interrupt_ID) return Parameterless_Handler
299
   is
300
   begin
301
      Check_Reserved_Interrupt (Interrupt);
302
 
303
      --  ??? Since Parameterless_Handler is not Atomic, the
304
      --  current implementation is wrong. We need a new service in
305
      --  Interrupt_Manager to ensure atomicity.
306
 
307
      return User_Handler (Interrupt).H;
308
   end Current_Handler;
309
 
310
   --------------------
311
   -- Detach_Handler --
312
   --------------------
313
 
314
   --  Calling this procedure with Static = True means we want to Detach the
315
   --  current handler regardless of the previous handler's binding status
316
   --  (i.e. do not care if it is a dynamic or static handler).
317
 
318
   --  This option is needed so that during the finalization of a PO, we can
319
   --  detach handlers attached through pragma Attach_Handler.
320
 
321
   procedure Detach_Handler
322
     (Interrupt : Interrupt_ID;
323
      Static    : Boolean := False) is
324
   begin
325
      Check_Reserved_Interrupt (Interrupt);
326
      Interrupt_Manager.Detach_Handler (Interrupt, Static);
327
   end Detach_Handler;
328
 
329
   ------------------------------
330
   -- Detach_Interrupt_Entries --
331
   ------------------------------
332
 
333
   procedure Detach_Interrupt_Entries (T : Task_Id) is
334
   begin
335
      Interrupt_Manager.Detach_Interrupt_Entries (T);
336
   end Detach_Interrupt_Entries;
337
 
338
   ----------------------
339
   -- Exchange_Handler --
340
   ----------------------
341
 
342
   --  Calling this procedure with New_Handler = null and Static = True
343
   --  means we want to detach the current handler regardless of the
344
   --  previous handler's binding status (i.e. do not care if it is a
345
   --  dynamic or static handler).
346
 
347
   --  This option is needed so that during the finalization of a PO, we
348
   --  can detach handlers attached through pragma Attach_Handler.
349
 
350
   procedure Exchange_Handler
351
     (Old_Handler : out Parameterless_Handler;
352
      New_Handler : Parameterless_Handler;
353
      Interrupt   : Interrupt_ID;
354
      Static      : Boolean := False)
355
   is
356
   begin
357
      Check_Reserved_Interrupt (Interrupt);
358
      Interrupt_Manager.Exchange_Handler
359
        (Old_Handler, New_Handler, Interrupt, Static);
360
   end Exchange_Handler;
361
 
362
   --------------
363
   -- Finalize --
364
   --------------
365
 
366
   procedure Finalize (Object : in out Static_Interrupt_Protection) is
367
   begin
368
      --  ??? loop to be executed only when we're not doing library level
369
      --  finalization, since in this case all interrupt / signal tasks are
370
      --  gone.
371
 
372
      if not Interrupt_Manager'Terminated then
373
         for N in reverse Object.Previous_Handlers'Range loop
374
            Interrupt_Manager.Attach_Handler
375
              (New_Handler => Object.Previous_Handlers (N).Handler,
376
               Interrupt   => Object.Previous_Handlers (N).Interrupt,
377
               Static      => Object.Previous_Handlers (N).Static,
378
               Restoration => True);
379
         end loop;
380
      end if;
381
 
382
      Tasking.Protected_Objects.Entries.Finalize
383
        (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
384
   end Finalize;
385
 
386
   --------------------------------
387
   -- Finalize_Interrupt_Servers --
388
   --------------------------------
389
 
390
   --  Restore default handlers for interrupt servers
391
 
392
   --  This is called by the Interrupt_Manager task when it receives the abort
393
   --  signal during program finalization.
394
 
395
   procedure Finalize_Interrupt_Servers is
396
      HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;
397
 
398
   begin
399
      if HW_Interrupts then
400
         for Int in HW_Interrupt loop
401
            if Server_ID (Interrupt_ID (Int)) /= null
402
              and then
403
                not Ada.Task_Identification.Is_Terminated
404
                 (To_Ada (Server_ID (Interrupt_ID (Int))))
405
            then
406
               Interrupt_Manager.Attach_Handler
407
                 (New_Handler => null,
408
                  Interrupt => Interrupt_ID (Int),
409
                  Static => True,
410
                  Restoration => True);
411
            end if;
412
         end loop;
413
      end if;
414
   end Finalize_Interrupt_Servers;
415
 
416
   -------------------------------------
417
   -- Has_Interrupt_Or_Attach_Handler --
418
   -------------------------------------
419
 
420
   function Has_Interrupt_Or_Attach_Handler
421
     (Object : access Dynamic_Interrupt_Protection)
422
      return   Boolean
423
   is
424
      pragma Unreferenced (Object);
425
   begin
426
      return True;
427
   end Has_Interrupt_Or_Attach_Handler;
428
 
429
   function Has_Interrupt_Or_Attach_Handler
430
     (Object : access Static_Interrupt_Protection)
431
      return   Boolean
432
   is
433
      pragma Unreferenced (Object);
434
   begin
435
      return True;
436
   end Has_Interrupt_Or_Attach_Handler;
437
 
438
   ----------------------
439
   -- Ignore_Interrupt --
440
   ----------------------
441
 
442
   procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
443
   begin
444
      Unimplemented ("Ignore_Interrupt");
445
   end Ignore_Interrupt;
446
 
447
   ----------------------
448
   -- Install_Handlers --
449
   ----------------------
450
 
451
   procedure Install_Handlers
452
     (Object       : access Static_Interrupt_Protection;
453
      New_Handlers : New_Handler_Array)
454
   is
455
   begin
456
      for N in New_Handlers'Range loop
457
 
458
         --  We need a lock around this ???
459
 
460
         Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
461
         Object.Previous_Handlers (N).Static    := User_Handler
462
           (New_Handlers (N).Interrupt).Static;
463
 
464
         --  We call Exchange_Handler and not directly Interrupt_Manager.
465
         --  Exchange_Handler so we get the Is_Reserved check.
466
 
467
         Exchange_Handler
468
           (Old_Handler => Object.Previous_Handlers (N).Handler,
469
            New_Handler => New_Handlers (N).Handler,
470
            Interrupt   => New_Handlers (N).Interrupt,
471
            Static      => True);
472
      end loop;
473
   end Install_Handlers;
474
 
475
   ---------------------------------
476
   -- Install_Restricted_Handlers --
477
   ---------------------------------
478
 
479
   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
480
   begin
481
      for N in Handlers'Range loop
482
         Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
483
      end loop;
484
   end Install_Restricted_Handlers;
485
 
486
   ------------------------------
487
   -- Install_Umbrella_Handler --
488
   ------------------------------
489
 
490
   procedure Install_Umbrella_Handler
491
     (Interrupt : HW_Interrupt;
492
      Handler   : System.OS_Interface.Interrupt_Handler)
493
   is
494
      Vec : constant Interrupt_Vector :=
495
              Interrupt_Number_To_Vector (int (Interrupt));
496
 
497
      Status : int;
498
 
499
   begin
500
      --  Only install umbrella handler when no Ada handler has already been
501
      --  installed. Note that the interrupt number is passed as a parameter
502
      --  when an interrupt occurs, so the umbrella handler has a different
503
      --  wrapper generated by intConnect for each interrupt number.
504
 
505
      if not Handler_Installed (Interrupt) then
506
         Status :=
507
            Interrupt_Connect (Vec, Handler, System.Address (Interrupt));
508
         pragma Assert (Status = 0);
509
 
510
         Handler_Installed (Interrupt) := True;
511
      end if;
512
   end Install_Umbrella_Handler;
513
 
514
   ----------------
515
   -- Is_Blocked --
516
   ----------------
517
 
518
   function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
519
   begin
520
      Unimplemented ("Is_Blocked");
521
      return False;
522
   end Is_Blocked;
523
 
524
   -----------------------
525
   -- Is_Entry_Attached --
526
   -----------------------
527
 
528
   function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
529
   begin
530
      Check_Reserved_Interrupt (Interrupt);
531
      return User_Entry (Interrupt).T /= Null_Task;
532
   end Is_Entry_Attached;
533
 
534
   -------------------------
535
   -- Is_Handler_Attached --
536
   -------------------------
537
 
538
   function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
539
   begin
540
      Check_Reserved_Interrupt (Interrupt);
541
      return User_Handler (Interrupt).H /= null;
542
   end Is_Handler_Attached;
543
 
544
   ----------------
545
   -- Is_Ignored --
546
   ----------------
547
 
548
   function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
549
   begin
550
      Unimplemented ("Is_Ignored");
551
      return False;
552
   end Is_Ignored;
553
 
554
   -------------------
555
   -- Is_Registered --
556
   -------------------
557
 
558
   function Is_Registered (Handler : Parameterless_Handler) return Boolean is
559
      type Fat_Ptr is record
560
         Object_Addr  : System.Address;
561
         Handler_Addr : System.Address;
562
      end record;
563
 
564
      function To_Fat_Ptr is new Ada.Unchecked_Conversion
565
        (Parameterless_Handler, Fat_Ptr);
566
 
567
      Ptr : R_Link;
568
      Fat : Fat_Ptr;
569
 
570
   begin
571
      if Handler = null then
572
         return True;
573
      end if;
574
 
575
      Fat := To_Fat_Ptr (Handler);
576
 
577
      Ptr := Registered_Handler_Head;
578
 
579
      while Ptr /= null loop
580
         if Ptr.H = Fat.Handler_Addr then
581
            return True;
582
         end if;
583
 
584
         Ptr := Ptr.Next;
585
      end loop;
586
 
587
      return False;
588
   end Is_Registered;
589
 
590
   -----------------
591
   -- Is_Reserved --
592
   -----------------
593
 
594
   function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
595
      use System.Interrupt_Management;
596
   begin
597
      return Reserve (System.Interrupt_Management.Interrupt_ID (Interrupt));
598
   end Is_Reserved;
599
 
600
   ----------------------
601
   -- Notify_Interrupt --
602
   ----------------------
603
 
604
   --  Umbrella handler for vectored hardware interrupts (as opposed to
605
   --  signals and exceptions).  As opposed to the signal implementation,
606
   --  this handler is installed in the vector table when the first Ada
607
   --  handler is attached to the interrupt.  However because VxWorks don't
608
   --  support disconnecting handlers, this subprogram always test whether
609
   --  or not an Ada handler is effectively attached.
610
 
611
   --  Otherwise, the handler that existed prior to program startup is
612
   --  in the vector table.  This ensures that handlers installed by
613
   --  the BSP are active unless explicitly replaced in the program text.
614
 
615
   --  Each Interrupt_Server_Task has an associated binary semaphore
616
   --  on which it pends once it's been started.  This routine determines
617
   --  The appropriate semaphore and issues a semGive call, waking
618
   --  the server task.  When a handler is unbound,
619
   --  System.Interrupts.Unbind_Handler issues a Binary_Semaphore_Flush,
620
   --  and the server task deletes its semaphore and terminates.
621
 
622
   procedure Notify_Interrupt (Param : System.Address) is
623
      Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
624
 
625
      Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt);
626
 
627
      Status : int;
628
 
629
   begin
630
      if Id /= 0 then
631
         Status := Binary_Semaphore_Release (Id);
632
         pragma Assert (Status = 0);
633
      end if;
634
   end Notify_Interrupt;
635
 
636
   ---------------
637
   -- Reference --
638
   ---------------
639
 
640
   function Reference (Interrupt : Interrupt_ID) return System.Address is
641
   begin
642
      Check_Reserved_Interrupt (Interrupt);
643
      return Storage_Elements.To_Address
644
        (Storage_Elements.Integer_Address (Interrupt));
645
   end Reference;
646
 
647
   --------------------------------
648
   -- Register_Interrupt_Handler --
649
   --------------------------------
650
 
651
   procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
652
      New_Node_Ptr : R_Link;
653
 
654
   begin
655
      --  This routine registers a handler as usable for dynamic
656
      --  interrupt handler association. Routines attaching and detaching
657
      --  handlers dynamically should determine whether the handler is
658
      --  registered. Program_Error should be raised if it is not registered.
659
 
660
      --  Pragma Interrupt_Handler can only appear in a library
661
      --  level PO definition and instantiation. Therefore, we do not need
662
      --  to implement an unregister operation. Nor do we need to
663
      --  protect the queue structure with a lock.
664
 
665
      pragma Assert (Handler_Addr /= System.Null_Address);
666
 
667
      New_Node_Ptr := new Registered_Handler;
668
      New_Node_Ptr.H := Handler_Addr;
669
 
670
      if Registered_Handler_Head = null then
671
         Registered_Handler_Head := New_Node_Ptr;
672
         Registered_Handler_Tail := New_Node_Ptr;
673
 
674
      else
675
         Registered_Handler_Tail.Next := New_Node_Ptr;
676
         Registered_Handler_Tail := New_Node_Ptr;
677
      end if;
678
   end Register_Interrupt_Handler;
679
 
680
   -----------------------
681
   -- Unblock_Interrupt --
682
   -----------------------
683
 
684
   procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
685
   begin
686
      Unimplemented ("Unblock_Interrupt");
687
   end Unblock_Interrupt;
688
 
689
   ------------------
690
   -- Unblocked_By --
691
   ------------------
692
 
693
   function Unblocked_By
694
     (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
695
   is
696
   begin
697
      Unimplemented ("Unblocked_By");
698
      return Null_Task;
699
   end Unblocked_By;
700
 
701
   ------------------------
702
   -- Unignore_Interrupt --
703
   ------------------------
704
 
705
   procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
706
   begin
707
      Unimplemented ("Unignore_Interrupt");
708
   end Unignore_Interrupt;
709
 
710
   -------------------
711
   -- Unimplemented --
712
   -------------------
713
 
714
   procedure Unimplemented (Feature : String) is
715
   begin
716
      raise Program_Error with Feature & " not implemented on VxWorks";
717
   end Unimplemented;
718
 
719
   -----------------------
720
   -- Interrupt_Manager --
721
   -----------------------
722
 
723
   task body Interrupt_Manager is
724
 
725
      --------------------
726
      -- Local Routines --
727
      --------------------
728
 
729
      procedure Bind_Handler (Interrupt : Interrupt_ID);
730
      --  This procedure does not do anything if a signal is blocked.
731
      --  Otherwise, we have to interrupt Server_Task for status change through
732
      --  a wakeup signal.
733
 
734
      procedure Unbind_Handler (Interrupt : Interrupt_ID);
735
      --  This procedure does not do anything if a signal is blocked.
736
      --  Otherwise, we have to interrupt Server_Task for status change
737
      --  through an abort signal.
738
 
739
      procedure Unprotected_Exchange_Handler
740
        (Old_Handler : out Parameterless_Handler;
741
         New_Handler : Parameterless_Handler;
742
         Interrupt   : Interrupt_ID;
743
         Static      : Boolean;
744
         Restoration : Boolean := False);
745
 
746
      procedure Unprotected_Detach_Handler
747
        (Interrupt : Interrupt_ID;
748
         Static    : Boolean);
749
 
750
      ------------------
751
      -- Bind_Handler --
752
      ------------------
753
 
754
      procedure Bind_Handler (Interrupt : Interrupt_ID) is
755
      begin
756
         Install_Umbrella_Handler
757
           (HW_Interrupt (Interrupt), Notify_Interrupt'Access);
758
      end Bind_Handler;
759
 
760
      --------------------
761
      -- Unbind_Handler --
762
      --------------------
763
 
764
      procedure Unbind_Handler (Interrupt : Interrupt_ID) is
765
         Status : int;
766
      begin
767
 
768
         --  Flush server task off semaphore, allowing it to terminate
769
 
770
         Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));
771
         pragma Assert (Status = 0);
772
      end Unbind_Handler;
773
 
774
      --------------------------------
775
      -- Unprotected_Detach_Handler --
776
      --------------------------------
777
 
778
      procedure Unprotected_Detach_Handler
779
        (Interrupt : Interrupt_ID;
780
         Static    : Boolean)
781
      is
782
         Old_Handler : Parameterless_Handler;
783
      begin
784
         if User_Entry (Interrupt).T /= Null_Task then
785
            --  If an interrupt entry is installed raise
786
            --  Program_Error. (propagate it to the caller).
787
 
788
            raise Program_Error with
789
              "An interrupt entry is already installed";
790
         end if;
791
 
792
         --  Note : Static = True will pass the following check. This is the
793
         --  case when we want to detach a handler regardless of the static
794
         --  status of the Current_Handler.
795
 
796
         if not Static and then User_Handler (Interrupt).Static then
797
 
798
            --  Trying to detach a static Interrupt Handler. raise
799
            --  Program_Error.
800
 
801
            raise Program_Error with
802
              "Trying to detach a static Interrupt Handler";
803
         end if;
804
 
805
         Old_Handler := User_Handler (Interrupt).H;
806
 
807
         --  The new handler
808
 
809
         User_Handler (Interrupt).H := null;
810
         User_Handler (Interrupt).Static := False;
811
 
812
         if Old_Handler /= null then
813
            Unbind_Handler (Interrupt);
814
         end if;
815
      end Unprotected_Detach_Handler;
816
 
817
      ----------------------------------
818
      -- Unprotected_Exchange_Handler --
819
      ----------------------------------
820
 
821
      procedure Unprotected_Exchange_Handler
822
        (Old_Handler : out Parameterless_Handler;
823
         New_Handler : Parameterless_Handler;
824
         Interrupt   : Interrupt_ID;
825
         Static      : Boolean;
826
         Restoration : Boolean := False)
827
      is
828
      begin
829
         if User_Entry (Interrupt).T /= Null_Task then
830
 
831
            --  If an interrupt entry is already installed, raise
832
            --  Program_Error. (propagate it to the caller).
833
 
834
            raise Program_Error with "An interrupt is already installed";
835
         end if;
836
 
837
         --  Note : A null handler with Static = True will
838
         --  pass the following check. This is the case when we want to
839
         --  detach a handler regardless of the Static status
840
         --  of Current_Handler.
841
         --  We don't check anything if Restoration is True, since we
842
         --  may be detaching a static handler to restore a dynamic one.
843
 
844
         if not Restoration and then not Static
845
           and then (User_Handler (Interrupt).Static
846
 
847
            --  Trying to overwrite a static Interrupt Handler with a
848
            --  dynamic Handler
849
 
850
            --  The new handler is not specified as an
851
            --  Interrupt Handler by a pragma.
852
 
853
           or else not Is_Registered (New_Handler))
854
         then
855
            raise Program_Error with
856
               "Trying to overwrite a static Interrupt Handler with a " &
857
               "dynamic Handler";
858
         end if;
859
 
860
         --  Save the old handler
861
 
862
         Old_Handler := User_Handler (Interrupt).H;
863
 
864
         --  The new handler
865
 
866
         User_Handler (Interrupt).H := New_Handler;
867
 
868
         if New_Handler = null then
869
 
870
            --  The null handler means we are detaching the handler
871
 
872
            User_Handler (Interrupt).Static := False;
873
 
874
         else
875
            User_Handler (Interrupt).Static := Static;
876
         end if;
877
 
878
         --  Invoke a corresponding Server_Task if not yet created.
879
         --  Place Task_Id info in Server_ID array.
880
 
881
         if New_Handler /= null
882
           and then
883
            (Server_ID (Interrupt) = Null_Task
884
              or else
885
                Ada.Task_Identification.Is_Terminated
886
                  (To_Ada (Server_ID (Interrupt))))
887
         then
888
            Interrupt_Access_Hold :=
889
              new Interrupt_Server_Task (Interrupt, Binary_Semaphore_Create);
890
            Server_ID (Interrupt) :=
891
              To_System (Interrupt_Access_Hold.all'Identity);
892
         end if;
893
 
894
         if (New_Handler = null) and then Old_Handler /= null then
895
 
896
            --  Restore default handler
897
 
898
            Unbind_Handler (Interrupt);
899
 
900
         elsif Old_Handler = null then
901
 
902
            --  Save default handler
903
 
904
            Bind_Handler (Interrupt);
905
         end if;
906
      end Unprotected_Exchange_Handler;
907
 
908
      --  Start of processing for Interrupt_Manager
909
 
910
   begin
911
      --  By making this task independent of any master, when the process
912
      --  goes away, the Interrupt_Manager will terminate gracefully.
913
 
914
      System.Tasking.Utilities.Make_Independent;
915
 
916
      loop
917
         --  A block is needed to absorb Program_Error exception
918
 
919
         declare
920
            Old_Handler : Parameterless_Handler;
921
 
922
         begin
923
            select
924
               accept Attach_Handler
925
                 (New_Handler : Parameterless_Handler;
926
                  Interrupt   : Interrupt_ID;
927
                  Static      : Boolean;
928
                  Restoration : Boolean := False)
929
               do
930
                  Unprotected_Exchange_Handler
931
                    (Old_Handler, New_Handler, Interrupt, Static, Restoration);
932
               end Attach_Handler;
933
 
934
            or
935
               accept Exchange_Handler
936
                 (Old_Handler : out Parameterless_Handler;
937
                  New_Handler : Parameterless_Handler;
938
                  Interrupt   : Interrupt_ID;
939
                  Static      : Boolean)
940
               do
941
                  Unprotected_Exchange_Handler
942
                    (Old_Handler, New_Handler, Interrupt, Static);
943
               end Exchange_Handler;
944
 
945
            or
946
               accept Detach_Handler
947
                  (Interrupt   : Interrupt_ID;
948
                   Static      : Boolean)
949
               do
950
                  Unprotected_Detach_Handler (Interrupt, Static);
951
               end Detach_Handler;
952
            or
953
               accept Bind_Interrupt_To_Entry
954
                 (T       : Task_Id;
955
                  E       : Task_Entry_Index;
956
                  Interrupt : Interrupt_ID)
957
               do
958
                  --  If there is a binding already (either a procedure or an
959
                  --  entry), raise Program_Error (propagate it to the caller).
960
 
961
                  if User_Handler (Interrupt).H /= null
962
                    or else User_Entry (Interrupt).T /= Null_Task
963
                  then
964
                     raise Program_Error with
965
                       "A binding for this interrupt is already present";
966
                  end if;
967
 
968
                  User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
969
 
970
                  --  Indicate the attachment of interrupt entry in the ATCB.
971
                  --  This is needed so when an interrupt entry task terminates
972
                  --  the binding can be cleaned. The call to unbinding must be
973
                  --  make by the task before it terminates.
974
 
975
                  T.Interrupt_Entry := True;
976
 
977
                  --  Invoke a corresponding Server_Task if not yet created.
978
                  --  Place Task_Id info in Server_ID array.
979
 
980
                  if Server_ID (Interrupt) = Null_Task
981
                    or else
982
                      Ada.Task_Identification.Is_Terminated
983
                        (To_Ada (Server_ID (Interrupt)))
984
                  then
985
                     Interrupt_Access_Hold := new Interrupt_Server_Task
986
                       (Interrupt, Binary_Semaphore_Create);
987
                     Server_ID (Interrupt) :=
988
                       To_System (Interrupt_Access_Hold.all'Identity);
989
                  end if;
990
 
991
                  Bind_Handler (Interrupt);
992
               end Bind_Interrupt_To_Entry;
993
 
994
            or
995
               accept Detach_Interrupt_Entries (T : Task_Id) do
996
                  for Int in Interrupt_ID'Range loop
997
                     if not Is_Reserved (Int) then
998
                        if User_Entry (Int).T = T then
999
                           User_Entry (Int) :=
1000
                             Entry_Assoc'
1001
                               (T => Null_Task, E => Null_Task_Entry);
1002
                           Unbind_Handler (Int);
1003
                        end if;
1004
                     end if;
1005
                  end loop;
1006
 
1007
                  --  Indicate in ATCB that no interrupt entries are attached
1008
 
1009
                  T.Interrupt_Entry := False;
1010
               end Detach_Interrupt_Entries;
1011
            end select;
1012
 
1013
         exception
1014
            --  If there is a Program_Error we just want to propagate it to
1015
            --  the caller and do not want to stop this task.
1016
 
1017
            when Program_Error =>
1018
               null;
1019
 
1020
            when others =>
1021
               pragma Assert (False);
1022
               null;
1023
         end;
1024
      end loop;
1025
 
1026
   exception
1027
      when Standard'Abort_Signal =>
1028
         --  Flush interrupt server semaphores, so they can terminate
1029
         Finalize_Interrupt_Servers;
1030
         raise;
1031
   end Interrupt_Manager;
1032
 
1033
   ---------------------------
1034
   -- Interrupt_Server_Task --
1035
   ---------------------------
1036
 
1037
   --  Server task for vectored hardware interrupt handling
1038
 
1039
   task body Interrupt_Server_Task is
1040
      Self_Id         : constant Task_Id := Self;
1041
      Tmp_Handler     : Parameterless_Handler;
1042
      Tmp_ID          : Task_Id;
1043
      Tmp_Entry_Index : Task_Entry_Index;
1044
      Status          : int;
1045
 
1046
   begin
1047
      System.Tasking.Utilities.Make_Independent;
1048
      Semaphore_ID_Map (Interrupt) := Int_Sema;
1049
 
1050
      loop
1051
         --  Pend on semaphore that will be triggered by the
1052
         --  umbrella handler when the associated interrupt comes in
1053
 
1054
         Status := Binary_Semaphore_Obtain (Int_Sema);
1055
         pragma Assert (Status = 0);
1056
 
1057
         if User_Handler (Interrupt).H /= null then
1058
 
1059
            --  Protected procedure handler
1060
 
1061
            Tmp_Handler := User_Handler (Interrupt).H;
1062
            Tmp_Handler.all;
1063
 
1064
         elsif User_Entry (Interrupt).T /= Null_Task then
1065
 
1066
            --  Interrupt entry handler
1067
 
1068
            Tmp_ID := User_Entry (Interrupt).T;
1069
            Tmp_Entry_Index := User_Entry (Interrupt).E;
1070
            System.Tasking.Rendezvous.Call_Simple
1071
              (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
1072
 
1073
         else
1074
            --  Semaphore has been flushed by an unbind operation in
1075
            --  the Interrupt_Manager. Terminate the server task.
1076
 
1077
            --  Wait for the Interrupt_Manager to complete its work
1078
 
1079
            POP.Write_Lock (Self_Id);
1080
 
1081
            --  Unassociate the interrupt handler
1082
 
1083
            Semaphore_ID_Map (Interrupt) := 0;
1084
 
1085
            --  Delete the associated semaphore
1086
 
1087
            Status := Binary_Semaphore_Delete (Int_Sema);
1088
 
1089
            pragma Assert (Status = 0);
1090
 
1091
            --  Set status for the Interrupt_Manager
1092
 
1093
            Server_ID (Interrupt) := Null_Task;
1094
            POP.Unlock (Self_Id);
1095
 
1096
            exit;
1097
         end if;
1098
      end loop;
1099
   end Interrupt_Server_Task;
1100
 
1101
begin
1102
   --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
1103
 
1104
   Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
1105
end System.Interrupts;

powered by: WebSVN 2.1.0

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