Skip to content

R
riscv-gcc-1
Commit cc892b2c by Doug Rupp Committed by Arnaud Charlet
Options

adaint.c, [...] (to_ptr32): New function. 

2005-02-09  Doug Rupp  <rupp@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>

	* adaint.c, adaint.h
	[VMS] (to_ptr32): New function.
	(MAYBE_TO_PTR32): New macro.
	(__gnat_portable_spawn,__gnat_portable_no_block_spawn): Adjust argv
	for pointer size.
	[VMS] (descriptor_s, ile_s): Use __char_ptr32 for adr field.
	[VMS] (#define fork()): Remove since unneccessary.
	(__gnat_set_close_on_exec): New routine to support
	GNAT.OS_Lib.Set_Close_On_Exec.

	* g-expect.adb (Set_Up_Communications): Mark the pipe descriptors for
	the parent side as close-on-exec so that they are not inherited by the
	child.

	* g-os_lib.ads, g-os_lib.adb (Set_Close_On_Exec): New subprogram to
	set or clear the FD_CLOEXEC flag on a file descriptor.

From-SVN: r94811
parent 4e45e7a9
Showing with 102 additions and 23 deletions
gcc/ada/adaint.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2004, 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- *
......@@ -277,6 +277,37 @@ int max_path_len = GNAT_MAX_PATH_LEN;
system provides the routine readdir_r. */
#undef HAVE_READDIR_R
#if defined(VMS) && defined (__LONG_POINTERS)
/* Return a 32 bit pointer to an array of 32 bit pointers
given a 64 bit pointer to an array of 64 bit pointers */
typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
static __char_ptr_char_ptr32
to_ptr32 (char **ptr64)
{
int argc;
__char_ptr_char_ptr32 short_argv;
for (argc=0; ptr64[argc]; argc++);
/* Reallocate argv with 32 bit pointers. */
short_argv = (__char_ptr_char_ptr32) decc$malloc
(sizeof (__char_ptr32) * (argc + 1));
for (argc=0; ptr64[argc]; argc++)
short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
short_argv[argc] = (__char_ptr32) 0;
return short_argv;
}
#define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
#else
#define MAYBE_TO_PTR32(argv) argv
#endif
void
__gnat_to_gm_time
(OS_Time *p_time,
......@@ -1213,13 +1244,13 @@ static char *to_host_path_spec (char *);
struct descriptor_s
{
unsigned short len, mbz;
char *adr;
__char_ptr32 adr;
};
typedef struct _ile3
{
unsigned short len, code;
char *adr;
__char_ptr32 adr;
unsigned short *retlen_adr;
} ile_s;
......@@ -1524,17 +1555,6 @@ __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
#endif
}
#ifdef VMS
/* Defined in VMS header files. */
#if defined (__ALPHA)
#define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
#elif defined (__IA64)
#define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
LIB$I64_GET_CURR_INVO_CONTEXT(decc$$get_vfork_jmpbuf()) : -1)
#endif
#endif
#if defined (sun) && defined (__SVR4)
/* Using fork on Solaris will duplicate all the threads. fork1, which
duplicates only the active thread, must be used instead, or spawning
......@@ -1585,7 +1605,7 @@ __gnat_portable_spawn (char *args[])
if (pid == 0)
{
/* The child. */
if (execv (args[0], args) != 0)
if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
#if defined (VMS)
return -1; /* execv is in parent context on VMS. */
#else
......@@ -1866,7 +1886,7 @@ __gnat_portable_no_block_spawn (char *args[])
if (pid == 0)
{
/* The child. */
if (execv (args[0], args) != 0)
if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
#if defined (VMS)
return -1; /* execv is in parent context on VMS. */
#else
......@@ -2593,3 +2613,24 @@ get_gcc_version (void)
{
return 3;
}
int
__gnat_set_close_on_exec (int fd, int close_on_exec_p)
{
#if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
int flags = fcntl (fd, F_GETFD, 0);
if (flags < 0)
return flags;
if (close_on_exec_p)
flags |= FD_CLOEXEC;
else
flags &= ~FD_CLOEXEC;
return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
#else
return -1;
/* For the Windows case, we should use SetHandleInformation to remove
the HANDLE_INHERIT property from fd. This is not implemented yet,
but for our purposes (support of GNAT.Expect) this does not matter,
as by default handles are *not* inherited. */
#endif
}
gcc/ada/adaint.h
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2004 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- *
......@@ -149,6 +149,7 @@ extern void __gnat_set_binary_mode (int);
extern void __gnat_set_text_mode (int);
extern char *__gnat_ttyname (int);
extern int __gnat_lseek (int, long, int);
extern int __gnat_set_close_on_exec (int, int);
extern int __gnat_dup (int);
extern int __gnat_dup2 (int, int);
......
gcc/ada/g-expect.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2005 Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1123,6 +1123,8 @@ package body GNAT.Expect is
Pipe2 : access Pipe_Type;
Pipe3 : access Pipe_Type)
is
Status : Boolean;
begin
-- Create the pipes
......@@ -1134,18 +1136,36 @@ package body GNAT.Expect is
return;
end if;
-- Record the 'parent' end of the two pipes in Pid:
-- Child stdin is connected to the 'write' end of Pipe1;
-- Child stdout is connected to the 'read' end of Pipe2.
-- We do not want these descriptors to remain open in the child
-- process, so we mark them close-on-exec/non-inheritable.
Pid.Input_Fd := Pipe1.Output;
Set_Close_On_Exec (Pipe1.Output, True, Status);
Pid.Output_Fd := Pipe2.Input;
Set_Close_On_Exec (Pipe2.Input, True, Status);
if Err_To_Out then
-- Reuse the standard output pipe for standard error
Pipe3.all := Pipe2.all;
else
-- Create a separate pipe for standard error
if Create_Pipe (Pipe3) /= 0 then
return;
end if;
end if;
-- As above, we record the proper fd for the child's
-- standard error stream.
Pid.Error_Fd := Pipe3.Input;
Set_Close_On_Exec (Pipe3.Input, True, Status);
end Set_Up_Communications;
----------------------------------
......
gcc/ada/g-os_lib.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 1995-2005 Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1075,7 +1075,7 @@ package body GNAT.OS_Lib is
S : Integer;
begin
-- Use the global lock because To_GM_Time is not thread safe.
-- Use the global lock because To_GM_Time is not thread safe
Locked_Processing : begin
SSL.Lock_Task.all;
......@@ -1920,7 +1920,7 @@ package body GNAT.OS_Lib is
if Status <= 0 then
Last := Finish + 1;
-- Replace symbolic link with its value.
-- Replace symbolic link with its value
else
if Is_Absolute_Path (Link_Buffer (1 .. Status)) then
......@@ -2056,6 +2056,23 @@ package body GNAT.OS_Lib is
Rename_File (C_Old_Name'Address, C_New_Name'Address, Success);
end Rename_File;
-----------------------
-- Set_Close_On_Exec --
-----------------------
procedure Set_Close_On_Exec
(FD : File_Descriptor;
Close_On_Exec : Boolean;
Status : out Boolean)
is
function C_Set_Close_On_Exec
(FD : File_Descriptor; Close_On_Exec : System.CRTL.int)
return System.CRTL.int;
pragma Import (C, C_Set_Close_On_Exec, "__gnat_set_close_on_exec");
begin
Status := C_Set_Close_On_Exec (FD, Boolean'Pos (Close_On_Exec)) = 0;
end Set_Close_On_Exec;
--------------------
-- Set_Executable --
--------------------
......@@ -2186,7 +2203,7 @@ package body GNAT.OS_Lib is
Dup2 (Saved_Error, Standerr);
end if;
-- And close the saved standard output and error file descriptors.
-- And close the saved standard output and error file descriptors
Close (Saved_Output);
......@@ -2234,7 +2251,7 @@ package body GNAT.OS_Lib is
is
procedure Spawn (Args : Argument_List);
-- Call Spawn.
-- Call Spawn with given argument list
N_Args : Argument_List (Args'Range);
-- Normalized arguments
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment