mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-25 01:20:52 +08:00
[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
This commit is contained in:
Arnaud Charlet
parent
6cc60200ce
commit
1f07382dbe
@ -1,3 +1,35 @@
|
||||
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>
|
||||
|
||||
* gcc-interface/Make-lang.in: Update dependencies.
|
||||
|
||||
@ -1404,12 +1404,14 @@ package body Exp_Ch7 is
|
||||
|
||||
-- Attach_To_Final_List (_Lx, Resx (Resx'last)._controller, 3);
|
||||
|
||||
-- If the context is an aggregate, the call will be expanded into an
|
||||
-- assignment, and the attachment will be done when the aggregate
|
||||
-- If the context is an array aggregate, the call will be expanded into
|
||||
-- an assignment, and the attachment will be done when the aggregate
|
||||
-- expansion is complete. See body of Exp_Aggr for the treatment of
|
||||
-- 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;
|
||||
end if;
|
||||
|
||||
@ -1424,10 +1426,10 @@ package body Exp_Ch7 is
|
||||
if Is_Array_Type (T2) then
|
||||
Len_Ref :=
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
Duplicate_Subexpr_Move_Checks
|
||||
(Unchecked_Convert_To (T2, Ref)),
|
||||
Attribute_Name => Name_Length);
|
||||
Prefix =>
|
||||
Duplicate_Subexpr_Move_Checks
|
||||
(Unchecked_Convert_To (T2, Ref)),
|
||||
Attribute_Name => Name_Length);
|
||||
end if;
|
||||
|
||||
while Is_Array_Type (T2) loop
|
||||
|
||||
@ -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
|
||||
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
|
||||
@section Operating gnatchop in Compilation Mode
|
||||
|
||||
|
||||
@ -30,13 +30,14 @@ with Ada.Streams.Stream_IO; use Ada.Streams;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
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.OS_Lib; use GNAT.OS_Lib;
|
||||
with GNAT.Heap_Sort_G;
|
||||
with GNAT.Table;
|
||||
|
||||
with Hostparm;
|
||||
with Switch; use Switch;
|
||||
with Switch; use Switch;
|
||||
with Types;
|
||||
|
||||
procedure Gnatchop is
|
||||
@ -67,6 +68,9 @@ procedure Gnatchop is
|
||||
-- but properly treated if present. Not generated in output files except
|
||||
-- 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 --
|
||||
--------------------
|
||||
@ -323,11 +327,15 @@ procedure Gnatchop is
|
||||
-- of line sequence to be written at the end of the pragma.
|
||||
|
||||
procedure Write_Unit
|
||||
(Source : not null access String;
|
||||
Num : Unit_Num;
|
||||
TS_Time : OS_Time;
|
||||
Success : out Boolean);
|
||||
-- Write one compilation unit of the source to file
|
||||
(Source : not null access String;
|
||||
Num : Unit_Num;
|
||||
TS_Time : OS_Time;
|
||||
Write_BOM : Boolean;
|
||||
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 --
|
||||
@ -1426,6 +1434,10 @@ procedure Gnatchop is
|
||||
Success : Boolean;
|
||||
TS_Time : OS_Time;
|
||||
|
||||
BOM_Present : Boolean;
|
||||
BOM : BOM_Kind;
|
||||
-- Record presence of UTF8 BOM in input
|
||||
|
||||
begin
|
||||
FD := Open_Read (Name'Address, Binary);
|
||||
TS_Time := File_Time_Stamp (FD);
|
||||
@ -1447,11 +1459,21 @@ procedure Gnatchop is
|
||||
Put_Line ("splitting " & File.Table (Input).Name.all & " into:");
|
||||
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
|
||||
|
||||
for Num in 1 .. Unit.Last loop
|
||||
if Unit.Table (Num).Chop_File = Input then
|
||||
Write_Unit (Buffer, Num, TS_Time, Success);
|
||||
for Unit_Number in 1 .. Unit.Last loop
|
||||
if Unit.Table (Unit_Number).Chop_File = Input then
|
||||
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;
|
||||
end if;
|
||||
end loop;
|
||||
@ -1613,10 +1635,11 @@ procedure Gnatchop is
|
||||
----------------
|
||||
|
||||
procedure Write_Unit
|
||||
(Source : not null access String;
|
||||
Num : Unit_Num;
|
||||
TS_Time : OS_Time;
|
||||
Success : out Boolean)
|
||||
(Source : not null access String;
|
||||
Num : Unit_Num;
|
||||
TS_Time : OS_Time;
|
||||
Write_BOM : Boolean;
|
||||
Success : out Boolean)
|
||||
is
|
||||
|
||||
procedure OS_Filename
|
||||
@ -1695,6 +1718,14 @@ procedure Gnatchop is
|
||||
Length := Info.Length;
|
||||
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
|
||||
|
||||
if Success and then Info.Bufferg /= null then
|
||||
|
||||
@ -763,7 +763,16 @@ package body Ch3 is
|
||||
Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
|
||||
|
||||
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
|
||||
Error_Msg_SC ("invalid kind of private extension");
|
||||
end if;
|
||||
|
||||
@ -1,249 +0,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;
|
||||
@ -45,15 +45,6 @@ package body System.OS_Interface is
|
||||
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 --
|
||||
-------------
|
||||
@ -73,7 +64,7 @@ package body System.OS_Interface is
|
||||
|
||||
if Result /= -1 then
|
||||
sig.all := Signal (Result);
|
||||
return 0;
|
||||
return OK;
|
||||
else
|
||||
sig.all := 0;
|
||||
return errno;
|
||||
@ -142,7 +133,7 @@ package body System.OS_Interface is
|
||||
|
||||
begin
|
||||
if D < 0.0 then
|
||||
return -1;
|
||||
return ERROR;
|
||||
end if;
|
||||
|
||||
-- Ensure that the duration can be converted to ticks
|
||||
@ -213,6 +204,15 @@ package body System.OS_Interface is
|
||||
return semFlush (SEM_ID (ID));
|
||||
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 --
|
||||
-----------------------
|
||||
@ -220,11 +220,13 @@ package body System.OS_Interface is
|
||||
function Interrupt_Connect
|
||||
(Vector : Interrupt_Vector;
|
||||
Handler : Interrupt_Handler;
|
||||
Parameter : System.Address := System.Null_Address) return int
|
||||
is
|
||||
pragma Unreferenced (Vector, Handler, Parameter);
|
||||
Parameter : System.Address := System.Null_Address) return int is
|
||||
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;
|
||||
|
||||
--------------------------------
|
||||
@ -234,7 +236,8 @@ package body System.OS_Interface is
|
||||
function Interrupt_Number_To_Vector
|
||||
(intNum : int) return Interrupt_Vector is
|
||||
begin
|
||||
return Interrupt_Vector (intNum);
|
||||
return Interrupt_Vector
|
||||
(System.VxWorks.Ext.Interrupt_Number_To_Vector (intNum));
|
||||
end Interrupt_Number_To_Vector;
|
||||
|
||||
end System.OS_Interface;
|
||||
|
||||
@ -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
|
||||
-- that are needed by the tasking run-time (libgnarl).
|
||||
@ -72,7 +72,7 @@ package System.OS_Interface is
|
||||
FUNC_ERR : constant := -1;
|
||||
|
||||
----------------------------
|
||||
-- Signals and Interrupts --
|
||||
-- Signals and interrupts --
|
||||
----------------------------
|
||||
|
||||
NSIG : constant := 64;
|
||||
@ -304,6 +304,8 @@ package System.OS_Interface is
|
||||
pragma Import (C, sysClkRateGet, "sysClkRateGet");
|
||||
|
||||
-- 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
|
||||
(tid : t_id; pVar : access System.Address) return int;
|
||||
@ -325,6 +327,8 @@ package System.OS_Interface is
|
||||
pragma Import (C, taskVarGet, "taskVarGet");
|
||||
|
||||
-- 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;
|
||||
pragma Import (C, tlsKeyCreate, "tlsKeyCreate");
|
||||
@ -364,8 +368,8 @@ package System.OS_Interface is
|
||||
|
||||
function Set_Time_Slice (ticks : int) return int
|
||||
renames System.VxWorks.Ext.Set_Time_Slice;
|
||||
-- Calls kernelTimeSlice under VxWorks 5.x
|
||||
-- Do nothing under VxWorks 6.x
|
||||
-- Calls kernelTimeSlice under VxWorks 5.x, VxWorks 653, or in VxWorks 6
|
||||
-- kernel apps. Returns ERROR for RTPs, VxWorks 5 /CERT
|
||||
|
||||
function taskPriorityGet (tid : t_id; pPriority : access int) return int;
|
||||
pragma Import (C, taskPriorityGet, "taskPriorityGet");
|
||||
@ -433,7 +437,7 @@ package System.OS_Interface is
|
||||
-- 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;
|
||||
@ -468,7 +472,7 @@ package System.OS_Interface is
|
||||
Parameter : System.Address := System.Null_Address) return int;
|
||||
pragma Inline (Interrupt_Connect);
|
||||
-- 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.
|
||||
|
||||
function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector;
|
||||
|
||||
57
gcc/ada/s-vxwext-kernel.adb
Normal file
57
gcc/ada/s-vxwext-kernel.adb
Normal file
@ -0,0 +1,57 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
@ -39,25 +39,40 @@ package System.VxWorks.Ext is
|
||||
type t_id is new Long_Integer;
|
||||
subtype int is Interfaces.C.int;
|
||||
|
||||
type Interrupt_Handler is access procedure (parameter : System.Address);
|
||||
pragma Convention (C, Interrupt_Handler);
|
||||
|
||||
type Interrupt_Vector is new System.Address;
|
||||
|
||||
function Int_Lock return int;
|
||||
pragma Inline (Int_Lock);
|
||||
|
||||
function Int_Unlock return int;
|
||||
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 Int_Lock return int;
|
||||
pragma Import (C, Int_Lock, "intLock");
|
||||
|
||||
function Int_Unlock return int;
|
||||
pragma Import (C, Int_Unlock, "intUnlock");
|
||||
|
||||
function kill (pid : t_id; sig : int) return int;
|
||||
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;
|
||||
pragma Import (C, getpid, "taskIdSelf");
|
||||
|
||||
function Set_Time_Slice (ticks : int) return int;
|
||||
pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
|
||||
|
||||
end System.VxWorks.Ext;
|
||||
|
||||
@ -39,11 +39,10 @@ package System.VxWorks.Ext is
|
||||
type t_id is new Long_Integer;
|
||||
subtype int is Interfaces.C.int;
|
||||
|
||||
function Task_Cont (tid : t_id) return int;
|
||||
pragma Import (C, Task_Cont, "taskResume");
|
||||
type Interrupt_Handler is access procedure (parameter : System.Address);
|
||||
pragma Convention (C, Interrupt_Handler);
|
||||
|
||||
function Task_Stop (tid : t_id) return int;
|
||||
pragma Import (C, Task_Stop, "taskSuspend");
|
||||
type Interrupt_Vector is new System.Address;
|
||||
|
||||
function Int_Lock return int;
|
||||
pragma Import (C, Int_Lock, "intLock");
|
||||
@ -51,13 +50,29 @@ package System.VxWorks.Ext is
|
||||
function Int_Unlock return int;
|
||||
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;
|
||||
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;
|
||||
pragma Import (C, getpid, "taskIdSelf");
|
||||
|
||||
function Set_Time_Slice (ticks : int) return int;
|
||||
pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
|
||||
|
||||
end System.VxWorks.Ext;
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
-- S Y S T E M --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- (Darwin/x86_64 Version) --
|
||||
-- (Darwin/x86_64 Version) --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
@ -142,7 +142,7 @@ private
|
||||
-- of the individual switch values.
|
||||
|
||||
Backend_Divide_Checks : constant Boolean := False;
|
||||
Backend_Overflow_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;
|
||||
|
||||
@ -116,7 +116,7 @@ private
|
||||
-- of the individual switch values.
|
||||
|
||||
Backend_Divide_Checks : constant Boolean := False;
|
||||
Backend_Overflow_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;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user