[multiple changes]

2011-12-15  Vincent Pucci  <pucci@adacore.com>

	* aspects.adb, aspects.ads Aspect_Dimension and
	Aspect_Dimension_System added
	* exp_ch6.adb (Expand_Call): Expand_Put_Call_With_Dimension_String
	case added
	* gcc-interface/Make-lang.in: s-llflex, sem_dim added.
	* impunit.adb :s-diflio and s-diinio defined as GNAT Defined
	Additions to System.
	* Makefile.rtl: s-diflio, s-diinio and s-llflex added
	* par-prag.adb, sem_prag.adb: Pragma_Dimension removed
	* rtsfind.ads: Expon_LLF added
	* sem_aggr.adb (Resolve_Aggregate): handles aggregate for
	Aspect_Dimension case
	* sem_attr.adb (Resolve_Attribute): analyze dimension for
	attribute
	* sem_ch10.adb (Analyze_With_Clause): Avoid the warning messages
	due to the use of a GNAT library for Dimension packages
	* sem_ch13.adb (Analyze_Aspect_Specifications):
	Aspect_Dimension and Aspect_Dimension_System cases added
	(Check_Aspect_At_Freeze_Point): Aspect_Dimension and
	Aspect_Dimension_System cases added
	* sem_ch2.adb (Analyze_Identifier): analyze dimension for
	identifier
	* sem_ch3.adb (Analyze_Component_Declaration): analyze dimension
	for component declaration (Analyze_Object_Declaration): analyze
	dimension for object declaration (Analyze_Subtype_Declaration):
	analyze dimension for subtype declaration
	* sem_ch4.adb (Operator_Check): checks exponent is a rational
	for dimensioned operand for a N_Op_Expon
	* sem_ch5.adb (Analyze_Assignment): analyze dimension for
	assignment (Analyze_Statements): removal of dimensions in all
	statements
	* sem_ch6.adb (Analyze_Return_Statement): analyze dimension for
	return statement
	* sem_ch8.adb (Analyze_Object_Renaming): analyze dimension for
	object renaming
	* sem_dim.adb, sem_dim.ads (Analyze_Aspect_Dimension):
	analyze the expression for aspect dimension and store the
	values in a Htable.
	(Analyze_Aspect_Dimension_System): analyze
	the expression for aspect dimension system and store the new
	system in a Table.
	(Analyze_Dimension): propagates dimension
	(Expand_Put_Call_With_Dimension_String): add the dimension
	string as a suffix of the numeric value in the output
	(Has_Dimension): return True if the node has a dimension
	(Remove_Dimension_In_Declaration): removal of dimension in the
	expression of the declaration.
	(Remove_Dimension_In_Statement): removal of dimension in statement
	* sem_res.adb (Resolve): analyze dimension if the node
	has already been analyzed.
	(Resolve_Arithmetic_Op): analyze
	dimension for arithmetic op.
	(Resolve_Call): analyze dimension for function call.
	(Resolve_Comparison_Op): analyze dimension for comparison op.
	(Resolve_Equality_Op): analyze dimension for equality op.
	(Resolve_Indexed_Component): analyze dimension for indexed component.
	(Resolve_Op_Expon): analyze dimension for op expon.
	(Resolve_Selected_Component): analyze dimension
	for selected component.
	(Resolve_Slice): analyze dimension for slice.
	(Resolve_Unary_Op): analyze dimension for unary op
	(Resolve_Type_Conversion): analyze dimension for type conversion
	(Resolve_Unchecked_Type_Conversion): analyze dimension for
	unchecked type conversion
	* snames.ads-tmpl Name_Dimension, Name_Dimension_System,
	Name_Dim_Float_IO, Name_Dim_Integer_IO,
	Name_Generic_Elementary_Functions, Name_Sqrt added.
	Pragma_Dimension removed
	* s-diflio.adb, s-diflio.ads New GNAT library generic package
	for dimensioned float type IO
	* s-diinio.adb, s-diinio.ads New GNAT library generic package
	for dimensioned integer type IO
	* s-llflex.ads (Expon_LLF): exponentiation routine for long long
	floats operand and exponent

2011-12-15  Robert Dewar  <dewar@adacore.com>

	* sem_aggr.adb: Minor comment addition.

2011-12-15  Bob Duff  <duff@adacore.com>

	* s-tasren.adb (Task_Count): Do not call Yield; E'Count is not a
	task dispatching point.
	* s-taprop-mingw.adb (Yield): Do not yield if Do_Yield is False.

From-SVN: r182368
This commit is contained in:
Arnaud Charlet 2011-12-15 15:33:46 +01:00
parent ca814625c9
commit dec6faf1db
30 changed files with 3513 additions and 35 deletions

View File

@ -1,3 +1,90 @@
2011-12-15 Vincent Pucci <pucci@adacore.com>
* aspects.adb, aspects.ads Aspect_Dimension and
Aspect_Dimension_System added
* exp_ch6.adb (Expand_Call): Expand_Put_Call_With_Dimension_String
case added
* gcc-interface/Make-lang.in: s-llflex, sem_dim added.
* impunit.adb :s-diflio and s-diinio defined as GNAT Defined
Additions to System.
* Makefile.rtl: s-diflio, s-diinio and s-llflex added
* par-prag.adb, sem_prag.adb: Pragma_Dimension removed
* rtsfind.ads: Expon_LLF added
* sem_aggr.adb (Resolve_Aggregate): handles aggregate for
Aspect_Dimension case
* sem_attr.adb (Resolve_Attribute): analyze dimension for
attribute
* sem_ch10.adb (Analyze_With_Clause): Avoid the warning messages
due to the use of a GNAT library for Dimension packages
* sem_ch13.adb (Analyze_Aspect_Specifications):
Aspect_Dimension and Aspect_Dimension_System cases added
(Check_Aspect_At_Freeze_Point): Aspect_Dimension and
Aspect_Dimension_System cases added
* sem_ch2.adb (Analyze_Identifier): analyze dimension for
identifier
* sem_ch3.adb (Analyze_Component_Declaration): analyze dimension
for component declaration (Analyze_Object_Declaration): analyze
dimension for object declaration (Analyze_Subtype_Declaration):
analyze dimension for subtype declaration
* sem_ch4.adb (Operator_Check): checks exponent is a rational
for dimensioned operand for a N_Op_Expon
* sem_ch5.adb (Analyze_Assignment): analyze dimension for
assignment (Analyze_Statements): removal of dimensions in all
statements
* sem_ch6.adb (Analyze_Return_Statement): analyze dimension for
return statement
* sem_ch8.adb (Analyze_Object_Renaming): analyze dimension for
object renaming
* sem_dim.adb, sem_dim.ads (Analyze_Aspect_Dimension):
analyze the expression for aspect dimension and store the
values in a Htable.
(Analyze_Aspect_Dimension_System): analyze
the expression for aspect dimension system and store the new
system in a Table.
(Analyze_Dimension): propagates dimension
(Expand_Put_Call_With_Dimension_String): add the dimension
string as a suffix of the numeric value in the output
(Has_Dimension): return True if the node has a dimension
(Remove_Dimension_In_Declaration): removal of dimension in the
expression of the declaration.
(Remove_Dimension_In_Statement): removal of dimension in statement
* sem_res.adb (Resolve): analyze dimension if the node
has already been analyzed.
(Resolve_Arithmetic_Op): analyze
dimension for arithmetic op.
(Resolve_Call): analyze dimension for function call.
(Resolve_Comparison_Op): analyze dimension for comparison op.
(Resolve_Equality_Op): analyze dimension for equality op.
(Resolve_Indexed_Component): analyze dimension for indexed component.
(Resolve_Op_Expon): analyze dimension for op expon.
(Resolve_Selected_Component): analyze dimension
for selected component.
(Resolve_Slice): analyze dimension for slice.
(Resolve_Unary_Op): analyze dimension for unary op
(Resolve_Type_Conversion): analyze dimension for type conversion
(Resolve_Unchecked_Type_Conversion): analyze dimension for
unchecked type conversion
* snames.ads-tmpl Name_Dimension, Name_Dimension_System,
Name_Dim_Float_IO, Name_Dim_Integer_IO,
Name_Generic_Elementary_Functions, Name_Sqrt added.
Pragma_Dimension removed
* s-diflio.adb, s-diflio.ads New GNAT library generic package
for dimensioned float type IO
* s-diinio.adb, s-diinio.ads New GNAT library generic package
for dimensioned integer type IO
* s-llflex.ads (Expon_LLF): exponentiation routine for long long
floats operand and exponent
2011-12-15 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb: Minor comment addition.
2011-12-15 Bob Duff <duff@adacore.com>
* s-tasren.adb (Task_Count): Do not call Yield; E'Count is not a
task dispatching point.
* s-taprop-mingw.adb (Yield): Do not yield if Do_Yield is False.
2011-12-15 Robert Dewar <dewar@adacore.com>
* sigtramp-ppcvxw.c, sigtramp.h: Fix header.

View File

@ -504,6 +504,8 @@ GNATRTL_NONTASKING_OBJS= \
s-crc32$(objext) \
s-crtl$(objext) \
s-crtrun$(objext) \
s-diflio$(objext) \
s-diinio$(objext) \
s-direio$(objext) \
s-dsaser$(objext) \
s-excdeb$(objext) \
@ -554,6 +556,7 @@ GNATRTL_NONTASKING_OBJS= \
s-imgwch$(objext) \
s-imgwiu$(objext) \
s-io$(objext) \
s-llflex$(objext) \
s-maccod$(objext) \
s-mantis$(objext) \
s-mastop$(objext) \

View File

@ -240,6 +240,8 @@ package body Aspects is
Aspect_Default_Component_Value => Aspect_Default_Component_Value,
Aspect_Default_Iterator => Aspect_Default_Iterator,
Aspect_Default_Value => Aspect_Default_Value,
Aspect_Dimension => Aspect_Dimension,
Aspect_Dimension_System => Aspect_Dimension_System,
Aspect_Discard_Names => Aspect_Discard_Names,
Aspect_Dispatching_Domain => Aspect_Dispatching_Domain,
Aspect_Dynamic_Predicate => Aspect_Predicate,

View File

@ -54,6 +54,8 @@ package Aspects is
Aspect_Default_Component_Value,
Aspect_Default_Iterator,
Aspect_Default_Value,
Aspect_Dimension,
Aspect_Dimension_System,
Aspect_Dispatching_Domain,
Aspect_Dynamic_Predicate,
Aspect_External_Tag,
@ -232,6 +234,8 @@ package Aspects is
Aspect_Default_Component_Value => Expression,
Aspect_Default_Iterator => Name,
Aspect_Default_Value => Expression,
Aspect_Dimension => Expression,
Aspect_Dimension_System => Expression,
Aspect_Dispatching_Domain => Expression,
Aspect_Dynamic_Predicate => Expression,
Aspect_External_Tag => Expression,
@ -293,6 +297,8 @@ package Aspects is
Aspect_Default_Iterator => Name_Default_Iterator,
Aspect_Default_Value => Name_Default_Value,
Aspect_Default_Component_Value => Name_Default_Component_Value,
Aspect_Dimension => Name_Dimension,
Aspect_Dimension_System => Name_Dimension_System,
Aspect_Discard_Names => Name_Discard_Names,
Aspect_Dispatching_Domain => Name_Dispatching_Domain,
Aspect_Dynamic_Predicate => Name_Dynamic_Predicate,

View File

@ -60,9 +60,10 @@ with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch12; use Sem_Ch12;
with Sem_Ch13; use Sem_Ch13;
with Sem_Eval; use Sem_Eval;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Eval; use Sem_Eval;
with Sem_Mech; use Sem_Mech;
with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
@ -2103,6 +2104,20 @@ package body Exp_Ch6 is
-- Start of processing for Expand_Call
begin
-- Expand the procedure call if the first actual has a dimension and if
-- the procedure is Put (Ada 2012).
if Ada_Version >= Ada_2012
and then Nkind (Call_Node) = N_Procedure_Call_Statement
and then Present (Parameter_Associations (Call_Node))
then
Expand_Put_Call_With_Dimension_String (Call_Node);
end if;
-- Remove the dimensions of every parameters in call
Remove_Dimension_In_Call (N);
-- Ignore if previous error
if Nkind (Call_Node) in N_Has_Etype

View File

@ -304,6 +304,7 @@ GNAT_ADA_OBJS = \
ada/s-htable.o \
ada/s-imenne.o \
ada/s-imgenu.o \
ada/s-llflex.o \
ada/s-mastop.o \
ada/s-memory.o \
ada/s-os_lib.o \
@ -353,6 +354,7 @@ GNAT_ADA_OBJS = \
ada/sem_ch7.o \
ada/sem_ch8.o \
ada/sem_ch9.o \
ada/sem_dim.o \
ada/sem_disp.o \
ada/sem_dist.o \
ada/sem_elab.o \
@ -4307,6 +4309,9 @@ ada/sem_ch9.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
ada/warnsw.ads ada/widechar.ads
ada/sem_dim.o : ada/sem_util.ads ada/sem_util.adb ada/nmake.ads \
ada/nmake.adb
ada/sem_disp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \

View File

@ -366,6 +366,8 @@ package body Impunit is
("s-addima", F), -- System.Address_Image
("s-assert", F), -- System.Assertions
("s-diflio", F), -- System.Dim_Float_IO
("s-diinio", F), -- System.Dim_Integer_IO
("s-memory", F), -- System.Memory
("s-parint", F), -- System.Partition_Interface
("s-pooglo", F), -- System.Pool_Global

View File

@ -1126,7 +1126,6 @@ begin
Pragma_Debug_Policy |
Pragma_Detect_Blocking |
Pragma_Default_Storage_Pool |
Pragma_Dimension |
Pragma_Disable_Atomic_Synchronization |
Pragma_Discard_Names |
Pragma_Dispatching_Domain |

View File

@ -262,6 +262,7 @@ package Rtsfind is
System_Img_Uns,
System_Img_WChar,
System_Interrupts,
System_Long_Long_Float_Expon,
System_Machine_Code,
System_Mantissa,
System_Memcop,
@ -866,6 +867,8 @@ package Rtsfind is
RE_Static_Interrupt_Protection, -- System.Interrupts
RE_System_Interrupt_Id, -- System.Interrupts
RE_Expon_LLF, -- System.Long_Long_Float_Expon
RE_Asm_Insn, -- System.Machine_Code
RE_Asm_Input_Operand, -- System.Machine_Code
RE_Asm_Output_Operand, -- System.Machine_Code
@ -2066,6 +2069,8 @@ package Rtsfind is
RE_Static_Interrupt_Protection => System_Interrupts,
RE_System_Interrupt_Id => System_Interrupts,
RE_Expon_LLF => System_Long_Long_Float_Expon,
RE_Asm_Insn => System_Machine_Code,
RE_Asm_Input_Operand => System_Machine_Code,
RE_Asm_Output_Operand => System_Machine_Code,

77
gcc/ada/s-diflio.adb Normal file
View File

@ -0,0 +1,77 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . D I M _ F L O A T _ I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
package body System.Dim_Float_IO is
package Num_Dim_Float_IO is new Ada.Text_IO.Float_IO (Num_Dim_Float);
---------
-- Put --
---------
procedure Put
(File : File_Type;
Item : Num_Dim_Float;
Unit : String := "";
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp)
is
begin
Num_Dim_Float_IO.Put (File, Item, Fore, Aft, Exp);
Ada.Text_IO.Put (File, Unit);
end Put;
procedure Put
(Item : Num_Dim_Float;
Unit : String := "";
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp)
is
begin
Num_Dim_Float_IO.Put (Item, Fore, Aft, Exp);
Ada.Text_IO.Put (Unit);
end Put;
procedure Put
(To : out String;
Item : Num_Dim_Float;
Unit : String := "";
Aft : Field := Default_Aft;
Exp : Field := Default_Exp)
is
begin
Num_Dim_Float_IO.Put (To, Item, Aft, Exp);
To := To & Unit;
end Put;
end System.Dim_Float_IO;

77
gcc/ada/s-diflio.ads Normal file
View File

@ -0,0 +1,77 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . D I M _ F L O A T _ I O --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- Note that this package should only be instantiated with a float dimensioned
-- type.
-- This package is a generic package that provides IO facilities for float
-- dimensioned types.
-- Note that there is a default string parameter in every Put routine
-- rewritten at compile time to output the corresponding dimensions as a
-- suffix of the numeric value.
with Ada.Text_IO; use Ada.Text_IO;
generic
type Num_Dim_Float is digits <>;
package System.Dim_Float_IO is
Default_Fore : Field := 2;
Default_Aft : Field := Num_Dim_Float'Digits - 1;
Default_Exp : Field := 3;
procedure Put
(File : File_Type;
Item : Num_Dim_Float;
Unit : String := "";
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
procedure Put
(Item : Num_Dim_Float;
Unit : String := "";
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
procedure Put
(To : out String;
Item : Num_Dim_Float;
Unit : String := "";
Aft : Field := Default_Aft;
Exp : Field := Default_Exp);
pragma Inline (Put);
end System.Dim_Float_IO;

77
gcc/ada/s-diinio.adb Normal file
View File

@ -0,0 +1,77 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . D I M _ I N T E G E R _ I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
package body System.Dim_Integer_IO is
package Num_Dim_Integer_IO is new Ada.Text_IO.Integer_IO (Num_Dim_Integer);
---------
-- Put --
---------
procedure Put
(File : File_Type;
Item : Num_Dim_Integer;
Unit : String := "";
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
Num_Dim_Integer_IO.Put (File, Item, Width, Base);
Ada.Text_IO.Put (File, Unit);
end Put;
procedure Put
(Item : Num_Dim_Integer;
Unit : String := "";
Width : Field := Default_Width;
Base : Number_Base := Default_Base)
is
begin
Num_Dim_Integer_IO.Put (Item, Width, Base);
Ada.Text_IO.Put (Unit);
end Put;
procedure Put
(To : out String;
Item : Num_Dim_Integer;
Unit : String := "";
Base : Number_Base := Default_Base)
is
begin
Num_Dim_Integer_IO.Put (To, Item, Base);
To := To & Unit;
end Put;
end System.Dim_Integer_IO;

73
gcc/ada/s-diinio.ads Normal file
View File

@ -0,0 +1,73 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . D I M _ I N T E G E R _ I O --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- Note that this package should only be instantiated with an integer
-- dimensioned type
-- This package is a generic package that provides IO facilities for integer
-- dimensioned types.
-- Note that there is a default string parameter in every Put routine
-- rewritten at compile time to output the corresponding dimensions as a
-- suffix of the numeric value.
with Ada.Text_IO; use Ada.Text_IO;
generic
type Num_Dim_Integer is range <>;
package System.Dim_Integer_IO is
Default_Width : Field := Num_Dim_Integer'Width;
Default_Base : Number_Base := 10;
procedure Put
(File : File_Type;
Item : Num_Dim_Integer;
Unit : String := "";
Width : Field := Default_Width;
Base : Number_Base := Default_Base);
procedure Put
(Item : Num_Dim_Integer;
Unit : String := "";
Width : Field := Default_Width;
Base : Number_Base := Default_Base);
procedure Put
(To : out String;
Item : Num_Dim_Integer;
Unit : String := "";
Base : Number_Base := Default_Base);
pragma Inline (Put);
end System.Dim_Integer_IO;

42
gcc/ada/s-llflex.ads Normal file
View File

@ -0,0 +1,42 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . L O N G _ L O N G _ F L O A T _ E X P O N --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains an instantiation of the functions "**" and Sqrt
-- between two long long floats.
with Ada.Numerics.Long_Long_Elementary_Functions;
package System.Long_Long_Float_Expon is
function Expon_LLF (Left, Right : Long_Long_Float) return Long_Long_Float
renames Ada.Numerics.Long_Long_Elementary_Functions."**";
end System.Long_Long_Float_Expon;

View File

@ -710,10 +710,9 @@ package body System.Task_Primitives.Operations is
-- Moreover, CXD8002 appears to pass on Windows (although we do not
-- guarantee full Annex D compliance on Windows in any case).
-- What is not clear is why we now call SwitchToThread in the False
-- case. Other versions don't do that, is it necessary???
SwitchToThread;
if Do_Yield then
SwitchToThread;
end if;
end Yield;
------------------

View File

@ -1069,10 +1069,6 @@ package body System.Tasking.Rendezvous is
Initialization.Undefer_Abort (Self_Id);
-- Call Yield to let other tasks get a chance to run as this is a
-- potential dispatching point.
Yield (Do_Yield => False);
return Return_Count;
end Task_Count;

View File

@ -1691,6 +1691,11 @@ package body Sem_Aggr is
end if;
end if;
-- If an aggregate component has a type with predicates, an explicit
-- predicate check must be applied, as for an assignment statement,
-- because the aggegate might not be expanded into individual
-- component assignments.
if Present (Predicate_Function (Component_Typ)) then
Apply_Predicate_Check (Expr, Component_Typ);
end if;
@ -3297,6 +3302,11 @@ package body Sem_Aggr is
Aggregate_Constraint_Checks (Expr, Expr_Type);
end if;
-- If an aggregate component has a type with predicates, an explicit
-- predicate check must be applied, as for an assignment statement,
-- because the aggegate might not be expanded into individual
-- component assignments.
if Present (Predicate_Function (Expr_Type)) then
Apply_Predicate_Check (Expr, Expr_Type);
end if;

View File

@ -52,6 +52,7 @@ with Sem_Cat; use Sem_Cat;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch10; use Sem_Ch10;
with Sem_Dim; use Sem_Dim;
with Sem_Dist; use Sem_Dist;
with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
@ -9165,6 +9166,7 @@ package body Sem_Attr is
-- Finally perform static evaluation on the attribute reference
Analyze_Dimension (N);
Eval_Attribute (N);
end Resolve_Attribute;

View File

@ -46,6 +46,7 @@ with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Dim; use Sem_Dim;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Type; use Sem_Type;
@ -1476,6 +1477,15 @@ package body Sem_Ch13 is
goto Continue;
end;
when Aspect_Dimension =>
Analyze_Aspect_Dimension (N, Id, Expr);
goto Continue;
when Aspect_Dimension_System =>
Analyze_Aspect_Dimension_System (N, Id, Expr);
goto Continue;
end case;
-- If a delay is required, we delay the freeze (not much point in
@ -6046,6 +6056,11 @@ package body Sem_Ch13 is
Aspect_Static_Predicate |
Aspect_Type_Invariant =>
T := Standard_Boolean;
when Aspect_Dimension |
Aspect_Dimension_System =>
raise Program_Error;
end case;
-- Do the preanalyze call
@ -8777,8 +8792,8 @@ package body Sem_Ch13 is
Source : constant Entity_Id := T.Source;
Target : constant Entity_Id := T.Target;
Source_Siz : Uint;
Target_Siz : Uint;
Source_Siz : Uint;
Target_Siz : Uint;
begin
-- This validation check, which warns if we have unequal sizes for

View File

@ -30,6 +30,7 @@ with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem_Ch8; use Sem_Ch8;
with Sem_Dim; use Sem_Dim;
with Sinfo; use Sinfo;
with Stand; use Stand;
with Uintp; use Uintp;
@ -75,6 +76,8 @@ package body Sem_Ch2 is
else
Find_Direct_Name (N);
end if;
Analyze_Dimension (N);
end Analyze_Identifier;
-----------------------------

View File

@ -56,6 +56,7 @@ with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Elim; use Sem_Elim;
@ -2036,6 +2037,7 @@ package body Sem_Ch3 is
if Has_Aspects (N) then
Analyze_Aspect_Specifications (N, Id);
end if;
Analyze_Dimension (N);
end Analyze_Component_Declaration;
--------------------------
@ -2089,6 +2091,11 @@ package body Sem_Ch3 is
-- Complete analysis of declaration
Analyze (D);
-- Removal of the dimension in the expression for object & component
-- declaration.
Remove_Dimension_In_Declaration (D);
Next_Node := Next (D);
if No (Freeze_From) then
@ -3773,6 +3780,7 @@ package body Sem_Ch3 is
if Has_Aspects (N) then
Analyze_Aspect_Specifications (N, Id);
end if;
Analyze_Dimension (N);
end Analyze_Object_Declaration;
---------------------------
@ -4571,6 +4579,7 @@ package body Sem_Ch3 is
if Has_Aspects (N) then
Analyze_Aspect_Specifications (N, Id);
end if;
Analyze_Dimension (N);
end Analyze_Subtype_Declaration;
--------------------------------

View File

@ -50,6 +50,7 @@ with Sem_Ch3; use Sem_Ch3;
with Sem_Ch5; use Sem_Ch5;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Eval; use Sem_Eval;
@ -6040,8 +6041,16 @@ package body Sem_Ch4 is
First_Subtype (Base_Type (Etype (R))) /= Standard_Integer
and then Base_Type (Etype (R)) /= Universal_Integer
then
Error_Msg_NE
("exponent must be of type Natural, found}", R, Etype (R));
if Ada_Version >= Ada_2012
and then Is_Dimensioned_Type (Etype (L))
then
Error_Msg_NE
("exponent for dimensioned type must be a Rational" &
", found}", R, Etype (R));
else
Error_Msg_NE
("exponent must be of type Natural, found}", R, Etype (R));
end if;
return;
end if;

View File

@ -47,6 +47,7 @@ with Sem_Case; use Sem_Case;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Elab; use Sem_Elab;
with Sem_Eval; use Sem_Eval;
@ -839,6 +840,7 @@ package body Sem_Ch5 is
Set_Last_Assignment (Ent, Lhs);
end if;
end;
Analyze_Dimension (N);
end Analyze_Assignment;
-----------------------------
@ -2731,6 +2733,10 @@ package body Sem_Ch5 is
S := First (L);
while Present (S) loop
Analyze (S);
-- Remove dimension in all statements
Remove_Dimension_In_Statement (S);
Next (S);
end loop;

View File

@ -60,6 +60,7 @@ with Sem_Ch8; use Sem_Ch8;
with Sem_Ch10; use Sem_Ch10;
with Sem_Ch12; use Sem_Ch12;
with Sem_Ch13; use Sem_Ch13;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Elim; use Sem_Elim;
@ -1529,6 +1530,8 @@ package body Sem_Ch6 is
Kill_Current_Values (Last_Assignment_Only => True);
Check_Unreachable_Code (N);
Analyze_Dimension (N);
end Analyze_Return_Statement;
-------------------------------------

View File

@ -53,6 +53,7 @@ with Sem_Ch4; use Sem_Ch4;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch12; use Sem_Ch12;
with Sem_Ch13; use Sem_Ch13;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Eval; use Sem_Eval;
@ -1215,6 +1216,7 @@ package body Sem_Ch8 is
end if;
Set_Renamed_Object (Id, Nam);
Analyze_Dimension (N);
end Analyze_Object_Renaming;
------------------------------

2779
gcc/ada/sem_dim.adb Normal file

File diff suppressed because it is too large Load Diff

150
gcc/ada/sem_dim.ads Normal file
View File

@ -0,0 +1,150 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ D I M --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, 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 new package of the GNAT compiler has been created in order to enable
-- any user of the GNAT compiler to deal with physical issues.
-- Indeed, the user is now able to create his own dimension system and to
-- assign a dimension, defined from the MKS system (package System.Dim_Mks)
-- or his own dimension systems, with any item and to run operations with
-- dimensionned entities.
-- In that case, a dimensionnality checking will be performed at compile time.
-- If no dimension has been assigned, the compiler assumes that the item is
-- dimensionless.
-----------------------------
-- Aspect_Dimension_System --
-----------------------------
-- In order to enable the user to create his own dimension system, a new
-- aspect: Aspect_Dimension_System has been created.
-- Note that this aspect applies for type declaration of type derived from any
-- numeric type.
-- It defines the names of each dimension.
----------------------
-- Aspect_Dimension --
----------------------
-- This new aspect applies for subtype and object declarations in order to
-- define new dimensions.
-- Using this aspect, the user is able to create new subtype/object with any
-- dimension needed.
-- Note that the base type of the subtype/object must be the type that defines
-- the corresponding dimension system.
-- The expression of this aspect is an aggregate of rational values for each
-- dimension in the corresponding dimension system.
-------------------------------------------
-- Dimensionality checking & propagation --
-------------------------------------------
-- For each node (when needed), a dimension analysis (Analyze_Dimension) is
-- performed as part of the Resolution routine or the Analysis routine if no
-- Resolution.
-- The dimension analysis is divided into two phases:
-- Phase 1: dimension checking
-- Phase 2: propagation of dimensions
-- Depending on the node kind, either none, one phase or two phases are
-- executed.
-- Phase 2 is called only when the node allows a dimension (see body of
-- Sem_Dim to get the list of nodes that permit dimensions).
------------------
-- Dimension_IO --
------------------
-- This section contains the routine used for IO purposes.
with Types; use Types;
package Sem_Dim is
-----------------------------
-- Aspect_Dimension_System --
-----------------------------
procedure Analyze_Aspect_Dimension_System
(N : Node_Id;
Id : Node_Id;
Expr : Node_Id);
-- Analyzes the aggregate of Aspect_Dimension_System
----------------------
-- Aspect_Dimension --
----------------------
procedure Analyze_Aspect_Dimension
(N : Node_Id;
Id : Node_Id;
Expr : Node_Id);
-- Analyzes the aggregate of Aspect_Dimension and attaches the
-- corresponding dimension to N.
-------------------------------------------
-- Dimensionality checking & propagation --
-------------------------------------------
procedure Analyze_Dimension (N : Node_Id);
-- Performs a dimension analysis and propagates dimension between nodes
-- when needed.
procedure Eval_Op_Expon_For_Dimensioned_Type
(N : Node_Id;
B_Typ : Entity_Id);
-- Eval the Expon operator for dimensioned type with rational exponent
function Is_Dimensioned_Type (E : Entity_Id) return Boolean;
-- Return True if the type is a dimensioned type (i.e: a type which has an
-- aspect Dimension_System)
procedure Remove_Dimension_In_Call (N : Node_Id);
-- At the end of the Expand_Call routine, remove the dimensions of every
-- parameters in the call N.
procedure Remove_Dimension_In_Declaration (D : Node_Id);
-- At the end of Analyze_Declarations routine (see Sem_Ch3), removes the
-- dimension of the expression for each declaration.
procedure Remove_Dimension_In_Statement (S : Node_Id);
-- At the end of the Analyze_Statements routine (see Sem_Ch5), removes the
-- dimension for every statements.
------------------
-- Dimension_IO --
------------------
procedure Expand_Put_Call_With_Dimension_String (N : Node_Id);
-- Expansion of Put call (from package System.Dim_Float_IO and
-- System.Dim_Integer_IO) for a dimensioned object in order to add the
-- dimension symbols as a suffix of the numeric value.
end Sem_Dim;

View File

@ -8062,24 +8062,6 @@ package body Sem_Prag is
Default_Pool := Expression (Arg1);
---------------
-- Dimension --
---------------
when Pragma_Dimension =>
GNAT_Pragma;
Check_Arg_Count (4);
Check_No_Identifiers;
Check_Arg_Is_Local_Name (Arg1);
if not Is_Type (Arg1) then
Error_Pragma ("first argument for pragma% must be subtype");
end if;
Check_Arg_Is_Static_Expression (Arg2, Standard_Integer);
Check_Arg_Is_Static_Expression (Arg3, Standard_Integer);
Check_Arg_Is_Static_Expression (Arg4, Standard_Integer);
------------------------------------
-- Disable_Atomic_Synchronization --
------------------------------------
@ -14956,7 +14938,6 @@ package body Sem_Prag is
Pragma_Debug_Policy => 0,
Pragma_Detect_Blocking => -1,
Pragma_Default_Storage_Pool => -1,
Pragma_Dimension => -1,
Pragma_Disable_Atomic_Synchronization => -1,
Pragma_Discard_Names => 0,
Pragma_Dispatching_Domain => -1,

View File

@ -57,6 +57,7 @@ with Sem_Ch4; use Sem_Ch4;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Elim; use Sem_Elim;
@ -2010,6 +2011,7 @@ package body Sem_Res is
if Analyzed (N) then
Debug_A_Exit ("resolving ", N, " (done, already analyzed)");
Analyze_Dimension (N);
return;
-- Return if type = Any_Type (previous error encountered)
@ -4878,6 +4880,7 @@ package body Sem_Res is
end if;
Generate_Operator_Reference (N, Typ);
Analyze_Dimension (N);
Eval_Arithmetic_Op (N);
-- In SPARK, a multiplication or division with operands of fixed point
@ -5808,6 +5811,10 @@ package body Sem_Res is
end;
end if;
-- dimension analysis
Analyze_Dimension (N);
-- All done, evaluate call and deal with elaboration issues
Eval_Call (N);
@ -6004,6 +6011,7 @@ package body Sem_Res is
-- Evaluate the relation (note we do this after the above check since
-- this Eval call may change N to True/False.
Analyze_Dimension (N);
Eval_Relational_Op (N);
end Resolve_Comparison_Op;
@ -6889,6 +6897,7 @@ package body Sem_Res is
or else Is_Intrinsic_Subprogram
(Corresponding_Equality (Entity (N)))
then
Analyze_Dimension (N);
Eval_Relational_Op (N);
elsif Nkind (N) = N_Op_Ne
@ -7143,6 +7152,8 @@ package body Sem_Res is
end loop;
end if;
Analyze_Dimension (N);
-- Do not generate the warning on suspicious index if we are analyzing
-- package Ada.Tags; otherwise we will report the warning with the
-- Prims_Ptr field of the dispatch table.
@ -7998,6 +8009,24 @@ package body Sem_Res is
Set_Etype (N, B_Typ);
Generate_Operator_Reference (N, B_Typ);
Analyze_Dimension (N);
-- Evaluate the Expon operator for dimensioned type with rational
-- exponent.
if Ada_Version >= Ada_2012
and then Is_Dimensioned_Type (B_Typ)
then
Eval_Op_Expon_For_Dimensioned_Type (N, B_Typ);
-- Skip the Eval_Op_Expon if the node has already been evaluated
if Nkind (N) = N_Type_Conversion then
return;
end if;
end if;
Eval_Op_Expon (N);
-- Set overflow checking bit. Much cleverer code needed here eventually
@ -8196,6 +8225,7 @@ package body Sem_Res is
Set_Etype (N, Etype (Expr));
end if;
Analyze_Dimension (N);
Eval_Qualified_Expression (N);
end Resolve_Qualified_Expression;
@ -8629,6 +8659,7 @@ package body Sem_Res is
Error_Msg_N ("?\may cause unexpected accesses to atomic object",
Prefix (N));
end if;
Analyze_Dimension (N);
end Resolve_Selected_Component;
-------------------
@ -8940,6 +8971,7 @@ package body Sem_Res is
Warn_On_Suspicious_Index (Name, High_Bound (Drange));
end if;
Analyze_Dimension (N);
Eval_Slice (N);
end Resolve_Slice;
@ -9346,6 +9378,8 @@ package body Sem_Res is
Check_SPARK_Restriction ("object required", Operand);
end if;
Analyze_Dimension (N);
-- Note: we do the Eval_Type_Conversion call before applying the
-- required checks for a subtype conversion. This is important, since
-- both are prepared under certain circumstances to change the type
@ -9629,6 +9663,7 @@ package body Sem_Res is
Check_Unset_Reference (R);
Generate_Operator_Reference (N, B_Typ);
Analyze_Dimension (N);
Eval_Unary_Op (N);
-- Set overflow checking bit. Much cleverer code needed here eventually
@ -9795,6 +9830,7 @@ package body Sem_Res is
-- Resolve operand using its own type
Resolve (Operand, Opnd_Type);
Analyze_Dimension (N);
Eval_Unchecked_Conversion (N);
end Resolve_Unchecked_Type_Conversion;

View File

@ -139,6 +139,8 @@ package Snames is
Name_Default_Value : constant Name_Id := N + $;
Name_Default_Component_Value : constant Name_Id := N + $;
Name_Dimension : constant Name_Id := N + $;
Name_Dimension_System : constant Name_Id := N + $;
Name_Dynamic_Predicate : constant Name_Id := N + $;
Name_Post : constant Name_Id := N + $;
Name_Pre : constant Name_Id := N + $;
@ -219,6 +221,14 @@ package Snames is
subtype Text_IO_Package_Name is Name_Id
range First_Text_IO_Package .. Last_Text_IO_Package;
-- Names used by the analyzer and expander for aspect Dimension and
-- Dimension_System to deal with Sqrt and IO routines.
Name_Dim_Float_IO : constant Name_Id := N + $; -- Ada 12
Name_Dim_Integer_IO : constant Name_Id := N + $; -- Ada 12
Name_Generic_Elementary_Functions : constant Name_Id := N + $; -- Ada 12
Name_Sqrt : constant Name_Id := N + $; -- Ada 12
-- Some miscellaneous names used for error detection/recovery
Name_Const : constant Name_Id := N + $;
@ -447,7 +457,6 @@ package Snames is
Name_CPP_Vtable : constant Name_Id := N + $; -- GNAT
Name_CPU : constant Name_Id := N + $; -- Ada 12
Name_Debug : constant Name_Id := N + $; -- GNAT
Name_Dimension : constant Name_Id := N + $; -- GNAT
Name_Elaborate : constant Name_Id := N + $; -- Ada 83
Name_Elaborate_All : constant Name_Id := N + $;
Name_Elaborate_Body : constant Name_Id := N + $;
@ -1610,7 +1619,6 @@ package Snames is
Pragma_CPP_Vtable,
Pragma_CPU,
Pragma_Debug,
Pragma_Dimension,
Pragma_Elaborate,
Pragma_Elaborate_All,
Pragma_Elaborate_Body,