Commit 7b50c4a3 by Arnaud Charlet

[multiple changes]

2012-02-08  Vincent Celier  <celier@adacore.com>

	* gcc-interface/Make-lang.in: Add g-byorma.o to gnatbind objects
	(g-buorma is now imported by sinput).
	Update dependencies.
	* scn.adb (Initialize_Scanner): Call Check_For_BOM
	* sinput-p.adb (Source_File_Is_Subunit): Call Check_For_BOM
	* sinput.adb: New procedure Check_For_BOM
	* sinput.ads: New procedure Check_For_BOM

2012-02-08  Vincent Pucci  <pucci@adacore.com>

	* impunit.adb: Dimension package names updated
	* Makefile.rtl: s-dim added
	* sem_dim.adb (Is_Procedure_Put_Call): minor changes
	(Is_Dim_IO_Package_Instantiation): minor changes
	* sem_dim.ads: minor changes in comments
	* snames.ads-tmpl: Name_Dim added Name_Dim_Float_IO and
	Name_Dim_Integer_IO removed
	* s-dim.ads: New package. Define the dimension terminology.
	* s-diflio.adb, s-diinio.adb, s-dimkio.ads, s-dimmks.ads,
	* s-dmotpr.ads: Package names updated.
	* s-diflio.ads, s-diinio.ads: Documentation added and package
	names updated.

2012-02-08  Gary Dismukes  <dismukes@adacore.com>

	* gcc-interface/utils2.c (build_call_alloc_dealloc_proc): Revise test
	for storage pools to test for an underlying record type rather than
	testing Is_Tagged_Type, so that simple storage pools will be handled
	the same as normal Ada storage pools.

From-SVN: r184004
parent f6205414
2012-02-08 Vincent Celier <celier@adacore.com>
* gcc-interface/Make-lang.in: Add g-byorma.o to gnatbind objects
(g-buorma is now imported by sinput).
Update dependencies.
* scn.adb (Initialize_Scanner): Call Check_For_BOM
* sinput-p.adb (Source_File_Is_Subunit): Call Check_For_BOM
* sinput.adb: New procedure Check_For_BOM
* sinput.ads: New procedure Check_For_BOM
2012-02-08 Vincent Pucci <pucci@adacore.com>
* impunit.adb: Dimension package names updated
* Makefile.rtl: s-dim added
* sem_dim.adb (Is_Procedure_Put_Call): minor changes
(Is_Dim_IO_Package_Instantiation): minor changes
* sem_dim.ads: minor changes in comments
* snames.ads-tmpl: Name_Dim added Name_Dim_Float_IO and
Name_Dim_Integer_IO removed
* s-dim.ads: New package. Define the dimension terminology.
* s-diflio.adb, s-diinio.adb, s-dimkio.ads, s-dimmks.ads,
* s-dmotpr.ads: Package names updated.
* s-diflio.ads, s-diinio.ads: Documentation added and package
names updated.
2012-02-08 Gary Dismukes <dismukes@adacore.com>
* gcc-interface/utils2.c (build_call_alloc_dealloc_proc): Revise test
for storage pools to test for an underlying record type rather than
testing Is_Tagged_Type, so that simple storage pools will be handled
the same as normal Ada storage pools.
2012-02-08 Yannick Moy <moy@adacore.com> 2012-02-08 Yannick Moy <moy@adacore.com>
* gnat_rm.texi: Minor reshuffling to place restriction at * gnat_rm.texi: Minor reshuffling to place restriction at
......
...@@ -505,6 +505,7 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -505,6 +505,7 @@ GNATRTL_NONTASKING_OBJS= \
s-crtl$(objext) \ s-crtl$(objext) \
s-crtrun$(objext) \ s-crtrun$(objext) \
s-diflio$(objext) \ s-diflio$(objext) \
s-dim$(objext) \
s-diinio$(objext) \ s-diinio$(objext) \
s-dimkio$(objext) \ s-dimkio$(objext) \
s-dimmks$(objext) \ s-dimmks$(objext) \
......
...@@ -453,6 +453,7 @@ GNATBIND_OBJS = \ ...@@ -453,6 +453,7 @@ GNATBIND_OBJS = \
ada/fmap.o \ ada/fmap.o \
ada/fname.o \ ada/fname.o \
ada/fname-uf.o \ ada/fname-uf.o \
ada/g-byorma.o \
ada/g-hesora.o \ ada/g-hesora.o \
ada/g-htable.o \ ada/g-htable.o \
ada/s-os_lib.o \ ada/s-os_lib.o \
...@@ -2435,31 +2436,33 @@ ada/exp_intr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ...@@ -2435,31 +2436,33 @@ ada/exp_intr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/eval_fat.ads \ ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/eval_fat.ads \
ada/exp_aggr.ads ada/exp_atag.ads ada/exp_ch11.ads ada/exp_ch2.ads \ ada/exp_aggr.ads ada/exp_atag.ads ada/exp_ch11.ads ada/exp_ch2.ads \
ada/exp_ch4.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_code.ads \ ada/exp_ch4.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_code.ads \
ada/exp_fixd.ads ada/exp_intr.ads ada/exp_intr.adb ada/exp_pakd.ads \ ada/exp_disp.ads ada/exp_fixd.ads ada/exp_intr.ads ada/exp_intr.adb \
ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/expander.ads \ ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \ ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
ada/gnat.ads ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads \ ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/gnatvsn.ads \
ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \ ada/hlo.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
ada/lib.ads ada/lib-load.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ ada/itypes.ads ada/lib.ads ada/lib-load.ads ada/lib-util.ads \
ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \ ada/put_alfa.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \ ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \ ada/sem_aux.ads ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads \
ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \ ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads \
ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \ ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \
ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \ ada/sem_ch9.ads ada/sem_disp.ads ada/sem_eval.ads ada/sem_prag.ads \
ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
ada/sinput.ads ada/sinput.adb ada/snames.ads ada/sprint.ads \ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \ ada/sinput.adb ada/snames.ads ada/sprint.ads ada/stand.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \ ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
ada/validsw.ads ada/widechar.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads ada/urealp.adb ada/validsw.ads ada/widechar.ads
ada/exp_pakd.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/exp_pakd.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/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2011, Free Software Foundation, Inc. * * Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -2003,9 +2003,10 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type, ...@@ -2003,9 +2003,10 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
tree gnu_proc = gnat_to_gnu (gnat_proc); tree gnu_proc = gnat_to_gnu (gnat_proc);
tree gnu_call; tree gnu_call;
/* The storage pools are obviously always tagged types, but the /* A storage pool's underlying type is a record type (for both predefined
secondary stack uses the same mechanism and is not tagged. */ storage pools and GNAT simple storage pools). The secondary stack uses
if (Is_Tagged_Type (Etype (gnat_pool))) the same mechanism, but its pool object (SS_Pool) is an integer. */
if (Is_Record_Type (Underlying_Type (Etype (gnat_pool))))
{ {
/* The size is the third parameter; the alignment is the /* The size is the third parameter; the alignment is the
same type. */ same type. */
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2011, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -366,11 +366,11 @@ package body Impunit is ...@@ -366,11 +366,11 @@ package body Impunit is
("s-addima", F), -- System.Address_Image ("s-addima", F), -- System.Address_Image
("s-assert", F), -- System.Assertions ("s-assert", F), -- System.Assertions
("s-diflio", F), -- System.Dim_Float_IO ("s-diflio", F), -- System.Dim.Float_IO
("s-diinio", F), -- System.Dim_Integer_IO ("s-diinio", F), -- System.Dim.Integer_IO
("s-dimkio", F), -- System.Dim_Mks_IO ("s-dimkio", F), -- System.Dim.Mks_IO
("s-dimmks", F), -- System.Dim_Mks ("s-dimmks", F), -- System.Dim.Mks
("s-dmotpr", F), -- System.Dim_Mks.Other_Prefixes ("s-dmotpr", F), -- System.Dim.Mks.Other_Prefixes
("s-memory", F), -- System.Memory ("s-memory", F), -- System.Memory
("s-parint", F), -- System.Partition_Interface ("s-parint", F), -- System.Partition_Interface
("s-pooglo", F), -- System.Pool_Global ("s-pooglo", F), -- System.Pool_Global
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT RUN-TIME COMPONENTS -- -- GNAT RUN-TIME COMPONENTS --
-- -- -- --
-- S Y S T E M . D I M _ F L O A T _ I O -- -- S Y S T E M . D I M . F L O A T _ I O --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
...@@ -29,7 +29,7 @@ ...@@ -29,7 +29,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
package body System.Dim_Float_IO is package body System.Dim.Float_IO is
package Num_Dim_Float_IO is new Ada.Text_IO.Float_IO (Num_Dim_Float); package Num_Dim_Float_IO is new Ada.Text_IO.Float_IO (Num_Dim_Float);
...@@ -74,4 +74,4 @@ package body System.Dim_Float_IO is ...@@ -74,4 +74,4 @@ package body System.Dim_Float_IO is
To := To & Symbols; To := To & Symbols;
end Put; end Put;
end System.Dim_Float_IO; end System.Dim.Float_IO;
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT RUN-TIME COMPONENTS -- -- GNAT RUN-TIME COMPONENTS --
-- -- -- --
-- S Y S T E M . D I M _ F L O A T _ I O -- -- S Y S T E M . D I M . F L O A T _ I O --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
...@@ -29,19 +29,74 @@ ...@@ -29,19 +29,74 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package is a generic package that provides IO facilities for float -- This package provides output routines for float dimensioned types. All Put
-- dimensioned types. -- routines are modelled after those in package Ada.Text_IO.Float_IO with the
-- addition of an extra default parameter.
-- Note that there is a default string parameter in every Put routine -- Parameter Symbol may be used in the following manner (all the examples are
-- rewritten at compile time to output the corresponding dimensions as a -- based on the MKS system of units as defined in package System.Dim.Mks):
-- suffix of the numeric value.
-- Case 1. A value is supplied for Symbol
-- The string appears as a suffix of Item
-- Obj : Mks_Type := 2.6;
-- Put (Obj, 1, 1, 0, " dimensionless");
-- The corresponding output is: 2.6 dimensionless
-- Case 2. No value is supplied for Symbol and Item is dimensionless
-- Item appears without a suffix
-- Obj : Mks_Type := 2.6;
-- Put (Obj, 1, 1, 0);
-- The corresponding output is: 2.6
-- Case 3. No value is supplied for Symbol and Item has a dimension
-- If the type of Item is a dimensioned subtype whose symbolic name is not
-- empty, then the symbolic name appears as a suffix.
-- subtype Length is Mks_Type
-- with
-- Dimension => ('m',
-- Meter => 1,
-- others => 0);
-- Obj : Length := 2.3 * dm;
-- Put (Obj, 1, 2, 0);
-- The corresponding output is: 0.23 m
-- Otherwise, a new string is created and appears as a suffix of Item.
-- This string results in the successive concatanations between each
-- dimension symbolic name raised by its corresponding dimension power from
-- the dimensions of Item.
-- subtype Random is Mks_Type
-- with
-- Dimension => ("",
-- Meter => 3,
-- Candela => -1,
-- others => 0);
-- Obj : Random := 5.0;
-- Put (Obj);
-- The corresponding output is: 5.0 m**3.cd**(-1)
-- Put (3.3 * km * dm * min, 5, 1, 0);
-- The corresponding output is: 19800.0 m**2.s
with Ada.Text_IO; use Ada.Text_IO; with Ada.Text_IO; use Ada.Text_IO;
generic generic
type Num_Dim_Float is digits <>; type Num_Dim_Float is digits <>;
package System.Dim_Float_IO is package System.Dim.Float_IO is
Default_Fore : Field := 2; Default_Fore : Field := 2;
Default_Aft : Field := Num_Dim_Float'Digits - 1; Default_Aft : Field := Num_Dim_Float'Digits - 1;
...@@ -71,4 +126,4 @@ package System.Dim_Float_IO is ...@@ -71,4 +126,4 @@ package System.Dim_Float_IO is
pragma Inline (Put); pragma Inline (Put);
end System.Dim_Float_IO; end System.Dim.Float_IO;
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT RUN-TIME COMPONENTS -- -- GNAT RUN-TIME COMPONENTS --
-- -- -- --
-- S Y S T E M . D I M _ I N T E G E R _ I O -- -- S Y S T E M . D I M . I N T E G E R _ I O --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
...@@ -29,7 +29,7 @@ ...@@ -29,7 +29,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
package body System.Dim_Integer_IO is package body System.Dim.Integer_IO is
package Num_Dim_Integer_IO is new Ada.Text_IO.Integer_IO (Num_Dim_Integer); package Num_Dim_Integer_IO is new Ada.Text_IO.Integer_IO (Num_Dim_Integer);
...@@ -74,4 +74,4 @@ package body System.Dim_Integer_IO is ...@@ -74,4 +74,4 @@ package body System.Dim_Integer_IO is
To := To & Symbols; To := To & Symbols;
end Put; end Put;
end System.Dim_Integer_IO; end System.Dim.Integer_IO;
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT RUN-TIME COMPONENTS -- -- GNAT RUN-TIME COMPONENTS --
-- -- -- --
-- S Y S T E M . D I M _ I N T E G E R _ I O -- -- S Y S T E M . D I M . I N T E G E R _ I O --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
...@@ -29,19 +29,81 @@ ...@@ -29,19 +29,81 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package is a generic package that provides IO facilities for integer -- This package provides output routines for integer dimensioned types. All
-- dimensioned types. -- Put routines are modelled after those in package Ada.Text_IO.Integer_IO
-- with the addition of an extra default parameter.
-- Note that there is a default string parameter in every Put routine -- All the examples in this package are based on the MKS system of units:
-- rewritten at compile time to output the corresponding dimensions as a
-- suffix of the numeric value. -- type Mks_Type is new Integer
-- with
-- Dimension_System => ((Meter, 'm'),
-- (Kilogram, "kg"),
-- (Second, 's'),
-- (Ampere, 'A'),
-- (Kelvin, 'K'),
-- (Mole, "mol"),
-- (Candela, "cd"));
-- Parameter Symbol may be used in the following manner:
-- Case 1. A value is supplied for Symbol
-- The string appears as a suffix of Item
-- Obj : Mks_Type := 2;
-- Put (Obj, Symbols => " dimensionless");
-- The corresponding output is: 2 dimensionless
-- Case 2. No value is supplied for Symbol and Item is dimensionless
-- Item appears without a suffix
-- Obj : Mks_Type := 2;
-- Put (Obj);
-- The corresponding output is: 2
-- Case 3. No value is supplied for Symbol and Item has a dimension
-- If the type of Item is a dimensioned subtype whose symbolic name is not
-- empty, then the symbolic name appears as a suffix.
-- subtype Length is Mks_Type
-- with
-- Dimension => ('m',
-- Meter => 1,
-- others => 0);
-- Obj : Length := 2;
-- Put (Obj);
-- The corresponding output is: 2 m
-- Otherwise, a new string is created and appears as a suffix of Item.
-- This string results in the successive concatanations between each
-- dimension symbolic name raised by its corresponding dimension power from
-- the dimensions of Item.
-- subtype Random is Mks_Type
-- with
-- Dimension => ("",
-- Meter => 3,
-- Candela => 2,
-- others => 0);
-- Obj : Random := 5;
-- Put (Obj);
-- The corresponding output is: 5 m**3.cd**2
with Ada.Text_IO; use Ada.Text_IO; with Ada.Text_IO; use Ada.Text_IO;
generic generic
type Num_Dim_Integer is range <>; type Num_Dim_Integer is range <>;
package System.Dim_Integer_IO is package System.Dim.Integer_IO is
Default_Width : Field := Num_Dim_Integer'Width; Default_Width : Field := Num_Dim_Integer'Width;
Default_Base : Number_Base := 10; Default_Base : Number_Base := 10;
...@@ -67,4 +129,4 @@ package System.Dim_Integer_IO is ...@@ -67,4 +129,4 @@ package System.Dim_Integer_IO is
pragma Inline (Put); pragma Inline (Put);
end System.Dim_Integer_IO; end System.Dim.Integer_IO;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . D I M --
-- --
-- S p e c --
-- --
-- Copyright (C) 2012, 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. --
-- --
-- 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/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Defines the dimension terminology
---------------------------
-- Dimension Terminology --
---------------------------
-- * Dimensioned type
-- A dimensioned type is a type (more accurately a first subtype) to which
-- the aspect Dimension_System applies to.
-- type Mks_Type is new Long_Long_Float
-- with
-- Dimension_System => ((Meter, 'm'),
-- (Kilogram, "kg"),
-- (Second, 's'),
-- (Ampere, 'A'),
-- (Kelvin, 'K'),
-- (Mole, "mol"),
-- (Candela, "cd"));
-- 'm' is the symbolic name of dimension Meter
-- * Dimensioned subtype
-- A dimensioned subtype is a subtype directly defined from the dimensioned
-- type and to which the aspect Dimension applies to.
-- subtype Length is Mks_Type
-- with
-- Dimension => ('m',
-- Meter => 1,
-- others => 0);
-- 'm' is the symbolic name of dimensioned subtype Length
package System.Dim is
end System.Dim;
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT RUN-TIME COMPONENTS -- -- GNAT RUN-TIME COMPONENTS --
-- -- -- --
-- S Y S T E M . D I M _ M K S _ I O -- -- S Y S T E M . D I M . M K S _ I O --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -29,10 +29,10 @@ ...@@ -29,10 +29,10 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package provides IO routines for the MKS dimension system (see -- Provides output facilities for the MKS dimension system (see System.Dim.Mks
-- System.Dim_Mks). -- and System.Dim.Float_IO).
with System.Dim_Mks; use System.Dim_Mks; with System.Dim.Mks; use System.Dim.Mks;
with System.Dim_Float_IO; with System.Dim.Float_IO;
package System.Dim_Mks_IO is new System.Dim_Float_IO (Mks_Type); package System.Dim.Mks_IO is new System.Dim.Float_IO (Mks_Type);
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT RUN-TIME COMPONENTS -- -- GNAT RUN-TIME COMPONENTS --
-- -- -- --
-- S Y S T E M . D I M _ M K S -- -- S Y S T E M . D I M . M K S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
...@@ -35,9 +35,11 @@ ...@@ -35,9 +35,11 @@
-- System.Dim_Mks.Other_Prefixes) in order to avoid too many constant -- System.Dim_Mks.Other_Prefixes) in order to avoid too many constant
-- declarations in this package. -- declarations in this package.
-- The dimension terminology is defined in System.Dim_IO package
with Ada.Numerics; with Ada.Numerics;
package System.Dim_Mks is package System.Dim.Mks is
e : constant := Ada.Numerics.e; e : constant := Ada.Numerics.e;
Pi : constant := Ada.Numerics.Pi; Pi : constant := Ada.Numerics.Pi;
...@@ -54,7 +56,7 @@ package System.Dim_Mks is ...@@ -54,7 +56,7 @@ package System.Dim_Mks is
(Mole, "mol"), (Mole, "mol"),
(Candela, "cd")); (Candela, "cd"));
-- SI Base -- SI Base dimensioned subtype
subtype Length is Mks_Type subtype Length is Mks_Type
with with
...@@ -321,4 +323,4 @@ package System.Dim_Mks is ...@@ -321,4 +323,4 @@ package System.Dim_Mks is
kA : constant Electric_Current := 1.0E+03; -- kilo kA : constant Electric_Current := 1.0E+03; -- kilo
MeA : constant Electric_Current := 1.0E+06; -- mega MeA : constant Electric_Current := 1.0E+06; -- mega
end System.Dim_Mks; end System.Dim.Mks;
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT RUN-TIME COMPONENTS -- -- GNAT RUN-TIME COMPONENTS --
-- -- -- --
-- S Y S T E M . D I M _ M K S . O T H E R _ P R E F I X E S -- -- S Y S T E M . D I M . M K S . O T H E R _ P R E F I X E S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -34,7 +34,7 @@ ...@@ -34,7 +34,7 @@
-- These prefixes have been defined in a child package in order to avoid too -- These prefixes have been defined in a child package in order to avoid too
-- many constant declarations in System.Dim_Mks. -- many constant declarations in System.Dim_Mks.
package System.Dim_Mks.Other_Prefixes is package System.Dim.Mks.Other_Prefixes is
-- SI prefixes for Meter -- SI prefixes for Meter
...@@ -165,4 +165,4 @@ package System.Dim_Mks.Other_Prefixes is ...@@ -165,4 +165,4 @@ package System.Dim_Mks.Other_Prefixes is
Zecd : constant Luminous_Intensity := 1.0E+21; -- zetta Zecd : constant Luminous_Intensity := 1.0E+21; -- zetta
Yocd : constant Luminous_Intensity := 1.0E+24; -- yotta Yocd : constant Luminous_Intensity := 1.0E+24; -- yotta
end System.Dim_Mks.Other_Prefixes; end System.Dim.Mks.Other_Prefixes;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -28,7 +28,6 @@ with Csets; use Csets; ...@@ -28,7 +28,6 @@ with Csets; use Csets;
with Hostparm; use Hostparm; with Hostparm; use Hostparm;
with Namet; use Namet; with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output;
with Restrict; use Restrict; with Restrict; use Restrict;
with Rident; use Rident; with Rident; use Rident;
with Scans; use Scans; with Scans; use Scans;
...@@ -36,10 +35,6 @@ with Sinfo; use Sinfo; ...@@ -36,10 +35,6 @@ with Sinfo; use Sinfo;
with Sinput; use Sinput; with Sinput; use Sinput;
with Uintp; use Uintp; with Uintp; use Uintp;
with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark;
with System.WCh_Con; use System.WCh_Con;
package body Scn is package body Scn is
use ASCII; use ASCII;
...@@ -271,45 +266,7 @@ package body Scn is ...@@ -271,45 +266,7 @@ package body Scn is
Set_License (Current_Source_File, Determine_License); Set_License (Current_Source_File, Determine_License);
end if; end if;
-- Check for BOM Check_For_BOM;
declare
BOM : BOM_Kind;
Len : Natural;
Tst : String (1 .. 5);
begin
for J in 1 .. 5 loop
Tst (J) := Source (Scan_Ptr + Source_Ptr (J) - 1);
end loop;
Read_BOM (Tst, Len, BOM, False);
case BOM is
when UTF8_All =>
Scan_Ptr := Scan_Ptr + Source_Ptr (Len);
Wide_Character_Encoding_Method := WCEM_UTF8;
Upper_Half_Encoding := True;
when UTF16_LE | UTF16_BE =>
Set_Standard_Error;
Write_Line ("UTF-16 encoding format not recognized");
Set_Standard_Output;
raise Unrecoverable_Error;
when UTF32_LE | UTF32_BE =>
Set_Standard_Error;
Write_Line ("UTF-32 encoding format not recognized");
Set_Standard_Output;
raise Unrecoverable_Error;
when Unknown =>
null;
when others =>
raise Program_Error;
end case;
end;
-- Because of the License stuff above, Scng.Initialize_Scanner cannot -- Because of the License stuff above, Scng.Initialize_Scanner cannot
-- call Scan. Scan initial token (note this initializes Prev_Token, -- call Scan. Scan initial token (note this initializes Prev_Token,
......
...@@ -2126,7 +2126,7 @@ package body Sem_Dim is ...@@ -2126,7 +2126,7 @@ package body Sem_Dim is
-- Expand_Put_Call_With_Dimension_Symbol -- -- Expand_Put_Call_With_Dimension_Symbol --
------------------------------------------- -------------------------------------------
-- For procedure Put defined in System.Dim_Float_IO/System.Dim_Integer_IO, -- For procedure Put defined in System.Dim.Float_IO/System.Dim.Integer_IO,
-- the default string parameter must be rewritten to include the dimension -- the default string parameter must be rewritten to include the dimension
-- symbols in the output of a dimensioned object. -- symbols in the output of a dimensioned object.
...@@ -2175,8 +2175,8 @@ package body Sem_Dim is ...@@ -2175,8 +2175,8 @@ package body Sem_Dim is
function Is_Procedure_Put_Call return Boolean; function Is_Procedure_Put_Call return Boolean;
-- Return True if the current call is a call of an instantiation of a -- Return True if the current call is a call of an instantiation of a
-- procedure Put defined in the package System.Dim_Float_IO and -- procedure Put defined in the package System.Dim.Float_IO and
-- System.Dim_Integer_IO. -- System.Dim.Integer_IO.
function Item_Actual return Node_Id; function Item_Actual return Node_Id;
-- Return the item actual parameter node in the put call -- Return the item actual parameter node in the put call
...@@ -2240,16 +2240,17 @@ package body Sem_Dim is ...@@ -2240,16 +2240,17 @@ package body Sem_Dim is
then then
Ent := Cunit_Entity (Get_Source_Unit (Ent)); Ent := Cunit_Entity (Get_Source_Unit (Ent));
-- Verify that the generic package is System.Dim_Float_IO or -- Verify that the generic package is System.Dim.Float_IO or
-- System.Dim_Integer_IO. -- System.Dim.Integer_IO.
if Is_Library_Level_Entity (Ent) then if Is_Library_Level_Entity (Ent) then
Package_Name := Chars (Ent); Package_Name := Chars (Ent);
return if Package_Name = Name_Float_IO
Package_Name = Name_Dim_Float_IO or else Package_Name = Name_Integer_IO
or else then
Package_Name = Name_Dim_Integer_IO; return Chars (Scope (Ent)) = Name_Dim;
end if;
end if; end if;
end if; end if;
end if; end if;
...@@ -2511,11 +2512,13 @@ package body Sem_Dim is ...@@ -2511,11 +2512,13 @@ package body Sem_Dim is
if Is_Entity_Name (Gen_Id) then if Is_Entity_Name (Gen_Id) then
Ent := Entity (Gen_Id); Ent := Entity (Gen_Id);
return if Is_Library_Level_Entity (Ent)
Is_Library_Level_Entity (Ent)
and then and then
(Chars (Ent) = Name_Dim_Float_IO (Chars (Ent) = Name_Float_IO
or else Chars (Ent) = Name_Dim_Integer_IO); or else Chars (Ent) = Name_Integer_IO)
then
return Chars (Scope (Ent)) = Name_Dim;
end if;
end if; end if;
return False; return False;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -27,7 +27,7 @@ ...@@ -27,7 +27,7 @@
-- "dimension" is a compile-time property of a numerical type which represents -- "dimension" is a compile-time property of a numerical type which represents
-- a relation between various quantifiers such as length, velocity, etc. -- a relation between various quantifiers such as length, velocity, etc.
-- Package System.Dim_Mks offers a ready-to-use system of SI base units. In -- Package System.Dim.Mks offers a ready-to-use system of SI base units. In
-- addition, the implementation of this feature offers the ability to define -- addition, the implementation of this feature offers the ability to define
-- an arbitrary system of units through the use of Ada 2012 aspects. -- an arbitrary system of units through the use of Ada 2012 aspects.
...@@ -83,12 +83,6 @@ ...@@ -83,12 +83,6 @@
-- Phase 2 is called only when the node allows a dimension (see body of -- 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). -- 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; with Types; use Types;
package Sem_Dim is package Sem_Dim is
...@@ -145,7 +139,7 @@ package Sem_Dim is ...@@ -145,7 +139,7 @@ package Sem_Dim is
procedure Expand_Put_Call_With_Dimension_Symbol (N : Node_Id); procedure Expand_Put_Call_With_Dimension_Symbol (N : Node_Id);
-- Determine whether N denotes a subprogram call to one of the routines -- Determine whether N denotes a subprogram call to one of the routines
-- defined in System.Dim_Float_IO or System.Dim_Integer_IO and add an -- defined in System.Dim.Float_IO or System.Dim.Integer_IO and add an
-- extra actual to the call to represent the symbolic representation of -- extra actual to the call to represent the symbolic representation of
-- a dimension. -- a dimension.
...@@ -153,8 +147,8 @@ package Sem_Dim is ...@@ -153,8 +147,8 @@ package Sem_Dim is
-- Return True if type Typ has aspect Dimension_System applied to it -- Return True if type Typ has aspect Dimension_System applied to it
function Is_Dim_IO_Package_Instantiation (N : Node_Id) return Boolean; function Is_Dim_IO_Package_Instantiation (N : Node_Id) return Boolean;
-- Return True if N is a package instantiation of System.Dim_Integer_IO or -- Return True if N is a package instantiation of System.Dim.Integer_IO or
-- of System.Dim_Float_IO. -- of System.Dim.Float_IO.
procedure Remove_Dimension_In_Call (Call : Node_Id); procedure Remove_Dimension_In_Call (Call : Node_Id);
-- Remove the dimensions from all formal parameters of Call -- Remove the dimensions from all formal parameters of Call
......
...@@ -26,15 +26,10 @@ ...@@ -26,15 +26,10 @@
with Ada.Unchecked_Conversion; with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark;
with Opt; use Opt;
with Output; use Output;
with Prj.Err; with Prj.Err;
with Sinput.C; with Sinput.C;
with System; with System;
with System.WCh_Con; use System.WCh_Con;
package body Sinput.P is package body Sinput.P is
...@@ -169,45 +164,7 @@ package body Sinput.P is ...@@ -169,45 +164,7 @@ package body Sinput.P is
Prj.Err.Scanner.Set_Special_Character ('#'); Prj.Err.Scanner.Set_Special_Character ('#');
Prj.Err.Scanner.Set_Special_Character ('$'); Prj.Err.Scanner.Set_Special_Character ('$');
-- Check for BOM Check_For_BOM;
declare
BOM : BOM_Kind;
Len : Natural;
Tst : String (1 .. 5);
begin
for J in 1 .. 5 loop
Tst (J) := Source (Scan_Ptr + Source_Ptr (J) - 1);
end loop;
Read_BOM (Tst, Len, BOM, False);
case BOM is
when UTF8_All =>
Scan_Ptr := Scan_Ptr + Source_Ptr (Len);
Wide_Character_Encoding_Method := WCEM_UTF8;
Upper_Half_Encoding := True;
when UTF16_LE | UTF16_BE =>
Set_Standard_Error;
Write_Line ("UTF-16 encoding format not recognized");
Set_Standard_Output;
raise Unrecoverable_Error;
when UTF32_LE | UTF32_BE =>
Set_Standard_Error;
Write_Line ("UTF-32 encoding format not recognized");
Set_Standard_Output;
raise Unrecoverable_Error;
when Unknown =>
null;
when others =>
raise Program_Error;
end case;
end;
-- We scan past junk to the first interesting compilation unit token, to -- We scan past junk to the first interesting compilation unit token, to
-- see if it is SEPARATE. We ignore WITH keywords during this and also -- see if it is SEPARATE. We ignore WITH keywords during this and also
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,11 +36,15 @@ with Atree; use Atree; ...@@ -36,11 +36,15 @@ with Atree; use Atree;
with Debug; use Debug; with Debug; use Debug;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with Scans; use Scans;
with Tree_IO; use Tree_IO; with Tree_IO; use Tree_IO;
with System; use System;
with Widechar; use Widechar; with Widechar; use Widechar;
with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark;
with System; use System;
with System.Memory; with System.Memory;
with System.WCh_Con; use System.WCh_Con;
with Unchecked_Conversion; with Unchecked_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
...@@ -246,6 +250,44 @@ package body Sinput is ...@@ -246,6 +250,44 @@ package body Sinput is
return Name_Buffer (1 .. Name_Len); return Name_Buffer (1 .. Name_Len);
end Build_Location_String; end Build_Location_String;
procedure Check_For_BOM is
BOM : BOM_Kind;
Len : Natural;
Tst : String (1 .. 5);
begin
for J in 1 .. 5 loop
Tst (J) := Source (Scan_Ptr + Source_Ptr (J) - 1);
end loop;
Read_BOM (Tst, Len, BOM, False);
case BOM is
when UTF8_All =>
Scan_Ptr := Scan_Ptr + Source_Ptr (Len);
Wide_Character_Encoding_Method := WCEM_UTF8;
Upper_Half_Encoding := True;
when UTF16_LE | UTF16_BE =>
Set_Standard_Error;
Write_Line ("UTF-16 encoding format not recognized");
Set_Standard_Output;
raise Unrecoverable_Error;
when UTF32_LE | UTF32_BE =>
Set_Standard_Error;
Write_Line ("UTF-32 encoding format not recognized");
Set_Standard_Output;
raise Unrecoverable_Error;
when Unknown =>
null;
when others =>
raise Program_Error;
end case;
end Check_For_BOM;
----------------------- -----------------------
-- Get_Column_Number -- -- Get_Column_Number --
----------------------- -----------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -712,6 +712,16 @@ package Sinput is ...@@ -712,6 +712,16 @@ package Sinput is
-- Writes out internal tables to current tree file using the relevant -- Writes out internal tables to current tree file using the relevant
-- Table.Tree_Write routines. -- Table.Tree_Write routines.
procedure Check_For_BOM;
-- Check if the current source starts with a BOM. Scan_Ptr needs to be at
-- the start of the current source.
-- If the current source starts with a recognized BOM, then some flags
-- such as Wide_Character_Encoding_Method are set accordingly.
-- An exception is raised if a BOM is found that indicates an unrecognized
-- format.
-- This procedure has no effect if there is no BOM at the beginning of the
-- current source.
private private
pragma Inline (File_Name); pragma Inline (File_Name);
pragma Inline (First_Mapped_Line); pragma Inline (First_Mapped_Line);
......
...@@ -225,8 +225,7 @@ package Snames is ...@@ -225,8 +225,7 @@ package Snames is
-- Names used by the analyzer and expander for aspect Dimension and -- Names used by the analyzer and expander for aspect Dimension and
-- Dimension_System to deal with Sqrt and IO routines. -- Dimension_System to deal with Sqrt and IO routines.
Name_Dim_Float_IO : constant Name_Id := N + $; -- Ada 12 Name_Dim : 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_Generic_Elementary_Functions : constant Name_Id := N + $; -- Ada 12
Name_Item : constant Name_Id := N + $; -- Ada 12 Name_Item : constant Name_Id := N + $; -- Ada 12
Name_Sqrt : constant Name_Id := N + $; -- Ada 12 Name_Sqrt : constant Name_Id := N + $; -- Ada 12
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment