OSDN Git Service

2005-05-04 Thomas Koenig <Thomas.Koenig@online.de>
[pf3gnuchains/gcc-fork.git] / libgfortran / generated / minloc0_4_i4.c
index 5407f4c..8f2dd23 100644 (file)
@@ -2,20 +2,29 @@
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+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 Lesser General Public
+modify it under the terms of the GNU General Public
 License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
+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 Lesser General Public License for more details.
+GNU General Public License for more details.
 
-You should have received a copy of the GNU Lesser General Public
-License along with libgfor; see the file COPYING.LIB.  If not,
+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., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 
@@ -28,8 +37,11 @@ Boston, MA 02111-1307, USA.  */
 
 
 
+extern void minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array);
+export_proto(minloc0_4_i4);
+
 void
-__minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array)
+minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array)
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -41,13 +53,34 @@ __minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -118,8 +151,13 @@ __minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array)
   }
 }
 
+
+extern void mminloc0_4_i4 (gfc_array_i4 *, gfc_array_i4 *, gfc_array_l4 *);
+export_proto(mminloc0_4_i4);
+
 void
-__mminloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, gfc_array_l4 * mask)
+mminloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array,
+                                 gfc_array_l4 * mask)
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -133,17 +171,37 @@ __mminloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, gfc_array_l4 * ma
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;