Check in gcc sources for prebuilt toolchains in Eclair.

1 files changed, 278 insertions, 0 deletions

diff --git a/gcc-4.2.1/libgfortran/intrinsics/args.c b/gcc-4.2.1/libgfortran/intrinsics/args.c
new file mode 100644
index 000000000..b9273b30a
--- /dev/null
+++ b/gcc-4.2.1/libgfortran/intrinsics/args.c
@@ -0,0 +1,278 @@
+/* Implementation of the GETARG and IARGC g77, and
+   corresponding F2003, intrinsics. 
+   Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+   Contributed by Bud Davis and 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 <string.h>
+#include "libgfortran.h"
+
+
+/* Get a commandline argument.  */
+
+extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type);
+iexport_proto(getarg_i4);
+
+void 
+getarg_i4 (GFC_INTEGER_4 *pos, char  *val, gfc_charlen_type val_len)
+{
+  int argc;
+  int arglen;
+  char **argv;
+
+  get_args (&argc, &argv);
+
+  if (val_len < 1 || !val )
+    return;   /* something is wrong , leave immediately */
+  
+  memset (val, ' ', val_len);
+
+  if ((*pos) + 1 <= argc  && *pos >=0 )
+    {
+      arglen = strlen (argv[*pos]);
+      if (arglen > val_len)
+	arglen = val_len;
+      memcpy (val, argv[*pos], arglen);
+    }
+}
+iexport(getarg_i4);
+
+
+/* INTEGER*8 wrapper of getarg.  */
+
+extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type);
+export_proto (getarg_i8);
+
+void 
+getarg_i8 (GFC_INTEGER_8 *pos, char  *val, gfc_charlen_type val_len)
+{
+  GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos;
+  getarg_i4 (&pos4, val, val_len);
+}
+
+
+/* Return the number of commandline arguments.  The g77 info page 
+   states that iargc does not include the specification of the
+   program name itself.  */
+
+extern GFC_INTEGER_4 iargc (void);
+export_proto(iargc);
+
+GFC_INTEGER_4
+iargc (void)
+{
+  int argc;
+  char **argv;
+
+  get_args (&argc, &argv);
+
+  return (argc - 1);
+} 
+
+
+/* F2003 intrinsic functions and subroutines related to command line
+   arguments.
+
+   - function command_argument_count() is converted to iargc by the compiler.
+
+   - subroutine get_command([command, length, status]).
+
+   - subroutine get_command_argument(number, [value, length, status]).
+*/
+
+/* These two status codes are specified in the standard. */
+#define GFC_GC_SUCCESS 0
+#define GFC_GC_VALUE_TOO_SHORT -1
+
+/* Processor-specific status failure code. */
+#define GFC_GC_FAILURE 42
+
+
+extern void get_command_argument_i4 (GFC_INTEGER_4 *, char *, GFC_INTEGER_4 *,
+				     GFC_INTEGER_4 *, gfc_charlen_type);
+iexport_proto(get_command_argument_i4);
+
+/* Get a single commandline argument.  */
+
+void
+get_command_argument_i4 (GFC_INTEGER_4 *number, char *value, 
+			 GFC_INTEGER_4 *length, GFC_INTEGER_4 *status, 
+			 gfc_charlen_type value_len)
+{
+  int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS;
+  char **argv;
+
+  if (number == NULL )
+    /* Should never happen.  */
+    runtime_error ("Missing argument to get_command_argument");
+
+  if (value == NULL && length == NULL && status == NULL)
+    return; /* No need to do anything.  */
+
+  get_args (&argc, &argv);
+
+  if (*number < 0 || *number >= argc)
+    stat_flag = GFC_GC_FAILURE;
+  else
+    arglen = strlen(argv[*number]);    
+
+  if (value != NULL)
+    {
+      if (value_len < 1)
+	stat_flag = GFC_GC_FAILURE;
+      else
+	memset (value, ' ', value_len);
+    }
+
+  if (value != NULL && stat_flag != GFC_GC_FAILURE)
+    {
+      if (arglen > value_len)
+       {
+	 arglen = value_len;
+	 stat_flag = GFC_GC_VALUE_TOO_SHORT;
+       }
+      memcpy (value, argv[*number], arglen);
+    }
+
+  if (length != NULL)
+    *length = arglen;
+
+  if (status != NULL)
+    *status = stat_flag;
+}
+iexport(get_command_argument_i4);
+
+
+/* INTEGER*8 wrapper for get_command_argument.  */
+
+extern void get_command_argument_i8 (GFC_INTEGER_8 *, char *, GFC_INTEGER_8 *, 
+				     GFC_INTEGER_8 *, gfc_charlen_type);
+export_proto(get_command_argument_i8);
+
+void
+get_command_argument_i8 (GFC_INTEGER_8 *number, char *value, 
+			 GFC_INTEGER_8 *length, GFC_INTEGER_8 *status, 
+			 gfc_charlen_type value_len)
+{
+  GFC_INTEGER_4 number4;
+  GFC_INTEGER_4 length4;
+  GFC_INTEGER_4 status4;
+
+  number4 = (GFC_INTEGER_4) *number;
+  get_command_argument_i4 (&number4, value, &length4, &status4, value_len);
+  if (length)
+    *length = length4;
+  if (status)
+    *status = status4;
+}
+
+
+/* Return the whole commandline.  */
+
+extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *,
+			    gfc_charlen_type);
+iexport_proto(get_command_i4);
+
+void
+get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
+		gfc_charlen_type command_len)
+{
+  int i, argc, arglen, thisarg;
+  int stat_flag = GFC_GC_SUCCESS;
+  int tot_len = 0;
+  char **argv;
+
+  if (command == NULL && length == NULL && status == NULL)
+    return; /* No need to do anything.  */
+
+  get_args (&argc, &argv);
+
+  if (command != NULL)
+    {
+      /* Initialize the string to blanks.  */
+      if (command_len < 1)
+	stat_flag = GFC_GC_FAILURE;
+      else
+	memset (command, ' ', command_len);
+    }
+
+  for (i = 0; i < argc ; i++)
+    {
+      arglen = strlen(argv[i]);
+
+      if (command != NULL && stat_flag == GFC_GC_SUCCESS)
+	{
+	  thisarg = arglen;
+	  if (tot_len + thisarg > command_len)
+	    {
+	      thisarg = command_len - tot_len; /* Truncate.  */
+	      stat_flag = GFC_GC_VALUE_TOO_SHORT;
+	    }
+	  /* Also a space before the next arg.  */
+	  else if (i != argc - 1 && tot_len + arglen == command_len)
+	    stat_flag = GFC_GC_VALUE_TOO_SHORT;
+
+	  memcpy (&command[tot_len], argv[i], thisarg);
+	}
+
+      /* Add the legth of the argument.  */
+      tot_len += arglen;
+      if (i != argc - 1)
+	tot_len++;
+    }
+
+  if (length != NULL)
+    *length = tot_len;
+
+  if (status != NULL)
+    *status = stat_flag;
+}
+iexport(get_command_i4);
+
+
+/* INTEGER*8 wrapper for get_command.  */
+
+extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *,
+			    gfc_charlen_type);
+export_proto(get_command_i8);
+
+void
+get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
+		gfc_charlen_type command_len)
+{
+  GFC_INTEGER_4 length4;
+  GFC_INTEGER_4 status4;
+
+  get_command_i4 (command, &length4, &status4, command_len);
+  if (length)
+    *length = length4;
+  if (status)
+    *status = status4;
+}