Commit c45b6ae0 by Arnaud Charlet

[multiple changes]

2003-12-08  Jerome Guitton  <guitton@act-europe.fr>

	* 5ytiitho.adb, 5zthrini.adb, 5ztiitho.adb, i-vthrea.adb,
	i-vthrea.ads, s-tpae65.adb, s-tpae65.ads: Cleanup: Remove a bunch of
	obsolete files.

	* Makefile.in: (rts-ravenscar): Generate an empty libgnat.a.
	(rts-zfp): Ditto.

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

	* 7sintman.adb: Minor reformatting

	* bindgen.adb: Configurable_Run_Time mode no longer suppresses the
	standard linker options to get standard libraries linked. We now plan
	to provide dummy versions of these libraries to match the appropriate
	configurable run-time (e.g. if a library is not needed at all, provide
	a dummy empty library).

	* targparm.ads: Configurable_Run_Time mode no longer affects linker
	options (-L parameters and standard libraries). What we plan to do is
	to provide dummy libraries where the libraries are not required.

	* gnatbind.adb: Minor comment improvement

2003-12-08  Javier Miranda  <miranda@gnat.com>

	* exp_aggr.adb (Build_Record_Aggr_Code): Do not remove the expanded
	aggregate in the parent. Otherwise constants with limited aggregates
	are not supported. Add new formal to pass the component type (Ctype).
	It is required to call the corresponding IP subprogram in case of
	default initialized components.
	(Gen_Assign): In case of default-initialized component, generate a
	call to the IP subprogram associated with the component.
	(Build_Record_Aggr_Code): Remove the aggregate from the parent in case
	of aggregate with default initialized components.
	(Has_Default_Init_Comps): Improve implementation to recursively check
	all the present expressions.

	* exp_ch3.ads, exp_ch3.adb (Build_Initialization_Call): Add new formal
	to indicate that the initialization call corresponds to a
	default-initialized component of an aggregate.
	In case of default initialized aggregate with tasks this parameter is
	used to generate a null string (this is just a workaround that must be
	improved later). In case of discriminants, this parameter is used to
	generate a selected component node that gives access to the discriminant
	value.

	* exp_ch9.ads, exp_ch9.adb (Build_Task_Allocate_Block_With_Stmts): New
	subprogram, based on Build_Task_Allocate_Block, but adapted to expand
	allocated aggregates with default-initialized components.

	* par-ch4.adb (P_Aggregate_Or_Paren_Expr): Improve error message if
	the box notation is used in positional aggregates.

2003-12-08  Samuel Tardieu  <tardieu@act-europe.fr>

	* lib.ads: Fix typo in comment

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

	* prj.adb (Project_Empty): New component Unkept_Comments
	(Scan): Remove procedure; moved to Prj.Err.

	* prj.ads (Project_Data): New Boolean component Unkept_Comments
	(Scan): Remove procedure; moved to Prj.Err.

	* prj-dect.adb: Manage comments for the different declarations.

	* prj-part.adb (With_Record): New component Node
	(Parse): New Boolean parameter Store_Comments, defaulted to False.
	Set the scanner to return ends of line and comments as tokens, if
	Store_Comments is True.
	(Pre_Parse_Context_Clause): Create the N_With_Clause nodes so that
	comments are associated with these nodes. Store the node IDs in the
	With_Records.
	(Post_Parse_Context_Clause): Use the N_With_Clause nodes stored in the
	With_Records.
	(Parse_Single_Project): Call Pre_Parse_Context_Clause before creating
	the N_Project node. Call Tree.Save and Tree.Reset before scanning the
	current project. Call Tree.Restore afterwards. Set the various nodes
	for comment storage (Next_End, End_Of_Line, Previous_Line,
	Previous_End).

	* prj-part.ads (Parse): New Boolean parameter Store_Comments,
	defaulted to False.

	* prj-pp.adb (Write_String): New Boolean parameter Truncated, defaulted
	to False. When Truncated is True, truncate the string, never go to the
	next line.
	(Write_End_Of_Line_Comment): New procedure
	(Print): Process comments for nodes N_With_Clause,
	N_Package_Declaration, N_String_Type_Declaration,
	N_Attribute_Declaration, N_Typed_Variable_Declaration,
	N_Variable_Declaration, N_Case_Construction, N_Case_Item.
	Process nodes N_Comment.

	* prj-tree.ads, prj-tree.adb (Default_Project_Node): If it is a node
	without comments and there are some comments, set the flag
	Unkept_Comments to True.
	(Scan): If there are comments, set the flag Unkept_Comments to True and
	clear the comments.
	(Project_Node_Kind): Add enum values N_Comment_Zones, N_Comment
	(Next_End_Nodes: New table
	(Comment_Zones_Of): New function
	(Scan): New procedure; moved from Prj. Accumulate comments in the
	Comments table and set end of line comments, comments after, after end
	and before end.
	(Add_Comments): New procedure
	(Save, Restore, Seset_State): New procedures
	(There_Are_Unkept_Comments): New function
	(Set_Previous_Line_Node, Set_Previous_End_Node): New procedures
	(Set_End_Of_Line, Set_Next_End_Node, Remove_Next_End_Node): New
	procedures.
	(First_Comment_After, First_Comment_After_End): New functions
	(First_Comment_Before, First_Comment_Before_End): New functions
	(Next_Comment): New function
	(End_Of_Line_Comment, Follows_Empty_Line,
	Is_Followed_By_Empty_Line): New functions
	(Set_First_Comment_After, Set_First_Comment_After_End): New procedures
	(Set_First_Comment_Before, Set_First_Comment_Before_End): New procedures
	(Set_Next_Comment): New procedure
	(Default_Project_Node): Associate comment before if the node can store
	comments.

	* scans.ads (Token_Type): New enumeration value Tok_Comment
	(Comment_Id): New global variable

	* scng.ads, scng.adb (Comment_Is_Token): New Boolean global variable,
	defaulted to False.
	(Scan): Store position of start of comment. If comments are tokens, set
	Comment_Id and set Token to Tok_Comment when scanning a comment.
	(Set_Comment_As_Token): New procedure

	* sinput-p.adb: Update Copyright notice
	(Source_File_Is_Subunit): Call Prj.Err.Scanner.Scan instead of Prj.Scan
	that no longer exists.

2003-12-08  Javier Miranda  <miranda@gnat.com>

	* sem_aggr.adb: Add dependence on Exp_Tss package
	Correct typo in comment
	(Resolve_Aggregate): In case of array aggregates set the estimated
	type of the aggregate before calling resolve. This is needed to know
	the name of the corresponding IP in case of limited array aggregates.
	(Resolve_Array_Aggregate): Delay the resolution to the expansion phase
	in case of default initialized array components.

	* sem_ch12.adb (Analyze_Formal_Object_Declaration): Allow limited
	types. Required to give support to limited aggregates in generic
	formals.

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

	* sem_ch3.adb (Check_Initialization): For legality purposes, an
	inlined body functions like an instantiation.
	(Decimal_Fixed_Point_Declaration): Do not set kind of first subtype
	until bounds are analyzed, to diagnose premature use of type.

	* sem_util.adb (Wrong_Type): Improve error message when the type of
	the expression is used prematurely.

2003-12-08  GNAT Script  <nobody@gnat.com>

	* Make-lang.in: Makefile automatically updated

From-SVN: r74414
parent 87383233
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . T H R E A D S . I N I T I A L I Z A T I O N . --
-- I N I T I A L I Z E _ T A S K _ H O O K S --
-- --
-- B o d y --
-- --
-- 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- --
-- ware Foundation; either version 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the VxWorks AE 653 version of this procedure
separate (System.Threads.Initialization)
procedure Initialize_Task_Hooks is
-- When defining the following routine for export in an AE 1.1
-- simulation of AE653, Interfaces.C.int may be used for the
-- parameters of FUNCPTR.
type FUNCPTR is access function (T : OSI.Thread_Id) return OSI.STATUS;
--------------------------------
-- Imported vThreads Routines --
--------------------------------
procedure procCreateHookAdd (createHookFunction : FUNCPTR);
pragma Import (C, procCreateHookAdd, "procCreateHookAdd");
-- Registers task registration routine for AE653
begin
-- Register the exported routine with the vThreads ARINC API
procCreateHookAdd (Register'Access);
end Initialize_Task_Hooks;
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . T H R E A D S . I N I T I A L I Z A T I O N --
-- --
-- B o d y --
-- --
-- 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- --
-- ware Foundation; either version 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the VxWorks version of this package; to use this implementation,
-- the task hook libraries should be included in the VxWorks kernel.
with System.Secondary_Stack;
with System.Storage_Elements;
with System.Soft_Links;
with Interfaces.C;
package body System.Threads.Initialization is
use Interfaces.C;
package SSS renames System.Secondary_Stack;
package SSL renames System.Soft_Links;
procedure Initialize_Task_Hooks;
-- Register the appropriate hooks (Register and Reset_TSD) to the
-- underlying OS, so that they will be called when a task is created
-- or reset.
Current_ATSD : aliased System.Address;
pragma Import (C, Current_ATSD, "__gnat_current_atsd");
---------------------------
-- Initialize_Task_Hooks --
---------------------------
procedure Initialize_Task_Hooks is separate;
-- Separate, as these hooks are different for AE653 and VxWorks 5.5.
--------------
-- Init_RTS --
--------------
procedure Init_RTS is
begin
SSL.Get_Jmpbuf_Address := Get_Jmpbuf_Address'Access;
SSL.Get_Sec_Stack_Addr := Get_Sec_Stack_Addr'Access;
SSL.Get_Current_Excep := Get_Current_Excep'Access;
SSL.Set_Jmpbuf_Address := Set_Jmpbuf_Address'Access;
SSL.Set_Sec_Stack_Addr := Set_Sec_Stack_Addr'Access;
end Init_RTS;
--------------
-- Register --
--------------
function Register (T : OSI.Thread_Id) return OSI.STATUS is
Result : OSI.STATUS;
begin
-- It cannot be assumed that the caller of this routine has a ATSD;
-- so neither this procedure nor the procedures that it calls should
-- raise or handle exceptions, or make use of a secondary stack.
-- This routine is only necessary because taskVarAdd cannot be
-- executed once an AE653 partition has entered normal mode
-- (depending on configRecord.c, allocation could be disabled).
-- Otherwise, everything could have been done in Thread_Body_Enter.
if OSI.taskIdVerify (T) = OSI.ERROR then
return OSI.ERROR;
end if;
Result := OSI.taskVarAdd (T, Current_ATSD'Access);
pragma Assert (Result /= OSI.ERROR);
return Result;
end Register;
subtype Default_Sec_Stack is
System.Storage_Elements.Storage_Array
(1 .. SSS.Default_Secondary_Stack_Size);
Main_Sec_Stack : aliased Default_Sec_Stack;
-- Secondary stack for environment task
Main_ATSD : aliased ATSD;
-- TSD for environment task
begin
Initialize_Task_Hooks;
-- Register the environment task
declare
Result : Interfaces.C.int := Register (OSI.taskIdSelf);
pragma Assert (Result /= OSI.ERROR);
begin
Thread_Body_Enter
(Main_Sec_Stack'Address,
Main_Sec_Stack'Size / System.Storage_Unit,
Main_ATSD'Address);
end;
end System.Threads.Initialization;
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . T H R E A D S . I N I T I A L I Z A T I O N . --
-- I N I T I A L I Z E _ T A S K _ H O O K S --
-- --
-- B o d y --
-- --
-- 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- --
-- ware Foundation; either version 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the VxWorks 5.5 version of this procedure
separate (System.Threads.Initialization)
procedure Initialize_Task_Hooks is
type FUNCPTR is access function (T : OSI.Thread_Id) return OSI.STATUS;
procedure taskCreateHookAdd (createHookFunction : FUNCPTR);
pragma Import (C, taskCreateHookAdd, "taskCreateHookAdd");
begin
taskCreateHookAdd (Register'Access);
end Initialize_Task_Hooks;
......@@ -152,7 +152,7 @@ begin
function State (Int : Interrupt_ID) return Character;
pragma Import (C, State, "__gnat_get_interrupt_state");
-- Get interrupt state. Defined in a-init.c
-- Get interrupt state. Defined in a-init.c
-- The input argument is the interrupt number,
-- and the result is one of the following:
......@@ -178,9 +178,9 @@ begin
act.sa_flags := SA_SIGINFO;
-- Setting SA_SIGINFO asks the kernel to pass more than just the signal
-- number argument to the handler when it is called. The set of extra
-- number argument to the handler when it is called. The set of extra
-- parameters typically includes a pointer to a structure describing
-- the interrupted context. Although the Notify_Exception handler does
-- the interrupted context. Although the Notify_Exception handler does
-- not use this information, it is actually required for the GCC/ZCX
-- exception propagation scheme because on some targets (at least
-- alpha-tru64), the structure contents are not even filled when this
......
2003-12-08 Jerome Guitton <guitton@act-europe.fr>
* 5ytiitho.adb, 5zthrini.adb, 5ztiitho.adb, i-vthrea.adb,
i-vthrea.ads, s-tpae65.adb, s-tpae65.ads: Cleanup: Remove a bunch of
obsolete files.
* Makefile.in: (rts-ravenscar): Generate an empty libgnat.a.
(rts-zfp): Ditto.
2003-12-08 Robert Dewar <dewar@gnat.com>
* 7sintman.adb: Minor reformatting
* bindgen.adb: Configurable_Run_Time mode no longer suppresses the
standard linker options to get standard libraries linked. We now plan
to provide dummy versions of these libraries to match the appropriate
configurable run-time (e.g. if a library is not needed at all, provide
a dummy empty library).
* targparm.ads: Configurable_Run_Time mode no longer affects linker
options (-L parameters and standard libraries). What we plan to do is
to provide dummy libraries where the libraries are not required.
* gnatbind.adb: Minor comment improvement
2003-12-08 Javier Miranda <miranda@gnat.com>
* exp_aggr.adb (Build_Record_Aggr_Code): Do not remove the expanded
aggregate in the parent. Otherwise constants with limited aggregates
are not supported. Add new formal to pass the component type (Ctype).
It is required to call the corresponding IP subprogram in case of
default initialized components.
(Gen_Assign): In case of default-initialized component, generate a
call to the IP subprogram associated with the component.
(Build_Record_Aggr_Code): Remove the aggregate from the parent in case
of aggregate with default initialized components.
(Has_Default_Init_Comps): Improve implementation to recursively check
all the present expressions.
* exp_ch3.ads, exp_ch3.adb (Build_Initialization_Call): Add new formal
to indicate that the initialization call corresponds to a
default-initialized component of an aggregate.
In case of default initialized aggregate with tasks this parameter is
used to generate a null string (this is just a workaround that must be
improved later). In case of discriminants, this parameter is used to
generate a selected component node that gives access to the discriminant
value.
* exp_ch9.ads, exp_ch9.adb (Build_Task_Allocate_Block_With_Stmts): New
subprogram, based on Build_Task_Allocate_Block, but adapted to expand
allocated aggregates with default-initialized components.
* par-ch4.adb (P_Aggregate_Or_Paren_Expr): Improve error message if
the box notation is used in positional aggregates.
2003-12-08 Samuel Tardieu <tardieu@act-europe.fr>
* lib.ads: Fix typo in comment
2003-12-08 Vincent Celier <celier@gnat.com>
* prj.adb (Project_Empty): New component Unkept_Comments
(Scan): Remove procedure; moved to Prj.Err.
* prj.ads (Project_Data): New Boolean component Unkept_Comments
(Scan): Remove procedure; moved to Prj.Err.
* prj-dect.adb: Manage comments for the different declarations.
* prj-part.adb (With_Record): New component Node
(Parse): New Boolean parameter Store_Comments, defaulted to False.
Set the scanner to return ends of line and comments as tokens, if
Store_Comments is True.
(Pre_Parse_Context_Clause): Create the N_With_Clause nodes so that
comments are associated with these nodes. Store the node IDs in the
With_Records.
(Post_Parse_Context_Clause): Use the N_With_Clause nodes stored in the
With_Records.
(Parse_Single_Project): Call Pre_Parse_Context_Clause before creating
the N_Project node. Call Tree.Save and Tree.Reset before scanning the
current project. Call Tree.Restore afterwards. Set the various nodes
for comment storage (Next_End, End_Of_Line, Previous_Line,
Previous_End).
* prj-part.ads (Parse): New Boolean parameter Store_Comments,
defaulted to False.
* prj-pp.adb (Write_String): New Boolean parameter Truncated, defaulted
to False. When Truncated is True, truncate the string, never go to the
next line.
(Write_End_Of_Line_Comment): New procedure
(Print): Process comments for nodes N_With_Clause,
N_Package_Declaration, N_String_Type_Declaration,
N_Attribute_Declaration, N_Typed_Variable_Declaration,
N_Variable_Declaration, N_Case_Construction, N_Case_Item.
Process nodes N_Comment.
* prj-tree.ads, prj-tree.adb (Default_Project_Node): If it is a node
without comments and there are some comments, set the flag
Unkept_Comments to True.
(Scan): If there are comments, set the flag Unkept_Comments to True and
clear the comments.
(Project_Node_Kind): Add enum values N_Comment_Zones, N_Comment
(Next_End_Nodes: New table
(Comment_Zones_Of): New function
(Scan): New procedure; moved from Prj. Accumulate comments in the
Comments table and set end of line comments, comments after, after end
and before end.
(Add_Comments): New procedure
(Save, Restore, Seset_State): New procedures
(There_Are_Unkept_Comments): New function
(Set_Previous_Line_Node, Set_Previous_End_Node): New procedures
(Set_End_Of_Line, Set_Next_End_Node, Remove_Next_End_Node): New
procedures.
(First_Comment_After, First_Comment_After_End): New functions
(First_Comment_Before, First_Comment_Before_End): New functions
(Next_Comment): New function
(End_Of_Line_Comment, Follows_Empty_Line,
Is_Followed_By_Empty_Line): New functions
(Set_First_Comment_After, Set_First_Comment_After_End): New procedures
(Set_First_Comment_Before, Set_First_Comment_Before_End): New procedures
(Set_Next_Comment): New procedure
(Default_Project_Node): Associate comment before if the node can store
comments.
* scans.ads (Token_Type): New enumeration value Tok_Comment
(Comment_Id): New global variable
* scng.ads, scng.adb (Comment_Is_Token): New Boolean global variable,
defaulted to False.
(Scan): Store position of start of comment. If comments are tokens, set
Comment_Id and set Token to Tok_Comment when scanning a comment.
(Set_Comment_As_Token): New procedure
* sinput-p.adb: Update Copyright notice
(Source_File_Is_Subunit): Call Prj.Err.Scanner.Scan instead of Prj.Scan
that no longer exists.
2003-12-08 Javier Miranda <miranda@gnat.com>
* sem_aggr.adb: Add dependence on Exp_Tss package
Correct typo in comment
(Resolve_Aggregate): In case of array aggregates set the estimated
type of the aggregate before calling resolve. This is needed to know
the name of the corresponding IP in case of limited array aggregates.
(Resolve_Array_Aggregate): Delay the resolution to the expansion phase
in case of default initialized array components.
* sem_ch12.adb (Analyze_Formal_Object_Declaration): Allow limited
types. Required to give support to limited aggregates in generic
formals.
2003-12-08 Ed Schonberg <schonberg@gnat.com>
* sem_ch3.adb (Check_Initialization): For legality purposes, an
inlined body functions like an instantiation.
(Decimal_Fixed_Point_Declaration): Do not set kind of first subtype
until bounds are analyzed, to diagnose premature use of type.
* sem_util.adb (Wrong_Type): Improve error message when the type of
the expression is used prematurely.
2003-12-08 GNAT Script <nobody@gnat.com>
* Make-lang.in: Makefile automatically updated
2003-12-08 Arnaud Charlet <charlet@act-europe.fr>
* sinfo.h, einfo.h, nmake.ads, treeprs.ads: Removed, since they
......
......@@ -915,8 +915,8 @@ ada.distclean:
-$(RM) ada/tools/*
-$(RMDIR) ada/tools
ada.maintainer-clean:
-$(RM) ada/a-sinfo.h
-$(RM) ada/a-einfo.h
-$(RM) ada/sinfo.h
-$(RM) ada/einfo.h
-$(RM) ada/nmake.adb
-$(RM) ada/nmake.ads
-$(RM) ada/treeprs.ads
......@@ -1213,6 +1213,11 @@ ada/a-charac.o : ada/ada.ads ada/a-charac.ads ada/system.ads
ada/a-chlat1.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
ada/system.ads
ada/a-elchha.o : ada/ada.ads ada/a-except.ads ada/a-elchha.ads \
ada/a-elchha.adb ada/system.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-traent.ads ada/unchconv.ads
ada/a-except.o : ada/ada.ads ada/a-except.ads ada/a-except.adb \
ada/a-excach.adb ada/a-exexda.adb ada/a-exexpr.adb ada/a-exextr.adb \
ada/a-excpol.adb ada/a-exstat.adb ada/a-unccon.ads ada/a-uncdea.ads \
......@@ -1525,26 +1530,26 @@ ada/exp_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
ada/exp_aggr.ads ada/exp_aggr.adb ada/exp_ch11.ads ada/exp_ch2.ads \
ada/exp_ch3.ads ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads \
ada/exp_util.adb ada/expander.ads ada/fname.ads ada/freeze.ads \
ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \
ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
ada/inline.ads ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_cat.ads \
ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_eval.adb \
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/snames.ads \
ada/sprint.ads ada/stand.ads ada/stringt.ads ada/system.ads \
ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads \
ada/s-memory.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-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/validsw.ads
ada/exp_ch3.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_tss.ads \
ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \
ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
ada/lib-list.adb ada/lib-sort.adb ada/namet.ads ada/nlists.ads \
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/sem.ads \
ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads \
ada/sem_eval.adb 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/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
ada/s-imgenu.ads ada/s-memory.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-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/validsw.ads
ada/exp_attr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
......@@ -1679,13 +1684,13 @@ ada/exp_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/sem_intr.ads ada/sem_mech.ads ada/sem_res.ads ada/sem_res.adb \
ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.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-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/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.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-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/validsw.ads
ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
......
......@@ -1843,6 +1843,8 @@ rts-zfp: force
-$(GNATMAKE) -Prts-zfp/zfp.gpr --GCC="../../../xgcc -B../../../"
$(RM) rts-zfp/adalib/*.o
$(CHMOD) a-wx rts-zfp/adalib/*.ali
$(AR) r rts-zfp/adalib/libgnat.a
$(CHMOD) a-wx rts-zfp/adalib/libgnat.a
rts-none: force
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
......@@ -1861,6 +1863,8 @@ rts-ravenscar: force
-$(GNATMAKE) -Prts-ravenscar/ravenscar.gpr \
--GCC="../../../xgcc -B../../../"
$(CHMOD) a-wx rts-ravenscar/adalib/*.ali
$(AR) r rts-ravenscar/adalib/libgnat.a
$(CHMOD) a-wx rts-ravenscar/adalib/libgnat.a
# Warning: this target assumes that LIBRARY_VERSION has been set correctly.
gnatlib-shared-default:
......
......@@ -1774,22 +1774,18 @@ package body Bindgen is
end if;
end loop;
-- Add a "-Ldir" for each directory in the object path. We skip this
-- in Configurable_Run_Time mode, where we want more precise control
-- of exactly what goes into the resulting object file
-- Add a "-Ldir" for each directory in the object path
if not Configurable_Run_Time_Mode then
for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
declare
Dir : constant String_Ptr := Dir_In_Obj_Search_Path (J);
begin
Name_Len := 0;
Add_Str_To_Name_Buffer ("-L");
Add_Str_To_Name_Buffer (Dir.all);
Write_Linker_Option;
end;
end loop;
end if;
for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
declare
Dir : constant String_Ptr := Dir_In_Obj_Search_Path (J);
begin
Name_Len := 0;
Add_Str_To_Name_Buffer ("-L");
Add_Str_To_Name_Buffer (Dir.all);
Write_Linker_Option;
end;
end loop;
-- Sort linker options
......@@ -1845,7 +1841,7 @@ package body Bindgen is
-- files. The reason for this decision is that libraries referenced
-- by internal routines may reference these standard library entries.
if not (Configurable_Run_Time_Mode or else Opt.No_Stdlib) then
if not Opt.No_Stdlib then
Name_Len := 0;
if Opt.Shared_Libgnat then
......
......@@ -56,6 +56,7 @@ with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Stand; use Stand;
with Stringt; use Stringt;
with Snames; use Snames;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
......@@ -1032,13 +1033,14 @@ package body Exp_Ch3 is
-- end;
function Build_Initialization_Call
(Loc : Source_Ptr;
Id_Ref : Node_Id;
Typ : Entity_Id;
In_Init_Proc : Boolean := False;
Enclos_Type : Entity_Id := Empty;
Discr_Map : Elist_Id := New_Elmt_List)
return List_Id
(Loc : Source_Ptr;
Id_Ref : Node_Id;
Typ : Entity_Id;
In_Init_Proc : Boolean := False;
Enclos_Type : Entity_Id := Empty;
Discr_Map : Elist_Id := New_Elmt_List;
With_Default_Init : Boolean := False)
return List_Id
is
First_Arg : Node_Id;
Args : List_Id;
......@@ -1076,7 +1078,6 @@ package body Exp_Ch3 is
-- honest. Actually it isn't quite type honest, because there can be
-- conflicts of views in the private type case. That is why we set
-- Conversion_OK in the conversion node.
if (Is_Record_Type (Typ)
or else Is_Array_Type (Typ)
or else Is_Private_Type (Typ))
......@@ -1110,12 +1111,28 @@ package body Exp_Ch3 is
Append_To (Args, Make_Identifier (Loc, Name_uChain));
Decls := Build_Task_Image_Decls (Loc, Id_Ref, Enclos_Type);
Decl := Last (Decls);
-- Ada0Y (AI-287): In case of default initialized components
-- with tasks, we generate a null string actual parameter.
-- This is just a workaround that must be improved later???
if With_Default_Init then
declare
S : String_Id;
Null_String : Node_Id;
begin
Start_String;
S := End_String;
Null_String := Make_String_Literal (Loc, Strval => S);
Append_To (Args, Null_String);
end;
else
Decls := Build_Task_Image_Decls (Loc, Id_Ref, Enclos_Type);
Decl := Last (Decls);
Append_To (Args,
New_Occurrence_Of (Defining_Identifier (Decl), Loc));
Append_List (Decls, Res);
Append_To (Args,
New_Occurrence_Of (Defining_Identifier (Decl), Loc));
Append_List (Decls, Res);
end if;
else
Decls := No_List;
......@@ -1202,7 +1219,22 @@ package body Exp_Ch3 is
end if;
end if;
Append_To (Args, Arg);
-- Ada0Y (AI-287) In case of default initialized components, we
-- need to generate the corresponding selected component node
-- to access the discriminant value. In other cases this is not
-- required because we are inside the init proc and we use the
-- corresponding formal.
if With_Default_Init
and then Nkind (Id_Ref) = N_Selected_Component
then
Append_To (Args,
Make_Selected_Component (Loc,
Prefix => New_Copy_Tree (Prefix (Id_Ref)),
Selector_Name => Arg));
else
Append_To (Args, Arg);
end if;
Next_Discriminant (Discr);
end loop;
......
......@@ -52,13 +52,14 @@ package Exp_Ch3 is
-- and the discriminant checking functions are inserted after this node.
function Build_Initialization_Call
(Loc : Source_Ptr;
Id_Ref : Node_Id;
Typ : Entity_Id;
In_Init_Proc : Boolean := False;
Enclos_Type : Entity_Id := Empty;
Discr_Map : Elist_Id := New_Elmt_List)
return List_Id;
(Loc : Source_Ptr;
Id_Ref : Node_Id;
Typ : Entity_Id;
In_Init_Proc : Boolean := False;
Enclos_Type : Entity_Id := Empty;
Discr_Map : Elist_Id := New_Elmt_List;
With_Default_Init : Boolean := False)
return List_Id;
-- Builds a call to the initialization procedure of the Id entity. Id_Ref
-- is either a new reference to Id (for record fields), or an indexed
-- component (for array elements). Loc is the source location for the
......@@ -76,6 +77,10 @@ package Exp_Ch3 is
-- entry families bounded by discriminants, protected type discriminants
-- can appear within expressions in array bounds (not as stand-alone
-- identifiers) and a general replacement is necessary.
--
-- Ada0Y (AI-287): With_Default_Init is used to indicate that the initia-
-- lization call corresponds to a default initialized component of an
-- aggregate.
procedure Freeze_Type (N : Node_Id);
-- This procedure executes the freezing actions associated with the given
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2001 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- --
......@@ -164,6 +164,15 @@ package Exp_Ch9 is
-- the Master_Id of the access type as the _Master parameter, and _Chain
-- (defined above) as the _Chain parameter.
procedure Build_Task_Allocate_Block_With_Init_Stmts
(Actions : List_Id;
N : Node_Id;
Init_Stmts : List_Id);
-- Ada0Y (AI-287): Similar to previous routine, but used to expand alloca-
-- ted aggregates with default initialized components. Init_Stmts contains
-- the list of statements required to initialize the allocated aggregate.
-- It replaces the call to Init (Args) done by Build_Task_Allocate_Block.
function Concurrent_Ref (N : Node_Id) return Node_Id;
-- Given the name of a concurrent object (task or protected object), or
-- the name of an access to a concurrent object, this function returns an
......
......@@ -471,7 +471,7 @@ begin
-- Add System.Standard_Library to list to ensure that these files are
-- included in the bind, even if not directly referenced from Ada code
-- This is suppressed if the configurable run-time requests it.
-- This is suppressed if the appropriate targparm switch is set.
if not Suppress_Standard_Library_On_Target then
Name_Buffer (1 .. 12) := "s-stalib.ali";
......
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- I N T E R F A C E S . V T H R E A D S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-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. --
-- --
------------------------------------------------------------------------------
-- Implement APEX process registration for AE653. The routines exported
-- by this package are only called from the APEX CREATE and START routines
-- in the AE653 vThreads API. A context clause for this unit must appear in
-- the Ada APEX binding.
--
-- If this package appears in a context clause for an application that will
-- be run in a non-AE653 version of VxWorks, or in a non-vThreads AE653
-- partition, link or load errors for the symbols procCreateHookAdd and
-- procStartHookAdd will occur, unless these routines are defined
-- in the application. This is used when simulating AE653 in AE 1.1.
with System.OS_Interface;
with Interfaces.C;
package Interfaces.Vthreads is
function Setup_Thread return System.Address;
-- Register an existing vxWorks task. This routine is used
-- under AE 1.1 when simulating AE 653.
function Install_Signal_Handlers return Interfaces.C.int;
pragma Export (C, Install_Signal_Handlers,
"__gnat_install_signal_handlers");
-- Map the synchronous signals SIGSEGV, SIGFPE, SIGILL and
-- SIGBUS to Ada exceptions for the calling ARINC process.
-- This routine should be called as early as possible in
-- each ARINC process body.
-- C declaration:
-- extern int __gnat_install_signal_handlers ();
-- This call is unnecessary on AE 1.1.
private
package OSI renames System.OS_Interface;
function Register_Foreign (T : OSI.Thread_Id) return OSI.STATUS;
-- Create runtime structures necessary for Ada language support for
-- an ARINC process. Called from APEX CREATE routine.
function Reset_Foreign (T : OSI.Thread_Id) return OSI.STATUS;
-- Reset runtime structures upon an AE653 process restart. Called from
-- APEX START routine.
-- When defining the following routines for export in an AE 1.1
-- simulation of AE653, Interfaces.C.int may be used for the
-- parameters of FUNCPTR.
type FUNCPTR is access function (T : OSI.Thread_Id) return OSI.STATUS;
--------------------------------
-- Imported vThreads Routines --
--------------------------------
procedure procCreateHookAdd (createHookFunction : FUNCPTR);
pragma Import (C, procCreateHookAdd, "procCreateHookAdd");
-- Registers task registration routine for AE653
procedure procStartHookAdd (StartHookFunction : FUNCPTR);
pragma Import (C, procStartHookAdd, "procStartHookAdd");
-- Registers task restart routine for AE653
end Interfaces.Vthreads;
......@@ -587,7 +587,7 @@ package Lib is
-- function returns True if the given generic unit entity E is for a
-- generic unit that should be separately compiled, and false otherwise.
--
-- Now GNAT can compile any generic unit including predefifined ones, but
-- Now GNAT can compile any generic unit including predefined ones, but
-- because of the backward compatibility (to keep the ability to use old
-- compiler versions to build GNAT) compiling library generics is an
-- option. That is, now GNAT compiles a library generic as an ordinary
......
......@@ -1167,6 +1167,20 @@ package body Ch4 is
end if;
end if;
-- Ada0Y (AI-287): The box notation is allowed only with named
-- notation because positional notation might be error prone. For
-- example, in "(X, <>, Y, <>)", there is no type associated with
-- the boxes, so you might not be leaving out the components you
-- thought you were leaving out.
if Extensions_Allowed and then Token = Tok_Box then
Error_Msg_SC ("(Ada 0Y) box notation only allowed with "
& "named notation");
Scan; -- past BOX
Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
return Aggregate_Node;
end if;
Expr_Node := P_Expression_Or_Range_Attribute;
-- Extension aggregate case
......@@ -1390,9 +1404,13 @@ package body Ch4 is
TF_Arrow;
if Token = Tok_Box then
-- Ada0Y (AI-287): The box notation is used to indicate the default
-- initialization of limited aggregate components
if not Extensions_Allowed then
Error_Msg_SP
("Limited aggregates are an Ada0X extension");
("(Ada 0Y) limited aggregates are an Ada0X extension");
if OpenVMS then
Error_Msg_SP
......
......@@ -125,6 +125,7 @@ package body Prj.Dect is
begin
Attribute := Default_Project_Node (Of_Kind => N_Attribute_Declaration);
Set_Location_Of (Attribute, To => Token_Ptr);
Set_Previous_Line_Node (Attribute);
-- Scan past "for"
......@@ -467,6 +468,9 @@ package body Prj.Dect is
if Current_Attribute = Empty_Attribute then
Attribute := Empty_Node;
end if;
Set_End_Of_Line (Attribute);
Set_Previous_Line_Node (Attribute);
end Parse_Attribute_Declaration;
-----------------------------
......@@ -535,6 +539,9 @@ package body Prj.Dect is
Expect (Tok_Is, "IS");
if Token = Tok_Is then
Set_End_Of_Line (Case_Construction);
Set_Previous_Line_Node (Case_Construction);
Set_Next_End_Node (Case_Construction);
-- Scan past "is"
......@@ -571,6 +578,8 @@ package body Prj.Dect is
Scan;
Expect (Tok_Arrow, "`=>`");
Set_End_Of_Line (Current_Item);
Set_Previous_Line_Node (Current_Item);
-- Empty_Node in Field1 of a Case_Item indicates
-- the "when others =>" branch.
......@@ -596,6 +605,8 @@ package body Prj.Dect is
Set_First_Choice_Of (Current_Item, To => First_Choice);
Expect (Tok_Arrow, "`=>`");
Set_End_Of_Line (Current_Item);
Set_Previous_Line_Node (Current_Item);
Parse_Declarative_Items
(Declarations => First_Declarative_Item,
......@@ -613,6 +624,7 @@ package body Prj.Dect is
End_Case_Construction;
Expect (Tok_End, "`END CASE`");
Remove_Next_End_Node;
if Token = Tok_End then
......@@ -629,6 +641,7 @@ package body Prj.Dect is
Scan;
Expect (Tok_Semicolon, "`;`");
Set_Previous_End_Node (Case_Construction);
end Parse_Case_Construction;
......@@ -673,6 +686,9 @@ package body Prj.Dect is
Current_Project => Current_Project,
Current_Package => Current_Package);
Set_End_Of_Line (Current_Declaration);
Set_Previous_Line_Node (Current_Declaration);
when Tok_For =>
Parse_Attribute_Declaration
......@@ -681,6 +697,9 @@ package body Prj.Dect is
Current_Project => Current_Project,
Current_Package => Current_Package);
Set_End_Of_Line (Current_Declaration);
Set_Previous_Line_Node (Current_Declaration);
when Tok_Package =>
-- Package declaration
......@@ -693,6 +712,8 @@ package body Prj.Dect is
(Package_Declaration => Current_Declaration,
Current_Project => Current_Project);
Set_Previous_End_Node (Current_Declaration);
when Tok_Type =>
-- Type String Declaration
......@@ -706,6 +727,9 @@ package body Prj.Dect is
(String_Type => Current_Declaration,
Current_Project => Current_Project);
Set_End_Of_Line (Current_Declaration);
Set_Previous_Line_Node (Current_Declaration);
when Tok_Case =>
-- Case construction
......@@ -716,6 +740,8 @@ package body Prj.Dect is
Current_Project => Current_Project,
Current_Package => Current_Package);
Set_Previous_End_Node (Current_Declaration);
when others =>
exit;
......@@ -928,8 +954,13 @@ package body Prj.Dect is
end if;
Expect (Tok_Semicolon, "`;`");
Set_End_Of_Line (Package_Declaration);
Set_Previous_Line_Node (Package_Declaration);
elsif Token = Tok_Is then
Set_End_Of_Line (Package_Declaration);
Set_Previous_Line_Node (Package_Declaration);
Set_Next_End_Node (Package_Declaration);
Parse_Declarative_Items
(Declarations => First_Declarative_Item,
......@@ -970,6 +1001,7 @@ package body Prj.Dect is
end if;
Expect (Tok_Semicolon, "`;`");
Remove_Next_End_Node;
else
Error_Msg ("expected IS or RENAMES", Token_Ptr);
......
......@@ -81,6 +81,7 @@ package body Prj.Part is
Path : Name_Id;
Location : Source_Ptr;
Limited_With : Boolean;
Node : Project_Node_Id;
Next : With_Id;
end record;
-- Information about an imported project, to be put in table Withs below
......@@ -426,7 +427,8 @@ package body Prj.Part is
(Project : out Project_Node_Id;
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages)
Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False)
is
Current_Directory : constant String := Get_Current_Dir;
......@@ -451,6 +453,8 @@ package body Prj.Part is
begin
Prj.Err.Initialize;
Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
-- Parse the main project file
......@@ -578,6 +582,8 @@ package body Prj.Part is
Current_With : With_Record;
Current_With_Node : Project_Node_Id := Empty_Node;
begin
-- Assume no context clause
......@@ -588,6 +594,7 @@ package body Prj.Part is
-- or we have exhausted the with clauses.
while Token = Tok_With or else Token = Tok_Limited loop
Current_With_Node := Default_Project_Node (Of_Kind => N_With_Clause);
Limited_With := Token = Tok_Limited;
if Limited_With then
......@@ -612,6 +619,7 @@ package body Prj.Part is
(Path => Token_Name,
Location => Token_Ptr,
Limited_With => Limited_With,
Node => Current_With_Node,
Next => No_With);
Withs.Increment_Last;
......@@ -629,6 +637,8 @@ package body Prj.Part is
Scan;
if Token = Tok_Semicolon then
Set_End_Of_Line (Current_With_Node);
Set_Previous_Line_Node (Current_With_Node);
-- End of (possibly multiple) with clause;
......@@ -639,6 +649,9 @@ package body Prj.Part is
Error_Msg ("expected comma or semi colon", Token_Ptr);
exit Comma_Loop;
end if;
Current_With_Node :=
Default_Project_Node (Of_Kind => N_With_Clause);
end loop Comma_Loop;
end loop With_Loop;
end Pre_Parse_Context_Clause;
......@@ -714,13 +727,11 @@ package body Prj.Part is
-- First with clause of the context clause
Current_Project := Default_Project_Node
(Of_Kind => N_With_Clause);
Current_Project := Current_With.Node;
Imported_Projects := Current_Project;
else
Next_Project := Default_Project_Node
(Of_Kind => N_With_Clause);
Next_Project := Current_With.Node;
Set_Next_With_Clause_Of (Current_Project, Next_Project);
Current_Project := Next_Project;
end if;
......@@ -829,6 +840,8 @@ package body Prj.Part is
use Tree_Private_Part;
Project_Comment_State : Tree.Comment_State;
begin
declare
Normed : String := Normalize_Pathname (Path_Name);
......@@ -868,6 +881,8 @@ package body Prj.Part is
end if;
end loop;
-- Put the new path name on the stack
Project_Stack.Increment_Last;
Project_Stack.Table (Project_Stack.Last).Name := Canonical_Path_Name;
......@@ -933,6 +948,7 @@ package body Prj.Part is
Save_Project_Scan_State (Project_Scan_State);
Source_Index := Load_Project_File (Path_Name);
Tree.Save (Project_Comment_State);
-- if we cannot find it, we stop
......@@ -943,6 +959,7 @@ package body Prj.Part is
end if;
Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
Tree.Reset_State;
Scan;
if Name_From_Path = No_Name then
......@@ -962,6 +979,10 @@ package body Prj.Part is
Write_Eol;
end if;
-- Is there any imported project?
Pre_Parse_Context_Clause (First_With);
Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
Project := Default_Project_Node (Of_Kind => N_Project);
Project_Stack.Table (Project_Stack.Last).Id := Project;
......@@ -969,10 +990,6 @@ package body Prj.Part is
Set_Path_Name_Of (Project, Normed_Path_Name);
Set_Location_Of (Project, Token_Ptr);
-- Is there any imported project?
Pre_Parse_Context_Clause (First_With);
Expect (Tok_Project, "PROJECT");
-- Mark location of PROJECT token if present
......@@ -1276,6 +1293,9 @@ package body Prj.Part is
end if;
Expect (Tok_Is, "IS");
Set_End_Of_Line (Project);
Set_Previous_Line_Node (Project);
Set_Next_End_Node (Project);
declare
Project_Declaration : Project_Node_Id := Empty_Node;
......@@ -1296,6 +1316,7 @@ package body Prj.Part is
end;
Expect (Tok_End, "END");
Remove_Next_End_Node;
-- Skip "end" if present
......@@ -1353,6 +1374,7 @@ package body Prj.Part is
-- source.
if Token = Tok_Semicolon then
Set_Previous_End_Node (Project);
Scan;
if Token /= Tok_EOF then
......@@ -1368,6 +1390,15 @@ package body Prj.Part is
-- And remove the project from the project stack
Project_Stack.Decrement_Last;
-- Indicate if there are unkept comments
Tree.Set_Project_File_Includes_Unkept_Comments
(Node => Project, To => Tree.There_Are_Unkept_Comments);
-- And restore the comment state that was saved
Tree.Restore (Project_Comment_State);
end Parse_Single_Project;
-----------------------
......
......@@ -34,13 +34,15 @@ package Prj.Part is
(Project : out Project_Node_Id;
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages);
Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False);
-- Parse project file and all its imported project files and create a tree.
-- Return the node for the project (or Empty_Node if parsing failed). If
-- Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
-- Otherwise, Errout.Finalize is only called if there are errors (but not
-- if there are only warnings). Packages_To_Check indicates the packages
-- where any unknown attribute produces an error. For other packages, an
-- unknown attribute produces a warning.
-- unknown attribute produces a warning. When Store_Comments is True,
-- comments are stored in the parse tree.
end Prj.Part;
......@@ -123,7 +123,8 @@ package body Prj is
Seen => False,
Flag1 => False,
Flag2 => False,
Depth => 0);
Depth => 0,
Unkept_Comments => False);
-------------------
-- Add_To_Buffer --
......@@ -387,15 +388,6 @@ package body Prj is
and then Left.Separate_Suffix = Right.Separate_Suffix;
end Same_Naming_Scheme;
----------
-- Scan --
----------
procedure Scan is
begin
Scanner.Scan;
end Scan;
--------------------------
-- Standard_Naming_Data --
--------------------------
......
......@@ -554,6 +554,10 @@ package Prj is
-- The maximum depth of a project in the project graph.
-- Depth of main project is 0.
Unkept_Comments : Boolean := False;
-- True if there are comments in the project sources that cannot
-- be kept in the project tree.
end record;
function Empty_Project return Project_Data;
......@@ -610,10 +614,6 @@ package Prj is
-- it is called for B. With_State may be used by Action to choose a
-- behavior or to report some global result.
procedure Scan;
pragma Inline (Scan);
-- Scan a token. Change all operator symbols to literal strings.
private
Initial_Buffer_Size : constant := 100;
......
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K _ P R I M I T I V E S . A E _ 6 5 3 --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-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. --
-- --
------------------------------------------------------------------------------
-- Export certain tasking-related routines for use by Interfaces.Vthreads
with Interfaces.C;
package body System.Task_Primitives.Ae_653 is
-------------------
-- ATCB_Key_Addr --
-------------------
function ATCB_Key_Addr return Address_Access is
Key_Addr : Address_Access;
pragma Import (Ada, Key_Addr, "__gnat_ATCB_key_addr");
-- Done this way to minimize impact on other targets. This
-- implementation is temporary, and specific to AE653
begin
return Key_Addr;
end ATCB_Key_Addr;
--------------------------
-- Set_Current_Priority --
--------------------------
procedure Set_Current_Priority
(T : System.Tasking.Task_ID;
Prio : System.Priority)
is
begin
T.Common.Current_Priority := Prio;
end Set_Current_Priority;
---------------------
-- Set_Task_Thread --
---------------------
procedure Set_Task_Thread
(T : System.Tasking.Task_ID;
Thread : System.OS_Interface.Thread_Id)
is
use System.OS_Interface;
use System.Tasking;
use type Interfaces.C.int;
Result : STATUS;
begin
T.Common.LL.Thread := Thread;
if taskVarGet (Thread, ATCB_Key_Addr) = ERROR then
Result := taskVarAdd (Thread, ATCB_Key_Addr);
pragma Assert (Result = OK);
end if;
Result := taskVarSet (Thread, ATCB_Key_Addr, To_Address (T));
pragma Assert (Result = OK);
end Set_Task_Thread;
end System.Task_Primitives.Ae_653;
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K _ P R I M I T I V E S . A E _ 6 5 3 --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-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. --
-- --
------------------------------------------------------------------------------
-- Export certain tasking-related routines for use by Interfaces.Vthreads
with System.Tasking;
with System.OS_Interface;
package System.Task_Primitives.Ae_653 is
type Address_Access is access System.Address;
function ATCB_Key_Addr return Address_Access;
pragma Inline (ATCB_Key_Addr);
-- Address of ATCB_Key taskvar
procedure Set_Current_Priority
(T : System.Tasking.Task_ID; Prio : System.Priority);
-- Set priority
procedure Set_Task_Thread
(T : System.Tasking.Task_ID;
Thread : System.OS_Interface.Thread_Id);
-- Set "Thread" as the underlying OS thread implementing "T"
end System.Task_Primitives.Ae_653;
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
......@@ -187,15 +187,21 @@ package Scans is
Tok_Dot_Dot, -- .. Sterm, Chtok
-- The following three entries are used only when scanning
-- project files.
-- The following three entries are used only when scanning project
-- files.
Tok_Project,
Tok_Extends,
Tok_External,
Tok_Comment,
-- The following entry is used by the preprocessor and when scanning
-- project files.
-- The following two entries are used by the preprocessor
Tok_End_Of_Line,
-- The following entry is used by the preprocessor
Tok_Special,
No_Token);
......@@ -404,6 +410,10 @@ package Scans is
Special_Character : Character;
-- Valid only when Token = Tok_Special
Comment_Id : Name_Id := No_Name;
-- Valid only when Token = Tok_Comment. Store the string that follows
-- the two '-' of a comment.
--------------------------------------------------------
-- Procedures for Saving and Restoring the Scan State --
--------------------------------------------------------
......
......@@ -49,6 +49,9 @@ package body Scng is
Special_Characters : array (Character) of Boolean := (others => False);
-- For characters that are Special token, the value is True
Comment_Is_Token : Boolean := False;
-- True if comments are tokens
End_Of_Line_Is_Token : Boolean := False;
-- True if End_Of_Line is a token
......@@ -229,6 +232,8 @@ package body Scng is
procedure Scan is
Start_Of_Comment : Source_Ptr;
procedure Check_End_Of_Line;
-- Called when end of line encountered. Checks that line is not
-- too long, and that other style checks for the end of line are met.
......@@ -1394,6 +1399,7 @@ package body Scng is
else -- Source (Scan_Ptr + 1) = '-' then
if Style_Check then Style.Check_Comment; end if;
Scan_Ptr := Scan_Ptr + 2;
Start_Of_Comment := Scan_Ptr;
-- Loop to scan comment (this loop runs more than once only if
-- a horizontal tab or other non-graphic character is scanned)
......@@ -1449,9 +1455,18 @@ package body Scng is
end loop;
-- Note that we do NOT execute a return here, instead we fall
-- through to reexecute the scan loop to look for a token.
-- Note that, except when comments are tokens, we do NOT
-- execute a return here, instead we fall through to reexecute
-- the scan loop to look for a token.
if Comment_Is_Token then
Name_Len := Integer (Scan_Ptr - Start_Of_Comment);
Name_Buffer (1 .. Name_Len) :=
String (Source (Start_Of_Comment .. Scan_Ptr - 1));
Comment_Id := Name_Find;
Token := Tok_Comment;
return;
end if;
end if;
end Minus_Case;
......@@ -2066,6 +2081,14 @@ package body Scng is
return;
end if;
end Scan;
--------------------------
-- Set_Comment_As_Token --
--------------------------
procedure Set_Comment_As_Token (Value : Boolean) is
begin
Comment_Is_Token := Value;
end Set_Comment_As_Token;
------------------------------
-- Set_End_Of_Line_As_Token --
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
......@@ -91,6 +91,10 @@ package Scng is
-- Indicate if End_Of_Line is a token or not.
-- By default, End_Of_Line is not a token.
procedure Set_Comment_As_Token (Value : Boolean);
-- Indicate if a comment is a token or not.
-- By default, a comment is not a token.
function Set_Start_Column return Column_Number;
-- This routine is called with Scan_Ptr pointing to the first character
-- of a line. On exit, Scan_Ptr is advanced to the first non-blank
......
......@@ -29,6 +29,7 @@ with Checks; use Checks;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Itypes; use Itypes;
......@@ -334,7 +335,7 @@ package body Sem_Aggr is
--
-- Typ is the context type in which N occurs.
--
-- This routine creates an implicit array subtype whose bouds are
-- This routine creates an implicit array subtype whose bounds are
-- those defined by the aggregate. When this routine is invoked
-- Resolve_Array_Aggregate has already processed aggregate N. Thus the
-- Aggregate_Bounds of each sub-aggregate, is an N_Range node giving the
......@@ -962,6 +963,8 @@ package body Sem_Aggr is
-- formal parameter. Consequently we also need to test for
-- N_Procedure_Call_Statement or N_Function_Call.
Set_Etype (N, Aggr_Typ); -- may be overridden later on.
if Is_Constrained (Typ) and then
(Pkind = N_Assignment_Statement or else
Pkind = N_Parameter_Association or else
......@@ -1641,9 +1644,27 @@ package body Sem_Aggr is
end if;
end loop;
if not
Resolve_Aggr_Expr
(Expression (Assoc), Single_Elmt => Single_Choice)
-- Ada0Y (AI-287): In case of default initialized component
-- we delay the resolution to the expansion phase
if Box_Present (Assoc) then
-- Ada0Y (AI-287): In case of default initialization of a
-- component the expander will generate calls to the
-- corresponding initialization subprogram.
if Present (Base_Init_Proc (Etype (Component_Typ)))
or else Has_Task (Base_Type (Component_Typ))
then
null;
else
Error_Msg_N
("(Ada 0Y): no value supplied for this component",
Assoc);
end if;
elsif not Resolve_Aggr_Expr (Expression (Assoc),
Single_Elmt => Single_Choice)
then
return Failure;
end if;
......@@ -1764,8 +1785,26 @@ package body Sem_Aggr is
if Others_Present then
Assoc := Last (Component_Associations (N));
if not Resolve_Aggr_Expr (Expression (Assoc),
Single_Elmt => False)
-- Ada0Y (AI-287): In case of default initialized component
-- we delay the resolution to the expansion phase.
if Box_Present (Assoc) then
-- Ada0Y (AI-287): In case of default initialization of a
-- component the expander will generate calls to the
-- corresponding initialization subprogram.
if Present (Base_Init_Proc (Etype (Component_Typ))) then
null;
else
Error_Msg_N
("(Ada 0Y): no value supplied for these components",
Assoc);
end if;
elsif not Resolve_Aggr_Expr (Expression (Assoc),
Single_Elmt => False)
then
return Failure;
end if;
......
......@@ -1466,7 +1466,10 @@ package body Sem_Ch12 is
end if;
if K = E_Generic_In_Parameter then
if Is_Limited_Type (T) then
-- Ada0Y (AI-287): Limited aggregates allowed in generic formals
if not Extensions_Allowed and then Is_Limited_Type (T) then
Error_Msg_N
("generic formal of mode IN must not be of limited type", N);
Explain_Limited_Type (T, N);
......
......@@ -6246,6 +6246,7 @@ package body Sem_Ch3 is
if (Is_Limited_Type (T)
or else Is_Limited_Composite (T))
and then not In_Instance
and then not In_Inlined_Body
then
-- Ada0Y (AI-287): Relax the strictness of the front-end in case of
-- limited aggregates and extension aggregates.
......@@ -8438,18 +8439,6 @@ package body Sem_Ch3 is
Init_Size_Align (Implicit_Base);
-- Complete entity for first subtype
Set_Ekind (T, E_Decimal_Fixed_Point_Subtype);
Set_Etype (T, Implicit_Base);
Set_Size_Info (T, Implicit_Base);
Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
Set_Digits_Value (T, Digs_Val);
Set_Delta_Value (T, Delta_Val);
Set_Small_Value (T, Delta_Val);
Set_Scale_Value (T, Scale_Val);
Set_Is_Constrained (T);
-- If there are bounds given in the declaration use them as the
-- bounds of the first named subtype.
......@@ -8492,6 +8481,18 @@ package body Sem_Ch3 is
Set_Fixed_Range (T, Loc, -Bound_Val, Bound_Val);
end if;
-- Complete entity for first subtype
Set_Ekind (T, E_Decimal_Fixed_Point_Subtype);
Set_Etype (T, Implicit_Base);
Set_Size_Info (T, Implicit_Base);
Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
Set_Digits_Value (T, Digs_Val);
Set_Delta_Value (T, Delta_Val);
Set_Small_Value (T, Delta_Val);
Set_Scale_Value (T, Scale_Val);
Set_Is_Constrained (T);
end Decimal_Fixed_Point_Type_Declaration;
-----------------------
......
......@@ -6371,6 +6371,9 @@ package body Sem_Util is
Error_Msg_N (
"operator of the type is not directly visible!", Expr);
elsif Ekind (Found_Type) = E_Void then
Error_Msg_NE ("found premature usage of}!", Expr, Found_Type);
else
Error_Msg_NE ("found}!", Expr, Found_Type);
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. --
-- --
-- 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- --
......@@ -24,7 +24,6 @@
-- --
------------------------------------------------------------------------------
with Prj; use Prj;
with Prj.Err;
with Sinput.C;
......@@ -97,7 +96,7 @@ package body Sinput.P is
or else Token = Tok_Private
or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
loop
Scan;
Prj.Err.Scanner.Scan;
end loop;
return Token = Tok_Separate;
......
......@@ -322,12 +322,6 @@ package Targparm is
--
-- The variable __gnat_exit_status is generated within the binder file
-- instead of being imported from the run-time library.
--
-- No -Ldir switches are added for the linker step
--
-- No standard switches are added after user file entries to the
-- linker line. All such switches must be explicit. In other words
-- the option -nostdlib is implicit with a configurable run-time.
Suppress_Standard_Library_On_Target : Boolean;
-- If this flag is True, then the standard library is not included by
......
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