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 \
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
ada/initialize.o \
ada/seh_init.o \
ada/link.o \
+ ada/targext.o \
ada/raise.o \
ada/tracebak.o \
ada/a-except.o \
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); \
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)
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 \
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,
# 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\
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 \
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
$(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
# 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) \
# 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)
$(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
-- --
------------------------------------------------------------------------------
-with Hostparm; use Hostparm;
with Namet; use Namet;
with Output; use Output;
+with Targparm; use Targparm;
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;
with ALI; use ALI;
with Csets;
with Gnatvsn;
-with Hostparm;
with Makeutl;
with MLib.Tgt; use MLib.Tgt;
with Namet; use Namet;
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;
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
-- 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
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;
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;
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 --
---------------------------
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 --
-----------------------
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 --
------------
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
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
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
-- 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);
-- 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.
-- Gnatlink usage: please consult the gnat documentation
with ALI; use ALI;
+with Csets;
with Gnatvsn; use Gnatvsn;
with Hostparm;
with Indepsw; use Indepsw;
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;
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;
elsif Arg'Length >= 3 and then Arg (2) = 'M' then
declare
Switches : String_List_Access;
+
begin
Convert (Map_File, Arg (3 .. Arg'Last), Switches);
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;
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
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
-- 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
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;
A : ALI_Id;
begin
- -- Osint.Add_Default_Search_Dirs;
-- Load the ALI file
T := Read_Library_Info (F, True);
-- 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) :=
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
"__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;
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);
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
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;
with Snames; use Snames;
with Switch; use Switch;
with Table;
+with Targparm; use Targparm;
with Ada.Characters.Handling;
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"
begin
if not Libgnarl_Needed or
- (Hostparm.OpenVMS and then
+ (OpenVMS_On_Target and then
((not Libdecgnat_Needed) or
(not Gtrasymobj_Needed)))
then
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;
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
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.
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
-- 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.
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);
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
-- 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
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;
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;
Additional_Objects :=
new Argument_List'
- (1 => new String'(Lib_Filename & "$init.obj"));
+ (1 => new String'(Lib_Filename & "__init.obj"));
end;
end if;
if Auto_Init then
declare
Auto_Init_Object_File_Name : constant String :=
- Lib_Filename & "$init.obj";
+ Lib_Filename & "__init.obj";
Disregard : Boolean;
begin
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;
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;
Additional_Objects :=
new Argument_List'
- (1 => new String'(Lib_Filename & "$init.obj"));
+ (1 => new String'(Lib_Filename & "__init.obj"));
end;
end if;
if Auto_Init then
declare
Auto_Init_Object_File_Name : constant String :=
- Lib_Filename & "$init.obj";
+ Lib_Filename & "__init.obj";
Disregard : Boolean;
begin
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
-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
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;
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
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;
---------------------------------
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;
with Output; use Output;
with Sdefault; use Sdefault;
with Table;
+with Targparm; use Targparm;
with System.Case_Util; use System.Case_Util;
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;
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) := '_';
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 ???
-- 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
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;
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
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'
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) := '.';
-- --
-- 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- --
-- 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. --
-- --
--- /dev/null
+/****************************************************************************
+ * *
+ * 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;
-- --
------------------------------------------------------------------------------
-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;
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
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
-- 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. --
-- --
projects / gcc.git / commitdiff