endif
endif
-# PowerPC and e500v2 VxWorks 653
-ifeq ($(strip $(filter-out powerpc% wrs vxworksae vxworksaespe,$(target_cpu) $(target_vendor) $(target_os))),)
-
- ifeq ($(strip $(filter-out e500%, $(target_alias))),)
- ARCH_STR=e500
- # gcc config translates the target e500v2-wrs-vxworks to
- # powerpc-wrs-vxworksspe. Let's keep the original alias here when
- # generating s-oscons.ads.
- target=$(target_alias)
- else
- ARCH_STR=ppc
- endif
-
- # target pairs for vthreads runtime
- LIBGNAT_TARGET_PAIRS = \
- a-elchha.adb<libgnat/a-elchha__vxworks-ppc-full.adb \
- a-intnam.ads<libgnarl/a-intnam__vxworks.ads \
- a-naliop.ads<libgnat/a-naliop__nolibm.ads \
- a-nuaufl.ads<libgnat/a-nuaufl__wraplf.ads \
- a-nashfl.ads<libgnat/a-nashfl__wraplf.ads \
- g-io.adb<hie/g-io__vxworks-cert.adb \
- s-dorepr.adb<libgnat/s-dorepr__fma.adb \
- s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \
- s-interr.adb<libgnarl/s-interr__vxworks.adb \
- s-intman.ads<libgnarl/s-intman__vxworks.ads \
- s-intman.adb<libgnarl/s-intman__vxworks.adb \
- s-osinte.adb<libgnarl/s-osinte__vxworks.adb \
- s-osinte.ads<libgnarl/s-osinte__vxworks.ads \
- s-osprim.adb<libgnat/s-osprim__vxworks.adb \
- s-parame.ads<libgnat/s-parame__ae653.ads \
- s-parame.adb<libgnat/s-parame__vxworks.adb \
- s-taprop.adb<libgnarl/s-taprop__vxworks.adb \
- s-tasinf.ads<libgnarl/s-tasinf__vxworks.ads \
- s-taspri.ads<libgnarl/s-taspri__vxworks.ads \
- s-tpopsp.adb<libgnarl/s-tpopsp__vxworks.adb \
- s-vxwext.adb<libgnarl/s-vxwext__noints.adb \
- s-vxwext.ads<libgnarl/s-vxwext__vthreads.ads \
- s-vxwork.ads<libgnarl/s-vxwork__ppc.ads \
- $(ATOMICS_TARGET_PAIRS) \
- $(ATOMICS_BUILTINS_TARGET_PAIRS) \
- system.ads<libgnat/system-vxworks-$(ARCH_STR)-vthread.ads
-
- EH_MECHANISM=-gcc
-
- TOOLS_TARGET_PAIRS=indepsw.adb<indepsw-gnu.adb
-
- EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
- EXTRA_GNATRTL_TASKING_OBJS=i-vxinco.o s-vxwork.o s-vxwext.o
-
- EXTRA_LIBGNAT_OBJS+=sigtramp-vxworks.o
- EXTRA_LIBGNAT_SRCS+=$(VX_SIGTRAMP_EXTRA_SRCS)
-
- # Extra pairs for the vthreads runtime
- ifeq ($(strip $(filter-out vthreads,$(THREAD_KIND))),)
- LIBGNAT_TARGET_PAIRS += \
- s-thread.adb<libgnat/s-thread__ae653.adb \
- s-osvers.ads<libgnat/s-osvers__vxworks-653.ads \
- $(DUMMY_SOCKETS_TARGET_PAIRS)
-
- GNATRTL_SOCKETS_OBJS =
- EXTRA_GNATRTL_NONTASKING_OBJS += s-thread.o s-osvers.o
- else
- LIBGNAT_TARGET_PAIRS += \
- g-socthi.ads<libgnat/g-socthi__vxworks.ads \
- g-socthi.adb<libgnat/g-socthi__vxworks.adb \
- g-sopowa.adb<libgnat/g-sopowa__posix.adb \
- g-stsifd.adb<libgnat/g-stsifd__sockets.adb
- endif
-
-endif
-
-# VxWorksae / VxWorks 653 for x86 (vxsim) - ?? VxWorks mils not implemented
-ifeq ($(strip $(filter-out %86 wrs vxworksae,$(target_cpu) $(target_vendor) $(target_os))),)
- # target pairs for kernel + vthreads runtime
- LIBGNAT_TARGET_PAIRS = \
- a-elchha.adb<libgnat/a-elchha__vxworks-ppc-full.adb \
- a-intnam.ads<libgnarl/a-intnam__vxworks.ads \
- a-naliop.ads<libgnat/a-naliop__nolibm.ads \
- a-nuaufl.ads<libgnat/a-nuaufl__wraplf.ads \
- a-nashfl.ads<libgnat/a-nashfl__wraplf.ads \
- g-io.adb<hie/g-io__vxworks-cert.adb \
- s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \
- s-interr.adb<libgnarl/s-interr__vxworks.adb \
- s-intman.ads<libgnarl/s-intman__vxworks.ads \
- s-intman.adb<libgnarl/s-intman__vxworks.adb \
- s-osinte.adb<libgnarl/s-osinte__vxworks.adb \
- s-osinte.ads<libgnarl/s-osinte__vxworks.ads \
- s-osprim.adb<libgnat/s-osprim__vxworks.adb \
- s-parame.ads<libgnat/s-parame__ae653.ads \
- s-parame.adb<libgnat/s-parame__vxworks.adb \
- s-taprop.adb<libgnarl/s-taprop__vxworks.adb \
- s-tasinf.ads<libgnarl/s-tasinf__vxworks.ads \
- s-taspri.ads<libgnarl/s-taspri__vxworks.ads \
- s-tpopsp.adb<libgnarl/s-tpopsp__vxworks.adb \
- s-vxwext.adb<libgnarl/s-vxwext__noints.adb \
- s-vxwext.ads<libgnarl/s-vxwext__vthreads.ads \
- s-vxwork.ads<libgnarl/s-vxwork__x86.ads \
- system.ads<libgnat/system-vxworks-x86-vthread.ads \
- $(ATOMICS_TARGET_PAIRS) \
- $(ATOMICS_BUILTINS_TARGET_PAIRS)
-
- EH_MECHANISM=-gcc
-
- TOOLS_TARGET_PAIRS=indepsw.adb<indepsw-gnu.adb
-
- EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
- EXTRA_GNATRTL_TASKING_OBJS=i-vxinco.o s-vxwork.o s-vxwext.o
-
- EXTRA_LIBGNAT_OBJS+=vx_stack_info.o
- GNATRTL_SOCKETS_OBJS =
-
- # Extra pairs for the vthreads runtime
- ifeq ($(strip $(filter-out vthreads,$(THREAD_KIND))),)
- LIBGNAT_TARGET_PAIRS += \
- s-thread.adb<libgnat/s-thread__ae653.adb \
- s-osvers.ads<libgnat/s-osvers__vxworks-653.ads \
- $(DUMMY_SOCKETS_TARGET_PAIRS)
-
- GNATRTL_SOCKETS_OBJS =
- EXTRA_GNATRTL_NONTASKING_OBJS += s-thread.o s-osvers.o
- else
- LIBGNAT_TARGET_PAIRS += \
- g-socthi.ads<libgnat/g-socthi__vxworks.ads \
- g-socthi.adb<libgnat/g-socthi__vxworks.adb \
- g-sopowa.adb<libgnat/g-sopowa__posix.adb \
- g-stsifd.adb<libgnat/g-stsifd__sockets.adb
- endif
-
-endif
-
# x86/x86_64 VxWorks
ifeq ($(strip $(filter-out %86 x86_64 wrs vxworks vxworks7%,$(target_cpu) $(target_vendor) $(target_os))),)
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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-2021, Free Software Foundation, Inc. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
-------------------------------------------------------------------------------
-
--- This package provides vxworks specific support functions needed
--- by System.OS_Interface.
-
--- This is a version for VxWorks 5 based systems with no interrupts:
--- HI-Ravenscar for VxWorks 5, VxWorks 653 vThreads (not ravenscar-cert)
-
-package body System.VxWorks.Ext is
-
- ERROR : constant := -1;
-
- --------------
- -- Int_Lock --
- --------------
-
- function Int_Lock return int is
- begin
- return ERROR;
- end Int_Lock;
-
- ----------------
- -- Int_Unlock --
- ----------------
-
- function Int_Unlock (Old : int) return int is
- pragma Unreferenced (Old);
- begin
- return ERROR;
- end Int_Unlock;
-
- -----------------------
- -- Interrupt_Connect --
- -----------------------
-
- function Interrupt_Connect
- (Vector : Interrupt_Vector;
- Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int
- is
- pragma Unreferenced (Vector, Handler, Parameter);
- begin
- return ERROR;
- end Interrupt_Connect;
-
- -----------------------
- -- Interrupt_Context --
- -----------------------
-
- function Interrupt_Context return int is
- begin
- -- For VxWorks 653 vThreads, never in an interrupt context
-
- return 0;
- end Interrupt_Context;
-
- --------------------------------
- -- Interrupt_Number_To_Vector --
- --------------------------------
-
- function Interrupt_Number_To_Vector
- (intNum : int) return Interrupt_Vector
- is
- pragma Unreferenced (intNum);
- begin
- return 0;
- end Interrupt_Number_To_Vector;
-
- ---------------
- -- semDelete --
- ---------------
-
- function semDelete (Sem : SEM_ID) return int is
- function Os_Sem_Delete (Sem : SEM_ID) return int;
- pragma Import (C, Os_Sem_Delete, "semDelete");
- begin
- return Os_Sem_Delete (Sem);
- end semDelete;
-
- ------------------------
- -- taskCpuAffinitySet --
- ------------------------
-
- function taskCpuAffinitySet (tid : t_id; CPU : int) return int is
- pragma Unreferenced (tid, CPU);
- begin
- return ERROR;
- end taskCpuAffinitySet;
-
- -------------------------
- -- taskMaskAffinitySet --
- -------------------------
-
- function taskMaskAffinitySet (tid : t_id; CPU_Set : unsigned) return int is
- pragma Unreferenced (tid, CPU_Set);
- begin
- return ERROR;
- end taskMaskAffinitySet;
-
-end System.VxWorks.Ext;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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-2021, Free Software Foundation, Inc. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
-------------------------------------------------------------------------------
-
--- This package provides VxWorks specific support functions needed
--- by System.OS_Interface.
-
--- This is the VxWorks 653 vThreads version of this package
-
-with Interfaces.C;
-
-package System.VxWorks.Ext is
- pragma Preelaborate;
-
- subtype SEM_ID is Long_Integer;
- -- typedef struct semaphore *SEM_ID;
-
- type sigset_t is mod 2 ** Interfaces.C.long'Size;
-
- type t_id is new Long_Integer;
- subtype int is Interfaces.C.int;
- subtype unsigned is Interfaces.C.unsigned;
-
- 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 (Old : int) return int;
- pragma Inline (Int_Unlock);
-
- function Interrupt_Connect
- (Vector : Interrupt_Vector;
- Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int;
- pragma Convention (C, Interrupt_Connect);
-
- function Interrupt_Context return int;
- pragma Convention (C, Interrupt_Context);
-
- function Interrupt_Number_To_Vector
- (intNum : int) return Interrupt_Vector;
- pragma Convention (C, Interrupt_Number_To_Vector);
-
- function semDelete (Sem : SEM_ID) return int;
- pragma Convention (C, semDelete);
-
- 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 getpid return t_id;
- pragma Import (C, getpid, "taskIdSelf");
-
- function Set_Time_Slice (ticks : int) return int;
- pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
-
- type UINT64 is mod 2 ** Long_Long_Integer'Size;
-
- function tickGet return UINT64;
- -- "tickGet" not available for cert vThreads:
- pragma Import (C, tickGet, "tick64Get");
-
- --------------------------------
- -- Processor Affinity for SMP --
- --------------------------------
-
- function taskCpuAffinitySet (tid : t_id; CPU : int) return int;
- pragma Convention (C, taskCpuAffinitySet);
- -- For SMP run-times set the CPU affinity.
- -- For uniprocessor systems return ERROR status.
-
- function taskMaskAffinitySet (tid : t_id; CPU_Set : unsigned) return int;
- pragma Convention (C, taskMaskAffinitySet);
- -- For SMP run-times set the CPU mask affinity.
- -- For uniprocessor systems return ERROR status.
-
-end System.VxWorks.Ext;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- A D A . E X C E P T I O N S . L A S T _ C H A N C E _ H A N D L E R --
--- --
--- B o d y --
--- --
--- Copyright (C) 2003-2021, Free Software Foundation, Inc. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-pragma Warnings (Off);
-with System.Standard_Library;
-pragma Warnings (On);
-
-with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
-with GNAT.IO; use GNAT.IO;
-
--- Default last chance handler for use with the full VxWorks 653 partition OS
--- Ada run-time library.
-
--- Logs error with health monitor, and dumps exception identity and argument
--- string for vxaddr2line for generation of a symbolic stack backtrace.
-
-procedure Ada.Exceptions.Last_Chance_Handler (Except : Exception_Occurrence) is
-
- ----------------------
- -- APEX definitions --
- ----------------------
-
- pragma Warnings (Off);
- type Error_Code_Type is (
- Deadline_Missed,
- Application_Error,
- Numeric_Error,
- Illegal_Request,
- Stack_Overflow,
- Memory_Violation,
- Hardware_Fault,
- Power_Fail);
- pragma Warnings (On);
- pragma Convention (C, Error_Code_Type);
- -- APEX Health Management error codes
-
- type Message_Addr_Type is new System.Address;
-
- type Apex_Integer is range -(2 ** 31) .. (2 ** 31) - 1;
- pragma Convention (C, Apex_Integer);
-
- Max_Error_Message_Size : constant := 64;
-
- type Error_Message_Size_Type is new Apex_Integer range
- 1 .. Max_Error_Message_Size;
-
- pragma Warnings (Off);
- type Return_Code_Type is (
- No_Error, -- request valid and operation performed
- No_Action, -- status of system unaffected by request
- Not_Available, -- resource required by request unavailable
- Invalid_Param, -- invalid parameter specified in request
- Invalid_Config, -- parameter incompatible with configuration
- Invalid_Mode, -- request incompatible with current mode
- Timed_Out); -- time-out tied up with request has expired
- pragma Warnings (On);
- pragma Convention (C, Return_Code_Type);
- -- APEX return codes
-
- procedure Raise_Application_Error
- (Error_Code : Error_Code_Type;
- Message_Addr : Message_Addr_Type;
- Length : Error_Message_Size_Type;
- Return_Code : out Return_Code_Type);
- pragma Import (C, Raise_Application_Error, "RAISE_APPLICATION_ERROR");
-
- procedure Unhandled_Terminate;
- pragma No_Return (Unhandled_Terminate);
- pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
- -- Perform system dependent shutdown code
-
- procedure Adainit;
- pragma Import (Ada, Adainit, "adainit");
-
- Adainit_Addr : constant System.Address := Adainit'Code_Address;
- -- Part of arguments to vxaddr2line
-
- Result : Return_Code_Type;
-
- Message : String :=
- Exception_Name (Except) & ": " & ASCII.LF &
- Exception_Message (Except) & ASCII.NUL;
-
- Message_Length : Error_Message_Size_Type;
-
-begin
- New_Line;
- Put_Line ("In last chance handler");
- Put_Line (Message (1 .. Message'Length - 1));
- New_Line;
-
- Put_Line ("adainit and traceback addresses for vxaddr2line:");
-
- Put (Image_C (Adainit_Addr)); Put (" ");
-
- for J in 1 .. Except.Num_Tracebacks loop
- Put (Image_C (Except.Tracebacks (J)));
- Put (" ");
- end loop;
-
- New_Line;
-
- if Message'Length > Error_Message_Size_Type'Last then
- Message_Length := Error_Message_Size_Type'Last;
- else
- Message_Length := Message'Length;
- end if;
-
- Raise_Application_Error
- (Error_Code => Application_Error,
- Message_Addr => Message_Addr_Type (Message (1)'Address),
- Length => Message_Length,
- Return_Code => Result);
-
- -- Shutdown the run-time library now. The rest of the procedure needs to be
- -- careful not to use anything that would require runtime support. In
- -- particular, functions returning strings are banned since the sec stack
- -- is no longer functional.
-
- System.Standard_Library.Adafinal;
- Unhandled_Terminate;
-end Ada.Exceptions.Last_Chance_Handler;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- S Y S T E M . O S _ P R I M I T I V E S --
--- --
--- B o d y --
--- --
--- Copyright (C) 1998-2021, 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 version is for VxWorks targets
-
-with System.OS_Interface;
--- Since the thread library is part of the VxWorks kernel, using OS_Interface
--- is not a problem here, as long as we only use System.OS_Interface as a
--- set of C imported routines: using Ada routines from this package would
--- create a dependency on libgnarl in libgnat, which is not desirable.
-
-with System.OS_Constants;
-with Interfaces.C;
-
-package body System.OS_Primitives is
-
- use System.OS_Interface;
- use type Interfaces.C.int;
-
- package OSC renames System.OS_Constants;
-
- ------------------------
- -- Internal functions --
- ------------------------
-
- function To_Clock_Ticks (D : Duration) return int;
- -- Convert a duration value (in seconds) into clock ticks.
- -- Note that this routine is duplicated from System.OS_Interface since
- -- as explained above, we do not want to depend on libgnarl
-
- 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;
-
- -----------
- -- Clock --
- -----------
-
- function Clock return Duration is
- TS : aliased timespec;
- Result : int;
- begin
- Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
- pragma Assert (Result = 0);
- return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
- end Clock;
-
- -----------------
- -- Timed_Delay --
- -----------------
-
- procedure Timed_Delay
- (Time : Duration;
- Mode : Integer)
- is
- Rel_Time : Duration;
- Abs_Time : Duration;
- Base_Time : constant Duration := Clock;
- Check_Time : Duration := Base_Time;
- Ticks : int;
-
- Result : int;
- pragma Unreferenced (Result);
-
- begin
- if Mode = Relative then
- Rel_Time := Time;
- Abs_Time := Time + Check_Time;
- else
- Rel_Time := Time - Check_Time;
- Abs_Time := Time;
- end if;
-
- if Rel_Time > 0.0 then
- loop
- Ticks := To_Clock_Ticks (Rel_Time);
-
- if Mode = Relative and then Ticks < int'Last then
- -- The first tick will delay anytime between 0 and
- -- 1 / sysClkRateGet seconds, so we need to add one to
- -- be on the safe side.
-
- Ticks := Ticks + 1;
- end if;
-
- Result := taskDelay (Ticks);
- Check_Time := Clock;
-
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
- Rel_Time := Abs_Time - Check_Time;
- end loop;
- end if;
- end Timed_Delay;
-
- ----------------
- -- Initialize --
- ----------------
-
- procedure Initialize is
- begin
- null;
- end Initialize;
-
-end System.OS_Primitives;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY COMPONENTS --
--- --
--- S Y S T E M . O S _ V E R S I O N --
--- --
--- S p e c --
--- --
--- Copyright (C) 2010-2021, AdaCore --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
-------------------------------------------------------------------------------
-
--- This is the VxWorks 653 Partition OS version of this file. If you add an OS
--- variant please be sure to update type OS_Version in all variants of this
--- file, which is part of the Level A certified run-time libraries.
-
-package System.OS_Versions is
- pragma Pure (System.OS_Versions);
- type OS_Version is
- (LynxOS_178, VxWorks_Cert, VxWorks_Cert_RTP, VxWorks_653, VxWorks_MILS);
- OS : constant OS_Version := VxWorks_653;
-end System.OS_Versions;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- S Y S T E M --
--- --
--- S p e c --
--- (VxWorks e500 AE653 vThreads) --
--- --
--- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
--- --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the contents of the part following the private keyword. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This version is for the AE653/e500v2 vThreads full run-time
-
-package System is
- pragma Pure;
- -- Note that we take advantage of the implementation permission to make
- -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
- -- 2005, this is Pure in any case (AI-362).
-
- pragma No_Elaboration_Code_All;
- -- Allow the use of that restriction in units that WITH this unit
-
- type Name is (SYSTEM_NAME_GNAT);
- System_Name : constant Name := SYSTEM_NAME_GNAT;
-
- -- System-Dependent Named Numbers
-
- Min_Int : constant := -2 ** (Standard'Max_Integer_Size - 1);
- Max_Int : constant := 2 ** (Standard'Max_Integer_Size - 1) - 1;
-
- Max_Binary_Modulus : constant := 2 ** Standard'Max_Integer_Size;
- Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1;
-
- Max_Base_Digits : constant := Long_Long_Float'Digits;
- Max_Digits : constant := Long_Long_Float'Digits;
-
- Max_Mantissa : constant := Standard'Max_Integer_Size - 1;
- Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
-
- Tick : constant := 1.0 / 60.0;
-
- -- Storage-related Declarations
-
- type Address is private;
- pragma Preelaborable_Initialization (Address);
- Null_Address : constant Address;
-
- Storage_Unit : constant := 8;
- Word_Size : constant := 32;
- Memory_Size : constant := 2 ** 32;
-
- -- Address comparison
-
- function "<" (Left, Right : Address) return Boolean;
- function "<=" (Left, Right : Address) return Boolean;
- function ">" (Left, Right : Address) return Boolean;
- function ">=" (Left, Right : Address) return Boolean;
- function "=" (Left, Right : Address) return Boolean;
-
- pragma Import (Intrinsic, "<");
- pragma Import (Intrinsic, "<=");
- pragma Import (Intrinsic, ">");
- pragma Import (Intrinsic, ">=");
- pragma Import (Intrinsic, "=");
-
- -- Other System-Dependent Declarations
-
- type Bit_Order is (High_Order_First, Low_Order_First);
- Default_Bit_Order : constant Bit_Order := High_Order_First;
- pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
-
- -- Priority-related Declarations (RM D.1)
-
- -- Ada priorities are mapped to VxWorks priorities using the following
- -- transformation: 255 - Ada Priority
-
- -- Ada priorities are used as follows:
-
- -- 256 is reserved for the VxWorks kernel
- -- 248 - 255 correspond to hardware interrupt levels 0 .. 7
- -- 247 is a catchall default "interrupt" priority for signals,
- -- allowing higher priority than normal tasks, but lower than
- -- hardware priority levels. Protected Object ceilings can
- -- override these values.
- -- 246 is used by the Interrupt_Manager task
-
- Max_Priority : constant Positive := 245;
- Max_Interrupt_Priority : constant Positive := 255;
-
- subtype Any_Priority is Integer range 0 .. 255;
- subtype Priority is Any_Priority range 0 .. 245;
- subtype Interrupt_Priority is Any_Priority range 246 .. 255;
-
- Default_Priority : constant Priority := 122;
-
-private
-
- type Address is mod Memory_Size;
- Null_Address : constant Address := 0;
-
- --------------------------------------
- -- System Implementation Parameters --
- --------------------------------------
-
- -- These parameters provide information about the target that is used
- -- by the compiler. They are in the private part of System, where they
- -- can be accessed using the special circuitry in the Targparm unit
- -- whose source should be consulted for more detailed descriptions
- -- of the individual switch values.
-
- Backend_Divide_Checks : constant Boolean := False;
- Backend_Overflow_Checks : constant Boolean := True;
- Command_Line_Args : constant Boolean := False;
- Configurable_Run_Time : constant Boolean := False;
- Denorm : constant Boolean := True;
- Duration_32_Bits : constant Boolean := False;
- Exit_Status_Supported : constant Boolean := True;
- Machine_Overflows : constant Boolean := False;
- Machine_Rounds : constant Boolean := True;
- Preallocated_Stacks : constant Boolean := False;
- Signed_Zeros : constant Boolean := True;
- Stack_Check_Default : constant Boolean := False;
- Stack_Check_Probes : constant Boolean := True;
- Stack_Check_Limits : constant Boolean := False;
- Support_Aggregates : constant Boolean := True;
- Support_Composite_Assign : constant Boolean := True;
- Support_Composite_Compare : constant Boolean := True;
- Support_Long_Shifts : constant Boolean := True;
- Always_Compatible_Rep : constant Boolean := False;
- Suppress_Standard_Library : constant Boolean := False;
- Use_Ada_Main_Program_Name : constant Boolean := True;
- Frontend_Exceptions : constant Boolean := False;
- ZCX_By_Default : constant Boolean := False;
-
- Executable_Extension : constant String := ".out";
-
-end System;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- S Y S T E M --
--- --
--- S p e c --
--- (VxWorks PPC AE653 vThreads) --
--- --
--- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
--- --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the contents of the part following the private keyword. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This version is for the AE653 vThreads full run-time
-
-package System is
- pragma Pure;
- -- Note that we take advantage of the implementation permission to make
- -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
- -- 2005, this is Pure in any case (AI-362).
-
- pragma No_Elaboration_Code_All;
- -- Allow the use of that restriction in units that WITH this unit
-
- type Name is (SYSTEM_NAME_GNAT);
- System_Name : constant Name := SYSTEM_NAME_GNAT;
-
- -- System-Dependent Named Numbers
-
- Min_Int : constant := -2 ** (Standard'Max_Integer_Size - 1);
- Max_Int : constant := 2 ** (Standard'Max_Integer_Size - 1) - 1;
-
- Max_Binary_Modulus : constant := 2 ** Standard'Max_Integer_Size;
- Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1;
-
- Max_Base_Digits : constant := Long_Long_Float'Digits;
- Max_Digits : constant := Long_Long_Float'Digits;
-
- Max_Mantissa : constant := Standard'Max_Integer_Size - 1;
- Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
-
- Tick : constant := 1.0 / 60.0;
-
- -- Storage-related Declarations
-
- type Address is private;
- pragma Preelaborable_Initialization (Address);
- Null_Address : constant Address;
-
- Storage_Unit : constant := 8;
- Word_Size : constant := 32;
- Memory_Size : constant := 2 ** 32;
-
- -- Address comparison
-
- function "<" (Left, Right : Address) return Boolean;
- function "<=" (Left, Right : Address) return Boolean;
- function ">" (Left, Right : Address) return Boolean;
- function ">=" (Left, Right : Address) return Boolean;
- function "=" (Left, Right : Address) return Boolean;
-
- pragma Import (Intrinsic, "<");
- pragma Import (Intrinsic, "<=");
- pragma Import (Intrinsic, ">");
- pragma Import (Intrinsic, ">=");
- pragma Import (Intrinsic, "=");
-
- -- Other System-Dependent Declarations
-
- type Bit_Order is (High_Order_First, Low_Order_First);
- Default_Bit_Order : constant Bit_Order := High_Order_First;
- pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
-
- -- Priority-related Declarations (RM D.1)
-
- -- Ada priorities are mapped to VxWorks priorities using the following
- -- transformation: 255 - Ada Priority
-
- -- Ada priorities are used as follows:
-
- -- 256 is reserved for the VxWorks kernel
- -- 248 - 255 correspond to hardware interrupt levels 0 .. 7
- -- 247 is a catchall default "interrupt" priority for signals,
- -- allowing higher priority than normal tasks, but lower than
- -- hardware priority levels. Protected Object ceilings can
- -- override these values.
- -- 246 is used by the Interrupt_Manager task
-
- Max_Priority : constant Positive := 245;
- Max_Interrupt_Priority : constant Positive := 255;
-
- subtype Any_Priority is Integer range 0 .. 255;
- subtype Priority is Any_Priority range 0 .. 245;
- subtype Interrupt_Priority is Any_Priority range 246 .. 255;
-
- Default_Priority : constant Priority := 122;
-
-private
-
- type Address is mod Memory_Size;
- Null_Address : constant Address := 0;
-
- --------------------------------------
- -- System Implementation Parameters --
- --------------------------------------
-
- -- These parameters provide information about the target that is used
- -- by the compiler. They are in the private part of System, where they
- -- can be accessed using the special circuitry in the Targparm unit
- -- whose source should be consulted for more detailed descriptions
- -- of the individual switch values.
-
- Backend_Divide_Checks : constant Boolean := False;
- Backend_Overflow_Checks : constant Boolean := True;
- Command_Line_Args : constant Boolean := False;
- Configurable_Run_Time : constant Boolean := False;
- Denorm : constant Boolean := True;
- Duration_32_Bits : constant Boolean := False;
- Exit_Status_Supported : constant Boolean := True;
- Machine_Overflows : constant Boolean := True;
- Machine_Rounds : constant Boolean := True;
- Preallocated_Stacks : constant Boolean := False;
- Signed_Zeros : constant Boolean := True;
- Stack_Check_Default : constant Boolean := False;
- Stack_Check_Probes : constant Boolean := True;
- Stack_Check_Limits : constant Boolean := False;
- Support_Aggregates : constant Boolean := True;
- Support_Composite_Assign : constant Boolean := True;
- Support_Composite_Compare : constant Boolean := True;
- Support_Long_Shifts : constant Boolean := True;
- Always_Compatible_Rep : constant Boolean := False;
- Suppress_Standard_Library : constant Boolean := False;
- Use_Ada_Main_Program_Name : constant Boolean := True;
- Frontend_Exceptions : constant Boolean := False;
- ZCX_By_Default : constant Boolean := False;
-
- Executable_Extension : constant String := ".out";
-
-end System;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- S Y S T E M --
--- --
--- S p e c --
--- (VxWorks 653 x86 vThreads) --
--- --
--- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
--- --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the contents of the part following the private keyword. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This version is for the AE653 vThreads full run-time
-
-package System is
- pragma Pure;
- -- Note that we take advantage of the implementation permission to make
- -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
- -- 2005, this is Pure in any case (AI-362).
-
- pragma No_Elaboration_Code_All;
- -- Allow the use of that restriction in units that WITH this unit
-
- type Name is (SYSTEM_NAME_GNAT);
- System_Name : constant Name := SYSTEM_NAME_GNAT;
-
- -- System-Dependent Named Numbers
-
- Min_Int : constant := -2 ** (Standard'Max_Integer_Size - 1);
- Max_Int : constant := 2 ** (Standard'Max_Integer_Size - 1) - 1;
-
- Max_Binary_Modulus : constant := 2 ** Standard'Max_Integer_Size;
- Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1;
-
- Max_Base_Digits : constant := Long_Long_Float'Digits;
- Max_Digits : constant := Long_Long_Float'Digits;
-
- Max_Mantissa : constant := Standard'Max_Integer_Size - 1;
- Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
-
- Tick : constant := 1.0 / 60.0;
-
- -- Storage-related Declarations
-
- type Address is private;
- pragma Preelaborable_Initialization (Address);
- Null_Address : constant Address;
-
- Storage_Unit : constant := 8;
- Word_Size : constant := 32;
- Memory_Size : constant := 2 ** 32;
-
- -- Address comparison
-
- function "<" (Left, Right : Address) return Boolean;
- function "<=" (Left, Right : Address) return Boolean;
- function ">" (Left, Right : Address) return Boolean;
- function ">=" (Left, Right : Address) return Boolean;
- function "=" (Left, Right : Address) return Boolean;
-
- pragma Import (Intrinsic, "<");
- pragma Import (Intrinsic, "<=");
- pragma Import (Intrinsic, ">");
- pragma Import (Intrinsic, ">=");
- pragma Import (Intrinsic, "=");
-
- -- Other System-Dependent Declarations
-
- type Bit_Order is (High_Order_First, Low_Order_First);
- Default_Bit_Order : constant Bit_Order := Low_Order_First;
- pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
-
- -- Priority-related Declarations (RM D.1)
-
- -- Ada priorities are mapped to VxWorks priorities using the following
- -- transformation: 255 - Ada Priority
-
- -- Ada priorities are used as follows:
-
- -- 256 is reserved for the VxWorks kernel
- -- 248 - 255 correspond to hardware interrupt levels 0 .. 7
- -- 247 is a catchall default "interrupt" priority for signals,
- -- allowing higher priority than normal tasks, but lower than
- -- hardware priority levels. Protected Object ceilings can
- -- override these values.
- -- 246 is used by the Interrupt_Manager task
-
- Max_Priority : constant Positive := 245;
- Max_Interrupt_Priority : constant Positive := 255;
-
- subtype Any_Priority is Integer range 0 .. 255;
- subtype Priority is Any_Priority range 0 .. 245;
- subtype Interrupt_Priority is Any_Priority range 246 .. 255;
-
- Default_Priority : constant Priority := 122;
-
-private
-
- type Address is mod Memory_Size;
- Null_Address : constant Address := 0;
-
- --------------------------------------
- -- System Implementation Parameters --
- --------------------------------------
-
- -- These parameters provide information about the target that is used
- -- by the compiler. They are in the private part of System, where they
- -- can be accessed using the special circuitry in the Targparm unit
- -- whose source should be consulted for more detailed descriptions
- -- of the individual switch values.
-
- Backend_Divide_Checks : constant Boolean := False;
- Backend_Overflow_Checks : constant Boolean := True;
- Command_Line_Args : constant Boolean := False;
- Configurable_Run_Time : constant Boolean := False;
- Denorm : constant Boolean := True;
- Duration_32_Bits : constant Boolean := False;
- Exit_Status_Supported : constant Boolean := True;
- Machine_Overflows : constant Boolean := True;
- Machine_Rounds : constant Boolean := True;
- Preallocated_Stacks : constant Boolean := False;
- Signed_Zeros : constant Boolean := True;
- Stack_Check_Default : constant Boolean := False;
- Stack_Check_Probes : constant Boolean := True;
- Stack_Check_Limits : constant Boolean := False;
- Support_Aggregates : constant Boolean := True;
- Support_Atomic_Primitives : constant Boolean := True;
- Support_Composite_Assign : constant Boolean := True;
- Support_Composite_Compare : constant Boolean := True;
- Support_Long_Shifts : constant Boolean := True;
- Always_Compatible_Rep : constant Boolean := False;
- Suppress_Standard_Library : constant Boolean := False;
- Use_Ada_Main_Program_Name : constant Boolean := True;
- Frontend_Exceptions : constant Boolean := False;
- ZCX_By_Default : constant Boolean := False;
-
- Executable_Extension : constant String := ".out";
-
-end System;