git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Makefile.in: (stamp-tools): Add handling of snames.ad[sb] 

2009-04-10  Thomas Quinot  <quinot@adacore.com>

gnattools/
	* Makefile.in: (stamp-tools): Add handling of snames.ad[sb]

ada/
	* snames.h, snames.ads, snames.adb: Remove files, now generated from
	templates.

	* snames.h-tmpl, snames.ads-tmpl, snames.adb-tmpl: Templates for the
	above.

	* xsnamest.adb: New file.

	* gcc-interface/Make-lang.in: New target for automated generation of
	snames.ads, snames.adb and snames.h

From-SVN: r145893
This commit is contained in:
Arnaud Charlet 2009-04-10 15:09:53 +02:00
parent 0d24670707
commit b62a90f259
10 changed files with 1637 additions and 2439 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/ada/ChangeLog
View File

@ -1,3 +1,16 @@
2009-04-10 Thomas Quinot <quinot@adacore.com>
* snames.h, snames.ads, snames.adb: Remove files, now generated from
templates.
* snames.h-tmpl, snames.ads-tmpl, snames.adb-tmpl: Templates for the
above.
* xsnamest.adb: New file.
* gcc-interface/Make-lang.in: New target for automated generation of
snames.ads, snames.adb and snames.h
2009-04-10 Tristan Gingold <gingold@adacore.com> 2009-04-10 Tristan Gingold <gingold@adacore.com>
* gcc-interface/Makefile.in, gcc-interface/utils.c: Include "rtl.h" to * gcc-interface/Makefile.in, gcc-interface/utils.c: Include "rtl.h" to

15
gcc/ada/gcc-interface/Make-lang.in
View File

@ -762,7 +762,7 @@ ada.uninstall:
ada.mostlyclean: ada.mostlyclean:
-$(RM) ada/*$(objext) ada/*.ali ada/b_*.c -$(RM) ada/*$(objext) ada/*.ali ada/b_*.c
-$(RM) ada/*$(coverageexts) -$(RM) ada/*$(coverageexts)
-$(RM) ada/sdefault.adb ada/stamp-sdefault -$(RM) ada/sdefault.adb ada/stamp-sdefault ada/stamp-snames
-$(RMDIR) ada/tools -$(RMDIR) ada/tools
ada.clean: ada.clean:
ada.distclean: ada.distclean:
@ -792,6 +792,7 @@ ada.maintainer-clean:
-$(RM) ada/nmake.adb -$(RM) ada/nmake.adb
-$(RM) ada/nmake.ads -$(RM) ada/nmake.ads
-$(RM) ada/treeprs.ads -$(RM) ada/treeprs.ads
-$(RM) ada/snames.ads ada/snames.adb ada/snames.h
# Stage hooks: # Stage hooks:
# The main makefile has already created stage?/ada # The main makefile has already created stage?/ada
@ -914,7 +915,7 @@ gnatstage2: force
# Ada language specific files. # Ada language specific files.
ada_extra_files : ada/treeprs.ads ada/einfo.h ada/sinfo.h ada/nmake.adb \ ada_extra_files : ada/treeprs.ads ada/einfo.h ada/sinfo.h ada/nmake.adb \
ada/nmake.ads ada/nmake.ads ada/snames.ads ada/snames.adb ada/snames.h
ada/b_gnat1.c : $(GNAT1_ADA_OBJS) ada/b_gnat1.c : $(GNAT1_ADA_OBJS)
$(GNATBIND) -C $(ADA_INCLUDES) -o ada/b_gnat1.c -n ada/gnat1drv.ali $(GNATBIND) -C $(ADA_INCLUDES) -o ada/b_gnat1.c -n ada/gnat1drv.ali
@ -943,6 +944,16 @@ ada/sinfo.h : ada/sinfo.ads ada/xsinfo.adb
$(CP) $^ ada/bldtools/sinfo $(CP) $^ ada/bldtools/sinfo
(cd ada/bldtools/sinfo && $(GNATMAKE) -q xsinfo && ./xsinfo ../../sinfo.h ) (cd ada/bldtools/sinfo && $(GNATMAKE) -q xsinfo && ./xsinfo ../../sinfo.h )
ada/snames.h ada/snames.ads ada/snames.adb : ada/stamp-snames
@true
ada/stamp-snames : ada/snames.ads-tmpl ada/snames.adb-tmpl ada/snames.h-tmpl ada/xsnamest.adb
-$(MKDIR) ada/bldtools/snamest
$(RM) $(addprefix ada/bldtools/snamest/,$(notdir $^))
$(CP) $^ ada/bldtools/snamest
(cd ada/bldtools/snamest; gnatmake -q xsnamest ; ./xsnamest ; cp snames.ns ../../snames.ads ; cp snames.nb ../../snames.adb ; cp snames.nh ../../snames.h)
touch $@
ada/nmake.adb : ada/sinfo.ads ada/nmake.adt ada/xnmake.adb ada/xutil.ads ada/xutil.adb ada/nmake.adb : ada/sinfo.ads ada/nmake.adt ada/xnmake.adb ada/xutil.ads ada/xutil.adb
-$(MKDIR) ada/bldtools/nmake_b -$(MKDIR) ada/bldtools/nmake_b
$(RM) $(addprefix ada/bldtools/nmake_b/,$(notdir $^)) $(RM) $(addprefix ada/bldtools/nmake_b/,$(notdir $^))

1218
gcc/ada/snames.adb
View File

File diff suppressed because it is too large Load Diff

460
gcc/ada/snames.adb-tmpl Normal file
View File

@ -0,0 +1,460 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S N A M E S --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Opt; use Opt;
with Table;
with Types; use Types;
package body Snames is
-- Table used to record convention identifiers
type Convention_Id_Entry is record
Name : Name_Id;
Convention : Convention_Id;
end record;
package Convention_Identifiers is new Table.Table (
Table_Component_Type => Convention_Id_Entry,
Table_Index_Type => Int,
Table_Low_Bound => 1,
Table_Initial => 50,
Table_Increment => 200,
Table_Name => "Name_Convention_Identifiers");
-- Table of names to be set by Initialize. Each name is terminated by a
-- single #, and the end of the list is marked by a null entry, i.e. by
-- two # marks in succession. Note that the table does not include the
-- entries for a-z, since these are initialized by Namet itself.
Preset_Names : constant String :=
!! TEMPLATE INSERTION POINT
"#";
---------------------
-- Generated Names --
---------------------
-- This section lists the various cases of generated names which are
-- built from existing names by adding unique leading and/or trailing
-- upper case letters. In some cases these names are built recursively,
-- in particular names built from types may be built from types which
-- themselves have generated names. In this list, xxx represents an
-- existing name to which identifying letters are prepended or appended,
-- and a trailing n represents a serial number in an external name that
-- has some semantic significance (e.g. the n'th index type of an array).
-- xxxA access type for formal xxx in entry param record (Exp_Ch9)
-- xxxB tag table for tagged type xxx (Exp_Ch3)
-- xxxB task body procedure for task xxx (Exp_Ch9)
-- xxxD dispatch table for tagged type xxx (Exp_Ch3)
-- xxxD discriminal for discriminant xxx (Sem_Ch3)
-- xxxDn n'th discr check function for rec type xxx (Exp_Ch3)
-- xxxE elaboration boolean flag for task xxx (Exp_Ch9)
-- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3)
-- xxxE parameters for accept body for entry xxx (Exp_Ch9)
-- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3)
-- xxxJ tag table type index for tagged type xxx (Exp_Ch3)
-- xxxM master Id value for access type xxx (Exp_Ch3)
-- xxxP tag table pointer type for tagged type xxx (Exp_Ch3)
-- xxxP parameter record type for entry xxx (Exp_Ch9)
-- xxxPA access to parameter record type for entry xxx (Exp_Ch9)
-- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3)
-- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3)
-- xxxT tag table type for tagged type xxx (Exp_Ch3)
-- xxxT literal table for enumeration type xxx (Sem_Ch3)
-- xxxV type for task value record for task xxx (Exp_Ch9)
-- xxxX entry index constant (Exp_Ch9)
-- xxxY dispatch table type for tagged type xxx (Exp_Ch3)
-- xxxZ size variable for task xxx (Exp_Ch9)
-- TSS names
-- xxxDA deep adjust routine for type xxx (Exp_TSS)
-- xxxDF deep finalize routine for type xxx (Exp_TSS)
-- xxxDI deep initialize routine for type xxx (Exp_TSS)
-- xxxEQ composite equality routine for record type xxx (Exp_TSS)
-- xxxFA PolyORB/DSA From_Any converter for type xxx (Exp_TSS)
-- xxxIP initialization procedure for type xxx (Exp_TSS)
-- xxxRA RAS type access routine for type xxx (Exp_TSS)
-- xxxRD RAS type dereference routine for type xxx (Exp_TSS)
-- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS)
-- xxxSA array/slice assignment for controlled comp. arrays (Exp_TSS)
-- xxxSI stream input attribute subprogram for type xxx (Exp_TSS)
-- xxxSO stream output attribute subprogram for type xxx (Exp_TSS)
-- xxxSR stream read attribute subprogram for type xxx (Exp_TSS)
-- xxxSW stream write attribute subprogram for type xxx (Exp_TSS)
-- xxxTA PolyORB/DSA To_Any converter for type xxx (Exp_TSS)
-- xxxTC PolyORB/DSA Typecode for type xxx (Exp_TSS)
-- Implicit type names
-- TxxxT type of literal table for enumeration type xxx (Sem_Ch3)
-- (Note: this list is not complete or accurate ???)
----------------------
-- Get_Attribute_Id --
----------------------
function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
begin
return Attribute_Id'Val (N - First_Attribute_Name);
end Get_Attribute_Id;
-----------------------
-- Get_Convention_Id --
-----------------------
function Get_Convention_Id (N : Name_Id) return Convention_Id is
begin
case N is
when Name_Ada => return Convention_Ada;
when Name_Assembler => return Convention_Assembler;
when Name_C => return Convention_C;
when Name_CIL => return Convention_CIL;
when Name_COBOL => return Convention_COBOL;
when Name_CPP => return Convention_CPP;
when Name_Fortran => return Convention_Fortran;
when Name_Intrinsic => return Convention_Intrinsic;
when Name_Java => return Convention_Java;
when Name_Stdcall => return Convention_Stdcall;
when Name_Stubbed => return Convention_Stubbed;
-- If no direct match, then we must have a convention
-- identifier pragma that has specified this name.
when others =>
for J in 1 .. Convention_Identifiers.Last loop
if N = Convention_Identifiers.Table (J).Name then
return Convention_Identifiers.Table (J).Convention;
end if;
end loop;
raise Program_Error;
end case;
end Get_Convention_Id;
-------------------------
-- Get_Convention_Name --
-------------------------
function Get_Convention_Name (C : Convention_Id) return Name_Id is
begin
case C is
when Convention_Ada => return Name_Ada;
when Convention_Assembler => return Name_Assembler;
when Convention_C => return Name_C;
when Convention_CIL => return Name_CIL;
when Convention_COBOL => return Name_COBOL;
when Convention_CPP => return Name_CPP;
when Convention_Entry => return Name_Entry;
when Convention_Fortran => return Name_Fortran;
when Convention_Intrinsic => return Name_Intrinsic;
when Convention_Java => return Name_Java;
when Convention_Protected => return Name_Protected;
when Convention_Stdcall => return Name_Stdcall;
when Convention_Stubbed => return Name_Stubbed;
end case;
end Get_Convention_Name;
---------------------------
-- Get_Locking_Policy_Id --
---------------------------
function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is
begin
return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);
end Get_Locking_Policy_Id;
-------------------
-- Get_Pragma_Id --
-------------------
function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
begin
if N = Name_AST_Entry then
return Pragma_AST_Entry;
elsif N = Name_Fast_Math then
return Pragma_Fast_Math;
elsif N = Name_Interface then
return Pragma_Interface;
elsif N = Name_Priority then
return Pragma_Priority;
elsif N = Name_Relative_Deadline then
return Pragma_Relative_Deadline;
elsif N = Name_Storage_Size then
return Pragma_Storage_Size;
elsif N = Name_Storage_Unit then
return Pragma_Storage_Unit;
elsif N not in First_Pragma_Name .. Last_Pragma_Name then
return Unknown_Pragma;
else
return Pragma_Id'Val (N - First_Pragma_Name);
end if;
end Get_Pragma_Id;
---------------------------
-- Get_Queuing_Policy_Id --
---------------------------
function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is
begin
return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);
end Get_Queuing_Policy_Id;
------------------------------------
-- Get_Task_Dispatching_Policy_Id --
------------------------------------
function Get_Task_Dispatching_Policy_Id
(N : Name_Id) return Task_Dispatching_Policy_Id
is
begin
return Task_Dispatching_Policy_Id'Val
(N - First_Task_Dispatching_Policy_Name);
end Get_Task_Dispatching_Policy_Id;
----------------
-- Initialize --
----------------
procedure Initialize is
P_Index : Natural;
Discard_Name : Name_Id;
begin
P_Index := Preset_Names'First;
loop
Name_Len := 0;
while Preset_Names (P_Index) /= '#' loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Preset_Names (P_Index);
P_Index := P_Index + 1;
end loop;
-- We do the Name_Find call to enter the name into the table, but
-- we don't need to do anything with the result, since we already
-- initialized all the preset names to have the right value (we
-- are depending on the order of the names and Preset_Names).
Discard_Name := Name_Find;
P_Index := P_Index + 1;
exit when Preset_Names (P_Index) = '#';
end loop;
-- Make sure that number of names in standard table is correct. If
-- this check fails, run utility program XSNAMES to construct a new
-- properly matching version of the body.
pragma Assert (Discard_Name = Last_Predefined_Name);
-- Initialize the convention identifiers table with the standard
-- set of synonyms that we recognize for conventions.
Convention_Identifiers.Init;
Convention_Identifiers.Append ((Name_Asm, Convention_Assembler));
Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler));
Convention_Identifiers.Append ((Name_Default, Convention_C));
Convention_Identifiers.Append ((Name_External, Convention_C));
Convention_Identifiers.Append ((Name_C_Plus_Plus, Convention_CPP));
Convention_Identifiers.Append ((Name_DLL, Convention_Stdcall));
Convention_Identifiers.Append ((Name_Win32, Convention_Stdcall));
end Initialize;
-----------------------
-- Is_Attribute_Name --
-----------------------
function Is_Attribute_Name (N : Name_Id) return Boolean is
begin
return N in First_Attribute_Name .. Last_Attribute_Name;
end Is_Attribute_Name;
----------------------------------
-- Is_Configuration_Pragma_Name --
----------------------------------
function Is_Configuration_Pragma_Name (N : Name_Id) return Boolean is
begin
return N in First_Pragma_Name .. Last_Configuration_Pragma_Name
or else N = Name_Fast_Math;
end Is_Configuration_Pragma_Name;
------------------------
-- Is_Convention_Name --
------------------------
function Is_Convention_Name (N : Name_Id) return Boolean is
begin
-- Check if this is one of the standard conventions
if N in First_Convention_Name .. Last_Convention_Name
or else N = Name_C
then
return True;
-- Otherwise check if it is in convention identifier table
else
for J in 1 .. Convention_Identifiers.Last loop
if N = Convention_Identifiers.Table (J).Name then
return True;
end if;
end loop;
return False;
end if;
end Is_Convention_Name;
------------------------------
-- Is_Entity_Attribute_Name --
------------------------------
function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is
begin
return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;
end Is_Entity_Attribute_Name;
--------------------------------
-- Is_Function_Attribute_Name --
--------------------------------
function Is_Function_Attribute_Name (N : Name_Id) return Boolean is
begin
return N in
First_Renamable_Function_Attribute ..
Last_Renamable_Function_Attribute;
end Is_Function_Attribute_Name;
---------------------
-- Is_Keyword_Name --
---------------------
function Is_Keyword_Name (N : Name_Id) return Boolean is
begin
return Get_Name_Table_Byte (N) /= 0
and then (Ada_Version >= Ada_95
or else N not in Ada_95_Reserved_Words)
and then (Ada_Version >= Ada_05
or else N not in Ada_2005_Reserved_Words);
end Is_Keyword_Name;
----------------------------
-- Is_Locking_Policy_Name --
----------------------------
function Is_Locking_Policy_Name (N : Name_Id) return Boolean is
begin
return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
end Is_Locking_Policy_Name;
-----------------------------
-- Is_Operator_Symbol_Name --
-----------------------------
function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is
begin
return N in First_Operator_Name .. Last_Operator_Name;
end Is_Operator_Symbol_Name;
--------------------
-- Is_Pragma_Name --
--------------------
function Is_Pragma_Name (N : Name_Id) return Boolean is
begin
return N in First_Pragma_Name .. Last_Pragma_Name
or else N = Name_AST_Entry
or else N = Name_Fast_Math
or else N = Name_Interface
or else N = Name_Relative_Deadline
or else N = Name_Priority
or else N = Name_Storage_Size
or else N = Name_Storage_Unit;
end Is_Pragma_Name;
---------------------------------
-- Is_Procedure_Attribute_Name --
---------------------------------
function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is
begin
return N in First_Procedure_Attribute .. Last_Procedure_Attribute;
end Is_Procedure_Attribute_Name;
----------------------------
-- Is_Queuing_Policy_Name --
----------------------------
function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is
begin
return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;
end Is_Queuing_Policy_Name;
-------------------------------------
-- Is_Task_Dispatching_Policy_Name --
-------------------------------------
function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is
begin
return N in First_Task_Dispatching_Policy_Name ..
Last_Task_Dispatching_Policy_Name;
end Is_Task_Dispatching_Policy_Name;
----------------------------
-- Is_Type_Attribute_Name --
----------------------------
function Is_Type_Attribute_Name (N : Name_Id) return Boolean is
begin
return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;
end Is_Type_Attribute_Name;
----------------------------------
-- Record_Convention_Identifier --
----------------------------------
procedure Record_Convention_Identifier
(Id : Name_Id;
Convention : Convention_Id)
is
begin
Convention_Identifiers.Append ((Id, Convention));
end Record_Convention_Identifier;
end Snames;

1632
gcc/ada/snames.ads → gcc/ada/snames.ads-tmpl
View File

File diff suppressed because it is too large Load Diff

400
gcc/ada/snames.h
View File

@ -1,400 +0,0 @@
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* S N A M E S *
* *
* C Header File *
* *
* Copyright (C) 1992-2008, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
* ware Foundation; either version 3, or (at your option) any later ver- *
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
* for more details. You should have received a copy of the GNU General *
* Public License distributed with GNAT; see file COPYING3. If not, go to *
* http://www.gnu.org/licenses for a complete copy of the license. *
* *
* GNAT was originally developed by the GNAT team at New York University. *
* Extensive contributions were provided by Ada Core Technologies Inc. *
* *
****************************************************************************/
/* This is the C file that corresponds to the Ada package specification
Snames. It was created automatically from the file snames.ads. */
/* Name_Id values */
#define Name_uParent (First_Name_Id + 256 + 0)
#define Name_uTag (First_Name_Id + 256 + 1)
#define Name_Off (First_Name_Id + 256 + 2)
#define Name_Space (First_Name_Id + 256 + 3)
#define Name_Time (First_Name_Id + 256 + 4)
/* Define the function to return one of the numeric values below. Note
that it actually returns a char since an enumeration value of less
than 256 entries is represented that way in Ada. The operand is a Chars
field value. */
#define Get_Attribute_Id snames__get_attribute_id
extern unsigned char Get_Attribute_Id (int);
/* Define the numeric values for attributes. */
#define Attr_Abort_Signal 0
#define Attr_Access 1
#define Attr_Address 2
#define Attr_Address_Size 3
#define Attr_Aft 4
#define Attr_Alignment 5
#define Attr_Asm_Input 6
#define Attr_Asm_Output 7
#define Attr_AST_Entry 8
#define Attr_Bit 9
#define Attr_Bit_Order 10
#define Attr_Bit_Position 11
#define Attr_Body_Version 12
#define Attr_Callable 13
#define Attr_Caller 14
#define Attr_Code_Address 15
#define Attr_Component_Size 16
#define Attr_Compose 17
#define Attr_Constrained 18
#define Attr_Count 19
#define Attr_Default_Bit_Order 20
#define Attr_Definite 21
#define Attr_Delta 22
#define Attr_Denorm 23
#define Attr_Digits 24
#define Attr_Elaborated 25
#define Attr_Emax 26
#define Attr_Enabled 27
#define Attr_Enum_Rep 28
#define Attr_Enum_Val 29
#define Attr_Epsilon 30
#define Attr_Exponent 31
#define Attr_External_Tag 32
#define Attr_Fast_Math 33
#define Attr_First 34
#define Attr_First_Bit 35
#define Attr_Fixed_Value 36
#define Attr_Fore 37
#define Attr_Has_Access_Values 38
#define Attr_Has_Discriminants 39
#define Attr_Has_Tagged_Values 40
#define Attr_Identity 41
#define Attr_Img 42
#define Attr_Integer_Value 43
#define Attr_Invalid_Value 44
#define Attr_Large 45
#define Attr_Last 46
#define Attr_Last_Bit 47
#define Attr_Leading_Part 48
#define Attr_Length 49
#define Attr_Machine_Emax 50
#define Attr_Machine_Emin 51
#define Attr_Machine_Mantissa 52
#define Attr_Machine_Overflows 53
#define Attr_Machine_Radix 54
#define Attr_Machine_Rounding 55
#define Attr_Machine_Rounds 56
#define Attr_Machine_Size 57
#define Attr_Mantissa 58
#define Attr_Max_Size_In_Storage_Elements 59
#define Attr_Maximum_Alignment 60
#define Attr_Mechanism_Code 61
#define Attr_Mod 62
#define Attr_Model_Emin 63
#define Attr_Model_Epsilon 64
#define Attr_Model_Mantissa 65
#define Attr_Model_Small 66
#define Attr_Modulus 67
#define Attr_Null_Parameter 68
#define Attr_Object_Size 69
#define Attr_Old 70
#define Attr_Partition_ID 71
#define Attr_Passed_By_Reference 72
#define Attr_Pool_Address 73
#define Attr_Pos 74
#define Attr_Position 75
#define Attr_Priority 76
#define Attr_Range 77
#define Attr_Range_Length 78
#define Attr_Result 79
#define Attr_Round 80
#define Attr_Safe_Emax 81
#define Attr_Safe_First 82
#define Attr_Safe_Large 83
#define Attr_Safe_Last 84
#define Attr_Safe_Small 85
#define Attr_Scale 86
#define Attr_Scaling 87
#define Attr_Signed_Zeros 88
#define Attr_Size 89
#define Attr_Small 90
#define Attr_Storage_Size 91
#define Attr_Storage_Unit 92
#define Attr_Stream_Size 93
#define Attr_Tag 94
#define Attr_Target_Name 95
#define Attr_Terminated 96
#define Attr_To_Address 97
#define Attr_Type_Class 98
#define Attr_UET_Address 99
#define Attr_Unbiased_Rounding 100
#define Attr_Unchecked_Access 101
#define Attr_Unconstrained_Array 102
#define Attr_Universal_Literal_String 103
#define Attr_Unrestricted_Access 104
#define Attr_VADS_Size 105
#define Attr_Val 106
#define Attr_Valid 107
#define Attr_Value_Size 108
#define Attr_Version 109
#define Attr_Wchar_T_Size 110
#define Attr_Wide_Wide_Width 111
#define Attr_Wide_Width 112
#define Attr_Width 113
#define Attr_Word_Size 114
#define Attr_Adjacent 115
#define Attr_Ceiling 116
#define Attr_Copy_Sign 117
#define Attr_Floor 118
#define Attr_Fraction 119
#define Attr_From_Any 120
#define Attr_Image 121
#define Attr_Input 122
#define Attr_Machine 123
#define Attr_Max 124
#define Attr_Min 125
#define Attr_Model 126
#define Attr_Pred 127
#define Attr_Remainder 128
#define Attr_Rounding 129
#define Attr_Succ 130
#define Attr_To_Any 131
#define Attr_Truncation 132
#define Attr_TypeCode 133
#define Attr_Value 134
#define Attr_Wide_Image 135
#define Attr_Wide_Wide_Image 136
#define Attr_Wide_Value 137
#define Attr_Wide_Wide_Value 138
#define Attr_Output 139
#define Attr_Read 140
#define Attr_Write 141
#define Attr_Elab_Body 142
#define Attr_Elab_Spec 143
#define Attr_Storage_Pool 144
#define Attr_Base 145
#define Attr_Class 146
#define Attr_Stub_Type 147
/* Define the numeric values for the conventions. */
#define Convention_Ada 0
#define Convention_Intrinsic 1
#define Convention_Entry 2
#define Convention_Protected 3
#define Convention_Stubbed 4
#define Convention_Assembler 5
#define Convention_C 6
#define Convention_CIL 7
#define Convention_COBOL 8
#define Convention_CPP 9
#define Convention_Fortran 10
#define Convention_Java 11
#define Convention_Stdcall 12
/* Define the function to check if a Name_Id value is a valid pragma */
#define Is_Pragma_Name snames__is_pragma_name
extern Boolean Is_Pragma_Name (Name_Id);
/* Define the function to return one of the numeric values below. Note
that it actually returns a char since an enumeration value of less
than 256 entries is represented that way in Ada. The operand is a Chars
field value. */
#define Get_Pragma_Id snames__get_pragma_id
extern unsigned char Get_Pragma_Id (int);
/* Define the numeric values for the pragmas. */
#define Pragma_Ada_83 0
#define Pragma_Ada_95 1
#define Pragma_Ada_05 2
#define Pragma_Ada_2005 3
#define Pragma_Assertion_Policy 4
#define Pragma_Assume_No_Invalid_Values 5
#define Pragma_C_Pass_By_Copy 6
#define Pragma_Check_Name 7
#define Pragma_Check_Policy 8
#define Pragma_Compile_Time_Error 9
#define Pragma_Compile_Time_Warning 10
#define Pragma_Compiler_Unit 11
#define Pragma_Component_Alignment 12
#define Pragma_Convention_Identifier 13
#define Pragma_Debug_Policy 14
#define Pragma_Detect_Blocking 15
#define Pragma_Discard_Names 16
#define Pragma_Elaboration_Checks 17
#define Pragma_Eliminate 18
#define Pragma_Extend_System 19
#define Pragma_Extensions_Allowed 20
#define Pragma_External_Name_Casing 21
#define Pragma_Favor_Top_Level 22
#define Pragma_Float_Representation 23
#define Pragma_Implicit_Packing 24
#define Pragma_Initialize_Scalars 25
#define Pragma_Interrupt_State 26
#define Pragma_License 27
#define Pragma_Locking_Policy 28
#define Pragma_Long_Float 29
#define Pragma_No_Run_Time 30
#define Pragma_No_Strict_Aliasing 31
#define Pragma_Normalize_Scalars 32
#define Pragma_Optimize_Alignment 33
#define Pragma_Persistent_BSS 34
#define Pragma_Polling 35
#define Pragma_Priority_Specific_Dispatching 36
#define Pragma_Profile 37
#define Pragma_Profile_Warnings 38
#define Pragma_Propagate_Exceptions 39
#define Pragma_Queuing_Policy 40
#define Pragma_Ravenscar 41
#define Pragma_Restricted_Run_Time 42
#define Pragma_Restrictions 43
#define Pragma_Restriction_Warnings 44
#define Pragma_Reviewable 45
#define Pragma_Source_File_Name 46
#define Pragma_Source_File_Name_Project 47
#define Pragma_Style_Checks 48
#define Pragma_Suppress 49
#define Pragma_Suppress_Exception_Locations 50
#define Pragma_Task_Dispatching_Policy 51
#define Pragma_Universal_Data 52
#define Pragma_Unsuppress 53
#define Pragma_Use_VADS_Size 54
#define Pragma_Validity_Checks 55
#define Pragma_Warnings 56
#define Pragma_Wide_Character_Encoding 57
#define Pragma_Abort_Defer 58
#define Pragma_All_Calls_Remote 59
#define Pragma_Annotate 60
#define Pragma_Assert 61
#define Pragma_Asynchronous 62
#define Pragma_Atomic 63
#define Pragma_Atomic_Components 64
#define Pragma_Attach_Handler 65
#define Pragma_Check 66
#define Pragma_CIL_Constructor 67
#define Pragma_Comment 68
#define Pragma_Common_Object 69
#define Pragma_Complete_Representation 70
#define Pragma_Complex_Representation 71
#define Pragma_Controlled 72
#define Pragma_Convention 73
#define Pragma_CPP_Class 74
#define Pragma_CPP_Constructor 75
#define Pragma_CPP_Virtual 76
#define Pragma_CPP_Vtable 77
#define Pragma_Debug 78
#define Pragma_Elaborate 79
#define Pragma_Elaborate_All 80
#define Pragma_Elaborate_Body 81
#define Pragma_Export 82
#define Pragma_Export_Exception 83
#define Pragma_Export_Function 84
#define Pragma_Export_Object 85
#define Pragma_Export_Procedure 86
#define Pragma_Export_Value 87
#define Pragma_Export_Valued_Procedure 88
#define Pragma_External 89
#define Pragma_Finalize_Storage_Only 90
#define Pragma_Ident 91
#define Pragma_Implemented_By_Entry 92
#define Pragma_Import 93
#define Pragma_Import_Exception 94
#define Pragma_Import_Function 95
#define Pragma_Import_Object 96
#define Pragma_Import_Procedure 97
#define Pragma_Import_Valued_Procedure 98
#define Pragma_Inline 99
#define Pragma_Inline_Always 100
#define Pragma_Inline_Generic 101
#define Pragma_Inspection_Point 102
#define Pragma_Interface_Name 103
#define Pragma_Interrupt_Handler 104
#define Pragma_Interrupt_Priority 105
#define Pragma_Java_Constructor 106
#define Pragma_Java_Interface 107
#define Pragma_Keep_Names 108
#define Pragma_Link_With 109
#define Pragma_Linker_Alias 110
#define Pragma_Linker_Constructor 111
#define Pragma_Linker_Destructor 112
#define Pragma_Linker_Options 113
#define Pragma_Linker_Section 114
#define Pragma_List 115
#define Pragma_Machine_Attribute 116
#define Pragma_Main 117
#define Pragma_Main_Storage 118
#define Pragma_Memory_Size 119
#define Pragma_No_Body 120
#define Pragma_No_Return 121
#define Pragma_Obsolescent 122
#define Pragma_Optimize 123
#define Pragma_Pack 124
#define Pragma_Page 125
#define Pragma_Passive 126
#define Pragma_Postcondition 127
#define Pragma_Precondition 128
#define Pragma_Preelaborable_Initialization 129
#define Pragma_Preelaborate 130
#define Pragma_Preelaborate_05 131
#define Pragma_Psect_Object 132
#define Pragma_Pure 133
#define Pragma_Pure_05 134
#define Pragma_Pure_Function 135
#define Pragma_Relative_Deadline 136
#define Pragma_Remote_Call_Interface 137
#define Pragma_Remote_Types 138
#define Pragma_Share_Generic 139
#define Pragma_Shared 140
#define Pragma_Shared_Passive 141
#define Pragma_Source_Reference 142
#define Pragma_Static_Elaboration_Desired 143
#define Pragma_Stream_Convert 144
#define Pragma_Subtitle 145
#define Pragma_Suppress_All 146
#define Pragma_Suppress_Debug_Info 147
#define Pragma_Suppress_Initialization 148
#define Pragma_System_Name 149
#define Pragma_Task_Info 150
#define Pragma_Task_Name 151
#define Pragma_Task_Storage 152
#define Pragma_Thread_Local_Storage 153
#define Pragma_Time_Slice 154
#define Pragma_Title 155
#define Pragma_Unchecked_Union 156
#define Pragma_Unimplemented_Unit 157
#define Pragma_Universal_Aliasing 158
#define Pragma_Unmodified 159
#define Pragma_Unreferenced 160
#define Pragma_Unreferenced_Objects 161
#define Pragma_Unreserve_All_Interrupts 162
#define Pragma_Volatile 163
#define Pragma_Volatile_Components 164
#define Pragma_Weak_External 165
#define Pragma_AST_Entry 166
#define Pragma_Fast_Math 167
#define Pragma_Interface 168
#define Pragma_Priority 169
#define Pragma_Storage_Size 170
#define Pragma_Storage_Unit 171
/* End of snames.h (C version of Snames package spec) */

66
gcc/ada/snames.h-tmpl Normal file
View File

@ -0,0 +1,66 @@
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* S N A M E S *
* *
* C Header File *
* *
* Copyright (C) 1992-2008, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
* ware Foundation; either version 3, or (at your option) any later ver- *
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
* for more details. You should have received a copy of the GNU General *
* Public License distributed with GNAT; see file COPYING3. If not, go to *
* http://www.gnu.org/licenses for a complete copy of the license. *
* *
* GNAT was originally developed by the GNAT team at New York University. *
* Extensive contributions were provided by Ada Core Technologies Inc. *
* *
****************************************************************************/
/* This is the C file that corresponds to the Ada package specification
Snames. It was created automatically from the file snames.ads. */
/* Name_Id values */
#define Name_ !! TEMPLATE INSERTION POINT
/* Define the function to return one of the numeric values below. Note
that it actually returns a char since an enumeration value of less
than 256 entries is represented that way in Ada. The operand is a Chars
field value. */
#define Get_Attribute_Id snames__get_attribute_id
extern unsigned char Get_Attribute_Id (int);
/* Define the numeric values for attributes. */
#define Attr_ !! TEMPLATE INSERTION POINT
/* Define the numeric values for the conventions. */
#define Convention_ !! TEMPLATE INSERTION POINT
/* Define the function to check if a Name_Id value is a valid pragma */
#define Is_Pragma_Name snames__is_pragma_name
extern Boolean Is_Pragma_Name (Name_Id);
/* Define the function to return one of the numeric values below. Note
that it actually returns a char since an enumeration value of less
than 256 entries is represented that way in Ada. The operand is a Chars
field value. */
#define Get_Pragma_Id snames__get_pragma_id
extern unsigned char Get_Pragma_Id (int);
/* Define the numeric values for the pragmas. */
#define Pragma_ !! TEMPLATE_INSERTION_POINT
/* End of snames.h (C version of Snames package spec) */

266
gcc/ada/xsnamest.adb Normal file
View File

@ -0,0 +1,266 @@
------------------------------------------------------------------------------
-- --
-- GNAT SYSTEM UTILITIES --
-- --
-- X S N A M E S T --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This utility is used to make a new version of the Snames package when new
-- names are added. This version reads a template file from snames.adt in
-- which the numbers are all written as $, and generates a new version of
-- the spec file snames.ads (written to snames.ns). It also reads snames.adb
-- and generates an updated body (written to snames.nb), and snames.h and
-- generates an updated C header file (written to snames.nh).
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Spitbol; use GNAT.Spitbol;
with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
procedure XSnamesT is
InB : File_Type;
InT : File_Type;
OutS : File_Type;
OutB : File_Type;
InH : File_Type;
OutH : File_Type;
A, B : VString := Nul;
Line : VString := Nul;
Name0 : VString := Nul;
Name1 : VString := Nul;
Oval : VString := Nul;
Restl : VString := Nul;
Name_Ref : constant Pattern := Span (' ') * A & Break (' ') * Name0
& Span (' ') * B
& ": constant Name_Id := N + $;"
& Rest * Restl;
Get_Name : constant Pattern := "Name_" & Rest * Name1;
Chk_Low : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
Findu : constant Pattern := Span ('u') * A;
Val : Natural;
Xlate_U_Und : constant Character_Mapping := To_Mapping ("u", "_");
M : Match_Result;
type Header_Symbol is (None, Name, Attr, Conv, Prag);
-- A symbol in the header file
procedure Output_Header_Line (S : Header_Symbol);
-- Output header line
Header_Name : aliased String := "Name";
Header_Attr : aliased String := "Attr";
Header_Conv : aliased String := "Convention";
Header_Prag : aliased String := "Pragma";
-- Prefixes used in the header file
type String_Ptr is access all String;
Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
(null,
Header_Name'Access,
Header_Attr'Access,
Header_Conv'Access,
Header_Prag'Access);
-- Patterns used in the spec file
Get_Attr : constant Pattern := Span (' ') & "Attribute_"
& Break (",)") * Name1;
Get_Conv : constant Pattern := Span (' ') & "Convention_"
& Break (",)") * Name1;
Get_Prag : constant Pattern := Span (' ') & "Pragma_"
& Break (",)") * Name1;
type Header_Symbol_Counter is array (Header_Symbol) of Natural;
Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0, 0);
Header_Current_Symbol : Header_Symbol := None;
Header_Pending_Line : VString := Nul;
------------------------
-- Output_Header_Line --
------------------------
procedure Output_Header_Line (S : Header_Symbol) is
function Make_Value (V : Integer) return String;
-- Build the definition for the current macro (Names are integers
-- offset to N, while other items are enumeration values).
function Make_Value (V : Integer) return String is
begin
if S = Name then
return "(First_Name_Id + 256 + " & V & ")";
else
return "" & V;
end if;
end Make_Value;
begin
-- Skip all the #define for S-prefixed symbols in the header.
-- Of course we are making implicit assumptions:
-- (1) No newline between symbols with the same prefix.
-- (2) Prefix order is the same as in snames.ads.
if Header_Current_Symbol /= S then
declare
Name2 : Vstring;
Pat : constant Pattern := "#define "
& Header_Prefix (S).all
& Break (' ') * Name2;
In_Pat : Boolean := False;
begin
if Header_Current_Symbol /= None then
Put_Line (OutH, Header_Pending_Line);
end if;
loop
Line := Get_Line (InH);
if Match (Line, Pat) then
In_Pat := True;
elsif In_Pat then
Header_Pending_Line := Line;
exit;
else
Put_Line (OutH, Line);
end if;
end loop;
Header_Current_Symbol := S;
end;
end if;
-- Now output the line
-- Note that we must ensure at least one space between macro name and
-- parens, otherwise the parenthesized value gets treated as an argument
-- specification.
Put_Line (OutH, "#define " & Header_Prefix (S).all
& "_" & Name1
& (30 - Natural'Min (29, Length (Name1))) * ' '
& Make_Value (Header_Counter (S)));
Header_Counter (S) := Header_Counter (S) + 1;
end Output_Header_Line;
-- Start of processing for XSnames
begin
Open (InT, In_File, "snames.ads-tmpl");
Open (InB, In_File, "snames.adb-tmpl");
Open (InH, In_File, "snames.h-tmpl");
Create (OutS, Out_File, "snames.ns");
Create (OutB, Out_File, "snames.nb");
Create (OutH, Out_File, "snames.nh");
Anchored_Mode := True;
Val := 0;
loop
Line := Get_Line (InB);
exit when Match (Line, " Preset_Names");
Put_Line (OutB, Line);
end loop;
Put_Line (OutB, Line);
LoopN : while not End_Of_File (InT) loop
Line := Get_Line (InT);
if not Match (Line, Name_Ref) then
Put_Line (OutS, Line);
if Match (Line, Get_Attr) then
Output_Header_Line (Attr);
elsif Match (Line, Get_Conv) then
Output_Header_Line (Conv);
elsif Match (Line, Get_Prag) then
Output_Header_Line (Prag);
end if;
else
Oval := Lpad (V (Val), 3, '0');
if Match (Name0, "Last_") then
Oval := Lpad (V (Val - 1), 3, '0');
end if;
Put_Line
(OutS, A & Name0 & B & ": constant Name_Id := N + "
& Oval & ';' & Restl);
if Match (Name0, Get_Name) then
Name0 := Name1;
Val := Val + 1;
if Match (Name0, Findu, M) then
Replace (M, Translate (A, Xlate_U_Und));
Translate (Name0, Lower_Case_Map);
elsif not Match (Name0, "Op_", "") then
Translate (Name0, Lower_Case_Map);
else
Name0 := 'O' & Translate (Name0, Lower_Case_Map);
end if;
if Name0 = "error" then
Name0 := V ("<error>");
end if;
if not Match (Name0, Chk_Low) then
Put_Line (OutB, " """ & Name0 & "#"" &");
end if;
Output_Header_Line (Name);
end if;
end if;
end loop LoopN;
loop
Line := Get_Line (InB);
exit when Match (Line, " ""#"";");
end loop;
Put_Line (OutB, Line);
while not End_Of_File (InB) loop
Line := Get_Line (InB);
Put_Line (OutB, Line);
end loop;
Put_Line (OutH, Header_Pending_Line);
while not End_Of_File (InH) loop
Line := Get_Line (InH);
Put_Line (OutH, Line);
end loop;
end XSnamesT;

4
gnattools/ChangeLog
View File

@ -1,3 +1,7 @@
2009-04-10 Arnaud Charlet <charlet@adacore.com>
* Makefile.in (stamp-tools): Add handling of snames.ad[sb]
2009-04-09 Jakub Jelinek <jakub@redhat.com> 2009-04-09 Jakub Jelinek <jakub@redhat.com>
* Makefile.in: Change copyright header to refer to version * Makefile.in: Change copyright header to refer to version

2
gnattools/Makefile.in
View File

@ -161,7 +161,7 @@ $(GCC_DIR)/stamp-gnatlib-rts:
$(GCC_DIR)/stamp-tools: $(GCC_DIR)/stamp-tools:
-rm -rf $(GCC_DIR)/ada/tools -rm -rf $(GCC_DIR)/ada/tools
-mkdir -p $(GCC_DIR)/ada/tools -mkdir -p $(GCC_DIR)/ada/tools
-(cd $(GCC_DIR)/ada/tools; $(LN_S) ../sdefault.adb .) -(cd $(GCC_DIR)/ada/tools; $(LN_S) ../sdefault.adb ../snames.ads ../snames.adb .)
-$(foreach PAIR,$(TOOLS_TARGET_PAIRS), \ -$(foreach PAIR,$(TOOLS_TARGET_PAIRS), \
rm -f $(GCC_DIR)/ada/tools/$(word 1,$(subst <, ,$(PAIR)));\ rm -f $(GCC_DIR)/ada/tools/$(word 1,$(subst <, ,$(PAIR)));\
$(LN_S) $(fsrcdir)/$(word 2,$(subst <, ,$(PAIR))) \ $(LN_S) $(fsrcdir)/$(word 2,$(subst <, ,$(PAIR))) \