[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
This commit is contained in:
Arnaud Charlet 2012-02-08 11:13:54 +01:00
parent f62054146e
commit 7b50c4a3fa
20 changed files with 377 additions and 190 deletions

View File

@ -1,3 +1,35 @@
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>
* gnat_rm.texi: Minor reshuffling to place restriction at

View File

@ -505,6 +505,7 @@ GNATRTL_NONTASKING_OBJS= \
s-crtl$(objext) \
s-crtrun$(objext) \
s-diflio$(objext) \
s-dim$(objext) \
s-diinio$(objext) \
s-dimkio$(objext) \
s-dimmks$(objext) \

View File

@ -453,6 +453,7 @@ GNATBIND_OBJS = \
ada/fmap.o \
ada/fname.o \
ada/fname-uf.o \
ada/g-byorma.o \
ada/g-hesora.o \
ada/g-htable.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 \
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_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_tss.ads ada/exp_util.ads ada/exp_util.adb ada/expander.ads \
ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
ada/gnat.ads ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads \
ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
ada/lib.ads ada/lib-load.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
ada/exp_disp.ads ada/exp_fixd.ads ada/exp_intr.ads ada/exp_intr.adb \
ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/gnatvsn.ads \
ada/hlo.ads ada/hostparm.ads ada/inline.ads ada/interfac.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/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \
ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \
ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \
ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \
ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/sinput.adb ada/snames.ads ada/sprint.ads \
ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
ada/types.ads ada/uintp.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/put_alfa.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
ada/sem_aux.ads ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads \
ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads \
ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \
ada/sem_ch9.ads ada/sem_disp.ads ada/sem_eval.ads ada/sem_prag.ads \
ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/sinput.adb ada/snames.ads ada/sprint.ads ada/stand.ads \
ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.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/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \

View File

@ -6,7 +6,7 @@
* *
* 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 *
* 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,
tree gnu_proc = gnat_to_gnu (gnat_proc);
tree gnu_call;
/* The storage pools are obviously always tagged types, but the
secondary stack uses the same mechanism and is not tagged. */
if (Is_Tagged_Type (Etype (gnat_pool)))
/* A storage pool's underlying type is a record type (for both predefined
storage pools and GNAT simple storage pools). The secondary stack uses
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
same type. */

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -366,11 +366,11 @@ 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-dimkio", F), -- System.Dim_Mks_IO
("s-dimmks", F), -- System.Dim_Mks
("s-dmotpr", F), -- System.Dim_Mks.Other_Prefixes
("s-diflio", F), -- System.Dim.Float_IO
("s-diinio", F), -- System.Dim.Integer_IO
("s-dimkio", F), -- System.Dim.Mks_IO
("s-dimmks", F), -- System.Dim.Mks
("s-dmotpr", F), -- System.Dim.Mks.Other_Prefixes
("s-memory", F), -- System.Memory
("s-parint", F), -- System.Partition_Interface
("s-pooglo", F), -- System.Pool_Global

View File

@ -2,7 +2,7 @@
-- --
-- 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 --
-- --
@ -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);
@ -74,4 +74,4 @@ package body System.Dim_Float_IO is
To := To & Symbols;
end Put;
end System.Dim_Float_IO;
end System.Dim.Float_IO;

View File

@ -2,7 +2,7 @@
-- --
-- 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 --
-- --
@ -29,19 +29,74 @@
-- --
------------------------------------------------------------------------------
-- This package is a generic package that provides IO facilities for float
-- dimensioned types.
-- This package provides output routines for float dimensioned types. All Put
-- 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
-- rewritten at compile time to output the corresponding dimensions as a
-- suffix of the numeric value.
-- Parameter Symbol may be used in the following manner (all the examples are
-- based on the MKS system of units as defined in package System.Dim.Mks):
-- 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;
generic
type Num_Dim_Float is digits <>;
package System.Dim_Float_IO is
package System.Dim.Float_IO is
Default_Fore : Field := 2;
Default_Aft : Field := Num_Dim_Float'Digits - 1;
@ -71,4 +126,4 @@ package System.Dim_Float_IO is
pragma Inline (Put);
end System.Dim_Float_IO;
end System.Dim.Float_IO;

View File

@ -2,7 +2,7 @@
-- --
-- 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 --
-- --
@ -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);
@ -74,4 +74,4 @@ package body System.Dim_Integer_IO is
To := To & Symbols;
end Put;
end System.Dim_Integer_IO;
end System.Dim.Integer_IO;

View File

@ -2,7 +2,7 @@
-- --
-- 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 --
-- --
@ -29,19 +29,81 @@
-- --
------------------------------------------------------------------------------
-- This package is a generic package that provides IO facilities for integer
-- dimensioned types.
-- This package provides output routines for integer dimensioned types. All
-- 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
-- rewritten at compile time to output the corresponding dimensions as a
-- suffix of the numeric value.
-- All the examples in this package are based on the MKS system of units:
-- 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;
generic
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_Base : Number_Base := 10;
@ -67,4 +129,4 @@ package System.Dim_Integer_IO is
pragma Inline (Put);
end System.Dim_Integer_IO;
end System.Dim.Integer_IO;

69
gcc/ada/s-dim.ads Normal file
View File

@ -0,0 +1,69 @@
------------------------------------------------------------------------------
-- --
-- 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;

View File

@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -29,10 +29,10 @@
-- --
------------------------------------------------------------------------------
-- This package provides IO routines for the MKS dimension system (see
-- System.Dim_Mks).
-- Provides output facilities for the MKS dimension system (see System.Dim.Mks
-- and System.Dim.Float_IO).
with System.Dim_Mks; use System.Dim_Mks;
with System.Dim_Float_IO;
with System.Dim.Mks; use System.Dim.Mks;
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);

View File

@ -2,7 +2,7 @@
-- --
-- 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 --
-- --
@ -35,9 +35,11 @@
-- System.Dim_Mks.Other_Prefixes) in order to avoid too many constant
-- declarations in this package.
-- The dimension terminology is defined in System.Dim_IO package
with Ada.Numerics;
package System.Dim_Mks is
package System.Dim.Mks is
e : constant := Ada.Numerics.e;
Pi : constant := Ada.Numerics.Pi;
@ -54,7 +56,7 @@ package System.Dim_Mks is
(Mole, "mol"),
(Candela, "cd"));
-- SI Base
-- SI Base dimensioned subtype
subtype Length is Mks_Type
with
@ -321,4 +323,4 @@ package System.Dim_Mks is
kA : constant Electric_Current := 1.0E+03; -- kilo
MeA : constant Electric_Current := 1.0E+06; -- mega
end System.Dim_Mks;
end System.Dim.Mks;

View File

@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -34,7 +34,7 @@
-- These prefixes have been defined in a child package in order to avoid too
-- 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
@ -165,4 +165,4 @@ package System.Dim_Mks.Other_Prefixes is
Zecd : constant Luminous_Intensity := 1.0E+21; -- zetta
Yocd : constant Luminous_Intensity := 1.0E+24; -- yotta
end System.Dim_Mks.Other_Prefixes;
end System.Dim.Mks.Other_Prefixes;

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -28,7 +28,6 @@ with Csets; use Csets;
with Hostparm; use Hostparm;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Restrict; use Restrict;
with Rident; use Rident;
with Scans; use Scans;
@ -36,10 +35,6 @@ with Sinfo; use Sinfo;
with Sinput; use Sinput;
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
use ASCII;
@ -271,45 +266,7 @@ package body Scn is
Set_License (Current_Source_File, Determine_License);
end if;
-- 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;
Check_For_BOM;
-- Because of the License stuff above, Scng.Initialize_Scanner cannot
-- call Scan. Scan initial token (note this initializes Prev_Token,

View File

@ -2126,7 +2126,7 @@ package body Sem_Dim is
-- 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
-- symbols in the output of a dimensioned object.
@ -2175,8 +2175,8 @@ package body Sem_Dim is
function Is_Procedure_Put_Call return Boolean;
-- 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
-- System.Dim_Integer_IO.
-- procedure Put defined in the package System.Dim.Float_IO and
-- System.Dim.Integer_IO.
function Item_Actual return Node_Id;
-- Return the item actual parameter node in the put call
@ -2240,16 +2240,17 @@ package body Sem_Dim is
then
Ent := Cunit_Entity (Get_Source_Unit (Ent));
-- Verify that the generic package is System.Dim_Float_IO or
-- System.Dim_Integer_IO.
-- Verify that the generic package is System.Dim.Float_IO or
-- System.Dim.Integer_IO.
if Is_Library_Level_Entity (Ent) then
Package_Name := Chars (Ent);
return
Package_Name = Name_Dim_Float_IO
or else
Package_Name = Name_Dim_Integer_IO;
if Package_Name = Name_Float_IO
or else Package_Name = Name_Integer_IO
then
return Chars (Scope (Ent)) = Name_Dim;
end if;
end if;
end if;
end if;
@ -2511,11 +2512,13 @@ package body Sem_Dim is
if Is_Entity_Name (Gen_Id) then
Ent := Entity (Gen_Id);
return
Is_Library_Level_Entity (Ent)
and then
(Chars (Ent) = Name_Dim_Float_IO
or else Chars (Ent) = Name_Dim_Integer_IO);
if Is_Library_Level_Entity (Ent)
and then
(Chars (Ent) = Name_Float_IO
or else Chars (Ent) = Name_Integer_IO)
then
return Chars (Scope (Ent)) = Name_Dim;
end if;
end if;
return False;

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -27,7 +27,7 @@
-- "dimension" is a compile-time property of a numerical type which represents
-- 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
-- an arbitrary system of units through the use of Ada 2012 aspects.
@ -83,12 +83,6 @@
-- 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
@ -145,7 +139,7 @@ package Sem_Dim is
procedure Expand_Put_Call_With_Dimension_Symbol (N : Node_Id);
-- 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
-- a dimension.
@ -153,8 +147,8 @@ package Sem_Dim is
-- Return True if type Typ has aspect Dimension_System applied to it
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
-- of System.Dim_Float_IO.
-- Return True if N is a package instantiation of System.Dim.Integer_IO or
-- of System.Dim.Float_IO.
procedure Remove_Dimension_In_Call (Call : Node_Id);
-- Remove the dimensions from all formal parameters of Call

View File

@ -26,15 +26,10 @@
with Ada.Unchecked_Conversion;
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 Sinput.C;
with System;
with System.WCh_Con; use System.WCh_Con;
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 ('$');
-- 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;
Check_For_BOM;
-- 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

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -36,11 +36,15 @@ with Atree; use Atree;
with Debug; use Debug;
with Opt; use Opt;
with Output; use Output;
with Scans; use Scans;
with Tree_IO; use Tree_IO;
with System; use System;
with Widechar; use Widechar;
with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark;
with System; use System;
with System.Memory;
with System.WCh_Con; use System.WCh_Con;
with Unchecked_Conversion;
with Unchecked_Deallocation;
@ -246,6 +250,44 @@ package body Sinput is
return Name_Buffer (1 .. Name_Len);
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 --
-----------------------

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -712,6 +712,16 @@ package Sinput is
-- Writes out internal tables to current tree file using the relevant
-- 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
pragma Inline (File_Name);
pragma Inline (First_Mapped_Line);

View File

@ -225,8 +225,7 @@ package Snames is
-- 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_Dim : 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_Sqrt : constant Name_Id := N + $; -- Ada 12