mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-11-23 10:54:07 +08:00
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
parent
0d24670707
commit
b62a90f259
@ -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>
|
||||
|
||||
* gcc-interface/Makefile.in, gcc-interface/utils.c: Include "rtl.h" to
|
||||
|
||||
@ -762,7 +762,7 @@ ada.uninstall:
|
||||
ada.mostlyclean:
|
||||
-$(RM) ada/*$(objext) ada/*.ali ada/b_*.c
|
||||
-$(RM) ada/*$(coverageexts)
|
||||
-$(RM) ada/sdefault.adb ada/stamp-sdefault
|
||||
-$(RM) ada/sdefault.adb ada/stamp-sdefault ada/stamp-snames
|
||||
-$(RMDIR) ada/tools
|
||||
ada.clean:
|
||||
ada.distclean:
|
||||
@ -792,6 +792,7 @@ ada.maintainer-clean:
|
||||
-$(RM) ada/nmake.adb
|
||||
-$(RM) ada/nmake.ads
|
||||
-$(RM) ada/treeprs.ads
|
||||
-$(RM) ada/snames.ads ada/snames.adb ada/snames.h
|
||||
|
||||
# Stage hooks:
|
||||
# The main makefile has already created stage?/ada
|
||||
@ -914,7 +915,7 @@ gnatstage2: force
|
||||
# Ada language specific files.
|
||||
|
||||
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)
|
||||
$(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
|
||||
(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
|
||||
-$(MKDIR) ada/bldtools/nmake_b
|
||||
$(RM) $(addprefix ada/bldtools/nmake_b/,$(notdir $^))
|
||||
|
||||
1218
gcc/ada/snames.adb
1218
gcc/ada/snames.adb
File diff suppressed because it is too large
Load Diff
460
gcc/ada/snames.adb-tmpl
Normal file
460
gcc/ada/snames.adb-tmpl
Normal 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;
|
||||
File diff suppressed because it is too large
Load Diff
400
gcc/ada/snames.h
400
gcc/ada/snames.h
@ -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
66
gcc/ada/snames.h-tmpl
Normal 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
266
gcc/ada/xsnamest.adb
Normal 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;
|
||||
@ -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>
|
||||
|
||||
* Makefile.in: Change copyright header to refer to version
|
||||
|
||||
@ -161,7 +161,7 @@ $(GCC_DIR)/stamp-gnatlib-rts:
|
||||
$(GCC_DIR)/stamp-tools:
|
||||
-rm -rf $(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), \
|
||||
rm -f $(GCC_DIR)/ada/tools/$(word 1,$(subst <, ,$(PAIR)));\
|
||||
$(LN_S) $(fsrcdir)/$(word 2,$(subst <, ,$(PAIR))) \
|
||||
|
||||
Loading…
Reference in New Issue
Block a user