OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2003-11-24  Jose Ruiz  <ruiz@act-europe.fr>

	* Makefile.in:
	Use 5zintman.ads for VxWorks targets. This file avoid confusion between
	signals and interrupts.

	* 5zintman.ads: New File.

	* 5zintman.adb: Replace Exception_Interrupts by Exception_Signals, and
	add exception signals to the set of unmasked signals.

	* 5ztaprop.adb:
	Use Abort_Task_Signal instead of Abort_Task_Interrupt to avoid confusion
	between signals and interrupts.
	Add to Unblocked_Signal_Mask the set of signals that are in
	Keep_Unmasked.

	* 7sinmaop.adb:
	Adding a check to see whether the Interrupt_ID we want to unmask is in
	the range of Keep_Unmasked (in procedure Interrupt_Self_Process). The
	reason is that the index type of the Keep_Unmasked array is not always
	Interrupt_ID; it may be a subtype of Interrupt_ID.

2003-11-24  Gary Dismukes  <dismukes@gnat.com>

	* exp_util.adb:
	(Remove_Side_Effects): Condition constantness of object created for a
	 an unchecked type conversion on the constantness of the expression
	 to ensure the correct value for 'Constrained when passing components
	 of view-converted class-wide objects.

2003-11-24  Robert Dewar  <dewar@gnat.com>

	* par-load.adb (Load): Improve handling of misspelled and missing units
	Removes several cases of compilation abandoned messages

	* lib.adb: (Remove_Unit): New procedure

	* lib.ads: (Remove_Unit): New procedure

	* lib-load.adb: Minor reformatting

2003-11-24  Vincent Celier  <celier@gnat.com>

	* make.adb:
	(Gnatmake, Initialize): Call Usage instead of Makeusg directly
	(Marking_Label): Label to mark processed source files. Incremented for
	each executable.
	(Gnatmake): Increase Marking_Labet for each executable
	(Is_Marked): Compare against marking label
	(Mark): Mark with marking label

2003-11-24  Jerome Guitton  <guitton@act-europe.fr>

	* s-thread.ads:
	Move the declaration of the TSD for System.Threads to System.Soft_Links.
	Add some comments.

	* Makefile.in: Added target pair for s-thread.adb for cert runtime.
	(rts-cert): build a single relocatable object for the run-time lib.
	Fix perms.

2003-11-24  Vasiliy Fofanov  <fofanov@act-europe.fr>

	* Make-lang.in:
	Use gnatls rather than gcc to obtain the location of GNAT RTL for
	crosstools build.

2003-11-24  Sergey Rybin  <rybin@act-europe.fr>

	* opt.adb (Tree_Write): Gnat_Version_String is now a function, so we
	can not use it as before (that is, as a variable) when dumping it into
	the tree file. Add a local variable to store the result of this
	function and to be used as the string to be written into the tree.

	* scn.adb (Initialize_Scanner): Add comments explaining the recent
	changes.

	* sinput.adb (Source_First, Source_Last): In case of
	Internal_Source_File, replace returning attributes of
	Internal_Source_Ptr (which is wrong) with returning attributes of
	Internal_Source.

2003-11-24  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch3.adb:
	(New_Concatenation_Op): Proper name for New_Binary_Operator, only
	used for implicit concatenation operators.
	Code cleanup.

	* sem_elab.adb:
	(Check_Elab_Call): Set No_Elaboration_Check appropriately on calls in
	task bodies that are in the scope of a Suppress pragma.
	(Check_A Call): Use the flag to prevent spurious elaboration checks.

	* sinfo.ads, sinfo.adb:
	New flag No_Elaboration_Check on function/procedure calls, to properly
	suppress checks on calls in task bodies that are within a local suppress
	pragma.

	* exp_ch4.adb:
	(Expand_Concatenate_Other): Use the proper integer type for the
	expression for the upper bound, to avoid universal_integer computations
	when possible.

From-SVN: r73874
This commit is contained in:
Arnaud Charlet 2003-11-24 15:27:57 +01:00
parent 8653a1eda8
commit 6c1e24d3a2
22 changed files with 551 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/5zintman.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -62,22 +62,27 @@ package body System.Interrupt_Management is
use System.OS_Interface;
use type Interfaces.C.int;
type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
Exception_Interrupts : constant Interrupt_List (1 .. 4) :=
(SIGFPE, SIGILL, SIGSEGV, SIGBUS);
type Signal_List is array (Signal_ID range <>) of Signal_ID;
Exception_Signals : constant Signal_List (1 .. 4) :=
(SIGFPE, SIGILL, SIGSEGV, SIGBUS);
-- Keep these variables global so that they are initialized only once.
-- Keep these variables global so that they are initialized only once
-- What are "these variables" ???, I see only one
Exception_Action : aliased struct_sigaction;
----------------------
-- Notify_Exception --
----------------------
-----------------------
-- Local Subprograms --
-----------------------
procedure Notify_Exception (signo : Signal);
-- Identify the Ada exception to be raised using
-- the information when the system received a synchronous signal.
----------------------
-- Notify_Exception --
----------------------
procedure Notify_Exception (signo : Signal) is
Mask : aliased sigset_t;
Result : int;
@ -126,10 +131,10 @@ package body System.Interrupt_Management is
old_act : aliased struct_sigaction;
begin
for J in Exception_Interrupts'Range loop
for J in Exception_Signals'Range loop
Result :=
sigaction
(Signal (Exception_Interrupts (J)), Exception_Action'Access,
(Signal (Exception_Signals (J)), Exception_Action'Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
end loop;
@ -160,15 +165,15 @@ begin
-- Change this if you want to use another signal for task abort.
-- SIGTERM might be a good one.
Abort_Task_Interrupt := SIGABRT;
Abort_Task_Signal := SIGABRT;
Exception_Action.sa_handler := Notify_Exception'Address;
Exception_Action.sa_flags := SA_ONSTACK;
Result := sigemptyset (mask'Access);
pragma Assert (Result = 0);
for J in Exception_Interrupts'Range loop
Result := sigaddset (mask'Access, Signal (Exception_Interrupts (J)));
for J in Exception_Signals'Range loop
Result := sigaddset (mask'Access, Signal (Exception_Signals (J)));
pragma Assert (Result = 0);
end loop;
@ -185,5 +190,15 @@ begin
Reserve (J) := True;
end if;
end loop;
-- Add exception signals to the set of unmasked signals
for J in Exception_Signals'Range loop
Keep_Unmasked (Exception_Signals (J)) := True;
end loop;
-- The abort signal must also be unmasked
Keep_Unmasked (Abort_Task_Signal) := True;
end;
end System.Interrupt_Management;

123
gcc/ada/5zintman.ads Normal file
View File

@ -0,0 +1,123 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNARL; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This is the VxWorks version of this package.
-- This package encapsulates and centralizes information about all
-- uses of interrupts (or signals), including the target-dependent
-- mapping of interrupts (or signals) to exceptions.
-- Unlike the original design, System.Interrupt_Management can only
-- be used for tasking systems.
-- PLEASE DO NOT remove the Elaborate_Body pragma from this package.
-- Elaboration of this package should happen early, as most other
-- initializations depend on it. Forcing immediate elaboration of
-- the body also helps to enforce the design assumption that this
-- is a second-level package, just one level above System.OS_Interface
-- with no cross-dependencies.
-- PLEASE DO NOT put any subprogram declarations with arguments of
-- type Interrupt_ID into the visible part of this package. The type
-- Interrupt_ID is used to derive the type in Ada.Interrupts, and
-- adding more operations to that type would be illegal according
-- to the Ada Reference Manual. This is the reason why the signals
-- sets are implemeneted using visible arrays rather than functions.
with System.OS_Interface;
-- used for sigset_t
with Interfaces.C;
-- used for int
package System.Interrupt_Management is
pragma Elaborate_Body;
type Interrupt_Mask is limited private;
type Interrupt_ID is new Interfaces.C.int
range 0 .. System.OS_Interface.Max_Interrupt;
type Interrupt_Set is array (Interrupt_ID) of Boolean;
subtype Signal_ID is Interrupt_ID
range 0 .. Interfaces.C."-" (System.OS_Interface.NSIG, 1);
type Signal_Set is array (Signal_ID) of Boolean;
-- The following objects serve as constants, but are initialized
-- in the body to aid portability. This permits us to use more
-- portable names for interrupts, where distinct names may map to
-- the same interrupt ID value.
--
-- For example, suppose SIGRARE is a signal that is not defined on
-- all systems, but is always reserved when it is defined. If we
-- have the convention that ID zero is not used for any "real"
-- signals, and SIGRARE = 0 when SIGRARE is not one of the locally
-- supported signals, we can write
-- Reserved (SIGRARE) := true;
-- and the initialization code will be portable.
Abort_Task_Signal : Signal_ID;
-- The signal that is used to implement task abortion if
-- an interrupt is used for that purpose. This is one of the
-- reserved signals.
Keep_Unmasked : Signal_Set := (others => False);
-- Keep_Unmasked (I) is true iff the signal I is one that must
-- that must be kept unmasked at all times, except (perhaps) for
-- short critical sections. This includes signals that are
-- mapped to exceptions, but may also include interrupts
-- (e.g. timer) that need to be kept unmasked for other
-- reasons. Where signal masking is per-task, the signal should be
-- unmasked in ALL TASKS.
Reserve : Interrupt_Set := (others => False);
-- Reserve (I) is true iff the interrupt I is one that cannot be
-- permitted to be attached to a user handler. The possible reasons
-- are many. For example, it may be mapped to an exception used to
-- implement task abortion, or used to implement time delays.
procedure Initialize_Interrupts;
-- On systems where there is no signal inheritance between tasks (e.g
-- VxWorks, GNU/LinuxThreads), this procedure is used to initialize
-- interrupts handling in each task. Otherwise this function should
-- only be called by initialize in this package body.
private
type Interrupt_Mask is new System.OS_Interface.sigset_t;
-- In some implementation Interrupt_Mask can be represented
-- as a linked list.
end System.Interrupt_Management;

15
gcc/ada/5ztaprop.adb
View File

@ -45,8 +45,8 @@ with System.Tasking.Debug;
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
-- Abort_Task_Signal
-- Signal_ID
-- Initialize_Interrupts
with System.Soft_Links;
@ -262,7 +262,7 @@ package body System.Task_Primitives.Operations is
Result :=
sigaction
(Signal (Interrupt_Management.Abort_Task_Interrupt),
(Signal (Interrupt_Management.Abort_Task_Signal),
act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
@ -1008,7 +1008,7 @@ package body System.Task_Primitives.Operations is
begin
Result := kill (T.Common.LL.Thread,
Signal (Interrupt_Management.Abort_Task_Interrupt));
Signal (Interrupt_Management.Abort_Task_Signal));
pragma Assert (Result = 0);
end Abort_Task;
@ -1126,6 +1126,13 @@ package body System.Task_Primitives.Operations is
Result := sigemptyset (Unblocked_Signal_Mask'Access);
pragma Assert (Result = 0);
for J in Interrupt_Management.Signal_ID loop
if System.Interrupt_Management.Keep_Unmasked (J) then
Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
pragma Assert (Result = 0);
end if;
end loop;
Environment_Task_ID := Environment_Task;
-- Initialize the lock used to synchronize chain of all ATCBs.

13
gcc/ada/7sinmaop.adb
View File

@ -325,11 +325,16 @@ begin
Storage_Elements.To_Address
(Storage_Elements.Integer_Address (SIG_IGN));
for I in Interrupt_ID loop
if Keep_Unmasked (I) then
Result := sigaddset (mask'Access, Signal (I));
for J in Interrupt_ID loop
-- We need to check whether J is in Keep_Unmasked because
-- the index type of the Keep_Unmasked array is not always
-- Interrupt_ID; it may be a subtype of Interrupt_ID.
if J in Keep_Unmasked'Range and then Keep_Unmasked (J) then
Result := sigaddset (mask'Access, Signal (J));
pragma Assert (Result = 0);
Result := sigdelset (allmask'Access, Signal (I));
Result := sigdelset (allmask'Access, Signal (J));
pragma Assert (Result = 0);
end if;
end loop;

105
gcc/ada/ChangeLog
View File

@ -1,3 +1,108 @@
2003-11-24 Jose Ruiz <ruiz@act-europe.fr>
* Makefile.in:
Use 5zintman.ads for VxWorks targets. This file avoid confusion between
signals and interrupts.
* 5zintman.ads: New File.
* 5zintman.adb: Replace Exception_Interrupts by Exception_Signals, and
add exception signals to the set of unmasked signals.
* 5ztaprop.adb:
Use Abort_Task_Signal instead of Abort_Task_Interrupt to avoid confusion
between signals and interrupts.
Add to Unblocked_Signal_Mask the set of signals that are in
Keep_Unmasked.
* 7sinmaop.adb:
Adding a check to see whether the Interrupt_ID we want to unmask is in
the range of Keep_Unmasked (in procedure Interrupt_Self_Process). The
reason is that the index type of the Keep_Unmasked array is not always
Interrupt_ID; it may be a subtype of Interrupt_ID.
2003-11-24 Gary Dismukes <dismukes@gnat.com>
* exp_util.adb:
(Remove_Side_Effects): Condition constantness of object created for a
an unchecked type conversion on the constantness of the expression
to ensure the correct value for 'Constrained when passing components
of view-converted class-wide objects.
2003-11-24 Robert Dewar <dewar@gnat.com>
* par-load.adb (Load): Improve handling of misspelled and missing units
Removes several cases of compilation abandoned messages
* lib.adb: (Remove_Unit): New procedure
* lib.ads: (Remove_Unit): New procedure
* lib-load.adb: Minor reformatting
2003-11-24 Vincent Celier <celier@gnat.com>
* make.adb:
(Gnatmake, Initialize): Call Usage instead of Makeusg directly
(Marking_Label): Label to mark processed source files. Incremented for
each executable.
(Gnatmake): Increase Marking_Labet for each executable
(Is_Marked): Compare against marking label
(Mark): Mark with marking label
2003-11-24 Jerome Guitton <guitton@act-europe.fr>
* s-thread.ads:
Move the declaration of the TSD for System.Threads to System.Soft_Links.
Add some comments.
* Makefile.in: Added target pair for s-thread.adb for cert runtime.
(rts-cert): build a single relocatable object for the run-time lib.
Fix perms.
2003-11-24 Vasiliy Fofanov <fofanov@act-europe.fr>
* Make-lang.in:
Use gnatls rather than gcc to obtain the location of GNAT RTL for
crosstools build.
2003-11-24 Sergey Rybin <rybin@act-europe.fr>
* opt.adb (Tree_Write): Gnat_Version_String is now a function, so we
can not use it as before (that is, as a variable) when dumping it into
the tree file. Add a local variable to store the result of this
function and to be used as the string to be written into the tree.
* scn.adb (Initialize_Scanner): Add comments explaining the recent
changes.
* sinput.adb (Source_First, Source_Last): In case of
Internal_Source_File, replace returning attributes of
Internal_Source_Ptr (which is wrong) with returning attributes of
Internal_Source.
2003-11-24 Ed Schonberg <schonberg@gnat.com>
* sem_ch3.adb:
(New_Concatenation_Op): Proper name for New_Binary_Operator, only
used for implicit concatenation operators.
Code cleanup.
* sem_elab.adb:
(Check_Elab_Call): Set No_Elaboration_Check appropriately on calls in
task bodies that are in the scope of a Suppress pragma.
(Check_A Call): Use the flag to prevent spurious elaboration checks.
* sinfo.ads, sinfo.adb:
New flag No_Elaboration_Check on function/procedure calls, to properly
suppress checks on calls in task bodies that are within a local suppress
pragma.
* exp_ch4.adb:
(Expand_Concatenate_Other): Use the proper integer type for the
expression for the upper bound, to avoid universal_integer computations
when possible.
2003-11-21 Kelley Cook <kcook@gcc.gnu.org>
* .cvsignore: Delete.

4
gcc/ada/Make-lang.in
View File

@ -290,10 +290,10 @@ regnattools:
# use host-gcc host-gnatmake host-gnatbind host-gnatlink
# put the host RTS dir first in the PATH to hide the default runtime
# files that are among the sources
RTS_DIR:=$(dir $(subst \,/,$(shell $(CC) -print-libgcc-file-name)))
RTS_DIR:=$(strip $(subst \,/,$(shell gnatls -v | grep adalib )))
cross-gnattools: force
$(MAKE) -C ada $(FLAGS_TO_PASS) $(ADA_FLAGS_TO_PASS)\
ADA_INCLUDES="-I$(RTS_DIR)adainclude -I$(RTS_DIR)adalib" \
ADA_INCLUDES="-I$(RTS_DIR)../adainclude -I$(RTS_DIR)" \
GNATMAKE="gnatmake" \
GNATBIND="gnatbind" \
GNATLINK="gnatlink" \

16
gcc/ada/Makefile.in
View File

@ -461,6 +461,7 @@ ifeq ($(strip $(filter-out alpha% dec vx%,$(targ))),)
a-numaux.ads<4znumaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-interr.adb<5zinterr.adb \
s-intman.ads<5zintman.ads \
s-intman.adb<5zintman.adb \
s-osinte.adb<5zosinte.adb \
s-osinte.ads<5zosinte.ads \
@ -487,6 +488,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
a-numaux.ads<4znumaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-interr.adb<5zinterr.adb \
s-intman.ads<5zintman.ads \
s-intman.adb<5zintman.adb \
s-osinte.adb<5zosinte.adb \
s-osinte.ads<5zosinte.ads \
@ -524,6 +526,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
a-numaux.ads<4znumaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-interr.adb<5zinterr.adb \
s-intman.ads<5zintman.ads \
s-intman.adb<5zintman.adb \
s-osinte.adb<5zosinte.adb \
s-osinte.ads<5zosinte.ads \
@ -593,6 +596,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
s-soflin.ads<2ssoflin.ads \
s-stalib.adb<1sstalib.adb \
s-stalib.ads<1sstalib.ads \
s-thread.adb<5zthread.adb \
s-thrini.ads<2sthrini.ads \
s-thrini.adb<5zthrini.adb \
s-tiitho.adb<5ztiitho.adb \
@ -619,6 +623,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
a-numaux.ads<4znumaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-interr.adb<5zinterr.adb \
s-intman.ads<5zintman.ads \
s-intman.adb<5zintman.adb \
s-osinte.adb<5zosinte.adb \
s-osinte.ads<5zosinte.ads \
@ -692,7 +697,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
s-soflin.ads<2ssoflin.ads \
s-stalib.adb<1sstalib.adb \
s-stalib.ads<1sstalib.ads \
s-thrini.adb<5zthrini.adb \
s-thread.adb<5zthread.adb \
s-thrini.ads<2sthrini.ads \
s-thrini.adb<5zthrini.adb \
s-tiitho.adb<5ytiitho.adb \
@ -736,6 +741,7 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
a-numaux.ads<4znumaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-interr.adb<5zinterr.adb \
s-intman.ads<5zintman.ads \
s-intman.adb<5zintman.adb \
s-osinte.adb<5zosinte.adb \
s-osinte.ads<5zosinte.ads \
@ -764,6 +770,7 @@ ifeq ($(strip $(filter-out xscale% coff wrs vx%,$(targ))),)
a-numaux.ads<4znumaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-interr.adb<5zinterr.adb \
s-intman.ads<5zintman.ads \
s-intman.adb<5zintman.adb \
s-osinte.adb<5zosinte.adb \
s-osinte.ads<5zosinte.ads \
@ -792,6 +799,7 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
a-numaux.ads<4znumaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-interr.adb<5zinterr.adb \
s-intman.ads<5zintman.ads \
s-intman.adb<5zintman.adb \
s-osinte.adb<5zosinte.adb \
s-osinte.ads<5zosinte.ads \
@ -2055,8 +2063,10 @@ rts-cert: force
../../../$(GCC_FOR_TARGET) -B../../../ $(TARGET_LIBGCC2_CFLAGS) \
$(ALL_CFLAGS) $(GNATLIBCFLAGS_FOR_C) -c ../adainclude/$(f).c \
-I../adainclude $(INCLUDES_FOR_SUBDIR) -I../../../ ;) \
$(AR) $(AR_FLAGS) libgnat$(arext) \
$(addsuffix .o,$(CERT_LEVEL_B_C_FILES))
../../../xgcc -B../../../ *.o -o libgnat ; \
$(CHMOD) a-wx *.ali ; \
$(RM) *.o ; \
$(MV) libgnat libgnat.o
rts-none: force
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \

41
gcc/ada/exp_ch4.adb
View File

@ -1472,7 +1472,7 @@ package body Exp_Ch4 is
-- their base type, Ind_Typ their index type, and Arr_Typ the original
-- array type to which the concatenantion operator applies, then the
-- following subprogram is constructed:
--
-- [function Cnn (S1 : Base_Typ; ...; Sn : Base_Typ) return Base_Typ is
-- L : Ind_Typ;
-- begin
@ -1489,7 +1489,7 @@ package body Exp_Ch4 is
-- else
-- return Sn;
-- end if;
--
-- declare
-- P : Ind_Typ;
-- H : Ind_Typ :=
@ -1516,9 +1516,9 @@ package body Exp_Ch4 is
-- P := Ind_Typ'Succ (P);
-- end loop;
-- end if;
--
-- ...
--
-- if Sn'Length /= 0 then
-- P := Sn'First;
-- loop
@ -1528,7 +1528,7 @@ package body Exp_Ch4 is
-- P := Ind_Typ'Succ (P);
-- end loop;
-- end if;
--
-- return R;
-- end;
-- end Cnn;]
@ -1598,7 +1598,9 @@ package body Exp_Ch4 is
-- Builds reference to identifier L.
function L_Pos return Node_Id;
-- Builds expression Ind_Typ'Pos (L).
-- Builds expression Integer_Type'(Ind_Typ'Pos (L)).
-- We qualify the expression to avoid universal_integer computations
-- whenever possible, in the expression for the upper bound H.
function L_Succ return Node_Id;
-- Builds expression Ind_Typ'Succ (L).
@ -1743,12 +1745,31 @@ package body Exp_Ch4 is
-----------
function L_Pos return Node_Id is
Target_Type : Entity_Id;
begin
-- If the index type is an enumeration type, the computation
-- can be done in standard integer. Otherwise, choose a large
-- enough integer type.
if Is_Enumeration_Type (Ind_Typ)
or else Root_Type (Ind_Typ) = Standard_Integer
or else Root_Type (Ind_Typ) = Standard_Short_Integer
or else Root_Type (Ind_Typ) = Standard_Short_Short_Integer
then
Target_Type := Standard_Integer;
else
Target_Type := Root_Type (Ind_Typ);
end if;
return
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Ind_Typ, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (L));
Make_Qualified_Expression (Loc,
Subtype_Mark => New_Reference_To (Target_Type, Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Ind_Typ, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (L)));
end L_Pos;
------------

2
gcc/ada/exp_util.adb
View File

@ -3510,7 +3510,7 @@ package body Exp_Util is
Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id,
Object_Definition => New_Reference_To (Exp_Type, Loc),
Constant_Present => True,
Constant_Present => not Is_Variable (Exp),
Expression => Relocate_Node (Exp));
Set_Assignment_OK (E);

7
gcc/ada/lib-load.adb
View File

@ -688,14 +688,11 @@ package body Lib.Load is
procedure Make_Instance_Unit (N : Node_Id) is
Sind : constant Source_File_Index := Source_Index (Main_Unit);
begin
Units.Increment_Last;
Units.Table (Units.Last) := Units.Table (Main_Unit);
Units.Table (Units.Last).Cunit := Library_Unit (N);
Units.Table (Units.Last).Generate_Code := True;
Units.Table (Main_Unit).Cunit := N;
Units.Table (Main_Unit).Unit_Name :=
Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
@ -713,7 +710,6 @@ package body Lib.Load is
is
Sunit : constant Node_Id := Cunit (Spec_Unit);
Bunit : constant Node_Id := Cunit (Body_Unit);
begin
-- The spec is irrelevant if the body is a subprogram body, and the
-- spec is other than a subprogram spec or generic subprogram spec.
@ -725,7 +721,6 @@ package body Lib.Load is
Nkind (Unit (Bunit)) = N_Subprogram_Body
and then Nkind (Unit (Sunit)) /= N_Subprogram_Declaration
and then Nkind (Unit (Sunit)) /= N_Generic_Subprogram_Declaration;
end Spec_Is_Irrelevant;
--------------------
@ -735,9 +730,7 @@ package body Lib.Load is
procedure Version_Update (U : Node_Id; From : Node_Id) is
Unum : constant Unit_Number_Type := Get_Cunit_Unit_Number (U);
Fnum : constant Unit_Number_Type := Get_Cunit_Unit_Number (From);
begin
if Source_Index (Fnum) /= No_Source_File then
Units.Table (Unum).Version :=
Units.Table (Unum).Version

11
gcc/ada/lib.adb
View File

@ -870,6 +870,17 @@ package body Lib is
return Int (Units.Last) - Int (Main_Unit) + 1;
end Num_Units;
-----------------
-- Remove_Unit --
-----------------
procedure Remove_Unit (U : Unit_Number_Type) is
begin
if U = Units.Last then
Units.Decrement_Last;
end if;
end Remove_Unit;
----------------------------------
-- Replace_Linker_Option_String --
----------------------------------

4
gcc/ada/lib.ads
View File

@ -417,6 +417,10 @@ package Lib is
function Num_Units return Nat;
-- Number of units currently in unit table
procedure Remove_Unit (U : Unit_Number_Type);
-- Remove unit U from unit table. Currently this is effective only
-- if U is the last unit currently stored in the unit table.
function Entity_Is_In_Main_Unit (E : Entity_Id) return Boolean;
-- Returns True if the entity E is declared in the main unit, or, in
-- its corresponding spec, or one of its subunits. Entities declared

50
gcc/ada/make.adb
View File

@ -24,12 +24,6 @@
-- --
------------------------------------------------------------------------------
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Case_Util; use GNAT.Case_Util;
with ALI; use ALI;
with ALI.Util; use ALI.Util;
with Csets;
@ -65,6 +59,12 @@ with System.HTable;
with Targparm;
with Tempdir;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Case_Util; use GNAT.Case_Util;
package body Make is
use ASCII;
@ -480,6 +480,9 @@ package body Make is
-- Marking Routines --
----------------------
Marking_Label : Byte := 1;
-- Value to mark the source files
procedure Mark (Source_File : File_Name_Type);
-- Mark Source_File. Marking is used to signal that Source_File has
-- already been inserted in the Q.
@ -2233,7 +2236,9 @@ package body Make is
-------------
function Compile
(S : Name_Id; L : Name_Id; Args : Argument_List) return Process_Id
(S : Name_Id;
L : Name_Id;
Args : Argument_List) return Process_Id
is
Comp_Args : Argument_List (Args'First .. Args'Last + 8);
Comp_Next : Integer := Args'First;
@ -3692,7 +3697,7 @@ package body Make is
else
-- Output usage information if no files to compile
Makeusg;
Usage;
Exit_Program (E_Fatal);
end if;
end if;
@ -4228,6 +4233,18 @@ package body Make is
Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
-- Increase the marking label to be sure to check sources
-- for all executables.
Marking_Label := Marking_Label + 1;
-- Make sure it is not 0, which is the default value for
-- a file that has never been marked.
if Marking_Label = 0 then
Marking_Label := 1;
end if;
-- First, find the executable name and path
Executable := No_File;
@ -5573,7 +5590,7 @@ package body Make is
end loop Scan_Args;
if Usage_Requested then
Makeusg;
Usage;
end if;
-- Test for trailing -P switch
@ -5695,6 +5712,10 @@ package body Make is
Make_Failed (Exception_Message (Err));
end;
end if;
-- Set the marking label to a value that is not zero
Marking_Label := 1;
end Initialize;
-----------------------------------
@ -5707,10 +5728,11 @@ package body Make is
Into_Q : Boolean)
is
Put_In_Q : Boolean := Into_Q;
Unit : Com.Unit_Data;
Sfile : Name_Id;
Unit : Com.Unit_Data;
Sfile : Name_Id;
Extending : constant Boolean :=
Projects.Table (The_Project).Extends /= No_Project;
Projects.Table (The_Project).Extends /= No_Project;
function Check_Project (P : Project_Id) return Boolean;
-- Returns True if P is The_Project or a project extended by
@ -6044,7 +6066,7 @@ package body Make is
function Is_Marked (Source_File : File_Name_Type) return Boolean is
begin
return Get_Name_Table_Byte (Source_File) /= 0;
return Get_Name_Table_Byte (Source_File) = Marking_Label;
end Is_Marked;
----------
@ -6228,7 +6250,7 @@ package body Make is
procedure Mark (Source_File : File_Name_Type) is
begin
Set_Name_Table_Byte (Source_File, 1);
Set_Name_Table_Byte (Source_File, Marking_Label);
end Mark;
--------------------

7
gcc/ada/opt.adb
View File

@ -186,6 +186,7 @@ package body Opt is
----------------
procedure Tree_Write is
Version_String : String := Gnat_Version_String;
begin
Tree_Write_Int (ASIS_Version_Number);
Tree_Write_Bool (Brief_Output);
@ -202,9 +203,9 @@ package body Opt is
Tree_Write_Bool (Assertions_Enabled);
Tree_Write_Bool (Enable_Overflow_Checks);
Tree_Write_Bool (Full_List);
Tree_Write_Int (Int (Gnat_Version_String'Length));
Tree_Write_Data (Gnat_Version_String'Address,
Gnat_Version_String'Length);
Tree_Write_Int (Int (Version_String'Length));
Tree_Write_Data (Version_String'Address,
Version_String'Length);
Tree_Write_Data (Distribution_Stub_Mode'Address,
Distribution_Stub_Mode_Type'Object_Size / Storage_Unit);
Tree_Write_Bool (Immediate_Errors);

60
gcc/ada/par-load.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2003 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- --
@ -42,6 +42,8 @@ with Sinput.L; use Sinput.L;
with Stylesw; use Stylesw;
with Validsw; use Validsw;
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
separate (Par)
procedure Load is
@ -188,26 +190,45 @@ begin
or else
Name_Buffer (1) = 'g')
then
-- In the predefined file case, we know the user did not construct
-- their own package, but we got the wrong one. This means that the
-- name supplied by the user crunched to something we recognized,
-- but then the file did not contain the unit expected. Most likely
-- this is due to a misspelling, e.g.
declare
Expect_Name : constant Name_Id := Expected_Unit (Cur_Unum);
Actual_Name : constant Name_Id := Unit_Name (Cur_Unum);
-- with Ada.Calender;
begin
Error_Msg_Name_1 := Expect_Name;
Error_Msg ("% is not a predefined library unit!", Loc);
-- This crunches to a-calend, which indeed contains the unit
-- Ada.Calendar, and we can diagnose the misspelling. This is
-- a simple heuristic, but it catches many common cases of
-- misspelling of predefined unit names without needing a full
-- list of them.
-- In the predefined file case, we know the user did not
-- construct their own package, but we got the wrong one.
-- This means that the name supplied by the user crunched
-- to something we recognized, but then the file did not
-- contain the unit expected. Most likely this is due to
-- a misspelling, e.g.
Error_Msg_Name_1 := Expected_Unit (Cur_Unum);
Error_Msg ("% is not a predefined library unit!", Loc);
Error_Msg_Name_1 := Unit_Name (Cur_Unum);
Error_Msg ("possible misspelling of %!", Loc);
-- with Ada.Calender;
-- Non-predefined file name case
-- This crunches to a-calend, which indeed contains the unit
-- Ada.Calendar, and we can diagnose the misspelling. This
-- is a simple heuristic, but it catches many common cases
-- of misspelling of predefined unit names without needing
-- a full list of them.
-- Before actually issinying the message, we will check that the
-- unit name is indeed a plausible misspelling of the one we got.
if Is_Bad_Spelling_Of
(Found => Get_Name_String (Expect_Name),
Expect => Get_Name_String (Actual_Name))
then
Error_Msg_Name_1 := Actual_Name;
Error_Msg ("possible misspelling of %!", Loc);
end if;
end;
-- Non-predefined file name case. In this case we generate a message
-- and then we quit, because we are in big trouble, and if we try
-- to continue compilation, we get into some nasty situations
-- (for example in some subunit cases).
else
Error_Msg ("file { does not contain expected unit!", Loc);
@ -217,7 +238,10 @@ begin
Error_Msg ("found unit $!", Loc);
end if;
raise Unrecoverable_Error;
-- In both cases, remove the unit if it is the last unit (which it
-- normally (always?) will be) so that it is out of the way later.
Remove_Unit (Cur_Unum);
end if;
-- If current unit is a body, load its corresponding spec

27
gcc/ada/s-thread.ads
View File

@ -38,6 +38,10 @@
-- VxWorks AE653 with the restricted / cert runtime
with Ada.Exceptions;
-- used for Exception_Occurrence
with System.Soft_Links;
-- used for TSD
package System.Threads is
@ -137,27 +141,6 @@ package System.Threads is
private
------------------------
-- Task Specific Data --
------------------------
type ATSD is limited record
Jmpbuf_Address : Address := Null_Address;
-- Address of jump buffer used to store the address of the
-- current longjmp/setjmp buffer for exception management.
-- These buffers are threaded into a stack, and the address
-- here is the top of the stack. A null address means that
-- no exception handler is currently active.
Sec_Stack_Addr : Address := Null_Address;
-- Address of currently allocated secondary stack
Current_Excep : aliased EO;
-- Exception occurrence that contains the information for the
-- current exception. Note that any exception in the same task
-- destroys this information, so the data in this variable must
-- be copied out before another exception can occur.
end record;
type ATSD is new System.Soft_Links.TSD;
end System.Threads;

14
gcc/ada/scn.adb
View File

@ -261,7 +261,9 @@ package body Scn is
begin
Scanner.Initialize_Scanner (Unit, Index);
-- Set default for Comes_From_Source. All nodes built now until we
-- Set default for Comes_From_Source (except if we are going to process
-- an artificial string internally created within the compiler and
-- placed into internal source duffer). All nodes built now until we
-- reenter the analyzer will have Comes_From_Source set to True
if Index /= Internal_Source_File then
@ -280,6 +282,16 @@ package body Scn is
-- call Scan. Scan initial token (note this initializes Prev_Token,
-- Prev_Token_Ptr).
-- There are two reasons not to do the Scan step in case if we
-- initialize the scanner for the internal source buffer:
-- - The artificial string may not be created by the compiler in this
-- buffer when we call Initialize_Scanner
-- - For these artificial strings a special way of scanning is used, so
-- the standard step of the scanner may just break the algorithm of
-- processing these strings.
if Index /= Internal_Source_File then
Scan;
end if;

26
gcc/ada/sem_ch3.adb
View File

@ -548,9 +548,9 @@ package body Sem_Ch3 is
-- Create new modular type. Verify that modulus is in bounds and is
-- a power of two (implementation restriction).
procedure New_Binary_Operator (Op_Name : Name_Id; Typ : Entity_Id);
procedure New_Concatenation_Op (Typ : Entity_Id);
-- Create an abbreviated declaration for an operator in order to
-- materialize minimally operators on derived types.
-- materialize concatenation on array types.
procedure Ordinary_Fixed_Point_Type_Declaration
(T : Entity_Id;
@ -2865,7 +2865,7 @@ package body Sem_Ch3 is
if Number_Dimensions (T) = 1
and then not Is_Packed_Array_Type (T)
then
New_Binary_Operator (Name_Op_Concat, T);
New_Concatenation_Op (T);
end if;
-- In the case of an unconstrained array the parser has already
@ -3068,7 +3068,7 @@ package body Sem_Ch3 is
and then not Is_Derived_Type (Parent_Type)
and then not Is_Package (Scope (Base_Type (Parent_Type)))
then
New_Binary_Operator (Name_Op_Concat, Derived_Type);
New_Concatenation_Op (Derived_Type);
end if;
end Build_Derived_Array_Type;
@ -10945,11 +10945,11 @@ package body Sem_Ch3 is
end Modular_Type_Declaration;
-------------------------
-- New_Binary_Operator --
-------------------------
--------------------------
-- New_Concatenation_Op --
--------------------------
procedure New_Binary_Operator (Op_Name : Name_Id; Typ : Entity_Id) is
procedure New_Concatenation_Op (Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
Op : Entity_Id;
@ -10971,26 +10971,26 @@ package body Sem_Ch3 is
return Formal;
end Make_Op_Formal;
-- Start of processing for New_Binary_Operator
-- Start of processing for New_Concatenation_Op
begin
Op := Make_Defining_Operator_Symbol (Loc, Op_Name);
Op := Make_Defining_Operator_Symbol (Loc, Name_Op_Concat);
Set_Ekind (Op, E_Operator);
Set_Scope (Op, Current_Scope);
Set_Etype (Op, Typ);
Set_Homonym (Op, Get_Name_Entity_Id (Op_Name));
Set_Homonym (Op, Get_Name_Entity_Id (Name_Op_Concat));
Set_Is_Immediately_Visible (Op);
Set_Is_Intrinsic_Subprogram (Op);
Set_Has_Completion (Op);
Append_Entity (Op, Current_Scope);
Set_Name_Entity_Id (Op_Name, Op);
Set_Name_Entity_Id (Name_Op_Concat, Op);
Append_Entity (Make_Op_Formal (Typ, Op), Op);
Append_Entity (Make_Op_Formal (Typ, Op), Op);
end New_Binary_Operator;
end New_Concatenation_Op;
-------------------------------------------
-- Ordinary_Fixed_Point_Type_Declaration --

83
gcc/ada/sem_elab.adb
View File

@ -325,6 +325,16 @@ package body Sem_Elab is
-- we ignore this flag.
begin
-- If the call is known to be within a local Suppress Elaboration
-- pragma, nothing to check. This can happen in task bodies.
if (Nkind (N) = N_Function_Call
or else Nkind (N) = N_Procedure_Call_Statement)
and then No_Elaboration_Check (N)
then
return;
end if;
-- Go to parent for derived subprogram, or to original subprogram
-- in the case of a renaming (Alias covers both these cases)
@ -826,10 +836,41 @@ package body Sem_Elab is
(N : Node_Id;
Outer_Scope : Entity_Id := Empty)
is
Nam : Node_Id;
Ent : Entity_Id;
P : Node_Id;
function Get_Called_Ent return Entity_Id;
-- Retrieve called entity. If this is a call to a protected subprogram,
-- entity is a selected component. The callable entity may be absent,
-- in which case there is no check to perform. This happens with
-- non-analyzed calls in nested generics.
--------------------
-- Get_Called_Ent --
--------------------
function Get_Called_Ent return Entity_Id is
Nam : Node_Id;
begin
Nam := Name (N);
if No (Nam) then
return Empty;
elsif Nkind (Nam) = N_Selected_Component then
return Entity (Selector_Name (Nam));
elsif not Is_Entity_Name (Nam) then
return Empty;
else
return Entity (Nam);
end if;
end Get_Called_Ent;
-- Start of processing for Check_Elab_Call
begin
-- For an entry call, check relevant restriction
@ -1014,6 +1055,26 @@ package body Sem_Elab is
exit;
elsif Nkind (P) = N_Task_Body then
-- The check is deferred until Check_Task_Activation
-- but we need to capture local suppress pragmas
-- that may inhibit checks on this call.
Ent := Get_Called_Ent;
if No (Ent) then
return;
elsif Elaboration_Checks_Suppressed (Current_Scope)
or else Elaboration_Checks_Suppressed (Ent)
or else Elaboration_Checks_Suppressed (Scope (Ent))
then
Set_No_Elaboration_Check (N);
end if;
return;
-- Static model, call is not in elaboration code, we
-- never need to worry, because in the static model
-- the top level caller always takes care of things.
@ -1027,25 +1088,7 @@ package body Sem_Elab is
end if;
end if;
-- Retrieve called entity. If this is a call to a protected subprogram,
-- the entity is a selected component.
-- The callable entity may be absent, in which case there is nothing
-- to do. This happens with non-analyzed calls in nested generics.
Nam := Name (N);
if No (Nam) then
return;
elsif Nkind (Nam) = N_Selected_Component then
Ent := Entity (Selector_Name (Nam));
elsif not Is_Entity_Name (Nam) then
return;
else
Ent := Entity (Nam);
end if;
Ent := Get_Called_Ent;
if No (Ent) then
return;

18
gcc/ada/sinfo.adb
View File

@ -1764,6 +1764,15 @@ package body Sinfo is
return Flag7 (N);
end No_Ctrl_Actions;
function No_Elaboration_Check
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Function_Call
or else NT (N).Nkind = N_Procedure_Call_Statement);
return Flag14 (N);
end No_Elaboration_Check;
function No_Entities_Ref_In_Spec
(N : Node_Id) return Boolean is
begin
@ -4187,6 +4196,15 @@ package body Sinfo is
Set_Flag7 (N, Val);
end Set_No_Ctrl_Actions;
procedure Set_No_Elaboration_Check
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Function_Call
or else NT (N).Nkind = N_Procedure_Call_Statement);
Set_Flag14 (N, Val);
end Set_No_Elaboration_Check;
procedure Set_No_Entities_Ref_In_Spec
(N : Node_Id; Val : Boolean := True) is
begin

17
gcc/ada/sinfo.ads
View File

@ -1266,6 +1266,13 @@ package Sinfo is
-- where the generated assignments are more initialisations than real
-- assignments.
-- No_Elaboration_Check (Flag14-Sem)
-- Present in N_Function_Call and N_Procedure_Call_Statement. Indicates
-- that no elaboration check is needed on the call, because it appears
-- in the context of a local Suppress pragma. This is used on calls
-- within task bodies, where the actual elaboration checks are applied
-- after analysis, when the local scope stack is not present.
-- No_Entities_Ref_In_Spec (Flag8-Sem)
-- Present in N_With_Clause nodes. Set if the with clause is on the
-- package or subprogram spec where the main unit is the corresponding
@ -4043,6 +4050,7 @@ package Sinfo is
-- First_Named_Actual (Node4-Sem)
-- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
-- Do_Tag_Check (Flag13-Sem)
-- No_Elaboration_Check (Flag14-Sem)
-- Parameter_List_Truncated (Flag17-Sem)
-- ABE_Is_Certain (Flag18-Sem)
-- plus fields for expression
@ -4073,6 +4081,7 @@ package Sinfo is
-- First_Named_Actual (Node4-Sem)
-- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
-- Do_Tag_Check (Flag13-Sem)
-- No_Elaboration_Check (Flag14-Sem)
-- Parameter_List_Truncated (Flag17-Sem)
-- ABE_Is_Certain (Flag18-Sem)
-- plus fields for expression
@ -7391,6 +7400,9 @@ package Sinfo is
function No_Ctrl_Actions
(N : Node_Id) return Boolean; -- Flag7
function No_Elaboration_Check
(N : Node_Id) return Boolean; -- Flag14
function No_Entities_Ref_In_Spec
(N : Node_Id) return Boolean; -- Flag8
@ -8165,6 +8177,9 @@ package Sinfo is
procedure Set_No_Ctrl_Actions
(N : Node_Id; Val : Boolean := True); -- Flag7
procedure Set_No_Elaboration_Check
(N : Node_Id; Val : Boolean := True); -- Flag14
procedure Set_No_Entities_Ref_In_Spec
(N : Node_Id; Val : Boolean := True); -- Flag8
@ -8600,6 +8615,7 @@ package Sinfo is
pragma Inline (Next_Rep_Item);
pragma Inline (Next_Use_Clause);
pragma Inline (No_Ctrl_Actions);
pragma Inline (No_Elaboration_Check);
pragma Inline (No_Entities_Ref_In_Spec);
pragma Inline (No_Initialization);
pragma Inline (No_Truncation);
@ -8854,6 +8870,7 @@ package Sinfo is
pragma Inline (Set_Next_Named_Actual);
pragma Inline (Set_Next_Use_Clause);
pragma Inline (Set_No_Ctrl_Actions);
pragma Inline (Set_No_Elaboration_Check);
pragma Inline (Set_No_Entities_Ref_In_Spec);
pragma Inline (Set_No_Initialization);
pragma Inline (Set_No_Truncation);

4
gcc/ada/sinput.adb
View File

@ -1111,7 +1111,7 @@ package body Sinput is
function Source_First (S : SFI) return Source_Ptr is
begin
if S = Internal_Source_File then
return Internal_Source_Ptr'First;
return Internal_Source'First;
else
return Source_File.Table (S).Source_First;
end if;
@ -1120,7 +1120,7 @@ package body Sinput is
function Source_Last (S : SFI) return Source_Ptr is
begin
if S = Internal_Source_File then
return Internal_Source_Ptr'Last;
return Internal_Source'Last;
else
return Source_File.Table (S).Source_Last;
end if;