[svn:parrot] r36689 - in trunk: compilers/imcc include/parrot src src/packfile t/compilers/imcc/imcpasm t/native_pbc t/op tools/dev
rurban at svn.parrot.org
rurban at svn.parrot.org
Fri Feb 13 21:12:09 UTC 2009
Author: rurban
Date: Fri Feb 13 21:12:06 2009
New Revision: 36689
URL: https://trac.parrot.org/parrot/changeset/36689
Log:
TT #308 add 16-byte long double
- Initial patch by Andy Dougherty
- Fixed 3 wrong tests and added new transformers
- Updated native_pbc tests and tools/dev/mk_native_pbc --noconf
- Added FLOATTYPE macros and even a 32-byte endianizer
Modified:
trunk/compilers/imcc/optimizer.c
trunk/include/parrot/packfile.h
trunk/src/byteorder.c
trunk/src/packfile.c
trunk/src/packfile/pf_items.c
trunk/t/compilers/imcc/imcpasm/opt1.t
trunk/t/native_pbc/header.t
trunk/t/native_pbc/integer.t
trunk/t/native_pbc/number.t
trunk/t/native_pbc/string.t
trunk/t/op/jitn.t
trunk/t/op/number.t
trunk/tools/dev/mk_native_pbc
Modified: trunk/compilers/imcc/optimizer.c
==============================================================================
--- trunk/compilers/imcc/optimizer.c Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/compilers/imcc/optimizer.c Fri Feb 13 21:12:06 2009 (r36689)
@@ -910,14 +910,28 @@
const char *debug_fmt = NULL; /* gcc -O uninit warn */
int found, branched;
- /* construct a FLOATVAL_FMT with needed precision */
+ /* construct a FLOATVAL_FMT with needed precision.
+ TT #308 XXX Should use Configure.pl to figure these out,
+ but it's not clear just what is needed.
+ The value of '16' for NUMVAL_SIZE == 8 was one larger than the
+ default FLOATVAL_FMT of '15' determined by Configure.pl. The
+ reason for this difference, if there is one, should be documented.
+ The values of.18Lg and .31Lg are guesses.
+ */
#if NUMVAL_SIZE == 8
fmt = "%0.16g";
#elif NUMVAL_SIZE == 12
fmt = "%0.18Lg";
+#elif NUMVAL_SIZE == 16
+ fmt = "%0.31Lg";
#else
fmt = FLOATVAL_FMT;
- IMCC_warning(interp, "subs_constants", "used default FLOATVAL_FMT\n");
+ /* Since it's not clear why this is needed, it's not clear what to
+ do if it's an unknown case.
+ */
+ IMCC_fatal(interp, 0,
+ "IMCC_subst_constants: unexpected NUMVAL_SIZE = %d\n",
+ NUMVAL_SIZE);
#endif
tmp = NULL;
Modified: trunk/include/parrot/packfile.h
==============================================================================
--- trunk/include/parrot/packfile.h Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/include/parrot/packfile.h Fri Feb 13 21:12:06 2009 (r36689)
@@ -28,7 +28,15 @@
#define FLOATTYPE_8_NAME "IEEE-754 8 byte double"
#define FLOATTYPE_12 1
#define FLOATTYPE_12_NAME "x86 little endian 12 byte long double"
-#define FLOATTYPE_MAX 1
+#define FLOATTYPE_16 2
+#define FLOATTYPE_16_NAME "IEEE-754 16 byte long double"
+#define FLOATTYPE_MAX 2
+/* Unsupported NaN difference, but patches welcome */
+#define FLOATTYPE_16MIPS 3
+#define FLOATTYPE_16MIPS_NAME "MIPS 16 byte long double"
+/* Not yet set into silicon AFAIK */
+#define FLOATTYPE_32 4
+#define FLOATTYPE_32_NAME "256-bit extended double"
#define TRACE_PACKFILE 0
@@ -1123,6 +1131,13 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*rb);
+void fetch_buf_be_32(
+ ARGOUT(unsigned char *rb),
+ ARGIN(const unsigned char *b))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*rb);
+
void fetch_buf_be_4(
ARGOUT(unsigned char *rb),
ARGIN(const unsigned char *b))
@@ -1151,6 +1166,13 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*rb);
+void fetch_buf_le_32(
+ ARGOUT(unsigned char *rb),
+ ARGIN(const unsigned char *b))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*rb);
+
void fetch_buf_le_4(
ARGOUT(unsigned char *rb),
ARGIN(const unsigned char *b))
@@ -1187,6 +1209,9 @@
#define ASSERT_ARGS_fetch_buf_be_16 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(rb) \
|| PARROT_ASSERT_ARG(b)
+#define ASSERT_ARGS_fetch_buf_be_32 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(rb) \
+ || PARROT_ASSERT_ARG(b)
#define ASSERT_ARGS_fetch_buf_be_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(rb) \
|| PARROT_ASSERT_ARG(b)
@@ -1199,6 +1224,9 @@
#define ASSERT_ARGS_fetch_buf_le_16 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(rb) \
|| PARROT_ASSERT_ARG(b)
+#define ASSERT_ARGS_fetch_buf_le_32 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(rb) \
+ || PARROT_ASSERT_ARG(b)
#define ASSERT_ARGS_fetch_buf_le_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(rb) \
|| PARROT_ASSERT_ARG(b)
Modified: trunk/src/byteorder.c
==============================================================================
--- trunk/src/byteorder.c Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/src/byteorder.c Fri Feb 13 21:12:06 2009 (r36689)
@@ -54,6 +54,7 @@
# if INTVAL_SIZE == 4
return (w << 24) | ((w & 0xff00) << 8) | ((w & 0xff0000) >> 8) | (w >> 24);
# else
+# if INTVAL_SIZE == 8
INTVAL r;
r = w << 56;
@@ -65,6 +66,10 @@
r |= (w & 0xff000000000000) >> 40;
r |= (w & 0xff00000000000000) >> 56;
return r;
+# else
+ exit_fatal(1, "Unsupported INTVAL_SIZE=%d\n",
+ INTVAL_SIZE);
+# endif
# endif
#endif
}
@@ -92,6 +97,7 @@
# if INTVAL_SIZE == 4
return (w << 24) | ((w & 0xff00) << 8) | ((w & 0xff0000) >> 8) | (w >> 24);
# else
+# if INTVAL_SIZE == 8
INTVAL r;
r = w << 56;
r |= (w & 0xff00) << 40;
@@ -102,6 +108,10 @@
r |= (w & 0xff000000000000) >> 40;
r |= (w & 0xff00000000000000) >> 56;
return r;
+# else
+ exit_fatal(1, "Unsupported INTVAL_SIZE=%d\n",
+ INTVAL_SIZE);
+# endif
# endif
#endif
}
@@ -436,6 +446,110 @@
/*
+=item C<void fetch_buf_le_32>
+
+Converts a 32-byte little-endian buffer C<b> into a big-endian buffer C<b>.
+
+=cut
+
+*/
+
+void
+fetch_buf_le_32(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b))
+{
+ ASSERT_ARGS(fetch_buf_le_32)
+#if !PARROT_BIGENDIAN
+ memcpy(rb, b, 32);
+#else
+ rb[0] = b[31];
+ rb[1] = b[30];
+ rb[2] = b[29];
+ rb[3] = b[28];
+ rb[4] = b[27];
+ rb[5] = b[26];
+ rb[6] = b[25];
+ rb[7] = b[24];
+ rb[8] = b[23];
+ rb[9] = b[22];
+ rb[10] = b[21];
+ rb[11] = b[20];
+ rb[12] = b[19];
+ rb[13] = b[18];
+ rb[14] = b[17];
+ rb[15] = b[16];
+ rb[16] = b[15];
+ rb[17] = b[14];
+ rb[18] = b[13];
+ rb[19] = b[12];
+ rb[20] = b[11];
+ rb[21] = b[10];
+ rb[22] = b[9];
+ rb[23] = b[8];
+ rb[24] = b[7];
+ rb[25] = b[6];
+ rb[26] = b[5];
+ rb[27] = b[4];
+ rb[28] = b[3];
+ rb[29] = b[2];
+ rb[30] = b[1];
+ rb[31] = b[0];
+#endif
+}
+
+/*
+
+=item C<void fetch_buf_be_32>
+
+Converts a 32-byte big-endian buffer C<b> into a little-endian buffer C<b>.
+
+=cut
+
+*/
+
+void
+fetch_buf_be_32(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b))
+{
+ ASSERT_ARGS(fetch_buf_be_32)
+#if PARROT_BIGENDIAN
+ memcpy(rb, b, 32);
+#else
+ rb[0] = b[31];
+ rb[1] = b[30];
+ rb[2] = b[29];
+ rb[3] = b[28];
+ rb[4] = b[27];
+ rb[5] = b[26];
+ rb[6] = b[25];
+ rb[7] = b[24];
+ rb[8] = b[23];
+ rb[9] = b[22];
+ rb[10] = b[21];
+ rb[11] = b[20];
+ rb[12] = b[19];
+ rb[13] = b[18];
+ rb[14] = b[17];
+ rb[15] = b[16];
+ rb[16] = b[15];
+ rb[17] = b[14];
+ rb[18] = b[13];
+ rb[19] = b[12];
+ rb[20] = b[11];
+ rb[21] = b[10];
+ rb[22] = b[9];
+ rb[23] = b[8];
+ rb[24] = b[7];
+ rb[25] = b[6];
+ rb[26] = b[5];
+ rb[27] = b[4];
+ rb[28] = b[3];
+ rb[29] = b[2];
+ rb[30] = b[1];
+ rb[31] = b[0];
+#endif
+}
+
+/*
+
=back
=head1 HISTORY
Modified: trunk/src/packfile.c
==============================================================================
--- trunk/src/packfile.c Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/src/packfile.c Fri Feb 13 21:12:06 2009 (r36689)
@@ -939,7 +939,10 @@
}
/* Ensure the bytecode version is one we can read. Currently, we only
- * support bytecode versions matching the current one. */
+ * support bytecode versions matching the current one.
+ *
+ * tools/dev/pbc_header.pl --upd t/native_pbc/ *.pbc
+ * stamps version and fingerprint in the native tests. */
if (header->bc_major != PARROT_PBC_MAJOR
&& header->bc_minor != PARROT_PBC_MINOR) {
Parrot_io_eprintf(NULL, "PackFile_unpack: This Parrot cannot read bytecode "
@@ -970,9 +973,11 @@
TRACE_PRINTF(("PackFile_unpack: Wordsize %d.\n", header->wordsize));
TRACE_PRINTF(("PackFile_unpack: Floattype %d (%s).\n",
header->floattype,
- header->floattype ?
- "x86 little endian 12 byte long double" :
- "IEEE-754 8 byte double"));
+ header->floattype == FLOATTYPE_8
+ ? FLOATTYPE_8_NAME
+ : header->floattype == FLOATTYPE_16
+ ? FLOATTYPE_16_NAME
+ : FLOATTYPE_12_NAME));
TRACE_PRINTF(("PackFile_unpack: Byteorder %d (%sendian).\n",
header->byteorder, header->byteorder ? "big " : "little-"));
@@ -1225,13 +1230,17 @@
header->bc_major = PARROT_PBC_MAJOR;
header->bc_minor = PARROT_PBC_MINOR;
#if NUMVAL_SIZE == 8
- header->floattype = 0;
+ header->floattype = FLOATTYPE_8;
#else
# if (NUMVAL_SIZE == 12) && PARROT_BIGENDIAN
- header->floattype = 1;
+ header->floattype = FLOATTYPE_12;
# else
+# if (NUMVAL_SIZE == 16)
+ header->floattype = FLOATTYPE_16;
+# else
exit_fatal(1, "PackFile_set_header: Unsupported floattype NUMVAL_SIZE=%d,"
" PARROT_BIGENDIAN=%d\n", NUMVAL_SIZE, PARROT_BIGENDIAN);
+# endif
# endif
#endif
}
@@ -4061,8 +4070,10 @@
self->groups[i] = mem_allocate_typed(PackFile_Annotations_Group);
self->groups[i]->bytecode_offset = PF_fetch_opcode(seg->pf, &cursor);
self->groups[i]->entries_offset = PF_fetch_opcode(seg->pf, &cursor);
- TRACE_PRINTF_VAL(("PackFile_Annotations_unpack: group[%d]/%d bytecode_offset=%d entries_offset=%d\n",
- i, self->num_groups, self->groups[i]->bytecode_offset, self->groups[i]->entries_offset));
+ TRACE_PRINTF_VAL((
+ "PackFile_Annotations_unpack: group[%d]/%d bytecode_offset=%d entries_offset=%d\n",
+ i, self->num_groups, self->groups[i]->bytecode_offset,
+ self->groups[i]->entries_offset));
}
/* Unpack entries. */
Modified: trunk/src/packfile/pf_items.c
==============================================================================
--- trunk/src/packfile/pf_items.c Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/src/packfile/pf_items.c Fri Feb 13 21:12:06 2009 (r36689)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2008, The Perl Foundation.
+Copyright (C) 2001-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -60,6 +60,41 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*dest);
+static void cvt_num16_num12(
+ ARGOUT(unsigned char *dest),
+ ARGIN(const unsigned char *src))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*dest);
+
+static void cvt_num16_num12_le(
+ ARGOUT(unsigned char *dest),
+ ARGIN(unsigned char *src))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*dest);
+
+static void cvt_num16_num8(
+ ARGOUT(unsigned char *dest),
+ ARGIN(const unsigned char *src))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*dest);
+
+static void cvt_num16_num8_be(
+ ARGOUT(unsigned char *dest),
+ ARGIN(const unsigned char *src))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*dest);
+
+static void cvt_num16_num8_le(
+ ARGOUT(unsigned char *dest),
+ ARGIN(unsigned char *src))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*dest);
+
PARROT_WARN_UNUSED_RESULT
static opcode_t fetch_op_be_4(ARGIN(const unsigned char *b))
__attribute__nonnull__(1);
@@ -97,6 +132,21 @@
#define ASSERT_ARGS_cvt_num12_num8_le __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(dest) \
|| PARROT_ASSERT_ARG(src)
+#define ASSERT_ARGS_cvt_num16_num12 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(dest) \
+ || PARROT_ASSERT_ARG(src)
+#define ASSERT_ARGS_cvt_num16_num12_le __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(dest) \
+ || PARROT_ASSERT_ARG(src)
+#define ASSERT_ARGS_cvt_num16_num8 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(dest) \
+ || PARROT_ASSERT_ARG(src)
+#define ASSERT_ARGS_cvt_num16_num8_be __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(dest) \
+ || PARROT_ASSERT_ARG(src)
+#define ASSERT_ARGS_cvt_num16_num8_le __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(dest) \
+ || PARROT_ASSERT_ARG(src)
#define ASSERT_ARGS_fetch_op_be_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(b)
#define ASSERT_ARGS_fetch_op_be_8 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
@@ -129,6 +179,7 @@
*
* Floattype 0 = IEEE-754 8 byte double
* Floattype 1 = x86 little endian 12 byte long double
+ * Floattype 2 = IEEE-754 16 byte long double
*
*/
@@ -193,10 +244,49 @@
/*
+=item C<static void cvt_num12_num8>
+
+Converts i386 LE 12-byte long double to IEEE 754 8 byte double.
+
+not yet implemented (throws internal_exception).
+
+=cut
+
+*/
+
+static void
+cvt_num16_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
+{
+ ASSERT_ARGS(cvt_num16_num8)
+ exit_fatal(1, "TODO cvt_num16_num8\n");
+}
+
+/*
+
+=item C<static void cvt_num16_num12>
+
+Converts IEEE 754 LE 16-byte long double to i386 LE 12-byte long double .
+
+Not yet implemented (throws internal_exception).
+
+=cut
+
+*/
+
+static void
+cvt_num16_num12(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
+{
+ ASSERT_ARGS(cvt_num16_num12)
+ exit_fatal(1, "TODO cvt_num16_num12\n");
+}
+
+/*
+
=item C<static void cvt_num12_num8_be>
Converts a 12-byte i386 long double into a big-endian IEEE 754 8-byte double.
-converting to BE not yet implemented (throws internal_exception).
+
+Converting to BE not yet implemented (throws internal_exception).
=cut
@@ -206,9 +296,10 @@
cvt_num12_num8_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
{
ASSERT_ARGS(cvt_num12_num8_be)
- cvt_num12_num8(dest, src);
- /* TODO endianize */
- exit_fatal(1, "TODO cvt_num12_num8_be\n");
+ unsigned char b[8];
+ cvt_num12_num8(b, src);
+ /* TODO test endianize */
+ fetch_buf_le_8(dest, b);
}
/*
@@ -233,6 +324,70 @@
/*
+=item C<static void cvt_num16_num8_le>
+
+Converts a IEEE 754 16-byte long double into a little-endian IEEE 754
+8-byte double.
+
+Not yet implemented (throws internal_exception).
+
+=cut
+
+*/
+
+static void
+cvt_num16_num8_le(ARGOUT(unsigned char *dest), ARGIN(unsigned char *src))
+{
+ ASSERT_ARGS(cvt_num16_num8_le)
+ unsigned char b[8];
+ cvt_num16_num8(b, src);
+ fetch_buf_le_8(dest, b);
+}
+
+/*
+
+=item C<static void cvt_num16_num8_be>
+
+Converts a IEEE 754 16-byte IA64 long double into a big-endian IEEE 754 8-byte double.
+
+Not yet implemented (throws internal_exception).
+
+=cut
+
+*/
+
+static void
+cvt_num16_num8_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
+{
+ ASSERT_ARGS(cvt_num16_num8_be)
+ unsigned char b[8];
+ cvt_num16_num8(b, src);
+ fetch_buf_be_8(dest, b);
+}
+
+/*
+
+=item C<static void cvt_num16_num12_le>
+
+Converts a IEEE 754 16-byte BE long double into a 12-byte i386 long double.
+
+Not yet implemented (throws internal_exception).
+
+=cut
+
+*/
+
+static void
+cvt_num16_num12_le(ARGOUT(unsigned char *dest), ARGIN(unsigned char *src))
+{
+ ASSERT_ARGS(cvt_num16_num12_le)
+ unsigned char b[12];
+ cvt_num16_num12(b, src);
+ fetch_buf_le_12(dest, b);
+}
+
+/*
+
=item C<static opcode_t fetch_op_test>
Fetches an C<opcode_t> operation in little-endian format.
@@ -643,6 +798,9 @@
else if (pf->header->floattype == FLOATTYPE_12) {
*((const unsigned char **) (stream)) += 12;
}
+ else if (pf->header->floattype == FLOATTYPE_16) {
+ *((const unsigned char **) (stream)) += 16;
+ }
return f;
}
@@ -933,20 +1091,52 @@
else
pf->fetch_op = fetch_op_le_8;
- if (pf->header->floattype)
+ if (pf->header->floattype == FLOATTYPE_8 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = fetch_buf_le_8;
+ else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 12)
+ pf->fetch_nv = fetch_buf_le_12;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 16)
+ pf->fetch_nv = fetch_buf_le_16;
+ else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 8)
pf->fetch_nv = cvt_num12_num8_le;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 12)
+ pf->fetch_nv = cvt_num16_num12_le;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = cvt_num16_num8_le;
else
- pf->fetch_nv = fetch_buf_le_8;
+ exit_fatal(1,
+ "PackFile_unpack: unsupported float conversion %d to %d, PARROT_BIGENDIAN=%d\n",
+ NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN);
+ return 0;
}
else {
if (pf->header->wordsize == 4)
pf->fetch_op = fetch_op_be_4;
else
pf->fetch_op = fetch_op_be_8;
+
+ if (pf->header->floattype == FLOATTYPE_8 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = fetch_buf_be_8;
+ else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 12)
+ pf->fetch_nv = fetch_buf_be_12;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 16)
+ pf->fetch_nv = fetch_buf_be_16;
+ else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = cvt_num12_num8;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 12)
+ pf->fetch_nv = cvt_num16_num12;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = cvt_num16_num8;
+ else {
+ exit_fatal(1,
+ "PackFile_unpack: unsupported float conversion %d to %d, PARROT_BIGENDIAN=%d\n",
+ NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN);
+ }
}
#else
+ pf->fetch_iv = pf->fetch_op;
/* this Parrot is on a LITTLE ENDIAN machine */
if (need_endianize) {
if (pf->header->wordsize == 4)
@@ -954,23 +1144,46 @@
else
pf->fetch_op = fetch_op_be_8;
- if (pf->header->floattype)
- pf->fetch_nv = cvt_num12_num8_be;
- else
+ if (pf->header->floattype == FLOATTYPE_8 && NUMVAL_SIZE == 8)
pf->fetch_nv = fetch_buf_be_8;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 16)
+ pf->fetch_nv = fetch_buf_be_16;
+ else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = cvt_num12_num8_be;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = cvt_num16_num8_be;
+ else {
+ exit_fatal(1,
+ "PackFile_unpack: unsupported float conversion %d to %d, PARROT_BIGENDIAN=%d\n",
+ NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN);
+ return;
+ }
}
else {
if (pf->header->wordsize == 4)
pf->fetch_op = fetch_op_le_4;
else
pf->fetch_op = fetch_op_le_8;
- if (NUMVAL_SIZE == 8 && pf->header->floattype)
- pf->fetch_nv = cvt_num12_num8;
- else if (NUMVAL_SIZE != 8 && ! pf->header->floattype)
+
+ if (pf->header->floattype == FLOATTYPE_8 && NUMVAL_SIZE == 8)
pf->fetch_nv = fetch_buf_le_8;
+ else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 12)
+ pf->fetch_nv = fetch_buf_le_12;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 16)
+ pf->fetch_nv = fetch_buf_le_16;
+ else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = cvt_num12_num8;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 12)
+ pf->fetch_nv = cvt_num16_num12;
+ else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 8)
+ pf->fetch_nv = cvt_num16_num8;
+ else {
+ exit_fatal(1,
+ "PackFile_unpack: unsupported float conversion %d to %d, PARROT_BIGENDIAN=%d\n",
+ NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN);
+ }
}
#endif
- pf->fetch_iv = pf->fetch_op;
}
/*
@@ -985,6 +1198,8 @@
Renamed PackFile_* to PF_*
+Added 16 byte types.
+
=head1 TODO
C<<PF_store_<type>()>> - write an opcode_t stream to cursor in natural
Modified: trunk/t/compilers/imcc/imcpasm/opt1.t
==============================================================================
--- trunk/t/compilers/imcc/imcpasm/opt1.t Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/t/compilers/imcc/imcpasm/opt1.t Fri Feb 13 21:12:06 2009 (r36689)
@@ -6,6 +6,9 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Parrot::Test tests => 78;
+use Parrot::Config;
+
+my $output;
# these tests are run with -O1 by TestCompiler and show
# generated PASM code for various optimizations at level 1
@@ -1151,18 +1154,25 @@
##############################
-pir_2_pasm_like( <<'CODE', <<'OUT', "constant add big nums" );
+$output = $PConfig{numvalsize} == 8
+ ? '/^# IMCC does produce b0rken PASM files
+# see http://guest@rt.perl.org/rt3/Ticket/Display.html\?id=32392
+_main:
+ set N0, 1\.6e\+0?22
+ end$/
+' : '/^# IMCC does produce b0rken PASM files
+# see http://guest@rt.perl.org/rt3/Ticket/Display.html\?id=32392
+_main:
+ set N0, 16000000000000000000000
+ end$/
+';
+
+pir_2_pasm_like( <<'CODE', $output, "constant add big nums" );
.sub _main
add $N0, 10.0e20, 15.0e21
end
.end
CODE
-/^# IMCC does produce b0rken PASM files
-# see http://guest@rt.perl.org/rt3/Ticket/Display.html\?id=32392
-_main:
- set N0, 1\.6e\+0?22
- end$/
-OUT
##############################
SKIP: {
Modified: trunk/t/native_pbc/header.t
==============================================================================
--- trunk/t/native_pbc/header.t Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/t/native_pbc/header.t Fri Feb 13 21:12:06 2009 (r36689)
@@ -66,7 +66,7 @@
is( $h{magic}, "\xfe\x50\x42\x43\x0a\x1a\x0a", "magic string 0xfePBC0x0a0x1a0x0a len=7" );
ok( $h{wordsize} == 2 || $h{wordsize} == 4 || $h{wordsize} == 8, "wordsize: $h{wordsize}" );
ok( $h{byteorder} < 2, "byteorder: $h{byteorder}" );
-ok( $h{floattype} < 4, "floattype: $h{floattype}" );
+ok( $h{floattype} < 3, "floattype: $h{floattype}" );
is( $h{major}, $PConfig{MAJOR}, "major version: $h{major} vs $PConfig{MAJOR}" );
is( $h{minor}, $PConfig{MINOR}, "minor version: $h{minor} vs $PConfig{MINOR}" );
is( $h{patch}, $PConfig{PATCH}, "patch version: $h{patch} vs $PConfig{PATCH}" );
Modified: trunk/t/native_pbc/integer.t
==============================================================================
--- trunk/t/native_pbc/integer.t Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/t/native_pbc/integer.t Fri Feb 13 21:12:06 2009 (r36689)
@@ -8,7 +8,7 @@
use Test::More;
use Parrot::Config;
-use Parrot::Test tests => 4;
+use Parrot::Test tests => 5;
=head1 NAME
@@ -30,10 +30,11 @@
=head1 PLATFORMS
_1 i386 32 bit opcode_t, 32 bit intval (linux-gcc-ix86, freebsd-gcc, cygwin)
- _2 i386 32 bit opcode_t, 32 bit intval, long double (linux-gcc-ix86)
+ _2 i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86)
_3 PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc)
_4 x86_64 double float 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int)
- _5 big-endian 64-bit (irix or similar)
+ _5 x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int)
+ _6 big-endian 64-bit (MIPS irix or similar)
=cut
@@ -86,11 +87,16 @@
pbc_output_is( undef, '270544960', "i386 32 bit opcode_t, 32 bit intval" )
or diag "May need to regenerate t/native_pbc/integer_1.pbc; read test file";
-}
-TODO: {
-local $TODO = "devel versions are not guaranteed to succeed"
- if $PConfig{DEVEL};
+# HEADER => [
+# wordsize = 4 (interpreter's wordsize/INTVAL = 4/4)
+# byteorder = 0 (interpreter's byteorder = 0)
+# floattype = 1 (interpreter's NUMVAL_SIZE = 12)
+# parrot-version 0.9.0, bytecode-version 3.34
+# UUID type = 0, UUID size = 0
+# no endianize, no opcode, no numval transform
+# dirformat = 1
+# ]
pbc_output_is( undef, '270544960', "i386 32 bit opcode_t, 32 bit intval long double" )
or diag "May need to regenerate t/native_pbc/integer_2.pbc; read test file";
@@ -108,6 +114,12 @@
pbc_output_is(undef, '270544960', "PPC BE 32 bit opcode_t, 32 bit intval")
or diag "May need to regenerate t/native_pbc/integer_3.pbc; read test file";
+}
+
+TODO: {
+local $TODO = "devel versions are not guaranteed to succeed"
+ if $PConfig{DEVEL};
+
# any ordinary 64-bit intel unix:
# HEADER => [
# wordsize = 8 (interpreter's wordsize/INTVAL = 8/8)
@@ -122,9 +134,22 @@
pbc_output_is(undef, '270544960', "i86_64 LE 64 bit opcode_t, 64 bit intval")
or diag "May need to regenerate t/native_pbc/integer_4.pbc; read test file";
+# HEADER => [
+# wordsize = 8 (interpreter's wordsize/INTVAL = 8/8)
+# byteorder = 0 (interpreter's byteorder = 0)
+# floattype = 2 (interpreter's NUMVAL_SIZE = 16)
+# parrot-version 0.9.0, bytecode-version 3.34
+# UUID type = 0, UUID size = 0
+# no endianize, no opcode, no numval transform
+# dirformat = 1
+# ]
+
+pbc_output_is(undef, '270544960', "i86_64 LE 64 bit opcode_t, 64 bit intval, long double")
+ or diag "May need to regenerate t/native_pbc/integer_5.pbc; read test file";
+
# Formerly following tests had been set up:
# pbc_output_is(undef, '270544960', "big-endian 64-bit (irix)");
-# or diag "May need to regenerate t/native_pbc/integer_5.pbc; read test file";
+# or diag "May need to regenerate t/native_pbc/integer_6.pbc; read test file";
}
Modified: trunk/t/native_pbc/number.t
==============================================================================
--- trunk/t/native_pbc/number.t Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/t/native_pbc/number.t Fri Feb 13 21:12:06 2009 (r36689)
@@ -8,7 +8,7 @@
use Test::More;
use Parrot::Config;
-use Parrot::Test tests => 4;
+use Parrot::Test tests => 5;
=head1 NAME
@@ -30,10 +30,11 @@
=head1 PLATFORMS
_1 i386 32 bit opcode_t, 32 bit intval (linux-gcc-ix86, freebsd-gcc, cygwin)
- _2 i386 32 bit opcode_t, 32 bit intval, long double (linux-gcc-ix86)
+ _2 i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86)
_3 PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc)
_4 x86_64 double float 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int)
- _5 big-endian 64-bit (irix or similar)
+ _5 x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int)
+ _6 big-endian 64-bit (MIPS irix or similar)
=cut
@@ -116,11 +117,18 @@
pbc_output_is( undef, $output, "i386 double float 32 bit opcode_t" )
or diag "May need to regenerate t/native_pbc/number_1.pbc; read test file";
+# HEADER => [
+# wordsize = 4 (interpreter's wordsize/INTVAL = 4/4)
+# byteorder = 0 (interpreter's byteorder = 0)
+# floattype = 1 (interpreter's NUMVAL_SIZE = 12)
+# parrot-version 0.9.0, bytecode-version 3.34
+# UUID type = 0, UUID size = 0
+# no endianize, no opcode, no numval transform
+# dirformat = 1
+# ]
pbc_output_is( undef, $output, "i386 long double float 32 bit opcode_t")
or diag "May need to regenerate t/native_pbc/number_2.pbc; read test file";
-}
-
# darwin/ppc:
# HEADER => [
# wordsize = 4 (interpreter's wordsize/INTVAL = 4/4)
@@ -132,13 +140,14 @@
# dirformat = 1
# ]
+pbc_output_is(undef, $output, "PPC double float 32 bit BE opcode_t")
+ or diag "May need to regenerate t/native_pbc/number_3.pbc; read test file";
+}
+
TODO: {
local $TODO = "devel versions are not guaranteed to succeed"
if $PConfig{DEVEL};
-pbc_output_is(undef, $output, "PPC double float 32 bit BE opcode_t")
- or diag "May need to regenerate t/native_pbc/number_3.pbc; read test file";
-
# any ordinary 64-bit intel unix:
# HEADER => [
# wordsize = 8 (interpreter's wordsize/INTVAL = 8/8)
@@ -153,9 +162,21 @@
pbc_output_is(undef, $output, "i86_64 LE 64 bit opcode_t, 64 bit intval")
or diag "May need to regenerate t/native_pbc/number_4.pbc; read test file";
+# HEADER => [
+# wordsize = 8 (interpreter's wordsize/INTVAL = 8/8)
+# byteorder = 0 (interpreter's byteorder = 0)
+# floattype = 2 (interpreter's NUMVAL_SIZE = 16)
+# parrot-version 0.9.0, bytecode-version 3.34
+# UUID type = 0, UUID size = 0
+# no endianize, no opcode, no numval transform
+# dirformat = 1
+# ]
+pbc_output_is(undef, $output, "i86_64 LE 64 bit opcode_t, 64 bit intval, long double")
+ or diag "May need to regenerate t/native_pbc/integer_5.pbc; read test file";
+
# Formerly there were also a test for:
# pbc_output_is(undef, $output, "big-endian 64-bit irix")
-# or diag "May need to regenerate t/native_pbc/number_5.pbc; read test file";
+# or diag "May need to regenerate t/native_pbc/number_6.pbc; read test file";
}
Modified: trunk/t/native_pbc/string.t
==============================================================================
--- trunk/t/native_pbc/string.t Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/t/native_pbc/string.t Fri Feb 13 21:12:06 2009 (r36689)
@@ -30,10 +30,11 @@
=head1 PLATFORMS
_1 i386 32 bit opcode_t, 32 bit intval (linux-gcc-ix86, freebsd-gcc, cygwin)
- _2 i386 32 bit opcode_t, 32 bit intval, long double (linux-gcc-ix86)
+ _2 i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86)
_3 PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc)
_4 x86_64 double float 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int)
- _5 big-endian 64-bit (irix or similar)
+ _5 x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int)
+ _6 big-endian 64-bit (MIPS irix or similar)
=cut
Modified: trunk/t/op/jitn.t
==============================================================================
--- trunk/t/op/jitn.t Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/t/op/jitn.t Fri Feb 13 21:12:06 2009 (r36689)
@@ -7,6 +7,7 @@
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test tests => 14;
+use Parrot::Config;
=head1 NAME
@@ -23,6 +24,8 @@
=cut
+my $output;
+
pasm_output_is( <<'CODE', <<'OUTPUT', "sub_n_n_n 1,2,3 mapped" );
set N0,0
set N1,1
@@ -320,7 +323,8 @@
123
OUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "rounding due to mapped" );
+$output = $PConfig{numvalsize} < 16 ? "zero\n" : "not zero\n";
+pasm_output_is( <<'CODE', $output, "rounding due to mapped" );
set N0, 15
mul N0, N0, 0.1
sub N0, 1.5
@@ -330,8 +334,6 @@
print "zero\n"
end
CODE
-zero
-OUTPUT
# Local Variables:
# mode: cperl
Modified: trunk/t/op/number.t
==============================================================================
--- trunk/t/op/number.t Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/t/op/number.t Fri Feb 13 21:12:06 2009 (r36689)
@@ -7,6 +7,7 @@
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test tests => 56;
+use Parrot::Config;
=head1 NAME
@@ -22,6 +23,8 @@
=cut
+my $output;
+
pasm_output_is( <<CODE, <<OUTPUT, "set_n_nc" );
set N0, 1.0
set N1, 4.0
@@ -1078,19 +1081,21 @@
0.5
OUTPUT
-pasm_output_is( <<'CODE', <<OUTPUT, "sqrt_n_n" );
+# long double succeeds
+$output = $PConfig{numvalsize} == 8
+ ? '1.4142135623731
+1.41421356237309
+' : '1.4142135623731
+1.4142135623731
+';
+pasm_output_is( <<'CODE', $output, "sqrt_n_n" );
set N1, 2
sqrt N2, N1
- print N2
- print "\n"
+ say N2
sqrt N2, 2.0
- print N2
- print "\n"
+ say N2
end
CODE
-1.4142135623731
-1.41421356237309
-OUTPUT
pasm_error_output_like( <<'CODE', <<OUTPUT, "div_n_n by zero" );
set N0, 0
Modified: trunk/tools/dev/mk_native_pbc
==============================================================================
--- trunk/tools/dev/mk_native_pbc Fri Feb 13 21:11:00 2009 (r36688)
+++ trunk/tools/dev/mk_native_pbc Fri Feb 13 21:12:06 2009 (r36689)
@@ -12,10 +12,11 @@
# update the VERSION and rm .parrot_current_rev
# _1 i386 32 bit opcode_t, 32 bit intval (linux-gcc-ix86, freebsd-gcc, cygwin)
-# _2 i386 32 bit opcode_t, 32 bit intval, long double (linux-gcc-ix86)
+# _2 i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86)
# _3 PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc)
# _4 x86_64 double float 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int)
-# _5 big-endian 64-bit (irix or similar)
+# _5 x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int)
+# _6 big-endian 64-bit (irix or similar)
#tests:
#parrot -o i.pbc -a - <<EOF
@@ -39,25 +40,28 @@
then
if [ "$byteorder" == "1234" ]
then
+ echo "1: i386 32 bit opcode_t, 32 bit intval"
N=1
if [ "$(perl -V:uselongdouble)" == "uselongdouble='define';" ]; then
enable_long_double=1
- conf=" --floatval=double"
+ # force double on 2nd run not to default to long double
+ conf=" --floatval='double'"
fi
else
if [ "$byteorder" == "4321" ]
then
+ echo "3: PPC BE 32 bit opcode_t, 32 bit intval"
N=3
else
if [ "$byteorder" == "12345678" \
-a "$(perl -V:osname)" == "osname='cygwin';" ]
then
- echo "detected cygwin use64bitint: ok"
+ echo "1: cygwin use64bitint"
N=1
exe=.exe
else
- echo "unsupported perl -V:byteorder $byteorder"
- exit 1
+ echo "Sorry, unsupported perl - parrot ptrsize mismatch."
+ exit
fi
fi
fi
@@ -66,9 +70,12 @@
then
if [ "$byteorder" == "12345678" ]
then
+ echo "4+5: x86_64 double float 64 bit opcode_t + long double"
N=4
+ enable_long_double=1
else
- N=5
+ echo "6: big-endian 64-bit"
+ N=6
fi
else
echo "unsupported perl -V:ptrsize $ptrsize"
@@ -83,18 +90,11 @@
fi
tail myconfig
make -s || exit 1
+ M=$((N+1))
[ -e t/op/number_1.pasm ] || perl t/harness t/op/number.t
- [ -e t/op/string_133.pasm ] || perl t/harness t/op/string.t
- ./parrot -o t/native_pbc/integer_2.pbc -a - <<EOF
-print 0x10203040
-end
-EOF
- [ $? -le 0 ] && echo "t/native_pbc/integer_2.pbc updated"
- ./parrot -o t/native_pbc/number_2.pbc t/op/number_1.pasm && echo "t/native_pbc/number_2.pbc updated"
- ./parrot -o t/native_pbc/string_2.pbc t/op/string_133.pasm && echo "t/native_pbc/string_2.pbc updated"
-
+ ./parrot -o t/native_pbc/number_${M}.pbc t/op/number_1.pasm && echo "t/native_pbc/number_${M}.pbc updated"
make pbc_dump$exe
- ./pbc_dump -h t/native_pbc/number_2.pbc
+ ./pbc_dump -h t/native_pbc/number_${M}.pbc
fi
if [ "$1" != "--noconf" ]; then
More information about the parrot-commits
mailing list