From c4394c1546db30313bdd30d0ad3d5e304d44ba24 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 8 Apr 2008 08:43:49 +0200 Subject: [PATCH] s-osinte-vxworks6.ads: Removed, merged with s-osinte-vxworks.ads/.adb * s-osinte-vxworks6.ads: Removed, merged with s-osinte-vxworks.ads/.adb * s-vxwext.ads, s-vxwext-kernel.ads, s-vxwext-rtp.ads, s-vxwext-rtp.adb: New files. * s-taprop-vxworks.adb, s-osinte-vxworks.ads, s-osinte-vxworks.adb: Minor updates to accomodate changes above. From-SVN: r134005 --- gcc/ada/s-osinte-vxworks.adb | 71 +----- gcc/ada/s-osinte-vxworks.ads | 116 ++++++--- gcc/ada/s-osinte-vxworks6.ads | 446 ---------------------------------- gcc/ada/s-taprop-vxworks.adb | 3 + gcc/ada/s-vxwext-kernel.ads | 65 +++++ gcc/ada/s-vxwext-rtp.adb | 67 +++++ gcc/ada/s-vxwext-rtp.ads | 65 +++++ gcc/ada/s-vxwext.ads | 65 +++++ 8 files changed, 343 insertions(+), 555 deletions(-) delete mode 100644 gcc/ada/s-osinte-vxworks6.ads create mode 100644 gcc/ada/s-vxwext-kernel.ads create mode 100644 gcc/ada/s-vxwext-rtp.adb create mode 100644 gcc/ada/s-vxwext-rtp.ads create mode 100644 gcc/ada/s-vxwext.ads diff --git a/gcc/ada/s-osinte-vxworks.adb b/gcc/ada/s-osinte-vxworks.adb index 417ab5d415a..312fabaaeb6 100644 --- a/gcc/ada/s-osinte-vxworks.adb +++ b/gcc/ada/s-osinte-vxworks.adb @@ -47,62 +47,15 @@ package body System.OS_Interface is Low_Priority : constant := 255; -- VxWorks native (default) lowest scheduling priority - ------------ - -- getpid -- - ------------ - - function getpid return t_id is - begin - -- VxWorks 5 (and VxWorks 6 in kernel mode) does not have a getpid - -- function. taskIdSelf is the equivalent routine. - - return taskIdSelf; - end getpid; - - -------------- - -- Int_Lock -- - -------------- - - function Int_Lock return int is - function intLock return int; - pragma Import (C, intLock, "intLock"); - begin - return intLock; - end Int_Lock; - - ---------------- - -- Int_Unlock -- - ---------------- - - function Int_Unlock return int is - function intUnlock return int; - pragma Import (C, intUnlock, "intUnlock"); - begin - return intUnlock; - end Int_Unlock; - ---------- -- kill -- ---------- function kill (pid : t_id; sig : Signal) return int is - function c_kill (pid : t_id; sig : Signal) return int; - pragma Import (C, c_kill, "kill"); begin - return c_kill (pid, sig); + return System.VxWorks.Ext.kill (pid, int (sig)); end kill; - -------------------- - -- Set_Time_Slice -- - -------------------- - - function Set_Time_Slice (ticks : int) return int is - function kernelTimeSlice (ticks : int) return int; - pragma Import (C, kernelTimeSlice, "kernelTimeSlice"); - begin - return kernelTimeSlice (ticks); - end Set_Time_Slice; - ------------- -- sigwait -- ------------- @@ -129,28 +82,6 @@ package body System.OS_Interface is end if; end sigwait; - --------------- - -- Task_Cont -- - --------------- - - function Task_Cont (tid : t_id) return int is - function taskResume (tid : t_id) return int; - pragma Import (C, taskResume, "taskResume"); - begin - return taskResume (tid); - end Task_Cont; - - --------------- - -- Task_Stop -- - --------------- - - function Task_Stop (tid : t_id) return int is - function taskSuspend (tid : t_id) return int; - pragma Import (C, taskSuspend, "taskSuspend"); - begin - return taskSuspend (tid); - end Task_Stop; - ----------------- -- To_Duration -- ----------------- diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads index 3204b4bb267..35baabb6924 100644 --- a/gcc/ada/s-osinte-vxworks.ads +++ b/gcc/ada/s-osinte-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-1994, Florida State University -- +-- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1995-2008, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- @@ -32,7 +32,7 @@ -- -- ------------------------------------------------------------------------------ --- This is the VxWorks version of this package +-- This is the VxWorks 5.x and 6.x version of this package -- This package encapsulates all direct interfaces to OS services -- that are needed by the tasking run-time (libgnarl). @@ -41,18 +41,20 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; - with System.VxWorks; +with System.VxWorks.Ext; package System.OS_Interface is pragma Preelaborate; - subtype int is Interfaces.C.int; - subtype short is Short_Integer; - type unsigned_int is mod 2 ** int'Size; - type long is new Long_Integer; - type unsigned_long is mod 2 ** long'Size; - type size_t is mod 2 ** Standard'Address_Size; + subtype int is Interfaces.C.int; + subtype short is Short_Integer; + type unsigned_int is mod 2 ** int'Size; + type long is new Long_Integer; + type unsigned_long is mod 2 ** long'Size; + type long_long is new Long_Long_Integer; + type unsigned_long_long is mod 2 ** long_long'Size; + type size_t is mod 2 ** Standard'Address_Size; ----------- -- Errno -- @@ -73,7 +75,7 @@ package System.OS_Interface is -- Signals and Interrupts -- ---------------------------- - NSIG : constant := 32; + NSIG : constant := 64; -- Number of signals on the target OS type Signal is new int range 0 .. Interfaces.C."-" (NSIG, 1); @@ -82,11 +84,58 @@ package System.OS_Interface is Max_Interrupt : constant := Max_HW_Interrupt; - SIGILL : constant := 4; -- illegal instruction (not reset) - SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future - SIGFPE : constant := 8; -- floating point exception - SIGBUS : constant := 10; -- bus error - SIGSEGV : constant := 11; -- segmentation violation + -- Signals common to Vxworks 5.x and 6.x + + SIGILL : constant := 4; -- illegal instruction (not reset when caught) + SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future + SIGFPE : constant := 8; -- floating point exception + SIGBUS : constant := 10; -- bus error + SIGSEGV : constant := 11; -- segmentation violation + + -- Signals specific to VxWorks 6.x + + SIGHUP : constant := 1; -- hangup + SIGINT : constant := 2; -- interrupt + SIGQUIT : constant := 3; -- quit + SIGTRAP : constant := 5; -- trace trap (not reset when caught) + SIGEMT : constant := 7; -- EMT instruction + SIGKILL : constant := 9; -- kill + SIGFMT : constant := 12; -- STACK FORMAT ERROR (not posix) + 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 + SIGCNCL : constant := 16; -- pthreads cancellation signal + SIGSTOP : constant := 17; -- sendable stop signal not from tty + SIGTSTP : constant := 18; -- stop signal from tty + SIGCONT : constant := 19; -- continue a stopped process + SIGCHLD : constant := 20; -- to parent on child stop or exit + SIGTTIN : constant := 21; -- to readers pgrp upon background tty read + SIGTTOU : constant := 22; -- like TTIN for output + + SIGRES1 : constant := 23; -- reserved signal number (Not POSIX) + SIGRES2 : constant := 24; -- reserved signal number (Not POSIX) + SIGRES3 : constant := 25; -- reserved signal number (Not POSIX) + SIGRES4 : constant := 26; -- reserved signal number (Not POSIX) + SIGRES5 : constant := 27; -- reserved signal number (Not POSIX) + SIGRES6 : constant := 28; -- reserved signal number (Not POSIX) + SIGRES7 : constant := 29; -- reserved signal number (Not POSIX) + + SIGUSR1 : constant := 30; -- user defined signal 1 + SIGUSR2 : constant := 31; -- user defined signal 2 + + SIGPOLL : constant := 32; -- pollable event + SIGPROF : constant := 33; -- profiling timer expired + SIGSYS : constant := 34; -- bad system call + SIGURG : constant := 35; -- high bandwidth data is available at socket + SIGVTALRM : constant := 36; -- virtual timer expired + SIGXCPU : constant := 37; -- CPU time limit exceeded + SIGXFSZ : constant := 38; -- file size time limit exceeded + + SIGEVTS : constant := 39; -- signal event thread send + SIGEVTD : constant := 40; -- signal event thread delete + + SIGRTMIN : constant := 48; -- Realtime signal min + SIGRTMAX : constant := 63; -- Realtime signal max ----------------------------------- -- Signal processing definitions -- @@ -100,8 +149,8 @@ package System.OS_Interface is -- The sa_flags in struct sigaction - SA_SIGINFO : constant := 16#0002#; - SA_ONSTACK : constant := 16#0004#; + SA_SIGINFO : constant := 16#0002#; + SA_ONSTACK : constant := 16#0004#; SIG_DFL : constant := 0; SIG_IGN : constant := 1; @@ -152,36 +201,33 @@ package System.OS_Interface is oset : access sigset_t) return int; pragma Import (C, pthread_sigmask, "sigprocmask"); - type t_id is new long; + subtype t_id is System.VxWorks.Ext.t_id; subtype Thread_Id is t_id; function kill (pid : t_id; sig : Signal) return int; pragma Inline (kill); - function getpid return t_id; - pragma Inline (getpid); + function getpid return t_id renames System.VxWorks.Ext.getpid; - function Task_Stop (tid : t_id) return int; - pragma Inline (Task_Stop); + function Task_Stop (tid : t_id) return int + renames System.VxWorks.Ext.Task_Stop; -- If we are in the kernel space, stop the task whose t_id is -- given in parameter in such a way that it can be examined by the -- debugger. This typically maps to taskSuspend on VxWorks 5 and -- to taskStop on VxWorks 6. - function Task_Cont (tid : t_id) return int; - pragma Inline (Task_Cont); + function Task_Cont (tid : t_id) return int + renames System.VxWorks.Ext.Task_Cont; -- If we are in the kernel space, continue the task whose t_id is -- given in parameter if it has been stopped previously to be examined -- by the debugger (e.g. by taskStop). It typically maps to taskResume -- on VxWorks 5 and to taskCont on VxWorks 6. - function Int_Lock return int; - pragma Inline (Int_Lock); + function Int_Lock return int renames System.VxWorks.Ext.Int_Lock; -- If we are in the kernel space, lock interrupts. It typically maps to -- intLock. - function Int_Unlock return int; - pragma Inline (Int_Unlock); + function Int_Unlock return int renames System.VxWorks.Ext.Int_Unlock; -- If we are in the kernel space, unlock interrupts. It typically maps to -- intUnlock. @@ -214,14 +260,6 @@ package System.OS_Interface is (clock_id : clockid_t; tp : access timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); - type ULONG is new unsigned_long; - - procedure tickSet (ticks : ULONG); - pragma Import (C, tickSet, "tickSet"); - - function tickGet return ULONG; - pragma Import (C, tickGet, "tickGet"); - ---------------------- -- Utility Routines -- ---------------------- @@ -324,8 +362,8 @@ package System.OS_Interface is procedure taskDelete (tid : t_id); pragma Import (C, taskDelete, "taskDelete"); - function Set_Time_Slice (ticks : int) return int; - pragma Inline (Set_Time_Slice); + 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 @@ -395,7 +433,7 @@ package System.OS_Interface is -- Release all threads blocked on the semaphore private - type sigset_t is new long; + type sigset_t is new unsigned_long_long; type pid_t is new int; diff --git a/gcc/ada/s-osinte-vxworks6.ads b/gcc/ada/s-osinte-vxworks6.ads deleted file mode 100644 index 4ef43c9c31f..00000000000 --- a/gcc/ada/s-osinte-vxworks6.ads +++ /dev/null @@ -1,446 +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 -- --- -- --- S p e c -- --- -- --- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2008, Free Software Foundation, Inc. -- --- -- --- GNARL is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the VxWorks 6.x 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 Interfaces.C; -with System.VxWorks; - -package System.OS_Interface is - pragma Preelaborate; - - subtype int is Interfaces.C.int; - subtype short is Short_Integer; - type unsigned_int is mod 2 ** int'Size; - type long is new Long_Integer; - type unsigned_long is mod 2 ** long'Size; - type long_long is new Long_Long_Integer; - type unsigned_long_long is mod 2 ** long_long'Size; - type size_t is mod 2 ** Standard'Address_Size; - - ----------- - -- Errno -- - ----------- - - function errno return int; - pragma Import (C, errno, "errnoGet"); - - EINTR : constant := 4; - EAGAIN : constant := 35; - ENOMEM : constant := 12; - EINVAL : constant := 22; - ETIMEDOUT : constant := 60; - - FUNC_ERR : constant := -1; - - ---------------------------- - -- Signals and Interrupts -- - ---------------------------- - - NSIG : constant := 64; - -- Number of signals on the target OS - type Signal is new int range 0 .. Interfaces.C."-" (NSIG, 1); - - Max_HW_Interrupt : constant := System.VxWorks.Num_HW_Interrupts - 1; - type HW_Interrupt is new int range 0 .. Max_HW_Interrupt; - - Max_Interrupt : constant := Max_HW_Interrupt; - - SIGHUP : constant := 1; -- hangup - SIGINT : constant := 2; -- interrupt - SIGQUIT : constant := 3; -- quit - SIGILL : constant := 4; -- illegal instruction (not reset when caught) - SIGTRAP : constant := 5; -- trace trap (not reset when caught) - SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future - SIGEMT : constant := 7; -- EMT instruction - SIGFPE : constant := 8; -- floating point exception - SIGKILL : constant := 9; -- kill - SIGBUS : constant := 10; -- bus error - SIGSEGV : constant := 11; -- segmentation violation - SIGFMT : constant := 12; -- STACK FORMAT ERROR (not posix) - 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 - SIGCNCL : constant := 16; -- pthreads cancellation signal - SIGSTOP : constant := 17; -- sendable stop signal not from tty - SIGTSTP : constant := 18; -- stop signal from tty - SIGCONT : constant := 19; -- continue a stopped process - SIGCHLD : constant := 20; -- to parent on child stop or exit - SIGTTIN : constant := 21; -- to readers pgrp upon background tty read - SIGTTOU : constant := 22; -- like TTIN for output - - SIGRES1 : constant := 23; -- reserved signal number (Not POSIX) - SIGRES2 : constant := 24; -- reserved signal number (Not POSIX) - SIGRES3 : constant := 25; -- reserved signal number (Not POSIX) - SIGRES4 : constant := 26; -- reserved signal number (Not POSIX) - SIGRES5 : constant := 27; -- reserved signal number (Not POSIX) - SIGRES6 : constant := 28; -- reserved signal number (Not POSIX) - SIGRES7 : constant := 29; -- reserved signal number (Not POSIX) - - SIGUSR1 : constant := 30; -- user defined signal 1 - SIGUSR2 : constant := 31; -- user defined signal 2 - - SIGPOLL : constant := 32; -- pollable event - SIGPROF : constant := 33; -- profiling timer expired - SIGSYS : constant := 34; -- bad system call - SIGURG : constant := 35; -- high bandwidth data is available at socket - SIGVTALRM : constant := 36; -- virtual timer expired - SIGXCPU : constant := 37; -- CPU time limit exceeded - SIGXFSZ : constant := 38; -- file size time limit exceeded - - SIGEVTS : constant := 39; -- signal event thread send - SIGEVTD : constant := 40; -- signal event thread delete - - SIGRTMIN : constant := 48; -- Realtime signal min - SIGRTMAX : constant := 63; -- Realtime signal max - - ----------------------------------- - -- Signal processing definitions -- - ----------------------------------- - - -- The how in sigprocmask() - SIG_BLOCK : constant := 1; - SIG_UNBLOCK : constant := 2; - SIG_SETMASK : constant := 3; - - -- The sa_flags in struct sigaction - SA_SIGINFO : constant := 16#0002#; - SA_ONSTACK : constant := 16#0004#; - - SIG_DFL : constant := 0; - SIG_IGN : constant := 1; - - type sigset_t is private; - - type struct_sigaction is record - sa_handler : System.Address; - sa_mask : sigset_t; - sa_flags : int; - end record; - pragma Convention (C, struct_sigaction); - type struct_sigaction_ptr is access all struct_sigaction; - - 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"); - - function sigaction - (sig : Signal; - act : struct_sigaction_ptr; - oact : struct_sigaction_ptr) return int; - pragma Import (C, sigaction, "sigaction"); - - type isr_address is access procedure (sig : int); - pragma Convention (C, isr_address); - - function c_signal (sig : Signal; handler : isr_address) return isr_address; - pragma Import (C, c_signal, "signal"); - - function sigwait (set : access sigset_t; sig : access Signal) return int; - pragma Inline (sigwait); - - function pthread_sigmask - (how : int; - set : access sigset_t; - oset : access sigset_t) return int; - pragma Import (C, pthread_sigmask, "sigprocmask"); - - type t_id is new long; - subtype Thread_Id is t_id; - - function kill (pid : t_id; sig : Signal) return int; - pragma Inline (kill); - - function getpid return t_id; - pragma Inline (getpid); - - function Task_Stop (tid : t_id) return int; - pragma Inline (Task_Stop); - -- If we are in the kernel space, continue the task whose t_id is - -- given in parameter if it has been stopped previously to be examined - -- by the debugger (e.g. by taskStop). It typically maps to taskResume - -- on VxWorks 5 and to taskCont on VxWorks 6. - - function Task_Cont (tid : t_id) return int; - pragma Inline (Task_Cont); - -- If we are in the kernel space, lock interrupts. It typically maps to - -- intLock. - - function Int_Lock return int; - pragma Inline (Int_Lock); - -- If we are in the kernel space, lock interrupts. It typically maps to - -- intLock. - - function Int_Unlock return int; - pragma Inline (Int_Unlock); - -- If we are in the kernel space, unlock interrupts. It typically maps to - -- intUnlock. - - ---------- - -- Time -- - ---------- - - type time_t is new unsigned_long; - - type timespec is record - ts_sec : time_t; - ts_nsec : long; - end record; - pragma Convention (C, timespec); - - type clockid_t is private; - - CLOCK_REALTIME : constant clockid_t; -- System wide realtime clock - - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - - function To_Clock_Ticks (D : Duration) return int; - -- Convert a duration value (in seconds) into clock ticks - - function clock_gettime - (clock_id : clockid_t; tp : access timespec) return int; - pragma Import (C, clock_gettime, "clock_gettime"); - - type ULONG is new unsigned_long; - - procedure tickSet (ticks : ULONG); - pragma Import (C, tickSet, "tickSet"); - - function tickGet return ULONG; - pragma Import (C, tickGet, "tickGet"); - - ---------------------- - -- Utility Routines -- - ---------------------- - - function To_VxWorks_Priority (Priority : int) return int; - pragma Inline (To_VxWorks_Priority); - -- Convenience routine to convert between VxWorks priority and Ada priority - - -------------------------- - -- VxWorks specific API -- - -------------------------- - - subtype STATUS is int; - -- Equivalent of the C type STATUS - - OK : constant STATUS := 0; - ERROR : constant STATUS := Interfaces.C.int (-1); - - function taskIdVerify (tid : t_id) return STATUS; - pragma Import (C, taskIdVerify, "taskIdVerify"); - - function taskIdSelf return t_id; - pragma Import (C, taskIdSelf, "taskIdSelf"); - - function taskOptionsGet (tid : t_id; pOptions : access int) return int; - pragma Import (C, taskOptionsGet, "taskOptionsGet"); - - function taskSuspend (tid : t_id) return int; - pragma Import (C, taskSuspend, "taskSuspend"); - - function taskResume (tid : t_id) return int; - pragma Import (C, taskResume, "taskResume"); - - function taskIsSuspended (tid : t_id) return int; - pragma Import (C, taskIsSuspended, "taskIsSuspended"); - - function taskDelay (ticks : int) return int; - procedure taskDelay (ticks : int); - pragma Import (C, taskDelay, "taskDelay"); - - function sysClkRateGet return int; - pragma Import (C, sysClkRateGet, "sysClkRateGet"); - - -- VxWorks 5.x specific functions - - function taskVarAdd - (tid : t_id; pVar : access System.Address) return int; - pragma Import (C, taskVarAdd, "taskVarAdd"); - - function taskVarDelete - (tid : t_id; pVar : access System.Address) return int; - pragma Import (C, taskVarDelete, "taskVarDelete"); - - function taskVarSet - (tid : t_id; - pVar : access System.Address; - value : System.Address) return int; - pragma Import (C, taskVarSet, "taskVarSet"); - - function taskVarGet - (tid : t_id; - pVar : access System.Address) return int; - pragma Import (C, taskVarGet, "taskVarGet"); - - -- VxWorks 6.x specific functions - - function tlsKeyCreate return int; - pragma Import (C, tlsKeyCreate, "tlsKeyCreate"); - - function tlsValueGet (key : int) return System.Address; - pragma Import (C, tlsValueGet, "tlsValueGet"); - - function tlsValueSet (key : int; value : System.Address) return STATUS; - pragma Import (C, tlsValueSet, "tlsValueSet"); - - -- Option flags for taskSpawn - - VX_UNBREAKABLE : constant := 16#0002#; - VX_FP_PRIVATE_ENV : constant := 16#0080#; - VX_NO_STACK_FILL : constant := 16#0100#; - - function taskSpawn - (name : System.Address; -- Pointer to task name - priority : int; - options : int; - stacksize : size_t; - start_routine : System.Address; - arg1 : System.Address; - arg2 : int := 0; - arg3 : int := 0; - arg4 : int := 0; - arg5 : int := 0; - arg6 : int := 0; - arg7 : int := 0; - arg8 : int := 0; - arg9 : int := 0; - arg10 : int := 0) return t_id; - pragma Import (C, taskSpawn, "taskSpawn"); - - procedure taskDelete (tid : t_id); - pragma Import (C, taskDelete, "taskDelete"); - - function Set_Time_Slice (ticks : int) return int; - pragma Inline (Set_Time_Slice); - -- Calls kernelTimeSlice under VxWorks 5.x - -- Do nothing under VxWorks 6.x - - function taskPriorityGet (tid : t_id; pPriority : access int) return int; - pragma Import (C, taskPriorityGet, "taskPriorityGet"); - - function taskPrioritySet (tid : t_id; newPriority : int) return int; - pragma Import (C, taskPrioritySet, "taskPrioritySet"); - - -- Semaphore creation flags - - SEM_Q_FIFO : constant := 0; - SEM_Q_PRIORITY : constant := 1; - SEM_DELETE_SAFE : constant := 4; -- only valid for binary semaphore - SEM_INVERSION_SAFE : constant := 8; -- only valid for binary semaphore - - -- Semaphore initial state flags - - SEM_EMPTY : constant := 0; - SEM_FULL : constant := 1; - - -- Semaphore take (semTake) time constants - - WAIT_FOREVER : constant := -1; - NO_WAIT : constant := 0; - - -- Error codes (errno). The lower level 16 bits are the error code, with - -- the upper 16 bits representing the module number in which the error - -- occurred. By convention, the module number is 0 for UNIX errors. VxWorks - -- reserves module numbers 1-500, with the remaining module numbers being - -- available for user applications. - - M_objLib : constant := 61 * 2**16; - -- semTake() failure with ticks = NO_WAIT - S_objLib_OBJ_UNAVAILABLE : constant := M_objLib + 2; - -- semTake() timeout with ticks > NO_WAIT - S_objLib_OBJ_TIMEOUT : constant := M_objLib + 4; - - type SEM_ID is new System.Address; - -- typedef struct semaphore *SEM_ID; - - -- We use two different kinds of VxWorks semaphores: mutex and binary - -- semaphores. A null ID is returned when a semaphore cannot be created. - - function semBCreate (options : int; initial_state : int) return SEM_ID; - pragma Import (C, semBCreate, "semBCreate"); - -- Create a binary semaphore. Return ID, or 0 if memory could not - -- be allocated. - - function semMCreate (options : int) return SEM_ID; - pragma Import (C, semMCreate, "semMCreate"); - - function semDelete (Sem : SEM_ID) return int; - pragma Import (C, semDelete, "semDelete"); - -- Delete a semaphore - - function semGive (Sem : SEM_ID) return int; - pragma Import (C, semGive, "semGive"); - - function semTake (Sem : SEM_ID; timeout : int) return int; - pragma Import (C, semTake, "semTake"); - -- Attempt to take binary semaphore. Error is returned if operation - -- times out - - function semFlush (SemID : SEM_ID) return STATUS; - pragma Import (C, semFlush, "semFlush"); - -- Release all threads blocked on the semaphore - -private - type sigset_t is new unsigned_long_long; - - type pid_t is new int; - - ERROR_PID : constant pid_t := -1; - - type clockid_t is new int; - CLOCK_REALTIME : constant clockid_t := 0; - -end System.OS_Interface; diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index c6469cd2b05..f12b9afd702 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -54,6 +54,8 @@ with System.Soft_Links; -- on. For example when using the restricted run time, it is replaced by -- System.Tasking.Restricted.Stages. +with System.VxWorks.Ext; + package body System.Task_Primitives.Operations is package SSL renames System.Soft_Links; @@ -62,6 +64,7 @@ package body System.Task_Primitives.Operations is use System.Tasking; use System.OS_Interface; use System.Parameters; + use type System.VxWorks.Ext.t_id; use type Interfaces.C.int; subtype int is System.OS_Interface.int; diff --git a/gcc/ada/s-vxwext-kernel.ads b/gcc/ada/s-vxwext-kernel.ads new file mode 100644 index 00000000000..bb3df913514 --- /dev/null +++ b/gcc/ada/s-vxwext-kernel.ads @@ -0,0 +1,65 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . V X W O R K S . E X T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides vxworks specific support functions needed +-- by System.OS_Interface. + +-- This is the VxWorks 6 kernel version of this package + +with Interfaces.C; + +package System.VxWorks.Ext is + pragma Preelaborate; + + 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, "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"); + +end System.VxWorks.Ext; diff --git a/gcc/ada/s-vxwext-rtp.adb b/gcc/ada/s-vxwext-rtp.adb new file mode 100644 index 00000000000..aab05e15ca1 --- /dev/null +++ b/gcc/ada/s-vxwext-rtp.adb @@ -0,0 +1,67 @@ +------------------------------------------------------------------------------ +-- -- +-- 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, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the VxWorks 6 rtp version of this package + +package body System.VxWorks.Ext is + + function Task_Cont (tid : t_id) return int is + pragma Unreferenced (tid); + begin + -- Operation not allowed in an RTP + return 0; + end Task_Cont; + + function Task_Stop (tid : t_id) return int is + pragma Unreferenced (tid); + begin + -- Operation not allowed in an RTP + return 0; + end Task_Stop; + + function Int_Lock return int is + begin + -- Operation not allowed in an RTP + return 0; + end Int_Lock; + + function Int_Unlock return int is + begin + -- Operation not allowed in an RTP + return 0; + end Int_Unlock; + + function Set_Time_Slice (ticks : int) return int is + pragma Unreferenced (ticks); + begin + return 0; + end Set_Time_Slice; + +end System.VxWorks.Ext; diff --git a/gcc/ada/s-vxwext-rtp.ads b/gcc/ada/s-vxwext-rtp.ads new file mode 100644 index 00000000000..d658e26c194 --- /dev/null +++ b/gcc/ada/s-vxwext-rtp.ads @@ -0,0 +1,65 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . V X W O R K S . E X T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides vxworks specific support functions needed +-- by System.OS_Interface. + +-- This is the VxWorks 6 rtp version of this package + +with Interfaces.C; + +package System.VxWorks.Ext is + pragma Preelaborate; + + type t_id is new Long_Integer; + subtype int is Interfaces.C.int; + + function Task_Cont (tid : t_id) return int; + pragma Inline (Task_Cont); + + function Task_Stop (tid : t_id) return int; + pragma Inline (Task_Stop); + + function Int_Lock return int; + pragma Inline (Int_Lock); + + function Int_Unlock return int; + pragma Inline (Int_Unlock); + + function kill (pid : t_id; sig : int) return int; + pragma Import (C, kill, "taskKill"); + + function Set_Time_Slice (ticks : int) return int; + pragma Inline (Set_Time_Slice); + + function getpid return t_id; + pragma Import (C, getpid, "getpid"); + +end System.VxWorks.Ext; diff --git a/gcc/ada/s-vxwext.ads b/gcc/ada/s-vxwext.ads new file mode 100644 index 00000000000..350aa9c4d8f --- /dev/null +++ b/gcc/ada/s-vxwext.ads @@ -0,0 +1,65 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . V X W O R K S . E X T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides vxworks specific support functions needed +-- by System.OS_Interface. + +-- This is the VxWorks 5 version of this package + +with Interfaces.C; + +package System.VxWorks.Ext is + pragma Preelaborate; + + 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"); + + function Task_Stop (tid : t_id) return int; + pragma Import (C, Task_Stop, "taskSuspend"); + + 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"); + +end System.VxWorks.Ext; -- 2.30.2