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 }