+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
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);
-- 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);
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);
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,
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
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:
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;
-- 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 (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
-- 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,
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),
-- 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 :=
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),
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
if Compilation_Errors then
Treepr.Tree_Dump;
Post_Compilation_Validation_Checks;
+ Errout.Finalize (Last_Call => True);
Errout.Output_Messages;
Namet.Finalize;
Tree_Gen;
end if;
- Errout.Finalize (Last_Call => True);
Exit_Program (E_Errors);
end if;
@copying
@quotation
-GNAT User's Guide for Native Platforms , Oct 20, 2017
+GNAT User's Guide for Native Platforms , Nov 09, 2017
AdaCore
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);
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- Priority Scheduling --
-------------------------
- SCHED_OTHER : constant := 0;
+ SCHED_OTHER : constant := 3;
SCHED_FIFO : constant := 1;
SCHED_RR : constant := 2;
PTHREAD_CREATE_DETACHED : constant := 1;
- PTHREAD_SCOPE_PROCESS : constant := 1;
+ PTHREAD_SCOPE_PROCESS : constant := 4;
PTHREAD_SCOPE_SYSTEM : constant := 0;
-- Read/Write lock not supported on Android.
-- POSIX.1c Section 13 --
--------------------------
- PTHREAD_PRIO_PROTECT : constant := 0;
- PTHREAD_PRIO_INHERIT : constant := 1;
+ PTHREAD_PRIO_INHERIT : constant := 0;
+ PTHREAD_PRIO_NONE : constant := 1;
+ PTHREAD_PRIO_PROTECT : constant := 2;
function pthread_mutexattr_setprotocol
(attr : access pthread_mutexattr_t;
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);
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);
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;
---------------
-- 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;
-- 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;
-- Priority-related Declarations (RM D.1)
- -- 0 .. 98 corresponds to the system priority range 1 .. 99.
- --
-- 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 := 97;
- Max_Interrupt_Priority : constant Positive := 98;
+ Max_Priority : constant Positive := 62;
+ Max_Interrupt_Priority : constant Positive := 63;
- subtype Any_Priority is Integer range 0 .. 98;
- subtype Priority is Any_Priority range 0 .. 97;
- subtype Interrupt_Priority is Any_Priority range 98 .. 98;
+ subtype Any_Priority is Integer range 0 .. 63;
+ subtype Priority is Any_Priority range 0 .. 62;
+ subtype Interrupt_Priority is Any_Priority range 63 .. 63;
- Default_Priority : constant Priority := 48;
+ Default_Priority : constant Priority := 31;
private
-- * 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
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);
elsif Present (Corresponding_Aspect (Prag)) then
return Parent (Corresponding_Aspect (Prag));
- -- No candidate packge [body] found
+ -- No candidate package [body] found
else
return Empty;
-- 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)
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.
CFI_COMMON_REGS \
TCR("# Push FP and LR on stack") \
TCR("stp x29, x30, [sp, #-16]!") \
- TCR("# Push CFA register on stack") \
- TCR("str x" S(CFA_REG) ", [sp, #-8]!" \
- TCR("# Set the CFA register to x2 value") \
+ 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") \
projects / gcc.git / commitdiff