Commit 752b81d9 by Arnaud Charlet

[multiple changes]

2013-04-11  Arnaud Charlet  <charlet@adacore.com>

	* xgnatugn.adb: Remove obsolete comments.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* back_end.ads, back_end.adb: Minor reformatting.
	* set_targ.ads, set_targ.adb: New files.

2013-04-11  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_case.adb (Check_Against_Predicate): New routine.
	(Check_Choices): When the type covered by the list of choices
	is a static subtype with a static predicate, check all choices
	agains the predicate.
	(Issue_Msg): All versions removed.
	(Missing_Choice): New routines.
	* sem_ch4.adb: Code and comment reformatting.
	(Analyze_Case_Expression): Do not check the choices when the case
	expression is being preanalyzed and the type of the expression
	is a subtype with a static predicate.
	(Has_Static_Predicate): New routine.
	* sem_ch13.adb: Code and comment reformatting.	(Build_Range):
	Always build a range even if the low and hi bounds denote the
	same value. This is needed by the machinery in Check_Choices.
	(Build_Static_Predicate): Always build a range even if the low and
	hi bounds denote the same value. This is needed by the machinery
	in Check_Choices.

From-SVN: r197789
parent 4b342b91
2013-04-11 Arnaud Charlet <charlet@adacore.com>
* xgnatugn.adb: Remove obsolete comments.
2013-04-11 Robert Dewar <dewar@adacore.com>
* back_end.ads, back_end.adb: Minor reformatting.
* set_targ.ads, set_targ.adb: New files.
2013-04-11 Hristian Kirtchev <kirtchev@adacore.com>
* sem_case.adb (Check_Against_Predicate): New routine.
(Check_Choices): When the type covered by the list of choices
is a static subtype with a static predicate, check all choices
agains the predicate.
(Issue_Msg): All versions removed.
(Missing_Choice): New routines.
* sem_ch4.adb: Code and comment reformatting.
(Analyze_Case_Expression): Do not check the choices when the case
expression is being preanalyzed and the type of the expression
is a subtype with a static predicate.
(Has_Static_Predicate): New routine.
* sem_ch13.adb: Code and comment reformatting. (Build_Range):
Always build a range even if the low and hi bounds denote the
same value. This is needed by the machinery in Check_Choices.
(Build_Static_Predicate): Always build a range even if the low and
hi bounds denote the same value. This is needed by the machinery
in Check_Choices.
2013-04-11 Robert Dewar <dewar@adacore.com>
* einfo.ads, sem_util.adb, exp_ch6.adb, xgnatugn.adb: Minor
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
......@@ -347,7 +347,6 @@ package body Back_End is
procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
pragma Import (C, Enumerate_Modes, "enumerate_modes");
begin
Enumerate_Modes (Call_Back);
end Register_Back_End_Types;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
......@@ -24,7 +24,8 @@
------------------------------------------------------------------------------
-- Call the back end with all the information needed. Also contains other
-- back-end specific interfaces required by the front end.
-- back-end specific interfaces required by the front end. See also Get_Targ,
-- which defines additional interfaces to the back end.
with Einfo; use Einfo;
......@@ -63,13 +64,13 @@ package Back_End is
-- the back end.
procedure Register_Back_End_Types (Call_Back : Register_Type_Proc);
-- Calls the Call_Back function with information for each supported type.
-- Calls the Call_Back function with information for each supported type
procedure Call_Back_End (Mode : Back_End_Mode_Type);
-- Call back end, i.e. make call to driver traversing the tree and
-- outputting code. This call is made with all tables locked.
-- The back end is responsible for unlocking any tables it may need
-- to change, and locking them again before returning.
-- outputting code. This call is made with all tables locked. The back
-- end is responsible for unlocking any tables it may need to change,
-- and locking them again before returning.
procedure Scan_Compiler_Arguments;
-- Acquires command-line parameters passed to the compiler and processes
......
......@@ -1248,14 +1248,8 @@ package body Sem_Ch4 is
-----------------------------
procedure Analyze_Case_Expression (N : Node_Id) is
Expr : constant Node_Id := Expression (N);
FirstX : constant Node_Id := Expression (First (Alternatives (N)));
Alt : Node_Id;
Exp_Type : Entity_Id;
Exp_Btype : Entity_Id;
Dont_Care : Boolean;
Others_Present : Boolean;
function Has_Static_Predicate (Subtyp : Entity_Id) return Boolean;
-- Determine whether subtype Subtyp has aspect Static_Predicate
procedure Non_Static_Choice_Error (Choice : Node_Id);
-- Error routine invoked by the generic instantiation below when
......@@ -1270,6 +1264,28 @@ package body Sem_Ch4 is
Process_Associated_Node => No_OP);
use Case_Choices_Processing;
--------------------------
-- Has_Static_Predicate --
--------------------------
function Has_Static_Predicate (Subtyp : Entity_Id) return Boolean is
Item : Node_Id;
begin
Item := First_Rep_Item (Subtyp);
while Present (Item) loop
if Nkind (Item) = N_Aspect_Specification
and then Chars (Identifier (Item)) = Name_Static_Predicate
then
return True;
end if;
Next_Rep_Item (Item);
end loop;
return False;
end Has_Static_Predicate;
-----------------------------
-- Non_Static_Choice_Error --
-----------------------------
......@@ -1280,6 +1296,17 @@ package body Sem_Ch4 is
("choice given in case expression is not static!", Choice);
end Non_Static_Choice_Error;
-- Local variables
Expr : constant Node_Id := Expression (N);
FirstX : constant Node_Id := Expression (First (Alternatives (N)));
Alt : Node_Id;
Exp_Type : Entity_Id;
Exp_Btype : Entity_Id;
Dont_Care : Boolean;
Others_Present : Boolean;
-- Start of processing for Analyze_Case_Expression
begin
......@@ -1364,9 +1391,22 @@ package body Sem_Ch4 is
Exp_Type := Exp_Btype;
end if;
-- The case expression alternatives cover the range of a static subtype
-- subject to aspect Static_Predicate. Do not check the choices when the
-- case expression has not been fully analyzed yet because this may lead
-- to bogus errors.
if Is_Static_Subtype (Exp_Type)
and then Has_Static_Predicate (Exp_Type)
and then In_Spec_Expression
then
null;
-- Call instantiated Analyze_Choices which does the rest of the work
Analyze_Choices (N, Exp_Type, Dont_Care, Others_Present);
else
Analyze_Choices (N, Exp_Type, Dont_Care, Others_Present);
end if;
if Exp_Type = Universal_Integer and then not Others_Present then
Error_Msg_N
......@@ -1896,10 +1936,9 @@ package body Sem_Ch4 is
begin
A := First (Actions (N));
loop
while Present (A) loop
Analyze (A);
Next (A);
exit when No (A);
end loop;
-- This test needs a comment ???
......
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E T _ T A R G --
-- --
-- S p e c --
-- --
-- Copyright (C) 2013, 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 package handles setting target dependent parameters. If the -gnatet
-- switch is not set, then these values are taken from the back end (via the
-- routines in Get_Targ, and the enumerate_modes routine in misc.c). If the
-- switch is set, then the values are read from the target.atp file in the
-- current directory (usually written with the Write_Target_Dependent_Values
-- procedure defined in this package).
-- Note that all these values return sizes of C types with corresponding
-- names. This allows GNAT to define the corresponding Ada types to have
-- the same representation. There is one exception: the representation
-- of Wide_Character_Type uses twice the size of a C char, instead of the
-- size of wchar_t, since this corresponds to expected Ada usage.
with Einfo; use Einfo;
with Types; use Types;
package Set_Targ is
-----------------------------
-- Target-Dependent Values --
-----------------------------
-- The following is a table of target dependent values. In normal operation
-- these values are set by calling the appropriate C backend routines that
-- interface to back end routines that determine target characteristics.
-- If the -gnateT switch is used, then any values that are read from the
-- file target.atp in the current directory overwrite values set from the
-- back end. This is used by tools other than the compiler, e.g. to do
-- semantic analysis of programs that will run on some other target than
-- the machine on which the tool is run.
-- Note: fields marked with a question mark are boolean fields, where a
-- value of 0 is False, and a value of 1 is True.
Bits_BE : Nat; -- Bits stored big-endian?
Bits_Per_Unit : Pos; -- Bits in a storage unit
Bits_Per_Word : Pos; -- Bits in a word
Bytes_BE : Nat; -- Bytes stored big-endian?
Char_Size : Pos; -- Standard.Character'Size
Double_Float_Alignment : Nat; -- Alignment of double float
Double_Scalar_Alignment : Nat; -- Alignment of double length scalar
Double_Size : Pos; -- Standard.Long_Float'Size
Float_Size : Pos; -- Standard.Float'Size
Float_Words_BE : Nat; -- Float words stored big-endian?
Int_Size : Pos; -- Standard.Integer'Size
Long_Double_Size : Pos; -- Standard.Long_Long_Float'Size
Long_Long_Size : Pos; -- Standard.Long_Long_Integer'Size
Long_Size : Pos; -- Standard.Long_Integer'Size
Maximum_Alignment : Pos; -- Maximum permitted alignment
Max_Unaligned_Field : Pos; -- Maximum size for unaligned bit field
Pointer_Size : Pos; -- System.Address'Size
Short_Size : Pos; -- Standard.Short_Integer'Size
Strict_Alignment : Nat; -- Strict alignment?
System_Allocator_Alignment : Nat; -- Alignment for malloc calls
Wchar_T_Size : Pos; -- Interfaces.C.wchar_t'Size
Words_BE : Nat; -- Words stored big-endian?
-------------------------------------
-- Registered Floating-Point Types --
-------------------------------------
-- This table contains the list of modes supported by the back-end as
-- provided by the back end routine enumerate_modes in misc.c. Note that
-- we only store floating-point modes (see Register_Float_Type).
type FPT_Mode_Entry is record
NAME : String_Ptr; -- Name of mode (no null character at end)
DIGS : Natural; -- Digits for floating-point type
FLOAT_REP : Float_Rep_Kind; -- Float representation
SIZE : Natural; -- Size in bits
ALIGNMENT : Natural; -- Alignment in bits
end record;
FPT_Mode_Table : array (1 .. 1000) of FPT_Mode_Entry;
Num_FPT_Modes : Natural;
-- Table containing the supported modes and number of entries
-----------------
-- Subprograms --
-----------------
procedure Write_Target_Dependent_Values;
-- This routine writes the file target.atp in the current directory with
-- the values of the global target parameters as listed above, and as set
-- by prior calls to Initialize/Read_Target_Dependent_Values. The format
-- of the target.atp file is as follows
--
-- First come the values of the variables defined in this spec:
--
-- One line per value
--
-- name value
--
-- where name is the name of the parameter, spelled out in full,
-- and cased as in the above list, and value is an unsigned decimal
-- integer. Two or more blanks separates the name from the value.
--
-- All the variables must be present, in alphabetical order (i.e. the
-- same order as the declarations in this spec).
--
-- Then there is a blank line to separate the two parts of the file. Then
-- come the lines showing the floating-point types to be registered.
--
-- One line per registered mode
--
-- name digs float_rep size alignment
--
-- where name is the string name of the type (which can have single
-- spaces embedded in the name (e.g. long double). The name is followed
-- by at least two blanks. The following fields are as described above
-- for a Mode_Entry (where float_rep is I/V/A for IEEE-754-Binary,
-- Vax_Native, AAMP), fields are separated by at least one blank, and
-- a LF character immediately follows the alignment field.
--
-- It is a fatal error to call this procedure if the target.atp file is
-- not found in the current directory.
end Set_Targ;
......@@ -85,12 +85,6 @@
-- output. A line containing this escape sequence may not also contain
-- a ^alpha^beta^ sequence.
-- Process @ifset and @ifclear for the target flags (unw, vms);
-- this is because we have menu problems if we let makeinfo handle
-- these ifset/ifclear pairs.
-- Note: @ifset/@ifclear commands for the edition flags (FSFEDITION,
-- PROEDITION, GPLEDITION) are passed through unchanged
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment