Skip to content

R
riscv-gcc-1
Commit 07fc65c4 by Geert Bosch
Options

41intnam.ads, [...]: Merge in ACT changes. 

	* 41intnam.ads, 42intnam.ads, 4aintnam.ads, 4cintnam.ads,
	4dintnam.ads, 4gintnam.ads, 4hintnam.ads, 4lintnam.ads,
	4mintnam.ads, 4pintnam.ads, 4rintnam.ads, 4sintnam.ads,
	4uintnam.ads, 4vcalend.adb, 4zintnam.ads, 52system.ads,
	5amastop.adb, 5asystem.ads, 5ataprop.adb, 5atpopsp.adb,
	5avxwork.ads, 5bosinte.adb, 5bsystem.ads, 5esystem.ads,
	5fsystem.ads, 5ftaprop.adb, 5ginterr.adb, 5gmastop.adb,
	5gsystem.ads, 5gtaprop.adb, 5gtasinf.adb, 5gtasinf.ads,
	5hparame.ads, 5hsystem.ads, 5htaprop.adb, 5htraceb.adb,
	5itaprop.adb, 5ksystem.ads, 5kvxwork.ads, 5lintman.adb,
	5lsystem.ads, 5mvxwork.ads, 5ninmaop.adb, 5nosinte.ads,
	5ntaprop.adb, 5ointerr.adb, 5omastop.adb, 5oosinte.adb,
	5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5pvxwork.ads,
	5qtaprop.adb, 5sintman.adb, 5ssystem.ads, 5staprop.adb,
	5stpopse.adb, 5svxwork.ads, 5tosinte.ads, 5uintman.adb,
	5vasthan.adb, 5vinmaop.adb, 5vinterr.adb, 5vintman.adb,
	5vmastop.adb, 5vparame.ads, 5vsystem.ads, 5vtaprop.adb,
	5vtpopde.adb, 5wmemory.adb, 5wsystem.ads, 5wtaprop.adb,
	5ysystem.ads, 5zinterr.adb, 5zintman.adb, 5zosinte.adb,
	5zosinte.ads, 5zsystem.ads, 5ztaprop.adb, 6vcpp.adb, 6vcstrea.adb,
	7sintman.adb, 7staprop.adb, 7stpopsp.adb, 9drpc.adb,
	Make-lang.in, Makefile.in, a-caldel.adb, a-comlin.ads,
	a-dynpri.adb, a-except.adb, a-except.ads, a-finali.adb,
	a-ncelfu.ads, a-reatim.adb, a-retide.adb, a-stream.ads,
	a-ststio.adb, a-ststio.ads, a-stwifi.adb, a-tags.adb, a-tasatt.adb,
	a-textio.adb, a-tideau.adb, a-tiflau.adb, a-tigeau.adb,
	a-tigeau.ads, a-tiinau.adb, a-timoau.adb, a-witeio.adb,
	a-wtdeau.adb, a-wtenau.adb, a-wtflau.adb, a-wtgeau.adb,
	a-wtgeau.ads, a-wtinau.adb, a-wtmoau.adb, ada-tree.def, ada-tree.h,
	adaint.c, adaint.h, ali-util.adb, ali.adb, ali.ads, atree.adb,
	atree.ads, atree.h, back_end.adb, bcheck.adb, bindgen.adb,
	bindusg.adb, checks.adb, comperr.adb, config-lang.in, csets.adb,
	csets.ads, cstand.adb, cstreams.c, debug.adb, debug.ads, decl.c,
	einfo.adb, einfo.ads, einfo.h, elists.h, errout.adb, errout.ads,
	eval_fat.adb, exp_aggr.adb, exp_attr.adb, exp_ch11.adb,
	exp_ch12.adb, exp_ch13.adb, exp_ch2.adb, exp_ch3.adb, exp_ch3.ads,
	exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_ch7.ads,
	exp_ch9.adb, exp_ch9.ads, exp_dbug.adb, exp_dbug.ads, exp_disp.ads,
	exp_dist.adb, exp_fixd.adb, exp_intr.adb, exp_pakd.adb,
	exp_prag.adb, exp_strm.adb, exp_util.adb, exp_util.ads,
	expander.adb, expect.c, fe.h, fmap.adb, fmap.ads, fname-uf.adb,
	freeze.adb, frontend.adb, g-awk.adb, g-cgideb.adb, g-comlin.adb,
	g-comlin.ads, g-debpoo.adb, g-dirope.adb, g-dirope.ads,
	g-dyntab.adb, g-expect.adb, g-expect.ads, g-io.ads, g-io_aux.adb,
	g-io_aux.ads, g-locfil.adb, g-locfil.ads, g-os_lib.adb,
	g-os_lib.ads, g-regexp.adb, g-regpat.adb, g-socket.adb,
	g-socket.ads, g-spipat.adb, g-table.adb, g-trasym.adb,
	g-trasym.ads, gigi.h, gmem.c, gnat1drv.adb, gnatbind.adb, gnatbl.c,
	gnatchop.adb, gnatcmd.adb, gnatdll.adb, gnatfind.adb, gnatlbr.adb,
	gnatlink.adb, gnatls.adb, gnatmem.adb, gnatprep.adb, gnatvsn.ads,
	gnatxref.adb, hlo.adb, hostparm.ads, i-cobol.adb, i-cpp.adb,
	i-cstrea.ads, i-cstrin.adb, i-pacdec.adb, i-vxwork.ads,
	impunit.adb, init.c, inline.adb, io-aux.c, layout.adb, lib-load.adb,
	lib-util.adb, lib-writ.adb, lib-writ.ads, lib-xref.adb,
	lib-xref.ads, lib.adb, lib.ads, make.adb, makeusg.adb, mdll.adb,
	memroot.adb, misc.c, mlib-tgt.adb, mlib-utl.adb, mlib-utl.ads,
	mlib.adb, namet.adb, namet.ads, namet.h, nlists.h, nmake.adb,
	nmake.ads, nmake.adt, opt.adb, opt.ads, osint.adb, osint.ads,
	output.adb, output.ads, par-ch2.adb, par-ch3.adb, par-ch5.adb,
	par-prag.adb, par-tchk.adb, par-util.adb, par.adb, prj-attr.adb,
	prj-dect.adb, prj-env.adb, prj-env.ads, prj-nmsc.adb, prj-part.adb,
	prj-proc.adb, prj-strt.adb, prj-tree.adb, prj-tree.ads, prj.adb,
	prj.ads, raise.c, raise.h, repinfo.adb, restrict.adb, restrict.ads,
	rident.ads, rtsfind.adb, rtsfind.ads, s-arit64.adb, s-asthan.adb,
	s-atacco.adb, s-atacco.ads, s-auxdec.adb, s-crc32.adb, s-crc32.ads,
	s-direio.adb, s-fatgen.adb, s-fileio.adb, s-finimp.adb,
	s-gloloc.adb, s-gloloc.ads, s-interr.adb, s-mastop.adb,
	s-mastop.ads, s-memory.adb, s-parame.ads, s-parint.adb,
	s-pooglo.adb, s-pooloc.adb, s-rpc.adb, s-secsta.adb, s-sequio.adb,
	s-shasto.adb, s-soflin.adb, s-soflin.ads, s-stache.adb,
	s-taasde.adb, s-taasde.ads, s-tadeca.adb, s-tadeca.ads,
	s-tadert.adb, s-tadert.ads, s-taenca.adb, s-taenca.ads,
	s-taprob.adb, s-taprop.ads, s-tarest.adb, s-tasdeb.adb,
	s-tasini.adb, s-tasini.ads, s-taskin.adb, s-taskin.ads,
	s-tasque.adb, s-tasque.ads, s-tasren.adb, s-tasren.ads,
	s-tassta.adb, s-tasuti.adb, s-tasuti.ads, s-tataat.adb,
	s-tataat.ads, s-tpoben.adb, s-tpoben.ads, s-tpobop.adb,
	s-tposen.adb, s-tposen.ads, s-traceb.adb, s-traceb.ads,
	s-unstyp.ads, s-widenu.adb, scn-nlit.adb, scn.adb, sem.adb,
	sem_aggr.adb, sem_attr.adb, sem_attr.ads, sem_case.adb,
	sem_ch10.adb, sem_ch11.adb, sem_ch11.ads, sem_ch12.adb,
	sem_ch13.adb, sem_ch13.ads, sem_ch2.adb, sem_ch3.adb, sem_ch3.ads,
	sem_ch4.adb, sem_ch5.adb, sem_ch6.adb, sem_ch6.ads, sem_ch7.adb,
	sem_ch8.adb, sem_ch8.ads, sem_ch9.adb, sem_disp.adb, sem_dist.adb,
	sem_elab.adb, sem_elim.adb, sem_elim.ads, sem_eval.adb,
	sem_intr.adb, sem_mech.adb, sem_prag.adb, sem_res.adb,
	sem_type.adb, sem_util.adb, sem_util.ads, sem_vfpt.adb,
	sem_warn.adb, sinfo.adb, sinfo.ads, sinfo.h, sinput-l.adb,
	sinput-l.ads, sinput.adb, sinput.ads, snames.adb, snames.ads,
	snames.h, sprint.adb, sprint.ads, stringt.adb, stringt.ads,
	stringt.h, style.adb, switch.adb, switch.ads, sysdep.c, system.ads,
	table.adb, targparm.adb, targparm.ads, targtyps.c, tbuild.adb,
	tbuild.ads, tracebak.c, trans.c, tree_gen.adb, tree_io.adb,
	treepr.adb, treepr.ads, treeprs.ads, treeprs.adt, ttypes.ads,
	types.adb, types.ads, types.h, uintp.ads, urealp.ads, usage.adb,
	utils.c, utils2.c, validsw.adb, xnmake.adb, xr_tabls.adb,
	xr_tabls.ads, xref_lib.adb, xref_lib.ads : Merge in ACT changes.

	* 1ssecsta.adb, 1ssecsta.ads, a-chlat9.ads, a-cwila9.ads,
	g-enblsp.adb, g-md5.adb, g-md5.ads, gnatname.adb, gnatname.ads,
	mkdir.c, osint-b.adb, osint-b.ads, osint-c.adb, osint-c.ads,
	osint-l.adb, osint-l.ads, osint-m.adb, osint-m.ads : New files

	* 3lsoccon.ads, 5qparame.ads, 5qvxwork.ads, 5smastop.adb,
	5zparame.ads, gnatmain.adb, gnatmain.ads, gnatpsys.adb : Removed

	* mdllfile.adb, mdllfile.ads, mdlltool.adb, mdlltool.ads : Renamed
	to mdll-fil.ad[bs] and mdll-util.ad[bs]

	* mdll-fil.adb, mdll-fil.ads, mdll-utl.adb, mdll-utl.ads : Renamed
	from mdllfile.ad[bs] and mdlltool.ad[bs]

From-SVN: r50451
parent 24965e7a
Showing with 998 additions and 1885 deletions
gcc/ada/1ssecsta.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C O N D A R Y _ S T A C K --
-- --
-- B o d y --
-- --
-- $Revision$
-- --
-- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the HI-E version of this package.
with Unchecked_Conversion;
package body System.Secondary_Stack is
use type SSE.Storage_Offset;
type Memory is array (Mark_Id range <>) of SSE.Storage_Element;
type Stack_Id is record
Top : Mark_Id;
Last : Mark_Id;
Mem : Memory (1 .. Mark_Id'Last);
end record;
pragma Suppress_Initialization (Stack_Id);
type Stack_Ptr is access Stack_Id;
function From_Addr is new Unchecked_Conversion (Address, Stack_Ptr);
function Get_Sec_Stack return Stack_Ptr;
pragma Import (C, Get_Sec_Stack, "__gnat_get_secondary_stack");
-- Return the address of the secondary stack.
-- In a multi-threaded environment, Sec_Stack should be a thread-local
-- variable.
-- Possible implementation of Get_Sec_Stack in a single-threaded
-- environment:
--
-- Chunk : aliased Memory (1 .. Default_Secondary_Stack_Size);
-- for Chunk'Alignment use Standard'Maximum_Alignment;
-- -- The secondary stack.
--
-- function Get_Sec_Stack return Stack_Ptr is
-- begin
-- return From_Addr (Chunk'Address);
-- end Get_Sec_Stack;
--
-- begin
-- SS_Init (Chunk'Address, Default_Secondary_Stack_Size);
-- end System.Secondary_Stack;
-----------------
-- SS_Allocate --
-----------------
procedure SS_Allocate
(Address : out System.Address;
Storage_Size : SSE.Storage_Count)
is
Max_Align : constant Mark_Id := Mark_Id (Standard'Maximum_Alignment);
Max_Size : constant Mark_Id :=
((Mark_Id (Storage_Size) + Max_Align - 1) / Max_Align)
* Max_Align;
Sec_Stack : constant Stack_Ptr := Get_Sec_Stack;
begin
if Sec_Stack.Top + Max_Size > Sec_Stack.Last then
raise Storage_Error;
end if;
Address := Sec_Stack.Mem (Sec_Stack.Top)'Address;
Sec_Stack.Top := Sec_Stack.Top + Mark_Id (Max_Size);
end SS_Allocate;
-------------
-- SS_Free --
-------------
procedure SS_Free (Stk : in out System.Address) is
begin
Stk := Null_Address;
end SS_Free;
-------------
-- SS_Init --
-------------
procedure SS_Init
(Stk : System.Address;
Size : Natural := Default_Secondary_Stack_Size)
is
Stack : Stack_Ptr := From_Addr (Stk);
begin
pragma Assert (Size >= 2 * Mark_Id'Max_Size_In_Storage_Elements);
Stack.Top := Stack.Mem'First;
Stack.Last := Mark_Id (Size) - 2 * Mark_Id'Max_Size_In_Storage_Elements;
end SS_Init;
-------------
-- SS_Mark --
-------------
function SS_Mark return Mark_Id is
begin
return Get_Sec_Stack.Top;
end SS_Mark;
----------------
-- SS_Release --
----------------
procedure SS_Release (M : Mark_Id) is
begin
Get_Sec_Stack.Top := M;
end SS_Release;
end System.Secondary_Stack;
gcc/ada/1ssecsta.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C O N D A R Y _ S T A C K --
-- --
-- S p e c --
-- --
-- $Revision$
-- --
-- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.Storage_Elements;
package System.Secondary_Stack is
package SSE renames System.Storage_Elements;
Default_Secondary_Stack_Size : constant := 10 * 1024;
-- Default size of a secondary stack
procedure SS_Init
(Stk : System.Address;
Size : Natural := Default_Secondary_Stack_Size);
-- Initialize the secondary stack with a main stack of the given Size.
--
-- Stk is an "in" parameter that is already pointing to a memory area of
-- size Size.
--
-- The secondary stack is fixed, and any attempt to allocate more than the
-- initial size will result in a Storage_Error being raised.
procedure SS_Allocate
(Address : out System.Address;
Storage_Size : SSE.Storage_Count);
-- Allocate enough space for a 'Storage_Size' bytes object with Maximum
-- alignment. The address of the allocated space is returned in 'Address'
procedure SS_Free (Stk : in out System.Address);
-- Release the memory allocated for the Secondary Stack. That is to say,
-- all the allocated chuncks.
-- Upon return, Stk will be set to System.Null_Address
type Mark_Id is private;
-- Type used to mark the stack.
function SS_Mark return Mark_Id;
-- Return the Mark corresponding to the current state of the stack
procedure SS_Release (M : Mark_Id);
-- Restore the state of the stack corresponding to the mark M. If an
-- additional chunk have been allocated, it will never be freed during a
private
SS_Pool : Integer;
-- Unused entity that is just present to ease the sharing of the pool
-- mechanism for specific allocation/deallocation in the compiler
type Mark_Id is new SSE.Integer_Address;
end System.Secondary_Stack;
gcc/ada/3lsoccon.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 --
-- --
-- $Revision$
-- --
-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the version for GNU/Linux
package GNAT.Sockets.Constants is
-- Families
AF_INET : constant := 2;
AF_INET6 : constant := 10;
-- Modes
SOCK_STREAM : constant := 1;
SOCK_DGRAM : constant := 2;
-- Socket Errors
EBADF : constant := 9;
ENOTSOCK : constant := 88;
ENOTCONN : constant := 107;
ENOBUFS : constant := 105;
EOPNOTSUPP : constant := 95;
EFAULT : constant := 14;
EWOULDBLOCK : constant := 11;
EADDRNOTAVAIL : constant := 99;
EMSGSIZE : constant := 90;
EADDRINUSE : constant := 98;
EINVAL : constant := 22;
EACCES : constant := 13;
EAFNOSUPPORT : constant := 97;
EISCONN : constant := 106;
ETIMEDOUT : constant := 110;
ECONNREFUSED : constant := 111;
ENETUNREACH : constant := 101;
EALREADY : constant := 114;
EINPROGRESS : constant := 115;
ENOPROTOOPT : constant := 92;
EPROTONOSUPPORT : constant := 93;
EINTR : constant := 4;
EIO : constant := 5;
ESOCKTNOSUPPORT : constant := 94;
-- Host Errors
HOST_NOT_FOUND : constant := 1;
TRY_AGAIN : constant := 2;
NO_ADDRESS : constant := 4;
NO_RECOVERY : constant := 3;
-- Control Flags
FIONBIO : constant := 21537;
FIONREAD : constant := 21531;
-- Shutdown Modes
SHUT_RD : constant := 0;
SHUT_WR : constant := 1;
SHUT_RDWR : constant := 2;
-- Protocol Levels
SOL_SOCKET : constant := 1;
IPPROTO_IP : constant := 0;
IPPROTO_UDP : constant := 17;
IPPROTO_TCP : constant := 6;
-- Socket Options
TCP_NODELAY : constant := 1;
SO_SNDBUF : constant := 7;
SO_RCVBUF : constant := 8;
SO_REUSEADDR : constant := 2;
SO_KEEPALIVE : constant := 9;
SO_LINGER : constant := 13;
SO_ERROR : constant := 4;
SO_BROADCAST : constant := 6;
IP_ADD_MEMBERSHIP : constant := 35;
IP_DROP_MEMBERSHIP : constant := 36;
IP_MULTICAST_TTL : constant := 33;
IP_MULTICAST_LOOP : constant := 34;
end GNAT.Sockets.Constants;
gcc/ada/41intnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $
-- $Revision$
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -44,7 +44,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handler
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
with System.OS_Interface;
-- used for names of interrupts
......
gcc/ada/42intnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $
-- $Revision$
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -44,7 +44,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handler
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
with System.OS_Interface;
-- used for names of interrupts
......
gcc/ada/4aintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -44,7 +44,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handler
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
with System.OS_Interface;
-- used for names of interrupts
......
gcc/ada/4cintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -49,7 +49,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handler
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
......
gcc/ada/4dintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -44,7 +44,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: Made available for Ada handler
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
......
gcc/ada/4gintnam.ads
......@@ -8,7 +8,7 @@
-- --
-- $Revision$
-- --
-- Copyright (C) 1997-2001, Florida State University --
-- Copyright (C) 1997-2002, Florida State University --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU Library General Public License as published by the --
......@@ -50,7 +50,6 @@
-- (Pthread library):
--
-- SIGINT: made available for Ada handler
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
......
gcc/ada/4hintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001, Florida State University --
-- Copyright (C) 1991-2002, Florida State University --
-- --
-- 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- --
......@@ -44,7 +44,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handler
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
......
gcc/ada/4lintnam.ads
......@@ -8,7 +8,7 @@
-- --
-- $Revision$
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -49,7 +49,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handler
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
......
gcc/ada/4mintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1996-2002 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- --
......@@ -44,7 +44,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handlers
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
......
gcc/ada/4pintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -44,7 +44,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handlers
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
......
gcc/ada/4rintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -48,7 +48,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handlers
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
......
gcc/ada/4sintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.7 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -49,7 +49,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handlers
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
with System.OS_Interface;
-- used for names of interrupts
......
gcc/ada/4uintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.7 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2002 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- --
......@@ -44,7 +44,6 @@
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- SIGINT: made available for Ada handlers
-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping
with System.OS_Interface;
-- used for names of interrupts
......
gcc/ada/4vcalend.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.19 $
-- $Revision$
-- --
-- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
-- --
......@@ -60,9 +60,6 @@ package body Ada.Calendar is
-- Some basic constants used throughout
Days_In_Month : constant array (Month_Number) of Day_Number :=
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
function To_Relative_Time (D : Duration) return Time;
function To_Relative_Time (D : Duration) return Time is
......
gcc/ada/4zintnam.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- $Revision$
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1998-2001 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- --
......@@ -35,20 +35,8 @@
------------------------------------------------------------------------------
-- This is the VxWorks version of this package.
--
-- The following signals are reserved by the run time:
--
-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT
--
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
--
-- none
-- This target-dependent package spec contains names of interrupts
-- supported by the local system.
with System.OS_Interface;
with System.VxWorks;
package Ada.Interrupts.Names is
......@@ -56,136 +44,4 @@ package Ada.Interrupts.Names is
range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt;
-- Range of values that can be used for hardware interrupts.
-- The following constants can be used for software interrupts mapped to
-- user-level signals:
SIGHUP : constant Interrupt_ID;
-- hangup
SIGINT : constant Interrupt_ID;
-- interrupt
SIGQUIT : constant Interrupt_ID;
-- quit
SIGILL : constant Interrupt_ID;
-- illegal instruction (not reset)
SIGTRAP : constant Interrupt_ID;
-- trace trap (not reset)
SIGIOT : constant Interrupt_ID;
-- IOT instruction
SIGABRT : constant Interrupt_ID;
-- used by abort, replace SIGIOT
SIGEMT : constant Interrupt_ID;
-- EMT instruction
SIGFPE : constant Interrupt_ID;
-- floating point exception
SIGKILL : constant Interrupt_ID;
-- kill (cannot be caught or ignored)
SIGBUS : constant Interrupt_ID;
-- bus error
SIGSEGV : constant Interrupt_ID;
-- segmentation violation
SIGSYS : constant Interrupt_ID;
-- bad argument to system call
SIGPIPE : constant Interrupt_ID;
-- no one to read it
SIGALRM : constant Interrupt_ID;
-- alarm clock
SIGTERM : constant Interrupt_ID;
-- software termination signal from kill
SIGURG : constant Interrupt_ID;
-- urgent condition on IO channel
SIGSTOP : constant Interrupt_ID;
-- stop (cannot be caught or ignored)
SIGTSTP : constant Interrupt_ID;
-- user stop requested from tty
SIGCONT : constant Interrupt_ID;
-- stopped process has been continued
SIGCHLD : constant Interrupt_ID;
-- child status change
SIGTTIN : constant Interrupt_ID;
-- background tty read attempted
SIGTTOU : constant Interrupt_ID;
-- background tty write attempted
SIGIO : constant Interrupt_ID;
-- input/output possible,
SIGXCPU : constant Interrupt_ID;
-- CPU time limit exceeded
SIGXFSZ : constant Interrupt_ID;
-- filesize limit exceeded
SIGVTALRM : constant Interrupt_ID;
-- virtual timer expired
SIGPROF : constant Interrupt_ID;
-- profiling timer expired
SIGWINCH : constant Interrupt_ID;
-- window size change
SIGUSR1 : constant Interrupt_ID;
-- user defined signal 1
SIGUSR2 : constant Interrupt_ID;
-- user defined signal 2
private
Signal_Base : constant := System.VxWorks.Num_HW_Interrupts;
SIGHUP : constant Interrupt_ID := 1 + Signal_Base;
SIGINT : constant Interrupt_ID := 2 + Signal_Base;
SIGQUIT : constant Interrupt_ID := 3 + Signal_Base;
SIGILL : constant Interrupt_ID := 4 + Signal_Base;
SIGTRAP : constant Interrupt_ID := 5 + Signal_Base;
SIGIOT : constant Interrupt_ID := 6 + Signal_Base;
SIGABRT : constant Interrupt_ID := 6 + Signal_Base;
SIGEMT : constant Interrupt_ID := 7 + Signal_Base;
SIGFPE : constant Interrupt_ID := 8 + Signal_Base;
SIGKILL : constant Interrupt_ID := 9 + Signal_Base;
SIGBUS : constant Interrupt_ID := 10 + Signal_Base;
SIGSEGV : constant Interrupt_ID := 11 + Signal_Base;
SIGSYS : constant Interrupt_ID := 12 + Signal_Base;
SIGPIPE : constant Interrupt_ID := 13 + Signal_Base;
SIGALRM : constant Interrupt_ID := 14 + Signal_Base;
SIGTERM : constant Interrupt_ID := 15 + Signal_Base;
SIGURG : constant Interrupt_ID := 16 + Signal_Base;
SIGSTOP : constant Interrupt_ID := 17 + Signal_Base;
SIGTSTP : constant Interrupt_ID := 18 + Signal_Base;
SIGCONT : constant Interrupt_ID := 19 + Signal_Base;
SIGCHLD : constant Interrupt_ID := 20 + Signal_Base;
SIGTTIN : constant Interrupt_ID := 21 + Signal_Base;
SIGTTOU : constant Interrupt_ID := 22 + Signal_Base;
SIGIO : constant Interrupt_ID := 23 + Signal_Base;
SIGXCPU : constant Interrupt_ID := 24 + Signal_Base;
SIGXFSZ : constant Interrupt_ID := 25 + Signal_Base;
SIGVTALRM : constant Interrupt_ID := 26 + Signal_Base;
SIGPROF : constant Interrupt_ID := 27 + Signal_Base;
SIGWINCH : constant Interrupt_ID := 28 + Signal_Base;
SIGUSR1 : constant Interrupt_ID := 30 + Signal_Base;
SIGUSR2 : constant Interrupt_ID := 31 + Signal_Base;
end Ada.Interrupts.Names;
gcc/ada/52system.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (LynxOS PPC/x86 Version)
-- --
-- $Revision: 1.4 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -88,32 +88,18 @@ pragma Pure (System);
-- Other System-Dependent Declarations
type Bit_Order is (High_Order_First, Low_Order_First);
Default_Bit_Order : constant Bit_Order :=
Bit_Order'Val (Standard'Default_Bit_Order);
Default_Bit_Order : constant Bit_Order := High_Order_First;
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -131,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := True;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
......
gcc/ada/5amastop.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- (Version for Alpha/Dec Unix) --
-- --
-- $Revision: 1.5 $
-- $Revision$
-- --
-- Copyright (C) 1999-2001 Ada Core Technologies, Inc. --
-- --
......@@ -87,11 +87,8 @@ package body System.Machine_State_Operations is
------------------------
procedure Free_Machine_State (M : in out Machine_State) is
procedure Gnat_Free (M : in Machine_State);
pragma Import (C, Gnat_Free, "__gnat_free");
begin
Gnat_Free (M);
Memory.Free (Address (M));
M := Machine_State (Null_Address);
end Free_Machine_State;
......
gcc/ada/5asystem.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (DEC Unix Version) --
-- --
-- $Revision: 1.20 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 64;
Memory_Size : constant := 2 ** 64;
-- Address comparison
......@@ -92,27 +92,14 @@ pragma Pure (System);
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 60;
Max_Interrupt_Priority : constant Positive := 63;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer range 0 .. 63;
subtype Priority is Any_Priority range 0 .. 60;
subtype Interrupt_Priority is Any_Priority range 61 .. 63;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
Default_Priority : constant Priority :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 30;
private
......@@ -130,10 +117,13 @@ private
-- 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;
Denorm : constant Boolean := False;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := True;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
High_Integrity_Mode : constant Boolean := False;
Machine_Overflows : constant Boolean := False;
......@@ -143,9 +133,9 @@ private
Stack_Check_Default : constant Boolean := True;
Stack_Check_Probes : constant Boolean := True;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
GCC_ZCX_Support : constant Boolean := False;
Front_End_ZCX_Support : constant Boolean := True;
Front_End_ZCX_Support : constant Boolean := False;
-- Note: Denorm is False because denormals are only handled properly
-- if the -mieee switch is set, and we do not require this usage.
......@@ -193,37 +183,29 @@ private
-- Suppress initialization in case gnat.adc specifies Normalize_Scalars
Underlying_Priorities : constant Priorities_Mapping :=
(Priority'First => 16,
1 => 17,
2 => 18,
3 => 18,
4 => 18,
5 => 18,
6 => 19,
7 => 19,
8 => 19,
9 => 20,
10 => 20,
11 => 21,
12 => 21,
13 => 22,
14 => 23,
Default_Priority => 24,
16 => 25,
17 => 25,
18 => 25,
19 => 26,
20 => 26,
21 => 26,
22 => 27,
23 => 27,
24 => 27,
25 => 28,
26 => 28,
27 => 29,
28 => 29,
29 => 30,
Priority'Last => 30,
Interrupt_Priority => 31);
(Priority'First => 0,
1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5,
6 => 6, 7 => 7, 8 => 8, 9 => 9, 10 => 10,
11 => 11, 12 => 12, 13 => 13, 14 => 14, 15 => 15,
16 => 16, 17 => 17, 18 => 18, 19 => 19, 20 => 20,
21 => 21, 22 => 22, 23 => 23, 24 => 24, 25 => 25,
26 => 26, 27 => 27, 28 => 28, 29 => 29,
Default_Priority => 30,
31 => 31, 32 => 32, 33 => 33, 34 => 34, 35 => 35,
36 => 36, 37 => 37, 38 => 38, 39 => 39, 40 => 40,
41 => 41, 42 => 42, 43 => 43, 44 => 44, 45 => 45,
46 => 46, 47 => 47, 48 => 48, 49 => 49, 50 => 50,
51 => 51, 52 => 52, 53 => 53, 54 => 54, 55 => 55,
56 => 56, 57 => 57, 58 => 58, 59 => 59,
Priority'Last => 60,
61 => 61, 62 => 62,
Interrupt_Priority'Last => 63);
end System;
gcc/ada/5atpopsp.adb
......@@ -7,9 +7,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.1 $
-- $Revision$
-- --
-- Copyright (C) 1991-2001, Florida State University --
-- Copyright (C) 1992-2001, 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- --
......@@ -30,15 +30,17 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is a POSIX version of this package where foreign threads are
-- recognized.
-- Currently, DEC Unix, SCO UnixWare, Solaris pthread, HPUX pthread and RTEMS
-- use this version.
-- Currently, DEC Unix, SCO UnixWare, Solaris pthread, HPUX pthread,
-- GNU/Linux threads and RTEMS use this version.
with System.Task_Info;
-- Use for Unspecified_Task_Info
with System.Soft_Links;
-- used to initialize TSD for a C thread, in function Self
......@@ -71,7 +73,7 @@ package body Specific is
Fake_ATCB_List : Fake_ATCB_Ptr;
-- A linear linked list.
-- The list is protected by All_Tasks_L;
-- The list is protected by Single_RTS_Lock;
-- Nodes are added to this list from the front.
-- Once a node is added to this list, it is never removed.
......@@ -109,7 +111,7 @@ package body Specific is
-- We dare not call anything that might require an ATCB, until
-- we have the new ATCB in place.
Write_Lock (All_Tasks_L'Access);
Lock_RTS;
Q := null;
P := Fake_ATCB_List;
......@@ -195,7 +197,7 @@ package body Specific is
-- Must not unlock until Next_ATCB is again allocated.
Unlock (All_Tasks_L'Access);
Unlock_RTS;
return Self_ID;
end New_Fake_ATCB;
......@@ -205,7 +207,6 @@ package body Specific is
procedure Initialize (Environment_Task : Task_ID) is
Result : Interfaces.C.int;
begin
Result := pthread_key_create (ATCB_Key'Access, null);
pragma Assert (Result = 0);
......@@ -223,7 +224,6 @@ package body Specific is
procedure Set (Self_Id : Task_ID) is
Result : Interfaces.C.int;
begin
Result := pthread_setspecific (ATCB_Key, To_Address (Self_Id));
pragma Assert (Result = 0);
......@@ -233,37 +233,21 @@ package body Specific is
-- Self --
----------
-- To make Ada tasks and C threads interoperate better, we have
-- added some functionality to Self. Suppose a C main program
-- (with threads) calls an Ada procedure and the Ada procedure
-- calls the tasking runtime system. Eventually, a call will be
-- made to self. Since the call is not coming from an Ada task,
-- there will be no corresponding ATCB.
-- (The entire Ada run-time system may not have been elaborated,
-- either, but that is a different problem, that we will need to
-- solve another way.)
-- To make Ada tasks and C threads interoperate better, we have added some
-- functionality to Self. Suppose a C main program (with threads) calls an
-- Ada procedure and the Ada procedure calls the tasking runtime system.
-- Eventually, a call will be made to self. Since the call is not coming
-- from an Ada task, there will be no corresponding ATCB.
-- What we do in Self is to catch references that do not come
-- from recognized Ada tasks, and create an ATCB for the calling
-- thread.
-- What we do in Self is to catch references that do not come from
-- recognized Ada tasks, and create an ATCB for the calling thread.
-- The new ATCB will be "detached" from the normal Ada task
-- master hierarchy, much like the existing implicitly created
-- signal-server tasks.
-- We will also use such points to poll for disappearance of the
-- threads associated with any implicit ATCBs that we created
-- earlier, and take the opportunity to recover them.
-- A nasty problem here is the limitations of the compilation
-- order dependency, and in particular the GNARL/GNULLI layering.
-- To initialize an ATCB we need to assume System.Tasking has
-- been elaborated.
-- The new ATCB will be "detached" from the normal Ada task master
-- hierarchy, much like the existing implicitly created signal-server
-- tasks.
function Self return Task_ID is
Result : System.Address;
begin
Result := pthread_getspecific (ATCB_Key);
......
gcc/ada/5avxwork.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- $Revision$
-- --
-- Copyright (C) 1998-2001 Free Software Foundation --
-- Copyright (C) 1998-2001 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- --
......@@ -29,8 +29,7 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
......@@ -43,68 +42,18 @@ package System.VxWorks is
package IC renames Interfaces.C;
-- Define enough of a Wind Task Control Block in order to
-- obtain the inherited priority. When porting this to
-- different versions of VxWorks (this is based on 5.3[.1]),
-- be sure to look at the definition for WIND_TCB located
-- in $WIND_BASE/target/h/taskLib.h
type Wind_Fill_1 is array (0 .. 16#77#) of IC.unsigned_char;
type Wind_Fill_2 is array (16#80# .. 16#1c7#) of IC.unsigned_char;
type Wind_Fill_3 is array (16#1d8# .. 16#777#) of IC.unsigned_char;
type Wind_TCB is record
Fill_1 : Wind_Fill_1; -- 0x00 - 0x77
Priority : IC.int; -- 0x78 - 0x7b, current (inherited) priority
Normal_Priority : IC.int; -- 0x7c - 0x7f, base priority
Fill_2 : Wind_Fill_2; -- 0x80 - 0x1c7
spare1 : Address; -- 0x1c8 - 0x1cb
spare2 : Address; -- 0x1cc - 0x1cf
spare3 : Address; -- 0x1d0 - 0x1d3
spare4 : Address; -- 0x1d4 - 0x1d7
-- Fill_3 is much smaller on the board runtime, but the larger size
-- below keeps this record compatible with vxsim.
Fill_3 : Wind_Fill_3; -- 0x1d8 - 0x777
end record;
type Wind_TCB_Ptr is access Wind_TCB;
-- Floating point context record. Alpha version
-- Floating point context record. Alpha version
FP_NUM_DREGS : constant := 32;
type Fpx_Array is array (1 .. FP_NUM_DREGS) of IC.double;
type FP_CONTEXT is record
fpx : Fpx_Array;
fpx : Fpx_Array;
fpcsr : IC.long;
end record;
pragma Convention (C, FP_CONTEXT);
-- Number of entries in hardware interrupt vector table. Value of
-- 0 disables hardware interrupt handling until it can be tested
Num_HW_Interrupts : constant := 0;
-- VxWorks 5.3 and 5.4 version
type TASK_DESC is record
td_id : IC.int; -- task id
td_name : Address; -- name of task
td_priority : IC.int; -- task priority
td_status : IC.int; -- task status
td_options : IC.int; -- task option bits (see below)
td_entry : Address; -- original entry point of task
td_sp : Address; -- saved stack pointer
td_pStackBase : Address; -- the bottom of the stack
td_pStackLimit : Address; -- the effective end of the stack
td_pStackEnd : Address; -- the actual end of the stack
td_stackSize : IC.int; -- size of stack in bytes
td_stackCurrent : IC.int; -- current stack usage in bytes
td_stackHigh : IC.int; -- maximum stack usage in bytes
td_stackMargin : IC.int; -- current stack margin in bytes
td_errorStatus : IC.int; -- most recent task error status
td_delay : IC.int; -- delay/timeout ticks
end record;
pragma Convention (C, TASK_DESC);
Num_HW_Interrupts : constant := 256;
-- Number of entries in hardware interrupt vector table.
end System.VxWorks;
gcc/ada/5bosinte.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.8 $
-- $Revision$
-- --
-- Copyright (C) 1997-2001, Florida State University --
-- Copyright (C) 1997-2001, Free Software Fundation, 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- --
......@@ -29,8 +29,7 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
......@@ -140,7 +139,7 @@ package body System.OS_Interface is
function sched_yield return int is
procedure pthread_yield;
pragma Import (C, pthread_yield, "pthread_yield");
pragma Import (C, pthread_yield, "sched_yield");
begin
pthread_yield;
......
gcc/ada/5bsystem.ads
......@@ -5,11 +5,11 @@
-- S Y S T E M --
-- --
-- S p e c --
-- (AIX/PPC Version)
-- (AIX/PPC Version) --
-- --
-- $Revision: 1.4 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -88,32 +88,18 @@ pragma Pure (System);
-- Other System-Dependent Declarations
type Bit_Order is (High_Order_First, Low_Order_First);
Default_Bit_Order : constant Bit_Order :=
Bit_Order'Val (Standard'Default_Bit_Order);
Default_Bit_Order : constant Bit_Order := High_Order_First;
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -131,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := True;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
......
gcc/ada/5esystem.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (X86 Solaris Version) --
-- --
-- $Revision: 1.10 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -92,27 +92,14 @@ pragma Pure (System);
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -130,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := True;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
......@@ -145,6 +135,6 @@ private
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;
Front_End_ZCX_Support : constant Boolean := True;
end System;
gcc/ada/5fsystem.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (SGI Irix, o32 ABI) --
-- --
-- $Revision: 1.13 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -92,27 +92,14 @@ pragma Pure (System);
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -130,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := False;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := True;
Long_Shifts_Inlined : constant Boolean := True;
......
gcc/ada/5ginterr.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.13 $
-- $Revision$
-- --
-- Copyright (C) 1998-1999 Free Software Fundation --
-- Copyright (C) 1998-2001 Free Software Fundation --
-- --
-- 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- --
......@@ -29,8 +29,7 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
......@@ -68,6 +67,9 @@ with System.Tasking.Initialization;
with System.Interrupt_Management;
with System.Parameters;
-- used for Single_Lock
with Interfaces.C;
-- used for int
......@@ -75,6 +77,7 @@ with Unchecked_Conversion;
package body System.Interrupts is
use Parameters;
use Tasking;
use Ada.Exceptions;
use System.OS_Interface;
......@@ -650,11 +653,21 @@ package body System.Interrupts is
end loop;
Initialization.Defer_Abort (Self_Id);
if Single_Lock then
STPO.Lock_RTS;
end if;
STPO.Write_Lock (Self_Id);
Self_Id.Common.State := Interrupt_Server_Idle_Sleep;
STPO.Sleep (Self_Id, Interrupt_Server_Idle_Sleep);
Self_Id.Common.State := Runnable;
STPO.Unlock (Self_Id);
if Single_Lock then
STPO.Unlock_RTS;
end if;
Initialization.Undefer_Abort (Self_Id);
-- Undefer abort here to allow a window for this task
......
gcc/ada/5gmastop.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- (Version for IRIX/MIPS) --
-- --
-- $Revision: 1.1 $
-- $Revision$
-- --
-- Copyright (C) 1999-2001 Free Software Foundation, Inc. --
-- --
......@@ -66,27 +66,26 @@ package body System.Machine_State_Operations is
type Reg_Array is array (0 .. 31) of Uns64;
type Sigcontext is
record
SC_Regmask : Uns32; -- 0
SC_Status : Uns32; -- 4
SC_PC : Uns64; -- 8
SC_Regs : Reg_Array; -- 16
SC_Fpregs : Reg_Array; -- 272
SC_Ownedfp : Uns32; -- 528
SC_Fpc_Csr : Uns32; -- 532
SC_Fpc_Eir : Uns32; -- 536
SC_Ssflags : Uns32; -- 540
SC_Mdhi : Uns64; -- 544
SC_Mdlo : Uns64; -- 552
SC_Cause : Uns64; -- 560
SC_Badvaddr : Uns64; -- 568
SC_Triggersave : Uns64; -- 576
SC_Sigset : Uns64; -- 584
SC_Fp_Rounded_Result : Uns64; -- 592
SC_Pancake : Uns64_Array (0 .. 5);
SC_Pad : Uns64_Array (0 .. 26);
end record;
type Sigcontext is record
SC_Regmask : Uns32; -- 0
SC_Status : Uns32; -- 4
SC_PC : Uns64; -- 8
SC_Regs : Reg_Array; -- 16
SC_Fpregs : Reg_Array; -- 272
SC_Ownedfp : Uns32; -- 528
SC_Fpc_Csr : Uns32; -- 532
SC_Fpc_Eir : Uns32; -- 536
SC_Ssflags : Uns32; -- 540
SC_Mdhi : Uns64; -- 544
SC_Mdlo : Uns64; -- 552
SC_Cause : Uns64; -- 560
SC_Badvaddr : Uns64; -- 568
SC_Triggersave : Uns64; -- 576
SC_Sigset : Uns64; -- 584
SC_Fp_Rounded_Result : Uns64; -- 592
SC_Pancake : Uns64_Array (0 .. 5);
SC_Pad : Uns64_Array (0 .. 26);
end record;
type Sigcontext_Ptr is access all Sigcontext;
......@@ -253,11 +252,8 @@ package body System.Machine_State_Operations is
------------------------
procedure Free_Machine_State (M : in out Machine_State) is
procedure Gnat_Free (M : in Machine_State);
pragma Import (C, Gnat_Free, "__gnat_free");
begin
Gnat_Free (M);
Memory.Free (Address (M));
M := Machine_State (Null_Address);
end Free_Machine_State;
......
gcc/ada/5gsystem.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (SGI Irix, n32 ABI) --
-- --
-- $Revision: 1.19 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 64;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -92,27 +92,14 @@ pragma Pure (System);
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -130,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := False;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := True;
Long_Shifts_Inlined : constant Boolean := True;
......
gcc/ada/5gtasinf.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.2 $ --
-- $Revision$
-- --
-- Copyright (C) 1992-1998 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2001 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- --
......@@ -42,6 +42,7 @@ with Interfaces.C;
with System.OS_Interface;
with System;
with Unchecked_Conversion;
package body System.Task_Info is
use System.OS_Interface;
......@@ -67,52 +68,72 @@ package body System.Task_Info is
TXTLOCK => 2,
DATLOCK => 4);
-------------------------------
-- Resource_Vector_Functions --
-------------------------------
package body Resource_Vector_Functions is
function "+" (R : Resource_T)
return Resource_Vector_T is
---------
-- "+" --
---------
function "+" (R : Resource_T) return Resource_Vector_T is
Result : Resource_Vector_T := NO_RESOURCES;
begin
Result (Resource_T'Pos (R)) := True;
return Result;
end "+";
function "+" (R1, R2 : Resource_T)
return Resource_Vector_T is
function "+" (R1, R2 : Resource_T) return Resource_Vector_T is
Result : Resource_Vector_T := NO_RESOURCES;
begin
Result (Resource_T'Pos (R1)) := True;
Result (Resource_T'Pos (R2)) := True;
return Result;
end "+";
function "+" (R : Resource_T; S : Resource_Vector_T)
return Resource_Vector_T is
function "+"
(R : Resource_T;
S : Resource_Vector_T)
return Resource_Vector_T
is
Result : Resource_Vector_T := S;
begin
Result (Resource_T'Pos (R)) := True;
return Result;
end "+";
function "+" (S : Resource_Vector_T; R : Resource_T)
return Resource_Vector_T is
function "+"
(S : Resource_Vector_T;
R : Resource_T)
return Resource_Vector_T
is
Result : Resource_Vector_T := S;
begin
Result (Resource_T'Pos (R)) := True;
return Result;
end "+";
function "+" (S1, S2 : Resource_Vector_T)
return Resource_Vector_T is
function "+" (S1, S2 : Resource_Vector_T) return Resource_Vector_T is
Result : Resource_Vector_T;
begin
Result := S1 or S2;
return Result;
end "+";
function "-" (S : Resource_Vector_T; R : Resource_T)
return Resource_Vector_T is
function "-"
(S : Resource_Vector_T;
R : Resource_T)
return Resource_Vector_T
is
Result : Resource_Vector_T := S;
begin
Result (Resource_T'Pos (R)) := False;
return Result;
......@@ -120,14 +141,19 @@ package body System.Task_Info is
end Resource_Vector_Functions;
---------------
-- New_Sproc --
---------------
function New_Sproc (Attr : Sproc_Attributes) return sproc_t is
Sproc_Attr : aliased sproc_attr_t;
Sproc : aliased sproc_t;
Status : int;
begin
Status := sproc_attr_init (Sproc_Attr'Unrestricted_Access);
if Status = 0 then
if Status = 0 then
Status := sproc_attr_setresources
(Sproc_Attr'Unrestricted_Access,
To_Resource_T (Attr.Sproc_Resources));
......@@ -136,13 +162,13 @@ package body System.Task_Info is
if Attr.CPU > Num_Processors then
raise Invalid_CPU_Number;
end if;
Status := sproc_attr_setcpu
(Sproc_Attr'Unrestricted_Access,
int (Attr.CPU));
end if;
if Attr.Resident /= NOLOCK then
if Geteuid /= 0 then
raise Permission_Error;
end if;
......@@ -153,6 +179,7 @@ package body System.Task_Info is
end if;
if Attr.NDPRI /= NDP_NONE then
-- ??? why is that comment out, should it be removed ?
-- if Geteuid /= 0 then
-- raise Permission_Error;
-- end if;
......@@ -184,13 +211,17 @@ package body System.Task_Info is
return Sproc;
end New_Sproc;
---------------
-- New_Sproc --
---------------
function New_Sproc
(Sproc_Resources : Resource_Vector_T := NO_RESOURCES;
CPU : CPU_Number := ANY_CPU;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE)
return sproc_t is
return sproc_t
is
Attr : Sproc_Attributes :=
(Sproc_Resources, CPU, Resident, NDPRI);
......@@ -198,23 +229,37 @@ package body System.Task_Info is
return New_Sproc (Attr);
end New_Sproc;
-------------------------------
-- Unbound_Thread_Attributes --
-------------------------------
function Unbound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0)
return Thread_Attributes is
return Thread_Attributes
is
begin
return (False, Thread_Resources, Thread_Timeslice);
end Unbound_Thread_Attributes;
-----------------------------
-- Bound_Thread_Attributes --
-----------------------------
function Bound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
Sproc : sproc_t)
return Thread_Attributes is
return Thread_Attributes
is
begin
return (True, Thread_Resources, Thread_Timeslice, Sproc);
end Bound_Thread_Attributes;
-----------------------------
-- Bound_Thread_Attributes --
-----------------------------
function Bound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
......@@ -222,8 +267,8 @@ package body System.Task_Info is
CPU : CPU_Number := ANY_CPU;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE)
return Thread_Attributes is
return Thread_Attributes
is
Sproc : sproc_t := New_Sproc
(Sproc_Resources, CPU, Resident, NDPRI);
......@@ -231,25 +276,39 @@ package body System.Task_Info is
return (True, Thread_Resources, Thread_Timeslice, Sproc);
end Bound_Thread_Attributes;
-----------------------------------
-- New_Unbound_Thread_Attributes --
-----------------------------------
function New_Unbound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0)
return Task_Info_Type is
return Task_Info_Type
is
begin
return new Thread_Attributes'
(False, Thread_Resources, Thread_Timeslice);
end New_Unbound_Thread_Attributes;
---------------------------------
-- New_Bound_Thread_Attributes --
---------------------------------
function New_Bound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
Sproc : sproc_t)
return Task_Info_Type is
return Task_Info_Type
is
begin
return new Thread_Attributes'
(True, Thread_Resources, Thread_Timeslice, Sproc);
end New_Bound_Thread_Attributes;
---------------------------------
-- New_Bound_Thread_Attributes --
---------------------------------
function New_Bound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
......@@ -257,8 +316,8 @@ package body System.Task_Info is
CPU : CPU_Number := ANY_CPU;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE)
return Task_Info_Type is
return Task_Info_Type
is
Sproc : sproc_t := New_Sproc
(Sproc_Resources, CPU, Resident, NDPRI);
......
gcc/ada/5gtasinf.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $
-- $Revision$
-- --
-- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2001 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- --
......@@ -40,6 +40,7 @@
with System.OS_Interface;
with Unchecked_Deallocation;
package System.Task_Info is
pragma Elaborate_Body;
-- To ensure that a body is allowed
......@@ -49,10 +50,10 @@ pragma Elaborate_Body;
---------------------------------------------------------
-- The SGI implementation of the GNU Low-Level Interface (GNULLI)
-- implements each Ada task as a Posix thread (Pthread). The SGI
-- implements each Ada task as a Posix thread (Pthread). The SGI
-- Pthread library distributes threads across one or more processes
-- that are members of a common share group. Irix distributes
-- processes across the available CPUs on a given machine. The
-- that are members of a common share group. Irix distributes
-- processes across the available CPUs on a given machine. The
-- pragma Task_Info provides the mechanism to control the distribution
-- of tasks to sprocs, and sprocs to processors.
......@@ -103,19 +104,37 @@ pragma Elaborate_Body;
NO_RESOURCES : constant Resource_Vector_T := (others => False);
generic
type Resource_T is (<>); -- Discrete type up to 32 entries
type Resource_T is (<>);
-- Discrete type up to 32 entries
package Resource_Vector_Functions is
function "+"(R : Resource_T)
function "+"
(R : Resource_T)
return Resource_Vector_T;
function "+"(R1, R2 : Resource_T)
function "+"
(R1 : Resource_T;
R2 : Resource_T)
return Resource_Vector_T;
function "+"(R : Resource_T; S : Resource_Vector_T)
function "+"
(R : Resource_T;
S : Resource_Vector_T)
return Resource_Vector_T;
function "+"(S : Resource_Vector_T; R : Resource_T)
function "+"
(S : Resource_Vector_T;
R : Resource_T)
return Resource_Vector_T;
function "+"(S1, S2 : Resource_Vector_T)
function "+"
(S1 : Resource_Vector_T;
S2 : Resource_Vector_T)
return Resource_Vector_T;
function "-"(S : Resource_Vector_T; R : Resource_T)
function "-"
(S : Resource_Vector_T;
R : Resource_T)
return Resource_Vector_T;
end Resource_Vector_Functions;
......@@ -129,7 +148,7 @@ pragma Elaborate_Body;
ANY_CPU : constant CPU_Number := CPU_Number'First;
--
type Non_Degrading_Priority is range 0 .. 255;
-- Specification of IRIX Non Degrading Priorities.
--
-- WARNING: IRIX priorities have the reverse meaning of Ada priorities.
......@@ -138,24 +157,22 @@ pragma Elaborate_Body;
--
-- See the schedctl(2) man page for a complete discussion of non-degrading
-- priorities.
--
type Non_Degrading_Priority is range 0 .. 255;
-- these priorities are higher than ALL normal user process priorities
NDPHIMAX : constant Non_Degrading_Priority := 30;
NDPHIMIN : constant Non_Degrading_Priority := 39;
NDPHIMAX : constant Non_Degrading_Priority := 30;
NDPHIMIN : constant Non_Degrading_Priority := 39;
-- These priorities are higher than ALL normal user process priorities
subtype NDP_High is Non_Degrading_Priority range NDPHIMAX .. NDPHIMIN;
-- these priorities overlap normal user process priorities
NDPNORMMAX : constant Non_Degrading_Priority := 40;
NDPNORMMIN : constant Non_Degrading_Priority := 127;
-- These priorities overlap normal user process priorities
subtype NDP_Norm is Non_Degrading_Priority range NDPNORMMAX .. NDPNORMMIN;
-- these priorities are below ALL normal user process priorities
NDPLOMAX : constant Non_Degrading_Priority := 128;
NDPLOMIN : constant Non_Degrading_Priority := 254;
NDPLOMAX : constant Non_Degrading_Priority := 128;
NDPLOMIN : constant Non_Degrading_Priority := 254;
-- These priorities are below ALL normal user process priorities
NDP_NONE : constant Non_Degrading_Priority := 255;
......@@ -168,17 +185,16 @@ pragma Elaborate_Body;
DATLOCK -- Lock data segment into memory (data lock)
);
type Sproc_Attributes is
record
Sproc_Resources : Resource_Vector_T := NO_RESOURCES;
CPU : CPU_Number := ANY_CPU;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE;
type Sproc_Attributes is record
Sproc_Resources : Resource_Vector_T := NO_RESOURCES;
CPU : CPU_Number := ANY_CPU;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE;
-- ??? why is that commented out, should it be removed ?
-- Sproc_Slice : Duration := 0.0;
-- Deadline_Period : Duration := 0.0;
-- Deadline_Alloc : Duration := 0.0;
end record;
end record;
Default_Sproc_Attributes : constant Sproc_Attributes :=
(NO_RESOURCES, ANY_CPU, NOLOCK, NDP_NONE);
......@@ -190,10 +206,8 @@ pragma Elaborate_Body;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE)
return sproc_t;
--
-- Allocates a sproc_t controll structure and creates the
-- Allocates a sproc_t control structure and creates the
-- corresponding sproc.
--
Invalid_CPU_Number : exception;
Permission_Error : exception;
......@@ -203,17 +217,18 @@ pragma Elaborate_Body;
-- Thread Attributes --
-----------------------
type Thread_Attributes (Bound_To_Sproc : Boolean) is
record
Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
case Bound_To_Sproc is
when False =>
null;
when True =>
Sproc : sproc_t;
end case;
end record;
type Thread_Attributes (Bound_To_Sproc : Boolean) is record
Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
case Bound_To_Sproc is
when False =>
null;
when True =>
Sproc : sproc_t;
end case;
end record;
Default_Thread_Attributes : constant Thread_Attributes :=
(False, NO_RESOURCES, 0.0);
......
gcc/ada/5hparame.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $
-- $Revision$
-- --
-- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2001 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- --
......@@ -34,6 +34,7 @@
------------------------------------------------------------------------------
-- This is the HP version of this package
-- Blank line intentional so that it lines up exactly with default.
-- This package defines some system dependent parameters for GNAT. These
-- are values that are referenced by the runtime library and are therefore
......@@ -101,7 +102,7 @@ pragma Pure (Parameters);
-- proper implementation of the stack overflow check.
----------------------------------------------
-- Characteristics of types in Interfaces.C --
-- Characteristics of Types in Interfaces.C --
----------------------------------------------
long_bits : constant := Long_Integer'Size;
......@@ -132,4 +133,59 @@ pragma Pure (Parameters);
Garbage_Collected : constant Boolean := False;
-- The storage mode for this system (release on program exit)
---------------------
-- Tasking Profile --
---------------------
-- In the following sections, constant parameters are defined to
-- allow some optimizations within the tasking run time based on
-- restrictions on the tasking features.
----------------------
-- Locking Strategy --
----------------------
Single_Lock : constant Boolean := False;
-- Indicates whether a single lock should be used within the tasking
-- run-time to protect internal structures. If True, a single lock
-- will be used, meaning less locking/unlocking operations, but also
-- more global contention. In general, Single_Lock should be set to
-- True on single processor machines, and to False to multi-processor
-- systems, but this can vary from application to application and also
-- depends on the scheduling policy.
-------------------
-- Task Abortion --
-------------------
No_Abort : constant Boolean := False;
-- This constant indicates whether abort statements and asynchronous
-- transfer of control (ATC) are disallowed. If set to True, it is
-- assumed that neither construct is used, and the run time does not
-- need to defer/undefer abort and check for pending actions at
-- completion points. A value of True for No_Abort corresponds to:
-- pragma Restrictions (No_Abort_Statements);
-- pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
----------------------
-- Dynamic Priority --
----------------------
Dynamic_Priority_Support : constant Boolean := True;
-- This constant indicates whether dynamic changes of task priorities
-- are allowed (True means normal RM mode in which such changes are
-- allowed). In particular, if this is False, then we do not need to
-- poll for pending base priority changes at every abort completion
-- point. A value of False for Dynamic_Priority_Support corresponds
-- to pragma Restrictions (No_Dynamic_Priorities);
--------------------
-- Runtime Traces --
--------------------
Runtime_Traces : constant Boolean := False;
-- This constant indicates whether the runtime outputs traces to a
-- predefined output or not (True means that traces are output).
-- See System.Traces for more details.
end System.Parameters;
gcc/ada/5hsystem.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (HP-UX Version) --
-- --
-- $Revision: 1.15 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -92,27 +92,14 @@ pragma Pure (System);
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -130,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := False;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := False;
......
gcc/ada/5htraceb.adb
......@@ -7,9 +7,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.10 $
-- $Revision$
-- --
-- Copyright (C) 1999-2001 Ada Core Technologies, Inc. --
-- Copyright (C) 1999-2002 Ada Core Technologies, 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- --
......@@ -200,9 +200,6 @@ package body System.Traceback is
-- Descriptors.
subtype UWT is Unwind_Table_Region;
type UWT_Ptr is access all UWT;
function To_UWT_Address is new Ada.Unchecked_Conversion (UWT_Ptr, Address);
-- The subprograms imported below are provided by the HP library
......@@ -598,4 +595,3 @@ package body System.Traceback is
end Call_Chain;
end System.Traceback;
gcc/ada/5ksystem.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (VxWorks version M68K) --
-- --
-- $Revision: 1.11 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -88,40 +88,26 @@ pragma Pure (System);
-- Other System-Dependent Declarations
type Bit_Order is (High_Order_First, Low_Order_First);
Default_Bit_Order : constant Bit_Order :=
Bit_Order'Val (Standard'Default_Bit_Order);
Default_Bit_Order : constant Bit_Order := High_Order_First;
-- Priority-related Declarations (RM D.1)
-- 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;
-- 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 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 122;
private
......@@ -139,8 +125,11 @@ private
-- 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 := False;
Denorm : constant Boolean := True;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := False;
......
gcc/ada/5kvxwork.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $
-- $Revision$
-- --
-- Copyright (C) 1998-2001 Free Software Foundation --
-- Copyright (C) 1998-2001 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- --
......@@ -43,30 +43,9 @@ package System.VxWorks is
package IC renames Interfaces.C;
-- Define enough of a Wind Task Control Block in order to
-- obtain the inherited priority. When porting this to
-- different versions of VxWorks (this is based on 5.3[.1]),
-- be sure to look at the definition for WIND_TCB located
-- in $WIND_BASE/target/h/taskLib.h
-- Floating point context record. 68K version
type Wind_Fill_1 is array (0 .. 16#3F#) of IC.unsigned_char;
type Wind_Fill_2 is array (16#48# .. 16#107#) of IC.unsigned_char;
type Wind_TCB is record
Fill_1 : Wind_Fill_1; -- 0x00 - 0x3f
Priority : IC.int; -- 0x40 - 0x43, current (inherited) priority
Normal_Priority : IC.int; -- 0x44 - 0x47, base priority
Fill_2 : Wind_Fill_2; -- 0x48 - 0x107
spare1 : Address; -- 0x108 - 0x10b
spare2 : Address; -- 0x10c - 0x10f
spare3 : Address; -- 0x110 - 0x113
spare4 : Address; -- 0x114 - 0x117
end record;
type Wind_TCB_Ptr is access Wind_TCB;
-- Floating point context record. 68K version
FP_NUM_DREGS : constant := 8;
FP_NUM_DREGS : constant := 8;
FP_STATE_FRAME_SIZE : constant := 216;
type DOUBLEX is array (1 .. 12) of Interfaces.Unsigned_8;
......@@ -97,25 +76,4 @@ package System.VxWorks is
Num_HW_Interrupts : constant := 256;
-- Number of entries in the hardware interrupt vector table
-- VxWorks 5.3 and 5.4 version
type TASK_DESC is record
td_id : IC.int; -- task id
td_name : Address; -- name of task
td_priority : IC.int; -- task priority
td_status : IC.int; -- task status
td_options : IC.int; -- task option bits (see below)
td_entry : Address; -- original entry point of task
td_sp : Address; -- saved stack pointer
td_pStackBase : Address; -- the bottom of the stack
td_pStackLimit : Address; -- the effective end of the stack
td_pStackEnd : Address; -- the actual end of the stack
td_stackSize : IC.int; -- size of stack in bytes
td_stackCurrent : IC.int; -- current stack usage in bytes
td_stackHigh : IC.int; -- maximum stack usage in bytes
td_stackMargin : IC.int; -- current stack margin in bytes
td_errorStatus : IC.int; -- most recent task error status
td_delay : IC.int; -- delay/timeout ticks
end record;
pragma Convention (C, TASK_DESC);
end System.VxWorks;
gcc/ada/5lintman.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.2 $
-- $Revision$
-- --
-- Copyright (C) 1991-2001 Florida State University --
-- Copyright (C) 1991-2002 Florida State University --
-- --
-- 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- --
......@@ -304,33 +304,22 @@ begin
act.sa_mask := Signal_Mask;
Result :=
sigaction
(Signal (SIGFPE), act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
for J in Exception_Interrupts'First + 1 .. Exception_Interrupts'Last loop
for J in Exception_Interrupts'Range loop
Keep_Unmasked (Exception_Interrupts (J)) := True;
if Unreserve_All_Interrupts = 0 then
Result :=
sigaction
(Signal (Exception_Interrupts (J)),
act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
end if;
Result :=
sigaction
(Signal (Exception_Interrupts (J)),
act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
end loop;
Keep_Unmasked (Abort_Task_Interrupt) := True;
Keep_Unmasked (SIGXCPU) := True;
Keep_Unmasked (SIGBUS) := True;
Keep_Unmasked (SIGFPE) := True;
-- By keeping SIGINT unmasked, allow the user to do a Ctrl-C, but in the
-- same time, disable the ability of handling this signal
-- via Ada.Interrupts.
-- The pragma Unreserve_All_Interrupts let the user the ability to
-- The pragma Unreserve_All_Interrupts allows the user to
-- change this behavior.
if Unreserve_All_Interrupts = 0 then
......
gcc/ada/5lsystem.ads
......@@ -5,11 +5,11 @@
-- S Y S T E M --
-- --
-- S p e c --
-- (GNU/Linux/x86 Version) --
-- (GNU-Linux/x86 Version) --
-- --
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -88,32 +88,18 @@ pragma Pure (System);
-- Other System-Dependent Declarations
type Bit_Order is (High_Order_First, Low_Order_First);
Default_Bit_Order : constant Bit_Order :=
Bit_Order'Val (Standard'Default_Bit_Order);
Default_Bit_Order : constant Bit_Order := Low_Order_First;
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -131,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := True;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
......@@ -146,5 +135,5 @@ private
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;
Front_End_ZCX_Support : constant Boolean := False;
end System;
gcc/ada/5mvxwork.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $
-- $Revision$
-- --
-- Copyright (C) 1998-2001 Free Software Foundation --
-- Copyright (C) 1998-2001 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- --
......@@ -29,8 +29,7 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
......@@ -43,61 +42,18 @@ package System.VxWorks is
package IC renames Interfaces.C;
-- Define enough of a Wind Task Control Block in order to
-- obtain the inherited priority. When porting this to
-- different versions of VxWorks (this is based on 5.3[.1]),
-- be sure to look at the definition for WIND_TCB located
-- in $WIND_BASE/target/h/taskLib.h
type Wind_Fill_1 is array (0 .. 16#3F#) of IC.unsigned_char;
type Wind_Fill_2 is array (16#48# .. 16#107#) of IC.unsigned_char;
type Wind_TCB is record
Fill_1 : Wind_Fill_1; -- 0x00 - 0x3f
Priority : IC.int; -- 0x40 - 0x43, current (inherited) priority
Normal_Priority : IC.int; -- 0x44 - 0x47, base priority
Fill_2 : Wind_Fill_2; -- 0x48 - 0x107
spare1 : Address; -- 0x108 - 0x10b
spare2 : Address; -- 0x10c - 0x10f
spare3 : Address; -- 0x110 - 0x113
spare4 : Address; -- 0x114 - 0x117
end record;
type Wind_TCB_Ptr is access Wind_TCB;
-- Floating point context record. MIPS version
-- Floating point context record. MIPS version
FP_NUM_DREGS : constant := 16;
type Fpx_Array is array (1 .. FP_NUM_DREGS) of IC.double;
type FP_CONTEXT is record
fpx : Fpx_Array;
fpx : Fpx_Array;
fpcsr : IC.int;
end record;
pragma Convention (C, FP_CONTEXT);
-- Number of entries in hardware interrupt vector table. Value of
-- 0 disables hardware interrupt handling until it can be tested
Num_HW_Interrupts : constant := 0;
-- VxWorks 5.3 and 5.4 version
type TASK_DESC is record
td_id : IC.int; -- task id
td_name : Address; -- name of task
td_priority : IC.int; -- task priority
td_status : IC.int; -- task status
td_options : IC.int; -- task option bits (see below)
td_entry : Address; -- original entry point of task
td_sp : Address; -- saved stack pointer
td_pStackBase : Address; -- the bottom of the stack
td_pStackLimit : Address; -- the effective end of the stack
td_pStackEnd : Address; -- the actual end of the stack
td_stackSize : IC.int; -- size of stack in bytes
td_stackCurrent : IC.int; -- current stack usage in bytes
td_stackHigh : IC.int; -- maximum stack usage in bytes
td_stackMargin : IC.int; -- current stack margin in bytes
td_errorStatus : IC.int; -- most recent task error status
td_delay : IC.int; -- delay/timeout ticks
end record;
pragma Convention (C, TASK_DESC);
Num_HW_Interrupts : constant := 256;
-- Number of entries in hardware interrupt vector table.
end System.VxWorks;
gcc/ada/5ninmaop.adb
......@@ -2,14 +2,13 @@
-- --
-- GNU ADA 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 . --
-- O P E R A T I O N S --
-- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS --
-- --
-- B o d y --
-- --
-- $Revision: 1.5 $ --
-- $Revision$
-- --
-- Copyright (C) 1992-1998 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2001 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- --
......@@ -39,6 +38,10 @@
package body System.Interrupt_Management.Operations is
-- Turn off warnings since many unused formals
pragma Warnings (Off);
----------------------------
-- Thread_Block_Interrupt --
----------------------------
......
gcc/ada/5nosinte.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $
-- $Revision$
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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- --
......@@ -29,25 +29,21 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the no tasking version
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
subtype int is Interfaces.C.int;
-------------
-- Signals --
-------------
Max_Interrupt : constant := 2;
type Signal is new int range 0 .. Max_Interrupt;
type Signal is new Integer range 0 .. Max_Interrupt;
type sigset_t is new Integer;
type Thread_Id is new Integer;
......
gcc/ada/5ntaprop.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.33 $
-- $Revision$
-- --
-- Copyright (C) 1991-2001, Florida State University --
-- Copyright (C) 1992-2001, 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- --
......@@ -29,8 +29,7 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
......@@ -59,9 +58,9 @@ package body System.Task_Primitives.Operations is
use System.Parameters;
use System.OS_Primitives;
-------------------
-- Stack_Guard --
-------------------
-----------------
-- Stack_Guard --
-----------------
procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is
begin
......@@ -92,8 +91,7 @@ package body System.Task_Primitives.Operations is
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : access Lock)
is
L : access Lock) is
begin
null;
end Initialize_Lock;
......@@ -126,7 +124,9 @@ package body System.Task_Primitives.Operations is
Ceiling_Violation := False;
end Write_Lock;
procedure Write_Lock (L : access RTS_Lock) is
procedure Write_Lock
(L : access RTS_Lock; Global_Lock : Boolean := False)
is
begin
null;
end Write_Lock;
......@@ -154,7 +154,7 @@ package body System.Task_Primitives.Operations is
null;
end Unlock;
procedure Unlock (L : access RTS_Lock) is
procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
begin
null;
end Unlock;
......@@ -164,12 +164,11 @@ package body System.Task_Primitives.Operations is
null;
end Unlock;
-------------
-- Sleep --
-------------
-----------
-- Sleep --
-----------
procedure Sleep (Self_ID : Task_ID;
Reason : System.Tasking.Task_States) is
procedure Sleep (Self_ID : Task_ID; Reason : System.Tasking.Task_States) is
begin
null;
end Sleep;
......@@ -195,25 +194,11 @@ package body System.Task_Primitives.Operations is
-----------------
procedure Timed_Delay
(Self_ID : Task_ID;
Time : Duration;
Mode : ST.Delay_Modes)
is
Rel_Time : Duration;
procedure sleep (How_Long : Natural);
pragma Import (C, sleep, "sleep");
(Self_ID : Task_ID;
Time : Duration;
Mode : ST.Delay_Modes) is
begin
if Mode = Relative then
Rel_Time := Time;
else
Rel_Time := Time - Monotonic_Clock;
end if;
if Rel_Time > 0.0 then
sleep (Natural (Rel_Time));
end if;
null;
end Timed_Delay;
---------------------
......@@ -248,8 +233,8 @@ package body System.Task_Primitives.Operations is
------------------
procedure Set_Priority
(T : Task_ID;
Prio : System.Any_Priority;
(T : Task_ID;
Prio : System.Any_Priority;
Loss_Of_Inheritance : Boolean := False) is
begin
null;
......@@ -300,8 +285,7 @@ package body System.Task_Primitives.Operations is
Wrapper : System.Address;
Stack_Size : System.Parameters.Size_Type;
Priority : System.Any_Priority;
Succeeded : out Boolean)
is
Succeeded : out Boolean) is
begin
Succeeded := False;
end Create_Task;
......@@ -372,23 +356,23 @@ package body System.Task_Primitives.Operations is
return null;
end Environment_Task;
-------------------------
-- Lock_All_Tasks_List --
-------------------------
--------------
-- Lock_RTS --
--------------
procedure Lock_All_Tasks_List is
procedure Lock_RTS is
begin
null;
end Lock_All_Tasks_List;
end Lock_RTS;
---------------------------
-- Unlock_All_Tasks_List --
---------------------------
----------------
-- Unlock_RTS --
----------------
procedure Unlock_All_Tasks_List is
procedure Unlock_RTS is
begin
null;
end Unlock_All_Tasks_List;
end Unlock_RTS;
------------------
-- Suspend_Task --
......@@ -424,7 +408,6 @@ package body System.Task_Primitives.Operations is
No_Tasking : Boolean;
begin
-- Can't raise an exception because target independent packages try to
-- do an Abort_Defer, which gets a memory fault.
......
gcc/ada/5ointerr.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.5 $
-- $Revision$
-- --
-- Copyright (C) 1991-2000 Florida State University --
-- Copyright (C) 1991-2001 Florida State University --
-- --
-- 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- --
......@@ -43,6 +43,8 @@ with Ada.Exceptions;
package body System.Interrupts is
pragma Warnings (Off); -- kill warnings on unreferenced formals
use System.Tasking;
-----------------------
......
gcc/ada/5omastop.adb
......@@ -7,9 +7,9 @@
-- B o d y --
-- (Version for x86) --
-- --
-- $Revision: 1.1 $
-- $Revision$
-- --
-- Copyright (C) 1999-2001 Ada Core Technologies, Inc. --
-- Copyright (C) 1999-2002 Ada Core Technologies, 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- --
......@@ -41,6 +41,7 @@
with Unchecked_Conversion;
with System.Storage_Elements;
with System.Machine_Code; use System.Machine_Code;
with System.Memory;
package body System.Machine_State_Operations is
......@@ -54,11 +55,7 @@ package body System.Machine_State_Operations is
function To_Address is new Unchecked_Conversion (Uns32, Address);
function To_Uns32 is new Unchecked_Conversion (Integer, Uns32);
function To_Uns32 is new Unchecked_Conversion (Address, Uns32);
type Uns32_Ptr is access all Uns32;
function To_Uns32_Ptr is new Unchecked_Conversion (Address, Uns32_Ptr);
function To_Uns32_Ptr is new Unchecked_Conversion (Uns32, Uns32_Ptr);
-- Note: the type Uns32 has an alignment of 4. However, in some cases
......@@ -178,9 +175,12 @@ package body System.Machine_State_Operations is
Op_Immed : constant Bits6 := 2#100000#;
Op2_addl_Immed : constant Bits5 := 2#11100#;
pragma Unreferenced (Op2_addl_Immed);
Op2_subl_Immed : constant Bits5 := 2#11101#;
type Word_Byte is (Word, Byte);
pragma Unreferenced (Byte);
type Ins_addl_subl_byte is record
Op : Bits6; -- Set to Op_Immed
......@@ -329,14 +329,11 @@ package body System.Machine_State_Operations is
----------------------------
function Allocate_Machine_State return Machine_State is
use System.Storage_Elements;
function Gnat_Malloc (Size : Storage_Offset) return Machine_State;
pragma Import (C, Gnat_Malloc, "__gnat_malloc");
begin
return Gnat_Malloc (MState'Max_Size_In_Storage_Elements);
return Machine_State
(Memory.Alloc (MState'Max_Size_In_Storage_Elements));
end Allocate_Machine_State;
--------------------
......@@ -445,11 +442,8 @@ package body System.Machine_State_Operations is
------------------------
procedure Free_Machine_State (M : in out Machine_State) is
procedure Gnat_Free (M : in Machine_State);
pragma Import (C, Gnat_Free, "__gnat_free");
begin
Gnat_Free (M);
Memory.Free (Address (M));
M := Machine_State (Null_Address);
end Free_Machine_State;
......@@ -584,7 +578,11 @@ package body System.Machine_State_Operations is
procedure Set_Signal_Machine_State
(M : Machine_State;
Context : System.Address) is
Context : System.Address)
is
pragma Warnings (Off, M);
pragma Warnings (Off, Context);
begin
null;
end Set_Signal_Machine_State;
......
gcc/ada/5oosinte.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.3 $
-- $Revision$
-- --
-- Copyright (C) 1991-2001 Florida State University --
-- Copyright (C) 1991-2002 Florida State University --
-- --
-- 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- --
......@@ -40,7 +40,6 @@ 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.Strings;
with Interfaces.OS2Lib.Errors;
with Interfaces.OS2Lib.Synchronization;
......@@ -51,33 +50,6 @@ package body System.OS_Interface is
use Interfaces.OS2Lib.Synchronization;
use Interfaces.OS2Lib.Errors;
------------------
-- Timer (spec) --
------------------
-- Although the OS uses a 32-bit integer representing milliseconds
-- as timer value that doesn't work for us since 32 bits are not
-- enough for absolute timing. Also it is useful to use better
-- intermediate precision when adding/subtracting timing intervals.
-- So we use the standard Ada Duration type which is implemented using
-- microseconds.
-- Shouldn't the timer be moved to a separate package ???
type Timer is record
Handle : aliased HTIMER := NULLHANDLE;
Event : aliased HEV := NULLHANDLE;
end record;
procedure Initialize (T : out Timer);
procedure Finalize (T : in out Timer);
procedure Wait (T : in out Timer);
procedure Reset (T : in out Timer);
procedure Set_Timer_For (T : in out Timer; Period : in Duration);
procedure Set_Timer_At (T : in out Timer; Time : in Duration);
-- Add a hook to locate the Epoch, for use with Calendar????
-----------
-- Yield --
-----------
......@@ -147,110 +119,4 @@ package body System.OS_Interface is
return Tick_Count * Tick_Duration;
end Clock;
----------------------
-- Initialize Timer --
----------------------
procedure Initialize (T : out Timer) is
begin
pragma Assert
(T.Handle = NULLHANDLE, "GNULLI---Timer already initialized");
Must_Not_Fail (DosCreateEventSem
(pszName => Interfaces.C.Strings.Null_Ptr,
f_phev => T.Event'Unchecked_Access,
flAttr => DC_SEM_SHARED,
fState => False32));
end Initialize;
-------------------
-- Set_Timer_For --
-------------------
procedure Set_Timer_For
(T : in out Timer;
Period : in Duration)
is
Rel_Time : Duration_In_Millisec :=
Duration_In_Millisec (Period * 1_000.0);
begin
pragma Assert
(T.Event /= NULLHANDLE, "GNULLI---Timer not initialized");
pragma Assert
(T.Handle = NULLHANDLE, "GNULLI---Timer already in use");
Must_Not_Fail (DosAsyncTimer
(msec => ULONG (Rel_Time),
F_hsem => HSEM (T.Event),
F_phtimer => T.Handle'Unchecked_Access));
end Set_Timer_For;
------------------
-- Set_Timer_At --
------------------
-- Note that the timer is started in a critical section to prevent the
-- race condition when absolute time is converted to time relative to
-- current time. T.Event will be posted when the Time has passed
procedure Set_Timer_At
(T : in out Timer;
Time : in Duration)
is
Relative_Time : Duration;
begin
Must_Not_Fail (DosEnterCritSec);
begin
Relative_Time := Time - Clock;
if Relative_Time > 0.0 then
Set_Timer_For (T, Period => Time - Clock);
else
Sem_Must_Not_Fail (DosPostEventSem (T.Event));
end if;
end;
Must_Not_Fail (DosExitCritSec);
end Set_Timer_At;
----------
-- Wait --
----------
procedure Wait (T : in out Timer) is
begin
Sem_Must_Not_Fail (DosWaitEventSem (T.Event, SEM_INDEFINITE_WAIT));
T.Handle := NULLHANDLE;
end Wait;
-----------
-- Reset --
-----------
procedure Reset (T : in out Timer) is
Dummy_Count : aliased ULONG;
begin
if T.Handle /= NULLHANDLE then
Must_Not_Fail (DosStopTimer (T.Handle));
T.Handle := NULLHANDLE;
end if;
Sem_Must_Not_Fail
(DosResetEventSem (T.Event, Dummy_Count'Unchecked_Access));
end Reset;
--------------
-- Finalize --
--------------
procedure Finalize (T : in out Timer) is
begin
Reset (T);
Must_Not_Fail (DosCloseEventSem (T.Event));
T.Event := NULLHANDLE;
end Finalize;
end System.OS_Interface;
gcc/ada/5osystem.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (OS/2 Version) --
-- --
-- $Revision: 1.9 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -88,32 +88,18 @@ pragma Pure (System);
-- Other System-Dependent Declarations
type Bit_Order is (High_Order_First, Low_Order_First);
Default_Bit_Order : constant Bit_Order :=
Bit_Order'Val (Standard'Default_Bit_Order);
Default_Bit_Order : constant Bit_Order := Low_Order_First;
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -131,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := True;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
......@@ -146,6 +135,6 @@ private
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;
Front_End_ZCX_Support : constant Boolean := True;
end System;
gcc/ada/5otaspri.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $
-- $Revision$
-- --
-- Copyright (C) 1991-1999 Florida State University --
-- Copyright (C) 1991-2001 Florida State University --
-- --
-- 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- --
......@@ -69,13 +69,12 @@ package System.Task_Primitives is
-- private
type Lock is
record
Mutex : aliased Interfaces.OS2Lib.Synchronization.HMTX;
Priority : Integer;
Owner_Priority : Integer;
Owner_ID : Address;
end record;
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;
......
gcc/ada/5pvxwork.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $ --
-- $Revision$
-- --
-- Copyright (C) 1998 - 2001 Free Software Foundation --
-- Copyright (C) 1998-2001 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- --
......@@ -34,8 +34,7 @@
-- --
------------------------------------------------------------------------------
-- This is the PPC VxWorks 5.x version of this package. A different version
-- is used for VxWorks 6.0
-- This is the PPC VxWorks version of this package.
with Interfaces.C;
......@@ -44,60 +43,18 @@ package System.VxWorks is
package IC renames Interfaces.C;
-- Define enough of a Wind Task Control Block in order to
-- obtain the inherited priority. When porting this to
-- different versions of VxWorks (this is based on 5.3[.1]),
-- be sure to look at the definition for WIND_TCB located
-- in $WIND_BASE/target/h/taskLib.h
type Wind_Fill_1 is array (0 .. 16#3F#) of IC.unsigned_char;
type Wind_Fill_2 is array (16#48# .. 16#107#) of IC.unsigned_char;
type Wind_TCB is record
Fill_1 : Wind_Fill_1; -- 0x00 - 0x3f
Priority : IC.int; -- 0x40 - 0x43, current (inherited) priority
Normal_Priority : IC.int; -- 0x44 - 0x47, base priority
Fill_2 : Wind_Fill_2; -- 0x48 - 0x107
spare1 : Address; -- 0x108 - 0x10b
spare2 : Address; -- 0x10c - 0x10f
spare3 : Address; -- 0x110 - 0x113
spare4 : Address; -- 0x114 - 0x117
end record;
type Wind_TCB_Ptr is access Wind_TCB;
-- Floating point context record. PPC version
-- Floating point context record. PPC version
FP_NUM_DREGS : constant := 32;
type Fpr_Array is array (1 .. FP_NUM_DREGS) of IC.double;
type FP_CONTEXT is record
fpr : Fpr_Array;
fpr : Fpr_Array;
fpcsr : IC.int;
pad : IC.int;
pad : IC.int;
end record;
pragma Convention (C, FP_CONTEXT);
Num_HW_Interrupts : constant := 256;
-- VxWorks 5.3 and 5.4 version
type TASK_DESC is record
td_id : IC.int; -- task id
td_name : Address; -- name of task
td_priority : IC.int; -- task priority
td_status : IC.int; -- task status
td_options : IC.int; -- task option bits (see below)
td_entry : Address; -- original entry point of task
td_sp : Address; -- saved stack pointer
td_pStackBase : Address; -- the bottom of the stack
td_pStackLimit : Address; -- the effective end of the stack
td_pStackEnd : Address; -- the actual end of the stack
td_stackSize : IC.int; -- size of stack in bytes
td_stackCurrent : IC.int; -- current stack usage in bytes
td_stackHigh : IC.int; -- maximum stack usage in bytes
td_stackMargin : IC.int; -- current stack margin in bytes
td_errorStatus : IC.int; -- most recent task error status
td_delay : IC.int; -- delay/timeout ticks
end record;
pragma Convention (C, TASK_DESC);
end System.VxWorks;
gcc/ada/5qparame.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . P A R A M E T E R S --
-- --
-- S p e c --
-- --
-- $Revision$
-- --
-- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the RT-GNU/Linux version.
-- Blank line intentional so that it lines up exactly with default.
-- This package defines some system dependent parameters for GNAT. These
-- are values that are referenced by the runtime library and are therefore
-- relevant to the target machine.
-- The parameters whose value is defined in the spec are not generally
-- expected to be changed. If they are changed, it will be necessary to
-- recompile the run-time library.
-- The parameters which are defined by functions can be changed by modifying
-- the body of System.Parameters in file s-parame.adb. A change to this body
-- requires only rebinding and relinking of the application.
-- Note: do not introduce any pragma Inline statements into this unit, since
-- otherwise the relinking and rebinding capability would be deactivated.
package System.Parameters is
pragma Pure (Parameters);
---------------------------------------
-- Task And Stack Allocation Control --
---------------------------------------
type Task_Storage_Size is new Integer;
-- Type used in tasking units for task storage size
type Size_Type is new Task_Storage_Size;
-- Type used to provide task storage size to runtime
Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set
subtype Ratio is Size_Type range -1 .. 100;
Dynamic : constant Size_Type := 10;
-- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is
-- used by the secondary stack (the rest being the primary stack).
-- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead.
Sec_Stack_Ratio : constant Ratio := Dynamic;
-- This constant defines the handling of the secondary stack
Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Ratio = Dynamic;
-- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type;
-- Default task stack size used if none is specified
function Minimum_Stack_Size return Size_Type;
-- Minimum task stack size permitted
function Adjust_Storage_Size (Size : Size_Type) return Size_Type;
-- Given the storage size stored in the TCB, return the Storage_Size
-- value required by the RM for the Storage_Size attribute. The
-- required adjustment is as follows:
--
-- when Size = Unspecified_Size, return Default_Stack_Size
-- when Size < Minimum_Stack_Size, return Minimum_Stack_Size
-- otherwise return given Size
Stack_Grows_Down : constant Boolean := True;
-- This constant indicates whether the stack grows up (False) or
-- down (True) in memory as functions are called. It is used for
-- proper implementation of the stack overflow check.
----------------------------------------------
-- Characteristics of types in Interfaces.C --
----------------------------------------------
long_bits : constant := Long_Integer'Size;
-- Number of bits in type long and unsigned_long. The normal convention
-- is that this is the same as type Long_Integer, but this is not true
-- of all targets. For example, in OpenVMS long /= Long_Integer.
----------------------------------------------
-- Behavior of Pragma Finalize_Storage_Only --
----------------------------------------------
-- Garbage_Collected is a Boolean constant whose value indicates the
-- effect of the pragma Finalize_Storage_Entry on a controlled type.
-- Garbage_Collected = False
-- The system releases all storage on program termination only,
-- but not other garbage collection occurs, so finalization calls
-- are ommitted only for outer level onjects can be omitted if
-- pragma Finalize_Storage_Only is used.
-- Garbage_Collected = True
-- The system provides full garbage collection, so it is never
-- necessary to release storage for controlled objects for which
-- a pragma Finalize_Storage_Only is used.
Garbage_Collected : constant Boolean := False;
-- The storage mode for this system (release on program exit)
end System.Parameters;
gcc/ada/5qtaprop.adb
......@@ -8,7 +8,7 @@
-- --
-- $Revision$
-- --
-- Copyright (C) 1991-2001, Florida State University --
-- Copyright (C) 1992-2001, 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- --
......@@ -29,8 +29,7 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
......@@ -185,8 +184,10 @@ package body System.Task_Primitives.Operations is
-- In the current implementation, this is the task assigned permanently
-- as the regular GNU/Linux kernel.
All_Tasks_L : aliased RTS_Lock;
-- See comments on locking rules in System.Tasking (spec).
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at
-- a time; it is used to execute in mutual exclusion from all other tasks.
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
-- The followings are internal configuration constants needed.
Next_Serial_Number : Task_Serial_Number := 100;
......@@ -722,12 +723,10 @@ package body System.Task_Primitives.Operations is
-- Write_Lock --
----------------
procedure Write_Lock
(L : access Lock;
Ceiling_Violation : out Boolean)
is
procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
Prio : constant System.Any_Priority :=
Current_Task.Common.LL.Active_Priority;
begin
pragma Debug (Printk ("procedure Write_Lock called" & LF));
......@@ -756,7 +755,9 @@ package body System.Task_Primitives.Operations is
end if;
end Write_Lock;
procedure Write_Lock (L : access RTS_Lock) is
procedure Write_Lock
(L : access RTS_Lock; Global_Lock : Boolean := False)
is
Prio : constant System.Any_Priority :=
Current_Task.Common.LL.Active_Priority;
......@@ -872,7 +873,7 @@ package body System.Task_Primitives.Operations is
end if;
end Unlock;
procedure Unlock (L : access RTS_Lock) is
procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
Flags : Integer;
begin
pragma Debug (Printk ("procedure Unlock (RTS_Lock) called" & LF));
......@@ -1607,27 +1608,23 @@ package body System.Task_Primitives.Operations is
return Environment_Task_ID;
end Environment_Task;
-------------------------
-- Lock_All_Tasks_List --
-------------------------
--------------
-- Lock_RTS --
--------------
procedure Lock_All_Tasks_List is
procedure Lock_RTS is
begin
pragma Debug (Printk ("procedure Lock_All_Tasks_List called" & LF));
Write_Lock (All_Tasks_L'Access);
end Lock_All_Tasks_List;
Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
end Lock_RTS;
---------------------------
-- Unlock_All_Tasks_List --
---------------------------
----------------
-- Unlock_RTS --
----------------
procedure Unlock_All_Tasks_List is
procedure Unlock_RTS is
begin
pragma Debug (Printk ("procedure Unlock_All_Tasks_List called" & LF));
Unlock (All_Tasks_L'Access);
end Unlock_All_Tasks_List;
Unlock (Single_RTS_Lock'Access, Global_Lock => True);
end Unlock_RTS;
-----------------
-- Stack_Guard --
......@@ -1770,7 +1767,10 @@ package body System.Task_Primitives.Operations is
-- Initialize the lock used to synchronize chain of all ATCBs.
Initialize_Lock (All_Tasks_L'Access, All_Tasks_Level);
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
-- Single_Lock isn't supported in this configuration
pragma Assert (not Single_Lock);
Enter_Task (Environment_Task);
end Initialize;
......
gcc/ada/5qvxwork.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . V X W O R K S --
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $ --
-- --
-- Copyright (C) 1998 - 2001 Free Software Foundation --
-- --
-- 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the PPC VxWorks 6.0 version of this package. A different version
-- is used for VxWorks 5.x
with Interfaces.C;
package System.VxWorks is
pragma Preelaborate (System.VxWorks);
package IC renames Interfaces.C;
-- Define enough of a Wind Task Control Block in order to
-- obtain the inherited priority. When porting this to
-- different versions of VxWorks (this is based on 6.0),
-- be sure to look at the definition for WIND_TCB located
-- in $WIND_BASE/target/h/taskLib.h
type Wind_Fill_1 is array (0 .. 16#6B#) of IC.unsigned_char;
type Wind_Fill_2 is array (16#74# .. 16#10F#) of IC.unsigned_char;
type Wind_TCB is record
Fill_1 : Wind_Fill_1; -- 0x00 - 0x6b
Priority : IC.int; -- 0x6c - 0x6f, current (inherited) priority
Normal_Priority : IC.int; -- 0x70 - 0x73, base priority
Fill_2 : Wind_Fill_2; -- 0x74 - 0x10f
spare1 : Address; -- 0x110 - 0x113
spare2 : Address; -- 0x114 - 0x117
spare3 : Address; -- 0x118 - 0x11b
spare4 : Address; -- 0x11c - 0x11f
end record;
type Wind_TCB_Ptr is access Wind_TCB;
-- Floating point context record. PPC version
FP_NUM_DREGS : constant := 32;
type Fpr_Array is array (1 .. FP_NUM_DREGS) of IC.double;
type FP_CONTEXT is record
fpr : Fpr_Array;
fpcsr : IC.int;
pad : IC.int;
end record;
pragma Convention (C, FP_CONTEXT);
Num_HW_Interrupts : constant := 256;
-- For VxWorks 6.0
type TASK_DESC is record
td_id : IC.int; -- task id
td_priority : IC.int; -- task priority
td_status : IC.int; -- task status
td_options : IC.int; -- task option bits (see below)
td_entry : Address; -- original entry point of task
td_sp : Address; -- saved stack pointer
td_pStackBase : Address; -- the bottom of the stack
td_pStackLimit : Address; -- the effective end of the stack
td_pStackEnd : Address; -- the actual end of the stack
td_stackSize : IC.int; -- size of stack in bytes
td_stackCurrent : IC.int; -- current stack usage in bytes
td_stackHigh : IC.int; -- maximum stack usage in bytes
td_stackMargin : IC.int; -- current stack margin in bytes
td_PExcStkBase : Address; -- exception stack base
td_PExcStkPtr : Address; -- exception stack pointer
td_ExcStkHigh : IC.int; -- exception stack max usage
td_ExcStkMgn : IC.int; -- exception stack margin
td_errorStatus : IC.int; -- most recent task error status
td_delay : IC.int; -- delay/timeout ticks
td_PdId : Address; -- task's home protection domain
td_name : Address; -- name of task
end record;
pragma Convention (C, TASK_DESC);
end System.VxWorks;
gcc/ada/5sintman.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.21 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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- --
......@@ -173,13 +173,6 @@ begin
act.sa_mask := mask;
Keep_Unmasked (Abort_Task_Interrupt) := True;
Keep_Unmasked (SIGXCPU) := True;
Keep_Unmasked (SIGFPE) := True;
Result :=
sigaction
(Signal (SIGFPE), act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
-- By keeping SIGINT unmasked, allow the user to do a Ctrl-C, but in the
-- same time, disable the ability of handling this signal
......@@ -191,17 +184,13 @@ begin
Keep_Unmasked (SIGINT) := True;
end if;
for J in
Exception_Interrupts'First + 1 .. Exception_Interrupts'Last loop
for J in Exception_Interrupts'Range loop
Keep_Unmasked (Exception_Interrupts (J)) := True;
if Unreserve_All_Interrupts = 0 then
Result :=
sigaction
(Signal (Exception_Interrupts (J)), act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
end if;
Result :=
sigaction
(Signal (Exception_Interrupts (J)), act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
end loop;
for J in Unmasked'Range loop
......
gcc/ada/5smastop.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- SYSTEM.MACHINE_STATE_OPERATIONS --
-- --
-- B o d y --
-- (Version using the GCC stack unwinding mechanism) --
-- --
-- $Revision: 1.3 $
-- --
-- Copyright (C) 1999-2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This version of System.Machine_State_Operations is for use on
-- systems where the GCC stack unwinding mechanism is supported.
-- It is currently only used on Solaris
package body System.Machine_State_Operations is
use System.Storage_Elements;
use System.Exceptions;
----------------------------
-- Allocate_Machine_State --
----------------------------
function Allocate_Machine_State return Machine_State is
function Machine_State_Length return Storage_Offset;
pragma Import (C, Machine_State_Length, "__gnat_machine_state_length");
function Gnat_Malloc (Size : Storage_Offset) return Machine_State;
pragma Import (C, Gnat_Malloc, "__gnat_malloc");
begin
return Gnat_Malloc (Machine_State_Length);
end Allocate_Machine_State;
-------------------
-- Enter_Handler --
-------------------
procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
procedure c_enter_handler (m : Machine_State; handler : Handler_Loc);
pragma Import (C, c_enter_handler, "__gnat_enter_handler");
begin
c_enter_handler (M, Handler);
end Enter_Handler;
----------------
-- Fetch_Code --
----------------
function Fetch_Code (Loc : Code_Loc) return Code_Loc is
begin
return Loc;
end Fetch_Code;
------------------------
-- Free_Machine_State --
------------------------
procedure Free_Machine_State (M : in out Machine_State) is
procedure Gnat_Free (M : in Machine_State);
pragma Import (C, Gnat_Free, "__gnat_free");
begin
Gnat_Free (M);
M := Machine_State (Null_Address);
end Free_Machine_State;
------------------
-- Get_Code_Loc --
------------------
function Get_Code_Loc (M : Machine_State) return Code_Loc is
function c_get_code_loc (m : Machine_State) return Code_Loc;
pragma Import (C, c_get_code_loc, "__gnat_get_code_loc");
begin
return c_get_code_loc (M);
end Get_Code_Loc;
--------------------------
-- Machine_State_Length --
--------------------------
function Machine_State_Length return Storage_Offset is
function c_machine_state_length return Storage_Offset;
pragma Import (C, c_machine_state_length, "__gnat_machine_state_length");
begin
return c_machine_state_length;
end Machine_State_Length;
---------------
-- Pop_Frame --
---------------
procedure Pop_Frame
(M : Machine_State;
Info : Subprogram_Info_Type)
is
procedure c_pop_frame (m : Machine_State);
pragma Import (C, c_pop_frame, "__gnat_pop_frame");
begin
c_pop_frame (M);
end Pop_Frame;
-----------------------
-- Set_Machine_State --
-----------------------
procedure Set_Machine_State (M : Machine_State) is
procedure c_set_machine_state (m : Machine_State);
pragma Import (C, c_set_machine_state, "__gnat_set_machine_state");
begin
c_set_machine_state (M);
Pop_Frame (M, System.Null_Address);
end Set_Machine_State;
------------------------------
-- Set_Signal_Machine_State --
------------------------------
procedure Set_Signal_Machine_State
(M : Machine_State;
Context : System.Address) is
begin
null;
end Set_Signal_Machine_State;
end System.Machine_State_Operations;
gcc/ada/5ssystem.ads
......@@ -7,9 +7,9 @@
-- S p e c --
-- (SUN Solaris Version) --
-- --
-- $Revision: 1.14 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2002 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 --
......@@ -60,16 +60,16 @@ pragma Pure (System);
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := Standard'Tick;
Tick : constant := 1.0;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
Storage_Unit : constant := 8;
Word_Size : constant := 32;
Memory_Size : constant := 2 ** 32;
-- Address comparison
......@@ -92,27 +92,14 @@ pragma Pure (System);
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
subtype Any_Priority is Integer
range 0 .. Standard'Max_Interrupt_Priority;
subtype Priority is Any_Priority
range 0 .. Standard'Max_Priority;
-- Functional notation is needed in the following to avoid visibility
-- problems when this package is compiled through rtsfind in the middle
-- of another compilation.
subtype Interrupt_Priority is Any_Priority
range
Standard."+" (Standard'Max_Priority, 1) ..
Standard'Max_Interrupt_Priority;
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 :=
Standard."/" (Standard."+" (Priority'First, Priority'Last), 2);
Default_Priority : constant Priority := 15;
private
......@@ -130,8 +117,11 @@ private
-- 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;
Denorm : constant Boolean := True;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Functions_Return_By_DSP : constant Boolean := False;
Long_Shifts_Inlined : constant Boolean := True;
......
gcc/ada/5stpopse.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.2 $ --
-- $Revision$
-- --
-- Copyright (C) 1991-1998, Florida State University --
-- Copyright (C) 1992-2002, 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- --
......@@ -139,6 +139,17 @@ separate (System.Task_Primitives.Operations)
-- been elaborated.
function Self return Task_ID is
ATCB_Magic_Code : constant := 16#ADAADAAD#;
-- This is used to allow us to catch attempts to call Self
-- from outside an Ada task, with high probability.
-- For an Ada task, Task_Wrapper.Magic_Number = ATCB_Magic_Code.
type Iptr is access Interfaces.C.unsigned;
function To_Iptr is new Unchecked_Conversion (Interfaces.C.unsigned, Iptr);
type Ptr is access Task_ID;
function To_Ptr is new Unchecked_Conversion (Interfaces.C.unsigned, Ptr);
X : Ptr;
Result : Interfaces.C.int;
......
gcc/ada/5svxwork.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $ --
-- $Revision$
-- --
-- Copyright (C) 1998-2001 Free Software Foundation --
-- Copyright (C) 1998-2002 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- --
......@@ -29,42 +29,18 @@
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the SPARC64 VxWorks version of this package.
-- This is the Sparc64 VxWorks version of this package.
with Interfaces.C;
with Interfaces;
package System.VxWorks is
pragma Preelaborate (System.VxWorks);
package IC renames Interfaces.C;
-- Define enough of a Wind Task Control Block in order to
-- obtain the inherited priority. When porting this to
-- different versions of VxWorks (this is based on 5.3[.1]),
-- be sure to look at the definition for WIND_TCB located
-- in $WIND_BASE/target/h/taskLib.h
type Wind_Fill_1 is array (0 .. 16#3F#) of IC.unsigned_char;
type Wind_Fill_2 is array (16#48# .. 16#107#) of IC.unsigned_char;
type Wind_TCB is record
Fill_1 : Wind_Fill_1; -- 0x00 - 0x3f
Priority : IC.int; -- 0x40 - 0x43, current (inherited) priority
Normal_Priority : IC.int; -- 0x44 - 0x47, base priority
Fill_2 : Wind_Fill_2; -- 0x48 - 0x107
spare1 : Address; -- 0x108 - 0x10b
spare2 : Address; -- 0x10c - 0x10f
spare3 : Address; -- 0x110 - 0x113
spare4 : Address; -- 0x114 - 0x117
end record;
type Wind_TCB_Ptr is access Wind_TCB;
-- Floating point context record. SPARCV9 version
-- Floating point context record. SPARCV9 version
FP_NUM_DREGS : constant := 32;
......@@ -75,37 +51,14 @@ package System.VxWorks is
for Fpd_Array'Alignment use 8;
type FP_CONTEXT is record
fpd : Fpd_Array;
fsr : RType;
fpd : Fpd_Array;
fsr : RType;
end record;
for FP_CONTEXT'Alignment use 8;
pragma Convention (C, FP_CONTEXT);
-- Number of entries in hardware interrupt vector table. Value of
-- 0 disables hardware interrupt handling until we have time to test it
-- on this target.
Num_HW_Interrupts : constant := 0;
-- VxWorks 5.3 and 5.4 version
type TASK_DESC is record
td_id : IC.int; -- task id
td_name : Address; -- name of task
td_priority : IC.int; -- task priority
td_status : IC.int; -- task status
td_options : IC.int; -- task option bits (see below)
td_entry : Address; -- original entry point of task
td_sp : Address; -- saved stack pointer
td_pStackBase : Address; -- the bottom of the stack
td_pStackLimit : Address; -- the effective end of the stack
td_pStackEnd : Address; -- the actual end of the stack
td_stackSize : IC.int; -- size of stack in bytes
td_stackCurrent : IC.int; -- current stack usage in bytes
td_stackHigh : IC.int; -- maximum stack usage in bytes
td_stackMargin : IC.int; -- current stack margin in bytes
td_errorStatus : IC.int; -- most recent task error status
td_delay : IC.int; -- delay/timeout ticks
end record;
pragma Convention (C, TASK_DESC);
Num_HW_Interrupts : constant := 256;
-- Number of entries in hardware interrupt vector table.
end System.VxWorks;
gcc/ada/5tosinte.ads
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.26 $
-- $Revision$
-- --
-- Copyright (C) 1997-2001, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2002, 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- --
......@@ -120,6 +120,8 @@ package System.OS_Interface is
SIGFREEZE : constant := 34; -- used by CPR (Solaris)
SIGTHAW : constant := 35; -- used by CPR (Solaris)
SIGCANCEL : constant := 36; -- used for thread cancel (Solaris)
SIGRTMIN : constant := 38; -- first (highest-priority) realtime signal
SIGRTMAX : constant := 45; -- last (lowest-priority) realtime signal
type Signal_Set is array (Natural range <>) of Signal;
......@@ -127,7 +129,7 @@ package System.OS_Interface is
(SIGTRAP, SIGLWP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF);
Reserved : constant Signal_Set :=
(SIGKILL, SIGSTOP, SIGALRM, SIGVTALRM, SIGWAITING);
(SIGKILL, SIGSTOP, SIGALRM, SIGVTALRM, SIGWAITING, SIGRTMAX);
type sigset_t is private;
......
gcc/ada/5uintman.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.15 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2001 Florida State University --
-- Copyright (C) 1991-2002 Florida State University --
-- --
-- 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- --
......@@ -208,28 +208,18 @@ begin
for J in Exception_Interrupts'Range loop
Keep_Unmasked (Exception_Interrupts (J)) := True;
if Unreserve_All_Interrupts = 0 then
Result :=
sigaction
(Signal (Exception_Interrupts (J)),
act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
end if;
Result :=
sigaction
(Signal (Exception_Interrupts (J)),
act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
end loop;
Keep_Unmasked (Abort_Task_Interrupt) := True;
Keep_Unmasked (SIGBUS) := True;
Keep_Unmasked (SIGFPE) := True;
Result :=
sigaction
(Signal (SIGFPE), act'Unchecked_Access,
old_act'Unchecked_Access);
Keep_Unmasked (SIGALRM) := True;
Keep_Unmasked (SIGSTOP) := True;
Keep_Unmasked (SIGKILL) := True;
Keep_Unmasked (SIGXCPU) := True;
-- By keeping SIGINT unmasked, allow the user to do a Ctrl-C, but at
-- the same time, disable the ability of handling this signal using
......
gcc/ada/5vasthan.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.18 $
-- $Revision$
-- --
-- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1996-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- --
......@@ -60,7 +60,6 @@ with Ada.Task_Identification;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body System.AST_Handling is
......@@ -162,12 +161,6 @@ package body System.AST_Handling is
function To_AST_Handler is new Ada.Unchecked_Conversion
(AST_Handler_Data_Ref, System.Aux_DEC.AST_Handler);
function To_AST_Data_Handler_Ref is new Ada.Unchecked_Conversion
(System.Aux_DEC.AST_Handler, AST_Handler_Data_Ref);
function To_AST_Data_Handler_Ref is new Ada.Unchecked_Conversion
(AST_Handler, AST_Handler_Data_Ref);
-- Each time Create_AST_Handler is called, a new value of this record
-- type is created, containing a copy of the procedure descriptor for
-- the routine used to handle all AST's (Process_AST), and the Task_Id
......@@ -198,9 +191,6 @@ package body System.AST_Handling is
type AST_Handler_Vector is array (Natural range <>) of AST_Handler_Data;
type AST_Handler_Vector_Ref is access all AST_Handler_Vector;
procedure Free is new Ada.Unchecked_Deallocation
(Object => AST_Handler_Vector,
Name => AST_Handler_Vector_Ref);
-- type AST_Vector_Ptr is new Ada.Finalization.Controlled with record
-- removed due to problem with controlled attribute, consequence is that
......@@ -211,9 +201,6 @@ package body System.AST_Handling is
Vector : AST_Handler_Vector_Ref;
end record;
procedure Finalize (Object : in out AST_Vector_Ptr);
-- Used to get rid of allocated AST_Vector's
AST_Vector_Init : AST_Vector_Ptr;
-- Initial value, treated as constant, Vector will be null.
......@@ -308,9 +295,6 @@ package body System.AST_Handling is
type AST_Server_Task_Ptr is access all AST_Server_Task;
-- Type used to allocate server tasks
function To_Integer is new Ada.Unchecked_Conversion
(ATID.Task_Id, Integer);
-----------------------
-- Local Subprograms --
-----------------------
......@@ -532,15 +516,6 @@ package body System.AST_Handling is
Total_Number := AST_Service_Queue_Size;
end Expand_AST_Packet_Pool;
--------------
-- Finalize --
--------------
procedure Finalize (Object : in out AST_Vector_Ptr) is
begin
Free (Object.Vector);
end Finalize;
-----------------
-- Process_AST --
-----------------
......
gcc/ada/5vinmaop.adb
......@@ -7,9 +7,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.8 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2000 Florida State University --
-- Copyright (C) 1991-2001 Florida State University --
-- --
-- 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- --
......@@ -57,7 +57,6 @@ package body System.Interrupt_Management.Operations is
use type unsigned_short;
function To_Address is new Unchecked_Conversion (Task_ID, System.Address);
function To_Task_ID is new Unchecked_Conversion (System.Address, Task_ID);
package POP renames System.Task_Primitives.Operations;
----------------------------
......
gcc/ada/5vintman.adb
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.6 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1991-2000, Florida State University --
-- Copyright (C) 1991-2001, Florida State University --
-- --
-- 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- --
......@@ -50,8 +50,6 @@ package body System.Interrupt_Management is
use System.OS_Interface;
use type unsigned_long;
type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
---------------------------
-- Initialize_Interrupts --
---------------------------
......
gcc/ada/5vmastop.adb
......@@ -7,9 +7,9 @@
-- B o d y --
-- (Version for Alpha/VMS) --
-- --
-- $Revision: 1.3 $
-- $Revision$
-- --
-- Copyright (C) 2001 Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2002 Ada Core Technologies, 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- --
......@@ -65,13 +65,6 @@ package body System.Machine_State_Operations is
end record;
for ICB_Fflags_Bits_Type'Size use 24;
ICB_Fflags_Bits_Type_Init : constant ICB_Fflags_Bits_Type :=
(ExceptIon_Frame => False,
Ast_Frame => False,
Bottom_Of_STACK => False,
Base_Frame => False,
Filler_1 => 0);
type ICB_Hdr_Quad_Type is record
Context_Length : Unsigned_Longword;
Fflags_Bits : ICB_Fflags_Bits_Type;
......@@ -85,11 +78,6 @@ package body System.Machine_State_Operations is
end record;
for ICB_Hdr_Quad_Type'Size use 64;
ICB_Hdr_Quad_Type_Init : constant ICB_Hdr_Quad_Type :=
(Context_Length => 0,
Fflags_Bits => ICB_Fflags_Bits_Type_Init,
Block_Version => 0);
type Invo_Context_Blk_Type is record
--
-- The first quadword contains:
......@@ -150,16 +138,6 @@ package body System.Machine_State_Operations is
end record;
for Invo_Context_Blk_Type'Size use 4352;
Invo_Context_Blk_Type_Init : constant Invo_Context_Blk_Type :=
(Hdr_Quad => ICB_Hdr_Quad_Type_Init,
Procedure_Descriptor => (0, 0),
Program_Counter => 0,
Processor_Status => 0,
Ireg => (others => (0, 0)),
Freg => (others => (0, 0)),
System_Defined => (others => (0, 0)),
Filler_1 => (others => ASCII.NUL));
subtype Invo_Handle_Type is Unsigned_Longword;
type Invo_Handle_Access_Type is access all Invo_Handle_Type;
......@@ -172,9 +150,6 @@ package body System.Machine_State_Operations is
function To_Machine_State is new Unchecked_Conversion
(System.Address, Machine_State);
function To_Code_Loc is new Unchecked_Conversion
(Unsigned_Longword, Code_Loc);
----------------------------
-- Allocate_Machine_State --
----------------------------
......@@ -244,11 +219,8 @@ package body System.Machine_State_Operations is
------------------------
procedure Free_Machine_State (M : in out Machine_State) is
procedure Gnat_Free (M : in Invo_Handle_Access_Type);
pragma Import (C, Gnat_Free, "__gnat_free");
begin
Gnat_Free (To_Invo_Handle_Access (M));
Memory.Free (Address (M));
M := Machine_State (Null_Address);
end Free_Machine_State;
......
gcc/ada/Makefile.in
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/gnatcmd.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/mkdir.c 0 → 100644
This diff is collapsed. Click to expand it.
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