procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2014-08-01  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Remove VMS specific rules for pragma Ident.
	* Makefile.rtl, adaint.c, gnat_rm.texi, s-asthan.adb, s-asthan.ads,
	s-filofl.ads, s-fishfl.ads, s-fvadfl.ads, s-fvaffl.ads, s-fvagfl.ads,
	s-po32gl.adb, s-po32gl.ads, s-vaflop.adb, s-vaflop.ads, s-vmexta.adb,
	s-vmexta.ads, sem_vfpt.adb, sem_vfpt.ads, socket.c: Remove VMS specific
	code.
	* gcc-interface/decl.c, gcc-interface/Makefile.in,
	gcc-interface/Make-lang.in: Ditto. Also remove refs to rTX.

2014-08-01  Pascal Obry  <obry@adacore.com>

	* s-os_lib.ads: Rename File_Size to Large_File_Size.

From-SVN: r213438
This commit is contained in:
Arnaud Charlet 2014-08-01 11:55:31 +02:00
parent 21c51f53f0
commit e08add8ea9
24 changed files with 87 additions and 2847 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/ada/ChangeLog
View file

@ -1,3 +1,18 @@
2014-08-01 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Remove VMS specific rules for pragma Ident.
* Makefile.rtl, adaint.c, gnat_rm.texi, s-asthan.adb, s-asthan.ads,
s-filofl.ads, s-fishfl.ads, s-fvadfl.ads, s-fvaffl.ads, s-fvagfl.ads,
s-po32gl.adb, s-po32gl.ads, s-vaflop.adb, s-vaflop.ads, s-vmexta.adb,
s-vmexta.ads, sem_vfpt.adb, sem_vfpt.ads, socket.c: Remove VMS specific
code.
* gcc-interface/decl.c, gcc-interface/Makefile.in,
gcc-interface/Make-lang.in: Ditto. Also remove refs to rTX.
2014-08-01 Pascal Obry <obry@adacore.com>
* s-os_lib.ads: Rename File_Size to Large_File_Size.
2014-08-01 Robert Dewar <dewar@adacore.com>
* a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads,

8
gcc/ada/Makefile.rtl
View file

@ -44,7 +44,6 @@ GNATRTL_TASKING_OBJS= \
g-signal$(objext) \
g-tastus$(objext) \
g-thread$(objext) \
s-asthan$(objext) \
s-inmaop$(objext) \
s-interr$(objext) \
s-intman$(objext) \
@ -540,15 +539,10 @@ GNATRTL_NONTASKING_OBJS= \
s-ficobl$(objext) \
s-filatt$(objext) \
s-fileio$(objext) \
s-filofl$(objext) \
s-finmas$(objext) \
s-finroo$(objext) \
s-fishfl$(objext) \
s-flocon$(objext) \
s-fore$(objext) \
s-fvadfl$(objext) \
s-fvaffl$(objext) \
s-fvagfl$(objext) \
s-gearop$(objext) \
s-geveop$(objext) \
s-gloloc$(objext) \
@ -674,7 +668,6 @@ GNATRTL_NONTASKING_OBJS= \
s-traent$(objext) \
s-unstyp$(objext) \
s-utf_32$(objext) \
s-vaflop$(objext) \
s-valboo$(objext) \
s-valcha$(objext) \
s-valdec$(objext) \
@ -690,7 +683,6 @@ GNATRTL_NONTASKING_OBJS= \
s-veboop$(objext) \
s-vector$(objext) \
s-vercon$(objext) \
s-vmexta$(objext) \
s-wchcnv$(objext) \
s-wchcon$(objext) \
s-wchjis$(objext) \

995
gcc/ada/adaint.c
View file

File diff suppressed because it is too large Load diff

1
gcc/ada/gcc-interface/Make-lang.in
View file

@ -414,7 +414,6 @@ GNAT_ADA_OBJS = \
ada/sem_smem.o \
ada/sem_type.o \
ada/sem_util.o \
ada/sem_vfpt.o \
ada/sem_warn.o \
ada/set_targ.o \
ada/sinfo-cn.o \

90
gcc/ada/gcc-interface/Makefile.in
View file

@ -1643,28 +1643,32 @@ ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(target_os))),)
g-soliop.ads<g-soliop-mingw.ads \
$(ATOMICS_TARGET_PAIRS)
ifeq ($(strip $(filter-out rtx_w32 rtx_rtss,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
s-intman.adb<s-intman-dummy.adb \
s-osinte.ads<s-osinte-rtx.ads \
s-osprim.adb<s-osprim-rtx.adb \
s-taprop.adb<s-taprop-rtx.adb \
$(X86_TARGET_PAIRS)
LIBGNAT_TARGET_PAIRS += \
a-exetim.adb<a-exetim-mingw.adb \
a-exetim.ads<a-exetim-mingw.ads \
a-intnam.ads<a-intnam-mingw.ads \
g-sercom.adb<g-sercom-mingw.adb \
s-trasym.adb<s-trasym-dwarf.adb \
s-tsmona.adb<s-tsmona-mingw.adb \
s-interr.adb<s-interr-sigaction.adb \
s-intman.adb<s-intman-mingw.adb \
s-mudido.adb<s-mudido-affinity.adb \
s-osinte.ads<s-osinte-mingw.ads \
s-osprim.adb<s-osprim-mingw.adb \
s-taprop.adb<s-taprop-mingw.adb
EXTRA_GNATRTL_NONTASKING_OBJS = s-win32.o
ifeq ($(strip $(filter-out rtx_w32,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += system.ads<system-rtx.ads
EH_MECHANISM=-gcc
ifeq ($(strip $(filter-out x86_64%,$(target_cpu))),)
ifeq ($(strip $(MULTISUBDIR)),/32)
LIBGNAT_TARGET_PAIRS += \
$(X86_TARGET_PAIRS) \
system.ads<system-mingw.ads
SO_OPTS= -m32 -Wl,-soname,
else
LIBGNAT_TARGET_PAIRS += \
system.ads<system-rtx-rtss.ads \
s-parame.adb<s-parame-vxworks.adb
EH_MECHANISM=
LIBGNAT_TARGET_PAIRS += \
$(X86_64_TARGET_PAIRS) \
system.ads<system-mingw-x86_64.ads
SO_OPTS = -m64 -Wl,-soname,
endif
else
LIBGNAT_TARGET_PAIRS += \
a-exetim.adb<a-exetim-mingw.adb \
@ -1691,32 +1695,25 @@ ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(target_os))),)
SO_OPTS = -m64 -Wl,-soname,
endif
else
ifeq ($(strip $(MULTISUBDIR)),/64)
LIBGNAT_TARGET_PAIRS += \
$(X86_64_TARGET_PAIRS) \
system.ads<system-mingw-x86_64.ads
SO_OPTS = -m64 -Wl,-soname,
else
LIBGNAT_TARGET_PAIRS += \
$(X86_TARGET_PAIRS) \
system.ads<system-mingw.ads
SO_OPTS = -m32 -Wl,-soname,
endif
LIBGNAT_TARGET_PAIRS += \
$(X86_TARGET_PAIRS) \
system.ads<system-mingw.ads
SO_OPTS = -m32 -Wl,-soname,
endif
EXTRA_GNATRTL_NONTASKING_OBJS = \
s-win32.o s-winext.o g-regist.o g-sse.o g-ssvety.o
EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o
EXTRA_LIBGNAT_SRCS+=mingw32.h
MISCLIB = -lws2_32
# ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT
# auto-import support for array/record will be done.
GNATLIB_SHARED = gnatlib-shared-win32
EH_MECHANISM=-gcc
endif
EXTRA_GNATRTL_NONTASKING_OBJS = \
s-win32.o s-winext.o g-regist.o g-sse.o g-ssvety.o
EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o
EXTRA_LIBGNAT_SRCS+=mingw32.h
MISCLIB = -lws2_32
# ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT
# auto-import support for array/record will be done.
GNATLIB_SHARED = gnatlib-shared-win32
EH_MECHANISM=-gcc
TOOLS_TARGET_PAIRS= \
mlib-tgt-specific.adb<mlib-tgt-specific-mingw.adb \
indepsw.adb<indepsw-mingw.adb
@ -2426,7 +2423,6 @@ ADA_EXCLUDE_SRCS =\
s-bbthre.ads s-bbtiev.adb s-bbtiev.ads s-bbtime.adb s-bbtime.ads \
s-bcprmu.adb s-bcprmu.ads s-btstch.adb s-btstch.ads \
s-init.ads s-init.adb \
s-po32gl.adb s-po32gl.ads \
s-stache.adb s-stache.ads \
s-thread.ads \
s-vxwext.adb s-vxwext.ads \
@ -2977,14 +2973,6 @@ s-tasdeb.o : s-tasdeb.adb s-tasdeb.ads
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 $(ADA_INCLUDES) \
$< $(OUTPUT_OPTION)
# force debugging information on s-vaflop.o so that it is always
# possible to call the VAX float debug print routines.
# force at least -O so that the inline assembly works.
s-vaflop.o : s-vaflop.adb s-vaflop.ads
$(CC) -c -O $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) $(ADA_INCLUDES) \
$< $(OUTPUT_OPTION)
# force no function reordering on a-except.o because of the exclusion bounds
# mechanism (see the source file for more detailed information).
# force debugging information on a-except.o so that it is always

20
gcc/ada/gcc-interface/decl.c
View file

@ -1921,18 +1921,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
break;
case E_Floating_Point_Type:
/* If this is a VAX floating-point type, use an integer of the proper
size. All the operations will be handled with ASM statements. */
if (Vax_Float (gnat_entity))
{
gnu_type = make_signed_type (esize);
TYPE_VAX_FLOATING_POINT_P (gnu_type) = 1;
SET_TYPE_DIGITS_VALUE (gnu_type,
UI_To_gnu (Digits_Value (gnat_entity),
sizetype));
break;
}
/* The type of the Low and High bounds can be our type if this is
a type from Standard, so set them at the end of the function. */
gnu_type = make_node (REAL_TYPE);
@ -1941,12 +1929,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
break;
case E_Floating_Point_Subtype:
if (Vax_Float (gnat_entity))
{
gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
break;
}
/* See the E_Signed_Integer_Subtype case for the rationale. */
if (!definition
&& Present (Ancestor_Subtype (gnat_entity))
@ -5296,7 +5278,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If this is an enumeration or floating-point type, we were not able to set
the bounds since they refer to the type. These are always static. */
if ((kind == E_Enumeration_Type && Present (First_Literal (gnat_entity)))
|| (kind == E_Floating_Point_Type && !Vax_Float (gnat_entity)))
|| (kind == E_Floating_Point_Type))
{
tree gnu_scalar_type = gnu_type;
tree gnu_low_bound, gnu_high_bound;

13
gcc/ada/gnat_rm.texi
View file

@ -3387,17 +3387,8 @@ pragma Ident (static_string_EXPRESSION);
@end smallexample
@noindent
This pragma provides a string identification in the generated object file,
if the system supports the concept of this kind of identification string.
This pragma is allowed only in the outermost declarative part or
declarative items of a compilation unit. If more than one @code{Ident}
pragma is given, only the last one processed is effective.
@cindex OpenVMS
On OpenVMS systems, the effect of the pragma is identical to the effect of
the DEC Ada 83 pragma of the same name. Note that in DEC Ada 83, the
maximum allowed length is 31 characters, so if it is important to
maintain compatibility with this compiler, you should obey this length
limit.
This pragma is identical in effect to pragma @code{Comment}. It is provided
for compatibility with other Ada compilers providing this pragma.
@node Pragma Implementation_Defined
@unnumberedsec Pragma Implementation_Defined

58
gcc/ada/s-asthan.adb
View file

@ -1,58 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUNT-TIME COMPONENTS --
-- --
-- S Y S T E M . A S T _ H A N D L I N G --
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the dummy version used on non-VMS systems
package body System.AST_Handling is
------------------------
-- Create_AST_Handler --
------------------------
function Create_AST_Handler
(Taskid : Ada.Task_Identification.Task_Id;
Entryno : Natural) return System.Aux_DEC.AST_Handler
is
begin
raise Program_Error with "AST is implemented only on VMS systems";
return System.Aux_DEC.No_AST_Handler;
end Create_AST_Handler;
procedure Expand_AST_Packet_Pool
(Requested_Packets : Natural;
Actual_Number : out Natural;
Total_Number : out Natural)
is
begin
raise Program_Error with "AST is implemented only on VMS systems";
end Expand_AST_Packet_Pool;
end System.AST_Handling;

57
gcc/ada/s-asthan.ads
View file

@ -1,57 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . A S T _ H A N D L I N G --
-- --
-- S p e c --
-- --
-- Copyright (C) 1996-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Runtime support for Handling of AST's (Used on VMS implementations only)
with Ada.Task_Identification;
with System;
with System.Aux_DEC;
package System.AST_Handling is
function Create_AST_Handler
(Taskid : Ada.Task_Identification.Task_Id;
Entryno : Natural) return System.Aux_DEC.AST_Handler;
-- This function implements the appropriate semantics for a use of the
-- AST_Entry pragma. See body for details of implementation approach.
-- The parameters are the Task_Id for the task containing the entry
-- and the entry Index for the specified entry.
procedure Expand_AST_Packet_Pool
(Requested_Packets : Natural;
Actual_Number : out Natural;
Total_Number : out Natural);
-- This function takes a request for zero or more extra AST packets and
-- returns the number actually added to the pool and the total number
-- now available or in use.
-- This function is not yet fully implemented.
end System.AST_Handling;

53
gcc/ada/s-filofl.ads
View file

@ -1,53 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . F A T _ I E E E _ L O N G _ F L O A T --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains an instantiation of the floating-point attribute
-- runtime routines for IEEE long float. This is used on VMS targets where
-- we can't just use Long_Float, since this may have been mapped to Vax_Float
-- using a Float_Representation configuration pragma.
-- TO BE RMOVED ???
with System.Fat_Gen;
package System.Fat_IEEE_Long_Float is
pragma Pure;
type Fat_IEEE_Long is digits 15;
-- Note the only entity from this package that is accessed by Rtsfind
-- is the name of the package instantiation. Entities within this package
-- (i.e. the individual floating-point attribute routines) are accessed
-- by name using selected notation.
package Attr_IEEE_Long is new System.Fat_Gen (Fat_IEEE_Long);
end System.Fat_IEEE_Long_Float;

53
gcc/ada/s-fishfl.ads
View file

@ -1,53 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . F A T _ I E E E _ S H O R T _ F L O A T --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains an instantiation of the floating-point attribute
-- runtime routines for IEEE short float. This is used on VMS targets where
-- we can't just use Float, since this may have been mapped to Vax_Float
-- using a Float_Representation configuration pragma.
-- TO BE REMOVED ???
with System.Fat_Gen;
package System.Fat_IEEE_Short_Float is
pragma Pure;
type Fat_IEEE_Short is digits 6;
-- Note the only entity from this package that is accessed by Rtsfind
-- is the name of the package instantiation. Entities within this package
-- (i.e. the individual floating-point attribute routines) are accessed
-- by name using selected notation.
package Attr_IEEE_Short is new System.Fat_Gen (Fat_IEEE_Short);
end System.Fat_IEEE_Short_Float;

51
gcc/ada/s-fvadfl.ads
View file

@ -1,51 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . F A T _ V A X _ D _ F L O A T --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains an instantiation of the floating-point attribute
-- runtime routines for VAX D-float for use on VMS targets.
-- TO BE REMOVED ???
with System.Fat_Gen;
package System.Fat_VAX_D_Float is
pragma Pure;
type Fat_VAX_D is digits 9;
-- Note the only entity from this package that is accessed by Rtsfind
-- is the name of the package instantiation. Entities within this package
-- (i.e. the individual floating-point attribute routines) are accessed
-- by name using selected notation.
package Attr_VAX_D_Float is new System.Fat_Gen (Fat_VAX_D);
end System.Fat_VAX_D_Float;

51
gcc/ada/s-fvaffl.ads
View file

@ -1,51 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . F A T _ V A X _ F _ F L O A T --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains an instantiation of the floating-point attribute
-- runtime routines for VAX F-float for use on VMS targets.
-- TO BE REMOVED ???
with System.Fat_Gen;
package System.Fat_VAX_F_Float is
pragma Pure;
type Fat_VAX_F is digits 6;
-- Note the only entity from this package that is accessed by Rtsfind
-- is the name of the package instantiation. Entities within this package
-- (i.e. the individual floating-point attribute routines) are accessed
-- by name using selected notation.
package Attr_VAX_F_Float is new System.Fat_Gen (Fat_VAX_F);
end System.Fat_VAX_F_Float;

51
gcc/ada/s-fvagfl.ads
View file

@ -1,51 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . F A T _ V A X _ G _ F L O A T --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains an instantiation of the floating-point attribute
-- runtime routines for VAX F-float for use on VMS targets.
-- TO BE REMOVED ???
with System.Fat_Gen;
package System.Fat_VAX_G_Float is
pragma Pure;
type Fat_VAX_G is digits 15;
-- Note the only entity from this package that is accessed by Rtsfind
-- is the name of the package instantiation. Entities within this package
-- (i.e. the individual floating-point attribute routines) are accessed
-- by name using selected notation.
package Attr_VAX_G_Float is new System.Fat_Gen (Fat_VAX_G);
end System.Fat_VAX_G_Float;

4
gcc/ada/s-os_lib.ads
View file

@ -426,12 +426,12 @@ package System.OS_Lib is
-- to the current position (origin = SEEK_CUR), end of file (origin =
-- SEEK_END), or start of file (origin = SEEK_SET).
type File_Size is range -(2 ** 63) .. (2 ** 63) - 1;
type Large_File_Size is range -(2 ** 63) .. (2 ** 63) - 1;
function File_Length (FD : File_Descriptor) return Long_Integer;
pragma Import (C, File_Length, "__gnat_file_length_long");
function File_Length64 (FD : File_Descriptor) return File_Size;
function File_Length64 (FD : File_Descriptor) return Large_File_Size;
pragma Import (C, File_Length64, "__gnat_file_length");
-- Get length of file from file descriptor FD

98
gcc/ada/s-po32gl.adb
View file

@ -1,98 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . P O O L _ 3 2 _ G L O B A L --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with System.Storage_Pools; use System.Storage_Pools;
with System.Memory;
package body System.Pool_32_Global is
package SSE renames System.Storage_Elements;
--------------
-- Allocate --
--------------
overriding procedure Allocate
(Pool : in out Unbounded_No_Reclaim_Pool_32;
Address : out System.Address;
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
pragma Warnings (Off, Pool);
pragma Warnings (Off, Alignment);
begin
Address := Memory.Alloc32 (Memory.size_t (Storage_Size));
-- The call to Alloc returns an address whose alignment is compatible
-- with the worst case alignment requirement for the machine; thus the
-- Alignment argument can be safely ignored.
if Address = Null_Address then
raise Storage_Error;
end if;
end Allocate;
----------------
-- Deallocate --
----------------
overriding procedure Deallocate
(Pool : in out Unbounded_No_Reclaim_Pool_32;
Address : System.Address;
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
pragma Warnings (Off, Pool);
pragma Warnings (Off, Storage_Size);
pragma Warnings (Off, Alignment);
begin
Memory.Free (Address);
end Deallocate;
------------------
-- Storage_Size --
------------------
overriding function Storage_Size
(Pool : Unbounded_No_Reclaim_Pool_32)
return SSE.Storage_Count
is
pragma Warnings (Off, Pool);
begin
-- The 32 bit heap is limited to 2 GB of memory
return SSE.Storage_Count (2 ** 31);
end Storage_Size;
end System.Pool_32_Global;

80
gcc/ada/s-po32gl.ads
View file

@ -1,80 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . P O O L _ 3 2 _ G L O B A L --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Storage pool corresponding to default global storage pool used for types
-- designated by a 32 bits access type for which no storage pool is specified.
-- This is specific to VMS.
with System;
with System.Storage_Pools;
with System.Storage_Elements;
package System.Pool_32_Global is
pragma Elaborate_Body;
-- Needed to ensure that library routines can execute allocators
-- Allocation strategy:
-- Call to malloc/free for each Allocate/Deallocate
-- No user specifiable size
-- No automatic reclaim
-- Minimal overhead
-- Pool simulating the allocation/deallocation strategy used by the
-- compiler for access types globally declared.
type Unbounded_No_Reclaim_Pool_32 is new
System.Storage_Pools.Root_Storage_Pool with null record;
overriding function Storage_Size
(Pool : Unbounded_No_Reclaim_Pool_32)
return System.Storage_Elements.Storage_Count;
overriding procedure Allocate
(Pool : in out Unbounded_No_Reclaim_Pool_32;
Address : out System.Address;
Storage_Size : System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count);
overriding procedure Deallocate
(Pool : in out Unbounded_No_Reclaim_Pool_32;
Address : System.Address;
Storage_Size : System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count);
-- Pool object used by the compiler when implicit Storage Pool objects are
-- explicitly referred to. For instance when writing something like:
-- for T'Storage_Pool use Q'Storage_Pool;
-- and Q'Storage_Pool hasn't been defined explicitly.
Global_Pool_32_Object : Unbounded_No_Reclaim_Pool_32;
end System.Pool_32_Global;

505
gcc/ada/s-vaflop.adb
View file

@ -1,505 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . V A X _ F L O A T _ O P E R A T I O N S --
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is a dummy body for use on non-Alpha systems so that the library
-- can compile. This dummy version uses ordinary conversions and other
-- arithmetic operations. It is used only for testing purposes in the
-- case where the -gnatdm switch is used to force testing of VMS features
-- on non-VMS systems.
with System.IO;
package body System.Vax_Float_Operations is
pragma Warnings (Off);
-- Warnings about infinite recursion when the -gnatdm switch is used
-----------
-- Abs_F --
-----------
function Abs_F (X : F) return F is
begin
return abs X;
end Abs_F;
-----------
-- Abs_G --
-----------
function Abs_G (X : G) return G is
begin
return abs X;
end Abs_G;
-----------
-- Add_F --
-----------
function Add_F (X, Y : F) return F is
begin
return X + Y;
end Add_F;
-----------
-- Add_G --
-----------
function Add_G (X, Y : G) return G is
begin
return X + Y;
end Add_G;
------------
-- D_To_G --
------------
function D_To_G (X : D) return G is
begin
return G (X);
end D_To_G;
--------------------
-- Debug_Output_D --
--------------------
procedure Debug_Output_D (Arg : D) is
begin
System.IO.Put (D'Image (Arg));
end Debug_Output_D;
--------------------
-- Debug_Output_F --
--------------------
procedure Debug_Output_F (Arg : F) is
begin
System.IO.Put (F'Image (Arg));
end Debug_Output_F;
--------------------
-- Debug_Output_G --
--------------------
procedure Debug_Output_G (Arg : G) is
begin
System.IO.Put (G'Image (Arg));
end Debug_Output_G;
--------------------
-- Debug_String_D --
--------------------
Debug_String_Buffer : String (1 .. 32);
-- Buffer used by all Debug_String_x routines for returning result
function Debug_String_D (Arg : D) return System.Address is
Image_String : constant String := D'Image (Arg) & ASCII.NUL;
Image_Size : constant Integer := Image_String'Length;
begin
Debug_String_Buffer (1 .. Image_Size) := Image_String;
return Debug_String_Buffer (1)'Address;
end Debug_String_D;
--------------------
-- Debug_String_F --
--------------------
function Debug_String_F (Arg : F) return System.Address is
Image_String : constant String := F'Image (Arg) & ASCII.NUL;
Image_Size : constant Integer := Image_String'Length;
begin
Debug_String_Buffer (1 .. Image_Size) := Image_String;
return Debug_String_Buffer (1)'Address;
end Debug_String_F;
--------------------
-- Debug_String_G --
--------------------
function Debug_String_G (Arg : G) return System.Address is
Image_String : constant String := G'Image (Arg) & ASCII.NUL;
Image_Size : constant Integer := Image_String'Length;
begin
Debug_String_Buffer (1 .. Image_Size) := Image_String;
return Debug_String_Buffer (1)'Address;
end Debug_String_G;
-----------
-- Div_F --
-----------
function Div_F (X, Y : F) return F is
begin
return X / Y;
end Div_F;
-----------
-- Div_G --
-----------
function Div_G (X, Y : G) return G is
begin
return X / Y;
end Div_G;
----------
-- Eq_F --
----------
function Eq_F (X, Y : F) return Boolean is
begin
return X = Y;
end Eq_F;
----------
-- Eq_G --
----------
function Eq_G (X, Y : G) return Boolean is
begin
return X = Y;
end Eq_G;
------------
-- F_To_G --
------------
function F_To_G (X : F) return G is
begin
return G (X);
end F_To_G;
------------
-- F_To_Q --
------------
function F_To_Q (X : F) return Q is
begin
return Q (X);
end F_To_Q;
------------
-- F_To_S --
------------
function F_To_S (X : F) return S is
begin
return S (X);
end F_To_S;
------------
-- G_To_D --
------------
function G_To_D (X : G) return D is
begin
return D (X);
end G_To_D;
------------
-- G_To_F --
------------
function G_To_F (X : G) return F is
begin
return F (X);
end G_To_F;
------------
-- G_To_Q --
------------
function G_To_Q (X : G) return Q is
begin
return Q (X);
end G_To_Q;
------------
-- G_To_T --
------------
function G_To_T (X : G) return T is
begin
return T (X);
end G_To_T;
----------
-- Le_F --
----------
function Le_F (X, Y : F) return Boolean is
begin
return X <= Y;
end Le_F;
----------
-- Le_G --
----------
function Le_G (X, Y : G) return Boolean is
begin
return X <= Y;
end Le_G;
----------
-- Lt_F --
----------
function Lt_F (X, Y : F) return Boolean is
begin
return X < Y;
end Lt_F;
----------
-- Lt_G --
----------
function Lt_G (X, Y : G) return Boolean is
begin
return X < Y;
end Lt_G;
-----------
-- Mul_F --
-----------
function Mul_F (X, Y : F) return F is
begin
return X * Y;
end Mul_F;
-----------
-- Mul_G --
-----------
function Mul_G (X, Y : G) return G is
begin
return X * Y;
end Mul_G;
----------
-- Ne_F --
----------
function Ne_F (X, Y : F) return Boolean is
begin
return X /= Y;
end Ne_F;
----------
-- Ne_G --
----------
function Ne_G (X, Y : G) return Boolean is
begin
return X /= Y;
end Ne_G;
-----------
-- Neg_F --
-----------
function Neg_F (X : F) return F is
begin
return -X;
end Neg_F;
-----------
-- Neg_G --
-----------
function Neg_G (X : G) return G is
begin
return -X;
end Neg_G;
--------
-- pd --
--------
procedure pd (Arg : D) is
begin
System.IO.Put_Line (D'Image (Arg));
end pd;
--------
-- pf --
--------
procedure pf (Arg : F) is
begin
System.IO.Put_Line (F'Image (Arg));
end pf;
--------
-- pg --
--------
procedure pg (Arg : G) is
begin
System.IO.Put_Line (G'Image (Arg));
end pg;
------------
-- Q_To_F --
------------
function Q_To_F (X : Q) return F is
begin
return F (X);
end Q_To_F;
------------
-- Q_To_G --
------------
function Q_To_G (X : Q) return G is
begin
return G (X);
end Q_To_G;
------------
-- S_To_F --
------------
function S_To_F (X : S) return F is
begin
return F (X);
end S_To_F;
--------------
-- Return_D --
--------------
function Return_D (X : D) return D is
begin
return X;
end Return_D;
--------------
-- Return_F --
--------------
function Return_F (X : F) return F is
begin
return X;
end Return_F;
--------------
-- Return_G --
--------------
function Return_G (X : G) return G is
begin
return X;
end Return_G;
-----------
-- Sub_F --
-----------
function Sub_F (X, Y : F) return F is
begin
return X - Y;
end Sub_F;
-----------
-- Sub_G --
-----------
function Sub_G (X, Y : G) return G is
begin
return X - Y;
end Sub_G;
------------
-- T_To_G --
------------
-- This function must be located before T_To_D for frontend inlining
function T_To_G (X : T) return G is
begin
return G (X);
end T_To_G;
------------
-- T_To_D --
------------
function T_To_D (X : T) return D is
begin
return G_To_D (T_To_G (X));
end T_To_D;
-------------
-- Valid_D --
-------------
-- For now, convert to IEEE and do Valid test on result. This is not quite
-- accurate, but is good enough in practice.
function Valid_D (Arg : D) return Boolean is
Val : constant T := G_To_T (D_To_G (Arg));
begin
return Val'Valid;
end Valid_D;
-------------
-- Valid_F --
-------------
-- For now, convert to IEEE and do Valid test on result. This is not quite
-- accurate, but is good enough in practice.
function Valid_F (Arg : F) return Boolean is
Val : constant S := F_To_S (Arg);
begin
return Val'Valid;
end Valid_F;
-------------
-- Valid_G --
-------------
-- For now, convert to IEEE and do Valid test on result. This is not quite
-- accurate, but is good enough in practice.
function Valid_G (Arg : G) return Boolean is
Val : constant T := G_To_T (Arg);
begin
return Val'Valid;
end Valid_G;
end System.Vax_Float_Operations;

230
gcc/ada/s-vaflop.ads
View file

@ -1,230 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . V A X _ F L O A T _ O P E R A T I O N S --
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains runtime routines for handling the non-IEEE
-- floating-point formats used on the Vax.
-- TO BE REMOVED ???
package System.Vax_Float_Operations is
type D is digits 9;
type G is digits 15;
type F is digits 6;
type S is digits 6;
type T is digits 15;
type Q is range -2 ** 63 .. +(2 ** 63 - 1);
-- 64-bit signed integer
--------------------------
-- Conversion Functions --
--------------------------
function D_To_G (X : D) return G;
function G_To_D (X : G) return D;
-- Conversions between D float and G float
function G_To_F (X : G) return F;
function F_To_G (X : F) return G;
-- Conversions between F float and G float
function F_To_S (X : F) return S;
function S_To_F (X : S) return F;
-- Conversions between F float and IEEE short
function G_To_T (X : G) return T;
function T_To_G (X : T) return G;
-- Conversions between G float and IEEE long
function F_To_Q (X : F) return Q;
function Q_To_F (X : Q) return F;
-- Conversions between F float and 64-bit integer
function G_To_Q (X : G) return Q;
function Q_To_G (X : Q) return G;
-- Conversions between G float and 64-bit integer
function T_To_D (X : T) return D;
-- Conversion from IEEE long to D_Float (used for literals)
--------------------------
-- Arithmetic Functions --
--------------------------
function Abs_F (X : F) return F;
function Abs_G (X : G) return G;
-- Absolute value of F/G float
function Add_F (X, Y : F) return F;
function Add_G (X, Y : G) return G;
-- Addition of F/G float
function Div_F (X, Y : F) return F;
function Div_G (X, Y : G) return G;
-- Division of F/G float
function Mul_F (X, Y : F) return F;
function Mul_G (X, Y : G) return G;
-- Multiplication of F/G float
function Neg_F (X : F) return F;
function Neg_G (X : G) return G;
-- Negation of F/G float
function Sub_F (X, Y : F) return F;
function Sub_G (X, Y : G) return G;
-- Subtraction of F/G float
--------------------------
-- Comparison Functions --
--------------------------
function Eq_F (X, Y : F) return Boolean;
function Eq_G (X, Y : G) return Boolean;
-- Compares for X = Y
function Le_F (X, Y : F) return Boolean;
function Le_G (X, Y : G) return Boolean;
-- Compares for X <= Y
function Lt_F (X, Y : F) return Boolean;
function Lt_G (X, Y : G) return Boolean;
-- Compares for X < Y
function Ne_F (X, Y : F) return Boolean;
function Ne_G (X, Y : G) return Boolean;
-- Compares for X /= Y
----------------------
-- Return Functions --
----------------------
function Return_D (X : D) return D;
function Return_F (X : F) return F;
function Return_G (X : G) return G;
-- Deal with returned value for an imported function where the function
-- result is of VAX Float type. Usually nothing needs to be done, and these
-- functions return their argument unchanged. But for the case of VMS Alpha
-- the return value is already in $f0, so we need to trick the compiler
-- into thinking that we are moving X to $f0. See bodies for this case
-- for the Asm sequence generated to achieve this.
----------------------------------
-- Routines for Valid Attribute --
----------------------------------
function Valid_D (Arg : D) return Boolean;
function Valid_F (Arg : F) return Boolean;
function Valid_G (Arg : G) return Boolean;
-- Test whether Arg has a valid representation
----------------------
-- Debug Procedures --
----------------------
procedure Debug_Output_D (Arg : D);
procedure Debug_Output_F (Arg : F);
procedure Debug_Output_G (Arg : G);
pragma Export (Ada, Debug_Output_D);
pragma Export (Ada, Debug_Output_F);
pragma Export (Ada, Debug_Output_G);
-- These routines output their argument in decimal string form, with
-- no terminating line return. They are provided for implicit use by
-- the pre gnat-3.12w GDB, and are retained for backwards compatibility.
function Debug_String_D (Arg : D) return System.Address;
function Debug_String_F (Arg : F) return System.Address;
function Debug_String_G (Arg : G) return System.Address;
pragma Export (Ada, Debug_String_D);
pragma Export (Ada, Debug_String_F);
pragma Export (Ada, Debug_String_G);
-- These routines return a decimal C string image of their argument.
-- They are provided for implicit use by the debugger, in response to
-- the special encoding used for Vax floating-point types (see Exp_Dbug
-- for details). They supersede the above Debug_Output_D/F/G routines
-- which didn't work properly with GDBTK.
procedure pd (Arg : D);
procedure pf (Arg : F);
procedure pg (Arg : G);
pragma Export (Ada, pd);
pragma Export (Ada, pf);
pragma Export (Ada, pg);
-- These are like the Debug_Output_D/F/G procedures except that they
-- output a line return after the output. They were originally present
-- for direct use in GDB before GDB recognized Vax floating-point
-- types, and are retained for backwards compatibility.
private
pragma Inline_Always (D_To_G);
pragma Inline_Always (F_To_G);
pragma Inline_Always (F_To_Q);
pragma Inline_Always (F_To_S);
pragma Inline_Always (G_To_D);
pragma Inline_Always (G_To_F);
pragma Inline_Always (G_To_Q);
pragma Inline_Always (G_To_T);
pragma Inline_Always (Q_To_F);
pragma Inline_Always (Q_To_G);
pragma Inline_Always (S_To_F);
pragma Inline_Always (T_To_G);
pragma Inline_Always (Abs_F);
pragma Inline_Always (Abs_G);
pragma Inline_Always (Add_F);
pragma Inline_Always (Add_G);
pragma Inline_Always (Div_G);
pragma Inline_Always (Div_F);
pragma Inline_Always (Mul_F);
pragma Inline_Always (Mul_G);
pragma Inline_Always (Neg_G);
pragma Inline_Always (Neg_F);
pragma Inline_Always (Return_D);
pragma Inline_Always (Return_F);
pragma Inline_Always (Return_G);
pragma Inline_Always (Sub_F);
pragma Inline_Always (Sub_G);
pragma Inline_Always (Eq_F);
pragma Inline_Always (Eq_G);
pragma Inline_Always (Le_F);
pragma Inline_Always (Le_G);
pragma Inline_Always (Lt_F);
pragma Inline_Always (Lt_G);
pragma Inline_Always (Ne_F);
pragma Inline_Always (Ne_G);
pragma Inline_Always (Valid_D);
pragma Inline_Always (Valid_F);
pragma Inline_Always (Valid_G);
end System.Vax_Float_Operations;

187
gcc/ada/s-vmexta.adb
View file

@ -1,187 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . V M S _ E X C E P T I O N _ T A B L E --
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is an Alpha/VMS package
with System.HTable;
pragma Elaborate_All (System.HTable);
with System.Storage_Elements; use System.Storage_Elements;
package body System.VMS_Exception_Table is
type HTable_Headers is range 1 .. 37;
type Exception_Code_Data;
type Exception_Code_Data_Ptr is access all Exception_Code_Data;
-- The following record maps an imported VMS condition to an
-- Ada exception.
type Exception_Code_Data is record
Code : Exception_Code;
Except : SSL.Exception_Data_Ptr;
HTable_Ptr : Exception_Code_Data_Ptr;
end record;
procedure Set_HT_Link
(T : Exception_Code_Data_Ptr;
Next : Exception_Code_Data_Ptr);
function Get_HT_Link (T : Exception_Code_Data_Ptr)
return Exception_Code_Data_Ptr;
function Hash (F : Exception_Code) return HTable_Headers;
function Get_Key (T : Exception_Code_Data_Ptr) return Exception_Code;
package Exception_Code_HTable is new System.HTable.Static_HTable (
Header_Num => HTable_Headers,
Element => Exception_Code_Data,
Elmt_Ptr => Exception_Code_Data_Ptr,
Null_Ptr => null,
Set_Next => Set_HT_Link,
Next => Get_HT_Link,
Key => Exception_Code,
Get_Key => Get_Key,
Hash => Hash,
Equal => "=");
------------------
-- Base_Code_In --
------------------
function Base_Code_In
(Code : Exception_Code) return Exception_Code
is
begin
return To_Address (To_Integer (Code) and not 2#0111#);
end Base_Code_In;
---------------------
-- Coded_Exception --
---------------------
function Coded_Exception
(X : Exception_Code) return SSL.Exception_Data_Ptr
is
Res : Exception_Code_Data_Ptr;
begin
Res := Exception_Code_HTable.Get (X);
if Res /= null then
return Res.Except;
else
return null;
end if;
end Coded_Exception;
-----------------
-- Get_HT_Link --
-----------------
function Get_HT_Link
(T : Exception_Code_Data_Ptr) return Exception_Code_Data_Ptr
is
begin
return T.HTable_Ptr;
end Get_HT_Link;
-------------
-- Get_Key --
-------------
function Get_Key (T : Exception_Code_Data_Ptr)
return Exception_Code
is
begin
return T.Code;
end Get_Key;
----------
-- Hash --
----------
function Hash
(F : Exception_Code) return HTable_Headers
is
Headers_Magnitude : constant Exception_Code :=
Exception_Code (HTable_Headers'Last - HTable_Headers'First + 1);
begin
return HTable_Headers
(To_Address ((To_Integer (F) mod To_Integer (Headers_Magnitude)) + 1));
end Hash;
----------------------------
-- Register_VMS_Exception --
----------------------------
procedure Register_VMS_Exception
(Code : Exception_Code;
E : SSL.Exception_Data_Ptr)
is
-- We bind the exception data with the base code found in the
-- input value, that is with the severity bits masked off.
Excode : constant Exception_Code := Base_Code_In (Code);
begin
-- The exception data registered here is mostly filled prior to this
-- call and by __gnat_error_handler when the exception is raised. We
-- still need to fill a couple of components for exceptions that will
-- be used as propagation filters (exception data pointer registered
-- as choices in the unwind tables): in some import/export cases, the
-- exception pointers for the choice and the propagated occurrence may
-- indeed be different for a single import code, and the personality
-- routine attempts to match the import codes in this case.
E.Lang := 'V';
E.Foreign_Data := Excode;
if Exception_Code_HTable.Get (Excode) = null then
Exception_Code_HTable.Set (new Exception_Code_Data'(Excode, E, null));
end if;
end Register_VMS_Exception;
-----------------
-- Set_HT_Link --
-----------------
procedure Set_HT_Link
(T : Exception_Code_Data_Ptr;
Next : Exception_Code_Data_Ptr)
is
begin
T.HTable_Ptr := Next;
end Set_HT_Link;
end System.VMS_Exception_Table;

67
gcc/ada/s-vmexta.ads
View file

@ -1,67 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . V M S _ E X C E P T I O N _ T A B L E --
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package is usually used only on OpenVMS systems in the case
-- where there is at least one Import/Export exception present.
with System.Standard_Library;
package System.VMS_Exception_Table is
package SSL renames System.Standard_Library;
subtype Exception_Code is System.Address;
procedure Register_VMS_Exception
(Code : Exception_Code;
E : SSL.Exception_Data_Ptr);
-- Register an exception in hash table mapping with a VMS condition code.
--
-- The table is used by exception code (the personnality routine) to detect
-- wether a VMS exception (aka condition) is known by the Ada code. In
-- that case, the identity of the imported or exported exception is used
-- to create the occurrence.
-- LOTS more comments needed here regarding the entire scheme ???
private
-- The following functions are directly called (without import/export) in
-- init.c by __gnat_handle_vms_condition.
function Base_Code_In (Code : Exception_Code) return Exception_Code;
-- Value of Code with the severity bits masked off
function Coded_Exception (X : Exception_Code)
return SSL.Exception_Data_Ptr;
-- Given a VMS condition, find and return its allocated Ada exception
end System.VMS_Exception_Table;

140
gcc/ada/sem_vfpt.adb
View file

@ -1,140 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ V F P T --
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with CStand; use CStand;
with Einfo; use Einfo;
with Stand; use Stand;
package body Sem_VFpt is
-----------------
-- Set_D_Float --
-----------------
procedure Set_D_Float (E : Entity_Id) is
VAXDF_Digits : constant := 9;
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXDF_Digits);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
Init_Alignment (E);
Init_Digits_Value (E, VAXDF_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_D_Float;
-----------------
-- Set_F_Float --
-----------------
procedure Set_F_Float (E : Entity_Id) is
VAXFF_Digits : constant := 6;
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXFF_Digits);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);
Init_Alignment (E);
Init_Digits_Value (E, VAXFF_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_F_Float;
-----------------
-- Set_G_Float --
-----------------
procedure Set_G_Float (E : Entity_Id) is
VAXGF_Digits : constant := 15;
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXGF_Digits);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
Init_Alignment (E);
Init_Digits_Value (E, VAXGF_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_G_Float;
-------------------
-- Set_IEEE_Long --
-------------------
procedure Set_IEEE_Long (E : Entity_Id) is
IEEEL_Digits : constant := 15;
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), IEEEL_Digits);
Set_Float_Rep (Base_Type (E), IEEE_Binary);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
Init_Alignment (E);
Init_Digits_Value (E, IEEEL_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_IEEE_Long;
--------------------
-- Set_IEEE_Short --
--------------------
procedure Set_IEEE_Short (E : Entity_Id) is
IEEES_Digits : constant := 6;
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), IEEES_Digits);
Set_Float_Rep (Base_Type (E), IEEE_Binary);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);
Init_Alignment (E);
Init_Digits_Value (E, IEEES_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_IEEE_Short;
------------------------------
-- Set_Standard_Fpt_Formats --
------------------------------
procedure Set_Standard_Fpt_Formats is
begin
Set_IEEE_Short (Standard_Float);
Set_IEEE_Long (Standard_Long_Float);
Set_IEEE_Long (Standard_Long_Long_Float);
end Set_Standard_Fpt_Formats;
end Sem_VFpt;

55
gcc/ada/sem_vfpt.ads
View file

@ -1,55 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ V F P T --
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains specialized routines for handling the Alpha
-- floating point formats. It is used only in Alpha implementations.
-- Note that this means that the caller can assume that we are on an
-- Alpha implementation, and that Vax floating-point formats are valid.
with Types; use Types;
package Sem_VFpt is
procedure Set_D_Float (E : Entity_Id);
-- Sets the given floating-point entity to have Vax D_Float format
procedure Set_F_Float (E : Entity_Id);
-- Sets the given floating-point entity to have Vax F_Float format
procedure Set_G_Float (E : Entity_Id);
-- Sets the given floating-point entity to have Vax G_Float format
procedure Set_IEEE_Short (E : Entity_Id);
-- Sets the given floating-point entity to have IEEE Short format
procedure Set_IEEE_Long (E : Entity_Id);
-- Sets the given floating-point entity to have IEEE Long format
procedure Set_Standard_Fpt_Formats;
-- This procedure sets the appropriate formats for the standard
-- floating-point types in Standard, based on the setting of
-- the flags Opt.Float_Format and Opt.Float_Format_Long
end Sem_VFpt;

52
gcc/ada/socket.c
View file

@ -37,39 +37,7 @@
#include "gsocket.h"
#if defined(VMS)
/*
* For VMS, gsocket.h can't include sockets-related DEC C header files
* when building the runtime (because these files are in a DEC C text library
* (DECC$RTLDEF.TLB) not accessible to GCC). So, we generate a separate header
* file along with s-oscons.ads and include it here.
*/
# include "s-oscons.h"
/*
* We also need the declaration of struct hostent/servent, which s-oscons
* can't provide, so we copy it manually here. This needs to be kept in synch
* with the definition of that structure in the DEC C headers, which
* hopefully won't change frequently.
*/
typedef char *__netdb_char_ptr __attribute__ (( mode (SI) ));
typedef __netdb_char_ptr *__netdb_char_ptr_ptr __attribute__ (( mode (SI) ));
struct hostent {
__netdb_char_ptr h_name;
__netdb_char_ptr_ptr h_aliases;
int h_addrtype;
int h_length;
__netdb_char_ptr_ptr h_addr_list;
};
struct servent {
__netdb_char_ptr s_name;
__netdb_char_ptr_ptr s_aliases;
int s_port;
__netdb_char_ptr s_proto;
};
#elif defined(__FreeBSD__)
#if defined(__FreeBSD__)
typedef unsigned int IOCTL_Req_T;
#else
typedef int IOCTL_Req_T;
@ -142,7 +110,7 @@ __gnat_disable_all_sigpipes (void)
#endif
}
#if defined (_WIN32) || defined (__vxworks) || defined (VMS)
#if defined (_WIN32) || defined (__vxworks)
/*
* Signalling FDs operations are implemented in Ada for these platforms
* (see subunit GNAT.Sockets.Thin.Signalling_Fds).
@ -509,15 +477,6 @@ __gnat_get_h_errno (void) {
return -1;
}
#elif defined (VMS)
/* h_errno is defined as follows in OpenVMS' version of <netdb.h>.
* However this header file is not available when building the GNAT
* runtime library using GCC, so we are hardcoding the definition
* directly. Note that the returned address is thread-specific.
*/
extern int *decc$h_errno_get_addr ();
return *decc$h_errno_get_addr ();
#elif defined (__rtems__)
/* At this stage in the tool build, no networking .h files are available.
* Newlib does not provide networking .h files and RTEMS is not built yet.
@ -550,11 +509,6 @@ __gnat_socket_ioctl (int fd, IOCTL_Req_T req, int *arg) {
#ifndef HAVE_INET_PTON
#ifdef VMS
# define in_addr_t int
# define inet_addr decc$inet_addr
#endif
int
__gnat_inet_pton (int af, const char *src, void *dst) {
switch (af) {
@ -592,7 +546,7 @@ __gnat_inet_pton (int af, const char *src, void *dst) {
}
return (rc == 0);
#elif defined (__hpux__) || defined (VMS)
#elif defined (__hpux__)
in_addr_t addr;
int rc = -1;