+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
s-crtl$(objext) \
s-crtrun$(objext) \
s-diflio$(objext) \
+ s-dim$(objext) \
s-diinio$(objext) \
s-dimkio$(objext) \
s-dimmks$(objext) \
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 \
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 \
* *
* 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- *
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. */
-- --
-- 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- --
("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
-- --
-- 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 --
-- --
-- --
------------------------------------------------------------------------------
-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);
To := To & Symbols;
end Put;
-end System.Dim_Float_IO;
+end System.Dim.Float_IO;
-- --
-- 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 --
-- --
-- --
------------------------------------------------------------------------------
--- 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;
pragma Inline (Put);
-end System.Dim_Float_IO;
+end System.Dim.Float_IO;
-- --
-- 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 --
-- --
-- --
------------------------------------------------------------------------------
-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);
To := To & Symbols;
end Put;
-end System.Dim_Integer_IO;
+end System.Dim.Integer_IO;
-- --
-- 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 --
-- --
-- --
------------------------------------------------------------------------------
--- 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;
pragma Inline (Put);
-end System.Dim_Integer_IO;
+end System.Dim.Integer_IO;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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);
-- --
-- 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 --
-- --
-- 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;
(Mole, "mol"),
(Candela, "cd"));
- -- SI Base
+ -- SI Base dimensioned subtype
subtype Length is Mks_Type
with
kA : constant Electric_Current := 1.0E+03; -- kilo
MeA : constant Electric_Current := 1.0E+06; -- mega
-end System.Dim_Mks;
+end System.Dim.Mks;
-- --
-- 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- --
-- 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
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;
-- --
-- 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- --
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;
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;
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,
-- 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.
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
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;
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;
-- --
-- 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- --
-- "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.
-- 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
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.
-- 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
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
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
-- --
-- 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- --
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;
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 --
-----------------------
-- --
-- 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- --
-- 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);
-- 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
projects / thirdparty / gcc.git / commitdiff
