-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
--- This is the OpenVMS/Alpha version.
+-- This is the OpenVMS/Alpha version
with System; use System;
-- removed, because of problem with controlled attribute ???
with Ada.Task_Attributes;
-with Ada.Task_Identification;
with Ada.Exceptions; use Ada.Exceptions;
type Descriptor_Type is new SSE.Storage_Array (1 .. 48);
for Descriptor_Type'Alignment use Standard'Maximum_Alignment;
- pragma Warnings (Off, Descriptor_Type);
- -- Suppress harmless warnings about alignment.
- -- Should explain why this warning is harmless ???
type Descriptor_Ref is access all Descriptor_Type;
-- Note: When we say it works fine, there is one delicate point, which
-- is that the code for the AST procedure itself requires the original
- -- descriptor address. We handle this by saving the orignal descriptor
+ -- descriptor address. We handle this by saving the original descriptor
-- address in this structure and restoring in Process_AST.
type AST_Handler_Data is record
end record;
AST_Vector_Init : AST_Vector_Ptr;
- -- Initial value, treated as constant, Vector will be null.
+ -- Initial value, treated as constant, Vector will be null
package AST_Attribute is new Ada.Task_Attributes
(Attribute => AST_Vector_Ptr,
-- number of AST instances that can be stored in the buffer. Since
-- these entries are immediately serviced by the high priority server
-- task that does the actual entry queuing, it is very unusual to have
- -- any significant number of entries simulaneously queued.
+ -- any significant number of entries simultaneously queued.
AST_Service_Queue : array (AST_Service_Queue_Index) of AST_Instance;
pragma Volatile_Components (AST_Service_Queue);
- -- The circular buffer used to store active AST requests.
+ -- The circular buffer used to store active AST requests
AST_Service_Queue_Put : AST_Service_Queue_Index := 0;
AST_Service_Queue_Get : AST_Service_Queue_Index := 0;
Process_AST_Ptr : constant AST_Handler := Process_AST'Access;
-- Reference to standard procedure descriptor for Process_AST
+ pragma Warnings (Off, "*alignment*");
+ -- Suppress harmless warnings about alignment.
+ -- Should explain why this warning is harmless ???
+
function To_Descriptor_Ref is new Ada.Unchecked_Conversion
(AST_Handler, Descriptor_Ref);
Original_Descriptor_Ref : constant Descriptor_Ref :=
To_Descriptor_Ref (Process_AST_Ptr);
+ pragma Warnings (On, "*alignment*");
+
begin
if ATID.Is_Terminated (Taskid) then
raise Program_Error;
----------------------------
procedure Expand_AST_Packet_Pool
- (Requested_Packets : in Natural;
+ (Requested_Packets : Natural;
Actual_Number : out Natural;
Total_Number : out Natural)
is
-- from which we can obtain the task and entry number information.
function To_Address is new Ada.Unchecked_Conversion
- (ST.Task_Id, System.Address);
+ (ST.Task_Id, System.Task_Primitives.Task_Address);
begin
System.Machine_Code.Asm
- (Template => "addl $27,0,%0",
+ (Template => "addq $27,0,%0",
Outputs => AST_Handler_Data_Ref'Asm_Output ("=r", Handler_Data_Ptr),
Volatile => True);
System.Machine_Code.Asm
- (Template => "ldl $27,%0",
+ (Template => "ldq $27,%0",
Inputs => Descriptor_Ref'Asm_Input
("m", Handler_Data_Ptr.Original_Descriptor_Ref),
Volatile => True);
if Is_Waiting (J) then
Is_Waiting (J) := False;
- -- Sleeps are handled by ASTs on VMS, so don't call Wakeup.
+ -- Sleeps are handled by ASTs on VMS, so don't call Wakeup
STPOD.Interrupt_AST_Handler (To_Address (AST_Task_Ids (J)));
exit;
OSDN Git Service
