Check in gcc sources for prebuilt toolchains in Eclair.

1 files changed, 202 insertions, 0 deletions

diff --git a/gcc-4.2.1/libgfortran/intrinsics/env.c b/gcc-4.2.1/libgfortran/intrinsics/env.c
new file mode 100644
index 000000000..d9084b746
--- /dev/null
+++ b/gcc-4.2.1/libgfortran/intrinsics/env.c
@@ -0,0 +1,202 @@
+/* Implementation of the GETENV g77, and
+   GET_ENVIRONMENT_VARIABLE F2003, intrinsics. 
+   Copyright (C) 2004 Free Software Foundation, Inc.
+   Contributed by Janne Blomqvist.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT 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 along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <sys/types.h>
+#include <stdlib.h>
+#include <string.h>
+#include "libgfortran.h"
+
+
+/* GETENV (NAME, VALUE), g77 intrinsic for retrieving the value of
+   an environment variable. The name of the variable is specified in
+   NAME, and the result is stored into VALUE.  */
+
+void PREFIX(getenv) (char *, char *, gfc_charlen_type, gfc_charlen_type);
+export_proto_np(PREFIX(getenv));
+
+void 
+PREFIX(getenv) (char * name, char * value, gfc_charlen_type name_len, 
+		gfc_charlen_type value_len)
+{
+  char *name_nt;
+  char *res = NULL;
+  int res_len;
+
+  if (name == NULL || value == NULL)
+    runtime_error ("Both arguments to getenv are mandatory.");
+
+  if (value_len < 1 || name_len < 1)
+    runtime_error ("Zero length string(s) passed to getenv.");
+  else
+    memset (value, ' ', value_len); /* Blank the string.  */
+
+  /* Trim trailing spaces from name.  */
+  while (name_len > 0 && name[name_len - 1] == ' ')
+    name_len--;
+
+  /* Make a null terminated copy of the string.  */
+  name_nt = gfc_alloca (name_len + 1);
+  memcpy (name_nt, name, name_len);
+  name_nt[name_len] = '\0'; 
+
+  res = getenv(name_nt);
+
+  /* If res is NULL, it means that the environment variable didn't 
+     exist, so just return.  */
+  if (res == NULL)
+    return;
+
+  res_len = strlen(res);
+  if (value_len < res_len)
+    memcpy (value, res, value_len);
+  else
+    memcpy (value, res, res_len);
+}
+
+
+/* GET_ENVIRONMENT_VARIABLE (name, [value, length, status, trim_name])
+   is a F2003 intrinsic for getting an environment variable.  */
+
+/* Status codes specifyed by the standard. */
+#define GFC_SUCCESS 0
+#define GFC_VALUE_TOO_SHORT -1
+#define GFC_NAME_DOES_NOT_EXIST 1
+
+/* This is also specified by the standard and means that the
+   processor doesn't support environment variables.  At the moment,
+   gfortran doesn't use it.  */
+#define GFC_NOT_SUPPORTED 2
+
+/* Processor-specific failure code.  */
+#define GFC_FAILURE 42
+
+extern void get_environment_variable_i4 (char *, char *, GFC_INTEGER_4 *,
+					 GFC_INTEGER_4 *, GFC_LOGICAL_4 *,
+					 gfc_charlen_type, gfc_charlen_type);
+iexport_proto(get_environment_variable_i4);
+
+void
+get_environment_variable_i4 (char *name, char *value, GFC_INTEGER_4 *length,
+			     GFC_INTEGER_4 *status, GFC_LOGICAL_4 *trim_name,
+			     gfc_charlen_type name_len,
+			     gfc_charlen_type value_len)
+{
+  int stat = GFC_SUCCESS, res_len = 0;
+  char *name_nt;
+  char *res;
+
+  if (name == NULL)
+    runtime_error ("Name is required for get_environment_variable.");
+
+  if (value == NULL && length == NULL && status == NULL && trim_name == NULL)
+    return;
+
+  if (name_len < 1)
+    runtime_error ("Zero-length string passed as name to "
+		   "get_environment_variable.");
+
+  if (value != NULL)
+    { 
+      if (value_len < 1)
+	runtime_error ("Zero-length string passed as value to "
+		       "get_environment_variable.");
+      else
+	memset (value, ' ', value_len); /* Blank the string.  */
+    }
+
+  if ((!trim_name) || *trim_name)
+    {
+      /* Trim trailing spaces from name.  */
+      while (name_len > 0 && name[name_len - 1] == ' ')
+	name_len--;
+    }
+  /* Make a null terminated copy of the name.  */
+  name_nt = gfc_alloca (name_len + 1);
+  memcpy (name_nt, name, name_len);
+  name_nt[name_len] = '\0'; 
+  
+  res = getenv(name_nt);
+
+  if (res == NULL)
+    stat = GFC_NAME_DOES_NOT_EXIST;
+  else
+    {
+      res_len = strlen(res);
+      if (value != NULL)
+	{
+	  if (value_len < res_len)
+	    {
+	      memcpy (value, res, value_len);
+	      stat = GFC_VALUE_TOO_SHORT;
+	    }
+	  else
+	    memcpy (value, res, res_len);
+	}
+    }
+
+  if (status != NULL)
+    *status = stat;
+
+  if (length != NULL)
+    *length = res_len;
+}
+iexport(get_environment_variable_i4);
+
+
+/* INTEGER*8 wrapper for get_environment_variable.  */
+
+extern void get_environment_variable_i8 (char *, char *, GFC_INTEGER_8 *,
+					 GFC_INTEGER_8 *, GFC_LOGICAL_8 *,
+					 gfc_charlen_type, gfc_charlen_type);
+export_proto(get_environment_variable_i8);
+
+void
+get_environment_variable_i8 (char *name, char *value, GFC_INTEGER_8 *length,
+			     GFC_INTEGER_8 *status, GFC_LOGICAL_8 *trim_name,
+			     gfc_charlen_type name_len,
+			     gfc_charlen_type value_len)
+{
+  GFC_INTEGER_4 length4, status4;
+  GFC_LOGICAL_4 trim_name4;
+
+  if (trim_name)
+    trim_name4 = *trim_name;
+
+  get_environment_variable_i4 (name, value, &length4, &status4, 
+			       &trim_name4, name_len, value_len);
+
+  if (length)
+    *length = length4;
+
+  if (status)
+    *status = status4;
+}