committed: Ada updates
Arnaud Charlet
charlet@ACT-Europe.FR
Fri Nov 21 11:12:00 GMT 2003
Tested on x86-linux, x86-windows
Compiled on x86-FreeBSD
--
2003-11-21 Vasiliy Fofanov <fofanov@act-europe.fr>
* 5wsystem.ads: Enable zero cost exception.
2003-11-21 Jerome Guitton <guitton@act-europe.fr>
* 5ztiitho.adb: Remove an unreferenced variable.
2003-11-21 Thomas Quinot <quinot@act-europe.fr>
* adaint.c: For FreeBSD, use mkstemp.
2003-11-21 Arnaud Charlet <charlet@act-europe.fr>
* gnatlbr.adb: Now reference Gnat_Static_Version_String.
2003-11-21 Robert Dewar <dewar@gnat.com>
* bld.adb: Remove useless USE of gnatvsn
* gnatchop.adb: Minor reformatting
Clean up version handling to be more consistent
* gnatxref.adb: Minor reformatting
* gprcmd.adb: Minor reformatting
Fix output of copyright to be more consistent with other tools
2003-11-21 Vincent Celier <celier@gnat.com>
* make.adb (Scan_Make_Args): Do not transmit --RTS= to gnatlink
2003-11-21 Sergey Rybin <rybin@act-europe.fr>
* atree.adb (Initialize): Add initializations for global variables
used in New_Copy_Tree.
* cstand.adb (Create_Standard): Add call to Initialize_Scanner (with
Internal_Source_File as the actual).
Put the set of statements creating Any_Character before the set of
statements creating Any_Array to have Any_Character fully initialized
when it is used in creating Any_Array.
* scn.adb (Initialize_Scanner): Do not set Comes_From_Source ON and do
not call Scan in case if the actual is Internal_Source_File
Add 2003 to copyright note.
* sinput.adb (Source_First, Source_Last, Source_Text): Add code for
processing Internal_Source_File.
* types.ads: Add the constant Internal_Source_File representing the
source buffer for artificial source-code-like strings created within
the compiler (the definition of Source_File_Index is changed).
--
Index: 5wsystem.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5wsystem.ads,v
retrieving revision 1.6
diff -u -r1.6 5wsystem.ads
--- 5wsystem.ads 21 Oct 2003 13:41:52 -0000 1.6
+++ 5wsystem.ads 20 Nov 2003 18:18:33 -0000
@@ -138,7 +138,7 @@
Support_Long_Shifts : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
- ZCX_By_Default : constant Boolean := False;
+ ZCX_By_Default : constant Boolean := True;
GCC_ZCX_Support : constant Boolean := True;
Front_End_ZCX_Support : constant Boolean := False;
Index: 5ztiitho.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5ztiitho.adb,v
retrieving revision 1.2
diff -u -r1.2 5ztiitho.adb
--- 5ztiitho.adb 17 Nov 2003 14:58:14 -0000 1.2
+++ 5ztiitho.adb 20 Nov 2003 18:18:33 -0000
@@ -43,7 +43,6 @@
procedure taskCreateHookAdd (createHookFunction : FUNCPTR);
pragma Import (C, taskCreateHookAdd, "taskCreateHookAdd");
- Result : OSI.STATUS;
begin
taskCreateHookAdd (Register'Access);
end Initialize_Task_Hooks;
Index: adaint.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/adaint.c,v
retrieving revision 1.23
diff -u -r1.23 adaint.c
--- adaint.c 17 Nov 2003 14:58:14 -0000 1.23
+++ adaint.c 20 Nov 2003 18:18:34 -0000
@@ -667,7 +667,7 @@
strcpy (path, "GNAT-XXXXXX");
-#if defined (linux) && !defined (__vxworks)
+#if (defined (__FreeBSD__) || defined (linux)) && !defined (__vxworks)
return mkstemp (path);
#elif defined (__Lynx__)
mktemp (path);
@@ -742,7 +742,7 @@
free (pname);
}
-#elif defined (linux)
+#elif defined (linux) || defined (__FreeBSD__)
#define MAX_SAFE_PATH 1000
char *tmpdir = getenv ("TMPDIR");
Index: atree.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/atree.adb,v
retrieving revision 1.9
diff -u -r1.9 atree.adb
--- atree.adb 20 Nov 2003 09:53:58 -0000 1.9
+++ atree.adb 20 Nov 2003 18:18:34 -0000
@@ -882,6 +882,11 @@
Dummy := New_Node (N_Error, No_Location);
Set_Name1 (Error, Error_Name);
Set_Error_Posted (Error, True);
+
+ -- Set global variables for New_Copy_Tree:
+ NCT_Hash_Tables_Used := False;
+ NCT_Table_Entries := 0;
+ NCT_Hash_Table_Setup := False;
end Initialize;
--------------------------
Index: bld.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/bld.adb,v
retrieving revision 1.3
diff -u -r1.3 bld.adb
--- bld.adb 20 Nov 2003 09:53:58 -0000 1.3
+++ bld.adb 20 Nov 2003 18:18:35 -0000
@@ -40,7 +40,7 @@
with Erroutc; use Erroutc;
with Err_Vars; use Err_Vars;
-with Gnatvsn; use Gnatvsn;
+with Gnatvsn;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
Index: cstand.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/cstand.adb,v
retrieving revision 1.11
diff -u -r1.11 cstand.adb
--- cstand.adb 10 Nov 2003 17:29:58 -0000 1.11
+++ cstand.adb 20 Nov 2003 18:18:35 -0000
@@ -38,6 +38,7 @@
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Ttypef; use Ttypef;
+with Scn;
with Sem_Mech; use Sem_Mech;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
@@ -259,10 +260,10 @@
-- by Initialize_Standard in the semantics module.
procedure Create_Standard is
- Decl_S : List_Id;
+ Decl_S : List_Id := New_List;
-- List of declarations in Standard
- Decl_A : List_Id;
+ Decl_A : List_Id := New_List;
-- List of declarations in ASCII
Decl : Node_Id;
@@ -297,7 +298,9 @@
-- Start of processing for Create_Standard
begin
- Decl_S := New_List;
+ -- Initialize scanner for internal scans of literals
+
+ Scn.Initialize_Scanner (No_Unit, Internal_Source_File);
-- First step is to create defining identifiers for each entity
@@ -414,7 +417,6 @@
declare
LIS : Nat;
-
begin
if Debug_Flag_M then
LIS := 64;
@@ -657,7 +659,6 @@
Set_Defining_Unit_Name (Pspec, Standard_Entity (S_ASCII));
Set_Ekind (Standard_Entity (S_ASCII), E_Package);
- Decl_A := New_List; -- for ASCII declarations
Set_Visible_Declarations (Pspec, Decl_A);
-- Create control character definitions in package ASCII. Note that
@@ -791,6 +792,18 @@
Set_Prim_Alignment (Any_Access);
Make_Name (Any_Access, "an access type");
+ Any_Character := New_Standard_Entity;
+ Set_Ekind (Any_Character, E_Enumeration_Type);
+ Set_Scope (Any_Character, Standard_Standard);
+ Set_Etype (Any_Character, Any_Character);
+ Set_Is_Unsigned_Type (Any_Character);
+ Set_Is_Character_Type (Any_Character);
+ Init_Esize (Any_Character, Standard_Character_Size);
+ Init_RM_Size (Any_Character, 8);
+ Set_Prim_Alignment (Any_Character);
+ Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character));
+ Make_Name (Any_Character, "a character type");
+
Any_Array := New_Standard_Entity;
Set_Ekind (Any_Array, E_String_Type);
Set_Scope (Any_Array, Standard_Standard);
@@ -809,18 +822,6 @@
Set_Is_Unsigned_Type (Any_Boolean);
Set_Scalar_Range (Any_Boolean, Scalar_Range (Standard_Boolean));
Make_Name (Any_Boolean, "a boolean type");
-
- Any_Character := New_Standard_Entity;
- Set_Ekind (Any_Character, E_Enumeration_Type);
- Set_Scope (Any_Character, Standard_Standard);
- Set_Etype (Any_Character, Any_Character);
- Set_Is_Unsigned_Type (Any_Character);
- Set_Is_Character_Type (Any_Character);
- Init_Esize (Any_Character, Standard_Character_Size);
- Init_RM_Size (Any_Character, 8);
- Set_Prim_Alignment (Any_Character);
- Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character));
- Make_Name (Any_Character, "a character type");
Any_Composite := New_Standard_Entity;
Set_Ekind (Any_Composite, E_Array_Type);
Index: gnatchop.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gnatchop.adb,v
retrieving revision 1.9
diff -u -r1.9 gnatchop.adb
--- gnatchop.adb 17 Nov 2003 14:58:15 -0000 1.9
+++ gnatchop.adb 20 Nov 2003 18:18:35 -0000
@@ -37,11 +37,6 @@
procedure Gnatchop is
- Cwrite : constant String :=
- "GNATCHOP " &
- Gnatvsn.Gnat_Version_String &
- " Copyright 1998-2000, Ada Core Technologies Inc.";
-
Terminate_Program : exception;
-- Used to terminate execution immediately
@@ -57,9 +52,13 @@
Gnat_Cmd : String_Access;
-- Command to execute the GNAT compiler
- Gnat_Args : Argument_List_Access := new Argument_List'
- (new String'("-c"), new String'("-x"), new String'("ada"),
- new String'("-gnats"), new String'("-gnatu"));
+ Gnat_Args : Argument_List_Access :=
+ new Argument_List'
+ (new String'("-c"),
+ new String'("-x"),
+ new String'("ada"),
+ new String'("-gnats"),
+ new String'("-gnatu"));
-- Arguments used in Gnat_Cmd call
EOF : constant Character := Character'Val (26);
@@ -1110,6 +1109,7 @@
else
Error_Msg ("-k# requires numeric parameter");
end if;
+
return False;
end if;
end loop;
@@ -1129,23 +1129,31 @@
end;
when 'p' =>
- Preserve_Mode := True;
+ Preserve_Mode := True;
when 'q' =>
- Quiet_Mode := True;
+ Quiet_Mode := True;
when 'r' =>
Source_References := True;
when 'v' =>
- Verbose_Mode := True;
- Put_Line (Standard_Error, Cwrite);
+ Verbose_Mode := True;
+
+ -- Why is following written to standard error. Most other
+ -- tools write to standard output ???
+
+ Put (Standard_Error, "GNATCHOP ");
+ Put (Standard_Error, Gnatvsn.Gnat_Version_String);
+ Put_Line
+ (Standard_Error,
+ " Copyright 1998-2000, Ada Core Technologies Inc.");
when 'w' =>
- Overwrite_Files := True;
+ Overwrite_Files := True;
when 'x' =>
- Exit_On_Error := True;
+ Exit_On_Error := True;
when others =>
null;
Index: gnatlbr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gnatlbr.adb,v
retrieving revision 1.8
diff -u -r1.8 gnatlbr.adb
--- gnatlbr.adb 14 Nov 2003 10:24:43 -0000 1.8
+++ gnatlbr.adb 20 Nov 2003 18:18:35 -0000
@@ -50,7 +50,7 @@
with System;
procedure GnatLbr is
- pragma Ident (Gnat_Version_String);
+ pragma Ident (Gnat_Static_Version_String);
type Lib_Mode is (None, Create, Set, Delete);
Next_Arg : Integer;
Index: gnatxref.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gnatxref.adb,v
retrieving revision 1.6
diff -u -r1.6 gnatxref.adb
--- gnatxref.adb 21 Oct 2003 13:42:08 -0000 1.6
+++ gnatxref.adb 20 Nov 2003 18:18:35 -0000
@@ -24,10 +24,10 @@
-- --
------------------------------------------------------------------------------
-with Xr_Tabls; use Xr_Tabls;
-with Xref_Lib; use Xref_Lib;
-with Osint; use Osint;
-with Types; use Types;
+with Xr_Tabls; use Xr_Tabls;
+with Xref_Lib; use Xref_Lib;
+with Osint; use Osint;
+with Types; use Types;
with Gnatvsn;
with Opt;
@@ -35,10 +35,9 @@
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Command_Line; use GNAT.Command_Line;
-with GNAT.Strings; use GNAT.Strings;
+with GNAT.Strings; use GNAT.Strings;
procedure Gnatxref is
-
Search_Unused : Boolean := False;
Local_Symbols : Boolean := True;
Prj_File : File_Name_String;
@@ -209,8 +208,6 @@
-----------------
procedure Write_Usage is
- use Ada.Text_IO;
-
begin
Put_Line ("GNATXREF " & Gnatvsn.Gnat_Version_String
& " Copyright 1998-2003, Ada Core Technologies Inc.");
Index: gprcmd.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gprcmd.adb,v
retrieving revision 1.3
diff -u -r1.3 gprcmd.adb
--- gprcmd.adb 20 Nov 2003 09:53:58 -0000 1.3
+++ gprcmd.adb 20 Nov 2003 18:18:35 -0000
@@ -39,23 +39,22 @@
-- stamp copy file time stamp from file1 to file2
-- prefix get the prefix of the GNAT installation
+with Gnatvsn;
+with Osint; use Osint;
+with Namet; use Namet;
+
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Regpat; use GNAT.Regpat;
-with Gnatvsn;
-with Osint; use Osint;
-with Namet; use Namet;
+
procedure Gprcmd is
-- ??? comments are thin throughout this unit
- Version : constant String :=
- "GPRCMD " & Gnatvsn.Gnat_Version_String &
- " Copyright 2002-2003, Free Software Fundation, Inc.";
procedure Cat (File : String);
-- Print the contents of file on standard output.
@@ -350,7 +349,13 @@
begin
if Cmd = "-v" then
- Put_Line (Standard_Error, Version);
+
+ -- Should this be on Standard_Error ???
+
+ Put (Standard_Error, "GPRCMD ");
+ Put (Standard_Error, Gnatvsn.Gnat_Version_String);
+ Put_Line (Standard_Error,
+ " Copyright 2002-2003, Free Software Fundation, Inc.");
Usage;
elsif Cmd = "pwd" then
Index: make.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/make.adb,v
retrieving revision 1.23
diff -u -r1.23 make.adb
--- make.adb 17 Nov 2003 14:58:15 -0000 1.23
+++ make.adb 20 Nov 2003 18:18:36 -0000
@@ -6551,7 +6551,6 @@
then
Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save);
- Add_Switch (Argv, Linker, And_Save => And_Save);
if Argv'Length <= 6 or else Argv (6) /= '=' then
Make_Failed ("missing path for --RTS");
Index: scn.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/scn.adb,v
retrieving revision 1.8
diff -u -r1.8 scn.adb
--- scn.adb 21 Oct 2003 13:42:18 -0000 1.8
+++ scn.adb 20 Nov 2003 18:18:36 -0000
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2003 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- --
@@ -264,7 +264,9 @@
-- Set default for Comes_From_Source. All nodes built now until we
-- reenter the analyzer will have Comes_From_Source set to True
- Set_Comes_From_Source_Default (True);
+ if Index /= Internal_Source_File then
+ Set_Comes_From_Source_Default (True);
+ end if;
-- Check license if GNAT type header possibly present
@@ -278,7 +280,9 @@
-- call Scan. Scan initial token (note this initializes Prev_Token,
-- Prev_Token_Ptr).
- Scan;
+ if Index /= Internal_Source_File then
+ Scan;
+ end if;
-- Clear flags for reserved words used as indentifiers
Index: sinput.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sinput.adb,v
retrieving revision 1.6
diff -u -r1.6 sinput.adb
--- sinput.adb 21 Oct 2003 13:42:22 -0000 1.6
+++ sinput.adb 20 Nov 2003 18:18:36 -0000
@@ -1110,17 +1110,31 @@
function Source_First (S : SFI) return Source_Ptr is
begin
- return Source_File.Table (S).Source_First;
+ if S = Internal_Source_File then
+ return Internal_Source_Ptr'First;
+ else
+ return Source_File.Table (S).Source_First;
+ end if;
end Source_First;
function Source_Last (S : SFI) return Source_Ptr is
begin
- return Source_File.Table (S).Source_Last;
+ if S = Internal_Source_File then
+ return Internal_Source_Ptr'Last;
+ else
+ return Source_File.Table (S).Source_Last;
+ end if;
+
end Source_Last;
function Source_Text (S : SFI) return Source_Buffer_Ptr is
begin
- return Source_File.Table (S).Source_Text;
+ if S = Internal_Source_File then
+ return Internal_Source_Ptr;
+ else
+ return Source_File.Table (S).Source_Text;
+ end if;
+
end Source_Text;
function Template (S : SFI) return SFI is
Index: types.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/types.ads,v
retrieving revision 1.10
diff -u -r1.10 types.ads
--- types.ads 21 Oct 2003 13:42:23 -0000 1.10
+++ types.ads 20 Nov 2003 18:18:36 -0000
@@ -569,8 +569,13 @@
No_Unit : constant Unit_Number_Type := -1;
-- Special value used to signal no unit
- type Source_File_Index is new Nat;
+ type Source_File_Index is new Int range -1 .. Int'Last;
-- Type used to index the source file table (see package Sinput)
+
+ Internal_Source_File : constant Source_File_Index :=
+ Source_File_Index'First;
+ -- Value used to indicate the buffer for the source-code-like strings
+ -- internally created withing the compiler (see package Sinput)
No_Source_File : constant Source_File_Index := 0;
-- Value used to indicate no source file present
More information about the Gcc-patches
mailing list