fmap.adb: Put routines in alpha order
2006-10-31 Robert Dewar <dewar@adacore.com> Thomas Quinot <quinot@adacore.com> Arnaud Charlet <charlet@adacore.com> * fmap.adb: Put routines in alpha order * g-boumai.ads: Remove redundant 'in' keywords * g-cgi.adb: Minor reformatting * g-cgi.ads: Remove redundant 'in' keywords * get_targ.adb: Put routines in alpha order * prj-attr.ads: Minor reformatting * s-atacco.ads: Minor reformatting * scn.adb: Put routines in alpha order * sinput-l.adb: Minor comment fix * sinput-p.adb: Minor comment fix * s-maccod.ads: Minor reformatting * s-memory.adb: Minor reformatting * s-htable.adb: Fix typo in comment. * s-secsta.adb: Minor comment update. * s-soflin.adb: Minor reformatting * s-stoele.ads: Add comment about odd qualification in Storage_Offset declaration * s-strxdr.adb: Remove unnecessary 'in' keywords for formal parameters. * treeprs.adt: Minor reformatting * urealp.adb: Put routines in alpha order * s-wchcon.ads, s-wchcon.adb (Get_WC_Encoding_Method): New version taking string. * s-asthan-vms-alpha.adb: Remove redundant 'in' keywords * g-trasym-vms-ia64.adb: Remove redundant 'in' keywords * env.c (__gnat_unsetenv): Unsetenv is unavailable on LynxOS, so workaround as on other platforms. * g-eacodu-vms.adb: Remove redundant 'in' keywords * g-expect-vms.adb: Remove redundant 'in' keywords * gnatdll.adb (Add_Files_From_List): Handle Name_Error and report a clear error message if the list-of-files file cannot be opened. * g-thread.adb (Unregister_Thread_Id): Add use type Thread_Id so the equality operator is always visible. * lang.opt: Woverlength-strings: New option. * nmake.adt: Update copyright, since nmake.ads and nmake.adb have changed. * osint-b.ads, osint-b.adb (Time_From_Last_Bind): removed function . (Binder_Output_Time_Stamps_Set): removed. (Old_Binder_Output_Time_Stamp): idem. (New_Binder_Output_Time_Stamp): idem. (Recording_Time_From_Last_Bind): idem. (Recording_Time_From_Last_Bind): Make constant. * output.ads, output.adb (Write_Str): Allow LF characters (Write_Spaces): New procedure * prepcomp.adb (Preproc_Data_Table): Change Increment from 5% to 100% * inline.adb: Minor reformatting * s-asthan-vms-alpha.adb: Remove redundant 'in' keywords * s-mastop-vms.adb: Remove redundant 'in' keywords * s-osprim-vms.adb: Remove redundant 'in' keywords * s-trafor-default.adb: Remove redundant 'in' keywords * 9drpc.adb: Remove redundant 'in' keywords * s-osinte-mingw.ads: Minor reformatting * s-inmaop-posix.adb: Minor reformatting * a-direio.ads: Remove quotes from Compile_Time_Warning message * a-exexda.adb: Minor code reorganization * a-filico.adb: Minor reformatting * a-finali.adb: Minor reformatting * a-nudira.ads: Remove quote from Compile_Time_Warning message * a-numeri.ads: Minor reformatting * a-sequio.ads: Remove quotes from Compile_Time_Warning message * exp_pakd.ads: Fix obsolete comment * a-ztenau.adb, a-ztenio.adb, a-wtenau.adb, a-tienau.adb, a-wtenio.adb (Put): Avoid assuming low bound of string is 1. Probably not a bug, but certainly neater and more efficient. * a-tienio.adb: Minor reformatting * comperr.adb (Compiler_Abort): Call Cancel_Special_Output at start Avoid assuming low bound of string is 1. * gnatbind.adb: Change Bindusg to package and rename procedure as Display, which now ensures that it only outputs usage information once. (Scan_Bind_Arg): Avoid assuming low bound of string is 1. * g-pehage.adb (Build_Identical_Keysets): Replace use of 1 by Table'First. * g-regpat.adb (Insert_Operator): Add pragma Warnings (Off) to kill warning. (Match): Add pragma Assert to ensure that Matches'First is zero * g-regpat.ads (Match): Document that Matches lower bound must be zero * makeutl.adb (Is_External_Assignment): Add pragma Assert's to check documented preconditions (also kills warnings about bad indexes). * mdll.adb (Build_Dynamic_Library): Avoid assumption that Afiles'First is 1. (Build_Import_Library): Ditto; * mdll-utl.adb: (Gnatbind): Avoid assumption that Alis'First = 1 * rtsfind.adb (RTE_Error_Msg): Avoid assuming low bound of string is 1. * sem_case.adb (Analyze_Choices): Add pragma Assert to check that lower bound of choice table is 1. * sem_case.ads (Analyze_Choices): Document that lower bound of Choice_Table is 1. * s-imgdec.adb (Set_Decimal_Digits): Avoid assuming low bound of string is 1. * uintp.adb (Init_Operand): Document that low bound of Vec is always 1, and add appropriate Assert pragma to suppress warnings. * atree.h, atree.ads, atree.adb Change Elist24 to Elist25 Add definitions of Field28 and Node28 (Traverse_Field): Use new syntactic parent table in sinfo. * cstand.adb: Change name Is_Ada_2005 to Is_Ada_2005_Only * itypes.adb: Change name Is_Ada_2005 to Is_Ada_2005_Only * exp_tss.adb: Put routines in alpha order * fe.h: Remove redundant declarations. From-SVN: r118330
This commit is contained in:
Robert Dewar
Arnaud Charlet
parent
e0ae4e94e9
commit
bfc8aa81e4
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006 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- --
|
||||
|
|
@ -93,11 +93,11 @@ package body System.RPC is
|
|||
task type Anonymous_Task_Type (Self : Anonymous_Task_Node_Access) is
|
||||
|
||||
entry Start
|
||||
(Message_Id : in Message_Id_Type;
|
||||
Partition : in Partition_ID;
|
||||
Params_Size : in Ada.Streams.Stream_Element_Count;
|
||||
Result_Size : in Ada.Streams.Stream_Element_Count;
|
||||
Protocol : in Garlic.Protocol_Access);
|
||||
(Message_Id : Message_Id_Type;
|
||||
Partition : Partition_ID;
|
||||
Params_Size : Ada.Streams.Stream_Element_Count;
|
||||
Result_Size : Ada.Streams.Stream_Element_Count;
|
||||
Protocol : Garlic.Protocol_Access);
|
||||
-- This entry provides an anonymous task a remote call to perform.
|
||||
-- This task calls for a Request id is provided to construct the
|
||||
-- reply id by using -Request. Partition is used to send the reply
|
||||
|
|
@ -153,8 +153,8 @@ package body System.RPC is
|
|||
-- When it is resumed, we provide the size of the reply
|
||||
|
||||
entry Wake_Up
|
||||
(Request : in Request_Id_Type;
|
||||
Length : in Ada.Streams.Stream_Element_Count);
|
||||
(Request : Request_Id_Type;
|
||||
Length : Ada.Streams.Stream_Element_Count);
|
||||
-- To wake up the calling stub when the environnement task has
|
||||
-- received a reply for this request
|
||||
|
||||
|
|
@ -198,7 +198,7 @@ package body System.RPC is
|
|||
-- Debugging package
|
||||
|
||||
procedure D
|
||||
(Flag : in Debug_Level; Info : in String) renames Debugging.Debug;
|
||||
(Flag : Debug_Level; Info : String) renames Debugging.Debug;
|
||||
-- Shortcut
|
||||
|
||||
------------------------
|
||||
|
|
@ -265,7 +265,7 @@ package body System.RPC is
|
|||
-- Null_Node --
|
||||
---------------
|
||||
|
||||
function Null_Node (Index : in Packet_Node_Access) return Boolean is
|
||||
function Null_Node (Index : Packet_Node_Access) return Boolean is
|
||||
begin
|
||||
return Index = null;
|
||||
|
||||
|
|
@ -375,7 +375,7 @@ package body System.RPC is
|
|||
|
||||
procedure Write
|
||||
(Stream : in out Params_Stream_Type;
|
||||
Item : in Ada.Streams.Stream_Element_Array)
|
||||
Item : Ada.Streams.Stream_Element_Array)
|
||||
renames System.RPC.Streams.Write;
|
||||
|
||||
-----------------------
|
||||
|
|
@ -687,8 +687,8 @@ package body System.RPC is
|
|||
----------------------------
|
||||
|
||||
procedure Establish_RPC_Receiver
|
||||
(Partition : in Partition_ID;
|
||||
Receiver : in RPC_Receiver)
|
||||
(Partition : Partition_ID;
|
||||
Receiver : RPC_Receiver)
|
||||
is
|
||||
begin
|
||||
-- Set Partition_RPC_Receiver and allow RPC mechanism
|
||||
|
|
@ -799,11 +799,11 @@ package body System.RPC is
|
|||
|
||||
select
|
||||
accept Start
|
||||
(Message_Id : in Message_Id_Type;
|
||||
Partition : in Partition_ID;
|
||||
Params_Size : in Ada.Streams.Stream_Element_Count;
|
||||
Result_Size : in Ada.Streams.Stream_Element_Count;
|
||||
Protocol : in Protocol_Access)
|
||||
(Message_Id : Message_Id_Type;
|
||||
Partition : Partition_ID;
|
||||
Params_Size : Ada.Streams.Stream_Element_Count;
|
||||
Result_Size : Ada.Streams.Stream_Element_Count;
|
||||
Protocol : Protocol_Access)
|
||||
do
|
||||
C_Message_Id := Message_Id;
|
||||
C_Partition := Partition;
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ package Ada.Direct_IO is
|
|||
|
||||
pragma Compile_Time_Warning
|
||||
(Element_Type'Has_Access_Values,
|
||||
"?Element_Type for Direct_'I'O instance has access values");
|
||||
"Element_Type for Direct_IO instance has access values");
|
||||
|
||||
type File_Type is limited private;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -407,10 +407,13 @@ package body Exception_Data is
|
|||
-----------------------------------------
|
||||
|
||||
function Basic_Exception_Tback_Maxlength
|
||||
(X : Exception_Occurrence) return Natural is
|
||||
(X : Exception_Occurrence) return Natural
|
||||
is
|
||||
Space_Per_Traceback : constant := 2 + 16 + 1;
|
||||
-- Space for "0x" + HHHHHHHHHHHHHHHH + " "
|
||||
begin
|
||||
return BETB_Header'Length + 1 + X.Num_Tracebacks * 19 + 1;
|
||||
-- 19 = 2 + 16 + 1 for each address ("0x" + HHHH + " ")
|
||||
return BETB_Header'Length + 1 +
|
||||
X.Num_Tracebacks * Space_Per_Traceback + 1;
|
||||
end Basic_Exception_Tback_Maxlength;
|
||||
|
||||
---------------------------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -50,7 +50,6 @@ package body Ada.Finalization is
|
|||
|
||||
procedure Adjust (Object : in out Controlled) is
|
||||
pragma Warnings (Off, Object);
|
||||
|
||||
begin
|
||||
null;
|
||||
end Adjust;
|
||||
|
|
@ -61,14 +60,12 @@ package body Ada.Finalization is
|
|||
|
||||
procedure Finalize (Object : in out Controlled) is
|
||||
pragma Warnings (Off, Object);
|
||||
|
||||
begin
|
||||
null;
|
||||
end Finalize;
|
||||
|
||||
procedure Finalize (Object : in out Limited_Controlled) is
|
||||
pragma Warnings (Off, Object);
|
||||
|
||||
begin
|
||||
null;
|
||||
end Finalize;
|
||||
|
|
@ -79,14 +76,12 @@ package body Ada.Finalization is
|
|||
|
||||
procedure Initialize (Object : in out Controlled) is
|
||||
pragma Warnings (Off, Object);
|
||||
|
||||
begin
|
||||
null;
|
||||
end Initialize;
|
||||
|
||||
procedure Initialize (Object : in out Limited_Controlled) is
|
||||
pragma Warnings (Off, Object);
|
||||
|
||||
begin
|
||||
null;
|
||||
end Initialize;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -58,7 +58,7 @@ package Ada.Numerics.Discrete_Random is
|
|||
|
||||
pragma Compile_Time_Warning
|
||||
(Result_Subtype'Size > 48,
|
||||
"statistical properties not guaranteed for size '> 48");
|
||||
"statistical properties not guaranteed for size > 48");
|
||||
|
||||
-- Basic facilities
|
||||
|
||||
|
|
|
|||
|
|
@ -23,8 +23,8 @@ package Ada.Numerics is
|
|||
|
||||
["03C0"] : constant := Pi;
|
||||
-- This is the greek letter Pi (for Ada 2005 AI-388). Note that it is
|
||||
-- conforming to have this present even in Ada 95 mode, because there is
|
||||
-- no way for a normal mode Ada 95 program to reference this identifier.
|
||||
-- conforming to have this constant present even in Ada 95 mode, as there
|
||||
-- is no way for a normal mode Ada 95 program to reference this identifier.
|
||||
|
||||
e : constant :=
|
||||
2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996;
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ package Ada.Sequential_IO is
|
|||
|
||||
pragma Compile_Time_Warning
|
||||
(Element_Type'Has_Access_Values,
|
||||
"?Element_Type for Sequential_'I'O instance has access values");
|
||||
"Element_Type for Sequential_IO instance has access values");
|
||||
|
||||
type File_Type is limited private;
|
||||
|
||||
|
|
|
|||
|
|
@ -128,7 +128,7 @@ package body Ada.Text_IO.Enumeration_Aux is
|
|||
Actual_Width : constant Count := Count'Max (Count (Width), Item'Length);
|
||||
|
||||
begin
|
||||
if Set = Lower_Case and then Item (1) /= ''' then
|
||||
if Set = Lower_Case and then Item (Item'First) /= ''' then
|
||||
declare
|
||||
Iteml : String (Item'First .. Item'Last);
|
||||
|
||||
|
|
@ -167,7 +167,7 @@ package body Ada.Text_IO.Enumeration_Aux is
|
|||
else
|
||||
Ptr := To'First;
|
||||
for J in Item'Range loop
|
||||
if Set = Lower_Case and then Item (1) /= ''' then
|
||||
if Set = Lower_Case and then Item (Item'First) /= ''' then
|
||||
To (Ptr) := To_Lower (Item (J));
|
||||
else
|
||||
To (Ptr) := Item (J);
|
||||
|
|
|
|||
|
|
@ -61,7 +61,6 @@ package body Ada.Text_IO.Enumeration_IO is
|
|||
|
||||
procedure Get (Item : out Enum) is
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
begin
|
||||
Get (Current_In, Item);
|
||||
end Get;
|
||||
|
|
@ -98,7 +97,6 @@ package body Ada.Text_IO.Enumeration_IO is
|
|||
Set : Type_Set := Default_Setting)
|
||||
is
|
||||
Image : constant String := Enum'Image (Item);
|
||||
|
||||
begin
|
||||
Aux.Put (File, Image, Width, Set);
|
||||
end Put;
|
||||
|
|
@ -118,7 +116,6 @@ package body Ada.Text_IO.Enumeration_IO is
|
|||
Set : Type_Set := Default_Setting)
|
||||
is
|
||||
Image : constant String := Enum'Image (Item);
|
||||
|
||||
begin
|
||||
Aux.Puts (To, Image, Set);
|
||||
end Put;
|
||||
|
|
|
|||
|
|
@ -159,7 +159,7 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is
|
|||
begin
|
||||
Check_On_One_Line (TFT (File), Actual_Width);
|
||||
|
||||
if Set = Lower_Case and then Item (1) /= ''' then
|
||||
if Set = Lower_Case and then Item (Item'First) /= ''' then
|
||||
declare
|
||||
Iteml : Wide_String (Item'First .. Item'Last);
|
||||
|
||||
|
|
@ -204,7 +204,7 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is
|
|||
Ptr := To'First;
|
||||
for J in Item'Range loop
|
||||
if Set = Lower_Case
|
||||
and then Item (1) /= '''
|
||||
and then Item (Item'First) /= '''
|
||||
and then Is_Character (Item (J))
|
||||
then
|
||||
To (Ptr) :=
|
||||
|
|
|
|||
|
|
@ -160,7 +160,7 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_Aux is
|
|||
begin
|
||||
Check_On_One_Line (TFT (File), Actual_Width);
|
||||
|
||||
if Set = Lower_Case and then Item (1) /= ''' then
|
||||
if Set = Lower_Case and then Item (Item'First) /= ''' then
|
||||
declare
|
||||
Iteml : Wide_Wide_String (Item'First .. Item'Last);
|
||||
|
||||
|
|
@ -206,7 +206,7 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_Aux is
|
|||
Ptr := To'First;
|
||||
for J in Item'Range loop
|
||||
if Set = Lower_Case
|
||||
and then Item (1) /= '''
|
||||
and then Item (Item'First) /= '''
|
||||
and then Is_Character (Item (J))
|
||||
then
|
||||
To (Ptr) :=
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -44,11 +44,9 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_IO is
|
|||
procedure Get (File : File_Type; Item : out Enum) is
|
||||
Buf : Wide_Wide_String (1 .. Enum'Width);
|
||||
Buflen : Natural;
|
||||
|
||||
begin
|
||||
Aux.Get_Enum_Lit (File, Buf, Buflen);
|
||||
Item := Enum'Wide_Wide_Value (Buf (1 .. Buflen));
|
||||
|
||||
exception
|
||||
when Constraint_Error => raise Data_Error;
|
||||
end Get;
|
||||
|
|
@ -64,11 +62,9 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_IO is
|
|||
Last : out Positive)
|
||||
is
|
||||
Start : Natural;
|
||||
|
||||
begin
|
||||
Aux.Scan_Enum_Lit (From, Start, Last);
|
||||
Item := Enum'Wide_Wide_Value (From (Start .. Last));
|
||||
|
||||
exception
|
||||
when Constraint_Error => raise Data_Error;
|
||||
end Get;
|
||||
|
|
@ -84,7 +80,6 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_IO is
|
|||
Set : Type_Set := Default_Setting)
|
||||
is
|
||||
Image : constant Wide_Wide_String := Enum'Wide_Wide_Image (Item);
|
||||
|
||||
begin
|
||||
Aux.Put (File, Image, Width, Set);
|
||||
end Put;
|
||||
|
|
@ -104,7 +99,6 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_IO is
|
|||
Set : Type_Set := Default_Setting)
|
||||
is
|
||||
Image : constant Wide_Wide_String := Enum'Wide_Wide_Image (Item);
|
||||
|
||||
begin
|
||||
Aux.Puts (To, Image, Set);
|
||||
end Put;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -2360,17 +2360,24 @@ package body Atree is
|
|||
|
||||
function Traverse_Func (Node : Node_Id) return Traverse_Result is
|
||||
|
||||
function Traverse_Field (Fld : Union_Id) return Traverse_Result;
|
||||
-- Fld is one of the fields of Node. If the field points to a
|
||||
-- syntactic node or list, then this node or list is traversed,
|
||||
-- and the result is the result of this traversal. Otherwise
|
||||
-- a value of True is returned with no processing.
|
||||
function Traverse_Field
|
||||
(Nod : Node_Id;
|
||||
Fld : Union_Id;
|
||||
FN : Field_Num) return Traverse_Result;
|
||||
-- Fld is one of the fields of Nod. If the field points to syntactic
|
||||
-- node or list, then this node or list is traversed, and the result is
|
||||
-- the result of this traversal. Otherwise a value of True is returned
|
||||
-- with no processing. FN is the number of the field (1 .. 5).
|
||||
|
||||
--------------------
|
||||
-- Traverse_Field --
|
||||
--------------------
|
||||
|
||||
function Traverse_Field (Fld : Union_Id) return Traverse_Result is
|
||||
function Traverse_Field
|
||||
(Nod : Node_Id;
|
||||
Fld : Union_Id;
|
||||
FN : Field_Num) return Traverse_Result
|
||||
is
|
||||
begin
|
||||
if Fld = Union_Id (Empty) then
|
||||
return OK;
|
||||
|
|
@ -2381,9 +2388,7 @@ package body Atree is
|
|||
|
||||
-- Traverse descendent that is syntactic subtree node
|
||||
|
||||
if Parent (Node_Id (Fld)) = Node
|
||||
or else Original_Node (Parent (Node_Id (Fld))) = Node
|
||||
then
|
||||
if Is_Syntactic_Field (Nkind (Nod), FN) then
|
||||
return Traverse_Func (Node_Id (Fld));
|
||||
|
||||
-- Node that is not a syntactic subtree
|
||||
|
|
@ -2398,9 +2403,7 @@ package body Atree is
|
|||
|
||||
-- Traverse descendent that is a syntactic subtree list
|
||||
|
||||
if Parent (List_Id (Fld)) = Node
|
||||
or else Original_Node (Parent (List_Id (Fld))) = Node
|
||||
then
|
||||
if Is_Syntactic_Field (Nkind (Nod), FN) then
|
||||
declare
|
||||
Elmt : Node_Id := First (List_Id (Fld));
|
||||
begin
|
||||
|
|
@ -2439,39 +2442,36 @@ package body Atree is
|
|||
return OK;
|
||||
|
||||
when OK =>
|
||||
if Traverse_Field (Union_Id (Field1 (Node))) = Abandon
|
||||
if Traverse_Field (Node, Union_Id (Field1 (Node)), 1) = Abandon
|
||||
or else
|
||||
Traverse_Field (Union_Id (Field2 (Node))) = Abandon
|
||||
Traverse_Field (Node, Union_Id (Field2 (Node)), 2) = Abandon
|
||||
or else
|
||||
Traverse_Field (Union_Id (Field3 (Node))) = Abandon
|
||||
Traverse_Field (Node, Union_Id (Field3 (Node)), 3) = Abandon
|
||||
or else
|
||||
Traverse_Field (Union_Id (Field4 (Node))) = Abandon
|
||||
Traverse_Field (Node, Union_Id (Field4 (Node)), 4) = Abandon
|
||||
or else
|
||||
Traverse_Field (Union_Id (Field5 (Node))) = Abandon
|
||||
Traverse_Field (Node, Union_Id (Field5 (Node)), 5) = Abandon
|
||||
then
|
||||
return Abandon;
|
||||
|
||||
else
|
||||
return OK;
|
||||
end if;
|
||||
|
||||
when OK_Orig =>
|
||||
declare
|
||||
Onode : constant Node_Id := Original_Node (Node);
|
||||
|
||||
Onod : constant Node_Id := Original_Node (Node);
|
||||
begin
|
||||
if Traverse_Field (Union_Id (Field1 (Onode))) = Abandon
|
||||
if Traverse_Field (Onod, Union_Id (Field1 (Onod)), 1) = Abandon
|
||||
or else
|
||||
Traverse_Field (Union_Id (Field2 (Onode))) = Abandon
|
||||
Traverse_Field (Onod, Union_Id (Field2 (Onod)), 2) = Abandon
|
||||
or else
|
||||
Traverse_Field (Union_Id (Field3 (Onode))) = Abandon
|
||||
Traverse_Field (Onod, Union_Id (Field3 (Onod)), 3) = Abandon
|
||||
or else
|
||||
Traverse_Field (Union_Id (Field4 (Onode))) = Abandon
|
||||
Traverse_Field (Onod, Union_Id (Field4 (Onod)), 4) = Abandon
|
||||
or else
|
||||
Traverse_Field (Union_Id (Field5 (Onode))) = Abandon
|
||||
Traverse_Field (Onod, Union_Id (Field5 (Onod)), 5) = Abandon
|
||||
then
|
||||
return Abandon;
|
||||
|
||||
else
|
||||
return OK_Orig;
|
||||
end if;
|
||||
|
|
@ -2681,6 +2681,12 @@ package body Atree is
|
|||
return Nodes.Table (N + 4).Field9;
|
||||
end Field27;
|
||||
|
||||
function Field28 (N : Node_Id) return Union_Id is
|
||||
begin
|
||||
pragma Assert (Nkind (N) in N_Entity);
|
||||
return Nodes.Table (N + 4).Field10;
|
||||
end Field28;
|
||||
|
||||
function Node1 (N : Node_Id) return Node_Id is
|
||||
begin
|
||||
pragma Assert (N in Nodes.First .. Nodes.Last);
|
||||
|
|
@ -2843,6 +2849,12 @@ package body Atree is
|
|||
return Node_Id (Nodes.Table (N + 4).Field9);
|
||||
end Node27;
|
||||
|
||||
function Node28 (N : Node_Id) return Node_Id is
|
||||
begin
|
||||
pragma Assert (Nkind (N) in N_Entity);
|
||||
return Node_Id (Nodes.Table (N + 4).Field10);
|
||||
end Node28;
|
||||
|
||||
function List1 (N : Node_Id) return List_Id is
|
||||
begin
|
||||
pragma Assert (N in Nodes.First .. Nodes.Last);
|
||||
|
|
@ -2995,16 +3007,16 @@ package body Atree is
|
|||
end if;
|
||||
end Elist23;
|
||||
|
||||
function Elist24 (N : Node_Id) return Elist_Id is
|
||||
function Elist25 (N : Node_Id) return Elist_Id is
|
||||
pragma Assert (Nkind (N) in N_Entity);
|
||||
Value : constant Union_Id := Nodes.Table (N + 4).Field6;
|
||||
Value : constant Union_Id := Nodes.Table (N + 4).Field7;
|
||||
begin
|
||||
if Value = 0 then
|
||||
return No_Elist;
|
||||
else
|
||||
return Elist_Id (Value);
|
||||
end if;
|
||||
end Elist24;
|
||||
end Elist25;
|
||||
|
||||
function Name1 (N : Node_Id) return Name_Id is
|
||||
begin
|
||||
|
|
@ -4647,6 +4659,12 @@ package body Atree is
|
|||
Nodes.Table (N + 4).Field9 := Val;
|
||||
end Set_Field27;
|
||||
|
||||
procedure Set_Field28 (N : Node_Id; Val : Union_Id) is
|
||||
begin
|
||||
pragma Assert (Nkind (N) in N_Entity);
|
||||
Nodes.Table (N + 4).Field10 := Val;
|
||||
end Set_Field28;
|
||||
|
||||
procedure Set_Node1 (N : Node_Id; Val : Node_Id) is
|
||||
begin
|
||||
pragma Assert (N in Nodes.First .. Nodes.Last);
|
||||
|
|
@ -4809,6 +4827,12 @@ package body Atree is
|
|||
Nodes.Table (N + 4).Field9 := Union_Id (Val);
|
||||
end Set_Node27;
|
||||
|
||||
procedure Set_Node28 (N : Node_Id; Val : Node_Id) is
|
||||
begin
|
||||
pragma Assert (Nkind (N) in N_Entity);
|
||||
Nodes.Table (N + 4).Field10 := Union_Id (Val);
|
||||
end Set_Node28;
|
||||
|
||||
procedure Set_List1 (N : Node_Id; Val : List_Id) is
|
||||
begin
|
||||
pragma Assert (N in Nodes.First .. Nodes.Last);
|
||||
|
|
@ -4908,11 +4932,11 @@ package body Atree is
|
|||
Nodes.Table (N + 3).Field10 := Union_Id (Val);
|
||||
end Set_Elist23;
|
||||
|
||||
procedure Set_Elist24 (N : Node_Id; Val : Elist_Id) is
|
||||
procedure Set_Elist25 (N : Node_Id; Val : Elist_Id) is
|
||||
begin
|
||||
pragma Assert (Nkind (N) in N_Entity);
|
||||
Nodes.Table (N + 4).Field6 := Union_Id (Val);
|
||||
end Set_Elist24;
|
||||
Nodes.Table (N + 4).Field7 := Union_Id (Val);
|
||||
end Set_Elist25;
|
||||
|
||||
procedure Set_Name1 (N : Node_Id; Val : Name_Id) is
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -49,7 +49,7 @@ package Atree is
|
|||
-- this tree. There is no separate symbol table structure.
|
||||
|
||||
-- WARNING: There is a C version of this package. Any changes to this
|
||||
-- source file must be properly reflected in the C header file tree.h
|
||||
-- source file must be properly reflected in the C header file atree.h
|
||||
|
||||
-- Package Atree defines the basic structure of the tree and its nodes and
|
||||
-- provides the basic abstract interface for manipulating the tree. Two
|
||||
|
|
@ -198,8 +198,8 @@ package Atree is
|
|||
-- Elist6 Synonym for Field6 typed as Elist_Id (Empty = No_Elist)
|
||||
-- Uint6 Synonym for Field6 typed as Uint (Empty = Uint_0)
|
||||
|
||||
-- Similar definitions for Field7 to Field27 (and Node7-Node27,
|
||||
-- Elist7-Elist27, Uint7-Uint27, Ureal7-Ureal27). Note that not all
|
||||
-- Similar definitions for Field7 to Field28 (and Node7-Node28,
|
||||
-- Elist7-Elist28, Uint7-Uint28, Ureal7-Ureal28). Note that not all
|
||||
-- these functions are defined, only the ones that are actually used.
|
||||
|
||||
type Paren_Count_Type is mod 4;
|
||||
|
|
@ -434,9 +434,9 @@ package Atree is
|
|||
|
||||
function New_Copy_Tree
|
||||
(Source : Node_Id;
|
||||
Map : Elist_Id := No_Elist;
|
||||
Map : Elist_Id := No_Elist;
|
||||
New_Sloc : Source_Ptr := No_Location;
|
||||
New_Scope : Entity_Id := Empty) return Node_Id;
|
||||
New_Scope : Entity_Id := Empty) return Node_Id;
|
||||
-- Given a node that is the root of a subtree, Copy_Tree copies the entire
|
||||
-- syntactic subtree, including recursively any descendents whose parent
|
||||
-- field references a copied node (descendents not linked to a copied node
|
||||
|
|
@ -860,6 +860,9 @@ package Atree is
|
|||
function Field27 (N : Node_Id) return Union_Id;
|
||||
pragma Inline (Field27);
|
||||
|
||||
function Field28 (N : Node_Id) return Union_Id;
|
||||
pragma Inline (Field28);
|
||||
|
||||
function Node1 (N : Node_Id) return Node_Id;
|
||||
pragma Inline (Node1);
|
||||
|
||||
|
|
@ -941,6 +944,9 @@ package Atree is
|
|||
function Node27 (N : Node_Id) return Node_Id;
|
||||
pragma Inline (Node27);
|
||||
|
||||
function Node28 (N : Node_Id) return Node_Id;
|
||||
pragma Inline (Node28);
|
||||
|
||||
function List1 (N : Node_Id) return List_Id;
|
||||
pragma Inline (List1);
|
||||
|
||||
|
|
@ -992,8 +998,8 @@ package Atree is
|
|||
function Elist23 (N : Node_Id) return Elist_Id;
|
||||
pragma Inline (Elist23);
|
||||
|
||||
function Elist24 (N : Node_Id) return Elist_Id;
|
||||
pragma Inline (Elist24);
|
||||
function Elist25 (N : Node_Id) return Elist_Id;
|
||||
pragma Inline (Elist25);
|
||||
|
||||
function Name1 (N : Node_Id) return Name_Id;
|
||||
pragma Inline (Name1);
|
||||
|
|
@ -1785,6 +1791,9 @@ package Atree is
|
|||
procedure Set_Field27 (N : Node_Id; Val : Union_Id);
|
||||
pragma Inline (Set_Field27);
|
||||
|
||||
procedure Set_Field28 (N : Node_Id; Val : Union_Id);
|
||||
pragma Inline (Set_Field28);
|
||||
|
||||
procedure Set_Node1 (N : Node_Id; Val : Node_Id);
|
||||
pragma Inline (Set_Node1);
|
||||
|
||||
|
|
@ -1866,6 +1875,9 @@ package Atree is
|
|||
procedure Set_Node27 (N : Node_Id; Val : Node_Id);
|
||||
pragma Inline (Set_Node27);
|
||||
|
||||
procedure Set_Node28 (N : Node_Id; Val : Node_Id);
|
||||
pragma Inline (Set_Node28);
|
||||
|
||||
procedure Set_List1 (N : Node_Id; Val : List_Id);
|
||||
pragma Inline (Set_List1);
|
||||
|
||||
|
|
@ -1917,8 +1929,8 @@ package Atree is
|
|||
procedure Set_Elist23 (N : Node_Id; Val : Elist_Id);
|
||||
pragma Inline (Set_Elist23);
|
||||
|
||||
procedure Set_Elist24 (N : Node_Id; Val : Elist_Id);
|
||||
pragma Inline (Set_Elist24);
|
||||
procedure Set_Elist25 (N : Node_Id; Val : Elist_Id);
|
||||
pragma Inline (Set_Elist25);
|
||||
|
||||
procedure Set_Name1 (N : Node_Id; Val : Name_Id);
|
||||
pragma Inline (Set_Name1);
|
||||
|
|
@ -2832,8 +2844,7 @@ package Atree is
|
|||
-- above is used to hold additional general fields and flags
|
||||
-- as follows:
|
||||
|
||||
-- Field6-9 Holds Field24-Field27
|
||||
-- Field10 currently unused, reserved for expansion
|
||||
-- Field6-10 Holds Field24-Field28
|
||||
-- Field11 Holds Flag184-Flag215
|
||||
-- Field12 currently unused, reserved for expansion
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
* *
|
||||
* C Header File *
|
||||
* *
|
||||
* Copyright (C) 1992-2005, Free Software Foundation, Inc. *
|
||||
* Copyright (C) 1992-2006, 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- *
|
||||
|
|
@ -382,6 +382,7 @@ extern Node_Id Current_Error_Node;
|
|||
#define Field25(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field7)
|
||||
#define Field26(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field8)
|
||||
#define Field27(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field9)
|
||||
#define Field28(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field10)
|
||||
|
||||
#define Node1(N) Field1 (N)
|
||||
#define Node2(N) Field2 (N)
|
||||
|
|
@ -410,6 +411,7 @@ extern Node_Id Current_Error_Node;
|
|||
#define Node25(N) Field25 (N)
|
||||
#define Node26(N) Field26 (N)
|
||||
#define Node27(N) Field27 (N)
|
||||
#define Node28(N) Field28 (N)
|
||||
|
||||
#define List1(N) Field1 (N)
|
||||
#define List2(N) Field2 (N)
|
||||
|
|
@ -429,7 +431,7 @@ extern Node_Id Current_Error_Node;
|
|||
#define Elist18(N) Field18 (N)
|
||||
#define Elist21(N) Field21 (N)
|
||||
#define Elist23(N) Field23 (N)
|
||||
#define Elist24(N) Field24 (N)
|
||||
#define Elist25(N) Field25 (N)
|
||||
|
||||
#define Name1(N) Field1 (N)
|
||||
#define Name2(N) Field2 (N)
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -80,6 +80,9 @@ package body Comperr is
|
|||
-- the FSF version of GNAT, but there are specializations for
|
||||
-- the GNATPRO and Public releases by AdaCore.
|
||||
|
||||
XF : constant Positive := X'First;
|
||||
-- Start index, usually 1, but we won't assume this
|
||||
|
||||
procedure End_Line;
|
||||
-- Add blanks up to column 76, and then a final vertical bar
|
||||
|
||||
|
|
@ -93,12 +96,14 @@ package body Comperr is
|
|||
Write_Eol;
|
||||
end End_Line;
|
||||
|
||||
Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
|
||||
Is_FSF_Version : constant Boolean := Get_Gnat_Build_Type = FSF;
|
||||
Is_GPL_Version : constant Boolean := Get_Gnat_Build_Type = GPL;
|
||||
Is_FSF_Version : constant Boolean := Get_Gnat_Build_Type = FSF;
|
||||
|
||||
-- Start of processing for Compiler_Abort
|
||||
|
||||
begin
|
||||
Cancel_Special_Output;
|
||||
|
||||
-- Prevent recursion through Compiler_Abort, e.g. via SIGSEGV
|
||||
|
||||
if Abort_In_Progress then
|
||||
|
|
@ -173,16 +178,16 @@ package body Comperr is
|
|||
Last_Blank : Integer := 70;
|
||||
|
||||
begin
|
||||
for P in 40 .. 69 loop
|
||||
if X (P) = ' ' then
|
||||
for P in 39 .. 68 loop
|
||||
if X (XF + P) = ' ' then
|
||||
Last_Blank := P;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
Write_Str (X (1 .. Last_Blank));
|
||||
Write_Str (X (XF .. XF - 1 + Last_Blank));
|
||||
End_Line;
|
||||
Write_Str ("| ");
|
||||
Write_Str (X (Last_Blank + 1 .. X'Length));
|
||||
Write_Str (X (XF + Last_Blank .. X'Last));
|
||||
end;
|
||||
else
|
||||
Write_Str (X);
|
||||
|
|
@ -267,12 +272,22 @@ package body Comperr is
|
|||
" http://gcc.gnu.org/bugs.html.");
|
||||
End_Line;
|
||||
|
||||
elsif Is_Public_Version then
|
||||
elsif Is_GPL_Version then
|
||||
|
||||
Write_Str
|
||||
("| submit bug report by email " &
|
||||
("| Please submit a bug report by email " &
|
||||
"to report@adacore.com.");
|
||||
End_Line;
|
||||
|
||||
Write_Str
|
||||
("| GAP members can alternatively use GNAT Tracker:");
|
||||
End_Line;
|
||||
|
||||
Write_Str
|
||||
("| http://www.adacore.com/ " &
|
||||
"section 'send a report'.");
|
||||
End_Line;
|
||||
|
||||
Write_Str
|
||||
("| See gnatinfo.txt for full info on procedure " &
|
||||
"for submitting bugs.");
|
||||
|
|
@ -290,7 +305,12 @@ package body Comperr is
|
|||
|
||||
Write_Str
|
||||
("| alternatively submit a bug report by email " &
|
||||
"to report@adacore.com.");
|
||||
"to report@adacore.com,");
|
||||
End_Line;
|
||||
|
||||
Write_Str
|
||||
("| including your customer number #nnn " &
|
||||
"in the subject line.");
|
||||
End_Line;
|
||||
end if;
|
||||
|
||||
|
|
@ -299,13 +319,6 @@ package body Comperr is
|
|||
" and us to track the bug.");
|
||||
End_Line;
|
||||
|
||||
if not (Is_Public_Version or Is_FSF_Version) then
|
||||
Write_Str
|
||||
("| Include your customer number #nnn " &
|
||||
"in the subject line.");
|
||||
End_Line;
|
||||
end if;
|
||||
|
||||
Write_Str
|
||||
("| Include the entire contents of this bug " &
|
||||
"box in the report.");
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -628,7 +628,7 @@ package body CStand is
|
|||
Set_Is_Character_Type (Standard_Wide_Wide_Character);
|
||||
Set_Is_Known_Valid (Standard_Wide_Wide_Character);
|
||||
Set_Size_Known_At_Compile_Time (Standard_Wide_Wide_Character);
|
||||
Set_Is_Ada_2005 (Standard_Wide_Wide_Character);
|
||||
Set_Is_Ada_2005_Only (Standard_Wide_Wide_Character);
|
||||
|
||||
-- Create the bounds for type Wide_Wide_Character
|
||||
|
||||
|
|
@ -743,14 +743,14 @@ package body CStand is
|
|||
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
|
||||
Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);
|
||||
|
||||
Set_Ekind (Standard_Wide_Wide_String, E_String_Type);
|
||||
Set_Etype (Standard_Wide_Wide_String,
|
||||
Standard_Wide_Wide_String);
|
||||
Set_Component_Type (Standard_Wide_Wide_String,
|
||||
Standard_Wide_Wide_Character);
|
||||
Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
|
||||
Init_Size_Align (Standard_Wide_Wide_String);
|
||||
Set_Is_Ada_2005 (Standard_Wide_Wide_String);
|
||||
Set_Ekind (Standard_Wide_Wide_String, E_String_Type);
|
||||
Set_Etype (Standard_Wide_Wide_String,
|
||||
Standard_Wide_Wide_String);
|
||||
Set_Component_Type (Standard_Wide_Wide_String,
|
||||
Standard_Wide_Wide_Character);
|
||||
Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
|
||||
Init_Size_Align (Standard_Wide_Wide_String);
|
||||
Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
|
||||
|
||||
-- Set index type of Wide_Wide_String
|
||||
|
||||
|
|
|
|||
|
|
@ -218,7 +218,7 @@ void __gnat_unsetenv (char *name) {
|
|||
#elif defined (__hpux__) || defined (sun) \
|
||||
|| (defined (__mips) && defined (__sgi)) \
|
||||
|| (defined (__vxworks) && ! defined (__RTP__)) \
|
||||
|| defined (_AIX)
|
||||
|| defined (_AIX) || defined (__Lynx__)
|
||||
|
||||
/* On Solaris, HP-UX and IRIX there is no function to clear an environment
|
||||
variable. So we look for the variable in the environ table and delete it
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -201,10 +201,8 @@ package Exp_Pakd is
|
|||
|
||||
-- 1-2-...-7-8 9-10-...15-16 17-18-19-20-x-x-x-x x-x-x-x-x-x-x-x
|
||||
|
||||
-- and now, we do indeed have the same representation. The special flag
|
||||
-- Is_Left_Justified_Modular is set in the modular type used as the
|
||||
-- packed array type in the big-endian case to ensure that this required
|
||||
-- left justification occurs.
|
||||
-- and now, we do indeed have the same representation for the memory
|
||||
-- version in the constrained and unconstrained cases.
|
||||
|
||||
-----------------
|
||||
-- Subprograms --
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -238,6 +238,21 @@ package body Exp_Tss is
|
|||
return Make_TSS_Name (Typ, TSS_Init_Proc);
|
||||
end Make_Init_Proc_Name;
|
||||
|
||||
-------------------
|
||||
-- Make_TSS_Name --
|
||||
-------------------
|
||||
|
||||
function Make_TSS_Name
|
||||
(Typ : Entity_Id;
|
||||
Nam : TSS_Name_Type) return Name_Id
|
||||
is
|
||||
begin
|
||||
Get_Name_String (Chars (Typ));
|
||||
Add_Char_To_Name_Buffer (Nam (1));
|
||||
Add_Char_To_Name_Buffer (Nam (2));
|
||||
return Name_Find;
|
||||
end Make_TSS_Name;
|
||||
|
||||
-------------------------
|
||||
-- Make_TSS_Name_Local --
|
||||
-------------------------
|
||||
|
|
@ -255,21 +270,6 @@ package body Exp_Tss is
|
|||
return Name_Find;
|
||||
end Make_TSS_Name_Local;
|
||||
|
||||
-------------------
|
||||
-- Make_TSS_Name --
|
||||
-------------------
|
||||
|
||||
function Make_TSS_Name
|
||||
(Typ : Entity_Id;
|
||||
Nam : TSS_Name_Type) return Name_Id
|
||||
is
|
||||
begin
|
||||
Get_Name_String (Chars (Typ));
|
||||
Add_Char_To_Name_Buffer (Nam (1));
|
||||
Add_Char_To_Name_Buffer (Nam (2));
|
||||
return Name_Find;
|
||||
end Make_TSS_Name;
|
||||
|
||||
--------------
|
||||
-- Same_TSS --
|
||||
--------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
* *
|
||||
* C Header File *
|
||||
* *
|
||||
* Copyright (C) 1992-2005, Free Software Foundation, Inc. *
|
||||
* Copyright (C) 1992-2006, 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- *
|
||||
|
|
@ -167,12 +167,10 @@ extern Boolean Back_Annotate_Rep_Info;
|
|||
#define No_Exception_Handlers_Set restrict__no_exception_handlers_set
|
||||
#define Check_No_Implicit_Heap_Alloc restrict__check_no_implicit_heap_alloc
|
||||
#define Check_Elaboration_Code_Allowed restrict__check_elaboration_code_allowed
|
||||
#define Check_No_Implicit_Heap_Alloc restrict__check_no_implicit_heap_alloc
|
||||
|
||||
extern Boolean No_Exception_Handlers_Set (void);
|
||||
extern void Check_No_Implicit_Heap_Alloc (Node_Id);
|
||||
extern void Check_Elaboration_Code_Allowed (Node_Id);
|
||||
extern void Check_No_Implicit_Heap_Alloc (Node_Id);
|
||||
|
||||
/* sem_elim: */
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2006, 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- --
|
||||
|
|
@ -200,6 +200,20 @@ package body Fmap is
|
|||
Last_In_Table := 0;
|
||||
end Empty_Tables;
|
||||
|
||||
---------------
|
||||
-- Find_Name --
|
||||
---------------
|
||||
|
||||
function Find_Name return Name_Id is
|
||||
begin
|
||||
if Name_Buffer (1 .. Name_Len) = "/" then
|
||||
return Error_Name;
|
||||
|
||||
else
|
||||
return Name_Find;
|
||||
end if;
|
||||
end Find_Name;
|
||||
|
||||
--------------
|
||||
-- Get_Line --
|
||||
--------------
|
||||
|
|
@ -236,20 +250,6 @@ package body Fmap is
|
|||
end if;
|
||||
end Get_Line;
|
||||
|
||||
---------------
|
||||
-- Find_Name --
|
||||
---------------
|
||||
|
||||
function Find_Name return Name_Id is
|
||||
begin
|
||||
if Name_Buffer (1 .. Name_Len) = "/" then
|
||||
return Error_Name;
|
||||
|
||||
else
|
||||
return Name_Find;
|
||||
end if;
|
||||
end Find_Name;
|
||||
|
||||
----------------------
|
||||
-- Report_Truncated --
|
||||
----------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2003-2005, AdaCore --
|
||||
-- Copyright (C) 2003-2006, AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -71,7 +71,7 @@ package GNAT.Bounded_Mailboxes is
|
|||
|
||||
-- Protected type Mailbox has the following inherited interface:
|
||||
|
||||
-- entry Insert (Item : in Message_Reference);
|
||||
-- entry Insert (Item : Message_Reference);
|
||||
-- Insert Item into the Mailbox. Blocks caller
|
||||
-- until space is available.
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2005, AdaCore --
|
||||
-- Copyright (C) 2001-2006, AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -188,6 +188,7 @@ package body GNAT.CGI is
|
|||
Data : constant String := Metavariable (Query_String);
|
||||
begin
|
||||
Current_Method := Get;
|
||||
|
||||
if Data /= "" then
|
||||
Set_Parameter_Table (Data);
|
||||
end if;
|
||||
|
|
@ -335,9 +336,8 @@ package body GNAT.CGI is
|
|||
---------------------
|
||||
|
||||
function Get_Environment (Variable_Name : String) return String is
|
||||
Value : OS_Lib.String_Access := OS_Lib.Getenv (Variable_Name);
|
||||
Value : OS_Lib.String_Access := OS_Lib.Getenv (Variable_Name);
|
||||
Result : constant String := Value.all;
|
||||
|
||||
begin
|
||||
OS_Lib.Free (Value);
|
||||
return Result;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, AdaCore --
|
||||
-- Copyright (C) 2000-2006, AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -68,7 +68,7 @@
|
|||
-- procedure New_Client is
|
||||
-- use GNAT;
|
||||
|
||||
-- procedure Add_Client_To_Database (Name : in String) is
|
||||
-- procedure Add_Client_To_Database (Name : String) is
|
||||
-- begin
|
||||
-- ...
|
||||
-- end Add_Client_To_Database;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2003-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2003-2006, 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- --
|
||||
|
|
@ -54,17 +54,17 @@ procedure Core_Dump (Occurrence : Exception_Occurrence) is
|
|||
|
||||
procedure Setexv (
|
||||
Status : out Cond_Value_Type;
|
||||
Vector : in Unsigned_Longword := 0;
|
||||
Addres : in Address := Address_Zero;
|
||||
Acmode : in Access_Mode_Type := Access_Mode_Zero;
|
||||
Prvhnd : in Unsigned_Longword := 0);
|
||||
Vector : Unsigned_Longword := 0;
|
||||
Addres : Address := Address_Zero;
|
||||
Acmode : Access_Mode_Type := Access_Mode_Zero;
|
||||
Prvhnd : Unsigned_Longword := 0);
|
||||
pragma Interface (External, Setexv);
|
||||
pragma Import_Valued_Procedure (Setexv, "SYS$SETEXV",
|
||||
(Cond_Value_Type, Unsigned_Longword, Address, Access_Mode_Type,
|
||||
Unsigned_Longword),
|
||||
(Value, Value, Value, Value, Value));
|
||||
|
||||
procedure Lib_Signal (I : in Integer);
|
||||
procedure Lib_Signal (I : Integer);
|
||||
pragma Interface (C, Lib_Signal);
|
||||
pragma Import_Procedure (Lib_Signal, "LIB$SIGNAL", Mechanism => (Value));
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2005, AdaCore --
|
||||
-- Copyright (C) 2002-2006, AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -1058,8 +1058,8 @@ package body GNAT.Expect is
|
|||
Pipe1 : in out Pipe_Type;
|
||||
Pipe2 : in out Pipe_Type;
|
||||
Pipe3 : in out Pipe_Type;
|
||||
Cmd : in String;
|
||||
Args : in System.Address)
|
||||
Cmd : String;
|
||||
Args : System.Address)
|
||||
is
|
||||
pragma Warnings (Off, Pid);
|
||||
|
||||
|
|
|
|||
|
|
@ -1970,6 +1970,7 @@ package body GNAT.Perfect_Hash_Generators is
|
|||
-- position selection plus Pos. Once this routine is called, reduced
|
||||
-- words are sorted by subsets and each item (First, Last) in Sets
|
||||
-- defines the range of identical keys.
|
||||
-- Need comment saying exactly what Last is ???
|
||||
|
||||
function Count_Different_Keys
|
||||
(Table : Vertex_Table_Type;
|
||||
|
|
@ -1991,9 +1992,9 @@ package body GNAT.Perfect_Hash_Generators is
|
|||
Last : in out Natural;
|
||||
Pos : Natural)
|
||||
is
|
||||
S : constant Vertex_Table_Type := Table (1 .. Last);
|
||||
S : constant Vertex_Table_Type := Table (Table'First .. Last);
|
||||
C : constant Natural := Pos;
|
||||
-- Shortcuts
|
||||
-- Shortcuts (why are these not renames ???)
|
||||
|
||||
F : Integer;
|
||||
L : Integer;
|
||||
|
|
|
|||
|
|
@ -684,9 +684,12 @@ package body GNAT.Regpat is
|
|||
Operand : Pointer;
|
||||
Greedy : Boolean := True)
|
||||
is
|
||||
Dest : constant Pointer := Emit_Ptr;
|
||||
Old : Pointer;
|
||||
Size : Pointer := 3;
|
||||
Dest : constant Pointer := Emit_Ptr;
|
||||
Old : Pointer;
|
||||
Size : Pointer := 3;
|
||||
|
||||
Discard : Pointer;
|
||||
pragma Warnings (Off, Discard);
|
||||
|
||||
begin
|
||||
-- If not greedy, we have to emit another opcode first
|
||||
|
|
@ -713,7 +716,7 @@ package body GNAT.Regpat is
|
|||
Link_Tail (Old, Old + 3);
|
||||
end if;
|
||||
|
||||
Old := Emit_Node (Op);
|
||||
Discard := Emit_Node (Op);
|
||||
Emit_Ptr := Dest + Size;
|
||||
end Insert_Operator;
|
||||
|
||||
|
|
@ -2364,21 +2367,23 @@ package body GNAT.Regpat is
|
|||
-----------
|
||||
|
||||
procedure Match
|
||||
(Self : Pattern_Matcher;
|
||||
Data : String;
|
||||
Matches : out Match_Array;
|
||||
(Self : Pattern_Matcher;
|
||||
Data : String;
|
||||
Matches : out Match_Array;
|
||||
Data_First : Integer := -1;
|
||||
Data_Last : Positive := Positive'Last)
|
||||
is
|
||||
Program : Program_Data renames Self.Program; -- Shorter notation
|
||||
pragma Assert (Matches'First = 0);
|
||||
|
||||
Program : Program_Data renames Self.Program; -- Shorter notation
|
||||
|
||||
First_In_Data : constant Integer := Integer'Max (Data_First, Data'First);
|
||||
Last_In_Data : constant Integer := Integer'Min (Data_Last, Data'Last);
|
||||
|
||||
-- Global work variables
|
||||
|
||||
Input_Pos : Natural; -- String-input pointer
|
||||
BOL_Pos : Natural; -- Beginning of input, for ^ check
|
||||
Input_Pos : Natural; -- String-input pointer
|
||||
BOL_Pos : Natural; -- Beginning of input, for ^ check
|
||||
Matched : Boolean := False; -- Until proven True
|
||||
|
||||
Matches_Full : Match_Array (0 .. Natural'Max (Self.Paren_Count,
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1986 by University of Toronto. --
|
||||
-- Copyright (C) 1996-2005, AdaCore --
|
||||
-- Copyright (C) 1996-2006, AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -583,7 +583,8 @@ package GNAT.Regpat is
|
|||
Data_First : Integer := -1;
|
||||
Data_Last : Positive := Positive'Last);
|
||||
-- Match Data using the given pattern matcher and store result in Matches.
|
||||
-- The expression matches if Matches (0) /= No_Match.
|
||||
-- The expression matches if Matches (0) /= No_Match. The lower bound of
|
||||
-- Matches is required to be zero.
|
||||
--
|
||||
-- At most Matches'Length parenthesis are returned
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1998-2005 AdaCore --
|
||||
-- Copyright (C) 1998-2006 AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -128,6 +128,7 @@ package body GNAT.Threads is
|
|||
T : Tasking.Task_Id;
|
||||
|
||||
use type Tasking.Task_Id;
|
||||
use type System.OS_Interface.Thread_Id;
|
||||
|
||||
begin
|
||||
STPO.Lock_RTS;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2005-2006, 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- --
|
||||
|
|
@ -69,7 +69,7 @@ package body GNAT.Traceback.Symbolic is
|
|||
|
||||
procedure Symbolize
|
||||
(Status : out Cond_Value_Type;
|
||||
Current_PC : in Address;
|
||||
Current_PC : Address;
|
||||
Filename_Name : out Address;
|
||||
Library_Name : out Address;
|
||||
Record_Number : out Integer;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -42,6 +42,15 @@ package body Get_Targ is
|
|||
end if;
|
||||
end Digits_From_Size;
|
||||
|
||||
-----------------------------
|
||||
-- Get_Max_Unaligned_Field --
|
||||
-----------------------------
|
||||
|
||||
function Get_Max_Unaligned_Field return Pos is
|
||||
begin
|
||||
return 64; -- Can be different on some targets (e.g., AAMP)
|
||||
end Get_Max_Unaligned_Field;
|
||||
|
||||
---------------------
|
||||
-- Width_From_Size --
|
||||
---------------------
|
||||
|
|
@ -57,13 +66,4 @@ package body Get_Targ is
|
|||
end if;
|
||||
end Width_From_Size;
|
||||
|
||||
-----------------------------
|
||||
-- Get_Max_Unaligned_Field --
|
||||
-----------------------------
|
||||
|
||||
function Get_Max_Unaligned_Field return Pos is
|
||||
begin
|
||||
return 64; -- Can be different on some targets (e.g., AAMP)
|
||||
end Get_Max_Unaligned_Field;
|
||||
|
||||
end Get_Targ;
|
||||
|
|
|
|||
|
|
@ -85,7 +85,7 @@ procedure Gnatbind is
|
|||
procedure Scan_Bind_Arg (Argv : String);
|
||||
-- Scan and process binder specific arguments. Argv is a single argument.
|
||||
-- All the one character arguments are still handled by Switch. This
|
||||
-- routine handles -aO -aI and -I-.
|
||||
-- routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
|
||||
|
||||
function Is_Cross_Compiler return Boolean;
|
||||
-- Returns True iff this is a cross-compiler
|
||||
|
|
@ -206,6 +206,8 @@ procedure Gnatbind is
|
|||
-------------------
|
||||
|
||||
procedure Scan_Bind_Arg (Argv : String) is
|
||||
pragma Assert (Argv'First = 1);
|
||||
|
||||
begin
|
||||
-- Now scan arguments that are specific to the binder and are not
|
||||
-- handled by the common circuitry in Switch.
|
||||
|
|
@ -420,11 +422,11 @@ begin
|
|||
Scan_Args : while Next_Arg < Arg_Count loop
|
||||
declare
|
||||
Next_Argv : String (1 .. Len_Arg (Next_Arg));
|
||||
|
||||
begin
|
||||
Fill_Arg (Next_Argv'Address, Next_Arg);
|
||||
Scan_Bind_Arg (Next_Argv);
|
||||
end;
|
||||
|
||||
Next_Arg := Next_Arg + 1;
|
||||
end loop Scan_Args;
|
||||
|
||||
|
|
@ -449,7 +451,7 @@ begin
|
|||
-- Output usage if requested
|
||||
|
||||
if Usage_Requested then
|
||||
Bindusg;
|
||||
Bindusg.Display;
|
||||
end if;
|
||||
|
||||
-- Check that the Ada binder file specified has extension .adb and that
|
||||
|
|
@ -535,7 +537,7 @@ begin
|
|||
-- Output usage information if no files
|
||||
|
||||
if not More_Lib_Files then
|
||||
Bindusg;
|
||||
Bindusg.Display;
|
||||
Exit_Program (E_Fatal);
|
||||
end if;
|
||||
|
||||
|
|
@ -600,8 +602,8 @@ begin
|
|||
|
||||
-- Set standard configuration parameters
|
||||
|
||||
Suppress_Standard_Library_On_Target := True;
|
||||
Configurable_Run_Time_Mode := True;
|
||||
Suppress_Standard_Library_On_Target := True;
|
||||
Configurable_Run_Time_Mode := True;
|
||||
end if;
|
||||
|
||||
-- For main ALI files, even if they are interfaces, we get their
|
||||
|
|
|
|||
|
|
@ -253,6 +253,12 @@ procedure Gnatdll is
|
|||
end loop;
|
||||
|
||||
Close (File);
|
||||
|
||||
exception
|
||||
when Name_Error =>
|
||||
Raise_Exception
|
||||
(Syntax_Error'Identity,
|
||||
"list-of-files file " & List_Filename & " not found.");
|
||||
end Add_Files_From_List;
|
||||
|
||||
-- Start of processing for Parse_Command_Line
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -579,7 +579,6 @@ package body Inline is
|
|||
end loop;
|
||||
|
||||
Comp_Unit := Parent (Pack);
|
||||
|
||||
while Present (Comp_Unit)
|
||||
and then Nkind (Comp_Unit) /= N_Compilation_Unit
|
||||
loop
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -93,14 +93,14 @@ package body Itypes is
|
|||
Set_Etype (I_Typ, T);
|
||||
Init_Size_Align (I_Typ);
|
||||
Set_Depends_On_Private (I_Typ, Depends_On_Private (T));
|
||||
Set_Is_Public (I_Typ, Is_Public (T));
|
||||
Set_From_With_Type (I_Typ, From_With_Type (T));
|
||||
Set_Is_Public (I_Typ, Is_Public (T));
|
||||
Set_From_With_Type (I_Typ, From_With_Type (T));
|
||||
Set_Is_Access_Constant (I_Typ, Is_Access_Constant (T));
|
||||
Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T));
|
||||
Set_Is_Volatile (I_Typ, Is_Volatile (T));
|
||||
Set_Treat_As_Volatile (I_Typ, Treat_As_Volatile (T));
|
||||
Set_Is_Atomic (I_Typ, Is_Atomic (T));
|
||||
Set_Is_Ada_2005 (I_Typ, Is_Ada_2005 (T));
|
||||
Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T));
|
||||
Set_Is_Volatile (I_Typ, Is_Volatile (T));
|
||||
Set_Treat_As_Volatile (I_Typ, Treat_As_Volatile (T));
|
||||
Set_Is_Atomic (I_Typ, Is_Atomic (T));
|
||||
Set_Is_Ada_2005_Only (I_Typ, Is_Ada_2005_Only (T));
|
||||
Set_Can_Never_Be_Null (I_Typ);
|
||||
|
||||
return I_Typ;
|
||||
|
|
|
|||
|
|
@ -61,6 +61,10 @@ Wmissing-format-attribute
|
|||
Ada
|
||||
; Documented for C
|
||||
|
||||
Woverlength-strings
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
nostdinc
|
||||
Ada RejectNegative
|
||||
; Don't look for source files
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2006, 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- --
|
||||
|
|
@ -135,6 +135,9 @@ package body Makeutl is
|
|||
Finish : Natural := Argv'Last;
|
||||
Equal_Pos : Natural;
|
||||
|
||||
pragma Assert (Argv'First = 1);
|
||||
pragma Assert (Argv (1 .. 2) = "-X");
|
||||
|
||||
begin
|
||||
if Argv'Last < 5 then
|
||||
return False;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -250,7 +250,7 @@ package body MDLL.Utl is
|
|||
if not Success then
|
||||
declare
|
||||
Base_Name : constant String :=
|
||||
Directory_Operations.Base_Name (Alis (1).all, ".ali");
|
||||
Directory_Operations.Base_Name (Alis (Alis'First).all, ".ali");
|
||||
begin
|
||||
OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
|
||||
OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
|
||||
|
|
|
|||
|
|
@ -394,6 +394,8 @@ package body MDLL is
|
|||
raise;
|
||||
end Ada_Build_Non_Reloc_DLL;
|
||||
|
||||
-- Start of processing for Build_Dynamic_Library
|
||||
|
||||
begin
|
||||
-- On Windows the binder file must not be in the first position in the
|
||||
-- list. This is due to the way DLL's are built on Windows. We swap the
|
||||
|
|
@ -402,13 +404,14 @@ package body MDLL is
|
|||
if L_Afiles'Length > 1 then
|
||||
declare
|
||||
Filename : constant String :=
|
||||
Directory_Operations.Base_Name (L_Afiles (1).all);
|
||||
Directory_Operations.Base_Name
|
||||
(L_Afiles (L_Afiles'First).all);
|
||||
First : constant Positive := Filename'First;
|
||||
|
||||
begin
|
||||
if Filename (First .. First + 1) = "b~" then
|
||||
L_Afiles (L_Afiles'Last) := Afiles (1);
|
||||
L_Afiles (1) := Afiles (Afiles'Last);
|
||||
L_Afiles (L_Afiles'Last) := Afiles (Afiles'First);
|
||||
L_Afiles (L_Afiles'First) := Afiles (Afiles'Last);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
|
@ -438,7 +441,6 @@ package body MDLL is
|
|||
(Lib_Filename : String;
|
||||
Def_Filename : String)
|
||||
is
|
||||
|
||||
procedure Build_Import_Library (Lib_Filename : String);
|
||||
-- Build an import library. This is to build only a .a library to link
|
||||
-- against a DLL.
|
||||
|
|
@ -472,8 +474,12 @@ package body MDLL is
|
|||
-- convention and we try as much as possible to follow the platform
|
||||
-- convention.
|
||||
|
||||
if Lib_Filename'Length > 3 and then Lib_Filename (1 .. 3) = "lib" then
|
||||
Build_Import_Library (Lib_Filename (4 .. Lib_Filename'Last));
|
||||
if Lib_Filename'Length > 3
|
||||
and then
|
||||
Lib_Filename (Lib_Filename'First .. Lib_Filename'First + 2) = "lib"
|
||||
then
|
||||
Build_Import_Library
|
||||
(Lib_Filename (Lib_Filename'First + 3 .. Lib_Filename'Last));
|
||||
else
|
||||
Build_Import_Library (Lib_Filename);
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- T e m p l a t e --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2006 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- --
|
||||
|
|
@ -30,12 +30,6 @@ with Targparm; use Targparm;
|
|||
|
||||
package body Osint.B is
|
||||
|
||||
Binder_Output_Time_Stamps_Set : Boolean := False;
|
||||
|
||||
Old_Binder_Output_Time_Stamp : Time_Stamp_Type;
|
||||
New_Binder_Output_Time_Stamp : Time_Stamp_Type;
|
||||
Recording_Time_From_Last_Bind : Boolean := False;
|
||||
|
||||
-------------------------
|
||||
-- Close_Binder_Output --
|
||||
-------------------------
|
||||
|
|
@ -51,10 +45,6 @@ package body Osint.B is
|
|||
Get_Name_String (Output_File_Name));
|
||||
end if;
|
||||
|
||||
if Recording_Time_From_Last_Bind then
|
||||
New_Binder_Output_Time_Stamp := File_Stamp (Output_File_Name);
|
||||
Binder_Output_Time_Stamps_Set := True;
|
||||
end if;
|
||||
end Close_Binder_Output;
|
||||
|
||||
--------------------------
|
||||
|
|
@ -164,10 +154,6 @@ package body Osint.B is
|
|||
|
||||
Bfile := Name_Find;
|
||||
|
||||
if Recording_Time_From_Last_Bind then
|
||||
Old_Binder_Output_Time_Stamp := File_Stamp (Bfile);
|
||||
end if;
|
||||
|
||||
Create_File_And_Check (Output_FD, Text);
|
||||
end Create_Binder_Output;
|
||||
|
||||
|
|
@ -183,80 +169,6 @@ package body Osint.B is
|
|||
|
||||
function Next_Main_Lib_File return File_Name_Type renames Next_Main_File;
|
||||
|
||||
--------------------------------
|
||||
-- Record_Time_From_Last_Bind --
|
||||
--------------------------------
|
||||
|
||||
procedure Record_Time_From_Last_Bind is
|
||||
begin
|
||||
Recording_Time_From_Last_Bind := True;
|
||||
end Record_Time_From_Last_Bind;
|
||||
|
||||
-------------------------
|
||||
-- Time_From_Last_Bind --
|
||||
-------------------------
|
||||
|
||||
function Time_From_Last_Bind return Nat is
|
||||
Old_Y : Nat;
|
||||
Old_M : Nat;
|
||||
Old_D : Nat;
|
||||
Old_H : Nat;
|
||||
Old_Mi : Nat;
|
||||
Old_S : Nat;
|
||||
New_Y : Nat;
|
||||
New_M : Nat;
|
||||
New_D : Nat;
|
||||
New_H : Nat;
|
||||
New_Mi : Nat;
|
||||
New_S : Nat;
|
||||
|
||||
type Month_Data is array (Int range 1 .. 12) of Int;
|
||||
Cumul : constant Month_Data := (0, 0, 3, 3, 4, 4, 5, 5, 5, 6, 6, 7);
|
||||
-- Represents the difference in days from a period compared to the
|
||||
-- same period if all months had 31 days, i.e:
|
||||
--
|
||||
-- Cumul (m) = 31x(m-1) - (number of days from 01/01 to m/01)
|
||||
|
||||
Res : Int;
|
||||
|
||||
begin
|
||||
if not Recording_Time_From_Last_Bind
|
||||
or else not Binder_Output_Time_Stamps_Set
|
||||
or else Old_Binder_Output_Time_Stamp = Empty_Time_Stamp
|
||||
then
|
||||
return Nat'Last;
|
||||
end if;
|
||||
|
||||
Split_Time_Stamp
|
||||
(Old_Binder_Output_Time_Stamp,
|
||||
Old_Y, Old_M, Old_D, Old_H, Old_Mi, Old_S);
|
||||
|
||||
Split_Time_Stamp
|
||||
(New_Binder_Output_Time_Stamp,
|
||||
New_Y, New_M, New_D, New_H, New_Mi, New_S);
|
||||
|
||||
Res := New_Mi - Old_Mi;
|
||||
|
||||
-- 60 minutes in an hour
|
||||
|
||||
Res := Res + 60 * (New_H - Old_H);
|
||||
|
||||
-- 24 hours in a day
|
||||
|
||||
Res := Res + 60 * 24 * (New_D - Old_D);
|
||||
|
||||
-- Almost 31 days in a month
|
||||
|
||||
Res := Res + 60 * 24 *
|
||||
(31 * (New_M - Old_M) - Cumul (New_M) + Cumul (Old_M));
|
||||
|
||||
-- 365 days in a year
|
||||
|
||||
Res := Res + 60 * 24 * 365 * (New_Y - Old_Y);
|
||||
|
||||
return Res;
|
||||
end Time_From_Last_Bind;
|
||||
|
||||
-----------------------
|
||||
-- Write_Binder_Info --
|
||||
-----------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2001 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2006 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- --
|
||||
|
|
@ -29,10 +29,6 @@
|
|||
|
||||
package Osint.B is
|
||||
|
||||
procedure Record_Time_From_Last_Bind;
|
||||
-- Trigger the computing of the time from the last bind of the same
|
||||
-- program.
|
||||
|
||||
function More_Lib_Files return Boolean;
|
||||
-- Indicates whether more library information files remain to be processed.
|
||||
-- Returns False right away if no source files, or if all source files
|
||||
|
|
@ -45,20 +41,6 @@ package Osint.B is
|
|||
-- called only if a previous call to More_Lib_Files returned True). This
|
||||
-- name is the simple name, excluding any directory information.
|
||||
|
||||
function Time_From_Last_Bind return Nat;
|
||||
-- This function give an approximate number of minute from the last bind.
|
||||
-- It bases its computation on file stamp and therefore does gibe not
|
||||
-- any meaningful result before the new output binder file is written.
|
||||
-- So it returns Nat'last if:
|
||||
--
|
||||
-- - it is the first bind of this specific program
|
||||
-- - Record_Time_From_Last_Bind was not Called first
|
||||
-- - Close_Binder_Output was not called first
|
||||
--
|
||||
-- otherwise it returns the number of minutes from the last bind. The
|
||||
-- computation does not try to be completely accurate and in particular
|
||||
-- does not take leap years into account.
|
||||
|
||||
-------------------
|
||||
-- Binder Output --
|
||||
-------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -58,6 +58,15 @@ package body Output is
|
|||
Special_Output_Proc := null;
|
||||
end Cancel_Special_Output;
|
||||
|
||||
------------
|
||||
-- Column --
|
||||
------------
|
||||
|
||||
function Column return Pos is
|
||||
begin
|
||||
return Pos (Next_Col);
|
||||
end Column;
|
||||
|
||||
------------------
|
||||
-- Flush_Buffer --
|
||||
------------------
|
||||
|
|
@ -100,15 +109,6 @@ package body Output is
|
|||
end if;
|
||||
end Flush_Buffer;
|
||||
|
||||
------------
|
||||
-- Column --
|
||||
------------
|
||||
|
||||
function Column return Pos is
|
||||
begin
|
||||
return Pos (Next_Col);
|
||||
end Column;
|
||||
|
||||
---------------------------
|
||||
-- Restore_Output_Buffer --
|
||||
---------------------------
|
||||
|
|
@ -240,8 +240,12 @@ package body Output is
|
|||
Write_Eol;
|
||||
end if;
|
||||
|
||||
Buffer (Next_Col) := C;
|
||||
Next_Col := Next_Col + 1;
|
||||
if C = ASCII.LF then
|
||||
Write_Eol;
|
||||
else
|
||||
Buffer (Next_Col) := C;
|
||||
Next_Col := Next_Col + 1;
|
||||
end if;
|
||||
end Write_Char;
|
||||
|
||||
---------------
|
||||
|
|
@ -295,6 +299,17 @@ package body Output is
|
|||
Write_Eol;
|
||||
end Write_Line;
|
||||
|
||||
------------------
|
||||
-- Write_Spaces --
|
||||
------------------
|
||||
|
||||
procedure Write_Spaces (N : Nat) is
|
||||
begin
|
||||
for J in 1 .. N loop
|
||||
Write_Char (' ');
|
||||
end loop;
|
||||
end Write_Spaces;
|
||||
|
||||
---------------
|
||||
-- Write_Str --
|
||||
---------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -101,11 +101,15 @@ package Output is
|
|||
-- Write an integer value with no leading blanks or zeroes. Negative
|
||||
-- values are preceded by a minus sign).
|
||||
|
||||
procedure Write_Spaces (N : Nat);
|
||||
-- Write N spaces
|
||||
|
||||
procedure Write_Str (S : String);
|
||||
-- Write a string of characters to the standard output file. Note that
|
||||
-- end of line is handled separately using WRITE_EOL, so the string
|
||||
-- should not contain either of the characters LF or CR, but it may
|
||||
-- contain horizontal tab characters.
|
||||
-- end of line is normally handled separately using WRITE_EOL, but it
|
||||
-- is allowed for the string to contain LF (but not CR) characters,
|
||||
-- which are properly interpreted as end of line characters. The string
|
||||
-- may also contain horizontal tab characters.
|
||||
|
||||
procedure Write_Line (S : String);
|
||||
-- Equivalent to Write_Str (S) followed by Write_Eol;
|
||||
|
|
@ -144,7 +148,7 @@ package Output is
|
|||
-- names, precisely to make sure that they are only used for debugging!
|
||||
|
||||
procedure w (C : Character);
|
||||
-- Dump quote, character quote, followed by line return
|
||||
-- Dump quote, character, quote, followed by line return
|
||||
|
||||
procedure w (S : String);
|
||||
-- Dump string followed by line return
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2006, 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- --
|
||||
|
|
@ -110,7 +110,7 @@ package Prj.Attr is
|
|||
-- The type to refers to an attribute, self-initialized
|
||||
|
||||
Empty_Attribute : constant Attribute_Node_Id;
|
||||
-- Indicates no attribute. Default value of Attribute_Node_Id objects.
|
||||
-- Indicates no attribute. Default value of Attribute_Node_Id objects
|
||||
|
||||
Attribute_First : constant Attribute_Node_Id;
|
||||
-- First attribute node id of project level attributes
|
||||
|
|
@ -205,7 +205,7 @@ private
|
|||
----------------
|
||||
|
||||
Attributes_Initial : constant := 50;
|
||||
Attributes_Increment : constant := 50;
|
||||
Attributes_Increment : constant := 100;
|
||||
|
||||
Attribute_Node_Low_Bound : constant := 0;
|
||||
Attribute_Node_High_Bound : constant := 099_999_999;
|
||||
|
|
@ -235,7 +235,7 @@ private
|
|||
--------------
|
||||
|
||||
Packages_Initial : constant := 10;
|
||||
Packages_Increment : constant := 50;
|
||||
Packages_Increment : constant := 100;
|
||||
|
||||
Package_Node_Low_Bound : constant := 0;
|
||||
Package_Node_High_Bound : constant := 099_999_999;
|
||||
|
|
|
|||
|
|
@ -517,7 +517,7 @@ package body System.AST_Handling is
|
|||
----------------------------
|
||||
|
||||
procedure Expand_AST_Packet_Pool
|
||||
(Requested_Packets : in Natural;
|
||||
(Requested_Packets : Natural;
|
||||
Actual_Number : out Natural;
|
||||
Total_Number : out Natural)
|
||||
is
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1995-2005 AdaCore --
|
||||
-- Copyright (C) 1995-2006, AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -48,9 +48,9 @@ package body System.HTable is
|
|||
Iterator_Started : Boolean := False;
|
||||
|
||||
function Get_Non_Null return Elmt_Ptr;
|
||||
-- Returns Null_Ptr if Iterator_Started is false of the Table is
|
||||
-- empty. Returns Iterator_Ptr if non null, or the next non null
|
||||
-- element in table if any.
|
||||
-- Returns Null_Ptr if Iterator_Started is false or the Table is empty.
|
||||
-- Returns Iterator_Ptr if non null, or the next non null element in
|
||||
-- table if any.
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -41,8 +41,7 @@ package body System.Img_Dec is
|
|||
|
||||
function Image_Decimal
|
||||
(V : Integer;
|
||||
Scale : Integer)
|
||||
return String
|
||||
Scale : Integer) return String
|
||||
is
|
||||
P : Natural := 0;
|
||||
S : String (1 .. 64);
|
||||
|
|
@ -76,10 +75,10 @@ package body System.Img_Dec is
|
|||
Aft : Natural;
|
||||
Exp : Natural)
|
||||
is
|
||||
Minus : constant Boolean := (Digs (1) = '-');
|
||||
Minus : constant Boolean := (Digs (Digs'First) = '-');
|
||||
-- Set True if input is negative
|
||||
|
||||
Zero : Boolean := (Digs (2) = '0');
|
||||
Zero : Boolean := (Digs (Digs'First + 1) = '0');
|
||||
-- Set True if input is exactly zero (only case when a leading zero
|
||||
-- is permitted in the input string given to this procedure). This
|
||||
-- flag can get set later if rounding causes the value to become zero.
|
||||
|
|
@ -147,10 +146,10 @@ package body System.Img_Dec is
|
|||
-- The result is zero, unless we are rounding just before
|
||||
-- the first digit, and the first digit is five or more.
|
||||
|
||||
if N = 1 and then Digs (2) >= '5' then
|
||||
Digs (1) := '1';
|
||||
if N = 1 and then Digs (Digs'First + 1) >= '5' then
|
||||
Digs (Digs'First) := '1';
|
||||
else
|
||||
Digs (1) := '0';
|
||||
Digs (Digs'First) := '0';
|
||||
Zero := True;
|
||||
end if;
|
||||
|
||||
|
|
@ -181,7 +180,7 @@ package body System.Img_Dec is
|
|||
-- OK, because we already captured the value of the sign and
|
||||
-- we are in any case destroying the value in the Digs buffer
|
||||
|
||||
Digs (1) := '1';
|
||||
Digs (Digs'First) := '1';
|
||||
FD := 1;
|
||||
ND := ND + 1;
|
||||
Digits_Before_Point := Digits_Before_Point + 1;
|
||||
|
|
|
|||
|
|
@ -295,7 +295,7 @@ begin
|
|||
|
||||
end loop;
|
||||
|
||||
-- Setup the masks to be exported.
|
||||
-- Setup the masks to be exported
|
||||
|
||||
Result := sigemptyset (mask'Access);
|
||||
pragma Assert (Result = 0);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -89,8 +89,7 @@ package System.Machine_Code is
|
|||
Outputs : Asm_Output_Operand_List;
|
||||
Inputs : Asm_Input_Operand_List;
|
||||
Clobber : String := "";
|
||||
Volatile : Boolean := False)
|
||||
return Asm_Insn;
|
||||
Volatile : Boolean := False) return Asm_Insn;
|
||||
|
||||
function Asm (
|
||||
Template : String;
|
||||
|
|
@ -121,7 +120,7 @@ private
|
|||
type Asm_Output_Operand is new Integer;
|
||||
type Asm_Insn is new Integer;
|
||||
-- All three of these types are dummy types, to meet the requirements of
|
||||
-- type consistenty. No values of these types are ever referenced.
|
||||
-- type consistency. No values of these types are ever referenced.
|
||||
|
||||
No_Input_Operands : constant Asm_Input_Operand := 0;
|
||||
No_Output_Operands : constant Asm_Output_Operand := 0;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- B o d y --
|
||||
-- (Version for Alpha/VMS) --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2005, AdaCore --
|
||||
-- Copyright (C) 2001-2006, AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -175,7 +175,7 @@ package body System.Machine_State_Operations is
|
|||
function Get_Code_Loc (M : Machine_State) return Code_Loc is
|
||||
procedure Get_Invo_Context (
|
||||
Result : out Unsigned_Longword; -- return value
|
||||
Invo_Handle : in Invo_Handle_Type;
|
||||
Invo_Handle : Invo_Handle_Type;
|
||||
Invo_Context : out Invo_Context_Blk_Type);
|
||||
|
||||
pragma Interface (External, Get_Invo_Context);
|
||||
|
|
@ -221,7 +221,7 @@ package body System.Machine_State_Operations is
|
|||
procedure Pop_Frame (M : Machine_State) is
|
||||
procedure Get_Prev_Invo_Handle (
|
||||
Result : out Invo_Handle_Type; -- return value
|
||||
ICB : in Invo_Handle_Type);
|
||||
ICB : Invo_Handle_Type);
|
||||
|
||||
pragma Interface (External, Get_Prev_Invo_Handle);
|
||||
|
||||
|
|
@ -255,7 +255,7 @@ package body System.Machine_State_Operations is
|
|||
|
||||
procedure Get_Invo_Handle (
|
||||
Result : out Invo_Handle_Type; -- return value
|
||||
Invo_Context : in Invo_Context_Blk_Type);
|
||||
Invo_Context : Invo_Context_Blk_Type);
|
||||
|
||||
pragma Interface (External, Get_Invo_Handle);
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2006, 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- --
|
||||
|
|
@ -31,7 +31,7 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This is the default implementation of this package.
|
||||
-- This is the default implementation of this package
|
||||
|
||||
-- This implementation assumes that the underlying malloc/free/realloc
|
||||
-- implementation is thread safe, and thus, no additional lock is required.
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1991-1994, Florida State University --
|
||||
-- Copyright (C) 1995-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1995-2006, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL 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- --
|
||||
|
|
@ -68,6 +68,7 @@ package System.OS_Interface is
|
|||
|
||||
subtype PSZ is Interfaces.C.Strings.chars_ptr;
|
||||
subtype PCHAR is Interfaces.C.Strings.chars_ptr;
|
||||
|
||||
subtype PVOID is System.Address;
|
||||
|
||||
Null_Void : constant PVOID := System.Null_Address;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1998-2006 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL 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- --
|
||||
|
|
@ -77,10 +77,10 @@ package body System.OS_Primitives is
|
|||
procedure Sys_Schdwk
|
||||
(
|
||||
Status : out Cond_Value_Type;
|
||||
Pidadr : in Address := Null_Address;
|
||||
Prcnam : in String := String'Null_Parameter;
|
||||
Daytim : in Long_Integer;
|
||||
Reptim : in Long_Integer := Long_Integer'Null_Parameter
|
||||
Pidadr : Address := Null_Address;
|
||||
Prcnam : String := String'Null_Parameter;
|
||||
Daytim : Long_Integer;
|
||||
Reptim : Long_Integer := Long_Integer'Null_Parameter
|
||||
);
|
||||
|
||||
pragma Interface (External, Sys_Schdwk);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -487,7 +487,7 @@ package body System.Secondary_Stack is
|
|||
-- Allocate a secondary stack for the main program to use
|
||||
|
||||
-- We make sure that the stack has maximum alignment. Some systems require
|
||||
-- this (e.g. Sun), and in any case it is a good idea for efficiency.
|
||||
-- this (e.g. Sparc), and in any case it is a good idea for efficiency.
|
||||
|
||||
Stack : aliased Stack_Id;
|
||||
for Stack'Alignment use Standard'Maximum_Alignment;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -54,7 +54,7 @@ package body System.Soft_Links is
|
|||
-- This is currently only used under VMS.
|
||||
|
||||
NT_TSD : TSD;
|
||||
-- Note: we rely on the default initialization of NT_TSD.
|
||||
-- Note: we rely on the default initialization of NT_TSD
|
||||
|
||||
--------------------
|
||||
-- Abort_Defer_NT --
|
||||
|
|
@ -295,14 +295,14 @@ package body System.Soft_Links is
|
|||
null;
|
||||
end Task_Lock_NT;
|
||||
|
||||
--------------------
|
||||
-- Task_Unlock_NT --
|
||||
--------------------
|
||||
------------------
|
||||
-- Task_Name_NT --
|
||||
-------------------
|
||||
|
||||
procedure Task_Unlock_NT is
|
||||
function Task_Name_NT return String is
|
||||
begin
|
||||
null;
|
||||
end Task_Unlock_NT;
|
||||
return "main_task";
|
||||
end Task_Name_NT;
|
||||
|
||||
-------------------------
|
||||
-- Task_Termination_NT --
|
||||
|
|
@ -314,6 +314,15 @@ package body System.Soft_Links is
|
|||
null;
|
||||
end Task_Termination_NT;
|
||||
|
||||
--------------------
|
||||
-- Task_Unlock_NT --
|
||||
--------------------
|
||||
|
||||
procedure Task_Unlock_NT is
|
||||
begin
|
||||
null;
|
||||
end Task_Unlock_NT;
|
||||
|
||||
-------------------------
|
||||
-- Update_Exception_NT --
|
||||
-------------------------
|
||||
|
|
@ -323,13 +332,4 @@ package body System.Soft_Links is
|
|||
Ada.Exceptions.Save_Occurrence (NT_TSD.Current_Excep, X);
|
||||
end Update_Exception_NT;
|
||||
|
||||
------------------
|
||||
-- Task_Name_NT --
|
||||
-------------------
|
||||
|
||||
function Task_Name_NT return String is
|
||||
begin
|
||||
return "main_task";
|
||||
end Task_Name_NT;
|
||||
|
||||
end System.Soft_Links;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2002-2006, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -54,6 +54,10 @@ package System.Storage_Elements is
|
|||
type Storage_Offset is range
|
||||
-(2 ** (Integer'(Standard'Address_Size) - 1)) ..
|
||||
+(2 ** (Integer'(Standard'Address_Size) - 1)) - Long_Long_Integer'(1);
|
||||
-- Note: the reason for the Long_Long_Integer qualification here is to
|
||||
-- avoid a bogus ambiguity when this unit is analyzed in an rtsfind
|
||||
-- context. It may be possible to remove this in the future, but it is
|
||||
-- certainly harmless in any case ???
|
||||
|
||||
subtype Storage_Count is Storage_Offset range 0 .. Storage_Offset'Last;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1996-2006, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GARLIC 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- --
|
||||
|
|
@ -1041,7 +1041,7 @@ package body System.Stream_Attributes is
|
|||
-- W_AD --
|
||||
----------
|
||||
|
||||
procedure W_AD (Stream : not null access RST; Item : in Fat_Pointer) is
|
||||
procedure W_AD (Stream : not null access RST; Item : Fat_Pointer) is
|
||||
S : XDR_S_TM;
|
||||
U : XDR_TM;
|
||||
|
||||
|
|
@ -1071,7 +1071,7 @@ package body System.Stream_Attributes is
|
|||
-- W_AS --
|
||||
----------
|
||||
|
||||
procedure W_AS (Stream : not null access RST; Item : in Thin_Pointer) is
|
||||
procedure W_AS (Stream : not null access RST; Item : Thin_Pointer) is
|
||||
S : XDR_S_TM;
|
||||
U : XDR_TM := XDR_TM (To_XDR_SA (Item.P1));
|
||||
|
||||
|
|
@ -1092,7 +1092,7 @@ package body System.Stream_Attributes is
|
|||
-- W_B --
|
||||
---------
|
||||
|
||||
procedure W_B (Stream : not null access RST; Item : in Boolean) is
|
||||
procedure W_B (Stream : not null access RST; Item : Boolean) is
|
||||
begin
|
||||
if Item then
|
||||
W_SSU (Stream, 1);
|
||||
|
|
@ -1105,7 +1105,7 @@ package body System.Stream_Attributes is
|
|||
-- W_C --
|
||||
---------
|
||||
|
||||
procedure W_C (Stream : not null access RST; Item : in Character) is
|
||||
procedure W_C (Stream : not null access RST; Item : Character) is
|
||||
S : XDR_S_C;
|
||||
|
||||
pragma Assert (C_L = 1);
|
||||
|
|
@ -1123,7 +1123,7 @@ package body System.Stream_Attributes is
|
|||
-- W_F --
|
||||
---------
|
||||
|
||||
procedure W_F (Stream : not null access RST; Item : in Float) is
|
||||
procedure W_F (Stream : not null access RST; Item : Float) is
|
||||
I : constant Precision := Single;
|
||||
E_Size : Integer renames Fields (I).E_Size;
|
||||
E_Bias : Integer renames Fields (I).E_Bias;
|
||||
|
|
@ -1205,7 +1205,7 @@ package body System.Stream_Attributes is
|
|||
-- W_I --
|
||||
---------
|
||||
|
||||
procedure W_I (Stream : not null access RST; Item : in Integer) is
|
||||
procedure W_I (Stream : not null access RST; Item : Integer) is
|
||||
S : XDR_S_I;
|
||||
U : XDR_U;
|
||||
|
||||
|
|
@ -1239,7 +1239,7 @@ package body System.Stream_Attributes is
|
|||
-- W_LF --
|
||||
----------
|
||||
|
||||
procedure W_LF (Stream : not null access RST; Item : in Long_Float) is
|
||||
procedure W_LF (Stream : not null access RST; Item : Long_Float) is
|
||||
I : constant Precision := Double;
|
||||
E_Size : Integer renames Fields (I).E_Size;
|
||||
E_Bias : Integer renames Fields (I).E_Bias;
|
||||
|
|
@ -1321,7 +1321,7 @@ package body System.Stream_Attributes is
|
|||
-- W_LI --
|
||||
----------
|
||||
|
||||
procedure W_LI (Stream : not null access RST; Item : in Long_Integer) is
|
||||
procedure W_LI (Stream : not null access RST; Item : Long_Integer) is
|
||||
S : XDR_S_LI;
|
||||
U : Unsigned;
|
||||
X : Long_Unsigned;
|
||||
|
|
@ -1367,7 +1367,7 @@ package body System.Stream_Attributes is
|
|||
-- W_LLF --
|
||||
-----------
|
||||
|
||||
procedure W_LLF (Stream : not null access RST; Item : in Long_Long_Float) is
|
||||
procedure W_LLF (Stream : not null access RST; Item : Long_Long_Float) is
|
||||
I : constant Precision := Quadruple;
|
||||
E_Size : Integer renames Fields (I).E_Size;
|
||||
E_Bias : Integer renames Fields (I).E_Bias;
|
||||
|
|
@ -1463,7 +1463,7 @@ package body System.Stream_Attributes is
|
|||
-----------
|
||||
|
||||
procedure W_LLI (Stream : not null access RST;
|
||||
Item : in Long_Long_Integer)
|
||||
Item : Long_Long_Integer)
|
||||
is
|
||||
S : XDR_S_LLI;
|
||||
U : Unsigned;
|
||||
|
|
@ -1511,7 +1511,7 @@ package body System.Stream_Attributes is
|
|||
-----------
|
||||
|
||||
procedure W_LLU (Stream : not null access RST;
|
||||
Item : in Long_Long_Unsigned) is
|
||||
Item : Long_Long_Unsigned) is
|
||||
S : XDR_S_LLU;
|
||||
U : Unsigned;
|
||||
X : Long_Long_Unsigned := Item;
|
||||
|
|
@ -1548,7 +1548,7 @@ package body System.Stream_Attributes is
|
|||
-- W_LU --
|
||||
----------
|
||||
|
||||
procedure W_LU (Stream : not null access RST; Item : in Long_Unsigned) is
|
||||
procedure W_LU (Stream : not null access RST; Item : Long_Unsigned) is
|
||||
S : XDR_S_LU;
|
||||
U : Unsigned;
|
||||
X : Long_Unsigned := Item;
|
||||
|
|
@ -1584,7 +1584,7 @@ package body System.Stream_Attributes is
|
|||
-- W_SF --
|
||||
----------
|
||||
|
||||
procedure W_SF (Stream : not null access RST; Item : in Short_Float) is
|
||||
procedure W_SF (Stream : not null access RST; Item : Short_Float) is
|
||||
I : constant Precision := Single;
|
||||
E_Size : Integer renames Fields (I).E_Size;
|
||||
E_Bias : Integer renames Fields (I).E_Bias;
|
||||
|
|
@ -1666,7 +1666,7 @@ package body System.Stream_Attributes is
|
|||
-- W_SI --
|
||||
----------
|
||||
|
||||
procedure W_SI (Stream : not null access RST; Item : in Short_Integer) is
|
||||
procedure W_SI (Stream : not null access RST; Item : Short_Integer) is
|
||||
S : XDR_S_SI;
|
||||
U : XDR_SU;
|
||||
|
||||
|
|
@ -1702,7 +1702,7 @@ package body System.Stream_Attributes is
|
|||
|
||||
procedure W_SSI
|
||||
(Stream : not null access RST;
|
||||
Item : in Short_Short_Integer)
|
||||
Item : Short_Short_Integer)
|
||||
is
|
||||
S : XDR_S_SSI;
|
||||
U : XDR_SSU;
|
||||
|
|
@ -1732,7 +1732,7 @@ package body System.Stream_Attributes is
|
|||
|
||||
procedure W_SSU
|
||||
(Stream : not null access RST;
|
||||
Item : in Short_Short_Unsigned)
|
||||
Item : Short_Short_Unsigned)
|
||||
is
|
||||
U : constant XDR_SSU := XDR_SSU (Item);
|
||||
S : XDR_S_SSU;
|
||||
|
|
@ -1747,7 +1747,7 @@ package body System.Stream_Attributes is
|
|||
-- W_SU --
|
||||
----------
|
||||
|
||||
procedure W_SU (Stream : not null access RST; Item : in Short_Unsigned) is
|
||||
procedure W_SU (Stream : not null access RST; Item : Short_Unsigned) is
|
||||
S : XDR_S_SU;
|
||||
U : XDR_SU := XDR_SU (Item);
|
||||
|
||||
|
|
@ -1772,7 +1772,7 @@ package body System.Stream_Attributes is
|
|||
-- W_U --
|
||||
---------
|
||||
|
||||
procedure W_U (Stream : not null access RST; Item : in Unsigned) is
|
||||
procedure W_U (Stream : not null access RST; Item : Unsigned) is
|
||||
S : XDR_S_U;
|
||||
U : XDR_U := XDR_U (Item);
|
||||
|
||||
|
|
@ -1797,7 +1797,7 @@ package body System.Stream_Attributes is
|
|||
-- W_WC --
|
||||
----------
|
||||
|
||||
procedure W_WC (Stream : not null access RST; Item : in Wide_Character) is
|
||||
procedure W_WC (Stream : not null access RST; Item : Wide_Character) is
|
||||
S : XDR_S_WC;
|
||||
U : XDR_WC;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2006 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL 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- --
|
||||
|
|
@ -41,7 +41,7 @@ package body System.Traces.Format is
|
|||
-- Format_Trace --
|
||||
------------------
|
||||
|
||||
function Format_Trace (Source : in String) return String_Trace is
|
||||
function Format_Trace (Source : String) return String_Trace is
|
||||
Length : Integer := Source'Length;
|
||||
Result : String_Trace := (others => ' ');
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2005-2006, 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- --
|
||||
|
|
@ -48,4 +48,17 @@ package body System.WCh_Con is
|
|||
raise Constraint_Error;
|
||||
end Get_WC_Encoding_Method;
|
||||
|
||||
function Get_WC_Encoding_Method (S : String) return WC_Encoding_Method is
|
||||
begin
|
||||
if S = "hex" then return WCEM_Hex;
|
||||
elsif S = "upper" then return WCEM_Upper;
|
||||
elsif S = "shift_jis" then return WCEM_Shift_JIS;
|
||||
elsif S = "euc" then return WCEM_EUC;
|
||||
elsif S = "utf8" then return WCEM_UTF8;
|
||||
elsif S = "brackets" then return WCEM_Brackets;
|
||||
else
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
end Get_WC_Encoding_Method;
|
||||
|
||||
end System.WCh_Con;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -186,4 +186,9 @@ package System.WCh_Con is
|
|||
-- Given a character C, returns corresponding encoding method (see array
|
||||
-- WC_Encoding_Letters above). Raises Constraint_Error if not in list.
|
||||
|
||||
function Get_WC_Encoding_Method (S : String) return WC_Encoding_Method;
|
||||
-- Given a lower case string that is one of hex, upper, shift_jis, euc,
|
||||
-- utf8, brackets, return the corresponding encoding method. Raises
|
||||
-- Constraint_Error if not in list.
|
||||
|
||||
end System.WCh_Con;
|
||||
|
|
|
|||
|
|
@ -57,45 +57,6 @@ package body Scn is
|
|||
procedure Error_Long_Line;
|
||||
-- Signal error of excessively long line
|
||||
|
||||
---------------
|
||||
-- Post_Scan --
|
||||
---------------
|
||||
|
||||
procedure Post_Scan is
|
||||
begin
|
||||
case Token is
|
||||
when Tok_Char_Literal =>
|
||||
Token_Node := New_Node (N_Character_Literal, Token_Ptr);
|
||||
Set_Char_Literal_Value (Token_Node, UI_From_CC (Character_Code));
|
||||
Set_Chars (Token_Node, Token_Name);
|
||||
|
||||
when Tok_Identifier =>
|
||||
Token_Node := New_Node (N_Identifier, Token_Ptr);
|
||||
Set_Chars (Token_Node, Token_Name);
|
||||
|
||||
when Tok_Real_Literal =>
|
||||
Token_Node := New_Node (N_Real_Literal, Token_Ptr);
|
||||
Set_Realval (Token_Node, Real_Literal_Value);
|
||||
|
||||
when Tok_Integer_Literal =>
|
||||
Token_Node := New_Node (N_Integer_Literal, Token_Ptr);
|
||||
Set_Intval (Token_Node, Int_Literal_Value);
|
||||
|
||||
when Tok_String_Literal =>
|
||||
Token_Node := New_Node (N_String_Literal, Token_Ptr);
|
||||
Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
|
||||
Set_Strval (Token_Node, String_Literal_Id);
|
||||
|
||||
when Tok_Operator_Symbol =>
|
||||
Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
|
||||
Set_Chars (Token_Node, Token_Name);
|
||||
Set_Strval (Token_Node, String_Literal_Id);
|
||||
|
||||
when others =>
|
||||
null;
|
||||
end case;
|
||||
end Post_Scan;
|
||||
|
||||
-----------------------
|
||||
-- Check_End_Of_Line --
|
||||
-----------------------
|
||||
|
|
@ -345,6 +306,45 @@ package body Scn is
|
|||
Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S));
|
||||
end Obsolescent_Check;
|
||||
|
||||
---------------
|
||||
-- Post_Scan --
|
||||
---------------
|
||||
|
||||
procedure Post_Scan is
|
||||
begin
|
||||
case Token is
|
||||
when Tok_Char_Literal =>
|
||||
Token_Node := New_Node (N_Character_Literal, Token_Ptr);
|
||||
Set_Char_Literal_Value (Token_Node, UI_From_CC (Character_Code));
|
||||
Set_Chars (Token_Node, Token_Name);
|
||||
|
||||
when Tok_Identifier =>
|
||||
Token_Node := New_Node (N_Identifier, Token_Ptr);
|
||||
Set_Chars (Token_Node, Token_Name);
|
||||
|
||||
when Tok_Real_Literal =>
|
||||
Token_Node := New_Node (N_Real_Literal, Token_Ptr);
|
||||
Set_Realval (Token_Node, Real_Literal_Value);
|
||||
|
||||
when Tok_Integer_Literal =>
|
||||
Token_Node := New_Node (N_Integer_Literal, Token_Ptr);
|
||||
Set_Intval (Token_Node, Int_Literal_Value);
|
||||
|
||||
when Tok_String_Literal =>
|
||||
Token_Node := New_Node (N_String_Literal, Token_Ptr);
|
||||
Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
|
||||
Set_Strval (Token_Node, String_Literal_Id);
|
||||
|
||||
when Tok_Operator_Symbol =>
|
||||
Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
|
||||
Set_Chars (Token_Node, Token_Name);
|
||||
Set_Strval (Token_Node, String_Literal_Id);
|
||||
|
||||
when others =>
|
||||
null;
|
||||
end case;
|
||||
end Post_Scan;
|
||||
|
||||
------------------------------
|
||||
-- Scan_Reserved_Identifier --
|
||||
------------------------------
|
||||
|
|
|
|||
|
|
@ -558,6 +558,8 @@ package body Sem_Case is
|
|||
Raises_CE : out Boolean;
|
||||
Others_Present : out Boolean)
|
||||
is
|
||||
pragma Assert (Choice_Table'First = 1);
|
||||
|
||||
E : Entity_Id;
|
||||
|
||||
Enode : Node_Id;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1996-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1996-2006, 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- --
|
||||
|
|
@ -93,8 +93,8 @@ package Sem_Case is
|
|||
-- Subtyp is the subtype of the discrete choices. The type against
|
||||
-- which the discrete choices must be resolved is its base type.
|
||||
--
|
||||
-- On entry Choice_Table must be big enough to contain all the
|
||||
-- discrete choices encountered.
|
||||
-- On entry Choice_Table must be big enough to contain all the discrete
|
||||
-- choices encountered. The lower bound of Choice_Table must be one.
|
||||
--
|
||||
-- On exit Choice_Table contains all the static and non empty discrete
|
||||
-- choices in sorted order. Last_Choice gives the position of the last
|
||||
|
|
|
|||
|
|
@ -652,8 +652,8 @@ package body Sinput.L is
|
|||
-- We scan past junk to the first interesting compilation unit
|
||||
-- token, to see if it is SEPARATE. We ignore WITH keywords during
|
||||
-- this and also PRIVATE. The reason for ignoring PRIVATE is that
|
||||
-- it handles some error situations, and also it is possible that
|
||||
-- a PRIVATE WITH feature might be approved some time in the future.
|
||||
-- it handles some error situations, and also to handle PRIVATE WITH
|
||||
-- in Ada 2005 mode.
|
||||
|
||||
while Token = Tok_With
|
||||
or else Token = Tok_Private
|
||||
|
|
|
|||
|
|
@ -89,8 +89,8 @@ package body Sinput.P is
|
|||
-- We scan past junk to the first interesting compilation unit
|
||||
-- token, to see if it is SEPARATE. We ignore WITH keywords during
|
||||
-- this and also PRIVATE. The reason for ignoring PRIVATE is that
|
||||
-- it handles some error situations, and also it is possible that
|
||||
-- a PRIVATE WITH feature might be approved some time in the future.
|
||||
-- it handles some error situations, and also to handle PRIVATE WITH
|
||||
-- in Ada 2005 mode.
|
||||
|
||||
while Token = Tok_With
|
||||
or else Token = Tok_Private
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- T e m p l a t e --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -47,9 +47,9 @@ package Treeprs is
|
|||
-- by the synonym name. The starting location for a given node type is
|
||||
-- found from the corresponding entry in the Pchars_Pos_Array.
|
||||
|
||||
-- The following characters identify the field. These are characters
|
||||
-- which could never occur in a field name, so they also mark the
|
||||
-- end of the previous name.
|
||||
-- The following characters identify the field. These are characters which
|
||||
-- could never occur in a field name, so they also mark the end of the
|
||||
-- previous name.
|
||||
|
||||
subtype Fchar is Character range '#' .. '9';
|
||||
|
||||
|
|
@ -79,9 +79,9 @@ package Treeprs is
|
|||
|
||||
-- Note this table does not include entity field and flags whose access
|
||||
-- functions are in Einfo (these are handled by the Print_Entity_Info
|
||||
-- procedure in Treepr, which uses the routines in Einfo to get the
|
||||
-- proper symbolic information). In addition, the following fields are
|
||||
-- handled by Treepr, and do not appear in the Pchars array:
|
||||
-- procedure in Treepr, which uses the routines in Einfo to get the proper
|
||||
-- symbolic information). In addition, the following fields are handled by
|
||||
-- Treepr, and do not appear in the Pchars array:
|
||||
|
||||
-- Analyzed
|
||||
-- Cannot_Be_Constant
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -134,6 +134,7 @@ package body Uintp is
|
|||
-- digit of Vec contains the sign, all other digits are always non-
|
||||
-- negative. Note that the input may be directly represented, and in
|
||||
-- this case Vec will contain the corresponding one or two digit value.
|
||||
-- The low bound of Vec is always 1.
|
||||
|
||||
function Least_Sig_Digit (Arg : Uint) return Int;
|
||||
pragma Inline (Least_Sig_Digit);
|
||||
|
|
@ -422,6 +423,8 @@ package body Uintp is
|
|||
procedure Init_Operand (UI : Uint; Vec : out UI_Vector) is
|
||||
Loc : Int;
|
||||
|
||||
pragma Assert (Vec'First = Int'(1));
|
||||
|
||||
begin
|
||||
if Direct (UI) then
|
||||
Vec (1) := Direct_Val (UI);
|
||||
|
|
@ -590,18 +593,28 @@ package body Uintp is
|
|||
Num : Nat;
|
||||
|
||||
begin
|
||||
-- Largest negative number has to be handled specially, since it is in
|
||||
-- Int_Range, but we cannot take the absolute value.
|
||||
|
||||
if Input = Uint_Int_First then
|
||||
return Int'Size;
|
||||
|
||||
-- For any other number in Int_Range, get absolute value of number
|
||||
|
||||
elsif UI_Is_In_Int_Range (Input) then
|
||||
Num := abs (UI_To_Int (Input));
|
||||
Bits := 0;
|
||||
|
||||
-- If not in Int_Range then initialize bit count for all low order
|
||||
-- words, and set number to high order digit.
|
||||
|
||||
else
|
||||
Bits := Base_Bits * (Uints.Table (Input).Length - 1);
|
||||
Num := abs (Udigits.Table (Uints.Table (Input).Loc));
|
||||
end if;
|
||||
|
||||
-- Increase bit count for remaining value in Num
|
||||
|
||||
while Types.">" (Num, 0) loop
|
||||
Num := Num / 2;
|
||||
Bits := Bits + 1;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2006, 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- --
|
||||
|
|
@ -1431,14 +1431,14 @@ package body Urealp is
|
|||
return UR_10_36;
|
||||
end Ureal_10_36;
|
||||
|
||||
-------------------
|
||||
-- Ureal_M_10_36 --
|
||||
-------------------
|
||||
----------------
|
||||
-- Ureal_2_80 --
|
||||
----------------
|
||||
|
||||
function Ureal_M_10_36 return Ureal is
|
||||
function Ureal_2_80 return Ureal is
|
||||
begin
|
||||
return UR_M_10_36;
|
||||
end Ureal_M_10_36;
|
||||
return UR_2_80;
|
||||
end Ureal_2_80;
|
||||
|
||||
-----------------
|
||||
-- Ureal_2_128 --
|
||||
|
|
@ -1449,14 +1449,14 @@ package body Urealp is
|
|||
return UR_2_128;
|
||||
end Ureal_2_128;
|
||||
|
||||
----------------
|
||||
-- Ureal_2_80 --
|
||||
----------------
|
||||
-------------------
|
||||
-- Ureal_2_M_80 --
|
||||
-------------------
|
||||
|
||||
function Ureal_2_80 return Ureal is
|
||||
function Ureal_2_M_80 return Ureal is
|
||||
begin
|
||||
return UR_2_80;
|
||||
end Ureal_2_80;
|
||||
return UR_2_M_80;
|
||||
end Ureal_2_M_80;
|
||||
|
||||
-------------------
|
||||
-- Ureal_2_M_128 --
|
||||
|
|
@ -1467,15 +1467,6 @@ package body Urealp is
|
|||
return UR_2_M_128;
|
||||
end Ureal_2_M_128;
|
||||
|
||||
-------------------
|
||||
-- Ureal_2_M_80 --
|
||||
-------------------
|
||||
|
||||
function Ureal_2_M_80 return Ureal is
|
||||
begin
|
||||
return UR_2_M_80;
|
||||
end Ureal_2_M_80;
|
||||
|
||||
----------------
|
||||
-- Ureal_Half --
|
||||
----------------
|
||||
|
|
@ -1494,6 +1485,15 @@ package body Urealp is
|
|||
return UR_M_0;
|
||||
end Ureal_M_0;
|
||||
|
||||
-------------------
|
||||
-- Ureal_M_10_36 --
|
||||
-------------------
|
||||
|
||||
function Ureal_M_10_36 return Ureal is
|
||||
begin
|
||||
return UR_M_10_36;
|
||||
end Ureal_M_10_36;
|
||||
|
||||
-----------------
|
||||
-- Ureal_Tenth --
|
||||
-----------------
|
||||
|
|
|
|||
Loading…
Reference in New Issue