mirror of git://gcc.gnu.org/git/gcc.git
[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:
parent
ca814625c9
commit
dec6faf1db
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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) \
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 |
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
||||
------------------
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
-----------------------------
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
--------------------------------
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
-------------------------------------
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
------------------------------
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -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;
|
||||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
Loading…
Reference in New Issue