Skip to content

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

a-intnam-os2.ads, [...]: Removed, no longer used. 

	* a-intnam-os2.ads, a-intnam-unixware.ads, g-soccon-unixware.ads,
	g-soliop-unixware.ads, i-os2err.ads, i-os2lib.adb, i-os2lib.ads,
	i-os2syn.ads, i-os2thr.ads, s-intman-irix-athread.adb,
	s-osinte-aix-fsu.ads, s-osinte-fsu.adb, s-parame-os2.adb,
	s-osinte-irix-athread.ads, s-osinte-linux-fsu.ads, s-osinte-os2.adb,
	s-osinte-os2.ads, s-osinte-solaris-fsu.ads, s-osinte-unixware.adb,
	s-osinte-unixware.ads, s-osprim-os2.adb, s-taprop-irix-athread.adb,
	s-taprop-os2.adb, s-tasinf-irix-athread.adb, s-tasinf-irix-athread.ads,
	s-taspri-os2.ads, system-os2.ads, system-unixware.ads: Removed,
	no longer used.

From-SVN: r111021
parent 5b4fdb20
Showing with 0 additions and 2365 deletions
gcc/ada/a-intnam-os2.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . I N T E R R U P T S . N A M E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- --
-- 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 an OS/2 version of this package
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
-- This is a stub, for systems that do not support interrupts (or signals)
package Ada.Interrupts.Names is
end Ada.Interrupts.Names;
gcc/ada/a-intnam-unixware.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . I N T E R R U P T S . N A M E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005, 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 a SCO UnixWare version of this package
-- The following signals are reserved by the run time:
-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
-- SIGWAITING, SIGLWP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF, SIGSTOP, SIGKILL
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
-- SIGINT: made available for Ada handler
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
-- Beware that the mapping of names to signals may be many-to-one. There
-- may be aliases.
SIGHUP : constant Interrupt_ID :=
System.OS_Interface.SIGHUP; -- hangup
SIGINT : constant Interrupt_ID :=
System.OS_Interface.SIGINT; -- interrupt (rubout)
SIGQUIT : constant Interrupt_ID :=
System.OS_Interface.SIGQUIT; -- quit (ASCD FS)
SIGILL : constant Interrupt_ID :=
System.OS_Interface.SIGILL; -- illegal instruction (not reset)
SIGTRAP : constant Interrupt_ID :=
System.OS_Interface.SIGTRAP; -- trace trap (not reset)
SIGIOT : constant Interrupt_ID :=
System.OS_Interface.SIGIOT; -- IOT instruction
SIGABRT : constant Interrupt_ID := -- used by abort,
System.OS_Interface.SIGABRT; -- replace SIGIOT in the future
SIGEMT : constant Interrupt_ID :=
System.OS_Interface.SIGEMT; -- EMT instruction
SIGFPE : constant Interrupt_ID :=
System.OS_Interface.SIGFPE; -- floating point exception
SIGKILL : constant Interrupt_ID :=
System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored)
SIGBUS : constant Interrupt_ID :=
System.OS_Interface.SIGBUS; -- bus error
SIGSEGV : constant Interrupt_ID :=
System.OS_Interface.SIGSEGV; -- segmentation violation
SIGSYS : constant Interrupt_ID :=
System.OS_Interface.SIGSYS; -- bad argument to system call
SIGPIPE : constant Interrupt_ID := -- write on a pipe with
System.OS_Interface.SIGPIPE; -- no one to read it
SIGALRM : constant Interrupt_ID :=
System.OS_Interface.SIGALRM; -- alarm clock
SIGTERM : constant Interrupt_ID :=
System.OS_Interface.SIGTERM; -- software termination signal from kill
SIGUSR1 : constant Interrupt_ID :=
System.OS_Interface.SIGUSR1; -- user defined signal 1
SIGUSR2 : constant Interrupt_ID :=
System.OS_Interface.SIGUSR2; -- user defined signal 2
SIGCLD : constant Interrupt_ID :=
System.OS_Interface.SIGCLD; -- child status change
SIGCHLD : constant Interrupt_ID :=
System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD
SIGPWR : constant Interrupt_ID :=
System.OS_Interface.SIGPWR; -- power-fail restart
SIGWINCH : constant Interrupt_ID :=
System.OS_Interface.SIGWINCH; -- window size change
SIGURG : constant Interrupt_ID :=
System.OS_Interface.SIGURG; -- urgent condition on IO channel
SIGPOLL : constant Interrupt_ID :=
System.OS_Interface.SIGPOLL; -- pollable event occurred
SIGIO : constant Interrupt_ID := -- input/output possible,
System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris)
SIGSTOP : constant Interrupt_ID :=
System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored)
SIGTSTP : constant Interrupt_ID :=
System.OS_Interface.SIGTSTP; -- user stop requested from tty
SIGCONT : constant Interrupt_ID :=
System.OS_Interface.SIGCONT; -- stopped process has been continued
SIGTTIN : constant Interrupt_ID :=
System.OS_Interface.SIGTTIN; -- background tty read attempted
SIGTTOU : constant Interrupt_ID :=
System.OS_Interface.SIGTTOU; -- background tty write attempted
SIGVTALRM : constant Interrupt_ID :=
System.OS_Interface.SIGVTALRM; -- virtual timer expired
SIGPROF : constant Interrupt_ID :=
System.OS_Interface.SIGPROF; -- profiling timer expired
SIGXCPU : constant Interrupt_ID :=
System.OS_Interface.SIGXCPU; -- CPU time limit exceeded
SIGXFSZ : constant Interrupt_ID :=
System.OS_Interface.SIGXFSZ; -- filesize limit exceeded
SIGWAITING : constant Interrupt_ID :=
System.OS_Interface.SIGWAITING; -- process's lwps blocked (Solaris)
SIGLWP : constant Interrupt_ID :=
System.OS_Interface.SIGLWP; -- used by thread library (Solaris)
SIGAIO : constant Interrupt_ID :=
System.OS_Interface.SIGAIO; -- Asynchronous I/O signal
end Ada.Interrupts.Names;
gcc/ada/g-soccon-unixware.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . C O N S T A N T S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2005, 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides target dependent definitions of constant for use
-- by the GNAT.Sockets package (g-socket.ads). This package should not be
-- directly with'ed by an applications program.
-- This is the version for UnixWare
-- Do not edit this file by hand, instead edit and re-run gen-soccon.c
package GNAT.Sockets.Constants is
--------------
-- Families --
--------------
AF_INET : constant := 2; -- IPv4 address family
AF_INET6 : constant := 27; -- IPv6 address family
-----------
-- Modes --
-----------
SOCK_STREAM : constant := 2; -- Stream socket
SOCK_DGRAM : constant := 1; -- Datagram socket
-------------------
-- Socket errors --
-------------------
EACCES : constant := 13; -- Permission denied
EADDRINUSE : constant := 125; -- Address already in use
EADDRNOTAVAIL : constant := 126; -- Cannot assign address
EAFNOSUPPORT : constant := 124; -- Addr family not supported
EALREADY : constant := 149; -- Operation in progress
EBADF : constant := 9; -- Bad file descriptor
ECONNABORTED : constant := 130; -- Connection aborted
ECONNREFUSED : constant := 146; -- Connection refused
ECONNRESET : constant := 131; -- Connection reset by peer
EDESTADDRREQ : constant := 96; -- Destination addr required
EFAULT : constant := 14; -- Bad address
EHOSTDOWN : constant := 147; -- Host is down
EHOSTUNREACH : constant := 148; -- No route to host
EINPROGRESS : constant := 150; -- Operation now in progress
EINTR : constant := 4; -- Interrupted system call
EINVAL : constant := 22; -- Invalid argument
EIO : constant := 5; -- Input output error
EISCONN : constant := 133; -- Socket already connected
ELOOP : constant := 90; -- Too many symbolic lynks
EMFILE : constant := 24; -- Too many open files
EMSGSIZE : constant := 97; -- Message too long
ENAMETOOLONG : constant := 78; -- Name too long
ENETDOWN : constant := 127; -- Network is down
ENETRESET : constant := 129; -- Disconn. on network reset
ENETUNREACH : constant := 128; -- Network is unreachable
ENOBUFS : constant := 132; -- No buffer space available
ENOPROTOOPT : constant := 99; -- Protocol not available
ENOTCONN : constant := 134; -- Socket not connected
ENOTSOCK : constant := 95; -- Operation on non socket
EOPNOTSUPP : constant := 122; -- Operation not supported
EPFNOSUPPORT : constant := 123; -- Unknown protocol family
EPROTONOSUPPORT : constant := 120; -- Unknown protocol
EPROTOTYPE : constant := 98; -- Unknown protocol type
ESHUTDOWN : constant := 143; -- Cannot send once shutdown
ESOCKTNOSUPPORT : constant := 121; -- Socket type not supported
ETIMEDOUT : constant := 145; -- Connection timed out
ETOOMANYREFS : constant := 144; -- Too many references
EWOULDBLOCK : constant := 11; -- Operation would block
-----------------
-- Host errors --
-----------------
HOST_NOT_FOUND : constant := 1; -- Unknown host
TRY_AGAIN : constant := 2; -- Host name lookup failure
NO_DATA : constant := 4; -- No data record for name
NO_RECOVERY : constant := 3; -- Non recoverable errors
-------------------
-- Control flags --
-------------------
FIONBIO : constant := -2147195266; -- Set/clear non-blocking io
FIONREAD : constant := 1074030207; -- How many bytes to read
--------------------
-- Shutdown modes --
--------------------
SHUT_RD : constant := 0; -- No more recv
SHUT_WR : constant := 1; -- No more send
SHUT_RDWR : constant := 2; -- No more recv/send
---------------------
-- Protocol levels --
---------------------
SOL_SOCKET : constant := 65535; -- Options for socket level
IPPROTO_IP : constant := 0; -- Dummy protocol for IP
IPPROTO_UDP : constant := 17; -- UDP
IPPROTO_TCP : constant := 6; -- TCP
-------------------
-- Request flags --
-------------------
MSG_OOB : constant := 1; -- Process out-of-band data
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
--------------------
TCP_NODELAY : constant := 1; -- Do not coalesce packets
SO_SNDBUF : constant := 4097; -- Set/get send buffer size
SO_RCVBUF : constant := 4098; -- Set/get recv buffer size
SO_REUSEADDR : constant := 4; -- Bind reuse local address
SO_KEEPALIVE : constant := 8; -- Enable keep-alive msgs
SO_LINGER : constant := 128; -- Defer close to flush data
SO_ERROR : constant := 4103; -- Get/clear error status
SO_BROADCAST : constant := 32; -- Can send broadcast msgs
IP_ADD_MEMBERSHIP : constant := 11; -- Join a multicast group
IP_DROP_MEMBERSHIP : constant := 12; -- Leave a multicast group
IP_MULTICAST_TTL : constant := 16; -- Set/get multicast TTL
IP_MULTICAST_LOOP : constant := 10; -- Set/get mcast loopback
end GNAT.Sockets.Constants;
gcc/ada/g-soliop-unixware.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . L I N K E R _ O P T I O N S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2005, 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package is used to provide target specific linker_options for the
-- support of scokets as required by the package GNAT.Sockets.
-- This is the UnixWare version of this package
package GNAT.Sockets.Linker_Options is
private
pragma Linker_Options ("-lnsl");
pragma Linker_Options ("-lsocket");
end GNAT.Sockets.Linker_Options;
gcc/ada/i-os2lib.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- I N T E R F A C E S . O S 2 L I B --
-- --
-- B o d y --
-- --
-- Copyright (C) 1993-1999 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Interfaces.OS2Lib.Errors;
package body Interfaces.OS2Lib is
pragma Warnings (Off, Errors);
package IOE renames Interfaces.OS2Lib.Errors;
-------------------
-- Must_Not_Fail --
-------------------
procedure Must_Not_Fail (Return_Code : APIRET) is
begin
pragma Assert (Return_Code = IOE.NO_ERROR);
null;
end Must_Not_Fail;
-----------------------
-- Sem_Must_Not_Fail --
-----------------------
procedure Sem_Must_Not_Fail (Return_Code : OS2Lib.APIRET) is
begin
pragma Assert
(Return_Code = IOE.NO_ERROR
or else
Return_Code = IOE.ERROR_ALREADY_POSTED
or else
Return_Code = IOE.ERROR_ALREADY_RESET);
null;
end Sem_Must_Not_Fail;
end Interfaces.OS2Lib;
gcc/ada/i-os2lib.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- I N T E R F A C E S . O S 2 L I B --
-- --
-- S p e c --
-- --
-- Copyright (C) 1993-2005, 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package (and children) provide interface definitions to the standard
-- OS/2 Library. They are merely a translation of the various <bse*.h> files.
-- It is intended that higher level interfaces (with better names, and
-- stronger typing!) be built on top of this one for Ada (i.e. clean)
-- programming.
-- We have chosen to keep names, types, etc. as close as possible to the
-- C definition to provide easier reference to the documentation. The main
-- exception is when a formal and its type (in C) differed only by the case
-- of letters (like in HMUX hmux). In this case, we have prepended "F_" to
-- the formal (i.e. F_hmux : HMUX).
with Interfaces.C;
with Interfaces.C.Strings;
with System;
package Interfaces.OS2Lib is
pragma Preelaborate;
package IC renames Interfaces.C;
package ICS renames Interfaces.C.Strings;
-------------------
-- General Types --
-------------------
type APIRET is new IC.unsigned_long;
type APIRET16 is new IC.unsigned_short;
subtype APIRET32 is APIRET;
subtype PSZ is ICS.chars_ptr;
subtype PCHAR is ICS.chars_ptr;
subtype PVOID is System.Address;
type PPVOID is access all PVOID;
type BOOL32 is new IC.unsigned_long;
False32 : constant BOOL32 := 0;
True32 : constant BOOL32 := 1;
type UCHAR is new IC.unsigned_char;
type USHORT is new IC.unsigned_short;
type ULONG is new IC.unsigned_long;
type PULONG is access all ULONG;
-- Coprocessor stack register element
type FPREG is record
losig : ULONG; -- Low 32-bits of the mantissa
hisig : ULONG; -- High 32-bits of the mantissa
signexp : USHORT; -- Sign and exponent
end record;
pragma Convention (C, FPREG);
type AULONG is array (IC.size_t range <>) of ULONG;
type AFPREG is array (IC.size_t range <>) of FPREG;
type LHANDLE is new IC.unsigned_long;
NULLHANDLE : constant := 0;
---------------------
-- Time Management --
---------------------
function DosSleep (How_long : ULONG) return APIRET;
pragma Import (C, DosSleep, "DosSleep");
type DATETIME is record
hours : UCHAR;
minutes : UCHAR;
seconds : UCHAR;
hundredths : UCHAR;
day : UCHAR;
month : UCHAR;
year : USHORT;
timezone : IC.short;
weekday : UCHAR;
end record;
type PDATETIME is access all DATETIME;
function DosGetDateTime (pdt : PDATETIME) return APIRET;
pragma Import (C, DosGetDateTime, "DosGetDateTime");
function DosSetDateTime (pdt : PDATETIME) return APIRET;
pragma Import (C, DosSetDateTime, "DosSetDateTime");
----------------------------
-- Miscelleneous Features --
----------------------------
-- Features which do not fit any child
function DosBeep (Freq : ULONG; Dur : ULONG) return APIRET;
pragma Import (C, DosBeep, "DosBeep");
procedure Must_Not_Fail (Return_Code : OS2Lib.APIRET);
pragma Inline (Must_Not_Fail);
-- Many OS/2 functions return APIRET and are not supposed to fail. In C
-- style, these would be called as procedures, disregarding the returned
-- value. This procedure can be used to achieve the same effect with a
-- call of the form: Must_Not_Fail (Some_OS2_Function (...));
procedure Sem_Must_Not_Fail (Return_Code : OS2Lib.APIRET);
pragma Inline (Sem_Must_Not_Fail);
-- Similar to Must_Not_Fail, but used in the case of DosPostEventSem,
-- where the "error" code ERROR_ALREADY_POSTED is not really an error.
end Interfaces.OS2Lib;
gcc/ada/i-os2syn.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- I N T E R F A C E S . O S 2 L I B . S Y N C H R O N I Z A T I O N --
-- --
-- S p e c --
-- --
-- Copyright (C) 1993-2005, 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Interfaces.OS2Lib.Threads;
package Interfaces.OS2Lib.Synchronization is
pragma Preelaborate;
package IC renames Interfaces.C;
package IOT renames Interfaces.OS2Lib.Threads;
package S renames System;
-- Semaphore Attributes
DC_SEM_SHARED : constant := 16#01#;
-- DosCreateMutex, DosCreateEvent, and DosCreateMuxWait use it to indicate
-- whether the semaphore is shared or private when the PSZ is null
SEM_INDEFINITE_WAIT : constant ULONG := -1;
SEM_IMMEDIATE_RETURN : constant ULONG := 0;
type HSEM is new LHANDLE;
type PHSEM is access all HSEM;
type SEMRECORD is record
hsemCur : HSEM;
ulUser : ULONG;
end record;
type PSEMRECORD is access all SEMRECORD;
-- Quad word structure
-- Originally QWORD is defined as a record containing two ULONGS,
-- the first containing low word and the second for the high word,
-- but it is cleaner to define it as follows:
type QWORD is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0;
type PQWORD is access all QWORD;
type HEV is new HSEM;
type PHEV is access all HEV;
type HMTX is new HSEM;
type PHMTX is access all HMTX;
type HMUX is new HSEM;
type PHMUX is access all HMUX;
type HTIMER is new LHANDLE;
type PHTIMER is access all HTIMER;
-----------------------
-- Critical sections --
-----------------------
function DosEnterCritSec return APIRET;
pragma Import (C, DosEnterCritSec, "DosEnterCritSec");
function DosExitCritSec return APIRET;
pragma Import (C, DosExitCritSec, "DosExitCritSec");
--------------
-- EventSem --
--------------
function DosCreateEventSem
(pszName : PSZ;
f_phev : PHEV;
flAttr : ULONG;
fState : BOOL32)
return APIRET;
pragma Import (C, DosCreateEventSem, "DosCreateEventSem");
function DosOpenEventSem
(pszName : PSZ;
F_phev : PHEV)
return APIRET;
pragma Import (C, DosOpenEventSem, "DosOpenEventSem");
function DosCloseEventSem
(F_hev : HEV)
return APIRET;
pragma Import (C, DosCloseEventSem, "DosCloseEventSem");
function DosResetEventSem
(F_hev : HEV;
pulPostCt : PULONG)
return APIRET;
pragma Import (C, DosResetEventSem, "DosResetEventSem");
function DosPostEventSem
(F_hev : HEV)
return APIRET;
pragma Import (C, DosPostEventSem, "DosPostEventSem");
function DosWaitEventSem
(F_hev : HEV;
ulTimeout : ULONG)
return APIRET;
pragma Import (C, DosWaitEventSem, "DosWaitEventSem");
function DosQueryEventSem
(F_hev : HEV;
pulPostCt : PULONG)
return APIRET;
pragma Import (C, DosQueryEventSem, "DosQueryEventSem");
--------------
-- MutexSem --
--------------
function DosCreateMutexSem
(pszName : PSZ;
F_phmtx : PHMTX;
flAttr : ULONG;
fState : BOOL32)
return APIRET;
pragma Import (C, DosCreateMutexSem, "DosCreateMutexSem");
function DosOpenMutexSem
(pszName : PSZ;
F_phmtx : PHMTX)
return APIRET;
pragma Import (C, DosOpenMutexSem, "DosOpenMutexSem");
function DosCloseMutexSem
(F_hmtx : HMTX)
return APIRET;
pragma Import (C, DosCloseMutexSem, "DosCloseMutexSem");
function DosRequestMutexSem
(F_hmtx : HMTX;
ulTimeout : ULONG)
return APIRET;
pragma Import (C, DosRequestMutexSem, "DosRequestMutexSem");
function DosReleaseMutexSem
(F_hmtx : HMTX)
return APIRET;
pragma Import (C, DosReleaseMutexSem, "DosReleaseMutexSem");
function DosQueryMutexSem
(F_hmtx : HMTX;
F_ppid : IOT.PPID;
F_ptid : IOT.PTID;
pulCount : PULONG)
return APIRET;
pragma Import (C, DosQueryMutexSem, "DosQueryMutexSem");
----------------
-- MuxWaitSem --
----------------
function DosCreateMuxWaitSem
(pszName : PSZ;
F_phmux : PHMUX;
cSemRec : ULONG;
pSemRec : PSEMRECORD;
flAttr : ULONG)
return APIRET;
pragma Import (C, DosCreateMuxWaitSem, "DosCreateMuxWaitSem");
DCMW_WAIT_ANY : constant := 16#02#; -- wait on any event/mutex to occur
DCMW_WAIT_ALL : constant := 16#04#; -- wait on all events/mutexes to occur
-- Values for "flAttr" parameter in DosCreateMuxWaitSem call
function DosOpenMuxWaitSem
(pszName : PSZ;
F_phmux : PHMUX)
return APIRET;
pragma Import (C, DosOpenMuxWaitSem, "DosOpenMuxWaitSem");
function DosCloseMuxWaitSem
(F_hmux : HMUX)
return APIRET;
pragma Import (C, DosCloseMuxWaitSem, "DosCloseMuxWaitSem");
function DosWaitMuxWaitSem
(F_hmux : HMUX;
ulTimeout : ULONG;
pulUser : PULONG)
return APIRET;
pragma Import (C, DosWaitMuxWaitSem, "DosWaitMuxWaitSem");
function DosAddMuxWaitSem
(F_hmux : HMUX;
pSemRec : PSEMRECORD)
return APIRET;
pragma Import (C, DosAddMuxWaitSem, "DosAddMuxWaitSem");
function DosDeleteMuxWaitSem
(F_hmux : HMUX;
F_hsem : HSEM)
return APIRET;
pragma Import (C, DosDeleteMuxWaitSem, "DosDeleteMuxWaitSem");
function DosQueryMuxWaitSem
(F_hmux : HMUX;
pcSemRec : PULONG;
pSemRec : PSEMRECORD;
pflAttr : PULONG)
return APIRET;
pragma Import (C, DosQueryMuxWaitSem, "DosQueryMuxWaitSem");
-----------
-- Timer --
-----------
function DosAsyncTimer
(msec : ULONG;
F_hsem : HSEM;
F_phtimer : PHTIMER)
return APIRET;
pragma Import (C, DosAsyncTimer, "DosAsyncTimer");
function DosStartTimer
(msec : ULONG;
F_hsem : HSEM;
F_phtimer : PHTIMER)
return APIRET;
pragma Import (C, DosStartTimer, "DosStartTimer");
function DosStopTimer
(F_htimer : HTIMER)
return APIRET;
pragma Import (C, DosStopTimer, "DosStopTimer");
-- DosTmrQueryTime provides a snapshot of the time
-- from the IRQ0 high resolution timer (Intel 8254)
function DosTmrQueryTime
(pqwTmrTime : access QWORD) -- Time in 8254 ticks (1_192_755.2 Hz)
return APIRET;
pragma Import (C, DosTmrQueryTime, "DosTmrQueryTime");
end Interfaces.OS2Lib.Synchronization;
gcc/ada/i-os2thr.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- I N T E R F A C E S . O S 2 L I B . T H R E A D S --
-- --
-- S p e c --
-- --
-- Copyright (C) 1993-2005, 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Interfaces.C;
package Interfaces.OS2Lib.Threads is
pragma Preelaborate;
package IC renames Interfaces.C;
type PID is new IC.unsigned_long;
type PPID is access all PID;
-- Process ID, and pointer to process ID
type TID is new IC.unsigned_long;
type PTID is access all TID;
-- Thread ID, and pointer to thread ID
-------------------------------------------------------------
-- Thread Creation, Activation, Suspension And Termination --
-------------------------------------------------------------
-- Note: <bsedos.h> defines the "Informations" and "param" parameter below
-- as a ULONG, but everyone knows that in general an address will be passed
-- to it. We declared it here with type PVOID (which it should have had)
-- because Ada is a bit more sensitive to mixing integers and addresses.
type PFNTHREAD is access procedure (Informations : System.Address);
-- TBSL should use PVOID instead of Address as per above node ???
function DosCreateThread
(F_ptid : PTID;
pfn : PFNTHREAD;
param : PVOID;
flag : ULONG;
cbStack : ULONG) return APIRET;
pragma Import (C, DosCreateThread, "DosCreateThread");
Block_Child : constant := 1;
No_Block_Child : constant := 0;
Commit_Stack : constant := 2;
No_Commit_Stack : constant := 0;
-- Values for "flag" parameter in DosCreateThread call
procedure DosExit (Action : ULONG; Result : ULONG);
pragma Import (C, DosExit, "DosExit");
EXIT_THREAD : constant := 0;
EXIT_PROCESS : constant := 1;
-- Values for "Action" parameter in Dos_Exit call
function DosResumeThread (Id : TID) return APIRET;
pragma Import (C, DosResumeThread, "DosResumeThread");
function DosSuspendThread (Id : TID) return APIRET;
pragma Import (C, DosSuspendThread, "DosSuspendThread");
procedure DosWaitThread (Thread_Ptr : PTID; Option : ULONG);
pragma Import (C, DosWaitThread, "DosWaitThread");
function DosKillThread (Id : TID) return APIRET;
pragma Import (C, DosKillThread, "DosKillThread");
DCWW_WAIT : constant := 0;
DCWW_NOWAIT : constant := 1;
-- Values for "Option" parameter in DosWaitThread call
---------------------------------------------------
-- Accessing properties of Threads and Processes --
---------------------------------------------------
-- Structures translated from BSETIB.H
-- Thread Information Block (TIB)
-- Need documentation clarifying distinction between TIB, TIB2 ???
-- GB970409: Changed TIB2 structure, because the tib2_ulprio field
-- is not the actual priority but contains two byte fields
-- that hold the priority class and rank respectively.
-- A proper Ada style record with explicit representation
-- avoids this kind of errors.
type TIB2 is record
Thread_ID : TID;
Prio_Rank : UCHAR;
Prio_Class : UCHAR;
Version : ULONG; -- Version number for this structure
Must_Complete_Count : USHORT; -- Must Complete count
Must_Complete_Force : USHORT; -- Must Complete force flag
end record;
type PTIB2 is access all TIB2;
-- Thread Information Block (TIB)
type TIB is record
tib_pexchain : PVOID; -- Head of exception handler chain
tib_pstack : PVOID; -- Pointer to base of stack
tib_pstacklimit : PVOID; -- Pointer to end of stack
System : PTIB2; -- Pointer to system specific TIB
tib_version : ULONG; -- Version number for this TIB structure
tib_ordinal : ULONG; -- Thread ordinal number
end record;
type PTIB is access all TIB;
-- Process Information Block (PIB)
type PIB is record
pib_ulpid : ULONG; -- Process I.D.
pib_ulppid : ULONG; -- Parent process I.D.
pib_hmte : ULONG; -- Program (.EXE) module handle
pib_pchcmd : PCHAR; -- Command line pointer
pib_pchenv : PCHAR; -- Environment pointer
pib_flstatus : ULONG; -- Process' status bits
pib_ultype : ULONG; -- Process' type code
end record;
type PPIB is access all PIB;
function DosGetInfoBlocks
(Pptib : access PTIB;
Pppib : access PPIB) return APIRET;
pragma Import (C, DosGetInfoBlocks, "DosGetInfoBlocks");
-- Thread local memory
-- This function allocates a block of memory that is unique, or local, to
-- a thread.
function DosAllocThreadLocalMemory
(cb : ULONG; -- Number of 4-byte DWORDs to allocate
p : access PVOID) -- Address of the memory block
return APIRET; -- Return Code (rc)
pragma Import
(Convention => C,
Entity => DosAllocThreadLocalMemory,
Link_Name => "_DosAllocThreadLocalMemory");
----------------
-- Priorities --
----------------
function DosSetPriority
(Scope : ULONG;
Class : ULONG;
Delta_P : IC.long;
PorTid : TID) return APIRET;
pragma Import (C, DosSetPriority, "DosSetPriority");
PRTYS_PROCESS : constant := 0;
PRTYS_PROCESSTREE : constant := 1;
PRTYS_THREAD : constant := 2;
-- Values for "Scope" parameter in DosSetPriority call
PRTYC_NOCHANGE : constant := 0;
PRTYC_IDLETIME : constant := 1;
PRTYC_REGULAR : constant := 2;
PRTYC_TIMECRITICAL : constant := 3;
PRTYC_FOREGROUNDSERVER : constant := 4;
-- Values for "class" parameter in DosSetPriority call
end Interfaces.OS2Lib.Threads;
gcc/ada/s-intman-irix-athread.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T --
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- --
-- 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 an Irix (old pthread library) version of this package.
-- Make a careful study of all signals available under the OS,
-- to see which need to be reserved, kept always unmasked,
-- or kept always unmasked.
-- Be on the lookout for special signals that
-- may be used by the thread library.
with System.OS_Interface;
-- used for various Constants, Signal and types
with Interfaces.C;
-- used for "int"
package body System.Interrupt_Management is
use System.OS_Interface;
type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
Exception_Interrupts : constant Interrupt_List :=
(SIGILL,
SIGABRT,
SIGFPE,
SIGSEGV,
SIGBUS);
Reserved_Interrupts : constant Interrupt_List :=
(0,
SIGTRAP,
SIGKILL,
SIGSYS,
SIGALRM,
SIGSTOP,
SIGPTINTR,
SIGPTRESCHED);
Abort_Signal : constant := 48;
--
-- Serious MOJO: The SGI pthreads library only supports the
-- unnamed signal number 48 for pthread_kill!
--
Unreserve_All_Interrupts : Interfaces.C.int;
pragma Import
(C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
function State (Int : Interrupt_ID) return Character;
pragma Import (C, State, "__gnat_get_interrupt_state");
-- Get interrupt state. Defined in a-init.c
-- The input argument is the interrupt number,
-- and the result is one of the following:
User : constant Character := 'u';
Runtime : constant Character := 'r';
Default : constant Character := 's';
-- 'n' this interrupt not set by any Interrupt_State pragma
-- 'u' Interrupt_State pragma set state to User
-- 'r' Interrupt_State pragma set state to Runtime
-- 's' Interrupt_State pragma set state to System (use "default"
-- system handler)
----------------
-- Initialize --
----------------
procedure Initialize is
use Interfaces.C;
begin
Abort_Task_Interrupt := Abort_Signal;
pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False));
pragma Assert (Reserve = (Interrupt_ID'Range => False));
-- Process state of exception signals
for J in Exception_Interrupts'Range loop
if State (Exception_Interrupts (J)) /= User then
Keep_Unmasked (Exception_Interrupts (J)) := True;
Reserve (Exception_Interrupts (J)) := True;
end if;
end loop;
if State (Abort_Task_Interrupt) /= User then
Keep_Unmasked (Abort_Task_Interrupt) := True;
Reserve (Abort_Task_Interrupt) := True;
end if;
-- Set SIGINT to unmasked state as long as it's
-- not in "User" state. Check for Unreserve_All_Interrupts last
if State (SIGINT) /= User then
Keep_Unmasked (SIGINT) := True;
end if;
-- Check all signals for state that requires keeping them
-- unmasked and reserved
for J in Interrupt_ID'Range loop
if State (J) = Default or else State (J) = Runtime then
Keep_Unmasked (J) := True;
Reserve (J) := True;
end if;
end loop;
-- Add target-specific reserved signals
for J in Reserved_Interrupts'Range loop
Reserve (Interrupt_ID (Reserved_Interrupts (J))) := True;
end loop;
-- Process pragma Unreserve_All_Interrupts. This overrides any
-- settings due to pragma Interrupt_State:
if Unreserve_All_Interrupts /= 0 then
Keep_Unmasked (SIGINT) := False;
Reserve (SIGINT) := False;
end if;
-- We do not have Signal 0 in reality. We just use this value
-- to identify not existing signals (see s-intnam.ads). Therefore,
-- Signal 0 should not be used in all signal related operations hence
-- mark it as reserved.
Reserve (0) := True;
end Initialize;
end System.Interrupt_Management;
gcc/ada/s-osinte-os2.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- --
-- 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 OS/2 version of this package
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.
with Interfaces.OS2Lib.Errors;
with Interfaces.OS2Lib.Synchronization;
package body System.OS_Interface is
use Interfaces;
use Interfaces.OS2Lib;
use Interfaces.OS2Lib.Synchronization;
use Interfaces.OS2Lib.Errors;
-----------
-- Yield --
-----------
-- Give up the remainder of the time-slice and yield the processor
-- to other threads of equal priority. Yield will return immediately
-- without giving up the current time-slice when the only threads
-- that are ready have a lower priority.
-- ??? Just giving up the current time-slice seems not to be enough
-- to get the thread to the end of the ready queue if OS/2 does use
-- a queue at all. As a partial work-around, we give up two time-slices.
-- This is the best we can do now, and at least is sufficient for passing
-- the ACVC 2.0.1 Annex D tests.
procedure Yield is
begin
Delay_For (0);
Delay_For (0);
end Yield;
---------------
-- Delay_For --
---------------
procedure Delay_For (Period : in Duration_In_Millisec) is
Result : APIRET;
begin
pragma Assert (Period >= 0, "GNULLI---Delay_For: negative argument");
-- ??? DosSleep is not the appropriate function for a delay in real
-- time. It only gives up some number of scheduled time-slices.
-- Use a timer instead or block for some semaphore with a time-out.
Result := DosSleep (ULONG (Period));
if Result = ERROR_TS_WAKEUP then
-- Do appropriate processing for interrupted sleep
-- Can we raise an exception here?
null;
end if;
pragma Assert (Result = NO_ERROR, "GNULLI---Error in Delay_For");
end Delay_For;
-----------
-- Clock --
-----------
function Clock return Duration is
-- Implement conversion from tick count to Duration
-- using fixed point arithmetic. The frequency of
-- the Intel 8254 timer chip is 18.2 * 2**16 Hz.
Tick_Duration : constant := 1.0 / (18.2 * 2**16);
Tick_Count : aliased QWORD;
begin
-- Read nr of clock ticks since boot time
Must_Not_Fail (DosTmrQueryTime (Tick_Count'Access));
return Tick_Count * Tick_Duration;
end Clock;
end System.OS_Interface;
gcc/ada/s-osinte-os2.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, 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 OS/2 version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- 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;
package System.OS_Interface is
pragma Preelaborate;
package C renames Interfaces.C;
subtype int is C.int;
subtype unsigned_long is C.unsigned_long;
type Duration_In_Millisec is new C.long;
-- New type to prevent confusing time functions in this package
-- with time functions returning seconds or other units.
type Thread_Id is new unsigned_long;
-----------
-- Errno --
-----------
function errno return int;
pragma Import (C, errno, "__get_errno");
EAGAIN : constant := 5;
EINTR : constant := 13;
EINVAL : constant := 14;
ENOMEM : constant := 25;
-------------
-- Signals --
-------------
Max_Interrupt : constant := 15;
type Signal is new int range 0 .. Max_Interrupt;
-- Signals for OS/2, only SIGTERM used currently. The values are
-- fake, since OS/2 uses 32 bit exception numbers that cannot be
-- used to index arrays etc. The GNULLI maps these Unix-like signals
-- to OS/2 exception numbers.
-- SIGTERM is used for the abort interrupt.
SIGHUP : constant := 1; -- hangup
SIGINT : constant := 2; -- interrupt (rubout)
SIGQUIT : constant := 3; -- quit (ASCD FS)
SIGILL : constant := 4; -- illegal instruction (not reset)
SIGTRAP : constant := 5; -- trace trap (not reset)
SIGIOT : constant := 6; -- IOT instruction
SIGEMT : constant := 0; -- EMT instruction
SIGFPE : constant := 8; -- floating point exception
SIGKILL : constant := 9; -- kill (cannot be caught or ignored)
SIGBUS : constant := 10; -- bus error
SIGSEGV : constant := 11; -- segmentation violation
SIGSYS : constant := 12; -- bad argument to system call
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
subtype sigset_t is unsigned_long;
----------
-- Time --
----------
function Clock return Duration;
pragma Inline (Clock);
-- Clock measuring time since the epoch, which is the boot-time.
-- The clock resolution is approximately 838 ns.
procedure Delay_For (Period : in Duration_In_Millisec);
pragma Inline (Delay_For);
-- Changed Sleep to Delay_For, for consistency with System.Time_Operations
----------------
-- Scheduling --
----------------
-- Put the calling task at the end of the ready queue for its priority
procedure Yield;
pragma Inline (Yield);
end System.OS_Interface;
gcc/ada/s-osinte-unixware.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2005 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 a UnixWare (Native) version of this package
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.
with Interfaces.C;
package body System.OS_Interface is
use Interfaces.C;
-----------------
-- To_Duration --
-----------------
function To_Duration (TS : timespec) return Duration is
begin
return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
end To_Duration;
function To_Duration (TV : struct_timeval) return Duration is
begin
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
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 has negative value due to a round-up, adjust for positive F
-- value.
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return timespec'(tv_sec => S,
tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
----------------
-- To_Timeval --
----------------
function To_Timeval (D : Duration) return struct_timeval is
S : long;
F : Duration;
begin
S := long (Long_Long_Integer (D));
F := D - Duration (S);
-- If F has negative value due to a round-up, adjust for positive F
-- value.
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return
struct_timeval'
(tv_sec => S,
tv_usec => long (Long_Long_Integer (F * 10#1#E6)));
end To_Timeval;
-------------------
-- clock_gettime --
-------------------
function clock_gettime
(clock_id : clockid_t;
tp : access timespec)
return int
is
pragma Warnings (Off, clock_id);
Result : int;
tv : aliased struct_timeval;
function gettimeofday
(tv : access struct_timeval;
tz : System.Address := System.Null_Address)
return int;
pragma Import (C, gettimeofday, "gettimeofday");
begin
Result := gettimeofday (tv'Unchecked_Access);
tp.all := To_Timespec (To_Duration (tv));
return Result;
end clock_gettime;
---------------------------
-- POSIX.1c Section 3 --
---------------------------
function sigwait (set : access sigset_t; sig : access Signal) return int is
Result : int;
function sigwait (set : access sigset_t) return int;
pragma Import (C, sigwait, "sigwait");
begin
Result := sigwait (set);
if Result < 0 then
sig.all := 0;
return errno;
end if;
sig.all := Signal (Result);
return 0;
end sigwait;
function pthread_kill (thread : pthread_t; sig : Signal) return int is
function pthread_kill_base
(thread : access pthread_t; sig : access Signal) return int;
pragma Import (C, pthread_kill_base, "pthread_kill");
thr : aliased pthread_t := thread;
signo : aliased Signal := sig;
begin
return pthread_kill_base (thr'Unchecked_Access, signo'Unchecked_Access);
end pthread_kill;
function Get_Stack_Base (thread : pthread_t) return Address is
pragma Warnings (Off, thread);
begin
return Null_Address;
end Get_Stack_Base;
procedure pthread_init is
begin
null;
end pthread_init;
end System.OS_Interface;
gcc/ada/s-osprim-os2.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- 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-2005 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 OS/2 version of this package
with Interfaces.C; use Interfaces.C;
with Interfaces.OS2Lib; use Interfaces.OS2Lib;
with Interfaces.OS2Lib.Synchronization; use Interfaces.OS2Lib.Synchronization;
package body System.OS_Primitives is
----------------
-- Local Data --
----------------
Epoch_Offset : Duration; -- See Set_Epoch_Offset
Max_Tick_Count : QWORD := 0.0;
-- This is needed to compensate for small glitches in the
-- hardware clock or the way it is read by the OS
-----------------------
-- Local Subprograms --
-----------------------
procedure Set_Epoch_Offset;
-- Initializes the Epoch_1970_Offset to the offset of the System_Clock
-- relative to the Unix epoch (Jan 1, 1970), such that
-- Clock = System_Clock + Epoch_1970_Offset
function System_Clock return Duration;
pragma Inline (System_Clock);
-- Function returning value of system clock with system-dependent timebase.
-- For OS/2 the system clock returns the elapsed time since system boot.
-- The clock resolution is approximately 838 ns.
------------------
-- System_Clock --
------------------
function System_Clock return Duration is
-- Implement conversion from tick count to Duration
-- using fixed point arithmetic. The frequency of
-- the Intel 8254 timer chip is 18.2 * 2**16 Hz.
Tick_Duration : constant := 1.0 / (18.2 * 2**16);
Tick_Count : aliased QWORD;
begin
Must_Not_Fail (DosTmrQueryTime (Tick_Count'Access));
-- Read nr of clock ticks since boot time
Max_Tick_Count := QWORD'Max (Tick_Count, Max_Tick_Count);
return Max_Tick_Count * Tick_Duration;
end System_Clock;
-----------
-- Clock --
-----------
function Clock return Duration is
begin
return System_Clock + Epoch_Offset;
end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
----------------------
-- Set_Epoch_Offset --
----------------------
procedure Set_Epoch_Offset is
-- Interface to Unix C style gettimeofday
type timeval is record
tv_sec : long;
tv_usec : long;
end record;
procedure gettimeofday
(time : access timeval;
zone : System.Address := System.Address'Null_Parameter);
pragma Import (C, gettimeofday);
Time_Of_Day : aliased timeval;
Micro_To_Nano : constant := 1.0E3;
Sec_To_Nano : constant := 1.0E9;
Nanos_Since_Epoch : QWORD;
begin
gettimeofday (Time_Of_Day'Access);
Nanos_Since_Epoch := QWORD (Time_Of_Day.tv_sec) * Sec_To_Nano
+ QWORD (Time_Of_Day.tv_usec) * Micro_To_Nano;
Epoch_Offset :=
Duration'(Nanos_Since_Epoch / Sec_To_Nano) - System_Clock;
end Set_Epoch_Offset;
-----------------
-- Timed_Delay --
-----------------
procedure Timed_Delay
(Time : Duration;
Mode : Integer)
is
Rel_Time : Duration;
Abs_Time : Duration;
Check_Time : Duration := Clock;
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
Must_Not_Fail (DosSleep (ULONG (Rel_Time * 1000.0)));
Check_Time := Clock;
exit when Abs_Time <= Check_Time;
Rel_Time := Abs_Time - Check_Time;
end loop;
end if;
end Timed_Delay;
----------------
-- Initialize --
----------------
Initialized : Boolean := False;
procedure Initialize is
begin
if not Initialized then
Initialized := True;
Set_Epoch_Offset;
end if;
end Initialize;
end System.OS_Primitives;
gcc/ada/s-parame-os2.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . P A R A M E T E R S --
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2002 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the OS/2 specific version - default stacksizes need to be large
package body System.Parameters is
------------------------
-- Default_Stack_Size --
------------------------
function Default_Stack_Size return Size_Type is
begin
-- The default stack size for extra tasks is based on the
-- default stack size for the main task (8 MB) and for the heap
-- (32 MB).
-- In OS/2 it doesn't hurt to define large stacks, unless
-- the system is configured to commit all memory reservations.
-- This is not a default configuration however.
return 1024 * 1024;
end Default_Stack_Size;
------------------------
-- Minimum_Stack_Size --
------------------------
function Minimum_Stack_Size return Size_Type is
begin
-- System functions may need 8 kB of stack, so 12 kB seems a
-- good minimum.
return 12 * 1024;
end Minimum_Stack_Size;
-------------------------
-- Adjust_Storage_Size --
-------------------------
function Adjust_Storage_Size (Size : Size_Type) return Size_Type is
begin
if Size = Unspecified_Size then
return Default_Stack_Size;
elsif Size < Minimum_Stack_Size then
return Minimum_Stack_Size;
else
return Size;
end if;
end Adjust_Storage_Size;
end System.Parameters;
gcc/ada/s-taspri-os2.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K _ P R I M I T I V E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- --
-- 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 an OS/2 version of this package
-- This package provides low-level support for most tasking features
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.
with Interfaces.OS2Lib.Threads;
with Interfaces.OS2Lib.Synchronization;
package System.Task_Primitives is
pragma Preelaborate;
type Lock is limited private;
-- Should be used for implementation of protected objects.
type RTS_Lock is limited private;
-- Should be used inside the runtime system.
-- The difference between Lock and the RTS_Lock is that the later
-- one serves only as a semaphore so that do not check for
-- ceiling violations.
type Task_Body_Access is access procedure;
-- Pointer to the task body's entry point (or possibly a wrapper
-- declared local to the GNARL).
type Private_Data is limited private;
-- Any information that the GNULLI needs maintained on a per-task
-- basis. A component of this type is guaranteed to be included
-- in the Ada_Task_Control_Block.
private
type Lock is record
Mutex : aliased Interfaces.OS2Lib.Synchronization.HMTX;
Priority : Integer;
Owner_Priority : Integer;
Owner_ID : Address;
end record;
type RTS_Lock is new Lock;
type Suspension_Object is record
State : Boolean;
pragma Atomic (State);
-- Boolean that indicates whether the object is open. This field is
-- marked Atomic to ensure that we can read its value without locking
-- the access to the Suspension_Object.
Waiting : Boolean;
-- Flag showing if there is a task already suspended on this object
L : aliased Interfaces.OS2Lib.Synchronization.HMTX;
-- Protection for ensuring mutual exclusion on the Suspension_Object
CV : aliased Interfaces.OS2Lib.Synchronization.HEV;
-- Condition variable used to queue threads until condition is signaled
end record;
type Private_Data is record
Thread : aliased Interfaces.OS2Lib.Threads.TID;
pragma Atomic (Thread);
-- Thread field may be updated by two different threads of control.
-- (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
-- value (thr_self value). We do not want to use lock on those
-- operations and the only thing we have to make sure is that they are
-- updated in atomic fashion.
CV : aliased Interfaces.OS2Lib.Synchronization.HEV;
L : aliased RTS_Lock;
-- Protection for all components is lock L
Current_Priority : Integer := -1;
-- The Current_Priority is the actual priority of a thread. This field
-- is needed because it is only possible to set delta priority in OS/2.
-- The only places where this field should be set are Set_Priority,
-- Create_Task and Initialize (Environment).
Wrapper : Interfaces.OS2Lib.Threads.PFNTHREAD;
-- This is the original wrapper passed by Operations.Create_Task. When
-- installing an exception handler in a thread, the thread starts
-- executing the Exception_Wrapper which calls Wrapper when the handler
-- has been installed. The handler is removed when wrapper returns.
end record;
end System.Task_Primitives;
gcc/ada/system-os2.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M --
-- --
-- S p e c --
-- (OS/2 Version) --
-- --
-- Copyright (C) 1992-2005, 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
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).
type Name is (SYSTEM_NAME_GNAT);
System_Name : constant Name := SYSTEM_NAME_GNAT;
-- System-Dependent Named Numbers
Min_Int : constant := Long_Long_Integer'First;
Max_Int : constant := Long_Long_Integer'Last;
Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size;
Max_Nonbinary_Modulus : constant := Integer'Last;
Max_Base_Digits : constant := Long_Long_Float'Digits;
Max_Digits : constant := Long_Long_Float'Digits;
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := 0.01;
-- Storage-related Declarations
type Address is private;
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;
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer range 0 .. 31;
subtype Priority is Any_Priority range 0 .. 30;
subtype Interrupt_Priority is Any_Priority range 31 .. 31;
Default_Priority : constant Priority := 15;
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.
AAMP : constant Boolean := False;
Backend_Divide_Checks : constant Boolean := False;
Backend_Overflow_Checks : constant Boolean := False;
Command_Line_Args : constant Boolean := True;
Compiler_System_Version : 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;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Machine_Overflows : constant Boolean := False;
Machine_Rounds : constant Boolean := True;
OpenVMS : constant Boolean := False;
Preallocated_Stacks : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
GCC_ZCX_Support : constant Boolean := False;
Front_End_ZCX_Support : constant Boolean := True;
-- Obsolete entries, to be removed eventually (bootstrap issues!)
High_Integrity_Mode : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
end System;
gcc/ada/system-unixware.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M --
-- --
-- S p e c --
-- (SCO UnixWare Version) --
-- --
-- Copyright (C) 1992-2005, 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
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).
type Name is (SYSTEM_NAME_GNAT);
System_Name : constant Name := SYSTEM_NAME_GNAT;
-- System-Dependent Named Numbers
Min_Int : constant := Long_Long_Integer'First;
Max_Int : constant := Long_Long_Integer'Last;
Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size;
Max_Nonbinary_Modulus : constant := Integer'Last;
Max_Base_Digits : constant := Long_Long_Float'Digits;
Max_Digits : constant := Long_Long_Float'Digits;
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := 0.01;
-- Storage-related Declarations
type Address is private;
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;
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer range 0 .. 31;
subtype Priority is Any_Priority range 0 .. 30;
subtype Interrupt_Priority is Any_Priority range 31 .. 31;
Default_Priority : constant Priority := 15;
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.
AAMP : constant Boolean := False;
Backend_Divide_Checks : constant Boolean := False;
Backend_Overflow_Checks : constant Boolean := False;
Command_Line_Args : constant Boolean := True;
Compiler_System_Version : 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;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Machine_Overflows : constant Boolean := False;
Machine_Rounds : constant Boolean := True;
OpenVMS : constant Boolean := False;
Preallocated_Stacks : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
GCC_ZCX_Support : constant Boolean := False;
Front_End_ZCX_Support : constant Boolean := False;
-- Obsolete entries, to be removed eventually (bootstrap issues!)
High_Integrity_Mode : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
end System;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment