Skip to content

R
riscv-gcc-1
Commit 1f07382d by Arnaud Charlet
Options

[multiple changes] 

2009-04-15  Robert Dewar  <dewar@adacore.com>

	* gnatchop.adb (BOM_Length): New global variable
	(Write_Unit): Add new parameter Write_BOM
	(Write_Chopped_Files): Check for BOM and set Write_BOM for call
	to Write_Unit

	* gnat_ugn.texi: Add note on propagation of BOM by gnatchop

2009-04-15  Geert Bosch  <bosch@adacore.com>

	* system-mingw-x86_64.ads, system-darwin-x86_64.ads
	(Backend_Overflow_Checks): Set to True.

2009-04-15  Gary Dismukes  <dismukes@adacore.com>

	* par-ch3.adb (P_Type_Declaration): Issue an error if the synchronized
	keyword is given in a record extension.

2009-04-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Expand_Ctrl_Function_Call): Procede with the expansion
	of a controlled function call in the context of a record aggregate.
	This does not apply to array aggregates since the call will be expanded
	into assignments.

2009-04-15  Ed Falis  <falis@adacore.com>

	* s-osinte-vxworks-kernel.adb, s-osinte-vxworks.adb,
	s-osinte-vxworks.ads s-vxwext.ads, s-vxwext-kernel.adb,
	s-vxwext-kernel.ads: Reorganize s-osinte-vxworks* and s-vxwext*.

From-SVN: r146108
parent 6cc60200
Showing with 235 additions and 311 deletions
gcc/ada/ChangeLog
2009-04-15 Robert Dewar <dewar@adacore.com>
* gnatchop.adb (BOM_Length): New global variable
(Write_Unit): Add new parameter Write_BOM
(Write_Chopped_Files): Check for BOM and set Write_BOM for call
to Write_Unit
* gnat_ugn.texi: Add note on propagation of BOM by gnatchop
2009-04-15 Geert Bosch <bosch@adacore.com>
* system-mingw-x86_64.ads, system-darwin-x86_64.ads
(Backend_Overflow_Checks): Set to True.
2009-04-15 Gary Dismukes <dismukes@adacore.com>
* par-ch3.adb (P_Type_Declaration): Issue an error if the synchronized
keyword is given in a record extension.
2009-04-15 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Expand_Ctrl_Function_Call): Procede with the expansion
of a controlled function call in the context of a record aggregate.
This does not apply to array aggregates since the call will be expanded
into assignments.
2009-04-15 Ed Falis <falis@adacore.com>
* s-osinte-vxworks-kernel.adb, s-osinte-vxworks.adb,
s-osinte-vxworks.ads s-vxwext.ads, s-vxwext-kernel.adb,
s-vxwext-kernel.ads: Reorganize s-osinte-vxworks* and s-vxwext*.
2009-04-15 Arnaud Charlet <charlet@adacore.com> 2009-04-15 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies. * gcc-interface/Make-lang.in: Update dependencies.
gcc/ada/exp_ch7.adb
...@@ -1404,12 +1404,14 @@ package body Exp_Ch7 is ...@@ -1404,12 +1404,14 @@ package body Exp_Ch7 is
-- Attach_To_Final_List (_Lx, Resx (Resx'last)._controller, 3); -- Attach_To_Final_List (_Lx, Resx (Resx'last)._controller, 3);
-- If the context is an aggregate, the call will be expanded into an -- If the context is an array aggregate, the call will be expanded into
-- assignment, and the attachment will be done when the aggregate -- an assignment, and the attachment will be done when the aggregate
-- expansion is complete. See body of Exp_Aggr for the treatment of -- expansion is complete. See body of Exp_Aggr for the treatment of
-- other controlled components. -- other controlled components.
if Nkind (Parent (N)) = N_Aggregate then if Nkind (Parent (N)) = N_Aggregate
and then Is_Array_Type (Etype (Parent (N)))
then
return; return;
end if; end if;
...@@ -1424,10 +1426,10 @@ package body Exp_Ch7 is ...@@ -1424,10 +1426,10 @@ package body Exp_Ch7 is
if Is_Array_Type (T2) then if Is_Array_Type (T2) then
Len_Ref := Len_Ref :=
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix =>
Duplicate_Subexpr_Move_Checks Duplicate_Subexpr_Move_Checks
(Unchecked_Convert_To (T2, Ref)), (Unchecked_Convert_To (T2, Ref)),
Attribute_Name => Name_Length); Attribute_Name => Name_Length);
end if; end if;
while Is_Array_Type (T2) loop while Is_Array_Type (T2) loop
......
gcc/ada/gnat_ugn.texi
...@@ -10702,6 +10702,11 @@ system, you can set up a procedure where you use @command{gnatchop} each ...@@ -10702,6 +10702,11 @@ system, you can set up a procedure where you use @command{gnatchop} each
time you compile, regarding the source files that it writes as temporary time you compile, regarding the source files that it writes as temporary
files that you throw away. files that you throw away.
Note that if your file containing multiple units starts with a byte order
mark (BOM) specifying UTF-8 encoding, then the files generated by gnatchop
will each start with a copy of this BOM, meaning that they can be compiled
automatically in UTF-8 mode without needing to specify an explicit encoding.
@node Operating gnatchop in Compilation Mode @node Operating gnatchop in Compilation Mode
@section Operating gnatchop in Compilation Mode @section Operating gnatchop in Compilation Mode
gcc/ada/gnatchop.adb
...@@ -30,13 +30,14 @@ with Ada.Streams.Stream_IO; use Ada.Streams; ...@@ -30,13 +30,14 @@ with Ada.Streams.Stream_IO; use Ada.Streams;
with Ada.Text_IO; use Ada.Text_IO; with Ada.Text_IO; use Ada.Text_IO;
with System.CRTL; use System; use System.CRTL; with System.CRTL; use System; use System.CRTL;
with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark;
with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Heap_Sort_G; with GNAT.Heap_Sort_G;
with GNAT.Table; with GNAT.Table;
with Hostparm; with Hostparm;
with Switch; use Switch; with Switch; use Switch;
with Types; with Types;
procedure Gnatchop is procedure Gnatchop is
...@@ -67,6 +68,9 @@ procedure Gnatchop is ...@@ -67,6 +68,9 @@ procedure Gnatchop is
-- but properly treated if present. Not generated in output files except -- but properly treated if present. Not generated in output files except
-- as a result of copying input file. -- as a result of copying input file.
BOM_Length : Natural := 0;
-- Reset to non-zero value if BOM detected at start of file
-------------------- --------------------
-- File arguments -- -- File arguments --
-------------------- --------------------
...@@ -323,11 +327,15 @@ procedure Gnatchop is ...@@ -323,11 +327,15 @@ procedure Gnatchop is
-- of line sequence to be written at the end of the pragma. -- of line sequence to be written at the end of the pragma.
procedure Write_Unit procedure Write_Unit
(Source : not null access String; (Source : not null access String;
Num : Unit_Num; Num : Unit_Num;
TS_Time : OS_Time; TS_Time : OS_Time;
Success : out Boolean); Write_BOM : Boolean;
-- Write one compilation unit of the source to file Success : out Boolean);
-- Write one compilation unit of the source to file. Source is the pointer
-- to the input string, Num is the unit number, TS_Time is the timestamp,
-- Write_BOM is set True to write a UTF-8 BOM at the start of the file.
-- Success is set True unless the write attempt fails.
--------- ---------
-- dup -- -- dup --
...@@ -1426,6 +1434,10 @@ procedure Gnatchop is ...@@ -1426,6 +1434,10 @@ procedure Gnatchop is
Success : Boolean; Success : Boolean;
TS_Time : OS_Time; TS_Time : OS_Time;
BOM_Present : Boolean;
BOM : BOM_Kind;
-- Record presence of UTF8 BOM in input
begin begin
FD := Open_Read (Name'Address, Binary); FD := Open_Read (Name'Address, Binary);
TS_Time := File_Time_Stamp (FD); TS_Time := File_Time_Stamp (FD);
...@@ -1447,11 +1459,21 @@ procedure Gnatchop is ...@@ -1447,11 +1459,21 @@ procedure Gnatchop is
Put_Line ("splitting " & File.Table (Input).Name.all & " into:"); Put_Line ("splitting " & File.Table (Input).Name.all & " into:");
end if; end if;
-- Test for presence of BOM
Read_BOM (Buffer.all, BOM_Length, BOM, False);
BOM_Present := BOM /= Unknown;
-- Only chop those units that come from this file -- Only chop those units that come from this file
for Num in 1 .. Unit.Last loop for Unit_Number in 1 .. Unit.Last loop
if Unit.Table (Num).Chop_File = Input then if Unit.Table (Unit_Number).Chop_File = Input then
Write_Unit (Buffer, Num, TS_Time, Success); Write_Unit
(Source => Buffer,
Num => Unit_Number,
TS_Time => TS_Time,
Write_BOM => BOM_Present and then Unit_Number /= 1,
Success => Success);
exit when not Success; exit when not Success;
end if; end if;
end loop; end loop;
...@@ -1613,10 +1635,11 @@ procedure Gnatchop is ...@@ -1613,10 +1635,11 @@ procedure Gnatchop is
---------------- ----------------
procedure Write_Unit procedure Write_Unit
(Source : not null access String; (Source : not null access String;
Num : Unit_Num; Num : Unit_Num;
TS_Time : OS_Time; TS_Time : OS_Time;
Success : out Boolean) Write_BOM : Boolean;
Success : out Boolean)
is is
procedure OS_Filename procedure OS_Filename
...@@ -1695,6 +1718,14 @@ procedure Gnatchop is ...@@ -1695,6 +1718,14 @@ procedure Gnatchop is
Length := Info.Length; Length := Info.Length;
end if; end if;
-- Write BOM if required
if Write_BOM then
String'Write
(Stream_IO.Stream (File),
Source.all (Source'First .. Source'First + BOM_Length - 1));
end if;
-- Prepend configuration pragmas if necessary -- Prepend configuration pragmas if necessary
if Success and then Info.Bufferg /= null then if Success and then Info.Bufferg /= null then
......
gcc/ada/par-ch3.adb
...@@ -763,7 +763,16 @@ package body Ch3 is ...@@ -763,7 +763,16 @@ package body Ch3 is
Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl; Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
if Saved_Token = Tok_Synchronized then if Saved_Token = Tok_Synchronized then
Set_Synchronized_Present (Typedef_Node); if Nkind (Typedef_Node) =
N_Derived_Type_Definition
then
Error_Msg_N
("SYNCHRONIZED not allowed for record extension",
Typedef_Node);
else
Set_Synchronized_Present (Typedef_Node);
end if;
else else
Error_Msg_SC ("invalid kind of private extension"); Error_Msg_SC ("invalid kind of private extension");
end if; end if;
......
gcc/ada/s-osinte-vxworks-kernel.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- 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) 1997-2009, 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 VxWorks version
-- This package encapsulates all direct interfaces to OS services that are
-- needed by children of System.
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.
package body System.OS_Interface is
use type Interfaces.C.int;
Low_Priority : constant := 255;
-- VxWorks native (default) lowest scheduling priority
----------
-- kill --
----------
function kill (pid : t_id; sig : Signal) return int is
begin
return System.VxWorks.Ext.kill (pid, int (sig));
end kill;
-------------
-- sigwait --
-------------
function sigwait
(set : access sigset_t;
sig : access Signal) return int
is
Result : int;
function sigwaitinfo
(set : access sigset_t; sigvalue : System.Address) return int;
pragma Import (C, sigwaitinfo, "sigwaitinfo");
begin
Result := sigwaitinfo (set, System.Null_Address);
if Result /= -1 then
sig.all := Signal (Result);
return 0;
else
sig.all := 0;
return errno;
end if;
end sigwait;
-----------------
-- To_Duration --
-----------------
function To_Duration (TS : timespec) return Duration is
begin
return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
end To_Duration;
-----------------
-- 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 is negative 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'(ts_sec => S,
ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
-------------------------
-- To_VxWorks_Priority --
-------------------------
function To_VxWorks_Priority (Priority : int) return int is
begin
return Low_Priority - Priority;
end To_VxWorks_Priority;
--------------------
-- To_Clock_Ticks --
--------------------
-- ??? - For now, we'll always get the system clock rate since it is
-- allowed to be changed during run-time in VxWorks. A better method would
-- be to provide an operation to set it that so we can always know its
-- value.
-- Another thing we should probably allow for is a resultant tick count
-- greater than int'Last. This should probably be a procedure with two
-- output parameters, one in the range 0 .. int'Last, and another
-- representing the overflow count.
function To_Clock_Ticks (D : Duration) return int is
Ticks : Long_Long_Integer;
Rate_Duration : Duration;
Ticks_Duration : Duration;
begin
if D < 0.0 then
return -1;
end if;
-- Ensure that the duration can be converted to ticks
-- at the current clock tick rate without overflowing.
Rate_Duration := Duration (sysClkRateGet);
if D > (Duration'Last / Rate_Duration) then
Ticks := Long_Long_Integer (int'Last);
else
Ticks_Duration := D * Rate_Duration;
Ticks := Long_Long_Integer (Ticks_Duration);
if Ticks_Duration > Duration (Ticks) then
Ticks := Ticks + 1;
end if;
if Ticks > Long_Long_Integer (int'Last) then
Ticks := Long_Long_Integer (int'Last);
end if;
end if;
return int (Ticks);
end To_Clock_Ticks;
-----------------------------
-- Binary_Semaphore_Create --
-----------------------------
function Binary_Semaphore_Create return Binary_Semaphore_Id is
begin
return Binary_Semaphore_Id (semBCreate (SEM_Q_FIFO, SEM_EMPTY));
end Binary_Semaphore_Create;
-----------------------------
-- Binary_Semaphore_Delete --
-----------------------------
function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int is
begin
return semDelete (SEM_ID (ID));
end Binary_Semaphore_Delete;
-----------------------------
-- Binary_Semaphore_Obtain --
-----------------------------
function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int is
begin
return semTake (SEM_ID (ID), WAIT_FOREVER);
end Binary_Semaphore_Obtain;
------------------------------
-- Binary_Semaphore_Release --
------------------------------
function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int is
begin
return semGive (SEM_ID (ID));
end Binary_Semaphore_Release;
----------------------------
-- Binary_Semaphore_Flush --
----------------------------
function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is
begin
return semFlush (SEM_ID (ID));
end Binary_Semaphore_Flush;
-----------------------
-- Interrupt_Connect --
-----------------------
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
Parameter : System.Address := System.Null_Address) return int
is
function intConnect
(vector : Interrupt_Vector;
handler : Interrupt_Handler;
parameter : System.Address) return int;
pragma Import (C, intConnect, "intConnect");
begin
return intConnect (Vector, Handler, Parameter);
end Interrupt_Connect;
--------------------------------
-- Interrupt_Number_To_Vector --
--------------------------------
function Interrupt_Number_To_Vector
(intNum : int) return Interrupt_Vector
is
function INUM_TO_IVEC (intNum : int) return Interrupt_Vector;
pragma Import (C, INUM_TO_IVEC, "__gnat_inum_to_ivec");
begin
return INUM_TO_IVEC (intNum);
end Interrupt_Number_To_Vector;
end System.OS_Interface;
gcc/ada/s-osinte-vxworks.adb
...@@ -45,15 +45,6 @@ package body System.OS_Interface is ...@@ -45,15 +45,6 @@ package body System.OS_Interface is
Low_Priority : constant := 255; Low_Priority : constant := 255;
-- VxWorks native (default) lowest scheduling priority -- VxWorks native (default) lowest scheduling priority
----------
-- kill --
----------
function kill (pid : t_id; sig : Signal) return int is
begin
return System.VxWorks.Ext.kill (pid, int (sig));
end kill;
------------- -------------
-- sigwait -- -- sigwait --
------------- -------------
...@@ -73,7 +64,7 @@ package body System.OS_Interface is ...@@ -73,7 +64,7 @@ package body System.OS_Interface is
if Result /= -1 then if Result /= -1 then
sig.all := Signal (Result); sig.all := Signal (Result);
return 0; return OK;
else else
sig.all := 0; sig.all := 0;
return errno; return errno;
...@@ -142,7 +133,7 @@ package body System.OS_Interface is ...@@ -142,7 +133,7 @@ package body System.OS_Interface is
begin begin
if D < 0.0 then if D < 0.0 then
return -1; return ERROR;
end if; end if;
-- Ensure that the duration can be converted to ticks -- Ensure that the duration can be converted to ticks
...@@ -213,6 +204,15 @@ package body System.OS_Interface is ...@@ -213,6 +204,15 @@ package body System.OS_Interface is
return semFlush (SEM_ID (ID)); return semFlush (SEM_ID (ID));
end Binary_Semaphore_Flush; end Binary_Semaphore_Flush;
----------
-- kill --
----------
function kill (pid : t_id; sig : Signal) return int is
begin
return System.VxWorks.Ext.kill (pid, int (sig));
end kill;
----------------------- -----------------------
-- Interrupt_Connect -- -- Interrupt_Connect --
----------------------- -----------------------
...@@ -220,11 +220,13 @@ package body System.OS_Interface is ...@@ -220,11 +220,13 @@ package body System.OS_Interface is
function Interrupt_Connect function Interrupt_Connect
(Vector : Interrupt_Vector; (Vector : Interrupt_Vector;
Handler : Interrupt_Handler; Handler : Interrupt_Handler;
Parameter : System.Address := System.Null_Address) return int Parameter : System.Address := System.Null_Address) return int is
is
pragma Unreferenced (Vector, Handler, Parameter);
begin begin
return 0; return
System.VxWorks.Ext.Interrupt_Connect
(System.VxWorks.Ext.Interrupt_Vector (Vector),
System.VxWorks.Ext.Interrupt_Handler (Handler),
Parameter);
end Interrupt_Connect; end Interrupt_Connect;
-------------------------------- --------------------------------
...@@ -234,7 +236,8 @@ package body System.OS_Interface is ...@@ -234,7 +236,8 @@ package body System.OS_Interface is
function Interrupt_Number_To_Vector function Interrupt_Number_To_Vector
(intNum : int) return Interrupt_Vector is (intNum : int) return Interrupt_Vector is
begin begin
return Interrupt_Vector (intNum); return Interrupt_Vector
(System.VxWorks.Ext.Interrupt_Number_To_Vector (intNum));
end Interrupt_Number_To_Vector; end Interrupt_Number_To_Vector;
end System.OS_Interface; end System.OS_Interface;
gcc/ada/s-osinte-vxworks.ads
...@@ -32,7 +32,7 @@ ...@@ -32,7 +32,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This is the VxWorks 5.x and 6.x version of this package -- This is the VxWorks version of this package
-- This package encapsulates all direct interfaces to OS services -- This package encapsulates all direct interfaces to OS services
-- that are needed by the tasking run-time (libgnarl). -- that are needed by the tasking run-time (libgnarl).
...@@ -72,7 +72,7 @@ package System.OS_Interface is ...@@ -72,7 +72,7 @@ package System.OS_Interface is
FUNC_ERR : constant := -1; FUNC_ERR : constant := -1;
---------------------------- ----------------------------
-- Signals and Interrupts -- -- Signals and interrupts --
---------------------------- ----------------------------
NSIG : constant := 64; NSIG : constant := 64;
...@@ -304,6 +304,8 @@ package System.OS_Interface is ...@@ -304,6 +304,8 @@ package System.OS_Interface is
pragma Import (C, sysClkRateGet, "sysClkRateGet"); pragma Import (C, sysClkRateGet, "sysClkRateGet");
-- VxWorks 5.x specific functions -- VxWorks 5.x specific functions
-- Must not be called from run-time for versions that do not support
-- taskVarLib: eg VxWorks 6 RTPs
function taskVarAdd function taskVarAdd
(tid : t_id; pVar : access System.Address) return int; (tid : t_id; pVar : access System.Address) return int;
...@@ -325,6 +327,8 @@ package System.OS_Interface is ...@@ -325,6 +327,8 @@ package System.OS_Interface is
pragma Import (C, taskVarGet, "taskVarGet"); pragma Import (C, taskVarGet, "taskVarGet");
-- VxWorks 6.x specific functions -- VxWorks 6.x specific functions
-- Can only be called from the VxWorks 6 run-time libary that supports
-- tlsLib, and not by the VxWorks 6.6 SMP library
function tlsKeyCreate return int; function tlsKeyCreate return int;
pragma Import (C, tlsKeyCreate, "tlsKeyCreate"); pragma Import (C, tlsKeyCreate, "tlsKeyCreate");
...@@ -364,8 +368,8 @@ package System.OS_Interface is ...@@ -364,8 +368,8 @@ package System.OS_Interface is
function Set_Time_Slice (ticks : int) return int function Set_Time_Slice (ticks : int) return int
renames System.VxWorks.Ext.Set_Time_Slice; renames System.VxWorks.Ext.Set_Time_Slice;
-- Calls kernelTimeSlice under VxWorks 5.x -- Calls kernelTimeSlice under VxWorks 5.x, VxWorks 653, or in VxWorks 6
-- Do nothing under VxWorks 6.x -- kernel apps. Returns ERROR for RTPs, VxWorks 5 /CERT
function taskPriorityGet (tid : t_id; pPriority : access int) return int; function taskPriorityGet (tid : t_id; pPriority : access int) return int;
pragma Import (C, taskPriorityGet, "taskPriorityGet"); pragma Import (C, taskPriorityGet, "taskPriorityGet");
...@@ -433,7 +437,7 @@ package System.OS_Interface is ...@@ -433,7 +437,7 @@ package System.OS_Interface is
-- Release all threads blocked on the semaphore -- Release all threads blocked on the semaphore
------------------------------------------------------------ ------------------------------------------------------------
-- Binary Semaphore Wrapper to Support Interrupt Tasks -- -- Binary Semaphore Wrapper to Support interrupt Tasks --
------------------------------------------------------------ ------------------------------------------------------------
type Binary_Semaphore_Id is new Long_Integer; type Binary_Semaphore_Id is new Long_Integer;
...@@ -468,7 +472,7 @@ package System.OS_Interface is ...@@ -468,7 +472,7 @@ package System.OS_Interface is
Parameter : System.Address := System.Null_Address) return int; Parameter : System.Address := System.Null_Address) return int;
pragma Inline (Interrupt_Connect); pragma Inline (Interrupt_Connect);
-- Use this to set up an user handler. The routine installs a -- Use this to set up an user handler. The routine installs a
-- a user handler which is invoked after RTEMS has saved enough -- a user handler which is invoked after the OS has saved enough
-- context for a high-level language routine to be safely invoked. -- context for a high-level language routine to be safely invoked.
function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector; function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector;
......
gcc/ada/s-vxwext-kernel.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . V X W O R K S . E X T --
-- --
-- B o d y --
-- --
-- Copyright (C) 2008-2009, 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 package provides vxworks specific support functions needed
-- by System.OS_Interface.
-- This is the VxWorks <= 6.5 kernel version of this package
-- Also works for 6.6 uniprocessor
package body System.VxWorks.Ext is
ERROR : constant := -1;
--------------
-- Int_Lock --
--------------
function intLock return int;
pragma Import (C, intLock, "intLock");
function Int_Lock return int renames intLock;
----------------
-- Int_Unlock --
----------------
function intUnlock return int;
pragma Import (C, intUnlock, "intUnlock");
function Int_Unlock return int renames intUnlock;
end System.VxWorks.Ext;
gcc/ada/s-vxwext-kernel.ads
...@@ -39,25 +39,40 @@ package System.VxWorks.Ext is ...@@ -39,25 +39,40 @@ package System.VxWorks.Ext is
type t_id is new Long_Integer; type t_id is new Long_Integer;
subtype int is Interfaces.C.int; subtype int is Interfaces.C.int;
function Task_Cont (tid : t_id) return int; type Interrupt_Handler is access procedure (parameter : System.Address);
pragma Import (C, Task_Cont, "taskCont"); pragma Convention (C, Interrupt_Handler);
function Task_Stop (tid : t_id) return int; type Interrupt_Vector is new System.Address;
pragma Import (C, Task_Stop, "taskStop");
function Int_Lock return int; function Int_Lock return int;
pragma Import (C, Int_Lock, "intLock"); pragma Inline (Int_Lock);
function Int_Unlock return int; function Int_Unlock return int;
pragma Import (C, Int_Unlock, "intUnlock"); pragma Inline (Int_Unlock);
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
Parameter : System.Address := System.Null_Address) return int;
pragma Import (C, Interrupt_Connect, "intConnect");
function Interrupt_Number_To_Vector
(intNum : int) return Interrupt_Vector;
pragma Import (C, Interrupt_Number_To_Vector, "__gnat_inum_to_ivec");
function Task_Cont (tid : t_id) return int;
pragma Import (C, Task_Cont, "taskCont");
function Task_Stop (tid : t_id) return int;
pragma Import (C, Task_Stop, "taskStop");
function kill (pid : t_id; sig : int) return int; function kill (pid : t_id; sig : int) return int;
pragma Import (C, kill, "kill"); pragma Import (C, kill, "kill");
function Set_Time_Slice (ticks : int) return int;
pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
function getpid return t_id; function getpid return t_id;
pragma Import (C, getpid, "taskIdSelf"); pragma Import (C, getpid, "taskIdSelf");
function Set_Time_Slice (ticks : int) return int;
pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
end System.VxWorks.Ext; end System.VxWorks.Ext;
gcc/ada/s-vxwext.ads
...@@ -39,11 +39,10 @@ package System.VxWorks.Ext is ...@@ -39,11 +39,10 @@ package System.VxWorks.Ext is
type t_id is new Long_Integer; type t_id is new Long_Integer;
subtype int is Interfaces.C.int; subtype int is Interfaces.C.int;
function Task_Cont (tid : t_id) return int; type Interrupt_Handler is access procedure (parameter : System.Address);
pragma Import (C, Task_Cont, "taskResume"); pragma Convention (C, Interrupt_Handler);
function Task_Stop (tid : t_id) return int; type Interrupt_Vector is new System.Address;
pragma Import (C, Task_Stop, "taskSuspend");
function Int_Lock return int; function Int_Lock return int;
pragma Import (C, Int_Lock, "intLock"); pragma Import (C, Int_Lock, "intLock");
...@@ -51,13 +50,29 @@ package System.VxWorks.Ext is ...@@ -51,13 +50,29 @@ package System.VxWorks.Ext is
function Int_Unlock return int; function Int_Unlock return int;
pragma Import (C, Int_Unlock, "intUnlock"); pragma Import (C, Int_Unlock, "intUnlock");
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
Parameter : System.Address := System.Null_Address) return int;
pragma Import (C, Interrupt_Connect, "intConnect");
function Interrupt_Number_To_Vector
(intNum : int) return Interrupt_Vector;
pragma Import (C, Interrupt_Number_To_Vector, "__gnat_inum_to_ivec");
function Task_Cont (tid : t_id) return int;
pragma Import (C, Task_Cont, "taskResume");
function Task_Stop (tid : t_id) return int;
pragma Import (C, Task_Stop, "taskSuspend");
function kill (pid : t_id; sig : int) return int; function kill (pid : t_id; sig : int) return int;
pragma Import (C, kill, "kill"); pragma Import (C, kill, "kill");
function Set_Time_Slice (ticks : int) return int;
pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
function getpid return t_id; function getpid return t_id;
pragma Import (C, getpid, "taskIdSelf"); pragma Import (C, getpid, "taskIdSelf");
function Set_Time_Slice (ticks : int) return int;
pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
end System.VxWorks.Ext; end System.VxWorks.Ext;
gcc/ada/system-darwin-x86_64.ads
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
-- S Y S T E M -- -- S Y S T E M --
-- -- -- --
-- S p e c -- -- S p e c --
-- (Darwin/x86_64 Version) -- -- (Darwin/x86_64 Version) --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- -- -- --
...@@ -142,7 +142,7 @@ private ...@@ -142,7 +142,7 @@ private
-- of the individual switch values. -- of the individual switch values.
Backend_Divide_Checks : constant Boolean := False; Backend_Divide_Checks : constant Boolean := False;
Backend_Overflow_Checks : constant Boolean := False; Backend_Overflow_Checks : constant Boolean := True;
Command_Line_Args : constant Boolean := True; Command_Line_Args : constant Boolean := True;
Configurable_Run_Time : constant Boolean := False; Configurable_Run_Time : constant Boolean := False;
Denorm : constant Boolean := True; Denorm : constant Boolean := True;
......
gcc/ada/system-mingw-x86_64.ads
...@@ -116,7 +116,7 @@ private ...@@ -116,7 +116,7 @@ private
-- of the individual switch values. -- of the individual switch values.
Backend_Divide_Checks : constant Boolean := False; Backend_Divide_Checks : constant Boolean := False;
Backend_Overflow_Checks : constant Boolean := False; Backend_Overflow_Checks : constant Boolean := True;
Command_Line_Args : constant Boolean := True; Command_Line_Args : constant Boolean := True;
Configurable_Run_Time : constant Boolean := False; Configurable_Run_Time : constant Boolean := False;
Denorm : constant Boolean := True; Denorm : constant Boolean := True;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment