Update

[l4.git] / l4 / pkg / libgfortran / lib / contrib / intrinsics / unpack_generic.c

diff --git a/l4/pkg/libgfortran/lib/contrib/intrinsics/unpack_generic.c b/l4/pkg/libgfortran/lib/contrib/intrinsics/unpack_generic.c
index db624996def168f919fbd18ca65326a6456fd17b..ee6bc26872b3d9b187a575e63e152d8f6fd8b2d3 100644 (file)
--- a/l4/pkg/libgfortran/lib/contrib/intrinsics/unpack_generic.c
+++ b/l4/pkg/libgfortran/lib/contrib/intrinsics/unpack_generic.c
@@ -1,9 +1,8 @@
 /* Generic implementation of the UNPACK intrinsic
-   Copyright 2002, 2003, 2004, 2005, 2007, 2009, 2010
-   Free Software Foundation, Inc.
+   Copyright (C) 2002-2015 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -49,7 +48,7 @@ unpack_bounds (gfc_array_char *ret, const gfc_array_char *vector,
     bounds_equal_extents ((array_t *) field, (array_t *) mask,
                          "FIELD", "UNPACK");
 
-  if (ret->data != NULL)
+  if (ret->base_addr != NULL)
     bounds_equal_extents ((array_t *) ret, (array_t *) mask,
                          "return value", "UNPACK");
 
@@ -87,7 +86,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
 
   empty = 0;
 
-  mptr = mask->data;
+  mptr = mask->base_addr;
 
   /* Use the same loop for all logical types, by using GFC_LOGICAL_1
      and using shifting to address size and endian issues.  */
@@ -107,7 +106,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
   else
     runtime_error ("Funny sized logical array");
 
-  if (ret->data == NULL)
+  if (ret->base_addr == NULL)
     {
       /* The front end has signalled that we need to populate the
         return array descriptor.  */
@@ -126,7 +125,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
          rs *= extent[n];
        }
       ret->offset = 0;
-      ret->data = internal_malloc_size (rs * size);
+      ret->base_addr = xmallocarray (rs, size);
     }
   else
     {
@@ -145,13 +144,16 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
   if (empty)
     return;
 
+  /* This assert makes sure GCC knows we can access *stride[0] later.  */
+  assert (dim > 0);
+
   vstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
   rstride0 = rstride[0];
   fstride0 = fstride[0];
   mstride0 = mstride[0];
-  rptr = ret->data;
-  fptr = field->data;
-  vptr = vector->data;
+  rptr = ret->base_addr;
+  fptr = field->base_addr;
+  vptr = vector->base_addr;
 
   while (rptr)
     {
@@ -317,8 +319,8 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 #endif
 
     case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(vector->data)
-         || GFC_UNALIGNED_2(field->data))
+      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)
+         || GFC_UNALIGNED_2(field->base_addr))
        break;
       else
        {
@@ -328,8 +330,8 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
        }
 
     case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(vector->data)
-         || GFC_UNALIGNED_4(field->data))
+      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)
+         || GFC_UNALIGNED_4(field->base_addr))
        break;
       else
        {
@@ -339,8 +341,8 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
        }
 
     case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(vector->data)
-         || GFC_UNALIGNED_8(field->data))
+      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)
+         || GFC_UNALIGNED_8(field->base_addr))
        break;
       else
        {
@@ -351,8 +353,9 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 
 #ifdef HAVE_GFC_INTEGER_16
     case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(vector->data)
-         || GFC_UNALIGNED_16(field->data))
+      if (GFC_UNALIGNED_16(ret->base_addr)
+         || GFC_UNALIGNED_16(vector->base_addr)
+         || GFC_UNALIGNED_16(field->base_addr))
        break;
       else
        {
@@ -527,7 +530,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 #endif
 
     case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(vector->data)
+      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)
          || GFC_UNALIGNED_2(field))
        break;
       else
@@ -538,7 +541,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
        }
 
     case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(vector->data)
+      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)
          || GFC_UNALIGNED_4(field))
        break;
       else
@@ -549,7 +552,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
        }
 
     case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(vector->data)
+      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)
          || GFC_UNALIGNED_8(field))
        break;
       else
@@ -561,7 +564,8 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 
 #ifdef HAVE_GFC_INTEGER_16
     case GFC_DTYPE_DERIVED_16:
-      if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(vector->data)
+      if (GFC_UNALIGNED_16(ret->base_addr)
+         || GFC_UNALIGNED_16(vector->base_addr)
          || GFC_UNALIGNED_16(field))
        break;
       else
@@ -576,7 +580,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 
   memset (&tmp, 0, sizeof (tmp));
   tmp.dtype = 0;
-  tmp.data = field;
+  tmp.base_addr = field;
   unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector));
 }
 
@@ -600,7 +604,7 @@ unpack0_char (gfc_array_char *ret,
 
   memset (&tmp, 0, sizeof (tmp));
   tmp.dtype = 0;
-  tmp.data = field;
+  tmp.base_addr = field;
   unpack_internal (ret, vector, mask, &tmp, vector_length);
 }
 
@@ -624,7 +628,7 @@ unpack0_char4 (gfc_array_char *ret,
 
   memset (&tmp, 0, sizeof (tmp));
   tmp.dtype = 0;
-  tmp.data = field;
+  tmp.base_addr = field;
   unpack_internal (ret, vector, mask, &tmp,
                   vector_length * sizeof (gfc_char4_t));
 }