Commit efdfd311 by Arnaud Charlet

[multiple changes]

2003-12-03  Thomas Quinot  <quinot@act-europe.fr>

	PR ada/11724

	* adaint.h, adaint.c, g-os_lib.ads:
	Do not assume that the offset argument to lseek(2) is a 32 bit integer,
	on some platforms (including FreeBSD), it is a 64 bit value.
	Introduce a __gnat_lseek wrapper in adaint.c to allow for portability.

2003-12-03  Arnaud Charlet  <charlet@act-europe.fr>

	* gnatvsn.ads (Library_Version): Now contain only the relevant
	version info.
	(Verbose_Library_Version): New constant.

	* g-spipat.adb, g-awk.adb, g-debpoo.adb,
	g-memdum.adb, g-thread.adb, s-geveop.adb, s-interr.adb,
	s-taskin.adb, s-tassta.adb: Make code compile with -gnatwa.

	* gnatlbr.adb: Clean up: replace Library_Version by
	Verbose_Library_Version.

	* make.adb, lib-writ.adb, exp_attr.adb:
	Clean up: replace Library_Version by Verbose_Library_Version.

	* 5lintman.adb: Removed.

	* Makefile.in:
	Update and simplify computation of LIBRARY_VERSION.
	Fix computation of GSMATCH_VERSION.
	5lintman.adb is no longer used: replaced by 7sintman.adb.

2003-12-03  Robert Dewar  <dewar@gnat.com>

	* exp_ch5.adb:
	(Possible_Bit_Aligned_Component): Maybe_Bit_Aligned_Large_Component new
	name. Modified to consider small non-bit-packed arrays as troublesome
	and in need of component-by-component assigment expansion.

2003-12-03  Vincent Celier  <celier@gnat.com>

	* lang-specs.h: Process nostdlib as nostdinc

	* back_end.adb: Update Copyright notice
	(Scan_Compiler_Arguments): Process -nostdlib directly.

2003-12-03  Jose Ruiz  <ruiz@act-europe.fr>

	* Makefile.in:
	When defining LIBGNAT_TARGET_PAIRS for bare board targets, remove the
	redundant inclusion of EXTRA_HIE_NONE_TARGET_PAIRS, which is always
	included in HIE_NONE_TARGET_PAIRS.

2003-12-03  Ed Schonberg  <schonberg@gnat.com>

	* sem_attr.adb:
	(Legal_Formal_Attribute): Attribute is legal in an inlined body, as it
	is legal in an instance, because legality is cheched in the template.

	* sem_prag.adb:
	(Analyze_Pragma, case Warnings): In an inlined body, the pragma may be
	appplied to an unchecked conversion of a formal parameter.

	* sem_warn.adb:
	(Output_Unreferenced_Messages): Suppress "not read" warnings on imported
	variables.

2003-12-03  Olivier Hainque  <hainque@act-europe.fr>

	* tb-alvms.c (unwind_regular_code, unwind_kernel_handler): New
	routines. The second one is new functionality to deal with backtracing
	through signal handlers.
	(unwind): Split into the two separate subroutines above.
	Update the documentation, and deal properly with sizeof (REG) different
	from sizeof (void*).

From-SVN: r74226
parent 1fcc57f1
2003-12-03 Thomas Quinot <quinot@act-europe.fr>
PR ada/11724
* adaint.h, adaint.c, g-os_lib.ads:
Do not assume that the offset argument to lseek(2) is a 32 bit integer,
on some platforms (including FreeBSD), it is a 64 bit value.
Introduce a __gnat_lseek wrapper in adaint.c to allow for portability.
2003-12-03 Arnaud Charlet <charlet@act-europe.fr>
* gnatvsn.ads (Library_Version): Now contain only the relevant
version info.
(Verbose_Library_Version): New constant.
* g-spipat.adb, g-awk.adb, g-debpoo.adb,
g-memdum.adb, g-thread.adb, s-geveop.adb, s-interr.adb,
s-taskin.adb, s-tassta.adb: Make code compile with -gnatwa.
* gnatlbr.adb: Clean up: replace Library_Version by
Verbose_Library_Version.
* make.adb, lib-writ.adb, exp_attr.adb:
Clean up: replace Library_Version by Verbose_Library_Version.
* 5lintman.adb: Removed.
* Makefile.in:
Update and simplify computation of LIBRARY_VERSION.
Fix computation of GSMATCH_VERSION.
5lintman.adb is no longer used: replaced by 7sintman.adb.
2003-12-03 Robert Dewar <dewar@gnat.com>
* exp_ch5.adb:
(Possible_Bit_Aligned_Component): Maybe_Bit_Aligned_Large_Component new
name. Modified to consider small non-bit-packed arrays as troublesome
and in need of component-by-component assigment expansion.
2003-12-03 Vincent Celier <celier@gnat.com>
* lang-specs.h: Process nostdlib as nostdinc
* back_end.adb: Update Copyright notice
(Scan_Compiler_Arguments): Process -nostdlib directly.
2003-12-03 Jose Ruiz <ruiz@act-europe.fr>
* Makefile.in:
When defining LIBGNAT_TARGET_PAIRS for bare board targets, remove the
redundant inclusion of EXTRA_HIE_NONE_TARGET_PAIRS, which is always
included in HIE_NONE_TARGET_PAIRS.
2003-12-03 Ed Schonberg <schonberg@gnat.com>
* sem_attr.adb:
(Legal_Formal_Attribute): Attribute is legal in an inlined body, as it
is legal in an instance, because legality is cheched in the template.
* sem_prag.adb:
(Analyze_Pragma, case Warnings): In an inlined body, the pragma may be
appplied to an unchecked conversion of a formal parameter.
* sem_warn.adb:
(Output_Unreferenced_Messages): Suppress "not read" warnings on imported
variables.
2003-12-03 Olivier Hainque <hainque@act-europe.fr>
* tb-alvms.c (unwind_regular_code, unwind_kernel_handler): New
routines. The second one is new functionality to deal with backtracing
through signal handlers.
(unwind): Split into the two separate subroutines above.
Update the documentation, and deal properly with sizeof (REG) different
from sizeof (void*).
2003-12-01 Nicolas Setton <setton@act-europe.fr>
* a-except.adb (Raise_Current_Excep): Add a pragma Inspection_Point,
......
......@@ -375,6 +375,8 @@ PREFIX_REAL_OBJS = ../prefix.o \
../../libiberty/xstrdup.o \
../../libiberty/xexit.o
LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(fsrcpfx)gnatvsn.ads | sed -e 's/.*"\(.*\)".*/\1/'))
# $(filter-out PATTERN...,TEXT) removes all PATTERN words from TEXT.
# $(strip STRING) removes leading and trailing spaces from STRING.
# If what's left is null then it's a match.
......@@ -450,7 +452,7 @@ ifeq ($(strip $(filter-out %86 sysv5uw%,$(arch) $(osys))),)
PREFIX_OBJS=$(PREFIX_REAL_OBJS)
SO_OPTS = -Wl,-h,
GNATLIB_SHARED = gnatlib-shared-dual
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out alpha% dec vx%,$(targ))),)
......@@ -692,8 +694,7 @@ ifeq ($(strip $(filter-out powerpc% unknown elf,$(targ))),)
system.ads<59system.ads
LIBGNAT_TARGET_PAIRS = \
$(HIE_NONE_TARGET_PAIRS) \
$(EXTRA_HIE_NONE_TARGET_PAIRS)
$(HIE_NONE_TARGET_PAIRS)
endif
ifeq ($(strip $(filter-out sparc% unknown elf,$(targ))),)
......@@ -701,8 +702,7 @@ ifeq ($(strip $(filter-out sparc% unknown elf,$(targ))),)
system.ads<5rsystem.ads
LIBGNAT_TARGET_PAIRS = \
$(HIE_NONE_TARGET_PAIRS) \
$(EXTRA_HIE_NONE_TARGET_PAIRS)
$(HIE_NONE_TARGET_PAIRS)
endif
ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
......@@ -819,7 +819,7 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),)
GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \
......@@ -903,7 +903,7 @@ ifeq ($(strip $(filter-out %86 solaris2%,$(arch) $(osys))),)
SO_OPTS = -Wl,-h,
GNATLIB_SHARED = gnatlib-shared-dual
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
......@@ -912,7 +912,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
a-numaux.adb<86numaux.adb \
a-numaux.ads<86numaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-intman.adb<5lintman.adb \
s-intman.adb<7sintman.adb \
s-mastop.adb<5omastop.adb \
s-osinte.adb<5iosinte.adb \
s-osinte.ads<5iosinte.ads \
......@@ -929,7 +929,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \
......@@ -937,7 +937,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
a-numaux.adb<86numaux.adb \
a-numaux.ads<86numaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-intman.adb<5lintman.adb \
s-intman.adb<7sintman.adb \
s-mastop.adb<5omastop.adb \
s-osinte.adb<7sosinte.adb \
s-osinte.ads<5losinte.ads \
......@@ -967,7 +967,7 @@ ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
system.ads<56system.ads
THREADSLIB=
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out mips sgi irix%,$(targ))),)
......@@ -1021,7 +1021,7 @@ ifeq ($(strip $(filter-out mips sgi irix%,$(targ))),)
MISCLIB = -lexc
SO_OPTS = -Wl,-all,-set_version,sgi1.0,-update_registry,../so_locations,-soname,
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out hppa% hp hpux10%,$(targ))),)
......@@ -1069,7 +1069,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(targ))),)
SO_OPTS = -Wl,+h,
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
GNATLIB_SHARED = gnatlib-shared-dual
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
ifeq ($(strip $(filter-out dce DCE,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \
......@@ -1220,7 +1220,7 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
THREADSLIB = -lpthread -lmach -lexc -lrt
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
GNATLIB_SHARED = gnatlib-shared-default
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(host))),)
......@@ -1290,8 +1290,7 @@ endif
../../gnatlbr$(exeext) \
,,/../gnatsym$(exeext)
# This command transforms (YYYYMMDD) into YY,MMDD
GSMATCH_VERSION := $(shell grep "^ *Gnat_Version_String" $(fsrcpfx)gnatvsn.ads | sed -e 's/.*(\(.*\)).*/\1/' -e 's/\(..\)\(..\)\(....\)/\2,\3/')
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/' -e 's/\./_/g'))
GSMATCH_VERSION := $(shell grep "^ *Gnat_Static_Version_String" $(fsrcpfx)gnatvsn.ads | sed -e 's/.*(\(.*\)).*/\1/' -e 's/\(..\)\(..\)\(....\)/\2,\3/')
TOOLS_LIBS_LO := --for-linker=sys\\$$\$$library:trace.exe
endif
......@@ -1328,14 +1327,14 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
EXTRA_GNATRTL_NONTASKING_OBJS = g-regist.o
soext = .dll
GNATLIB_SHARED = gnatlib-shared-win32
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<4lintnam.ads \
s-inmaop.adb<7sinmaop.adb \
s-intman.adb<5lintman.adb \
s-intman.adb<7sintman.adb \
s-osinte.ads<5iosinte.ads \
s-osinte.adb<5iosinte.adb \
s-osprim.adb<7sosprim.adb \
......@@ -1349,14 +1348,14 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual
PREFIX_OBJS=$(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<4lintnam.ads \
s-inmaop.adb<7sinmaop.adb \
s-intman.adb<5lintman.adb \
s-intman.adb<7sintman.adb \
s-osinte.ads<5iosinte.ads \
s-osinte.adb<5iosinte.adb \
s-osprim.adb<7sosprim.adb \
......@@ -1370,7 +1369,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual
PREFIX_OBJS=$(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
LIBRARY_VERSION := $(LIB_VERSION)
endif
# The runtime library for gnat comprises two directories. One contains the
......
......@@ -2481,3 +2481,9 @@ __gnatlib_install_locks (void (*lock) (void) ATTRIBUTE_UNUSED,
a no-op in this case. */
#endif
}
int
__gnat_lseek (int fd, long offset, int whence)
{
return (int) lseek (fd, offset, whence);
}
......@@ -140,6 +140,7 @@ extern int __gnat_expect_poll (int *, int, int, int *);
extern void __gnat_set_binary_mode (int);
extern void __gnat_set_text_mode (int);
extern char *__gnat_ttyname (int);
extern int __gnat_lseek (int, long, int);
#ifdef __MINGW32__
extern void __gnat_plist_init (void);
......
......@@ -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- --
......@@ -270,6 +270,12 @@ package body Back_End is
Opt.No_Stdinc := True;
Scan_Back_End_Switches (Argv);
-- We must recognize -nostdlib to suppress visibility on the
-- standard GNAT RTL objects.
elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
Opt.No_Stdlib := True;
elsif Is_Front_End_Switch (Argv) then
Scan_Front_End_Switches (Argv);
......
......@@ -907,8 +907,9 @@ package body Exp_Attr is
if Pent = Standard_Standard
or else Pent = Standard_ASCII
then
Name_Buffer (1 .. Library_Version'Length) := Library_Version;
Name_Len := Library_Version'Length;
Name_Buffer (1 .. Verbose_Library_Version'Length) :=
Verbose_Library_Version;
Name_Len := Verbose_Library_Version'Length;
Rewrite (N,
Make_String_Literal (Loc,
Strval => String_From_Name_Buffer));
......
......@@ -95,24 +95,6 @@ package body Exp_Ch5 is
-- either because the target is not byte aligned, or there is a change
-- of representation.
function Maybe_Bit_Aligned_Large_Component (N : Node_Id) return Boolean;
-- This function is used in processing the assignment of a record or
-- indexed component. The back end can handle such assignments fine
-- if the objects involved are small (64-bits) or are both aligned on
-- a byte boundary (starts on a byte, and ends on a byte). However,
-- problems arise for large components that are not byte aligned,
-- since the assignment may clobber other components that share bit
-- positions in the starting or ending bytes, and in the case of
-- components not starting on a byte boundary, the back end cannot
-- even manage to extract the value. This function is used to detect
-- such situations, so that the assignment can be handled component-wise.
-- A value of False means that either the object is known to be greater
-- than 64 bits, or that it is known to be byte aligned (and occupy an
-- integral number of bytes. True is returned if the object is known to
-- be greater than 64 bits, and is known to be unaligned. As implied
-- by the name, the result is conservative, in that if the compiler
-- cannot determine these conditions at compile time, True is returned.
function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;
-- Generate the necessary code for controlled and Tagged assignment,
-- that is to say, finalization of the target before, adjustement of
......@@ -120,13 +102,41 @@ package body Exp_Ch5 is
-- pointers which are not 'part of the value' and must not be changed
-- upon assignment. N is the original Assignment node.
function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean;
-- This function is used in processing the assignment of a record or
-- indexed component. The back end can handle such assignments fine
-- if the objects involved are small (64-bits or less) records or
-- scalar items (including bit-packed arrays represented with modular
-- types) or are both aligned on a byte boundary (starting on a byte
-- boundary, and occupying an integral number of bytes).
--
-- However, problems arise for records larger than 64 bits, or for
-- arrays (other than bit-packed arrays represented with a modular
-- type) if the component starts on a non-byte boundary, or does
-- not occupy an integral number of bytes (i.e. there are some bits
-- possibly shared with fields at the start or beginning of the
-- component). The back end cannot handle loading and storing such
-- components in a single operation.
--
-- This function is used to detect the troublesome situation. it is
-- conservative in the sense that it produces True unless it knows
-- for sure that the component is safe (as outlined in the first
-- paragraph above). The code generation for record and array
-- assignment checks for trouble using this function, and if so
-- the assignment is generated component-wise, which the back end
-- is required to handle correctly.
--
-- Note that in GNAT 3, the back end will reject such components
-- anyway, so the hard work in checking for this case is wasted
-- in GNAT 3, but it's harmless, so it is easier to do it in
-- all cases, rather than conditionalize it in GNAT 5 or beyond.
------------------------------
-- Change_Of_Representation --
------------------------------
function Change_Of_Representation (N : Node_Id) return Boolean is
Rhs : constant Node_Id := Expression (N);
begin
return
Nkind (Rhs) = N_Type_Conversion
......@@ -372,9 +382,9 @@ package body Exp_Ch5 is
-- We require a loop if the left side is possibly bit unaligned
elsif Maybe_Bit_Aligned_Large_Component (Lhs)
elsif Possible_Bit_Aligned_Component (Lhs)
or else
Maybe_Bit_Aligned_Large_Component (Rhs)
Possible_Bit_Aligned_Component (Rhs)
then
Loop_Required := True;
......@@ -1026,9 +1036,9 @@ package body Exp_Ch5 is
-- clobbering of other components sharing bits in the first or
-- last byte of the component to be assigned.
elsif Maybe_Bit_Aligned_Large_Component (Lhs)
elsif Possible_Bit_Aligned_Component (Lhs)
or
Maybe_Bit_Aligned_Large_Component (Rhs)
Possible_Bit_Aligned_Component (Rhs)
then
null;
......@@ -3221,11 +3231,11 @@ package body Exp_Ch5 is
return Empty_List;
end Make_Tag_Ctrl_Assignment;
---------------------------------------
-- Maybe_Bit_Aligned_Large_Component --
---------------------------------------
------------------------------------
-- Possible_Bit_Aligned_Component --
------------------------------------
function Maybe_Bit_Aligned_Large_Component (N : Node_Id) return Boolean is
function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean is
begin
case Nkind (N) is
......@@ -3250,7 +3260,7 @@ package body Exp_Ch5 is
-- indexing from a possibly unaligned component.
else
return Maybe_Bit_Aligned_Large_Component (P);
return Possible_Bit_Aligned_Component (P);
end if;
end;
......@@ -3268,17 +3278,22 @@ package body Exp_Ch5 is
-- only the recursive test on the prefix.
if No (Component_Clause (Comp)) then
return Maybe_Bit_Aligned_Large_Component (P);
return Possible_Bit_Aligned_Component (P);
-- Otherwise we have a component clause, which means that
-- the Esize and Normalized_First_Bit fields are set and
-- contain static values known at compile time.
else
-- If we know the size is 64 bits or less we are fine
-- since the back end always handles small fields right.
if Esize (Comp) <= 64 then
-- If we know that we have a small (64 bits or less) record
-- or bit-packed array, then everything is fine, since the
-- back end can handle these cases correctly.
if Esize (Comp) <= 64
and then (Is_Record_Type (Etype (Comp))
or else
Is_Bit_Packed_Array (Etype (Comp)))
then
return False;
-- Otherwise if the component is not byte aligned, we
......@@ -3293,7 +3308,7 @@ package body Exp_Ch5 is
-- but we still need to test our prefix recursively.
else
return Maybe_Bit_Aligned_Large_Component (P);
return Possible_Bit_Aligned_Component (P);
end if;
end if;
end;
......@@ -3306,6 +3321,6 @@ package body Exp_Ch5 is
return False;
end case;
end Maybe_Bit_Aligned_Large_Component;
end Possible_Bit_Aligned_Component;
end Exp_Ch5;
......@@ -873,8 +873,7 @@ package body GNAT.AWK is
Callbacks : Callback_Mode := None;
Session : Session_Type := Current_Session)
is
Filter_Active : Boolean;
Quit : Boolean;
Quit : Boolean;
begin
Open (Separators, Filename, Session);
......@@ -884,7 +883,12 @@ package body GNAT.AWK is
Split_Line (Session);
if Callbacks in Only .. Pass_Through then
Filter_Active := Apply_Filters (Session);
declare
Discard : Boolean;
pragma Unreferenced (Discard);
begin
Discard := Apply_Filters (Session);
end;
end if;
if Callbacks /= Only then
......
......@@ -116,7 +116,7 @@ package body GNAT.Debug_Pools is
return Tracebacks_Array_Access;
function Hash (T : Tracebacks_Array_Access) return Header;
function Equal (K1, K2 : Tracebacks_Array_Access) return Boolean;
pragma Inline (Set_Next, Next, Get_Key, Equal, Hash);
pragma Inline (Set_Next, Next, Get_Key, Hash);
-- Subprograms required for instantiation of the htable. See GNAT.HTable.
package Backtrace_Htable is new GNAT.HTable.Static_HTable
......@@ -374,7 +374,6 @@ package body GNAT.Debug_Pools is
function Equal (K1, K2 : Tracebacks_Array_Access) return Boolean is
use Ada.Exceptions.Traceback;
begin
return K1.all = K2.all;
end Equal;
......
......@@ -66,7 +66,7 @@ package body GNAT.Memory_Dump is
Line_Buf : String (1 .. Line_Len);
Hex : array (0 .. 15) of Character := "0123456789ABCDEF";
Hex : constant array (0 .. 15) of Character := "0123456789ABCDEF";
type Char_Ptr is access all Character;
......
......@@ -359,7 +359,7 @@ pragma Elaborate_Body (OS_Lib);
(FD : File_Descriptor;
offset : Long_Integer;
origin : Integer);
pragma Import (C, Lseek, "lseek");
pragma Import (C, Lseek, "__gnat_lseek");
-- Sets the current file pointer to the indicated offset value,
-- relative to the current position (origin = SEEK_CUR), end of
-- file (origin = SEEK_END), or start of file (origin = SEEK_SET).
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2002, Ada Core Technologies, Inc. --
-- Copyright (C) 1998-2003, Ada Core Technologies, 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- --
......@@ -343,30 +343,28 @@ package body GNAT.Spitbol.Patterns is
-- structure (i.e. it is a pattern that is guaranteed to match at least
-- one character on success, and not to make any entries on the stack.
OK_For_Simple_Arbno :
array (Pattern_Code) of Boolean := (
PC_Any_CS |
PC_Any_CH |
PC_Any_VF |
PC_Any_VP |
PC_Char |
PC_Len_Nat |
PC_NotAny_CS |
PC_NotAny_CH |
PC_NotAny_VF |
PC_NotAny_VP |
PC_Span_CS |
PC_Span_CH |
PC_Span_VF |
PC_Span_VP |
PC_String |
PC_String_2 |
PC_String_3 |
PC_String_4 |
PC_String_5 |
PC_String_6 => True,
others => False);
OK_For_Simple_Arbno : constant array (Pattern_Code) of Boolean :=
(PC_Any_CS |
PC_Any_CH |
PC_Any_VF |
PC_Any_VP |
PC_Char |
PC_Len_Nat |
PC_NotAny_CS |
PC_NotAny_CH |
PC_NotAny_VF |
PC_NotAny_VP |
PC_Span_CS |
PC_Span_CH |
PC_Span_VF |
PC_Span_VP |
PC_String |
PC_String_2 |
PC_String_3 |
PC_String_4 |
PC_String_5 |
PC_String_6 => True,
others => False);
-------------------------------
-- The Pattern History Stack --
......
......@@ -81,8 +81,7 @@ package body GNAT.Threads is
(Code : Address;
Parm : Void_Ptr;
Size : Natural;
Prio : Integer)
return System.Address
Prio : Integer) return System.Address
is
TP : Tptr;
......@@ -108,7 +107,6 @@ package body GNAT.Threads is
procedure Unregister_Thread is
Self_Id : constant Tasking.Task_ID := Task_Primitives.Operations.Self;
begin
Self_Id.Common.State := Tasking.Terminated;
Destroy_TSD (Self_Id.Common.Compiler_Data);
......@@ -150,7 +148,6 @@ package body GNAT.Threads is
procedure Destroy_Thread (Id : Address) is
Tid : constant Task_Id := To_Id (Id);
begin
Abort_Task (Tid);
end Destroy_Thread;
......@@ -161,9 +158,7 @@ package body GNAT.Threads is
procedure Get_Thread (Id : Address; Thread : Address) is
use System.OS_Interface;
Thr : Thread_Id_Ptr := To_Thread (Thread);
Thr : constant Thread_Id_Ptr := To_Thread (Thread);
begin
Thr.all := Task_Primitives.Operations.Get_Thread_Id (To_Id (Id));
end Get_Thread;
......@@ -173,8 +168,7 @@ package body GNAT.Threads is
----------------
function To_Task_Id
(Id : System.Address)
return Ada.Task_Identification.Task_Id
(Id : System.Address) return Ada.Task_Identification.Task_Id
is
begin
return To_Tid (Id);
......
......@@ -254,7 +254,8 @@ begin
& F_ADC_File (1 .. F_ADC_File_Len));
Make_Args (6) :=
new String'("LIBRARY_VERSION=" & '"' & Library_Version & '"');
new String'("LIBRARY_VERSION=" & '"' &
Verbose_Library_Version & '"');
Make_Args (7) :=
new String'("-f");
......
......@@ -71,7 +71,7 @@ package Gnatvsn is
-- value should never be decreased in the future, but it would be
-- OK to increase it if absolutely necessary.
Library_Version : constant String := "GNAT Lib v3.4";
Library_Version : constant String := "3.4";
-- Library version. This value must be updated whenever any change to the
-- compiler affects the library formats in such a way as to obsolete
-- previously compiled library modules.
......@@ -79,6 +79,9 @@ package Gnatvsn is
-- Note: Makefile.in relies on the precise format of the library version
-- string in order to correctly construct the soname value.
Verbose_Library_Version : constant String := "GNAT Lib v" & Library_Version;
-- Version string stored in e.g. ALI files.
ASIS_Version_Number : constant := 2;
-- ASIS Version. This is used to check for consistency between the compiler
-- used to generate trees, and an ASIS application that is reading the
......
......@@ -35,6 +35,7 @@
%{!gnatc*:%{!gnatz*:%{!gnats*:%{!S:%{!c:\
%eone of -c, -S, -gnatc, -gnatz, or -gnats is required for Ada}}}}}\
gnat1 %{I*} %{k8:-gnatk8} %{w:-gnatws} %1 %{!Q:-quiet} %{nostdinc*}\
%{nostdlib*}\
-dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
%{g*} %{O*} %{W*} %{w} %{p} %{pg:-p} %{m*} %{a} %{f*} %{d*}\
%{!S:%{o*:%w%*-gnatO}} \
......
......@@ -729,7 +729,7 @@ package body Lib.Writ is
Write_Info_Initiate ('V');
Write_Info_Str (" """);
Write_Info_Str (Library_Version);
Write_Info_Str (Verbose_Library_Version);
Write_Info_Char ('"');
Write_Info_EOL;
......
......@@ -1356,7 +1356,7 @@ package body Make is
return;
elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /=
Library_Version
Verbose_Library_Version
then
Verbose_Msg (Full_Lib_File, "compiled with old GNAT version");
ALI := No_ALI_Id;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002 Free Software Foundation, Inc. --
-- Copyright (C) 2002-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- --
......@@ -61,7 +61,7 @@ package body System.Generic_Vector_Operations is
function VP is new Unchecked_Conversion (Address, Vector_Ptr);
function EP is new Unchecked_Conversion (Address, Element_Ptr);
SA : Address := XA + ((Length + 0) / VU * VU
SA : constant Address := XA + ((Length + 0) / VU * VU
and (Boolean'Pos (Unaligned) - Address'(1)));
-- First address of argument X to start serial processing
......@@ -102,7 +102,7 @@ package body System.Generic_Vector_Operations is
function VP is new Unchecked_Conversion (Address, Vector_Ptr);
function EP is new Unchecked_Conversion (Address, Element_Ptr);
SA : Address := XA + ((Length + 0) / VU * VU
SA : constant Address := XA + ((Length + 0) / VU * VU
and (Boolean'Pos (Unaligned) - Address'(1)));
-- First address of argument X to start serial processing
......
......@@ -598,7 +598,7 @@ package body System.Interrupts is
Ptr := Registered_Handler_Head;
while (Ptr /= null) loop
while Ptr /= null loop
if Ptr.H = Fat.Handler_Addr then
return True;
end if;
......@@ -946,7 +946,7 @@ package body System.Interrupts is
Server_ID (Interrupt) := To_System (Access_Hold.all'Identity);
end if;
if (New_Handler = null) then
if New_Handler = null then
if Old_Handler /= null then
Unbind_Handler (Interrupt);
end if;
......
......@@ -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- --
......@@ -122,7 +122,7 @@ package body System.Tasking is
All_Tasks_List := T;
end Initialize_ATCB;
Main_Task_Image : String := "main_task";
Main_Task_Image : constant String := "main_task";
-- Image of environment task.
Main_Priority : Integer;
......
......@@ -1089,7 +1089,8 @@ package body System.Tasking.Stages is
(Ada, Tailored_Exception_Information,
"__gnat_tailored_exception_information");
Excep : Exception_Occurrence_Access := SSL.Get_Current_Excep.all;
Excep : constant Exception_Occurrence_Access :=
SSL.Get_Current_Excep.all;
begin
-- This procedure is called by the task outermost handler in
......
......@@ -1364,7 +1364,8 @@ package body Sem_Attr is
Error_Attr ("prefix of % attribute must be generic type", N);
elsif Is_Generic_Actual_Type (Entity (P))
or In_Instance
or else In_Instance
or else In_Inlined_Body
then
null;
......
......@@ -9631,6 +9631,12 @@ package body Sem_Prag is
E_Id := Expression (Arg2);
Analyze (E_Id);
if In_Instance_Body
and then Nkind (E_Id) = N_Unchecked_Type_Conversion
then
E_Id := Expression (E_Id);
end if;
if not Is_Entity_Name (E_Id) then
Error_Pragma_Arg
("second argument of pragma% must be entity name",
......
......@@ -1440,14 +1440,16 @@ package body Sem_Warn is
when E_Variable =>
-- Case of variable that is assigned but not read. We
-- suppress the message if the variable is volatile or
-- has an address clause.
-- suppress the message if the variable is volatile,
-- has an address clause, or is imported.
if Referenced_As_LHS (E)
and then No (Address_Clause (E))
and then not Is_Volatile (E)
then
if Warn_On_Modified_Unread then
if Warn_On_Modified_Unread
and then not Is_Imported (E)
then
Error_Msg_N
("variable & is assigned but never read?", E);
end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment