OSDN Git Service

2004-09-09 Victor Leikehman <lei@il.ibm.com>
[pf3gnuchains/gcc-fork.git] / libgfortran / intrinsics / eoshift0.c
index f86f4bd..fca1ef0 100644 (file)
@@ -1,4 +1,4 @@
-/* Generic implementation of the RESHAPE intrinsic
+/* Generic implementation of the EOSHIFT intrinsic
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
@@ -32,7 +32,7 @@ static const char zeros[16] =
    sizeof(int) < sizeof (index_type).  */
 
 static void
-__eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
     int shift, const char * pbound, int which)
 {
   /* r.* indicates the return array.  */
@@ -60,6 +60,25 @@ __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
 
   size = GFC_DESCRIPTOR_SIZE (ret);
 
+  if (ret->data == NULL)
+    {
+      int i;
+
+      ret->data = internal_malloc (size * size0 ((array_t *)array));
+      ret->base = 0;
+      ret->dtype = array->dtype;
+      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+        {
+          ret->dim[i].lbound = 0;
+          ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+          if (i == 0)
+            ret->dim[i].stride = 1;
+          else
+            ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+        }
+    }
+
   which = which - 1;
 
   extent[0] = 1;
@@ -170,7 +189,7 @@ __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
 
 
 void
-__eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0_4 (gfc_array_char * ret, const gfc_array_char * array,
     const GFC_INTEGER_4 * pshift, const char * pbound,
     const GFC_INTEGER_4 * pdim)
 {
@@ -179,7 +198,7 @@ __eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
 
 
 void
-__eoshift0_8 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0_8 (gfc_array_char * ret, const gfc_array_char * array,
     const GFC_INTEGER_8 * pshift, const char * pbound,
     const GFC_INTEGER_8 * pdim)
 {