OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

mlib-tgt-vms-ia64.adb, [...] (Is_Interface): Change Ada bind file prefix on VMS from b$ to b__.

Browse Source 
2005-12-05  Doug Rupp  <rupp@adacore.com>

	* mlib-tgt-vms-ia64.adb, mlib-tgt-vms-alpha.adb (Is_Interface): Change
	Ada bind file prefix on VMS from b$ to b__.
	(Build_Dynamic_Library): Change Init file suffix on VMS from $init to
	__init.

	* prj-nmsc.adb: Change some Hostparm.OpenVMS checks to
	Targparm.OpenVMS_On_Target.
	(Object_Suffix): Initialize with target object suffix.
	(Get_Unit): Change Ada bind file prefix on VMS from b$ to b__.

	* butil.adb: Change some Hostparm.OpenVMS checks to
	Targparm.OpenVMS_On_Target.

	* clean.adb: Change some Hostparm.OpenVMS checks to
	Targparm.OpenVMS_On_Target.
	(Object_Suffix): Initialize with call to Get_Target_Object_Suffix.
	({declaraction},Delete_Binder_Generated_Files,{initialization}): Change
	Ada bind file prefix on VMS from b$ to b__.

	* gnatlink.adb (Process_Args): Call Add_Src_Search_Dir for -I in
	--GCC so that Get_Target_Parameters can find system.ads.
	(Gnatlink): Call Get_Target_Parameters in mainline.
	Initialize standard packages for Targparm.
	Change some Hostparm.OpenVMS checks to Targparm.OpenVMS_On_Target.
	(Process_Args): Also Check for object files with target object
	extension.
	(Make_Binder_File_Names): Create with target object extension.
	(Make_Binder_File_Names): Change Ada bind file prefix on VMS from b$
	to b__.

	* mlib-prj.adb: Change some Hostparm.OpenVMS checks to
	Targparm.OpenVMS_On_Target.
	({declaration},Build_Library,Check_Library): Change Ada bind file
	prefix on VMS from b$ to b__.

	* osint-b.adb: Change some Hostparm.OpenVMS checks to
	Targparm.OpenVMS_On_Target.
	(Create_Binder_Output): Change Ada bind file prefix on VMS from b$ to
	b__.

	* targext.c: New file.

	* Makefile.in: add support for vxworks653 builds
	(../../vxaddr2line): gnatlink with targext.o.
	(TOOLS_LIBS): Move targext.o to precede libgnat.
	(init.o, initialize.o): Minor clean up in dependencies.
	(GNATLINK_OBJS): Add targparm.o, snames.o
	Add rules fo building targext.o and linking it explicitly with all
	tools.
	Also add targext.o to gnatlib.

	* Make-lang.in: Add rules for building targext.o and linking it in
	with gnat1 and gnatbind.
	Add entry for exp_sel.o.

	* osint.adb Change some Hostparm.OpenVMS checks to
	Targparm.OpenVMS_On_Target.
	(Object_File_Name): Use target object suffix.

	* osint.ads (Object_Suffix): Remove, no longer used.
	(Target_Object_Suffix): Initialize with target object suffix.

	* rident.ads: Add special exception to license.

	* targparm.adb (Get_Target_Parameters): Set the value of
	Multi_Unit_Index_Character after OpenVMS_On_Target gets its definitive
	value.
	(Get_Target_Parameters): Set OpenVMS_On_Target if openvms.
	
	* targparm.ads: Add special exception to license.

	* g-os_lib.ads, g-os_lib.adb (Get_Target_Debuggable_Suffix): New
	function.
	(Copy_File): Make sure from file is closed if error on to file
	(Get_Target_Executable_Suffix, Get_Target_Object_Suffix): New functions.

	* make.adb (Object_Suffix): Intialize with Get_Target_Object_Suffix.
	(Executable_Suffix): Intialize with Get_Target_Executable_Suffix.

	* osint-c.adb (Set_Output_Object_File_Name): Initialize extension with
	target object suffix.

From-SVN: r108285
This commit is contained in:
Doug Rupp 2005-12-09 18:14:34 +01:00 committed by Arnaud Charlet
parent 4d744221db
commit bb4daba346
20 changed files with 435 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/Make-lang.in
View File

@ -121,10 +121,10 @@ GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
ada/exp_ch4.o ada/exp_ch5.o ada/exp_ch6.o ada/exp_ch7.o ada/exp_ch8.o \
ada/exp_ch9.o ada/exp_code.o ada/exp_dbug.o ada/exp_disp.o ada/exp_dist.o \
ada/exp_fixd.o ada/exp_aggr.o ada/exp_imgv.o ada/exp_intr.o ada/exp_pakd.o \
ada/exp_prag.o ada/exp_smem.o ada/exp_strm.o ada/exp_tss.o ada/exp_util.o \
ada/exp_vfpt.o ada/expander.o ada/fname.o ada/fname-uf.o ada/fmap.o \
ada/freeze.o ada/frontend.o ada/gnat.o ada/g-hesora.o ada/g-htable.o \
ada/g-os_lib.o ada/g-speche.o ada/g-string.o ada/g-utf_32.o \
ada/exp_prag.o ada/exp_sel.o ada/exp_smem.o ada/exp_strm.o ada/exp_tss.o \
ada/exp_util.o ada/exp_vfpt.o ada/expander.o ada/fname.o ada/fname-uf.o \
ada/fmap.o ada/freeze.o ada/frontend.o ada/gnat.o ada/g-hesora.o \
ada/g-htable.o ada/g-os_lib.o ada/g-speche.o ada/g-string.o ada/g-utf_32.o \
ada/s-crc32.o ada/get_targ.o \
ada/gnatvsn.o ada/hlo.o ada/hostparm.o ada/impunit.o ada/interfac.o \
ada/itypes.o ada/inline.o ada/krunch.o ada/lib.o ada/layout.o ada/lib-load.o \
@ -148,7 +148,7 @@ GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
ada/stylesw.o ada/validsw.o ada/system.o ada/table.o ada/targparm.o \
ada/tbuild.o ada/tree_gen.o ada/tree_io.o ada/treepr.o ada/treeprs.o \
ada/ttypef.o ada/ttypes.o ada/types.o ada/uintp.o ada/uname.o ada/urealp.o \
ada/usage.o ada/widechar.o ada/s-crtl.o ada/seh_init.o
ada/usage.o ada/widechar.o ada/s-crtl.o ada/seh_init.o ada/targext.o
# Object files for gnat executables
GNAT1_ADA_OBJS = $(GNAT_ADA_OBJS) ada/back_end.o ada/gnat1drv.o
@ -166,6 +166,7 @@ GNATBIND_OBJS = \
ada/initialize.o \
ada/seh_init.o \
ada/link.o \
ada/targext.o \
ada/raise.o \
ada/tracebak.o \
ada/a-except.o \
@ -491,7 +492,7 @@ ada.install-common:
if [ -d $(DESTDIR)$(tooldir)/bin/. ] ; then \
rm -f $(DESTDIR)$(tooldir)/bin/gnatchop$(exeext); \
$(INSTALL_PROGRAM) gnatchop-cross$(exeext) $(DESTDIR)$(tooldir)/bin/gnatchop$(exeext); \
fi; \
fi ; \
else \
$(RM) $(DESTDIR)$(bindir)/gnatchop$(exeext); \
$(INSTALL_PROGRAM) gnatchop$(exeext) $(DESTDIR)$(bindir)/gnatchop$(exeext); \
@ -1017,6 +1018,11 @@ ada/exit.o : ada/exit.c $(CONFIG_H) $(SYSTEM_H) ada/adaint.h
ada/final.o : ada/final.c $(CONFIG_H) $(SYSTEM_H) ada/raise.h
ada/link.o : ada/link.c
ada/targext.o : ada/targext.c $(SYSTEM_H) coretypes.h $(TM_H)
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
$< $(OUTPUT_OPTION)
ada/cio.o : ada/cio.c $(CONFIG_H) $(SYSTEM_H) ada/adaint.h
$(CC) -c $(ALL_CFLAGS) $(ALL_ADA_CFLAGS) \
$(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
@ -1050,7 +1056,7 @@ ada/decl.o : ada/decl.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H) \
gt-ada-decl.h $(EXPR_H)
ada/misc.o : ada/misc.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H) \
$(RTL_H) $(EXPR_H) insn-codes.h insn-flags.h recog.h flags.h \
$(RTL_H) $(EXPR_H) insn-codes.h insn-flags.h insn-config.h recog.h flags.h \
diagnostic.h output.h except.h $(TM_P_H) langhooks.h debug.h \
$(LANGHOOKS_DEF_H) libfuncs.h $(OPTABS_H) ada/ada.h ada/types.h \
ada/atree.h ada/nlists.h ada/elists.h ada/sinfo.h ada/einfo.h ada/namet.h \

86
gcc/ada/Makefile.in
View File

@ -247,7 +247,7 @@ LIBS = $(LIBINTL) $(LIBIBERTY) $(SYSLIBS)
LIBDEPS = $(LIBINTL_DEP) $(LIBIBERTY)
# Default is no TGT_LIB; one might be passed down or something
TGT_LIB =
TOOLS_LIBS = $(LIBGNAT) $(EXTRA_GNATTOOLS_OBJS) link.o ../../../libiberty/libiberty.a $(SYSLIBS) $(TGT_LIB)
TOOLS_LIBS = $(EXTRA_GNATTOOLS_OBJS) targext.o link.o $(LIBGNAT) ../../../libiberty/libiberty.a $(SYSLIBS) $(TGT_LIB)
# Specify the directories to be searched for header files.
# Both . and srcdir are used, in that order,
@ -296,10 +296,11 @@ Makefile: ../config.status $(srcdir)/Makefile.in $(srcdir)/../version.c
# Lists of files for various purposes.
GNATLINK_OBJS = gnatlink.o \
a-except.o ali.o alloc.o butil.o casing.o csets.o debug.o fmap.o fname.o gnatvsn.o \
hostparm.o indepsw.o interfac.o i-c.o i-cstrin.o namet.o opt.o osint.o output.o rident.o \
s-exctab.o s-secsta.o s-stalib.o s-stoele.o sdefault.o stylesw.o switch.o system.o \
table.o tree_io.o types.o validsw.o widechar.o
a-except.o ali.o alloc.o butil.o casing.o csets.o debug.o fmap.o fname.o \
gnatvsn.o hostparm.o indepsw.o interfac.o i-c.o i-cstrin.o namet.o opt.o \
osint.o output.o rident.o s-exctab.o s-secsta.o s-stalib.o s-stoele.o \
sdefault.o snames.o stylesw.o switch.o system.o table.o targparm.o tree_io.o \
types.o validsw.o widechar.o
GNATMAKE_OBJS = a-except.o ctrl_c.o ali.o ali-util.o s-casuti.o \
alloc.o atree.o binderr.o butil.o casing.o csets.o debug.o elists.o einfo.o\
@ -595,6 +596,56 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
endif
# vxworksae / vxworks 653
ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
# target pairs for kernel + vthreads runtime
LIBGNAT_TARGET_PAIRS = \
a-elchha.adb<a-elchha-vxworks-ppc-full.adb \
a-intnam.ads<a-intnam-vxworks.ads \
a-numaux.ads<a-numaux-vxworks.ads \
a-sytaco.ads<1asytaco.ads \
a-sytaco.adb<1asytaco.adb \
g-io.adb<g-io-vxworks-ppc-cert.adb \
g-io.ads<g-io-vxworks-ppc-cert.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-interr.adb<s-interr-vxworks.adb \
s-intman.ads<s-intman-vxworks.ads \
s-intman.adb<s-intman-vxworks.adb \
s-osinte.adb<s-osinte-vxworks.adb \
s-osinte.ads<s-osinte-vxworks.ads \
s-osprim.adb<s-osprim-vxworks.adb \
s-parame.ads<s-parame-ae653.ads \
s-taprop.adb<s-taprop-vxworks.adb \
s-taspri.ads<s-taspri-vxworks.ads \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwork.ads<s-vxwork-ppc.ads \
g-soccon.ads<g-soccon-vxworks.ads \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
system.ads<system-vxworks-ppc-vthread.ads
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-vxworks.adb
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
# Extra pairs for the vthreads runtime
ifeq ($(strip $(filter-out vthreads,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
s-thread.adb<s-thread-ae653.adb
EXTRA_GNATRTL_NONTASKING_OBJS += s-thread.o
endif
ifeq ($(strip $(filter-out yes,$(TRACE))),)
LIBGNAT_TARGET_PAIRS += \
s-traces.adb<s-traces-default.adb \
s-trafor.adb<s-trafor-default.adb \
s-trafor.ads<s-trafor-default.ads \
s-tratas.adb<s-tratas-default.adb \
s-tfsetr.adb<s-tfsetr-vxworks.adb
endif
endif
ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-solaris.ads \
@ -1335,11 +1386,11 @@ LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \
errno.c exit.c cal.c ctrl_c.c \
raise.h raise.c sysdep.c aux-io.c init.c initialize.c seh_init.c \
final.c tracebak.c tb-alvms.c tb-alvxw.c expect.c mkdir.c socket.c gsocket.h \
$(EXTRA_LIBGNAT_SRCS)
targext.c $(EXTRA_LIBGNAT_SRCS)
LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o \
raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o \
final.o tracebak.o expect.o mkdir.o socket.o $(EXTRA_LIBGNAT_OBJS)
final.o tracebak.o expect.o mkdir.o socket.o targext.o $(EXTRA_LIBGNAT_OBJS)
# NOTE ??? - when the -I option for compiling Ada code is made to work,
# the library installation will change and there will be a
@ -1445,12 +1496,12 @@ endif
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) $(GNATBIND_FLAGS) gnatdll
$(GNATLINK) -v gnatdll -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
../../vxaddr2line$(exeext):
../../vxaddr2line$(exeext): targext.o
$(GNATMAKE) -c $(ADA_INCLUDES) vxaddr2line --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vxaddr2line
$(GNATLINK) -v vxaddr2line -o $@ --GCC=$(GCC_LINK) $(CLIB)
$(GNATLINK) -v vxaddr2line -o $@ --GCC=$(GCC_LINK) targext.o $(CLIB)
gnatmake-re: link.o
gnatmake-re: link.o targext.o
$(GNATMAKE) $(ADA_INCLUDES) -u sdefault --GCC="$(CC) $(MOST_ADA_FLAGS)"
$(GNATMAKE) -c $(ADA_INCLUDES) gnatmake --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatmake
@ -1459,7 +1510,7 @@ gnatmake-re: link.o
# Note the use of the "mv" command in order to allow gnatlink to be linked with
# with the former version of gnatlink itself which cannot override itself.
gnatlink-re: link.o
gnatlink-re: link.o targext.o
$(GNATMAKE) -c $(ADA_INCLUDES) gnatlink --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatlink
$(GNATLINK) -v gnatlink -o ../../gnatlinknew$(exeext) \
@ -1471,11 +1522,11 @@ gnatlink-re: link.o
# stamp target in the parent directory whenever gnat1 is rebuilt
# Likewise for the tools
../../gnatmake$(exeext): $(P) b_gnatm.o link.o $(GNATMAKE_OBJS)
../../gnatmake$(exeext): $(P) b_gnatm.o link.o targext.o $(GNATMAKE_OBJS)
$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ b_gnatm.o $(GNATMAKE_OBJS) \
$(TOOLS_LIBS)
../../gnatlink$(exeext): $(P) b_gnatl.o link.o $(GNATLINK_OBJS)
../../gnatlink$(exeext): $(P) b_gnatl.o link.o targext.o $(GNATLINK_OBJS)
$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ b_gnatl.o $(GNATLINK_OBJS) \
$(TOOLS_LIBS)
@ -1869,14 +1920,19 @@ cio.o : cio.c
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
$(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
init.o : init.c ada.h types.h raise.h
init.o : init.c adaint.h raise.h
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
$(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
initialize.o : initialize.c
initialize.o : initialize.c raise.h
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
$(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
targext.o : targext.c
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
$(ALL_CPPFLAGS) $(INCLUDES_FOR_SUBDIR) \
$< $(OUTPUT_OPTION)
# No optimization to compile this file as optimizations (-O1 or above) breaks
# the SEH handling on Windows. The reasons are not clear.
seh_init.o : seh_init.c raise.h

12
gcc/ada/butil.adb
View File

@ -24,9 +24,9 @@
-- --
------------------------------------------------------------------------------
with Hostparm; use Hostparm;
with Namet; use Namet;
with Output; use Output;
with Targparm; use Targparm;
package body Butil is
@ -45,11 +45,11 @@ package body Butil is
or else
Name_Buffer (1 .. 5) = "gnat."))
or else
(OpenVMS
and then Name_Len > 3
and then (Name_Buffer (1 .. 4) = "dec%"
or else
Name_Buffer (1 .. 4) = "dec."));
(OpenVMS_On_Target
and then Name_Len > 3
and then (Name_Buffer (1 .. 4) = "dec%"
or else
Name_Buffer (1 .. 4) = "dec."));
end Is_Internal_Unit;

16
gcc/ada/clean.adb
View File

@ -27,7 +27,6 @@
with ALI; use ALI;
with Csets;
with Gnatvsn;
with Hostparm;
with Makeutl;
with MLib.Tgt; use MLib.Tgt;
with Namet; use Namet;
@ -41,6 +40,7 @@ with Prj.Pars;
with Prj.Util; use Prj.Util;
with Snames;
with Table;
with Targparm; use Targparm;
with Types; use Types;
with Ada.Command_Line; use Ada.Command_Line;
@ -60,16 +60,16 @@ package body Clean is
Assembly_Suffix : constant String := ".s";
ALI_Suffix : constant String := ".ali";
Tree_Suffix : constant String := ".adt";
Object_Suffix : constant String := Get_Object_Suffix.all;
Object_Suffix : constant String := Get_Target_Object_Suffix.all;
Debug_Suffix : String := ".dg";
-- Changed to "_dg" for VMS in the body of the package
Repinfo_Suffix : String := ".rep";
-- Changed to "_rep" for VMS in the body of the package
B_Start : String := "b~";
-- Prefix of binder generated file.
-- Changed to "b$" for VMS in the body of the package.
B_Start : String_Ptr := new String'("b~");
-- Prefix of binder generated file, and number of actual characters used.
-- Changed to "b__" for VMS in the body of the package.
Object_Directory_Path : String_Access := null;
-- The path name of the object directory, set with switch -D
@ -1240,7 +1240,7 @@ package body Clean is
-- Build the file name (before the extension)
File_Name (1 .. B_Start'Length) := B_Start;
File_Name (1 .. B_Start'Length) := B_Start.all;
File_Name (B_Start'Length + 1 .. Last) := Source_Name;
-- Spec
@ -1899,9 +1899,9 @@ package body Clean is
end Usage;
begin
if Hostparm.OpenVMS then
if OpenVMS_On_Target then
Debug_Suffix (Debug_Suffix'First) := '_';
Repinfo_Suffix (Repinfo_Suffix'First) := '_';
B_Start (B_Start'Last) := '$';
B_Start := new String'("b__");
end if;
end Clean;

96
gcc/ada/g-os_lib.adb
View File

@ -384,7 +384,11 @@ package body GNAT.OS_Lib is
procedure Free is new Unchecked_Deallocation (Buf, Buf_Ptr);
begin
if From = Invalid_FD or else To = Invalid_FD then
if From = Invalid_FD then
raise Copy_Error;
elsif To = Invalid_FD then
Close (From, Status_From);
raise Copy_Error;
end if;
@ -903,6 +907,36 @@ package body GNAT.OS_Lib is
return Result;
end Get_Debuggable_Suffix;
----------------------------------
-- Get_Target_Debuggable_Suffix --
----------------------------------
function Get_Target_Debuggable_Suffix return String_Access is
Target_Exec_Ext_Ptr : Address;
pragma Import
(C, Target_Exec_Ext_Ptr, "__gnat_target_debuggable_extension");
procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer);
pragma Import (C, Strncpy, "strncpy");
function Strlen (Cstring : Address) return Integer;
pragma Import (C, Strlen, "strlen");
Suffix_Length : Integer;
Result : String_Access;
begin
Suffix_Length := Strlen (Target_Exec_Ext_Ptr);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
Strncpy (Result.all'Address, Target_Exec_Ext_Ptr, Suffix_Length);
end if;
return Result;
end Get_Target_Debuggable_Suffix;
---------------------------
-- Get_Executable_Suffix --
---------------------------
@ -930,6 +964,36 @@ package body GNAT.OS_Lib is
return Result;
end Get_Executable_Suffix;
----------------------------------
-- Get_Target_Executable_Suffix --
----------------------------------
function Get_Target_Executable_Suffix return String_Access is
Target_Exec_Ext_Ptr : Address;
pragma Import
(C, Target_Exec_Ext_Ptr, "__gnat_target_executable_extension");
procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer);
pragma Import (C, Strncpy, "strncpy");
function Strlen (Cstring : Address) return Integer;
pragma Import (C, Strlen, "strlen");
Suffix_Length : Integer;
Result : String_Access;
begin
Suffix_Length := Strlen (Target_Exec_Ext_Ptr);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
Strncpy (Result.all'Address, Target_Exec_Ext_Ptr, Suffix_Length);
end if;
return Result;
end Get_Target_Executable_Suffix;
-----------------------
-- Get_Object_Suffix --
-----------------------
@ -957,6 +1021,36 @@ package body GNAT.OS_Lib is
return Result;
end Get_Object_Suffix;
------------------------------
-- Get_Target_Object_Suffix --
------------------------------
function Get_Target_Object_Suffix return String_Access is
Target_Object_Ext_Ptr : Address;
pragma Import
(C, Target_Object_Ext_Ptr, "__gnat_target_object_extension");
procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer);
pragma Import (C, Strncpy, "strncpy");
function Strlen (Cstring : Address) return Integer;
pragma Import (C, Strlen, "strlen");
Suffix_Length : Integer;
Result : String_Access;
begin
Suffix_Length := Strlen (Target_Object_Ext_Ptr);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
Strncpy (Result.all'Address, Target_Object_Ext_Ptr, Suffix_Length);
end if;
return Result;
end Get_Target_Object_Suffix;
------------
-- Getenv --
------------

38
gcc/ada/g-os_lib.ads
View File

@ -520,17 +520,29 @@ package GNAT.OS_Lib is
function Get_Debuggable_Suffix return String_Access;
-- Return the debuggable suffix convention. Usually this is the same as
-- the convention for Get_Executable_Suffix. The result is allocated on
-- the heap and should be freed when no longer needed to avoid storage
-- the heap and should be freed after use to avoid storage leaks.
function Get_Target_Debuggable_Suffix return String_Access;
-- Return the target debuggable suffix convention. Usually this is the
-- same as the convention for Get_Executable_Suffix. The result is
-- allocated on the heap and should be freed after use to avoid storage
-- leaks.
function Get_Executable_Suffix return String_Access;
-- Return the executable suffix convention. The result is allocated on
-- the heap and should be freed when no longer needed to avoid storage
-- leaks.
-- Return the executable suffix convention. The result is allocated on the
-- heap and should be freed after use to avoid storage leaks.
function Get_Object_Suffix return String_Access;
-- Return the object suffix convention. The result is allocated on the
-- heap and should be freed when no longer needed to avoid storage leaks.
-- Return the object suffix convention. The result is allocated on the heap
-- and should be freed after use to avoid storage leaks.
function Get_Target_Executable_Suffix return String_Access;
-- Return the target executable suffix convention. The result is allocated
-- on the heap and should be freed after use to avoid storage leaks.
function Get_Target_Object_Suffix return String_Access;
-- Return the target object suffix convention. The result is allocated on
-- the heap and should be freed after use to avoid storage leaks.
-- The following section contains low-level routines using addresses to
-- pass file name and executable name. In each routine the name must be
@ -706,12 +718,12 @@ package GNAT.OS_Lib is
Args : Argument_List)
return Process_Id;
-- This is a non blocking call. The Process_Id of the spawned process is
-- returned. Parameters are to be used as in Spawn. If Invalid_Id is
-- returned. Parameters are to be used as in Spawn. If Invalid_Pid is
-- returned the program could not be spawned.
--
-- "Non_Blocking_Spawn" should not be used in tasking applications.
--
-- This function will always return Invalid_Id under VxWorks, since there
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
@ -721,12 +733,12 @@ package GNAT.OS_Lib is
Err_To_Out : Boolean := True) return Process_Id;
-- Similar to the procedure above, but redirects the output to the file
-- designated by Output_File_Descriptor. If Err_To_Out is True, then the
-- Standard Error output is also redirected. Invalid_Id is returned
-- Standard Error output is also redirected. Invalid_Pid is returned
-- if the program could not be spawned successfully.
--
-- "Non_Blocking_Spawn" should not be used in tasking applications.
--
-- This function will always return Invalid_Id under VxWorks, since there
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
@ -739,13 +751,13 @@ package GNAT.OS_Lib is
-- a file with the name Output_File.
--
-- Success is set to True if the command is executed and its output
-- successfully written to the file. Invalid_Id is returned if the output
-- successfully written to the file. Invalid_Pid is returned if the output
-- file could not be created or if the program could not be spawned
-- successfully.
--
-- "Non_Blocking_Spawn" should not be used in tasking applications.
--
-- This function will always return Invalid_Id under VxWorks, since there
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
procedure Wait_Process (Pid : out Process_Id; Success : out Boolean);
@ -757,7 +769,7 @@ package GNAT.OS_Lib is
-- Wait_Process is immediate. Pid identifies the process that has
-- terminated (matching the value returned from Non_Blocking_Spawn).
-- Success is set to True if this sub-process terminated successfully. If
-- Pid = Invalid_Id, there were no subprocesses left to wait on.
-- Pid = Invalid_Pid, there were no subprocesses left to wait on.
--
-- This function will always set success to False under VxWorks, since
-- there is no notion of executables under this OS.

118
gcc/ada/gnatlink.adb
View File

@ -27,6 +27,7 @@
-- Gnatlink usage: please consult the gnat documentation
with ALI; use ALI;
with Csets;
with Gnatvsn; use Gnatvsn;
with Hostparm;
with Indepsw; use Indepsw;
@ -34,9 +35,11 @@ with Namet; use Namet;
with Opt;
with Osint; use Osint;
with Output; use Output;
with Snames;
with Switch; use Switch;
with System; use System;
with Table;
with Targparm; use Targparm;
with Types;
with Ada.Command_Line; use Ada.Command_Line;
@ -301,9 +304,7 @@ procedure Gnatlink is
new String'(Arg);
elsif Arg'Length /= 0 and then Arg (1) = '-' then
if Arg'Length > 4
and then Arg (2 .. 5) = "gnat"
then
if Arg'Length > 4 and then Arg (2 .. 5) = "gnat" then
Exit_With_Error
("invalid switch: """ & Arg & """ (gnat not needed here)");
end if;
@ -335,6 +336,7 @@ procedure Gnatlink is
elsif Arg'Length >= 3 and then Arg (2) = 'M' then
declare
Switches : String_List_Access;
begin
Convert (Map_File, Arg (3 .. Arg'Last), Switches);
@ -461,7 +463,6 @@ procedure Gnatlink is
Linker_Options.Table (Linker_Options.Last);
elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then
if Arg'Length = 7 then
Exit_With_Error ("Missing argument for --LINK=");
end if;
@ -502,6 +503,15 @@ procedure Gnatlink is
end if;
end if;
-- Add directory to source search dirs so that
-- Get_Target_Parameters can find system.ads
if Arg (AF .. AF + 1) = "-I"
and then Arg'Length > 2
then
Add_Src_Search_Dir (Arg (AF + 2 .. Arg'Last));
end if;
-- Pass to gcc for compiling binder generated file
-- No use passing libraries, it will just generate
-- a warning
@ -546,7 +556,20 @@ procedure Gnatlink is
Exit_With_Error ("cannot handle more than one ALI file");
end if;
-- If object file, record object file
-- If target object file, record object file
elsif Arg'Length > Get_Target_Object_Suffix.all'Length
and then Arg
(Arg'Last -
Get_Target_Object_Suffix.all'Length + 1 .. Arg'Last)
= Get_Target_Object_Suffix.all
then
Linker_Objects.Increment_Last;
Linker_Objects.Table (Linker_Objects.Last) :=
new String'(Arg);
-- If host object file, record object file
-- e.g. accept foo.o as well as foo.obj on VMS target
elsif Arg'Length > Get_Object_Suffix.all'Length
and then Arg
@ -1012,7 +1035,7 @@ procedure Gnatlink is
-- The following test needs comments, why is it VMS specific.
-- The above comment looks out of date ???
elsif not (Hostparm.OpenVMS
elsif not (OpenVMS_On_Target
and then
Is_Option_Present (Next_Line (Nfirst .. Nlast)))
then
@ -1424,17 +1447,24 @@ begin
if not Is_Regular_File (Ali_File_Name.all) then
Exit_With_Error (Ali_File_Name.all & " not found");
end if;
-- Get target parameters
Namet.Initialize;
Csets.Initialize;
Snames.Initialize;
Osint.Add_Default_Search_Dirs;
Targparm.Get_Target_Parameters;
-- Read the ALI file of the main subprogram if the binder generated
-- file needs to be compiled and no --GCC= switch has been specified.
-- Fetch the back end switches from this ALI file and use these switches
-- to compile the binder generated file
elsif Compile_Bind_File and then Standard_Gcc then
-- Do some initializations
if Compile_Bind_File and then Standard_Gcc then
Initialize_ALI;
Namet.Initialize;
Name_Len := Ali_File_Name'Length;
Name_Buffer (1 .. Name_Len) := Ali_File_Name.all;
@ -1445,7 +1475,6 @@ begin
A : ALI_Id;
begin
-- Osint.Add_Default_Search_Dirs;
-- Load the ALI file
T := Read_Library_Info (F, True);
@ -1494,10 +1523,9 @@ begin
-- If no output name specified, then use the base name of .ali file name
if Output_File_Name = null then
Output_File_Name :=
new String'(Base_Name (Ali_File_Name.all)
& Get_Debuggable_Suffix.all);
& Get_Target_Debuggable_Suffix.all);
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
@ -1506,7 +1534,6 @@ begin
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) :=
new String'(Output_File_Name.all);
end if;
-- Warn if main program is called "test", as that may be a built-in command
@ -1554,63 +1581,49 @@ begin
"__gnat_get_maximum_file_name_length");
Maximum_File_Name_Length : constant Integer :=
Get_Maximum_File_Name_Length;
Get_Maximum_File_Name_Length;
Second_Char : Character;
-- Second character of name of files
Bind_File_Prefix : Types.String_Ptr;
-- Contains prefix used for bind files
begin
-- Set proper second character of file name
-- Set prefix
if not Ada_Bind_File then
Second_Char := '_';
elsif Hostparm.OpenVMS then
Second_Char := '$';
Bind_File_Prefix := new String'("b_");
elsif OpenVMS_On_Target then
Bind_File_Prefix := new String'("b__");
else
Second_Char := '~';
Bind_File_Prefix := new String'("b~");
end if;
-- If the length of the binder file becomes too long due to
-- the addition of the "b?" prefix, then truncate it.
if Maximum_File_Name_Length > 0 then
while Fname_Len > Maximum_File_Name_Length - 2 loop
while Fname_Len >
Maximum_File_Name_Length - Bind_File_Prefix.all'Length
loop
Fname_Len := Fname_Len - 1;
end loop;
end if;
if Ada_Bind_File then
Binder_Spec_Src_File :=
new String'('b'
& Second_Char
& Fname (Fname'First .. Fname'First + Fname_Len - 1)
& ".ads");
Binder_Body_Src_File :=
new String'('b'
& Second_Char
& Fname (Fname'First .. Fname'First + Fname_Len - 1)
& ".adb");
Binder_Ali_File :=
new String'('b'
& Second_Char
& Fname (Fname'First .. Fname'First + Fname_Len - 1)
& ".ali");
declare
Fnam : constant String :=
Bind_File_Prefix.all &
Fname (Fname'First .. Fname'First + Fname_Len - 1);
else
Binder_Body_Src_File :=
new String'('b'
& Second_Char
& Fname (Fname'First .. Fname'First + Fname_Len - 1)
& ".c");
end if;
begin
if Ada_Bind_File then
Binder_Spec_Src_File := new String'(Fnam & ".ads");
Binder_Body_Src_File := new String'(Fnam & ".adb");
Binder_Ali_File := new String'(Fnam & ".ali");
else
Binder_Body_Src_File := new String'(Fnam & ".c");
end if;
Binder_Obj_File :=
new String'('b'
& Second_Char
& Fname (Fname'First .. Fname'First + Fname_Len - 1)
& Get_Object_Suffix.all);
Binder_Obj_File := new String'(Fnam & Get_Target_Object_Suffix.all);
end;
if Fname_Len /= Fname'Length then
Binder_Options.Increment_Last;
@ -1618,7 +1631,6 @@ begin
Binder_Options.Increment_Last;
Binder_Options.Table (Binder_Options.Last) := Binder_Obj_File;
end if;
end Make_Binder_File_Names;
Process_Binder_File (Binder_Body_Src_File.all & ASCII.NUL);

4
gcc/ada/make.adb
View File

@ -628,8 +628,8 @@ package body Make is
GNAT_Flag : constant String_Access := new String'("-gnatpg");
Do_Not_Check_Flag : constant String_Access := new String'("-x");
Object_Suffix : constant String := Get_Object_Suffix.all;
Executable_Suffix : constant String := Get_Executable_Suffix.all;
Object_Suffix : constant String := Get_Target_Object_Suffix.all;
Executable_Suffix : constant String := Get_Target_Executable_Suffix.all;
Syntax_Only : Boolean := False;
-- Set to True when compiling with -gnats

41
gcc/ada/mlib-prj.adb
View File

@ -26,7 +26,6 @@
with ALI; use ALI;
with Gnatvsn; use Gnatvsn;
with Hostparm;
with MLib.Fil; use MLib.Fil;
with MLib.Tgt; use MLib.Tgt;
with MLib.Utl; use MLib.Utl;
@ -40,6 +39,7 @@ with Sinput.P;
with Snames; use Snames;
with Switch; use Switch;
with Table;
with Targparm; use Targparm;
with Ada.Characters.Handling;
@ -55,12 +55,13 @@ package body MLib.Prj is
pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files");
Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0;
-- Indicates if object files in pragmas Linker_Options (found in the
-- binder generated file) should be taken when linking aq stand-alone
-- library.
-- False for Windows, True for other platforms.
-- binder generated file) should be taken when linking a stand-alone
-- library. False for Windows, True for other platforms.
ALI_Suffix : constant String := ".ali";
B_Start : String := "b~";
B_Start : String_Ptr := new String'("b~");
-- Prefix of bind file, changed to b__ for VMS
S_Osinte_Ads : Name_Id := No_Name;
-- Name_Id for "s-osinte.ads"
@ -515,7 +516,7 @@ package body MLib.Prj is
begin
if not Libgnarl_Needed or
(Hostparm.OpenVMS and then
(OpenVMS_On_Target and then
((not Libdecgnat_Needed) or
(not Gtrasymobj_Needed)))
then
@ -542,7 +543,7 @@ package body MLib.Prj is
if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
Libgnarl_Needed := True;
elsif Hostparm.OpenVMS then
elsif OpenVMS_On_Target then
if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
Libdecgnat_Needed := True;
@ -799,18 +800,18 @@ package body MLib.Prj is
Arguments := new String_List (1 .. Initial_Argument_Max);
end if;
-- Add "-n -o b~<lib>.adb (b$<lib>.adb on VMS) -L<lib>"
-- Add "-n -o b~<lib>.adb (b__<lib>.adb on VMS) -L<lib>"
Argument_Number := 2;
Arguments (1) := No_Main;
Arguments (2) := Output_Switch;
if Hostparm.OpenVMS then
B_Start (B_Start'Last) := '$';
if OpenVMS_On_Target then
B_Start := new String'("b__");
end if;
Add_Argument
(B_Start & Get_Name_String (Data.Library_Name) & ".adb");
(B_Start.all & Get_Name_String (Data.Library_Name) & ".adb");
Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
if Data.Lib_Auto_Init and then SALs_Use_Constructors then
@ -1006,7 +1007,7 @@ package body MLib.Prj is
In_Tree => In_Tree,
Including_Libraries => True);
-- Invoke <gcc> -c b$$<lib>.adb
-- Invoke <gcc> -c b__<lib>.adb
-- Allocate Arguments, if it is the first time we see a standalone
-- library.
@ -1018,12 +1019,12 @@ package body MLib.Prj is
Argument_Number := 1;
Arguments (1) := Compile_Switch;
if Hostparm.OpenVMS then
B_Start (B_Start'Last) := '$';
if OpenVMS_On_Target then
B_Start := new String'("b__");
end if;
Add_Argument
(B_Start & Get_Name_String (Data.Library_Name) & ".adb");
(B_Start.all & Get_Name_String (Data.Library_Name) & ".adb");
-- If necessary, add the PIC option
@ -1160,7 +1161,7 @@ package body MLib.Prj is
-- Add the objects found in the object directory and the object
-- directories of the extended files, if any, except for generated
-- object files (b~.. or B$..) from extended projects.
-- object files (b~.. or B__..) from extended projects.
-- When there are one or more extended files, only add an object file
-- if no object file with the same name have already been added.
@ -1203,7 +1204,7 @@ package body MLib.Prj is
if In_Main_Object_Directory
or else Last < 5
or else Filename (1 .. B_Start'Length) /= B_Start
or else Filename (1 .. B_Start'Length) /= B_Start.all
then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
@ -1790,8 +1791,8 @@ package body MLib.Prj is
Object_Dir : Dir_Type;
begin
if Hostparm.OpenVMS then
B_Start (B_Start'Last) := '$';
if OpenVMS_On_Target then
B_Start := new String'("b__");
end if;
-- If the library file does not exist, then the time stamp will
@ -1810,7 +1811,7 @@ package body MLib.Prj is
-- generated file.
if Is_Obj (Name_Buffer (1 .. Name_Len))
and then Name_Buffer (1 .. B_Start'Length) /= B_Start
and then Name_Buffer (1 .. B_Start'Length) /= B_Start.all
then
-- Get the object file time stamp

8
gcc/ada/mlib-tgt-vms-alpha.adb
View File

@ -179,7 +179,7 @@ package body MLib.Tgt is
return True;
elsif ALI'Length > 2 and then
ALI (ALI'First .. ALI'First + 1) = "b$"
ALI (ALI'First .. ALI'First + 2) = "b__"
then
return True;
@ -289,7 +289,7 @@ package body MLib.Tgt is
if Auto_Init then
declare
Macro_File_Name : constant String := Lib_Filename & "$init.asm";
Macro_File_Name : constant String := Lib_Filename & "__init.asm";
Macro_File : File_Descriptor;
Init_Proc : String := Lib_Filename & "INIT";
Popen_Result : System.Address;
@ -382,7 +382,7 @@ package body MLib.Tgt is
Additional_Objects :=
new Argument_List'
(1 => new String'(Lib_Filename & "$init.obj"));
(1 => new String'(Lib_Filename & "__init.obj"));
end;
end if;
@ -515,7 +515,7 @@ package body MLib.Tgt is
if Auto_Init then
declare
Auto_Init_Object_File_Name : constant String :=
Lib_Filename & "$init.obj";
Lib_Filename & "__init.obj";
Disregard : Boolean;
begin

8
gcc/ada/mlib-tgt-vms-ia64.adb
View File

@ -179,7 +179,7 @@ package body MLib.Tgt is
return True;
elsif ALI'Length > 2 and then
ALI (ALI'First .. ALI'First + 1) = "b$"
ALI (ALI'First .. ALI'First + 2) = "b__"
then
return True;
@ -287,7 +287,7 @@ package body MLib.Tgt is
if Auto_Init then
declare
Macro_File_Name : constant String := Lib_Filename & "$init.asm";
Macro_File_Name : constant String := Lib_Filename & "__init.asm";
Macro_File : File_Descriptor;
Init_Proc : String := Lib_Filename & "INIT";
Popen_Result : System.Address;
@ -415,7 +415,7 @@ package body MLib.Tgt is
Additional_Objects :=
new Argument_List'
(1 => new String'(Lib_Filename & "$init.obj"));
(1 => new String'(Lib_Filename & "__init.obj"));
end;
end if;
@ -548,7 +548,7 @@ package body MLib.Tgt is
if Auto_Init then
declare
Auto_Init_Object_File_Name : constant String :=
Lib_Filename & "$init.obj";
Lib_Filename & "__init.obj";
Disregard : Boolean;
begin

43
gcc/ada/osint-b.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -24,9 +24,9 @@
-- --
------------------------------------------------------------------------------
with Hostparm;
with Namet; use Namet;
with Opt; use Opt;
with Namet; use Namet;
with Opt; use Opt;
with Targparm; use Targparm;
package body Osint.B is
@ -71,6 +71,10 @@ package body Osint.B is
Findex2 : Natural;
Flength : Natural;
Bind_File_Prefix_Len : Natural := 2;
-- Length of binder file prefix (normally set to 2 for b~, but gets
-- reset to 3 for VMS for b__).
begin
if Output_File_Name /= "" then
Name_Buffer (Output_File_Name'Range) := Output_File_Name;
@ -112,16 +116,24 @@ package body Osint.B is
if Maximum_File_Name_Length > 0 then
if OpenVMS_On_Target and then Typ /= 'c' then
Bind_File_Prefix_Len := 3;
end if;
-- Make room for the extra two characters in "b?"
while Int (Flength) > Maximum_File_Name_Length - 2 loop
while Int (Flength) >
Maximum_File_Name_Length - Nat (Bind_File_Prefix_Len)
loop
Findex2 := Findex2 - 1;
Flength := Findex2 - Findex1;
end loop;
end if;
Name_Buffer (3 .. Flength + 2) := File_Name (Findex1 .. Findex2 - 1);
Name_Buffer (Flength + 3) := '.';
Name_Buffer
(Bind_File_Prefix_Len + 1 .. Flength + Bind_File_Prefix_Len) :=
File_Name (Findex1 .. Findex2 - 1);
Name_Buffer (Flength + Bind_File_Prefix_Len + 1) := '.';
-- C bind file, name is b_xxx.c
@ -132,20 +144,21 @@ package body Osint.B is
Name_Len := Flength + 4;
-- Ada bind file, name is b~xxx.adb or b~xxx.ads
-- (with $ instead of ~ in VMS)
-- (with __ instead of ~ in VMS)
else
if Hostparm.OpenVMS then
Name_Buffer (2) := '$';
if OpenVMS_On_Target then
Name_Buffer (2) := '_';
Name_Buffer (3) := '_';
else
Name_Buffer (2) := '~';
end if;
Name_Buffer (Flength + 4) := 'a';
Name_Buffer (Flength + 5) := 'd';
Name_Buffer (Flength + 6) := Typ;
Name_Buffer (Flength + 7) := ASCII.NUL;
Name_Len := Flength + 6;
Name_Buffer (Flength + Bind_File_Prefix_Len + 2) := 'a';
Name_Buffer (Flength + Bind_File_Prefix_Len + 3) := 'd';
Name_Buffer (Flength + Bind_File_Prefix_Len + 4) := Typ;
Name_Buffer (Flength + Bind_File_Prefix_Len + 5) := ASCII.NUL;
Name_Len := Flength + Bind_File_Prefix_Len + 4;
end if;
end if;

2
gcc/ada/osint-c.adb
View File

@ -319,7 +319,7 @@ package body Osint.C is
---------------------------------
procedure Set_Output_Object_File_Name (Name : String) is
Ext : constant String := Object_Suffix;
Ext : constant String := Target_Object_Suffix;
NL : constant Natural := Name'Length;
EL : constant Natural := Ext'Length;

14
gcc/ada/osint.adb
View File

@ -32,6 +32,7 @@ with Opt; use Opt;
with Output; use Output;
with Sdefault; use Sdefault;
with Table;
with Targparm; use Targparm;
with System.Case_Util; use System.Case_Util;
@ -1776,9 +1777,9 @@ package body Osint is
Get_Name_String (N);
Name_Len := Name_Len - ALI_Suffix'Length - 1;
for J in Object_Suffix'Range loop
for J in Target_Object_Suffix'Range loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Object_Suffix (J);
Name_Buffer (Name_Len) := Target_Object_Suffix (J);
end loop;
return Name_Enter;
@ -2292,7 +2293,7 @@ package body Osint is
Library (3 + Name'Length) := '-';
Library (4 + Name'Length .. Library'Last) := Library_Version;
if Hostparm.OpenVMS then
if OpenVMS_On_Target then
for K in Library'First + 2 .. Library'Last loop
if Library (K) = '.' or else Library (K) = '-' then
Library (K) := '_';
@ -2799,13 +2800,6 @@ begin
Identifier_Character_Set := Get_Default_Identifier_Character_Set;
Maximum_File_Name_Length := Get_Maximum_File_Name_Length;
-- On VMS, '~' is not allowed in file names. Change the multi unit
-- index character to '$'.
if Hostparm.OpenVMS then
Multi_Unit_Index_Character := '$';
end if;
-- Following should be removed by having above function return
-- Integer'Last as indication of no maximum instead of -1 ???

4
gcc/ada/osint.ads
View File

@ -558,8 +558,8 @@ private
-- No_File, that indicates that the file whose name was returned by the
-- last call to Next_Main_Source (and stored here) is to be read.
Object_Suffix : constant String := Get_Object_Suffix.all;
-- The suffix used for the object files
Target_Object_Suffix : constant String := Get_Target_Object_Suffix.all;
-- The suffix used for the target object files
Output_FD : File_Descriptor;
-- The file descriptor for the current library info, tree or binder output

11
gcc/ada/prj-nmsc.adb
View File

@ -38,6 +38,7 @@ with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
with Table; use Table;
with Targparm; use Targparm;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings; use Ada.Strings;
@ -56,7 +57,7 @@ package body Prj.Nmsc is
ALI_Suffix : constant String := ".ali";
-- File suffix for ali files
Object_Suffix : constant String := Get_Object_Suffix.all;
Object_Suffix : constant String := Get_Target_Object_Suffix.all;
-- File suffix for object files
type Name_Location is record
@ -3902,6 +3903,7 @@ package body Prj.Nmsc is
declare
S1 : constant Character := Src (Src'First);
S2 : constant Character := Src (Src'First + 1);
S3 : constant Character := Src (Src'First + 2);
begin
if S1 = 'a' or else S1 = 'g'
@ -3909,8 +3911,11 @@ package body Prj.Nmsc is
then
-- Children or separates of packages A, G, I or S
if (Hostparm.OpenVMS and then S2 = '$')
or else (not Hostparm.OpenVMS and then S2 = '~')
if (OpenVMS_On_Target
and then S2 = '_'
and then S3 = '_')
or else
S2 = '~'
then
Src (Src'First + 1) := '.';

9
gcc/ada/rident.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -19,6 +19,13 @@
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --

51
gcc/ada/targext.c Normal file
View File

@ -0,0 +1,51 @@
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* T A R G E X T *
* *
* C Implementation File *
* *
* Copyright (C) 2005, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
* ware Foundation; either version 2, or (at your option) any later ver- *
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
* for more details. You should have received a copy of the GNU General *
* Public License distributed with GNAT; see file COPYING. If not, write *
* to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
* Boston, MA 02110-1301, USA. *
* *
* As a special exception, if you link this file with other files to *
* produce an executable, this file does not by itself cause the resulting *
* executable to be covered by the GNU General Public License. This except- *
* ion does not however invalidate any other reasons why the executable *
* file might be covered by the GNU Public License. *
* *
* GNAT was originally developed by the GNAT team at New York University. *
* Extensive contributions were provided by Ada Core Technologies Inc. *
* *
****************************************************************************/
/* This file contains target-specific parameters describing the file */
/* extension for object and executable files. It is used by the compiler, */
/* binder and tools. */
#include "system.h"
#include "coretypes.h"
#include "tm.h"
#ifndef TARGET_OBJECT_SUFFIX
#define TARGET_OBJECT_SUFFIX ".o"
#endif
#ifndef TARGET_EXECUTABLE_SUFFIX
#define TARGET_EXECUTABLE_SUFFIX ""
#endif
const char *__gnat_target_object_extension = TARGET_OBJECT_SUFFIX;
const char *__gnat_target_executable_extension = TARGET_EXECUTABLE_SUFFIX;
const char *__gnat_target_debuggable_extension = TARGET_EXECUTABLE_SUFFIX;

18
gcc/ada/targparm.adb
View File

@ -24,11 +24,11 @@
-- --
------------------------------------------------------------------------------
with Csets; use Csets;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
with Csets; use Csets;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
package body Targparm is
use ASCII;
@ -154,7 +154,6 @@ package body Targparm is
procedure Set_Profile_Restrictions (P : Profile_Name) is
R : Restriction_Flags renames Profile_Info (P).Set;
V : Restriction_Values renames Profile_Info (P).Value;
begin
for J in R'Range loop
if R (J) then
@ -603,6 +602,13 @@ package body Targparm is
end if;
end loop Line_Loop;
-- Now that OpenVMS_On_Target has been given its definitive value,
-- change the multi-unit index character from '~' to '$' for OpenVMS.
if OpenVMS_On_Target then
Multi_Unit_Index_Character := '$';
end if;
-- Check no missing target parameter settings (skip for compiler vsn)
if not Compiler_System_Version then

7
gcc/ada/targparm.ads
View File

@ -19,6 +19,13 @@
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --