aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/runtime
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/runtime')
-rw-r--r--libgfortran/runtime/backtrace.c8
-rw-r--r--libgfortran/runtime/in_pack_generic.c113
-rw-r--r--libgfortran/runtime/in_unpack_generic.c140
3 files changed, 148 insertions, 113 deletions
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index 00605b5..4a33888 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -43,12 +43,6 @@ Boston, MA 02110-1301, USA. */
#include <unistd.h>
#endif
-#ifdef HAVE_INTPTR_T
-# define INTPTR_T intptr_t
-#else
-# define INTPTR_T int
-#endif
-
#ifdef HAVE_EXECINFO_H
#include <execinfo.h>
#endif
@@ -158,7 +152,7 @@ show_backtrace (void)
/* Write the list of addresses in hexadecimal format. */
for (i = 0; i < depth; i++)
- addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (INTPTR_T) trace[i], addr_buf[i],
+ addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
sizeof (addr_buf[i]));
/* Don't output an error message if something goes wrong, we'll simply
diff --git a/libgfortran/runtime/in_pack_generic.c b/libgfortran/runtime/in_pack_generic.c
index 067cd28..79cbbd7 100644
--- a/libgfortran/runtime/in_pack_generic.c
+++ b/libgfortran/runtime/in_pack_generic.c
@@ -51,7 +51,7 @@ internal_pack (gfc_array_char * source)
int n;
int packed;
index_type size;
- int type;
+ index_type type_size;
if (source->dim[0].stride == 0)
{
@@ -59,73 +59,88 @@ internal_pack (gfc_array_char * source)
return source->data;
}
- type = GFC_DESCRIPTOR_TYPE (source);
+ type_size = GFC_DTYPE_TYPE_SIZE(source);
size = GFC_DESCRIPTOR_SIZE (source);
- switch (type)
+ switch (type_size)
{
- case GFC_DTYPE_INTEGER:
- case GFC_DTYPE_LOGICAL:
- switch (size)
- {
- case sizeof (GFC_INTEGER_1):
- return internal_pack_1 ((gfc_array_i1 *) source);
-
- case sizeof (GFC_INTEGER_2):
- return internal_pack_2 ((gfc_array_i2 *) source);
-
- case sizeof (GFC_INTEGER_4):
- return internal_pack_4 ((gfc_array_i4 *) source);
-
- case sizeof (GFC_INTEGER_8):
- return internal_pack_8 ((gfc_array_i8 *) source);
+ case GFC_DTYPE_INTEGER_1:
+ case GFC_DTYPE_LOGICAL_1:
+ case GFC_DTYPE_DERIVED_1:
+ return internal_pack_1 ((gfc_array_i1 *) source);
+
+ case GFC_DTYPE_INTEGER_2:
+ case GFC_DTYPE_LOGICAL_2:
+ return internal_pack_2 ((gfc_array_i2 *) source);
+
+ case GFC_DTYPE_INTEGER_4:
+ case GFC_DTYPE_LOGICAL_4:
+ return internal_pack_4 ((gfc_array_i4 *) source);
+
+ case GFC_DTYPE_INTEGER_8:
+ case GFC_DTYPE_LOGICAL_8:
+ return internal_pack_8 ((gfc_array_i8 *) source);
#if defined(HAVE_GFC_INTEGER_16)
- case sizeof (GFC_INTEGER_16):
- return internal_pack_16 ((gfc_array_i16 *) source);
+ case GFC_DTYPE_INTEGER_16:
+ case GFC_DTYPE_LOGICAL_16:
+ return internal_pack_16 ((gfc_array_i16 *) source);
#endif
- }
- break;
-
- case GFC_DTYPE_REAL:
- switch (size)
- {
- case sizeof (GFC_REAL_4):
- return internal_pack_r4 ((gfc_array_r4 *) source);
+ case GFC_DTYPE_REAL_4:
+ return internal_pack_r4 ((gfc_array_r4 *) source);
- case sizeof (GFC_REAL_8):
- return internal_pack_r8 ((gfc_array_r8 *) source);
+ case GFC_DTYPE_REAL_8:
+ return internal_pack_r8 ((gfc_array_r8 *) source);
#if defined (HAVE_GFC_REAL_10)
- case sizeof (GFC_REAL_10):
- return internal_pack_r10 ((gfc_array_r10 *) source);
+ case GFC_DTYPE_REAL_10:
+ return internal_pack_r10 ((gfc_array_r10 *) source);
#endif
#if defined (HAVE_GFC_REAL_16)
- case sizeof (GFC_REAL_16):
- return internal_pack_r16 ((gfc_array_r16 *) source);
+ case GFC_DTYPE_REAL_16:
+ return internal_pack_r16 ((gfc_array_r16 *) source);
#endif
- }
- case GFC_DTYPE_COMPLEX:
- switch (size)
- {
- case sizeof (GFC_COMPLEX_4):
- return internal_pack_c4 ((gfc_array_c4 *) source);
-
- case sizeof (GFC_COMPLEX_8):
- return internal_pack_c8 ((gfc_array_c8 *) source);
+ case GFC_DTYPE_COMPLEX_4:
+ return internal_pack_c4 ((gfc_array_c4 *) source);
+
+ case GFC_DTYPE_COMPLEX_8:
+ return internal_pack_c8 ((gfc_array_c8 *) source);
#if defined (HAVE_GFC_COMPLEX_10)
- case sizeof (GFC_COMPLEX_10):
- return internal_pack_c10 ((gfc_array_c10 *) source);
+ case GFC_DTYPE_COMPLEX_10:
+ return internal_pack_c10 ((gfc_array_c10 *) source);
#endif
#if defined (HAVE_GFC_COMPLEX_16)
- case sizeof (GFC_COMPLEX_16):
- return internal_pack_c16 ((gfc_array_c16 *) source);
+ case GFC_DTYPE_COMPLEX_16:
+ return internal_pack_c16 ((gfc_array_c16 *) source);
#endif
- }
- break;
+ case GFC_DTYPE_DERIVED_2:
+ if (GFC_UNALIGNED_2(source->data))
+ break;
+ else
+ return internal_pack_2 ((gfc_array_i2 *) source);
+
+ case GFC_DTYPE_DERIVED_4:
+ if (GFC_UNALIGNED_4(source->data))
+ break;
+ else
+ return internal_pack_4 ((gfc_array_i4 *) source);
+
+ case GFC_DTYPE_DERIVED_8:
+ if (GFC_UNALIGNED_8(source->data))
+ break;
+ else
+ return internal_pack_8 ((gfc_array_i8 *) source);
+
+#ifdef HAVE_GFC_INTEGER_16
+ case GFC_DTYPE_DERIVED_16:
+ if (GFC_UNALIGNED_16(source->data))
+ break;
+ else
+ return internal_pack_16 ((gfc_array_i16 *) source);
+#endif
default:
break;
diff --git a/libgfortran/runtime/in_unpack_generic.c b/libgfortran/runtime/in_unpack_generic.c
index 8b51fe9..81d1f04 100644
--- a/libgfortran/runtime/in_unpack_generic.c
+++ b/libgfortran/runtime/in_unpack_generic.c
@@ -49,98 +49,124 @@ internal_unpack (gfc_array_char * d, const void * s)
const char *src;
int n;
int size;
- int type;
+ int type_size;
dest = d->data;
/* This check may be redundant, but do it anyway. */
if (s == dest || !s)
return;
- type = GFC_DESCRIPTOR_TYPE (d);
- size = GFC_DESCRIPTOR_SIZE (d);
- switch (type)
+ type_size = GFC_DTYPE_TYPE_SIZE (d);
+ switch (type_size)
{
- case GFC_DTYPE_INTEGER:
- case GFC_DTYPE_LOGICAL:
- switch (size)
- {
- case sizeof (GFC_INTEGER_1):
- internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s);
- return;
+ case GFC_DTYPE_INTEGER_1:
+ case GFC_DTYPE_LOGICAL_1:
+ case GFC_DTYPE_DERIVED_1:
+ internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s);
+ return;
- case sizeof (GFC_INTEGER_2):
- internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);
- return;
+ case GFC_DTYPE_INTEGER_2:
+ case GFC_DTYPE_LOGICAL_2:
+ internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);
+ return;
- case sizeof (GFC_INTEGER_4):
- internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s);
- return;
+ case GFC_DTYPE_INTEGER_4:
+ case GFC_DTYPE_LOGICAL_4:
+ internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s);
+ return;
- case sizeof (GFC_INTEGER_8):
- internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s);
- return;
+ case GFC_DTYPE_INTEGER_8:
+ case GFC_DTYPE_LOGICAL_8:
+ internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s);
+ return;
#if defined (HAVE_GFC_INTEGER_16)
- case sizeof (GFC_INTEGER_16):
- internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s);
- return;
+ case GFC_DTYPE_INTEGER_16:
+ case GFC_DTYPE_LOGICAL_16:
+ internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s);
+ return;
#endif
- }
- break;
-
- case GFC_DTYPE_REAL:
- switch (size)
- {
- case sizeof (GFC_REAL_4):
- internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s);
- return;
+ case GFC_DTYPE_REAL_4:
+ internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s);
+ return;
- case sizeof (GFC_REAL_8):
- internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s);
- return;
+ case GFC_DTYPE_REAL_8:
+ internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s);
+ return;
#if defined(HAVE_GFC_REAL_10)
- case sizeof (GFC_REAL_10):
- internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s);
- return;
+ case GFC_DTYPE_REAL_10:
+ internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s);
+ return;
#endif
#if defined(HAVE_GFC_REAL_16)
- case sizeof (GFC_REAL_16):
- internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s);
- return;
+ case GFC_DTYPE_REAL_16:
+ internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s);
+ return;
#endif
+ case GFC_DTYPE_COMPLEX_4:
+ internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s);
+ return;
- }
+ case GFC_DTYPE_COMPLEX_8:
+ internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s);
+ return;
+
+#if defined(HAVE_GFC_COMPLEX_10)
+ case GFC_DTYPE_COMPLEX_10:
+ internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s);
+ return;
+#endif
- case GFC_DTYPE_COMPLEX:
- switch (size)
+#if defined(HAVE_GFC_COMPLEX_16)
+ case GFC_DTYPE_COMPLEX_16:
+ internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s);
+ return;
+#endif
+ case GFC_DTYPE_DERIVED_2:
+ if (GFC_UNALIGNED_2(d->data) || GFC_UNALIGNED_2(s))
+ break;
+ else
{
- case sizeof (GFC_COMPLEX_4):
- internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s);
+ internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);
return;
-
- case sizeof (GFC_COMPLEX_8):
- internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s);
+ }
+ case GFC_DTYPE_DERIVED_4:
+ if (GFC_UNALIGNED_4(d->data) || GFC_UNALIGNED_4(s))
+ break;
+ else
+ {
+ internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s);
return;
+ }
-#if defined(HAVE_GFC_COMPLEX_10)
- case sizeof (GFC_COMPLEX_10):
- internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s);
+ case GFC_DTYPE_DERIVED_8:
+ if (GFC_UNALIGNED_8(d->data) || GFC_UNALIGNED_8(s))
+ break;
+ else
+ {
+ internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s);
return;
-#endif
+ }
-#if defined(HAVE_GFC_COMPLEX_16)
- case sizeof (GFC_COMPLEX_16):
- internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s);
+#ifdef HAVE_GFC_INTEGER_16
+ case GFC_DTYPE_DERIVED_16:
+ if (GFC_UNALIGNED_16(d->data) || GFC_UNALIGNED_16(s))
+ break;
+ else
+ {
+ internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s);
return;
+ }
#endif
- }
default:
break;
}
+ size = GFC_DESCRIPTOR_SIZE (d);
+
if (d->dim[0].stride == 0)
d->dim[0].stride = 1;
generated by cgit v1.1 at 2025-05-28 18:11:04 +0000