diff options
author | Richard Sandiford <richard.sandiford@linaro.org> | 2017-11-20 16:02:55 +0000 |
---|---|---|
committer | Richard Sandiford <richard.sandiford@linaro.org> | 2017-11-20 16:02:55 +0000 |
commit | d58952aefb03632bbb5b441d5c0bd330711f0af1 (patch) | |
tree | d046e56bfbd6a40106ae6ab96fafc954f1dfc955 /gcc/ada | |
parent | 648f8fc59b2cc39abd24f4c22388b346cdebcc31 (diff) | |
parent | 50221fae802a10fafe95e61d40504a58da33e98f (diff) | |
download | gcc-linaro-dev/sve.tar.gz |
Merge trunk into svelinaro-dev/sve
Diffstat (limited to 'gcc/ada')
126 files changed, 7531 insertions, 5074 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6e2a7ffd099..edf87c37cdf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,791 @@ +2017-11-10 Martin Sebor <msebor@redhat.com> + + PR c/81117 + * adadecode.c (__gnat_decode): Use memcpy instead of strncpy. + * argv.c (__gnat_fill_arg, __gnat_fill_env): Likewise. + +2017-11-10 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/utils.c (convert) <RECORD_TYPE>: Add comment and do + not fall through to the next case. + <ARRAY_TYPE>: Deal specially with a dereference from another array + type with the same element type. + +2017-11-09 Gary Dismukes <dismukes@adacore.com> + + * exp_util.adb, freeze.adb: Minor reformatting. + +2017-11-09 Jerome Lambourg <lambourg@adacore.com> + + * gcc-interface/Makefile.in: Add rules to build aarch64-qnx runtimes. + +2017-11-09 Hristian Kirtchev <kirtchev@adacore.com> + + * gcc-interface/trans.c (gnat_to_gnu): Add processing for + N_Variable_Reference_Marker nodes. + +2017-11-09 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb (Analyze_Generic_Package_Declaration): Handle properly + the pragma Compile_Time_Error when it appears in a generic package + declaration and uses an expanded name to denote the current unit. + +2017-11-09 Jerome Lambourg <lambourg@adacore.com> + + * libgnarl/s-taprop__qnx.adb: Fix incorrect casing for pthread_self. + * tracebak.c: Add support for tracebacks in QNX. + +2017-11-09 Eric Botcazou <ebotcazou@adacore.com> + + * exp_aggr.adb (Aggr_Size_OK): Bump base limit from 50000 to 500000. + +2017-11-09 Yannick Moy <moy@adacore.com> + + * erroutc.adb, set_targ.adb: Remove pragma Annotate for CodePeer + justification. + +2017-11-09 Joel Brobecker <brobecker@adacore.com> + + * doc/gnat_ugn/platform_specific_information.rst: Document packages + needed on GNU/Linux by GNAT. + * gnat_ugn.texi: Regenerate. + +2017-11-09 Hristian Kirtchev <kirtchev@adacore.com> + + * contracts.adb (Analyze_Contracts): Remove the three parameter + version. This routine now only analyzes contracts and does not perform + any freezing actions. + (Analyze_Previous_Contracts): Removed. + (Freeze_Previous_Contracts): New routine. + * contracts.ads (Analyze_Previous_Contracts): Removed. + (Freeze_Previous_Contracts): New routine. + * sem_ch3.adb (Analyze_Declarations): Analyze the contract of an + enclosing package spec regardless of whether the list denotes the + visible or private declarations. Fix the removal of partial state + refinements when the context is a package spec. + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Freeze previous + contracts. + * sem_ch7.adb (Analyze_Package_Body_Helper): Freeze previous contracts. + * sem_ch9.adb (Analyze_Entry_Body): Freeze previous contracts. + (Analyze_Protected_Body): Freeze previous contracts. + (Analyze_Task_Body): Freeze previous contracts. + * sem_prag.adb: Comment reformatting. + +2017-11-09 Bob Duff <duff@adacore.com> + + * libgnarl/g-thread.ads, libgnarl/g-thread.adb: (Make_Independent): + Export this so users can use it without importing + System.Tasking.Utilities. + * libgnarl/s-tassta.adb (Vulnerable_Complete_Task): Relax assertion + that fails when Make_Independent is called on a user task. + * libgnarl/s-taskin.ads (Master_Of_Task): Avoid unusual + capitalization style ((style) bad casing of "Master_of_Task"). + +2017-11-09 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb (Analyze_Subprogram_Instantiation): Correct use of + uninitialized variable uncovered by Codepeer. + +2017-11-09 Arnaud Charlet <charlet@adacore.com> + + * namet.adb: Replace pragma Assume by pragma Assert to fix bootstrap. + +2017-11-09 Javier Miranda <miranda@adacore.com> + + * doc/gnat_rm/standard_and_implementation_defined_restrictions.rst: + (Static_Dispatch_Tables): Minor rewording. + * gnat_rm.texi: Regenerate. + +2017-11-09 Justin Squirek <squirek@adacore.com> + + * sem_ch8.adb (Analyze_Use_Package): Remove forced installation of + use_clauses within instances. + (Use_One_Package): Add condition to check for "hidden" open scopes to + avoid skipping over packages that have not been properly installed even + though they are visible. + +2017-11-09 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Analyze_Selected_Component): Reject properly a call to a + private operation of a protected type, when the type has no visible + operations. + +2017-11-09 Javier Miranda <miranda@adacore.com> + + * rtsfind.ads (RE_Id, RE_Unit_Table): Add RE_HT_Link. + * exp_disp.adb (Make_DT): Initialize the HT_Link field of the TSD only + if available. + +2017-11-09 Bob Duff <duff@adacore.com> + + * exp_ch4.adb, exp_ch9.adb, exp_prag.adb, par-ch3.adb, sem_aggr.adb, + sem_ch12.adb, sem_ch13.adb, sem_ch4.adb, sem_disp.adb, sem_prag.adb, + sem_res.adb, sem_util.adb: Get rid of warnings about uninitialized + variables. + +2017-11-09 Yannick Moy <moy@adacore.com> + + * exp_disp.adb (Make_DT): Default initialize Ifaces_List and + Ifaces_Comp_List. + +2017-11-09 Pascal Obry <obry@adacore.com> + + * libgnarl/s-taprop__mingw.adb: On Windows, initialize the thead handle + only for foreign threads. We initialize the thread handle only if not + yet initialized. This happens in Enter_Task for foreign threads only. + But for native threads (Ada tasking) we do want to keep the real + handle (from Create_Task) to be able to free the corresponding + resources in Finalize_TCB (CloseHandle). + +2017-11-09 Yannick Moy <moy@adacore.com> + + * sem_attr.adb (Analyze_Attribute): Default initialize P_Type, + P_Base_Type. + (Error_Attr_P): Fix name in pragma No_Return. + (Unexpected_Argument): Add pragma No_Return. + (Placement_Error): Add pragma No_Return. + +2017-11-09 Javier Miranda <miranda@adacore.com> + + * exp_disp.adb (Elab_Flag_Needed): Elaboration flag not needed when the + dispatch table is statically built. + (Make_DT): Declare constant the Interface_Table object associated with + an statically built dispatch table. For this purpose the Offset_To_Top + value of each interface is computed using the dummy object. + * exp_ch3.adb (Build_Init_Procedure): Do not generate code initializing + the Offset_To_Top field of secondary dispatch tables when the dispatch + table is statically built. + (Initialize_Tag): Do not generate calls to Register_Interface_Offset + when the dispatch table is statically built. + * doc/gnat_rm/standard_and_implementation_defined_restrictions.rst: + Document the new GNAT restriction Static_Dispatch_Tables. + * gnat_rm.texi: Regenerate. + +2017-11-09 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_aggr.adb (Resolve_Delta_Record_Aggregate): Reorder declarations + to avoid a dormant bug. + +2017-11-09 Jerome Lambourg <lambourg@adacore.com> + + * init.c: Define missing __gnat_alternate_stack for QNX. Set it to 0, + as such capability is not available on the OS. + * link.c: Make sure linker options for QNX are correct. + * libgnarl/s-osinte__qnx.ads: Add some missing bindings to pthread. + * libgnarl/s-taprop__qnx.adb: New, derived from s-taprop__posix.adb. This brings + in particular a workaround with locks priority ceiling where a higher + priority task is allowed to lock a lower ceiling priority lock. This + also fixes the scheduling of FIFO tasks when the priority of a task is + lowered. + * libgnat/system-qnx-aarch64.ads: Fix priority ranges. + +2017-11-09 Yannick Moy <moy@adacore.com> + + * erroutc.adb (Output_Error_Msgs): Justify CodePeer false positive + message. + * gnatbind.adb (Scan_Bind_Arg): Simplify test to remove always true + condition. + * namet.adb (Copy_One_Character): Add assumption for static analysis, + as knowledge that Hex(2) is in the range 0..255 is too complex for + CodePeer. + (Finalize): Add assumption for static analysis, as the fact that there + are symbols in the table depends on a global invariant at this point in + the program. + * set_targ.adb (Check_Spaces): Justify CodePeer false positive message. + * stylesw.adb (Save_Style_Check_Options): Rewrite to avoid test always + true. + +2017-11-09 Javier Miranda <miranda@adacore.com> + + * libgnat/s-rident.ads (Static_Dispatch_Tables): New restriction name. + * exp_disp.adb (Building_Static_DT): Check restriction. + (Building_Static_Secondary_DT): Check restriction. + (Make_DT): Initialize the HT_Link to No_Tag. + * opt.ads (Static_Dispatch_Tables): Rename flag... + (Building_Static_Dispatch_Tables): ... into this. This will avoid + conflict with the restriction name. + * gnat1drv.adb: Update. + * exp_aggr.adb (Is_Static_Dispatch_Table_Aggregate): Update. + * exp_ch3.adb (Expand_N_Object_Declaration): Update. + +2017-11-09 Pascal Obry <obry@adacore.com> + + * libgnarl/s-taprop__mingw.adb: Minor code clean-up. Better using a + named number. + +2017-11-09 Yannick Moy <moy@adacore.com> + + * binde.adb (Diagnose_Elaboration_Problem): Mark procedure No_Return. + * checks.adb (Apply_Scalar_Range_Check): Rescope variable OK closer to + use. Default initialize Hi, Lo. + (Selected_Range_Checks): Retype Num_Checks more precisely. + (Determine_Range, Determine_Range_R): Default initialize Hi_Right, + Lo_Right. + * contracts.adb (Process_Contract_Cases): Mark parameter Stmts as + Unmodified. + (Process_Postconditions): Mark parameter Stmts as Unmodified. + * exp_attr.adb (Expand_Loop_Entry_Attribute): Default initialize Blk. + * exp_ch4.adb (Expand_N_Allocator): Default initialize Typ. + (Expand_Concatenate): Default initialize High_Bound. + (Optimize_Length_Comparison): Default initialize Ent, Index. + * exp_ch5.adb (Expand_Predicated_Loop): Default initialize L_Hi and + L_Lo. + * exp_ch6.adb (Expand_N_Extended_Return_Statement): Default initialize + Return_Stmt. + * exp_ch9.adb (Expand_Entry_Barrier): Default initialize Func_Body and + remove pragma Warnings(Off). + * exp_imgv.adb (Expand_Image_Attribute): Default initialize Tent. + * exp_util.adb (Find_Interface_Tag): Default initialize AI_Tag. + * freeze.adb (Check_Component_Storage_Order): Default initialize + Comp_Byte_Aligned rather than silencing messages with pragma + Warnings(Off), which does not work for CodePeer initialization + messages, and given that here the possible read of an unitialized value + depends on a proper use of parameters by the caller. + * inline.adb (Expand_Inlined_Call): Default initialize Lab_Decl, Targ. + * sem_ch12.adb (Build_Operator_Wrapper): Default initialize Expr. + * sem_ch3.adb (Build_Derived_Array_Type): Default initialize + Implicit_Base. + * sem_ch4.adb (List_Operand_Interps): Default initialize Nam and remove + pragma Warnings(Off). + (Analyze_Case_Expression): Rescope checking block within branch where + Others_Present is set by the call to Check_Choices. + * sem_ch5.adb (Analyze_Assignment): Default initialize + Save_Full_Analysis. + * sem_ch6.adb (Analyze_Function_Return): Default initialize Obj_Decl, + and restructure code to defend against previous errors, so that, in + that case, control does not flow to the elsif condition which read an + uninitialized Obj_Decl. + * sem_ch9.adb (Analyze_Requeue): Default initialize Synch_Type. + (Check_Interfaces): Default initialize Full_T_Ifaces and Priv_T_Ifaces, + which seem to be left uninitialized and possibly read in some cases. + * sem_dim.adb (Analyze_Aspect_Dimension_System): Retype Position more + precisely. This requires to exchange the test for exiting in case of + too many positions and the increment to Position, inside the loop. + * sem_eval.adb (Eval_Concatenation): Default initialize Folded_Val, + which cannot be read uninitialized, but the reasons for that are quite + subtle. + * sem_intr.adb (Check_Intrinsic_Call): Default initialize Rtyp. + * sem_prag.adb (Collect_Subprogram_Inputs_Outputs): Default initialize + Spec_Id. + * sem_res.adb (Make_Call_Into_Operator): Default initialize Opnd_Type, + and test for presence of non-null Opnd_Type before testing its scope, + in a test which would read its value uninitialized, and is very rarely + exercized (it depends on the presence of an extension of System). + * sem_spark.ads: Update comment to fix name of main analysis procedure. + * sem_warn.adb (Warn_On_Known_Condition): Default initialize + Test_Result. + * set_targ.adb (FailN): Mark procedure with No_Return. + * stylesw.adb (Save_Style_Check_Options): Delete useless code to + initialize all array Options to white space, as there is already code + doing the same for the remaining positions in Options at the end of the + procedure. + +2017-11-09 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch11.adb (Possible_Local_Raise): Do not issue the warning for + generic instantiations either. + +2017-11-09 Piotr Trojanek <trojanek@adacore.com> + + * sem_prag.adb (Analyze_Part_Of): Reword error message. + (Get_SPARK_Mode_Type): Do not raise Program_Error in case pragma + SPARK_Mode appears with an illegal mode, treat this as a non-existent + mode. + +2017-11-09 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Analyze_Call): Reject a call to a function that returns + a limited view of a type T declared in unit U1, when the function is + declared in another unit U2 and the call appears in a procedure within + another unit. + +2017-11-09 Justin Squirek <squirek@adacore.com> + + * sem_ch8.adb (Analyze_Use_Package): Force installation of use_clauses + when processing generic instances. + +2017-11-09 Bob Duff <duff@adacore.com> + + * namet.ads, namet.adb (Valid_Name_Id): New subtype that excludes + Error_Name and No_Name. Use this (versus Name_Id) to indicate which + objects can have those special values. Valid_Name_Id could usefully be + used all over the compiler front end, but that's too much trouble for + now. If we did that, we might want to rename: + Name_Id --> Optional_Name_Id, Valid_Name_Id --> Name_Id. + For parameters of type Valid_Name_Id, remove some redundant tests, + including the ones found by CodePeer. Use Is_Valid_Name instead of + membership test when appropriate. + (Error_Name_Or_No_Name): Delete this; it's no longer needed. + * sem_ch2.adb (Analyze_Identifier): Use "not Is_Valid_Name" instead of + "in Error_Name_Or_No_Name". + (Check_Parameterless_Call): Use "not Is_Valid_Name" instead of "in + Error_Name_Or_No_Name". + +2017-11-09 Arnaud Charlet <charlet@adacore.com> + + * gnat1drv.adb (Adjust_Global_Switches): Suppress warnings in codepeer + mode here unless -gnateC is specified. + * switch-c.adb (Scan_Front_End_Switches): Do not suppress warnings with + -gnatC here. + +2017-11-09 Piotr Trojanek <trojanek@adacore.com> + + * lib-writ.adb (Write_ALI): Remove processing of the frontend xrefs as + part of the ALI writing; they are now processed directly from memory + when requested by the backend. + * lib-xref.ads (Collect_SPARK_Xrefs): Remove. + (Iterate_SPARK_Xrefs): New routine for iterating over frontend xrefs. + * lib-xref-spark_specific.adb (Traverse_Compilation_Unit): Remove. + (Add_SPARK_File): Remove. + (Add_SPARK_Xref): Refactored from removed code; filters xref entries + that are trivially uninteresting to the SPARK backend. + * spark_xrefs.ads: Remove code that is no longer needed. + * spark_xrefs.adb (dspark): Adapt to use Iterate_SPARK_Xrefs. + +2017-11-09 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_elab.adb: Update the documentation on adding a new elaboration + schenario. Add new hash table Recorded_Top_Level_Scenarios. + (Is_Check_Emitting_Scenario): Removed. + (Is_Recorded_Top_Level_Scenario): New routine. + (Kill_Elaboration_Scenario): Reimplemented. + (Record_Elaboration_Scenario): Mark the scenario as recorded. + (Set_Is_Recorded_Top_Level_Scenario): New routine. + (Update_Elaboration_Scenario): Reimplemented. + * sinfo.adb (Is_Recorded_Scenario): Removed. + (Set_Is_Recorded_Scenario): Removed. + * sinfo.ads: Remove attribute Is_Recorded_Scenario along with + occurrences in nodes. + (Is_Recorded_Scenario): Removed along with pragma Inline. + (Set_Is_Recorded_Scenario): Removed along with pragma Inline. + +2017-11-09 Piotr Trojanek <trojanek@adacore.com> + + * sem_prag.adb (Analyze_Part_Of): Change "designate" to "denote" in + error message. + +2017-11-09 Justin Squirek <squirek@adacore.com> + + * sem_res.adb (Resolve_Allocator): Add warning messages corresponding + to the allocation of an anonymous access-to-controlled object. + +2017-11-09 Jerome Lambourg <lambourg@adacore.com> + + * sigtramp-qnx.c: Fix obvious typo. + +2017-11-09 Doug Rupp <rupp@adacore.com> + + * libgnarl/s-taprop__linux.adb (Monotonic_Clock): Minor reformatting. + +2017-11-09 Ed Schonberg <schonberg@adacore.com> + + * sem_res.adb (Resolve): If expression is an entity whose type has + implicit dereference, generate reference to it, because no reference is + generated for an overloaded entity during analysis, given that its + identity may not be known. + +2017-11-09 Javier Miranda <miranda@adacore.com> + + * exp_disp.adb (Expand_Interface_Thunk): Replace substraction of + offset-to-top field by addition. + (Make_Secondary_DT): Initialize the offset-to-top field with a negative + offset. + * exp_ch3.adb (Build_Offset_To_Top_Function): Build functions that + return a negative offset-to-top value. + (Initialize_Tag): Invoke runtime services Set_Dynamic_Offset_To_Top and + Set_Static_Offset_To_Top passing a negative offet-to-top value; + initialize also the offset-to-top field with a negative offset. + * libgnat/a-tags.adb (Base_Address): Displace the pointer by means of + an addition since the offset-to-top field is now a negative value. + (Displace): Displace the pointer to the object means of a substraction + since it is now a negative value. + (Set_Dynamic_Offset_to_top): Displace the pointer to the object by + means of a substraction since it is now a negative value. + +2017-11-09 Eric Botcazou <ebotcazou@adacore.com> + + * gnat1drv.adb (Gnat1drv): Call Errout.Finalize (Last_Call => True) + before Errout.Output_Messages also in the case of compilation errors. + +2017-11-09 Javier Miranda <miranda@adacore.com> + + * doc/gnat_ugn/the_gnat_compilation_model.rst (Interfacing with C++ at + the Class Level): Fix error interfacing with C strings. + * gnat_ugn.texi: Regenerate. + +2017-11-09 Jerome Lambourg <lambourg@adacore.com> + + * system-qnx-aarch64.ads: Fix the priority constants. + * s-osinte__qnx.ads: Fix constants for handling the locking protocols + and scheduling. + * s-osinte__qnx.adb: New file , prevents the use of priority 0 that + corresponds to an idle priority on QNX. + +2017-11-09 Piotr Trojanek <trojanek@adacore.com> + + * sem_prag.adb, sem_util.adb, sem_elab.adb: Fix minor typos in + comments. + +2017-11-09 Piotr Trojanek <trojanek@adacore.com> + + * lib-xref-spark_specific.adb (Add_SPARK_Xrefs): Ignore loop parameters + in expression funtions that are expanded into variables. + +2017-11-09 Piotr Trojanek <trojanek@adacore.com> + + * sem_util.adb: Minor whitespace cleanup. + +2017-11-09 Jerome Lambourg <lambourg@adacore.com> + + * libgnarl/s-taprop__qnx.adb: Refine aarch64-qnx. Use the POSIX + s-taprop version rather than a custom one. + * sigtramp-qnx.c (aarch64-qnx): Implement the signal trampoline. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * lib-xref.ads, lib-xref-spark_specific.adb + (Traverse_Compilation_Unit): Move declaration to package body. + +2017-11-08 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_spark.adb (Expand_SPARK_N_Object_Renaming_Declaration): Obtain + the type of the renaming from its defining entity, rather then the + subtype mark as there may not be a subtype mark. + +2017-11-08 Jerome Lambourg <lambourg@adacore.com> + + * adaint.c, s-oscons-tmplt.c, init.c, libgnat/system-qnx-aarch64.ads, + libgnarl/a-intnam__qnx.ads, libgnarl/s-intman__qnx.adb, + libgnarl/s-osinte__qnx.ads, libgnarl/s-qnx.ads, + libgnarl/s-taprop__qnx.adb, s-oscons-tmplt.c, sigtramp-qnx.c, + terminals.c: Initial port of GNAT for aarch64-qnx + +2017-11-08 Elisa Barboni <barboni@adacore.com> + + * exp_util.adb (Find_DIC_Type): Move... + * sem_util.ads, sem_util.adb (Find_DIC_Type): ... here. + +2017-11-08 Justin Squirek <squirek@adacore.com> + + * sem_res.adb (Resolve_Allocator): Add info messages corresponding to + the owner and corresponding coextension. + +2017-11-08 Ed Schonberg <schonberg@adacore.com> + + * sem_aggr.adb (Resolve_Delta_Aggregate): Divide into the + following separate procedures. + (Resolve_Delta_Array_Aggregate): Previous code form + Resolve_Delta_Aggregate. + (Resolve_Delta_Record_Aggregate): Extend previous code to cover latest + ARG decisions on the legality rules for delta aggregates for records: + in the case of a variant record, components from different variants + cannot be specified in the delta aggregate, and this must be checked + statically. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * spark_xrefs.ads (SPARK_Scope_Record): Remove File_Num component. + * lib-xref-spark_specific.adb (Add_SPARK_Scope): Skip initialization of + removed component. + +2017-11-08 Gary Dismukes <dismukes@adacore.com> + + * sem_ch4.adb: Minor typo fix. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * spark_xrefs.ads (SPARK_Scope_Record): Remove Spec_File_Num and + Spec_Scope_Num components. + * spark_xrefs.adb (dspark): Skip pretty-printing to removed components. + * lib-xref-spark_specific.adb (Add_SPARK_Scope): Skip initialization of + removed components. + (Collect_SPARK_Xrefs): Skip setting proper values of removed + components. + +2017-11-08 Gary Dismukes <dismukes@adacore.com> + + * exp_ch4.adb (Expand_N_Type_Conversion): Add test that the selector + name is a discriminant in check for unconditional accessibility + violation within instances. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * lib-xref-spark_specific.adb (Add_SPARK_Xrefs): Remove special-case + for constants (with variable input). + (Is_Constant_Object_Without_Variable_Input): Remove. + +2017-11-08 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch9.adb, sem_disp.adb, sem_util.adb: Minor reformatting. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * spark_xrefs.ads (Rtype): Remove special-casing of constants for SPARK + cross-references. + (dspark): Remove hardcoded table bound. + +2017-11-08 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Analyze_Aggregate): For Ada2020 delta aggregates, use + the type of the base of the construct to determine the type (or + candidate interpretations) of the delta aggregate. This allows the + construct to appear in a context that expects a private extension. + * sem_res.adb (Resolve): Handle properly a delta aggregate with an + overloaded base. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * spark_xrefs.ads (SPARK_Xref_Record): Replace file and scope indices + with Entity_Id of the reference. + * spark_xrefs.adb (dspark): Adapt pretty-printing routine. + * lib-xref-spark_specific.adb (Add_SPARK_Xrefs): Store Entity_Id of the + reference, not the file and scope indices. + +2017-11-08 Arnaud Charlet <charlet@adacore.com> + + * errout.ads (Current_Node): New. + * errout.adb (Error_Msg): Use Current_Node. + * par-ch6.adb, par-ch7.adb, par-ch9.adb, par-util.adb: Set Current_Node + when relevant. + * style.adb: Call Error_Msg_N when possible. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * spark_xrefs.ads (SPARK_Scope_Record): Rename Scope_Id component to + Entity. + * lib-xref-spark_specific.adb, spark_xrefs.adb: Propagate renaming of + the Scope_Id record component. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * spark_xrefs.ads (SPARK_File_Record): Remove string components. + * spark_xrefs.adb (dspark): Remove pretty-printing of removed + SPARK_File_Record components. + * lib-xref-spark_specific.adb (Add_SPARK_File): Do not store string + representation of files/units. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * lib-xref.ads, lib-xref-spark_specific.adb (Traverse_Declarations): + Remove Inside_Stubs parameter. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * spark_xrefs.ads (SPARK_Xref_Record): Referenced object is now + represented by Entity_Id. + (SPARK_Scope_Record): Referenced scope (e.g. subprogram) is now + represented by Entity_Id; this information is not repeated as + Scope_Entity. + (Heap): Moved from lib-xref-spark_specific.adb, to reside next to + Name_Of_Heap_Variable. + * spark_xrefs.adb (dspark): Adapt debug routine to above changes in + data types. + * lib-xref-spark_specific.adb: Adapt routines for populating SPARK + scope and xrefs tables to above changes in data types. + +2017-11-08 Justin Squirek <squirek@adacore.com> + + * sem_ch8.adb (Mark_Use_Clauses): Add condition to always mark the + primitives of generic actuals. + (Mark_Use_Type): Add recursive call to properly mark class-wide type's + base type clauses as per ARM 8.4 (8.2/3). + +2017-11-08 Ed Schonberg <schonberg@adacore.com> + + * sem_ch6.adb (Analyze_Generic_Subprobram_Body): Validate + categorization dependency of the body, as is done for non-generic + units. + (New_Overloaded_Entity, Visible_Part_Type): Remove linear search + through declarations (Simple optimization, no behavior change). + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * spark_xrefs.ads (SPARK_Xref_Record): Remove inessential components. + (SPARK_Scope_Record): Remove inessential components. + * spark_xrefs.adb (dspark): Remove pretty-printing of removed record + components. + * lib-xref-spark_specific.adb (Add_SPARK_Scope): Remove setting of + removed record components. + (Add_SPARK_Xrefs): Remove setting of removed record components. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * lib-xref-spark_specific.adb (Add_SPARK_Xrefs): Remove dead check for + empty entities. + +2017-11-08 Javier Miranda <miranda@adacore.com> + + * sem_disp.adb (Is_Inherited_Public_Operation): Extend the + functionality of this routine to handle multiple levels of derivations. + +2017-11-08 Hristian Kirtchev <kirtchev@adacore.com> + + * einfo.adb: Elist36 is now used as Nested_Scenarios. + (Nested_Scenarios): New routine. + (Set_Nested_Scenarios): New routine. + (Write_Field36_Name): New routine. + * einfo.ads: Add new attribute Nested_Scenarios along with occurrences + in entities. + (Nested_Scenarios): New routine along with pragma Inline. + (Set_Nested_Scenarios): New routine along with pragma Inline. + * sem_elab.adb (Find_And_Process_Nested_Scenarios): New routine. + (Process_Nested_Scenarios): New routine. + (Traverse_Body): When a subprogram body is traversed for the first + time, find, save, and process all suitable scenarios found within. + Subsequent traversals of the same subprogram body utilize the saved + scenarios. + +2017-11-08 Piotr Trojanek <trojanek@adacore.com> + + * lib-xref-spark_specific.adb (Add_SPARK_Scope): Remove detection of + protected operations. + (Add_SPARK_Xrefs): Simplify detection of empty entities. + * get_spark_xrefs.ads, get_spark_xrefs.adb, put_spark_xrefs.ads, + put_spark_xrefs.adb, spark_xrefs_test.adb: Remove code for writing, + reading and testing SPARK cross-references stored in the ALI files. + * lib-xref.ads (Output_SPARK_Xrefs): Remove. + * lib-writ.adb (Write_ALI): Do not write SPARK cross-references to the + ALI file. + * spark_xrefs.ads, spark_xrefs.adb (pspark): Remove, together + with description of the SPARK xrefs ALI format. + * gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Remove get_spark_refs.o + and put_spark_refs.o. + +2017-11-08 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch4.adb (Apply_Accessibility_Check): Do not finalize the object + when the associated access type is subject to pragma + No_Heap_Finalization. + * exp_intr.adb (Expand_Unc_Deallocation): Use the available view of the + designated type in case it comes from a limited withed unit. + +2017-11-08 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch3.adb (Expand_N_Object_Declaration): Save and restore relevant + SPARK-related flags. Add ??? comment. + * exp_util.adb (Insert_Actions): Add an entry for node + N_Variable_Reference_Marker. + * sem.adb (Analyze): Add an entry for node N_Variable_Reference_Marker. + * sem_ch8.adb (Find_Direct_Name): Add constant Is_Assignment_LHS. Build + and record a variable reference marker for the current name. + (Find_Expanded_Name): Add constant Is_Assignment_LHS. Build and record + a variable reference marker for the current name. + * sem_elab.adb (Build_Variable_Reference_Marker): New routine. + (Extract_Variable_Reference_Attributes): Reimplemented. + (Info_Scenario): Add output for variable references and remove output + for variable reads. + (Info_Variable_Read): Removed. + (Info_Variable_Reference): New routine. + (Is_Suitable_Scenario): Variable references are now suitable scenarios + while variable reads are not. + (Output_Active_Scenarios): Add output for variable references and + remove output for variable reads. + (Output_Variable_Read): Removed. + (Output_Variable_Reference): New routine. + (Process_Variable_Read): Removed. + (Process_Variable_Reference): New routine. + (Process_Variable_Reference_Read): New routine. + * sem_elab.ads (Build_Variable_Reference_Marker): New routine. + * sem_res.adb (Resolve_Actuals): Build and record a variable reference + marker for the current actual. + * sem_spark.adb (Check_Node): Add an entry for node + N_Variable_Reference_Marker. + * sem_util.adb (Within_Subprogram_Call): Moved to the library level. + * sem_util.ads (Within_Subprogram_Call): Moved to the library level. + * sinfo.adb (Is_Read): New routine. + (Is_Write): New routine. + (Target): Updated to handle variable reference markers. + (Set_Is_Read): New routine. + (Set_Is_Write): New routine. + (Set_Target): Updated to handle variable reference markers. + * sinfo.ads: Add new attributes Is_Read and Is_Write along with + occurrences in nodes. Update attribute Target. Add new node + kind N_Variable_Reference_Marker. + (Is_Read): New routine along with pragma Inline. + (Is_Write): New routine along with pragma Inline. + (Set_Is_Read): New routine along with pragma Inline. + (Set_Is_Write): New routine along with pragma Inline. + * sprint.adb (Sprint_Node_Actual): Add an entry for node + N_Variable_Reference_Marker. + +2017-11-08 Arnaud Charlet <charlet@adacore.com> + + * sem_util.adb (Subprogram_Name): Append suffix for overloaded + subprograms. + +2017-11-08 Yannick Moy <moy@adacore.com> + + * sem_ch8.adb (Use_One_Type, Update_Use_Clause_Chain): Do not report + about unused use-type or use-package clauses inside inlined bodies. + +2017-11-08 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_elab.adb (Ensure_Prior_Elaboration): Add new parameter + In_Partial_Fin along with a comment on its usage. Do not guarantee the + prior elaboration of a unit when the need came from a partial + finalization context. + (In_Initialization_Context): Relocated to Process_Call. + (Is_Partial_Finalization_Proc): New routine. + (Process_Access): Add new parameter In_Partial_Fin along with a comment + on its usage. + (Process_Activation_Call): Add new parameter In_Partial_Fin along with + a comment on its usage. + (Process_Activation_Conditional_ABE_Impl): Add new parameter + In_Partial_Fin along with a comment on its usage. Do not emit any ABE + diagnostics when the activation occurs in a partial finalization + context. + (Process_Activation_Guaranteed_ABE_Impl): Add new parameter + In_Partial_Fin along with a comment on its usage. + (Process_Call): Add new parameter In_Partial_Fin along with a comment + on its usage. A call is within a partial finalization context when it + targets a finalizer or primitive [Deep_]Finalize, and the call appears + in initialization actions. Pass this information down to the recursive + steps of the Processing phase. + (Process_Call_Ada): Add new parameter In_Partial_Fin along with a + comment on its usage. Remove the guard which suppresses the generation + of implicit Elaborate[_All] pragmas. This is now done in + Ensure_Prior_Elaboration. + (Process_Call_Conditional_ABE): Add new parameter In_Partial_Fin along + with a comment on its usage. Do not emit any ABE diagnostics when the + call occurs in a partial finalization context. + (Process_Call_SPARK): Add new parameter In_Partial_Fin along with a + comment on its usage. + (Process_Instantiation): Add new parameter In_Partial_Fin along with a + comment on its usage. + (Process_Instantiation_Ada): Add new parameter In_Partial_Fin along + with a comment on its usage. + (Process_Instantiation_Conditional_ABE): Add new parameter + In_Partial_Fin along with a comment on its usage. Do not emit any ABE + diagnostics when the instantiation occurs in a partial finalization + context. + (Process_Instantiation_SPARK): Add new parameter In_Partial_Fin along + with a comment on its usage. + (Process_Scenario): Add new parameter In_Partial_Fin along with a + comment on its usage. + (Process_Single_Activation): Add new parameter In_Partial_Fin along + with a comment on its usage. + (Traverse_Body): Add new parameter In_Partial_Fin along with a comment + on its usage. + +2017-11-08 Arnaud Charlet <charlet@adacore.com> + + * sem_ch13.adb: Add optional parameter to Error_Msg. + +2017-11-08 Jerome Lambourg <lambourg@adacore.com> + + * fname.adb (Is_Internal_File_Name): Do not check the 8+3 naming schema + for the Interfaces.* hierarchy as longer unit names are now allowed. + +2017-11-08 Arnaud Charlet <charlet@adacore.com> + + * sem_util.adb (Subprogram_Name): Emit sloc for the enclosing + subprogram as well. Support more cases of entities. + (Append_Entity_Name): Add some defensive code. + +2017-11-06 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/misc.c (gnat_post_options): Clear warn_return_type. + 2017-10-31 Eric Botcazou <ebotcazou@adacore.com> PR ada/82785 diff --git a/gcc/ada/adadecode.c b/gcc/ada/adadecode.c index 8c9c7ab7a88..0cbef8123f9 100644 --- a/gcc/ada/adadecode.c +++ b/gcc/ada/adadecode.c @@ -330,7 +330,7 @@ __gnat_decode (const char *coded_name, char *ada_name, int verbose) } /* Write symbol in the space. */ - strncpy (optoken, trans_table[k][1], oplen); + memcpy (optoken, trans_table[k][1], oplen); } else k++; diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 10325b0f1d0..cb0f4bb93b0 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -1012,7 +1012,7 @@ __gnat_open_new_temp (char *path, int fmode) #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \ || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \ - || defined (__DragonFly__)) && !defined (__vxworks) + || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks) return mkstemp (path); #elif defined (__Lynx__) mktemp (path); @@ -1185,7 +1185,7 @@ __gnat_tmp_name (char *tmp_filename) #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \ || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \ - || defined (__DragonFly__) + || defined (__DragonFly__) || defined (__QNX__) #define MAX_SAFE_PATH 1000 char *tmpdir = getenv ("TMPDIR"); diff --git a/gcc/ada/argv.c b/gcc/ada/argv.c index 430404e3aa4..aee0f886443 100644 --- a/gcc/ada/argv.c +++ b/gcc/ada/argv.c @@ -92,7 +92,7 @@ void __gnat_fill_arg (char *a, int i) { if (gnat_argv != NULL) - strncpy (a, gnat_argv[i], strlen(gnat_argv[i])); + memcpy (a, gnat_argv[i], strlen (gnat_argv[i])); } int @@ -118,7 +118,7 @@ void __gnat_fill_env (char *a, int i) { if (gnat_envp != NULL) - strncpy (a, gnat_envp[i], strlen (gnat_envp[i])); + memcpy (a, gnat_envp[i], strlen (gnat_envp[i])); } #ifdef __cplusplus diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index dd076be3acf..5a78bc82499 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -353,6 +353,7 @@ package body Binde is procedure Diagnose_Elaboration_Problem (Elab_Order : in out Unit_Id_Table); + pragma No_Return (Diagnose_Elaboration_Problem); -- Called when no elaboration order can be found. Outputs an appropriate -- diagnosis of the problem, and then abandons the bind. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index b2c26ca4981..c4b37e788ab 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2765,7 +2765,6 @@ package body Checks is S_Typ : Entity_Id; Arr : Node_Id := Empty; -- initialize to prevent warning Arr_Typ : Entity_Id := Empty; -- initialize to prevent warning - OK : Boolean := False; -- initialize to prevent warning Is_Subscr_Ref : Boolean; -- Set true if Expr is a subscript @@ -2995,10 +2994,11 @@ package body Checks is and then Compile_Time_Known_Value (Thi) then declare + OK : Boolean := False; -- initialize to prevent warning Hiv : constant Uint := Expr_Value (Thi); Lov : constant Uint := Expr_Value (Tlo); - Hi : Uint; - Lo : Uint; + Hi : Uint := No_Uint; + Lo : Uint := No_Uint; begin -- If range is null, we for sure have a constraint error (we @@ -4370,8 +4370,8 @@ package body Checks is Hi_Left : Uint; -- Lo and Hi bounds of left operand - Lo_Right : Uint; - Hi_Right : Uint; + Lo_Right : Uint := No_Uint; + Hi_Right : Uint := No_Uint; -- Lo and Hi bounds of right (or only) operand Bound : Node_Id; @@ -4909,8 +4909,8 @@ package body Checks is Hi_Left : Ureal; -- Lo and Hi bounds of left operand - Lo_Right : Ureal; - Hi_Right : Ureal; + Lo_Right : Ureal := No_Ureal; + Hi_Right : Ureal := No_Ureal; -- Lo and Hi bounds of right (or only) operand Bound : Node_Id; @@ -9814,7 +9814,7 @@ package body Checks is Do_Access : Boolean := False; Wnode : Node_Id := Warn_Node; Ret_Result : Check_Result := (Empty, Empty); - Num_Checks : Integer := 0; + Num_Checks : Natural := 0; procedure Add_Check (N : Node_Id); -- Adds the action given to Ret_Result if N is non-Empty diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 8a35b82f55e..1bd13bd91d3 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -53,16 +53,6 @@ with Tbuild; use Tbuild; package body Contracts is - procedure Analyze_Contracts - (L : List_Id; - Freeze_Nod : Node_Id; - Freeze_Id : Entity_Id); - -- Subsidiary to the one parameter version of Analyze_Contracts and routine - -- Analyze_Previous_Constracts. Analyze the contracts of all constructs in - -- the list L. If Freeze_Nod is set, then the analysis stops when the node - -- is reached. Freeze_Id is the entity of some related context which caused - -- freezing up to node Freeze_Nod. - procedure Build_And_Analyze_Contract_Only_Subprograms (L : List_Id); -- (CodePeer): Subsidiary procedure to Analyze_Contracts which builds the -- contract-only subprogram body of eligible subprograms found in L, adds @@ -351,32 +341,16 @@ package body Contracts is ----------------------- procedure Analyze_Contracts (L : List_Id) is + Decl : Node_Id; + begin if CodePeer_Mode and then Debug_Flag_Dot_KK then Build_And_Analyze_Contract_Only_Subprograms (L); end if; - Analyze_Contracts (L, Freeze_Nod => Empty, Freeze_Id => Empty); - end Analyze_Contracts; - - procedure Analyze_Contracts - (L : List_Id; - Freeze_Nod : Node_Id; - Freeze_Id : Entity_Id) - is - Decl : Node_Id; - - begin Decl := First (L); while Present (Decl) loop - -- The caller requests that the traversal stops at a particular node - -- that causes contract "freezing". - - if Present (Freeze_Nod) and then Decl = Freeze_Nod then - exit; - end if; - -- Entry or subprogram declarations if Nkind_In (Decl, N_Abstract_Subprogram_Declaration, @@ -388,7 +362,7 @@ package body Contracts is Subp_Id : constant Entity_Id := Defining_Entity (Decl); begin - Analyze_Entry_Or_Subprogram_Contract (Subp_Id, Freeze_Id); + Analyze_Entry_Or_Subprogram_Contract (Subp_Id); -- If analysis of a class-wide pre/postcondition indicates -- that a class-wide clone is needed, analyze its declaration @@ -410,9 +384,7 @@ package body Contracts is -- Objects elsif Nkind (Decl) = N_Object_Declaration then - Analyze_Object_Contract - (Obj_Id => Defining_Entity (Decl), - Freeze_Id => Freeze_Id); + Analyze_Object_Contract (Defining_Entity (Decl)); -- Protected units @@ -433,8 +405,9 @@ package body Contracts is then Analyze_Task_Contract (Defining_Entity (Decl)); - -- For type declarations, we need to do the pre-analysis of - -- Iterable aspect specifications. + -- For type declarations, we need to do the pre-analysis of Iterable + -- aspect specifications. + -- Other type aspects need to be resolved here??? elsif Nkind (Decl) = N_Private_Type_Declaration @@ -443,6 +416,7 @@ package body Contracts is declare E : constant Entity_Id := Defining_Identifier (Decl); It : constant Node_Id := Find_Aspect (E, Aspect_Iterable); + begin if Present (It) then Validate_Iterable_Aspect (E, It); @@ -1127,76 +1101,6 @@ package body Contracts is end Analyze_Package_Contract; -------------------------------- - -- Analyze_Previous_Contracts -- - -------------------------------- - - procedure Analyze_Previous_Contracts (Body_Decl : Node_Id) is - Body_Id : constant Entity_Id := Defining_Entity (Body_Decl); - Orig_Decl : constant Node_Id := Original_Node (Body_Decl); - - Par : Node_Id; - - begin - -- A body that is in the process of being inlined appears from source, - -- but carries name _parent. Such a body does not cause "freezing" of - -- contracts. - - if Chars (Body_Id) = Name_uParent then - return; - end if; - - -- Climb the parent chain looking for an enclosing package body. Do not - -- use the scope stack, as a body uses the entity of its corresponding - -- spec. - - Par := Parent (Body_Decl); - while Present (Par) loop - if Nkind (Par) = N_Package_Body then - Analyze_Package_Body_Contract - (Body_Id => Defining_Entity (Par), - Freeze_Id => Defining_Entity (Body_Decl)); - - exit; - - -- Do not look for an enclosing package body when the construct which - -- causes freezing is a body generated for an expression function and - -- it appears within a package spec. This ensures that the traversal - -- will not reach too far up the parent chain and attempt to freeze a - -- package body which should not be frozen. - - -- package body Enclosing_Body - -- with Refined_State => (State => Var) - -- is - -- package Nested is - -- type Some_Type is ...; - -- function Cause_Freezing return ...; - -- private - -- function Cause_Freezing is (...); - -- end Nested; - -- - -- Var : Nested.Some_Type; - - elsif Nkind (Par) = N_Package_Declaration - and then Nkind (Orig_Decl) = N_Expression_Function - then - exit; - end if; - - Par := Parent (Par); - end loop; - - -- Analyze the contracts of all eligible construct up to the body which - -- caused the "freezing". - - if Is_List_Member (Body_Decl) then - Analyze_Contracts - (L => List_Containing (Body_Decl), - Freeze_Nod => Body_Decl, - Freeze_Id => Body_Id); - end if; - end Analyze_Previous_Contracts; - - -------------------------------- -- Analyze_Protected_Contract -- -------------------------------- @@ -2393,6 +2297,11 @@ package body Contracts is end if; end Process_Contract_Cases_For; + pragma Unmodified (Stmts); + -- Stmts is passed as IN OUT to signal that the list can be updated, + -- even if the corresponding integer value representing the list does + -- not change. + -- Start of processing for Process_Contract_Cases begin @@ -2535,6 +2444,11 @@ package body Contracts is end loop; end Process_Spec_Postconditions; + pragma Unmodified (Stmts); + -- Stmts is passed as IN OUT to signal that the list can be updated, + -- even if the corresponding integer value representing the list does + -- not change. + -- Start of processing for Process_Postconditions begin @@ -3087,6 +3001,187 @@ package body Contracts is end if; end Expand_Subprogram_Contract; + ------------------------------- + -- Freeze_Previous_Contracts -- + ------------------------------- + + procedure Freeze_Previous_Contracts (Body_Decl : Node_Id) is + function Causes_Contract_Freezing (N : Node_Id) return Boolean; + pragma Inline (Causes_Contract_Freezing); + -- Determine whether arbitrary node N causes contract freezing + + procedure Freeze_Contracts; + pragma Inline (Freeze_Contracts); + -- Freeze the contracts of all eligible constructs which precede body + -- Body_Decl. + + procedure Freeze_Enclosing_Package_Body; + pragma Inline (Freeze_Enclosing_Package_Body); + -- Freeze the contract of the nearest package body (if any) which + -- encloses body Body_Decl. + + ------------------------------ + -- Causes_Contract_Freezing -- + ------------------------------ + + function Causes_Contract_Freezing (N : Node_Id) return Boolean is + begin + return Nkind_In (N, N_Entry_Body, + N_Package_Body, + N_Protected_Body, + N_Subprogram_Body, + N_Subprogram_Body_Stub, + N_Task_Body); + end Causes_Contract_Freezing; + + ---------------------- + -- Freeze_Contracts -- + ---------------------- + + procedure Freeze_Contracts is + Body_Id : constant Entity_Id := Defining_Entity (Body_Decl); + Decl : Node_Id; + + begin + -- Nothing to do when the body which causes freezing does not appear + -- in a declarative list because there cannot possibly be constructs + -- with contracts. + + if not Is_List_Member (Body_Decl) then + return; + end if; + + -- Inspect the declarations preceding the body, and freeze individual + -- contracts of eligible constructs. + + Decl := Prev (Body_Decl); + while Present (Decl) loop + + -- Stop the traversal when a preceding construct that causes + -- freezing is encountered as there is no point in refreezing + -- the already frozen constructs. + + if Causes_Contract_Freezing (Decl) then + exit; + + -- Entry or subprogram declarations + + elsif Nkind_In (Decl, N_Abstract_Subprogram_Declaration, + N_Entry_Declaration, + N_Generic_Subprogram_Declaration, + N_Subprogram_Declaration) + then + Analyze_Entry_Or_Subprogram_Contract + (Subp_Id => Defining_Entity (Decl), + Freeze_Id => Body_Id); + + -- Objects + + elsif Nkind (Decl) = N_Object_Declaration then + Analyze_Object_Contract + (Obj_Id => Defining_Entity (Decl), + Freeze_Id => Body_Id); + + -- Protected units + + elsif Nkind_In (Decl, N_Protected_Type_Declaration, + N_Single_Protected_Declaration) + then + Analyze_Protected_Contract (Defining_Entity (Decl)); + + -- Subprogram body stubs + + elsif Nkind (Decl) = N_Subprogram_Body_Stub then + Analyze_Subprogram_Body_Stub_Contract (Defining_Entity (Decl)); + + -- Task units + + elsif Nkind_In (Decl, N_Single_Task_Declaration, + N_Task_Type_Declaration) + then + Analyze_Task_Contract (Defining_Entity (Decl)); + end if; + + Prev (Decl); + end loop; + end Freeze_Contracts; + + ----------------------------------- + -- Freeze_Enclosing_Package_Body -- + ----------------------------------- + + procedure Freeze_Enclosing_Package_Body is + Orig_Decl : constant Node_Id := Original_Node (Body_Decl); + Par : Node_Id; + + begin + -- Climb the parent chain looking for an enclosing package body. Do + -- not use the scope stack, because a body utilizes the entity of its + -- corresponding spec. + + Par := Parent (Body_Decl); + while Present (Par) loop + if Nkind (Par) = N_Package_Body then + Analyze_Package_Body_Contract + (Body_Id => Defining_Entity (Par), + Freeze_Id => Defining_Entity (Body_Decl)); + + exit; + + -- Do not look for an enclosing package body when the construct + -- which causes freezing is a body generated for an expression + -- function and it appears within a package spec. This ensures + -- that the traversal will not reach too far up the parent chain + -- and attempt to freeze a package body which must not be frozen. + + -- package body Enclosing_Body + -- with Refined_State => (State => Var) + -- is + -- package Nested is + -- type Some_Type is ...; + -- function Cause_Freezing return ...; + -- private + -- function Cause_Freezing is (...); + -- end Nested; + -- + -- Var : Nested.Some_Type; + + elsif Nkind (Par) = N_Package_Declaration + and then Nkind (Orig_Decl) = N_Expression_Function + then + exit; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; + end Freeze_Enclosing_Package_Body; + + -- Local variables + + Body_Id : constant Entity_Id := Defining_Entity (Body_Decl); + + -- Start of processing for Freeze_Previous_Contracts + + begin + pragma Assert (Causes_Contract_Freezing (Body_Decl)); + + -- A body that is in the process of being inlined appears from source, + -- but carries name _parent. Such a body does not cause freezing of + -- contracts. + + if Chars (Body_Id) = Name_uParent then + return; + end if; + + Freeze_Enclosing_Package_Body; + Freeze_Contracts; + end Freeze_Previous_Contracts; + --------------------------------- -- Inherit_Subprogram_Contract -- --------------------------------- diff --git a/gcc/ada/contracts.ads b/gcc/ada/contracts.ads index d40200e183d..3d700cc9dd3 100644 --- a/gcc/ada/contracts.ads +++ b/gcc/ada/contracts.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2015-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2015-2017, 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- -- @@ -128,12 +128,6 @@ package Contracts is -- Initializes -- Part_Of - procedure Analyze_Previous_Contracts (Body_Decl : Node_Id); - -- Analyze the contracts of all source constructs found in the declarative - -- list which contains entry, package, protected, subprogram, or task body - -- denoted by Body_Decl. The analysis stops once Body_Decl is reached. In - -- addition, analyze the contract of the nearest enclosing package body. - procedure Analyze_Protected_Contract (Prot_Id : Entity_Id); -- Analyze all delayed pragmas chained on the contract of protected unit -- Prot_Id if they appeared at the end of a declarative region. Currently @@ -165,6 +159,12 @@ package Contracts is -- generic body denoted by Unit by collecting all source contract-related -- pragmas in the contract of the unit. + procedure Freeze_Previous_Contracts (Body_Decl : Node_Id); + -- Freeze the contracts of all source constructs found in the declarative + -- list which contains entry, package, protected, subprogram, or task body + -- denoted by Body_Decl. In addition, freeze the contract of the nearest + -- enclosing package body. + procedure Inherit_Subprogram_Contract (Subp : Entity_Id; From_Subp : Entity_Id); diff --git a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst index 7b647682314..1f56403f81a 100644 --- a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst +++ b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst @@ -988,6 +988,13 @@ appear, and that no wide or wide wide string or character literals appear in the program (that is literals representing characters not in type ``Character``). +Static_Dispatch_Tables +---------------------- +.. index:: Static_Dispatch_Tables + +[GNAT] This restriction checks at compile time that all the artifacts +associated with dispatch tables can be placed in read-only memory. + SPARK_05 -------- .. index:: SPARK_05 diff --git a/gcc/ada/doc/gnat_ugn/platform_specific_information.rst b/gcc/ada/doc/gnat_ugn/platform_specific_information.rst index 9b54803aeec..bbf790124cc 100644 --- a/gcc/ada/doc/gnat_ugn/platform_specific_information.rst +++ b/gcc/ada/doc/gnat_ugn/platform_specific_information.rst @@ -219,6 +219,36 @@ this in a library package body in your application: It gets the effective user id, and if it's not 0 (i.e. root), it raises Program_Error. +.. index:: Linux +.. index:: GNU/Linux + +.. _GNU_Linux_Topics: + +GNU/Linux Topics +================ + +This section describes topics that are specific to GNU/Linux platforms. + +.. _Required_packages_on_GNU_Linux: + +Required Packages on GNU/Linux: +------------------------------- + +GNAT requires the C library developer's package to be installed. +The name of of that package depends on your GNU/Linux distribution: + +* RedHat, SUSE: ``glibc-devel``; +* Debian, Ubuntu: ``libc6-dev`` (normally installed by default). + +If using the 32-bit version of GNAT on a 64-bit version of GNU/Linux, +you'll need the 32-bit version of that package instead: + +* RedHat, SUSE: ``glibc-devel.i686``; +* Debian, Ubuntu: ``libc6-dev:i386``. + +Other GNU/Linux distributions might be choosing a different name +for that package. + .. index:: Windows .. _Microsoft_Windows_Topics: diff --git a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst index 248bf8ef97f..48fedfea3a4 100644 --- a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst +++ b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst @@ -4356,7 +4356,7 @@ how to import these C++ declarations from the Ada side: type Dog is new Animal and Carnivore and Domestic with record Tooth_Count : Natural; - Owner : String (1 .. 30); + Owner : Chars_Ptr; end record; pragma Import (C_Plus_Plus, Dog); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 01d64f3aff5..94e326184eb 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -273,6 +273,7 @@ package body Einfo is -- Entry_Max_Queue_Lengths_Array Node35 -- Import_Pragma Node35 + -- Nested_Scenarios Elist36 -- Validated_Object Node36 -- Class_Wide_Clone Node38 @@ -2867,6 +2868,14 @@ package body Einfo is return Flag22 (Id); end Needs_No_Actuals; + function Nested_Scenarios (Id : E) return L is + begin + pragma Assert (Ekind_In (Id, E_Function, + E_Procedure, + E_Subprogram_Body)); + return Elist36 (Id); + end Nested_Scenarios; + function Never_Set_In_Source (Id : E) return B is begin return Flag115 (Id); @@ -6071,6 +6080,14 @@ package body Einfo is Set_Flag22 (Id, V); end Set_Needs_No_Actuals; + procedure Set_Nested_Scenarios (Id : E; V : L) is + begin + pragma Assert (Ekind_In (Id, E_Function, + E_Procedure, + E_Subprogram_Body)); + Set_Elist36 (Id, V); + end Set_Nested_Scenarios; + procedure Set_Never_Set_In_Source (Id : E; V : B := True) is begin Set_Flag115 (Id, V); @@ -11118,6 +11135,12 @@ package body Einfo is procedure Write_Field36_Name (Id : Entity_Id) is begin case Ekind (Id) is + when E_Function + | E_Procedure + | E_Subprogram_Body + => + Write_Str ("Nested_Scenarios"); + when E_Variable => Write_Str ("Validated_Object"); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index bfe14fcae7c..7bcf3f9298d 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3531,6 +3531,14 @@ package Einfo is -- interpreted as an indexing of the result of the call. It is also -- used to resolve various cases of entry calls. +-- Nested_Scenarios (Elist36) +-- Present in [stand alone] subprogram bodies. The list contains all +-- nested scenarios (see the terminology in Sem_Elab) which appear within +-- the declarations, statements, and exception handlers of the subprogram +-- body. The list improves the performance of the ABE Processing phase by +-- avoiding a full tree traversal when the same subprogram body is part +-- of several distinct paths in the elaboration graph. + -- Never_Set_In_Source (Flag115) -- Defined in all entities, but can be set only for variables and -- parameters. This flag is set if the object is never assigned a value @@ -6076,6 +6084,7 @@ package Einfo is -- Linker_Section_Pragma (Node33) -- Contract (Node34) -- Import_Pragma (Node35) (non-generic case only) + -- Nested_Scenarios (Elist36) -- Class_Wide_Clone (Node38) -- Protected_Subprogram (Node39) (non-generic case only) -- SPARK_Pragma (Node40) @@ -6398,6 +6407,7 @@ package Einfo is -- Linker_Section_Pragma (Node33) -- Contract (Node34) -- Import_Pragma (Node35) (non-generic case only) + -- Nested_Scenarios (Elist36) -- Class_Wide_Clone (Node38) -- Protected_Subprogram (Node39) (non-generic case only) -- SPARK_Pragma (Node40) @@ -6592,6 +6602,7 @@ package Einfo is -- Extra_Formals (Node28) -- Anonymous_Masters (Elist29) -- Contract (Node34) + -- Nested_Scenarios (Elist36) -- SPARK_Pragma (Node40) -- Contains_Ignored_Ghost_Code (Flag279) -- SPARK_Pragma_Inherited (Flag265) @@ -7308,6 +7319,7 @@ package Einfo is function Must_Have_Preelab_Init (Id : E) return B; function Needs_Debug_Info (Id : E) return B; function Needs_No_Actuals (Id : E) return B; + function Nested_Scenarios (Id : E) return L; function Never_Set_In_Source (Id : E) return B; function Next_Inlined_Subprogram (Id : E) return E; function No_Dynamic_Predicate_On_Actual (Id : E) return B; @@ -8005,6 +8017,7 @@ package Einfo is procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True); procedure Set_Needs_Debug_Info (Id : E; V : B := True); procedure Set_Needs_No_Actuals (Id : E; V : B := True); + procedure Set_Nested_Scenarios (Id : E; V : L); procedure Set_Never_Set_In_Source (Id : E; V : B := True); procedure Set_Next_Inlined_Subprogram (Id : E; V : E); procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True); @@ -8857,6 +8870,7 @@ package Einfo is pragma Inline (Must_Have_Preelab_Init); pragma Inline (Needs_Debug_Info); pragma Inline (Needs_No_Actuals); + pragma Inline (Nested_Scenarios); pragma Inline (Never_Set_In_Source); pragma Inline (Next_Index); pragma Inline (Next_Inlined_Subprogram); @@ -9343,6 +9357,7 @@ package Einfo is pragma Inline (Set_Must_Have_Preelab_Init); pragma Inline (Set_Needs_Debug_Info); pragma Inline (Set_Needs_No_Actuals); + pragma Inline (Set_Nested_Scenarios); pragma Inline (Set_Never_Set_In_Source); pragma Inline (Set_Next_Inlined_Subprogram); pragma Inline (Set_No_Dynamic_Predicate_On_Actual); diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index a402c684101..2b9664daac3 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -307,7 +307,7 @@ package body Errout is procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is begin - Error_Msg (Msg, Flag_Location, Empty); + Error_Msg (Msg, Flag_Location, Current_Node); end Error_Msg; procedure Error_Msg diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index e9c4eb47f7f..d3de0ad9ff3 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -68,6 +68,10 @@ package Errout is -- error message tag. The -gnatw.d switch sets this flag True, -gnatw.D -- sets this flag False. + Current_Node : Node_Id := Empty; + -- Used by Error_Msg as a default Node_Id. + -- Relevant only when Opt.Include_Subprogram_In_Messages is set. + ----------------------------------- -- Suppression of Error Messages -- ----------------------------------- diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 86621a4a06a..919f46fde00 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -428,7 +428,7 @@ package body Exp_Aggr is -- Start of processing for Aggr_Size_OK begin - -- The normal aggregate limit is 50000, but we increase this limit to + -- The normal aggregate limit is 500000, but we increase this limit to -- 2**24 (about 16 million) if Restrictions (No_Elaboration_Code) or -- Restrictions (No_Implicit_Loops) is specified, since in either case -- we are at risk of declaring the program illegal because of this @@ -448,7 +448,7 @@ package body Exp_Aggr is -- Finally, we use a small limit in CodePeer mode where we favor loops -- instead of thousands of single assignments (from large aggregates). - Max_Aggr_Size := 50000; + Max_Aggr_Size := 500000; if CodePeer_Mode then Max_Aggr_Size := 100; @@ -7533,7 +7533,7 @@ package body Exp_Aggr is Typ : constant Entity_Id := Base_Type (Etype (N)); begin - return Static_Dispatch_Tables + return Building_Static_Dispatch_Tables and then Tagged_Type_Expansion and then RTU_Loaded (Ada_Tags) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 70d39b7a916..79c6524769b 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1054,7 +1054,7 @@ package body Exp_Attr is Base_Typ : constant Entity_Id := Base_Type (Etype (Pref)); Exprs : constant List_Id := Expressions (N); Aux_Decl : Node_Id; - Blk : Node_Id; + Blk : Node_Id := Empty; Decls : List_Id; Installed : Boolean; Loc : Source_Ptr; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 7941cbd2ca6..c4bf096cab7 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1855,11 +1855,13 @@ package body Exp_Ch11 is -- and the warning is enabled, generate the appropriate warnings. -- ??? Do not do it for the Call_Marker nodes inserted by the ABE - -- mechanism because this generates too many false positives. + -- mechanism because this generates too many false positives, or + -- for generic instantiations for the same reason. elsif Warn_On_Non_Local_Exception and then Restriction_Active (No_Exception_Propagation) and then Nkind (N) /= N_Call_Marker + and then Nkind (N) not in N_Generic_Instantiation then Warn_No_Exception_Propagation_Active (N); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 043a02c64ba..f21806923da 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2176,7 +2176,7 @@ package body Exp_Ch3 is -- Generate -- function Fxx (O : in Rec_Typ) return Storage_Offset is -- begin - -- return O.Iface_Comp'Position; + -- return -O.Iface_Comp'Position; -- end Fxx; Body_Node := New_Node (N_Subprogram_Body, Loc); @@ -2199,15 +2199,16 @@ package body Exp_Ch3 is Statements => New_List ( Make_Simple_Return_Statement (Loc, Expression => - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => - Unchecked_Convert_To (Acc_Type, - Make_Identifier (Loc, Name_uO)), - Selector_Name => - New_Occurrence_Of (Iface_Comp, Loc)), - Attribute_Name => Name_Position))))); + Make_Op_Minus (Loc, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => + Unchecked_Convert_To (Acc_Type, + Make_Identifier (Loc, Name_uO)), + Selector_Name => + New_Occurrence_Of (Iface_Comp, Loc)), + Attribute_Name => Name_Position)))))); Set_Ekind (Func_Id, E_Function); Set_Mechanism (Func_Id, Default_Mechanism); @@ -2544,6 +2545,7 @@ package body Exp_Ch3 is then declare Elab_Sec_DT_Stmts_List : constant List_Id := New_List; + Elab_List : List_Id := New_List; begin Init_Secondary_Tags @@ -2554,24 +2556,30 @@ package body Exp_Ch3 is Fixed_Comps => True, Variable_Comps => False); - Append_To (Elab_Sec_DT_Stmts_List, - Make_Assignment_Statement (Loc, - Name => - New_Occurrence_Of - (Access_Disp_Table_Elab_Flag (Rec_Type), Loc), - Expression => - New_Occurrence_Of (Standard_False, Loc))); - - Prepend_List_To (Body_Stmts, New_List ( + Elab_List := New_List ( Make_If_Statement (Loc, Condition => New_Occurrence_Of (Set_Tag, Loc), - Then_Statements => Init_Tags_List), + Then_Statements => Init_Tags_List)); + + if Elab_Flag_Needed (Rec_Type) then + Append_To (Elab_Sec_DT_Stmts_List, + Make_Assignment_Statement (Loc, + Name => + New_Occurrence_Of + (Access_Disp_Table_Elab_Flag (Rec_Type), + Loc), + Expression => + New_Occurrence_Of (Standard_False, Loc))); + + Append_To (Elab_List, + Make_If_Statement (Loc, + Condition => + New_Occurrence_Of + (Access_Disp_Table_Elab_Flag (Rec_Type), Loc), + Then_Statements => Elab_Sec_DT_Stmts_List)); + end if; - Make_If_Statement (Loc, - Condition => - New_Occurrence_Of - (Access_Disp_Table_Elab_Flag (Rec_Type), Loc), - Then_Statements => Elab_Sec_DT_Stmts_List))); + Prepend_List_To (Body_Stmts, Elab_List); end; else Prepend_To (Body_Stmts, @@ -6279,7 +6287,7 @@ package body Exp_Ch3 is -- Force construction of dispatch tables of library level tagged types if Tagged_Type_Expansion - and then Static_Dispatch_Tables + and then Building_Static_Dispatch_Tables and then Is_Library_Level_Entity (Def_Id) and then Is_Library_Level_Tagged_Type (Base_Typ) and then Ekind_In (Base_Typ, E_Record_Type, @@ -6727,8 +6735,11 @@ package body Exp_Ch3 is declare New_Id : constant Entity_Id := Defining_Identifier (N); Next_Temp : constant Entity_Id := Next_Entity (New_Id); - S_Flag : constant Boolean := + Save_CFS : constant Boolean := Comes_From_Source (Def_Id); + Save_SP : constant Node_Id := SPARK_Pragma (Def_Id); + Save_SPI : constant Boolean := + SPARK_Pragma_Inherited (Def_Id); begin Set_Next_Entity (New_Id, Next_Entity (Def_Id)); @@ -6740,8 +6751,20 @@ package body Exp_Ch3 is Set_Sloc (Defining_Identifier (N), Sloc (Def_Id)); Set_Comes_From_Source (Def_Id, False); + + -- ??? This is extremely dangerous!!! Exchanging entities + -- is very low level, and as a result it resets flags and + -- fields which belong to the original Def_Id. Several of + -- these attributes are saved and restored, but there may + -- be many more that need to be preserverd. + Exchange_Entities (Defining_Identifier (N), Def_Id); - Set_Comes_From_Source (Def_Id, S_Flag); + + -- Restore clobbered attributes + + Set_Comes_From_Source (Def_Id, Save_CFS); + Set_SPARK_Pragma (Def_Id, Save_SP); + Set_SPARK_Pragma_Inherited (Def_Id, Save_SPI); end; end; end if; @@ -8501,13 +8524,14 @@ package body Exp_Ch3 is Unchecked_Convert_To (RTE (RE_Storage_Offset), - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => New_Copy_Tree (Target), - Selector_Name => - New_Occurrence_Of (Tag_Comp, Loc)), - Attribute_Name => Name_Position)), + Make_Op_Minus (Loc, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => New_Copy_Tree (Target), + Selector_Name => + New_Occurrence_Of (Tag_Comp, Loc)), + Attribute_Name => Name_Position))), Unchecked_Convert_To (RTE (RE_Offset_To_Top_Function_Ptr), Make_Attribute_Reference (Loc, @@ -8530,12 +8554,13 @@ package body Exp_Ch3 is New_Occurrence_Of (Offset_To_Top_Comp, Loc)), Expression => - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => New_Copy_Tree (Target), - Selector_Name => New_Occurrence_Of (Tag_Comp, Loc)), - Attribute_Name => Name_Position))); + Make_Op_Minus (Loc, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => New_Copy_Tree (Target), + Selector_Name => New_Occurrence_Of (Tag_Comp, Loc)), + Attribute_Name => Name_Position)))); -- Normal case: No discriminants in the parent type @@ -8552,13 +8577,14 @@ package body Exp_Ch3 is Iface_Tag => New_Occurrence_Of (Iface_Tag, Loc), Offset_Value => Unchecked_Convert_To (RTE (RE_Storage_Offset), - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => New_Copy_Tree (Target), - Selector_Name => - New_Occurrence_Of (Tag_Comp, Loc)), - Attribute_Name => Name_Position)))); + Make_Op_Minus (Loc, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => New_Copy_Tree (Target), + Selector_Name => + New_Occurrence_Of (Tag_Comp, Loc)), + Attribute_Name => Name_Position))))); end if; -- Generate: @@ -8569,7 +8595,9 @@ package body Exp_Ch3 is -- Offset_Value => n, -- Offset_Func => null); - if RTE_Available (RE_Register_Interface_Offset) then + if not Building_Static_Secondary_DT (Typ) + and then RTE_Available (RE_Register_Interface_Offset) + then Append_To (Stmts_List, Make_Procedure_Call_Statement (Loc, Name => @@ -8587,13 +8615,14 @@ package body Exp_Ch3 is New_Occurrence_Of (Standard_True, Loc), Unchecked_Convert_To (RTE (RE_Storage_Offset), - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => New_Copy_Tree (Target), - Selector_Name => - New_Occurrence_Of (Tag_Comp, Loc)), - Attribute_Name => Name_Position)), + Make_Op_Minus (Loc, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => New_Copy_Tree (Target), + Selector_Name => + New_Occurrence_Of (Tag_Comp, Loc)), + Attribute_Name => Name_Position))), Make_Null (Loc)))); end if; @@ -8697,15 +8726,11 @@ package body Exp_Ch3 is -- Initialize secondary tags else - Append_To (Init_Tags_List, - Make_Assignment_Statement (Loc, - Name => - Make_Selected_Component (Loc, - Prefix => New_Copy_Tree (Target), - Selector_Name => - New_Occurrence_Of (Node (Iface_Comp_Elmt), Loc)), - Expression => - New_Occurrence_Of (Node (Iface_Tag_Elmt), Loc))); + Initialize_Tag + (Typ => Full_Typ, + Iface => Node (Iface_Elmt), + Tag_Comp => Tag_Comp, + Iface_Tag => Node (Iface_Tag_Elmt)); end if; -- Otherwise generate code to initialize the tag @@ -8714,10 +8739,11 @@ package body Exp_Ch3 is if (In_Variable_Pos and then Variable_Comps) or else (not In_Variable_Pos and then Fixed_Comps) then - Initialize_Tag (Full_Typ, - Iface => Node (Iface_Elmt), - Tag_Comp => Tag_Comp, - Iface_Tag => Node (Iface_Tag_Elmt)); + Initialize_Tag + (Typ => Full_Typ, + Iface => Node (Iface_Elmt), + Tag_Comp => Tag_Comp, + Iface_Tag => Node (Iface_Tag_Elmt)); end if; end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index abf6d635451..88303c66861 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -630,7 +630,9 @@ package body Exp_Ch4 is -- [Deep_]Finalize (Obj_Ref.all); - if Needs_Finalization (DesigT) then + if Needs_Finalization (DesigT) + and then not No_Heap_Finalization (PtrT) + then Fin_Call := Make_Final_Call (Obj_Ref => @@ -2764,7 +2766,7 @@ package body Exp_Ch4 is -- special case of setting the right high bound for a null result. -- This is of type Ityp. - High_Bound : Node_Id; + High_Bound : Node_Id := Empty; -- A tree node representing the high bound of the result (of type Ityp) Result : Node_Id; @@ -4798,7 +4800,7 @@ package body Exp_Ch4 is declare Dis : Boolean := False; - Typ : Entity_Id; + Typ : Entity_Id := Empty; begin if Has_Discriminants (T) then @@ -10747,6 +10749,8 @@ package body Exp_Ch4 is if Present (Stored) then Elmt := First_Elmt (Stored); + else + Elmt := No_Elmt; -- init to avoid warning end if; Cons := New_List; @@ -11277,6 +11281,7 @@ package body Exp_Ch4 is elsif In_Instance_Body and then Ekind (Operand_Type) = E_Anonymous_Access_Type and then Nkind (Operand) = N_Selected_Component + and then Ekind (Entity (Selector_Name (Operand))) = E_Discriminant and then Object_Access_Level (Operand) > Type_Access_Level (Target_Type) then @@ -13109,10 +13114,10 @@ package body Exp_Ch4 is Comp : Node_Id; -- Comparison operand, set only if Is_Zero is false - Ent : Entity_Id; + Ent : Entity_Id := Empty; -- Entity whose length is being compared - Index : Node_Id; + Index : Node_Id := Empty; -- Integer_Literal node for length attribute expression, or Empty -- if there is no such expression present. diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 9d2f652f119..d98e725d85f 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -4769,8 +4769,8 @@ package body Exp_Ch5 is -- If the domain is an itype, note the bounds of its range. - L_Hi : Node_Id; - L_Lo : Node_Id; + L_Hi : Node_Id := Empty; + L_Lo : Node_Id := Empty; function Lo_Val (N : Node_Id) return Node_Id; -- Given static expression or static range, returns an identifier diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index bca7e5deae4..357979e663e 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4721,9 +4721,11 @@ package body Exp_Ch6 is Exp : Node_Id; HSS : Node_Id; Result : Node_Id; - Return_Stmt : Node_Id; Stmts : List_Id; + Return_Stmt : Node_Id := Empty; + -- Force initialization to facilitate static analysis + -- Start of processing for Expand_N_Extended_Return_Statement begin diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 063b812f9bc..d94a72ffeb8 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -6189,8 +6189,7 @@ package body Exp_Ch9 is Cond_Id : Entity_Id; Entry_Body : Node_Id; - Func_Body : Node_Id; - pragma Warnings (Off, Func_Body); + Func_Body : Node_Id := Empty; -- Start of processing for Expand_Entry_Barrier @@ -12356,7 +12355,7 @@ package body Exp_Ch9 is Call : Node_Id; Call_Ent : Entity_Id; Conc_Typ_Stmts : List_Id; - Concval : Node_Id; + Concval : Node_Id := Empty; -- init to avoid warning D_Alt : constant Node_Id := Delay_Alternative (N); D_Conv : Node_Id; D_Disc : Node_Id; @@ -12909,8 +12908,8 @@ package body Exp_Ch9 is end if; -- If the type of the dispatching object is an access type then return - -- an explicit dereference of a copy of the object, and note that - -- this is the controlling actual of the call. + -- an explicit dereference of a copy of the object, and note that this + -- is the controlling actual of the call. if Is_Access_Type (Etype (Object)) then Object := @@ -14590,9 +14589,9 @@ package body Exp_Ch9 is -- Jnn'unchecked_access - -- and add it to aggegate for access to formals. Note that - -- the actual may be by-copy but still be a controlling actual - -- if it is an access to class-wide interface. + -- and add it to aggegate for access to formals. Note that the + -- actual may be by-copy but still be a controlling actual if it + -- is an access to class-wide interface. if not Is_Controlling_Actual (Actual) then Append_To (Params, diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index f3728f655d4..926df631ac9 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -281,7 +281,8 @@ package body Exp_Disp is ------------------------ function Building_Static_DT (Typ : Entity_Id) return Boolean is - Root_Typ : Entity_Id := Root_Type (Typ); + Root_Typ : Entity_Id := Root_Type (Typ); + Static_DT : Boolean; begin -- Handle private types @@ -290,14 +291,21 @@ package body Exp_Disp is Root_Typ := Full_View (Root_Typ); end if; - return Static_Dispatch_Tables - and then Is_Library_Level_Tagged_Type (Typ) + Static_DT := + Building_Static_Dispatch_Tables + and then Is_Library_Level_Tagged_Type (Typ) - -- If the type is derived from a CPP class we cannot statically - -- build the dispatch tables because we must inherit primitives - -- from the CPP side. + -- If the type is derived from a CPP class we cannot statically + -- build the dispatch tables because we must inherit primitives + -- from the CPP side. - and then not Is_CPP_Class (Root_Typ); + and then not Is_CPP_Class (Root_Typ); + + if not Static_DT then + Check_Restriction (Static_Dispatch_Tables, Typ); + end if; + + return Static_DT; end Building_Static_DT; ---------------------------------- @@ -305,8 +313,9 @@ package body Exp_Disp is ---------------------------------- function Building_Static_Secondary_DT (Typ : Entity_Id) return Boolean is - Full_Typ : Entity_Id := Typ; - Root_Typ : Entity_Id := Root_Type (Typ); + Full_Typ : Entity_Id := Typ; + Root_Typ : Entity_Id := Root_Type (Typ); + Static_DT : Boolean; begin -- Handle private types @@ -319,11 +328,21 @@ package body Exp_Disp is Root_Typ := Full_View (Root_Typ); end if; - return Building_Static_DT (Full_Typ) + Static_DT := + Building_Static_DT (Full_Typ) + and then not Is_Interface (Full_Typ) + and then Has_Interfaces (Full_Typ) + and then (Full_Typ = Root_Typ + or else not Is_Variable_Size_Record (Etype (Full_Typ))); + + if not Static_DT and then not Is_Interface (Full_Typ) and then Has_Interfaces (Full_Typ) - and then (Full_Typ = Root_Typ - or else not Is_Variable_Size_Record (Etype (Full_Typ))); + then + Check_Restriction (Static_Dispatch_Tables, Typ); + end if; + + return Static_DT; end Building_Static_Secondary_DT; ---------------------------------- @@ -660,7 +679,8 @@ package body Exp_Disp is begin return Ada_Version >= Ada_2005 and then not Is_Interface (Typ) - and then Has_Interfaces (Typ); + and then Has_Interfaces (Typ) + and then not Building_Static_DT (Typ); end Elab_Flag_Needed; ----------------------------- @@ -1884,7 +1904,7 @@ package body Exp_Disp is -- Generate: -- type T is access all <<type of the target formal>> -- S : Storage_Offset := Storage_Offset!(Formal) - -- - Offset_To_Top (address!(Formal)) + -- + Offset_To_Top (address!(Formal)) Decl_2 := Make_Full_Type_Declaration (Loc, @@ -1918,7 +1938,7 @@ package body Exp_Disp is Object_Definition => New_Occurrence_Of (RTE (RE_Storage_Offset), Loc), Expression => - Make_Op_Subtract (Loc, + Make_Op_Add (Loc, Left_Opnd => Unchecked_Convert_To (RTE (RE_Storage_Offset), @@ -1942,7 +1962,7 @@ package body Exp_Disp is -- Generate: -- S1 : Storage_Offset := Storage_Offset!(Formal'Address) - -- - Offset_To_Top (Formal'Address) + -- + Offset_To_Top (Formal'Address) -- S2 : Addr_Ptr := Addr_Ptr!(S1) New_Arg := @@ -1969,7 +1989,7 @@ package body Exp_Disp is Object_Definition => New_Occurrence_Of (RTE (RE_Storage_Offset), Loc), Expression => - Make_Op_Subtract (Loc, + Make_Op_Add (Loc, Left_Opnd => Unchecked_Convert_To (RTE (RE_Storage_Offset), @@ -4234,14 +4254,15 @@ package body Exp_Disp is else Append_To (DT_Aggr_List, - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => - New_Occurrence_Of (Dummy_Object, Loc), - Selector_Name => - New_Occurrence_Of (Iface_Comp, Loc)), - Attribute_Name => Name_Position)); + Make_Op_Minus (Loc, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => + New_Occurrence_Of (Dummy_Object, Loc), + Selector_Name => + New_Occurrence_Of (Iface_Comp, Loc)), + Attribute_Name => Name_Position))); end if; -- Generate the Object Specific Data table required to dispatch calls @@ -5102,7 +5123,8 @@ package body Exp_Disp is Append_To (Result, Make_Object_Declaration (Loc, Defining_Identifier => HT_Link, - Object_Definition => New_Occurrence_Of (RTE (RE_Tag), Loc))); + Object_Definition => New_Occurrence_Of (RTE (RE_Tag), Loc), + Expression => New_Occurrence_Of (RTE (RE_No_Tag), Loc))); end if; -- Generate code to create the storage for the type specific data object @@ -5370,7 +5392,8 @@ package body Exp_Disp is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (HT_Link, Loc), Attribute_Name => Name_Address))); - else + + elsif RTE_Record_Component_Available (RE_HT_Link) then Append_To (TSD_Aggr_List, Unchecked_Convert_To (RTE (RE_Tag_Ptr), New_Occurrence_Of (RTE (RE_Null_Address), Loc))); @@ -5494,16 +5517,28 @@ package body Exp_Disp is else declare - TSD_Ifaces_List : constant List_Id := New_List; - Elmt : Elmt_Id; - Sec_DT_Tag : Node_Id; + TSD_Ifaces_List : constant List_Id := New_List; + Elmt : Elmt_Id; + Ifaces_List : Elist_Id := No_Elist; + Ifaces_Comp_List : Elist_Id := No_Elist; + Ifaces_Tag_List : Elist_Id; + Offset_To_Top : Node_Id; + Sec_DT_Tag : Node_Id; begin + -- Collect interfaces information if we need to compute the + -- offset to the top using the dummy object. + + if Present (Dummy_Object) then + Collect_Interfaces_Info (Typ, + Ifaces_List, Ifaces_Comp_List, Ifaces_Tag_List); + end if; + AI := First_Elmt (Typ_Ifaces); while Present (AI) loop if Is_Ancestor (Node (AI), Typ, Use_Full_View => True) then - Sec_DT_Tag := - New_Occurrence_Of (DT_Ptr, Loc); + Sec_DT_Tag := New_Occurrence_Of (DT_Ptr, Loc); + else Elmt := Next_Elmt @@ -5511,9 +5546,9 @@ package body Exp_Disp is pragma Assert (Has_Thunks (Node (Elmt))); while Is_Tag (Node (Elmt)) - and then not - Is_Ancestor (Node (AI), Related_Type (Node (Elmt)), - Use_Full_View => True) + and then not + Is_Ancestor (Node (AI), Related_Type (Node (Elmt)), + Use_Full_View => True) loop pragma Assert (Has_Thunks (Node (Elmt))); Next_Elmt (Elmt); @@ -5528,14 +5563,56 @@ package body Exp_Disp is pragma Assert (Ekind (Node (Elmt)) = E_Constant and then not Has_Thunks (Node (Next_Elmt (Next_Elmt (Elmt))))); + Sec_DT_Tag := - New_Occurrence_Of (Node (Next_Elmt (Next_Elmt (Elmt))), - Loc); + New_Occurrence_Of + (Node (Next_Elmt (Next_Elmt (Elmt))), Loc); + end if; + + -- For static dispatch tables compute Offset_To_Top using + -- the dummy object. + + if Present (Dummy_Object) then + declare + Iface : constant Node_Id := Node (AI); + Iface_Comp : Node_Id := Empty; + Iface_Comp_Elmt : Elmt_Id; + Iface_Elmt : Elmt_Id; + + begin + Iface_Elmt := First_Elmt (Ifaces_List); + Iface_Comp_Elmt := First_Elmt (Ifaces_Comp_List); + + while Present (Iface_Elmt) loop + if Node (Iface_Elmt) = Iface then + Iface_Comp := Node (Iface_Comp_Elmt); + exit; + end if; + + Next_Elmt (Iface_Elmt); + Next_Elmt (Iface_Comp_Elmt); + end loop; + + pragma Assert (Present (Iface_Comp)); + + Offset_To_Top := + Make_Op_Minus (Loc, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => + New_Occurrence_Of (Dummy_Object, Loc), + Selector_Name => + New_Occurrence_Of (Iface_Comp, Loc)), + Attribute_Name => Name_Position)); + end; + else + Offset_To_Top := Make_Integer_Literal (Loc, 0); end if; Append_To (TSD_Ifaces_List, - Make_Aggregate (Loc, - Expressions => New_List ( + Make_Aggregate (Loc, + Expressions => New_List ( -- Iface_Tag @@ -5550,7 +5627,7 @@ package body Exp_Disp is -- Offset_To_Top_Value - Make_Integer_Literal (Loc, 0), + Offset_To_Top, -- Offset_To_Top_Func @@ -5558,9 +5635,7 @@ package body Exp_Disp is -- Secondary_DT - Unchecked_Convert_To (RTE (RE_Tag), Sec_DT_Tag) - - ))); + Unchecked_Convert_To (RTE (RE_Tag), Sec_DT_Tag)))); Next_Elmt (AI); end loop; @@ -5570,17 +5645,15 @@ package body Exp_Disp is Set_Is_Statically_Allocated (ITable, Is_Library_Level_Tagged_Type (Typ)); - -- The table of interfaces is not constant; its slots are - -- filled at run time by the IP routine using attribute - -- 'Position to know the location of the tag components - -- (and this attribute cannot be safely used before the - -- object is initialized). + -- The table of interfaces is constant if we are building a + -- static dispatch table; otherwise is not constant because + -- its slots are filled at run time by the IP routine. Append_To (Result, Make_Object_Declaration (Loc, Defining_Identifier => ITable, Aliased_Present => True, - Constant_Present => False, + Constant_Present => Present (Dummy_Object), Object_Definition => Make_Subtype_Indication (Loc, Subtype_Mark => @@ -5590,10 +5663,11 @@ package body Exp_Disp is Constraints => New_List ( Make_Integer_Literal (Loc, Num_Ifaces)))), - Expression => Make_Aggregate (Loc, - Expressions => New_List ( - Make_Integer_Literal (Loc, Num_Ifaces), - Make_Aggregate (Loc, TSD_Ifaces_List))))); + Expression => + Make_Aggregate (Loc, + Expressions => New_List ( + Make_Integer_Literal (Loc, Num_Ifaces), + Make_Aggregate (Loc, TSD_Ifaces_List))))); Append_To (Result, Make_Attribute_Definition_Clause (Loc, diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 78777075d8b..6f6b008f99f 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -436,7 +436,7 @@ package body Exp_Imgv is Imid : RE_Id; Ptyp : Entity_Id; Rtyp : Entity_Id; - Tent : Entity_Id; + Tent : Entity_Id := Empty; Ttyp : Entity_Id; Proc_Ent : Entity_Id; Enum_Case : Boolean; diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 6de8952ae85..bca7301449f 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -924,7 +924,8 @@ package body Exp_Intr is Arg : constant Node_Id := First_Actual (N); Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (Arg); - Desig_Typ : constant Entity_Id := Designated_Type (Typ); + Desig_Typ : constant Entity_Id := + Available_View (Designated_Type (Typ)); Needs_Fin : constant Boolean := Needs_Finalization (Desig_Typ); Root_Typ : constant Entity_Id := Underlying_Type (Root_Type (Typ)); Pool : constant Entity_Id := Associated_Storage_Pool (Root_Typ); diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index dfed6af66a7..a92db56b525 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -1090,7 +1090,7 @@ package body Exp_Prag is Conseq_Checks : Node_Id := Empty; Count : Entity_Id; Count_Decl : Node_Id; - Error_Decls : List_Id; + Error_Decls : List_Id := No_List; -- init to avoid warning Flag : Entity_Id; Flag_Decl : Node_Id; If_Stmt : Node_Id; diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index 5386fa6578b..43ca12f7940 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -349,7 +349,7 @@ package body Exp_SPARK is Loc : constant Source_Ptr := Sloc (N); Obj_Id : constant Entity_Id := Defining_Entity (N); Nam : constant Node_Id := Name (N); - Typ : constant Entity_Id := Etype (Subtype_Mark (N)); + Typ : constant Entity_Id := Etype (Obj_Id); begin -- Transform a renaming of the form diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 8fdd8aa8200..6ebcc4c9794 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -165,11 +165,6 @@ package body Exp_Util is -- Force evaluation of bounds of a slice, which may be given by a range -- or by a subtype indication with or without a constraint. - function Find_DIC_Type (Typ : Entity_Id) return Entity_Id; - -- Subsidiary to all Build_DIC_Procedure_xxx routines. Find the type which - -- defines the Default_Initial_Condition pragma of type Typ. This is either - -- Typ itself or a parent type when the pragma is inherited. - function Make_CW_Equivalent_Type (T : Entity_Id; E : Node_Id) return Entity_Id; @@ -4996,7 +4991,7 @@ package body Exp_Util is -- is transformed into - -- Val : Constrained_Subtype_of_T := Maybe_Modified_Expr; + -- Val : Constrained_Subtype_Of_T := Maybe_Modified_Expr; -- -- Here are the main cases : -- @@ -5389,66 +5384,6 @@ package body Exp_Util is return TSS (Utyp, TSS_Finalize_Address); end Finalize_Address; - ------------------- - -- Find_DIC_Type -- - ------------------- - - function Find_DIC_Type (Typ : Entity_Id) return Entity_Id is - Curr_Typ : Entity_Id; - -- The current type being examined in the parent hierarchy traversal - - DIC_Typ : Entity_Id; - -- The type which carries the DIC pragma. This variable denotes the - -- partial view when private types are involved. - - Par_Typ : Entity_Id; - -- The parent type of the current type. This variable denotes the full - -- view when private types are involved. - - begin - -- The input type defines its own DIC pragma, therefore it is the owner - - if Has_Own_DIC (Typ) then - DIC_Typ := Typ; - - -- Otherwise the DIC pragma is inherited from a parent type - - else - pragma Assert (Has_Inherited_DIC (Typ)); - - -- Climb the parent chain - - Curr_Typ := Typ; - loop - -- Inspect the parent type. Do not consider subtypes as they - -- inherit the DIC attributes from their base types. - - DIC_Typ := Base_Type (Etype (Curr_Typ)); - - -- Look at the full view of a private type because the type may - -- have a hidden parent introduced in the full view. - - Par_Typ := DIC_Typ; - - if Is_Private_Type (Par_Typ) - and then Present (Full_View (Par_Typ)) - then - Par_Typ := Full_View (Par_Typ); - end if; - - -- Stop the climb once the nearest parent type which defines a DIC - -- pragma of its own is encountered or when the root of the parent - -- chain is reached. - - exit when Has_Own_DIC (DIC_Typ) or else Curr_Typ = Par_Typ; - - Curr_Typ := Par_Typ; - end loop; - end if; - - return DIC_Typ; - end Find_DIC_Type; - ------------------------ -- Find_Interface_ADT -- ------------------------ @@ -5512,7 +5447,7 @@ package body Exp_Util is (T : Entity_Id; Iface : Entity_Id) return Entity_Id is - AI_Tag : Entity_Id; + AI_Tag : Entity_Id := Empty; Found : Boolean := False; Typ : Entity_Id := T; @@ -7255,9 +7190,11 @@ package body Exp_Util is null; end if; - -- Special case: a call marker + -- Special case: a marker - when N_Call_Marker => + when N_Call_Marker + | N_Variable_Reference_Marker + => if Is_List_Member (P) then Insert_List_Before_And_Analyze (P, Ins_Actions); return; @@ -11074,11 +11011,11 @@ package body Exp_Util is Scope_Suppress.Suppress := (others => True); - -- If this is an elementary or a small not by-reference record type, and + -- If this is an elementary or a small not-by-reference record type, and -- we need to capture the value, just make a constant; this is cheap and -- objects of both kinds of types can be bit aligned, so it might not be -- possible to generate a reference to them. Likewise if this is not a - -- name reference, except for a type conversion because we would enter + -- name reference, except for a type conversion, because we would enter -- an infinite recursion with Checks.Apply_Predicate_Check if the target -- type has predicates (and type conversions need a specific treatment -- anyway, see below). Also do it if we have a volatile reference and diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index 2bdfbf685d9..96d813adbad 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.adb @@ -167,8 +167,11 @@ package body Fname is is begin -- Definitely false if longer than 12 characters (8.3) + -- except for the Interfaces packages - if Fname'Length > 12 then + if Fname'Length > 12 + and then Fname (Fname'First .. Fname'First + 1) /= "i-" + then return False; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index a106d68ae86..bc7694cd170 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1173,8 +1173,7 @@ package body Freeze is Component_Aliased : Boolean; - Comp_Byte_Aligned : Boolean; - pragma Warnings (Off, Comp_Byte_Aligned); + Comp_Byte_Aligned : Boolean := False; -- Set for the record case, True if Comp is aligned on byte boundaries -- (in which case it is allowed to have different storage order). @@ -2788,7 +2787,6 @@ package body Freeze is elsif Csiz mod System_Storage_Unit = 0 and then Is_Composite_Type (Ctyp) then - Set_Is_Packed (Base_Type (Arr), True); Set_Has_Non_Standard_Rep (Base_Type (Arr), True); Set_Is_Bit_Packed_Array (Base_Type (Arr), False); diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 9c7b6e1496f..d51d3973b4d 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -322,7 +322,6 @@ GNAT_ADA_OBJS = \ ada/libgnat/g-spchge.o \ ada/libgnat/g-speche.o \ ada/libgnat/g-u3spch.o \ - ada/get_spark_xrefs.o \ ada/get_targ.o \ ada/ghost.o \ ada/libgnat/gnat.o \ @@ -352,7 +351,6 @@ GNAT_ADA_OBJS = \ ada/par_sco.o \ ada/prep.o \ ada/prepcomp.o \ - ada/put_spark_xrefs.o \ ada/put_scos.o \ ada/repinfo.o \ ada/restrict.o \ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index b1621d11b11..749dbbfec47 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1,5 +1,5 @@ # Makefile for GNU Ada Compiler (GNAT). -# Copyright (C) 1994-2016 Free Software Foundation, Inc. +# Copyright (C) 1994-2017 Free Software Foundation, Inc. #This file is part of GCC. @@ -887,6 +887,37 @@ ifeq ($(strip $(filter-out arm% linux-androideabi,$(target_cpu) $(target_os))),) LIBRARY_VERSION := $(LIB_VERSION) endif +# AARCH64 QNX +ifeq ($(strip $(filter-out aarch64 %qnx,$(target_cpu) $(target_os))),) + LIBGNAT_TARGET_PAIRS = \ + a-intnam.ads<libgnarl/a-intnam__qnx.ads \ + s-inmaop.adb<libgnarl/s-inmaop__posix.adb \ + s-intman.adb<libgnarl/s-intman__qnx.adb \ + s-osinte.adb<libgnarl/s-osinte__qnx.adb \ + s-osinte.ads<libgnarl/s-osinte__qnx.ads \ + s-osprim.adb<libgnat/s-osprim__posix.adb \ + s-qnx.ads<libgnarl/s-qnx.ads \ + s-taprop.adb<libgnarl/s-taprop__qnx.adb \ + s-taspri.ads<libgnarl/s-taspri__posix.ads \ + s-tpopsp.adb<libgnarl/s-tpopsp__posix-foreign.adb \ + $(ATOMICS_TARGET_PAIRS) \ + $(ATOMICS_BUILTINS_TARGET_PAIRS) \ + system.ads<libgnat/system-qnx-aarch64.ads + + TOOLS_TARGET_PAIRS = indepsw.adb<indepsw-gnu.adb + + EXTRA_GNATRTL_TASKING_OBJS=s-qnx.o + EXTRA_LIBGNAT_OBJS+=sigtramp-qnx.o + EXTRA_LIBGNAT_SRCS+=sigtramp.h + EH_MECHANISM=-gcc + + SO_OPTS= -shared-libgcc -Wl,-soname, + MISCLIB= - lsocket + THREADSLIB = + GNATLIB_SHARED = gnatlib-shared-dual + LIBRARY_VERSION := $(LIB_VERSION) +endif + # Sparc Solaris ifeq ($(strip $(filter-out sparc% sun solaris%,$(target_cpu) $(target_vendor) $(target_os))),) LIBGNAT_TARGET_PAIRS = \ diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 4d7f432bff2..2cf5e51e91d 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -262,6 +262,9 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) /* No psABI change warnings for Ada. */ warn_psabi = 0; + /* No return type warnings for Ada. */ + warn_return_type = 0; + /* No caret by default for Ada. */ if (!global_options_set.x_flag_diagnostics_show_caret) global_dc->show_caret = false; diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index d22d82ad610..238b841139b 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -7695,12 +7695,12 @@ gnat_to_gnu (Node_Id gnat_node) /* Added Nodes */ /****************/ - /* Call markers are created by the ABE mechanism to capture the target of - a call along with other elaboration-related attributes which are either - unavailable of expensive to recompute. Call markers do not have static - and runtime semantics, and should be ignored. */ + /* Markers are created by the ABE mechanism to capture information which + is either unavailable of expensive to recompute. Markers do not have + and runtime semantics, and should be ignored. */ case N_Call_Marker: + case N_Variable_Reference_Marker: gnu_result = alloc_stmt_list (); break; diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index bad5aeade13..d7f9f3464ae 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -4706,6 +4706,7 @@ convert (tree type, tree expr) return fold (convert_to_real (type, expr)); case RECORD_TYPE: + /* Do a normal conversion between scalar and justified modular type. */ if (TYPE_JUSTIFIED_MODULAR_P (type) && !AGGREGATE_TYPE_P (etype)) { vec<constructor_elt, va_gc> *v; @@ -4717,9 +4718,27 @@ convert (tree type, tree expr) return gnat_build_constructor (type, v); } - /* ... fall through ... */ + /* In these cases, assume the front-end has validated the conversion. + If the conversion is valid, it will be a bit-wise conversion, so + it can be viewed as an unchecked conversion. */ + return unchecked_convert (type, expr, false); case ARRAY_TYPE: + /* Do a normal conversion between unconstrained and constrained array + type, assuming the latter is a constrained version of the former. */ + if (TREE_CODE (expr) == INDIRECT_REF + && ecode == ARRAY_TYPE + && TREE_TYPE (etype) == TREE_TYPE (type)) + { + tree ptr_type = build_pointer_type (type); + tree t = build_unary_op (INDIRECT_REF, NULL_TREE, + fold_convert (ptr_type, + TREE_OPERAND (expr, 0))); + TREE_READONLY (t) = TREE_READONLY (expr); + TREE_THIS_NOTRAP (t) = TREE_THIS_NOTRAP (expr); + return t; + } + /* In these cases, assume the front-end has validated the conversion. If the conversion is valid, it will be a bit-wise conversion, so it can be viewed as an unchecked conversion. */ diff --git a/gcc/ada/get_spark_xrefs.adb b/gcc/ada/get_spark_xrefs.adb deleted file mode 100644 index 9b82d5bfdd1..00000000000 --- a/gcc/ada/get_spark_xrefs.adb +++ /dev/null @@ -1,493 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G E T _ S P A R K _ X R E F S -- --- -- --- B o d y -- --- -- --- Copyright (C) 2011-2016, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with SPARK_Xrefs; use SPARK_Xrefs; -with Types; use Types; - -with Ada.IO_Exceptions; use Ada.IO_Exceptions; - -procedure Get_SPARK_Xrefs is - C : Character; - - use ASCII; - -- For CR/LF - - Cur_File : Nat; - -- Dependency number for the current file - - Cur_Scope : Nat; - -- Scope number for the current scope entity - - Cur_File_Idx : File_Index; - -- Index in SPARK_File_Table of the current file - - Cur_Scope_Idx : Scope_Index; - -- Index in SPARK_Scope_Table of the current scope - - Name_Str : String (1 .. 32768); - Name_Len : Natural := 0; - -- Local string used to store name of File/entity scanned as - -- Name_Str (1 .. Name_Len). - - File_Name : String_Ptr; - Unit_File_Name : String_Ptr; - - ----------------------- - -- Local Subprograms -- - ----------------------- - - function At_EOL return Boolean; - -- Skips any spaces, then checks if at the end of a line. If so, returns - -- True (but does not skip the EOL sequence). If not, then returns False. - - procedure Check (C : Character); - -- Checks that file is positioned at given character, and if so skips past - -- it, If not, raises Data_Error. - - function Get_Nat return Nat; - -- On entry the file is positioned to a digit. On return, the file is - -- positioned past the last digit, and the returned result is the decimal - -- value read. Data_Error is raised for overflow (value greater than - -- Int'Last), or if the initial character is not a digit. - - procedure Get_Name; - -- On entry the file is positioned to a name. On return, the file is - -- positioned past the last character, and the name scanned is returned - -- in Name_Str (1 .. Name_Len). - - procedure Skip_EOL; - -- Called with the current character about to be read being LF or CR. Skips - -- past CR/LF characters until either a non-CR/LF character is found, or - -- the end of file is encountered. - - procedure Skip_Spaces; - -- Skips zero or more spaces at the current position, leaving the file - -- positioned at the first non-blank character (or Types.EOF). - - ------------ - -- At_EOL -- - ------------ - - function At_EOL return Boolean is - begin - Skip_Spaces; - return Nextc = CR or else Nextc = LF; - end At_EOL; - - ----------- - -- Check -- - ----------- - - procedure Check (C : Character) is - begin - if Nextc = C then - Skipc; - else - raise Data_Error; - end if; - end Check; - - ------------- - -- Get_Nat -- - ------------- - - function Get_Nat return Nat is - C : Character := Nextc; - Val : Nat := 0; - - begin - if C not in '0' .. '9' then - raise Data_Error; - end if; - - -- Loop to read digits of integer value - - loop - declare - pragma Unsuppress (Overflow_Check); - begin - Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0')); - end; - - Skipc; - C := Nextc; - - exit when C not in '0' .. '9'; - end loop; - - return Val; - - exception - when Constraint_Error => - raise Data_Error; - end Get_Nat; - - -------------- - -- Get_Name -- - -------------- - - procedure Get_Name is - N : Natural := 0; - - begin - while Nextc > ' ' loop - N := N + 1; - Name_Str (N) := Getc; - end loop; - - Name_Len := N; - end Get_Name; - - -------------- - -- Skip_EOL -- - -------------- - - procedure Skip_EOL is - C : Character; - - begin - loop - Skipc; - C := Nextc; - exit when C /= LF and then C /= CR; - - if C = ' ' then - Skip_Spaces; - C := Nextc; - exit when C /= LF and then C /= CR; - end if; - end loop; - end Skip_EOL; - - ----------------- - -- Skip_Spaces -- - ----------------- - - procedure Skip_Spaces is - begin - while Nextc = ' ' loop - Skipc; - end loop; - end Skip_Spaces; - --- Start of processing for Get_SPARK_Xrefs - -begin - Initialize_SPARK_Tables; - - Cur_File := 0; - Cur_Scope := 0; - Cur_File_Idx := 1; - Cur_Scope_Idx := 0; - - -- Loop through lines of SPARK cross-reference information - - while Nextc = 'F' loop - Skipc; - - C := Getc; - - -- Make sure first line is a File line - - if SPARK_File_Table.Last = 0 and then C /= 'D' then - raise Data_Error; - end if; - - -- Otherwise dispatch on type of line - - case C is - - -- Header entry for scope section - - when 'D' => - - -- Complete previous entry if any - - if SPARK_File_Table.Last /= 0 then - SPARK_File_Table.Table (SPARK_File_Table.Last).To_Scope := - SPARK_Scope_Table.Last; - end if; - - -- Scan out dependency number and file name - - Skip_Spaces; - Cur_File := Get_Nat; - Skip_Spaces; - - Get_Name; - File_Name := new String'(Name_Str (1 .. Name_Len)); - Skip_Spaces; - - -- Scan out unit file name when present (for subunits) - - if Nextc = '-' then - Skipc; - Check ('>'); - Skip_Spaces; - Get_Name; - Unit_File_Name := new String'(Name_Str (1 .. Name_Len)); - - else - Unit_File_Name := null; - end if; - - -- Make new File table entry (will fill in To_Scope later) - - SPARK_File_Table.Append ( - (File_Name => File_Name, - Unit_File_Name => Unit_File_Name, - File_Num => Cur_File, - From_Scope => SPARK_Scope_Table.Last + 1, - To_Scope => 0)); - - -- Initialize counter for scopes - - Cur_Scope := 1; - - -- Scope entry - - when 'S' => - declare - Spec_File : Nat; - Spec_Scope : Nat; - Scope : Nat; - Line : Nat; - Col : Nat; - Typ : Character; - - begin - -- Scan out location - - Skip_Spaces; - Check ('.'); - Scope := Get_Nat; - Check (' '); - Line := Get_Nat; - Typ := Getc; - Col := Get_Nat; - - pragma Assert (Scope = Cur_Scope); - - -- Scan out scope entity name - - Skip_Spaces; - Get_Name; - Skip_Spaces; - - if Nextc = '-' then - Skipc; - Check ('>'); - Skip_Spaces; - Spec_File := Get_Nat; - Check ('.'); - Spec_Scope := Get_Nat; - - else - Spec_File := 0; - Spec_Scope := 0; - end if; - - -- Make new scope table entry (will fill in From_Xref and - -- To_Xref later). Initial range (From_Xref .. To_Xref) is - -- empty for scopes without entities. - - SPARK_Scope_Table.Append ( - (Scope_Entity => Empty, - Scope_Name => new String'(Name_Str (1 .. Name_Len)), - File_Num => Cur_File, - Scope_Num => Cur_Scope, - Spec_File_Num => Spec_File, - Spec_Scope_Num => Spec_Scope, - Line => Line, - Stype => Typ, - Col => Col, - From_Xref => 1, - To_Xref => 0)); - end; - - -- Update counter for scopes - - Cur_Scope := Cur_Scope + 1; - - -- Header entry for cross-ref section - - when 'X' => - - -- Scan out dependency number and file name (ignored) - - Skip_Spaces; - Cur_File := Get_Nat; - Skip_Spaces; - Get_Name; - - -- Update component From_Xref of current file if first reference - -- in this file. - - while SPARK_File_Table.Table (Cur_File_Idx).File_Num /= Cur_File - loop - Cur_File_Idx := Cur_File_Idx + 1; - end loop; - - -- Scan out scope entity number and entity name (ignored) - - Skip_Spaces; - Check ('.'); - Cur_Scope := Get_Nat; - Skip_Spaces; - Get_Name; - - -- Update component To_Xref of previous scope - - if Cur_Scope_Idx /= 0 then - SPARK_Scope_Table.Table (Cur_Scope_Idx).To_Xref := - SPARK_Xref_Table.Last; - end if; - - -- Update component From_Xref of current scope - - Cur_Scope_Idx := SPARK_File_Table.Table (Cur_File_Idx).From_Scope; - - while SPARK_Scope_Table.Table (Cur_Scope_Idx).Scope_Num /= - Cur_Scope - loop - Cur_Scope_Idx := Cur_Scope_Idx + 1; - end loop; - - SPARK_Scope_Table.Table (Cur_Scope_Idx).From_Xref := - SPARK_Xref_Table.Last + 1; - - -- Cross reference entry - - when ' ' => - declare - XR_Entity : String_Ptr; - XR_Entity_Line : Nat; - XR_Entity_Col : Nat; - XR_Entity_Typ : Character; - - XR_File : Nat; - -- Keeps track of the current file (changed by nn|) - - XR_Scope : Nat; - -- Keeps track of the current scope (changed by nn:) - - begin - XR_File := Cur_File; - XR_Scope := Cur_Scope; - - XR_Entity_Line := Get_Nat; - XR_Entity_Typ := Getc; - XR_Entity_Col := Get_Nat; - - Skip_Spaces; - Get_Name; - XR_Entity := new String'(Name_Str (1 .. Name_Len)); - - -- Initialize to scan items on one line - - Skip_Spaces; - - -- Loop through cross-references for this entity - - loop - declare - Line : Nat; - Col : Nat; - N : Nat; - Rtype : Character; - - begin - Skip_Spaces; - - if At_EOL then - Skip_EOL; - exit when Nextc /= '.'; - Skipc; - Skip_Spaces; - end if; - - if Nextc = '.' then - Skipc; - XR_Scope := Get_Nat; - Check (':'); - - else - N := Get_Nat; - - if Nextc = '|' then - XR_File := N; - Skipc; - - else - Line := N; - Rtype := Getc; - Col := Get_Nat; - - pragma Assert - (Rtype = 'r' or else - Rtype = 'c' or else - Rtype = 'm' or else - Rtype = 's'); - - SPARK_Xref_Table.Append ( - (Entity_Name => XR_Entity, - Entity_Line => XR_Entity_Line, - Etype => XR_Entity_Typ, - Entity_Col => XR_Entity_Col, - File_Num => XR_File, - Scope_Num => XR_Scope, - Line => Line, - Rtype => Rtype, - Col => Col)); - end if; - end if; - end; - end loop; - end; - - -- No other SPARK lines are possible - - when others => - raise Data_Error; - end case; - - -- For cross reference lines, the EOL character has been skipped already - - if C /= ' ' then - Skip_EOL; - end if; - end loop; - - -- Here with all Xrefs stored, complete last entries in File/Scope tables - - if SPARK_File_Table.Last /= 0 then - SPARK_File_Table.Table (SPARK_File_Table.Last).To_Scope := - SPARK_Scope_Table.Last; - end if; - - if Cur_Scope_Idx /= 0 then - SPARK_Scope_Table.Table (Cur_Scope_Idx).To_Xref := SPARK_Xref_Table.Last; - end if; -end Get_SPARK_Xrefs; diff --git a/gcc/ada/get_spark_xrefs.ads b/gcc/ada/get_spark_xrefs.ads deleted file mode 100644 index 22af7edccc2..00000000000 --- a/gcc/ada/get_spark_xrefs.ads +++ /dev/null @@ -1,60 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G E T _ S P A R K _ X R E F S -- --- -- --- S p e c -- --- -- --- Copyright (C) 2011-2013, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains the function used to read SPARK cross-reference --- information from an ALI file and populate the tables defined in package --- SPARK_Xrefs with the result. - -generic - -- These subprograms provide access to the ALI file. Locating, opening and - -- providing access to the ALI file is the callers' responsibility. - - with function Getc return Character is <>; - -- Get next character, positioning the ALI file ready to read the following - -- character (equivalent to calling Nextc, then Skipc). If the end of file - -- is encountered, the value Types.EOF is returned. - - with function Nextc return Character is <>; - -- Look at the next character, and return it, leaving the position of the - -- file unchanged, so that a subsequent call to Getc or Nextc will return - -- this same character. If the file is positioned at the end of file, then - -- Types.EOF is returned. - - with procedure Skipc is <>; - -- Skip past the current character (which typically was read with Nextc), - -- and position to the next character, which will be returned by the next - -- call to Getc or Nextc. - -procedure Get_SPARK_Xrefs; --- Load SPARK cross-reference information from ALI file text format into --- internal SPARK tables (SPARK_Xrefs.SPARK_Xref_Table, --- SPARK_Xrefs.SPARK_Scope_Table and SPARK_Xrefs.SPARK_File_Table). On entry --- the input file is positioned to the initial 'F' of the first SPARK specific --- line in the ALI file. On return, the file is positioned either to the end --- of file, or to the first character of the line following the SPARK specific --- information (which will never start with an 'F'). --- --- If a format error is detected in the input, then an exception is raised --- (Ada.IO_Exceptions.Data_Error), with the file positioned to the error. diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 4bf910bca3e..3e4234bcbd5 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -383,6 +383,15 @@ procedure Gnat1drv is Relaxed_RM_Semantics := True; + if not Generate_CodePeer_Messages then + + -- Suppress compiler warnings by default when generating SCIL for + -- CodePeer, except when combined with -gnateC where we do want to + -- emit GNAT warnings. + + Warning_Mode := Suppress; + end if; + -- Disable all simple value propagation. This is an optimization -- which is valuable for code optimization, and also for generation -- of compiler warnings, but these are being turned off by default, @@ -581,7 +590,7 @@ procedure Gnat1drv is -- problems with subtypes of type Ada.Tags.Dispatch_Table_Wrapper. ??? if Debug_Flag_Dot_T then - Static_Dispatch_Tables := False; + Building_Static_Dispatch_Tables := False; end if; -- Flip endian mode if -gnatd8 set @@ -1180,6 +1189,7 @@ begin if Compilation_Errors then Treepr.Tree_Dump; Post_Compilation_Validation_Checks; + Errout.Finalize (Last_Call => True); Errout.Output_Messages; Namet.Finalize; @@ -1190,7 +1200,6 @@ begin Tree_Gen; end if; - Errout.Finalize (Last_Call => True); Exit_Program (E_Errors); end if; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index b042e2be3e1..0a2b151dffa 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Oct 14, 2017 +GNAT Reference Manual , Nov 09, 2017 AdaCore @@ -535,6 +535,7 @@ Program Unit Level Restrictions * No_Implicit_Loops:: * No_Obsolescent_Features:: * No_Wide_Characters:: +* Static_Dispatch_Tables:: * SPARK_05:: Implementation Advice @@ -12917,6 +12918,7 @@ other compilation units in the partition. * No_Implicit_Loops:: * No_Obsolescent_Features:: * No_Wide_Characters:: +* Static_Dispatch_Tables:: * SPARK_05:: @end menu @@ -13118,7 +13120,7 @@ is set in the spec of a package, it will not apply to its body. [RM 13.12.1] This restriction checks at compile time that no obsolescent features are used, as defined in Annex J of the Ada Reference Manual. -@node No_Wide_Characters,SPARK_05,No_Obsolescent_Features,Program Unit Level Restrictions +@node No_Wide_Characters,Static_Dispatch_Tables,No_Obsolescent_Features,Program Unit Level Restrictions @anchor{gnat_rm/standard_and_implementation_defined_restrictions no-wide-characters}@anchor{209} @subsection No_Wide_Characters @@ -13132,8 +13134,18 @@ appear, and that no wide or wide wide string or character literals appear in the program (that is literals representing characters not in type @code{Character}). -@node SPARK_05,,No_Wide_Characters,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions spark-05}@anchor{20a} +@node Static_Dispatch_Tables,SPARK_05,No_Wide_Characters,Program Unit Level Restrictions +@anchor{gnat_rm/standard_and_implementation_defined_restrictions static-dispatch-tables}@anchor{20a} +@subsection Static_Dispatch_Tables + + +@geindex Static_Dispatch_Tables + +[GNAT] This restriction checks at compile time that all the artifacts +associated with dispatch tables can be placed in read-only memory. + +@node SPARK_05,,Static_Dispatch_Tables,Program Unit Level Restrictions +@anchor{gnat_rm/standard_and_implementation_defined_restrictions spark-05}@anchor{20b} @subsection SPARK_05 @@ -13492,7 +13504,7 @@ violations will be reported for constructs forbidden in SPARK 95, instead of SPARK 2005. @node Implementation Advice,Implementation Defined Characteristics,Standard and Implementation Defined Restrictions,Top -@anchor{gnat_rm/implementation_advice doc}@anchor{20b}@anchor{gnat_rm/implementation_advice implementation-advice}@anchor{a}@anchor{gnat_rm/implementation_advice id1}@anchor{20c} +@anchor{gnat_rm/implementation_advice doc}@anchor{20c}@anchor{gnat_rm/implementation_advice implementation-advice}@anchor{a}@anchor{gnat_rm/implementation_advice id1}@anchor{20d} @chapter Implementation Advice @@ -13589,7 +13601,7 @@ case the text describes what GNAT does and why. @end menu @node RM 1 1 3 20 Error Detection,RM 1 1 3 31 Child Units,,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-1-1-3-20-error-detection}@anchor{20d} +@anchor{gnat_rm/implementation_advice rm-1-1-3-20-error-detection}@anchor{20e} @section RM 1.1.3(20): Error Detection @@ -13606,7 +13618,7 @@ or diagnosed at compile time. @geindex Child Units @node RM 1 1 3 31 Child Units,RM 1 1 5 12 Bounded Errors,RM 1 1 3 20 Error Detection,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-1-1-3-31-child-units}@anchor{20e} +@anchor{gnat_rm/implementation_advice rm-1-1-3-31-child-units}@anchor{20f} @section RM 1.1.3(31): Child Units @@ -13622,7 +13634,7 @@ Followed. @geindex Bounded errors @node RM 1 1 5 12 Bounded Errors,RM 2 8 16 Pragmas,RM 1 1 3 31 Child Units,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-1-1-5-12-bounded-errors}@anchor{20f} +@anchor{gnat_rm/implementation_advice rm-1-1-5-12-bounded-errors}@anchor{210} @section RM 1.1.5(12): Bounded Errors @@ -13639,7 +13651,7 @@ runtime. @geindex Pragmas @node RM 2 8 16 Pragmas,RM 2 8 17-19 Pragmas,RM 1 1 5 12 Bounded Errors,Implementation Advice -@anchor{gnat_rm/implementation_advice id2}@anchor{210}@anchor{gnat_rm/implementation_advice rm-2-8-16-pragmas}@anchor{211} +@anchor{gnat_rm/implementation_advice id2}@anchor{211}@anchor{gnat_rm/implementation_advice rm-2-8-16-pragmas}@anchor{212} @section RM 2.8(16): Pragmas @@ -13752,7 +13764,7 @@ that this advice not be followed. For details see @ref{7,,Implementation Defined Pragmas}. @node RM 2 8 17-19 Pragmas,RM 3 5 2 5 Alternative Character Sets,RM 2 8 16 Pragmas,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-2-8-17-19-pragmas}@anchor{212} +@anchor{gnat_rm/implementation_advice rm-2-8-17-19-pragmas}@anchor{213} @section RM 2.8(17-19): Pragmas @@ -13773,14 +13785,14 @@ replacing @code{library_items}." @end itemize @end quotation -See @ref{211,,RM 2.8(16); Pragmas}. +See @ref{212,,RM 2.8(16); Pragmas}. @geindex Character Sets @geindex Alternative Character Sets @node RM 3 5 2 5 Alternative Character Sets,RM 3 5 4 28 Integer Types,RM 2 8 17-19 Pragmas,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-2-5-alternative-character-sets}@anchor{213} +@anchor{gnat_rm/implementation_advice rm-3-5-2-5-alternative-character-sets}@anchor{214} @section RM 3.5.2(5): Alternative Character Sets @@ -13808,7 +13820,7 @@ there is no such restriction. @geindex Integer types @node RM 3 5 4 28 Integer Types,RM 3 5 4 29 Integer Types,RM 3 5 2 5 Alternative Character Sets,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-4-28-integer-types}@anchor{214} +@anchor{gnat_rm/implementation_advice rm-3-5-4-28-integer-types}@anchor{215} @section RM 3.5.4(28): Integer Types @@ -13827,7 +13839,7 @@ are supported for convenient interface to C, and so that all hardware types of the machine are easily available. @node RM 3 5 4 29 Integer Types,RM 3 5 5 8 Enumeration Values,RM 3 5 4 28 Integer Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-4-29-integer-types}@anchor{215} +@anchor{gnat_rm/implementation_advice rm-3-5-4-29-integer-types}@anchor{216} @section RM 3.5.4(29): Integer Types @@ -13843,7 +13855,7 @@ Followed. @geindex Enumeration values @node RM 3 5 5 8 Enumeration Values,RM 3 5 7 17 Float Types,RM 3 5 4 29 Integer Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-5-8-enumeration-values}@anchor{216} +@anchor{gnat_rm/implementation_advice rm-3-5-5-8-enumeration-values}@anchor{217} @section RM 3.5.5(8): Enumeration Values @@ -13863,7 +13875,7 @@ Followed. @geindex Float types @node RM 3 5 7 17 Float Types,RM 3 6 2 11 Multidimensional Arrays,RM 3 5 5 8 Enumeration Values,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-7-17-float-types}@anchor{217} +@anchor{gnat_rm/implementation_advice rm-3-5-7-17-float-types}@anchor{218} @section RM 3.5.7(17): Float Types @@ -13893,7 +13905,7 @@ since this is a software rather than a hardware format. @geindex multidimensional @node RM 3 6 2 11 Multidimensional Arrays,RM 9 6 30-31 Duration'Small,RM 3 5 7 17 Float Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-6-2-11-multidimensional-arrays}@anchor{218} +@anchor{gnat_rm/implementation_advice rm-3-6-2-11-multidimensional-arrays}@anchor{219} @section RM 3.6.2(11): Multidimensional Arrays @@ -13911,7 +13923,7 @@ Followed. @geindex Duration'Small @node RM 9 6 30-31 Duration'Small,RM 10 2 1 12 Consistent Representation,RM 3 6 2 11 Multidimensional Arrays,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-9-6-30-31-duration-small}@anchor{219} +@anchor{gnat_rm/implementation_advice rm-9-6-30-31-duration-small}@anchor{21a} @section RM 9.6(30-31): Duration'Small @@ -13932,7 +13944,7 @@ it need not be the same time base as used for @code{Calendar.Clock}." Followed. @node RM 10 2 1 12 Consistent Representation,RM 11 4 1 19 Exception Information,RM 9 6 30-31 Duration'Small,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-10-2-1-12-consistent-representation}@anchor{21a} +@anchor{gnat_rm/implementation_advice rm-10-2-1-12-consistent-representation}@anchor{21b} @section RM 10.2.1(12): Consistent Representation @@ -13954,7 +13966,7 @@ advice without severely impacting efficiency of execution. @geindex Exception information @node RM 11 4 1 19 Exception Information,RM 11 5 28 Suppression of Checks,RM 10 2 1 12 Consistent Representation,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-11-4-1-19-exception-information}@anchor{21b} +@anchor{gnat_rm/implementation_advice rm-11-4-1-19-exception-information}@anchor{21c} @section RM 11.4.1(19): Exception Information @@ -13985,7 +13997,7 @@ Pragma @code{Discard_Names}. @geindex suppression of @node RM 11 5 28 Suppression of Checks,RM 13 1 21-24 Representation Clauses,RM 11 4 1 19 Exception Information,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-11-5-28-suppression-of-checks}@anchor{21c} +@anchor{gnat_rm/implementation_advice rm-11-5-28-suppression-of-checks}@anchor{21d} @section RM 11.5(28): Suppression of Checks @@ -14000,7 +14012,7 @@ Followed. @geindex Representation clauses @node RM 13 1 21-24 Representation Clauses,RM 13 2 6-8 Packed Types,RM 11 5 28 Suppression of Checks,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-1-21-24-representation-clauses}@anchor{21d} +@anchor{gnat_rm/implementation_advice rm-13-1-21-24-representation-clauses}@anchor{21e} @section RM 13.1 (21-24): Representation Clauses @@ -14049,7 +14061,7 @@ Followed. @geindex Packed types @node RM 13 2 6-8 Packed Types,RM 13 3 14-19 Address Clauses,RM 13 1 21-24 Representation Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-2-6-8-packed-types}@anchor{21e} +@anchor{gnat_rm/implementation_advice rm-13-2-6-8-packed-types}@anchor{21f} @section RM 13.2(6-8): Packed Types @@ -14088,7 +14100,7 @@ Followed. @geindex Address clauses @node RM 13 3 14-19 Address Clauses,RM 13 3 29-35 Alignment Clauses,RM 13 2 6-8 Packed Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-14-19-address-clauses}@anchor{21f} +@anchor{gnat_rm/implementation_advice rm-13-3-14-19-address-clauses}@anchor{220} @section RM 13.3(14-19): Address Clauses @@ -14141,7 +14153,7 @@ Followed. @geindex Alignment clauses @node RM 13 3 29-35 Alignment Clauses,RM 13 3 42-43 Size Clauses,RM 13 3 14-19 Address Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-29-35-alignment-clauses}@anchor{220} +@anchor{gnat_rm/implementation_advice rm-13-3-29-35-alignment-clauses}@anchor{221} @section RM 13.3(29-35): Alignment Clauses @@ -14198,7 +14210,7 @@ Followed. @geindex Size clauses @node RM 13 3 42-43 Size Clauses,RM 13 3 50-56 Size Clauses,RM 13 3 29-35 Alignment Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-42-43-size-clauses}@anchor{221} +@anchor{gnat_rm/implementation_advice rm-13-3-42-43-size-clauses}@anchor{222} @section RM 13.3(42-43): Size Clauses @@ -14216,7 +14228,7 @@ object's @code{Alignment} (if the @code{Alignment} is nonzero)." Followed. @node RM 13 3 50-56 Size Clauses,RM 13 3 71-73 Component Size Clauses,RM 13 3 42-43 Size Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-50-56-size-clauses}@anchor{222} +@anchor{gnat_rm/implementation_advice rm-13-3-50-56-size-clauses}@anchor{223} @section RM 13.3(50-56): Size Clauses @@ -14267,7 +14279,7 @@ Followed. @geindex Component_Size clauses @node RM 13 3 71-73 Component Size Clauses,RM 13 4 9-10 Enumeration Representation Clauses,RM 13 3 50-56 Size Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-71-73-component-size-clauses}@anchor{223} +@anchor{gnat_rm/implementation_advice rm-13-3-71-73-component-size-clauses}@anchor{224} @section RM 13.3(71-73): Component Size Clauses @@ -14301,7 +14313,7 @@ Followed. @geindex enumeration @node RM 13 4 9-10 Enumeration Representation Clauses,RM 13 5 1 17-22 Record Representation Clauses,RM 13 3 71-73 Component Size Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-4-9-10-enumeration-representation-clauses}@anchor{224} +@anchor{gnat_rm/implementation_advice rm-13-4-9-10-enumeration-representation-clauses}@anchor{225} @section RM 13.4(9-10): Enumeration Representation Clauses @@ -14323,7 +14335,7 @@ Followed. @geindex records @node RM 13 5 1 17-22 Record Representation Clauses,RM 13 5 2 5 Storage Place Attributes,RM 13 4 9-10 Enumeration Representation Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-5-1-17-22-record-representation-clauses}@anchor{225} +@anchor{gnat_rm/implementation_advice rm-13-5-1-17-22-record-representation-clauses}@anchor{226} @section RM 13.5.1(17-22): Record Representation Clauses @@ -14383,7 +14395,7 @@ and all mentioned features are implemented. @geindex Storage place attributes @node RM 13 5 2 5 Storage Place Attributes,RM 13 5 3 7-8 Bit Ordering,RM 13 5 1 17-22 Record Representation Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-5-2-5-storage-place-attributes}@anchor{226} +@anchor{gnat_rm/implementation_advice rm-13-5-2-5-storage-place-attributes}@anchor{227} @section RM 13.5.2(5): Storage Place Attributes @@ -14403,7 +14415,7 @@ Followed. There are no such components in GNAT. @geindex Bit ordering @node RM 13 5 3 7-8 Bit Ordering,RM 13 7 37 Address as Private,RM 13 5 2 5 Storage Place Attributes,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-5-3-7-8-bit-ordering}@anchor{227} +@anchor{gnat_rm/implementation_advice rm-13-5-3-7-8-bit-ordering}@anchor{228} @section RM 13.5.3(7-8): Bit Ordering @@ -14423,7 +14435,7 @@ Thus non-default bit ordering is not supported. @geindex as private type @node RM 13 7 37 Address as Private,RM 13 7 1 16 Address Operations,RM 13 5 3 7-8 Bit Ordering,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-7-37-address-as-private}@anchor{228} +@anchor{gnat_rm/implementation_advice rm-13-7-37-address-as-private}@anchor{229} @section RM 13.7(37): Address as Private @@ -14441,7 +14453,7 @@ Followed. @geindex operations of @node RM 13 7 1 16 Address Operations,RM 13 9 14-17 Unchecked Conversion,RM 13 7 37 Address as Private,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-7-1-16-address-operations}@anchor{229} +@anchor{gnat_rm/implementation_advice rm-13-7-1-16-address-operations}@anchor{22a} @section RM 13.7.1(16): Address Operations @@ -14459,7 +14471,7 @@ operation raises @code{Program_Error}, since all operations make sense. @geindex Unchecked conversion @node RM 13 9 14-17 Unchecked Conversion,RM 13 11 23-25 Implicit Heap Usage,RM 13 7 1 16 Address Operations,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-9-14-17-unchecked-conversion}@anchor{22a} +@anchor{gnat_rm/implementation_advice rm-13-9-14-17-unchecked-conversion}@anchor{22b} @section RM 13.9(14-17): Unchecked Conversion @@ -14503,7 +14515,7 @@ Followed. @geindex implicit @node RM 13 11 23-25 Implicit Heap Usage,RM 13 11 2 17 Unchecked Deallocation,RM 13 9 14-17 Unchecked Conversion,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-11-23-25-implicit-heap-usage}@anchor{22b} +@anchor{gnat_rm/implementation_advice rm-13-11-23-25-implicit-heap-usage}@anchor{22c} @section RM 13.11(23-25): Implicit Heap Usage @@ -14554,7 +14566,7 @@ Followed. @geindex Unchecked deallocation @node RM 13 11 2 17 Unchecked Deallocation,RM 13 13 2 17 Stream Oriented Attributes,RM 13 11 23-25 Implicit Heap Usage,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-11-2-17-unchecked-deallocation}@anchor{22c} +@anchor{gnat_rm/implementation_advice rm-13-11-2-17-unchecked-deallocation}@anchor{22d} @section RM 13.11.2(17): Unchecked Deallocation @@ -14569,7 +14581,7 @@ Followed. @geindex Stream oriented attributes @node RM 13 13 2 17 Stream Oriented Attributes,RM A 1 52 Names of Predefined Numeric Types,RM 13 11 2 17 Unchecked Deallocation,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-13-2-17-stream-oriented-attributes}@anchor{22d} +@anchor{gnat_rm/implementation_advice rm-13-13-2-17-stream-oriented-attributes}@anchor{22e} @section RM 13.13.2(17): Stream Oriented Attributes @@ -14624,7 +14636,7 @@ the @emph{GNAT and Libraries} section of the @cite{GNAT User's Guide}. @end itemize @node RM A 1 52 Names of Predefined Numeric Types,RM A 3 2 49 Ada Characters Handling,RM 13 13 2 17 Stream Oriented Attributes,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-1-52-names-of-predefined-numeric-types}@anchor{22e} +@anchor{gnat_rm/implementation_advice rm-a-1-52-names-of-predefined-numeric-types}@anchor{22f} @section RM A.1(52): Names of Predefined Numeric Types @@ -14642,7 +14654,7 @@ Followed. @geindex Ada.Characters.Handling @node RM A 3 2 49 Ada Characters Handling,RM A 4 4 106 Bounded-Length String Handling,RM A 1 52 Names of Predefined Numeric Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-3-2-49-ada-characters-handling}@anchor{22f} +@anchor{gnat_rm/implementation_advice rm-a-3-2-49-ada-characters-handling}@anchor{230} @section RM A.3.2(49): @code{Ada.Characters.Handling} @@ -14659,7 +14671,7 @@ Followed. GNAT provides no such localized definitions. @geindex Bounded-length strings @node RM A 4 4 106 Bounded-Length String Handling,RM A 5 2 46-47 Random Number Generation,RM A 3 2 49 Ada Characters Handling,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-4-4-106-bounded-length-string-handling}@anchor{230} +@anchor{gnat_rm/implementation_advice rm-a-4-4-106-bounded-length-string-handling}@anchor{231} @section RM A.4.4(106): Bounded-Length String Handling @@ -14674,7 +14686,7 @@ Followed. No implicit pointers or dynamic allocation are used. @geindex Random number generation @node RM A 5 2 46-47 Random Number Generation,RM A 10 7 23 Get_Immediate,RM A 4 4 106 Bounded-Length String Handling,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-5-2-46-47-random-number-generation}@anchor{231} +@anchor{gnat_rm/implementation_advice rm-a-5-2-46-47-random-number-generation}@anchor{232} @section RM A.5.2(46-47): Random Number Generation @@ -14703,7 +14715,7 @@ condition here to hold true. @geindex Get_Immediate @node RM A 10 7 23 Get_Immediate,RM B 1 39-41 Pragma Export,RM A 5 2 46-47 Random Number Generation,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-10-7-23-get-immediate}@anchor{232} +@anchor{gnat_rm/implementation_advice rm-a-10-7-23-get-immediate}@anchor{233} @section RM A.10.7(23): @code{Get_Immediate} @@ -14727,7 +14739,7 @@ this functionality. @geindex Export @node RM B 1 39-41 Pragma Export,RM B 2 12-13 Package Interfaces,RM A 10 7 23 Get_Immediate,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-1-39-41-pragma-export}@anchor{233} +@anchor{gnat_rm/implementation_advice rm-b-1-39-41-pragma-export}@anchor{234} @section RM B.1(39-41): Pragma @code{Export} @@ -14775,7 +14787,7 @@ Followed. @geindex Interfaces @node RM B 2 12-13 Package Interfaces,RM B 3 63-71 Interfacing with C,RM B 1 39-41 Pragma Export,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-2-12-13-package-interfaces}@anchor{234} +@anchor{gnat_rm/implementation_advice rm-b-2-12-13-package-interfaces}@anchor{235} @section RM B.2(12-13): Package @code{Interfaces} @@ -14805,7 +14817,7 @@ Followed. GNAT provides all the packages described in this section. @geindex interfacing with @node RM B 3 63-71 Interfacing with C,RM B 4 95-98 Interfacing with COBOL,RM B 2 12-13 Package Interfaces,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-3-63-71-interfacing-with-c}@anchor{235} +@anchor{gnat_rm/implementation_advice rm-b-3-63-71-interfacing-with-c}@anchor{236} @section RM B.3(63-71): Interfacing with C @@ -14893,7 +14905,7 @@ Followed. @geindex interfacing with @node RM B 4 95-98 Interfacing with COBOL,RM B 5 22-26 Interfacing with Fortran,RM B 3 63-71 Interfacing with C,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-4-95-98-interfacing-with-cobol}@anchor{236} +@anchor{gnat_rm/implementation_advice rm-b-4-95-98-interfacing-with-cobol}@anchor{237} @section RM B.4(95-98): Interfacing with COBOL @@ -14934,7 +14946,7 @@ Followed. @geindex interfacing with @node RM B 5 22-26 Interfacing with Fortran,RM C 1 3-5 Access to Machine Operations,RM B 4 95-98 Interfacing with COBOL,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-5-22-26-interfacing-with-fortran}@anchor{237} +@anchor{gnat_rm/implementation_advice rm-b-5-22-26-interfacing-with-fortran}@anchor{238} @section RM B.5(22-26): Interfacing with Fortran @@ -14985,7 +14997,7 @@ Followed. @geindex Machine operations @node RM C 1 3-5 Access to Machine Operations,RM C 1 10-16 Access to Machine Operations,RM B 5 22-26 Interfacing with Fortran,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-1-3-5-access-to-machine-operations}@anchor{238} +@anchor{gnat_rm/implementation_advice rm-c-1-3-5-access-to-machine-operations}@anchor{239} @section RM C.1(3-5): Access to Machine Operations @@ -15020,7 +15032,7 @@ object that is specified as exported." Followed. @node RM C 1 10-16 Access to Machine Operations,RM C 3 28 Interrupt Support,RM C 1 3-5 Access to Machine Operations,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-1-10-16-access-to-machine-operations}@anchor{239} +@anchor{gnat_rm/implementation_advice rm-c-1-10-16-access-to-machine-operations}@anchor{23a} @section RM C.1(10-16): Access to Machine Operations @@ -15081,7 +15093,7 @@ Followed on any target supporting such operations. @geindex Interrupt support @node RM C 3 28 Interrupt Support,RM C 3 1 20-21 Protected Procedure Handlers,RM C 1 10-16 Access to Machine Operations,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-3-28-interrupt-support}@anchor{23a} +@anchor{gnat_rm/implementation_advice rm-c-3-28-interrupt-support}@anchor{23b} @section RM C.3(28): Interrupt Support @@ -15099,7 +15111,7 @@ of interrupt blocking. @geindex Protected procedure handlers @node RM C 3 1 20-21 Protected Procedure Handlers,RM C 3 2 25 Package Interrupts,RM C 3 28 Interrupt Support,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-3-1-20-21-protected-procedure-handlers}@anchor{23b} +@anchor{gnat_rm/implementation_advice rm-c-3-1-20-21-protected-procedure-handlers}@anchor{23c} @section RM C.3.1(20-21): Protected Procedure Handlers @@ -15125,7 +15137,7 @@ Followed. Compile time warnings are given when possible. @geindex Interrupts @node RM C 3 2 25 Package Interrupts,RM C 4 14 Pre-elaboration Requirements,RM C 3 1 20-21 Protected Procedure Handlers,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-3-2-25-package-interrupts}@anchor{23c} +@anchor{gnat_rm/implementation_advice rm-c-3-2-25-package-interrupts}@anchor{23d} @section RM C.3.2(25): Package @code{Interrupts} @@ -15143,7 +15155,7 @@ Followed. @geindex Pre-elaboration requirements @node RM C 4 14 Pre-elaboration Requirements,RM C 5 8 Pragma Discard_Names,RM C 3 2 25 Package Interrupts,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-4-14-pre-elaboration-requirements}@anchor{23d} +@anchor{gnat_rm/implementation_advice rm-c-4-14-pre-elaboration-requirements}@anchor{23e} @section RM C.4(14): Pre-elaboration Requirements @@ -15159,7 +15171,7 @@ Followed. Executable code is generated in some cases, e.g., loops to initialize large arrays. @node RM C 5 8 Pragma Discard_Names,RM C 7 2 30 The Package Task_Attributes,RM C 4 14 Pre-elaboration Requirements,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-5-8-pragma-discard-names}@anchor{23e} +@anchor{gnat_rm/implementation_advice rm-c-5-8-pragma-discard-names}@anchor{23f} @section RM C.5(8): Pragma @code{Discard_Names} @@ -15177,7 +15189,7 @@ Followed. @geindex Task_Attributes @node RM C 7 2 30 The Package Task_Attributes,RM D 3 17 Locking Policies,RM C 5 8 Pragma Discard_Names,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-7-2-30-the-package-task-attributes}@anchor{23f} +@anchor{gnat_rm/implementation_advice rm-c-7-2-30-the-package-task-attributes}@anchor{240} @section RM C.7.2(30): The Package Task_Attributes @@ -15198,7 +15210,7 @@ Not followed. This implementation is not targeted to such a domain. @geindex Locking Policies @node RM D 3 17 Locking Policies,RM D 4 16 Entry Queuing Policies,RM C 7 2 30 The Package Task_Attributes,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-3-17-locking-policies}@anchor{240} +@anchor{gnat_rm/implementation_advice rm-d-3-17-locking-policies}@anchor{241} @section RM D.3(17): Locking Policies @@ -15215,7 +15227,7 @@ whose names (@code{Inheritance_Locking} and @geindex Entry queuing policies @node RM D 4 16 Entry Queuing Policies,RM D 6 9-10 Preemptive Abort,RM D 3 17 Locking Policies,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-4-16-entry-queuing-policies}@anchor{241} +@anchor{gnat_rm/implementation_advice rm-d-4-16-entry-queuing-policies}@anchor{242} @section RM D.4(16): Entry Queuing Policies @@ -15230,7 +15242,7 @@ Followed. No such implementation-defined queuing policies exist. @geindex Preemptive abort @node RM D 6 9-10 Preemptive Abort,RM D 7 21 Tasking Restrictions,RM D 4 16 Entry Queuing Policies,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-6-9-10-preemptive-abort}@anchor{242} +@anchor{gnat_rm/implementation_advice rm-d-6-9-10-preemptive-abort}@anchor{243} @section RM D.6(9-10): Preemptive Abort @@ -15256,7 +15268,7 @@ Followed. @geindex Tasking restrictions @node RM D 7 21 Tasking Restrictions,RM D 8 47-49 Monotonic Time,RM D 6 9-10 Preemptive Abort,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-7-21-tasking-restrictions}@anchor{243} +@anchor{gnat_rm/implementation_advice rm-d-7-21-tasking-restrictions}@anchor{244} @section RM D.7(21): Tasking Restrictions @@ -15275,7 +15287,7 @@ pragma @code{Profile (Restricted)} for more details. @geindex monotonic @node RM D 8 47-49 Monotonic Time,RM E 5 28-29 Partition Communication Subsystem,RM D 7 21 Tasking Restrictions,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-8-47-49-monotonic-time}@anchor{244} +@anchor{gnat_rm/implementation_advice rm-d-8-47-49-monotonic-time}@anchor{245} @section RM D.8(47-49): Monotonic Time @@ -15310,7 +15322,7 @@ Followed. @geindex PCS @node RM E 5 28-29 Partition Communication Subsystem,RM F 7 COBOL Support,RM D 8 47-49 Monotonic Time,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-e-5-28-29-partition-communication-subsystem}@anchor{245} +@anchor{gnat_rm/implementation_advice rm-e-5-28-29-partition-communication-subsystem}@anchor{246} @section RM E.5(28-29): Partition Communication Subsystem @@ -15338,7 +15350,7 @@ GNAT. @geindex COBOL support @node RM F 7 COBOL Support,RM F 1 2 Decimal Radix Support,RM E 5 28-29 Partition Communication Subsystem,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-f-7-cobol-support}@anchor{246} +@anchor{gnat_rm/implementation_advice rm-f-7-cobol-support}@anchor{247} @section RM F(7): COBOL Support @@ -15358,7 +15370,7 @@ Followed. @geindex Decimal radix support @node RM F 1 2 Decimal Radix Support,RM G Numerics,RM F 7 COBOL Support,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-f-1-2-decimal-radix-support}@anchor{247} +@anchor{gnat_rm/implementation_advice rm-f-1-2-decimal-radix-support}@anchor{248} @section RM F.1(2): Decimal Radix Support @@ -15374,7 +15386,7 @@ representations. @geindex Numerics @node RM G Numerics,RM G 1 1 56-58 Complex Types,RM F 1 2 Decimal Radix Support,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-numerics}@anchor{248} +@anchor{gnat_rm/implementation_advice rm-g-numerics}@anchor{249} @section RM G: Numerics @@ -15394,7 +15406,7 @@ Followed. @geindex Complex types @node RM G 1 1 56-58 Complex Types,RM G 1 2 49 Complex Elementary Functions,RM G Numerics,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-1-1-56-58-complex-types}@anchor{249} +@anchor{gnat_rm/implementation_advice rm-g-1-1-56-58-complex-types}@anchor{24a} @section RM G.1.1(56-58): Complex Types @@ -15456,7 +15468,7 @@ Followed. @geindex Complex elementary functions @node RM G 1 2 49 Complex Elementary Functions,RM G 2 4 19 Accuracy Requirements,RM G 1 1 56-58 Complex Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-1-2-49-complex-elementary-functions}@anchor{24a} +@anchor{gnat_rm/implementation_advice rm-g-1-2-49-complex-elementary-functions}@anchor{24b} @section RM G.1.2(49): Complex Elementary Functions @@ -15478,7 +15490,7 @@ Followed. @geindex Accuracy requirements @node RM G 2 4 19 Accuracy Requirements,RM G 2 6 15 Complex Arithmetic Accuracy,RM G 1 2 49 Complex Elementary Functions,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-2-4-19-accuracy-requirements}@anchor{24b} +@anchor{gnat_rm/implementation_advice rm-g-2-4-19-accuracy-requirements}@anchor{24c} @section RM G.2.4(19): Accuracy Requirements @@ -15502,7 +15514,7 @@ Followed. @geindex complex arithmetic @node RM G 2 6 15 Complex Arithmetic Accuracy,RM H 6 15/2 Pragma Partition_Elaboration_Policy,RM G 2 4 19 Accuracy Requirements,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-2-6-15-complex-arithmetic-accuracy}@anchor{24c} +@anchor{gnat_rm/implementation_advice rm-g-2-6-15-complex-arithmetic-accuracy}@anchor{24d} @section RM G.2.6(15): Complex Arithmetic Accuracy @@ -15520,7 +15532,7 @@ Followed. @geindex Sequential elaboration policy @node RM H 6 15/2 Pragma Partition_Elaboration_Policy,,RM G 2 6 15 Complex Arithmetic Accuracy,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-h-6-15-2-pragma-partition-elaboration-policy}@anchor{24d} +@anchor{gnat_rm/implementation_advice rm-h-6-15-2-pragma-partition-elaboration-policy}@anchor{24e} @section RM H.6(15/2): Pragma Partition_Elaboration_Policy @@ -15535,7 +15547,7 @@ immediately terminated." Not followed. @node Implementation Defined Characteristics,Intrinsic Subprograms,Implementation Advice,Top -@anchor{gnat_rm/implementation_defined_characteristics implementation-defined-characteristics}@anchor{b}@anchor{gnat_rm/implementation_defined_characteristics doc}@anchor{24e}@anchor{gnat_rm/implementation_defined_characteristics id1}@anchor{24f} +@anchor{gnat_rm/implementation_defined_characteristics implementation-defined-characteristics}@anchor{b}@anchor{gnat_rm/implementation_defined_characteristics doc}@anchor{24f}@anchor{gnat_rm/implementation_defined_characteristics id1}@anchor{250} @chapter Implementation Defined Characteristics @@ -16731,7 +16743,7 @@ When the @code{Pattern} parameter is not the null string, it is interpreted according to the syntax of regular expressions as defined in the @code{GNAT.Regexp} package. -See @ref{250,,GNAT.Regexp (g-regexp.ads)}. +See @ref{251,,GNAT.Regexp (g-regexp.ads)}. @itemize * @@ -17775,7 +17787,7 @@ H.4(27)." There are no restrictions on pragma @code{Restrictions}. @node Intrinsic Subprograms,Representation Clauses and Pragmas,Implementation Defined Characteristics,Top -@anchor{gnat_rm/intrinsic_subprograms doc}@anchor{251}@anchor{gnat_rm/intrinsic_subprograms intrinsic-subprograms}@anchor{c}@anchor{gnat_rm/intrinsic_subprograms id1}@anchor{252} +@anchor{gnat_rm/intrinsic_subprograms doc}@anchor{252}@anchor{gnat_rm/intrinsic_subprograms intrinsic-subprograms}@anchor{c}@anchor{gnat_rm/intrinsic_subprograms id1}@anchor{253} @chapter Intrinsic Subprograms @@ -17813,7 +17825,7 @@ Ada standard does not require Ada compilers to implement this feature. @end menu @node Intrinsic Operators,Compilation_ISO_Date,,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id2}@anchor{253}@anchor{gnat_rm/intrinsic_subprograms intrinsic-operators}@anchor{254} +@anchor{gnat_rm/intrinsic_subprograms id2}@anchor{254}@anchor{gnat_rm/intrinsic_subprograms intrinsic-operators}@anchor{255} @section Intrinsic Operators @@ -17844,7 +17856,7 @@ It is also possible to specify such operators for private types, if the full views are appropriate arithmetic types. @node Compilation_ISO_Date,Compilation_Date,Intrinsic Operators,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id3}@anchor{255}@anchor{gnat_rm/intrinsic_subprograms compilation-iso-date}@anchor{256} +@anchor{gnat_rm/intrinsic_subprograms id3}@anchor{256}@anchor{gnat_rm/intrinsic_subprograms compilation-iso-date}@anchor{257} @section Compilation_ISO_Date @@ -17858,7 +17870,7 @@ application program should simply call the function the current compilation (in local time format YYYY-MM-DD). @node Compilation_Date,Compilation_Time,Compilation_ISO_Date,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms compilation-date}@anchor{257}@anchor{gnat_rm/intrinsic_subprograms id4}@anchor{258} +@anchor{gnat_rm/intrinsic_subprograms compilation-date}@anchor{258}@anchor{gnat_rm/intrinsic_subprograms id4}@anchor{259} @section Compilation_Date @@ -17868,7 +17880,7 @@ Same as Compilation_ISO_Date, except the string is in the form MMM DD YYYY. @node Compilation_Time,Enclosing_Entity,Compilation_Date,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms compilation-time}@anchor{259}@anchor{gnat_rm/intrinsic_subprograms id5}@anchor{25a} +@anchor{gnat_rm/intrinsic_subprograms compilation-time}@anchor{25a}@anchor{gnat_rm/intrinsic_subprograms id5}@anchor{25b} @section Compilation_Time @@ -17882,7 +17894,7 @@ application program should simply call the function the current compilation (in local time format HH:MM:SS). @node Enclosing_Entity,Exception_Information,Compilation_Time,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id6}@anchor{25b}@anchor{gnat_rm/intrinsic_subprograms enclosing-entity}@anchor{25c} +@anchor{gnat_rm/intrinsic_subprograms id6}@anchor{25c}@anchor{gnat_rm/intrinsic_subprograms enclosing-entity}@anchor{25d} @section Enclosing_Entity @@ -17896,7 +17908,7 @@ application program should simply call the function the current subprogram, package, task, entry, or protected subprogram. @node Exception_Information,Exception_Message,Enclosing_Entity,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id7}@anchor{25d}@anchor{gnat_rm/intrinsic_subprograms exception-information}@anchor{25e} +@anchor{gnat_rm/intrinsic_subprograms id7}@anchor{25e}@anchor{gnat_rm/intrinsic_subprograms exception-information}@anchor{25f} @section Exception_Information @@ -17910,7 +17922,7 @@ so an application program should simply call the function the exception information associated with the current exception. @node Exception_Message,Exception_Name,Exception_Information,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms exception-message}@anchor{25f}@anchor{gnat_rm/intrinsic_subprograms id8}@anchor{260} +@anchor{gnat_rm/intrinsic_subprograms exception-message}@anchor{260}@anchor{gnat_rm/intrinsic_subprograms id8}@anchor{261} @section Exception_Message @@ -17924,7 +17936,7 @@ so an application program should simply call the function the message associated with the current exception. @node Exception_Name,File,Exception_Message,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms exception-name}@anchor{261}@anchor{gnat_rm/intrinsic_subprograms id9}@anchor{262} +@anchor{gnat_rm/intrinsic_subprograms exception-name}@anchor{262}@anchor{gnat_rm/intrinsic_subprograms id9}@anchor{263} @section Exception_Name @@ -17938,7 +17950,7 @@ so an application program should simply call the function the name of the current exception. @node File,Line,Exception_Name,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id10}@anchor{263}@anchor{gnat_rm/intrinsic_subprograms file}@anchor{264} +@anchor{gnat_rm/intrinsic_subprograms id10}@anchor{264}@anchor{gnat_rm/intrinsic_subprograms file}@anchor{265} @section File @@ -17952,7 +17964,7 @@ application program should simply call the function file. @node Line,Shifts and Rotates,File,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id11}@anchor{265}@anchor{gnat_rm/intrinsic_subprograms line}@anchor{266} +@anchor{gnat_rm/intrinsic_subprograms id11}@anchor{266}@anchor{gnat_rm/intrinsic_subprograms line}@anchor{267} @section Line @@ -17966,7 +17978,7 @@ application program should simply call the function source line. @node Shifts and Rotates,Source_Location,Line,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms shifts-and-rotates}@anchor{267}@anchor{gnat_rm/intrinsic_subprograms id12}@anchor{268} +@anchor{gnat_rm/intrinsic_subprograms shifts-and-rotates}@anchor{268}@anchor{gnat_rm/intrinsic_subprograms id12}@anchor{269} @section Shifts and Rotates @@ -18005,7 +18017,7 @@ the Provide_Shift_Operators pragma, which provides the function declarations and corresponding pragma Import's for all five shift functions. @node Source_Location,,Shifts and Rotates,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms source-location}@anchor{269}@anchor{gnat_rm/intrinsic_subprograms id13}@anchor{26a} +@anchor{gnat_rm/intrinsic_subprograms source-location}@anchor{26a}@anchor{gnat_rm/intrinsic_subprograms id13}@anchor{26b} @section Source_Location @@ -18019,7 +18031,7 @@ application program should simply call the function source file location. @node Representation Clauses and Pragmas,Standard Library Routines,Intrinsic Subprograms,Top -@anchor{gnat_rm/representation_clauses_and_pragmas representation-clauses-and-pragmas}@anchor{d}@anchor{gnat_rm/representation_clauses_and_pragmas doc}@anchor{26b}@anchor{gnat_rm/representation_clauses_and_pragmas id1}@anchor{26c} +@anchor{gnat_rm/representation_clauses_and_pragmas representation-clauses-and-pragmas}@anchor{d}@anchor{gnat_rm/representation_clauses_and_pragmas doc}@anchor{26c}@anchor{gnat_rm/representation_clauses_and_pragmas id1}@anchor{26d} @chapter Representation Clauses and Pragmas @@ -18065,7 +18077,7 @@ and this section describes the additional capabilities provided. @end menu @node Alignment Clauses,Size Clauses,,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id2}@anchor{26d}@anchor{gnat_rm/representation_clauses_and_pragmas alignment-clauses}@anchor{26e} +@anchor{gnat_rm/representation_clauses_and_pragmas id2}@anchor{26e}@anchor{gnat_rm/representation_clauses_and_pragmas alignment-clauses}@anchor{26f} @section Alignment Clauses @@ -18194,7 +18206,7 @@ assumption is non-portable, and other compilers may choose different alignments for the subtype @code{RS}. @node Size Clauses,Storage_Size Clauses,Alignment Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id3}@anchor{26f}@anchor{gnat_rm/representation_clauses_and_pragmas size-clauses}@anchor{270} +@anchor{gnat_rm/representation_clauses_and_pragmas id3}@anchor{270}@anchor{gnat_rm/representation_clauses_and_pragmas size-clauses}@anchor{271} @section Size Clauses @@ -18271,7 +18283,7 @@ if it is known that a Size value can be accommodated in an object of type Integer. @node Storage_Size Clauses,Size of Variant Record Objects,Size Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas storage-size-clauses}@anchor{271}@anchor{gnat_rm/representation_clauses_and_pragmas id4}@anchor{272} +@anchor{gnat_rm/representation_clauses_and_pragmas storage-size-clauses}@anchor{272}@anchor{gnat_rm/representation_clauses_and_pragmas id4}@anchor{273} @section Storage_Size Clauses @@ -18344,7 +18356,7 @@ Of course in practice, there will not be any explicit allocators in the case of such an access declaration. @node Size of Variant Record Objects,Biased Representation,Storage_Size Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id5}@anchor{273}@anchor{gnat_rm/representation_clauses_and_pragmas size-of-variant-record-objects}@anchor{274} +@anchor{gnat_rm/representation_clauses_and_pragmas id5}@anchor{274}@anchor{gnat_rm/representation_clauses_and_pragmas size-of-variant-record-objects}@anchor{275} @section Size of Variant Record Objects @@ -18454,7 +18466,7 @@ the maximum size, regardless of the current variant value, the variant value. @node Biased Representation,Value_Size and Object_Size Clauses,Size of Variant Record Objects,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id6}@anchor{275}@anchor{gnat_rm/representation_clauses_and_pragmas biased-representation}@anchor{276} +@anchor{gnat_rm/representation_clauses_and_pragmas id6}@anchor{276}@anchor{gnat_rm/representation_clauses_and_pragmas biased-representation}@anchor{277} @section Biased Representation @@ -18492,7 +18504,7 @@ biased representation can be used for all discrete types except for enumeration types for which a representation clause is given. @node Value_Size and Object_Size Clauses,Component_Size Clauses,Biased Representation,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id7}@anchor{277}@anchor{gnat_rm/representation_clauses_and_pragmas value-size-and-object-size-clauses}@anchor{278} +@anchor{gnat_rm/representation_clauses_and_pragmas id7}@anchor{278}@anchor{gnat_rm/representation_clauses_and_pragmas value-size-and-object-size-clauses}@anchor{279} @section Value_Size and Object_Size Clauses @@ -18799,7 +18811,7 @@ definition clause forces biased representation. This warning can be turned off using @code{-gnatw.B}. @node Component_Size Clauses,Bit_Order Clauses,Value_Size and Object_Size Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id8}@anchor{279}@anchor{gnat_rm/representation_clauses_and_pragmas component-size-clauses}@anchor{27a} +@anchor{gnat_rm/representation_clauses_and_pragmas id8}@anchor{27a}@anchor{gnat_rm/representation_clauses_and_pragmas component-size-clauses}@anchor{27b} @section Component_Size Clauses @@ -18846,7 +18858,7 @@ and a pragma Pack for the same array type. if such duplicate clauses are given, the pragma Pack will be ignored. @node Bit_Order Clauses,Effect of Bit_Order on Byte Ordering,Component_Size Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas bit-order-clauses}@anchor{27b}@anchor{gnat_rm/representation_clauses_and_pragmas id9}@anchor{27c} +@anchor{gnat_rm/representation_clauses_and_pragmas bit-order-clauses}@anchor{27c}@anchor{gnat_rm/representation_clauses_and_pragmas id9}@anchor{27d} @section Bit_Order Clauses @@ -18952,7 +18964,7 @@ if desired. The following section contains additional details regarding the issue of byte ordering. @node Effect of Bit_Order on Byte Ordering,Pragma Pack for Arrays,Bit_Order Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id10}@anchor{27d}@anchor{gnat_rm/representation_clauses_and_pragmas effect-of-bit-order-on-byte-ordering}@anchor{27e} +@anchor{gnat_rm/representation_clauses_and_pragmas id10}@anchor{27e}@anchor{gnat_rm/representation_clauses_and_pragmas effect-of-bit-order-on-byte-ordering}@anchor{27f} @section Effect of Bit_Order on Byte Ordering @@ -19209,7 +19221,7 @@ to set the boolean constant @code{Master_Byte_First} in an appropriate manner. @node Pragma Pack for Arrays,Pragma Pack for Records,Effect of Bit_Order on Byte Ordering,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas pragma-pack-for-arrays}@anchor{27f}@anchor{gnat_rm/representation_clauses_and_pragmas id11}@anchor{280} +@anchor{gnat_rm/representation_clauses_and_pragmas pragma-pack-for-arrays}@anchor{280}@anchor{gnat_rm/representation_clauses_and_pragmas id11}@anchor{281} @section Pragma Pack for Arrays @@ -19326,7 +19338,7 @@ Here 31-bit packing is achieved as required, and no warning is generated, since in this case the programmer intention is clear. @node Pragma Pack for Records,Record Representation Clauses,Pragma Pack for Arrays,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas pragma-pack-for-records}@anchor{281}@anchor{gnat_rm/representation_clauses_and_pragmas id12}@anchor{282} +@anchor{gnat_rm/representation_clauses_and_pragmas pragma-pack-for-records}@anchor{282}@anchor{gnat_rm/representation_clauses_and_pragmas id12}@anchor{283} @section Pragma Pack for Records @@ -19411,7 +19423,7 @@ the @code{L6} field is aligned to the next byte boundary, and takes an integral number of bytes, i.e., 72 bits. @node Record Representation Clauses,Handling of Records with Holes,Pragma Pack for Records,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id13}@anchor{283}@anchor{gnat_rm/representation_clauses_and_pragmas record-representation-clauses}@anchor{284} +@anchor{gnat_rm/representation_clauses_and_pragmas id13}@anchor{284}@anchor{gnat_rm/representation_clauses_and_pragmas record-representation-clauses}@anchor{285} @section Record Representation Clauses @@ -19489,7 +19501,7 @@ end record; @end example @node Handling of Records with Holes,Enumeration Clauses,Record Representation Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas handling-of-records-with-holes}@anchor{285}@anchor{gnat_rm/representation_clauses_and_pragmas id14}@anchor{286} +@anchor{gnat_rm/representation_clauses_and_pragmas handling-of-records-with-holes}@anchor{286}@anchor{gnat_rm/representation_clauses_and_pragmas id14}@anchor{287} @section Handling of Records with Holes @@ -19566,7 +19578,7 @@ for Hrec'Size use 64; @end example @node Enumeration Clauses,Address Clauses,Handling of Records with Holes,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas enumeration-clauses}@anchor{287}@anchor{gnat_rm/representation_clauses_and_pragmas id15}@anchor{288} +@anchor{gnat_rm/representation_clauses_and_pragmas enumeration-clauses}@anchor{288}@anchor{gnat_rm/representation_clauses_and_pragmas id15}@anchor{289} @section Enumeration Clauses @@ -19609,7 +19621,7 @@ the overhead of converting representation values to the corresponding positional values, (i.e., the value delivered by the @code{Pos} attribute). @node Address Clauses,Use of Address Clauses for Memory-Mapped I/O,Enumeration Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id16}@anchor{289}@anchor{gnat_rm/representation_clauses_and_pragmas address-clauses}@anchor{28a} +@anchor{gnat_rm/representation_clauses_and_pragmas id16}@anchor{28a}@anchor{gnat_rm/representation_clauses_and_pragmas address-clauses}@anchor{28b} @section Address Clauses @@ -19938,7 +19950,7 @@ then the program compiles without the warning and when run will generate the output @code{X was not clobbered}. @node Use of Address Clauses for Memory-Mapped I/O,Effect of Convention on Representation,Address Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id17}@anchor{28b}@anchor{gnat_rm/representation_clauses_and_pragmas use-of-address-clauses-for-memory-mapped-i-o}@anchor{28c} +@anchor{gnat_rm/representation_clauses_and_pragmas id17}@anchor{28c}@anchor{gnat_rm/representation_clauses_and_pragmas use-of-address-clauses-for-memory-mapped-i-o}@anchor{28d} @section Use of Address Clauses for Memory-Mapped I/O @@ -19996,7 +20008,7 @@ provides the pragma @code{Volatile_Full_Access} which can be used in lieu of pragma @code{Atomic} and will give the additional guarantee. @node Effect of Convention on Representation,Conventions and Anonymous Access Types,Use of Address Clauses for Memory-Mapped I/O,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id18}@anchor{28d}@anchor{gnat_rm/representation_clauses_and_pragmas effect-of-convention-on-representation}@anchor{28e} +@anchor{gnat_rm/representation_clauses_and_pragmas id18}@anchor{28e}@anchor{gnat_rm/representation_clauses_and_pragmas effect-of-convention-on-representation}@anchor{28f} @section Effect of Convention on Representation @@ -20074,7 +20086,7 @@ when one of these values is read, any nonzero value is treated as True. @end itemize @node Conventions and Anonymous Access Types,Determining the Representations chosen by GNAT,Effect of Convention on Representation,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas conventions-and-anonymous-access-types}@anchor{28f}@anchor{gnat_rm/representation_clauses_and_pragmas id19}@anchor{290} +@anchor{gnat_rm/representation_clauses_and_pragmas conventions-and-anonymous-access-types}@anchor{290}@anchor{gnat_rm/representation_clauses_and_pragmas id19}@anchor{291} @section Conventions and Anonymous Access Types @@ -20150,7 +20162,7 @@ package ConvComp is @end example @node Determining the Representations chosen by GNAT,,Conventions and Anonymous Access Types,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id20}@anchor{291}@anchor{gnat_rm/representation_clauses_and_pragmas determining-the-representations-chosen-by-gnat}@anchor{292} +@anchor{gnat_rm/representation_clauses_and_pragmas id20}@anchor{292}@anchor{gnat_rm/representation_clauses_and_pragmas determining-the-representations-chosen-by-gnat}@anchor{293} @section Determining the Representations chosen by GNAT @@ -20302,7 +20314,7 @@ generated by the compiler into the original source to fix and guarantee the actual representation to be used. @node Standard Library Routines,The Implementation of Standard I/O,Representation Clauses and Pragmas,Top -@anchor{gnat_rm/standard_library_routines standard-library-routines}@anchor{e}@anchor{gnat_rm/standard_library_routines doc}@anchor{293}@anchor{gnat_rm/standard_library_routines id1}@anchor{294} +@anchor{gnat_rm/standard_library_routines standard-library-routines}@anchor{e}@anchor{gnat_rm/standard_library_routines doc}@anchor{294}@anchor{gnat_rm/standard_library_routines id1}@anchor{295} @chapter Standard Library Routines @@ -21128,7 +21140,7 @@ For packages in Interfaces and System, all the RM defined packages are available in GNAT, see the Ada 2012 RM for full details. @node The Implementation of Standard I/O,The GNAT Library,Standard Library Routines,Top -@anchor{gnat_rm/the_implementation_of_standard_i_o the-implementation-of-standard-i-o}@anchor{f}@anchor{gnat_rm/the_implementation_of_standard_i_o doc}@anchor{295}@anchor{gnat_rm/the_implementation_of_standard_i_o id1}@anchor{296} +@anchor{gnat_rm/the_implementation_of_standard_i_o the-implementation-of-standard-i-o}@anchor{f}@anchor{gnat_rm/the_implementation_of_standard_i_o doc}@anchor{296}@anchor{gnat_rm/the_implementation_of_standard_i_o id1}@anchor{297} @chapter The Implementation of Standard I/O @@ -21180,7 +21192,7 @@ these additional facilities are also described in this chapter. @end menu @node Standard I/O Packages,FORM Strings,,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o standard-i-o-packages}@anchor{297}@anchor{gnat_rm/the_implementation_of_standard_i_o id2}@anchor{298} +@anchor{gnat_rm/the_implementation_of_standard_i_o standard-i-o-packages}@anchor{298}@anchor{gnat_rm/the_implementation_of_standard_i_o id2}@anchor{299} @section Standard I/O Packages @@ -21251,7 +21263,7 @@ flush the common I/O streams and in particular Standard_Output before elaborating the Ada code. @node FORM Strings,Direct_IO,Standard I/O Packages,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o form-strings}@anchor{299}@anchor{gnat_rm/the_implementation_of_standard_i_o id3}@anchor{29a} +@anchor{gnat_rm/the_implementation_of_standard_i_o form-strings}@anchor{29a}@anchor{gnat_rm/the_implementation_of_standard_i_o id3}@anchor{29b} @section FORM Strings @@ -21277,7 +21289,7 @@ unrecognized keyword appears in a form string, it is silently ignored and not considered invalid. @node Direct_IO,Sequential_IO,FORM Strings,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o direct-io}@anchor{29b}@anchor{gnat_rm/the_implementation_of_standard_i_o id4}@anchor{29c} +@anchor{gnat_rm/the_implementation_of_standard_i_o direct-io}@anchor{29c}@anchor{gnat_rm/the_implementation_of_standard_i_o id4}@anchor{29d} @section Direct_IO @@ -21297,7 +21309,7 @@ There is no limit on the size of Direct_IO files, they are expanded as necessary to accommodate whatever records are written to the file. @node Sequential_IO,Text_IO,Direct_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o sequential-io}@anchor{29d}@anchor{gnat_rm/the_implementation_of_standard_i_o id5}@anchor{29e} +@anchor{gnat_rm/the_implementation_of_standard_i_o sequential-io}@anchor{29e}@anchor{gnat_rm/the_implementation_of_standard_i_o id5}@anchor{29f} @section Sequential_IO @@ -21344,7 +21356,7 @@ using Stream_IO, and this is the preferred mechanism. In particular, the above program fragment rewritten to use Stream_IO will work correctly. @node Text_IO,Wide_Text_IO,Sequential_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id6}@anchor{29f}@anchor{gnat_rm/the_implementation_of_standard_i_o text-io}@anchor{2a0} +@anchor{gnat_rm/the_implementation_of_standard_i_o id6}@anchor{2a0}@anchor{gnat_rm/the_implementation_of_standard_i_o text-io}@anchor{2a1} @section Text_IO @@ -21427,7 +21439,7 @@ the file. @end menu @node Stream Pointer Positioning,Reading and Writing Non-Regular Files,,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o id7}@anchor{2a1}@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning}@anchor{2a2} +@anchor{gnat_rm/the_implementation_of_standard_i_o id7}@anchor{2a2}@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning}@anchor{2a3} @subsection Stream Pointer Positioning @@ -21463,7 +21475,7 @@ between two Ada files, then the difference may be observable in some situations. @node Reading and Writing Non-Regular Files,Get_Immediate,Stream Pointer Positioning,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files}@anchor{2a3}@anchor{gnat_rm/the_implementation_of_standard_i_o id8}@anchor{2a4} +@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files}@anchor{2a4}@anchor{gnat_rm/the_implementation_of_standard_i_o id8}@anchor{2a5} @subsection Reading and Writing Non-Regular Files @@ -21514,7 +21526,7 @@ to read data past that end of file indication, until another end of file indication is entered. @node Get_Immediate,Treating Text_IO Files as Streams,Reading and Writing Non-Regular Files,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o get-immediate}@anchor{2a5}@anchor{gnat_rm/the_implementation_of_standard_i_o id9}@anchor{2a6} +@anchor{gnat_rm/the_implementation_of_standard_i_o get-immediate}@anchor{2a6}@anchor{gnat_rm/the_implementation_of_standard_i_o id9}@anchor{2a7} @subsection Get_Immediate @@ -21532,7 +21544,7 @@ possible), it is undefined whether the FF character will be treated as a page mark. @node Treating Text_IO Files as Streams,Text_IO Extensions,Get_Immediate,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o id10}@anchor{2a7}@anchor{gnat_rm/the_implementation_of_standard_i_o treating-text-io-files-as-streams}@anchor{2a8} +@anchor{gnat_rm/the_implementation_of_standard_i_o id10}@anchor{2a8}@anchor{gnat_rm/the_implementation_of_standard_i_o treating-text-io-files-as-streams}@anchor{2a9} @subsection Treating Text_IO Files as Streams @@ -21548,7 +21560,7 @@ skipped and the effect is similar to that described above for @code{Get_Immediate}. @node Text_IO Extensions,Text_IO Facilities for Unbounded Strings,Treating Text_IO Files as Streams,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o id11}@anchor{2a9}@anchor{gnat_rm/the_implementation_of_standard_i_o text-io-extensions}@anchor{2aa} +@anchor{gnat_rm/the_implementation_of_standard_i_o id11}@anchor{2aa}@anchor{gnat_rm/the_implementation_of_standard_i_o text-io-extensions}@anchor{2ab} @subsection Text_IO Extensions @@ -21576,7 +21588,7 @@ the string is to be read. @end itemize @node Text_IO Facilities for Unbounded Strings,,Text_IO Extensions,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o text-io-facilities-for-unbounded-strings}@anchor{2ab}@anchor{gnat_rm/the_implementation_of_standard_i_o id12}@anchor{2ac} +@anchor{gnat_rm/the_implementation_of_standard_i_o text-io-facilities-for-unbounded-strings}@anchor{2ac}@anchor{gnat_rm/the_implementation_of_standard_i_o id12}@anchor{2ad} @subsection Text_IO Facilities for Unbounded Strings @@ -21624,7 +21636,7 @@ files @code{a-szuzti.ads} and @code{a-szuzti.adb} provides similar extended @code{Wide_Wide_Text_IO} functionality for unbounded wide wide strings. @node Wide_Text_IO,Wide_Wide_Text_IO,Text_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o wide-text-io}@anchor{2ad}@anchor{gnat_rm/the_implementation_of_standard_i_o id13}@anchor{2ae} +@anchor{gnat_rm/the_implementation_of_standard_i_o wide-text-io}@anchor{2ae}@anchor{gnat_rm/the_implementation_of_standard_i_o id13}@anchor{2af} @section Wide_Text_IO @@ -21871,12 +21883,12 @@ input also causes Constraint_Error to be raised. @end menu @node Stream Pointer Positioning<2>,Reading and Writing Non-Regular Files<2>,,Wide_Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning-1}@anchor{2af}@anchor{gnat_rm/the_implementation_of_standard_i_o id14}@anchor{2b0} +@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning-1}@anchor{2b0}@anchor{gnat_rm/the_implementation_of_standard_i_o id14}@anchor{2b1} @subsection Stream Pointer Positioning @code{Ada.Wide_Text_IO} is similar to @code{Ada.Text_IO} in its handling -of stream pointer positioning (@ref{2a0,,Text_IO}). There is one additional +of stream pointer positioning (@ref{2a1,,Text_IO}). There is one additional case: If @code{Ada.Wide_Text_IO.Look_Ahead} reads a character outside the @@ -21895,7 +21907,7 @@ to a normal program using @code{Wide_Text_IO}. However, this discrepancy can be observed if the wide text file shares a stream with another file. @node Reading and Writing Non-Regular Files<2>,,Stream Pointer Positioning<2>,Wide_Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files-1}@anchor{2b1}@anchor{gnat_rm/the_implementation_of_standard_i_o id15}@anchor{2b2} +@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files-1}@anchor{2b2}@anchor{gnat_rm/the_implementation_of_standard_i_o id15}@anchor{2b3} @subsection Reading and Writing Non-Regular Files @@ -21906,7 +21918,7 @@ treated as data characters), and @code{End_Of_Page} always returns it is possible to read beyond an end of file. @node Wide_Wide_Text_IO,Stream_IO,Wide_Text_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id16}@anchor{2b3}@anchor{gnat_rm/the_implementation_of_standard_i_o wide-wide-text-io}@anchor{2b4} +@anchor{gnat_rm/the_implementation_of_standard_i_o id16}@anchor{2b4}@anchor{gnat_rm/the_implementation_of_standard_i_o wide-wide-text-io}@anchor{2b5} @section Wide_Wide_Text_IO @@ -22075,12 +22087,12 @@ input also causes Constraint_Error to be raised. @end menu @node Stream Pointer Positioning<3>,Reading and Writing Non-Regular Files<3>,,Wide_Wide_Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning-2}@anchor{2b5}@anchor{gnat_rm/the_implementation_of_standard_i_o id17}@anchor{2b6} +@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning-2}@anchor{2b6}@anchor{gnat_rm/the_implementation_of_standard_i_o id17}@anchor{2b7} @subsection Stream Pointer Positioning @code{Ada.Wide_Wide_Text_IO} is similar to @code{Ada.Text_IO} in its handling -of stream pointer positioning (@ref{2a0,,Text_IO}). There is one additional +of stream pointer positioning (@ref{2a1,,Text_IO}). There is one additional case: If @code{Ada.Wide_Wide_Text_IO.Look_Ahead} reads a character outside the @@ -22099,7 +22111,7 @@ to a normal program using @code{Wide_Wide_Text_IO}. However, this discrepancy can be observed if the wide text file shares a stream with another file. @node Reading and Writing Non-Regular Files<3>,,Stream Pointer Positioning<3>,Wide_Wide_Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o id18}@anchor{2b7}@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files-2}@anchor{2b8} +@anchor{gnat_rm/the_implementation_of_standard_i_o id18}@anchor{2b8}@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files-2}@anchor{2b9} @subsection Reading and Writing Non-Regular Files @@ -22110,7 +22122,7 @@ treated as data characters), and @code{End_Of_Page} always returns it is possible to read beyond an end of file. @node Stream_IO,Text Translation,Wide_Wide_Text_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id19}@anchor{2b9}@anchor{gnat_rm/the_implementation_of_standard_i_o stream-io}@anchor{2ba} +@anchor{gnat_rm/the_implementation_of_standard_i_o id19}@anchor{2ba}@anchor{gnat_rm/the_implementation_of_standard_i_o stream-io}@anchor{2bb} @section Stream_IO @@ -22132,7 +22144,7 @@ manner described for stream attributes. @end itemize @node Text Translation,Shared Files,Stream_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id20}@anchor{2bb}@anchor{gnat_rm/the_implementation_of_standard_i_o text-translation}@anchor{2bc} +@anchor{gnat_rm/the_implementation_of_standard_i_o id20}@anchor{2bc}@anchor{gnat_rm/the_implementation_of_standard_i_o text-translation}@anchor{2bd} @section Text Translation @@ -22166,7 +22178,7 @@ mode. (corresponds to_O_U16TEXT). @end itemize @node Shared Files,Filenames encoding,Text Translation,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id21}@anchor{2bd}@anchor{gnat_rm/the_implementation_of_standard_i_o shared-files}@anchor{2be} +@anchor{gnat_rm/the_implementation_of_standard_i_o id21}@anchor{2be}@anchor{gnat_rm/the_implementation_of_standard_i_o shared-files}@anchor{2bf} @section Shared Files @@ -22229,7 +22241,7 @@ heterogeneous input-output. Although this approach will work in GNAT if for this purpose (using the stream attributes) @node Filenames encoding,File content encoding,Shared Files,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o filenames-encoding}@anchor{2bf}@anchor{gnat_rm/the_implementation_of_standard_i_o id22}@anchor{2c0} +@anchor{gnat_rm/the_implementation_of_standard_i_o filenames-encoding}@anchor{2c0}@anchor{gnat_rm/the_implementation_of_standard_i_o id22}@anchor{2c1} @section Filenames encoding @@ -22269,7 +22281,7 @@ platform. On the other Operating Systems the run-time is supporting UTF-8 natively. @node File content encoding,Open Modes,Filenames encoding,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o file-content-encoding}@anchor{2c1}@anchor{gnat_rm/the_implementation_of_standard_i_o id23}@anchor{2c2} +@anchor{gnat_rm/the_implementation_of_standard_i_o file-content-encoding}@anchor{2c2}@anchor{gnat_rm/the_implementation_of_standard_i_o id23}@anchor{2c3} @section File content encoding @@ -22302,7 +22314,7 @@ Unicode 8-bit encoding This encoding is only supported on the Windows platform. @node Open Modes,Operations on C Streams,File content encoding,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o open-modes}@anchor{2c3}@anchor{gnat_rm/the_implementation_of_standard_i_o id24}@anchor{2c4} +@anchor{gnat_rm/the_implementation_of_standard_i_o open-modes}@anchor{2c4}@anchor{gnat_rm/the_implementation_of_standard_i_o id24}@anchor{2c5} @section Open Modes @@ -22405,7 +22417,7 @@ subsequently requires switching from reading to writing or vice-versa, then the file is reopened in @code{r+} mode to permit the required operation. @node Operations on C Streams,Interfacing to C Streams,Open Modes,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o operations-on-c-streams}@anchor{2c5}@anchor{gnat_rm/the_implementation_of_standard_i_o id25}@anchor{2c6} +@anchor{gnat_rm/the_implementation_of_standard_i_o operations-on-c-streams}@anchor{2c6}@anchor{gnat_rm/the_implementation_of_standard_i_o id25}@anchor{2c7} @section Operations on C Streams @@ -22565,7 +22577,7 @@ end Interfaces.C_Streams; @end example @node Interfacing to C Streams,,Operations on C Streams,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o interfacing-to-c-streams}@anchor{2c7}@anchor{gnat_rm/the_implementation_of_standard_i_o id26}@anchor{2c8} +@anchor{gnat_rm/the_implementation_of_standard_i_o interfacing-to-c-streams}@anchor{2c8}@anchor{gnat_rm/the_implementation_of_standard_i_o id26}@anchor{2c9} @section Interfacing to C Streams @@ -22658,7 +22670,7 @@ imported from a C program, allowing an Ada file to operate on an existing C file. @node The GNAT Library,Interfacing to Other Languages,The Implementation of Standard I/O,Top -@anchor{gnat_rm/the_gnat_library the-gnat-library}@anchor{10}@anchor{gnat_rm/the_gnat_library doc}@anchor{2c9}@anchor{gnat_rm/the_gnat_library id1}@anchor{2ca} +@anchor{gnat_rm/the_gnat_library the-gnat-library}@anchor{10}@anchor{gnat_rm/the_gnat_library doc}@anchor{2ca}@anchor{gnat_rm/the_gnat_library id1}@anchor{2cb} @chapter The GNAT Library @@ -22850,7 +22862,7 @@ of GNAT, and will generate a warning message. @end menu @node Ada Characters Latin_9 a-chlat9 ads,Ada Characters Wide_Latin_1 a-cwila1 ads,,The GNAT Library -@anchor{gnat_rm/the_gnat_library id2}@anchor{2cb}@anchor{gnat_rm/the_gnat_library ada-characters-latin-9-a-chlat9-ads}@anchor{2cc} +@anchor{gnat_rm/the_gnat_library id2}@anchor{2cc}@anchor{gnat_rm/the_gnat_library ada-characters-latin-9-a-chlat9-ads}@anchor{2cd} @section @code{Ada.Characters.Latin_9} (@code{a-chlat9.ads}) @@ -22867,7 +22879,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Characters Wide_Latin_1 a-cwila1 ads,Ada Characters Wide_Latin_9 a-cwila1 ads,Ada Characters Latin_9 a-chlat9 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-characters-wide-latin-1-a-cwila1-ads}@anchor{2cd}@anchor{gnat_rm/the_gnat_library id3}@anchor{2ce} +@anchor{gnat_rm/the_gnat_library ada-characters-wide-latin-1-a-cwila1-ads}@anchor{2ce}@anchor{gnat_rm/the_gnat_library id3}@anchor{2cf} @section @code{Ada.Characters.Wide_Latin_1} (@code{a-cwila1.ads}) @@ -22884,7 +22896,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Characters Wide_Latin_9 a-cwila1 ads,Ada Characters Wide_Wide_Latin_1 a-chzla1 ads,Ada Characters Wide_Latin_1 a-cwila1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id4}@anchor{2cf}@anchor{gnat_rm/the_gnat_library ada-characters-wide-latin-9-a-cwila1-ads}@anchor{2d0} +@anchor{gnat_rm/the_gnat_library id4}@anchor{2d0}@anchor{gnat_rm/the_gnat_library ada-characters-wide-latin-9-a-cwila1-ads}@anchor{2d1} @section @code{Ada.Characters.Wide_Latin_9} (@code{a-cwila1.ads}) @@ -22901,7 +22913,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Characters Wide_Wide_Latin_1 a-chzla1 ads,Ada Characters Wide_Wide_Latin_9 a-chzla9 ads,Ada Characters Wide_Latin_9 a-cwila1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-characters-wide-wide-latin-1-a-chzla1-ads}@anchor{2d1}@anchor{gnat_rm/the_gnat_library id5}@anchor{2d2} +@anchor{gnat_rm/the_gnat_library ada-characters-wide-wide-latin-1-a-chzla1-ads}@anchor{2d2}@anchor{gnat_rm/the_gnat_library id5}@anchor{2d3} @section @code{Ada.Characters.Wide_Wide_Latin_1} (@code{a-chzla1.ads}) @@ -22918,7 +22930,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Characters Wide_Wide_Latin_9 a-chzla9 ads,Ada Containers Formal_Doubly_Linked_Lists a-cfdlli ads,Ada Characters Wide_Wide_Latin_1 a-chzla1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-characters-wide-wide-latin-9-a-chzla9-ads}@anchor{2d3}@anchor{gnat_rm/the_gnat_library id6}@anchor{2d4} +@anchor{gnat_rm/the_gnat_library ada-characters-wide-wide-latin-9-a-chzla9-ads}@anchor{2d4}@anchor{gnat_rm/the_gnat_library id6}@anchor{2d5} @section @code{Ada.Characters.Wide_Wide_Latin_9} (@code{a-chzla9.ads}) @@ -22935,7 +22947,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Containers Formal_Doubly_Linked_Lists a-cfdlli ads,Ada Containers Formal_Hashed_Maps a-cfhama ads,Ada Characters Wide_Wide_Latin_9 a-chzla9 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id7}@anchor{2d5}@anchor{gnat_rm/the_gnat_library ada-containers-formal-doubly-linked-lists-a-cfdlli-ads}@anchor{2d6} +@anchor{gnat_rm/the_gnat_library id7}@anchor{2d6}@anchor{gnat_rm/the_gnat_library ada-containers-formal-doubly-linked-lists-a-cfdlli-ads}@anchor{2d7} @section @code{Ada.Containers.Formal_Doubly_Linked_Lists} (@code{a-cfdlli.ads}) @@ -22954,7 +22966,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Hashed_Maps a-cfhama ads,Ada Containers Formal_Hashed_Sets a-cfhase ads,Ada Containers Formal_Doubly_Linked_Lists a-cfdlli ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id8}@anchor{2d7}@anchor{gnat_rm/the_gnat_library ada-containers-formal-hashed-maps-a-cfhama-ads}@anchor{2d8} +@anchor{gnat_rm/the_gnat_library id8}@anchor{2d8}@anchor{gnat_rm/the_gnat_library ada-containers-formal-hashed-maps-a-cfhama-ads}@anchor{2d9} @section @code{Ada.Containers.Formal_Hashed_Maps} (@code{a-cfhama.ads}) @@ -22973,7 +22985,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Hashed_Sets a-cfhase ads,Ada Containers Formal_Ordered_Maps a-cforma ads,Ada Containers Formal_Hashed_Maps a-cfhama ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id9}@anchor{2d9}@anchor{gnat_rm/the_gnat_library ada-containers-formal-hashed-sets-a-cfhase-ads}@anchor{2da} +@anchor{gnat_rm/the_gnat_library id9}@anchor{2da}@anchor{gnat_rm/the_gnat_library ada-containers-formal-hashed-sets-a-cfhase-ads}@anchor{2db} @section @code{Ada.Containers.Formal_Hashed_Sets} (@code{a-cfhase.ads}) @@ -22992,7 +23004,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Ordered_Maps a-cforma ads,Ada Containers Formal_Ordered_Sets a-cforse ads,Ada Containers Formal_Hashed_Sets a-cfhase ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id10}@anchor{2db}@anchor{gnat_rm/the_gnat_library ada-containers-formal-ordered-maps-a-cforma-ads}@anchor{2dc} +@anchor{gnat_rm/the_gnat_library id10}@anchor{2dc}@anchor{gnat_rm/the_gnat_library ada-containers-formal-ordered-maps-a-cforma-ads}@anchor{2dd} @section @code{Ada.Containers.Formal_Ordered_Maps} (@code{a-cforma.ads}) @@ -23011,7 +23023,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Ordered_Sets a-cforse ads,Ada Containers Formal_Vectors a-cofove ads,Ada Containers Formal_Ordered_Maps a-cforma ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-containers-formal-ordered-sets-a-cforse-ads}@anchor{2dd}@anchor{gnat_rm/the_gnat_library id11}@anchor{2de} +@anchor{gnat_rm/the_gnat_library ada-containers-formal-ordered-sets-a-cforse-ads}@anchor{2de}@anchor{gnat_rm/the_gnat_library id11}@anchor{2df} @section @code{Ada.Containers.Formal_Ordered_Sets} (@code{a-cforse.ads}) @@ -23030,7 +23042,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Vectors a-cofove ads,Ada Containers Formal_Indefinite_Vectors a-cfinve ads,Ada Containers Formal_Ordered_Sets a-cforse ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id12}@anchor{2df}@anchor{gnat_rm/the_gnat_library ada-containers-formal-vectors-a-cofove-ads}@anchor{2e0} +@anchor{gnat_rm/the_gnat_library id12}@anchor{2e0}@anchor{gnat_rm/the_gnat_library ada-containers-formal-vectors-a-cofove-ads}@anchor{2e1} @section @code{Ada.Containers.Formal_Vectors} (@code{a-cofove.ads}) @@ -23049,7 +23061,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Indefinite_Vectors a-cfinve ads,Ada Containers Functional_Vectors a-cofuve ads,Ada Containers Formal_Vectors a-cofove ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id13}@anchor{2e1}@anchor{gnat_rm/the_gnat_library ada-containers-formal-indefinite-vectors-a-cfinve-ads}@anchor{2e2} +@anchor{gnat_rm/the_gnat_library id13}@anchor{2e2}@anchor{gnat_rm/the_gnat_library ada-containers-formal-indefinite-vectors-a-cfinve-ads}@anchor{2e3} @section @code{Ada.Containers.Formal_Indefinite_Vectors} (@code{a-cfinve.ads}) @@ -23068,7 +23080,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Functional_Vectors a-cofuve ads,Ada Containers Functional_Sets a-cofuse ads,Ada Containers Formal_Indefinite_Vectors a-cfinve ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id14}@anchor{2e3}@anchor{gnat_rm/the_gnat_library ada-containers-functional-vectors-a-cofuve-ads}@anchor{2e4} +@anchor{gnat_rm/the_gnat_library id14}@anchor{2e4}@anchor{gnat_rm/the_gnat_library ada-containers-functional-vectors-a-cofuve-ads}@anchor{2e5} @section @code{Ada.Containers.Functional_Vectors} (@code{a-cofuve.ads}) @@ -23090,7 +23102,7 @@ and annotations, so that they can be removed from the final executable. The specification of this unit is compatible with SPARK 2014. @node Ada Containers Functional_Sets a-cofuse ads,Ada Containers Functional_Maps a-cofuma ads,Ada Containers Functional_Vectors a-cofuve ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-containers-functional-sets-a-cofuse-ads}@anchor{2e5}@anchor{gnat_rm/the_gnat_library id15}@anchor{2e6} +@anchor{gnat_rm/the_gnat_library ada-containers-functional-sets-a-cofuse-ads}@anchor{2e6}@anchor{gnat_rm/the_gnat_library id15}@anchor{2e7} @section @code{Ada.Containers.Functional_Sets} (@code{a-cofuse.ads}) @@ -23112,7 +23124,7 @@ and annotations, so that they can be removed from the final executable. The specification of this unit is compatible with SPARK 2014. @node Ada Containers Functional_Maps a-cofuma ads,Ada Containers Bounded_Holders a-coboho ads,Ada Containers Functional_Sets a-cofuse ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id16}@anchor{2e7}@anchor{gnat_rm/the_gnat_library ada-containers-functional-maps-a-cofuma-ads}@anchor{2e8} +@anchor{gnat_rm/the_gnat_library id16}@anchor{2e8}@anchor{gnat_rm/the_gnat_library ada-containers-functional-maps-a-cofuma-ads}@anchor{2e9} @section @code{Ada.Containers.Functional_Maps} (@code{a-cofuma.ads}) @@ -23134,7 +23146,7 @@ and annotations, so that they can be removed from the final executable. The specification of this unit is compatible with SPARK 2014. @node Ada Containers Bounded_Holders a-coboho ads,Ada Command_Line Environment a-colien ads,Ada Containers Functional_Maps a-cofuma ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-containers-bounded-holders-a-coboho-ads}@anchor{2e9}@anchor{gnat_rm/the_gnat_library id17}@anchor{2ea} +@anchor{gnat_rm/the_gnat_library ada-containers-bounded-holders-a-coboho-ads}@anchor{2ea}@anchor{gnat_rm/the_gnat_library id17}@anchor{2eb} @section @code{Ada.Containers.Bounded_Holders} (@code{a-coboho.ads}) @@ -23146,7 +23158,7 @@ This child of @code{Ada.Containers} defines a modified version of Indefinite_Holders that avoids heap allocation. @node Ada Command_Line Environment a-colien ads,Ada Command_Line Remove a-colire ads,Ada Containers Bounded_Holders a-coboho ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-command-line-environment-a-colien-ads}@anchor{2eb}@anchor{gnat_rm/the_gnat_library id18}@anchor{2ec} +@anchor{gnat_rm/the_gnat_library ada-command-line-environment-a-colien-ads}@anchor{2ec}@anchor{gnat_rm/the_gnat_library id18}@anchor{2ed} @section @code{Ada.Command_Line.Environment} (@code{a-colien.ads}) @@ -23159,7 +23171,7 @@ provides a mechanism for obtaining environment values on systems where this concept makes sense. @node Ada Command_Line Remove a-colire ads,Ada Command_Line Response_File a-clrefi ads,Ada Command_Line Environment a-colien ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id19}@anchor{2ed}@anchor{gnat_rm/the_gnat_library ada-command-line-remove-a-colire-ads}@anchor{2ee} +@anchor{gnat_rm/the_gnat_library id19}@anchor{2ee}@anchor{gnat_rm/the_gnat_library ada-command-line-remove-a-colire-ads}@anchor{2ef} @section @code{Ada.Command_Line.Remove} (@code{a-colire.ads}) @@ -23177,7 +23189,7 @@ to further calls on the subprograms in @code{Ada.Command_Line} will not see the removed argument. @node Ada Command_Line Response_File a-clrefi ads,Ada Direct_IO C_Streams a-diocst ads,Ada Command_Line Remove a-colire ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id20}@anchor{2ef}@anchor{gnat_rm/the_gnat_library ada-command-line-response-file-a-clrefi-ads}@anchor{2f0} +@anchor{gnat_rm/the_gnat_library id20}@anchor{2f0}@anchor{gnat_rm/the_gnat_library ada-command-line-response-file-a-clrefi-ads}@anchor{2f1} @section @code{Ada.Command_Line.Response_File} (@code{a-clrefi.ads}) @@ -23197,7 +23209,7 @@ Using a response file allow passing a set of arguments to an executable longer than the maximum allowed by the system on the command line. @node Ada Direct_IO C_Streams a-diocst ads,Ada Exceptions Is_Null_Occurrence a-einuoc ads,Ada Command_Line Response_File a-clrefi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id21}@anchor{2f1}@anchor{gnat_rm/the_gnat_library ada-direct-io-c-streams-a-diocst-ads}@anchor{2f2} +@anchor{gnat_rm/the_gnat_library id21}@anchor{2f2}@anchor{gnat_rm/the_gnat_library ada-direct-io-c-streams-a-diocst-ads}@anchor{2f3} @section @code{Ada.Direct_IO.C_Streams} (@code{a-diocst.ads}) @@ -23212,7 +23224,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Exceptions Is_Null_Occurrence a-einuoc ads,Ada Exceptions Last_Chance_Handler a-elchha ads,Ada Direct_IO C_Streams a-diocst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id22}@anchor{2f3}@anchor{gnat_rm/the_gnat_library ada-exceptions-is-null-occurrence-a-einuoc-ads}@anchor{2f4} +@anchor{gnat_rm/the_gnat_library id22}@anchor{2f4}@anchor{gnat_rm/the_gnat_library ada-exceptions-is-null-occurrence-a-einuoc-ads}@anchor{2f5} @section @code{Ada.Exceptions.Is_Null_Occurrence} (@code{a-einuoc.ads}) @@ -23226,7 +23238,7 @@ exception occurrence (@code{Null_Occurrence}) without raising an exception. @node Ada Exceptions Last_Chance_Handler a-elchha ads,Ada Exceptions Traceback a-exctra ads,Ada Exceptions Is_Null_Occurrence a-einuoc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id23}@anchor{2f5}@anchor{gnat_rm/the_gnat_library ada-exceptions-last-chance-handler-a-elchha-ads}@anchor{2f6} +@anchor{gnat_rm/the_gnat_library id23}@anchor{2f6}@anchor{gnat_rm/the_gnat_library ada-exceptions-last-chance-handler-a-elchha-ads}@anchor{2f7} @section @code{Ada.Exceptions.Last_Chance_Handler} (@code{a-elchha.ads}) @@ -23240,7 +23252,7 @@ exceptions (hence the name last chance), and perform clean ups before terminating the program. Note that this subprogram never returns. @node Ada Exceptions Traceback a-exctra ads,Ada Sequential_IO C_Streams a-siocst ads,Ada Exceptions Last_Chance_Handler a-elchha ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-exceptions-traceback-a-exctra-ads}@anchor{2f7}@anchor{gnat_rm/the_gnat_library id24}@anchor{2f8} +@anchor{gnat_rm/the_gnat_library ada-exceptions-traceback-a-exctra-ads}@anchor{2f8}@anchor{gnat_rm/the_gnat_library id24}@anchor{2f9} @section @code{Ada.Exceptions.Traceback} (@code{a-exctra.ads}) @@ -23253,7 +23265,7 @@ give a traceback array of addresses based on an exception occurrence. @node Ada Sequential_IO C_Streams a-siocst ads,Ada Streams Stream_IO C_Streams a-ssicst ads,Ada Exceptions Traceback a-exctra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-sequential-io-c-streams-a-siocst-ads}@anchor{2f9}@anchor{gnat_rm/the_gnat_library id25}@anchor{2fa} +@anchor{gnat_rm/the_gnat_library ada-sequential-io-c-streams-a-siocst-ads}@anchor{2fa}@anchor{gnat_rm/the_gnat_library id25}@anchor{2fb} @section @code{Ada.Sequential_IO.C_Streams} (@code{a-siocst.ads}) @@ -23268,7 +23280,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Streams Stream_IO C_Streams a-ssicst ads,Ada Strings Unbounded Text_IO a-suteio ads,Ada Sequential_IO C_Streams a-siocst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id26}@anchor{2fb}@anchor{gnat_rm/the_gnat_library ada-streams-stream-io-c-streams-a-ssicst-ads}@anchor{2fc} +@anchor{gnat_rm/the_gnat_library id26}@anchor{2fc}@anchor{gnat_rm/the_gnat_library ada-streams-stream-io-c-streams-a-ssicst-ads}@anchor{2fd} @section @code{Ada.Streams.Stream_IO.C_Streams} (@code{a-ssicst.ads}) @@ -23283,7 +23295,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Strings Unbounded Text_IO a-suteio ads,Ada Strings Wide_Unbounded Wide_Text_IO a-swuwti ads,Ada Streams Stream_IO C_Streams a-ssicst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-strings-unbounded-text-io-a-suteio-ads}@anchor{2fd}@anchor{gnat_rm/the_gnat_library id27}@anchor{2fe} +@anchor{gnat_rm/the_gnat_library ada-strings-unbounded-text-io-a-suteio-ads}@anchor{2fe}@anchor{gnat_rm/the_gnat_library id27}@anchor{2ff} @section @code{Ada.Strings.Unbounded.Text_IO} (@code{a-suteio.ads}) @@ -23300,7 +23312,7 @@ strings, avoiding the necessity for an intermediate operation with ordinary strings. @node Ada Strings Wide_Unbounded Wide_Text_IO a-swuwti ads,Ada Strings Wide_Wide_Unbounded Wide_Wide_Text_IO a-szuzti ads,Ada Strings Unbounded Text_IO a-suteio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id28}@anchor{2ff}@anchor{gnat_rm/the_gnat_library ada-strings-wide-unbounded-wide-text-io-a-swuwti-ads}@anchor{300} +@anchor{gnat_rm/the_gnat_library id28}@anchor{300}@anchor{gnat_rm/the_gnat_library ada-strings-wide-unbounded-wide-text-io-a-swuwti-ads}@anchor{301} @section @code{Ada.Strings.Wide_Unbounded.Wide_Text_IO} (@code{a-swuwti.ads}) @@ -23317,7 +23329,7 @@ wide strings, avoiding the necessity for an intermediate operation with ordinary wide strings. @node Ada Strings Wide_Wide_Unbounded Wide_Wide_Text_IO a-szuzti ads,Ada Text_IO C_Streams a-tiocst ads,Ada Strings Wide_Unbounded Wide_Text_IO a-swuwti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id29}@anchor{301}@anchor{gnat_rm/the_gnat_library ada-strings-wide-wide-unbounded-wide-wide-text-io-a-szuzti-ads}@anchor{302} +@anchor{gnat_rm/the_gnat_library id29}@anchor{302}@anchor{gnat_rm/the_gnat_library ada-strings-wide-wide-unbounded-wide-wide-text-io-a-szuzti-ads}@anchor{303} @section @code{Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO} (@code{a-szuzti.ads}) @@ -23334,7 +23346,7 @@ wide wide strings, avoiding the necessity for an intermediate operation with ordinary wide wide strings. @node Ada Text_IO C_Streams a-tiocst ads,Ada Text_IO Reset_Standard_Files a-tirsfi ads,Ada Strings Wide_Wide_Unbounded Wide_Wide_Text_IO a-szuzti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-text-io-c-streams-a-tiocst-ads}@anchor{303}@anchor{gnat_rm/the_gnat_library id30}@anchor{304} +@anchor{gnat_rm/the_gnat_library ada-text-io-c-streams-a-tiocst-ads}@anchor{304}@anchor{gnat_rm/the_gnat_library id30}@anchor{305} @section @code{Ada.Text_IO.C_Streams} (@code{a-tiocst.ads}) @@ -23349,7 +23361,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Text_IO Reset_Standard_Files a-tirsfi ads,Ada Wide_Characters Unicode a-wichun ads,Ada Text_IO C_Streams a-tiocst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-text-io-reset-standard-files-a-tirsfi-ads}@anchor{305}@anchor{gnat_rm/the_gnat_library id31}@anchor{306} +@anchor{gnat_rm/the_gnat_library ada-text-io-reset-standard-files-a-tirsfi-ads}@anchor{306}@anchor{gnat_rm/the_gnat_library id31}@anchor{307} @section @code{Ada.Text_IO.Reset_Standard_Files} (@code{a-tirsfi.ads}) @@ -23364,7 +23376,7 @@ execution (for example a standard input file may be redefined to be interactive). @node Ada Wide_Characters Unicode a-wichun ads,Ada Wide_Text_IO C_Streams a-wtcstr ads,Ada Text_IO Reset_Standard_Files a-tirsfi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id32}@anchor{307}@anchor{gnat_rm/the_gnat_library ada-wide-characters-unicode-a-wichun-ads}@anchor{308} +@anchor{gnat_rm/the_gnat_library id32}@anchor{308}@anchor{gnat_rm/the_gnat_library ada-wide-characters-unicode-a-wichun-ads}@anchor{309} @section @code{Ada.Wide_Characters.Unicode} (@code{a-wichun.ads}) @@ -23377,7 +23389,7 @@ This package provides subprograms that allow categorization of Wide_Character values according to Unicode categories. @node Ada Wide_Text_IO C_Streams a-wtcstr ads,Ada Wide_Text_IO Reset_Standard_Files a-wrstfi ads,Ada Wide_Characters Unicode a-wichun ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-wide-text-io-c-streams-a-wtcstr-ads}@anchor{309}@anchor{gnat_rm/the_gnat_library id33}@anchor{30a} +@anchor{gnat_rm/the_gnat_library ada-wide-text-io-c-streams-a-wtcstr-ads}@anchor{30a}@anchor{gnat_rm/the_gnat_library id33}@anchor{30b} @section @code{Ada.Wide_Text_IO.C_Streams} (@code{a-wtcstr.ads}) @@ -23392,7 +23404,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Wide_Text_IO Reset_Standard_Files a-wrstfi ads,Ada Wide_Wide_Characters Unicode a-zchuni ads,Ada Wide_Text_IO C_Streams a-wtcstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-wide-text-io-reset-standard-files-a-wrstfi-ads}@anchor{30b}@anchor{gnat_rm/the_gnat_library id34}@anchor{30c} +@anchor{gnat_rm/the_gnat_library ada-wide-text-io-reset-standard-files-a-wrstfi-ads}@anchor{30c}@anchor{gnat_rm/the_gnat_library id34}@anchor{30d} @section @code{Ada.Wide_Text_IO.Reset_Standard_Files} (@code{a-wrstfi.ads}) @@ -23407,7 +23419,7 @@ execution (for example a standard input file may be redefined to be interactive). @node Ada Wide_Wide_Characters Unicode a-zchuni ads,Ada Wide_Wide_Text_IO C_Streams a-ztcstr ads,Ada Wide_Text_IO Reset_Standard_Files a-wrstfi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id35}@anchor{30d}@anchor{gnat_rm/the_gnat_library ada-wide-wide-characters-unicode-a-zchuni-ads}@anchor{30e} +@anchor{gnat_rm/the_gnat_library id35}@anchor{30e}@anchor{gnat_rm/the_gnat_library ada-wide-wide-characters-unicode-a-zchuni-ads}@anchor{30f} @section @code{Ada.Wide_Wide_Characters.Unicode} (@code{a-zchuni.ads}) @@ -23420,7 +23432,7 @@ This package provides subprograms that allow categorization of Wide_Wide_Character values according to Unicode categories. @node Ada Wide_Wide_Text_IO C_Streams a-ztcstr ads,Ada Wide_Wide_Text_IO Reset_Standard_Files a-zrstfi ads,Ada Wide_Wide_Characters Unicode a-zchuni ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id36}@anchor{30f}@anchor{gnat_rm/the_gnat_library ada-wide-wide-text-io-c-streams-a-ztcstr-ads}@anchor{310} +@anchor{gnat_rm/the_gnat_library id36}@anchor{310}@anchor{gnat_rm/the_gnat_library ada-wide-wide-text-io-c-streams-a-ztcstr-ads}@anchor{311} @section @code{Ada.Wide_Wide_Text_IO.C_Streams} (@code{a-ztcstr.ads}) @@ -23435,7 +23447,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Wide_Wide_Text_IO Reset_Standard_Files a-zrstfi ads,GNAT Altivec g-altive ads,Ada Wide_Wide_Text_IO C_Streams a-ztcstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id37}@anchor{311}@anchor{gnat_rm/the_gnat_library ada-wide-wide-text-io-reset-standard-files-a-zrstfi-ads}@anchor{312} +@anchor{gnat_rm/the_gnat_library id37}@anchor{312}@anchor{gnat_rm/the_gnat_library ada-wide-wide-text-io-reset-standard-files-a-zrstfi-ads}@anchor{313} @section @code{Ada.Wide_Wide_Text_IO.Reset_Standard_Files} (@code{a-zrstfi.ads}) @@ -23450,7 +23462,7 @@ change during execution (for example a standard input file may be redefined to be interactive). @node GNAT Altivec g-altive ads,GNAT Altivec Conversions g-altcon ads,Ada Wide_Wide_Text_IO Reset_Standard_Files a-zrstfi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-g-altive-ads}@anchor{313}@anchor{gnat_rm/the_gnat_library id38}@anchor{314} +@anchor{gnat_rm/the_gnat_library gnat-altivec-g-altive-ads}@anchor{314}@anchor{gnat_rm/the_gnat_library id38}@anchor{315} @section @code{GNAT.Altivec} (@code{g-altive.ads}) @@ -23463,7 +23475,7 @@ definitions of constants and types common to all the versions of the binding. @node GNAT Altivec Conversions g-altcon ads,GNAT Altivec Vector_Operations g-alveop ads,GNAT Altivec g-altive ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-conversions-g-altcon-ads}@anchor{315}@anchor{gnat_rm/the_gnat_library id39}@anchor{316} +@anchor{gnat_rm/the_gnat_library gnat-altivec-conversions-g-altcon-ads}@anchor{316}@anchor{gnat_rm/the_gnat_library id39}@anchor{317} @section @code{GNAT.Altivec.Conversions} (@code{g-altcon.ads}) @@ -23474,7 +23486,7 @@ binding. This package provides the Vector/View conversion routines. @node GNAT Altivec Vector_Operations g-alveop ads,GNAT Altivec Vector_Types g-alvety ads,GNAT Altivec Conversions g-altcon ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-operations-g-alveop-ads}@anchor{317}@anchor{gnat_rm/the_gnat_library id40}@anchor{318} +@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-operations-g-alveop-ads}@anchor{318}@anchor{gnat_rm/the_gnat_library id40}@anchor{319} @section @code{GNAT.Altivec.Vector_Operations} (@code{g-alveop.ads}) @@ -23488,7 +23500,7 @@ library. The hard binding is provided as a separate package. This unit is common to both bindings. @node GNAT Altivec Vector_Types g-alvety ads,GNAT Altivec Vector_Views g-alvevi ads,GNAT Altivec Vector_Operations g-alveop ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-types-g-alvety-ads}@anchor{319}@anchor{gnat_rm/the_gnat_library id41}@anchor{31a} +@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-types-g-alvety-ads}@anchor{31a}@anchor{gnat_rm/the_gnat_library id41}@anchor{31b} @section @code{GNAT.Altivec.Vector_Types} (@code{g-alvety.ads}) @@ -23500,7 +23512,7 @@ This package exposes the various vector types part of the Ada binding to AltiVec facilities. @node GNAT Altivec Vector_Views g-alvevi ads,GNAT Array_Split g-arrspl ads,GNAT Altivec Vector_Types g-alvety ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-views-g-alvevi-ads}@anchor{31b}@anchor{gnat_rm/the_gnat_library id42}@anchor{31c} +@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-views-g-alvevi-ads}@anchor{31c}@anchor{gnat_rm/the_gnat_library id42}@anchor{31d} @section @code{GNAT.Altivec.Vector_Views} (@code{g-alvevi.ads}) @@ -23515,7 +23527,7 @@ vector elements and provides a simple way to initialize vector objects. @node GNAT Array_Split g-arrspl ads,GNAT AWK g-awk ads,GNAT Altivec Vector_Views g-alvevi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-array-split-g-arrspl-ads}@anchor{31d}@anchor{gnat_rm/the_gnat_library id43}@anchor{31e} +@anchor{gnat_rm/the_gnat_library gnat-array-split-g-arrspl-ads}@anchor{31e}@anchor{gnat_rm/the_gnat_library id43}@anchor{31f} @section @code{GNAT.Array_Split} (@code{g-arrspl.ads}) @@ -23528,7 +23540,7 @@ an array wherever the separators appear, and provide direct access to the resulting slices. @node GNAT AWK g-awk ads,GNAT Bind_Environment g-binenv ads,GNAT Array_Split g-arrspl ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id44}@anchor{31f}@anchor{gnat_rm/the_gnat_library gnat-awk-g-awk-ads}@anchor{320} +@anchor{gnat_rm/the_gnat_library id44}@anchor{320}@anchor{gnat_rm/the_gnat_library gnat-awk-g-awk-ads}@anchor{321} @section @code{GNAT.AWK} (@code{g-awk.ads}) @@ -23543,7 +23555,7 @@ or more files containing formatted data. The file is viewed as a database where each record is a line and a field is a data element in this line. @node GNAT Bind_Environment g-binenv ads,GNAT Bounded_Buffers g-boubuf ads,GNAT AWK g-awk ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bind-environment-g-binenv-ads}@anchor{321}@anchor{gnat_rm/the_gnat_library id45}@anchor{322} +@anchor{gnat_rm/the_gnat_library gnat-bind-environment-g-binenv-ads}@anchor{322}@anchor{gnat_rm/the_gnat_library id45}@anchor{323} @section @code{GNAT.Bind_Environment} (@code{g-binenv.ads}) @@ -23556,7 +23568,7 @@ These associations can be specified using the @code{-V} binder command line switch. @node GNAT Bounded_Buffers g-boubuf ads,GNAT Bounded_Mailboxes g-boumai ads,GNAT Bind_Environment g-binenv ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id46}@anchor{323}@anchor{gnat_rm/the_gnat_library gnat-bounded-buffers-g-boubuf-ads}@anchor{324} +@anchor{gnat_rm/the_gnat_library id46}@anchor{324}@anchor{gnat_rm/the_gnat_library gnat-bounded-buffers-g-boubuf-ads}@anchor{325} @section @code{GNAT.Bounded_Buffers} (@code{g-boubuf.ads}) @@ -23571,7 +23583,7 @@ useful directly or as parts of the implementations of other abstractions, such as mailboxes. @node GNAT Bounded_Mailboxes g-boumai ads,GNAT Bubble_Sort g-bubsor ads,GNAT Bounded_Buffers g-boubuf ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id47}@anchor{325}@anchor{gnat_rm/the_gnat_library gnat-bounded-mailboxes-g-boumai-ads}@anchor{326} +@anchor{gnat_rm/the_gnat_library id47}@anchor{326}@anchor{gnat_rm/the_gnat_library gnat-bounded-mailboxes-g-boumai-ads}@anchor{327} @section @code{GNAT.Bounded_Mailboxes} (@code{g-boumai.ads}) @@ -23584,7 +23596,7 @@ such as mailboxes. Provides a thread-safe asynchronous intertask mailbox communication facility. @node GNAT Bubble_Sort g-bubsor ads,GNAT Bubble_Sort_A g-busora ads,GNAT Bounded_Mailboxes g-boumai ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-bubsor-ads}@anchor{327}@anchor{gnat_rm/the_gnat_library id48}@anchor{328} +@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-bubsor-ads}@anchor{328}@anchor{gnat_rm/the_gnat_library id48}@anchor{329} @section @code{GNAT.Bubble_Sort} (@code{g-bubsor.ads}) @@ -23599,7 +23611,7 @@ data items. Exchange and comparison procedures are provided by passing access-to-procedure values. @node GNAT Bubble_Sort_A g-busora ads,GNAT Bubble_Sort_G g-busorg ads,GNAT Bubble_Sort g-bubsor ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id49}@anchor{329}@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-a-g-busora-ads}@anchor{32a} +@anchor{gnat_rm/the_gnat_library id49}@anchor{32a}@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-a-g-busora-ads}@anchor{32b} @section @code{GNAT.Bubble_Sort_A} (@code{g-busora.ads}) @@ -23615,7 +23627,7 @@ access-to-procedure values. This is an older version, retained for compatibility. Usually @code{GNAT.Bubble_Sort} will be preferable. @node GNAT Bubble_Sort_G g-busorg ads,GNAT Byte_Order_Mark g-byorma ads,GNAT Bubble_Sort_A g-busora ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-g-busorg-ads}@anchor{32b}@anchor{gnat_rm/the_gnat_library id50}@anchor{32c} +@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-g-busorg-ads}@anchor{32c}@anchor{gnat_rm/the_gnat_library id50}@anchor{32d} @section @code{GNAT.Bubble_Sort_G} (@code{g-busorg.ads}) @@ -23631,7 +23643,7 @@ if the procedures can be inlined, at the expense of duplicating code for multiple instantiations. @node GNAT Byte_Order_Mark g-byorma ads,GNAT Byte_Swapping g-bytswa ads,GNAT Bubble_Sort_G g-busorg ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-byte-order-mark-g-byorma-ads}@anchor{32d}@anchor{gnat_rm/the_gnat_library id51}@anchor{32e} +@anchor{gnat_rm/the_gnat_library gnat-byte-order-mark-g-byorma-ads}@anchor{32e}@anchor{gnat_rm/the_gnat_library id51}@anchor{32f} @section @code{GNAT.Byte_Order_Mark} (@code{g-byorma.ads}) @@ -23647,7 +23659,7 @@ the encoding of the string. The routine includes detection of special XML sequences for various UCS input formats. @node GNAT Byte_Swapping g-bytswa ads,GNAT Calendar g-calend ads,GNAT Byte_Order_Mark g-byorma ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-byte-swapping-g-bytswa-ads}@anchor{32f}@anchor{gnat_rm/the_gnat_library id52}@anchor{330} +@anchor{gnat_rm/the_gnat_library gnat-byte-swapping-g-bytswa-ads}@anchor{330}@anchor{gnat_rm/the_gnat_library id52}@anchor{331} @section @code{GNAT.Byte_Swapping} (@code{g-bytswa.ads}) @@ -23661,7 +23673,7 @@ General routines for swapping the bytes in 2-, 4-, and 8-byte quantities. Machine-specific implementations are available in some cases. @node GNAT Calendar g-calend ads,GNAT Calendar Time_IO g-catiio ads,GNAT Byte_Swapping g-bytswa ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-calendar-g-calend-ads}@anchor{331}@anchor{gnat_rm/the_gnat_library id53}@anchor{332} +@anchor{gnat_rm/the_gnat_library gnat-calendar-g-calend-ads}@anchor{332}@anchor{gnat_rm/the_gnat_library id53}@anchor{333} @section @code{GNAT.Calendar} (@code{g-calend.ads}) @@ -23675,7 +23687,7 @@ Also provides conversion of @code{Ada.Calendar.Time} values to and from the C @code{timeval} format. @node GNAT Calendar Time_IO g-catiio ads,GNAT CRC32 g-crc32 ads,GNAT Calendar g-calend ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id54}@anchor{333}@anchor{gnat_rm/the_gnat_library gnat-calendar-time-io-g-catiio-ads}@anchor{334} +@anchor{gnat_rm/the_gnat_library id54}@anchor{334}@anchor{gnat_rm/the_gnat_library gnat-calendar-time-io-g-catiio-ads}@anchor{335} @section @code{GNAT.Calendar.Time_IO} (@code{g-catiio.ads}) @@ -23686,7 +23698,7 @@ C @code{timeval} format. @geindex GNAT.Calendar.Time_IO (g-catiio.ads) @node GNAT CRC32 g-crc32 ads,GNAT Case_Util g-casuti ads,GNAT Calendar Time_IO g-catiio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id55}@anchor{335}@anchor{gnat_rm/the_gnat_library gnat-crc32-g-crc32-ads}@anchor{336} +@anchor{gnat_rm/the_gnat_library id55}@anchor{336}@anchor{gnat_rm/the_gnat_library gnat-crc32-g-crc32-ads}@anchor{337} @section @code{GNAT.CRC32} (@code{g-crc32.ads}) @@ -23703,7 +23715,7 @@ of this algorithm see Aug. 1988. Sarwate, D.V. @node GNAT Case_Util g-casuti ads,GNAT CGI g-cgi ads,GNAT CRC32 g-crc32 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id56}@anchor{337}@anchor{gnat_rm/the_gnat_library gnat-case-util-g-casuti-ads}@anchor{338} +@anchor{gnat_rm/the_gnat_library id56}@anchor{338}@anchor{gnat_rm/the_gnat_library gnat-case-util-g-casuti-ads}@anchor{339} @section @code{GNAT.Case_Util} (@code{g-casuti.ads}) @@ -23718,7 +23730,7 @@ without the overhead of the full casing tables in @code{Ada.Characters.Handling}. @node GNAT CGI g-cgi ads,GNAT CGI Cookie g-cgicoo ads,GNAT Case_Util g-casuti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id57}@anchor{339}@anchor{gnat_rm/the_gnat_library gnat-cgi-g-cgi-ads}@anchor{33a} +@anchor{gnat_rm/the_gnat_library id57}@anchor{33a}@anchor{gnat_rm/the_gnat_library gnat-cgi-g-cgi-ads}@anchor{33b} @section @code{GNAT.CGI} (@code{g-cgi.ads}) @@ -23733,7 +23745,7 @@ builds a table whose index is the key and provides some services to deal with this table. @node GNAT CGI Cookie g-cgicoo ads,GNAT CGI Debug g-cgideb ads,GNAT CGI g-cgi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-cookie-g-cgicoo-ads}@anchor{33b}@anchor{gnat_rm/the_gnat_library id58}@anchor{33c} +@anchor{gnat_rm/the_gnat_library gnat-cgi-cookie-g-cgicoo-ads}@anchor{33c}@anchor{gnat_rm/the_gnat_library id58}@anchor{33d} @section @code{GNAT.CGI.Cookie} (@code{g-cgicoo.ads}) @@ -23748,7 +23760,7 @@ Common Gateway Interface (CGI). It exports services to deal with Web cookies (piece of information kept in the Web client software). @node GNAT CGI Debug g-cgideb ads,GNAT Command_Line g-comlin ads,GNAT CGI Cookie g-cgicoo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-debug-g-cgideb-ads}@anchor{33d}@anchor{gnat_rm/the_gnat_library id59}@anchor{33e} +@anchor{gnat_rm/the_gnat_library gnat-cgi-debug-g-cgideb-ads}@anchor{33e}@anchor{gnat_rm/the_gnat_library id59}@anchor{33f} @section @code{GNAT.CGI.Debug} (@code{g-cgideb.ads}) @@ -23760,7 +23772,7 @@ This is a package to help debugging CGI (Common Gateway Interface) programs written in Ada. @node GNAT Command_Line g-comlin ads,GNAT Compiler_Version g-comver ads,GNAT CGI Debug g-cgideb ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id60}@anchor{33f}@anchor{gnat_rm/the_gnat_library gnat-command-line-g-comlin-ads}@anchor{340} +@anchor{gnat_rm/the_gnat_library id60}@anchor{340}@anchor{gnat_rm/the_gnat_library gnat-command-line-g-comlin-ads}@anchor{341} @section @code{GNAT.Command_Line} (@code{g-comlin.ads}) @@ -23773,7 +23785,7 @@ including the ability to scan for named switches with optional parameters and expand file names using wild card notations. @node GNAT Compiler_Version g-comver ads,GNAT Ctrl_C g-ctrl_c ads,GNAT Command_Line g-comlin ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-compiler-version-g-comver-ads}@anchor{341}@anchor{gnat_rm/the_gnat_library id61}@anchor{342} +@anchor{gnat_rm/the_gnat_library gnat-compiler-version-g-comver-ads}@anchor{342}@anchor{gnat_rm/the_gnat_library id61}@anchor{343} @section @code{GNAT.Compiler_Version} (@code{g-comver.ads}) @@ -23791,7 +23803,7 @@ of the compiler if a consistent tool set is used to compile all units of a partition). @node GNAT Ctrl_C g-ctrl_c ads,GNAT Current_Exception g-curexc ads,GNAT Compiler_Version g-comver ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-ctrl-c-g-ctrl-c-ads}@anchor{343}@anchor{gnat_rm/the_gnat_library id62}@anchor{344} +@anchor{gnat_rm/the_gnat_library gnat-ctrl-c-g-ctrl-c-ads}@anchor{344}@anchor{gnat_rm/the_gnat_library id62}@anchor{345} @section @code{GNAT.Ctrl_C} (@code{g-ctrl_c.ads}) @@ -23802,7 +23814,7 @@ of a partition). Provides a simple interface to handle Ctrl-C keyboard events. @node GNAT Current_Exception g-curexc ads,GNAT Debug_Pools g-debpoo ads,GNAT Ctrl_C g-ctrl_c ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id63}@anchor{345}@anchor{gnat_rm/the_gnat_library gnat-current-exception-g-curexc-ads}@anchor{346} +@anchor{gnat_rm/the_gnat_library id63}@anchor{346}@anchor{gnat_rm/the_gnat_library gnat-current-exception-g-curexc-ads}@anchor{347} @section @code{GNAT.Current_Exception} (@code{g-curexc.ads}) @@ -23819,7 +23831,7 @@ This is particularly useful in simulating typical facilities for obtaining information about exceptions provided by Ada 83 compilers. @node GNAT Debug_Pools g-debpoo ads,GNAT Debug_Utilities g-debuti ads,GNAT Current_Exception g-curexc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-debug-pools-g-debpoo-ads}@anchor{347}@anchor{gnat_rm/the_gnat_library id64}@anchor{348} +@anchor{gnat_rm/the_gnat_library gnat-debug-pools-g-debpoo-ads}@anchor{348}@anchor{gnat_rm/the_gnat_library id64}@anchor{349} @section @code{GNAT.Debug_Pools} (@code{g-debpoo.ads}) @@ -23836,7 +23848,7 @@ problems. See @code{The GNAT Debug_Pool Facility} section in the @cite{GNAT User's Guide}. @node GNAT Debug_Utilities g-debuti ads,GNAT Decode_String g-decstr ads,GNAT Debug_Pools g-debpoo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id65}@anchor{349}@anchor{gnat_rm/the_gnat_library gnat-debug-utilities-g-debuti-ads}@anchor{34a} +@anchor{gnat_rm/the_gnat_library id65}@anchor{34a}@anchor{gnat_rm/the_gnat_library gnat-debug-utilities-g-debuti-ads}@anchor{34b} @section @code{GNAT.Debug_Utilities} (@code{g-debuti.ads}) @@ -23849,7 +23861,7 @@ to and from string images of address values. Supports both C and Ada formats for hexadecimal literals. @node GNAT Decode_String g-decstr ads,GNAT Decode_UTF8_String g-deutst ads,GNAT Debug_Utilities g-debuti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-decode-string-g-decstr-ads}@anchor{34b}@anchor{gnat_rm/the_gnat_library id66}@anchor{34c} +@anchor{gnat_rm/the_gnat_library gnat-decode-string-g-decstr-ads}@anchor{34c}@anchor{gnat_rm/the_gnat_library id66}@anchor{34d} @section @code{GNAT.Decode_String} (@code{g-decstr.ads}) @@ -23873,7 +23885,7 @@ Useful in conjunction with Unicode character coding. Note there is a preinstantiation for UTF-8. See next entry. @node GNAT Decode_UTF8_String g-deutst ads,GNAT Directory_Operations g-dirope ads,GNAT Decode_String g-decstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-decode-utf8-string-g-deutst-ads}@anchor{34d}@anchor{gnat_rm/the_gnat_library id67}@anchor{34e} +@anchor{gnat_rm/the_gnat_library gnat-decode-utf8-string-g-deutst-ads}@anchor{34e}@anchor{gnat_rm/the_gnat_library id67}@anchor{34f} @section @code{GNAT.Decode_UTF8_String} (@code{g-deutst.ads}) @@ -23894,7 +23906,7 @@ preinstantiation for UTF-8. See next entry. A preinstantiation of GNAT.Decode_Strings for UTF-8 encoding. @node GNAT Directory_Operations g-dirope ads,GNAT Directory_Operations Iteration g-diopit ads,GNAT Decode_UTF8_String g-deutst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-directory-operations-g-dirope-ads}@anchor{34f}@anchor{gnat_rm/the_gnat_library id68}@anchor{350} +@anchor{gnat_rm/the_gnat_library gnat-directory-operations-g-dirope-ads}@anchor{350}@anchor{gnat_rm/the_gnat_library id68}@anchor{351} @section @code{GNAT.Directory_Operations} (@code{g-dirope.ads}) @@ -23907,7 +23919,7 @@ the current directory, making new directories, and scanning the files in a directory. @node GNAT Directory_Operations Iteration g-diopit ads,GNAT Dynamic_HTables g-dynhta ads,GNAT Directory_Operations g-dirope ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id69}@anchor{351}@anchor{gnat_rm/the_gnat_library gnat-directory-operations-iteration-g-diopit-ads}@anchor{352} +@anchor{gnat_rm/the_gnat_library id69}@anchor{352}@anchor{gnat_rm/the_gnat_library gnat-directory-operations-iteration-g-diopit-ads}@anchor{353} @section @code{GNAT.Directory_Operations.Iteration} (@code{g-diopit.ads}) @@ -23919,7 +23931,7 @@ A child unit of GNAT.Directory_Operations providing additional operations for iterating through directories. @node GNAT Dynamic_HTables g-dynhta ads,GNAT Dynamic_Tables g-dyntab ads,GNAT Directory_Operations Iteration g-diopit ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id70}@anchor{353}@anchor{gnat_rm/the_gnat_library gnat-dynamic-htables-g-dynhta-ads}@anchor{354} +@anchor{gnat_rm/the_gnat_library id70}@anchor{354}@anchor{gnat_rm/the_gnat_library gnat-dynamic-htables-g-dynhta-ads}@anchor{355} @section @code{GNAT.Dynamic_HTables} (@code{g-dynhta.ads}) @@ -23937,7 +23949,7 @@ dynamic instances of the hash table, while an instantiation of @code{GNAT.HTable} creates a single instance of the hash table. @node GNAT Dynamic_Tables g-dyntab ads,GNAT Encode_String g-encstr ads,GNAT Dynamic_HTables g-dynhta ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-dynamic-tables-g-dyntab-ads}@anchor{355}@anchor{gnat_rm/the_gnat_library id71}@anchor{356} +@anchor{gnat_rm/the_gnat_library gnat-dynamic-tables-g-dyntab-ads}@anchor{356}@anchor{gnat_rm/the_gnat_library id71}@anchor{357} @section @code{GNAT.Dynamic_Tables} (@code{g-dyntab.ads}) @@ -23957,7 +23969,7 @@ dynamic instances of the table, while an instantiation of @code{GNAT.Table} creates a single instance of the table type. @node GNAT Encode_String g-encstr ads,GNAT Encode_UTF8_String g-enutst ads,GNAT Dynamic_Tables g-dyntab ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id72}@anchor{357}@anchor{gnat_rm/the_gnat_library gnat-encode-string-g-encstr-ads}@anchor{358} +@anchor{gnat_rm/the_gnat_library id72}@anchor{358}@anchor{gnat_rm/the_gnat_library gnat-encode-string-g-encstr-ads}@anchor{359} @section @code{GNAT.Encode_String} (@code{g-encstr.ads}) @@ -23979,7 +23991,7 @@ encoding method. Useful in conjunction with Unicode character coding. Note there is a preinstantiation for UTF-8. See next entry. @node GNAT Encode_UTF8_String g-enutst ads,GNAT Exception_Actions g-excact ads,GNAT Encode_String g-encstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-encode-utf8-string-g-enutst-ads}@anchor{359}@anchor{gnat_rm/the_gnat_library id73}@anchor{35a} +@anchor{gnat_rm/the_gnat_library gnat-encode-utf8-string-g-enutst-ads}@anchor{35a}@anchor{gnat_rm/the_gnat_library id73}@anchor{35b} @section @code{GNAT.Encode_UTF8_String} (@code{g-enutst.ads}) @@ -24000,7 +24012,7 @@ Note there is a preinstantiation for UTF-8. See next entry. A preinstantiation of GNAT.Encode_Strings for UTF-8 encoding. @node GNAT Exception_Actions g-excact ads,GNAT Exception_Traces g-exctra ads,GNAT Encode_UTF8_String g-enutst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exception-actions-g-excact-ads}@anchor{35b}@anchor{gnat_rm/the_gnat_library id74}@anchor{35c} +@anchor{gnat_rm/the_gnat_library gnat-exception-actions-g-excact-ads}@anchor{35c}@anchor{gnat_rm/the_gnat_library id74}@anchor{35d} @section @code{GNAT.Exception_Actions} (@code{g-excact.ads}) @@ -24013,7 +24025,7 @@ for specific exceptions, or when any exception is raised. This can be used for instance to force a core dump to ease debugging. @node GNAT Exception_Traces g-exctra ads,GNAT Exceptions g-expect ads,GNAT Exception_Actions g-excact ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exception-traces-g-exctra-ads}@anchor{35d}@anchor{gnat_rm/the_gnat_library id75}@anchor{35e} +@anchor{gnat_rm/the_gnat_library gnat-exception-traces-g-exctra-ads}@anchor{35e}@anchor{gnat_rm/the_gnat_library id75}@anchor{35f} @section @code{GNAT.Exception_Traces} (@code{g-exctra.ads}) @@ -24027,7 +24039,7 @@ Provides an interface allowing to control automatic output upon exception occurrences. @node GNAT Exceptions g-expect ads,GNAT Expect g-expect ads,GNAT Exception_Traces g-exctra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id76}@anchor{35f}@anchor{gnat_rm/the_gnat_library gnat-exceptions-g-expect-ads}@anchor{360} +@anchor{gnat_rm/the_gnat_library id76}@anchor{360}@anchor{gnat_rm/the_gnat_library gnat-exceptions-g-expect-ads}@anchor{361} @section @code{GNAT.Exceptions} (@code{g-expect.ads}) @@ -24048,7 +24060,7 @@ predefined exceptions, and for example allow raising @code{Constraint_Error} with a message from a pure subprogram. @node GNAT Expect g-expect ads,GNAT Expect TTY g-exptty ads,GNAT Exceptions g-expect ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-expect-g-expect-ads}@anchor{361}@anchor{gnat_rm/the_gnat_library id77}@anchor{362} +@anchor{gnat_rm/the_gnat_library gnat-expect-g-expect-ads}@anchor{362}@anchor{gnat_rm/the_gnat_library id77}@anchor{363} @section @code{GNAT.Expect} (@code{g-expect.ads}) @@ -24064,7 +24076,7 @@ It is not implemented for cross ports, and in particular is not implemented for VxWorks or LynxOS. @node GNAT Expect TTY g-exptty ads,GNAT Float_Control g-flocon ads,GNAT Expect g-expect ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id78}@anchor{363}@anchor{gnat_rm/the_gnat_library gnat-expect-tty-g-exptty-ads}@anchor{364} +@anchor{gnat_rm/the_gnat_library id78}@anchor{364}@anchor{gnat_rm/the_gnat_library gnat-expect-tty-g-exptty-ads}@anchor{365} @section @code{GNAT.Expect.TTY} (@code{g-exptty.ads}) @@ -24076,7 +24088,7 @@ ports. It is not implemented for cross ports, and in particular is not implemented for VxWorks or LynxOS. @node GNAT Float_Control g-flocon ads,GNAT Formatted_String g-forstr ads,GNAT Expect TTY g-exptty ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id79}@anchor{365}@anchor{gnat_rm/the_gnat_library gnat-float-control-g-flocon-ads}@anchor{366} +@anchor{gnat_rm/the_gnat_library id79}@anchor{366}@anchor{gnat_rm/the_gnat_library gnat-float-control-g-flocon-ads}@anchor{367} @section @code{GNAT.Float_Control} (@code{g-flocon.ads}) @@ -24090,7 +24102,7 @@ library calls may cause this mode to be modified, and the Reset procedure in this package can be used to reestablish the required mode. @node GNAT Formatted_String g-forstr ads,GNAT Heap_Sort g-heasor ads,GNAT Float_Control g-flocon ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id80}@anchor{367}@anchor{gnat_rm/the_gnat_library gnat-formatted-string-g-forstr-ads}@anchor{368} +@anchor{gnat_rm/the_gnat_library id80}@anchor{368}@anchor{gnat_rm/the_gnat_library gnat-formatted-string-g-forstr-ads}@anchor{369} @section @code{GNAT.Formatted_String} (@code{g-forstr.ads}) @@ -24105,7 +24117,7 @@ derived from Integer, Float or enumerations as values for the formatted string. @node GNAT Heap_Sort g-heasor ads,GNAT Heap_Sort_A g-hesora ads,GNAT Formatted_String g-forstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-heasor-ads}@anchor{369}@anchor{gnat_rm/the_gnat_library id81}@anchor{36a} +@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-heasor-ads}@anchor{36a}@anchor{gnat_rm/the_gnat_library id81}@anchor{36b} @section @code{GNAT.Heap_Sort} (@code{g-heasor.ads}) @@ -24119,7 +24131,7 @@ access-to-procedure values. The algorithm used is a modified heap sort that performs approximately N*log(N) comparisons in the worst case. @node GNAT Heap_Sort_A g-hesora ads,GNAT Heap_Sort_G g-hesorg ads,GNAT Heap_Sort g-heasor ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id82}@anchor{36b}@anchor{gnat_rm/the_gnat_library gnat-heap-sort-a-g-hesora-ads}@anchor{36c} +@anchor{gnat_rm/the_gnat_library id82}@anchor{36c}@anchor{gnat_rm/the_gnat_library gnat-heap-sort-a-g-hesora-ads}@anchor{36d} @section @code{GNAT.Heap_Sort_A} (@code{g-hesora.ads}) @@ -24135,7 +24147,7 @@ This differs from @code{GNAT.Heap_Sort} in having a less convenient interface, but may be slightly more efficient. @node GNAT Heap_Sort_G g-hesorg ads,GNAT HTable g-htable ads,GNAT Heap_Sort_A g-hesora ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id83}@anchor{36d}@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-g-hesorg-ads}@anchor{36e} +@anchor{gnat_rm/the_gnat_library id83}@anchor{36e}@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-g-hesorg-ads}@anchor{36f} @section @code{GNAT.Heap_Sort_G} (@code{g-hesorg.ads}) @@ -24149,7 +24161,7 @@ if the procedures can be inlined, at the expense of duplicating code for multiple instantiations. @node GNAT HTable g-htable ads,GNAT IO g-io ads,GNAT Heap_Sort_G g-hesorg ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id84}@anchor{36f}@anchor{gnat_rm/the_gnat_library gnat-htable-g-htable-ads}@anchor{370} +@anchor{gnat_rm/the_gnat_library id84}@anchor{370}@anchor{gnat_rm/the_gnat_library gnat-htable-g-htable-ads}@anchor{371} @section @code{GNAT.HTable} (@code{g-htable.ads}) @@ -24162,7 +24174,7 @@ data. Provides two approaches, one a simple static approach, and the other allowing arbitrary dynamic hash tables. @node GNAT IO g-io ads,GNAT IO_Aux g-io_aux ads,GNAT HTable g-htable ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id85}@anchor{371}@anchor{gnat_rm/the_gnat_library gnat-io-g-io-ads}@anchor{372} +@anchor{gnat_rm/the_gnat_library id85}@anchor{372}@anchor{gnat_rm/the_gnat_library gnat-io-g-io-ads}@anchor{373} @section @code{GNAT.IO} (@code{g-io.ads}) @@ -24178,7 +24190,7 @@ Standard_Input, and writing characters, strings and integers to either Standard_Output or Standard_Error. @node GNAT IO_Aux g-io_aux ads,GNAT Lock_Files g-locfil ads,GNAT IO g-io ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-io-aux-g-io-aux-ads}@anchor{373}@anchor{gnat_rm/the_gnat_library id86}@anchor{374} +@anchor{gnat_rm/the_gnat_library gnat-io-aux-g-io-aux-ads}@anchor{374}@anchor{gnat_rm/the_gnat_library id86}@anchor{375} @section @code{GNAT.IO_Aux} (@code{g-io_aux.ads}) @@ -24192,7 +24204,7 @@ Provides some auxiliary functions for use with Text_IO, including a test for whether a file exists, and functions for reading a line of text. @node GNAT Lock_Files g-locfil ads,GNAT MBBS_Discrete_Random g-mbdira ads,GNAT IO_Aux g-io_aux ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id87}@anchor{375}@anchor{gnat_rm/the_gnat_library gnat-lock-files-g-locfil-ads}@anchor{376} +@anchor{gnat_rm/the_gnat_library id87}@anchor{376}@anchor{gnat_rm/the_gnat_library gnat-lock-files-g-locfil-ads}@anchor{377} @section @code{GNAT.Lock_Files} (@code{g-locfil.ads}) @@ -24206,7 +24218,7 @@ Provides a general interface for using files as locks. Can be used for providing program level synchronization. @node GNAT MBBS_Discrete_Random g-mbdira ads,GNAT MBBS_Float_Random g-mbflra ads,GNAT Lock_Files g-locfil ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id88}@anchor{377}@anchor{gnat_rm/the_gnat_library gnat-mbbs-discrete-random-g-mbdira-ads}@anchor{378} +@anchor{gnat_rm/the_gnat_library id88}@anchor{378}@anchor{gnat_rm/the_gnat_library gnat-mbbs-discrete-random-g-mbdira-ads}@anchor{379} @section @code{GNAT.MBBS_Discrete_Random} (@code{g-mbdira.ads}) @@ -24218,7 +24230,7 @@ The original implementation of @code{Ada.Numerics.Discrete_Random}. Uses a modified version of the Blum-Blum-Shub generator. @node GNAT MBBS_Float_Random g-mbflra ads,GNAT MD5 g-md5 ads,GNAT MBBS_Discrete_Random g-mbdira ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id89}@anchor{379}@anchor{gnat_rm/the_gnat_library gnat-mbbs-float-random-g-mbflra-ads}@anchor{37a} +@anchor{gnat_rm/the_gnat_library id89}@anchor{37a}@anchor{gnat_rm/the_gnat_library gnat-mbbs-float-random-g-mbflra-ads}@anchor{37b} @section @code{GNAT.MBBS_Float_Random} (@code{g-mbflra.ads}) @@ -24230,7 +24242,7 @@ The original implementation of @code{Ada.Numerics.Float_Random}. Uses a modified version of the Blum-Blum-Shub generator. @node GNAT MD5 g-md5 ads,GNAT Memory_Dump g-memdum ads,GNAT MBBS_Float_Random g-mbflra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id90}@anchor{37b}@anchor{gnat_rm/the_gnat_library gnat-md5-g-md5-ads}@anchor{37c} +@anchor{gnat_rm/the_gnat_library id90}@anchor{37c}@anchor{gnat_rm/the_gnat_library gnat-md5-g-md5-ads}@anchor{37d} @section @code{GNAT.MD5} (@code{g-md5.ads}) @@ -24243,7 +24255,7 @@ the HMAC-MD5 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT Memory_Dump g-memdum ads,GNAT Most_Recent_Exception g-moreex ads,GNAT MD5 g-md5 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id91}@anchor{37d}@anchor{gnat_rm/the_gnat_library gnat-memory-dump-g-memdum-ads}@anchor{37e} +@anchor{gnat_rm/the_gnat_library id91}@anchor{37e}@anchor{gnat_rm/the_gnat_library gnat-memory-dump-g-memdum-ads}@anchor{37f} @section @code{GNAT.Memory_Dump} (@code{g-memdum.ads}) @@ -24256,7 +24268,7 @@ standard output or standard error files. Uses GNAT.IO for actual output. @node GNAT Most_Recent_Exception g-moreex ads,GNAT OS_Lib g-os_lib ads,GNAT Memory_Dump g-memdum ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id92}@anchor{37f}@anchor{gnat_rm/the_gnat_library gnat-most-recent-exception-g-moreex-ads}@anchor{380} +@anchor{gnat_rm/the_gnat_library id92}@anchor{380}@anchor{gnat_rm/the_gnat_library gnat-most-recent-exception-g-moreex-ads}@anchor{381} @section @code{GNAT.Most_Recent_Exception} (@code{g-moreex.ads}) @@ -24270,7 +24282,7 @@ various logging purposes, including duplicating functionality of some Ada 83 implementation dependent extensions. @node GNAT OS_Lib g-os_lib ads,GNAT Perfect_Hash_Generators g-pehage ads,GNAT Most_Recent_Exception g-moreex ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-os-lib-g-os-lib-ads}@anchor{381}@anchor{gnat_rm/the_gnat_library id93}@anchor{382} +@anchor{gnat_rm/the_gnat_library gnat-os-lib-g-os-lib-ads}@anchor{382}@anchor{gnat_rm/the_gnat_library id93}@anchor{383} @section @code{GNAT.OS_Lib} (@code{g-os_lib.ads}) @@ -24286,7 +24298,7 @@ including a portable spawn procedure, and access to environment variables and error return codes. @node GNAT Perfect_Hash_Generators g-pehage ads,GNAT Random_Numbers g-rannum ads,GNAT OS_Lib g-os_lib ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-perfect-hash-generators-g-pehage-ads}@anchor{383}@anchor{gnat_rm/the_gnat_library id94}@anchor{384} +@anchor{gnat_rm/the_gnat_library gnat-perfect-hash-generators-g-pehage-ads}@anchor{384}@anchor{gnat_rm/the_gnat_library id94}@anchor{385} @section @code{GNAT.Perfect_Hash_Generators} (@code{g-pehage.ads}) @@ -24304,7 +24316,7 @@ hashcode are in the same order. These hashing functions are very convenient for use with realtime applications. @node GNAT Random_Numbers g-rannum ads,GNAT Regexp g-regexp ads,GNAT Perfect_Hash_Generators g-pehage ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-random-numbers-g-rannum-ads}@anchor{385}@anchor{gnat_rm/the_gnat_library id95}@anchor{386} +@anchor{gnat_rm/the_gnat_library gnat-random-numbers-g-rannum-ads}@anchor{386}@anchor{gnat_rm/the_gnat_library id95}@anchor{387} @section @code{GNAT.Random_Numbers} (@code{g-rannum.ads}) @@ -24316,7 +24328,7 @@ Provides random number capabilities which extend those available in the standard Ada library and are more convenient to use. @node GNAT Regexp g-regexp ads,GNAT Registry g-regist ads,GNAT Random_Numbers g-rannum ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-regexp-g-regexp-ads}@anchor{250}@anchor{gnat_rm/the_gnat_library id96}@anchor{387} +@anchor{gnat_rm/the_gnat_library gnat-regexp-g-regexp-ads}@anchor{251}@anchor{gnat_rm/the_gnat_library id96}@anchor{388} @section @code{GNAT.Regexp} (@code{g-regexp.ads}) @@ -24332,7 +24344,7 @@ simplest of the three pattern matching packages provided, and is particularly suitable for 'file globbing' applications. @node GNAT Registry g-regist ads,GNAT Regpat g-regpat ads,GNAT Regexp g-regexp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-registry-g-regist-ads}@anchor{388}@anchor{gnat_rm/the_gnat_library id97}@anchor{389} +@anchor{gnat_rm/the_gnat_library gnat-registry-g-regist-ads}@anchor{389}@anchor{gnat_rm/the_gnat_library id97}@anchor{38a} @section @code{GNAT.Registry} (@code{g-regist.ads}) @@ -24346,7 +24358,7 @@ registry API, but at a lower level of abstraction, refer to the Win32.Winreg package provided with the Win32Ada binding @node GNAT Regpat g-regpat ads,GNAT Rewrite_Data g-rewdat ads,GNAT Registry g-regist ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id98}@anchor{38a}@anchor{gnat_rm/the_gnat_library gnat-regpat-g-regpat-ads}@anchor{38b} +@anchor{gnat_rm/the_gnat_library id98}@anchor{38b}@anchor{gnat_rm/the_gnat_library gnat-regpat-g-regpat-ads}@anchor{38c} @section @code{GNAT.Regpat} (@code{g-regpat.ads}) @@ -24361,7 +24373,7 @@ from the original V7 style regular expression library written in C by Henry Spencer (and binary compatible with this C library). @node GNAT Rewrite_Data g-rewdat ads,GNAT Secondary_Stack_Info g-sestin ads,GNAT Regpat g-regpat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id99}@anchor{38c}@anchor{gnat_rm/the_gnat_library gnat-rewrite-data-g-rewdat-ads}@anchor{38d} +@anchor{gnat_rm/the_gnat_library id99}@anchor{38d}@anchor{gnat_rm/the_gnat_library gnat-rewrite-data-g-rewdat-ads}@anchor{38e} @section @code{GNAT.Rewrite_Data} (@code{g-rewdat.ads}) @@ -24375,7 +24387,7 @@ full content to be processed is not loaded into memory all at once. This makes this interface usable for large files or socket streams. @node GNAT Secondary_Stack_Info g-sestin ads,GNAT Semaphores g-semaph ads,GNAT Rewrite_Data g-rewdat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id100}@anchor{38e}@anchor{gnat_rm/the_gnat_library gnat-secondary-stack-info-g-sestin-ads}@anchor{38f} +@anchor{gnat_rm/the_gnat_library id100}@anchor{38f}@anchor{gnat_rm/the_gnat_library gnat-secondary-stack-info-g-sestin-ads}@anchor{390} @section @code{GNAT.Secondary_Stack_Info} (@code{g-sestin.ads}) @@ -24387,7 +24399,7 @@ Provide the capability to query the high water mark of the current task's secondary stack. @node GNAT Semaphores g-semaph ads,GNAT Serial_Communications g-sercom ads,GNAT Secondary_Stack_Info g-sestin ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id101}@anchor{390}@anchor{gnat_rm/the_gnat_library gnat-semaphores-g-semaph-ads}@anchor{391} +@anchor{gnat_rm/the_gnat_library id101}@anchor{391}@anchor{gnat_rm/the_gnat_library gnat-semaphores-g-semaph-ads}@anchor{392} @section @code{GNAT.Semaphores} (@code{g-semaph.ads}) @@ -24398,7 +24410,7 @@ secondary stack. Provides classic counting and binary semaphores using protected types. @node GNAT Serial_Communications g-sercom ads,GNAT SHA1 g-sha1 ads,GNAT Semaphores g-semaph ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-serial-communications-g-sercom-ads}@anchor{392}@anchor{gnat_rm/the_gnat_library id102}@anchor{393} +@anchor{gnat_rm/the_gnat_library gnat-serial-communications-g-sercom-ads}@anchor{393}@anchor{gnat_rm/the_gnat_library id102}@anchor{394} @section @code{GNAT.Serial_Communications} (@code{g-sercom.ads}) @@ -24410,7 +24422,7 @@ Provides a simple interface to send and receive data over a serial port. This is only supported on GNU/Linux and Windows. @node GNAT SHA1 g-sha1 ads,GNAT SHA224 g-sha224 ads,GNAT Serial_Communications g-sercom ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha1-g-sha1-ads}@anchor{394}@anchor{gnat_rm/the_gnat_library id103}@anchor{395} +@anchor{gnat_rm/the_gnat_library gnat-sha1-g-sha1-ads}@anchor{395}@anchor{gnat_rm/the_gnat_library id103}@anchor{396} @section @code{GNAT.SHA1} (@code{g-sha1.ads}) @@ -24423,7 +24435,7 @@ and RFC 3174, and the HMAC-SHA1 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA224 g-sha224 ads,GNAT SHA256 g-sha256 ads,GNAT SHA1 g-sha1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha224-g-sha224-ads}@anchor{396}@anchor{gnat_rm/the_gnat_library id104}@anchor{397} +@anchor{gnat_rm/the_gnat_library gnat-sha224-g-sha224-ads}@anchor{397}@anchor{gnat_rm/the_gnat_library id104}@anchor{398} @section @code{GNAT.SHA224} (@code{g-sha224.ads}) @@ -24436,7 +24448,7 @@ and the HMAC-SHA224 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA256 g-sha256 ads,GNAT SHA384 g-sha384 ads,GNAT SHA224 g-sha224 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id105}@anchor{398}@anchor{gnat_rm/the_gnat_library gnat-sha256-g-sha256-ads}@anchor{399} +@anchor{gnat_rm/the_gnat_library id105}@anchor{399}@anchor{gnat_rm/the_gnat_library gnat-sha256-g-sha256-ads}@anchor{39a} @section @code{GNAT.SHA256} (@code{g-sha256.ads}) @@ -24449,7 +24461,7 @@ and the HMAC-SHA256 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA384 g-sha384 ads,GNAT SHA512 g-sha512 ads,GNAT SHA256 g-sha256 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha384-g-sha384-ads}@anchor{39a}@anchor{gnat_rm/the_gnat_library id106}@anchor{39b} +@anchor{gnat_rm/the_gnat_library gnat-sha384-g-sha384-ads}@anchor{39b}@anchor{gnat_rm/the_gnat_library id106}@anchor{39c} @section @code{GNAT.SHA384} (@code{g-sha384.ads}) @@ -24462,7 +24474,7 @@ and the HMAC-SHA384 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA512 g-sha512 ads,GNAT Signals g-signal ads,GNAT SHA384 g-sha384 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha512-g-sha512-ads}@anchor{39c}@anchor{gnat_rm/the_gnat_library id107}@anchor{39d} +@anchor{gnat_rm/the_gnat_library gnat-sha512-g-sha512-ads}@anchor{39d}@anchor{gnat_rm/the_gnat_library id107}@anchor{39e} @section @code{GNAT.SHA512} (@code{g-sha512.ads}) @@ -24475,7 +24487,7 @@ and the HMAC-SHA512 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT Signals g-signal ads,GNAT Sockets g-socket ads,GNAT SHA512 g-sha512 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-signals-g-signal-ads}@anchor{39e}@anchor{gnat_rm/the_gnat_library id108}@anchor{39f} +@anchor{gnat_rm/the_gnat_library gnat-signals-g-signal-ads}@anchor{39f}@anchor{gnat_rm/the_gnat_library id108}@anchor{3a0} @section @code{GNAT.Signals} (@code{g-signal.ads}) @@ -24487,7 +24499,7 @@ Provides the ability to manipulate the blocked status of signals on supported targets. @node GNAT Sockets g-socket ads,GNAT Source_Info g-souinf ads,GNAT Signals g-signal ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id109}@anchor{3a0}@anchor{gnat_rm/the_gnat_library gnat-sockets-g-socket-ads}@anchor{3a1} +@anchor{gnat_rm/the_gnat_library id109}@anchor{3a1}@anchor{gnat_rm/the_gnat_library gnat-sockets-g-socket-ads}@anchor{3a2} @section @code{GNAT.Sockets} (@code{g-socket.ads}) @@ -24502,7 +24514,7 @@ on all native GNAT ports and on VxWorks cross prots. It is not implemented for the LynxOS cross port. @node GNAT Source_Info g-souinf ads,GNAT Spelling_Checker g-speche ads,GNAT Sockets g-socket ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-source-info-g-souinf-ads}@anchor{3a2}@anchor{gnat_rm/the_gnat_library id110}@anchor{3a3} +@anchor{gnat_rm/the_gnat_library gnat-source-info-g-souinf-ads}@anchor{3a3}@anchor{gnat_rm/the_gnat_library id110}@anchor{3a4} @section @code{GNAT.Source_Info} (@code{g-souinf.ads}) @@ -24516,7 +24528,7 @@ subprograms yielding the date and time of the current compilation (like the C macros @code{__DATE__} and @code{__TIME__}) @node GNAT Spelling_Checker g-speche ads,GNAT Spelling_Checker_Generic g-spchge ads,GNAT Source_Info g-souinf ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-g-speche-ads}@anchor{3a4}@anchor{gnat_rm/the_gnat_library id111}@anchor{3a5} +@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-g-speche-ads}@anchor{3a5}@anchor{gnat_rm/the_gnat_library id111}@anchor{3a6} @section @code{GNAT.Spelling_Checker} (@code{g-speche.ads}) @@ -24528,7 +24540,7 @@ Provides a function for determining whether one string is a plausible near misspelling of another string. @node GNAT Spelling_Checker_Generic g-spchge ads,GNAT Spitbol Patterns g-spipat ads,GNAT Spelling_Checker g-speche ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id112}@anchor{3a6}@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-generic-g-spchge-ads}@anchor{3a7} +@anchor{gnat_rm/the_gnat_library id112}@anchor{3a7}@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-generic-g-spchge-ads}@anchor{3a8} @section @code{GNAT.Spelling_Checker_Generic} (@code{g-spchge.ads}) @@ -24541,7 +24553,7 @@ determining whether one string is a plausible near misspelling of another string. @node GNAT Spitbol Patterns g-spipat ads,GNAT Spitbol g-spitbo ads,GNAT Spelling_Checker_Generic g-spchge ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id113}@anchor{3a8}@anchor{gnat_rm/the_gnat_library gnat-spitbol-patterns-g-spipat-ads}@anchor{3a9} +@anchor{gnat_rm/the_gnat_library id113}@anchor{3a9}@anchor{gnat_rm/the_gnat_library gnat-spitbol-patterns-g-spipat-ads}@anchor{3aa} @section @code{GNAT.Spitbol.Patterns} (@code{g-spipat.ads}) @@ -24557,7 +24569,7 @@ the SNOBOL4 dynamic pattern construction and matching capabilities, using the efficient algorithm developed by Robert Dewar for the SPITBOL system. @node GNAT Spitbol g-spitbo ads,GNAT Spitbol Table_Boolean g-sptabo ads,GNAT Spitbol Patterns g-spipat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-g-spitbo-ads}@anchor{3aa}@anchor{gnat_rm/the_gnat_library id114}@anchor{3ab} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-g-spitbo-ads}@anchor{3ab}@anchor{gnat_rm/the_gnat_library id114}@anchor{3ac} @section @code{GNAT.Spitbol} (@code{g-spitbo.ads}) @@ -24572,7 +24584,7 @@ useful for constructing arbitrary mappings from strings in the style of the SNOBOL4 TABLE function. @node GNAT Spitbol Table_Boolean g-sptabo ads,GNAT Spitbol Table_Integer g-sptain ads,GNAT Spitbol g-spitbo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-boolean-g-sptabo-ads}@anchor{3ac}@anchor{gnat_rm/the_gnat_library id115}@anchor{3ad} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-boolean-g-sptabo-ads}@anchor{3ad}@anchor{gnat_rm/the_gnat_library id115}@anchor{3ae} @section @code{GNAT.Spitbol.Table_Boolean} (@code{g-sptabo.ads}) @@ -24587,7 +24599,7 @@ for type @code{Standard.Boolean}, giving an implementation of sets of string values. @node GNAT Spitbol Table_Integer g-sptain ads,GNAT Spitbol Table_VString g-sptavs ads,GNAT Spitbol Table_Boolean g-sptabo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-integer-g-sptain-ads}@anchor{3ae}@anchor{gnat_rm/the_gnat_library id116}@anchor{3af} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-integer-g-sptain-ads}@anchor{3af}@anchor{gnat_rm/the_gnat_library id116}@anchor{3b0} @section @code{GNAT.Spitbol.Table_Integer} (@code{g-sptain.ads}) @@ -24604,7 +24616,7 @@ for type @code{Standard.Integer}, giving an implementation of maps from string to integer values. @node GNAT Spitbol Table_VString g-sptavs ads,GNAT SSE g-sse ads,GNAT Spitbol Table_Integer g-sptain ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id117}@anchor{3b0}@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-vstring-g-sptavs-ads}@anchor{3b1} +@anchor{gnat_rm/the_gnat_library id117}@anchor{3b1}@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-vstring-g-sptavs-ads}@anchor{3b2} @section @code{GNAT.Spitbol.Table_VString} (@code{g-sptavs.ads}) @@ -24621,7 +24633,7 @@ a variable length string type, giving an implementation of general maps from strings to strings. @node GNAT SSE g-sse ads,GNAT SSE Vector_Types g-ssvety ads,GNAT Spitbol Table_VString g-sptavs ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id118}@anchor{3b2}@anchor{gnat_rm/the_gnat_library gnat-sse-g-sse-ads}@anchor{3b3} +@anchor{gnat_rm/the_gnat_library id118}@anchor{3b3}@anchor{gnat_rm/the_gnat_library gnat-sse-g-sse-ads}@anchor{3b4} @section @code{GNAT.SSE} (@code{g-sse.ads}) @@ -24633,7 +24645,7 @@ targets. It exposes vector component types together with a general introduction to the binding contents and use. @node GNAT SSE Vector_Types g-ssvety ads,GNAT String_Hash g-strhas ads,GNAT SSE g-sse ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sse-vector-types-g-ssvety-ads}@anchor{3b4}@anchor{gnat_rm/the_gnat_library id119}@anchor{3b5} +@anchor{gnat_rm/the_gnat_library gnat-sse-vector-types-g-ssvety-ads}@anchor{3b5}@anchor{gnat_rm/the_gnat_library id119}@anchor{3b6} @section @code{GNAT.SSE.Vector_Types} (@code{g-ssvety.ads}) @@ -24642,7 +24654,7 @@ introduction to the binding contents and use. SSE vector types for use with SSE related intrinsics. @node GNAT String_Hash g-strhas ads,GNAT Strings g-string ads,GNAT SSE Vector_Types g-ssvety ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-string-hash-g-strhas-ads}@anchor{3b6}@anchor{gnat_rm/the_gnat_library id120}@anchor{3b7} +@anchor{gnat_rm/the_gnat_library gnat-string-hash-g-strhas-ads}@anchor{3b7}@anchor{gnat_rm/the_gnat_library id120}@anchor{3b8} @section @code{GNAT.String_Hash} (@code{g-strhas.ads}) @@ -24654,7 +24666,7 @@ Provides a generic hash function working on arrays of scalars. Both the scalar type and the hash result type are parameters. @node GNAT Strings g-string ads,GNAT String_Split g-strspl ads,GNAT String_Hash g-strhas ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-strings-g-string-ads}@anchor{3b8}@anchor{gnat_rm/the_gnat_library id121}@anchor{3b9} +@anchor{gnat_rm/the_gnat_library gnat-strings-g-string-ads}@anchor{3b9}@anchor{gnat_rm/the_gnat_library id121}@anchor{3ba} @section @code{GNAT.Strings} (@code{g-string.ads}) @@ -24664,7 +24676,7 @@ Common String access types and related subprograms. Basically it defines a string access and an array of string access types. @node GNAT String_Split g-strspl ads,GNAT Table g-table ads,GNAT Strings g-string ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-string-split-g-strspl-ads}@anchor{3ba}@anchor{gnat_rm/the_gnat_library id122}@anchor{3bb} +@anchor{gnat_rm/the_gnat_library gnat-string-split-g-strspl-ads}@anchor{3bb}@anchor{gnat_rm/the_gnat_library id122}@anchor{3bc} @section @code{GNAT.String_Split} (@code{g-strspl.ads}) @@ -24678,7 +24690,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node GNAT Table g-table ads,GNAT Task_Lock g-tasloc ads,GNAT String_Split g-strspl ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-table-g-table-ads}@anchor{3bc}@anchor{gnat_rm/the_gnat_library id123}@anchor{3bd} +@anchor{gnat_rm/the_gnat_library gnat-table-g-table-ads}@anchor{3bd}@anchor{gnat_rm/the_gnat_library id123}@anchor{3be} @section @code{GNAT.Table} (@code{g-table.ads}) @@ -24698,7 +24710,7 @@ while an instantiation of @code{GNAT.Dynamic_Tables} creates a type that can be used to define dynamic instances of the table. @node GNAT Task_Lock g-tasloc ads,GNAT Time_Stamp g-timsta ads,GNAT Table g-table ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id124}@anchor{3be}@anchor{gnat_rm/the_gnat_library gnat-task-lock-g-tasloc-ads}@anchor{3bf} +@anchor{gnat_rm/the_gnat_library id124}@anchor{3bf}@anchor{gnat_rm/the_gnat_library gnat-task-lock-g-tasloc-ads}@anchor{3c0} @section @code{GNAT.Task_Lock} (@code{g-tasloc.ads}) @@ -24715,7 +24727,7 @@ single global task lock. Appropriate for use in situations where contention between tasks is very rarely expected. @node GNAT Time_Stamp g-timsta ads,GNAT Threads g-thread ads,GNAT Task_Lock g-tasloc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id125}@anchor{3c0}@anchor{gnat_rm/the_gnat_library gnat-time-stamp-g-timsta-ads}@anchor{3c1} +@anchor{gnat_rm/the_gnat_library id125}@anchor{3c1}@anchor{gnat_rm/the_gnat_library gnat-time-stamp-g-timsta-ads}@anchor{3c2} @section @code{GNAT.Time_Stamp} (@code{g-timsta.ads}) @@ -24730,7 +24742,7 @@ represents the current date and time in ISO 8601 format. This is a very simple routine with minimal code and there are no dependencies on any other unit. @node GNAT Threads g-thread ads,GNAT Traceback g-traceb ads,GNAT Time_Stamp g-timsta ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-threads-g-thread-ads}@anchor{3c2}@anchor{gnat_rm/the_gnat_library id126}@anchor{3c3} +@anchor{gnat_rm/the_gnat_library gnat-threads-g-thread-ads}@anchor{3c3}@anchor{gnat_rm/the_gnat_library id126}@anchor{3c4} @section @code{GNAT.Threads} (@code{g-thread.ads}) @@ -24747,7 +24759,7 @@ further details if your program has threads that are created by a non-Ada environment which then accesses Ada code. @node GNAT Traceback g-traceb ads,GNAT Traceback Symbolic g-trasym ads,GNAT Threads g-thread ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id127}@anchor{3c4}@anchor{gnat_rm/the_gnat_library gnat-traceback-g-traceb-ads}@anchor{3c5} +@anchor{gnat_rm/the_gnat_library id127}@anchor{3c5}@anchor{gnat_rm/the_gnat_library gnat-traceback-g-traceb-ads}@anchor{3c6} @section @code{GNAT.Traceback} (@code{g-traceb.ads}) @@ -24759,7 +24771,7 @@ Provides a facility for obtaining non-symbolic traceback information, useful in various debugging situations. @node GNAT Traceback Symbolic g-trasym ads,GNAT UTF_32 g-table ads,GNAT Traceback g-traceb ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-traceback-symbolic-g-trasym-ads}@anchor{3c6}@anchor{gnat_rm/the_gnat_library id128}@anchor{3c7} +@anchor{gnat_rm/the_gnat_library gnat-traceback-symbolic-g-trasym-ads}@anchor{3c7}@anchor{gnat_rm/the_gnat_library id128}@anchor{3c8} @section @code{GNAT.Traceback.Symbolic} (@code{g-trasym.ads}) @@ -24768,7 +24780,7 @@ in various debugging situations. @geindex Trace back facilities @node GNAT UTF_32 g-table ads,GNAT Wide_Spelling_Checker g-u3spch ads,GNAT Traceback Symbolic g-trasym ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id129}@anchor{3c8}@anchor{gnat_rm/the_gnat_library gnat-utf-32-g-table-ads}@anchor{3c9} +@anchor{gnat_rm/the_gnat_library id129}@anchor{3c9}@anchor{gnat_rm/the_gnat_library gnat-utf-32-g-table-ads}@anchor{3ca} @section @code{GNAT.UTF_32} (@code{g-table.ads}) @@ -24787,7 +24799,7 @@ lower case to upper case fold routine corresponding to the Ada 2005 rules for identifier equivalence. @node GNAT Wide_Spelling_Checker g-u3spch ads,GNAT Wide_Spelling_Checker g-wispch ads,GNAT UTF_32 g-table ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-u3spch-ads}@anchor{3ca}@anchor{gnat_rm/the_gnat_library id130}@anchor{3cb} +@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-u3spch-ads}@anchor{3cb}@anchor{gnat_rm/the_gnat_library id130}@anchor{3cc} @section @code{GNAT.Wide_Spelling_Checker} (@code{g-u3spch.ads}) @@ -24800,7 +24812,7 @@ near misspelling of another wide wide string, where the strings are represented using the UTF_32_String type defined in System.Wch_Cnv. @node GNAT Wide_Spelling_Checker g-wispch ads,GNAT Wide_String_Split g-wistsp ads,GNAT Wide_Spelling_Checker g-u3spch ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-wispch-ads}@anchor{3cc}@anchor{gnat_rm/the_gnat_library id131}@anchor{3cd} +@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-wispch-ads}@anchor{3cd}@anchor{gnat_rm/the_gnat_library id131}@anchor{3ce} @section @code{GNAT.Wide_Spelling_Checker} (@code{g-wispch.ads}) @@ -24812,7 +24824,7 @@ Provides a function for determining whether one wide string is a plausible near misspelling of another wide string. @node GNAT Wide_String_Split g-wistsp ads,GNAT Wide_Wide_Spelling_Checker g-zspche ads,GNAT Wide_Spelling_Checker g-wispch ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id132}@anchor{3ce}@anchor{gnat_rm/the_gnat_library gnat-wide-string-split-g-wistsp-ads}@anchor{3cf} +@anchor{gnat_rm/the_gnat_library id132}@anchor{3cf}@anchor{gnat_rm/the_gnat_library gnat-wide-string-split-g-wistsp-ads}@anchor{3d0} @section @code{GNAT.Wide_String_Split} (@code{g-wistsp.ads}) @@ -24826,7 +24838,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node GNAT Wide_Wide_Spelling_Checker g-zspche ads,GNAT Wide_Wide_String_Split g-zistsp ads,GNAT Wide_String_Split g-wistsp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-wide-spelling-checker-g-zspche-ads}@anchor{3d0}@anchor{gnat_rm/the_gnat_library id133}@anchor{3d1} +@anchor{gnat_rm/the_gnat_library gnat-wide-wide-spelling-checker-g-zspche-ads}@anchor{3d1}@anchor{gnat_rm/the_gnat_library id133}@anchor{3d2} @section @code{GNAT.Wide_Wide_Spelling_Checker} (@code{g-zspche.ads}) @@ -24838,7 +24850,7 @@ Provides a function for determining whether one wide wide string is a plausible near misspelling of another wide wide string. @node GNAT Wide_Wide_String_Split g-zistsp ads,Interfaces C Extensions i-cexten ads,GNAT Wide_Wide_Spelling_Checker g-zspche ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-wide-string-split-g-zistsp-ads}@anchor{3d2}@anchor{gnat_rm/the_gnat_library id134}@anchor{3d3} +@anchor{gnat_rm/the_gnat_library gnat-wide-wide-string-split-g-zistsp-ads}@anchor{3d3}@anchor{gnat_rm/the_gnat_library id134}@anchor{3d4} @section @code{GNAT.Wide_Wide_String_Split} (@code{g-zistsp.ads}) @@ -24852,7 +24864,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node Interfaces C Extensions i-cexten ads,Interfaces C Streams i-cstrea ads,GNAT Wide_Wide_String_Split g-zistsp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-c-extensions-i-cexten-ads}@anchor{3d4}@anchor{gnat_rm/the_gnat_library id135}@anchor{3d5} +@anchor{gnat_rm/the_gnat_library interfaces-c-extensions-i-cexten-ads}@anchor{3d5}@anchor{gnat_rm/the_gnat_library id135}@anchor{3d6} @section @code{Interfaces.C.Extensions} (@code{i-cexten.ads}) @@ -24863,7 +24875,7 @@ for use with either manually or automatically generated bindings to C libraries. @node Interfaces C Streams i-cstrea ads,Interfaces Packed_Decimal i-pacdec ads,Interfaces C Extensions i-cexten ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-c-streams-i-cstrea-ads}@anchor{3d6}@anchor{gnat_rm/the_gnat_library id136}@anchor{3d7} +@anchor{gnat_rm/the_gnat_library interfaces-c-streams-i-cstrea-ads}@anchor{3d7}@anchor{gnat_rm/the_gnat_library id136}@anchor{3d8} @section @code{Interfaces.C.Streams} (@code{i-cstrea.ads}) @@ -24876,7 +24888,7 @@ This package is a binding for the most commonly used operations on C streams. @node Interfaces Packed_Decimal i-pacdec ads,Interfaces VxWorks i-vxwork ads,Interfaces C Streams i-cstrea ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-packed-decimal-i-pacdec-ads}@anchor{3d8}@anchor{gnat_rm/the_gnat_library id137}@anchor{3d9} +@anchor{gnat_rm/the_gnat_library interfaces-packed-decimal-i-pacdec-ads}@anchor{3d9}@anchor{gnat_rm/the_gnat_library id137}@anchor{3da} @section @code{Interfaces.Packed_Decimal} (@code{i-pacdec.ads}) @@ -24891,7 +24903,7 @@ from a packed decimal format compatible with that used on IBM mainframes. @node Interfaces VxWorks i-vxwork ads,Interfaces VxWorks Int_Connection i-vxinco ads,Interfaces Packed_Decimal i-pacdec ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id138}@anchor{3da}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-i-vxwork-ads}@anchor{3db} +@anchor{gnat_rm/the_gnat_library id138}@anchor{3db}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-i-vxwork-ads}@anchor{3dc} @section @code{Interfaces.VxWorks} (@code{i-vxwork.ads}) @@ -24907,7 +24919,7 @@ In particular, it interfaces with the VxWorks hardware interrupt facilities. @node Interfaces VxWorks Int_Connection i-vxinco ads,Interfaces VxWorks IO i-vxwoio ads,Interfaces VxWorks i-vxwork ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-vxworks-int-connection-i-vxinco-ads}@anchor{3dc}@anchor{gnat_rm/the_gnat_library id139}@anchor{3dd} +@anchor{gnat_rm/the_gnat_library interfaces-vxworks-int-connection-i-vxinco-ads}@anchor{3dd}@anchor{gnat_rm/the_gnat_library id139}@anchor{3de} @section @code{Interfaces.VxWorks.Int_Connection} (@code{i-vxinco.ads}) @@ -24923,7 +24935,7 @@ intConnect() with a custom routine for installing interrupt handlers. @node Interfaces VxWorks IO i-vxwoio ads,System Address_Image s-addima ads,Interfaces VxWorks Int_Connection i-vxinco ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-vxworks-io-i-vxwoio-ads}@anchor{3de}@anchor{gnat_rm/the_gnat_library id140}@anchor{3df} +@anchor{gnat_rm/the_gnat_library interfaces-vxworks-io-i-vxwoio-ads}@anchor{3df}@anchor{gnat_rm/the_gnat_library id140}@anchor{3e0} @section @code{Interfaces.VxWorks.IO} (@code{i-vxwoio.ads}) @@ -24946,7 +24958,7 @@ function codes. A particular use of this package is to enable the use of Get_Immediate under VxWorks. @node System Address_Image s-addima ads,System Assertions s-assert ads,Interfaces VxWorks IO i-vxwoio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id141}@anchor{3e0}@anchor{gnat_rm/the_gnat_library system-address-image-s-addima-ads}@anchor{3e1} +@anchor{gnat_rm/the_gnat_library id141}@anchor{3e1}@anchor{gnat_rm/the_gnat_library system-address-image-s-addima-ads}@anchor{3e2} @section @code{System.Address_Image} (@code{s-addima.ads}) @@ -24962,7 +24974,7 @@ function that gives an (implementation dependent) string which identifies an address. @node System Assertions s-assert ads,System Atomic_Counters s-atocou ads,System Address_Image s-addima ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-assertions-s-assert-ads}@anchor{3e2}@anchor{gnat_rm/the_gnat_library id142}@anchor{3e3} +@anchor{gnat_rm/the_gnat_library system-assertions-s-assert-ads}@anchor{3e3}@anchor{gnat_rm/the_gnat_library id142}@anchor{3e4} @section @code{System.Assertions} (@code{s-assert.ads}) @@ -24978,7 +24990,7 @@ by an run-time assertion failure, as well as the routine that is used internally to raise this assertion. @node System Atomic_Counters s-atocou ads,System Memory s-memory ads,System Assertions s-assert ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id143}@anchor{3e4}@anchor{gnat_rm/the_gnat_library system-atomic-counters-s-atocou-ads}@anchor{3e5} +@anchor{gnat_rm/the_gnat_library id143}@anchor{3e5}@anchor{gnat_rm/the_gnat_library system-atomic-counters-s-atocou-ads}@anchor{3e6} @section @code{System.Atomic_Counters} (@code{s-atocou.ads}) @@ -24992,7 +25004,7 @@ on most targets, including all Alpha, ia64, PowerPC, SPARC V9, x86, and x86_64 platforms. @node System Memory s-memory ads,System Multiprocessors s-multip ads,System Atomic_Counters s-atocou ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-memory-s-memory-ads}@anchor{3e6}@anchor{gnat_rm/the_gnat_library id144}@anchor{3e7} +@anchor{gnat_rm/the_gnat_library system-memory-s-memory-ads}@anchor{3e7}@anchor{gnat_rm/the_gnat_library id144}@anchor{3e8} @section @code{System.Memory} (@code{s-memory.ads}) @@ -25010,7 +25022,7 @@ calls to this unit may be made for low level allocation uses (for example see the body of @code{GNAT.Tables}). @node System Multiprocessors s-multip ads,System Multiprocessors Dispatching_Domains s-mudido ads,System Memory s-memory ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id145}@anchor{3e8}@anchor{gnat_rm/the_gnat_library system-multiprocessors-s-multip-ads}@anchor{3e9} +@anchor{gnat_rm/the_gnat_library id145}@anchor{3e9}@anchor{gnat_rm/the_gnat_library system-multiprocessors-s-multip-ads}@anchor{3ea} @section @code{System.Multiprocessors} (@code{s-multip.ads}) @@ -25023,7 +25035,7 @@ in GNAT we also make it available in Ada 95 and Ada 2005 (where it is technically an implementation-defined addition). @node System Multiprocessors Dispatching_Domains s-mudido ads,System Partition_Interface s-parint ads,System Multiprocessors s-multip ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-multiprocessors-dispatching-domains-s-mudido-ads}@anchor{3ea}@anchor{gnat_rm/the_gnat_library id146}@anchor{3eb} +@anchor{gnat_rm/the_gnat_library system-multiprocessors-dispatching-domains-s-mudido-ads}@anchor{3eb}@anchor{gnat_rm/the_gnat_library id146}@anchor{3ec} @section @code{System.Multiprocessors.Dispatching_Domains} (@code{s-mudido.ads}) @@ -25036,7 +25048,7 @@ in GNAT we also make it available in Ada 95 and Ada 2005 (where it is technically an implementation-defined addition). @node System Partition_Interface s-parint ads,System Pool_Global s-pooglo ads,System Multiprocessors Dispatching_Domains s-mudido ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id147}@anchor{3ec}@anchor{gnat_rm/the_gnat_library system-partition-interface-s-parint-ads}@anchor{3ed} +@anchor{gnat_rm/the_gnat_library id147}@anchor{3ed}@anchor{gnat_rm/the_gnat_library system-partition-interface-s-parint-ads}@anchor{3ee} @section @code{System.Partition_Interface} (@code{s-parint.ads}) @@ -25049,7 +25061,7 @@ is used primarily in a distribution context when using Annex E with @code{GLADE}. @node System Pool_Global s-pooglo ads,System Pool_Local s-pooloc ads,System Partition_Interface s-parint ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id148}@anchor{3ee}@anchor{gnat_rm/the_gnat_library system-pool-global-s-pooglo-ads}@anchor{3ef} +@anchor{gnat_rm/the_gnat_library id148}@anchor{3ef}@anchor{gnat_rm/the_gnat_library system-pool-global-s-pooglo-ads}@anchor{3f0} @section @code{System.Pool_Global} (@code{s-pooglo.ads}) @@ -25066,7 +25078,7 @@ declared. It uses malloc/free to allocate/free and does not attempt to do any automatic reclamation. @node System Pool_Local s-pooloc ads,System Restrictions s-restri ads,System Pool_Global s-pooglo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-pool-local-s-pooloc-ads}@anchor{3f0}@anchor{gnat_rm/the_gnat_library id149}@anchor{3f1} +@anchor{gnat_rm/the_gnat_library system-pool-local-s-pooloc-ads}@anchor{3f1}@anchor{gnat_rm/the_gnat_library id149}@anchor{3f2} @section @code{System.Pool_Local} (@code{s-pooloc.ads}) @@ -25083,7 +25095,7 @@ a list of allocated blocks, so that all storage allocated for the pool can be freed automatically when the pool is finalized. @node System Restrictions s-restri ads,System Rident s-rident ads,System Pool_Local s-pooloc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id150}@anchor{3f2}@anchor{gnat_rm/the_gnat_library system-restrictions-s-restri-ads}@anchor{3f3} +@anchor{gnat_rm/the_gnat_library id150}@anchor{3f3}@anchor{gnat_rm/the_gnat_library system-restrictions-s-restri-ads}@anchor{3f4} @section @code{System.Restrictions} (@code{s-restri.ads}) @@ -25099,7 +25111,7 @@ compiler determined information on which restrictions are violated by one or more packages in the partition. @node System Rident s-rident ads,System Strings Stream_Ops s-ststop ads,System Restrictions s-restri ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-rident-s-rident-ads}@anchor{3f4}@anchor{gnat_rm/the_gnat_library id151}@anchor{3f5} +@anchor{gnat_rm/the_gnat_library system-rident-s-rident-ads}@anchor{3f5}@anchor{gnat_rm/the_gnat_library id151}@anchor{3f6} @section @code{System.Rident} (@code{s-rident.ads}) @@ -25115,7 +25127,7 @@ since the necessary instantiation is included in package System.Restrictions. @node System Strings Stream_Ops s-ststop ads,System Unsigned_Types s-unstyp ads,System Rident s-rident ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id152}@anchor{3f6}@anchor{gnat_rm/the_gnat_library system-strings-stream-ops-s-ststop-ads}@anchor{3f7} +@anchor{gnat_rm/the_gnat_library id152}@anchor{3f7}@anchor{gnat_rm/the_gnat_library system-strings-stream-ops-s-ststop-ads}@anchor{3f8} @section @code{System.Strings.Stream_Ops} (@code{s-ststop.ads}) @@ -25131,7 +25143,7 @@ stream attributes are applied to string types, but the subprograms in this package can be used directly by application programs. @node System Unsigned_Types s-unstyp ads,System Wch_Cnv s-wchcnv ads,System Strings Stream_Ops s-ststop ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-unsigned-types-s-unstyp-ads}@anchor{3f8}@anchor{gnat_rm/the_gnat_library id153}@anchor{3f9} +@anchor{gnat_rm/the_gnat_library system-unsigned-types-s-unstyp-ads}@anchor{3f9}@anchor{gnat_rm/the_gnat_library id153}@anchor{3fa} @section @code{System.Unsigned_Types} (@code{s-unstyp.ads}) @@ -25144,7 +25156,7 @@ also contains some related definitions for other specialized types used by the compiler in connection with packed array types. @node System Wch_Cnv s-wchcnv ads,System Wch_Con s-wchcon ads,System Unsigned_Types s-unstyp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-wch-cnv-s-wchcnv-ads}@anchor{3fa}@anchor{gnat_rm/the_gnat_library id154}@anchor{3fb} +@anchor{gnat_rm/the_gnat_library system-wch-cnv-s-wchcnv-ads}@anchor{3fb}@anchor{gnat_rm/the_gnat_library id154}@anchor{3fc} @section @code{System.Wch_Cnv} (@code{s-wchcnv.ads}) @@ -25165,7 +25177,7 @@ encoding method. It uses definitions in package @code{System.Wch_Con}. @node System Wch_Con s-wchcon ads,,System Wch_Cnv s-wchcnv ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-wch-con-s-wchcon-ads}@anchor{3fc}@anchor{gnat_rm/the_gnat_library id155}@anchor{3fd} +@anchor{gnat_rm/the_gnat_library system-wch-con-s-wchcon-ads}@anchor{3fd}@anchor{gnat_rm/the_gnat_library id155}@anchor{3fe} @section @code{System.Wch_Con} (@code{s-wchcon.ads}) @@ -25177,7 +25189,7 @@ in ordinary strings. These definitions are used by the package @code{System.Wch_Cnv}. @node Interfacing to Other Languages,Specialized Needs Annexes,The GNAT Library,Top -@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-other-languages}@anchor{11}@anchor{gnat_rm/interfacing_to_other_languages doc}@anchor{3fe}@anchor{gnat_rm/interfacing_to_other_languages id1}@anchor{3ff} +@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-other-languages}@anchor{11}@anchor{gnat_rm/interfacing_to_other_languages doc}@anchor{3ff}@anchor{gnat_rm/interfacing_to_other_languages id1}@anchor{400} @chapter Interfacing to Other Languages @@ -25195,7 +25207,7 @@ provided. @end menu @node Interfacing to C,Interfacing to C++,,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-c}@anchor{400}@anchor{gnat_rm/interfacing_to_other_languages id2}@anchor{401} +@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-c}@anchor{401}@anchor{gnat_rm/interfacing_to_other_languages id2}@anchor{402} @section Interfacing to C @@ -25333,7 +25345,7 @@ of the length corresponding to the @code{type'Size} value in Ada. @end itemize @node Interfacing to C++,Interfacing to COBOL,Interfacing to C,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id4}@anchor{402}@anchor{gnat_rm/interfacing_to_other_languages id3}@anchor{45} +@anchor{gnat_rm/interfacing_to_other_languages id4}@anchor{403}@anchor{gnat_rm/interfacing_to_other_languages id3}@anchor{45} @section Interfacing to C++ @@ -25390,7 +25402,7 @@ The @code{External_Name} is the name of the C++ RTTI symbol. You can then cover a specific C++ exception in an exception handler. @node Interfacing to COBOL,Interfacing to Fortran,Interfacing to C++,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id5}@anchor{403}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-cobol}@anchor{404} +@anchor{gnat_rm/interfacing_to_other_languages id5}@anchor{404}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-cobol}@anchor{405} @section Interfacing to COBOL @@ -25398,7 +25410,7 @@ Interfacing to COBOL is achieved as described in section B.4 of the Ada Reference Manual. @node Interfacing to Fortran,Interfacing to non-GNAT Ada code,Interfacing to COBOL,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id6}@anchor{405}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-fortran}@anchor{406} +@anchor{gnat_rm/interfacing_to_other_languages id6}@anchor{406}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-fortran}@anchor{407} @section Interfacing to Fortran @@ -25408,7 +25420,7 @@ multi-dimensional array causes the array to be stored in column-major order as required for convenient interface to Fortran. @node Interfacing to non-GNAT Ada code,,Interfacing to Fortran,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-non-gnat-ada-code}@anchor{407}@anchor{gnat_rm/interfacing_to_other_languages id7}@anchor{408} +@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-non-gnat-ada-code}@anchor{408}@anchor{gnat_rm/interfacing_to_other_languages id7}@anchor{409} @section Interfacing to non-GNAT Ada code @@ -25432,7 +25444,7 @@ values or simple record types without variants, or simple array types with fixed bounds. @node Specialized Needs Annexes,Implementation of Specific Ada Features,Interfacing to Other Languages,Top -@anchor{gnat_rm/specialized_needs_annexes specialized-needs-annexes}@anchor{12}@anchor{gnat_rm/specialized_needs_annexes doc}@anchor{409}@anchor{gnat_rm/specialized_needs_annexes id1}@anchor{40a} +@anchor{gnat_rm/specialized_needs_annexes specialized-needs-annexes}@anchor{12}@anchor{gnat_rm/specialized_needs_annexes doc}@anchor{40a}@anchor{gnat_rm/specialized_needs_annexes id1}@anchor{40b} @chapter Specialized Needs Annexes @@ -25473,7 +25485,7 @@ in Ada 2005) is fully implemented. @end table @node Implementation of Specific Ada Features,Implementation of Ada 2012 Features,Specialized Needs Annexes,Top -@anchor{gnat_rm/implementation_of_specific_ada_features implementation-of-specific-ada-features}@anchor{13}@anchor{gnat_rm/implementation_of_specific_ada_features doc}@anchor{40b}@anchor{gnat_rm/implementation_of_specific_ada_features id1}@anchor{40c} +@anchor{gnat_rm/implementation_of_specific_ada_features implementation-of-specific-ada-features}@anchor{13}@anchor{gnat_rm/implementation_of_specific_ada_features doc}@anchor{40c}@anchor{gnat_rm/implementation_of_specific_ada_features id1}@anchor{40d} @chapter Implementation of Specific Ada Features @@ -25491,7 +25503,7 @@ facilities. @end menu @node Machine Code Insertions,GNAT Implementation of Tasking,,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features machine-code-insertions}@anchor{164}@anchor{gnat_rm/implementation_of_specific_ada_features id2}@anchor{40d} +@anchor{gnat_rm/implementation_of_specific_ada_features machine-code-insertions}@anchor{164}@anchor{gnat_rm/implementation_of_specific_ada_features id2}@anchor{40e} @section Machine Code Insertions @@ -25659,7 +25671,7 @@ according to normal visibility rules. In particular if there is no qualification is required. @node GNAT Implementation of Tasking,GNAT Implementation of Shared Passive Packages,Machine Code Insertions,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id3}@anchor{40e}@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-tasking}@anchor{40f} +@anchor{gnat_rm/implementation_of_specific_ada_features id3}@anchor{40f}@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-tasking}@anchor{410} @section GNAT Implementation of Tasking @@ -25675,7 +25687,7 @@ to compliance with the Real-Time Systems Annex. @end menu @node Mapping Ada Tasks onto the Underlying Kernel Threads,Ensuring Compliance with the Real-Time Annex,,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features mapping-ada-tasks-onto-the-underlying-kernel-threads}@anchor{410}@anchor{gnat_rm/implementation_of_specific_ada_features id4}@anchor{411} +@anchor{gnat_rm/implementation_of_specific_ada_features mapping-ada-tasks-onto-the-underlying-kernel-threads}@anchor{411}@anchor{gnat_rm/implementation_of_specific_ada_features id4}@anchor{412} @subsection Mapping Ada Tasks onto the Underlying Kernel Threads @@ -25744,7 +25756,7 @@ support this functionality when the parent contains more than one task. @geindex Forking a new process @node Ensuring Compliance with the Real-Time Annex,Support for Locking Policies,Mapping Ada Tasks onto the Underlying Kernel Threads,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features id5}@anchor{412}@anchor{gnat_rm/implementation_of_specific_ada_features ensuring-compliance-with-the-real-time-annex}@anchor{413} +@anchor{gnat_rm/implementation_of_specific_ada_features id5}@anchor{413}@anchor{gnat_rm/implementation_of_specific_ada_features ensuring-compliance-with-the-real-time-annex}@anchor{414} @subsection Ensuring Compliance with the Real-Time Annex @@ -25795,7 +25807,7 @@ placed at the end. @c Support_for_Locking_Policies @node Support for Locking Policies,,Ensuring Compliance with the Real-Time Annex,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features support-for-locking-policies}@anchor{414} +@anchor{gnat_rm/implementation_of_specific_ada_features support-for-locking-policies}@anchor{415} @subsection Support for Locking Policies @@ -25829,7 +25841,7 @@ then ceiling locking is used. Otherwise, the @code{Ceiling_Locking} policy is ignored. @node GNAT Implementation of Shared Passive Packages,Code Generation for Array Aggregates,GNAT Implementation of Tasking,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id6}@anchor{415}@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-shared-passive-packages}@anchor{416} +@anchor{gnat_rm/implementation_of_specific_ada_features id6}@anchor{416}@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-shared-passive-packages}@anchor{417} @section GNAT Implementation of Shared Passive Packages @@ -25930,7 +25942,7 @@ GNAT supports shared passive packages on all platforms except for OpenVMS. @node Code Generation for Array Aggregates,The Size of Discriminated Records with Default Discriminants,GNAT Implementation of Shared Passive Packages,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features code-generation-for-array-aggregates}@anchor{417}@anchor{gnat_rm/implementation_of_specific_ada_features id7}@anchor{418} +@anchor{gnat_rm/implementation_of_specific_ada_features code-generation-for-array-aggregates}@anchor{418}@anchor{gnat_rm/implementation_of_specific_ada_features id7}@anchor{419} @section Code Generation for Array Aggregates @@ -25961,7 +25973,7 @@ component values and static subtypes also lead to simpler code. @end menu @node Static constant aggregates with static bounds,Constant aggregates with unconstrained nominal types,,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features static-constant-aggregates-with-static-bounds}@anchor{419}@anchor{gnat_rm/implementation_of_specific_ada_features id8}@anchor{41a} +@anchor{gnat_rm/implementation_of_specific_ada_features static-constant-aggregates-with-static-bounds}@anchor{41a}@anchor{gnat_rm/implementation_of_specific_ada_features id8}@anchor{41b} @subsection Static constant aggregates with static bounds @@ -26008,7 +26020,7 @@ Zero2: constant two_dim := (others => (others => 0)); @end example @node Constant aggregates with unconstrained nominal types,Aggregates with static bounds,Static constant aggregates with static bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features constant-aggregates-with-unconstrained-nominal-types}@anchor{41b}@anchor{gnat_rm/implementation_of_specific_ada_features id9}@anchor{41c} +@anchor{gnat_rm/implementation_of_specific_ada_features constant-aggregates-with-unconstrained-nominal-types}@anchor{41c}@anchor{gnat_rm/implementation_of_specific_ada_features id9}@anchor{41d} @subsection Constant aggregates with unconstrained nominal types @@ -26023,7 +26035,7 @@ Cr_Unc : constant One_Unc := (12,24,36); @end example @node Aggregates with static bounds,Aggregates with nonstatic bounds,Constant aggregates with unconstrained nominal types,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features id10}@anchor{41d}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-static-bounds}@anchor{41e} +@anchor{gnat_rm/implementation_of_specific_ada_features id10}@anchor{41e}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-static-bounds}@anchor{41f} @subsection Aggregates with static bounds @@ -26051,7 +26063,7 @@ end loop; @end example @node Aggregates with nonstatic bounds,Aggregates in assignment statements,Aggregates with static bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features id11}@anchor{41f}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-nonstatic-bounds}@anchor{420} +@anchor{gnat_rm/implementation_of_specific_ada_features id11}@anchor{420}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-nonstatic-bounds}@anchor{421} @subsection Aggregates with nonstatic bounds @@ -26062,7 +26074,7 @@ have to be applied to sub-arrays individually, if they do not have statically compatible subtypes. @node Aggregates in assignment statements,,Aggregates with nonstatic bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features id12}@anchor{421}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-in-assignment-statements}@anchor{422} +@anchor{gnat_rm/implementation_of_specific_ada_features id12}@anchor{422}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-in-assignment-statements}@anchor{423} @subsection Aggregates in assignment statements @@ -26104,7 +26116,7 @@ a temporary (created either by the front-end or the code generator) and then that temporary will be copied onto the target. @node The Size of Discriminated Records with Default Discriminants,Strict Conformance to the Ada Reference Manual,Code Generation for Array Aggregates,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id13}@anchor{423}@anchor{gnat_rm/implementation_of_specific_ada_features the-size-of-discriminated-records-with-default-discriminants}@anchor{424} +@anchor{gnat_rm/implementation_of_specific_ada_features id13}@anchor{424}@anchor{gnat_rm/implementation_of_specific_ada_features the-size-of-discriminated-records-with-default-discriminants}@anchor{425} @section The Size of Discriminated Records with Default Discriminants @@ -26184,7 +26196,7 @@ say) must be consistent, so it is imperative that the object, once created, remain invariant. @node Strict Conformance to the Ada Reference Manual,,The Size of Discriminated Records with Default Discriminants,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features strict-conformance-to-the-ada-reference-manual}@anchor{425}@anchor{gnat_rm/implementation_of_specific_ada_features id14}@anchor{426} +@anchor{gnat_rm/implementation_of_specific_ada_features strict-conformance-to-the-ada-reference-manual}@anchor{426}@anchor{gnat_rm/implementation_of_specific_ada_features id14}@anchor{427} @section Strict Conformance to the Ada Reference Manual @@ -26211,7 +26223,7 @@ behavior (although at the cost of a significant performance penalty), so infinite and NaN values are properly generated. @node Implementation of Ada 2012 Features,Obsolescent Features,Implementation of Specific Ada Features,Top -@anchor{gnat_rm/implementation_of_ada_2012_features doc}@anchor{427}@anchor{gnat_rm/implementation_of_ada_2012_features implementation-of-ada-2012-features}@anchor{14}@anchor{gnat_rm/implementation_of_ada_2012_features id1}@anchor{428} +@anchor{gnat_rm/implementation_of_ada_2012_features doc}@anchor{428}@anchor{gnat_rm/implementation_of_ada_2012_features implementation-of-ada-2012-features}@anchor{14}@anchor{gnat_rm/implementation_of_ada_2012_features id1}@anchor{429} @chapter Implementation of Ada 2012 Features @@ -28377,7 +28389,7 @@ RM References: H.04 (8/1) @end itemize @node Obsolescent Features,Compatibility and Porting Guide,Implementation of Ada 2012 Features,Top -@anchor{gnat_rm/obsolescent_features id1}@anchor{429}@anchor{gnat_rm/obsolescent_features doc}@anchor{42a}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{15} +@anchor{gnat_rm/obsolescent_features id1}@anchor{42a}@anchor{gnat_rm/obsolescent_features doc}@anchor{42b}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{15} @chapter Obsolescent Features @@ -28396,7 +28408,7 @@ compatibility purposes. @end menu @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id2}@anchor{42b}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{42c} +@anchor{gnat_rm/obsolescent_features id2}@anchor{42c}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{42d} @section pragma No_Run_Time @@ -28409,7 +28421,7 @@ preferred usage is to use an appropriately configured run-time that includes just those features that are to be made accessible. @node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id3}@anchor{42d}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{42e} +@anchor{gnat_rm/obsolescent_features id3}@anchor{42e}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{42f} @section pragma Ravenscar @@ -28418,7 +28430,7 @@ The pragma @code{Ravenscar} has exactly the same effect as pragma is part of the new Ada 2005 standard. @node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features -@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{42f}@anchor{gnat_rm/obsolescent_features id4}@anchor{430} +@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{430}@anchor{gnat_rm/obsolescent_features id4}@anchor{431} @section pragma Restricted_Run_Time @@ -28428,7 +28440,7 @@ preferred since the Ada 2005 pragma @code{Profile} is intended for this kind of implementation dependent addition. @node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{431}@anchor{gnat_rm/obsolescent_features id5}@anchor{432} +@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{432}@anchor{gnat_rm/obsolescent_features id5}@anchor{433} @section pragma Task_Info @@ -28454,7 +28466,7 @@ in the spec of package System.Task_Info in the runtime library. @node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features -@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{433}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{434} +@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{434}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{435} @section package System.Task_Info (@code{s-tasinf.ads}) @@ -28464,7 +28476,7 @@ to support the @code{Task_Info} pragma. The predefined Ada package standard replacement for GNAT's @code{Task_Info} functionality. @node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{16}@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{435}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{436} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{16}@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{436}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{437} @chapter Compatibility and Porting Guide @@ -28486,7 +28498,7 @@ applications developed in other Ada environments. @end menu @node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{437}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{438} +@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{438}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{439} @section Writing Portable Fixed-Point Declarations @@ -28608,7 +28620,7 @@ If you follow this scheme you will be guaranteed that your fixed-point types will be portable. @node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{439}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{43a} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{43a}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{43b} @section Compatibility with Ada 83 @@ -28636,7 +28648,7 @@ following subsections treat the most likely issues to be encountered. @end menu @node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{43b}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{43c} +@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{43c}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{43d} @subsection Legal Ada 83 programs that are illegal in Ada 95 @@ -28736,7 +28748,7 @@ the fix is usually simply to add the @code{(<>)} to the generic declaration. @end itemize @node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{43d}@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{43e} +@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{43e}@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{43f} @subsection More deterministic semantics @@ -28764,7 +28776,7 @@ which open select branches are executed. @end itemize @node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{43f}@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{440} +@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{440}@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{441} @subsection Changed semantics @@ -28806,7 +28818,7 @@ covers only the restricted range. @end itemize @node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{441}@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{442} +@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{442}@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{443} @subsection Other language compatibility issues @@ -28839,7 +28851,7 @@ include @code{pragma Interface} and the floating point type attributes @end itemize @node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{443}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{444} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{444}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{445} @section Compatibility between Ada 95 and Ada 2005 @@ -28911,7 +28923,7 @@ can declare a function returning a value from an anonymous access type. @end itemize @node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{445}@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{446} +@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{446}@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{447} @section Implementation-dependent characteristics @@ -28934,7 +28946,7 @@ transition from certain Ada 83 compilers. @end menu @node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{447}@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{448} +@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{448}@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{449} @subsection Implementation-defined pragmas @@ -28956,7 +28968,7 @@ avoiding compiler rejection of units that contain such pragmas; they are not relevant in a GNAT context and hence are not otherwise implemented. @node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{449}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{44a} +@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{44a}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{44b} @subsection Implementation-defined attributes @@ -28970,7 +28982,7 @@ Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and @code{Type_Class}. @node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{44b}@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{44c} +@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{44c}@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{44d} @subsection Libraries @@ -28999,7 +29011,7 @@ be preferable to retrofit the application using modular types. @end itemize @node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{44d}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{44e} +@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{44e}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{44f} @subsection Elaboration order @@ -29035,7 +29047,7 @@ pragmas either globally (as an effect of the @emph{-gnatE} switch) or locally @end itemize @node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{44f}@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{450} +@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{450}@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{451} @subsection Target-specific aspects @@ -29048,10 +29060,10 @@ on the robustness of the original design. Moreover, Ada 95 (and thus Ada 2005 and Ada 2012) are sometimes incompatible with typical Ada 83 compiler practices regarding implicit packing, the meaning of the Size attribute, and the size of access values. -GNAT's approach to these issues is described in @ref{451,,Representation Clauses}. +GNAT's approach to these issues is described in @ref{452,,Representation Clauses}. @node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{452}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{453} +@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{453}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{454} @section Compatibility with Other Ada Systems @@ -29094,7 +29106,7 @@ far beyond this minimal set, as described in the next section. @end itemize @node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{451}@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{454} +@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{452}@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{455} @section Representation Clauses @@ -29187,7 +29199,7 @@ with thin pointers. @end itemize @node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{455}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{456} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{456}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{457} @section Compatibility with HP Ada 83 @@ -29217,7 +29229,7 @@ extension of package System. @end itemize @node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top -@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license doc}@anchor{457}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{458} +@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license doc}@anchor{458}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{459} @chapter GNU Free Documentation License diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 947506799a5..05fdf4c84d0 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Oct 20, 2017 +GNAT User's Guide for Native Platforms , Nov 09, 2017 AdaCore @@ -446,6 +446,7 @@ Platform-Specific Information * Run-Time Libraries:: * Specifying a Run-Time Library:: +* GNU/Linux Topics:: * Microsoft Windows Topics:: * Mac OS Topics:: @@ -457,6 +458,10 @@ Specifying a Run-Time Library * Choosing the Scheduling Policy:: +GNU/Linux Topics + +* Required Packages on GNU/Linux;: Required Packages on GNU/Linux. + Microsoft Windows Topics * Using GNAT on Windows:: @@ -6456,7 +6461,7 @@ package Animals is type Dog is new Animal and Carnivore and Domestic with record Tooth_Count : Natural; - Owner : String (1 .. 30); + Owner : Chars_Ptr; end record; pragma Import (C_Plus_Plus, Dog); @@ -23449,6 +23454,7 @@ topics related to the GNAT implementation on Windows and Mac OS. @menu * Run-Time Libraries:: * Specifying a Run-Time Library:: +* GNU/Linux Topics:: * Microsoft Windows Topics:: * Mac OS Topics:: @@ -23615,7 +23621,7 @@ ZCX @end multitable -@node Specifying a Run-Time Library,Microsoft Windows Topics,Run-Time Libraries,Platform-Specific Information +@node Specifying a Run-Time Library,GNU/Linux Topics,Run-Time Libraries,Platform-Specific Information @anchor{gnat_ugn/platform_specific_information specifying-a-run-time-library}@anchor{1d6}@anchor{gnat_ugn/platform_specific_information id4}@anchor{1d7} @section Specifying a Run-Time Library @@ -23770,10 +23776,60 @@ Ignore : constant Boolean := It gets the effective user id, and if it's not 0 (i.e. root), it raises Program_Error. +@geindex Linux + +@geindex GNU/Linux + +@node GNU/Linux Topics,Microsoft Windows Topics,Specifying a Run-Time Library,Platform-Specific Information +@anchor{gnat_ugn/platform_specific_information id6}@anchor{1da}@anchor{gnat_ugn/platform_specific_information gnu-linux-topics}@anchor{1db} +@section GNU/Linux Topics + + +This section describes topics that are specific to GNU/Linux platforms. + +@menu +* Required Packages on GNU/Linux;: Required Packages on GNU/Linux. + +@end menu + +@node Required Packages on GNU/Linux,,,GNU/Linux Topics +@anchor{gnat_ugn/platform_specific_information id7}@anchor{1dc}@anchor{gnat_ugn/platform_specific_information required-packages-on-gnu-linux}@anchor{1dd} +@subsection Required Packages on GNU/Linux: + + +GNAT requires the C library developer's package to be installed. +The name of of that package depends on your GNU/Linux distribution: + + +@itemize * + +@item +RedHat, SUSE: @code{glibc-devel}; + +@item +Debian, Ubuntu: @code{libc6-dev} (normally installed by default). +@end itemize + +If using the 32-bit version of GNAT on a 64-bit version of GNU/Linux, +you'll need the 32-bit version of that package instead: + + +@itemize * + +@item +RedHat, SUSE: @code{glibc-devel.i686}; + +@item +Debian, Ubuntu: @code{libc6-dev:i386}. +@end itemize + +Other GNU/Linux distributions might be choosing a different name +for that package. + @geindex Windows -@node Microsoft Windows Topics,Mac OS Topics,Specifying a Run-Time Library,Platform-Specific Information -@anchor{gnat_ugn/platform_specific_information id6}@anchor{1da}@anchor{gnat_ugn/platform_specific_information microsoft-windows-topics}@anchor{2c} +@node Microsoft Windows Topics,Mac OS Topics,GNU/Linux Topics,Platform-Specific Information +@anchor{gnat_ugn/platform_specific_information microsoft-windows-topics}@anchor{2c}@anchor{gnat_ugn/platform_specific_information id8}@anchor{1de} @section Microsoft Windows Topics @@ -23796,7 +23852,7 @@ platforms. @end menu @node Using GNAT on Windows,Using a network installation of GNAT,,Microsoft Windows Topics -@anchor{gnat_ugn/platform_specific_information using-gnat-on-windows}@anchor{1db}@anchor{gnat_ugn/platform_specific_information id7}@anchor{1dc} +@anchor{gnat_ugn/platform_specific_information using-gnat-on-windows}@anchor{1df}@anchor{gnat_ugn/platform_specific_information id9}@anchor{1e0} @subsection Using GNAT on Windows @@ -23873,7 +23929,7 @@ uninstall or integrate different GNAT products. @end itemize @node Using a network installation of GNAT,CONSOLE and WINDOWS subsystems,Using GNAT on Windows,Microsoft Windows Topics -@anchor{gnat_ugn/platform_specific_information id8}@anchor{1dd}@anchor{gnat_ugn/platform_specific_information using-a-network-installation-of-gnat}@anchor{1de} +@anchor{gnat_ugn/platform_specific_information id10}@anchor{1e1}@anchor{gnat_ugn/platform_specific_information using-a-network-installation-of-gnat}@anchor{1e2} @subsection Using a network installation of GNAT @@ -23900,7 +23956,7 @@ transfer of large amounts of data across the network and will likely cause serious performance penalty. @node CONSOLE and WINDOWS subsystems,Temporary Files,Using a network installation of GNAT,Microsoft Windows Topics -@anchor{gnat_ugn/platform_specific_information console-and-windows-subsystems}@anchor{1df}@anchor{gnat_ugn/platform_specific_information id9}@anchor{1e0} +@anchor{gnat_ugn/platform_specific_information id11}@anchor{1e3}@anchor{gnat_ugn/platform_specific_information console-and-windows-subsystems}@anchor{1e4} @subsection CONSOLE and WINDOWS subsystems @@ -23925,7 +23981,7 @@ $ gnatmake winprog -largs -mwindows @end quotation @node Temporary Files,Disabling Command Line Argument Expansion,CONSOLE and WINDOWS subsystems,Microsoft Windows Topics -@anchor{gnat_ugn/platform_specific_information id10}@anchor{1e1}@anchor{gnat_ugn/platform_specific_information temporary-files}@anchor{1e2} +@anchor{gnat_ugn/platform_specific_information id12}@anchor{1e5}@anchor{gnat_ugn/platform_specific_information temporary-files}@anchor{1e6} @subsection Temporary Files @@ -23964,7 +24020,7 @@ environments where you may not have write access to some directories. @node Disabling Command Line Argument Expansion,Mixed-Language Programming on Windows,Temporary Files,Microsoft Windows Topics -@anchor{gnat_ugn/platform_specific_information disabling-command-line-argument-expansion}@anchor{1e3} +@anchor{gnat_ugn/platform_specific_information disabling-command-line-argument-expansion}@anchor{1e7} @subsection Disabling Command Line Argument Expansion @@ -24035,7 +24091,7 @@ Ada.Command_Line.Argument (1) -> "'*.txt'" @end example @node Mixed-Language Programming on Windows,Windows Specific Add-Ons,Disabling Command Line Argument Expansion,Microsoft Windows Topics -@anchor{gnat_ugn/platform_specific_information id11}@anchor{1e4}@anchor{gnat_ugn/platform_specific_information mixed-language-programming-on-windows}@anchor{1e5} +@anchor{gnat_ugn/platform_specific_information id13}@anchor{1e8}@anchor{gnat_ugn/platform_specific_information mixed-language-programming-on-windows}@anchor{1e9} @subsection Mixed-Language Programming on Windows @@ -24057,12 +24113,12 @@ to use the Microsoft tools for your C++ code, you have two choices: Encapsulate your C++ code in a DLL to be linked with your Ada application. In this case, use the Microsoft or whatever environment to build the DLL and use GNAT to build your executable -(@ref{1e6,,Using DLLs with GNAT}). +(@ref{1ea,,Using DLLs with GNAT}). @item Or you can encapsulate your Ada code in a DLL to be linked with the other part of your application. In this case, use GNAT to build the DLL -(@ref{1e7,,Building DLLs with GNAT Project files}) and use the Microsoft +(@ref{1eb,,Building DLLs with GNAT Project files}) and use the Microsoft or whatever environment to build your executable. @end itemize @@ -24119,7 +24175,7 @@ native SEH support is used. @end menu @node Windows Calling Conventions,Introduction to Dynamic Link Libraries DLLs,,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information windows-calling-conventions}@anchor{1e8}@anchor{gnat_ugn/platform_specific_information id12}@anchor{1e9} +@anchor{gnat_ugn/platform_specific_information windows-calling-conventions}@anchor{1ec}@anchor{gnat_ugn/platform_specific_information id14}@anchor{1ed} @subsubsection Windows Calling Conventions @@ -24164,7 +24220,7 @@ are available for Windows: @end menu @node C Calling Convention,Stdcall Calling Convention,,Windows Calling Conventions -@anchor{gnat_ugn/platform_specific_information c-calling-convention}@anchor{1ea}@anchor{gnat_ugn/platform_specific_information id13}@anchor{1eb} +@anchor{gnat_ugn/platform_specific_information c-calling-convention}@anchor{1ee}@anchor{gnat_ugn/platform_specific_information id15}@anchor{1ef} @subsubsection @code{C} Calling Convention @@ -24206,10 +24262,10 @@ is missing, as in the above example, this parameter is set to be the When importing a variable defined in C, you should always use the @code{C} calling convention unless the object containing the variable is part of a DLL (in which case you should use the @code{Stdcall} calling -convention, @ref{1ec,,Stdcall Calling Convention}). +convention, @ref{1f0,,Stdcall Calling Convention}). @node Stdcall Calling Convention,Win32 Calling Convention,C Calling Convention,Windows Calling Conventions -@anchor{gnat_ugn/platform_specific_information stdcall-calling-convention}@anchor{1ec}@anchor{gnat_ugn/platform_specific_information id14}@anchor{1ed} +@anchor{gnat_ugn/platform_specific_information stdcall-calling-convention}@anchor{1f0}@anchor{gnat_ugn/platform_specific_information id16}@anchor{1f1} @subsubsection @code{Stdcall} Calling Convention @@ -24306,7 +24362,7 @@ Note that to ease building cross-platform bindings this convention will be handled as a @code{C} calling convention on non-Windows platforms. @node Win32 Calling Convention,DLL Calling Convention,Stdcall Calling Convention,Windows Calling Conventions -@anchor{gnat_ugn/platform_specific_information win32-calling-convention}@anchor{1ee}@anchor{gnat_ugn/platform_specific_information id15}@anchor{1ef} +@anchor{gnat_ugn/platform_specific_information win32-calling-convention}@anchor{1f2}@anchor{gnat_ugn/platform_specific_information id17}@anchor{1f3} @subsubsection @code{Win32} Calling Convention @@ -24314,7 +24370,7 @@ This convention, which is GNAT-specific is fully equivalent to the @code{Stdcall} calling convention described above. @node DLL Calling Convention,,Win32 Calling Convention,Windows Calling Conventions -@anchor{gnat_ugn/platform_specific_information dll-calling-convention}@anchor{1f0}@anchor{gnat_ugn/platform_specific_information id16}@anchor{1f1} +@anchor{gnat_ugn/platform_specific_information id18}@anchor{1f4}@anchor{gnat_ugn/platform_specific_information dll-calling-convention}@anchor{1f5} @subsubsection @code{DLL} Calling Convention @@ -24322,7 +24378,7 @@ This convention, which is GNAT-specific is fully equivalent to the @code{Stdcall} calling convention described above. @node Introduction to Dynamic Link Libraries DLLs,Using DLLs with GNAT,Windows Calling Conventions,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information introduction-to-dynamic-link-libraries-dlls}@anchor{1f2}@anchor{gnat_ugn/platform_specific_information id17}@anchor{1f3} +@anchor{gnat_ugn/platform_specific_information id19}@anchor{1f6}@anchor{gnat_ugn/platform_specific_information introduction-to-dynamic-link-libraries-dlls}@anchor{1f7} @subsubsection Introduction to Dynamic Link Libraries (DLLs) @@ -24406,10 +24462,10 @@ As a side note, an interesting difference between Microsoft DLLs and Unix shared libraries, is the fact that on most Unix systems all public routines are exported by default in a Unix shared library, while under Windows it is possible (but not required) to list exported routines in -a definition file (see @ref{1f4,,The Definition File}). +a definition file (see @ref{1f8,,The Definition File}). @node Using DLLs with GNAT,Building DLLs with GNAT Project files,Introduction to Dynamic Link Libraries DLLs,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information id18}@anchor{1f5}@anchor{gnat_ugn/platform_specific_information using-dlls-with-gnat}@anchor{1e6} +@anchor{gnat_ugn/platform_specific_information id20}@anchor{1f9}@anchor{gnat_ugn/platform_specific_information using-dlls-with-gnat}@anchor{1ea} @subsubsection Using DLLs with GNAT @@ -24500,7 +24556,7 @@ example a fictitious DLL called @code{API.dll}. @end menu @node Creating an Ada Spec for the DLL Services,Creating an Import Library,,Using DLLs with GNAT -@anchor{gnat_ugn/platform_specific_information creating-an-ada-spec-for-the-dll-services}@anchor{1f6}@anchor{gnat_ugn/platform_specific_information id19}@anchor{1f7} +@anchor{gnat_ugn/platform_specific_information id21}@anchor{1fa}@anchor{gnat_ugn/platform_specific_information creating-an-ada-spec-for-the-dll-services}@anchor{1fb} @subsubsection Creating an Ada Spec for the DLL Services @@ -24540,7 +24596,7 @@ end API; @end quotation @node Creating an Import Library,,Creating an Ada Spec for the DLL Services,Using DLLs with GNAT -@anchor{gnat_ugn/platform_specific_information id20}@anchor{1f8}@anchor{gnat_ugn/platform_specific_information creating-an-import-library}@anchor{1f9} +@anchor{gnat_ugn/platform_specific_information id22}@anchor{1fc}@anchor{gnat_ugn/platform_specific_information creating-an-import-library}@anchor{1fd} @subsubsection Creating an Import Library @@ -24554,7 +24610,7 @@ as in this case it is possible to link directly against the DLL. Otherwise read on. @geindex Definition file -@anchor{gnat_ugn/platform_specific_information the-definition-file}@anchor{1f4} +@anchor{gnat_ugn/platform_specific_information the-definition-file}@anchor{1f8} @subsubheading The Definition File @@ -24602,17 +24658,17 @@ EXPORTS @end table Note that you must specify the correct suffix (@code{@@@emph{nn}}) -(see @ref{1e8,,Windows Calling Conventions}) for a Stdcall +(see @ref{1ec,,Windows Calling Conventions}) for a Stdcall calling convention function in the exported symbols list. There can actually be other sections in a definition file, but these sections are not relevant to the discussion at hand. -@anchor{gnat_ugn/platform_specific_information create-def-file-automatically}@anchor{1fa} +@anchor{gnat_ugn/platform_specific_information create-def-file-automatically}@anchor{1fe} @subsubheading Creating a Definition File Automatically You can automatically create the definition file @code{API.def} -(see @ref{1f4,,The Definition File}) from a DLL. +(see @ref{1f8,,The Definition File}) from a DLL. For that use the @code{dlltool} program as follows: @quotation @@ -24622,7 +24678,7 @@ $ dlltool API.dll -z API.def --export-all-symbols @end example Note that if some routines in the DLL have the @code{Stdcall} convention -(@ref{1e8,,Windows Calling Conventions}) with stripped @code{@@@emph{nn}} +(@ref{1ec,,Windows Calling Conventions}) with stripped @code{@@@emph{nn}} suffix then you'll have to edit @code{api.def} to add it, and specify @code{-k} to @code{gnatdll} when creating the import library. @@ -24646,13 +24702,13 @@ tells you what symbol is expected. You just have to go back to the definition file and add the right suffix. @end itemize @end quotation -@anchor{gnat_ugn/platform_specific_information gnat-style-import-library}@anchor{1fb} +@anchor{gnat_ugn/platform_specific_information gnat-style-import-library}@anchor{1ff} @subsubheading GNAT-Style Import Library To create a static import library from @code{API.dll} with the GNAT tools you should create the .def file, then use @code{gnatdll} tool -(see @ref{1fc,,Using gnatdll}) as follows: +(see @ref{200,,Using gnatdll}) as follows: @quotation @@ -24668,15 +24724,15 @@ definition file name is @code{xyz.def}, the import library name will be @code{libxyz.a}. Note that in the previous example option @code{-e} could have been removed because the name of the definition file (before the @code{.def} suffix) is the same as the name of the -DLL (@ref{1fc,,Using gnatdll} for more information about @code{gnatdll}). +DLL (@ref{200,,Using gnatdll} for more information about @code{gnatdll}). @end quotation -@anchor{gnat_ugn/platform_specific_information msvs-style-import-library}@anchor{1fd} +@anchor{gnat_ugn/platform_specific_information msvs-style-import-library}@anchor{201} @subsubheading Microsoft-Style Import Library A Microsoft import library is needed only if you plan to make an Ada DLL available to applications developed with Microsoft -tools (@ref{1e5,,Mixed-Language Programming on Windows}). +tools (@ref{1e9,,Mixed-Language Programming on Windows}). To create a Microsoft-style import library for @code{API.dll} you should create the .def file, then build the actual import library using @@ -24700,7 +24756,7 @@ See the Microsoft documentation for further details about the usage of @end quotation @node Building DLLs with GNAT Project files,Building DLLs with GNAT,Using DLLs with GNAT,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information id21}@anchor{1fe}@anchor{gnat_ugn/platform_specific_information building-dlls-with-gnat-project-files}@anchor{1e7} +@anchor{gnat_ugn/platform_specific_information id23}@anchor{202}@anchor{gnat_ugn/platform_specific_information building-dlls-with-gnat-project-files}@anchor{1eb} @subsubsection Building DLLs with GNAT Project files @@ -24716,7 +24772,7 @@ when inside the @code{DllMain} routine which is used for auto-initialization of shared libraries, so it is not possible to have library level tasks in SALs. @node Building DLLs with GNAT,Building DLLs with gnatdll,Building DLLs with GNAT Project files,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information building-dlls-with-gnat}@anchor{1ff}@anchor{gnat_ugn/platform_specific_information id22}@anchor{200} +@anchor{gnat_ugn/platform_specific_information building-dlls-with-gnat}@anchor{203}@anchor{gnat_ugn/platform_specific_information id24}@anchor{204} @subsubsection Building DLLs with GNAT @@ -24747,7 +24803,7 @@ $ gcc -shared -shared-libgcc -o api.dll obj1.o obj2.o ... It is important to note that in this case all symbols found in the object files are automatically exported. It is possible to restrict the set of symbols to export by passing to @code{gcc} a definition -file (see @ref{1f4,,The Definition File}). +file (see @ref{1f8,,The Definition File}). For example: @example @@ -24785,7 +24841,7 @@ $ gnatmake main -Iapilib -bargs -shared -largs -Lapilib -lAPI @end quotation @node Building DLLs with gnatdll,Ada DLLs and Finalization,Building DLLs with GNAT,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information building-dlls-with-gnatdll}@anchor{201}@anchor{gnat_ugn/platform_specific_information id23}@anchor{202} +@anchor{gnat_ugn/platform_specific_information building-dlls-with-gnatdll}@anchor{205}@anchor{gnat_ugn/platform_specific_information id25}@anchor{206} @subsubsection Building DLLs with gnatdll @@ -24793,8 +24849,8 @@ $ gnatmake main -Iapilib -bargs -shared -largs -Lapilib -lAPI @geindex building Note that it is preferred to use GNAT Project files -(@ref{1e7,,Building DLLs with GNAT Project files}) or the built-in GNAT -DLL support (@ref{1ff,,Building DLLs with GNAT}) or to build DLLs. +(@ref{1eb,,Building DLLs with GNAT Project files}) or the built-in GNAT +DLL support (@ref{203,,Building DLLs with GNAT}) or to build DLLs. This section explains how to build DLLs containing Ada code using @code{gnatdll}. These DLLs will be referred to as Ada DLLs in the @@ -24810,20 +24866,20 @@ non-Ada applications are as follows: You need to mark each Ada entity exported by the DLL with a @code{C} or @code{Stdcall} calling convention to avoid any Ada name mangling for the entities exported by the DLL -(see @ref{203,,Exporting Ada Entities}). You can +(see @ref{207,,Exporting Ada Entities}). You can skip this step if you plan to use the Ada DLL only from Ada applications. @item Your Ada code must export an initialization routine which calls the routine @code{adainit} generated by @code{gnatbind} to perform the elaboration of -the Ada code in the DLL (@ref{204,,Ada DLLs and Elaboration}). The initialization +the Ada code in the DLL (@ref{208,,Ada DLLs and Elaboration}). The initialization routine exported by the Ada DLL must be invoked by the clients of the DLL to initialize the DLL. @item When useful, the DLL should also export a finalization routine which calls routine @code{adafinal} generated by @code{gnatbind} to perform the -finalization of the Ada code in the DLL (@ref{205,,Ada DLLs and Finalization}). +finalization of the Ada code in the DLL (@ref{209,,Ada DLLs and Finalization}). The finalization routine exported by the Ada DLL must be invoked by the clients of the DLL when the DLL services are no further needed. @@ -24833,11 +24889,11 @@ of the programming languages to which you plan to make the DLL available. @item You must provide a definition file listing the exported entities -(@ref{1f4,,The Definition File}). +(@ref{1f8,,The Definition File}). @item Finally you must use @code{gnatdll} to produce the DLL and the import -library (@ref{1fc,,Using gnatdll}). +library (@ref{200,,Using gnatdll}). @end itemize Note that a relocatable DLL stripped using the @code{strip} @@ -24857,7 +24913,7 @@ chapter of the @emph{GPRbuild User's Guide}. @end menu @node Limitations When Using Ada DLLs from Ada,Exporting Ada Entities,,Building DLLs with gnatdll -@anchor{gnat_ugn/platform_specific_information limitations-when-using-ada-dlls-from-ada}@anchor{206} +@anchor{gnat_ugn/platform_specific_information limitations-when-using-ada-dlls-from-ada}@anchor{20a} @subsubsection Limitations When Using Ada DLLs from Ada @@ -24878,7 +24934,7 @@ It is completely safe to exchange plain elementary, array or record types, Windows object handles, etc. @node Exporting Ada Entities,Ada DLLs and Elaboration,Limitations When Using Ada DLLs from Ada,Building DLLs with gnatdll -@anchor{gnat_ugn/platform_specific_information exporting-ada-entities}@anchor{203}@anchor{gnat_ugn/platform_specific_information id24}@anchor{207} +@anchor{gnat_ugn/platform_specific_information exporting-ada-entities}@anchor{207}@anchor{gnat_ugn/platform_specific_information id26}@anchor{20b} @subsubsection Exporting Ada Entities @@ -24978,10 +25034,10 @@ end API; Note that if you do not export the Ada entities with a @code{C} or @code{Stdcall} convention you will have to provide the mangled Ada names in the definition file of the Ada DLL -(@ref{208,,Creating the Definition File}). +(@ref{20c,,Creating the Definition File}). @node Ada DLLs and Elaboration,,Exporting Ada Entities,Building DLLs with gnatdll -@anchor{gnat_ugn/platform_specific_information ada-dlls-and-elaboration}@anchor{204}@anchor{gnat_ugn/platform_specific_information id25}@anchor{209} +@anchor{gnat_ugn/platform_specific_information ada-dlls-and-elaboration}@anchor{208}@anchor{gnat_ugn/platform_specific_information id27}@anchor{20d} @subsubsection Ada DLLs and Elaboration @@ -24999,7 +25055,7 @@ the Ada elaboration routine @code{adainit} generated by the GNAT binder (@ref{b4,,Binding with Non-Ada Main Programs}). See the body of @code{Initialize_Api} for an example. Note that the GNAT binder is automatically invoked during the DLL build process by the @code{gnatdll} -tool (@ref{1fc,,Using gnatdll}). +tool (@ref{200,,Using gnatdll}). When a DLL is loaded, Windows systematically invokes a routine called @code{DllMain}. It would therefore be possible to call @code{adainit} @@ -25012,7 +25068,7 @@ time), which means that the GNAT run-time will deadlock waiting for the newly created task to complete its initialization. @node Ada DLLs and Finalization,Creating a Spec for Ada DLLs,Building DLLs with gnatdll,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information ada-dlls-and-finalization}@anchor{205}@anchor{gnat_ugn/platform_specific_information id26}@anchor{20a} +@anchor{gnat_ugn/platform_specific_information id28}@anchor{20e}@anchor{gnat_ugn/platform_specific_information ada-dlls-and-finalization}@anchor{209} @subsubsection Ada DLLs and Finalization @@ -25027,10 +25083,10 @@ routine @code{adafinal} generated by the GNAT binder See the body of @code{Finalize_Api} for an example. As already pointed out the GNAT binder is automatically invoked during the DLL build process by the @code{gnatdll} tool -(@ref{1fc,,Using gnatdll}). +(@ref{200,,Using gnatdll}). @node Creating a Spec for Ada DLLs,GNAT and Windows Resources,Ada DLLs and Finalization,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information id27}@anchor{20b}@anchor{gnat_ugn/platform_specific_information creating-a-spec-for-ada-dlls}@anchor{20c} +@anchor{gnat_ugn/platform_specific_information id29}@anchor{20f}@anchor{gnat_ugn/platform_specific_information creating-a-spec-for-ada-dlls}@anchor{210} @subsubsection Creating a Spec for Ada DLLs @@ -25088,7 +25144,7 @@ end API; @end menu @node Creating the Definition File,Using gnatdll,,Creating a Spec for Ada DLLs -@anchor{gnat_ugn/platform_specific_information id28}@anchor{20d}@anchor{gnat_ugn/platform_specific_information creating-the-definition-file}@anchor{208} +@anchor{gnat_ugn/platform_specific_information creating-the-definition-file}@anchor{20c}@anchor{gnat_ugn/platform_specific_information id30}@anchor{211} @subsubsection Creating the Definition File @@ -25124,7 +25180,7 @@ EXPORTS @end quotation @node Using gnatdll,,Creating the Definition File,Creating a Spec for Ada DLLs -@anchor{gnat_ugn/platform_specific_information id29}@anchor{20e}@anchor{gnat_ugn/platform_specific_information using-gnatdll}@anchor{1fc} +@anchor{gnat_ugn/platform_specific_information using-gnatdll}@anchor{200}@anchor{gnat_ugn/platform_specific_information id31}@anchor{212} @subsubsection Using @code{gnatdll} @@ -25335,7 +25391,7 @@ asks @code{gnatlink} to generate the routines @code{DllMain} and is loaded into memory. @item -@code{gnatdll} uses @code{dlltool} (see @ref{20f,,Using dlltool}) to build the +@code{gnatdll} uses @code{dlltool} (see @ref{213,,Using dlltool}) to build the export table (@code{api.exp}). The export table contains the relocation information in a form which can be used during the final link to ensure that the Windows loader is able to place the DLL anywhere in memory. @@ -25374,7 +25430,7 @@ $ gnatbind -n api $ gnatlink api api.exp -o api.dll -mdll @end example @end itemize -@anchor{gnat_ugn/platform_specific_information using-dlltool}@anchor{20f} +@anchor{gnat_ugn/platform_specific_information using-dlltool}@anchor{213} @subsubheading Using @code{dlltool} @@ -25433,7 +25489,7 @@ DLL in the static import library generated by @code{dlltool} with switch @item @code{-k} Kill @code{@@@emph{nn}} from exported names -(@ref{1e8,,Windows Calling Conventions} +(@ref{1ec,,Windows Calling Conventions} for a discussion about @code{Stdcall}-style symbols. @end table @@ -25489,7 +25545,7 @@ Use @code{assembler-name} as the assembler. The default is @code{as}. @end table @node GNAT and Windows Resources,Using GNAT DLLs from Microsoft Visual Studio Applications,Creating a Spec for Ada DLLs,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information gnat-and-windows-resources}@anchor{210}@anchor{gnat_ugn/platform_specific_information id30}@anchor{211} +@anchor{gnat_ugn/platform_specific_information gnat-and-windows-resources}@anchor{214}@anchor{gnat_ugn/platform_specific_information id32}@anchor{215} @subsubsection GNAT and Windows Resources @@ -25584,7 +25640,7 @@ the corresponding Microsoft documentation. @end menu @node Building Resources,Compiling Resources,,GNAT and Windows Resources -@anchor{gnat_ugn/platform_specific_information building-resources}@anchor{212}@anchor{gnat_ugn/platform_specific_information id31}@anchor{213} +@anchor{gnat_ugn/platform_specific_information building-resources}@anchor{216}@anchor{gnat_ugn/platform_specific_information id33}@anchor{217} @subsubsection Building Resources @@ -25604,7 +25660,7 @@ complete description of the resource script language can be found in the Microsoft documentation. @node Compiling Resources,Using Resources,Building Resources,GNAT and Windows Resources -@anchor{gnat_ugn/platform_specific_information compiling-resources}@anchor{214}@anchor{gnat_ugn/platform_specific_information id32}@anchor{215} +@anchor{gnat_ugn/platform_specific_information compiling-resources}@anchor{218}@anchor{gnat_ugn/platform_specific_information id34}@anchor{219} @subsubsection Compiling Resources @@ -25646,7 +25702,7 @@ $ windres -i myres.res -o myres.o @end quotation @node Using Resources,,Compiling Resources,GNAT and Windows Resources -@anchor{gnat_ugn/platform_specific_information using-resources}@anchor{216}@anchor{gnat_ugn/platform_specific_information id33}@anchor{217} +@anchor{gnat_ugn/platform_specific_information using-resources}@anchor{21a}@anchor{gnat_ugn/platform_specific_information id35}@anchor{21b} @subsubsection Using Resources @@ -25666,7 +25722,7 @@ $ gnatmake myprog -largs myres.o @end quotation @node Using GNAT DLLs from Microsoft Visual Studio Applications,Debugging a DLL,GNAT and Windows Resources,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information using-gnat-dll-from-msvs}@anchor{218}@anchor{gnat_ugn/platform_specific_information using-gnat-dlls-from-microsoft-visual-studio-applications}@anchor{219} +@anchor{gnat_ugn/platform_specific_information using-gnat-dll-from-msvs}@anchor{21c}@anchor{gnat_ugn/platform_specific_information using-gnat-dlls-from-microsoft-visual-studio-applications}@anchor{21d} @subsubsection Using GNAT DLLs from Microsoft Visual Studio Applications @@ -25700,7 +25756,7 @@ $ gprbuild -p mylib.gpr @item Produce a .def file for the symbols you need to interface with, either by hand or automatically with possibly some manual adjustments -(see @ref{1fa,,Creating Definition File Automatically}): +(see @ref{1fe,,Creating Definition File Automatically}): @end enumerate @quotation @@ -25717,7 +25773,7 @@ $ dlltool libmylib.dll -z libmylib.def --export-all-symbols Make sure that MSVS command-line tools are accessible on the path. @item -Create the Microsoft-style import library (see @ref{1fd,,MSVS-Style Import Library}): +Create the Microsoft-style import library (see @ref{201,,MSVS-Style Import Library}): @end enumerate @quotation @@ -25759,7 +25815,7 @@ or copy the DLL into into the directory containing the .exe. @end enumerate @node Debugging a DLL,Setting Stack Size from gnatlink,Using GNAT DLLs from Microsoft Visual Studio Applications,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information id34}@anchor{21a}@anchor{gnat_ugn/platform_specific_information debugging-a-dll}@anchor{21b} +@anchor{gnat_ugn/platform_specific_information id36}@anchor{21e}@anchor{gnat_ugn/platform_specific_information debugging-a-dll}@anchor{21f} @subsubsection Debugging a DLL @@ -25797,7 +25853,7 @@ tools suite used to build the DLL. @end menu @node Program and DLL Both Built with GCC/GNAT,Program Built with Foreign Tools and DLL Built with GCC/GNAT,,Debugging a DLL -@anchor{gnat_ugn/platform_specific_information program-and-dll-both-built-with-gcc-gnat}@anchor{21c}@anchor{gnat_ugn/platform_specific_information id35}@anchor{21d} +@anchor{gnat_ugn/platform_specific_information id37}@anchor{220}@anchor{gnat_ugn/platform_specific_information program-and-dll-both-built-with-gcc-gnat}@anchor{221} @subsubsection Program and DLL Both Built with GCC/GNAT @@ -25807,7 +25863,7 @@ the process. Let's suppose here that the main procedure is named @code{ada_main} and that in the DLL there is an entry point named @code{ada_dll}. -The DLL (@ref{1f2,,Introduction to Dynamic Link Libraries (DLLs)}) and +The DLL (@ref{1f7,,Introduction to Dynamic Link Libraries (DLLs)}) and program must have been built with the debugging information (see GNAT -g switch). Here are the step-by-step instructions for debugging it: @@ -25847,7 +25903,7 @@ you can use the standard approach to debug the whole program (@ref{24,,Running and Debugging Ada Programs}). @node Program Built with Foreign Tools and DLL Built with GCC/GNAT,,Program and DLL Both Built with GCC/GNAT,Debugging a DLL -@anchor{gnat_ugn/platform_specific_information id36}@anchor{21e}@anchor{gnat_ugn/platform_specific_information program-built-with-foreign-tools-and-dll-built-with-gcc-gnat}@anchor{21f} +@anchor{gnat_ugn/platform_specific_information program-built-with-foreign-tools-and-dll-built-with-gcc-gnat}@anchor{222}@anchor{gnat_ugn/platform_specific_information id38}@anchor{223} @subsubsection Program Built with Foreign Tools and DLL Built with GCC/GNAT @@ -25864,7 +25920,7 @@ example some C code built with Microsoft Visual C) and that there is a DLL named @code{test.dll} containing an Ada entry point named @code{ada_dll}. -The DLL (see @ref{1f2,,Introduction to Dynamic Link Libraries (DLLs)}) must have +The DLL (see @ref{1f7,,Introduction to Dynamic Link Libraries (DLLs)}) must have been built with debugging information (see the GNAT @code{-g} option). @subsubheading Debugging the DLL Directly @@ -26003,7 +26059,7 @@ approach to debug a program as described in @ref{24,,Running and Debugging Ada Programs}. @node Setting Stack Size from gnatlink,Setting Heap Size from gnatlink,Debugging a DLL,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information id37}@anchor{220}@anchor{gnat_ugn/platform_specific_information setting-stack-size-from-gnatlink}@anchor{136} +@anchor{gnat_ugn/platform_specific_information setting-stack-size-from-gnatlink}@anchor{136}@anchor{gnat_ugn/platform_specific_information id39}@anchor{224} @subsubsection Setting Stack Size from @code{gnatlink} @@ -26046,7 +26102,7 @@ because the comma is a separator for this option. @end itemize @node Setting Heap Size from gnatlink,,Setting Stack Size from gnatlink,Mixed-Language Programming on Windows -@anchor{gnat_ugn/platform_specific_information setting-heap-size-from-gnatlink}@anchor{137}@anchor{gnat_ugn/platform_specific_information id38}@anchor{221} +@anchor{gnat_ugn/platform_specific_information setting-heap-size-from-gnatlink}@anchor{137}@anchor{gnat_ugn/platform_specific_information id40}@anchor{225} @subsubsection Setting Heap Size from @code{gnatlink} @@ -26079,7 +26135,7 @@ because the comma is a separator for this option. @end itemize @node Windows Specific Add-Ons,,Mixed-Language Programming on Windows,Microsoft Windows Topics -@anchor{gnat_ugn/platform_specific_information windows-specific-add-ons}@anchor{222}@anchor{gnat_ugn/platform_specific_information win32-specific-addons}@anchor{223} +@anchor{gnat_ugn/platform_specific_information windows-specific-add-ons}@anchor{226}@anchor{gnat_ugn/platform_specific_information win32-specific-addons}@anchor{227} @subsection Windows Specific Add-Ons @@ -26092,7 +26148,7 @@ This section describes the Windows specific add-ons. @end menu @node Win32Ada,wPOSIX,,Windows Specific Add-Ons -@anchor{gnat_ugn/platform_specific_information win32ada}@anchor{224}@anchor{gnat_ugn/platform_specific_information id39}@anchor{225} +@anchor{gnat_ugn/platform_specific_information win32ada}@anchor{228}@anchor{gnat_ugn/platform_specific_information id41}@anchor{229} @subsubsection Win32Ada @@ -26123,7 +26179,7 @@ gprbuild p.gpr @end quotation @node wPOSIX,,Win32Ada,Windows Specific Add-Ons -@anchor{gnat_ugn/platform_specific_information wposix}@anchor{226}@anchor{gnat_ugn/platform_specific_information id40}@anchor{227} +@anchor{gnat_ugn/platform_specific_information id42}@anchor{22a}@anchor{gnat_ugn/platform_specific_information wposix}@anchor{22b} @subsubsection wPOSIX @@ -26156,7 +26212,7 @@ gprbuild p.gpr @end quotation @node Mac OS Topics,,Microsoft Windows Topics,Platform-Specific Information -@anchor{gnat_ugn/platform_specific_information mac-os-topics}@anchor{2d}@anchor{gnat_ugn/platform_specific_information id41}@anchor{228} +@anchor{gnat_ugn/platform_specific_information mac-os-topics}@anchor{2d}@anchor{gnat_ugn/platform_specific_information id43}@anchor{22c} @section Mac OS Topics @@ -26171,7 +26227,7 @@ platform. @end menu @node Codesigning the Debugger,,,Mac OS Topics -@anchor{gnat_ugn/platform_specific_information codesigning-the-debugger}@anchor{229} +@anchor{gnat_ugn/platform_specific_information codesigning-the-debugger}@anchor{22d} @subsection Codesigning the Debugger @@ -26252,7 +26308,7 @@ the location where you installed GNAT. Also, be sure that users are in the Unix group @code{_developer}. @node Example of Binder Output File,Elaboration Order Handling in GNAT,Platform-Specific Information,Top -@anchor{gnat_ugn/example_of_binder_output example-of-binder-output-file}@anchor{e}@anchor{gnat_ugn/example_of_binder_output doc}@anchor{22a}@anchor{gnat_ugn/example_of_binder_output id1}@anchor{22b} +@anchor{gnat_ugn/example_of_binder_output example-of-binder-output-file}@anchor{e}@anchor{gnat_ugn/example_of_binder_output doc}@anchor{22e}@anchor{gnat_ugn/example_of_binder_output id1}@anchor{22f} @chapter Example of Binder Output File @@ -27004,7 +27060,7 @@ elaboration code in your own application). @c -- Example: A |withing| unit has a |with| clause, it |withs| a |withed| unit @node Elaboration Order Handling in GNAT,Inline Assembler,Example of Binder Output File,Top -@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-order-handling-in-gnat}@anchor{f}@anchor{gnat_ugn/elaboration_order_handling_in_gnat doc}@anchor{22c}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id1}@anchor{22d} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-order-handling-in-gnat}@anchor{f}@anchor{gnat_ugn/elaboration_order_handling_in_gnat doc}@anchor{230}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id1}@anchor{231} @chapter Elaboration Order Handling in GNAT @@ -27037,7 +27093,7 @@ GNAT, either automatically or with explicit programming features. @end menu @node Elaboration Code,Elaboration Order,,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-code}@anchor{22e}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id2}@anchor{22f} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-code}@anchor{232}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id2}@anchor{233} @section Elaboration Code @@ -27179,7 +27235,7 @@ elaborated. @end itemize @node Elaboration Order,Checking the Elaboration Order,Elaboration Code,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-order}@anchor{230}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id3}@anchor{231} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-order}@anchor{234}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id3}@anchor{235} @section Elaboration Order @@ -27329,7 +27385,7 @@ avoids ABE problems should be chosen, however a compiler may not always find such an order due to complications with respect to control and data flow. @node Checking the Elaboration Order,Controlling the Elaboration Order in Ada,Elaboration Order,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id4}@anchor{232}@anchor{gnat_ugn/elaboration_order_handling_in_gnat checking-the-elaboration-order}@anchor{233} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id4}@anchor{236}@anchor{gnat_ugn/elaboration_order_handling_in_gnat checking-the-elaboration-order}@anchor{237} @section Checking the Elaboration Order @@ -27391,7 +27447,7 @@ order. @end itemize @node Controlling the Elaboration Order in Ada,Controlling the Elaboration Order in GNAT,Checking the Elaboration Order,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-the-elaboration-order-in-ada}@anchor{234}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id5}@anchor{235} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-the-elaboration-order-in-ada}@anchor{238}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id5}@anchor{239} @section Controlling the Elaboration Order in Ada @@ -27719,7 +27775,7 @@ is that the program continues to stay in the last state (one or more correct orders exist) even if maintenance changes the bodies of targets. @node Controlling the Elaboration Order in GNAT,Common Elaboration-model Traits,Controlling the Elaboration Order in Ada,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id6}@anchor{236}@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-the-elaboration-order-in-gnat}@anchor{237} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id6}@anchor{23a}@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-the-elaboration-order-in-gnat}@anchor{23b} @section Controlling the Elaboration Order in GNAT @@ -27776,7 +27832,7 @@ effect. @end itemize @node Common Elaboration-model Traits,Dynamic Elaboration Model in GNAT,Controlling the Elaboration Order in GNAT,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat common-elaboration-model-traits}@anchor{238}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id7}@anchor{239} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat common-elaboration-model-traits}@anchor{23c}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id7}@anchor{23d} @section Common Elaboration-model Traits @@ -27845,7 +27901,7 @@ data and control flow. The warnings can be suppressed with compiler switch @code{-gnatws}. @node Dynamic Elaboration Model in GNAT,Static Elaboration Model in GNAT,Common Elaboration-model Traits,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat dynamic-elaboration-model-in-gnat}@anchor{23a}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id8}@anchor{23b} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat dynamic-elaboration-model-in-gnat}@anchor{23e}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id8}@anchor{23f} @section Dynamic Elaboration Model in GNAT @@ -27902,7 +27958,7 @@ is in effect. @end example @node Static Elaboration Model in GNAT,SPARK Elaboration Model in GNAT,Dynamic Elaboration Model in GNAT,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat static-elaboration-model-in-gnat}@anchor{23c}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id9}@anchor{23d} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat static-elaboration-model-in-gnat}@anchor{240}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id9}@anchor{241} @section Static Elaboration Model in GNAT @@ -28045,7 +28101,7 @@ elaborated prior to the body of @code{Static_Model}. @end itemize @node SPARK Elaboration Model in GNAT,Mixing Elaboration Models,Static Elaboration Model in GNAT,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id10}@anchor{23e}@anchor{gnat_ugn/elaboration_order_handling_in_gnat spark-elaboration-model-in-gnat}@anchor{23f} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id10}@anchor{242}@anchor{gnat_ugn/elaboration_order_handling_in_gnat spark-elaboration-model-in-gnat}@anchor{243} @section SPARK Elaboration Model in GNAT @@ -28068,7 +28124,7 @@ external, and compiler switch @code{-gnatd.v} is in effect. @end example @node Mixing Elaboration Models,Elaboration Circularities,SPARK Elaboration Model in GNAT,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat mixing-elaboration-models}@anchor{240}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id11}@anchor{241} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat mixing-elaboration-models}@anchor{244}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id11}@anchor{245} @section Mixing Elaboration Models @@ -28112,7 +28168,7 @@ warning: "y.ads" which has static elaboration checks The warnings can be suppressed by binder switch @code{-ws}. @node Elaboration Circularities,Resolving Elaboration Circularities,Mixing Elaboration Models,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id12}@anchor{242}@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-circularities}@anchor{243} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id12}@anchor{246}@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-circularities}@anchor{247} @section Elaboration Circularities @@ -28171,7 +28227,7 @@ they @emph{with}, must be elaborated prior to @code{Client}. However, @code{Serv @code{Client}, and this leads to a circularity. @node Resolving Elaboration Circularities,Resolving Task Issues,Elaboration Circularities,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id13}@anchor{244}@anchor{gnat_ugn/elaboration_order_handling_in_gnat resolving-elaboration-circularities}@anchor{245} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id13}@anchor{248}@anchor{gnat_ugn/elaboration_order_handling_in_gnat resolving-elaboration-circularities}@anchor{249} @section Resolving Elaboration Circularities @@ -28316,7 +28372,7 @@ run-time checks. @end itemize @node Resolving Task Issues,Elaboration-related Compiler Switches,Resolving Elaboration Circularities,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id14}@anchor{246}@anchor{gnat_ugn/elaboration_order_handling_in_gnat resolving-task-issues}@anchor{247} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id14}@anchor{24a}@anchor{gnat_ugn/elaboration_order_handling_in_gnat resolving-task-issues}@anchor{24b} @section Resolving Task Issues @@ -28612,7 +28668,7 @@ static model will verify that no entry calls take place at elaboration time. @end itemize @node Elaboration-related Compiler Switches,Summary of Procedures for Elaboration Control,Resolving Task Issues,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-related-compiler-switches}@anchor{248}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id15}@anchor{249} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-related-compiler-switches}@anchor{24c}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id15}@anchor{24d} @section Elaboration-related Compiler Switches @@ -28904,7 +28960,7 @@ In the example above, the elaboration of declaration @code{Ptr} is assigned @end table @node Summary of Procedures for Elaboration Control,Inspecting the Chosen Elaboration Order,Elaboration-related Compiler Switches,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat summary-of-procedures-for-elaboration-control}@anchor{24a}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id16}@anchor{24b} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat summary-of-procedures-for-elaboration-control}@anchor{24e}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id16}@anchor{24f} @section Summary of Procedures for Elaboration Control @@ -28949,7 +29005,7 @@ program using the dynamic model by using compiler switch @code{-gnatE}. @end itemize @node Inspecting the Chosen Elaboration Order,,Summary of Procedures for Elaboration Control,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat inspecting-the-chosen-elaboration-order}@anchor{24c}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id17}@anchor{24d} +@anchor{gnat_ugn/elaboration_order_handling_in_gnat inspecting-the-chosen-elaboration-order}@anchor{250}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id17}@anchor{251} @section Inspecting the Chosen Elaboration Order @@ -29086,7 +29142,7 @@ gdbstr (body) @end example @node Inline Assembler,GNU Free Documentation License,Elaboration Order Handling in GNAT,Top -@anchor{gnat_ugn/inline_assembler inline-assembler}@anchor{10}@anchor{gnat_ugn/inline_assembler doc}@anchor{24e}@anchor{gnat_ugn/inline_assembler id1}@anchor{24f} +@anchor{gnat_ugn/inline_assembler inline-assembler}@anchor{10}@anchor{gnat_ugn/inline_assembler doc}@anchor{252}@anchor{gnat_ugn/inline_assembler id1}@anchor{253} @chapter Inline Assembler @@ -29145,7 +29201,7 @@ and with assembly language programming. @end menu @node Basic Assembler Syntax,A Simple Example of Inline Assembler,,Inline Assembler -@anchor{gnat_ugn/inline_assembler id2}@anchor{250}@anchor{gnat_ugn/inline_assembler basic-assembler-syntax}@anchor{251} +@anchor{gnat_ugn/inline_assembler id2}@anchor{254}@anchor{gnat_ugn/inline_assembler basic-assembler-syntax}@anchor{255} @section Basic Assembler Syntax @@ -29261,7 +29317,7 @@ Intel: Destination first; for example @code{mov eax, 4}@w{ } @node A Simple Example of Inline Assembler,Output Variables in Inline Assembler,Basic Assembler Syntax,Inline Assembler -@anchor{gnat_ugn/inline_assembler a-simple-example-of-inline-assembler}@anchor{252}@anchor{gnat_ugn/inline_assembler id3}@anchor{253} +@anchor{gnat_ugn/inline_assembler a-simple-example-of-inline-assembler}@anchor{256}@anchor{gnat_ugn/inline_assembler id3}@anchor{257} @section A Simple Example of Inline Assembler @@ -29410,7 +29466,7 @@ If there are no errors, @code{as} will generate an object file @code{nothing.out}. @node Output Variables in Inline Assembler,Input Variables in Inline Assembler,A Simple Example of Inline Assembler,Inline Assembler -@anchor{gnat_ugn/inline_assembler id4}@anchor{254}@anchor{gnat_ugn/inline_assembler output-variables-in-inline-assembler}@anchor{255} +@anchor{gnat_ugn/inline_assembler id4}@anchor{258}@anchor{gnat_ugn/inline_assembler output-variables-in-inline-assembler}@anchor{259} @section Output Variables in Inline Assembler @@ -29777,7 +29833,7 @@ end Get_Flags_3; @end quotation @node Input Variables in Inline Assembler,Inlining Inline Assembler Code,Output Variables in Inline Assembler,Inline Assembler -@anchor{gnat_ugn/inline_assembler id5}@anchor{256}@anchor{gnat_ugn/inline_assembler input-variables-in-inline-assembler}@anchor{257} +@anchor{gnat_ugn/inline_assembler id5}@anchor{25a}@anchor{gnat_ugn/inline_assembler input-variables-in-inline-assembler}@anchor{25b} @section Input Variables in Inline Assembler @@ -29866,7 +29922,7 @@ _increment__incr.1: @end quotation @node Inlining Inline Assembler Code,Other Asm Functionality,Input Variables in Inline Assembler,Inline Assembler -@anchor{gnat_ugn/inline_assembler id6}@anchor{258}@anchor{gnat_ugn/inline_assembler inlining-inline-assembler-code}@anchor{259} +@anchor{gnat_ugn/inline_assembler id6}@anchor{25c}@anchor{gnat_ugn/inline_assembler inlining-inline-assembler-code}@anchor{25d} @section Inlining Inline Assembler Code @@ -29937,7 +29993,7 @@ movl %esi,%eax thus saving the overhead of stack frame setup and an out-of-line call. @node Other Asm Functionality,,Inlining Inline Assembler Code,Inline Assembler -@anchor{gnat_ugn/inline_assembler other-asm-functionality}@anchor{25a}@anchor{gnat_ugn/inline_assembler id7}@anchor{25b} +@anchor{gnat_ugn/inline_assembler other-asm-functionality}@anchor{25e}@anchor{gnat_ugn/inline_assembler id7}@anchor{25f} @section Other @code{Asm} Functionality @@ -29952,7 +30008,7 @@ and @code{Volatile}, which inhibits unwanted optimizations. @end menu @node The Clobber Parameter,The Volatile Parameter,,Other Asm Functionality -@anchor{gnat_ugn/inline_assembler the-clobber-parameter}@anchor{25c}@anchor{gnat_ugn/inline_assembler id8}@anchor{25d} +@anchor{gnat_ugn/inline_assembler the-clobber-parameter}@anchor{260}@anchor{gnat_ugn/inline_assembler id8}@anchor{261} @subsection The @code{Clobber} Parameter @@ -30016,7 +30072,7 @@ Use 'register' name @code{memory} if you changed a memory location @end itemize @node The Volatile Parameter,,The Clobber Parameter,Other Asm Functionality -@anchor{gnat_ugn/inline_assembler the-volatile-parameter}@anchor{25e}@anchor{gnat_ugn/inline_assembler id9}@anchor{25f} +@anchor{gnat_ugn/inline_assembler the-volatile-parameter}@anchor{262}@anchor{gnat_ugn/inline_assembler id9}@anchor{263} @subsection The @code{Volatile} Parameter @@ -30052,7 +30108,7 @@ to @code{True} only if the compiler's optimizations have created problems. @node GNU Free Documentation License,Index,Inline Assembler,Top -@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license doc}@anchor{260}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{261} +@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license doc}@anchor{264}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{265} @chapter GNU Free Documentation License diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index baba9feef7c..4f5197d82bd 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -330,9 +330,7 @@ procedure Gnatbind is then Output_File_Name_Seen := True; - if Argv'Length = 0 - or else (Argv'Length >= 1 and then Argv (1) = '-') - then + if Argv'Length = 0 or else Argv (1) = '-' then Fail ("output File_Name missing after -o"); else diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 4071bb461e7..608f41fd748 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -2516,6 +2516,108 @@ __gnat_install_handler (void) __gnat_handler_installed = 1; } +#elif defined(__QNX__) + +/***************/ +/* QNX Section */ +/***************/ + +#include <signal.h> +#include <unistd.h> +#include <string.h> +#include "sigtramp.h" + +void +__gnat_map_signal (int sig, + siginfo_t *si ATTRIBUTE_UNUSED, + void *mcontext ATTRIBUTE_UNUSED) +{ + struct Exception_Data *exception; + const char *msg; + + switch(sig) + { + case SIGFPE: + exception = &constraint_error; + msg = "SIGFPE"; + break; + case SIGILL: + exception = &constraint_error; + msg = "SIGILL"; + break; + case SIGSEGV: + exception = &storage_error; + msg = "stack overflow or erroneous memory access"; + break; + case SIGBUS: + exception = &constraint_error; + msg = "SIGBUS"; + break; + default: + exception = &program_error; + msg = "unhandled signal"; + } + + Raise_From_Signal_Handler (exception, msg); +} + +static void +__gnat_error_handler (int sig, siginfo_t *si, void *ucontext) +{ + __gnat_sigtramp (sig, (void *) si, (void *) ucontext, + (__sigtramphandler_t *)&__gnat_map_signal); +} + +/* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */ +/* sigaltstack is currently not supported by QNX7 */ +char __gnat_alternate_stack[0]; + +void +__gnat_install_handler (void) +{ + struct sigaction act; + int err; + + act.sa_handler = __gnat_error_handler; + act.sa_flags = SA_NODEFER | SA_SIGINFO; + sigemptyset (&act.sa_mask); + + /* Do not install handlers if interrupt state is "System" */ + if (__gnat_get_interrupt_state (SIGFPE) != 's') { + err = sigaction (SIGFPE, &act, NULL); + if (err == -1) { + err = errno; + perror ("error while attaching SIGFPE"); + perror (strerror (err)); + } + } + if (__gnat_get_interrupt_state (SIGILL) != 's') { + sigaction (SIGILL, &act, NULL); + if (err == -1) { + err = errno; + perror ("error while attaching SIGFPE"); + perror (strerror (err)); + } + } + if (__gnat_get_interrupt_state (SIGSEGV) != 's') { + sigaction (SIGSEGV, &act, NULL); + if (err == -1) { + err = errno; + perror ("error while attaching SIGFPE"); + perror (strerror (err)); + } + } + if (__gnat_get_interrupt_state (SIGBUS) != 's') { + sigaction (SIGBUS, &act, NULL); + if (err == -1) { + err = errno; + perror ("error while attaching SIGFPE"); + perror (strerror (err)); + } + } + __gnat_handler_installed = 1; +} + #elif defined (__DJGPP__) void @@ -2648,7 +2750,7 @@ __gnat_install_handler (void) #if defined (_WIN32) || defined (__INTERIX) \ || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \ - || defined (__OpenBSD__) || defined (__DragonFly__) + || defined (__OpenBSD__) || defined (__DragonFly__) || defined(__QNX__) #define HAVE_GNAT_INIT_FLOAT diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 7096f7c7431..f97fce782f4 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2224,13 +2224,13 @@ package body Inline is Exit_Lab : Entity_Id := Empty; F : Entity_Id; A : Node_Id; - Lab_Decl : Node_Id; + Lab_Decl : Node_Id := Empty; Lab_Id : Node_Id; New_A : Node_Id; - Num_Ret : Nat := 0; + Num_Ret : Nat := 0; Ret_Type : Entity_Id; - Targ : Node_Id; + Targ : Node_Id := Empty; -- The target of the call. If context is an assignment statement then -- this is the left-hand side of the assignment, else it is a temporary -- to which the return value is assigned prior to rewriting the call. diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 47109b4e3f9..addc9a083c5 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -1567,14 +1567,6 @@ package body Lib.Writ is SCO_Output; end if; - -- Output SPARK cross-reference information if needed - - if Opt.Xref_Active and then GNATprove_Mode then - SPARK_Specific.Collect_SPARK_Xrefs (Sdep_Table => Sdep_Table, - Num_Sdep => Num_Sdep); - SPARK_Specific.Output_SPARK_Xrefs; - end if; - -- Output final blank line and we are done. This final blank line is -- probably junk, but we don't feel like making an incompatible change. diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index 4d221749907..52958328b1e 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -27,8 +27,6 @@ with Einfo; use Einfo; with Nmake; use Nmake; with SPARK_Xrefs; use SPARK_Xrefs; -with GNAT.HTable; - separate (Lib.Xref) package body SPARK_Specific is @@ -59,16 +57,10 @@ package body SPARK_Specific is 's' => True, others => False); - type Entity_Hashed_Range is range 0 .. 255; - -- Size of hash table headers - --------------------- -- Local Variables -- --------------------- - Heap : Entity_Id := Empty; - -- A special entity which denotes the heap object - package Drefs is new Table.Table ( Table_Component_Type => Xref_Entry, Table_Index_Type => Xref_Entry_Number, @@ -81,243 +73,13 @@ package body SPARK_Specific is -- "Heap". These references are added to the regular references when -- computing SPARK cross-references. - ----------------------- - -- Local Subprograms -- - ----------------------- - - procedure Add_SPARK_File (Uspec, Ubody : Unit_Number_Type; Dspec : Nat); - -- Add file and corresponding scopes for unit to the tables - -- SPARK_File_Table and SPARK_Scope_Table. When two units are present - -- for the same compilation unit, as it happens for library-level - -- instantiations of generics, then Ubody is the number of the body - -- unit; otherwise it is No_Unit. - - procedure Add_SPARK_Xrefs; - -- Filter table Xrefs to add all references used in SPARK to the table - -- SPARK_Xref_Table. - - function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range; - -- Hash function for hash table - - -------------------- - -- Add_SPARK_File -- - -------------------- - - procedure Add_SPARK_File (Uspec, Ubody : Unit_Number_Type; Dspec : Nat) is - File : constant Source_File_Index := Source_Index (Uspec); - From : constant Scope_Index := SPARK_Scope_Table.Last + 1; - - Scope_Id : Pos := 1; - - procedure Add_SPARK_Scope (N : Node_Id); - -- Add scope N to the table SPARK_Scope_Table - - procedure Detect_And_Add_SPARK_Scope (N : Node_Id); - -- Call Add_SPARK_Scope on scopes - - --------------------- - -- Add_SPARK_Scope -- - --------------------- - - procedure Add_SPARK_Scope (N : Node_Id) is - E : constant Entity_Id := Defining_Entity (N); - Loc : constant Source_Ptr := Sloc (E); - - -- The character describing the kind of scope is chosen to be the - -- same as the one describing the corresponding entity in cross - -- references, see Xref_Entity_Letters in lib-xrefs.ads - - Typ : Character; - - begin - -- Ignore scopes without a proper location - - if Sloc (N) = No_Location then - return; - end if; - - case Ekind (E) is - when E_Entry - | E_Entry_Family - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Package - | E_Protected_Type - | E_Task_Type - => - Typ := Xref_Entity_Letters (Ekind (E)); - - when E_Function - | E_Procedure - => - -- In SPARK we need to distinguish protected functions and - -- procedures from ordinary subprograms, but there are no - -- special Xref letters for them. Since this distiction is - -- only needed to detect protected calls, we pretend that - -- such calls are entry calls. - - if Ekind (Scope (E)) = E_Protected_Type then - Typ := Xref_Entity_Letters (E_Entry); - else - Typ := Xref_Entity_Letters (Ekind (E)); - end if; - - when E_Package_Body - | E_Protected_Body - | E_Subprogram_Body - | E_Task_Body - => - Typ := Xref_Entity_Letters (Ekind (Unique_Entity (E))); - - when E_Void => - - -- Compilation of prj-attr.adb with -gnatn creates a node with - -- entity E_Void for the package defined at a-charac.ads16:13. - -- ??? TBD - - return; - - when others => - raise Program_Error; - end case; - - -- File_Num and Scope_Num are filled later. From_Xref and To_Xref - -- are filled even later, but are initialized to represent an empty - -- range. - - SPARK_Scope_Table.Append - ((Scope_Name => new String'(Unique_Name (E)), - File_Num => Dspec, - Scope_Num => Scope_Id, - Spec_File_Num => 0, - Spec_Scope_Num => 0, - Line => Nat (Get_Logical_Line_Number (Loc)), - Stype => Typ, - Col => Nat (Get_Column_Number (Loc)), - From_Xref => 1, - To_Xref => 0, - Scope_Entity => E)); - - Scope_Id := Scope_Id + 1; - end Add_SPARK_Scope; - - -------------------------------- - -- Detect_And_Add_SPARK_Scope -- - -------------------------------- - - procedure Detect_And_Add_SPARK_Scope (N : Node_Id) is - begin - -- Entries - - if Nkind_In (N, N_Entry_Body, N_Entry_Declaration) - - -- Packages - - or else Nkind_In (N, N_Package_Body, - N_Package_Declaration) - -- Protected units - - or else Nkind_In (N, N_Protected_Body, - N_Protected_Type_Declaration) - - -- Subprograms - - or else Nkind_In (N, N_Subprogram_Body, - N_Subprogram_Declaration) - - -- Task units - - or else Nkind_In (N, N_Task_Body, - N_Task_Type_Declaration) - then - Add_SPARK_Scope (N); - end if; - end Detect_And_Add_SPARK_Scope; - - procedure Traverse_Scopes is new - Traverse_Compilation_Unit (Detect_And_Add_SPARK_Scope); - - -- Local variables - - File_Name : String_Ptr; - Unit_File_Name : String_Ptr; - - -- Start of processing for Add_SPARK_File - - begin - -- Source file could be inexistant as a result of an error, if option - -- gnatQ is used. - - if File <= No_Source_File then - return; - end if; - - -- Subunits are traversed as part of the top-level unit to which they - -- belong. - - if Nkind (Unit (Cunit (Uspec))) = N_Subunit then - return; - end if; - - Traverse_Scopes (CU => Cunit (Uspec), Inside_Stubs => True); - - -- When two units are present for the same compilation unit, as it - -- happens for library-level instantiations of generics, then add all - -- scopes to the same SPARK file. - - if Ubody /= No_Unit then - Traverse_Scopes (CU => Cunit (Ubody), Inside_Stubs => True); - end if; - - -- Make entry for new file in file table - - Get_Name_String (Reference_Name (File)); - File_Name := new String'(Name_Buffer (1 .. Name_Len)); - - -- For subunits, also retrieve the file name of the unit. Only do so if - -- unit has an associated compilation unit. - - if Present (Cunit (Unit (File))) - and then Nkind (Unit (Cunit (Unit (File)))) = N_Subunit - then - Get_Name_String (Reference_Name (Main_Source_File)); - Unit_File_Name := new String'(Name_Buffer (1 .. Name_Len)); - else - Unit_File_Name := null; - end if; - - SPARK_File_Table.Append ( - (File_Name => File_Name, - Unit_File_Name => Unit_File_Name, - File_Num => Dspec, - From_Scope => From, - To_Scope => SPARK_Scope_Table.Last)); - end Add_SPARK_File; - - --------------------- - -- Add_SPARK_Xrefs -- - --------------------- - - procedure Add_SPARK_Xrefs is - function Entity_Of_Scope (S : Scope_Index) return Entity_Id; - -- Return the entity which maps to the input scope index - - function Get_Entity_Type (E : Entity_Id) return Character; - -- Return a character representing the type of entity - - function Get_Scope_Num (E : Entity_Id) return Nat; - -- Return the scope number associated with the entity E + ------------------------- + -- Iterate_SPARK_Xrefs -- + ------------------------- - function Is_Constant_Object_Without_Variable_Input - (E : Entity_Id) return Boolean; - -- Return True if E is known to have no variable input, as defined in - -- SPARK RM. + procedure Iterate_SPARK_Xrefs is - function Is_Future_Scope_Entity - (E : Entity_Id; - S : Scope_Index) return Boolean; - -- Check whether entity E is in SPARK_Scope_Table at index S or higher + procedure Add_SPARK_Xref (Index : Int; Xref : Xref_Entry); function Is_SPARK_Reference (E : Entity_Id; @@ -329,168 +91,29 @@ package body SPARK_Specific is -- Return whether the entity or reference scope meets requirements for -- being a SPARK scope. - function Lt (Op1 : Natural; Op2 : Natural) return Boolean; - -- Comparison function for Sort call - - procedure Move (From : Natural; To : Natural); - -- Move procedure for Sort call - - procedure Set_Scope_Num (E : Entity_Id; Num : Nat); - -- Associate entity E with the scope number Num - - procedure Update_Scope_Range - (S : Scope_Index; - From : Xref_Index; - To : Xref_Index); - -- Update the scope which maps to S with the new range From .. To - - package Sorting is new GNAT.Heap_Sort_G (Move, Lt); - - No_Scope : constant Nat := 0; - -- Initial scope counter - - package Scopes is new GNAT.HTable.Simple_HTable - (Header_Num => Entity_Hashed_Range, - Element => Nat, - No_Element => No_Scope, - Key => Entity_Id, - Hash => Entity_Hash, - Equal => "="); - -- Package used to build a correspondence between entities and scope - -- numbers used in SPARK cross references. - - Nrefs : Nat := Xrefs.Last; - -- Number of references in table. This value may get reset (reduced) - -- when we eliminate duplicate reference entries as well as references - -- not suitable for local cross-references. - - Nrefs_Add : constant Nat := Drefs.Last; - -- Number of additional references which correspond to dereferences in - -- the source code. - - Rnums : array (0 .. Nrefs + Nrefs_Add) of Nat; - -- This array contains numbers of references in the Xrefs table. This - -- list is sorted in output order. The extra 0'th entry is convenient - -- for the call to sort. When we sort the table, we move the indices in - -- Rnums around, but we do not move the original table entries. - - --------------------- - -- Entity_Of_Scope -- - --------------------- - - function Entity_Of_Scope (S : Scope_Index) return Entity_Id is - begin - return SPARK_Scope_Table.Table (S).Scope_Entity; - end Entity_Of_Scope; - - --------------------- - -- Get_Entity_Type -- - --------------------- - - function Get_Entity_Type (E : Entity_Id) return Character is - begin - case Ekind (E) is - when E_Out_Parameter => return '<'; - when E_In_Out_Parameter => return '='; - when E_In_Parameter => return '>'; - when others => return '*'; - end case; - end Get_Entity_Type; - - ------------------- - -- Get_Scope_Num -- - ------------------- - - function Get_Scope_Num (E : Entity_Id) return Nat renames Scopes.Get; - - ----------------------------------------------- - -- Is_Constant_Object_Without_Variable_Input -- - ----------------------------------------------- - - function Is_Constant_Object_Without_Variable_Input - (E : Entity_Id) return Boolean - is - begin - case Ekind (E) is - - -- A constant is known to have no variable input if its - -- initializing expression is static (a value which is - -- compile-time-known is not guaranteed to have no variable input - -- as defined in the SPARK RM). Otherwise, the constant may or not - -- have variable input. - - when E_Constant => - declare - Decl : Node_Id; - begin - if Present (Full_View (E)) then - Decl := Parent (Full_View (E)); - else - Decl := Parent (E); - end if; - - if Is_Imported (E) then - return False; - else - pragma Assert (Present (Expression (Decl))); - return Is_Static_Expression (Expression (Decl)); - end if; - end; - - when E_In_Parameter - | E_Loop_Parameter - => - return True; - - when others => - return False; - end case; - end Is_Constant_Object_Without_Variable_Input; - - ---------------------------- - -- Is_Future_Scope_Entity -- - ---------------------------- - - function Is_Future_Scope_Entity - (E : Entity_Id; - S : Scope_Index) return Boolean - is - function Is_Past_Scope_Entity return Boolean; - -- Check whether entity E is in SPARK_Scope_Table at index strictly - -- lower than S. - - -------------------------- - -- Is_Past_Scope_Entity -- - -------------------------- - - function Is_Past_Scope_Entity return Boolean is - begin - for Index in SPARK_Scope_Table.First .. S - 1 loop - if SPARK_Scope_Table.Table (Index).Scope_Entity = E then - return True; - end if; - end loop; - - return False; - end Is_Past_Scope_Entity; - - -- Start of processing for Is_Future_Scope_Entity + -------------------- + -- Add_SPARK_Xref -- + -------------------- + procedure Add_SPARK_Xref (Index : Int; Xref : Xref_Entry) is + Ref : Xref_Key renames Xref.Key; begin - for Index in S .. SPARK_Scope_Table.Last loop - if SPARK_Scope_Table.Table (Index).Scope_Entity = E then - return True; - end if; - end loop; + -- Eliminate entries not appropriate for SPARK - -- If this assertion fails, this means that the scope which we are - -- looking for has been treated already, which reveals a problem in - -- the order of cross-references. - - pragma Assert (not Is_Past_Scope_Entity); + if SPARK_Entities (Ekind (Ref.Ent)) + and then SPARK_References (Ref.Typ) + and then Is_SPARK_Scope (Ref.Ent_Scope) + and then Is_SPARK_Scope (Ref.Ref_Scope) + and then Is_SPARK_Reference (Ref.Ent, Ref.Typ) + then + Process + (Index, + (Entity => Ref.Ent, + Ref_Scope => Ref.Ref_Scope, + Rtype => Ref.Typ)); + end if; - return False; - end Is_Future_Scope_Entity; + end Add_SPARK_Xref; ------------------------ -- Is_SPARK_Reference -- @@ -528,525 +151,22 @@ package body SPARK_Specific is begin return Present (E) and then not Is_Generic_Unit (E) - and then (not Can_Be_Renamed or else No (Renamed_Entity (E))) - and then Get_Scope_Num (E) /= No_Scope; + and then (not Can_Be_Renamed or else No (Renamed_Entity (E))); end Is_SPARK_Scope; - -------- - -- Lt -- - -------- - - function Lt (Op1 : Natural; Op2 : Natural) return Boolean is - T1 : constant Xref_Entry := Xrefs.Table (Rnums (Nat (Op1))); - T2 : constant Xref_Entry := Xrefs.Table (Rnums (Nat (Op2))); - - begin - -- First test: if entity is in different unit, sort by unit. Note: - -- that we use Ent_Scope_File rather than Eun, as Eun may refer to - -- the file where the generic scope is defined, which may differ from - -- the file where the enclosing scope is defined. It is the latter - -- which matters for a correct order here. - - if T1.Ent_Scope_File /= T2.Ent_Scope_File then - return Dependency_Num (T1.Ent_Scope_File) < - Dependency_Num (T2.Ent_Scope_File); - - -- Second test: within same unit, sort by location of the scope of - -- the entity definition. - - elsif Get_Scope_Num (T1.Key.Ent_Scope) /= - Get_Scope_Num (T2.Key.Ent_Scope) - then - return Get_Scope_Num (T1.Key.Ent_Scope) < - Get_Scope_Num (T2.Key.Ent_Scope); - - -- Third test: within same unit and scope, sort by location of - -- entity definition. - - elsif T1.Def /= T2.Def then - return T1.Def < T2.Def; - - else - -- Both entities must be equal at this point - - pragma Assert (T1.Key.Ent = T2.Key.Ent); - pragma Assert (T1.Key.Ent_Scope = T2.Key.Ent_Scope); - pragma Assert (T1.Ent_Scope_File = T2.Ent_Scope_File); - - -- Fourth test: if reference is in same unit as entity definition, - -- sort first. - - if T1.Key.Lun /= T2.Key.Lun - and then T1.Ent_Scope_File = T1.Key.Lun - then - return True; - - elsif T1.Key.Lun /= T2.Key.Lun - and then T2.Ent_Scope_File = T2.Key.Lun - then - return False; - - -- Fifth test: if reference is in same unit and same scope as - -- entity definition, sort first. - - elsif T1.Ent_Scope_File = T1.Key.Lun - and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope - and then T1.Key.Ent_Scope = T1.Key.Ref_Scope - then - return True; - - elsif T2.Ent_Scope_File = T2.Key.Lun - and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope - and then T2.Key.Ent_Scope = T2.Key.Ref_Scope - then - return False; - - -- Sixth test: for same entity, sort by reference location unit - - elsif T1.Key.Lun /= T2.Key.Lun then - return Dependency_Num (T1.Key.Lun) < - Dependency_Num (T2.Key.Lun); - - -- Seventh test: for same entity, sort by reference location scope - - elsif Get_Scope_Num (T1.Key.Ref_Scope) /= - Get_Scope_Num (T2.Key.Ref_Scope) - then - return Get_Scope_Num (T1.Key.Ref_Scope) < - Get_Scope_Num (T2.Key.Ref_Scope); - - -- Eighth test: order of location within referencing unit - - elsif T1.Key.Loc /= T2.Key.Loc then - return T1.Key.Loc < T2.Key.Loc; - - -- Finally, for two locations at the same address prefer the one - -- that does NOT have the type 'r', so that a modification or - -- extension takes preference, when there are more than one - -- reference at the same location. As a result, in the case of - -- entities that are in-out actuals, the read reference follows - -- the modify reference. - - else - return T2.Key.Typ = 'r'; - end if; - end if; - end Lt; - - ---------- - -- Move -- - ---------- - - procedure Move (From : Natural; To : Natural) is - begin - Rnums (Nat (To)) := Rnums (Nat (From)); - end Move; - - ------------------- - -- Set_Scope_Num -- - ------------------- - - procedure Set_Scope_Num (E : Entity_Id; Num : Nat) renames Scopes.Set; - - ------------------------ - -- Update_Scope_Range -- - ------------------------ - - procedure Update_Scope_Range - (S : Scope_Index; - From : Xref_Index; - To : Xref_Index) - is - begin - SPARK_Scope_Table.Table (S).From_Xref := From; - SPARK_Scope_Table.Table (S).To_Xref := To; - end Update_Scope_Range; - - -- Local variables - - Col : Nat; - From_Index : Xref_Index; - Line : Nat; - Prev_Loc : Source_Ptr; - Prev_Typ : Character; - Ref_Count : Nat; - Ref_Id : Entity_Id; - Ref_Name : String_Ptr; - Scope_Id : Scope_Index; - -- Start of processing for Add_SPARK_Xrefs begin - for Index in SPARK_Scope_Table.First .. SPARK_Scope_Table.Last loop - declare - S : SPARK_Scope_Record renames SPARK_Scope_Table.Table (Index); - begin - Set_Scope_Num (S.Scope_Entity, S.Scope_Num); - end; - end loop; - - declare - Drefs_Table : Drefs.Table_Type - renames Drefs.Table (Drefs.First .. Drefs.Last); - begin - Xrefs.Append_All (Xrefs.Table_Type (Drefs_Table)); - Nrefs := Nrefs + Drefs_Table'Length; - end; - - -- Capture the definition Sloc values. As in the case of normal cross - -- references, we have to wait until now to get the correct value. - - for Index in 1 .. Nrefs loop - Xrefs.Table (Index).Def := Sloc (Xrefs.Table (Index).Key.Ent); - end loop; - - -- Eliminate entries not appropriate for SPARK. Done prior to sorting - -- cross-references, as it discards useless references which do not have - -- a proper format for the comparison function (like no location). - - Ref_Count := Nrefs; - Nrefs := 0; + -- Expose cross-references from private frontend tables to the backend - for Index in 1 .. Ref_Count loop - declare - Ref : Xref_Key renames Xrefs.Table (Index).Key; - - begin - if SPARK_Entities (Ekind (Ref.Ent)) - and then SPARK_References (Ref.Typ) - and then Is_SPARK_Scope (Ref.Ent_Scope) - and then Is_SPARK_Scope (Ref.Ref_Scope) - and then Is_SPARK_Reference (Ref.Ent, Ref.Typ) - - -- Discard references from unknown scopes, e.g. generic scopes - - and then Get_Scope_Num (Ref.Ent_Scope) /= No_Scope - and then Get_Scope_Num (Ref.Ref_Scope) /= No_Scope - - -- Discard references to loop parameters introduced within - -- expression functions, as they give two references: one from - -- the analysis of the expression function itself and one from - -- the analysis of the expanded body. We don't lose any globals - -- by discarding them, because such loop parameters can only be - -- accessed locally from within the expression function body. - - and then not - (Ekind (Ref.Ent) = E_Loop_Parameter - and then Scope_Within - (Ref.Ent, Unique_Entity (Ref.Ref_Scope)) - and then Is_Expression_Function (Ref.Ref_Scope)) - then - Nrefs := Nrefs + 1; - Rnums (Nrefs) := Index; - end if; - end; + for Index in Drefs.First .. Drefs.Last loop + Add_SPARK_Xref (Index, Drefs.Table (Index)); end loop; - -- Sort the references - - Sorting.Sort (Integer (Nrefs)); - - -- Eliminate duplicate entries - - -- We need this test for Ref_Count because if we force ALI file - -- generation in case of errors detected, it may be the case that - -- Nrefs is 0, so we should not reset it here. - - if Nrefs >= 2 then - Ref_Count := Nrefs; - Nrefs := 1; - - for Index in 2 .. Ref_Count loop - if Xrefs.Table (Rnums (Index)) /= Xrefs.Table (Rnums (Nrefs)) then - Nrefs := Nrefs + 1; - Rnums (Nrefs) := Rnums (Index); - end if; - end loop; - end if; - - -- Eliminate the reference if it is at the same location as the previous - -- one, unless it is a read-reference indicating that the entity is an - -- in-out actual in a call. - - Ref_Count := Nrefs; - Nrefs := 0; - Prev_Loc := No_Location; - Prev_Typ := 'm'; - - for Index in 1 .. Ref_Count loop - declare - Ref : Xref_Key renames Xrefs.Table (Rnums (Index)).Key; - - begin - if Ref.Loc /= Prev_Loc - or else (Prev_Typ = 'm' and then Ref.Typ = 'r') - then - Prev_Loc := Ref.Loc; - Prev_Typ := Ref.Typ; - Nrefs := Nrefs + 1; - Rnums (Nrefs) := Rnums (Index); - end if; - end; + for Index in Xrefs.First .. Xrefs.Last loop + Add_SPARK_Xref (-Index, Xrefs.Table (Index)); end loop; - - -- The two steps have eliminated all references, nothing to do - - if SPARK_Scope_Table.Last = 0 then - return; - end if; - - Ref_Id := Empty; - Scope_Id := 1; - From_Index := 1; - - -- Loop to output references - - for Refno in 1 .. Nrefs loop - declare - Ref_Entry : Xref_Entry renames Xrefs.Table (Rnums (Refno)); - Ref : Xref_Key renames Ref_Entry.Key; - Typ : Character; - - begin - -- If this assertion fails, the scope which we are looking for is - -- not in SPARK scope table, which reveals either a problem in the - -- construction of the scope table, or an erroneous scope for the - -- current cross-reference. - - pragma Assert (Is_Future_Scope_Entity (Ref.Ent_Scope, Scope_Id)); - - -- Update the range of cross references to which the current scope - -- refers to. This may be the empty range only for the first scope - -- considered. - - if Ref.Ent_Scope /= Entity_Of_Scope (Scope_Id) then - Update_Scope_Range - (S => Scope_Id, - From => From_Index, - To => SPARK_Xref_Table.Last); - - From_Index := SPARK_Xref_Table.Last + 1; - end if; - - while Ref.Ent_Scope /= Entity_Of_Scope (Scope_Id) loop - Scope_Id := Scope_Id + 1; - pragma Assert (Scope_Id <= SPARK_Scope_Table.Last); - end loop; - - if Ref.Ent /= Ref_Id then - Ref_Name := new String'(Unique_Name (Ref.Ent)); - end if; - - if Ref.Ent = Heap then - Line := 0; - Col := 0; - else - Line := Nat (Get_Logical_Line_Number (Ref_Entry.Def)); - Col := Nat (Get_Column_Number (Ref_Entry.Def)); - end if; - - -- References to constant objects without variable inputs (see - -- SPARK RM 3.3.1) are considered specially in SPARK section, - -- because these will be translated as constants in the - -- intermediate language for formal verification, and should - -- therefore never appear in frame conditions. Other constants may - -- later be treated the same, up to GNATprove to decide based on - -- its flow analysis. - - if Is_Constant_Object_Without_Variable_Input (Ref.Ent) then - Typ := 'c'; - else - Typ := Ref.Typ; - end if; - - SPARK_Xref_Table.Append ( - (Entity_Name => Ref_Name, - Entity_Line => Line, - Etype => Get_Entity_Type (Ref.Ent), - Entity_Col => Col, - File_Num => Dependency_Num (Ref.Lun), - Scope_Num => Get_Scope_Num (Ref.Ref_Scope), - Line => Nat (Get_Logical_Line_Number (Ref.Loc)), - Rtype => Typ, - Col => Nat (Get_Column_Number (Ref.Loc)))); - end; - end loop; - - -- Update the range of cross references to which the scope refers to - - Update_Scope_Range - (S => Scope_Id, - From => From_Index, - To => SPARK_Xref_Table.Last); - end Add_SPARK_Xrefs; - - ------------------------- - -- Collect_SPARK_Xrefs -- - ------------------------- - - procedure Collect_SPARK_Xrefs - (Sdep_Table : Unit_Ref_Table; - Num_Sdep : Nat) - is - Sdep : Pos; - Sdep_Next : Pos; - -- Index of the current and next source dependency - - Sdep_File : Pos; - -- Index of the file to which the scopes need to be assigned; for - -- library-level instances of generic units this points to the unit - -- of the body, because this is where references are assigned to. - - Ubody : Unit_Number_Type; - Uspec : Unit_Number_Type; - -- Unit numbers for the dependency spec and possibly its body (only in - -- the case of library-level instance of a generic package). - - begin - -- Cross-references should have been computed first - - pragma Assert (Xrefs.Last /= 0); - - Initialize_SPARK_Tables; - - -- Generate file and scope SPARK cross-reference information - - Sdep := 1; - while Sdep <= Num_Sdep loop - - -- Skip dependencies with no entity node, e.g. configuration files - -- with pragmas (.adc) or target description (.atp), since they - -- present no interest for SPARK cross references. - - if No (Cunit_Entity (Sdep_Table (Sdep))) then - Sdep_Next := Sdep + 1; - - -- For library-level instantiation of a generic, two consecutive - -- units refer to the same compilation unit node and entity (one to - -- body, one to spec). In that case, treat them as a single unit for - -- the sake of SPARK cross references by passing to Add_SPARK_File. - - else - if Sdep < Num_Sdep - and then Cunit_Entity (Sdep_Table (Sdep)) = - Cunit_Entity (Sdep_Table (Sdep + 1)) - then - declare - Cunit1 : Node_Id renames Cunit (Sdep_Table (Sdep)); - Cunit2 : Node_Id renames Cunit (Sdep_Table (Sdep + 1)); - - begin - -- Both Cunits point to compilation unit nodes - - pragma Assert - (Nkind (Cunit1) = N_Compilation_Unit - and then Nkind (Cunit2) = N_Compilation_Unit); - - -- Do not depend on the sorting order, which is based on - -- Unit_Name, and for library-level instances of nested - -- generic packages they are equal. - - -- If declaration comes before the body - - if Nkind (Unit (Cunit1)) = N_Package_Declaration - and then Nkind (Unit (Cunit2)) = N_Package_Body - then - Uspec := Sdep_Table (Sdep); - Ubody := Sdep_Table (Sdep + 1); - - Sdep_File := Sdep + 1; - - -- If body comes before declaration - - elsif Nkind (Unit (Cunit1)) = N_Package_Body - and then Nkind (Unit (Cunit2)) = N_Package_Declaration - then - Uspec := Sdep_Table (Sdep + 1); - Ubody := Sdep_Table (Sdep); - - Sdep_File := Sdep; - - -- Otherwise it is an error - - else - raise Program_Error; - end if; - - Sdep_Next := Sdep + 2; - end; - - -- ??? otherwise? - - else - Uspec := Sdep_Table (Sdep); - Ubody := No_Unit; - - Sdep_File := Sdep; - Sdep_Next := Sdep + 1; - end if; - - Add_SPARK_File - (Uspec => Uspec, - Ubody => Ubody, - Dspec => Sdep_File); - end if; - - Sdep := Sdep_Next; - end loop; - - -- Fill in the spec information when relevant - - declare - package Entity_Hash_Table is new - GNAT.HTable.Simple_HTable - (Header_Num => Entity_Hashed_Range, - Element => Scope_Index, - No_Element => 0, - Key => Entity_Id, - Hash => Entity_Hash, - Equal => "="); - - begin - -- Fill in the hash-table - - for S in SPARK_Scope_Table.First .. SPARK_Scope_Table.Last loop - declare - Srec : SPARK_Scope_Record renames SPARK_Scope_Table.Table (S); - begin - Entity_Hash_Table.Set (Srec.Scope_Entity, S); - end; - end loop; - - -- Use the hash-table to locate spec entities - - for S in SPARK_Scope_Table.First .. SPARK_Scope_Table.Last loop - declare - Srec : SPARK_Scope_Record renames SPARK_Scope_Table.Table (S); - - Spec_Entity : constant Entity_Id := - Unique_Entity (Srec.Scope_Entity); - Spec_Scope : constant Scope_Index := - Entity_Hash_Table.Get (Spec_Entity); - - begin - -- Generic spec may be missing in which case Spec_Scope is zero - - if Spec_Entity /= Srec.Scope_Entity - and then Spec_Scope /= 0 - then - Srec.Spec_File_Num := - SPARK_Scope_Table.Table (Spec_Scope).File_Num; - Srec.Spec_Scope_Num := - SPARK_Scope_Table.Table (Spec_Scope).Scope_Num; - end if; - end; - end loop; - end; - - -- Generate SPARK cross-reference information - - Add_SPARK_Xrefs; - end Collect_SPARK_Xrefs; + end Iterate_SPARK_Xrefs; ------------------------------------- -- Enclosing_Subprogram_Or_Package -- @@ -1143,16 +263,6 @@ package body SPARK_Specific is return Context; end Enclosing_Subprogram_Or_Library_Package; - ----------------- - -- Entity_Hash -- - ----------------- - - function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range is - begin - return - Entity_Hashed_Range (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1)); - end Entity_Hash; - -------------------------- -- Generate_Dereference -- -------------------------- @@ -1221,332 +331,4 @@ package body SPARK_Specific is end if; end Generate_Dereference; - ------------------------------- - -- Traverse_Compilation_Unit -- - ------------------------------- - - procedure Traverse_Compilation_Unit - (CU : Node_Id; - Inside_Stubs : Boolean) - is - procedure Traverse_Block (N : Node_Id); - procedure Traverse_Declaration_Or_Statement (N : Node_Id); - procedure Traverse_Declarations_And_HSS (N : Node_Id); - procedure Traverse_Declarations_Or_Statements (L : List_Id); - procedure Traverse_Handled_Statement_Sequence (N : Node_Id); - procedure Traverse_Package_Body (N : Node_Id); - procedure Traverse_Visible_And_Private_Parts (N : Node_Id); - procedure Traverse_Protected_Body (N : Node_Id); - procedure Traverse_Subprogram_Body (N : Node_Id); - procedure Traverse_Task_Body (N : Node_Id); - - -- Traverse corresponding construct, calling Process on all declarations - - -------------------- - -- Traverse_Block -- - -------------------- - - procedure Traverse_Block (N : Node_Id) renames - Traverse_Declarations_And_HSS; - - --------------------------------------- - -- Traverse_Declaration_Or_Statement -- - --------------------------------------- - - procedure Traverse_Declaration_Or_Statement (N : Node_Id) is - function Traverse_Stub (N : Node_Id) return Boolean; - -- Returns True iff stub N should be traversed - - function Traverse_Stub (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind_In (N, N_Package_Body_Stub, - N_Protected_Body_Stub, - N_Subprogram_Body_Stub, - N_Task_Body_Stub)); - - return Inside_Stubs and then Present (Library_Unit (N)); - end Traverse_Stub; - - -- Start of processing for Traverse_Declaration_Or_Statement - - begin - case Nkind (N) is - when N_Package_Declaration => - Traverse_Visible_And_Private_Parts (Specification (N)); - - when N_Package_Body => - Traverse_Package_Body (N); - - when N_Package_Body_Stub => - if Traverse_Stub (N) then - Traverse_Package_Body (Get_Body_From_Stub (N)); - end if; - - when N_Subprogram_Body => - Traverse_Subprogram_Body (N); - - when N_Entry_Body => - Traverse_Subprogram_Body (N); - - when N_Subprogram_Body_Stub => - if Traverse_Stub (N) then - Traverse_Subprogram_Body (Get_Body_From_Stub (N)); - end if; - - when N_Protected_Body => - Traverse_Protected_Body (N); - - when N_Protected_Body_Stub => - if Traverse_Stub (N) then - Traverse_Protected_Body (Get_Body_From_Stub (N)); - end if; - - when N_Protected_Type_Declaration => - Traverse_Visible_And_Private_Parts (Protected_Definition (N)); - - when N_Task_Type_Declaration => - - -- Task type definition is optional (unlike protected type - -- definition, which is mandatory). - - declare - Task_Def : constant Node_Id := Task_Definition (N); - begin - if Present (Task_Def) then - Traverse_Visible_And_Private_Parts (Task_Def); - end if; - end; - - when N_Task_Body => - Traverse_Task_Body (N); - - when N_Task_Body_Stub => - if Traverse_Stub (N) then - Traverse_Task_Body (Get_Body_From_Stub (N)); - end if; - - when N_Block_Statement => - Traverse_Block (N); - - when N_If_Statement => - - -- Traverse the statements in the THEN part - - Traverse_Declarations_Or_Statements (Then_Statements (N)); - - -- Loop through ELSIF parts if present - - if Present (Elsif_Parts (N)) then - declare - Elif : Node_Id := First (Elsif_Parts (N)); - - begin - while Present (Elif) loop - Traverse_Declarations_Or_Statements - (Then_Statements (Elif)); - Next (Elif); - end loop; - end; - end if; - - -- Finally traverse the ELSE statements if present - - Traverse_Declarations_Or_Statements (Else_Statements (N)); - - when N_Case_Statement => - - -- Process case branches - - declare - Alt : Node_Id := First (Alternatives (N)); - begin - loop - Traverse_Declarations_Or_Statements (Statements (Alt)); - Next (Alt); - exit when No (Alt); - end loop; - end; - - when N_Extended_Return_Statement => - Traverse_Handled_Statement_Sequence - (Handled_Statement_Sequence (N)); - - when N_Loop_Statement => - Traverse_Declarations_Or_Statements (Statements (N)); - - -- Generic declarations are ignored - - when others => - null; - end case; - end Traverse_Declaration_Or_Statement; - - ----------------------------------- - -- Traverse_Declarations_And_HSS -- - ----------------------------------- - - procedure Traverse_Declarations_And_HSS (N : Node_Id) is - begin - Traverse_Declarations_Or_Statements (Declarations (N)); - Traverse_Handled_Statement_Sequence (Handled_Statement_Sequence (N)); - end Traverse_Declarations_And_HSS; - - ----------------------------------------- - -- Traverse_Declarations_Or_Statements -- - ----------------------------------------- - - procedure Traverse_Declarations_Or_Statements (L : List_Id) is - N : Node_Id; - - begin - -- Loop through statements or declarations - - N := First (L); - while Present (N) loop - - -- Call Process on all declarations - - if Nkind (N) in N_Declaration - or else Nkind (N) in N_Later_Decl_Item - or else Nkind (N) = N_Entry_Body - then - if Nkind (N) in N_Body_Stub then - Process (Get_Body_From_Stub (N)); - else - Process (N); - end if; - end if; - - Traverse_Declaration_Or_Statement (N); - - Next (N); - end loop; - end Traverse_Declarations_Or_Statements; - - ----------------------------------------- - -- Traverse_Handled_Statement_Sequence -- - ----------------------------------------- - - procedure Traverse_Handled_Statement_Sequence (N : Node_Id) is - Handler : Node_Id; - - begin - if Present (N) then - Traverse_Declarations_Or_Statements (Statements (N)); - - if Present (Exception_Handlers (N)) then - Handler := First (Exception_Handlers (N)); - while Present (Handler) loop - Traverse_Declarations_Or_Statements (Statements (Handler)); - Next (Handler); - end loop; - end if; - end if; - end Traverse_Handled_Statement_Sequence; - - --------------------------- - -- Traverse_Package_Body -- - --------------------------- - - procedure Traverse_Package_Body (N : Node_Id) is - Spec_E : constant Entity_Id := Unique_Defining_Entity (N); - - begin - case Ekind (Spec_E) is - when E_Package => - Traverse_Declarations_And_HSS (N); - - when E_Generic_Package => - null; - - when others => - raise Program_Error; - end case; - end Traverse_Package_Body; - - ----------------------------- - -- Traverse_Protected_Body -- - ----------------------------- - - procedure Traverse_Protected_Body (N : Node_Id) is - begin - Traverse_Declarations_Or_Statements (Declarations (N)); - end Traverse_Protected_Body; - - ------------------------------ - -- Traverse_Subprogram_Body -- - ------------------------------ - - procedure Traverse_Subprogram_Body (N : Node_Id) is - Spec_E : constant Entity_Id := Unique_Defining_Entity (N); - - begin - case Ekind (Spec_E) is - when Entry_Kind - | E_Function - | E_Procedure - => - Traverse_Declarations_And_HSS (N); - - when Generic_Subprogram_Kind => - null; - - when others => - raise Program_Error; - end case; - end Traverse_Subprogram_Body; - - ------------------------ - -- Traverse_Task_Body -- - ------------------------ - - procedure Traverse_Task_Body (N : Node_Id) renames - Traverse_Declarations_And_HSS; - - ---------------------------------------- - -- Traverse_Visible_And_Private_Parts -- - ---------------------------------------- - - procedure Traverse_Visible_And_Private_Parts (N : Node_Id) is - begin - Traverse_Declarations_Or_Statements (Visible_Declarations (N)); - Traverse_Declarations_Or_Statements (Private_Declarations (N)); - end Traverse_Visible_And_Private_Parts; - - -- Local variables - - Lu : Node_Id; - - -- Start of processing for Traverse_Compilation_Unit - - begin - -- Get Unit (checking case of subunit) - - Lu := Unit (CU); - - if Nkind (Lu) = N_Subunit then - Lu := Proper_Body (Lu); - end if; - - -- Do not add scopes for generic units - - if Nkind (Lu) = N_Package_Body - and then Ekind (Corresponding_Spec (Lu)) in Generic_Unit_Kind - then - return; - end if; - - -- Call Process on all declarations - - if Nkind (Lu) in N_Declaration - or else Nkind (Lu) in N_Later_Decl_Item - then - Process (Lu); - end if; - - -- Traverse the unit - - Traverse_Declaration_Or_Statement (Lu); - end Traverse_Compilation_Unit; - end SPARK_Specific; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index eb6ac0a629f..513d5924126 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -27,6 +27,7 @@ with Atree; use Atree; with Csets; use Csets; with Elists; use Elists; with Errout; use Errout; +with Lib.Util; use Lib.Util; with Nlists; use Nlists; with Opt; use Opt; with Restrict; use Restrict; diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index d4216396c9c..0baa896253e 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -26,9 +26,8 @@ -- This package contains for collecting and outputting cross-reference -- information. -with Einfo; use Einfo; -with Lib.Util; use Lib.Util; -with Put_SPARK_Xrefs; +with Einfo; use Einfo; +with SPARK_Xrefs; package Lib.Xref is @@ -640,26 +639,15 @@ package Lib.Xref is -- This procedure is called to record a dereference. N is the location -- of the dereference. - procedure Collect_SPARK_Xrefs - (Sdep_Table : Unit_Ref_Table; - Num_Sdep : Nat); - -- Collect SPARK cross-reference information from library units (for - -- files and scopes) and from shared cross-references. Fill in the - -- tables in library package called SPARK_Xrefs. - - procedure Output_SPARK_Xrefs is new Put_SPARK_Xrefs; - -- Output SPARK cross-reference information to the ALI files, based on - -- the information collected in the tables in library package called - -- SPARK_Xrefs, and using routines in Lib.Util. - generic - with procedure Process (N : Node_Id) is <>; - procedure Traverse_Compilation_Unit - (CU : Node_Id; - Inside_Stubs : Boolean); - -- Call Process on all declarations within compilation unit CU. If - -- Inside_Stubs is True, then the body of stubs is also traversed. - -- Generic declarations are ignored. + with procedure Process + (Index : Int; + Xref : SPARK_Xrefs.SPARK_Xref_Record); + procedure Iterate_SPARK_Xrefs; + -- Call Process on cross-references relevant to the SPARK backend with + -- parameter Xref holding the relevant subset of the xref entry and + -- Index holding the position in the original tables with references + -- (if positive) or dereferences (if negative). end SPARK_Specific; diff --git a/gcc/ada/libgnarl/a-intnam__qnx.ads b/gcc/ada/libgnarl/a-intnam__qnx.ads new file mode 100644 index 00000000000..ab45b381863 --- /dev/null +++ b/gcc/ada/libgnarl/a-intnam__qnx.ads @@ -0,0 +1,146 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1991-2017, 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 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a QNX version of this package + +-- The pragma Unreserve_All_Interrupts affects the following signal(s): + +-- SIGINT: made available for Ada handler + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; + +package Ada.Interrupts.Names is + + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + + -- Beware that the mapping of names to signals may be many-to-one. There + -- may be aliases. Also, for all signal names that are not supported on the + -- current system the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + +end Ada.Interrupts.Names; diff --git a/gcc/ada/libgnarl/g-thread.adb b/gcc/ada/libgnarl/g-thread.adb index 90d51afb8c9..59c444b1f9e 100644 --- a/gcc/ada/libgnarl/g-thread.adb +++ b/gcc/ada/libgnarl/g-thread.adb @@ -33,6 +33,7 @@ with Ada.Task_Identification; use Ada.Task_Identification; with System.Task_Primitives.Operations; with System.Tasking; with System.Tasking.Stages; use System.Tasking.Stages; +with System.Tasking.Utilities; with System.OS_Interface; use System.OS_Interface; with System.Soft_Links; use System.Soft_Links; with Ada.Unchecked_Conversion; @@ -172,6 +173,15 @@ package body GNAT.Threads is Thr.all := Task_Primitives.Operations.Get_Thread_Id (To_Id (Id)); end Get_Thread; + ---------------------- + -- Make_Independent -- + ---------------------- + + function Make_Independent return Boolean is + begin + return System.Tasking.Utilities.Make_Independent; + end Make_Independent; + ---------------- -- To_Task_Id -- ---------------- diff --git a/gcc/ada/libgnarl/g-thread.ads b/gcc/ada/libgnarl/g-thread.ads index e2fd748dc1d..027b7c2f747 100644 --- a/gcc/ada/libgnarl/g-thread.ads +++ b/gcc/ada/libgnarl/g-thread.ads @@ -146,4 +146,15 @@ package GNAT.Threads is -- Given a low level Id, as returned by Create_Thread, return a Task_Id, -- so that operations in Ada.Task_Identification can be used. + function Make_Independent return Boolean; + -- If a procedure loads a shared library containing tasks, and that + -- procedure is considered to be a master by the compiler (because it + -- contains tasks or class-wide objects that might contain tasks), + -- then the tasks in the shared library need to call Make_Independent + -- because otherwise they will depend on the procedure that loaded the + -- shared library. + -- + -- See System.Tasking.Utilities.Make_Independent in s-tasuti.ads for + -- further documentation. + end GNAT.Threads; diff --git a/gcc/ada/libgnarl/s-intman__qnx.adb b/gcc/ada/libgnarl/s-intman__qnx.adb new file mode 100644 index 00000000000..ae33d69fae3 --- /dev/null +++ b/gcc/ada/libgnarl/s-intman__qnx.adb @@ -0,0 +1,298 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2017, 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 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the QNX/Neutrino threads version of this package + +-- Make a careful study of all signals available under the OS, to see which +-- need to be reserved, kept always unmasked, or kept always unmasked. Be on +-- the lookout for special signals that may be used by the thread library. + +-- Since this is a multi target file, the signal <-> exception mapping +-- is simple minded. If you need a more precise and target specific +-- signal handling, create a new s-intman.adb that will fit your needs. + +-- This file assumes that: + +-- SIGFPE, SIGILL, SIGSEGV and SIGBUS exist. They are mapped as follows: +-- SIGPFE => Constraint_Error +-- SIGILL => Program_Error +-- SIGSEGV => Storage_Error +-- SIGBUS => Storage_Error + +-- SIGINT exists and will be kept unmasked unless the pragma +-- Unreserve_All_Interrupts is specified anywhere in the application. + +-- System.OS_Interface contains the following: +-- SIGADAABORT: the signal that will be used to abort tasks. +-- Unmasked: the OS specific set of signals that should be unmasked in +-- all the threads. SIGADAABORT is unmasked by +-- default +-- Reserved: the OS specific set of signals that are reserved. + +with System.Task_Primitives; + +package body System.Interrupt_Management is + + use Interfaces.C; + use System.OS_Interface; + + type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID; + Exception_Interrupts : constant Interrupt_List := + (SIGFPE, SIGILL, SIGSEGV, SIGBUS); + + Unreserve_All_Interrupts : Interfaces.C.int; + pragma Import + (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts"); + + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Signal_Trampoline + (signo : Signal; + siginfo : System.Address; + ucontext : System.Address; + handler : System.Address); + pragma Import (C, Signal_Trampoline, "__gnat_sigtramp"); + -- Pass the real handler to a speical function that handles unwinding by + -- skipping over the kernel signal frame (which doesn't contain any unwind + -- information). + + procedure Map_Signal + (signo : Signal; + siginfo : System.Address; + ucontext : System.Address); + pragma Import (C, Map_Signal, "__gnat_map_signal"); + + function State (Int : Interrupt_ID) return Character; + pragma Import (C, State, "__gnat_get_interrupt_state"); + -- Get interrupt state. Defined in init.c The input argument is the + -- interrupt number, and the result is one of the following: + + User : constant Character := 'u'; + Runtime : constant Character := 'r'; + Default : constant Character := 's'; + -- 'n' this interrupt not set by any Interrupt_State pragma + -- 'u' Interrupt_State pragma set state to User + -- 'r' Interrupt_State pragma set state to Runtime + -- 's' Interrupt_State pragma set state to System (use "default" + -- system handler) + + procedure Notify_Exception + (signo : Signal; + siginfo : System.Address; + ucontext : System.Address); + -- This function identifies the Ada exception to be raised using the + -- information when the system received a synchronous signal. Since this + -- function is machine and OS dependent, different code has to be provided + -- for different target. + + ---------------------- + -- Notify_Exception -- + ---------------------- + + Signal_Mask : aliased sigset_t; + -- The set of signals handled by Notify_Exception + + procedure Notify_Exception + (signo : Signal; + siginfo : System.Address; + ucontext : System.Address) + is + Result : Interfaces.C.int; + + begin + -- With the __builtin_longjmp, the signal mask is not restored, so we + -- need to restore it explicitly. + + Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null); + pragma Assert (Result = 0); + + -- Perform the necessary context adjustments prior to a raise + -- from a signal handler. + + Adjust_Context_For_Raise (signo, ucontext); + + -- Check that treatment of exception propagation here is consistent with + -- treatment of the abort signal in System.Task_Primitives.Operations. + + Signal_Trampoline (signo, siginfo, ucontext, Map_Signal'Address); + end Notify_Exception; + + ---------------- + -- Initialize -- + ---------------- + + Initialized : Boolean := False; + + procedure Initialize is + act : aliased struct_sigaction; + old_act : aliased struct_sigaction; + Result : System.OS_Interface.int; + + Use_Alternate_Stack : constant Boolean := + System.Task_Primitives.Alternate_Stack_Size /= 0; + -- Whether to use an alternate signal stack for stack overflows + + begin + if Initialized then + return; + end if; + + Initialized := True; + + -- Need to call pthread_init very early because it is doing signal + -- initializations. + + pthread_init; + + Abort_Task_Interrupt := SIGADAABORT; + + act.sa_handler := Notify_Exception'Address; + + -- 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 + -- parameters includes a pointer to the interrupted context, which the + -- ZCX propagation scheme needs. + + -- Most man pages for sigaction mention that sa_sigaction should be set + -- instead of sa_handler when SA_SIGINFO is on. In practice, the two + -- fields are actually union'ed and located at the same offset. + + -- On some targets, we set sa_flags to SA_NODEFER so that during the + -- handler execution we do not change the Signal_Mask to be masked for + -- the Signal. + + -- This is a temporary fix to the problem that the Signal_Mask is not + -- restored after the exception (longjmp) from the handler. The right + -- fix should be made in sigsetjmp so that we save the Signal_Set and + -- restore it after a longjmp. + + -- Since SA_NODEFER is obsolete, instead we reset explicitly the mask + -- in the exception handler. + + Result := sigemptyset (Signal_Mask'Access); + pragma Assert (Result = 0); + + -- Add signals that map to Ada exceptions to the mask + + for J in Exception_Interrupts'Range loop + if State (Exception_Interrupts (J)) /= Default then + Result := + sigaddset (Signal_Mask'Access, Signal (Exception_Interrupts (J))); + pragma Assert (Result = 0); + end if; + end loop; + + act.sa_mask := Signal_Mask; + + pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False)); + pragma Assert (Reserve = (Interrupt_ID'Range => False)); + + -- Process state of exception signals + + for J in Exception_Interrupts'Range loop + if State (Exception_Interrupts (J)) /= User then + Keep_Unmasked (Exception_Interrupts (J)) := True; + Reserve (Exception_Interrupts (J)) := True; + + if State (Exception_Interrupts (J)) /= Default then + act.sa_flags := SA_SIGINFO; + + if Use_Alternate_Stack + and then Exception_Interrupts (J) = SIGSEGV + then + act.sa_flags := act.sa_flags + SA_ONSTACK; + end if; + + Result := + sigaction + (Signal (Exception_Interrupts (J)), act'Unchecked_Access, + old_act'Unchecked_Access); + pragma Assert (Result = 0); + end if; + end if; + end loop; + + if State (Abort_Task_Interrupt) /= User then + Keep_Unmasked (Abort_Task_Interrupt) := True; + Reserve (Abort_Task_Interrupt) := True; + end if; + + -- Set SIGINT to unmasked state as long as it is not in "User" state. + -- Check for Unreserve_All_Interrupts last. + + if State (SIGINT) /= User then + Keep_Unmasked (SIGINT) := True; + Reserve (SIGINT) := True; + end if; + + -- Check all signals for state that requires keeping them unmasked and + -- reserved. + + for J in Interrupt_ID'Range loop + if State (J) = Default or else State (J) = Runtime then + Keep_Unmasked (J) := True; + Reserve (J) := True; + end if; + end loop; + + -- Add the set of signals that must always be unmasked for this target + + for J in Unmasked'Range loop + Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True; + Reserve (Interrupt_ID (Unmasked (J))) := True; + end loop; + + -- Add target-specific reserved signals + + if Reserved'Length > 0 then + for J in Reserved'Range loop + Reserve (Interrupt_ID (Reserved (J))) := True; + end loop; + end if; + + -- Process pragma Unreserve_All_Interrupts. This overrides any settings + -- due to pragma Interrupt_State: + + if Unreserve_All_Interrupts /= 0 then + Keep_Unmasked (SIGINT) := False; + Reserve (SIGINT) := False; + end if; + + -- We do not really have Signal 0. We just use this value to identify + -- non-existent signals (see s-intnam.ads). Therefore, Signal should not + -- be used in all signal related operations hence mark it as reserved. + + Reserve (0) := True; + end Initialize; + +end System.Interrupt_Management; diff --git a/gcc/ada/libgnarl/s-osinte__qnx.adb b/gcc/ada/libgnarl/s-osinte__qnx.adb new file mode 100644 index 00000000000..bc9ec4446c7 --- /dev/null +++ b/gcc/ada/libgnarl/s-osinte__qnx.adb @@ -0,0 +1,109 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ I N T E R F A C E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1991-2017, Florida State University -- +-- Copyright (C) 1995-2017, AdaCore -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This version is for QNX operating systems + +pragma Polling (Off); +-- Turn off polling, we do not want ATC polling to take place during +-- tasking operations. It causes infinite loops and other problems. + +-- This package encapsulates all direct interfaces to OS services +-- that are needed by children of System. + +with Interfaces.C; use Interfaces.C; +package body System.OS_Interface is + + -------------------- + -- Get_Stack_Base -- + -------------------- + + function Get_Stack_Base (thread : pthread_t) return Address is + pragma Warnings (Off, thread); + + begin + return Null_Address; + end Get_Stack_Base; + + ------------------ + -- pthread_init -- + ------------------ + + procedure pthread_init is + begin + null; + end pthread_init; + + ----------------- + -- To_Duration -- + ----------------- + + function To_Duration (TS : timespec) return Duration is + begin + return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; + end To_Duration; + + ------------------------ + -- To_Target_Priority -- + ------------------------ + + function To_Target_Priority + (Prio : System.Any_Priority) return Interfaces.C.int + is + begin + return Interfaces.C.int (Prio + 1); + end To_Target_Priority; + + ----------------- + -- To_Timespec -- + ----------------- + + function To_Timespec (D : Duration) return timespec is + S : time_t; + F : Duration; + + begin + S := time_t (Long_Long_Integer (D)); + F := D - Duration (S); + + -- If F has negative value due to a round-up, adjust for positive F + -- value. + + if F < 0.0 then + S := S - 1; + F := F + 1.0; + end if; + + return timespec'(tv_sec => S, + tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); + end To_Timespec; + +end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-osinte__qnx.ads b/gcc/ada/libgnarl/s-osinte__qnx.ads new file mode 100644 index 00000000000..14416cc7ab7 --- /dev/null +++ b/gcc/ada/libgnarl/s-osinte__qnx.ads @@ -0,0 +1,617 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ I N T E R F A C E -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1995-2017, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a QNX/Neutrino version of this package + +-- This package encapsulates all direct interfaces to OS services +-- that are needed by the tasking run-time (libgnarl). + +-- PLEASE DO NOT add any with-clauses to this package or remove the pragma +-- Preelaborate. This package is designed to be a bottom-level (leaf) package. + +with Ada.Unchecked_Conversion; +with Interfaces.C; +with System.OS_Constants; + +package System.OS_Interface is + pragma Preelaborate; + + subtype int is Interfaces.C.int; + subtype char is Interfaces.C.char; + subtype short is Interfaces.C.short; + subtype long is Interfaces.C.long; + subtype unsigned is Interfaces.C.unsigned; + subtype unsigned_short is Interfaces.C.unsigned_short; + subtype unsigned_long is Interfaces.C.unsigned_long; + subtype unsigned_char is Interfaces.C.unsigned_char; + subtype plain_char is Interfaces.C.plain_char; + subtype size_t is Interfaces.C.size_t; + + ----------- + -- Errno -- + ----------- + + function errno return int; + pragma Import (C, errno, "__get_errno"); + + EPERM : constant := 1; + EINTR : constant := 4; + EAGAIN : constant := 11; + ENOMEM : constant := 12; + EINVAL : constant := 22; + ETIMEDOUT : constant := 260; + + ------------- + -- Signals -- + ------------- + + Max_Interrupt : constant := 64; + type Signal is new int range 0 .. Max_Interrupt; + for Signal'Size use int'Size; + + SIGHUP : constant := 1; + SIGINT : constant := 2; + SIGQUIT : constant := 3; + SIGILL : constant := 4; + SIGTRAP : constant := 5; + SIGIOT : constant := 6; + SIGABRT : constant := 6; + SIGDEADLK : constant := 7; + SIGFPE : constant := 8; + SIGKILL : constant := 9; + SIGBUS : constant := 10; + SIGSEGV : constant := 11; + SIGSYS : constant := 12; + SIGPIPE : constant := 13; + SIGALRM : constant := 14; + SIGTERM : constant := 15; + SIGUSR1 : constant := 16; + SIGUSR2 : constant := 17; + SIGCLD : constant := 18; + SIGCHLD : constant := 18; + SIGPWR : constant := 19; + SIGWINCH : constant := 20; + SIGURG : constant := 21; + SIGPOLL : constant := 22; + SIGIO : constant := 22; + SIGSTOP : constant := 23; + SIGTSTP : constant := 24; + SIGCONT : constant := 25; + SIGTTIN : constant := 26; + SIGTTOU : constant := 27; + SIGVTALRM : constant := 28; + SIGPROF : constant := 29; + SIGXCPU : constant := 30; + SIGXFSZ : constant := 31; + + SIGRTMIN : constant := 41; + SITRTMAX : constant := 56; + + SIGSELECT : constant := 57; + SIGPHOTON : constant := 58; + + SIGADAABORT : constant := SIGABRT; + -- Change this to use another signal for task abort. SIGTERM might be a + -- good one. + + type Signal_Set is array (Natural range <>) of Signal; + + Unmasked : constant Signal_Set := ( + SIGTRAP, + -- To enable debugging on multithreaded applications, mark SIGTRAP to + -- be kept unmasked. + + SIGBUS, + + SIGTTIN, SIGTTOU, SIGTSTP, + -- Keep these three signals unmasked so that background processes and IO + -- behaves as normal "C" applications + + SIGPROF, + -- To avoid confusing the profiler + + SIGKILL, SIGSTOP); + -- These two signals actually can't be masked (POSIX won't allow it) + + Reserved : constant Signal_Set := (SIGABRT, SIGKILL, SIGSTOP, SIGSEGV); + + type sigset_t is private; + + function sigaddset (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigaddset, "sigaddset"); + + function sigdelset (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigdelset, "sigdelset"); + + function sigfillset (set : access sigset_t) return int; + pragma Import (C, sigfillset, "sigfillset"); + + function sigismember (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigismember, "sigismember"); + + function sigemptyset (set : access sigset_t) return int; + pragma Import (C, sigemptyset, "sigemptyset"); + + type pad7 is array (1 .. 7) of int; + type siginfo_t is record + si_signo : int; + si_code : int; + si_errno : int; + X_data : pad7; + end record; + pragma Convention (C, siginfo_t); + + type struct_sigaction is record + sa_handler : System.Address; + sa_flags : int; + sa_mask : sigset_t; + end record; + pragma Convention (C, struct_sigaction); + + type struct_sigaction_ptr is access all struct_sigaction; + + SIG_BLOCK : constant := 0; + SIG_UNBLOCK : constant := 1; + SIG_SETMASK : constant := 2; + SIG_PENDING : constant := 5; + + SA_NOCLDSTOP : constant := 16#0001#; + SA_SIGINFO : constant := 16#0002#; + SA_RESETHAND : constant := 16#0004#; + SA_ONSTACK : constant := 16#0008#; + SA_NODEFER : constant := 16#0010#; + SA_NOCLDWAIT : constant := 16#0020#; + + SS_ONSTACK : constant := 1; + SS_DISABLE : constant := 2; + + SIG_DFL : constant := 0; + SIG_IGN : constant := 1; + + function sigaction + (sig : Signal; + act : struct_sigaction_ptr; + oact : struct_sigaction_ptr) return int; + pragma Import (C, sigaction, "sigaction"); + + ---------- + -- Time -- + ---------- + + Time_Slice_Supported : constant Boolean := True; + -- Indicates whether time slicing is supported + + type timespec is private; + + type clockid_t is new int; + + function clock_gettime + (clock_id : clockid_t; tp : access timespec) return int; + pragma Import (C, clock_gettime, "clock_gettime"); + + function clock_getres + (clock_id : clockid_t; + res : access timespec) return int; + pragma Import (C, clock_getres, "clock_getres"); + + function To_Duration (TS : timespec) return Duration; + pragma Inline (To_Duration); + + function To_Timespec (D : Duration) return timespec; + pragma Inline (To_Timespec); + + ------------------------- + -- Priority Scheduling -- + ------------------------- + + SCHED_FIFO : constant := 1; + SCHED_RR : constant := 2; + SCHED_OTHER : constant := 3; + + function To_Target_Priority + (Prio : System.Any_Priority) return Interfaces.C.int + with Inline_Always; + -- Maps System.Any_Priority to a POSIX priority + + ------------- + -- Process -- + ------------- + + type pid_t is private; + + function kill (pid : pid_t; sig : Signal) return int; + pragma Import (C, kill, "kill"); + + function getpid return pid_t; + pragma Import (C, getpid, "getpid"); + + ------------- + -- Threads -- + ------------- + + type Thread_Body is access + function (arg : System.Address) return System.Address; + pragma Convention (C, Thread_Body); + + function Thread_Body_Access is new + Ada.Unchecked_Conversion (System.Address, Thread_Body); + + type pthread_t is new int; + subtype Thread_Id is pthread_t; + + type pthread_mutex_t is limited private; + type pthread_cond_t is limited private; + type pthread_attr_t is limited private; + type pthread_mutexattr_t is limited private; + type pthread_condattr_t is limited private; + type pthread_key_t is private; + + PTHREAD_CREATE_DETACHED : constant := 1; + + PTHREAD_SCOPE_PROCESS : constant := 4; + PTHREAD_SCOPE_SYSTEM : constant := 0; + + PTHREAD_INHERIT_SCHED : constant := 0; + PTHREAD_EXPLICIT_SCHED : constant := 2; + + -- Read/Write lock not supported on Android. + + subtype pthread_rwlock_t is pthread_mutex_t; + subtype pthread_rwlockattr_t is pthread_mutexattr_t; + + ----------- + -- Stack -- + ----------- + + type stack_t is record + ss_sp : System.Address; + ss_flags : int; + ss_size : size_t; + end record; + pragma Convention (C, stack_t); + + function sigaltstack + (ss : not null access stack_t; + oss : access stack_t) return int + is (0); + -- Not supported on QNX + + Alternate_Stack : aliased System.Address; + -- Dummy definition: alternate stack not available due to missing + -- sigaltstack in QNX + + Alternate_Stack_Size : constant := 0; + -- This must be kept in sync with init.c:__gnat_alternate_stack + + Stack_Base_Available : constant Boolean := False; + -- Indicates whether the stack base is available on this target + + function Get_Stack_Base (thread : pthread_t) return System.Address + with Inline_Always; + -- This is a dummy procedure to share some GNULLI files + + function Get_Page_Size return int; + pragma Import (C, Get_Page_Size, "getpagesize"); + -- Returns the size of a page + + PROT_NONE : constant := 16#00_00#; + PROT_READ : constant := 16#01_00#; + PROT_WRITE : constant := 16#02_00#; + PROT_EXEC : constant := 16#04_00#; + PROT_ALL : constant := PROT_READ + PROT_WRITE + PROT_EXEC; + PROT_ON : constant := PROT_READ; + PROT_OFF : constant := PROT_ALL; + + function mprotect (addr : Address; len : size_t; prot : int) return int; + pragma Import (C, mprotect); + + --------------------------------------- + -- Nonstandard Thread Initialization -- + --------------------------------------- + + procedure pthread_init with Inline_Always; + + ------------------------- + -- POSIX.1c Section 3 -- + ------------------------- + + function sigwait (set : access sigset_t; sig : access Signal) return int; + pragma Import (C, sigwait, "sigwait"); + + function pthread_kill (thread : pthread_t; sig : Signal) return int; + pragma Import (C, pthread_kill, "pthread_kill"); + + function pthread_sigmask + (how : int; + set : access sigset_t; + oset : access sigset_t) return int; + pragma Import (C, pthread_sigmask, "pthread_sigmask"); + + -------------------------- + -- POSIX.1c Section 11 -- + -------------------------- + + function pthread_mutexattr_init + (attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutexattr_init, "pthread_mutexattr_init"); + + function pthread_mutexattr_destroy + (attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutexattr_destroy, "pthread_mutexattr_destroy"); + + function pthread_mutex_init + (mutex : access pthread_mutex_t; + attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutex_init, "pthread_mutex_init"); + + function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_destroy, "pthread_mutex_destroy"); + + function pthread_mutex_lock (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_lock, "pthread_mutex_lock"); + + function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock"); + + function pthread_mutex_setprioceiling + (mutex : access pthread_mutex_t; + prioceiling : int; + old_ceiling : access int) return int; + pragma Import (C, pthread_mutex_setprioceiling); + + function pthread_condattr_init + (attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_condattr_init, "pthread_condattr_init"); + + function pthread_condattr_destroy + (attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_condattr_destroy, "pthread_condattr_destroy"); + + function pthread_cond_init + (cond : access pthread_cond_t; + attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_cond_init, "pthread_cond_init"); + + function pthread_cond_destroy (cond : access pthread_cond_t) return int; + pragma Import (C, pthread_cond_destroy, "pthread_cond_destroy"); + + function pthread_cond_signal (cond : access pthread_cond_t) return int; + pragma Import (C, pthread_cond_signal, "pthread_cond_signal"); + + function pthread_cond_wait + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_cond_wait, "pthread_cond_wait"); + + function pthread_cond_timedwait + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t; + abstime : access timespec) return int; + pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); + + Relative_Timed_Wait : constant Boolean := False; + -- pthread_cond_timedwait requires an absolute delay time + + -------------------------- + -- POSIX.1c Section 13 -- + -------------------------- + + PTHREAD_PRIO_INHERIT : constant := 0; + PTHREAD_PRIO_NONE : constant := 1; + PTHREAD_PRIO_PROTECT : constant := 2; + + function pthread_mutexattr_setprotocol + (attr : access pthread_mutexattr_t; + protocol : int) return int; + pragma Import (C, pthread_mutexattr_setprotocol); + + function pthread_mutexattr_getprotocol + (attr : access pthread_mutexattr_t; + protocol : access int) return int; + pragma Import (C, pthread_mutexattr_getprotocol); + + function pthread_mutexattr_setprioceiling + (attr : access pthread_mutexattr_t; + prioceiling : int) return int; + pragma Import (C, pthread_mutexattr_setprioceiling); + + function pthread_mutexattr_getprioceiling + (attr : access pthread_mutexattr_t; + prioceiling : access int) return int; + pragma Import (C, pthread_mutexattr_getprioceiling); + + function pthread_mutex_getprioceiling + (attr : access pthread_mutex_t; + prioceiling : access int) return int; + pragma Import (C, pthread_mutex_getprioceiling); + + type pad8 is array (1 .. 8) of int; + pragma Convention (C, pad8); + + type struct_sched_param is record + sched_priority : int := 0; -- scheduling priority + sched_curpriority : int := 0; + reserved : pad8 := (others => 0); + end record; + pragma Convention (C, struct_sched_param); + + function pthread_setschedparam + (thread : pthread_t; + policy : int; + param : access struct_sched_param) return int; + pragma Import (C, pthread_setschedparam, "pthread_setschedparam"); + + function pthread_getschedparam + (thread : pthread_t; + policy : access int; + param : access struct_sched_param) return int; + pragma Import (C, pthread_getschedparam, "pthread_getschedparam"); + + function pthread_setschedprio + (thread : pthread_t; + priority : int) return int; + pragma Import (C, pthread_setschedprio); + + function pthread_attr_setschedparam + (attr : access pthread_attr_t; + param : access struct_sched_param) return int; + pragma Import (C, pthread_attr_setschedparam); + + function pthread_attr_setinheritsched + (attr : access pthread_attr_t; + inheritsched : int) return int; + pragma Import (C, pthread_attr_setinheritsched); + + function pthread_attr_setscope + (attr : access pthread_attr_t; + scope : int) return int; + pragma Import (C, pthread_attr_setscope, "pthread_attr_setscope"); + + function pthread_attr_setschedpolicy + (attr : access pthread_attr_t; + policy : int) return int; + pragma Import + (C, pthread_attr_setschedpolicy, "pthread_attr_setschedpolicy"); + + function sched_yield return int; + pragma Import (C, sched_yield, "sched_yield"); + + --------------------------- + -- P1003.1c - Section 16 -- + --------------------------- + + function pthread_attr_init + (attributes : access pthread_attr_t) return int; + pragma Import (C, pthread_attr_init, "pthread_attr_init"); + + function pthread_attr_destroy + (attributes : access pthread_attr_t) return int; + pragma Import (C, pthread_attr_destroy, "pthread_attr_destroy"); + + function pthread_attr_setdetachstate + (attr : access pthread_attr_t; + detachstate : int) return int; + pragma Import (C, pthread_attr_setdetachstate); + + function pthread_attr_setstacksize + (attr : access pthread_attr_t; + stacksize : size_t) return int; + pragma Import (C, pthread_attr_setstacksize); + + function pthread_create + (thread : access pthread_t; + attributes : access pthread_attr_t; + start_routine : Thread_Body; + arg : System.Address) return int; + pragma Import (C, pthread_create, "pthread_create"); + + procedure pthread_exit (status : System.Address); + pragma Import (C, pthread_exit, "pthread_exit"); + + function pthread_self return pthread_t; + pragma Import (C, pthread_self, "pthread_self"); + + function lwp_self return System.Address; + pragma Import (C, lwp_self, "pthread_self"); + + -------------------------- + -- POSIX.1c Section 17 -- + -------------------------- + + function pthread_setspecific + (key : pthread_key_t; + value : System.Address) return int; + pragma Import (C, pthread_setspecific, "pthread_setspecific"); + + function pthread_getspecific (key : pthread_key_t) return System.Address; + pragma Import (C, pthread_getspecific, "pthread_getspecific"); + + type destructor_pointer is access procedure (arg : System.Address); + pragma Convention (C, destructor_pointer); + + function pthread_key_create + (key : access pthread_key_t; + destructor : destructor_pointer) return int; + pragma Import (C, pthread_key_create, "pthread_key_create"); + +private + + type sigset_t is array (1 .. 2) of Interfaces.Unsigned_32; + pragma Convention (C, sigset_t); + + type pid_t is new int; + + type time_t is new long; + + type timespec is record + tv_sec : time_t; + tv_nsec : long; + end record; + pragma Convention (C, timespec); + + type unsigned_long_long_t is mod 2 ** 64; + -- Local type only used to get the alignment of this type below + + subtype char_array is Interfaces.C.char_array; + + type pthread_attr_t is record + Data : char_array (1 .. OS_Constants.PTHREAD_ATTR_SIZE); + end record; + pragma Convention (C, pthread_attr_t); + for pthread_attr_t'Alignment use Interfaces.C.unsigned_long'Alignment; + + type pthread_condattr_t is record + Data : char_array (1 .. OS_Constants.PTHREAD_CONDATTR_SIZE); + end record; + pragma Convention (C, pthread_condattr_t); + for pthread_condattr_t'Alignment use Interfaces.C.int'Alignment; + + type pthread_mutexattr_t is record + Data : char_array (1 .. OS_Constants.PTHREAD_MUTEXATTR_SIZE); + end record; + pragma Convention (C, pthread_mutexattr_t); + for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment; + + type pthread_mutex_t is record + Data : char_array (1 .. OS_Constants.PTHREAD_MUTEX_SIZE); + end record; + pragma Convention (C, pthread_mutex_t); + for pthread_mutex_t'Alignment use Interfaces.C.unsigned_long'Alignment; + + type pthread_cond_t is record + Data : char_array (1 .. OS_Constants.PTHREAD_COND_SIZE); + end record; + pragma Convention (C, pthread_cond_t); + for pthread_cond_t'Alignment use unsigned_long_long_t'Alignment; + + type pthread_key_t is new int; + +end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-qnx.ads b/gcc/ada/libgnarl/s-qnx.ads new file mode 100644 index 00000000000..2097f778624 --- /dev/null +++ b/gcc/ada/libgnarl/s-qnx.ads @@ -0,0 +1,122 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . Q N X -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2017, 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 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- -- +------------------------------------------------------------------------------ + +-- This is the default version of this package + +-- This package encapsulates cpu specific differences between implementations +-- of QNX, in order to share s-osinte-linux.ads. + +-- PLEASE DO NOT add any with-clauses to this package or remove the pragma +-- Preelaborate. This package is designed to be a bottom-level (leaf) package + +with Interfaces.C; + +package System.QNX is + pragma Preelaborate; + + ---------- + -- Time -- + ---------- + + subtype long is Interfaces.C.long; + subtype suseconds_t is Interfaces.C.long; + subtype time_t is Interfaces.C.long; + subtype clockid_t is Interfaces.C.int; + + type timespec is record + tv_sec : time_t; + tv_nsec : long; + end record; + pragma Convention (C, timespec); + + type timeval is record + tv_sec : time_t; + tv_usec : suseconds_t; + end record; + pragma Convention (C, timeval); + + ----------- + -- Errno -- + ----------- + + EAGAIN : constant := 11; + EINTR : constant := 4; + EINVAL : constant := 22; + ENOMEM : constant := 12; + EPERM : constant := 1; + ETIMEDOUT : constant := 110; + + ------------- + -- Signals -- + ------------- + + SIGHUP : constant := 1; -- hangup + SIGINT : constant := 2; -- interrupt (rubout) + SIGQUIT : constant := 3; -- quit (ASCD FS) + SIGILL : constant := 4; -- illegal instruction (not reset) + SIGTRAP : constant := 5; -- trace trap (not reset) + SIGIOT : constant := 6; -- IOT instruction + SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future + SIGEMT : constant := 7; -- EMT instruction + SIGDEADLK : constant := 7; -- Mutex deadlock + SIGFPE : constant := 8; -- floating point exception + SIGKILL : constant := 9; -- kill (cannot be caught or ignored) + SIGSEGV : constant := 11; -- segmentation violation + SIGPIPE : constant := 13; -- write on a pipe with no one to read it + SIGALRM : constant := 14; -- alarm clock + SIGTERM : constant := 15; -- software termination signal from kill + SIGUSR1 : constant := 16; -- user defined signal 1 + SIGUSR2 : constant := 17; -- user defined signal 2 + SIGCHLD : constant := 18; -- child status change + SIGCLD : constant := 18; -- alias for SIGCHLD + SIGPWR : constant := 19; -- power-fail restart + SIGWINCH : constant := 20; -- window size change + SIGURG : constant := 21; -- urgent condition on IO channel + SIGPOLL : constant := 22; -- pollable event occurred + SIGIO : constant := 22; -- I/O now possible (4.2 BSD) + SIGSTOP : constant := 23; -- stop (cannot be caught or ignored) + SIGTSTP : constant := 24; -- user stop requested from tty + SIGCONT : constant := 25; -- stopped process has been continued + SIGTTIN : constant := 26; -- background tty read attempted + SIGTTOU : constant := 27; -- background tty write attempted + SIGVTALRM : constant := 28; -- virtual timer expired + SIGPROF : constant := 29; -- profiling timer expired + SIGXCPU : constant := 30; -- CPU time limit exceeded + SIGXFSZ : constant := 31; -- filesize limit exceeded + + -- struct_sigaction offsets + + sa_handler_pos : constant := 0; + sa_mask_pos : constant := Standard'Address_Size / 8; + sa_flags_pos : constant := 128 + sa_mask_pos; + + SA_SIGINFO : constant := 16#04#; + SA_ONSTACK : constant := 16#08000000#; + +end System.QNX; diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index 5da10824a15..2efdc978ff2 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -141,9 +141,9 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration; pragma Inline (Monotonic_Clock); - -- Returns "absolute" time, represented as an offset relative to "the - -- Epoch", which is Jan 1, 1970. This clock implementation is immune to - -- the system's clock changes. + -- Returns an absolute time, represented as an offset relative to some + -- unspecified starting point, typically system boot time. This clock is + -- not affected by discontinuous jumps in the system time. function RT_Resolution return Duration; pragma Inline (RT_Resolution); diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb index b14444ad185..8517bbe86ec 100644 --- a/gcc/ada/libgnarl/s-taprop__mingw.adb +++ b/gcc/ada/libgnarl/s-taprop__mingw.adb @@ -796,7 +796,17 @@ package body System.Task_Primitives.Operations is raise Invalid_CPU_Number; end if; - Self_ID.Common.LL.Thread := GetCurrentThread; + -- Initialize the thread here only if not set. This is done for a + -- foreign task but is not needed when a real thread-id is already + -- set in Create_Task. Note that we do want to keep the real thread-id + -- as it is the only way to free the associated resource. Another way + -- to say this is that a pseudo thread-id from a foreign thread won't + -- allow for freeing resources. + + if Self_ID.Common.LL.Thread = Null_Thread_Id then + Self_ID.Common.LL.Thread := GetCurrentThread; + end if; + Self_ID.Common.LL.Thread_Id := GetCurrentThreadId; Get_Stack_Bounds @@ -976,7 +986,7 @@ package body System.Task_Primitives.Operations is Known_Tasks (T.Known_Tasks_Index) := null; end if; - if T.Common.LL.Thread /= 0 then + if T.Common.LL.Thread /= Null_Thread_Id then -- This task has been activated. Close the thread handle. This -- is needed to release system resources. diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb b/gcc/ada/libgnarl/s-taprop__posix.adb index d9ee078b364..b1d619f16b5 100644 --- a/gcc/ada/libgnarl/s-taprop__posix.adb +++ b/gcc/ada/libgnarl/s-taprop__posix.adb @@ -149,9 +149,9 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration; pragma Inline (Monotonic_Clock); - -- Returns "absolute" time, represented as an offset relative to "the - -- Epoch", which is Jan 1, 1970. This clock implementation is immune to - -- the system's clock changes. + -- Returns an absolute time, represented as an offset relative to some + -- unspecified starting point, typically system boot time. This clock + -- is not affected by discontinuous jumps in the system time. function RT_Resolution return Duration; pragma Inline (RT_Resolution); diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb b/gcc/ada/libgnarl/s-taprop__qnx.adb new file mode 100644 index 00000000000..4ec033046c5 --- /dev/null +++ b/gcc/ada/libgnarl/s-taprop__qnx.adb @@ -0,0 +1,1355 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT 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 . O P E R A T I O N S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2017, 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 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a POSIX-like version of this package + +-- This package contains all the GNULL primitives that interface directly with +-- the underlying OS. + +-- Note: this file can only be used for POSIX compliant systems that implement +-- SCHED_FIFO and Ceiling Locking correctly. + +-- For configurations where SCHED_FIFO and priority ceiling are not a +-- requirement, this file can also be used (e.g AiX threads) + +pragma Polling (Off); +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. + +with Ada.Unchecked_Conversion; + +with Interfaces.C; + +with System.Tasking.Debug; +with System.Interrupt_Management; +with System.OS_Constants; +with System.OS_Primitives; +with System.Task_Info; + +with System.Soft_Links; +-- We use System.Soft_Links instead of System.Tasking.Initialization +-- because the later is a higher level package that we shouldn't depend on. +-- For example when using the restricted run time, it is replaced by +-- System.Tasking.Restricted.Stages. + +package body System.Task_Primitives.Operations is + + package OSC renames System.OS_Constants; + package SSL renames System.Soft_Links; + + use System.Tasking.Debug; + use System.Tasking; + use Interfaces.C; + use System.OS_Interface; + use System.Parameters; + use System.OS_Primitives; + + ---------------- + -- Local Data -- + ---------------- + + -- The followings are logically constants, but need to be initialized + -- at run time. + + Single_RTS_Lock : aliased RTS_Lock; + -- This is a lock to allow only one thread of control in the RTS at + -- a time; it is used to execute in mutual exclusion from all other tasks. + -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List + + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task + + Locking_Policy : Character; + pragma Import (C, Locking_Policy, "__gl_locking_policy"); + -- Value of the pragma Locking_Policy: + -- 'C' for Ceiling_Locking + -- 'I' for Inherit_Locking + -- ' ' for none. + + Unblocked_Signal_Mask : aliased sigset_t; + -- The set of signals that should unblocked in all tasks + + -- The followings are internal configuration constants needed + + Next_Serial_Number : Task_Serial_Number := 100; + -- We start at 100, to reserve some special values for + -- using in error checking. + + Time_Slice_Val : Integer; + pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); + + Dispatching_Policy : Character; + pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); + + Foreign_Task_Elaborated : aliased Boolean := True; + -- Used to identified fake tasks (i.e., non-Ada Threads) + + Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; + -- Whether to use an alternate signal stack for stack overflows + + Abort_Handler_Installed : Boolean := False; + -- True if a handler for the abort signal is installed + + type RTS_Lock_Ptr is not null access all RTS_Lock; + + function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return int; + -- Initialize the mutex L. If Ceiling_Support is True, then set the ceiling + -- to Prio. Returns 0 for success, or ENOMEM for out-of-memory. + + function Get_Policy (Prio : System.Any_Priority) return Character; + pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching"); + -- Get priority specific dispatching policy + + -------------------- + -- Local Packages -- + -------------------- + + package Specific is + + procedure Initialize (Environment_Task : Task_Id); + pragma Inline (Initialize); + -- Initialize various data needed by this package + + function Is_Valid_Task return Boolean; + pragma Inline (Is_Valid_Task); + -- Does executing thread have a TCB? + + procedure Set (Self_Id : Task_Id); + pragma Inline (Set); + -- Set the self id for the current task + + function Self return Task_Id; + pragma Inline (Self); + -- Return a pointer to the Ada Task Control Block of the calling task + + end Specific; + + package body Specific is separate; + -- The body of this package is target specific + + package Monotonic is + + function Monotonic_Clock return Duration; + pragma Inline (Monotonic_Clock); + -- Returns an absolute time, represented as an offset relative to some + -- unspecified starting point, typically system boot time. This clock + -- is not affected by discontinuous jumps in the system time. + + function RT_Resolution return Duration; + pragma Inline (RT_Resolution); + -- Returns resolution of the underlying clock used to implement RT_Clock + + procedure Timed_Sleep + (Self_ID : ST.Task_Id; + Time : Duration; + Mode : ST.Delay_Modes; + Reason : System.Tasking.Task_States; + Timedout : out Boolean; + Yielded : out Boolean); + -- Combination of Sleep (above) and Timed_Delay + + procedure Timed_Delay + (Self_ID : ST.Task_Id; + Time : Duration; + Mode : ST.Delay_Modes); + -- Implement the semantics of the delay statement. + -- The caller should be abort-deferred and should not hold any locks. + + end Monotonic; + + package body Monotonic is separate; + + ---------------------------------- + -- ATCB allocation/deallocation -- + ---------------------------------- + + package body ATCB_Allocation is separate; + -- The body of this package is shared across several targets + + --------------------------------- + -- Support for foreign threads -- + --------------------------------- + + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. + + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; + + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Abort_Handler (Sig : Signal); + -- Signal handler used to implement asynchronous abort. + -- See also comment before body, below. + + function To_Address is + new Ada.Unchecked_Conversion (Task_Id, System.Address); + + function GNAT_pthread_condattr_setup + (attr : access pthread_condattr_t) return int; + pragma Import (C, + GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup"); + + ------------------- + -- Abort_Handler -- + ------------------- + + -- Target-dependent binding of inter-thread Abort signal to the raising of + -- the Abort_Signal exception. + + -- The technical issues and alternatives here are essentially the + -- same as for raising exceptions in response to other signals + -- (e.g. Storage_Error). See code and comments in the package body + -- System.Interrupt_Management. + + -- Some implementations may not allow an exception to be propagated out of + -- a handler, and others might leave the signal or interrupt that invoked + -- this handler masked after the exceptional return to the application + -- code. + + -- GNAT exceptions are originally implemented using setjmp()/longjmp(). On + -- most UNIX systems, this will allow transfer out of a signal handler, + -- which is usually the only mechanism available for implementing + -- asynchronous handlers of this kind. However, some systems do not + -- restore the signal mask on longjmp(), leaving the abort signal masked. + + procedure Abort_Handler (Sig : Signal) is + pragma Unreferenced (Sig); + + T : constant Task_Id := Self; + Old_Set : aliased sigset_t; + + Result : Interfaces.C.int; + pragma Warnings (Off, Result); + + begin + -- It's not safe to raise an exception when using GCC ZCX mechanism. + -- Note that we still need to install a signal handler, since in some + -- cases (e.g. shutdown of the Server_Task in System.Interrupts) we + -- need to send the Abort signal to a task. + + if ZCX_By_Default then + return; + end if; + + if T.Deferral_Level = 0 + and then T.Pending_ATC_Level < T.ATC_Nesting_Level and then + not T.Aborting + then + T.Aborting := True; + + -- Make sure signals used for RTS internal purpose are unmasked + + Result := pthread_sigmask (SIG_UNBLOCK, + Unblocked_Signal_Mask'Access, Old_Set'Access); + pragma Assert (Result = 0); + + raise Standard'Abort_Signal; + end if; + end Abort_Handler; + + ----------------- + -- Stack_Guard -- + ----------------- + + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is + Stack_Base : constant Address := Get_Stack_Base (T.Common.LL.Thread); + Page_Size : Address; + Res : Interfaces.C.int; + + begin + if Stack_Base_Available then + + -- Compute the guard page address + + Page_Size := Address (Get_Page_Size); + Res := + mprotect + (Stack_Base - (Stack_Base mod Page_Size) + Page_Size, + size_t (Page_Size), + prot => (if On then PROT_ON else PROT_OFF)); + pragma Assert (Res = 0); + end if; + end Stack_Guard; + + -------------------- + -- Get_Thread_Id -- + -------------------- + + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is + begin + return T.Common.LL.Thread; + end Get_Thread_Id; + + ---------- + -- Self -- + ---------- + + function Self return Task_Id renames Specific.Self; + + ---------------- + -- Init_Mutex -- + ---------------- + + function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return int + is + Attributes : aliased pthread_mutexattr_t; + Result : int; + Result_2 : aliased int; + + begin + Result := pthread_mutexattr_init (Attributes'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + if Result = ENOMEM then + return Result; + end if; + + if Locking_Policy = 'C' then + Result := pthread_mutexattr_setprotocol + (Attributes'Access, PTHREAD_PRIO_PROTECT); + pragma Assert (Result = 0); + + Result := pthread_mutexattr_getprotocol + (Attributes'Access, Result_2'Access); + if Result_2 /= PTHREAD_PRIO_PROTECT then + raise Program_Error with "setprotocol failed"; + end if; + + Result := pthread_mutexattr_setprioceiling + (Attributes'Access, To_Target_Priority (Prio)); + pragma Assert (Result = 0); + + elsif Locking_Policy = 'I' then + Result := pthread_mutexattr_setprotocol + (Attributes'Access, PTHREAD_PRIO_INHERIT); + pragma Assert (Result = 0); + end if; + + Result := pthread_mutex_init (L, Attributes'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + Result_2 := pthread_mutexattr_destroy (Attributes'Access); + pragma Assert (Result_2 = 0); + + return Result; + end Init_Mutex; + + --------------------- + -- Initialize_Lock -- + --------------------- + + -- Note: mutexes and cond_variables needed per-task basis are initialized + -- in Initialize_TCB and the Storage_Error is handled. Other mutexes (such + -- as RTS_Lock, Memory_Lock...) used in RTS is initialized before any + -- status change of RTS. Therefore raising Storage_Error in the following + -- routines should be able to be handled safely. + + procedure Initialize_Lock + (Prio : System.Any_Priority; + L : not null access Lock) + is + begin + if Init_Mutex (L.WO'Access, Prio) = ENOMEM then + raise Storage_Error with "Failed to allocate a lock"; + end if; + end Initialize_Lock; + + procedure Initialize_Lock + (L : not null access RTS_Lock; Level : Lock_Level) + is + pragma Unreferenced (Level); + + begin + if Init_Mutex (L.all'Access, Any_Priority'Last) = ENOMEM then + raise Storage_Error with "Failed to allocate a lock"; + end if; + end Initialize_Lock; + + ------------------- + -- Finalize_Lock -- + ------------------- + + procedure Finalize_Lock (L : not null access Lock) is + Result : Interfaces.C.int; + begin + Result := pthread_mutex_destroy (L.WO'Access); + pragma Assert (Result = 0); + end Finalize_Lock; + + procedure Finalize_Lock (L : not null access RTS_Lock) is + Result : Interfaces.C.int; + begin + Result := pthread_mutex_destroy (L); + pragma Assert (Result = 0); + end Finalize_Lock; + + ---------------- + -- Write_Lock -- + ---------------- + + procedure Write_Lock + (L : not null access Lock; Ceiling_Violation : out Boolean) + is + Self : constant pthread_t := pthread_self; + Result : int; + Policy : aliased int; + Ceiling : aliased int; + Sched : aliased struct_sched_param; + + begin + Result := pthread_mutex_lock (L.WO'Access); + + -- The cause of EINVAL is a priority ceiling violation + + Ceiling_Violation := Result = EINVAL; + pragma Assert (Result = 0 or else Ceiling_Violation); + + -- Workaround bug in QNX on ceiling locks: tasks with priority higher + -- than the ceiling priority don't receive EINVAL upon trying to lock. + if Result = 0 then + Result := pthread_getschedparam (Self, Policy'Access, Sched'Access); + pragma Assert (Result = 0); + Result := pthread_mutex_getprioceiling (L.WO'Access, Ceiling'Access); + pragma Assert (Result = 0); + + -- Ceiling = 0 means no Ceiling Priority policy is set on this mutex + -- Else, Ceiling < current priority means Ceiling violation + -- (otherwise the current priority == ceiling) + if Ceiling > 0 and then Ceiling < Sched.sched_curpriority then + Ceiling_Violation := True; + Result := pthread_mutex_unlock (L.WO'Access); + pragma Assert (Result = 0); + end if; + end if; + end Write_Lock; + + procedure Write_Lock + (L : not null access RTS_Lock; + Global_Lock : Boolean := False) + is + Result : Interfaces.C.int; + begin + if not Single_Lock or else Global_Lock then + Result := pthread_mutex_lock (L); + pragma Assert (Result = 0); + end if; + end Write_Lock; + + procedure Write_Lock (T : Task_Id) is + Result : Interfaces.C.int; + begin + if not Single_Lock then + Result := pthread_mutex_lock (T.Common.LL.L'Access); + pragma Assert (Result = 0); + end if; + end Write_Lock; + + --------------- + -- Read_Lock -- + --------------- + + procedure Read_Lock + (L : not null access Lock; Ceiling_Violation : out Boolean) is + begin + Write_Lock (L, Ceiling_Violation); + end Read_Lock; + + ------------ + -- Unlock -- + ------------ + + procedure Unlock (L : not null access Lock) is + Result : Interfaces.C.int; + begin + Result := pthread_mutex_unlock (L.WO'Access); + pragma Assert (Result = 0); + end Unlock; + + procedure Unlock + (L : not null access RTS_Lock; Global_Lock : Boolean := False) + is + Result : Interfaces.C.int; + begin + if not Single_Lock or else Global_Lock then + Result := pthread_mutex_unlock (L); + pragma Assert (Result = 0); + end if; + end Unlock; + + procedure Unlock (T : Task_Id) is + Result : Interfaces.C.int; + begin + if not Single_Lock then + Result := pthread_mutex_unlock (T.Common.LL.L'Access); + pragma Assert (Result = 0); + end if; + end Unlock; + + ----------------- + -- Set_Ceiling -- + ----------------- + + procedure Set_Ceiling + (L : not null access Lock; + Prio : System.Any_Priority) + is + Result : Interfaces.C.int; + begin + Result := pthread_mutex_setprioceiling + (L.WO'Access, To_Target_Priority (Prio), null); + pragma Assert (Result = 0); + end Set_Ceiling; + + ----------- + -- Sleep -- + ----------- + + procedure Sleep + (Self_ID : Task_Id; + Reason : System.Tasking.Task_States) + is + pragma Unreferenced (Reason); + + Result : Interfaces.C.int; + + begin + Result := + pthread_cond_wait + (cond => Self_ID.Common.LL.CV'Access, + mutex => (if Single_Lock + then Single_RTS_Lock'Access + else Self_ID.Common.LL.L'Access)); + + -- EINTR is not considered a failure + + pragma Assert (Result = 0 or else Result = EINTR); + end Sleep; + + ----------------- + -- Timed_Sleep -- + ----------------- + + -- This is for use within the run-time system, so abort is + -- assumed to be already deferred, and the caller should be + -- holding its own ATCB lock. + + procedure Timed_Sleep + (Self_ID : Task_Id; + Time : Duration; + Mode : ST.Delay_Modes; + Reason : Task_States; + Timedout : out Boolean; + Yielded : out Boolean) renames Monotonic.Timed_Sleep; + + ----------------- + -- Timed_Delay -- + ----------------- + + -- This is for use in implementing delay statements, so we assume the + -- caller is abort-deferred but is holding no locks. + + procedure Timed_Delay + (Self_ID : Task_Id; + Time : Duration; + Mode : ST.Delay_Modes) renames Monotonic.Timed_Delay; + + --------------------- + -- Monotonic_Clock -- + --------------------- + + function Monotonic_Clock return Duration renames Monotonic.Monotonic_Clock; + + ------------------- + -- RT_Resolution -- + ------------------- + + function RT_Resolution return Duration renames Monotonic.RT_Resolution; + + ------------ + -- Wakeup -- + ------------ + + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is + pragma Unreferenced (Reason); + Result : Interfaces.C.int; + begin + Result := pthread_cond_signal (T.Common.LL.CV'Access); + pragma Assert (Result = 0); + end Wakeup; + + ----------- + -- Yield -- + ----------- + + procedure Yield (Do_Yield : Boolean := True) is + Result : Interfaces.C.int; + pragma Unreferenced (Result); + begin + if Do_Yield then + Result := sched_yield; + end if; + end Yield; + + ------------------ + -- Set_Priority -- + ------------------ + + procedure Set_Priority + (T : Task_Id; + Prio : System.Any_Priority; + Loss_Of_Inheritance : Boolean := False) + is + pragma Unreferenced (Loss_Of_Inheritance); + Result : Interfaces.C.int; + Old : constant System.Any_Priority := T.Common.Current_Priority; + + begin + T.Common.Current_Priority := Prio; + Result := pthread_setschedprio + (T.Common.LL.Thread, To_Target_Priority (Prio)); + pragma Assert (Result = 0); + + if T.Common.LL.Thread = pthread_self + and then Old > Prio + then + -- When lowering the priority via a pthread_setschedprio, QNX ensures + -- that the running thread remains in the head of the FIFO for tne + -- new priority. Annex D expects the thread to be requeued so let's + -- yield to the other threads of the same priority. + Result := sched_yield; + pragma Assert (Result = 0); + end if; + end Set_Priority; + + ------------------ + -- Get_Priority -- + ------------------ + + function Get_Priority (T : Task_Id) return System.Any_Priority is + begin + return T.Common.Current_Priority; + end Get_Priority; + + ---------------- + -- Enter_Task -- + ---------------- + + procedure Enter_Task (Self_ID : Task_Id) is + begin + Self_ID.Common.LL.Thread := pthread_self; + Self_ID.Common.LL.LWP := lwp_self; + + Specific.Set (Self_ID); + + if Use_Alternate_Stack then + declare + Stack : aliased stack_t; + Result : Interfaces.C.int; + begin + Stack.ss_sp := Self_ID.Common.Task_Alternate_Stack; + Stack.ss_size := Alternate_Stack_Size; + Stack.ss_flags := 0; + Result := sigaltstack (Stack'Access, null); + pragma Assert (Result = 0); + end; + end if; + end Enter_Task; + + ------------------- + -- Is_Valid_Task -- + ------------------- + + function Is_Valid_Task return Boolean renames Specific.Is_Valid_Task; + + ----------------------------- + -- Register_Foreign_Thread -- + ----------------------------- + + function Register_Foreign_Thread return Task_Id is + begin + if Is_Valid_Task then + return Self; + else + return Register_Foreign_Thread (pthread_self); + end if; + end Register_Foreign_Thread; + + -------------------- + -- Initialize_TCB -- + -------------------- + + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) + is + Result : Interfaces.C.int; + Cond_Attr : aliased pthread_condattr_t; + + begin + -- Give the task a unique serial number + + Self_ID.Serial_Number := Next_Serial_Number; + Next_Serial_Number := Next_Serial_Number + 1; + pragma Assert (Next_Serial_Number /= 0); + + if not Single_Lock then + Result := Init_Mutex (Self_ID.Common.LL.L'Access, Any_Priority'Last); + pragma Assert (Result = 0); + + if Result /= 0 then + Succeeded := False; + return; + end if; + end if; + + Result := pthread_condattr_init (Cond_Attr'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + if Result = 0 then + Result := GNAT_pthread_condattr_setup (Cond_Attr'Access); + pragma Assert (Result = 0); + + Result := + pthread_cond_init + (Self_ID.Common.LL.CV'Access, Cond_Attr'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + end if; + + if Result = 0 then + Succeeded := True; + else + if not Single_Lock then + Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access); + pragma Assert (Result = 0); + end if; + + Succeeded := False; + end if; + + Result := pthread_condattr_destroy (Cond_Attr'Access); + pragma Assert (Result = 0); + end Initialize_TCB; + + ----------------- + -- Create_Task -- + ----------------- + + procedure Create_Task + (T : Task_Id; + Wrapper : System.Address; + Stack_Size : System.Parameters.Size_Type; + Priority : System.Any_Priority; + Succeeded : out Boolean) + is + Attributes : aliased pthread_attr_t; + Adjusted_Stack_Size : Interfaces.C.size_t; + Page_Size : constant Interfaces.C.size_t := + Interfaces.C.size_t (Get_Page_Size); + Sched_Param : aliased struct_sched_param; + Result : Interfaces.C.int; + + Priority_Specific_Policy : constant Character := Get_Policy (Priority); + -- Upper case first character of the policy name corresponding to the + -- task as set by a Priority_Specific_Dispatching pragma. + + function Thread_Body_Access is new + Ada.Unchecked_Conversion (System.Address, Thread_Body); + + begin + Adjusted_Stack_Size := + Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size); + + if Stack_Base_Available then + + -- If Stack Checking is supported then allocate 2 additional pages: + + -- In the worst case, stack is allocated at something like + -- N * Get_Page_Size - epsilon, we need to add the size for 2 pages + -- to be sure the effective stack size is greater than what + -- has been asked. + + Adjusted_Stack_Size := Adjusted_Stack_Size + 2 * Page_Size; + end if; + + -- Round stack size as this is required by some OSes (Darwin) + + Adjusted_Stack_Size := Adjusted_Stack_Size + Page_Size - 1; + Adjusted_Stack_Size := + Adjusted_Stack_Size - Adjusted_Stack_Size mod Page_Size; + + Result := pthread_attr_init (Attributes'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + if Result /= 0 then + Succeeded := False; + return; + end if; + + Result := + pthread_attr_setdetachstate + (Attributes'Access, PTHREAD_CREATE_DETACHED); + pragma Assert (Result = 0); + + Result := + pthread_attr_setstacksize + (Attributes'Access, Adjusted_Stack_Size); + pragma Assert (Result = 0); + + -- Set thread priority + T.Common.Current_Priority := Priority; + Sched_Param.sched_priority := To_Target_Priority (Priority); + + Result := pthread_attr_setinheritsched + (Attributes'Access, PTHREAD_EXPLICIT_SCHED); + pragma Assert (Result = 0); + + Result := pthread_attr_setschedparam + (Attributes'Access, Sched_Param'Access); + pragma Assert (Result = 0); + + if Time_Slice_Supported + and then (Dispatching_Policy = 'R' + or else Priority_Specific_Policy = 'R' + or else Time_Slice_Val > 0) + then + Result := pthread_attr_setschedpolicy + (Attributes'Access, SCHED_RR); + + elsif Dispatching_Policy = 'F' + or else Priority_Specific_Policy = 'F' + or else Time_Slice_Val = 0 + then + Result := pthread_attr_setschedpolicy + (Attributes'Access, SCHED_FIFO); + + else + Result := pthread_attr_setschedpolicy + (Attributes'Access, SCHED_OTHER); + end if; + + pragma Assert (Result = 0); + + -- Since the initial signal mask of a thread is inherited from the + -- creator, and the Environment task has all its signals masked, we + -- do not need to manipulate caller's signal mask at this point. + -- All tasks in RTS will have All_Tasks_Mask initially. + + -- Note: the use of Unrestricted_Access in the following call is needed + -- because otherwise we have an error of getting a access-to-volatile + -- value which points to a non-volatile object. But in this case it is + -- safe to do this, since we know we have no problems with aliasing and + -- Unrestricted_Access bypasses this check. + + Result := pthread_create + (T.Common.LL.Thread'Unrestricted_Access, + Attributes'Access, + Thread_Body_Access (Wrapper), + To_Address (T)); + pragma Assert (Result = 0 or else Result = EAGAIN); + + Succeeded := Result = 0; + + Result := pthread_attr_destroy (Attributes'Access); + pragma Assert (Result = 0); + end Create_Task; + + ------------------ + -- Finalize_TCB -- + ------------------ + + procedure Finalize_TCB (T : Task_Id) is + Result : Interfaces.C.int; + + begin + if not Single_Lock then + Result := pthread_mutex_destroy (T.Common.LL.L'Access); + pragma Assert (Result = 0); + end if; + + Result := pthread_cond_destroy (T.Common.LL.CV'Access); + pragma Assert (Result = 0); + + if T.Known_Tasks_Index /= -1 then + Known_Tasks (T.Known_Tasks_Index) := null; + end if; + + ATCB_Allocation.Free_ATCB (T); + end Finalize_TCB; + + --------------- + -- Exit_Task -- + --------------- + + procedure Exit_Task is + begin + -- Mark this task as unknown, so that if Self is called, it won't + -- return a dangling pointer. + + Specific.Set (null); + end Exit_Task; + + ---------------- + -- Abort_Task -- + ---------------- + + procedure Abort_Task (T : Task_Id) is + Result : Interfaces.C.int; + begin + if Abort_Handler_Installed then + Result := + pthread_kill + (T.Common.LL.Thread, + Signal (System.Interrupt_Management.Abort_Task_Interrupt)); + pragma Assert (Result = 0); + end if; + end Abort_Task; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (S : in out Suspension_Object) is + Mutex_Attr : aliased pthread_mutexattr_t; + Cond_Attr : aliased pthread_condattr_t; + Result : Interfaces.C.int; + + begin + -- Initialize internal state (always to False (RM D.10 (6))) + + S.State := False; + S.Waiting := False; + + -- Initialize internal mutex + + Result := pthread_mutexattr_init (Mutex_Attr'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + if Result = ENOMEM then + raise Storage_Error; + end if; + + Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + if Result = ENOMEM then + Result := pthread_mutexattr_destroy (Mutex_Attr'Access); + pragma Assert (Result = 0); + + raise Storage_Error; + end if; + + Result := pthread_mutexattr_destroy (Mutex_Attr'Access); + pragma Assert (Result = 0); + + -- Initialize internal condition variable + + Result := pthread_condattr_init (Cond_Attr'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + if Result /= 0 then + Result := pthread_mutex_destroy (S.L'Access); + pragma Assert (Result = 0); + + -- Storage_Error is propagated as intended if the allocation of the + -- underlying OS entities fails. + + raise Storage_Error; + + else + Result := GNAT_pthread_condattr_setup (Cond_Attr'Access); + pragma Assert (Result = 0); + end if; + + Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + if Result /= 0 then + Result := pthread_mutex_destroy (S.L'Access); + pragma Assert (Result = 0); + + Result := pthread_condattr_destroy (Cond_Attr'Access); + pragma Assert (Result = 0); + + -- Storage_Error is propagated as intended if the allocation of the + -- underlying OS entities fails. + + raise Storage_Error; + end if; + + Result := pthread_condattr_destroy (Cond_Attr'Access); + pragma Assert (Result = 0); + end Initialize; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (S : in out Suspension_Object) is + Result : Interfaces.C.int; + + begin + -- Destroy internal mutex + + Result := pthread_mutex_destroy (S.L'Access); + pragma Assert (Result = 0); + + -- Destroy internal condition variable + + Result := pthread_cond_destroy (S.CV'Access); + pragma Assert (Result = 0); + end Finalize; + + ------------------- + -- Current_State -- + ------------------- + + function Current_State (S : Suspension_Object) return Boolean is + begin + -- We do not want to use lock on this read operation. State is marked + -- as Atomic so that we ensure that the value retrieved is correct. + + return S.State; + end Current_State; + + --------------- + -- Set_False -- + --------------- + + procedure Set_False (S : in out Suspension_Object) is + Result : Interfaces.C.int; + + begin + SSL.Abort_Defer.all; + + Result := pthread_mutex_lock (S.L'Access); + pragma Assert (Result = 0); + + S.State := False; + + Result := pthread_mutex_unlock (S.L'Access); + pragma Assert (Result = 0); + + SSL.Abort_Undefer.all; + end Set_False; + + -------------- + -- Set_True -- + -------------- + + procedure Set_True (S : in out Suspension_Object) is + Result : Interfaces.C.int; + + begin + SSL.Abort_Defer.all; + + Result := pthread_mutex_lock (S.L'Access); + pragma Assert (Result = 0); + + -- If there is already a task waiting on this suspension object then + -- we resume it, leaving the state of the suspension object to False, + -- as it is specified in (RM D.10(9)). Otherwise, it just leaves + -- the state to True. + + if S.Waiting then + S.Waiting := False; + S.State := False; + + Result := pthread_cond_signal (S.CV'Access); + pragma Assert (Result = 0); + + else + S.State := True; + end if; + + Result := pthread_mutex_unlock (S.L'Access); + pragma Assert (Result = 0); + + SSL.Abort_Undefer.all; + end Set_True; + + ------------------------ + -- Suspend_Until_True -- + ------------------------ + + procedure Suspend_Until_True (S : in out Suspension_Object) is + Result : Interfaces.C.int; + + begin + SSL.Abort_Defer.all; + + Result := pthread_mutex_lock (S.L'Access); + pragma Assert (Result = 0); + + if S.Waiting then + + -- Program_Error must be raised upon calling Suspend_Until_True + -- if another task is already waiting on that suspension object + -- (RM D.10(10)). + + Result := pthread_mutex_unlock (S.L'Access); + pragma Assert (Result = 0); + + SSL.Abort_Undefer.all; + + raise Program_Error; + + else + -- Suspend the task if the state is False. Otherwise, the task + -- continues its execution, and the state of the suspension object + -- is set to False (ARM D.10 par. 9). + + if S.State then + S.State := False; + else + S.Waiting := True; + + loop + -- Loop in case pthread_cond_wait returns earlier than expected + -- (e.g. in case of EINTR caused by a signal). + + Result := pthread_cond_wait (S.CV'Access, S.L'Access); + pragma Assert (Result = 0 or else Result = EINTR); + + exit when not S.Waiting; + end loop; + end if; + + Result := pthread_mutex_unlock (S.L'Access); + pragma Assert (Result = 0); + + SSL.Abort_Undefer.all; + end if; + end Suspend_Until_True; + + ---------------- + -- Check_Exit -- + ---------------- + + -- Dummy version + + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is + pragma Unreferenced (Self_ID); + begin + return True; + end Check_Exit; + + -------------------- + -- Check_No_Locks -- + -------------------- + + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is + pragma Unreferenced (Self_ID); + begin + return True; + end Check_No_Locks; + + ---------------------- + -- Environment_Task -- + ---------------------- + + function Environment_Task return Task_Id is + begin + return Environment_Task_Id; + end Environment_Task; + + -------------- + -- Lock_RTS -- + -------------- + + procedure Lock_RTS is + begin + Write_Lock (Single_RTS_Lock'Access, Global_Lock => True); + end Lock_RTS; + + ---------------- + -- Unlock_RTS -- + ---------------- + + procedure Unlock_RTS is + begin + Unlock (Single_RTS_Lock'Access, Global_Lock => True); + end Unlock_RTS; + + ------------------ + -- Suspend_Task -- + ------------------ + + function Suspend_Task + (T : ST.Task_Id; + Thread_Self : Thread_Id) return Boolean + is + pragma Unreferenced (T, Thread_Self); + begin + return False; + end Suspend_Task; + + ----------------- + -- Resume_Task -- + ----------------- + + function Resume_Task + (T : ST.Task_Id; + Thread_Self : Thread_Id) return Boolean + is + pragma Unreferenced (T, Thread_Self); + begin + return False; + end Resume_Task; + + -------------------- + -- Stop_All_Tasks -- + -------------------- + + procedure Stop_All_Tasks is + begin + null; + end Stop_All_Tasks; + + --------------- + -- Stop_Task -- + --------------- + + function Stop_Task (T : ST.Task_Id) return Boolean is + pragma Unreferenced (T); + begin + return False; + end Stop_Task; + + ------------------- + -- Continue_Task -- + ------------------- + + function Continue_Task (T : ST.Task_Id) return Boolean is + pragma Unreferenced (T); + begin + return False; + end Continue_Task; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (Environment_Task : Task_Id) is + act : aliased struct_sigaction; + old_act : aliased struct_sigaction; + Tmp_Set : aliased sigset_t; + Result : Interfaces.C.int; + + function State + (Int : System.Interrupt_Management.Interrupt_ID) return Character; + pragma Import (C, State, "__gnat_get_interrupt_state"); + -- Get interrupt state. Defined in a-init.c + -- The input argument is the interrupt number, + -- and the result is one of the following: + + Default : constant Character := 's'; + -- 'n' this interrupt not set by any Interrupt_State pragma + -- 'u' Interrupt_State pragma set state to User + -- 'r' Interrupt_State pragma set state to Runtime + -- 's' Interrupt_State pragma set state to System (use "default" + -- system handler) + + begin + Environment_Task_Id := Environment_Task; + + Interrupt_Management.Initialize; + + -- Prepare the set of signals that should unblocked in all tasks + + Result := sigemptyset (Unblocked_Signal_Mask'Access); + pragma Assert (Result = 0); + + for J in Interrupt_Management.Interrupt_ID loop + if System.Interrupt_Management.Keep_Unmasked (J) then + Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J)); + pragma Assert (Result = 0); + end if; + end loop; + + -- Initialize the lock used to synchronize chain of all ATCBs + + Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); + + Specific.Initialize (Environment_Task); + + if Use_Alternate_Stack then + Environment_Task.Common.Task_Alternate_Stack := + Alternate_Stack'Address; + end if; + + -- Make environment task known here because it doesn't go through + -- Activate_Tasks, which does it for all other tasks. + + Known_Tasks (Known_Tasks'First) := Environment_Task; + Environment_Task.Known_Tasks_Index := Known_Tasks'First; + + Enter_Task (Environment_Task); + + if State + (System.Interrupt_Management.Abort_Task_Interrupt) /= Default + then + act.sa_flags := 0; + act.sa_handler := Abort_Handler'Address; + + Result := sigemptyset (Tmp_Set'Access); + pragma Assert (Result = 0); + act.sa_mask := Tmp_Set; + + Result := + sigaction + (Signal (System.Interrupt_Management.Abort_Task_Interrupt), + act'Unchecked_Access, + old_act'Unchecked_Access); + pragma Assert (Result = 0); + Abort_Handler_Installed := True; + end if; + end Initialize; + + ----------------------- + -- Set_Task_Affinity -- + ----------------------- + + procedure Set_Task_Affinity (T : ST.Task_Id) is + pragma Unreferenced (T); + + begin + -- Setting task affinity is not supported by the underlying system + + null; + end Set_Task_Affinity; + +end System.Task_Primitives.Operations; diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb index 21404d0cd52..d83ed3cda14 100644 --- a/gcc/ada/libgnarl/s-tasini.adb +++ b/gcc/ada/libgnarl/s-tasini.adb @@ -325,8 +325,8 @@ package body System.Tasking.Initialization is -- of the environment task. Self_Id := Environment_Task; - Self_Id.Master_of_Task := Environment_Task_Level; - Self_Id.Master_Within := Self_Id.Master_of_Task + 1; + Self_Id.Master_Of_Task := Environment_Task_Level; + Self_Id.Master_Within := Self_Id.Master_Of_Task + 1; for L in Self_Id.Entry_Calls'Range loop Self_Id.Entry_Calls (L).Self := Self_Id; diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads index 7c8b44b952c..fe725b8d731 100644 --- a/gcc/ada/libgnarl/s-taskin.ads +++ b/gcc/ada/libgnarl/s-taskin.ads @@ -982,7 +982,7 @@ package System.Tasking is -- updated it itself using information from a suspended Caller, or -- after Caller has updated it and awakened Self. - Master_of_Task : Master_Level; + Master_Of_Task : Master_Level; -- The task executing the master of this task, and the ID of this task's -- master (unique only among masters currently active within Parent). -- diff --git a/gcc/ada/libgnarl/s-tasren.adb b/gcc/ada/libgnarl/s-tasren.adb index c1b35482c41..f180631d4f8 100644 --- a/gcc/ada/libgnarl/s-tasren.adb +++ b/gcc/ada/libgnarl/s-tasren.adb @@ -1138,7 +1138,7 @@ package body System.Tasking.Rendezvous is Parent.Awake_Count := Parent.Awake_Count + 1; if Parent.Common.State = Master_Completion_Sleep - and then Acceptor.Master_of_Task = Parent.Master_Within + and then Acceptor.Master_Of_Task = Parent.Master_Within then Parent.Common.Wait_Count := Parent.Common.Wait_Count + 1; diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb index 518a02c8b48..f0f1df4d8e7 100644 --- a/gcc/ada/libgnarl/s-tassta.adb +++ b/gcc/ada/libgnarl/s-tassta.adb @@ -151,7 +151,7 @@ package body System.Tasking.Stages is -- duplicate master ids. For example, suppose we have three nested -- task bodies T1,T2,T3. And suppose T1 also calls P which calls Q (and -- both P and Q are task masters). Q will have the same master id as - -- Master_of_Task of T3. Previous versions of this would abort T3 when + -- Master_Of_Task of T3. Previous versions of this would abort T3 when -- Q calls Complete_Master, which was completely wrong. begin @@ -160,7 +160,7 @@ package body System.Tasking.Stages is P := C.Common.Parent; if P = Self_ID then - if C.Master_of_Task = Self_ID.Master_Within then + if C.Master_Of_Task = Self_ID.Master_Within then pragma Debug (Debug.Trace (Self_ID, "Aborting", 'X', C)); Utilities.Abort_One_Task (Self_ID, C); @@ -304,7 +304,7 @@ package body System.Tasking.Stages is P.Alive_Count := P.Alive_Count + 1; if P.Common.State = Master_Completion_Sleep and then - C.Master_of_Task = P.Master_Within + C.Master_Of_Task = P.Master_Within then pragma Assert (Self_ID /= P); P.Common.Wait_Count := P.Common.Wait_Count + 1; @@ -498,7 +498,7 @@ package body System.Tasking.Stages is -- has already awaited its dependent tasks. This raises Program_Error, -- by 4.8(10.3/2). See AI-280. Ignore this check for foreign threads. - if Self_ID.Master_of_Task /= Foreign_Task_Level + if Self_ID.Master_Of_Task /= Foreign_Task_Level and then Master > Self_ID.Master_Within then raise Program_Error with @@ -559,10 +559,10 @@ package body System.Tasking.Stages is P := Self_ID; - if P.Master_of_Task <= Independent_Task_Level then + if P.Master_Of_Task <= Independent_Task_Level then P := Environment_Task; else - while P /= null and then P.Master_of_Task >= Master loop + while P /= null and then P.Master_Of_Task >= Master loop P := P.Common.Parent; end loop; end if; @@ -621,13 +621,13 @@ package body System.Tasking.Stages is -- a regular library level task, otherwise the run-time will get -- confused when waiting for these tasks to terminate. - T.Master_of_Task := Library_Task_Level; + T.Master_Of_Task := Library_Task_Level; else - T.Master_of_Task := Master; + T.Master_Of_Task := Master; end if; - T.Master_Within := T.Master_of_Task + 1; + T.Master_Within := T.Master_Of_Task + 1; for L in T.Entry_Calls'Range loop T.Entry_Calls (L).Self := T; @@ -710,7 +710,7 @@ package body System.Tasking.Stages is pragma Debug (Debug.Trace - (Self_ID, "Created task in " & T.Master_of_Task'Img, 'C', T)); + (Self_ID, "Created task in " & T.Master_Of_Task'Img, 'C', T)); end Create_Task; -------------------- @@ -988,11 +988,11 @@ package body System.Tasking.Stages is Initialization.Defer_Abort_Nestable (Self_ID); - -- Loop through the From chain, changing their Master_of_Task fields, + -- Loop through the From chain, changing their Master_Of_Task fields, -- and to find the end of the chain. loop - C.Master_of_Task := New_Master; + C.Master_Of_Task := New_Master; exit when C.Common.Activation_Link = null; C := C.Common.Activation_Link; end loop; @@ -1094,7 +1094,7 @@ package body System.Tasking.Stages is pragma Assert (Self_ID.Deferral_Level = 1); Debug.Master_Hook - (Self_ID, Self_ID.Common.Parent, Self_ID.Master_of_Task); + (Self_ID, Self_ID.Common.Parent, Self_ID.Master_Of_Task); if Use_Alternate_Stack then Self_ID.Common.Task_Alternate_Stack := Task_Alternate_Stack'Address; @@ -1307,7 +1307,7 @@ package body System.Tasking.Stages is -- environment task), because they are implementation artifacts that -- should be invisible to Ada programs. - elsif Self_ID.Master_of_Task /= Independent_Task_Level then + elsif Self_ID.Master_Of_Task /= Independent_Task_Level then -- Look for a fall-back handler following the master relationship -- for the task. As specified in ARM C.7.3 par. 9/2, "the fall-back @@ -1377,7 +1377,7 @@ package body System.Tasking.Stages is procedure Terminate_Task (Self_ID : Task_Id) is Environment_Task : constant Task_Id := STPO.Environment_Task; - Master_of_Task : Integer; + Master_Of_Task : Integer; Deallocate : Boolean; begin @@ -1397,12 +1397,12 @@ package body System.Tasking.Stages is Lock_RTS; end if; - Master_of_Task := Self_ID.Master_of_Task; + Master_Of_Task := Self_ID.Master_Of_Task; -- Check if the current task is an independent task If so, decrement -- the Independent_Task_Count value. - if Master_of_Task = Independent_Task_Level then + if Master_Of_Task = Independent_Task_Level then if Single_Lock then Utilities.Independent_Task_Count := Utilities.Independent_Task_Count - 1; @@ -1439,7 +1439,7 @@ package body System.Tasking.Stages is Free_Task (Self_ID); end if; - if Master_of_Task > 0 then + if Master_Of_Task > 0 then STPO.Exit_Task; end if; end Terminate_Task; @@ -1606,11 +1606,11 @@ package body System.Tasking.Stages is C := All_Tasks_List; while C /= null loop - if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then + if C.Common.Activator = Self_ID and then C.Master_Of_Task = CM then return False; end if; - if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then + if C.Common.Parent = Self_ID and then C.Master_Of_Task = CM then Write_Lock (C); if C.Common.State = Unactivated then @@ -1662,9 +1662,9 @@ package body System.Tasking.Stages is -- Terminate unactivated (never-to-be activated) tasks - if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then + if C.Common.Activator = Self_ID and then C.Master_Of_Task = CM then - -- Usually, C.Common.Activator = Self_ID implies C.Master_of_Task + -- Usually, C.Common.Activator = Self_ID implies C.Master_Of_Task -- = CM. The only case where C is pending activation by this -- task, but the master of C is not CM is in Ada 2005, when C is -- part of a return object of a build-in-place function. @@ -1681,7 +1681,7 @@ package body System.Tasking.Stages is -- Count it if directly dependent on this master - if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then + if C.Common.Parent = Self_ID and then C.Master_Of_Task = CM then Write_Lock (C); if C.Awake_Count /= 0 then @@ -1781,7 +1781,7 @@ package body System.Tasking.Stages is C := All_Tasks_List; while C /= null loop - if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then + if C.Common.Parent = Self_ID and then C.Master_Of_Task = CM then Write_Lock (C); pragma Assert (C.Awake_Count = 0); @@ -1840,7 +1840,7 @@ package body System.Tasking.Stages is -- while the task calls Free_Task itself, in Terminate_Task. if C.Common.Parent = Self_ID - and then C.Master_of_Task >= CM + and then C.Master_Of_Task >= CM and then not C.Free_On_Termination then if P /= null then @@ -1912,7 +1912,7 @@ package body System.Tasking.Stages is if (T.Common.Parent /= null and then T.Common.Parent.Common.Parent /= null) - or else T.Master_of_Task > Library_Task_Level + or else T.Master_Of_Task > Library_Task_Level then Initialization.Task_Lock (Self_ID); @@ -1977,7 +1977,7 @@ package body System.Tasking.Stages is pragma Assert (Self_ID = Self); pragma Assert (Self_ID.Master_Within in - Self_ID.Master_of_Task + 1 .. Self_ID.Master_of_Task + 3); + Self_ID.Master_Of_Task .. Self_ID.Master_Of_Task + 3); pragma Assert (Self_ID.Common.Wait_Count = 0); pragma Assert (Self_ID.Open_Accepts = null); pragma Assert (Self_ID.ATC_Nesting_Level = 1); @@ -2007,10 +2007,10 @@ package body System.Tasking.Stages is Unlock_RTS; end if; - -- If Self_ID.Master_Within = Self_ID.Master_of_Task + 2 we may have + -- If Self_ID.Master_Within = Self_ID.Master_Of_Task + 2 we may have -- dependent tasks for which we need to wait. Otherwise we just exit. - if Self_ID.Master_Within = Self_ID.Master_of_Task + 2 then + if Self_ID.Master_Within = Self_ID.Master_Of_Task + 2 then Vulnerable_Complete_Master (Self_ID); end if; end Vulnerable_Complete_Task; diff --git a/gcc/ada/libgnarl/s-tassta.ads b/gcc/ada/libgnarl/s-tassta.ads index a1129a1085a..10803823c85 100644 --- a/gcc/ada/libgnarl/s-tassta.ads +++ b/gcc/ada/libgnarl/s-tassta.ads @@ -285,7 +285,7 @@ package System.Tasking.Stages is (From, To : Activation_Chain_Access; New_Master : Master_ID); -- Compiler interface only. Do not call from within the RTS. - -- Move all tasks on From list to To list, and change their Master_of_Task + -- Move all tasks on From list to To list, and change their Master_Of_Task -- to be New_Master. This is used to implement build-in-place function -- returns. Tasks that are part of the return object are initially placed -- on an activation chain local to the return statement, and their master diff --git a/gcc/ada/libgnarl/s-tasuti.adb b/gcc/ada/libgnarl/s-tasuti.adb index 1a7e8cf9f10..d95bfa861e6 100644 --- a/gcc/ada/libgnarl/s-tasuti.adb +++ b/gcc/ada/libgnarl/s-tasuti.adb @@ -258,7 +258,7 @@ package body System.Tasking.Utilities is pragma Assert (Parent = Environment_Task); - Self_Id.Master_of_Task := Independent_Task_Level; + Self_Id.Master_Of_Task := Independent_Task_Level; -- Update Independent_Task_Count that is needed for the GLADE -- termination rule. See also pending update in @@ -396,7 +396,7 @@ package body System.Tasking.Utilities is end loop; if P.Common.State = Master_Phase_2_Sleep - and then C.Master_of_Task = P.Master_Within + and then C.Master_Of_Task = P.Master_Within then pragma Assert (P.Common.Wait_Count > 0); P.Common.Wait_Count := P.Common.Wait_Count - 1; @@ -462,7 +462,7 @@ package body System.Tasking.Utilities is -- P has non-passive dependents if P.Common.State = Master_Completion_Sleep - and then C.Master_of_Task = P.Master_Within + and then C.Master_Of_Task = P.Master_Within then pragma Debug (Debug.Trace diff --git a/gcc/ada/libgnarl/s-tasuti.ads b/gcc/ada/libgnarl/s-tasuti.ads index 351666645fb..81351d37d67 100644 --- a/gcc/ada/libgnarl/s-tasuti.ads +++ b/gcc/ada/libgnarl/s-tasuti.ads @@ -54,9 +54,9 @@ package System.Tasking.Utilities is -- -- This is a dangerous operation, and should never be used on nested tasks -- or tasks that depend on any objects that might be finalized earlier than - -- the termination of the environment task. It is for internal use by the - -- GNARL, to prevent such internal server tasks from preventing a partition - -- from terminating. + -- the termination of the environment task. It is primarily for internal + -- use by the GNARL, to prevent such internal server tasks from preventing + -- a partition from terminating. -- -- Also note that the run time assumes that the parent of an independent -- task is the environment task. If this is not the case, Make_Independent diff --git a/gcc/ada/libgnarl/s-tporft.adb b/gcc/ada/libgnarl/s-tporft.adb index 56eda26e6a1..a1c68b33719 100644 --- a/gcc/ada/libgnarl/s-tporft.adb +++ b/gcc/ada/libgnarl/s-tporft.adb @@ -70,8 +70,8 @@ begin Unlock_RTS; pragma Assert (Succeeded); - Self_Id.Master_of_Task := 0; - Self_Id.Master_Within := Self_Id.Master_of_Task + 1; + Self_Id.Master_Of_Task := 0; + Self_Id.Master_Within := Self_Id.Master_Of_Task + 1; for L in Self_Id.Entry_Calls'Range loop Self_Id.Entry_Calls (L).Self := Self_Id; diff --git a/gcc/ada/libgnat/a-tags.adb b/gcc/ada/libgnat/a-tags.adb index f3c2c0e969c..40dd11e68b5 100644 --- a/gcc/ada/libgnat/a-tags.adb +++ b/gcc/ada/libgnat/a-tags.adb @@ -332,7 +332,7 @@ package body Ada.Tags is function Base_Address (This : System.Address) return System.Address is begin - return This - Offset_To_Top (This); + return This + Offset_To_Top (This); end Base_Address; --------------- @@ -412,14 +412,14 @@ package body Ada.Tags is -- Case of Static value of Offset_To_Top if Iface_Table.Ifaces_Table (Id).Static_Offset_To_Top then - Obj_Base := Obj_Base + + Obj_Base := Obj_Base - Iface_Table.Ifaces_Table (Id).Offset_To_Top_Value; -- Otherwise call the function generated by the expander to -- provide the value. else - Obj_Base := Obj_Base + + Obj_Base := Obj_Base - Iface_Table.Ifaces_Table (Id).Offset_To_Top_Func.all (Obj_Base); end if; @@ -1046,7 +1046,7 @@ package body Ada.Tags is -- Save the offset to top field in the secondary dispatch table if Offset_Value /= 0 then - Sec_Base := This + Offset_Value; + Sec_Base := This - Offset_Value; Sec_DT := DT (To_Tag_Ptr (Sec_Base).all); Sec_DT.Offset_To_Top := SSE.Storage_Offset'Last; end if; diff --git a/gcc/ada/libgnat/g-altive.ads b/gcc/ada/libgnat/g-altive.ads index 1e247b30f5c..cc62ca8a540 100644 --- a/gcc/ada/libgnat/g-altive.ads +++ b/gcc/ada/libgnat/g-altive.ads @@ -668,18 +668,18 @@ end GNAT.Altivec; -- type of A. The quad-word operations are only implemented by one -- Altivec primitive operation. That means that, if QW_Operation is a -- quad-word operation, we should have: --- QW_Operation (To_Type_of_A (B)) = QW_Operation (A) +-- QW_Operation (To_Type_Of_A (B)) = QW_Operation (A) -- That is true iff: --- To_Quad_Word (To_Type_of_A (B)) = To_Quad_Word (A) +-- To_Quad_Word (To_Type_Of_A (B)) = To_Quad_Word (A) -- As To_Quad_Word is a bijection. we have: --- To_Type_of_A (B) = A +-- To_Type_Of_A (B) = A -- resp. any combination of A, B, C: --- To_Type_of_A (C) = A --- To_Type_of_B (A) = B --- To_Type_of_C (B) = C +-- To_Type_Of_A (C) = A +-- To_Type_Of_B (A) = B +-- To_Type_Of_C (B) = C -- ... -- Making sure that the properties described above are verified by the diff --git a/gcc/ada/libgnat/s-rident.ads b/gcc/ada/libgnat/s-rident.ads index cd88593656b..cde036aa89d 100644 --- a/gcc/ada/libgnat/s-rident.ads +++ b/gcc/ada/libgnat/s-rident.ads @@ -183,6 +183,7 @@ package System.Rident is No_Elaboration_Code, -- GNAT No_Obsolescent_Features, -- Ada 2005 AI-368 No_Wide_Characters, -- GNAT + Static_Dispatch_Tables, -- GNAT SPARK_05, -- GNAT -- The following cases require a parameter value diff --git a/gcc/ada/libgnat/s-spsufi.adb b/gcc/ada/libgnat/s-spsufi.adb index 11846c996f2..f1faab268d8 100644 --- a/gcc/ada/libgnat/s-spsufi.adb +++ b/gcc/ada/libgnat/s-spsufi.adb @@ -71,9 +71,9 @@ package body System.Storage_Pools.Subpools.Finalization is -- requires that "The subpool no longer belongs to any pool" BEFORE -- calling Deallocate_Subpool. The actual dispatching call required is: -- - -- Deallocate_Subpool(Pool_of_Subpool(Subpool).all, Subpool); + -- Deallocate_Subpool(Pool_Of_Subpool(Subpool).all, Subpool); -- - -- but that can't be taken literally, because Pool_of_Subpool will + -- but that can't be taken literally, because Pool_Of_Subpool will -- return null. declare diff --git a/gcc/ada/libgnat/system-qnx-aarch64.ads b/gcc/ada/libgnat/system-qnx-aarch64.ads new file mode 100644 index 00000000000..4cb1c1be091 --- /dev/null +++ b/gcc/ada/libgnat/system-qnx-aarch64.ads @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M -- +-- -- +-- S p e c -- +-- (QNX/Aarch64 Version) -- +-- -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package System is + pragma Pure; + -- Note that we take advantage of the implementation permission to make + -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada + -- 2005, this is Pure in any case (AI-362). + + pragma No_Elaboration_Code_All; + -- Allow the use of that restriction in units that WITH this unit + + type Name is (SYSTEM_NAME_GNAT); + System_Name : constant Name := SYSTEM_NAME_GNAT; + + -- System-Dependent Named Numbers + + Min_Int : constant := Long_Long_Integer'First; + Max_Int : constant := Long_Long_Integer'Last; + + Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; + Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; + + Max_Base_Digits : constant := Long_Long_Float'Digits; + Max_Digits : constant := Long_Long_Float'Digits; + + Max_Mantissa : constant := 63; + Fine_Delta : constant := 2.0 ** (-Max_Mantissa); + + Tick : constant := 0.000_001; + + -- Storage-related Declarations + + type Address is private; + pragma Preelaborable_Initialization (Address); + Null_Address : constant Address; + + Storage_Unit : constant := 8; + Word_Size : constant := Standard'Word_Size; + Memory_Size : constant := 2 ** Long_Integer'Size; + + -- Address comparison + + function "<" (Left, Right : Address) return Boolean; + function "<=" (Left, Right : Address) return Boolean; + function ">" (Left, Right : Address) return Boolean; + function ">=" (Left, Right : Address) return Boolean; + function "=" (Left, Right : Address) return Boolean; + + pragma Import (Intrinsic, "<"); + pragma Import (Intrinsic, "<="); + pragma Import (Intrinsic, ">"); + pragma Import (Intrinsic, ">="); + pragma Import (Intrinsic, "="); + + -- Other System-Dependent Declarations + + type Bit_Order is (High_Order_First, Low_Order_First); + Default_Bit_Order : constant Bit_Order := + Bit_Order'Val (Standard'Default_Bit_Order); + pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning + + -- Priority-related Declarations (RM D.1) + + -- System priority is Ada priority + 1, so lies in the range 1 .. 63. + -- + -- If the scheduling policy is SCHED_FIFO or SCHED_RR the runtime makes use + -- of the entire range provided by the system. + -- + -- If the scheduling policy is SCHED_OTHER the only valid system priority + -- is 1 and other values are simply ignored. + + Max_Priority : constant Positive := 61; + Max_Interrupt_Priority : constant Positive := 62; + + subtype Any_Priority is Integer range 0 .. 62; + subtype Priority is Any_Priority range 0 .. 61; + subtype Interrupt_Priority is Any_Priority range 62 .. 62; + + Default_Priority : constant Priority := 30; + +private + + type Address is mod Memory_Size; + Null_Address : constant Address := 0; + + -------------------------------------- + -- System Implementation Parameters -- + -------------------------------------- + + -- These parameters provide information about the target that is used + -- by the compiler. They are in the private part of System, where they + -- can be accessed using the special circuitry in the Targparm unit + -- whose source should be consulted for more detailed descriptions + -- of the individual switch values. + + Backend_Divide_Checks : constant Boolean := False; + Backend_Overflow_Checks : constant Boolean := True; + Command_Line_Args : constant Boolean := True; + Configurable_Run_Time : constant Boolean := False; + Denorm : constant Boolean := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + Preallocated_Stacks : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : constant Boolean := True; + Stack_Check_Limits : constant Boolean := False; + Support_Aggregates : constant Boolean := True; + Support_Atomic_Primitives : constant Boolean := True; + Support_Composite_Assign : constant Boolean := True; + Support_Composite_Compare : constant Boolean := True; + Support_Long_Shifts : constant Boolean := True; + Always_Compatible_Rep : constant Boolean := False; + Suppress_Standard_Library : constant Boolean := False; + Use_Ada_Main_Program_Name : constant Boolean := False; + Frontend_Exceptions : constant Boolean := False; + ZCX_By_Default : constant Boolean := True; + +end System; diff --git a/gcc/ada/link.c b/gcc/ada/link.c index ac3c372f611..99fa000e73b 100644 --- a/gcc/ada/link.c +++ b/gcc/ada/link.c @@ -105,6 +105,7 @@ const char *__gnat_default_libgcc_subdir = "lib"; #elif defined (__FreeBSD__) || defined (__DragonFly__) \ || defined (__NetBSD__) || defined (__OpenBSD__) + || defined (__QNX__) const char *__gnat_object_file_option = "-Wl,@"; const char *__gnat_run_path_option = "-Wl,-rpath,"; char __gnat_shared_libgnat_default = STATIC; diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 2dcbe1a677c..04e92dab55c 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -159,8 +159,8 @@ package body Namet is Append (Buf, Buf2.Chars (1 .. Buf2.Length)); end Append; - procedure Append (Buf : in out Bounded_String; Id : Name_Id) is - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + procedure Append (Buf : in out Bounded_String; Id : Valid_Name_Id) is + pragma Assert (Is_Valid_Name (Id)); Index : constant Int := Name_Entries.Table (Id).Name_Chars_Index; Len : constant Short := Name_Entries.Table (Id).Name_Len; @@ -174,7 +174,10 @@ package body Namet is -- Append_Decoded -- -------------------- - procedure Append_Decoded (Buf : in out Bounded_String; Id : Name_Id) is + procedure Append_Decoded + (Buf : in out Bounded_String; + Id : Valid_Name_Id) + is C : Character; P : Natural; Temp : Bounded_String; @@ -255,7 +258,15 @@ package body Namet is -- simply use their normal representation. else - Insert_Character (Character'Val (Hex (2))); + declare + W2 : constant Word := Hex (2); + begin + pragma Assert (W2 <= 255); + -- Add assumption to facilitate static analysis. Note + -- that we cannot use pragma Assume for bootstrap + -- reasons. + Insert_Character (Character'Val (W2)); + end; end if; -- WW (wide wide character insertion) @@ -449,7 +460,7 @@ package body Namet is procedure Append_Decoded_With_Brackets (Buf : in out Bounded_String; - Id : Name_Id) + Id : Valid_Name_Id) is P : Natural; @@ -596,7 +607,10 @@ package body Namet is -- Append_Unqualified -- ------------------------ - procedure Append_Unqualified (Buf : in out Bounded_String; Id : Name_Id) is + procedure Append_Unqualified + (Buf : in out Bounded_String; + Id : Valid_Name_Id) + is Temp : Bounded_String; begin Append (Temp, Id); @@ -610,7 +624,7 @@ package body Namet is procedure Append_Unqualified_Decoded (Buf : in out Bounded_String; - Id : Name_Id) + Id : Valid_Name_Id) is Temp : Bounded_String; begin @@ -747,6 +761,9 @@ package body Namet is Write_Eol; Write_Str ("Average number of probes for lookup = "); + pragma Assert (Nsyms /= 0); + -- Add assumption to facilitate static analysis. Here Nsyms cannot be + -- zero because many symbols are added to the table by default. Probes := Probes / Nsyms; Write_Int (Probes / 200); Write_Char ('.'); @@ -773,7 +790,7 @@ package body Namet is -- Get_Decoded_Name_String -- ----------------------------- - procedure Get_Decoded_Name_String (Id : Name_Id) is + procedure Get_Decoded_Name_String (Id : Valid_Name_Id) is begin Global_Name_Buffer.Length := 0; Append_Decoded (Global_Name_Buffer, Id); @@ -783,7 +800,7 @@ package body Namet is -- Get_Decoded_Name_String_With_Brackets -- ------------------------------------------- - procedure Get_Decoded_Name_String_With_Brackets (Id : Name_Id) is + procedure Get_Decoded_Name_String_With_Brackets (Id : Valid_Name_Id) is begin Global_Name_Buffer.Length := 0; Append_Decoded_With_Brackets (Global_Name_Buffer, Id); @@ -794,7 +811,7 @@ package body Namet is ------------------------ procedure Get_Last_Two_Chars - (N : Name_Id; + (N : Valid_Name_Id; C1 : out Character; C2 : out Character) is @@ -815,13 +832,13 @@ package body Namet is -- Get_Name_String -- --------------------- - procedure Get_Name_String (Id : Name_Id) is + procedure Get_Name_String (Id : Valid_Name_Id) is begin Global_Name_Buffer.Length := 0; Append (Global_Name_Buffer, Id); end Get_Name_String; - function Get_Name_String (Id : Name_Id) return String is + function Get_Name_String (Id : Valid_Name_Id) return String is Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id))); begin Append (Buf, Id); @@ -832,7 +849,7 @@ package body Namet is -- Get_Name_String_And_Append -- -------------------------------- - procedure Get_Name_String_And_Append (Id : Name_Id) is + procedure Get_Name_String_And_Append (Id : Valid_Name_Id) is begin Append (Global_Name_Buffer, Id); end Get_Name_String_And_Append; @@ -841,9 +858,9 @@ package body Namet is -- Get_Name_Table_Boolean1 -- ----------------------------- - function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean is + function Get_Name_Table_Boolean1 (Id : Valid_Name_Id) return Boolean is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); return Name_Entries.Table (Id).Boolean1_Info; end Get_Name_Table_Boolean1; @@ -851,9 +868,9 @@ package body Namet is -- Get_Name_Table_Boolean2 -- ----------------------------- - function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean is + function Get_Name_Table_Boolean2 (Id : Valid_Name_Id) return Boolean is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); return Name_Entries.Table (Id).Boolean2_Info; end Get_Name_Table_Boolean2; @@ -861,9 +878,9 @@ package body Namet is -- Get_Name_Table_Boolean3 -- ----------------------------- - function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean is + function Get_Name_Table_Boolean3 (Id : Valid_Name_Id) return Boolean is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); return Name_Entries.Table (Id).Boolean3_Info; end Get_Name_Table_Boolean3; @@ -871,9 +888,9 @@ package body Namet is -- Get_Name_Table_Byte -- ------------------------- - function Get_Name_Table_Byte (Id : Name_Id) return Byte is + function Get_Name_Table_Byte (Id : Valid_Name_Id) return Byte is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); return Name_Entries.Table (Id).Byte_Info; end Get_Name_Table_Byte; @@ -881,9 +898,9 @@ package body Namet is -- Get_Name_Table_Int -- ------------------------- - function Get_Name_Table_Int (Id : Name_Id) return Int is + function Get_Name_Table_Int (Id : Valid_Name_Id) return Int is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); return Name_Entries.Table (Id).Int_Info; end Get_Name_Table_Int; @@ -891,7 +908,7 @@ package body Namet is -- Get_Unqualified_Decoded_Name_String -- ----------------------------------------- - procedure Get_Unqualified_Decoded_Name_String (Id : Name_Id) is + procedure Get_Unqualified_Decoded_Name_String (Id : Valid_Name_Id) is begin Global_Name_Buffer.Length := 0; Append_Unqualified_Decoded (Global_Name_Buffer, Id); @@ -901,7 +918,7 @@ package body Namet is -- Get_Unqualified_Name_String -- --------------------------------- - procedure Get_Unqualified_Name_String (Id : Name_Id) is + procedure Get_Unqualified_Name_String (Id : Valid_Name_Id) is begin Global_Name_Buffer.Length := 0; Append_Unqualified (Global_Name_Buffer, Id); @@ -1032,15 +1049,11 @@ package body Namet is return False; end Is_Internal_Name; - function Is_Internal_Name (Id : Name_Id) return Boolean is + function Is_Internal_Name (Id : Valid_Name_Id) return Boolean is Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id))); begin - if Id in Error_Name_Or_No_Name then - return False; - else - Append (Buf, Id); - return Is_Internal_Name (Buf); - end if; + Append (Buf, Id); + return Is_Internal_Name (Buf); end Is_Internal_Name; function Is_Internal_Name return Boolean is @@ -1066,10 +1079,10 @@ package body Namet is -- Is_Operator_Name -- ---------------------- - function Is_Operator_Name (Id : Name_Id) return Boolean is + function Is_Operator_Name (Id : Valid_Name_Id) return Boolean is S : Int; begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); S := Name_Entries.Table (Id).Name_Chars_Index; return Name_Chars.Table (S + 1) = 'O'; end Is_Operator_Name; @@ -1087,7 +1100,7 @@ package body Namet is -- Length_Of_Name -- -------------------- - function Length_Of_Name (Id : Name_Id) return Nat is + function Length_Of_Name (Id : Valid_Name_Id) return Nat is begin return Int (Name_Entries.Table (Id).Name_Len); end Length_Of_Name; @@ -1111,7 +1124,7 @@ package body Namet is ---------------- function Name_Enter - (Buf : Bounded_String := Global_Name_Buffer) return Name_Id + (Buf : Bounded_String := Global_Name_Buffer) return Valid_Name_Id is begin Name_Entries.Append @@ -1136,7 +1149,7 @@ package body Namet is return Name_Entries.Last; end Name_Enter; - function Name_Enter (S : String) return Name_Id is + function Name_Enter (S : String) return Valid_Name_Id is Buf : Bounded_String (Max_Length => S'Length); begin Append (Buf, S); @@ -1157,7 +1170,7 @@ package body Namet is --------------- function Name_Find - (Buf : Bounded_String := Global_Name_Buffer) return Name_Id + (Buf : Bounded_String := Global_Name_Buffer) return Valid_Name_Id is New_Id : Name_Id; -- Id of entry in hash search, and value to be returned @@ -1172,7 +1185,7 @@ package body Namet is -- Quick handling for one character names if Buf.Length = 1 then - return Name_Id (First_Name_Id + Character'Pos (Buf.Chars (1))); + return Valid_Name_Id (First_Name_Id + Character'Pos (Buf.Chars (1))); -- Otherwise search hash table for existing matching entry @@ -1241,7 +1254,7 @@ package body Namet is end if; end Name_Find; - function Name_Find (S : String) return Name_Id is + function Name_Find (S : String) return Valid_Name_Id is Buf : Bounded_String (Max_Length => S'Length); begin Append (Buf, S); @@ -1476,7 +1489,10 @@ package body Namet is -- Name_Equals -- ----------------- - function Name_Equals (N1 : Name_Id; N2 : Name_Id) return Boolean is + function Name_Equals + (N1 : Valid_Name_Id; + N2 : Valid_Name_Id) return Boolean + is begin return N1 = N2 or else Get_Name_String (N1) = Get_Name_String (N2); end Name_Equals; @@ -1550,9 +1566,9 @@ package body Namet is -- Set_Name_Table_Boolean1 -- ----------------------------- - procedure Set_Name_Table_Boolean1 (Id : Name_Id; Val : Boolean) is + procedure Set_Name_Table_Boolean1 (Id : Valid_Name_Id; Val : Boolean) is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); Name_Entries.Table (Id).Boolean1_Info := Val; end Set_Name_Table_Boolean1; @@ -1560,9 +1576,9 @@ package body Namet is -- Set_Name_Table_Boolean2 -- ----------------------------- - procedure Set_Name_Table_Boolean2 (Id : Name_Id; Val : Boolean) is + procedure Set_Name_Table_Boolean2 (Id : Valid_Name_Id; Val : Boolean) is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); Name_Entries.Table (Id).Boolean2_Info := Val; end Set_Name_Table_Boolean2; @@ -1570,9 +1586,9 @@ package body Namet is -- Set_Name_Table_Boolean3 -- ----------------------------- - procedure Set_Name_Table_Boolean3 (Id : Name_Id; Val : Boolean) is + procedure Set_Name_Table_Boolean3 (Id : Valid_Name_Id; Val : Boolean) is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); Name_Entries.Table (Id).Boolean3_Info := Val; end Set_Name_Table_Boolean3; @@ -1580,9 +1596,9 @@ package body Namet is -- Set_Name_Table_Byte -- ------------------------- - procedure Set_Name_Table_Byte (Id : Name_Id; Val : Byte) is + procedure Set_Name_Table_Byte (Id : Valid_Name_Id; Val : Byte) is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); Name_Entries.Table (Id).Byte_Info := Val; end Set_Name_Table_Byte; @@ -1590,9 +1606,9 @@ package body Namet is -- Set_Name_Table_Int -- ------------------------- - procedure Set_Name_Table_Int (Id : Name_Id; Val : Int) is + procedure Set_Name_Table_Int (Id : Valid_Name_Id; Val : Int) is begin - pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + pragma Assert (Is_Valid_Name (Id)); Name_Entries.Table (Id).Int_Info := Val; end Set_Name_Table_Int; @@ -1734,8 +1750,13 @@ package body Namet is procedure wn (Id : Name_Id) is begin - if Id not in Name_Entries.First .. Name_Entries.Last then - Write_Str ("<invalid name_id>"); + if Is_Valid_Name (Id) then + declare + Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id))); + begin + Append (Buf, Id); + Write_Str (Buf.Chars (1 .. Buf.Length)); + end; elsif Id = No_Name then Write_Str ("<No_Name>"); @@ -1744,12 +1765,8 @@ package body Namet is Write_Str ("<Error_Name>"); else - declare - Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id))); - begin - Append (Buf, Id); - Write_Str (Buf.Chars (1 .. Buf.Length)); - end; + Write_Str ("<invalid name_id>"); + Write_Int (Int (Id)); end if; Write_Eol; @@ -1759,26 +1776,22 @@ package body Namet is -- Write_Name -- ---------------- - procedure Write_Name (Id : Name_Id) is + procedure Write_Name (Id : Valid_Name_Id) is Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id))); begin - if Id >= First_Name_Id then - Append (Buf, Id); - Write_Str (Buf.Chars (1 .. Buf.Length)); - end if; + Append (Buf, Id); + Write_Str (Buf.Chars (1 .. Buf.Length)); end Write_Name; ------------------------ -- Write_Name_Decoded -- ------------------------ - procedure Write_Name_Decoded (Id : Name_Id) is + procedure Write_Name_Decoded (Id : Valid_Name_Id) is Buf : Bounded_String; begin - if Id >= First_Name_Id then - Append_Decoded (Buf, Id); - Write_Str (Buf.Chars (1 .. Buf.Length)); - end if; + Append_Decoded (Buf, Id); + Write_Str (Buf.Chars (1 .. Buf.Length)); end Write_Name_Decoded; -- Package initialization, initialize tables diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 72ac8fabf30..b55d3361744 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -198,12 +198,12 @@ package Namet is -- indicate that some kind of error was encountered in scanning out -- the relevant name, so it does not have a representable label. - subtype Error_Name_Or_No_Name is Name_Id range No_Name .. Error_Name; - -- Used to test for either error name or no name - First_Name_Id : constant Name_Id := Names_Low_Bound + 2; -- Subscript of first entry in names table + subtype Valid_Name_Id is Name_Id range First_Name_Id .. Name_Id'Last; + -- All but No_Name and Error_Name + ------------------------------ -- Name_Id Membership Tests -- ------------------------------ @@ -337,8 +337,8 @@ package Namet is function "+" (Buf : Bounded_String) return String renames To_String; function Name_Find - (Buf : Bounded_String := Global_Name_Buffer) return Name_Id; - function Name_Find (S : String) return Name_Id; + (Buf : Bounded_String := Global_Name_Buffer) return Valid_Name_Id; + function Name_Find (S : String) return Valid_Name_Id; -- Name_Find searches the names table to see if the string has already been -- stored. If so, the Id of the existing entry is returned. Otherwise a new -- entry is created with its Name_Table_Int fields set to zero/false. Note @@ -346,8 +346,8 @@ package Namet is -- name string. function Name_Enter - (Buf : Bounded_String := Global_Name_Buffer) return Name_Id; - function Name_Enter (S : String) return Name_Id; + (Buf : Bounded_String := Global_Name_Buffer) return Valid_Name_Id; + function Name_Enter (S : String) return Valid_Name_Id; -- Name_Enter is similar to Name_Find. The difference is that it does not -- search the table for an existing match, and also subsequent Name_Find -- calls using the same name will not locate the entry created by this @@ -358,10 +358,12 @@ package Namet is -- names, since these are efficiently located without hashing by Name_Find -- in any case. - function Name_Equals (N1 : Name_Id; N2 : Name_Id) return Boolean; + function Name_Equals + (N1 : Valid_Name_Id; + N2 : Valid_Name_Id) return Boolean; -- Return whether N1 and N2 denote the same character sequence - function Get_Name_String (Id : Name_Id) return String; + function Get_Name_String (Id : Valid_Name_Id) return String; -- Returns the characters of Id as a String. The lower bound is 1. -- The following Append procedures ignore any characters that don't fit in @@ -380,11 +382,11 @@ package Namet is procedure Append (Buf : in out Bounded_String; Buf2 : Bounded_String); -- Append Buf2 onto Buf - procedure Append (Buf : in out Bounded_String; Id : Name_Id); + procedure Append (Buf : in out Bounded_String; Id : Valid_Name_Id); -- Append the characters of Id onto Buf. It is an error to call this with -- one of the special name Id values (No_Name or Error_Name). - procedure Append_Decoded (Buf : in out Bounded_String; Id : Name_Id); + procedure Append_Decoded (Buf : in out Bounded_String; Id : Valid_Name_Id); -- Same as Append, except that the result is decoded, so that upper half -- characters and wide characters appear as originally found in the source -- program text, operators have their source forms (special characters and @@ -393,7 +395,7 @@ package Namet is procedure Append_Decoded_With_Brackets (Buf : in out Bounded_String; - Id : Name_Id); + Id : Valid_Name_Id); -- Same as Append_Decoded, except that the brackets notation (Uhh -- replaced by ["hh"], Whhhh replaced by ["hhhh"], WWhhhhhhhh replaced by -- ["hhhhhhhh"]) is used for all non-lower half characters, regardless of @@ -403,7 +405,8 @@ package Namet is -- requirement for a canonical representation not affected by the -- character set options (e.g. in the binder generation of symbols). - procedure Append_Unqualified (Buf : in out Bounded_String; Id : Name_Id); + procedure Append_Unqualified + (Buf : in out Bounded_String; Id : Valid_Name_Id); -- Same as Append, except that qualification (as defined in unit -- Exp_Dbug) is removed (including both preceding __ delimited names, and -- also the suffixes used to indicate package body entities and to @@ -415,7 +418,7 @@ package Namet is procedure Append_Unqualified_Decoded (Buf : in out Bounded_String; - Id : Name_Id); + Id : Valid_Name_Id); -- Same as Append_Unqualified, but decoded as for Append_Decoded procedure Append_Encoded (Buf : in out Bounded_String; C : Char_Code); @@ -443,40 +446,40 @@ package Namet is function Is_Internal_Name (Buf : Bounded_String) return Boolean; procedure Get_Last_Two_Chars - (N : Name_Id; + (N : Valid_Name_Id; C1 : out Character; C2 : out Character); -- Obtains last two characters of a name. C1 is last but one character and -- C2 is last character. If name is less than two characters long then both -- C1 and C2 are set to ASCII.NUL on return. - function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean; - function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean; - function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean; + function Get_Name_Table_Boolean1 (Id : Valid_Name_Id) return Boolean; + function Get_Name_Table_Boolean2 (Id : Valid_Name_Id) return Boolean; + function Get_Name_Table_Boolean3 (Id : Valid_Name_Id) return Boolean; -- Fetches the Boolean values associated with the given name - function Get_Name_Table_Byte (Id : Name_Id) return Byte; + function Get_Name_Table_Byte (Id : Valid_Name_Id) return Byte; pragma Inline (Get_Name_Table_Byte); -- Fetches the Byte value associated with the given name - function Get_Name_Table_Int (Id : Name_Id) return Int; + function Get_Name_Table_Int (Id : Valid_Name_Id) return Int; pragma Inline (Get_Name_Table_Int); -- Fetches the Int value associated with the given name - procedure Set_Name_Table_Boolean1 (Id : Name_Id; Val : Boolean); - procedure Set_Name_Table_Boolean2 (Id : Name_Id; Val : Boolean); - procedure Set_Name_Table_Boolean3 (Id : Name_Id; Val : Boolean); + procedure Set_Name_Table_Boolean1 (Id : Valid_Name_Id; Val : Boolean); + procedure Set_Name_Table_Boolean2 (Id : Valid_Name_Id; Val : Boolean); + procedure Set_Name_Table_Boolean3 (Id : Valid_Name_Id; Val : Boolean); -- Sets the Boolean value associated with the given name - procedure Set_Name_Table_Byte (Id : Name_Id; Val : Byte); + procedure Set_Name_Table_Byte (Id : Valid_Name_Id; Val : Byte); pragma Inline (Set_Name_Table_Byte); -- Sets the Byte value associated with the given name - procedure Set_Name_Table_Int (Id : Name_Id; Val : Int); + procedure Set_Name_Table_Int (Id : Valid_Name_Id; Val : Int); pragma Inline (Set_Name_Table_Int); -- Sets the Int value associated with the given name - function Is_Internal_Name (Id : Name_Id) return Boolean; + function Is_Internal_Name (Id : Valid_Name_Id) return Boolean; -- Returns True if the name is an internal name, i.e. contains a character -- for which Is_OK_Internal_Letter is true, or if the name starts or ends -- with an underscore. @@ -500,7 +503,7 @@ package Namet is -- set of reserved letters is O, Q, U, W) and also returns False for the -- letter X, which is reserved for debug output (see Exp_Dbug). - function Is_Operator_Name (Id : Name_Id) return Boolean; + function Is_Operator_Name (Id : Valid_Name_Id) return Boolean; -- Returns True if name given is of the form of an operator (that is, it -- starts with an upper case O). @@ -508,7 +511,7 @@ package Namet is -- True if Id is a valid name - points to a valid entry in the Name_Entries -- table. - function Length_Of_Name (Id : Name_Id) return Nat; + function Length_Of_Name (Id : Valid_Name_Id) return Nat; pragma Inline (Length_Of_Name); -- Returns length of given name in characters. This is the length of the -- encoded name, as stored in the names table. @@ -553,13 +556,13 @@ package Namet is -- Writes out internal tables to current tree file using the relevant -- Table.Tree_Write routines. - procedure Write_Name (Id : Name_Id); + procedure Write_Name (Id : Valid_Name_Id); -- Write_Name writes the characters of the specified name using the -- standard output procedures in package Output. The name is written -- in encoded form (i.e. including Uhh, Whhh, Qx, _op as they appear in -- the name table). If Id is Error_Name, or No_Name, no text is output. - procedure Write_Name_Decoded (Id : Name_Id); + procedure Write_Name_Decoded (Id : Valid_Name_Id); -- Like Write_Name, except that the name written is the decoded name, as -- described for Append_Decoded. @@ -586,17 +589,17 @@ package Namet is procedure Add_Str_To_Name_Buffer (S : String); - procedure Get_Decoded_Name_String (Id : Name_Id); + procedure Get_Decoded_Name_String (Id : Valid_Name_Id); - procedure Get_Decoded_Name_String_With_Brackets (Id : Name_Id); + procedure Get_Decoded_Name_String_With_Brackets (Id : Valid_Name_Id); - procedure Get_Name_String (Id : Name_Id); + procedure Get_Name_String (Id : Valid_Name_Id); - procedure Get_Name_String_And_Append (Id : Name_Id); + procedure Get_Name_String_And_Append (Id : Valid_Name_Id); - procedure Get_Unqualified_Decoded_Name_String (Id : Name_Id); + procedure Get_Unqualified_Decoded_Name_String (Id : Valid_Name_Id); - procedure Get_Unqualified_Name_String (Id : Name_Id); + procedure Get_Unqualified_Name_String (Id : Valid_Name_Id); procedure Insert_Str_In_Name_Buffer (S : String; Index : Positive); @@ -739,12 +742,12 @@ private for Name_Entry'Size use 16 * 8; -- This ensures that we did not leave out any fields - -- This is the table that is referenced by Name_Id entries. + -- This is the table that is referenced by Valid_Name_Id entries. -- It contains one entry for each unique name in the table. package Name_Entries is new Table.Table ( Table_Component_Type => Name_Entry, - Table_Index_Type => Name_Id'Base, + Table_Index_Type => Valid_Name_Id'Base, Table_Low_Bound => First_Name_Id, Table_Initial => Alloc.Names_Initial, Table_Increment => Alloc.Names_Increment, diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 96e2f3e2f92..94ed9533ac2 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -2148,17 +2148,7 @@ package Opt is -- Other Global Flags -- ------------------------ - Expander_Active : Boolean := False; - -- A flag that indicates if expansion is active (True) or deactivated - -- (False). When expansion is deactivated all calls to expander routines - -- have no effect. Note that the initial setting of False is merely to - -- prevent saving of an undefined value for an initial call to the - -- Expander_Mode_Save_And_Set procedure. For more information on the use of - -- this flag, see package Expander. Indeed this flag might more logically - -- be in the spec of Expander, but it is referenced by Errout, and it - -- really seems wrong for Errout to depend on Expander. - - Static_Dispatch_Tables : Boolean := True; + Building_Static_Dispatch_Tables : Boolean := True; -- This flag indicates if the backend supports generation of statically -- allocated dispatch tables. If it is True, then the front end will -- generate static aggregates for dispatch tables that contain forward @@ -2170,6 +2160,16 @@ package Opt is -- behavior can be disabled using switch -gnatd.t which will set this flag -- to False and revert to the previous dynamic behavior. + Expander_Active : Boolean := False; + -- A flag that indicates if expansion is active (True) or deactivated + -- (False). When expansion is deactivated all calls to expander routines + -- have no effect. Note that the initial setting of False is merely to + -- prevent saving of an undefined value for an initial call to the + -- Expander_Mode_Save_And_Set procedure. For more information on the use of + -- this flag, see package Expander. Indeed this flag might more logically + -- be in the spec of Expander, but it is referenced by Errout, and it + -- really seems wrong for Errout to depend on Expander. + ----------------------- -- Tree I/O Routines -- ----------------------- diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 54dd5621fd8..ddbf716ea6d 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -4314,6 +4314,8 @@ package body Ch3 is Scan_State : Saved_Scan_State; begin + Done := False; + if Style_Check then Style.Check_Indentation; end if; @@ -4326,7 +4328,6 @@ package body Ch3 is => Check_Bad_Layout; Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls); - Done := False; when Tok_For => Check_Bad_Layout; @@ -4350,12 +4351,10 @@ package body Ch3 is Restore_Scan_State (Scan_State); Append (P_Representation_Clause, Decls); - Done := False; when Tok_Generic => Check_Bad_Layout; Append (P_Generic, Decls); - Done := False; when Tok_Identifier => Check_Bad_Layout; @@ -4370,7 +4369,6 @@ package body Ch3 is Token := Tok_Overriding; Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls); - Done := False; -- Normal case, no overriding, or overriding followed by colon @@ -4381,38 +4379,31 @@ package body Ch3 is when Tok_Package => Check_Bad_Layout; Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls); - Done := False; when Tok_Pragma => Append (P_Pragma, Decls); - Done := False; when Tok_Protected => Check_Bad_Layout; Scan; -- past PROTECTED Append (P_Protected, Decls); - Done := False; when Tok_Subtype => Check_Bad_Layout; Append (P_Subtype_Declaration, Decls); - Done := False; when Tok_Task => Check_Bad_Layout; Scan; -- past TASK Append (P_Task, Decls); - Done := False; when Tok_Type => Check_Bad_Layout; Append (P_Type_Declaration, Decls); - Done := False; when Tok_Use => Check_Bad_Layout; P_Use_Clause (Decls); - Done := False; when Tok_With => Check_Bad_Layout; @@ -4439,8 +4430,6 @@ package body Ch3 is -- a declarative list. After discarding the misplaced aspects -- we can continue the scan. - Done := False; - declare Dummy_Node : constant Node_Id := New_Node (N_Package_Specification, Token_Ptr); @@ -4533,8 +4522,6 @@ package body Ch3 is End_Statements (Handled_Statement_Sequence (Body_Node)); end; - Done := False; - else Done := True; end if; @@ -4556,7 +4543,6 @@ package body Ch3 is -- After discarding the misplaced aspects we can continue the -- scan. - Done := False; else Restore_Scan_State (Scan_State); -- to END Done := True; @@ -4671,7 +4657,6 @@ package body Ch3 is exception when Error_Resync => Resync_Past_Semicolon; - Done := False; end P_Declarative_Items; ---------------------------------- diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 83bb25118a4..ddcedcae130 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -336,6 +336,7 @@ package body Ch6 is end if; Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; Ignore (Tok_Colon); -- Deal with generic instantiation, the one case in which we do not diff --git a/gcc/ada/par-ch7.adb b/gcc/ada/par-ch7.adb index dd4bdb4b329..7ea2d0675d8 100644 --- a/gcc/ada/par-ch7.adb +++ b/gcc/ada/par-ch7.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -146,6 +146,7 @@ package body Ch7 is Scope.Table (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Program_Unit_Name; Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; if Aspect_Specifications_Present then Aspect_Sloc := Token_Ptr; @@ -211,6 +212,7 @@ package body Ch7 is Scope.Table (Scope.Last).Sloc := Token_Ptr; Name_Node := P_Defining_Program_Unit_Name; Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; -- Case of renaming declaration diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb index 9e4ac07426f..b5d6d2036a3 100644 --- a/gcc/ada/par-ch9.adb +++ b/gcc/ada/par-ch9.adb @@ -101,6 +101,7 @@ package body Ch9 is Scan; -- past BODY Name_Node := P_Defining_Identifier (C_Is); Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; if Token = Tok_Left_Paren then Error_Msg_SC ("discriminant part not allowed in task body"); @@ -168,6 +169,7 @@ package body Ch9 is Name_Node := P_Defining_Identifier; Set_Defining_Identifier (Task_Node, Name_Node); Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; Set_Discriminant_Specifications (Task_Node, P_Known_Discriminant_Part_Opt); @@ -176,6 +178,7 @@ package body Ch9 is Name_Node := P_Defining_Identifier (C_Is); Set_Defining_Identifier (Task_Node, Name_Node); Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; if Token = Tok_Left_Paren then Error_Msg_SC ("discriminant part not allowed for single task"); @@ -447,6 +450,7 @@ package body Ch9 is Scan; -- past BODY Name_Node := P_Defining_Identifier (C_Is); Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; if Token = Tok_Left_Paren then Error_Msg_SC ("discriminant part not allowed in protected body"); @@ -501,6 +505,7 @@ package body Ch9 is Name_Node := P_Defining_Identifier (C_Is); Set_Defining_Identifier (Protected_Node, Name_Node); Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; Set_Discriminant_Specifications (Protected_Node, P_Known_Discriminant_Part_Opt); @@ -517,6 +522,7 @@ package body Ch9 is end if; Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; end if; P_Aspect_Specifications (Protected_Node, Semicolon => False); @@ -1049,6 +1055,7 @@ package body Ch9 is Accept_Node := New_Node (N_Accept_Statement, Token_Ptr); Scan; -- past ACCEPT Scope.Table (Scope.Last).Labl := Token_Node; + Current_Node := Token_Node; Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do)); @@ -1197,6 +1204,7 @@ package body Ch9 is Name_Node := P_Defining_Identifier; Set_Defining_Identifier (Entry_Node, Name_Node); Scope.Table (Scope.Last).Labl := Name_Node; + Current_Node := Name_Node; Formal_Part_Node := P_Entry_Body_Formal_Part; Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node); diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index bbcbff92c13..c9f81d07fd3 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index ec9a916be0b..01b4670458b 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -667,6 +667,12 @@ package body Util is pragma Assert (Scope.Last > 0); Scope.Decrement_Last; + if Include_Subprogram_In_Messages + and then Scope.Table (Scope.Last).Labl /= Error + then + Current_Node := Scope.Table (Scope.Last).Labl; + end if; + if Debug_Flag_P then Error_Msg_Uint_1 := UI_From_Int (Scope.Last); Error_Msg_SC ("decrement scope stack ptr, new value = ^!"); diff --git a/gcc/ada/put_spark_xrefs.adb b/gcc/ada/put_spark_xrefs.adb deleted file mode 100644 index a65fa8a9290..00000000000 --- a/gcc/ada/put_spark_xrefs.adb +++ /dev/null @@ -1,194 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- P U T _ S P A R K _ X R E F S -- --- -- --- B o d y -- --- -- --- Copyright (C) 2011-2016, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with SPARK_Xrefs; use SPARK_Xrefs; - -procedure Put_SPARK_Xrefs is -begin - -- Loop through entries in SPARK_File_Table - - for J in 1 .. SPARK_File_Table.Last loop - declare - F : SPARK_File_Record renames SPARK_File_Table.Table (J); - - begin - Write_Info_Initiate ('F'); - Write_Info_Char ('D'); - Write_Info_Char (' '); - Write_Info_Nat (F.File_Num); - Write_Info_Char (' '); - - Write_Info_Str (F.File_Name.all); - - -- If file is a subunit, print the file name for the unit - - if F.Unit_File_Name /= null then - Write_Info_Str (" -> " & F.Unit_File_Name.all); - end if; - - Write_Info_Terminate; - - -- Loop through scope entries for this file - - for J in F.From_Scope .. F.To_Scope loop - declare - S : SPARK_Scope_Record renames SPARK_Scope_Table.Table (J); - - begin - Write_Info_Initiate ('F'); - Write_Info_Char ('S'); - Write_Info_Char (' '); - Write_Info_Char ('.'); - Write_Info_Nat (S.Scope_Num); - Write_Info_Char (' '); - Write_Info_Nat (S.Line); - Write_Info_Char (S.Stype); - Write_Info_Nat (S.Col); - Write_Info_Char (' '); - - pragma Assert (S.Scope_Name.all /= ""); - - Write_Info_Str (S.Scope_Name.all); - - if S.Spec_File_Num /= 0 then - Write_Info_Str (" -> "); - Write_Info_Nat (S.Spec_File_Num); - Write_Info_Char ('.'); - Write_Info_Nat (S.Spec_Scope_Num); - end if; - - Write_Info_Terminate; - end; - end loop; - end; - end loop; - - -- Loop through entries in SPARK_File_Table - - for J in 1 .. SPARK_File_Table.Last loop - declare - F : SPARK_File_Record renames SPARK_File_Table.Table (J); - File : Nat; - Scope : Nat; - Entity_Line : Nat; - Entity_Col : Nat; - - begin - -- Loop through scope entries for this file - - for K in F.From_Scope .. F.To_Scope loop - Output_One_Scope : declare - S : SPARK_Scope_Record renames SPARK_Scope_Table.Table (K); - - begin - -- Write only non-empty tables - - if S.From_Xref <= S.To_Xref then - - Write_Info_Initiate ('F'); - Write_Info_Char ('X'); - Write_Info_Char (' '); - Write_Info_Nat (F.File_Num); - Write_Info_Char (' '); - - Write_Info_Str (F.File_Name.all); - - Write_Info_Char (' '); - Write_Info_Char ('.'); - Write_Info_Nat (S.Scope_Num); - Write_Info_Char (' '); - - Write_Info_Str (S.Scope_Name.all); - - -- Default value of (0,0) is used for the special __HEAP - -- variable so use another default value. - - Entity_Line := 0; - Entity_Col := 1; - - -- Loop through cross reference entries for this scope - - for X in S.From_Xref .. S.To_Xref loop - - Output_One_Xref : declare - R : SPARK_Xref_Record renames - SPARK_Xref_Table.Table (X); - - begin - if R.Entity_Line /= Entity_Line - or else R.Entity_Col /= Entity_Col - then - Write_Info_Terminate; - - Write_Info_Initiate ('F'); - Write_Info_Char (' '); - Write_Info_Nat (R.Entity_Line); - Write_Info_Char (R.Etype); - Write_Info_Nat (R.Entity_Col); - Write_Info_Char (' '); - - Write_Info_Str (R.Entity_Name.all); - - Entity_Line := R.Entity_Line; - Entity_Col := R.Entity_Col; - File := F.File_Num; - Scope := S.Scope_Num; - end if; - - if Write_Info_Col > 72 then - Write_Info_Terminate; - Write_Info_Initiate ('.'); - end if; - - Write_Info_Char (' '); - - if R.File_Num /= File then - Write_Info_Nat (R.File_Num); - Write_Info_Char ('|'); - File := R.File_Num; - Scope := 0; - end if; - - if R.Scope_Num /= Scope then - Write_Info_Char ('.'); - Write_Info_Nat (R.Scope_Num); - Write_Info_Char (':'); - Scope := R.Scope_Num; - end if; - - Write_Info_Nat (R.Line); - Write_Info_Char (R.Rtype); - Write_Info_Nat (R.Col); - end Output_One_Xref; - - end loop; - - Write_Info_Terminate; - end if; - end Output_One_Scope; - end loop; - end; - end loop; -end Put_SPARK_Xrefs; diff --git a/gcc/ada/put_spark_xrefs.ads b/gcc/ada/put_spark_xrefs.ads deleted file mode 100644 index fa4a4bc04e0..00000000000 --- a/gcc/ada/put_spark_xrefs.ads +++ /dev/null @@ -1,62 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- P U T _ S P A R K _ X R E F S -- --- -- --- S p e c -- --- -- --- Copyright (C) 2011-2016, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains the function used to read SPARK cross-reference --- information from the internal tables defined in package SPARK_Xrefs, and --- output text information for the ALI file. The interface allows control over --- the destination of the output, so that this routine can also be used for --- debugging purposes. - -with Types; use Types; - -generic - -- The following procedures are used to output text information. The - -- destination of the text information is thus under control of the - -- particular instantiation. In particular, this procedure is used to - -- write output to the ALI file, and also for debugging output. - - with function Write_Info_Col return Positive is <>; - -- Return the column in which the next character will be written - - with procedure Write_Info_Char (C : Character) is <>; - -- Output one character - - with procedure Write_Info_Str (Val : String) is <>; - -- Output string stored in string pointer - - with procedure Write_Info_Initiate (Key : Character) is <>; - -- Initiate write of new line to output file, the parameter is the - -- keyword character for the line. - - with procedure Write_Info_Nat (N : Nat) is <>; - -- Write image of N to output file with no leading or trailing blanks - - with procedure Write_Info_Terminate is <>; - -- Terminate current info line and output lines built in Info_Buffer - -procedure Put_SPARK_Xrefs; --- Read information from SPARK tables (SPARK_Xrefs.SPARK_Xref_Table, --- SPARK_Xrefs.SPARK_Scope_Table and SPARK_Xrefs.SPARK_File_Table) and output --- corresponding information in ALI format using the Write_Info procedures. diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index c4d7d3c80c6..57b8897f2da 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -631,6 +631,7 @@ package Rtsfind is RE_Get_Offset_Index, -- Ada.Tags RE_Get_Prim_Op_Kind, -- Ada.Tags RE_Get_Tagged_Kind, -- Ada.Tags + RE_HT_Link, -- Ada.Tags RE_Idepth, -- Ada.Tags RE_Interfaces_Array, -- Ada.Tags RE_Interfaces_Table, -- Ada.Tags @@ -1866,6 +1867,7 @@ package Rtsfind is RE_Get_Offset_Index => Ada_Tags, RE_Get_Prim_Op_Kind => Ada_Tags, RE_Get_Tagged_Kind => Ada_Tags, + RE_HT_Link => Ada_Tags, RE_Idepth => Ada_Tags, RE_Interfaces_Array => Ada_Tags, RE_Interfaces_Table => Ada_Tags, diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 444ad6072d4..95eadfc8854 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -157,7 +157,8 @@ pragma Style_Checks ("M32766"); # include <_types.h> #endif -#if defined (__linux__) || defined (__ANDROID__) || defined (__rtems__) +#if defined (__linux__) || defined (__ANDROID__) || defined (__QNX__) \ + || defined (__rtems__) # include <pthread.h> # include <signal.h> #endif @@ -1191,7 +1192,7 @@ CND(MSG_WAITALL, "Wait for full reception") #endif CND(MSG_NOSIGNAL, "No SIGPIPE on send") -#if defined (__linux__) || defined (__ANDROID__) +#if defined (__linux__) || defined (__ANDROID__) || defined (__QNX__) # define MSG_Forced_Flags "MSG_NOSIGNAL" #else # define MSG_Forced_Flags "0" @@ -1361,7 +1362,7 @@ CND(SIZEOF_struct_hostent, "struct hostent") #define SIZEOF_struct_servent (sizeof (struct servent)) CND(SIZEOF_struct_servent, "struct servent") -#if defined (__linux__) || defined (__ANDROID__) +#if defined (__linux__) || defined (__ANDROID__) || defined (__QNX__) #define SIZEOF_sigset (sizeof (sigset_t)) CND(SIZEOF_sigset, "sigset") #endif @@ -1464,7 +1465,7 @@ CNS(CLOCK_RT_Ada, "") #endif #if defined (__APPLE__) || defined (__linux__) || defined (__ANDROID__) \ - || defined (__rtems__) || defined (DUMMY) + || defined (__QNX__) || defined (__rtems__) || defined (DUMMY) /* -- Sizes of pthread data types diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index aaa3ccb2e40..02c8fa244ed 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -612,10 +612,12 @@ package body Sem is when N_With_Clause => Analyze_With_Clause (N); - -- A call to analyze a call marker is ignored because the node does - -- not have any static and run-time semantics. + -- A call to analyze a marker is ignored because the node does not + -- have any static and run-time semantics. - when N_Call_Marker => + when N_Call_Marker + | N_Variable_Reference_Marker + => null; -- A call to analyze the Empty node is an error, but most likely it diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 6c29b38b93a..7d6ae41c49e 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -418,6 +418,13 @@ package body Sem_Aggr is -- array of characters is expected. This procedure simply rewrites the -- string as an aggregate, prior to resolution. + --------------------------------- + -- Delta aggregate processing -- + --------------------------------- + + procedure Resolve_Delta_Array_Aggregate (N : Node_Id; Typ : Entity_Id); + procedure Resolve_Delta_Record_Aggregate (N : Node_Id; Typ : Entity_Id); + ------------------------ -- Array_Aggr_Subtype -- ------------------------ @@ -2758,10 +2765,196 @@ package body Sem_Aggr is ----------------------------- procedure Resolve_Delta_Aggregate (N : Node_Id; Typ : Entity_Id) is - Base : constant Node_Id := Expression (N); + Base : constant Node_Id := Expression (N); + + begin + if not Is_Composite_Type (Typ) then + Error_Msg_N ("not a composite type", N); + end if; + + Analyze_And_Resolve (Base, Typ); + + if Is_Array_Type (Typ) then + Resolve_Delta_Array_Aggregate (N, Typ); + else + Resolve_Delta_Record_Aggregate (N, Typ); + end if; + + Set_Etype (N, Typ); + end Resolve_Delta_Aggregate; + + ----------------------------------- + -- Resolve_Delta_Array_Aggregate -- + ----------------------------------- + + procedure Resolve_Delta_Array_Aggregate (N : Node_Id; Typ : Entity_Id) is Deltas : constant List_Id := Component_Associations (N); + Assoc : Node_Id; + Choice : Node_Id; + Index_Type : Entity_Id; + + begin + Index_Type := Etype (First_Index (Typ)); + + Assoc := First (Deltas); + while Present (Assoc) loop + if Nkind (Assoc) = N_Iterated_Component_Association then + Choice := First (Choice_List (Assoc)); + while Present (Choice) loop + if Nkind (Choice) = N_Others_Choice then + Error_Msg_N + ("others not allowed in delta aggregate", Choice); + + else + Analyze_And_Resolve (Choice, Index_Type); + end if; + + Next (Choice); + end loop; + + declare + Id : constant Entity_Id := Defining_Identifier (Assoc); + Ent : constant Entity_Id := + New_Internal_Entity + (E_Loop, Current_Scope, Sloc (Assoc), 'L'); + + begin + Set_Etype (Ent, Standard_Void_Type); + Set_Parent (Ent, Assoc); + + if No (Scope (Id)) then + Enter_Name (Id); + Set_Etype (Id, Index_Type); + Set_Ekind (Id, E_Variable); + Set_Scope (Id, Ent); + end if; + + Push_Scope (Ent); + Analyze_And_Resolve + (New_Copy_Tree (Expression (Assoc)), Component_Type (Typ)); + End_Scope; + end; + + else + Choice := First (Choice_List (Assoc)); + while Present (Choice) loop + if Nkind (Choice) = N_Others_Choice then + Error_Msg_N + ("others not allowed in delta aggregate", Choice); + + else + Analyze (Choice); + + if Is_Entity_Name (Choice) + and then Is_Type (Entity (Choice)) + then + -- Choice covers a range of values + + if Base_Type (Entity (Choice)) /= + Base_Type (Index_Type) + then + Error_Msg_NE + ("choice does mat match index type of", + Choice, Typ); + end if; + else + Resolve (Choice, Index_Type); + end if; + end if; + + Next (Choice); + end loop; + + Analyze_And_Resolve (Expression (Assoc), Component_Type (Typ)); + end if; + + Next (Assoc); + end loop; + end Resolve_Delta_Array_Aggregate; + + ------------------------------------ + -- Resolve_Delta_Record_Aggregate -- + ------------------------------------ + + procedure Resolve_Delta_Record_Aggregate (N : Node_Id; Typ : Entity_Id) is + + -- Variables used to verify that discriminant-dependent components + -- appear in the same variant. + + Comp_Ref : Entity_Id := Empty; -- init to avoid warning + Variant : Node_Id; + + procedure Check_Variant (Id : Entity_Id); + -- If a given component of the delta aggregate appears in a variant + -- part, verify that it is within the same variant as that of previous + -- specified variant components of the delta. + function Get_Component_Type (Nam : Node_Id) return Entity_Id; + -- Locate component with a given name and return its type. If none found + -- report error. + + function Nested_In (V1 : Node_Id; V2 : Node_Id) return Boolean; + -- Determine whether variant V1 is within variant V2 + + function Variant_Depth (N : Node_Id) return Integer; + -- Determine the distance of a variant to the enclosing type + -- declaration. + + -------------------- + -- Check_Variant -- + -------------------- + + procedure Check_Variant (Id : Entity_Id) is + Comp : Entity_Id; + Comp_Variant : Node_Id; + + begin + if not Has_Discriminants (Typ) then + return; + end if; + + Comp := First_Entity (Typ); + while Present (Comp) loop + exit when Chars (Comp) = Chars (Id); + Next_Component (Comp); + end loop; + + -- Find the variant, if any, whose component list includes the + -- component declaration. + + Comp_Variant := Parent (Parent (List_Containing (Parent (Comp)))); + if Nkind (Comp_Variant) = N_Variant then + if No (Variant) then + Variant := Comp_Variant; + Comp_Ref := Comp; + + elsif Variant /= Comp_Variant then + declare + D1 : constant Integer := Variant_Depth (Variant); + D2 : constant Integer := Variant_Depth (Comp_Variant); + + begin + if D1 = D2 + or else + (D1 > D2 and then not Nested_In (Variant, Comp_Variant)) + or else + (D2 > D1 and then not Nested_In (Comp_Variant, Variant)) + then + pragma Assert (Present (Comp_Ref)); + Error_Msg_Node_2 := Comp_Ref; + Error_Msg_NE + ("& and & appear in different variants", Id, Comp); + + -- Otherwise retain the deeper variant for subsequent tests + + elsif D2 > D1 then + Variant := Comp_Variant; + end if; + end; + end if; + end if; + end Check_Variant; ------------------------ -- Get_Component_Type -- @@ -2772,7 +2965,6 @@ package body Sem_Aggr is begin Comp := First_Entity (Typ); - while Present (Comp) loop if Chars (Comp) = Chars (Nam) then if Ekind (Comp) = E_Discriminant then @@ -2789,113 +2981,76 @@ package body Sem_Aggr is return Any_Type; end Get_Component_Type; - -- Local variables - - Assoc : Node_Id; - Choice : Node_Id; - Comp_Type : Entity_Id; - Index_Type : Entity_Id; + --------------- + -- Nested_In -- + --------------- - -- Start of processing for Resolve_Delta_Aggregate + function Nested_In (V1, V2 : Node_Id) return Boolean is + Par : Node_Id; - begin - if not Is_Composite_Type (Typ) then - Error_Msg_N ("not a composite type", N); - end if; + begin + Par := Parent (V1); + while Nkind (Par) /= N_Full_Type_Declaration loop + if Par = V2 then + return True; + end if; - Analyze_And_Resolve (Base, Typ); + Par := Parent (Par); + end loop; - if Is_Array_Type (Typ) then - Index_Type := Etype (First_Index (Typ)); - Assoc := First (Deltas); - while Present (Assoc) loop - if Nkind (Assoc) = N_Iterated_Component_Association then - Choice := First (Choice_List (Assoc)); - while Present (Choice) loop - if Nkind (Choice) = N_Others_Choice then - Error_Msg_N - ("others not allowed in delta aggregate", Choice); + return False; + end Nested_In; - else - Analyze_And_Resolve (Choice, Index_Type); - end if; + ------------------- + -- Variant_Depth -- + ------------------- - Next (Choice); - end loop; + function Variant_Depth (N : Node_Id) return Integer is + Depth : Integer; + Par : Node_Id; - declare - Id : constant Entity_Id := Defining_Identifier (Assoc); - Ent : constant Entity_Id := - New_Internal_Entity - (E_Loop, Current_Scope, Sloc (Assoc), 'L'); + begin + Depth := 0; + Par := Parent (N); + while Nkind (Par) /= N_Full_Type_Declaration loop + Depth := Depth + 1; + Par := Parent (Par); + end loop; - begin - Set_Etype (Ent, Standard_Void_Type); - Set_Parent (Ent, Assoc); - - if No (Scope (Id)) then - Enter_Name (Id); - Set_Etype (Id, Index_Type); - Set_Ekind (Id, E_Variable); - Set_Scope (Id, Ent); - end if; + return Depth; + end Variant_Depth; - Push_Scope (Ent); - Analyze_And_Resolve - (New_Copy_Tree (Expression (Assoc)), Component_Type (Typ)); - End_Scope; - end; + -- Local variables - else - Choice := First (Choice_List (Assoc)); - while Present (Choice) loop - if Nkind (Choice) = N_Others_Choice then - Error_Msg_N - ("others not allowed in delta aggregate", Choice); + Deltas : constant List_Id := Component_Associations (N); - else - Analyze (Choice); - if Is_Entity_Name (Choice) - and then Is_Type (Entity (Choice)) - then - -- Choice covers a range of values. - if Base_Type (Entity (Choice)) /= - Base_Type (Index_Type) - then - Error_Msg_NE - ("choice does mat match index type of", - Choice, Typ); - end if; - else - Resolve (Choice, Index_Type); - end if; - end if; + Assoc : Node_Id; + Choice : Node_Id; + Comp_Type : Entity_Id := Empty; -- init to avoid warning - Next (Choice); - end loop; + -- Start of processing for Resolve_Delta_Record_Aggregate - Analyze_And_Resolve (Expression (Assoc), Component_Type (Typ)); - end if; + begin + Variant := Empty; - Next (Assoc); - end loop; + Assoc := First (Deltas); + while Present (Assoc) loop + Choice := First (Choice_List (Assoc)); + while Present (Choice) loop + Comp_Type := Get_Component_Type (Choice); - else - Assoc := First (Deltas); - while Present (Assoc) loop - Choice := First (Choice_List (Assoc)); - while Present (Choice) loop - Comp_Type := Get_Component_Type (Choice); - Next (Choice); - end loop; + if Comp_Type /= Any_Type then + Check_Variant (Choice); + end if; - Analyze_And_Resolve (Expression (Assoc), Comp_Type); - Next (Assoc); + Next (Choice); end loop; - end if; - Set_Etype (N, Typ); - end Resolve_Delta_Aggregate; + pragma Assert (Present (Comp_Type)); + Analyze_And_Resolve (Expression (Assoc), Comp_Type); + Next (Assoc); + end loop; + end Resolve_Delta_Record_Aggregate; --------------------------------- -- Resolve_Extension_Aggregate -- diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 5aef17df8ec..cc4e39c50d8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -231,10 +231,10 @@ package body Sem_Attr is E1 : Node_Id; E2 : Node_Id; - P_Type : Entity_Id; + P_Type : Entity_Id := Empty; -- Type of prefix after analysis - P_Base_Type : Entity_Id; + P_Base_Type : Entity_Id := Empty; -- Base type of prefix after analysis ----------------------- @@ -419,7 +419,7 @@ package body Sem_Attr is -- required error messages. procedure Error_Attr_P (Msg : String); - pragma No_Return (Error_Attr); + pragma No_Return (Error_Attr_P); -- Like Error_Attr, but error is posted at the start of the prefix procedure Legal_Formal_Attribute; @@ -446,7 +446,9 @@ package body Sem_Attr is -- node in the aspect case). procedure Unexpected_Argument (En : Node_Id); - -- Signal unexpected attribute argument (En is the argument) + pragma No_Return (Unexpected_Argument); + -- Signal unexpected attribute argument (En is the argument), and then + -- raises Bad_Attribute to avoid any further semantic processing. procedure Validate_Non_Static_Attribute_Function_Call; -- Called when processing an attribute that is a function call to a @@ -1108,8 +1110,10 @@ package body Sem_Attr is -- node Nod is within enclosing node Encl_Nod. procedure Placement_Error; + pragma No_Return (Placement_Error); -- Emit a general error when the attributes does not appear in a - -- postcondition-like aspect or pragma. + -- postcondition-like aspect or pragma, and then raises Bad_Attribute + -- to avoid any further semantic processing. ------------------------------ -- Check_Placement_In_Check -- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index ac5035fd1bc..23f9ca7c223 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3466,9 +3466,9 @@ package body Sem_Ch12 is ------------------------------------------ procedure Analyze_Generic_Package_Declaration (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Decls : constant List_Id := - Visible_Declarations (Specification (N)); + Decls : constant List_Id := Visible_Declarations (Specification (N)); + Loc : constant Source_Ptr := Sloc (N); + Decl : Node_Id; Id : Entity_Id; New_N : Node_Id; @@ -3492,9 +3492,20 @@ package body Sem_Ch12 is Name => Make_Identifier (Loc, Chars (Defining_Entity (N)))); + -- The declaration is inserted before other declarations, but before + -- pragmas that may be library-unit pragmas and must appear before other + -- declarations. The pragma Compile_Time_Error is not in this class, and + -- may contain an expression that includes such a qualified name, so the + -- renaming declaration must appear before it. + + -- Are there other pragmas that require this special handling ??? + if Present (Decls) then Decl := First (Decls); - while Present (Decl) and then Nkind (Decl) = N_Pragma loop + while Present (Decl) + and then Nkind (Decl) = N_Pragma + and then Get_Pragma_Id (Decl) /= Pragma_Compile_Time_Error + loop Next (Decl); end loop; @@ -4761,7 +4772,7 @@ package body Sem_Ch12 is Use_Clauses : array (1 .. Scope_Stack_Depth) of Node_Id; Curr_Scope : Entity_Id := Empty; - List : Elist_Id; + List : Elist_Id := No_Elist; -- init to avoid warning N_Instances : Nat := 0; Num_Inner : Nat := 0; Num_Scopes : Nat := 0; @@ -5130,13 +5141,14 @@ package body Sem_Ch12 is is Loc : constant Source_Ptr := Sloc (N); Gen_Id : constant Node_Id := Name (N); + Errs : constant Nat := Serious_Errors_Detected; Anon_Id : constant Entity_Id := Make_Defining_Identifier (Sloc (Defining_Entity (N)), Chars => New_External_Name (Chars (Defining_Entity (N)), 'R')); - Act_Decl_Id : Entity_Id; + Act_Decl_Id : Entity_Id := Empty; -- init to avoid warning Act_Decl : Node_Id; Act_Spec : Node_Id; Act_Tree : Node_Id; @@ -5723,7 +5735,9 @@ package body Sem_Ch12 is end if; <<Leave>> - if Has_Aspects (N) then + -- Analyze aspects in declaration if no errors appear in the instance. + + if Has_Aspects (N) and then Serious_Errors_Detected = Errs then Analyze_Aspect_Specifications (N, Act_Decl_Id); end if; @@ -5895,8 +5909,7 @@ package body Sem_Ch12 is Present (Next_Formal (First_Formal (Formal_Subp))); Decl : Node_Id; - Expr : Node_Id; - pragma Warnings (Off, Expr); + Expr : Node_Id := Empty; F1, F2 : Entity_Id; Func : Entity_Id; Op_Name : Name_Id; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 564ff0dfc0a..83d31081fac 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1360,6 +1360,8 @@ package body Sem_Ch13 is ----------------------------------- procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is + pragma Assert (Present (E)); + procedure Decorate (Asp : Node_Id; Prag : Node_Id); -- Establish linkages between an aspect and its corresponding pragma @@ -1578,6 +1580,7 @@ package body Sem_Ch13 is Ent : Node_Id; L : constant List_Id := Aspect_Specifications (N); + pragma Assert (Present (L)); Ins_Node : Node_Id := N; -- Insert pragmas/attribute definition clause after this node when no @@ -1605,8 +1608,6 @@ package body Sem_Ch13 is -- of visibility for the expression analysis. Thus, we just insert -- the pragma after the node N. - pragma Assert (Present (L)); - -- Loop through aspects Aspect := First (L); @@ -1906,9 +1907,6 @@ package body Sem_Ch13 is ----------------------------------------- procedure Analyze_Aspect_Implicit_Dereference is - Disc : Entity_Id; - Parent_Disc : Entity_Id; - begin if not Is_Type (E) or else not Has_Discriminants (E) then Error_Msg_N @@ -1924,45 +1922,56 @@ package body Sem_Ch13 is -- Missing synchronized types??? - Disc := First_Discriminant (E); - while Present (Disc) loop - if Chars (Expr) = Chars (Disc) - and then Ekind_In (Etype (Disc), - E_Anonymous_Access_Subprogram_Type, - E_Anonymous_Access_Type) - then - Set_Has_Implicit_Dereference (E); - Set_Has_Implicit_Dereference (Disc); - exit; - end if; + declare + Disc : Entity_Id := First_Discriminant (E); + begin + while Present (Disc) loop + if Chars (Expr) = Chars (Disc) + and then Ekind_In + (Etype (Disc), + E_Anonymous_Access_Subprogram_Type, + E_Anonymous_Access_Type) + then + Set_Has_Implicit_Dereference (E); + Set_Has_Implicit_Dereference (Disc); + exit; + end if; - Next_Discriminant (Disc); - end loop; + Next_Discriminant (Disc); + end loop; - -- Error if no proper access discriminant + -- Error if no proper access discriminant - if No (Disc) then - Error_Msg_NE ("not an access discriminant of&", Expr, E); - return; - end if; - end if; + if Present (Disc) then + -- For a type extension, check whether parent has + -- a reference discriminant, to verify that use is + -- proper. - -- For a type extension, check whether parent has a - -- reference discriminant, to verify that use is proper. - - if Is_Derived_Type (E) - and then Has_Discriminants (Etype (E)) - then - Parent_Disc := Get_Reference_Discriminant (Etype (E)); + if Is_Derived_Type (E) + and then Has_Discriminants (Etype (E)) + then + declare + Parent_Disc : constant Entity_Id := + Get_Reference_Discriminant (Etype (E)); + begin + if Present (Parent_Disc) + and then Corresponding_Discriminant (Disc) /= + Parent_Disc + then + Error_Msg_N + ("reference discriminant does not match " + & "discriminant of parent type", Expr); + end if; + end; + end if; - if Present (Parent_Disc) - and then Corresponding_Discriminant (Disc) /= Parent_Disc - then - Error_Msg_N - ("reference discriminant does not match discriminant " - & "of parent type", Expr); - end if; + else + Error_Msg_NE + ("not an access discriminant of&", Expr, E); + end if; + end; end if; + end Analyze_Aspect_Implicit_Dereference; ----------------------- @@ -6529,7 +6538,7 @@ package body Sem_Ch13 is Max : Uint; -- Minimum and maximum values of entries - Max_Node : Node_Id; + Max_Node : Node_Id := Empty; -- init to avoid warning -- Pointer to node for literal providing max value begin @@ -8384,7 +8393,7 @@ package body Sem_Ch13 is -- This is the expression for the result of the function. It is -- is build by connecting the component predicates with AND THEN. - Expr_M : Node_Id; + Expr_M : Node_Id := Empty; -- init to avoid warning -- This is the corresponding return expression for the Predicate_M -- function. It differs in that raise expressions are marked for -- special expansion (see Process_REs). @@ -9925,7 +9934,7 @@ package body Sem_Ch13 is -- this tagged type and the parent component. Tagged_Parent will point -- to this parent type. For all other cases, Tagged_Parent is Empty. - Parent_Last_Bit : Uint; + Parent_Last_Bit : Uint := No_Uint; -- init to avoid warning -- Relevant only if Tagged_Parent is set, Parent_Last_Bit indicates the -- last bit position for any field in the parent type. We only need to -- check overlap for fields starting below this point. @@ -14317,7 +14326,7 @@ package body Sem_Ch13 is if Source_Siz /= Target_Siz then Error_Msg ("?z?types for unchecked conversion have different sizes!", - Eloc); + Eloc, Act_Unit); if All_Errors_Mode then Error_Msg_Name_1 := Chars (Source); @@ -14353,17 +14362,17 @@ package body Sem_Ch13 is if Bytes_Big_Endian then Error_Msg ("\?z?target value will include ^ undefined " - & "low order bits!", Eloc); + & "low order bits!", Eloc, Act_Unit); else Error_Msg ("\?z?target value will include ^ undefined " - & "high order bits!", Eloc); + & "high order bits!", Eloc, Act_Unit); end if; else Error_Msg ("\?z?^ trailing bits of target value will be " - & "undefined!", Eloc); + & "undefined!", Eloc, Act_Unit); end if; else pragma Assert (Source_Siz > Target_Siz); @@ -14371,17 +14380,17 @@ package body Sem_Ch13 is if Bytes_Big_Endian then Error_Msg ("\?z?^ low order bits of source will be " - & "ignored!", Eloc); + & "ignored!", Eloc, Act_Unit); else Error_Msg ("\?z?^ high order bits of source will be " - & "ignored!", Eloc); + & "ignored!", Eloc, Act_Unit); end if; else Error_Msg ("\?z?^ trailing bits of source will be " - & "ignored!", Eloc); + & "ignored!", Eloc, Act_Unit); end if; end if; end if; @@ -14435,10 +14444,10 @@ package body Sem_Ch13 is Error_Msg_Node_2 := D_Source; Error_Msg ("?z?alignment of & (^) is stricter than " - & "alignment of & (^)!", Eloc); + & "alignment of & (^)!", Eloc, Act_Unit); Error_Msg ("\?z?resulting access value may have invalid " - & "alignment!", Eloc); + & "alignment!", Eloc, Act_Unit); end if; end; end if; diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index f20a518d4d2..904a8f0f74f 100644 --- a/gcc/ada/sem_ch2.adb +++ b/gcc/ada/sem_ch2.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -68,9 +68,7 @@ package body Sem_Ch2 is -- this is the result of some kind of previous error generating a -- junk identifier. - if Chars (N) in Error_Name_Or_No_Name - and then Total_Errors_Detected /= 0 - then + if not Is_Valid_Name (Chars (N)) and then Total_Errors_Detected /= 0 then return; else Find_Direct_Name (N); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 1e3b78ccf2f..9dc39028033 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2818,19 +2818,23 @@ package body Sem_Ch3 is if Present (L) then Context := Parent (L); - -- Analyze the contracts of packages and their bodies + -- Certain contract annocations have forward visibility semantics and + -- must be analyzed after all declarative items have been processed. + -- This timing ensures that entities referenced by such contracts are + -- visible. - if Nkind (Context) = N_Package_Specification - and then L = Visible_Declarations (Context) - then - Analyze_Package_Contract (Defining_Entity (Context)); + -- Analyze the contract of an immediately enclosing package spec or + -- body first because other contracts may depend on its information. - elsif Nkind (Context) = N_Package_Body then + if Nkind (Context) = N_Package_Body then Analyze_Package_Body_Contract (Defining_Entity (Context)); + + elsif Nkind (Context) = N_Package_Specification then + Analyze_Package_Contract (Defining_Entity (Context)); end if; - -- Analyze the contracts of various constructs now due to the delayed - -- visibility needs of their aspects and pragmas. + -- Analyze the contracts of various constructs in the declarative + -- list. Analyze_Contracts (L); @@ -2848,13 +2852,13 @@ package body Sem_Ch3 is Remove_Visible_Refinements (Corresponding_Spec (Context)); Remove_Partial_Visible_Refinements (Corresponding_Spec (Context)); - elsif Nkind (Context) = N_Package_Declaration then + elsif Nkind (Context) = N_Package_Specification then -- Partial state refinements are visible up to the end of the -- package spec declarations. Hide the partial state refinements -- from visibility to restore the original state conditions. - Remove_Partial_Visible_Refinements (Corresponding_Spec (Context)); + Remove_Partial_Visible_Refinements (Defining_Entity (Context)); end if; -- Verify that all abstract states found in any package declared in @@ -6639,7 +6643,7 @@ package body Sem_Ch3 is Tdef : constant Node_Id := Type_Definition (N); Indic : constant Node_Id := Subtype_Indication (Tdef); Parent_Base : constant Entity_Id := Base_Type (Parent_Type); - Implicit_Base : Entity_Id; + Implicit_Base : Entity_Id := Empty; New_Indic : Node_Id; procedure Make_Implicit_Base; @@ -6751,7 +6755,7 @@ package body Sem_Ch3 is N_Subtype_Indication; D_Constraint : Node_Id; - New_Constraint : Elist_Id; + New_Constraint : Elist_Id := No_Elist; Old_Disc : Entity_Id; New_Disc : Entity_Id; New_N : Node_Id; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 538023524e3..d13140fb135 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -339,9 +339,8 @@ package body Sem_Ch4 is -------------------------- procedure List_Operand_Interps (Opnd : Node_Id) is - Nam : Node_Id; - pragma Warnings (Off, Nam); - Err : Node_Id := N; + Nam : Node_Id := Empty; + Err : Node_Id := N; begin if Is_Overloaded (Opnd) then @@ -413,13 +412,46 @@ package body Sem_Ch4 is -- Analyze_Aggregate -- ----------------------- - -- Most of the analysis of Aggregates requires that the type be known, - -- and is therefore put off until resolution. + -- Most of the analysis of Aggregates requires that the type be known, and + -- is therefore put off until resolution of the context. Delta aggregates + -- have a base component that determines the enclosing aggregate type so + -- its type can be ascertained earlier. This also allows delta aggregates + -- to appear in the context of a record type with a private extension, as + -- per the latest update of AI12-0127. procedure Analyze_Aggregate (N : Node_Id) is begin if No (Etype (N)) then - Set_Etype (N, Any_Composite); + if Nkind (N) = N_Delta_Aggregate then + declare + Base : constant Node_Id := Expression (N); + + I : Interp_Index; + It : Interp; + + begin + Analyze (Base); + + -- If the base is overloaded, propagate interpretations to the + -- enclosing aggregate. + + if Is_Overloaded (Base) then + Get_First_Interp (Base, I, It); + Set_Etype (N, Any_Type); + + while Present (It.Nam) loop + Add_One_Interp (N, It.Typ, It.Typ); + Get_Next_Interp (I, It); + end loop; + + else + Set_Etype (N, Etype (Base)); + end if; + end; + + else + Set_Etype (N, Any_Composite); + end if; end if; end Analyze_Aggregate; @@ -1043,12 +1075,11 @@ package body Sem_Ch4 is else declare - Outermost : Node_Id; + Outermost : Node_Id := Empty; -- init to avoid warning P : Node_Id := N; begin while Present (P) loop - -- For object declarations we can climb to the node from -- its object definition branch or from its initializing -- expression. We prefer to mark the child node as the @@ -1063,7 +1094,7 @@ package body Sem_Ch4 is Outermost := P; end if; - -- Avoid climbing more than needed! + -- Avoid climbing more than needed exit when Stop_Subtree_Climbing (Nkind (P)) or else (Nkind (P) = N_Range @@ -1488,6 +1519,30 @@ package body Sem_Ch4 is and then Present (Non_Limited_View (Etype (N))) then Set_Etype (N, Non_Limited_View (Etype (N))); + + -- If there is no completion for the type, this may be because + -- there is only a limited view of it and there is nothing in + -- the context of the current unit that has required a regular + -- compilation of the unit containing the type. We recognize + -- this unusual case by the fact that that unit is not analyzed. + -- Note that the call being analyzed is in a different unit from + -- the function declaration, and nothing indicates that the type + -- is a limited view. + + elsif Ekind (Scope (Etype (N))) = E_Package + and then Present (Limited_View (Scope (Etype (N)))) + and then not Analyzed (Unit_Declaration_Node (Scope (Etype (N)))) + then + Error_Msg_NE + ("cannot call function that returns limited view of}", + N, Etype (N)); + + Error_Msg_NE + ("\there must be a regular with_clause for package & in the " + & "current unit, or in some unit in its context", + N, Scope (Etype (N))); + + Set_Etype (N, Any_Type); end if; end if; end if; @@ -1667,11 +1722,11 @@ package body Sem_Ch4 is else Analyze_Choices (Alternatives (N), Exp_Type); Check_Choices (N, Alternatives (N), Exp_Type, Others_Present); - end if; - if Exp_Type = Universal_Integer and then not Others_Present then - Error_Msg_N - ("case on universal integer requires OTHERS choice", Expr); + if Exp_Type = Universal_Integer and then not Others_Present then + Error_Msg_N + ("case on universal integer requires OTHERS choice", Expr); + end if; end if; end Analyze_Case_Expression; @@ -4988,10 +5043,13 @@ package body Sem_Ch4 is end if; end if; - Next_Entity (Comp); + -- Do not examine private operations if not within scope of + -- the synchronized type. + exit when not In_Scope and then Comp = First_Private_Entity (Base_Type (Prefix_Type)); + Next_Entity (Comp); end loop; -- If the scope is a current instance, the prefix cannot be an @@ -8649,7 +8707,8 @@ package body Sem_Ch4 is else -- The type of the subprogram may be a limited view obtained -- transitively from another unit. If full view is available, - -- use it to analyze call. + -- use it to analyze call. If there is no nonlimited view, then + -- this is diagnosed when analyzing the rewritten call. declare T : constant Entity_Id := Etype (Subprog); @@ -9094,9 +9153,8 @@ package body Sem_Ch4 is declare Dup_Call_Node : constant Node_Id := New_Copy (New_Call_Node); - CW_Result : Boolean; - Prim_Result : Boolean; - pragma Unreferenced (CW_Result); + Ignore : Boolean; + Prim_Result : Boolean := False; begin if not CW_Test_Only then @@ -9111,7 +9169,7 @@ package body Sem_Ch4 is -- was found in order to report ambiguous calls. if not Prim_Result then - CW_Result := + Ignore := Try_Class_Wide_Operation (Call_Node => New_Call_Node, Node_To_Replace => Node_To_Replace); @@ -9121,7 +9179,7 @@ package body Sem_Ch4 is -- decoration if there is no ambiguity). else - CW_Result := + Ignore := Try_Class_Wide_Operation (Call_Node => Dup_Call_Node, Node_To_Replace => Node_To_Replace); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 10002ea08c2..14cf2e5a732 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -391,7 +391,8 @@ package body Sem_Ch5 is T1 : Entity_Id; T2 : Entity_Id; - Save_Full_Analysis : Boolean; + Save_Full_Analysis : Boolean := False; + -- Force initialization to facilitate static analysis Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; -- Save the Ghost mode to restore on exit diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 4f719e9b81c..a6d70e5b597 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1039,7 +1039,7 @@ package body Sem_Ch6 is --------------------- Expr : Node_Id; - Obj_Decl : Node_Id; + Obj_Decl : Node_Id := Empty; -- Start of processing for Analyze_Function_Return @@ -1190,13 +1190,16 @@ package body Sem_Ch6 is -- Case of Expr present - if Present (Expr) + if Present (Expr) then - -- Defend against previous errors + -- Defend against previous errors + + if Nkind (Expr) = N_Empty + or else No (Etype (Expr)) + then + return; + end if; - and then Nkind (Expr) /= N_Empty - and then Present (Etype (Expr)) - then -- Apply constraint check. Note that this is done before the implicit -- conversion of the expression done for anonymous access types to -- ensure correct generation of the null-excluding check associated @@ -1510,6 +1513,7 @@ package body Sem_Ch6 is Process_End_Label (Handled_Statement_Sequence (N), 't', Current_Scope); Update_Use_Clause_Chain; + Validate_Categorization_Dependency (N, Gen_Id); End_Scope; Check_Subprogram_Order (N); @@ -3456,7 +3460,7 @@ package body Sem_Ch6 is -- Start of processing for Analyze_Subprogram_Body_Helper begin - -- A [generic] subprogram body "freezes" the contract of the nearest + -- A [generic] subprogram body freezes the contract of the nearest -- enclosing package body and all other contracts encountered in the -- same declarative part up to and excluding the subprogram body: @@ -3469,17 +3473,17 @@ package body Sem_Ch6 is -- with Refined_Depends => (Input => Constit) ... -- This ensures that any annotations referenced by the contract of the - -- [generic] subprogram body are available. This form of "freezing" is + -- [generic] subprogram body are available. This form of freezing is -- decoupled from the usual Freeze_xxx mechanism because it must also -- work in the context of generics where normal freezing is disabled. - -- Only bodies coming from source should cause this type of "freezing". + -- Only bodies coming from source should cause this type of freezing. -- Expression functions that act as bodies and complete an initial -- declaration must be included in this category, hence the use of -- Original_Node. if Comes_From_Source (Original_Node (N)) then - Analyze_Previous_Contracts (N); + Freeze_Previous_Contracts (N); end if; -- Generic subprograms are handled separately. They always have a @@ -4354,7 +4358,7 @@ package body Sem_Ch6 is end if; end if; - -- A subprogram body "freezes" its own contract. Analyze the contract + -- A subprogram body freezes its own contract. Analyze the contract -- after the declarations of the body have been processed as pragmas -- are now chained on the contract of the subprogram body. @@ -10118,7 +10122,6 @@ package body Sem_Ch6 is function Visible_Part_Type (T : Entity_Id) return Boolean is P : constant Node_Id := Unit_Declaration_Node (Scope (T)); - N : Node_Id; begin -- If the entity is a private type, then it must be declared in a @@ -10126,34 +10129,19 @@ package body Sem_Ch6 is if Ekind (T) in Private_Kind then return True; - end if; - - -- Otherwise, we traverse the visible part looking for its - -- corresponding declaration. We cannot use the declaration - -- node directly because in the private part the entity of a - -- private type is the one in the full view, which does not - -- indicate that it is the completion of something visible. - - N := First (Visible_Declarations (Specification (P))); - while Present (N) loop - if Nkind (N) = N_Full_Type_Declaration - and then Present (Defining_Identifier (N)) - and then T = Defining_Identifier (N) - then - return True; - elsif Nkind_In (N, N_Private_Type_Declaration, - N_Private_Extension_Declaration) - and then Present (Defining_Identifier (N)) - and then T = Full_View (Defining_Identifier (N)) - then - return True; - end if; + elsif Is_Type (T) and then Has_Private_Declaration (T) then + return True; - Next (N); - end loop; + elsif Is_List_Member (Declaration_Node (T)) + and then List_Containing (Declaration_Node (T)) = + Visible_Declarations (Specification (P)) + then + return True; - return False; + else + return False; + end if; end Visible_Part_Type; -- Start of processing for Check_For_Primitive_Subprogram diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index dc00cf9f249..f50b8669529 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -707,9 +707,9 @@ package body Sem_Ch7 is end if; end if; - -- A [generic] package body "freezes" the contract of the nearest - -- enclosing package body and all other contracts encountered in the - -- same declarative part up to and excluding the package body: + -- A [generic] package body freezes the contract of the nearest + -- enclosing package body and all other contracts encountered in + -- the same declarative part up to and excluding the package body: -- package body Nearest_Enclosing_Package -- with Refined_State => (State => Constit) @@ -726,21 +726,21 @@ package body Sem_Ch7 is -- This ensures that any annotations referenced by the contract of a -- [generic] subprogram body declared within the current package body - -- are available. This form of "freezing" is decoupled from the usual + -- are available. This form of freezing is decoupled from the usual -- Freeze_xxx mechanism because it must also work in the context of -- generics where normal freezing is disabled. - -- Only bodies coming from source should cause this type of "freezing". + -- Only bodies coming from source should cause this type of freezing. -- Instantiated generic bodies are excluded because their processing is -- performed in a separate compilation pass which lacks enough semantic -- information with respect to contract analysis. It is safe to suppress - -- the "freezing" of contracts in this case because this action already + -- the freezing of contracts in this case because this action already -- took place at the end of the enclosing declarative part. if Comes_From_Source (N) and then not Is_Generic_Instance (Spec_Id) then - Analyze_Previous_Contracts (N); + Freeze_Previous_Contracts (N); end if; -- A package body is Ghost when the corresponding spec is Ghost. Set @@ -876,10 +876,6 @@ package body Sem_Ch7 is Declare_Inherited_Private_Subprograms (Spec_Id); end if; - -- A package body "freezes" the contract of its initial declaration. - -- This analysis depends on attribute Corresponding_Spec being set. Only - -- bodies coming from source shuld cause this type of "freezing". - if Present (Declarations (N)) then Analyze_Declarations (Declarations (N)); Inspect_Deferred_Constant_Completion (Declarations (N)); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index bdc8aba1e1f..d8d5b7b5c04 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5358,6 +5358,8 @@ package body Sem_Ch8 is -- Local variables + Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes; + Nested_Inst : Entity_Id := Empty; -- The entity of a nested instance which appears within Inst (if any) @@ -5895,9 +5897,20 @@ package body Sem_Ch8 is <<Done>> Check_Restriction_No_Use_Of_Entity (N); - -- Save the scenario for later examination by the ABE Processing phase + -- Annotate the tree by creating a variable reference marker in case the + -- original variable reference is folded or optimized away. The variable + -- reference marker is automatically saved for later examination by the + -- ABE Processing phase. Variable references which act as actuals in a + -- call require special processing and are left to Resolve_Actuals. The + -- reference is a write when it appears on the left hand side of an + -- assignment. - Record_Elaboration_Scenario (N); + if not Within_Subprogram_Call (N) then + Build_Variable_Reference_Marker + (N => N, + Read => not Is_Assignment_LHS, + Write => Is_Assignment_LHS); + end if; end Find_Direct_Name; ------------------------ @@ -5969,8 +5982,10 @@ package body Sem_Ch8 is -- Local variables - Selector : constant Node_Id := Selector_Name (N); - Candidate : Entity_Id := Empty; + Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes; + Selector : constant Node_Id := Selector_Name (N); + + Candidate : Entity_Id := Empty; P_Name : Entity_Id; Id : Entity_Id; @@ -6529,9 +6544,20 @@ package body Sem_Ch8 is Check_Restriction_No_Use_Of_Entity (N); - -- Save the scenario for later examination by the ABE Processing phase + -- Annotate the tree by creating a variable reference marker in case the + -- original variable reference is folded or optimized away. The variable + -- reference marker is automatically saved for later examination by the + -- ABE Processing phase. Variable references which act as actuals in a + -- call require special processing and are left to Resolve_Actuals. The + -- reference is a write when it appears on the left hand side of an + -- assignment. - Record_Elaboration_Scenario (N); + if not Within_Subprogram_Call (N) then + Build_Variable_Reference_Marker + (N => N, + Read => not Is_Assignment_LHS, + Write => Is_Assignment_LHS); + end if; end Find_Expanded_Name; -------------------- @@ -8294,6 +8320,7 @@ package body Sem_Ch8 is procedure Mark_Use_Type (E : Entity_Id) is Curr : Node_Id; + Base : Entity_Id; begin -- Ignore void types and unresolved string literals and primitives @@ -8305,12 +8332,22 @@ package body Sem_Ch8 is return; end if; + -- Primitives with class-wide operands might additionally render + -- their base type's use_clauses effective - so do a recursive check + -- here. + + Base := Base_Type (Etype (E)); + + if Ekind (Base) = E_Class_Wide_Type then + Mark_Use_Type (Base); + end if; + -- The package containing the type or operator function being used -- may be in use as well, so mark any use_package_clauses for it as -- effective. There are also additional sanity checks performed here -- for ignoring previous errors. - Mark_Use_Package (Scope (Base_Type (Etype (E)))); + Mark_Use_Package (Scope (Base)); if Nkind (E) in N_Op and then Present (Entity (E)) @@ -8319,7 +8356,7 @@ package body Sem_Ch8 is Mark_Use_Package (Scope (Entity (E))); end if; - Curr := Current_Use_Clause (Base_Type (Etype (E))); + Curr := Current_Use_Clause (Base); while Present (Curr) and then not Is_Effective_Use_Clause (Curr) loop @@ -8371,7 +8408,9 @@ package body Sem_Ch8 is or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure)) and then (Is_Potentially_Use_Visible (Id) - or else Is_Intrinsic_Subprogram (Id)) + or else Is_Intrinsic_Subprogram (Id) + or else (Ekind_In (Id, E_Function, E_Procedure) + and then Is_Generic_Actual_Subprogram (Id))) then Mark_Parameters (Id); end if; @@ -9057,6 +9096,7 @@ package body Sem_Ch8 is and then Comes_From_Source (Curr) and then not Is_Effective_Use_Clause (Curr) and then not In_Instance + and then not In_Inlined_Body then -- We are dealing with a potentially unused use_package_clause @@ -9400,7 +9440,10 @@ package body Sem_Ch8 is -- Warn about detected redundant clauses - elsif In_Open_Scopes (P) and not Force then + elsif not Force + and then In_Open_Scopes (P) + and then not Is_Hidden_Open_Scope (P) + then if Warn_On_Redundant_Constructs and then P = Current_Scope then Error_Msg_NE -- CODEFIX ("& is already use-visible within itself?r?", @@ -9865,6 +9908,7 @@ package body Sem_Ch8 is and then not Spec_Reloaded_For_Body and then not In_Instance + and then not In_Inlined_Body then -- The type already has a use clause diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 199cd8a8c7a..766742297fa 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1210,13 +1210,13 @@ package body Sem_Ch9 is Entry_Name : Entity_Id; begin - -- An entry body "freezes" the contract of the nearest enclosing package + -- An entry body freezes the contract of the nearest enclosing package -- body and all other contracts encountered in the same declarative part -- up to and excluding the entry body. This ensures that any annotations -- referenced by the contract of an entry or subprogram body declared -- within the current protected body are available. - Analyze_Previous_Contracts (N); + Freeze_Previous_Contracts (N); Tasking_Used := True; @@ -1794,14 +1794,14 @@ package body Sem_Ch9 is -- Start of processing for Analyze_Protected_Body begin - -- A protected body "freezes" the contract of the nearest enclosing + -- A protected body freezes the contract of the nearest enclosing -- package body and all other contracts encountered in the same - -- declarative part up to and excluding the protected body. This ensures - -- that any annotations referenced by the contract of an entry or - -- subprogram body declared within the current protected body are - -- available. + -- declarative part up to and excluding the protected body. This + -- ensures that any annotations referenced by the contract of an + -- entry or subprogram body declared within the current protected + -- body are available. - Analyze_Previous_Contracts (N); + Freeze_Previous_Contracts (N); Tasking_Used := True; Set_Ekind (Body_Id, E_Protected_Body); @@ -2287,7 +2287,7 @@ package body Sem_Ch9 is Target_Obj : Node_Id := Empty; Req_Scope : Entity_Id; Outer_Ent : Entity_Id; - Synch_Type : Entity_Id; + Synch_Type : Entity_Id := Empty; begin -- Preserve relevant elaboration-related attributes of the context which @@ -2900,13 +2900,13 @@ package body Sem_Ch9 is -- a single task, since Spec_Id is set to the task type). begin - -- A task body "freezes" the contract of the nearest enclosing package + -- A task body freezes the contract of the nearest enclosing package -- body and all other contracts encountered in the same declarative part -- up to and excluding the task body. This ensures that annotations -- referenced by the contract of an entry or subprogram body declared -- within the current protected body are available. - Analyze_Previous_Contracts (N); + Freeze_Previous_Contracts (N); Tasking_Used := True; Set_Scope (Body_Id, Current_Scope); @@ -3513,10 +3513,10 @@ package body Sem_Ch9 is -- declarations. Search for the private type declaration. declare - Full_T_Ifaces : Elist_Id; + Full_T_Ifaces : Elist_Id := No_Elist; Iface : Node_Id; Priv_T : Entity_Id; - Priv_T_Ifaces : Elist_Id; + Priv_T_Ifaces : Elist_Id := No_Elist; begin Priv_T := First_Entity (Scope (T)); diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index a271ca55960..44166002ee9 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -903,13 +903,13 @@ package body Sem_Dim is Choice : Node_Id; Dim_Aggr : Node_Id; Dim_Symbol : Node_Id; - Dim_Symbols : Symbol_Array := No_Symbols; - Dim_System : System_Type := Null_System; - Position : Nat := 0; + Dim_Symbols : Symbol_Array := No_Symbols; + Dim_System : System_Type := Null_System; + Position : Dimension_Position := Invalid_Position; Unit_Name : Node_Id; - Unit_Names : Name_Array := No_Names; + Unit_Names : Name_Array := No_Names; Unit_Symbol : Node_Id; - Unit_Symbols : Symbol_Array := No_Symbols; + Unit_Symbols : Symbol_Array := No_Symbols; Errors_Count : Nat; -- Errors_Count is a count of errors detected by the compiler so far @@ -949,13 +949,13 @@ package body Sem_Dim is Dim_Aggr := First (Expressions (Aggr)); Errors_Count := Serious_Errors_Detected; while Present (Dim_Aggr) loop - Position := Position + 1; - - if Position > High_Position_Bound then + if Position = High_Position_Bound then Error_Msg_N ("too many dimensions in system", Aggr); exit; end if; + Position := Position + 1; + if Nkind (Dim_Aggr) /= N_Aggregate then Error_Msg_N ("aggregate expected", Dim_Aggr); diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 974edd35679..4cc41e3acaa 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -404,7 +404,7 @@ package body Sem_Disp is Func : Entity_Id; Subp_Entity : Entity_Id; Indeterm_Ancestor_Call : Boolean := False; - Indeterm_Ctrl_Type : Entity_Id; + Indeterm_Ctrl_Type : Entity_Id := Empty; -- init to avoid warning Static_Tag : Node_Id := Empty; -- If a controlling formal has a statically tagged actual, the tag of @@ -2371,16 +2371,26 @@ package body Sem_Disp is ----------------------------------- function Is_Inherited_Public_Operation (Op : Entity_Id) return Boolean is - Prim : constant Entity_Id := Alias (Op); - Scop : constant Entity_Id := Scope (Prim); Pack_Decl : Node_Id; + Prim : Entity_Id := Op; + Scop : Entity_Id := Prim; begin + -- Locate the ultimate non-hidden alias entity + + while Present (Alias (Prim)) and then not Is_Hidden (Alias (Prim)) loop + pragma Assert (Alias (Prim) /= Prim); + Prim := Alias (Prim); + Scop := Scope (Prim); + end loop; + if Comes_From_Source (Prim) and then Ekind (Scop) = E_Package then Pack_Decl := Unit_Declaration_Node (Scop); - return Nkind (Pack_Decl) = N_Package_Declaration - and then List_Containing (Unit_Declaration_Node (Prim)) = - Visible_Declarations (Specification (Pack_Decl)); + + return + Nkind (Pack_Decl) = N_Package_Declaration + and then List_Containing (Unit_Declaration_Node (Prim)) = + Visible_Declarations (Specification (Pack_Decl)); else return False; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 8dec4280eb3..b3077adfbf8 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -26,6 +26,7 @@ with Atree; use Atree; with Debug; use Debug; with Einfo; use Einfo; +with Elists; use Elists; with Errout; use Errout; with Exp_Ch11; use Exp_Ch11; with Exp_Tss; use Exp_Tss; @@ -67,7 +68,7 @@ package body Sem_Elab is -- * Diagnose at compile-time or install run-time checks to prevent ABE -- access to data and behaviour. -- - -- The high level idea is to accurately diagnose ABE issues within a + -- The high-level idea is to accurately diagnose ABE issues within a -- single unit because the ABE mechanism can inspect the whole unit. -- As soon as the elaboration graph extends to an external unit, the -- diagnostics stop because the body of the unit may not be available. @@ -127,7 +128,7 @@ package body Sem_Elab is -- * Declaration level - A type of enclosing level. A scenario or target is -- at the declaration level when it appears within the declarations of a -- block statement, entry body, subprogram body, or task body, ignoring - -- enclosing packges. + -- enclosing packages. -- -- * Generic library level - A type of enclosing level. A scenario or -- target is at the generic library level if it appears in a generic @@ -145,8 +146,8 @@ package body Sem_Elab is -- the library level if it appears in a package library unit, ignoring -- enclosng packages. -- - -- * Non-library level encapsulator - A construct that cannot be elaborated - -- on its own and requires elaboration by a top level scenario. + -- * Non-library-level encapsulator - A construct that cannot be elaborated + -- on its own and requires elaboration by a top-level scenario. -- -- * Scenario - A construct or context which may be elaborated or executed -- by elaboration code. The scenarios recognized by the ABE mechanism are @@ -180,7 +181,7 @@ package body Sem_Elab is -- -- - For task activation, the target is the task body -- - -- * Top level scenario - A scenario which appears in a non-generic main + -- * Top-level scenario - A scenario which appears in a non-generic main -- unit. Depending on the elaboration model is in effect, the following -- addotional restrictions apply: -- @@ -197,7 +198,7 @@ package body Sem_Elab is -- The Recording phase coincides with the analysis/resolution phase of the -- compiler. It has the following objectives: -- - -- * Record all top level scenarios for examination by the Processing + -- * Record all top-level scenarios for examination by the Processing -- phase. -- -- Saving only a certain number of nodes improves the performance of @@ -230,9 +231,9 @@ package body Sem_Elab is -- and/or inlining of bodies, but before the removal of Ghost code. It has -- the following objectives: -- - -- * Examine all top level scenarios saved during the Recording phase + -- * Examine all top-level scenarios saved during the Recording phase -- - -- The top level scenarios act as roots for depth-first traversal of + -- The top-level scenarios act as roots for depth-first traversal of -- the call/instantiation/task activation graph. The traversal stops -- when an outgoing edge leaves the main unit. -- @@ -293,7 +294,7 @@ package body Sem_Elab is -- | | | -- | +--> Process_Variable_Assignment | -- | | | - -- | +--> Process_Variable_Read | + -- | +--> Process_Variable_Reference | -- | | -- +------------------------- Processing phase -------------------------+ @@ -419,8 +420,7 @@ package body Sem_Elab is -- The following steps describe how to add a new elaboration scenario and -- preserve the existing architecture. -- - -- 1) If necessary, update predicates Is_Check_Emitting_Scenario and - -- Is_Scenario. + -- 1) If necessary, update predicate Is_Scenario -- -- 2) Add predicate Is_Suitable_xxx. Include a call to it in predicate -- Is_Suitable_Scenario. @@ -683,10 +683,6 @@ package body Sem_Elab is -- variable. type Variable_Attributes is record - SPARK_Mode_On : Boolean; - -- This flag is set when the variable appears in a region subject to - -- pragma SPARK_Mode with value On, or starts one such region. - Unit_Id : Entity_Id; -- This attribute denotes the entity of the compilation unit where the -- variable resides. @@ -715,8 +711,28 @@ package body Sem_Elab is Hash => Elaboration_Context_Hash, Equal => "="); + -- The following table stores a status flag for each top-level scenario + -- recorded in table Top_Level_Scenarios. + + Recorded_Top_Level_Scenarios_Max : constant := 503; + + type Recorded_Top_Level_Scenarios_Index is + range 0 .. Recorded_Top_Level_Scenarios_Max - 1; + + function Recorded_Top_Level_Scenarios_Hash + (Key : Node_Id) return Recorded_Top_Level_Scenarios_Index; + -- Obtain the hash value of entity Key + + package Recorded_Top_Level_Scenarios is new Simple_HTable + (Header_Num => Recorded_Top_Level_Scenarios_Index, + Element => Boolean, + No_Element => False, + Key => Node_Id, + Hash => Recorded_Top_Level_Scenarios_Hash, + Equal => "="); + -- The following table stores all active scenarios in a recursive traversal - -- starting from a top level scenario. This table must be maintained in a + -- starting from a top-level scenario. This table must be maintained in a -- FIFO fashion. package Scenario_Stack is new Table.Table @@ -727,7 +743,7 @@ package body Sem_Elab is Table_Increment => 100, Table_Name => "Scenario_Stack"); - -- The following table stores all top level scenario saved during the + -- The following table stores all top-level scenario saved during the -- Recording phase. The contents of this table act as traversal roots -- later in the Processing phase. This table must be maintained in a -- LIFO fashion. @@ -741,7 +757,7 @@ package body Sem_Elab is Table_Name => "Top_Level_Scenarios"); -- The following table stores the bodies of all eligible scenarios visited - -- during a traversal starting from a top level scenario. The contents of + -- during a traversal starting from a top-level scenario. The contents of -- this table must be reset upon each new traversal. Visited_Bodies_Max : constant := 511; @@ -785,12 +801,15 @@ package body Sem_Elab is -- string " in SPARK" is added to the end of the message. procedure Ensure_Prior_Elaboration - (N : Node_Id; - Unit_Id : Entity_Id; - In_Task_Body : Boolean); + (N : Node_Id; + Unit_Id : Entity_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Guarantee the elaboration of unit Unit_Id with respect to the main unit. - -- N denotes the related scenario. Flag In_Task_Body should be set when the - -- need for elaboration is initiated from a task body. + -- N denotes the related scenario. Flag In_Partial_Fin should be set when + -- the need for elaboration is initiated by a partial finalization routine. + -- Flag In_Task_Body should be set when the need for prior elaboration is + -- initiated from a task body. procedure Ensure_Prior_Elaboration_Dynamic (N : Node_Id; @@ -867,7 +886,7 @@ package body Sem_Elab is -- Return the code unit which contains arbitrary node or entity N. This -- is the unit of the file which physically contains the related construct -- denoted by N except when N is within an instantiation. In that case the - -- unit is that of the top level instantiation. + -- unit is that of the top-level instantiation. procedure Find_Elaborated_Units; -- Populate table Elaboration_Context with all units which have prior @@ -962,16 +981,16 @@ package body Sem_Elab is -- information message, otherwise it emits an error. If flag In_SPARK -- is set, then string " in SPARK" is added to the end of the message. - procedure Info_Variable_Read + procedure Info_Variable_Reference (Ref : Node_Id; Var_Id : Entity_Id; Info_Msg : Boolean; In_SPARK : Boolean); - pragma Inline (Info_Variable_Read); - -- Output information concerning reference Ref which reads variable Var_Id. - -- If flag Info_Msg is set, the routine emits an information message, - -- otherwise it emits an error. If flag In_SPARK is set, then string " in - -- SPARK" is added to the end of the message. + pragma Inline (Info_Variable_Reference); + -- Output information concerning reference Ref which mentions variable + -- Var_Id. If flag Info_Msg is set, the routine emits an information + -- message, otherwise it emits an error. If flag In_SPARK is set, then + -- string " in SPARK" is added to the end of the message. function Insertion_Node (N : Node_Id; Ins_Nod : Node_Id) return Node_Id; pragma Inline (Insertion_Node); @@ -1019,11 +1038,6 @@ package body Sem_Elab is pragma Inline (Is_Bodiless_Subprogram); -- Determine whether subprogram Subp_Id will never have a body - function Is_Check_Emitting_Scenario (N : Node_Id) return Boolean; - pragma Inline (Is_Check_Emitting_Scenario); - -- Determine whether arbitrary node N denotes a scenario which may emit a - -- conditional ABE check. - function Is_Controlled_Proc (Subp_Id : Entity_Id; Subp_Nam : Name_Id) return Boolean; @@ -1101,6 +1115,11 @@ package body Sem_Elab is -- Determine whether entity Id denotes the protected or unprotected version -- of a protected subprogram. + function Is_Recorded_Top_Level_Scenario (N : Node_Id) return Boolean; + pragma Inline (Is_Recorded_Top_Level_Scenario); + -- Determine whether arbitrary node is a recorded top-level scenario which + -- appears in table Top_Level_Scenarios. + function Is_Safe_Activation (Call : Node_Id; Task_Decl : Node_Id) return Boolean; @@ -1163,10 +1182,10 @@ package body Sem_Elab is -- Determine whether arbitrary node N denotes a suitable assignment for ABE -- processing. - function Is_Suitable_Variable_Read (N : Node_Id) return Boolean; - pragma Inline (Is_Suitable_Variable_Read); - -- Determine whether arbitrary node N is a suitable variable read for ABE - -- processing. + function Is_Suitable_Variable_Reference (N : Node_Id) return Boolean; + pragma Inline (Is_Suitable_Variable_Reference); + -- Determine whether arbitrary node N is a suitable variable reference for + -- ABE processing. function Is_Task_Entry (Id : Entity_Id) return Boolean; pragma Inline (Is_Task_Entry); @@ -1202,86 +1221,111 @@ package body Sem_Elab is -- Pop the top of the scenario stack. A check is made to ensure that the -- scenario being removed is the same as N. - procedure Process_Access (Attr : Node_Id; In_Task_Body : Boolean); + procedure Process_Access + (Attr : Node_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Perform ABE checks and diagnostics for 'Access to entry, operator, or - -- subprogram denoted by Attr. Flag In_Task_Body should be set when the - -- processing is initiated from a task body. + -- subprogram denoted by Attr. Flag In_Partial_Fin shoud be set when the + -- processing is initiated by a partial finalization routine. Flag + -- In_Task_Body should be set when the processing is initiated from a task + -- body. generic with procedure Process_Single_Activation - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Obj_Id : Entity_Id; - Task_Attrs : Task_Attributes; - In_Task_Body : Boolean); + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Perform ABE checks and diagnostics for task activation call Call -- which activates task Obj_Id. Call_Attrs are the attributes of the -- activation call. Task_Attrs are the attributes of the task type. - -- Flag In_Task_Body should be set when the processing is initiated - -- from a task body. + -- Flag In_Partial_Fin shoud be set when the processing is initiated + -- by a partial finalization routine. Flag In_Task_Body should be set + -- when the processing is initiated from a task body. procedure Process_Activation_Call - (Call : Node_Id; - Call_Attrs : Call_Attributes; - In_Task_Body : Boolean); + (Call : Node_Id; + Call_Attrs : Call_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Perform ABE checks and diagnostics for activation call Call by invoking -- routine Process_Single_Activation on each task object being activated. - -- Call_Attrs are the attributes of the activation call. Flag In_Task_Body - -- should be set when the processing is initiated from a task body. + -- Call_Attrs are the attributes of the activation call. In_Partial_Fin + -- shoud be set when the processing is initiated by a partial finalization + -- routine. Flag In_Task_Body should be set when the processing is started + -- from a task body. procedure Process_Activation_Conditional_ABE_Impl - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Obj_Id : Entity_Id; - Task_Attrs : Task_Attributes; - In_Task_Body : Boolean); + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Perform common conditional ABE checks and diagnostics for call Call -- which activates task Obj_Id ignoring the Ada or SPARK rules. CAll_Attrs -- are the attributes of the activation call. Task_Attrs are the attributes - -- of the task type. Flag In_Task_Body should be set when the processing is - -- initiated from a task body. + -- of the task type. Flag In_Partial_Fin shoud be set when the processing + -- is initiated by a partial finalization routine. Flag In_Task_Body should + -- be set when the processing is initiated from a task body. procedure Process_Activation_Guaranteed_ABE_Impl - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Obj_Id : Entity_Id; - Task_Attrs : Task_Attributes; - In_Task_Body : Boolean); - -- Perform common guaranteed ABE checks and diagnostics for call Call - -- which activates task Obj_Id ignoring the Ada or SPARK rules. CAll_Attrs - -- are the attributes of the activation call. Task_Attrs are the attributes - -- of the task type. Flag In_Task_Body should be set when the processing is - -- initiated from a task body. + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); + -- Perform common guaranteed ABE checks and diagnostics for call Call which + -- activates task Obj_Id ignoring the Ada or SPARK rules. Task_Attrs are + -- the attributes of the task type. The following parameters are provided + -- for compatibility and are unused. + -- + -- Call_Attrs + -- In_Partial_Fin + -- In_Task_Body procedure Process_Call - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Target_Id : Entity_Id; - In_Task_Body : Boolean); + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Top-level dispatcher for processing of calls. Perform ABE checks and -- diagnostics for call Call which invokes target Target_Id. Call_Attrs - -- are the attributes of the call. Flag In_Task_Body should be set when - -- the processing is initiated from a task body. + -- are the attributes of the call. Flag In_Partial_Fin shoud be set when + -- the processing is initiated by a partial finalization routine. Flag + -- In_Task_Body should be set when the processing is started from a task + -- body. procedure Process_Call_Ada - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Target_Id : Entity_Id; - Target_Attrs : Target_Attributes; - In_Task_Body : Boolean); + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Perform ABE checks and diagnostics for call Call which invokes target -- Target_Id using the Ada rules. Call_Attrs are the attributes of the - -- call. Target_Attrs are attributes of the target. Flag In_Task_Body - -- should be set when the processing is initiated from a task body. + -- call. Target_Attrs are attributes of the target. Flag In_Partial_Fin + -- shoud be set when the processing is initiated by a partial finalization + -- routine. Flag In_Task_Body should be set when the processing is started + -- from a task body. procedure Process_Call_Conditional_ABE - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Target_Id : Entity_Id; - Target_Attrs : Target_Attributes); + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes; + In_Partial_Fin : Boolean); -- Perform common conditional ABE checks and diagnostics for call Call that -- invokes target Target_Id ignoring the Ada or SPARK rules. Call_Attrs are -- the attributes of the call. Target_Attrs are attributes of the target. + -- Flag In_Partial_Fin shoud be set when the processing is initiated by a + -- partial finalization routine. procedure Process_Call_Guaranteed_ABE (Call : Node_Id; @@ -1292,49 +1336,59 @@ package body Sem_Elab is -- the attributes of the call. procedure Process_Call_SPARK - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Target_Id : Entity_Id; - Target_Attrs : Target_Attributes); + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes; + In_Partial_Fin : Boolean); -- Perform ABE checks and diagnostics for call Call which invokes target -- Target_Id using the SPARK rules. Call_Attrs are the attributes of the - -- call. Target_Attrs are attributes of the target. + -- call. Target_Attrs are attributes of the target. Flag In_Partial_Fin + -- shoud be set when the processing is initiated by a partial finalization + -- routine. procedure Process_Guaranteed_ABE (N : Node_Id); - -- Top level dispatcher for processing of scenarios which result in a + -- Top-level dispatcher for processing of scenarios which result in a -- guaranteed ABE. procedure Process_Instantiation - (Exp_Inst : Node_Id; - In_Task_Body : Boolean); - -- Top level dispatcher for processing of instantiations. Perform ABE + (Exp_Inst : Node_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); + -- Top-level dispatcher for processing of instantiations. Perform ABE -- checks and diagnostics for expanded instantiation Exp_Inst. Flag - -- In_Task_Body should be set when the processing is initiated from a - -- task body. + -- In_Partial_Fin shoud be set when the processing is initiated by a + -- partial finalization routine. Flag In_Task_Body should be set when + -- the processing is initiated from a task body. procedure Process_Instantiation_Ada - (Exp_Inst : Node_Id; - Inst : Node_Id; - Inst_Attrs : Instantiation_Attributes; - Gen_Id : Entity_Id; - Gen_Attrs : Target_Attributes; - In_Task_Body : Boolean); + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Perform ABE checks and diagnostics for expanded instantiation Exp_Inst -- of generic Gen_Id using the Ada rules. Inst is the instantiation node. - -- Inst_Attrs are the attributes of the instance. Gen_Attrs are the - -- attributes of the generic. Flag In_Task_Body should be set when the - -- processing is initiated from a task body. + -- Inst_Attrs are the attributes of the instance. Gen_Attrs denotes the + -- attributes of the generic. Flag In_Partial_Fin shoud be set when the + -- processing is initiated by a partial finalization routine. In_Task_Body + -- should be set when the processing is initiated from a task body. procedure Process_Instantiation_Conditional_ABE - (Exp_Inst : Node_Id; - Inst : Node_Id; - Inst_Attrs : Instantiation_Attributes; - Gen_Id : Entity_Id; - Gen_Attrs : Target_Attributes); + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes; + In_Partial_Fin : Boolean); -- Perform common conditional ABE checks and diagnostics for expanded -- instantiation Exp_Inst of generic Gen_Id ignoring the Ada or SPARK -- rules. Inst is the instantiation node. Inst_Attrs are the attributes - -- of the instance. Gen_Attrs are the attributes of the generic. + -- of the instance. Gen_Attrs are the attributes of the generic. Flag + -- In_Partial_Fin shoud be set when the processing is initiated by a + -- partial finalization routine. procedure Process_Instantiation_Guaranteed_ABE (Exp_Inst : Node_Id); -- Perform common guaranteed ABE checks and diagnostics for expanded @@ -1342,23 +1396,30 @@ package body Sem_Elab is -- rules. procedure Process_Instantiation_SPARK - (Exp_Inst : Node_Id; - Inst : Node_Id; - Inst_Attrs : Instantiation_Attributes; - Gen_Id : Entity_Id; - Gen_Attrs : Target_Attributes); + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes; + In_Partial_Fin : Boolean); -- Perform ABE checks and diagnostics for expanded instantiation Exp_Inst -- of generic Gen_Id using the SPARK rules. Inst is the instantiation node. - -- Inst_Attrs are the attributes of the instance. Gen_Attrs are the - -- attributes of the generic. - - procedure Process_Scenario (N : Node_Id; In_Task_Body : Boolean := False); - -- Top level dispatcher for processing of various elaboration scenarios. - -- Perform ABE checks and diagnostics for scenario N. Flag In_Task_Body - -- should be set when the processing is initiated from a task body. + -- Inst_Attrs are the attributes of the instance. Gen_Attrs denotes the + -- attributes of the generic. Flag In_Partial_Fin shoud be set when the + -- processing is initiated by a partial finalization routine. + + procedure Process_Scenario + (N : Node_Id; + In_Partial_Fin : Boolean := False; + In_Task_Body : Boolean := False); + -- Top-level dispatcher for processing of various elaboration scenarios. + -- Perform ABE checks and diagnostics for scenario N. Flag In_Partial_Fin + -- shoud be set when the processing is initiated by a partial finalization + -- routine. Flag In_Task_Body should be set when the processing is started + -- from a task body. procedure Process_Variable_Assignment (Asmt : Node_Id); - -- Top level dispatcher for processing of variable assignments. Perform ABE + -- Top-level dispatcher for processing of variable assignments. Perform ABE -- checks and diagnostics for assignment statement Asmt. procedure Process_Variable_Assignment_Ada @@ -1373,9 +1434,16 @@ package body Sem_Elab is -- Perform ABE checks and diagnostics for assignment statement Asmt that -- updates the value of variable Var_Id using the SPARK rules. - procedure Process_Variable_Read (Ref : Node_Id); - -- Perform ABE checks and diagnostics for reference Ref that reads a - -- variable. + procedure Process_Variable_Reference (Ref : Node_Id); + -- Top-level dispatcher for processing of variable references. Perform ABE + -- checks and diagnostics for variable reference Ref. + + procedure Process_Variable_Reference_Read + (Ref : Node_Id; + Var_Id : Entity_Id; + Attrs : Variable_Attributes); + -- Perform ABE checks and diagnostics for reference Ref described by its + -- attributes Attrs, that reads variable Var_Id. procedure Push_Active_Scenario (N : Node_Id); pragma Inline (Push_Active_Scenario); @@ -1383,18 +1451,29 @@ package body Sem_Elab is function Root_Scenario return Node_Id; pragma Inline (Root_Scenario); - -- Return the top level scenario which started a recursive search for other - -- scenarios. It is assumed that there is a valid top level scenario on the + -- Return the top-level scenario which started a recursive search for other + -- scenarios. It is assumed that there is a valid top-level scenario on the -- active scenario stack. + procedure Set_Is_Recorded_Top_Level_Scenario + (N : Node_Id; + Val : Boolean := True); + pragma Inline (Set_Is_Recorded_Top_Level_Scenario); + -- Mark scenario N as being recorded in table Top_Level_Scenarios + function Static_Elaboration_Checks return Boolean; pragma Inline (Static_Elaboration_Checks); -- Determine whether the static model is in effect - procedure Traverse_Body (N : Node_Id; In_Task_Body : Boolean); + procedure Traverse_Body + (N : Node_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean); -- Inspect the declarations and statements of subprogram body N for - -- suitable elaboration scenarios and process them. Flag In_Task_Body - -- should be set when the traversal is initiated from a task body. + -- suitable elaboration scenarios and process them. Flag In_Partial_Fin + -- shoud be set when the processing is initiated by a partial finalization + -- routine. Flag In_Task_Body should be set when the traversal is initiated + -- from a task body. procedure Update_Elaboration_Scenario (New_N : Node_Id; Old_N : Node_Id); pragma Inline (Update_Elaboration_Scenario); @@ -1597,6 +1676,12 @@ package body Sem_Elab is if ASIS_Mode then return; + -- Nothing to do when the call is being preanalyzed as the marker will + -- be inserted in the wrong place. + + elsif Preanalysis_Active then + return; + -- Nothing to do when the input does not denote a call or a requeue elsif not Nkind_In (N, N_Entry_Call_Statement, @@ -1606,12 +1691,6 @@ package body Sem_Elab is then return; - -- Nothing to do when the call is being preanalyzed as the marker will - -- be inserted in the wrong place. - - elsif Preanalysis_Active then - return; - -- Nothing to do when the call is analyzed/resolved too early within an -- intermediate context. @@ -1758,6 +1837,146 @@ package body Sem_Elab is Record_Elaboration_Scenario (Marker); end Build_Call_Marker; + ------------------------------------- + -- Build_Variable_Reference_Marker -- + ------------------------------------- + + procedure Build_Variable_Reference_Marker + (N : Node_Id; + Read : Boolean; + Write : Boolean) + is + function In_Pragma (Nod : Node_Id) return Boolean; + -- Determine whether arbitrary node Nod appears within a pragma + + --------------- + -- In_Pragma -- + --------------- + + function In_Pragma (Nod : Node_Id) return Boolean is + Par : Node_Id; + + begin + Par := Nod; + while Present (Par) loop + if Nkind (Par) = N_Pragma then + return True; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; + + return False; + end In_Pragma; + + -- Local variables + + Marker : Node_Id; + Prag : Node_Id; + Var_Attrs : Variable_Attributes; + Var_Id : Entity_Id; + + -- Start of processing for Build_Variable_Reference_Marker + + begin + -- Nothing to do for ASIS. As a result, ABE checks and diagnostics are + -- not performed in this mode. + + if ASIS_Mode then + return; + + -- Nothing to do when the reference is being preanalyzed as the marker + -- will be inserted in the wrong place. + + elsif Preanalysis_Active then + return; + + -- Nothing to do when the input does not denote a reference + + elsif not Nkind_In (N, N_Expanded_Name, N_Identifier) then + return; + + -- Nothing to do for internally-generated references + + elsif not Comes_From_Source (N) then + return; + + -- Nothing to do when the reference is erroneous, left in a bad state, + -- or does not denote a variable. + + elsif not (Present (Entity (N)) + and then Ekind (Entity (N)) = E_Variable + and then Entity (N) /= Any_Id) + then + return; + end if; + + Extract_Variable_Reference_Attributes + (Ref => N, + Var_Id => Var_Id, + Attrs => Var_Attrs); + + Prag := SPARK_Pragma (Var_Id); + + if Comes_From_Source (Var_Id) + + -- Both the variable and the reference must appear in SPARK_Mode On + -- regions because this scenario falls under the SPARK rules. + + and then Present (Prag) + and then Get_SPARK_Mode_From_Annotation (Prag) = On + and then Is_SPARK_Mode_On_Node (N) + + -- The reference must not be considered when it appears in a pragma. + -- If the pragma has run-time semantics, then the reference will be + -- reconsidered once the pragma is expanded. + + -- Performance note: parent traversal + + and then not In_Pragma (N) + then + null; + + -- Otherwise the reference is not suitable for ABE processing. This + -- prevents the generation of variable markers which will never play + -- a role in ABE diagnostics. + + else + return; + end if; + + -- At this point it is known that the variable reference will play some + -- role in ABE checks and diagnostics. Create a corresponding variable + -- marker in case the original variable reference is folded or optimized + -- away. + + Marker := Make_Variable_Reference_Marker (Sloc (N)); + + -- Inherit the attributes of the original variable reference + + Set_Target (Marker, Var_Id); + Set_Is_Read (Marker, Read); + Set_Is_Write (Marker, Write); + + -- The marker is inserted prior to the original variable reference. The + -- insertion must take place even when the reference does not occur in + -- the main unit to keep the tree symmetric. This ensures that internal + -- name serialization is consistent in case the variable marker causes + -- the tree to transform in some way. + + Insert_Action (N, Marker); + + -- The marker becomes the "corresponding" scenario for the reference. + -- Save the marker for later processing for the ABE phase. + + Record_Elaboration_Scenario (Marker); + end Build_Variable_Reference_Marker; + --------------------------------- -- Check_Elaboration_Scenarios -- --------------------------------- @@ -1776,12 +1995,12 @@ package body Sem_Elab is Find_Elaborated_Units; - -- Examine each top level scenario saved during the Recording phase and + -- Examine each top-level scenario saved during the Recording phase and -- perform various actions depending on the elaboration model in effect. for Index in Top_Level_Scenarios.First .. Top_Level_Scenarios.Last loop - -- Clear the table of visited scenario bodies for each new top level + -- Clear the table of visited scenario bodies for each new top-level -- scenario. Visited_Bodies.Reset; @@ -1852,7 +2071,7 @@ package body Sem_Elab is Level := Find_Enclosing_Level (Call); - -- Library level calls are always considered because they are part of + -- Library-level calls are always considered because they are part of -- the associated unit's elaboration actions. if Level in Library_Level then @@ -1996,9 +2215,10 @@ package body Sem_Elab is ------------------------------ procedure Ensure_Prior_Elaboration - (N : Node_Id; - Unit_Id : Entity_Id; - In_Task_Body : Boolean) + (N : Node_Id; + Unit_Id : Entity_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) is Prag_Nam : Name_Id; @@ -2035,11 +2255,18 @@ package body Sem_Elab is Prag_Nam := Name_Elaborate_All; end if; + -- Nothing to do when the need for prior elaboration came from a partial + -- finalization routine which occurs in an initialization context. This + -- behaviour parallels that of the old ABE mechanism. + + if In_Partial_Fin then + return; + -- Nothing to do when the need for prior elaboration came from a task -- body and switch -gnatd.y (disable implicit pragma Elaborate_All on -- task bodies) is in effect. - if Debug_Flag_Dot_Y and then In_Task_Body then + elsif Debug_Flag_Dot_Y and then In_Task_Body then return; -- Nothing to do when the unit is elaborated prior to the main unit. @@ -2932,14 +3159,45 @@ package body Sem_Elab is Var_Id : out Entity_Id; Attrs : out Variable_Attributes) is + function Get_Renamed_Variable (Id : Entity_Id) return Entity_Id; + -- Obtain the ultimate renamed variable of variable Id + + -------------------------- + -- Get_Renamed_Variable -- + -------------------------- + + function Get_Renamed_Variable (Id : Entity_Id) return Entity_Id is + Ren_Id : Entity_Id; + + begin + Ren_Id := Id; + while Present (Renamed_Entity (Ren_Id)) + and then Nkind (Renamed_Entity (Ren_Id)) in N_Entity + loop + Ren_Id := Renamed_Entity (Ren_Id); + end loop; + + return Ren_Id; + end Get_Renamed_Variable; + + -- Start of processing for Extract_Variable_Reference_Attributes + begin - -- Traverse a possible chain of renamings to obtain the original - -- variable being referenced. + -- Extraction for variable reference markers + + if Nkind (Ref) = N_Variable_Reference_Marker then + Var_Id := Target (Ref); + + -- Extraction for expanded names and identifiers - Var_Id := Get_Renamed_Entity (Entity (Ref)); + else + Var_Id := Entity (Ref); + end if; - Attrs.SPARK_Mode_On := Is_SPARK_Mode_On_Node (Ref); - Attrs.Unit_Id := Find_Top_Unit (Var_Id); + -- Obtain the original variable which the reference mentions + + Var_Id := Get_Renamed_Variable (Var_Id); + Attrs.Unit_Id := Find_Top_Unit (Var_Id); -- At this point certain attributes should always be available @@ -3356,7 +3614,7 @@ package body Sem_Elab is return Declaration_Level; end if; - -- The current construct is a declaration level encapsulator + -- The current construct is a declaration-level encapsulator elsif Nkind_In (Curr, N_Entry_Body, N_Subprogram_Body, @@ -3379,9 +3637,9 @@ package body Sem_Elab is return Declaration_Level; end if; - -- The current construct is a non-library level encapsulator which + -- The current construct is a non-library-level encapsulator which -- indicates that the node cannot possibly appear at any level. - -- Note that this check must come after the declaration level check + -- Note that this check must come after the declaration-level check -- because both predicates share certain nodes. elsif Is_Non_Library_Level_Encapsulator (Curr) then @@ -3870,7 +4128,7 @@ package body Sem_Elab is Nested_OK : Boolean := False) return Boolean is function Find_Enclosing_Context (N : Node_Id) return Node_Id; - -- Return the nearest enclosing non-library level or compilation unit + -- Return the nearest enclosing non-library-level or compilation unit -- node which which encapsulates arbitrary node N. Return Empty is no -- such context is available. @@ -3916,7 +4174,7 @@ package body Sem_Elab is return Par; end if; - -- Reaching a compilation unit node without hitting a non-library + -- Reaching a compilation unit node without hitting a non-library- -- level encapsulator indicates that N is at the library level in -- which case the compilation unit is the context. @@ -3998,7 +4256,7 @@ package body Sem_Elab is procedure Initialize is begin - -- Set the soft link which enables Atree.Rewrite to update a top level + -- Set the soft link which enables Atree.Rewrite to update a top-level -- scenario each time it is transformed into another node. Set_Rewriting_Proc (Update_Elaboration_Scenario'Access); @@ -4226,24 +4484,26 @@ package body Sem_Elab is In_SPARK => In_SPARK); end Info_Instantiation; - ------------------------ - -- Info_Variable_Read -- - ------------------------ + ----------------------------- + -- Info_Variable_Reference -- + ----------------------------- - procedure Info_Variable_Read + procedure Info_Variable_Reference (Ref : Node_Id; Var_Id : Entity_Id; Info_Msg : Boolean; In_SPARK : Boolean) is begin - Elab_Msg_NE - (Msg => "read of variable & during elaboration", - N => Ref, - Id => Var_Id, - Info_Msg => Info_Msg, - In_SPARK => In_SPARK); - end Info_Variable_Read; + if Is_Read (Ref) then + Elab_Msg_NE + (Msg => "read of variable & during elaboration", + N => Ref, + Id => Var_Id, + Info_Msg => Info_Msg, + In_SPARK => In_SPARK); + end if; + end Info_Variable_Reference; -------------------- -- Insertion_Node -- @@ -4602,19 +4862,6 @@ package body Sem_Elab is return False; end Is_Bodiless_Subprogram; - -------------------------------- - -- Is_Check_Emitting_Scenario -- - -------------------------------- - - function Is_Check_Emitting_Scenario (N : Node_Id) return Boolean is - begin - return - Nkind_In (N, N_Call_Marker, - N_Function_Instantiation, - N_Package_Instantiation, - N_Procedure_Instantiation); - end Is_Check_Emitting_Scenario; - ------------------------ -- Is_Controlled_Proc -- ------------------------ @@ -4870,6 +5117,15 @@ package body Sem_Elab is and then Present (Protected_Subprogram (Id)); end Is_Protected_Body_Subp; + ------------------------------------ + -- Is_Recorded_Top_Level_Scenario -- + ------------------------------------ + + function Is_Recorded_Top_Level_Scenario (N : Node_Id) return Boolean is + begin + return Recorded_Top_Level_Scenarios.Get (N); + end Is_Recorded_Top_Level_Scenario; + ------------------------ -- Is_Safe_Activation -- ------------------------ @@ -5200,7 +5456,7 @@ package body Sem_Elab is or else Is_Suitable_Call (N) or else Is_Suitable_Instantiation (N) or else Is_Suitable_Variable_Assignment (N) - or else Is_Suitable_Variable_Read (N); + or else Is_Suitable_Variable_Reference (N); end Is_Suitable_Scenario; ------------------------------------- @@ -5297,187 +5553,19 @@ package body Sem_Elab is and then Corresponding_Body (Var_Unit) = N_Unit_Id; end Is_Suitable_Variable_Assignment; - ------------------------------- - -- Is_Suitable_Variable_Read -- - ------------------------------- - - function Is_Suitable_Variable_Read (N : Node_Id) return Boolean is - function In_Pragma (Nod : Node_Id) return Boolean; - -- Determine whether arbitrary node Nod appears within a pragma - - function Is_Variable_Read (Ref : Node_Id) return Boolean; - -- Determine whether variable reference Ref constitutes a read - - --------------- - -- In_Pragma -- - --------------- - - function In_Pragma (Nod : Node_Id) return Boolean is - Par : Node_Id; - - begin - Par := Nod; - while Present (Par) loop - if Nkind (Par) = N_Pragma then - return True; - - -- Prevent the search from going too far - - elsif Is_Body_Or_Package_Declaration (Par) then - exit; - end if; - - Par := Parent (Par); - end loop; - - return False; - end In_Pragma; - - ---------------------- - -- Is_Variable_Read -- - ---------------------- - - function Is_Variable_Read (Ref : Node_Id) return Boolean is - function Is_Out_Actual (Call : Node_Id) return Boolean; - -- Determine whether the corresponding formal of actual Ref which - -- appears in call Call has mode OUT. - - ------------------- - -- Is_Out_Actual -- - ------------------- - - function Is_Out_Actual (Call : Node_Id) return Boolean is - Actual : Node_Id; - Call_Attrs : Call_Attributes; - Formal : Entity_Id; - Target_Id : Entity_Id; - - begin - Extract_Call_Attributes - (Call => Call, - Target_Id => Target_Id, - Attrs => Call_Attrs); - - -- Inspect the actual and formal parameters, trying to find the - -- corresponding formal for Ref. - - Actual := First_Actual (Call); - Formal := First_Formal (Target_Id); - while Present (Actual) and then Present (Formal) loop - if Actual = Ref then - return Ekind (Formal) = E_Out_Parameter; - end if; - - Next_Actual (Actual); - Next_Formal (Formal); - end loop; - - return False; - end Is_Out_Actual; - - -- Local variables - - Context : constant Node_Id := Parent (Ref); - - -- Start of processing for Is_Variable_Read - - begin - -- The majority of variable references are reads, and they can appear - -- in a great number of contexts. To determine whether a reference is - -- a read, it is more practical to find out whether it is a write. - - -- A reference is a write when it appears immediately on the left- - -- hand side of an assignment. - - if Nkind (Context) = N_Assignment_Statement - and then Name (Context) = Ref - then - return False; - - -- A reference is a write when it acts as an actual in a subprogram - -- call and the corresponding formal has mode OUT. - - elsif Nkind_In (Context, N_Function_Call, - N_Procedure_Call_Statement) - and then Is_Out_Actual (Context) - then - return False; - end if; - - -- Any other reference is a read - - return True; - end Is_Variable_Read; - - -- Local variables - - Prag : Node_Id; - Var_Id : Entity_Id; - - -- Start of processing for Is_Suitable_Variable_Read + ------------------------------------ + -- Is_Suitable_Variable_Reference -- + ------------------------------------ + function Is_Suitable_Variable_Reference (N : Node_Id) return Boolean is begin - -- This scenario is relevant only when the static model is in effect - -- because it is graph-dependent and does not involve any run-time - -- checks. Allowing it in the dynamic model would create confusing - -- noise. - - if not Static_Elaboration_Checks then - return False; - - -- Attributes and operator sumbols are not considered to be suitable - -- references even though they are part of predicate Is_Entity_Name. + -- Expanded names and identifiers are intentionally ignored because they + -- be folded, optimized away, etc. Variable references markers play the + -- role of variable references and provide a uniform foundation for ABE + -- processing. - elsif not Nkind_In (N, N_Expanded_Name, N_Identifier) then - return False; - - -- Nothing to do for internally-generated references because they are - -- assumed to be ABE safe. - - elsif not Comes_From_Source (N) then - return False; - end if; - - -- Sanitize the reference - - Var_Id := Entity (N); - - if No (Var_Id) then - return False; - - elsif Var_Id = Any_Id then - return False; - - elsif Ekind (Var_Id) /= E_Variable then - return False; - end if; - - Prag := SPARK_Pragma (Var_Id); - - -- To qualify, the reference must meet the following prerequisites: - - return - Comes_From_Source (Var_Id) - - -- Both the variable and the reference must appear in SPARK_Mode On - -- regions because this scenario falls under the SPARK rules. - - and then Present (Prag) - and then Get_SPARK_Mode_From_Annotation (Prag) = On - and then Is_SPARK_Mode_On_Node (N) - - -- The reference must denote a variable read - - and then Is_Variable_Read (N) - - -- The reference must not be considered when it appears in a pragma. - -- If the pragma has run-time semantics, then the reference will be - -- reconsidered once the pragma is expanded. - - -- Performance note: parent traversal - - and then not In_Pragma (N); - end Is_Suitable_Variable_Read; + return Nkind (N) = N_Variable_Reference_Marker; + end Is_Suitable_Variable_Reference; ------------------- -- Is_Task_Entry -- @@ -5501,7 +5589,7 @@ package body Sem_Elab is begin -- The root appears within the declaratons of a block statement, entry -- body, subprogram body, or task body ignoring enclosing packages. The - -- root is always within the main unit. An up level target is a notion + -- root is always within the main unit. An up-level target is a notion -- applicable only to the static model because scenarios are reached by -- means of graph traversal started from a fixed declarative or library -- level. @@ -5511,7 +5599,7 @@ package body Sem_Elab is if Static_Elaboration_Checks and then Find_Enclosing_Level (Root) = Declaration_Level then - -- The target is within the main unit. It acts as an up level target + -- The target is within the main unit. It acts as an up-level target -- when it appears within a context which encloses the root. -- package body Main_Unit is @@ -5527,7 +5615,7 @@ package body Sem_Elab is return not In_Same_Context (Root, Target_Decl, Nested_OK => True); -- Otherwise the target is external to the main unit which makes it - -- an up level target. + -- an up-level target. else return True; @@ -5542,14 +5630,32 @@ package body Sem_Elab is ------------------------------- procedure Kill_Elaboration_Scenario (N : Node_Id) is + package Scenarios renames Top_Level_Scenarios; + begin - -- Eliminate the scenario by suppressing the generation of conditional - -- ABE checks or guaranteed ABE failures. Note that other diagnostics - -- must be carried out ignoring the fact that the scenario is within - -- dead code. + -- Eliminate a recorded top-level scenario when it appears within dead + -- code because it will not be executed at elaboration time. + + if Is_Scenario (N) + and then Is_Recorded_Top_Level_Scenario (N) + then + -- Performance node: list traversal + + for Index in Scenarios.First .. Scenarios.Last loop + if Scenarios.Table (Index) = N then + Scenarios.Table (Index) := Empty; - if Is_Scenario (N) then - Set_Is_Elaboration_Checks_OK_Node (N, False); + -- The top-level scenario is no longer recorded + + Set_Is_Recorded_Top_Level_Scenario (N, False); + return; + end if; + end loop; + + -- A recorded top-level scenario must be in the table of recorded + -- top-level scenarios. + + pragma Assert (False); end if; end Kill_Elaboration_Scenario; @@ -5652,8 +5758,8 @@ package body Sem_Elab is Info_Msg => False, In_SPARK => True); - elsif Is_Suitable_Variable_Read (N) then - Info_Variable_Read + elsif Is_Suitable_Variable_Reference (N) then + Info_Variable_Reference (Ref => N, Var_Id => Target_Id, Info_Msg => False, @@ -5817,8 +5923,8 @@ package body Sem_Elab is procedure Output_Variable_Assignment (N : Node_Id); -- Emit a specific diagnostic message for assignment statement N - procedure Output_Variable_Read (N : Node_Id); - -- Emit a specific diagnostic message for reference N which reads a + procedure Output_Variable_Reference (N : Node_Id); + -- Emit a specific diagnostic message for reference N which mentions a -- variable. ------------------- @@ -6148,11 +6254,11 @@ package body Sem_Elab is Error_Msg_NE ("\\ variable & assigned #", Error_Nod, Var_Id); end Output_Variable_Assignment; - -------------------------- - -- Output_Variable_Read -- - -------------------------- + ------------------------------- + -- Output_Variable_Reference -- + ------------------------------- - procedure Output_Variable_Read (N : Node_Id) is + procedure Output_Variable_Reference (N : Node_Id) is Dummy : Variable_Attributes; Var_Id : Entity_Id; @@ -6163,8 +6269,11 @@ package body Sem_Elab is Attrs => Dummy); Error_Msg_Sloc := Sloc (N); - Error_Msg_NE ("\\ variable & read #", Error_Nod, Var_Id); - end Output_Variable_Read; + + if Is_Read (N) then + Error_Msg_NE ("\\ variable & read #", Error_Nod, Var_Id); + end if; + end Output_Variable_Reference; -- Local variables @@ -6225,10 +6334,10 @@ package body Sem_Elab is elsif Nkind (N) = N_Assignment_Statement then Output_Variable_Assignment (N); - -- Variable read + -- Variable references - elsif Is_Suitable_Variable_Read (N) then - Output_Variable_Read (N); + elsif Is_Suitable_Variable_Reference (N) then + Output_Variable_Reference (N); else pragma Assert (False); @@ -6253,7 +6362,11 @@ package body Sem_Elab is -- Process_Access -- -------------------- - procedure Process_Access (Attr : Node_Id; In_Task_Body : Boolean) is + procedure Process_Access + (Attr : Node_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) + is function Build_Access_Marker (Target_Id : Entity_Id) return Node_Id; pragma Inline (Build_Access_Marker); -- Create a suitable call marker which invokes target Target_Id @@ -6340,17 +6453,19 @@ package body Sem_Elab is if Debug_Flag_Dot_O then Process_Scenario - (N => Build_Access_Marker (Target_Id), - In_Task_Body => In_Task_Body); + (N => Build_Access_Marker (Target_Id), + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); -- Otherwise ensure that the unit with the corresponding body is -- elaborated prior to the main unit. else Ensure_Prior_Elaboration - (N => Attr, - Unit_Id => Target_Attrs.Unit_Id, - In_Task_Body => In_Task_Body); + (N => Attr, + Unit_Id => Target_Attrs.Unit_Id, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); end if; end Process_Access; @@ -6359,9 +6474,10 @@ package body Sem_Elab is ----------------------------- procedure Process_Activation_Call - (Call : Node_Id; - Call_Attrs : Call_Attributes; - In_Task_Body : Boolean) + (Call : Node_Id; + Call_Attrs : Call_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) is procedure Process_Task_Object (Obj_Id : Entity_Id; Typ : Entity_Id); -- Perform ABE checks and diagnostics for object Obj_Id with type Typ. @@ -6389,11 +6505,12 @@ package body Sem_Elab is Attrs => Task_Attrs); Process_Single_Activation - (Call => Call, - Call_Attrs => Call_Attrs, - Obj_Id => Obj_Id, - Task_Attrs => Task_Attrs, - In_Task_Body => In_Task_Body); + (Call => Call, + Call_Attrs => Call_Attrs, + Obj_Id => Obj_Id, + Task_Attrs => Task_Attrs, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); -- Examine the component type when the object is an array @@ -6507,11 +6624,12 @@ package body Sem_Elab is --------------------------------------------- procedure Process_Activation_Conditional_ABE_Impl - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Obj_Id : Entity_Id; - Task_Attrs : Task_Attributes; - In_Task_Body : Boolean) + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) is Check_OK : constant Boolean := not Is_Ignored_Ghost_Entity (Obj_Id) @@ -6650,12 +6768,19 @@ package body Sem_Elab is if Earlier_In_Extended_Unit (Root, Task_Attrs.Body_Decl) then + -- Do not emit any ABE diagnostics when the activation occurs in + -- a partial finalization context because this leads to confusing + -- noise. + + if In_Partial_Fin then + null; + -- ABE diagnostics are emitted only in the static model because -- there is a well-defined order to visiting scenarios. Without -- this order diagnostics appear jumbled and result in unwanted -- noise. - if Static_Elaboration_Checks then + elsif Static_Elaboration_Checks then Error_Msg_Sloc := Sloc (Call); Error_Msg_N ("??task & will be activated # before elaboration of its " @@ -6707,12 +6832,16 @@ package body Sem_Elab is else Ensure_Prior_Elaboration - (N => Call, - Unit_Id => Task_Attrs.Unit_Id, - In_Task_Body => In_Task_Body); + (N => Call, + Unit_Id => Task_Attrs.Unit_Id, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); end if; - Traverse_Body (Task_Attrs.Body_Decl, In_Task_Body => True); + Traverse_Body + (N => Task_Attrs.Body_Decl, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => True); end Process_Activation_Conditional_ABE_Impl; procedure Process_Activation_Conditional_ABE is @@ -6723,13 +6852,15 @@ package body Sem_Elab is -------------------------------------------- procedure Process_Activation_Guaranteed_ABE_Impl - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Obj_Id : Entity_Id; - Task_Attrs : Task_Attributes; - In_Task_Body : Boolean) + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) is pragma Unreferenced (Call_Attrs); + pragma Unreferenced (In_Partial_Fin); pragma Unreferenced (In_Task_Body); Check_OK : constant Boolean := @@ -6868,19 +6999,108 @@ package body Sem_Elab is ------------------ procedure Process_Call - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Target_Id : Entity_Id; - In_Task_Body : Boolean) + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) is + function In_Initialization_Context (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N appears within a type init proc, + -- primitive [Deep_]Initialize, or a block created for initialization + -- purposes. + + function Is_Partial_Finalization_Proc return Boolean; + pragma Inline (Is_Partial_Finalization_Proc); + -- Determine whether call Call with target Target_Id invokes a partial + -- finalization procedure. + + ------------------------------- + -- In_Initialization_Context -- + ------------------------------- + + function In_Initialization_Context (N : Node_Id) return Boolean is + Par : Node_Id; + Spec_Id : Entity_Id; + + begin + -- Climb the parent chain looking for initialization actions + + Par := Parent (N); + while Present (Par) loop + + -- A block may be part of the initialization actions of a default + -- initialized object. + + if Nkind (Par) = N_Block_Statement + and then Is_Initialization_Block (Par) + then + return True; + + -- A subprogram body may denote an initialization routine + + elsif Nkind (Par) = N_Subprogram_Body then + Spec_Id := Unique_Defining_Entity (Par); + + -- The current subprogram body denotes a type init proc or + -- primitive [Deep_]Initialize. + + if Is_Init_Proc (Spec_Id) + or else Is_Controlled_Proc (Spec_Id, Name_Initialize) + or else Is_TSS (Spec_Id, TSS_Deep_Initialize) + then + return True; + end if; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; + + return False; + end In_Initialization_Context; + + ---------------------------------- + -- Is_Partial_Finalization_Proc -- + ---------------------------------- + + function Is_Partial_Finalization_Proc return Boolean is + begin + -- To qualify, the target must denote primitive [Deep_]Finalize or a + -- finalizer procedure, and the call must appear in an initialization + -- context. + + return + (Is_Controlled_Proc (Target_Id, Name_Finalize) + or else Is_Finalizer_Proc (Target_Id) + or else Is_TSS (Target_Id, TSS_Deep_Finalize)) + and then In_Initialization_Context (Call); + end Is_Partial_Finalization_Proc; + + -- Local variables + + Partial_Fin_On : Boolean; SPARK_Rules_On : Boolean; Target_Attrs : Target_Attributes; + -- Start of processing for Process_Call + begin Extract_Target_Attributes (Target_Id => Target_Id, Attrs => Target_Attrs); + -- The call occurs in a partial finalization context when a prior + -- scenario is already in that mode, or when the target denotes a + -- [Deep_]Finalize primitive or a finalizer within an initialization + -- context. + + Partial_Fin_On := In_Partial_Fin or else Is_Partial_Finalization_Proc; + -- The SPARK rules are in effect when both the call and target are -- subject to SPARK_Mode On. @@ -6954,28 +7174,30 @@ package body Sem_Elab is elsif SPARK_Rules_On and Debug_Flag_Dot_V then Process_Call_SPARK - (Call => Call, - Call_Attrs => Call_Attrs, - Target_Id => Target_Id, - Target_Attrs => Target_Attrs); + (Call => Call, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + Target_Attrs => Target_Attrs, + In_Partial_Fin => In_Partial_Fin); -- Otherwise the Ada rules are in effect, or SPARK code is allowed to -- violate the SPARK rules. else Process_Call_Ada - (Call => Call, - Call_Attrs => Call_Attrs, - Target_Id => Target_Id, - Target_Attrs => Target_Attrs, - In_Task_Body => In_Task_Body); + (Call => Call, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + Target_Attrs => Target_Attrs, + In_Partial_Fin => Partial_Fin_On, + In_Task_Body => In_Task_Body); end if; -- Inspect the target body (and barried function) for other suitable -- elaboration scenarios. - Traverse_Body (Target_Attrs.Body_Barf, In_Task_Body); - Traverse_Body (Target_Attrs.Body_Decl, In_Task_Body); + Traverse_Body (Target_Attrs.Body_Barf, Partial_Fin_On, In_Task_Body); + Traverse_Body (Target_Attrs.Body_Decl, Partial_Fin_On, In_Task_Body); end Process_Call; ---------------------- @@ -6983,67 +7205,13 @@ package body Sem_Elab is ---------------------- procedure Process_Call_Ada - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Target_Id : Entity_Id; - Target_Attrs : Target_Attributes; - In_Task_Body : Boolean) + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) is - function In_Initialization_Context (N : Node_Id) return Boolean; - -- Determine whether arbitrary node N appears within a type init proc or - -- primitive [Deep_]Initialize. - - ------------------------------- - -- In_Initialization_Context -- - ------------------------------- - - function In_Initialization_Context (N : Node_Id) return Boolean is - Par : Node_Id; - Spec_Id : Entity_Id; - - begin - -- Climb the parent chain looking for initialization actions - - Par := Parent (N); - while Present (Par) loop - - -- A block may be part of the initialization actions of a default - -- initialized object. - - if Nkind (Par) = N_Block_Statement - and then Is_Initialization_Block (Par) - then - return True; - - -- A subprogram body may denote an initialization routine - - elsif Nkind (Par) = N_Subprogram_Body then - Spec_Id := Unique_Defining_Entity (Par); - - -- The current subprogram body denotes a type init proc or - -- primitive [Deep_]Initialize. - - if Is_Init_Proc (Spec_Id) - or else Is_Controlled_Proc (Spec_Id, Name_Initialize) - or else Is_TSS (Spec_Id, TSS_Deep_Initialize) - then - return True; - end if; - - -- Prevent the search from going too far - - elsif Is_Body_Or_Package_Declaration (Par) then - exit; - end if; - - Par := Parent (Par); - end loop; - - return False; - end In_Initialization_Context; - - -- Local variables - Check_OK : constant Boolean := not Call_Attrs.Ghost_Mode_Ignore and then not Target_Attrs.Ghost_Mode_Ignore @@ -7053,8 +7221,6 @@ package body Sem_Elab is -- target have active elaboration checks, and both are not ignored Ghost -- constructs. - -- Start of processing for Process_Call_Ada - begin -- Nothing to do for an Ada dispatching call because there are no ABE -- diagnostics for either models. ABE checks for the dynamic model are @@ -7088,10 +7254,11 @@ package body Sem_Elab is and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl) then Process_Call_Conditional_ABE - (Call => Call, - Call_Attrs => Call_Attrs, - Target_Id => Target_Id, - Target_Attrs => Target_Attrs); + (Call => Call, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + Target_Attrs => Target_Attrs, + In_Partial_Fin => In_Partial_Fin); -- Otherwise the target body is not available in this compilation or it -- resides in an external unit. Install a run-time ABE check to verify @@ -7105,35 +7272,17 @@ package body Sem_Elab is Id => Target_Attrs.Unit_Id); end if; - -- No implicit pragma Elaborate[_All] is generated when the call has - -- elaboration checks suppressed. This behaviour parallels that of the - -- old ABE mechanism. - - if not Call_Attrs.Elab_Checks_OK then - null; - - -- No implicit pragma Elaborate[_All] is generated for finalization - -- actions when primitive [Deep_]Finalize is not defined in the main - -- unit and the call appears within some initialization actions. This - -- behaviour parallels that of the old ABE mechanism. + -- Ensure that the unit with the target body is elaborated prior to the + -- main unit. The implicit Elaborate[_All] is generated only when the + -- call has elaboration checks enabled. This behaviour parallels that of + -- the old ABE mechanism. - -- Performance note: parent traversal - - elsif (Is_Controlled_Proc (Target_Id, Name_Finalize) - or else Is_TSS (Target_Id, TSS_Deep_Finalize)) - and then not In_Extended_Main_Code_Unit (Target_Attrs.Spec_Decl) - and then In_Initialization_Context (Call) - then - null; - - -- Otherwise ensure that the unit with the target body is elaborated - -- prior to the main unit. - - else + if Call_Attrs.Elab_Checks_OK then Ensure_Prior_Elaboration - (N => Call, - Unit_Id => Target_Attrs.Unit_Id, - In_Task_Body => In_Task_Body); + (N => Call, + Unit_Id => Target_Attrs.Unit_Id, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); end if; end Process_Call_Ada; @@ -7142,10 +7291,11 @@ package body Sem_Elab is ---------------------------------- procedure Process_Call_Conditional_ABE - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Target_Id : Entity_Id; - Target_Attrs : Target_Attributes) + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes; + In_Partial_Fin : Boolean) is Check_OK : constant Boolean := not Call_Attrs.Ghost_Mode_Ignore @@ -7186,11 +7336,17 @@ package body Sem_Elab is if Earlier_In_Extended_Unit (Root, Target_Attrs.Body_Decl) then + -- Do not emit any ABE diagnostics when the call occurs in a partial + -- finalization context because this leads to confusing noise. + + if In_Partial_Fin then + null; + -- ABE diagnostics are emitted only in the static model because there -- is a well-defined order to visiting scenarios. Without this order -- diagnostics appear jumbled and result in unwanted noise. - if Static_Elaboration_Checks then + elsif Static_Elaboration_Checks then Error_Msg_NE ("??cannot call & before body seen", Call, Target_Id); Error_Msg_N ("\Program_Error may be raised at run time", Call); @@ -7329,10 +7485,11 @@ package body Sem_Elab is ------------------------ procedure Process_Call_SPARK - (Call : Node_Id; - Call_Attrs : Call_Attributes; - Target_Id : Entity_Id; - Target_Attrs : Target_Attributes) + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes; + In_Partial_Fin : Boolean) is begin -- A call to a source target or to a target which emulates Ada or SPARK @@ -7376,10 +7533,11 @@ package body Sem_Elab is and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl) then Process_Call_Conditional_ABE - (Call => Call, - Call_Attrs => Call_Attrs, - Target_Id => Target_Id, - Target_Attrs => Target_Attrs); + (Call => Call, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + Target_Attrs => Target_Attrs, + In_Partial_Fin => In_Partial_Fin); -- Otherwise the target body is not available in this compilation or it -- resides in an external unit. There is no need to guarantee the prior @@ -7416,9 +7574,10 @@ package body Sem_Elab is if Is_Activation_Proc (Target_Id) then Process_Activation_Guaranteed_ABE - (Call => N, - Call_Attrs => Call_Attrs, - In_Task_Body => False); + (Call => N, + Call_Attrs => Call_Attrs, + In_Partial_Fin => False, + In_Task_Body => False); else Process_Call_Guaranteed_ABE @@ -7442,8 +7601,9 @@ package body Sem_Elab is --------------------------- procedure Process_Instantiation - (Exp_Inst : Node_Id; - In_Task_Body : Boolean) + (Exp_Inst : Node_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) is Gen_Attrs : Target_Attributes; Gen_Id : Entity_Id; @@ -7524,23 +7684,25 @@ package body Sem_Elab is elsif SPARK_Rules_On and Debug_Flag_Dot_V then Process_Instantiation_SPARK - (Exp_Inst => Exp_Inst, - Inst => Inst, - Inst_Attrs => Inst_Attrs, - Gen_Id => Gen_Id, - Gen_Attrs => Gen_Attrs); + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Attrs => Inst_Attrs, + Gen_Id => Gen_Id, + Gen_Attrs => Gen_Attrs, + In_Partial_Fin => In_Partial_Fin); -- Otherwise the Ada rules are in effect, or SPARK code is allowed to -- violate the SPARK rules. else Process_Instantiation_Ada - (Exp_Inst => Exp_Inst, - Inst => Inst, - Inst_Attrs => Inst_Attrs, - Gen_Id => Gen_Id, - Gen_Attrs => Gen_Attrs, - In_Task_Body => In_Task_Body); + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Attrs => Inst_Attrs, + Gen_Id => Gen_Id, + Gen_Attrs => Gen_Attrs, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); end if; end Process_Instantiation; @@ -7549,12 +7711,13 @@ package body Sem_Elab is ------------------------------- procedure Process_Instantiation_Ada - (Exp_Inst : Node_Id; - Inst : Node_Id; - Inst_Attrs : Instantiation_Attributes; - Gen_Id : Entity_Id; - Gen_Attrs : Target_Attributes; - In_Task_Body : Boolean) + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) is Check_OK : constant Boolean := not Inst_Attrs.Ghost_Mode_Ignore @@ -7591,11 +7754,12 @@ package body Sem_Elab is and then In_Extended_Main_Code_Unit (Gen_Attrs.Body_Decl) then Process_Instantiation_Conditional_ABE - (Exp_Inst => Exp_Inst, - Inst => Inst, - Inst_Attrs => Inst_Attrs, - Gen_Id => Gen_Id, - Gen_Attrs => Gen_Attrs); + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Attrs => Inst_Attrs, + Gen_Id => Gen_Id, + Gen_Attrs => Gen_Attrs, + In_Partial_Fin => In_Partial_Fin); -- Otherwise the generic body is not available in this compilation or it -- resides in an external unit. Install a run-time ABE check to verify @@ -7616,9 +7780,10 @@ package body Sem_Elab is if Inst_Attrs.Elab_Checks_OK then Ensure_Prior_Elaboration - (N => Inst, - Unit_Id => Gen_Attrs.Unit_Id, - In_Task_Body => In_Task_Body); + (N => Inst, + Unit_Id => Gen_Attrs.Unit_Id, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); end if; end Process_Instantiation_Ada; @@ -7627,11 +7792,12 @@ package body Sem_Elab is ------------------------------------------- procedure Process_Instantiation_Conditional_ABE - (Exp_Inst : Node_Id; - Inst : Node_Id; - Inst_Attrs : Instantiation_Attributes; - Gen_Id : Entity_Id; - Gen_Attrs : Target_Attributes) + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes; + In_Partial_Fin : Boolean) is Check_OK : constant Boolean := not Inst_Attrs.Ghost_Mode_Ignore @@ -7676,11 +7842,17 @@ package body Sem_Elab is if Earlier_In_Extended_Unit (Root, Gen_Attrs.Body_Decl) then + -- Do not emit any ABE diagnostics when the instantiation occurs in a + -- partial finalization context because this leads to unwanted noise. + + if In_Partial_Fin then + null; + -- ABE diagnostics are emitted only in the static model because there -- is a well-defined order to visiting scenarios. Without this order -- diagnostics appear jumbled and result in unwanted noise. - if Static_Elaboration_Checks then + elsif Static_Elaboration_Checks then Error_Msg_NE ("??cannot instantiate & before body seen", Inst, Gen_Id); Error_Msg_N ("\Program_Error may be raised at run time", Inst); @@ -7832,11 +8004,12 @@ package body Sem_Elab is --------------------------------- procedure Process_Instantiation_SPARK - (Exp_Inst : Node_Id; - Inst : Node_Id; - Inst_Attrs : Instantiation_Attributes; - Gen_Id : Entity_Id; - Gen_Attrs : Target_Attributes) + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes; + In_Partial_Fin : Boolean) is Req_Nam : Name_Id; @@ -7882,11 +8055,12 @@ package body Sem_Elab is and then In_Extended_Main_Code_Unit (Gen_Attrs.Body_Decl) then Process_Instantiation_Conditional_ABE - (Exp_Inst => Exp_Inst, - Inst => Inst, - Inst_Attrs => Inst_Attrs, - Gen_Id => Gen_Id, - Gen_Attrs => Gen_Attrs); + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Attrs => Inst_Attrs, + Gen_Id => Gen_Id, + Gen_Attrs => Gen_Attrs, + In_Partial_Fin => In_Partial_Fin); -- Otherwise the generic body is not available in this compilation or -- it resides in an external unit. There is no need to guarantee the @@ -8017,11 +8191,11 @@ package body Sem_Elab is end if; end Process_Variable_Assignment_SPARK; - --------------------------- - -- Process_Variable_Read -- - --------------------------- + -------------------------------- + -- Process_Variable_Reference -- + -------------------------------- - procedure Process_Variable_Read (Ref : Node_Id) is + procedure Process_Variable_Reference (Ref : Node_Id) is Var_Attrs : Variable_Attributes; Var_Id : Entity_Id; @@ -8031,6 +8205,24 @@ package body Sem_Elab is Var_Id => Var_Id, Attrs => Var_Attrs); + if Is_Read (Ref) then + Process_Variable_Reference_Read + (Ref => Ref, + Var_Id => Var_Id, + Attrs => Var_Attrs); + end if; + end Process_Variable_Reference; + + ------------------------------------- + -- Process_Variable_Reference_Read -- + ------------------------------------- + + procedure Process_Variable_Reference_Read + (Ref : Node_Id; + Var_Id : Entity_Id; + Attrs : Variable_Attributes) + is + begin -- Output relevant information when switch -gnatel (info messages on -- implicit Elaborate[_All] pragmas) is in effect. @@ -8046,7 +8238,7 @@ package body Sem_Elab is -- Nothing to do when the variable appears within the main unit because -- diagnostics on reads are relevant only for external variables. - if Is_Same_Unit (Var_Attrs.Unit_Id, Cunit_Entity (Main_Unit)) then + if Is_Same_Unit (Attrs.Unit_Id, Cunit_Entity (Main_Unit)) then null; -- Nothing to do when the variable is already initialized. Note that the @@ -8058,7 +8250,7 @@ package body Sem_Elab is -- Nothing to do when the external unit guarantees the initialization of -- the variable by means of pragma Elaborate_Body. - elsif Has_Pragma_Elaborate_Body (Var_Attrs.Unit_Id) then + elsif Has_Pragma_Elaborate_Body (Attrs.Unit_Id) then null; -- A variable read imposes an Elaborate requirement on the context of @@ -8071,7 +8263,7 @@ package body Sem_Elab is Target_Id => Var_Id, Req_Nam => Name_Elaborate); end if; - end Process_Variable_Read; + end Process_Variable_Reference_Read; -------------------------- -- Push_Active_Scenario -- @@ -8086,7 +8278,11 @@ package body Sem_Elab is -- Process_Scenario -- ---------------------- - procedure Process_Scenario (N : Node_Id; In_Task_Body : Boolean := False) is + procedure Process_Scenario + (N : Node_Id; + In_Partial_Fin : Boolean := False; + In_Task_Body : Boolean := False) + is Call_Attrs : Call_Attributes; Target_Id : Entity_Id; @@ -8098,7 +8294,7 @@ package body Sem_Elab is -- 'Access if Is_Suitable_Access (N) then - Process_Access (N, In_Task_Body); + Process_Access (N, In_Partial_Fin, In_Task_Body); -- Calls @@ -8119,33 +8315,46 @@ package body Sem_Elab is if Is_Activation_Proc (Target_Id) then Process_Activation_Conditional_ABE - (Call => N, - Call_Attrs => Call_Attrs, - In_Task_Body => In_Task_Body); + (Call => N, + Call_Attrs => Call_Attrs, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); else Process_Call - (Call => N, - Call_Attrs => Call_Attrs, - Target_Id => Target_Id, - In_Task_Body => In_Task_Body); + (Call => N, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); end if; end if; -- Instantiations elsif Is_Suitable_Instantiation (N) then - Process_Instantiation (N, In_Task_Body); + Process_Instantiation (N, In_Partial_Fin, In_Task_Body); -- Variable assignments elsif Is_Suitable_Variable_Assignment (N) then Process_Variable_Assignment (N); - -- Variable read + -- Variable references + + elsif Is_Suitable_Variable_Reference (N) then - elsif Is_Suitable_Variable_Read (N) then - Process_Variable_Read (N); + -- In general, only variable references found within the main unit + -- are processed because the ALI information supplied to binde is for + -- the main unit only. However, to preserve the consistency of the + -- tree and ensure proper serialization of internal names, external + -- variable references also receive corresponding variable reference + -- markers (see Build_Varaible_Reference_Marker). Regardless of the + -- reason, external variable references must not be processed. + + if In_Main_Context (N) then + Process_Variable_Reference (N); + end if; end if; -- Remove the current scenario from the stack of active scenarios once @@ -8182,7 +8391,7 @@ package body Sem_Elab is return; end if; - -- Ensure that a library level call does not appear in a preelaborated + -- Ensure that a library-level call does not appear in a preelaborated -- unit. The check must come before ignoring scenarios within external -- units or inside generics because calls in those context must also be -- verified. @@ -8236,7 +8445,7 @@ package body Sem_Elab is Possible_Local_Raise (N, Standard_Program_Error); elsif Is_Suitable_Variable_Assignment (N) - or else Is_Suitable_Variable_Read (N) + or else Is_Suitable_Variable_Reference (N) then null; @@ -8256,23 +8465,23 @@ package body Sem_Elab is Level := Find_Enclosing_Level (N); - -- Declaration level scenario + -- Declaration-level scenario if Declaration_Level_OK and then Level = Declaration_Level then null; - -- Library level scenario + -- Library-level scenario elsif Level in Library_Level then null; - -- Instantiation library level scenario + -- Instantiation library-level scenario elsif Level = Instantiation then null; -- Otherwise the scenario does not appear at the proper level and - -- cannot possibly act as a top level scenario. + -- cannot possibly act as a top-level scenario. else return; @@ -8289,16 +8498,21 @@ package body Sem_Elab is -- later processing by the ABE phase. Top_Level_Scenarios.Append (N); + Set_Is_Recorded_Top_Level_Scenario (N); + end Record_Elaboration_Scenario; - -- Mark a scenario which may produce run-time conditional ABE checks or - -- guaranteed ABE failures as recorded. The flag ensures that scenario - -- rewriting performed by Atree.Rewrite will be properly reflected in - -- all relevant internal data structures. + --------------------------------------- + -- Recorded_Top_Level_Scenarios_Hash -- + --------------------------------------- - if Is_Check_Emitting_Scenario (N) then - Set_Is_Recorded_Scenario (N); - end if; - end Record_Elaboration_Scenario; + function Recorded_Top_Level_Scenarios_Hash + (Key : Node_Id) return Recorded_Top_Level_Scenarios_Index + is + begin + return + Recorded_Top_Level_Scenarios_Index + (Key mod Recorded_Top_Level_Scenarios_Max); + end Recorded_Top_Level_Scenarios_Hash; ------------------- -- Root_Scenario -- @@ -8315,6 +8529,18 @@ package body Sem_Elab is return Stack.Table (Stack.First); end Root_Scenario; + ---------------------------------------- + -- Set_Is_Recorded_Top_Level_Scenario -- + ---------------------------------------- + + procedure Set_Is_Recorded_Top_Level_Scenario + (N : Node_Id; + Val : Boolean := True) + is + begin + Recorded_Top_Level_Scenarios.Set (N, Val); + end Set_Is_Recorded_Top_Level_Scenario; + ------------------------------- -- Static_Elaboration_Checks -- ------------------------------- @@ -8328,85 +8554,177 @@ package body Sem_Elab is -- Traverse_Body -- ------------------- - procedure Traverse_Body (N : Node_Id; In_Task_Body : Boolean) is - function Is_Potential_Scenario (Nod : Node_Id) return Traverse_Result; - -- Determine whether arbitrary node Nod denotes a suitable scenario and - -- if so, process it. + procedure Traverse_Body + (N : Node_Id; + In_Partial_Fin : Boolean; + In_Task_Body : Boolean) + is + procedure Find_And_Process_Nested_Scenarios; + pragma Inline (Find_And_Process_Nested_Scenarios); + -- Examine the declarations and statements of subprogram body N for + -- suitable scenarios. Save each discovered scenario and process it + -- accordingly. + + procedure Process_Nested_Scenarios (Nested : Elist_Id); + pragma Inline (Process_Nested_Scenarios); + -- Invoke Process_Scenario on each individual scenario whith appears in + -- list Nested. + + --------------------------------------- + -- Find_And_Process_Nested_Scenarios -- + --------------------------------------- + + procedure Find_And_Process_Nested_Scenarios is + Body_Id : constant Entity_Id := Defining_Entity (N); + + function Is_Potential_Scenario + (Nod : Node_Id) return Traverse_Result; + -- Determine whether arbitrary node Nod denotes a suitable scenario. + -- If it does, save it in the Nested_Scenarios list of the subprogram + -- body, and process it. + + procedure Save_Scenario (Nod : Node_Id); + pragma Inline (Save_Scenario); + -- Save scenario Nod in the Nested_Scenarios list of the subprogram + -- body. - procedure Traverse_Potential_Scenarios is - new Traverse_Proc (Is_Potential_Scenario); + procedure Traverse_List (List : List_Id); + pragma Inline (Traverse_List); + -- Invoke Traverse_Potential_Scenarios on each node in list List - procedure Traverse_List (List : List_Id); - -- Inspect list List for suitable elaboration scenarios and process them + procedure Traverse_Potential_Scenarios is + new Traverse_Proc (Is_Potential_Scenario); - --------------------------- - -- Is_Potential_Scenario -- - --------------------------- + --------------------------- + -- Is_Potential_Scenario -- + --------------------------- - function Is_Potential_Scenario (Nod : Node_Id) return Traverse_Result is - begin - -- Special cases + function Is_Potential_Scenario + (Nod : Node_Id) return Traverse_Result + is + begin + -- Special cases - -- Skip constructs which do not have elaboration of their own and - -- need to be elaborated by other means such as invocation, task - -- activation, etc. + -- Skip constructs which do not have elaboration of their own and + -- need to be elaborated by other means such as invocation, task + -- activation, etc. - if Is_Non_Library_Level_Encapsulator (Nod) then - return Skip; + if Is_Non_Library_Level_Encapsulator (Nod) then + return Skip; - -- Terminate the traversal of a task body with an accept statement - -- when no entry calls in elaboration are allowed because the task - -- will block at run-time and none of the remaining statements will - -- be executed. + -- Terminate the traversal of a task body with an accept statement + -- when no entry calls in elaboration are allowed because the task + -- will block at run-time and the remaining statements will not be + -- executed. - elsif Nkind_In (Original_Node (Nod), N_Accept_Statement, - N_Selective_Accept) - and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code) - then - return Abandon; + elsif Nkind_In (Original_Node (Nod), N_Accept_Statement, + N_Selective_Accept) + and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code) + then + return Abandon; - -- Certain nodes carry semantic lists which act as repositories until - -- expansion transforms the node and relocates the contents. Examine - -- these lists in case expansion is disabled. + -- Certain nodes carry semantic lists which act as repositories + -- until expansion transforms the node and relocates the contents. + -- Examine these lists in case expansion is disabled. - elsif Nkind_In (Nod, N_And_Then, N_Or_Else) then - Traverse_List (Actions (Nod)); + elsif Nkind_In (Nod, N_And_Then, N_Or_Else) then + Traverse_List (Actions (Nod)); - elsif Nkind_In (Nod, N_Elsif_Part, N_Iteration_Scheme) then - Traverse_List (Condition_Actions (Nod)); + elsif Nkind_In (Nod, N_Elsif_Part, N_Iteration_Scheme) then + Traverse_List (Condition_Actions (Nod)); - elsif Nkind (Nod) = N_If_Expression then - Traverse_List (Then_Actions (Nod)); - Traverse_List (Else_Actions (Nod)); + elsif Nkind (Nod) = N_If_Expression then + Traverse_List (Then_Actions (Nod)); + Traverse_List (Else_Actions (Nod)); - elsif Nkind_In (Nod, N_Component_Association, - N_Iterated_Component_Association) - then - Traverse_List (Loop_Actions (Nod)); + elsif Nkind_In (Nod, N_Component_Association, + N_Iterated_Component_Association) + then + Traverse_List (Loop_Actions (Nod)); - -- General case + -- General case - elsif Is_Suitable_Scenario (Nod) then - Process_Scenario (Nod, In_Task_Body); - end if; + -- Save a suitable scenario in the Nested_Scenarios list of the + -- subprogram body. As a result any subsequent traversals of the + -- subprogram body started from a different top-level scenario no + -- longer need to reexamine the tree. - return OK; - end Is_Potential_Scenario; + elsif Is_Suitable_Scenario (Nod) then + Save_Scenario (Nod); + Process_Scenario (Nod, In_Partial_Fin, In_Task_Body); + end if; - ------------------- - -- Traverse_List -- - ------------------- + return OK; + end Is_Potential_Scenario; - procedure Traverse_List (List : List_Id) is - Item : Node_Id; + ------------------- + -- Save_Scenario -- + ------------------- + + procedure Save_Scenario (Nod : Node_Id) is + Nested : Elist_Id; + + begin + Nested := Nested_Scenarios (Body_Id); + + if No (Nested) then + Nested := New_Elmt_List; + Set_Nested_Scenarios (Body_Id, Nested); + end if; + + Append_Elmt (Nod, Nested); + end Save_Scenario; + + ------------------- + -- Traverse_List -- + ------------------- + + procedure Traverse_List (List : List_Id) is + Item : Node_Id; + + begin + Item := First (List); + while Present (Item) loop + Traverse_Potential_Scenarios (Item); + Next (Item); + end loop; + end Traverse_List; + + -- Start of processing for Find_And_Process_Nested_Scenarios begin - Item := First (List); - while Present (Item) loop - Traverse_Potential_Scenarios (Item); - Next (Item); + -- Examine the declarations for suitable scenarios + + Traverse_List (Declarations (N)); + + -- Examine the handled sequence of statements. This also includes any + -- exceptions handlers. + + Traverse_Potential_Scenarios (Handled_Statement_Sequence (N)); + end Find_And_Process_Nested_Scenarios; + + ------------------------------ + -- Process_Nested_Scenarios -- + ------------------------------ + + procedure Process_Nested_Scenarios (Nested : Elist_Id) is + Nested_Elmt : Elmt_Id; + + begin + Nested_Elmt := First_Elmt (Nested); + while Present (Nested_Elmt) loop + Process_Scenario + (N => Node (Nested_Elmt), + In_Partial_Fin => In_Partial_Fin, + In_Task_Body => In_Task_Body); + + Next_Elmt (Nested_Elmt); end loop; - end Traverse_List; + end Process_Nested_Scenarios; + + -- Local variables + + Nested : Elist_Id; -- Start of processing for Traverse_Body @@ -8421,7 +8739,7 @@ package body Sem_Elab is end if; -- Nothing to do if the body was already traversed during the processing - -- of the same top level scenario. + -- of the same top-level scenario. if Visited_Bodies.Get (N) then return; @@ -8432,14 +8750,23 @@ package body Sem_Elab is Visited_Bodies.Set (N, True); end if; - -- Examine the declarations for suitable scenarios + Nested := Nested_Scenarios (Defining_Entity (N)); + + -- The subprogram body was already examined as part of the elaboration + -- graph starting from a different top-level scenario. There is no need + -- to traverse the declarations and statements again because this will + -- yield the exact same scenarios. Use the nested scenarios collected + -- during the first inspection of the body. - Traverse_List (Declarations (N)); + if Present (Nested) then + Process_Nested_Scenarios (Nested); - -- Examine the handled sequence of statements. This also includes any - -- exceptions handlers. + -- Otherwise examine the declarations and statements of the subprogram + -- body for suitable scenarios, save and process them accordingly. - Traverse_Potential_Scenarios (Handled_Statement_Sequence (N)); + else + Find_And_Process_Nested_Scenarios; + end if; end Traverse_Body; --------------------------------- @@ -8450,14 +8777,18 @@ package body Sem_Elab is package Scenarios renames Top_Level_Scenarios; begin + -- Nothing to do when the old and new scenarios are one and the same + + if Old_N = New_N then + return; + -- A scenario is being transformed by Atree.Rewrite. Update all relevant -- internal data structures to reflect this change. This ensures that a -- potential run-time conditional ABE check or a guaranteed ABE failure -- is inserted at the proper place in the tree. - if Is_Check_Emitting_Scenario (Old_N) - and then Is_Recorded_Scenario (Old_N) - and then Old_N /= New_N + elsif Is_Scenario (Old_N) + and then Is_Recorded_Top_Level_Scenario (Old_N) then -- Performance note: list traversal @@ -8465,13 +8796,17 @@ package body Sem_Elab is if Scenarios.Table (Index) = Old_N then Scenarios.Table (Index) := New_N; - Set_Is_Recorded_Scenario (Old_N, False); - Set_Is_Recorded_Scenario (New_N); + -- The old top-level scenario is no longer recorded, but the + -- new one is. + + Set_Is_Recorded_Top_Level_Scenario (Old_N, False); + Set_Is_Recorded_Top_Level_Scenario (New_N); return; end if; end loop; - -- A recorded scenario must be in the table of recorded scenarios + -- A recorded top-level scenario must be in the table of recorded + -- top-level scenarios. pragma Assert (False); end if; diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads index ddcd43306b0..69d65d8cd69 100644 --- a/gcc/ada/sem_elab.ads +++ b/gcc/ada/sem_elab.ads @@ -34,6 +34,15 @@ package Sem_Elab is -- Create a call marker for call or requeue statement N and record it for -- later processing by the ABE mechanism. + procedure Build_Variable_Reference_Marker + (N : Node_Id; + Read : Boolean; + Write : Boolean); + -- Create a variable reference marker for arbitrary node N if it mentions a + -- variable, and record it for later processing by the ABE mechanism. Flag + -- Read should be set when the reference denotes a read. Flag Write should + -- be set when the reference denotes a write. + procedure Check_Elaboration_Scenarios; -- Examine each scenario recorded during analysis/resolution and apply the -- Ada or SPARK elaboration rules taking into account the model in effect. diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 0c6c2ea7472..01eb8144e68 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -2301,7 +2301,7 @@ package body Sem_Eval is Left_Str : constant Node_Id := Get_String_Val (Left); Left_Len : Nat; Right_Str : constant Node_Id := Get_String_Val (Right); - Folded_Val : String_Id; + Folded_Val : String_Id := No_String; begin -- Establish new string literal, and store left operand. We make diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index ad8c388c616..886c2b4f432 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -101,7 +101,7 @@ package body Sem_Intr is Nam : constant Entity_Id := Entity (Name (N)); Arg1 : constant Node_Id := First_Actual (N); Typ : Entity_Id; - Rtyp : Entity_Id; + Rtyp : Entity_Id := Empty; Cnam : Name_Id; Unam : Node_Id; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index eae149805fa..b071aa8c892 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -217,7 +217,7 @@ package body Sem_Prag is Freeze_Id : Entity_Id); -- Subsidiary to the analysis of pragmas Contract_Cases, Part_Of, Post, and -- Pre. Emit a freezing-related error message where Freeze_Id is the entity - -- of a body which caused contract "freezing" and Contract_Id denotes the + -- of a body which caused contract freezing and Contract_Id denotes the -- entity of the affected contstruct. procedure Duplication_Error (Prag : Node_Id; Prev : Node_Id); @@ -432,7 +432,7 @@ package body Sem_Prag is -- Emit a clarification message when the case guard contains -- at least one undefined reference, possibly due to contract - -- "freezing". + -- freezing. if Errors /= Serious_Errors_Detected and then Present (Freeze_Id) @@ -447,7 +447,7 @@ package body Sem_Prag is -- Emit a clarification message when the consequence contains -- at least one undefined reference, possibly due to contract - -- "freezing". + -- freezing. if Errors /= Serious_Errors_Detected and then Present (Freeze_Id) @@ -3287,8 +3287,8 @@ package body Sem_Prag is if not Is_Child_Or_Sibling (Pack_Id, Scope (Encap_Id)) then SPARK_Msg_NE - ("indicator Part_Of must denote abstract state or public " - & "descendant of & (SPARK RM 7.2.6(3))", + ("indicator Part_Of must denote abstract state of & " + & "or of its public descendant (SPARK RM 7.2.6(3))", Indic, Parent_Unit); return; @@ -3301,8 +3301,8 @@ package body Sem_Prag is else SPARK_Msg_NE - ("indicator Part_Of must denote abstract state or public " - & "descendant of & (SPARK RM 7.2.6(3))", + ("indicator Part_Of must denote abstract state of & " + & "or of its public descendant (SPARK RM 7.2.6(3))", Indic, Parent_Unit); return; end if; @@ -3327,7 +3327,7 @@ package body Sem_Prag is elsif Placement = Private_State_Space then if Scope (Encap_Id) /= Pack_Id then SPARK_Msg_NE - ("indicator Part_Of must designate an abstract state of " + ("indicator Part_Of must denote an abstract state of " & "package & (SPARK RM 7.2.6(2))", Indic, Pack_Id); Error_Msg_Name_1 := Chars (Pack_Id); SPARK_Msg_NE @@ -3510,7 +3510,7 @@ package body Sem_Prag is end if; -- Emit a clarification message when the encapsulator is undefined, - -- possibly due to contract "freezing". + -- possibly due to contract freezing. if Errors /= Serious_Errors_Detected and then Present (Freeze_Id) @@ -5817,8 +5817,8 @@ package body Sem_Prag is procedure Check_Grouping (L : List_Id) is HSS : Node_Id; - Prag : Node_Id; Stmt : Node_Id; + Prag : Node_Id := Empty; -- init to avoid warning begin -- Inspect the list of declarations or statements looking for @@ -5872,16 +5872,15 @@ package body Sem_Prag is else while Present (Stmt) loop - -- The current pragma is either the first pragma - -- of the group or is a member of the group. Stop - -- the search as the placement is legal. + -- of the group or is a member of the group. + -- Stop the search as the placement is legal. if Stmt = N then raise Stop_Search; - -- Skip group members, but keep track of the last - -- pragma in the group. + -- Skip group members, but keep track of the + -- last pragma in the group. elsif Is_Loop_Pragma (Stmt) then Prag := Stmt; @@ -11390,6 +11389,7 @@ package body Sem_Prag is SPARK_Msg_N ("expression of external state property must be " & "static", Expr); + return; end if; -- The lack of expression defaults the property to True @@ -16474,6 +16474,20 @@ package body Sem_Prag is return; end if; + -- Ada 2012 (AI05-0030): Cannot apply the implementation_kind + -- By_Protected_Procedure to the primitive procedure of a task + -- interface. + + if Chars (Arg2) = Name_By_Protected_Procedure + and then Is_Interface (Typ) + and then Is_Task_Interface (Typ) + then + Error_Pragma_Arg + ("implementation kind By_Protected_Procedure cannot be " + & "applied to a task interface primitive", Arg2); + return; + end if; + -- Procedures declared inside a protected type must be accepted elsif Ekind (Proc_Id) = E_Procedure @@ -16489,20 +16503,6 @@ package body Sem_Prag is return; end if; - -- Ada 2012 (AI05-0030): Cannot apply the implementation_kind - -- By_Protected_Procedure to the primitive procedure of a task - -- interface. - - if Chars (Arg2) = Name_By_Protected_Procedure - and then Is_Interface (Typ) - and then Is_Task_Interface (Typ) - then - Error_Pragma_Arg - ("implementation kind By_Protected_Procedure cannot be " - & "applied to a task interface primitive", Arg2); - return; - end if; - Record_Rep_Item (Proc_Id, N); end Implemented; @@ -24253,11 +24253,16 @@ package body Sem_Prag is else OK := Set_Warning_Switch (Chr); end if; - end if; - if not OK then + if not OK then + Error_Pragma_Arg + ("invalid warning switch character " & Chr, + Arg1); + end if; + + else Error_Pragma_Arg - ("invalid warning switch character " & Chr, + ("invalid wide character in warning switch ", Arg1); end if; @@ -24608,7 +24613,7 @@ package body Sem_Prag is Preanalyze_Assert_Expression (Expr, Standard_Boolean); -- Emit a clarification message when the expression contains at least - -- one undefined reference, possibly due to contract "freezing". + -- one undefined reference, possibly due to contract freezing. if Errors /= Serious_Errors_Detected and then Present (Freeze_Id) @@ -27358,7 +27363,7 @@ package body Sem_Prag is Constit_Id := Entity_Of (Constit); -- When a constituent is declared after a subprogram body - -- that caused "freezing" of the related contract where + -- that caused freezing of the related contract where -- pragma Refined_State resides, the constituent appears -- undefined and carries Any_Id as its entity. @@ -28398,8 +28403,8 @@ package body Sem_Prag is end if; end if; - -- When the item appears in the private state space of a packge, it must - -- be a part of some state declared by the said package. + -- When the item appears in the private state space of a package, it + -- must be a part of some state declared by the said package. else pragma Assert (Placement = Private_State_Space); @@ -28747,7 +28752,7 @@ package body Sem_Prag is Depends : Node_Id; Formal : Entity_Id; Global : Node_Id; - Spec_Id : Entity_Id; + Spec_Id : Entity_Id := Empty; Subp_Decl : Node_Id; Typ : Entity_Id; @@ -29290,7 +29295,7 @@ package body Sem_Prag is elsif Present (Corresponding_Aspect (Prag)) then return Parent (Corresponding_Aspect (Prag)); - -- No candidate packge [body] found + -- No candidate package [body] found else return Empty; @@ -29364,10 +29369,11 @@ package body Sem_Prag is elsif N = Name_Off then return Off; - -- Any other argument is illegal + -- Any other argument is illegal. Assume that no SPARK mode applies to + -- avoid potential cascaded errors. else - raise Program_Error; + return None; end if; end Get_SPARK_Mode_Type; diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 33dbe488ae1..57fb8e57af9 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -191,6 +191,8 @@ package Sem_Prag is Pragma_Remote_Types => False, Pragma_Shared_Passive => False, Pragma_Task_Dispatching_Policy => False, + Pragma_Unmodified => False, + Pragma_Unreferenced => False, Pragma_Warnings => False, others => True); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index f5c5f9e96dc..024b879fd14 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1030,7 +1030,7 @@ package body Sem_Res is if Nkind (N) in N_Has_Etype and then Etype (N) = Any_Type then return; elsif Nkind (N) in N_Has_Chars - and then Chars (N) in Error_Name_Or_No_Name + and then not Is_Valid_Name (Chars (N)) then return; end if; @@ -1212,7 +1212,7 @@ package body Sem_Res is Func : constant Entity_Id := Entity (Name (N)); Is_Binary : constant Boolean := Present (Act2); Op_Node : Node_Id; - Opnd_Type : Entity_Id; + Opnd_Type : Entity_Id := Empty; Orig_Type : Entity_Id := Empty; Pack : Entity_Id; @@ -1523,6 +1523,7 @@ package body Sem_Res is -- Operator may be defined in an extension of System elsif Present (System_Aux_Id) + and then Present (Opnd_Type) and then Scope (Opnd_Type) = System_Aux_Id then null; @@ -2439,22 +2440,27 @@ package body Sem_Res is Set_Entity (N, Seen); Generate_Reference (Seen, N); - elsif Nkind (N) = N_Case_Expression then - Set_Etype (N, Expr_Type); - - elsif Nkind (N) = N_Character_Literal then - Set_Etype (N, Expr_Type); - - elsif Nkind (N) = N_If_Expression then + elsif Nkind_In (N, N_Case_Expression, + N_Character_Literal, + N_Delta_Aggregate, + N_If_Expression) + then Set_Etype (N, Expr_Type); -- AI05-0139-2: Expression is overloaded because type has -- implicit dereference. If type matches context, no implicit - -- dereference is involved. + -- dereference is involved. If the expression is an entity, + -- generate a reference to it, as this is not done for an + -- overloaded construct during analysis. elsif Has_Implicit_Dereference (Expr_Type) then Set_Etype (N, Expr_Type); Set_Is_Overloaded (N, False); + + if Is_Entity_Name (N) then + Generate_Reference (Entity (N), N); + end if; + exit Interp_Loop; elsif Is_Overloaded (N) @@ -3138,12 +3144,12 @@ package body Sem_Res is Loc : constant Source_Ptr := Sloc (N); A : Node_Id; A_Id : Entity_Id; - A_Typ : Entity_Id; + A_Typ : Entity_Id := Empty; -- init to avoid warning F : Entity_Id; F_Typ : Entity_Id; Prev : Node_Id := Empty; Orig_A : Node_Id; - Real_F : Entity_Id; + Real_F : Entity_Id := Empty; -- init to avoid warning Real_Subp : Entity_Id; -- If the subprogram being called is an inherited operation for @@ -3744,6 +3750,21 @@ package body Sem_Res is and then Is_Entity_Name (A) and then Comes_From_Source (A) then + -- Annotate the tree by creating a variable reference marker when + -- the actual denotes a variable reference, in case the reference + -- is folded or optimized away. The variable reference marker is + -- automatically saved for later examination by the ABE Processing + -- phase. The status of the reference is set as follows: + + -- status mode + -- read IN, IN OUT + -- write IN OUT, OUT + + Build_Variable_Reference_Marker + (N => A, + Read => Ekind (F) /= E_Out_Parameter, + Write => Ekind (F) /= E_In_Parameter); + Orig_A := Entity (A); if Present (Orig_A) then @@ -5130,6 +5151,38 @@ package body Sem_Res is if not Is_Static_Coextension (N) then Set_Is_Dynamic_Coextension (N); + + -- ??? We currently do not handle finalization and deallocation + -- of coextensions properly so let's at least warn the user + -- about it. + + if Is_Controlled_Active (Desig_T) then + if Is_Controlled_Active + (Defining_Identifier + (Parent (Associated_Node_For_Itype (Typ)))) + then + Error_Msg_N + ("??coextension will not be finalized when its " + & "associated owner is finalized", N); + else + Error_Msg_N + ("??coextension will not be finalized when its " + & "associated owner is deallocated", N); + end if; + else + if Is_Controlled_Active + (Defining_Identifier + (Parent (Associated_Node_For_Itype (Typ)))) + then + Error_Msg_N + ("??coextension will not be deallocated when " + & "its associated owner is finalized", N); + else + Error_Msg_N + ("??coextension will not be deallocated when " + & "its associated owner is deallocated", N); + end if; + end if; end if; -- Cleanup for potential static coextensions @@ -5137,6 +5190,19 @@ package body Sem_Res is else Set_Is_Dynamic_Coextension (N, False); Set_Is_Static_Coextension (N, False); + + -- ??? It seems we also do not properly finalize anonymous + -- access-to-controlled objects within their declared scope and + -- instead finalize them with their associated unit. Warn the + -- user about it here. + + if Ekind (Typ) = E_Anonymous_Access_Type + and then Is_Controlled_Active (Desig_T) + then + Error_Msg_N + ("??anonymous access-to-controlled object will be finalized " + & "when its enclosing unit goes out of scope", N); + end if; end if; end if; @@ -7210,9 +7276,13 @@ package body Sem_Res is elsif Ekind (E) = E_Generic_Function then Error_Msg_N ("illegal use of generic function", N); - -- In Ada 83 an OUT parameter cannot be read + -- In Ada 83 an OUT parameter cannot be read, but attributes of + -- array types (i.e. bounds and length) are legal. elsif Ekind (E) = E_Out_Parameter + and then (Nkind (Parent (N)) /= N_Attribute_Reference + or else Is_Scalar_Type (Etype (E))) + and then (Nkind (Parent (N)) in N_Op or else Nkind (Parent (N)) = N_Explicit_Dereference or else Is_Assignment_Or_Object_Expression diff --git a/gcc/ada/sem_spark.adb b/gcc/ada/sem_spark.adb index 5107d3bc5f4..42517ea0829 100644 --- a/gcc/ada/sem_spark.adb +++ b/gcc/ada/sem_spark.adb @@ -2349,6 +2349,7 @@ package body Sem_SPARK is | N_With_Clause | N_Use_Type_Clause | N_Validate_Unchecked_Conversion + | N_Variable_Reference_Marker => null; diff --git a/gcc/ada/sem_spark.ads b/gcc/ada/sem_spark.ads index d7abd8ad74a..d6977880d47 100644 --- a/gcc/ada/sem_spark.ads +++ b/gcc/ada/sem_spark.ads @@ -27,10 +27,10 @@ -- rules that are enforced are defined in the anti-aliasing section of the -- SPARK RM 6.4.2 -- --- Analyze_SPARK is called by Gnat1drv, when GNATprove mode is activated. It --- does an analysis of the source code, looking for code that is considered --- as SPARK and launches another function called Analyze_Node that will do --- the whole analysis. +-- Check_Safe_Pointers is called by Gnat1drv, when GNATprove mode is +-- activated. It does an analysis of the source code, looking for code that is +-- considered as SPARK and launches another function called Analyze_Node that +-- will do the whole analysis. -- -- A path is an abstraction of a name, of which all indices, slices (for -- indexed components) and function calls have been abstracted and all diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3698bbf16bd..102da89e9ca 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -141,7 +141,9 @@ package body Sem_Util is function Subprogram_Name (N : Node_Id) return String; -- Return the fully qualified name of the enclosing subprogram for the - -- given node N. + -- given node N, with file:line:col information appended, e.g. + -- "subp:file:line:col", corresponding to the source location of the + -- body of the subprogram. ------------------------------ -- Abstract_Interface_List -- @@ -594,6 +596,8 @@ package body Sem_Util is ----------- procedure Inner (E : Entity_Id) is + Scop : Node_Id; + begin -- If entity has an internal name, skip by it, and print its scope. -- Note that we strip a final R from the name before the test; this @@ -615,21 +619,23 @@ package body Sem_Util is end if; end; + Scop := Scope (E); + -- Just print entity name if its scope is at the outer level - if Scope (E) = Standard_Standard then + if Scop = Standard_Standard then null; -- If scope comes from source, write scope and entity - elsif Comes_From_Source (Scope (E)) then - Append_Entity_Name (Temp, Scope (E)); + elsif Comes_From_Source (Scop) then + Append_Entity_Name (Temp, Scop); Append (Temp, '.'); -- If in wrapper package skip past it - elsif Is_Wrapper_Package (Scope (E)) then - Append_Entity_Name (Temp, Scope (Scope (E))); + elsif Present (Scop) and then Is_Wrapper_Package (Scop) then + Append_Entity_Name (Temp, Scope (Scop)); Append (Temp, '.'); -- Otherwise nothing to output (happens in unnamed block statements) @@ -4025,7 +4031,7 @@ package body Sem_Util is if SPARK_Mode_Is_Off (Pack) then null; - -- State refinement can only occur in a completing packge body. Do + -- State refinement can only occur in a completing package body. Do -- not verify proper state refinement when the body is subject to -- pragma SPARK_Mode Off because this disables the requirement for -- state refinement. @@ -7835,6 +7841,66 @@ package body Sem_Util is raise Program_Error; end Find_Corresponding_Discriminant; + ------------------- + -- Find_DIC_Type -- + ------------------- + + function Find_DIC_Type (Typ : Entity_Id) return Entity_Id is + Curr_Typ : Entity_Id; + -- The current type being examined in the parent hierarchy traversal + + DIC_Typ : Entity_Id; + -- The type which carries the DIC pragma. This variable denotes the + -- partial view when private types are involved. + + Par_Typ : Entity_Id; + -- The parent type of the current type. This variable denotes the full + -- view when private types are involved. + + begin + -- The input type defines its own DIC pragma, therefore it is the owner + + if Has_Own_DIC (Typ) then + DIC_Typ := Typ; + + -- Otherwise the DIC pragma is inherited from a parent type + + else + pragma Assert (Has_Inherited_DIC (Typ)); + + -- Climb the parent chain + + Curr_Typ := Typ; + loop + -- Inspect the parent type. Do not consider subtypes as they + -- inherit the DIC attributes from their base types. + + DIC_Typ := Base_Type (Etype (Curr_Typ)); + + -- Look at the full view of a private type because the type may + -- have a hidden parent introduced in the full view. + + Par_Typ := DIC_Typ; + + if Is_Private_Type (Par_Typ) + and then Present (Full_View (Par_Typ)) + then + Par_Typ := Full_View (Par_Typ); + end if; + + -- Stop the climb once the nearest parent type which defines a DIC + -- pragma of its own is encountered or when the root of the parent + -- chain is reached. + + exit when Has_Own_DIC (DIC_Typ) or else Curr_Typ = Par_Typ; + + Curr_Typ := Par_Typ; + end loop; + end if; + + return DIC_Typ; + end Find_DIC_Type; + ---------------------------------- -- Find_Enclosing_Iterator_Loop -- ---------------------------------- @@ -13193,14 +13259,14 @@ package body Sem_Util is if Ekind (Proc_Nam) = E_Procedure and then Present (Parameter_Specifications (Parent (Proc_Nam))) then - Param := Parameter_Type (First ( - Parameter_Specifications (Parent (Proc_Nam)))); + Param := + Parameter_Type + (First (Parameter_Specifications (Parent (Proc_Nam)))); - -- The formal may be an anonymous access type. + -- The formal may be an anonymous access type if Nkind (Param) = N_Access_Definition then Param_Typ := Entity (Subtype_Mark (Param)); - else Param_Typ := Etype (Param); end if; @@ -14860,10 +14926,6 @@ package body Sem_Util is function Within_Check (Nod : Node_Id) return Boolean; -- Determine whether an arbitrary node appears in a check node - function Within_Subprogram_Call (Nod : Node_Id) return Boolean; - -- Determine whether an arbitrary node appears in an entry, function, or - -- procedure call. - function Within_Volatile_Function (Id : Entity_Id) return Boolean; -- Determine whether an arbitrary entity appears in a volatile function @@ -14926,36 +14988,6 @@ package body Sem_Util is return False; end Within_Check; - ---------------------------- - -- Within_Subprogram_Call -- - ---------------------------- - - function Within_Subprogram_Call (Nod : Node_Id) return Boolean is - Par : Node_Id; - - begin - -- Climb the parent chain looking for a function or procedure call - - Par := Nod; - while Present (Par) loop - if Nkind_In (Par, N_Entry_Call_Statement, - N_Function_Call, - N_Procedure_Call_Statement) - then - return True; - - -- Prevent the search from going too far - - elsif Is_Body_Or_Package_Declaration (Par) then - exit; - end if; - - Par := Parent (Par); - end loop; - - return False; - end Within_Subprogram_Call; - ------------------------------ -- Within_Volatile_Function -- ------------------------------ @@ -15416,7 +15448,7 @@ package body Sem_Util is Anc_Part : Node_Id; Assoc : Node_Id; Choice : Node_Id; - Comp_Typ : Entity_Id; + Comp_Typ : Entity_Id := Empty; -- init to avoid warning Expr : Node_Id; begin @@ -15492,6 +15524,7 @@ package body Sem_Util is -- The type of the choice must have preelaborable initialization if -- the association carries a <>. + pragma Assert (Present (Comp_Typ)); if Box_Present (Assoc) then if not Has_Preelaborable_Initialization (Comp_Typ) then return False; @@ -17526,8 +17559,8 @@ package body Sem_Util is L_Ndims : constant Nat := Number_Dimensions (L_Typ); R_Ndims : constant Nat := Number_Dimensions (R_Typ); - L_Index : Node_Id; - R_Index : Node_Id; + L_Index : Node_Id := Empty; -- init to ... + R_Index : Node_Id := Empty; -- ...avoid warnings L_Low : Node_Id; L_High : Node_Id; L_Len : Uint; @@ -19504,9 +19537,9 @@ package body Sem_Util is N : constant Entity_Id := Make_Temporary (Sloc_Value, Id_Char); begin - Set_Ekind (N, Kind); - Set_Is_Internal (N, True); - Append_Entity (N, Scope_Id); + Set_Ekind (N, Kind); + Set_Is_Internal (N, True); + Append_Entity (N, Scope_Id); if Kind in Type_Kind then Init_Size_Align (N); @@ -23295,6 +23328,7 @@ package body Sem_Util is function Subprogram_Name (N : Node_Id) return String is Buf : Bounded_String; Ent : Node_Id := N; + Nod : Node_Id; begin while Present (Ent) loop @@ -23303,17 +23337,32 @@ package body Sem_Util is Ent := Defining_Unit_Name (Specification (Ent)); exit; - when N_Package_Body + when N_Subprogram_Declaration => + Nod := Corresponding_Body (Ent); + + if Present (Nod) then + Ent := Nod; + else + Ent := Defining_Unit_Name (Specification (Ent)); + end if; + + exit; + + when N_Subprogram_Instantiation + | N_Package_Body | N_Package_Specification - | N_Subprogram_Specification => Ent := Defining_Unit_Name (Ent); exit; + when N_Protected_Type_Declaration => + Ent := Corresponding_Body (Ent); + exit; + when N_Protected_Body - | N_Protected_Type_Declaration | N_Task_Body => + Ent := Defining_Identifier (Ent); exit; when others => @@ -23324,18 +23373,55 @@ package body Sem_Util is end loop; if No (Ent) then - return "unknown subprogram"; + return "unknown subprogram:unknown file:0:0"; end if; -- If the subprogram is a child unit, use its simple name to start the -- construction of the fully qualified name. if Nkind (Ent) = N_Defining_Program_Unit_Name then - Append_Entity_Name (Buf, Defining_Identifier (Ent)); - else - Append_Entity_Name (Buf, Ent); + Ent := Defining_Identifier (Ent); + end if; + + Append_Entity_Name (Buf, Ent); + + -- Append homonym number if needed + + if Nkind (N) in N_Entity and then Has_Homonym (N) then + declare + H : Entity_Id := Homonym (N); + Nr : Nat := 1; + + begin + while Present (H) loop + if Scope (H) = Scope (N) then + Nr := Nr + 1; + end if; + + H := Homonym (H); + end loop; + + if Nr > 1 then + Append (Buf, '#'); + Append (Buf, Nr); + end if; + end; end if; + -- Append source location of Ent to Buf so that the string will + -- look like "subp:file:line:col". + + declare + Loc : constant Source_Ptr := Sloc (Ent); + begin + Append (Buf, ':'); + Append (Buf, Reference_Name (Get_Source_File_Index (Loc))); + Append (Buf, ':'); + Append (Buf, Nat (Get_Logical_Line_Number (Loc))); + Append (Buf, ':'); + Append (Buf, Nat (Get_Column_Number (Loc))); + end; + return +Buf; end Subprogram_Name; @@ -24184,6 +24270,36 @@ package body Sem_Util is return Scope_Within_Or_Same (Scope (E), S); end Within_Scope; + ---------------------------- + -- Within_Subprogram_Call -- + ---------------------------- + + function Within_Subprogram_Call (N : Node_Id) return Boolean is + Par : Node_Id; + + begin + -- Climb the parent chain looking for a function or procedure call + + Par := N; + while Present (Par) loop + if Nkind_In (Par, N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement) + then + return True; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; + + return False; + end Within_Subprogram_Call; + ---------------- -- Wrong_Type -- ---------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c6958cb1aaa..9aaa1160ed7 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -769,6 +769,11 @@ package Sem_Util is -- analyzed. Subsequent uses of this id on a different type denotes the -- discriminant at the same position in this new type. + function Find_DIC_Type (Typ : Entity_Id) return Entity_Id; + -- Subsidiary to all Build_DIC_Procedure_xxx routines. Find the type which + -- defines the Default_Initial_Condition pragma of type Typ. This is either + -- Typ itself or a parent type when the pragma is inherited. + function Find_Enclosing_Iterator_Loop (Id : Entity_Id) return Entity_Id; -- Find the nearest iterator loop which encloses arbitrary entity Id. If -- such a loop exists, return the entity of its identifier (E_Loop scope), @@ -2735,6 +2740,10 @@ package Sem_Util is function Within_Scope (E : Entity_Id; S : Entity_Id) return Boolean; -- Returns True if entity E is declared within scope S + function Within_Subprogram_Call (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N appears in an entry, function, or + -- procedure call. + procedure Wrong_Type (Expr : Node_Id; Expected_Type : Entity_Id); -- Output error message for incorrectly typed expression. Expr is the node -- for the incorrectly typed construct (Etype (Expr) is the type found), diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 0e498d3e6cb..ff94cf84e41 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3344,7 +3344,8 @@ package body Sem_Warn is ----------------------------- procedure Warn_On_Known_Condition (C : Node_Id) is - Test_Result : Boolean; + Test_Result : Boolean := False; + -- Force initialization to facilitate static analysis function Is_Known_Branch return Boolean; -- If the type of the condition is Boolean, the constant value of the diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb index f25c9f84f81..93b71018d89 100755 --- a/gcc/ada/set_targ.adb +++ b/gcc/ada/set_targ.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2013-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2013-2017, 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- -- @@ -580,6 +580,7 @@ package body Set_Targ is -- Checks that we have one or more spaces and skips them procedure FailN (S : String); + pragma No_Return (FailN); -- Calls Fail adding " name in file xxx", where name is the currently -- gathered name in Nam_Buf, surrounded by quotes, and xxx is the -- name of the file. diff --git a/gcc/ada/sigtramp-qnx.c b/gcc/ada/sigtramp-qnx.c new file mode 100644 index 00000000000..6e70534c08c --- /dev/null +++ b/gcc/ada/sigtramp-qnx.c @@ -0,0 +1,273 @@ +/**************************************************************************** + * * + * GNAT COMPILER COMPONENTS * + * * + * S I G T R A M P * + * * + * Asm Implementation File * + * * + * Copyright (C) 2017, Free Software Foundation, Inc. * + * * + * GNAT is free software; you can redistribute it and/or modify it under * + * terms of the GNU General Public License as published by the Free Soft- * + * ware Foundation; either version 3, or (at your option) any later ver- * + * sion. GNAT is distributed in the hope that it will be useful, but WITH- * + * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * + * or FITNESS FOR A PARTICULAR PURPOSE. * + * * + * As a special exception under Section 7 of GPL version 3, you are granted * + * additional permissions described in the GCC Runtime Library Exception, * + * version 3.1, as published by the Free Software Foundation. * + * * + * In particular, you can freely distribute your programs built with the * + * GNAT Pro compiler, including any required library run-time units, using * + * any licensing terms of your choosing. See the AdaCore Software License * + * for full details. * + * * + * GNAT was originally developed by the GNAT team at New York University. * + * Extensive contributions were provided by Ada Core Technologies Inc. * + * * + ****************************************************************************/ + +/********************************************** + * QNX version of the __gnat_sigtramp service * + **********************************************/ + +#include <ucontext.h> + +#include "sigtramp.h" +/* See sigtramp.h for a general explanation of functionality. */ + +extern void __gnat_sigtramp_common + (int signo, void *siginfo, void *sigcontext, + __sigtramphandler_t * handler); + +void __gnat_sigtramp (int signo, void *si, void *sc, + __sigtramphandler_t * handler) + __attribute__((optimize(2))); + +void __gnat_sigtramp (int signo, void *si, void *ucontext, + __sigtramphandler_t * handler) +{ + struct sigcontext *mcontext = &((ucontext_t *) ucontext)->uc_mcontext; + + __gnat_sigtramp_common (signo, si, mcontext, handler); +} + +/* asm string construction helpers. */ + +#define STR(TEXT) #TEXT +/* stringify expanded TEXT, surrounding it with double quotes. */ + +#define S(E) STR(E) +/* stringify E, which will resolve as text but may contain macros + still to be expanded. */ + +/* asm (TEXT) outputs <tab>TEXT. These facilitate the output of + multiline contents: */ +#define TAB(S) "\t" S +#define CR(S) S "\n" + +#undef TCR +#define TCR(S) TAB(CR(S)) + +/* Trampoline body block + --------------------- */ + +#define COMMON_CFI(REG) \ + ".cfi_offset " S(REGNO_##REG) "," S(REG_OFFSET_##REG) + +#ifdef __x86_64__ +/***************************************** + * x86-64 * + *****************************************/ + +// CFI register numbers +#define REGNO_RAX 0 +#define REGNO_RDX 1 +#define REGNO_RCX 2 +#define REGNO_RBX 3 +#define REGNO_RSI 4 +#define REGNO_RDI 5 +#define REGNO_RBP 6 +#define REGNO_RSP 7 +#define REGNO_R8 8 +#define REGNO_R9 9 +#define REGNO_R10 10 +#define REGNO_R11 11 +#define REGNO_R12 12 +#define REGNO_R13 13 +#define REGNO_R14 14 +#define REGNO_R15 15 /* Used as CFA */ +#define REGNO_RPC 16 /* aka %rip */ + +// Registers offset from the regset structure +#define REG_OFFSET_RDI 0x00 +#define REG_OFFSET_RSI 0x08 +#define REG_OFFSET_RDX 0x10 +#define REG_OFFSET_R10 0x18 +#define REG_OFFSET_R8 0x20 +#define REG_OFFSET_R9 0x28 +#define REG_OFFSET_RAX 0x30 +#define REG_OFFSET_RBX 0x38 +#define REG_OFFSET_RBP 0x40 +#define REG_OFFSET_RCX 0x48 +#define REG_OFFSET_R11 0x50 +#define REG_OFFSET_R12 0x58 +#define REG_OFFSET_R13 0x60 +#define REG_OFFSET_R14 0x68 +#define REG_OFFSET_R15 0x70 +#define REG_OFFSET_RPC 0x78 /* RIP */ +#define REG_OFFSET_RSP 0x90 + +#define CFI_COMMON_REGS \ +CR("# CFI for common registers\n") \ +TCR(COMMON_CFI(RSP)) \ +TCR(COMMON_CFI(R15)) \ +TCR(COMMON_CFI(R14)) \ +TCR(COMMON_CFI(R13)) \ +TCR(COMMON_CFI(R12)) \ +TCR(COMMON_CFI(R11)) \ +TCR(COMMON_CFI(RCX)) \ +TCR(COMMON_CFI(RBP)) \ +TCR(COMMON_CFI(RBX)) \ +TCR(COMMON_CFI(RAX)) \ +TCR(COMMON_CFI(R9)) \ +TCR(COMMON_CFI(R8)) \ +TCR(COMMON_CFI(R10)) \ +TCR(COMMON_CFI(RSI)) \ +TCR(COMMON_CFI(RDI)) \ +TCR(COMMON_CFI(RDX)) \ +TCR(COMMON_CFI(RPC)) \ +TCR(".cfi_return_column " S(REGNO_RPC)) + +#define SIGTRAMP_BODY \ +TCR(".cfi_def_cfa 15, 0") \ +CFI_COMMON_REGS \ +CR("") \ +TCR("# Allocate frame and save the non-volatile") \ +TCR("# registers we're going to modify") \ +TCR("subq $8, %rsp") \ +TCR("# Setup CFA_REG = context, which we'll retrieve as our CFA value") \ +TCR("movq %rdx, %r15") \ +TCR("# Call the real handler. The signo, siginfo and sigcontext") \ +TCR("# arguments are the same as those we received") \ +TCR("call *%rcx") \ +TCR("# This part should never be executed") \ +TCR("addq $8, %rsp") \ +TCR("ret") +#endif + +#ifdef __aarch64__ +/***************************************** + * Aarch64 * + *****************************************/ + +/* CFA reg: any callee saved register will do */ +#define CFA_REG 19 + +/* General purpose registers */ +#define REG_OFFSET_GR(n) (n * 8) +#define REGNO_GR(n) n + +/* point to the ELR value of the mcontext registers list */ +#define REG_OFFSET_ELR (32 * 8) +#define REGNO_PC 30 + +#define CFI_DEF_CFA \ + TCR(".cfi_def_cfa " S(CFA_REG) ", 0") + +#define CFI_COMMON_REGS \ + CR("# CFI for common registers\n") \ + TCR(COMMON_CFI(GR(0))) \ + TCR(COMMON_CFI(GR(1))) \ + TCR(COMMON_CFI(GR(2))) \ + TCR(COMMON_CFI(GR(3))) \ + TCR(COMMON_CFI(GR(4))) \ + TCR(COMMON_CFI(GR(5))) \ + TCR(COMMON_CFI(GR(6))) \ + TCR(COMMON_CFI(GR(7))) \ + TCR(COMMON_CFI(GR(8))) \ + TCR(COMMON_CFI(GR(9))) \ + TCR(COMMON_CFI(GR(10))) \ + TCR(COMMON_CFI(GR(11))) \ + TCR(COMMON_CFI(GR(12))) \ + TCR(COMMON_CFI(GR(13))) \ + TCR(COMMON_CFI(GR(14))) \ + TCR(COMMON_CFI(GR(15))) \ + TCR(COMMON_CFI(GR(16))) \ + TCR(COMMON_CFI(GR(17))) \ + TCR(COMMON_CFI(GR(18))) \ + TCR(COMMON_CFI(GR(19))) \ + TCR(COMMON_CFI(GR(20))) \ + TCR(COMMON_CFI(GR(21))) \ + TCR(COMMON_CFI(GR(22))) \ + TCR(COMMON_CFI(GR(23))) \ + TCR(COMMON_CFI(GR(24))) \ + TCR(COMMON_CFI(GR(25))) \ + TCR(COMMON_CFI(GR(26))) \ + TCR(COMMON_CFI(GR(27))) \ + TCR(COMMON_CFI(GR(28))) \ + TCR(COMMON_CFI(GR(29))) \ + TCR(".cfi_offset " S(REGNO_PC) "," S(REG_OFFSET_ELR)) \ + TCR(".cfi_return_column " S(REGNO_PC)) + +#define SIGTRAMP_BODY \ + CFI_DEF_CFA \ + CFI_COMMON_REGS \ + TCR("# Push FP and LR on stack") \ + TCR("stp x29, x30, [sp, #-16]!") \ + TCR("# Push register used to hold the CFA on stack") \ + TCR("str x" S(CFA_REG) ", [sp, #-8]!") \ + TCR("# Set the CFA: x2 value") \ + TCR("mov x" S(CFA_REG) ", x2") \ + TCR("# Call the handler") \ + TCR("blr x3") \ + TCR("# Release our frame and return (should never get here!).") \ + TCR("ldr x" S(CFA_REG) " , [sp], 8") \ + TCR("ldp x29, x30, [sp], 16") \ + TCR("ret") + +#endif /* AARCH64 */ + +/* Symbol definition block + ----------------------- */ + +#if defined (__x86_64__) || defined (__aarch64__) +#define FUNC_ALIGN TCR(".p2align 4,,15") +#else +#define FUNC_ALIGN +#endif + +#define SIGTRAMP_START(SYM) \ +CR("# " S(SYM) " cfi trampoline") \ +TCR(".type " S(SYM) ", @function") \ +CR("") \ +FUNC_ALIGN \ +CR(S(SYM) ":") \ +TCR(".cfi_startproc") \ +TCR(".cfi_signal_frame") + +/* Symbol termination block + ------------------------ */ + +#define SIGTRAMP_END(SYM) \ +CR(".cfi_endproc") \ +TCR(".size " S(SYM) ", .-" S(SYM)) + +/*---------------------------- + -- And now, the real code -- + ---------------------------- */ + +/* Text section start. The compiler isn't aware of that switch. */ + +asm (".text\n" + TCR(".align 2")); + +/* sigtramp stub for common registers. */ + +#define TRAMP_COMMON __gnat_sigtramp_common + +asm (SIGTRAMP_START(TRAMP_COMMON)); +asm (SIGTRAMP_BODY); +asm (SIGTRAMP_END(TRAMP_COMMON)); diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index dc4e8fb2c1a..20ff3b26557 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -2090,16 +2090,13 @@ package body Sinfo is return Flag4 (N); end Is_Qualified_Universal_Literal; - function Is_Recorded_Scenario + function Is_Read (N : Node_Id) return Boolean is begin pragma Assert (False - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Instantiation); - return Flag6 (N); - end Is_Recorded_Scenario; + or else NT (N).Nkind = N_Variable_Reference_Marker); + return Flag1 (N); + end Is_Read; function Is_Source_Call (N : Node_Id) return Boolean is @@ -2179,6 +2176,14 @@ package body Sinfo is return Flag5 (N); end Is_Task_Master; + function Is_Write + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Variable_Reference_Marker); + return Flag2 (N); + end Is_Write; + function Iteration_Scheme (N : Node_Id) return Node_Id is begin @@ -3277,7 +3282,8 @@ package body Sinfo is (N : Node_Id) return Entity_Id is begin pragma Assert (False - or else NT (N).Nkind = N_Call_Marker); + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Variable_Reference_Marker); return Node1 (N); end Target; @@ -5512,16 +5518,13 @@ package body Sinfo is Set_Flag4 (N, Val); end Set_Is_Qualified_Universal_Literal; - procedure Set_Is_Recorded_Scenario + procedure Set_Is_Read (N : Node_Id; Val : Boolean := True) is begin pragma Assert (False - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Instantiation); - Set_Flag6 (N, Val); - end Set_Is_Recorded_Scenario; + or else NT (N).Nkind = N_Variable_Reference_Marker); + Set_Flag1 (N, Val); + end Set_Is_Read; procedure Set_Is_Source_Call (N : Node_Id; Val : Boolean := True) is @@ -5601,6 +5604,14 @@ package body Sinfo is Set_Flag5 (N, Val); end Set_Is_Task_Master; + procedure Set_Is_Write + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Variable_Reference_Marker); + Set_Flag2 (N, Val); + end Set_Is_Write; + procedure Set_Iteration_Scheme (N : Node_Id; Val : Node_Id) is begin @@ -6699,7 +6710,8 @@ package body Sinfo is (N : Node_Id; Val : Entity_Id) is begin pragma Assert (False - or else NT (N).Nkind = N_Call_Marker); + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Variable_Reference_Marker); Set_Node1 (N, Val); -- semantic field, no parent set end Set_Target; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index cf220e4e563..f9f84ac416b 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -38,7 +38,7 @@ -- The tree contains not only the full syntactic representation of the -- program, but also the results of semantic analysis. In particular, the --- nodes for defining identifiers, defining character literals and defining +-- nodes for defining identifiers, defining character literals, and defining -- operator symbols, collectively referred to as entities, represent what -- would normally be regarded as the symbol table information. In addition a -- number of the tree nodes contain semantic information. @@ -213,7 +213,7 @@ package Sinfo is -- The Present function tests for Empty, which in this case signals the end -- of the list. First returns Empty immediately if the list is empty. - -- Present is defined in Atree, First and Next are defined in Nlists. + -- Present is defined in Atree; First and Next are defined in Nlists. -- The exceptions to this rule occur with {DEFINING_IDENTIFIERS} in all -- contexts, which is handled as described in the previous section, and @@ -389,7 +389,7 @@ package Sinfo is -- In the following node definitions, all fields, both syntactic and -- semantic, are documented. The one exception is in the case of entities - -- (defining identifiers, character literals and operator symbols), where + -- (defining identifiers, character literals, and operator symbols), where -- the usage of the fields depends on the entity kind. Entity fields are -- fully documented in the separate package Einfo. @@ -1116,7 +1116,7 @@ package Sinfo is -- complete a subprogram declaration. -- Corresponding_Spec_Of_Stub (Node2-Sem) - -- This field is present in subprogram, package, task and protected body + -- This field is present in subprogram, package, task, and protected body -- stubs where it points to the corresponding spec of the stub. Due to -- clashes in the structure of nodes, we cannot use Corresponding_Spec. @@ -1754,7 +1754,7 @@ package Sinfo is -- Is_Generic_Contract_Pragma (Flag2-Sem) -- This flag is present in N_Pragma nodes. It is set when the pragma is - -- a source construct, applies to a generic unit or its body and denotes + -- a source construct, applies to a generic unit or its body, and denotes -- one of the following contract-related annotations: -- Abstract_State -- Contract_Cases @@ -1863,11 +1863,9 @@ package Sinfo is -- the resolution of accidental overloading of binary or unary operators -- which may occur in instances. - -- Is_Recorded_Scenario (Flag6-Sem) - -- Present in call marker and instantiation nodes. Set when the scenario - -- was saved by the ABE Recording phase. This flag aids the ABE machinery - -- to keep its internal data up-to-date in case the node is transformed - -- by Atree.Rewrite. + -- Is_Read (Flag1-Sem) + -- Present in variable reference markers. Set when the original variable + -- reference constitues a read of the variable. -- Is_Source_Call (Flag4-Sem) -- Present in call marker nodes. Set when the related call came from @@ -1912,10 +1910,14 @@ package Sinfo is -- nodes which emulate the body of a task unit. -- Is_Task_Master (Flag5-Sem) - -- A flag set in a Subprogram_Body, Block_Statement or Task_Body node to + -- A flag set in a Subprogram_Body, Block_Statement, or Task_Body node to -- indicate that the construct is a task master (i.e. has declared tasks -- or declares an access to a task type). + -- Is_Write (Flag2-Sem) + -- Present in variable reference markers. Set when the original variable + -- reference constitues a write of the variable. + -- Itype (Node1-Sem) -- Used in N_Itype_Reference node to reference an itype for which it is -- important to ensure that it is defined. See description of this node @@ -2017,7 +2019,7 @@ package Sinfo is -- calls to Freeze_Expression. -- Next_Entity (Node2-Sem) - -- Present in defining identifiers, defining character literals and + -- Present in defining identifiers, defining character literals, and -- defining operator symbols (i.e. in all entities). The entities of a -- scope are chained, and this field is used as the forward pointer for -- this list. See Einfo for further details. @@ -2234,7 +2236,7 @@ package Sinfo is -- because Analyze wants to insert extra actions on this list. -- Rounded_Result (Flag18-Sem) - -- Present in N_Type_Conversion, N_Op_Divide and N_Op_Multiply nodes. + -- Present in N_Type_Conversion, N_Op_Divide, and N_Op_Multiply nodes. -- Used in the fixed-point cases to indicate that the result must be -- rounded as a result of the use of the 'Round attribute. Also used for -- integer N_Op_Divide nodes to indicate that the result should be @@ -2267,7 +2269,7 @@ package Sinfo is -- operation named (statically) in a dispatching call. -- Scope (Node3-Sem) - -- Present in defining identifiers, defining character literals and + -- Present in defining identifiers, defining character literals, and -- defining operator symbols (i.e. in all entities). The entities of a -- scope all use this field to reference the corresponding scope entity. -- See Einfo for further details. @@ -2318,8 +2320,9 @@ package Sinfo is -- only execute if invalid values are present). -- Target (Node1-Sem) - -- Present in call marker nodes. References the entity of the entry, - -- operator, or subprogram invoked by the related call or requeue. + -- Present in call and variable reference marker nodes. References the + -- entity of the original entity, operator, or subprogram being invoked, + -- or the original variable being read or written. -- Target_Type (Node2-Sem) -- Used in an N_Validate_Unchecked_Conversion node to point to the target @@ -2338,7 +2341,7 @@ package Sinfo is -- always set to No_List. -- Treat_Fixed_As_Integer (Flag14-Sem) - -- This flag appears in operator nodes for divide, multiply, mod and rem + -- This flag appears in operator nodes for divide, multiply, mod, and rem -- on fixed-point operands. It indicates that the operands are to be -- treated as integer values, ignoring small values. This flag is only -- set as a result of expansion of fixed-point operations. Typically a @@ -2728,7 +2731,7 @@ package Sinfo is -- pain to allow these aspects to pervade the pragma syntax, and the -- representation of pragma nodes internally. So what we do is to -- replace these ASPECT_MARK forms with identifiers whose name is one - -- of the special internal names _Pre, _Post or _Type_Invariant. + -- of the special internal names _Pre, _Post, or _Type_Invariant. -- We do a similar replacement of these Aspect_Mark forms in the -- Expression of a pragma argument association for the cases of @@ -3025,8 +3028,8 @@ package Sinfo is -- [abstract] [limited] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION -- [[and INTERFACE_LIST] RECORD_EXTENSION_PART] - -- Note: ABSTRACT, LIMITED and record extension part are not permitted - -- in Ada 83 mode + -- Note: ABSTRACT, LIMITED, and record extension part are not permitted + -- in Ada 83 mode. -- Note: a record extension part is required if ABSTRACT is present @@ -3337,7 +3340,7 @@ package Sinfo is -- Subtype_Indication field or else the Access_Definition field. -- N_Component_Definition - -- Sloc points to ALIASED, ACCESS or to first token of subtype mark + -- Sloc points to ALIASED, ACCESS, or to first token of subtype mark -- Aliased_Present (Flag4) -- Null_Exclusion_Present (Flag11) -- Subtype_Indication (Node5) (set to Empty if not present) @@ -3485,7 +3488,7 @@ package Sinfo is -- end record -- | null record - -- Note: the Abstract_Present, Tagged_Present and Limited_Present + -- Note: the Abstract_Present, Tagged_Present, and Limited_Present -- flags appear only for a record definition appearing in a record -- type definition. @@ -4013,7 +4016,7 @@ package Sinfo is -- Instead the Attribute_Name and Expressions fields of the parent -- node (N_Attribute_Reference node) hold the information. - -- Note: if ACCESS, DELTA or DIGITS appears in an attribute + -- Note: if ACCESS, DELTA, or DIGITS appears in an attribute -- designator, then they are treated as identifiers internally -- rather than the keywords of the same name. @@ -7036,7 +7039,6 @@ package Sinfo is -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) -- Is_SPARK_Mode_On_Node (Flag2-Sem) -- Is_Declaration_Level_Node (Flag5-Sem) - -- Is_Recorded_Scenario (Flag6-Sem) -- Is_Known_Guaranteed_ABE (Flag18-Sem) -- N_Procedure_Instantiation @@ -7050,7 +7052,6 @@ package Sinfo is -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) -- Is_SPARK_Mode_On_Node (Flag2-Sem) -- Is_Declaration_Level_Node (Flag5-Sem) - -- Is_Recorded_Scenario (Flag6-Sem) -- Must_Override (Flag14) set if overriding indicator present -- Must_Not_Override (Flag15) set if not_overriding indicator present -- Is_Known_Guaranteed_ABE (Flag18-Sem) @@ -7066,7 +7067,6 @@ package Sinfo is -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) -- Is_SPARK_Mode_On_Node (Flag2-Sem) -- Is_Declaration_Level_Node (Flag5-Sem) - -- Is_Recorded_Scenario (Flag6-Sem) -- Must_Override (Flag14) set if overriding indicator present -- Must_Not_Override (Flag15) set if not_overriding indicator present -- Is_Known_Guaranteed_ABE (Flag18-Sem) @@ -7824,7 +7824,6 @@ package Sinfo is -- Is_Dispatching_Call (Flag3-Sem) -- Is_Source_Call (Flag4-Sem) -- Is_Declaration_Level_Node (Flag5-Sem) - -- Is_Recorded_Scenario (Flag6-Sem) -- Is_Known_Guaranteed_ABE (Flag18-Sem) ------------------------ @@ -7911,7 +7910,7 @@ package Sinfo is -- to aspects/pragmas Contract_Cases and Test_Case. The ordering in the -- list is in LIFO fashion. - -- Classifications contains pragmas that either declare, categorize or + -- Classifications contains pragmas that either declare, categorize, or -- establish dependencies between subprogram or package inputs and -- outputs. Currently the following pragmas appear in this list: -- Abstract_States @@ -8455,6 +8454,37 @@ package Sinfo is -- Note: in the case where a debug source file is generated, the Sloc -- for this node points to the VALIDATE keyword in the file output. + ------------------------------- + -- Variable_Reference_Marker -- + ------------------------------- + + -- This node is created during the analysis of direct or expanded names, + -- and the resolution of entry and subprogram calls. It performs several + -- functions: + + -- * Variable reference markers provide a uniform model for handling + -- variable references by the ABE mechanism, regardless of whether + -- expansion took place. + + -- * The variable reference marker captures the entity of the variable + -- being read or written. + + -- * The variable reference markers aid the ABE Processing phase by + -- signaling the presence of a call in case the original variable + -- reference was transformed by expansion. + + -- Sprint syntax: r#target# -- for a read + -- rw#target# -- for a read/write + -- w#target# -- for a write + + -- The Sprint syntax shown above is not enabled by default + + -- N_Variable_Reference_Marker + -- Sloc points to Sloc of original variable reference + -- Target (Node1-Sem) + -- Is_Read (Flag1-Sem) + -- Is_Write (Flag2-Sem) + ----------- -- Empty -- ----------- @@ -8877,6 +8907,7 @@ package Sinfo is N_Triggering_Alternative, N_Use_Type_Clause, N_Validate_Unchecked_Conversion, + N_Variable_Reference_Marker, N_Variant, N_Variant_Part, N_With_Clause, @@ -9733,8 +9764,8 @@ package Sinfo is function Is_Qualified_Universal_Literal (N : Node_Id) return Boolean; -- Flag4 - function Is_Recorded_Scenario - (N : Node_Id) return Boolean; -- Flag6 + function Is_Read + (N : Node_Id) return Boolean; -- Flag1 function Is_Source_Call (N : Node_Id) return Boolean; -- Flag4 @@ -9760,6 +9791,9 @@ package Sinfo is function Is_Task_Master (N : Node_Id) return Boolean; -- Flag5 + function Is_Write + (N : Node_Id) return Boolean; -- Flag2 + function Iteration_Scheme (N : Node_Id) return Node_Id; -- Node2 @@ -10822,8 +10856,8 @@ package Sinfo is procedure Set_Is_Qualified_Universal_Literal (N : Node_Id; Val : Boolean := True); -- Flag4 - procedure Set_Is_Recorded_Scenario - (N : Node_Id; Val : Boolean := True); -- Flag6 + procedure Set_Is_Read + (N : Node_Id; Val : Boolean := True); -- Flag1 procedure Set_Is_Source_Call (N : Node_Id; Val : Boolean := True); -- Flag4 @@ -10849,6 +10883,9 @@ package Sinfo is procedure Set_Is_Task_Master (N : Node_Id; Val : Boolean := True); -- Flag5 + procedure Set_Is_Write + (N : Node_Id; Val : Boolean := True); -- Flag2 + procedure Set_Iteration_Scheme (N : Node_Id; Val : Node_Id); -- Node2 @@ -13023,7 +13060,14 @@ package Sinfo is 4 => False, -- unused 5 => False), -- unused - -- Entries for Empty, Error and Unused. Even thought these have a Chars + N_Variable_Reference_Marker => + (1 => False, -- Target (Node1-Sem) + 2 => False, -- unused + 3 => False, -- unused + 4 => False, -- unused + 5 => False), -- unused + + -- Entries for Empty, Error, and Unused. Even though these have a Chars -- field for debugging purposes, they are not really syntactic fields, so -- we mark all fields as unused. @@ -13276,7 +13320,7 @@ package Sinfo is pragma Inline (Is_Prefixed_Call); pragma Inline (Is_Protected_Subprogram_Body); pragma Inline (Is_Qualified_Universal_Literal); - pragma Inline (Is_Recorded_Scenario); + pragma Inline (Is_Read); pragma Inline (Is_Source_Call); pragma Inline (Is_SPARK_Mode_On_Node); pragma Inline (Is_Static_Coextension); @@ -13285,6 +13329,7 @@ package Sinfo is pragma Inline (Is_Task_Allocation_Block); pragma Inline (Is_Task_Body_Procedure); pragma Inline (Is_Task_Master); + pragma Inline (Is_Write); pragma Inline (Iteration_Scheme); pragma Inline (Itype); pragma Inline (Kill_Range_Check); @@ -13634,7 +13679,7 @@ package Sinfo is pragma Inline (Set_Is_Prefixed_Call); pragma Inline (Set_Is_Protected_Subprogram_Body); pragma Inline (Set_Is_Qualified_Universal_Literal); - pragma Inline (Set_Is_Recorded_Scenario); + pragma Inline (Set_Is_Read); pragma Inline (Set_Is_Source_Call); pragma Inline (Set_Is_SPARK_Mode_On_Node); pragma Inline (Set_Is_Static_Coextension); @@ -13643,6 +13688,7 @@ package Sinfo is pragma Inline (Set_Is_Task_Allocation_Block); pragma Inline (Set_Is_Task_Body_Procedure); pragma Inline (Set_Is_Task_Master); + pragma Inline (Set_Is_Write); pragma Inline (Set_Iteration_Scheme); pragma Inline (Set_Iterator_Specification); pragma Inline (Set_Itype); diff --git a/gcc/ada/spark_xrefs.adb b/gcc/ada/spark_xrefs.adb index 8fab555ac20..e59114d48c7 100644 --- a/gcc/ada/spark_xrefs.adb +++ b/gcc/ada/spark_xrefs.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2011-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2017, 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- -- @@ -23,8 +23,9 @@ -- -- ------------------------------------------------------------------------------ -with Output; use Output; -with Put_SPARK_Xrefs; +with Lib.Xref; +with Output; use Output; +with Sem_Util; use Sem_Util; package body SPARK_Xrefs is @@ -33,174 +34,48 @@ package body SPARK_Xrefs is ------------ procedure dspark is - begin - -- Dump SPARK cross-reference file table - Write_Line ("SPARK Xrefs File Table"); - Write_Line ("----------------------"); + procedure Dump (Index : Nat; AXR : SPARK_Xref_Record); + + procedure Dump_SPARK_Xrefs is new + Lib.Xref.SPARK_Specific.Iterate_SPARK_Xrefs (Dump); - for Index in 1 .. SPARK_File_Table.Last loop - declare - AFR : SPARK_File_Record renames SPARK_File_Table.Table (Index); + ---------- + -- Dump -- + ---------- - begin - Write_Str (" "); - Write_Int (Int (Index)); - Write_Str (". File_Num = "); - Write_Int (Int (AFR.File_Num)); - Write_Str (" File_Name = """); + procedure Dump (Index : Nat; AXR : SPARK_Xref_Record) is + begin + Write_Str (" "); + Write_Int (Index); + Write_Char ('.'); - if AFR.File_Name /= null then - Write_Str (AFR.File_Name.all); - end if; + Write_Str (" Entity = " & Unique_Name (AXR.Entity)); + Write_Str (" ("); + Write_Int (Nat (AXR.Entity)); + Write_Str (")"); - Write_Char ('"'); - Write_Str (" From = "); - Write_Int (Int (AFR.From_Scope)); - Write_Str (" To = "); - Write_Int (Int (AFR.To_Scope)); - Write_Eol; - end; - end loop; + Write_Str (" Scope = " & Unique_Name (AXR.Ref_Scope)); + Write_Str (" ("); + Write_Int (Nat (AXR.Ref_Scope)); + Write_Str (")"); - -- Dump SPARK cross-reference scope table + Write_Str (" Ref_Type = '" & AXR.Rtype & "'"); - Write_Eol; - Write_Line ("SPARK Xrefs Scope Table"); - Write_Line ("-----------------------"); - - for Index in 1 .. SPARK_Scope_Table.Last loop - declare - ASR : SPARK_Scope_Record renames SPARK_Scope_Table.Table (Index); - - begin - Write_Str (" "); - Write_Int (Int (Index)); - Write_Str (". File_Num = "); - Write_Int (Int (ASR.File_Num)); - Write_Str (" Scope_Num = "); - Write_Int (Int (ASR.Scope_Num)); - Write_Str (" Scope_Name = """); - - if ASR.Scope_Name /= null then - Write_Str (ASR.Scope_Name.all); - end if; - - Write_Char ('"'); - Write_Str (" Line = "); - Write_Int (Int (ASR.Line)); - Write_Str (" Col = "); - Write_Int (Int (ASR.Col)); - Write_Str (" Type = "); - Write_Char (ASR.Stype); - Write_Str (" From = "); - Write_Int (Int (ASR.From_Xref)); - Write_Str (" To = "); - Write_Int (Int (ASR.To_Xref)); - Write_Str (" Scope_Entity = "); - Write_Int (Int (ASR.Scope_Entity)); - Write_Eol; - end; - end loop; + Write_Eol; + end Dump; + -- Start of processing for dspark + + begin -- Dump SPARK cross-reference table Write_Eol; Write_Line ("SPARK Xref Table"); Write_Line ("----------------"); - for Index in 1 .. SPARK_Xref_Table.Last loop - declare - AXR : SPARK_Xref_Record renames SPARK_Xref_Table.Table (Index); - - begin - Write_Str (" "); - Write_Int (Int (Index)); - Write_Str (". Entity_Name = """); - - if AXR.Entity_Name /= null then - Write_Str (AXR.Entity_Name.all); - end if; - - Write_Char ('"'); - Write_Str (" Entity_Line = "); - Write_Int (Int (AXR.Entity_Line)); - Write_Str (" Entity_Col = "); - Write_Int (Int (AXR.Entity_Col)); - Write_Str (" File_Num = "); - Write_Int (Int (AXR.File_Num)); - Write_Str (" Scope_Num = "); - Write_Int (Int (AXR.Scope_Num)); - Write_Str (" Line = "); - Write_Int (Int (AXR.Line)); - Write_Str (" Col = "); - Write_Int (Int (AXR.Col)); - Write_Str (" Type = "); - Write_Char (AXR.Rtype); - Write_Eol; - end; - end loop; - end dspark; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize_SPARK_Tables is - begin - SPARK_File_Table.Init; - SPARK_Scope_Table.Init; - SPARK_Xref_Table.Init; - end Initialize_SPARK_Tables; - - ------------ - -- pspark -- - ------------ - - procedure pspark is - - procedure Write_Info_Char (C : Character) renames Write_Char; - -- Write one character + Dump_SPARK_Xrefs; - procedure Write_Info_Str (Val : String) renames Write_Str; - -- Write string - - function Write_Info_Col return Positive; - -- Return next column for writing - - procedure Write_Info_Initiate (Key : Character) renames Write_Char; - -- Start new one and write one character; - - procedure Write_Info_Nat (N : Nat); - -- Write value of N - - procedure Write_Info_Terminate renames Write_Eol; - -- Terminate current line - - -------------------- - -- Write_Info_Col -- - -------------------- - - function Write_Info_Col return Positive is - begin - return Positive (Column); - end Write_Info_Col; - - -------------------- - -- Write_Info_Nat -- - -------------------- - - procedure Write_Info_Nat (N : Nat) is - begin - Write_Int (N); - end Write_Info_Nat; - - procedure Debug_Put_SPARK_Xrefs is new Put_SPARK_Xrefs; - - -- Start of processing for pspark - - begin - Debug_Put_SPARK_Xrefs; - end pspark; + end dspark; end SPARK_Xrefs; diff --git a/gcc/ada/spark_xrefs.ads b/gcc/ada/spark_xrefs.ads index fd5b76d4a66..25af9024d51 100644 --- a/gcc/ada/spark_xrefs.ads +++ b/gcc/ada/spark_xrefs.ads @@ -23,352 +23,28 @@ -- -- ------------------------------------------------------------------------------ --- This package defines tables used to store information needed for the SPARK --- mode. It is used by procedures in Lib.Xref.SPARK_Specific to build the --- SPARK-specific cross-reference information before writing it to the ALI --- file, and by Get_SPARK_Xrefs/Put_SPARK_Xrefs to read/write the textual --- representation that is stored in the ALI file. +-- This package defines data structures used to expose frontend +-- cross-references to the SPARK backend. -with Table; -with Types; use Types; +with Types; use Types; package SPARK_Xrefs is - -- SPARK cross-reference information can exist in one of two forms. In - -- the ALI file, it is represented using a text format that is described - -- in this specification. Internally it is stored using three tables: - -- SPARK_Xref_Table, SPARK_Scope_Table and SPARK_File_Table, which are - -- also defined in this unit. - - -- Lib.Xref.SPARK_Specific is part of the compiler. It extracts SPARK - -- cross-reference information from the complete set of cross-references - -- generated during compilation. - - -- Get_SPARK_Xrefs reads the text lines in ALI format and populates the - -- internal tables with corresponding information. - - -- Put_SPARK_Xrefs reads the internal tables and generates text lines in - -- the ALI format. - - ---------------------------- - -- SPARK Xrefs ALI Format -- - ---------------------------- - - -- SPARK cross-reference information is generated on a unit-by-unit basis - -- in the ALI file, using lines that start with the identifying character F - -- ("Formal"). These lines are generated if GNATprove_Mode is True. - - -- The SPARK cross-reference information comes after the shared - -- cross-reference information, so it can be ignored by tools like - -- gnatbind, gnatmake, etc. - - -- ------------------- - -- -- Scope Section -- - -- ------------------- - - -- A first section defines the scopes in which entities are defined and - -- referenced. A scope is a package/subprogram/protected_type/task_type - -- declaration/body. Note that a package declaration and body define two - -- different scopes. Similarly, a subprogram, protected type and task type - -- declaration and body, when both present, define two different scopes. - - -- FD dependency-number filename (-> unit-filename)? - - -- This header precedes scope information for the unit identified by - -- dependency number and file name. The dependency number is the index - -- into the generated D lines and is ones-origin (e.g. 2 = reference to - -- second generated D line). - - -- The list of FD lines should match the list of D lines defined in the - -- ALI file, in the same order. - - -- Note that the filename here will reflect the original name if a - -- Source_Reference pragma was encountered (since all line number - -- references will be with respect to the original file). - - -- Note: the filename is redundant in that it could be deduced from the - -- corresponding D line, but it is convenient at least for human - -- reading of the SPARK cross-reference information, and means that - -- the SPARK cross-reference information can stand on its own without - -- needing other parts of the ALI file. - - -- The optional unit filename is given only for subunits. - - -- FS . scope line type col entity (-> spec-file . spec-scope)? - - -- (The ? mark stands for an optional entry in the syntax) - - -- scope is the ones-origin scope number for the current file (e.g. 2 = - -- reference to the second FS line in this FD block). - - -- line is the line number of the scope entity. The name of the entity - -- starts in column col. Columns are numbered from one, and if - -- horizontal tab characters are present, the column number is computed - -- assuming standard 1,9,17,.. tab stops. For example, if the entity is - -- the first token on the line, and is preceded by space-HT-space, then - -- the column would be column 10. - - -- type is a single letter identifying the type of the entity, using - -- the same code as in cross-references: - - -- K = package (k = generic package) - -- V = function (v = generic function) - -- U = procedure (u = generic procedure) - -- Y = entry - - -- col is the column number of the scope entity - - -- entity is the name of the scope entity, with casing in the canonical - -- casing for the source file where it is defined. - - -- spec-file and spec-scope are respectively the file and scope for the - -- spec corresponding to the current body scope, when they differ. - - -- ------------------ - -- -- Xref Section -- - -- ------------------ - - -- A second section defines cross-references useful for computing global - -- variables read/written in each subprogram/package/protected_type/ - -- task_type. - - -- FX dependency-number filename . entity-number entity - - -- dependency-number and filename identify a file in FD lines - - -- entity-number and entity identify a scope in FS lines - -- for the previously identified file. - - -- (filename and entity are just a textual representations of - -- dependency-number and entity-number) - - -- F line typ col entity ref* - - -- line is the line number of the referenced entity - - -- typ is the type of the referenced entity, using a code similar to - -- the one used for cross-references: - - -- > = IN parameter - -- < = OUT parameter - -- = = IN OUT parameter - -- * = all other cases - - -- col is the column number of the referenced entity - - -- entity is the name of the referenced entity as written in the source - -- file where it is defined. - - -- There may be zero or more ref entries on each line - - -- (file |)? ((. scope :)? line type col)* - - -- file is the dependency number of the file with the reference. It and - -- the following vertical bar are omitted if the file is the same as - -- the previous ref, and the refs for the current file are first (and - -- do not need a bar). - - -- scope is the scope number of the scope with the reference. It and - -- the following colon are omitted if the scope is the same as the - -- previous ref, and the refs for the current scope are first (and do - -- not need a colon). - - -- line is the line number of the reference - - -- col is the column number of the reference - - -- type is one of the following, using the same code as in - -- cross-references: - - -- m = modification - -- r = reference - -- c = reference to constant object - -- s = subprogram reference in a static call - - -- Special entries for reads and writes to memory reference a special - -- variable called "__HEAP". These special entries are present in every - -- scope where reads and writes to memory are present. Line and column for - -- this special variable are always 0. - - -- Examples: ??? add examples here - - -- ------------------------------- - -- -- Generated Globals Section -- - -- ------------------------------- - - -- The Generated Globals section is located at the end of the ALI file - - -- All lines with information related to the Generated Globals begin with - -- string "GG". This string should therefore not be used in the beginning - -- of any line not related to Generated Globals. - - -- The processing (reading and writing) of this section happens in package - -- Flow_Generated_Globals (from the SPARK 2014 sources), for further - -- information please refer there. - - ---------------- - -- Xref Table -- - ---------------- - - -- The following table records SPARK cross-references - - type Xref_Index is new Nat; - -- Used to index values in this table. Values start at 1 and are assigned - -- sequentially as entries are constructed; value 0 is used temporarily - -- until a proper value is determined. - type SPARK_Xref_Record is record - Entity_Name : String_Ptr; - -- Pointer to entity name in ALI file - - Entity_Line : Nat; - -- Line number for the entity referenced - - Etype : Character; - -- Indicates type of entity, using code used in ALI file: - -- > = IN parameter - -- < = OUT parameter - -- = = IN OUT parameter - -- * = all other cases - - Entity_Col : Nat; - -- Column number for the entity referenced - - File_Num : Nat; - -- File dependency number for the cross-reference. Note that if no file - -- entry is present explicitly, this is just a copy of the reference for - -- the current cross-reference section. - - Scope_Num : Nat; - -- Scope number for the cross-reference. Note that if no scope entry is - -- present explicitly, this is just a copy of the reference for the - -- current cross-reference section. + Entity : Entity_Id; + -- Referenced entity - Line : Nat; - -- Line number for the reference + Ref_Scope : Entity_Id; + -- Scope where the reference occurs Rtype : Character; -- Indicates type of the reference, using code used in ALI file: -- r = reference - -- c = reference to constant object -- m = modification -- s = call - - Col : Nat; - -- Column number for the reference - end record; - - package SPARK_Xref_Table is new Table.Table ( - Table_Component_Type => SPARK_Xref_Record, - Table_Index_Type => Xref_Index, - Table_Low_Bound => 1, - Table_Initial => 2000, - Table_Increment => 300, - Table_Name => "Xref_Table"); - - ----------------- - -- Scope Table -- - ----------------- - - -- This table keeps track of the scopes and the corresponding starting and - -- ending indexes (From, To) in the Xref table. - - type Scope_Index is new Nat; - -- Used to index values in this table. Values start at 1 and are assigned - -- sequentially as entries are constructed; value 0 indicates that no - -- entries have been constructed and is also used until a proper value is - -- determined. - - type SPARK_Scope_Record is record - Scope_Name : String_Ptr; - -- Pointer to scope name in ALI file - - File_Num : Nat; - -- Set to the file dependency number for the scope - - Scope_Num : Pos; - -- Set to the scope number for the scope - - Spec_File_Num : Nat; - -- Set to the file dependency number for the scope corresponding to the - -- spec of the current scope entity, if different, or else 0. - - Spec_Scope_Num : Nat; - -- Set to the scope number for the scope corresponding to the spec of - -- the current scope entity, if different, or else 0. - - Line : Nat; - -- Line number for the scope - - Stype : Character; - -- Indicates type of scope, using code used in ALI file: - -- K = package - -- T = task - -- U = procedure - -- V = function - -- Y = entry - - Col : Nat; - -- Column number for the scope - - From_Xref : Xref_Index; - -- Starting index in Xref table for this scope - - To_Xref : Xref_Index; - -- Ending index in Xref table for this scope - - -- The following component is only used in-memory, not printed out in - -- ALI file. - - Scope_Entity : Entity_Id := Empty; - -- Entity (subprogram or package) for the scope end record; - - package SPARK_Scope_Table is new Table.Table ( - Table_Component_Type => SPARK_Scope_Record, - Table_Index_Type => Scope_Index, - Table_Low_Bound => 1, - Table_Initial => 200, - Table_Increment => 300, - Table_Name => "Scope_Table"); - - ---------------- - -- File Table -- - ---------------- - - -- This table keeps track of the units and the corresponding starting and - -- ending indexes (From, To) in the Scope table. - - type File_Index is new Nat; - -- Used to index values in this table. Values start at 1 and are assigned - -- sequentially as entries are constructed; value 0 indicates that no - -- entries have been constructed. - - type SPARK_File_Record is record - File_Name : String_Ptr; - -- Pointer to file name in ALI file - - Unit_File_Name : String_Ptr; - -- Pointer to file name for unit in ALI file, when File_Name refers to a - -- subunit; otherwise null. - - File_Num : Nat; - -- Dependency number in ALI file - - From_Scope : Scope_Index; - -- Starting index in Scope table for this unit - - To_Scope : Scope_Index; - -- Ending index in Scope table for this unit - end record; - - package SPARK_File_Table is new Table.Table ( - Table_Component_Type => SPARK_File_Record, - Table_Index_Type => File_Index, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 200, - Table_Name => "File_Table"); + -- This type holds a subset of the frontend xref entry that is needed by + -- the SPARK backend. --------------- -- Constants -- @@ -378,19 +54,17 @@ package SPARK_Xrefs is -- Name of special variable used in effects to denote reads and writes -- through explicit dereference. + Heap : Entity_Id := Empty; + -- A special entity which denotes the heap object; it should be considered + -- constant, but needs to be variable, because it can only be initialized + -- after the node tables are created. + ----------------- -- Subprograms -- ----------------- - procedure Initialize_SPARK_Tables; - -- Reset tables for a new compilation - procedure dspark; -- Debug routine to dump internal SPARK cross-reference tables. This is a -- raw format dump showing exactly what the tables contain. - procedure pspark; - -- Debugging procedure to output contents of SPARK cross-reference binary - -- tables in the format in which they appear in an ALI file. - end SPARK_Xrefs; diff --git a/gcc/ada/spark_xrefs_test.adb b/gcc/ada/spark_xrefs_test.adb deleted file mode 100644 index 6ad4de2c158..00000000000 --- a/gcc/ada/spark_xrefs_test.adb +++ /dev/null @@ -1,321 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- S P A R K _ X R E F S _ T E S T -- --- -- --- B o d y -- --- -- --- Copyright (C) 2011-2013, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This utility program is used to test proper operation of the --- Get_SPARK_Xrefs and Put_SPARK_Xrefs units. To run it, compile any source --- file with switch -gnatd.E or -gnatd.F to get an ALI file file.ALI --- containing SPARK information. Then run this utility using: - --- spark_xrefs_test file.ali - --- This test will read the SPARK cross-reference information from the ALI --- file, and use Get_SPARK_Xrefs to store this in binary form in the internal --- tables in SPARK_Xrefs. Then Put_SPARK_Xrefs is used to write the --- information from these tables back into text form. This output is compared --- with the original SPARK cross-reference information in the ALI file and the --- two should be identical. If not an error message is output. - -with Get_SPARK_Xrefs; -with Put_SPARK_Xrefs; - -with SPARK_Xrefs; use SPARK_Xrefs; -with Types; use Types; - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Streams; use Ada.Streams; -with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; -with Ada.Text_IO; - -with GNAT.OS_Lib; use GNAT.OS_Lib; - -procedure SPARK_Xrefs_Test is - Infile : File_Type; - Name1 : String_Access; - Outfile_1 : File_Type; - Name2 : String_Access; - Outfile_2 : File_Type; - C : Character; - - Stop : exception; - -- Terminate execution - - Diff_Exec : constant String_Access := Locate_Exec_On_Path ("diff"); - Diff_Result : Integer; - - use ASCII; - -begin - if Argument_Count /= 1 then - Ada.Text_IO.Put_Line ("Usage: spark_xrefs_test FILE.ali"); - raise Stop; - end if; - - Name1 := new String'(Argument (1) & ".1"); - Name2 := new String'(Argument (1) & ".2"); - - Open (Infile, In_File, Argument (1)); - Create (Outfile_1, Out_File, Name1.all); - Create (Outfile_2, Out_File, Name2.all); - - -- Read input file till we get to first 'F' line - - Process : declare - Output_Col : Positive := 1; - - function Get_Char (F : File_Type) return Character; - -- Read one character from specified file - - procedure Put_Char (F : File_Type; C : Character); - -- Write one character to specified file - - function Get_Output_Col return Positive; - -- Return current column in output file, where each line starts at - -- column 1 and terminate with LF, and HT is at columns 1, 9, etc. - -- All output is supposed to be carried through Put_Char. - - -------------- - -- Get_Char -- - -------------- - - function Get_Char (F : File_Type) return Character is - Item : Stream_Element_Array (1 .. 1); - Last : Stream_Element_Offset; - - begin - Read (F, Item, Last); - - if Last /= 1 then - return Types.EOF; - else - return Character'Val (Item (1)); - end if; - end Get_Char; - - -------------------- - -- Get_Output_Col -- - -------------------- - - function Get_Output_Col return Positive is - begin - return Output_Col; - end Get_Output_Col; - - -------------- - -- Put_Char -- - -------------- - - procedure Put_Char (F : File_Type; C : Character) is - Item : Stream_Element_Array (1 .. 1); - - begin - if C /= CR and then C /= EOF then - if C = LF then - Output_Col := 1; - elsif C = HT then - Output_Col := ((Output_Col + 6) / 8) * 8 + 1; - else - Output_Col := Output_Col + 1; - end if; - - Item (1) := Character'Pos (C); - Write (F, Item); - end if; - end Put_Char; - - -- Subprograms used by Get_SPARK_Xrefs (these also copy the output to - -- Outfile_1 for later comparison with the output generated by - -- Put_SPARK_Xrefs). - - function Getc return Character; - function Nextc return Character; - procedure Skipc; - - ---------- - -- Getc -- - ---------- - - function Getc return Character is - C : Character; - begin - C := Get_Char (Infile); - Put_Char (Outfile_1, C); - return C; - end Getc; - - ----------- - -- Nextc -- - ----------- - - function Nextc return Character is - C : Character; - - begin - C := Get_Char (Infile); - - if C /= EOF then - Set_Index (Infile, Index (Infile) - 1); - end if; - - return C; - end Nextc; - - ----------- - -- Skipc -- - ----------- - - procedure Skipc is - C : Character; - pragma Unreferenced (C); - begin - C := Getc; - end Skipc; - - -- Subprograms used by Put_SPARK_Xrefs, which write information to - -- Outfile_2. - - function Write_Info_Col return Positive; - procedure Write_Info_Char (C : Character); - procedure Write_Info_Initiate (Key : Character); - procedure Write_Info_Nat (N : Nat); - procedure Write_Info_Terminate; - - -------------------- - -- Write_Info_Col -- - -------------------- - - function Write_Info_Col return Positive is - begin - return Get_Output_Col; - end Write_Info_Col; - - --------------------- - -- Write_Info_Char -- - --------------------- - - procedure Write_Info_Char (C : Character) is - begin - Put_Char (Outfile_2, C); - end Write_Info_Char; - - ------------------------- - -- Write_Info_Initiate -- - ------------------------- - - procedure Write_Info_Initiate (Key : Character) is - begin - Write_Info_Char (Key); - end Write_Info_Initiate; - - -------------------- - -- Write_Info_Nat -- - -------------------- - - procedure Write_Info_Nat (N : Nat) is - begin - if N > 9 then - Write_Info_Nat (N / 10); - end if; - - Write_Info_Char (Character'Val (48 + N mod 10)); - end Write_Info_Nat; - - -------------------------- - -- Write_Info_Terminate -- - -------------------------- - - procedure Write_Info_Terminate is - begin - Write_Info_Char (LF); - end Write_Info_Terminate; - - -- Local instantiations of Put_SPARK_Xrefs and Get_SPARK_Xrefs - - procedure Get_SPARK_Xrefs_Info is new Get_SPARK_Xrefs; - procedure Put_SPARK_Xrefs_Info is new Put_SPARK_Xrefs; - - -- Start of processing for Process - - begin - -- Loop to skip till first 'F' line - - loop - C := Get_Char (Infile); - - if C = EOF then - raise Stop; - - elsif C = LF or else C = CR then - loop - C := Get_Char (Infile); - exit when C /= LF and then C /= CR; - end loop; - - exit when C = 'F'; - end if; - end loop; - - -- Position back to initial 'F' of first 'F' line - - Set_Index (Infile, Index (Infile) - 1); - - -- Read SPARK cross-reference information to internal SPARK tables, also - -- copying SPARK xrefs info to Outfile_1. - - Initialize_SPARK_Tables; - Get_SPARK_Xrefs_Info; - - -- Write SPARK cross-reference information from internal SPARK tables to - -- Outfile_2. - - Put_SPARK_Xrefs_Info; - - -- Junk blank line (see comment at end of Lib.Writ) - - Write_Info_Terminate; - - -- Flush to disk - - Close (Outfile_1); - Close (Outfile_2); - - -- Now Outfile_1 and Outfile_2 should be identical - - Diff_Result := - Spawn (Diff_Exec.all, - Argument_String_To_List - ("-u " & Name1.all & " " & Name2.all).all); - - if Diff_Result /= 0 then - Ada.Text_IO.Put_Line ("diff(1) exit status" & Diff_Result'Img); - end if; - - OS_Exit (Diff_Result); - - end Process; - -exception - when Stop => - null; -end SPARK_Xrefs_Test; diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index ac2dcd8a14d..428e91a73cd 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -3459,6 +3459,25 @@ package body Sprint is Sprint_Node (Target_Type (Node)); Write_Str (");"); + when N_Variable_Reference_Marker => + null; + + -- Enable the following code for debugging purposes only + + -- if Is_Read (Node) and then Is_Write (Node) then + -- Write_Indent_Str ("rw#"); + + -- elsif Is_Read (Node) then + -- Write_Indent_Str ("r#"); + + -- else + -- pragma Assert (Is_Write (Node)); + -- Write_Indent_Str ("w#"); + -- end if; + + -- Write_Id (Target (Node)); + -- Write_Char ('#'); + when N_Variant => Write_Indent_Str_Sloc ("when "); Sprint_Bar_List (Discrete_Choices (Node)); diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb index a0d61aa37b4..df043d0669b 100644 --- a/gcc/ada/style.adb +++ b/gcc/ada/style.adb @@ -166,7 +166,7 @@ package body Style is Error_Msg_Node_1 := Def; Error_Msg_Sloc := Sloc (Def); Error_Msg -- CODEFIX - ("(style) bad casing of & declared#", Sref); + ("(style) bad casing of & declared#", Sref, Ref); return; -- Else end of identifiers, and they match diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb index ff8155adfc9..e851a2466b8 100644 --- a/gcc/ada/stylesw.adb +++ b/gcc/ada/stylesw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -150,10 +150,6 @@ package body Stylesw is -- Start of processing for Save_Style_Check_Options begin - for K in Options'Range loop - Options (K) := ' '; - end loop; - Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')), Style_Check_Indentation /= 0); @@ -165,7 +161,8 @@ package body Stylesw is if Style_Check_Comments then if Style_Check_Comments_Spacing = 2 then Add ('c', Style_Check_Comments); - elsif Style_Check_Comments_Spacing = 1 then + else + pragma Assert (Style_Check_Comments_Spacing = 1); Add ('C', Style_Check_Comments); end if; end if; diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 5ad10e348a5..c1ff88d234e 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -337,19 +337,7 @@ package body Switch.C is when 'C' => Ptr := Ptr + 1; - - if not CodePeer_Mode then - CodePeer_Mode := True; - - -- Suppress compiler warnings by default, since what we are - -- interested in here is what CodePeer can find out. Note - -- that if -gnatwxxx is specified after -gnatC on the - -- command line, we do not want to override this setting in - -- Adjust_Global_Switches, and assume that the user wants to - -- get both warnings from GNAT and CodePeer messages. - - Warning_Mode := Suppress; - end if; + CodePeer_Mode := True; -- -gnatd (compiler debug options) diff --git a/gcc/ada/terminals.c b/gcc/ada/terminals.c index 9133a3bd88c..9f300514ced 100644 --- a/gcc/ada/terminals.c +++ b/gcc/ada/terminals.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 2008-2016, AdaCore * + * Copyright (C) 2008-2017, AdaCore * * * * 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- * @@ -1111,7 +1111,7 @@ __gnat_setup_winsize (void *desc, int rows, int columns) /* On some system termio is either absent or including it will disable termios (HP-UX) */ #if !defined (__hpux__) && !defined (BSD) && !defined (__APPLE__) \ - && !defined (__rtems__) + && !defined (__rtems__) && !defined (__QNXNTO__) # include <termio.h> #endif diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c index 7532ca2d71b..e5eb0fefc26 100644 --- a/gcc/ada/tracebak.c +++ b/gcc/ada/tracebak.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 2000-2016, Free Software Foundation, Inc. * + * Copyright (C) 2000-2017, 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- * @@ -500,6 +500,18 @@ struct layout || ((*((ptr) - 1) & 0xff) == 0xff) \ || (((*(ptr) & 0xd0ff) == 0xd0ff)))) +/*----------------------------- qnx ----------------------------------*/ + +#elif defined (__QNX__) + +#define USE_GCC_UNWINDER + +#if defined (__aarch64__) +#define PC_ADJUST -4 +#else +#error Unhandled QNX architecture. +#endif + /*----------------------------- ia64 ---------------------------------*/ #elif defined (__ia64__) && (defined (__linux__) || defined (__hpux__)) |