void
__gnat_setenv (char *name, char *value)
{
#if defined (VMS)
struct dsc$descriptor_s name_desc;
$DESCRIPTOR (table_desc, "LNM$PROCESS");
char *host_pathspec = value;
char *copy_pathspec;
int num_dirs_in_pathspec = 1;
char *ptr;
long status;
name_desc.dsc$w_length = strlen (name);
name_desc.dsc$b_dtype = DSC$K_DTYPE_T;
name_desc.dsc$b_class = DSC$K_CLASS_S;
name_desc.dsc$a_pointer = name; /* ??? Danger, not 64bit safe. */
if (*host_pathspec == 0)
/* deassign */
{
status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
/* no need to check status; if the logical name is not
defined, that's fine. */
return;
}
ptr = host_pathspec;
while (*ptr++)
if (*ptr == ',')
num_dirs_in_pathspec++;
{
int i, status;
/* Alloca is guaranteed to be 32bit. */
ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
char *curr, *next;
strcpy (copy_pathspec, host_pathspec);
curr = copy_pathspec;
for (i = 0; i < num_dirs_in_pathspec; i++)
{
next = strchr (curr, ',');
if (next == 0)
next = strchr (curr, 0);
*next = 0;
ile_array[i].len = strlen (curr);
/* Code 2 from lnmdef.h means it's a string. */
ile_array[i].code = 2;
ile_array[i].adr = curr;
/* retlen_adr is ignored. */
ile_array[i].retlen_adr = 0;
curr = next + 1;
}
/* Terminating item must be zero. */
ile_array[i].len = 0;
ile_array[i].code = 0;
ile_array[i].adr = 0;
ile_array[i].retlen_adr = 0;
status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
if ((status & 1) != 1)
LIB$SIGNAL (status);
}
#elif (defined (__vxworks) && defined (__RTP__)) || defined (__APPLE__)
setenv (name, value, 1);
#else
size_t size = strlen (name) + strlen (value) + 2;
char *expression;
expression = (char *) xmalloc (size * sizeof (char));
sprintf (expression, "%s=%s", name, value);
putenv (expression);
#if (defined (__FreeBSD__) && (__FreeBSD__ < 7)) \
|| defined (__MINGW32__) \
||(defined (__vxworks) && ! defined (__RTP__))
/* On some systems like FreeBSD 6.x and earlier, MacOS X and Windows,
putenv is making a copy of the expression string so we can free
it after the call to putenv */
free (expression);
#endif
#endif
}
void
__gnat_setenv (char *name, char *value)
{
#ifdef MSDOS
#elif defined (VMS)
struct descriptor_s name_desc;
/* Put in JOB table for now, so that the project stuff at least works. */
struct descriptor_s table_desc = {7, 0, "LNM$JOB"};
char *host_pathspec = value;
char *copy_pathspec;
int num_dirs_in_pathspec = 1;
char *ptr;
long status;
name_desc.len = strlen (name);
name_desc.mbz = 0;
name_desc.adr = name;
if (*host_pathspec == 0)
/* deassign */
{
status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
/* no need to check status; if the logical name is not
defined, that's fine. */
return;
}
ptr = host_pathspec;
while (*ptr++)
if (*ptr == ',')
num_dirs_in_pathspec++;
{
int i, status;
ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
char *curr, *next;
strcpy (copy_pathspec, host_pathspec);
curr = copy_pathspec;
for (i = 0; i < num_dirs_in_pathspec; i++)
{
next = strchr (curr, ',');
if (next == 0)
next = strchr (curr, 0);
*next = 0;
ile_array[i].len = strlen (curr);
/* Code 2 from lnmdef.h means it's a string. */
ile_array[i].code = 2;
ile_array[i].adr = curr;
/* retlen_adr is ignored. */
ile_array[i].retlen_adr = 0;
curr = next + 1;
}
/* Terminating item must be zero. */
ile_array[i].len = 0;
ile_array[i].code = 0;
ile_array[i].adr = 0;
ile_array[i].retlen_adr = 0;
status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
if ((status & 1) != 1)
LIB$SIGNAL (status);
}
#elif defined (__vxworks) && defined (__RTP__)
setenv (name, value, 1);
#else
size_t size = strlen (name) + strlen (value) + 2;
char *expression;
expression = (char *) xmalloc (size * sizeof (char));
sprintf (expression, "%s=%s", name, value);
putenv (expression);
#if defined (__FreeBSD__) || defined (__APPLE__) || defined (__MINGW32__) \
||(defined (__vxworks) && ! defined (__RTP__))
/* On some systems like FreeBSD, MacOS X and Windows, putenv is making
a copy of the expression string so we can free it after the call to
putenv */
free (expression);
#endif
#endif
}
