Ticket #254: tt254-64bit-pbc.patch

include/parrot/packfile.h

@@ -1 +1 @@
 /*
- * Copyright (C) 2001-2007, Parrot Foundation
+ * Copyright (C) 2001-2009, Parrot Foundation
  */
 
 /* packfile.h
@@ -30 +30 @@
 #define FLOATTYPE_12_NAME     "x86 little endian 12 byte long double"
 #define FLOATTYPE_16          2
 #define FLOATTYPE_16_NAME     "IEEE-754 16 byte long double"
+/* Supported until here. */
 #define FLOATTYPE_MAX         2
-/* Unsupported NaN difference, but patches welcome */
+/* Non IEEE-754 versions, yet unsupported. */
+/* NaN difference, but patches welcome */
 #define FLOATTYPE_16MIPS      3
 #define FLOATTYPE_16MIPS_NAME "MIPS 16 byte long double"
 /* See http://www.ncsa.uiuc.edu/UserInfo/Resources/Hardware/IBMp690/IBM/usr/share/man/info/en_US/a_doc_lib/aixprggd/genprogc/128bit_long_double_floating-point_datatype.htm */
 #define FLOATTYPE_16AIX       4
-#define FLOATTYPE_16AIX_NAME "AIX 16 byte long double"
-/* Not yet set into silicon AFAIK */
-#define FLOATTYPE_32          5
-#define FLOATTYPE_32_NAME     "256-bit extended double"
+#define FLOATTYPE_16AIX_NAME  "AIX 16 byte long double"
+/* IEEE-754 old and tiny, yet unsupported */
+#define FLOATTYPE_4           5
+#define FLOATTYPE_4_NAME      "4-byte float"
 
-#define TRACE_PACKFILE 0
+#define TRACE_PACKFILE 2
 
 #if TRACE_PACKFILE
 /* Here we pass multipe args to a macro so the args may not be bracketed here! */
-#  define TRACE_PRINTF(args)       if (pf->options) Parrot_trace_eprintf args
+#  define TRACE_PRINTF(args)       if (pf->options & 2) Parrot_trace_eprintf args
+#  define TRACE_PRINTF_ALIGN(args) if (pf->options & 4) Parrot_trace_eprintf args
 #  if TRACE_PACKFILE == 2
-#    define TRACE_PRINTF_VAL(args) if (pf->options & 2) Parrot_trace_eprintf args
+#    define TRACE_PRINTF_VAL(args) if (pf->options & 8) Parrot_trace_eprintf args
 #    define TRACE_PRINTF_2(args)   Parrot_trace_eprintf args
 #  else
 #    define TRACE_PRINTF_VAL(args)
@@ -56 +59 @@
 #else
 #  define TRACE_PRINTF(args)
 #  define TRACE_PRINTF_VAL(args)
+#  define TRACE_PRINTF_ALIGN(args)
 #  define TRACE_PRINTF_2(args)
 #endif
 
+#if TRACE_PACKFILE && (PARROT_PTR_ALIGNMENT > 1)
+/* TT #364 Check if cursor is ptr_alignment aligned */
+#  define CHECK_PTR_ALIGNMENT(ptr, where) \
+    if (PTR2INTVAL(ptr) & (PARROT_PTR_ALIGNMENT - 1)) { \
+        TRACE_PRINTF_2(("Warning: Misaligned cursor ptr %x at %s\n", (ptr), (where))); \
+    }
+#else
+#  define CHECK_PTR_ALIGNMENT(ptr, where) \
+    PARROT_ASSERT((PTR2INTVAL(ptr) & (PARROT_PTR_ALIGNMENT - 1)) == 0)
+#endif
+
 /*
 ** Structure Definitions:
 */

src/pbc_dump.c

@@ -9 +9 @@
 =head1 SYNOPSIS
 
  pbc_dump [-tdh] [--terse|--disassemble|--header-only] file.pbc
+ pbc_dump --debug|-D <2-14> file.pbc
 
  pbc_dump -o converted.pbc file.pbc
 
@@ -32 +33 @@
 
 Terse output.
 
-=item C<-e> C--debug>
+=item C<-D> C<--debug> value
 
 Display detailed packfile reader debugging information if
-F<include/parrot/packfile.h> enables TRACE_PACKFILE
+F<include/parrot/packfile.h> enables TRACE_PACKFILE.
+
+  2  print general debug info
+  4  print alignment info
+  8  print values
 
 =item C<-o converted.pbc>
 
@@ -156 +161 @@
     Parrot_io_printf(interp, "\tparrot-version %d.%d.%d, bytecode-version %d.%d\n",
                      pf->header->major, pf->header->minor, pf->header->patch,
                      pf->header->bc_major, pf->header->bc_minor);
-    Parrot_io_printf(interp, "\tUUID type = %d, UUID size = %d\n",
+    Parrot_io_printf(interp, "\tUUID: type = %d, size = %d",
                      pf->header->uuid_type, pf->header->uuid_size);
+    if (pf->header->uuid_data)
+        Parrot_io_printf(interp, ", '%s'\n", pf->header->uuid_data);
+    else
+        Parrot_io_printf(interp, "\n");
     Parrot_io_printf(interp, "\t%s endianize, %s opcode, %s numval transform\n",
             pf->need_endianize ? "**need**" : "no",
             pf->need_wordsize ? "**need**" : "no",
@@ -186 +195 @@
     printf("\t-h ... dump header only\n");
     printf("\t-t ... terse output\n");
 #if TRACE_PACKFILE
-    printf("\t--debug debug output\n");
+    printf("\t-D<2-14> --debug debug output\n");
+    printf("\t   2 general info\n");
+    printf("\t   4 alignment\n");
+    printf("\t   8 values\n");
 #endif
     printf("\n\t-o converted.pbc repacks a PBC file into "
            "the platform's native\n");
@@ -200 +212 @@
     { '?', '?', OPTION_optional_FLAG, { "--help" } },
     { 't', 't', OPTION_optional_FLAG, { "--terse" } },
     { 'd', 'd', OPTION_optional_FLAG, { "--disassemble" } },
-    { 'e', 'e', OPTION_optional_FLAG, { "--debug" } },
+    { 'D', 'D', OPTION_required_FLAG, { "--debug" } },
     { 'o', 'o', OPTION_required_FLAG, { "--output" } }
 };
 
@@ -224 +236 @@
     int disas = 0;
     int convert = 0;
     int header = 0;
-    int debug = 0;
+    int debug = 1; /* parrot_utils continue on version/UUID mismatches */
     const char *file = NULL;
     struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT;
     int status;
@@ -247 +259 @@
             case 'd':
                 disas = 1;
                 break;
-            case 'e':
-                debug = 1;
+            case 'D':
+                debug += (atoi(opt.opt_arg) | 1) - 1;
                 break;
             case 'o':
                 file = opt.opt_arg;

src/packfile.c

@@ -147 +147 @@
 PARROT_CANNOT_RETURN_NULL
 static const opcode_t * directory_unpack(PARROT_INTERP,
     ARGMOD(PackFile_Segment *segp),
-    ARGIN(const opcode_t *cursor))
+    ARGMOD(opcode_t *cursor))
         __attribute__nonnull__(1)
         __attribute__nonnull__(2)
         __attribute__nonnull__(3)
-        FUNC_MODIFIES(*segp);
+        FUNC_MODIFIES(*segp)
+        FUNC_MODIFIES(*cursor);
 
 PARROT_WARN_UNUSED_RESULT
 PARROT_CAN_RETURN_NULL
@@ -452 +453 @@
     extern int Parrot_exec_run;
 #endif
 
-/* TODO: This is broken on 64/32 transformations. See TT #254 */
-#define ROUND_16(val) (((val) & 0xf) ? 16 - ((val) & 0xf) : 0)
-#define ALIGN_16(st, cursor) \
-    (cursor) += ROUND_16((const char *)(cursor) - (const char *)(st))/sizeof (opcode_t)
+/* pad to 16 in bytes */
+#define PAD_16_B(size)        ((size) % 16 ? 16 - (size) % 16 : 0)
+/* offset from pf->src not in ptr diff, but in byte */
+#define OFFS(cursor) ((const char *)(cursor) - (const char *)(pf->src))
+
 
 #if TRACE_PACKFILE
 void
@@ -933 +935 @@
     self->src  = packed;
     self->size = packed_size;
 
-    /* Extract the header. */
+    /* Extract the header, up to excluding uuid_data */
     memcpy(header, packed, PACKFILE_HEADER_BYTES);
 
     /* Ensure the magic is correct. */
@@ -953 +955 @@
         Parrot_io_eprintf(NULL, "PackFile_unpack: This Parrot cannot read "
             "bytecode files with version %d.%d.\n",
             header->bc_major, header->bc_minor);
-        return 0;
+        if (!(pf->options & 1))
+            return 0;
     }
 
     /* Check wordsize, byte order and floating point number type are valid. */
@@ -976 +979 @@
     }
 
     /* Describe what was read for debugging. */
-    TRACE_PRINTF(("PackFile_unpack: Wordsize %d.\n", header->wordsize));
+    TRACE_PRINTF(("PackFile_unpack: Wordsize  %d.\n", header->wordsize));
     TRACE_PRINTF(("PackFile_unpack: Floattype %d (%s).\n",
                   header->floattype,
                   header->floattype == FLOATTYPE_8
@@ -986 +989 @@
                           : FLOATTYPE_12_NAME));
     TRACE_PRINTF(("PackFile_unpack: Byteorder %d (%sendian).\n",
                   header->byteorder, header->byteorder ? "big " : "little-"));
+    TRACE_PRINTF(("PackFile_unpack: parrot version %d.%d.%d",
+                  header->major, header->minor, header->patch));
+    TRACE_PRINTF((", bc_version %d.%d\n",
+                  header->bc_major, header->bc_minor));
+    TRACE_PRINTF(("PackFile_unpack: uuid: type=%d, size=%d\n",
+                  header->uuid_type, header->uuid_size));
 
     /* Check the UUID type is valid and, if needed, read a UUID. */
     if (header->uuid_type == 0) {
         /* No UUID; fine, nothing more to do. */
     }
-    else if (header->uuid_type == 1) {
+    else if (header->uuid_type == 1 && header->uuid_size) {
         /* Read in the UUID. We'll put it in a NULL-terminated string, just in
-         * case pepole use it that way. */
+         * case people use it that way. */
         header->uuid_data = (unsigned char *)
             mem_sys_allocate(header->uuid_size + 1);
 
-        memcpy(header->uuid_data, packed + PACKFILE_HEADER_BYTES,
-            header->uuid_size);
+        memcpy(header->uuid_data, packed +
+               (PACKFILE_HEADER_BYTES/sizeof (opcode_t *)),
+               header->uuid_size);
 
         /* NULL terminate */
         header->uuid_data[header->uuid_size] = 0;
+
+        TRACE_PRINTF_VAL(("PackFile_unpack: uuid_data='%s'\n", header->uuid_data));
+        /* TODO TT #359. compare computed UUID and fail */
     }
-    else
+    else {
         /* Don't know this UUID type. */
         Parrot_io_eprintf(NULL, "PackFile_unpack: Invalid UUID type %d\n",
                     header->uuid_type);
+        if (!(pf->options & 1))
+            return 0;
+    }
 
     /* Set cursor to position after what we've read, allowing for padding to a
      * 16 byte boundary. */
     header_read_length  = PACKFILE_HEADER_BYTES + header->uuid_size;
-    header_read_length += header_read_length % 16 ?
-        16 - header_read_length % 16 : 0;
+    header_read_length += PAD_16_B(header_read_length);
     cursor              = packed + (header_read_length / sizeof (opcode_t));
+    TRACE_PRINTF(("PackFile_unpack: pad=%d\n",
+                  cursor - packed));
 
     /* Set what transforms we need to do when reading the rest of the file. */
     PackFile_assign_transforms(self);
@@ -1244 +1261 @@
     header->floattype = FLOATTYPE_16;
 #    else
     exit_fatal(1, "PackFile_set_header: Unsupported floattype NUMVAL_SIZE=%d,"
-               " PARROT_BIGENDIAN=%d\n", NUMVAL_SIZE,
-               PARROT_BIGENDIAN ? "big-endian" : "little-endian");
+               " PARROT_BIGENDIAN=%s\n",
+               NUMVAL_SIZE, PARROT_BIGENDIAN ? "big-endian" : "little-endian");
 #    endif
 #  endif
 #endif
@@ -1440 +1457 @@
     }
     else {
         int i;
+        /* XXX What are we doing here? */
+        TRACE_PRINTF(("default_unpack: pre-fetch %d ops into data\n",
+                      self->size));
         for (i = 0; i < (int)self->size; i++) {
             self->data[i] = PF_fetch_opcode(self->pf, &cursor);
-            TRACE_PRINTF(("default_unpack: transformed op[#%d]/%d %u\n",
+            TRACE_PRINTF(("default_unpack: transformed op[#%d]/%d %lu\n",
                           i, self->size, self->data[i]));
         }
     }
@@ -1707 +1727 @@
 
 =item C<void PackFile_Segment_destroy>
 
-Destroys the given PackFile_Segment.
+Call the segment registered destroy_func and then destroy the segment self.
 
 =cut
 
@@ -1790 +1810 @@
 
     if (align && (cursor - self->pf->src) % align)
         cursor += align - (cursor - self->pf->src) % align;
+    CHECK_PTR_ALIGNMENT(cursor, "PackFile_Segment_pack");
 
     return cursor;
 }
@@ -1818 +1839 @@
         ARGIN(const opcode_t *cursor))
 {
     ASSERT_ARGS(PackFile_Segment_unpack)
+    int offs;
     PackFile_Segment_unpack_func_t f = self->pf->PackFuncs[self->type].unpack;
-#if TRACE_PACKFILE
     PackFile * const pf  = self->pf;
-#endif
 
     cursor = default_unpack(self, cursor);
 
@@ -1833 +1853 @@
 
         cursor = (f)(interp, self, cursor);
         TRACE_PRINTF_VAL(("  PackFile_Segment_unpack: offset=0x%x\n",
-                          pf->src - cursor));
+                          OFFS(cursor)));
 
         if (!cursor)
             return NULL;
     }
 
-    TRACE_PRINTF_VAL(("pre-ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
-                      pf->src - cursor, pf->src, cursor));
-
-    /* FIXME on 64bit reading 32bit */
-    ALIGN_16(self->pf->src, cursor);
-    TRACE_PRINTF_VAL(("ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
-                      pf->src - cursor, pf->src, cursor));
+    offs = OFFS(cursor);
+    TRACE_PRINTF_ALIGN(("-S ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
+                        offs, pf->src, cursor));
+    offs += PAD_16_B(offs);
+    cursor = (const char *)(pf->src) + offs;
+    TRACE_PRINTF_ALIGN(("+S ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
+                        offs, pf->src, cursor));
+    CHECK_PTR_ALIGNMENT(cursor, "PackFile_Segment_unpack");
     return cursor;
 }
 
@@ -1950 +1971 @@
 PARROT_WARN_UNUSED_RESULT
 PARROT_CANNOT_RETURN_NULL
 static const opcode_t *
-directory_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *segp), ARGIN(const opcode_t *cursor))
+directory_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *segp), ARGMOD(opcode_t *cursor))
 {
     ASSERT_ARGS(directory_unpack)
     PackFile_Directory * const dir = (PackFile_Directory *) segp;
     PackFile           * const pf  = dir->base.pf;
     const opcode_t            *pos;
     size_t                     i;
+    int                        offs;
 
     dir->num_segments = PF_fetch_opcode(pf, &cursor);
     TRACE_PRINTF(("directory_unpack: %ld num_segments\n", dir->num_segments));
@@ -2002 +2024 @@
                 return 0;
             }
             TRACE_PRINTF_VAL(("Segment offset: new pos 0x%x "
-                "(src=0x%x cursor=0x%x).\n", pos - pf->src, pf->src, cursor));
+                              "(src=0x%x cursor=0x%x).\n",
+                              OFFS(pos), pf->src, cursor));
         }
         else
             pos = pf->src + seg->file_offset;
@@ -2029 +2052 @@
         seg->dir         = dir;
     }
 
-    TRACE_PRINTF_VAL(("pre-ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
-                      pf->src - cursor, pf->src, cursor));
-
-    /* FIXME on 64bit reading 32bit */
-    ALIGN_16(pf->src, cursor);
-    TRACE_PRINTF_VAL(("ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
-                      pf->src - cursor, pf->src, cursor));
+    offs = OFFS(cursor);
+    TRACE_PRINTF_ALIGN(("-D ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
+                        offs, pf->src, cursor));
+    offs += PAD_16_B(offs);
+    cursor = (const char *)(pf->src) + offs;
+    TRACE_PRINTF_ALIGN(("+D ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
+                        offs, pf->src, cursor));
+    CHECK_PTR_ALIGNMENT(cursor, "directory_unpack");
 
     /* and now unpack contents of dir */
     for (i = 0; cursor && i < dir->num_segments; i++) {
@@ -2057 +2081 @@
             return 0;
         }
         else {
-            TRACE_PRINTF_VAL(("PackFile_Segment_unpack ok. pos=0x%x\n", pos));
+            TRACE_PRINTF_VAL(("directory_unpack ok. pos=0x%x\n", OFFS(pos)));
         }
 
-        /* BUG: on 64bit reading 32bit lurking here! */
         if (pf->need_wordsize) {
 #if OPCODE_T_SIZE == 8
             if (pf->header->wordsize == 4)
@@ -2073 +2096 @@
         else
             delta = pos - cursor;
 
-        TRACE_PRINTF_VAL(("  delta=%d pos=0x%x cursor=0x%x\n",
+        TRACE_PRINTF_VAL(("  delta=%d, pos=0x%x cursor=0x%x\n",
                           delta, pos, cursor));
 
         if ((size_t)delta != tmp || dir->segments[i]->op_count != tmp)
-            fprintf(stderr, "PackFile_unpack segment '%s' directory length %d "
-                    "length in file %d needed %d for unpack\n",
+            fprintf(stderr, "PackFile_unpack segment '%s' directory length %d. "
+                    "length in file %d, needed %d for unpack\n",
                     dir->segments[i]->name,
                     (int)dir->segments[i]->op_count, (int)tmp,
                     (int)delta);
         cursor = pos;
     }
+    CHECK_PTR_ALIGNMENT(cursor, "directory_unpack after padding");
 
     return cursor;
 }
@@ -2248 +2272 @@
 
     if (align && (cursor - self->pf->src) % align)
         cursor += align - (cursor - self->pf->src) % align;
+    CHECK_PTR_ALIGNMENT(cursor, "directory_pack after padding");
 
     /* now pack all segments into new format */
     for (i = 0; i < dir->num_segments; i++) {
@@ -3232 +3257 @@
     opcode_t i;
 
     *cursor++ = ft->fixup_count;
+    CHECK_PTR_ALIGNMENT(cursor, "fixup_pack fixup_count");
 
     for (i = 0; i < ft->fixup_count; i++) {
         *cursor++ = (opcode_t) ft->fixups[i]->type;
@@ -3349 +3375 @@
                 return NULL;
         }
     }
+    CHECK_PTR_ALIGNMENT(cursor, "fixup_unpack");
 
     return cursor;
 }
@@ -3791 +3818 @@
 
     TRACE_PRINTF(("PackFile_Constant_unpack(): Type is %ld ('%c')...\n",
                   type, (char)type));
+    CHECK_PTR_ALIGNMENT(cursor, "PackFile_Constant_unpack");
 
     switch (type) {
         case PFC_NUMBER:
@@ -3849 +3877 @@
     /* thawing the PMC needs the real packfile in place */
     PackFile_ByteCode * const cs_save = interp->code;
     interp->code                      = pf->cur_cs;
+    CHECK_PTR_ALIGNMENT(cursor, "PackFile_Constant_unpack_pmc");
     image                             = PF_fetch_string(interp, pf, &cursor);
 
     /*
      * TODO use thaw_constants
      * current issue: a constant Sub with attached properties
      *                doesn't GC mark the properties
-     * for a constant PMC *all* contents have to be in the constant pools
+     * for a constant PMC *all* contents have to be in the constant pools.
      */
     pmc         = Parrot_thaw(interp, image);
-
     /* place item in const_table */
     self->type  = PFC_PMC;
     self->u.key = pmc;
@@ -4078 +4106 @@
 
     /* Write key count and any keys. */
     *cursor++ = self->num_keys;
+    CHECK_PTR_ALIGNMENT(cursor, "PackFile_Annotations_pack");
 
     for (i = 0; i < self->num_keys; i++) {
         *cursor++ = self->keys[i]->name;
         *cursor++ = self->keys[i]->type;
     }
+    CHECK_PTR_ALIGNMENT(cursor, "PackFile_Annotations_pack keys");
 
     /* Write group count and any groups. */
     *cursor++ = self->num_groups;
@@ -4132 +4162 @@
     /* Unpack keys. */
     self->num_keys = PF_fetch_opcode(seg->pf, &cursor);
 
+    CHECK_PTR_ALIGNMENT(cursor, "PackFile_Annotations_unpack");
     TRACE_PRINTF(("PackFile_Annotations_unpack: Unpacking %ld keys\n",
                   self->num_keys));
 

src/embed.c

@@ -381 +381 @@
 
 Read in a bytecode, unpack it into a C<PackFile> structure, and do fixups.
 
+C<options> are passed to the packfile reader.
+
+  0   strict,  fails on version or UUID mismatch (parrot).
+  1   relaxed, warns on version or UUID mismatch (parrot_utils).
+  2++ --debug cmdline options, only when packfile.h has TRACE_PACKFILE set.
+     2 TRACE_PRINTF
+     4 TRACE_PRINTF_ALIGN
+     8 TRACE_PRINTF_VAL
+
 =cut
 
 */
@@ -388 +397 @@
 PARROT_EXPORT
 PARROT_CAN_RETURN_NULL
 PackFile *
-Parrot_pbc_read(PARROT_INTERP, ARGIN_NULLOK(const char *fullname), const int debug)
+Parrot_pbc_read(PARROT_INTERP, ARGIN_NULLOK(const char *fullname), const int options)
 {
     FILE     *io        = NULL;
     INTVAL    is_mapped = 0;
@@ -531 +540 @@
 
     pf = PackFile_new(interp, is_mapped);
 
-    /* Make the cmdline option available to the unpackers */
-    pf->options = debug;
+    /* 0   to fail on version or UUID mismatch (parrot)
+     * 1   to pass on version or UUID mismatch (parrot_utils)
+     * 2++ --debug cmdline options:
+     *   2 TRACE_PRINTF
+     *   4 TRACE_PRINTF_ALIGN
+     *   8 TRACE_PRINTF_VAL */
+    pf->options = options;
 
     if (!PackFile_unpack(interp, pf, (opcode_t *)program_code,
             (size_t)program_size)) {
@@ -1154 +1168 @@
 
 PARROT_EXPORT
 void
-Parrot_disassemble(PARROT_INTERP, const char *outfile, Parrot_disassemble_options options)
+Parrot_disassemble(PARROT_INTERP, ARGIN_NULLOK(const char *outfile),
+                   Parrot_disassemble_options options)
 {
     PDB_line_t *line;
     PDB_t      *pdb             = mem_allocate_zeroed_typed(PDB_t);
@@ -1293 +1308 @@
      */
     if (! interp->initial_pf) {
         PackFile *pf = PackFile_new_dummy(interp, "compile_string");
+        interp->initial_pf = pf;
         /* Assumption: there is no valid reason to fail to create it.
-         * If the assumption changes, replace the assertio with a
+         * If the assumption changes, replace the assertion with a
          * runtime check
          */
         PARROT_ASSERT(interp->initial_pf);

src/packfile/pf_items.c

@@ -161 +161 @@
 static opcode_t fetch_op_mixed_le(ARGIN(const unsigned char *b))
         __attribute__nonnull__(1);
 
-PARROT_WARN_UNUSED_RESULT
-static opcode_t fetch_op_test(ARGIN(const unsigned char *b))
-        __attribute__nonnull__(1);
-
 #define ASSERT_ARGS_cvt_num12_num16 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
        PARROT_ASSERT_ARG(dest) \
     || PARROT_ASSERT_ARG(src)
@@ -219 +215 @@
        PARROT_ASSERT_ARG(b)
 #define ASSERT_ARGS_fetch_op_mixed_le __attribute__unused__ int _ASSERT_ARGS_CHECK = \
        PARROT_ASSERT_ARG(b)
-#define ASSERT_ARGS_fetch_op_test __attribute__unused__ int _ASSERT_ARGS_CHECK = \
-       PARROT_ASSERT_ARG(b)
 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 /* HEADERIZER END: static */
 
@@ -235 +229 @@
 #define ROUND_UP(val, size) (((val) + ((size) - 1))/(size))
 
 /*
+ * offset not in ptr diff, but in byte
+ */
+#define OFFS(cursor) ((const char *)(cursor) - (const char *)(pf->src))
+
+/*
  * low level FLOATVAL fetch and convert functions
  *
  * Floattype 0 = IEEE-754 8 byte double
@@ -274 +273 @@
        exp  11 bits 62-52
        man  52 bits 51-0
 
-         +------+------+------+------+------+------+-...--+------+
-         |byte 0|byte 1|byte 2|byte 3|byte 4|byte 5| ...  |byte12|
-         S|    E       |                F                        |
-         +------+------+------+------+------+------+-...--+------+
-         1|<----15---->|<-------------80 bits------------------->|
-         <-----------------------96 bits------------------------->
-              12-byte LONG DOUBLE FLOATING-POINT (i386 special)
-
-         +------+------+------+------+------+------+------+------+
-         |byte 0|byte 1|byte 2|byte 3|byte 4|byte 5|byte 6|byte 7|
-         S|    E   |                    F                        |
-         +------+------+------+------+------+------+------+------+
-         1|<--11-->|<-----------------52 bits------------------->|
-         <-----------------------64 bits------------------------->
-                 8-byte DOUBLE FLOATING-POINT
+    +-------+-------+-------+-------+-------+-------+--...--+-------+
+    |src[11]|src[10]|src[9] |src[8] |src[7] |src[6] | ...   |src[0] |
+    S|     E        |                    F                          |
+    +-------+-------+-------+-------+-------+-------+--...--+-------+
+    1|<-----15----->|<----------------80 bits---------------------->|
+    <----------------------------96 bits---------------------------->
+
+    +-------+-------+-------+-------+-------+-------+-------+-------+
+    |dest[7]|dest[6]|dest[5]|dest[4]|dest[3]|dest[2]|dest[1]|dest[0]|
+    S|    E    |                           F                        |
+    +-------+-------+-------+-------+-------+-------+-------+-------+
+    1|<---11-->|<---------------------52 bits---------------------->|
+    <----------------------------64 bits---------------------------->
+                       8-byte DOUBLE FLOATING-POINT
     */
+
     memset(dest, 0, 8);
     /* exponents 15 -> 11 bits */
     s = src[9] & 0x80; /* sign */
@@ -359 +358 @@
        exp  15 bits 94-80
        man  80 bits 79-0
 
-         +------+------+------+------+------+------+-...--+------+
-         |byte 0|byte 1|byte 2|byte 3|byte 4|byte 5| ...  |byte15|
-         S|    E       |                  F                      |
-         +------+------+------+------+------+------+-...--+------+
-         1|<----15---->|<-------------112 bits------------------>|
-         <-----------------------128 bits------------------------>
+    +-------+-------+-------+-------+-------+-------+--...--+-------+
+    |src[15]|src[14]|src[13]|src[12]|src[11]|src[10]| ...   |src[0] |
+    S|     E        |                    F                          |
+    +-------+-------+-------+-------+-------+-------+--...--+-------+
+    1|<-----15----->|<----------------112 bits--------------------->|
+    <---------------------------128 bits---------------------------->
             16-byte LONG DOUBLE FLOATING-POINT (IA64 or BE 64-bit)
 
-         +------+------+------+------+------+------+-...--+------+
-         |byte 0|byte 1|byte 2|byte 3|byte 4|byte 5| ...  |byte11|
-         S|    E       |                F                        |
-         +------+------+------+------+------+------+-...--+------+
-         1|<----15---->|<-------------80 bits------------------->|
-         <-----------------------96 bits------------------------->
+    +-------+-------+-------+-------+-------+-------+--...--+-------+
+    |dest[11]dest[10]dest[9]|dest[8]|dest[7]|dest[6]| ...   |dest[0]|
+    S|     E        |                    F                          |
+    +-------+-------+-------+-------+-------+-------+--...--+-------+
+    1|<-----15----->|<----------------80 bits---------------------->|
+    <----------------------------96 bits---------------------------->
               12-byte LONG DOUBLE FLOATING-POINT (i386 special)
 
     */
@@ -395 +394 @@
 
 Converts i386 LE 12-byte long double to IEEE 754 LE 16-byte long double.
 
-TODO: Inaccurate implementation 12->8->16. Need to follow cvt_num12_num8
-See http://babbage.cs.qc.cuny.edu/IEEE-754/References.xhtml
+TODO: Inaccurate implementation 12->8->16. Need to disect.
 
 =cut
 
 */
 
+#if (NUMVAL_SIZE == 16)
 static void
 cvt_num12_num16(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 {
@@ -410 +409 @@
     cvt_num12_num8(b, src);
     cvt_num8_num16(dest, b);
 }
-
+#endif
 /*
 
 =item C<static void cvt_num16_num8>
 
 Converts IEEE 754 16-byte long double to IEEE 754 8 byte double.
 
-Fails on longdoublesize=12 with fatal exception.
-Untested on longdoublesize=16.
+Tested ok.
 
 =cut
 
@@ -429 +427 @@
 {
     ASSERT_ARGS(cvt_num16_num8)
 
-#if NUMVAL_SIZE == 16
+    if ((sizeof (long double) == 16) && (sizeof (double) == 8)) {
 
-    /* The compiler can do this for us */
-    long double ld;
-    double d;
-    memcpy(&d, src, 8);
-    ld = (long double)d; /* TODO: test compiler cast */
-    TRACE_PRINTF_2(("  cvt_num16_num8: ld=%lf, d=%f\n", ld, d));
-    memcpy(dest, &ld, 16);
+        long double ld;
+        double d;
 
-#else
+        memcpy(&ld, src, 16);
+        d = (double)ld; /* compiler cast */
+        memcpy(dest, &d, 8);
 
-    int expo, i, s;
-#  ifdef __LCC__
-    int expo2;
-#  endif
+    }
+    else {
+
+        int expo, i, s;
+#ifdef __LCC__
+        int expo2;
+#endif
 
-    /* TODO: Have only 12-byte long double, need to disect it */
-    exit_fatal(1, "TODO cvt_num16_num8\n");
+    /* Have only 12-byte long double, or no long double at all. Need to disect it */
 
     /*
        16-byte double (128 bits):
@@ -459 +456 @@
        exp  11 bits 62-52
        man  52 bits 51-0
 
-         +------+------+------+------+------+------+-...--+------+
-         |byte 0|byte 1|byte 2|byte 3|byte 4|byte 5| ...  |byte15|
-         S|    E       |                  F                      |
-         +------+------+------+------+------+------+-...--+------+
-         1|<----15---->|<-------------112 bits------------------>|
-         <-----------------------128 bits------------------------>
+    +-------+-------+-------+-------+-------+-------+--...--+-------+
+    |src[15]|src[14]|src[13]|src[12]|src[11]|src[10]| ...   |src[0] |
+    S|     E        |                    F                          |
+    +-------+-------+-------+-------+-------+-------+--...--+-------+
+    1|<-----15----->|<----------------112 bits--------------------->|
+    <---------------------------128 bits---------------------------->
             16-byte LONG DOUBLE FLOATING-POINT (IA64 or BE 64-bit)
 
-         +------+------+------+------+------+------+------+------+
-         |byte 0|byte 1|byte 2|byte 3|byte 4|byte 5|byte 6|byte 7|
-         S|    E   |                    F                        |
-         +------+------+------+------+------+------+------+------+
-         1|<--11-->|<-----------------52 bits------------------->|
-         <-----------------------64 bits------------------------->
-                 8-byte DOUBLE FLOATING-POINT
+    +-------+-------+-------+-------+-------+-------+-------+-------+
+    |dest[7]|dest[6]|dest[5]|dest[4]|dest[3]|dest[2]|dest[1]|dest[0]|
+    S|    E    |                           F                        |
+    +-------+-------+-------+-------+-------+-------+-------+-------+
+    1|<---11-->|<---------------------52 bits---------------------->|
+    <----------------------------64 bits---------------------------->
+                       8-byte DOUBLE FLOATING-POINT
+
    */
 
-    memset(dest, 0, 16);
-    s = src[15] & 0x80; /* 10000000 */
-    /* 15->8 exponents bits */
-    expo = ((src[15] & 0x7f)<< 8 | src[14]);
-    if (expo == 0) {
-nul:
+        memset(dest, 0, 8);
+        s = src[15] & 0x80; /* 10000000 */
+        /* 15->11 exponents bits */
+        expo = ((src[15] & 0x7f)<< 8 | src[14]);
+        if (expo == 0) {
+          nul:
+            if (s)
+                dest[7] |= 0x80;
+            return;
+        }
+#ifdef __LCC__
+        /* LCC blows up mysteriously until a temporary variable is
+         * added. */
+        expo2 = expo - 16383;
+        expo  = expo2;
+#else
+        expo -= 16383;       /* - same bias as with 12-byte */
+#endif
+        expo += 1023;       /* + bias 8byte */
+        if (expo <= 0)       /* underflow */
+            goto nul;
+        if (expo > 0x7ff) {  /* inf/nan */
+            dest[7] = 0x7f;
+            dest[6] = src[7] == 0xc0 ? 0xf8 : 0xf0 ;
+            goto nul;
+        }
+        expo <<= 4;
+        dest[6] = (expo & 0xff);
+        dest[7] = (expo & 0x7f00) >> 8;
         if (s)
             dest[7] |= 0x80;
-        return;
-    }
-#  ifdef __LCC__
-    /* LCC blows up mysteriously until a temporary variable is
-     * added. */
-    expo2 = expo - 16383;
-    expo  = expo2;
-#  else
-    expo -= 16383;       /* - same bias as with 12-byte */
-#  endif
-    expo += 1023;       /* + bias 8byte */
-    if (expo <= 0)       /* underflow */
-        goto nul;
-    if (expo > 0x7ff) {  /* inf/nan */
-        dest[7] = 0x7f;
-        dest[6] = src[7] == 0xc0 ? 0xf8 : 0xf0 ;
-        goto nul;
-    }
-    expo <<= 4;
-    dest[6] = (expo & 0xff);
-    dest[7] = (expo & 0x7f00) >> 8;
-    if (s)
-        dest[7] |= 0x80;
-    /* long double frac 63 bits => 52 bits
-       src[7] &= 0x7f; reset integer bit */
-    for (i = 0; i < 6; i++) {
-        dest[i+1] |= (i==5 ? src[7]&0x7f : src[i+2]) >> 3;
-        dest[i] |= (src[i+2] & 0x1f) << 5;
+        /* long double frac 112 bits => 52 bits
+           src[13] &= 0x7f; reset integer bit */
+        for (i = 0; i < 6; i++) {
+            dest[i+1] |= (i==5 ? src[13]&0x7f : src[i+7]) >> 3;
+            dest[i] |= (src[i+7] & 0x1f) << 5;
+        }
+        dest[0] |= src[1] >> 3;
     }
-    dest[0] |= src[1] >> 3;
-
-#endif
 }
 
 /*
@@ -530 +527 @@
 
 */
 
+#if (NUMVAL_SIZE == 16)
 static void
 cvt_num8_num16(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 {
@@ -542 +540 @@
     TRACE_PRINTF_2(("  cvt_num8_num16: d=%f, ld=%lf\n", d, ld));
     memcpy(dest, &ld, 16);
 }
+#endif
 
 /*
 
@@ -576 +575 @@
 
 Converts a big-endian IEEE 754 8-byte double to i386 LE 12-byte long double.
 
-Untested.
+Tested ok.
 
 =cut
 
@@ -588 +587 @@
 {
     ASSERT_ARGS(cvt_num8_num12_be)
     unsigned char b[8];
-    fetch_buf_be_8(b, src);  /* TODO test endianize */
-    TRACE_PRINTF_2(("  cvt_num8_num12_be: 0x%8x\n", b));
+    fetch_buf_be_8(b, src);
+    /*TRACE_PRINTF_2(("  cvt_num8_num12_be: 0x%8x\n", b));*/
     cvt_num8_num12(dest, b);
 }
 #endif
@@ -752 +751 @@
 
 */
 
+#if (NUMVAL_SIZE == 16) && !PARROT_BIGENDIAN
 static void
 cvt_num8_num16_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 {
@@ -760 +760 @@
     fetch_buf_be_8(b, src);
     cvt_num8_num16(dest, b);
 }
+#endif
 
-/*
-
-=item C<static opcode_t fetch_op_test>
-
-Fetches an C<opcode_t> operation in little-endian format.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-static opcode_t
-fetch_op_test(ARGIN(const unsigned char *b))
-{
-    ASSERT_ARGS(fetch_op_test)
-    union {
-        unsigned char buf[4];
-        opcode_t o;
-    } u;
-    fetch_buf_le_4(u.buf, b);
-    return u.o;
-}
+#if 0
 
 /*
 
@@ -803 +783 @@
 fetch_op_mixed_le(ARGIN(const unsigned char *b))
 {
     ASSERT_ARGS(fetch_op_mixed_le)
-#if OPCODE_T_SIZE == 4
+#  if OPCODE_T_SIZE == 4
     union {
         unsigned char buf[8];
         opcode_t o[2];
@@ -811 +791 @@
     /* wordsize = 8 then */
     fetch_buf_le_8(u.buf, b);
     return u.o[0]; /* or u.o[1] */
-#else
+#  else
     union {
         unsigned char buf[4];
         opcode_t o;
@@ -821 +801 @@
     u.o = 0;
     fetch_buf_le_4(u.buf, b);
     return u.o;
-#endif
+#  endif
 }
 
 /*
@@ -840 +820 @@
 fetch_op_mixed_be(ARGIN(const unsigned char *b))
 {
     ASSERT_ARGS(fetch_op_mixed_be)
-#if OPCODE_T_SIZE == 4
+#  if OPCODE_T_SIZE == 4
     union {
         unsigned char buf[8];
         opcode_t o[2];
@@ -848 +828 @@
     /* wordsize = 8 then */
     fetch_buf_be_8(u.buf, b);
     return u.o[1]; /* or u.o[0] */
-#else
+#  else
     union {
         unsigned char buf[4];
         opcode_t o;
@@ -857 +837 @@
     u.o = 0;
     fetch_buf_be_4(u.buf, b);
     return u.o;
-#endif
+#  endif
 }
 
+#endif
+
 /*
 
 =item C<static opcode_t fetch_op_be_4>
@@ -998 +980 @@
 
 Fetches an C<opcode_t> from the stream, converting byteorder if needed.
 
+When used for freeze/thaw the C<pf> argument might be NULL.
+
 =cut
 
 */
@@ -1009 +993 @@
 {
     ASSERT_ARGS(PF_fetch_opcode)
     opcode_t o;
+
+    CHECK_PTR_ALIGNMENT(*stream, "PF_fetch_opcode");
+    PARROT_ASSERT((PTR2INTVAL(*stream) & (PARROT_PTR_ALIGNMENT - 1)) == 0);
     if (!pf || !pf->fetch_op)
         return *(*stream)++;
     o = (pf->fetch_op)(*((const unsigned char **)stream));
+    TRACE_PRINTF_VAL(("  PF_fetch_opcode: 0x%lx (%ld), at 0x%x\n",
+                      o, o, OFFS(*stream)));
     *((const unsigned char **) (stream)) += pf->header->wordsize;
-    TRACE_PRINTF_VAL(("  PF_fetch_opcode: 0x%lx (%ld)\n", o, o));
+    CHECK_PTR_ALIGNMENT(*stream, "PF_fetch_opcode after padding");
     return o;
 }
 
@@ -1065 +1054 @@
 XXX assumes C<sizeof (INTVAL) == sizeof (opcode_t)> - we don't have
 C<INTVAL> size in the PackFile header.
 
+When used for freeze/thaw the C<pf> argument might be NULL.
+
 =cut
 
 */
@@ -1075 +1066 @@
 {
     ASSERT_ARGS(PF_fetch_integer)
     INTVAL i;
+    CHECK_PTR_ALIGNMENT(*stream, "PF_fetch_integer");
     if (!pf || pf->fetch_iv == NULL)
         return *(*stream)++;
     i = (pf->fetch_iv)(*((const unsigned char **)stream));
-
+    TRACE_PRINTF_VAL(("  PF_fetch_integer: 0x%x (%d) at 0x%x\n", i, i,
+                      OFFS(*stream)));
     /* XXX assume sizeof (opcode_t) == sizeof (INTVAL) on the
-     * machine producing this PBC
+     * machine producing this PBC.
+     *
+     * TT #364 on Sparc 64bit: On pbc wordsize=4 but native ptrsize=8 and ptr_alignment=8
+     * the advance by 4 will signal BUS (invalid address alignment) in PF_fetch_integer
+     * http://nopaste.snit.ch/15684. It even fails natively by some PMC thaw misalignment
+     * at the innocent *(*stream)++ above.
      */
     *((const unsigned char **) (stream)) += pf->header->wordsize;
+    CHECK_PTR_ALIGNMENT(*stream, "PF_fetch_integer after padding");
     return i;
 }
 
@@ -1145 +1144 @@
      * to use memcpy() for native byteorder.  */
     FLOATVAL f;
     double d;
+
+    CHECK_PTR_ALIGNMENT(*stream, "PF_fetch_number");
     if (!pf || !pf->fetch_nv) {
         TRACE_PRINTF(("PF_fetch_number: Native [%d bytes]\n",
                       sizeof (FLOATVAL)));
         memcpy(&f, (const char *)*stream, sizeof (FLOATVAL));
-        TRACE_PRINTF_VAL(("PF_fetch_number: %f\n", f));
+        TRACE_PRINTF_VAL(("PF_fetch_number: %f at 0x%x\n", f, OFFS(*stream)));
         (*stream) += (sizeof (FLOATVAL) + sizeof (opcode_t) - 1)/
             sizeof (opcode_t);
+        CHECK_PTR_ALIGNMENT(*stream, "PF_fetch_number after padding");
         return f;
     }
     f = (FLOATVAL) 0;
-    TRACE_PRINTF(("PF_fetch_number: Converting...\n"));
+    TRACE_PRINTF(("PF_fetch_number at 0x%x: Converting...\n", OFFS(*stream)));
     /* 12->8 has a messy cast. */
     if (NUMVAL_SIZE == 8 && pf->header->floattype == FLOATTYPE_12) {
         (pf->fetch_nv)((unsigned char *)&d, (const unsigned char *) *stream);
@@ -1175 +1177 @@
     else if (pf->header->floattype == FLOATTYPE_16) {
         *((const unsigned char **) (stream)) += 16;
     }
+    else if (pf->header->floattype == FLOATTYPE_16MIPS) {
+        *((const unsigned char **) (stream)) += 16;
+    }
+    else if (pf->header->floattype == FLOATTYPE_16AIX) {
+        *((const unsigned char **) (stream)) += 16;
+    }
+    else if (pf->header->floattype == FLOATTYPE_4) {
+        *((const unsigned char **) (stream)) += 4;
+    }
+    CHECK_PTR_ALIGNMENT(*stream, "PF_fetch_number after (no padding)");
     return f;
 }
 
@@ -1233 +1245 @@
     opcode_t size
     * data
 
+When used for freeze/thaw the C<pf> argument might be NULL.
+
 =cut
 
 */
@@ -1250 +1264 @@
     const int wordsize = pf ? pf->header->wordsize : sizeof (opcode_t);
     const char *charset_name;
 
+    CHECK_PTR_ALIGNMENT(*cursor, "PF_fetch_string");
     flags = PF_fetch_opcode(pf, cursor);
     /* don't let PBC mess our internals - only constant or not */
     flags &= (PObj_constant_FLAG | PObj_private7_FLAG);
@@ -1257 +1272 @@
 
     /* These may need to be separate */
     size = (size_t)PF_fetch_opcode(pf, cursor);
-    TRACE_PRINTF(("PF_fetch_string(): flags are 0x%04x...\n", flags));
-    TRACE_PRINTF(("PF_fetch_string(): charset_nr is %ld...\n",
-                  charset_nr));
-    TRACE_PRINTF(("PF_fetch_string(): size is %ld...\n", size));
-
+#if TRACE_PACKFILE
+    if (pf && pf->options & 2) {
+        TRACE_PRINTF(("PF_fetch_string(): flags=0x%04x, ", flags));
+        TRACE_PRINTF(("charset_nr=%ld, ", charset_nr));
+        TRACE_PRINTF(("size=%ld.\n", size));
+    }
+#endif
     charset_name = Parrot_charset_c_name(interp, charset_nr);
     s = string_make(interp, (const char *)*cursor, size, charset_name, flags);
 
 #if TRACE_PACKFILE == 2
-    if (pf->options & 3) {
+    if (pf->options & 8) {
         /* print only printable characters */
-        Parrot_io_eprintf(NULL, "PF_fetch_string(): string is '%s'\n", s->strstart);
+        Parrot_io_eprintf(NULL, "PF_fetch_string(): string is '%s' at 0x%x\n",
+                          s->strstart, OFFS(*cursor));
     }
 #endif
 
 /*    s = string_make(interp, *cursor, size,
             encoding_lookup_index(encoding),
                                flags); */
-
+    TRACE_PRINTF_ALIGN(("-s ROUND_UP_B: cursor=0x%x, size=%d, wordsize=%d\n",
+                        (const char *)*cursor + size, size, wordsize));
     size = ROUND_UP_B(size, wordsize);
     TRACE_PRINTF(("PF_fetch_string(): round size up to %ld.\n", size));
     *((const unsigned char **) (cursor)) += size;
+    TRACE_PRINTF_ALIGN(("+s ROUND_UP_B: cursor=0x%x, size=%d\n", *cursor, size));
+    CHECK_PTR_ALIGNMENT(*cursor, "PF_fetch_string after padding");
     return s;
 }
 
@@ -1386 +1407 @@
     ASSERT_ARGS(PF_fetch_cstring)
     const size_t str_len = strlen((const char *)(*cursor)) + 1;
     char * const p = (char *)mem_sys_allocate(str_len);
-
     const int wordsize = pf->header->wordsize;
 
+    CHECK_PTR_ALIGNMENT(*cursor, "PF_fetch_cstring");
+
+#if TRACE_PACKFILE
+    if (pf && pf->options & 2) {
+        TRACE_PRINTF(("PF_fetch_cstring(): size is %ld...\n", str_len));
+    }
+#endif
+
     strcpy(p, (const char*) (*cursor));
+#if TRACE_PACKFILE == 2
+    if (pf && pf->options & 8) {
+        TRACE_PRINTF(("PF_fetch_cstring(): string is '%s' at 0x%x\n",
+                      p, OFFS(*cursor)));
+    }
+#endif
+    TRACE_PRINTF_ALIGN(("-s ROUND_UP_B: cursor=0x%x, size=%d, wordsize=%d (cstring)\n",
+                        *cursor, str_len, wordsize));
+    /* TT #254 need 32/64bit ptr advance correction */
+    /*(*cursor) += (ROUND_UP_B(str_len, wordsize) + sizeof (opcode_t) - 1)/sizeof (opcode_t);*/
     *((const unsigned char **) (cursor)) += ROUND_UP_B(str_len, wordsize);
+    TRACE_PRINTF_ALIGN(("+s ROUND_UP_B: cursor=0x%x\n",
+                        *cursor));
+    CHECK_PTR_ALIGNMENT(*cursor, "PF_fetch_cstring after padding");
 
     return p;
 }
@@ -1466 +1507 @@
             pf->fetch_op = fetch_op_le_8;
         pf->fetch_iv = pf->fetch_op;
 
+        pf->fetch_iv = pf->fetch_op;
         switch (pf->header->floattype) {
 #  if NUMVAL_SIZE == 8
         case FLOATTYPE_8:

src/pbc_disassemble.c

@@ -85 +85 @@
     Parrot_Interp interp;
     const char *outfile = NULL;
     int option = 0;
-    int debug = 0;
+    int debug = 1;
     struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT;
     int status;
 
@@ -108 +108 @@
                 outfile = opt.opt_arg;
                 break;
             case 'd':
-                debug = 1;
+                debug += 6;
                 break;
             case '?':
             default:

src/pbc_info.c

@@ -70 +70 @@
 
     interp = Parrot_new(NULL);
 
-    pf = Parrot_pbc_read(interp, argv[1], 0);
+    pf = Parrot_pbc_read(interp, argv[1], 1);
 
     /*
      * add some more segments

t/codingstd/c_macro_args.t

@@ -46 +46 @@
         $buf =~ s{ (?:
                        (?: ' (?: \\\\ | \\' | [^'] )* ' )  # remove ' string
                      | (?: " (?: \\\\ | \\" | [^"] )* " )  # remove " string
-                     | /\*[^@] .*? \*/                         # remove C comment
+                     | /\*[^@] .*? \*/                     # remove C comment
                    )
                 }{}gsx;
 
@@ -87 +87 @@
                     next if $macro =~ m/(TEST|SET|CLEAR)$/;
 
                     # skip those two varargs macros, already called as TRACE_PRINTF((args))
-                    next if $macro =~ m/^TRACE_PRINTF(_VAL)?$/;
+                    next if $macro =~ m/^TRACE_PRINTF(_VAL|_ALIGN)?$/;
 
                     # Any remaining usage must be improper
                     if ($definition =~ m/\b\Q$arg\E\b/) {

docs/pdds/pdd13_bytecode.pod

@@ -51 +51 @@
 implemented. This section details these changes and some of the reasoning
 behind them.
 
+=head4 8-byte ptr_alignment
+
+We should be aware that some systems such as a Sparc/PPC 64-bit use strict
+8-byte ptr_alignment per default, and all C<(opcode_t*)cursor++> or
+C<(opcode_t*)cursor +=> advances must ensure that the cursor ptr is 8-byte
+aligned.  We enforce 16-byte alignment at the start and end of all segments
+and ptrsize alignment for all strings, but not in-between, esp. with 4-byte
+integers and 4-byte opcode_t pointers.
+
+Which means that for a 32-bit (4-byte) pbc on a 8-byte ptr_alignment machine
+the pmc designer should take care that integers and opcode_t pointers appear
+pairwise in the frozen format, so that the 16-byte padding at the end of a
+segment already happens on an already 8-byte aligned pointer (<C<xxx0> or
+C<xxx8>), and not on a 4-byte ptr (C<xxx4> or C<xxxc>) alignment. Operations
+on aligned pointers are much faster than on un-aligned pointers.
 
 =head4 Packfile Header
 
@@ -146 +161 @@
   |        |        | Must be one of:                                        |
   |        |        |    0x00 - IEEE 754 8 byte double                       |
   |        |        |    0x01 - i386 little endian 12 byte long double       |
+  |        |        |    0x02 - IEEE 754 16 byte long double                 |
   +--------+--------+--------------------------------------------------------+
   | 11     | 1      | Major version number of the version of Parrot that     |
   |        |        | wrote this bytecode file. For example, if Parrot 0.9.5 |
@@ -170 +186 @@
   | 16     | 1      | The type of the UUID associated with this packfile.    |
   |        |        | Must be one of:                                        |
   |        |        |    0x00 - No UUID                                      |
-  |        |        |    0x01 - MD5                                          |
+  |        |        |    0x01 - MD5 + base64                                 |
   +--------+--------+--------------------------------------------------------+
   | 17     | 1      | Length of the UUID associated with this packfile. May  |
   |        |        | be zero if the type of the UUID is 0x00. Maximum       |
@@ -185 +201 @@
   +--------+--------+--------------------------------------------------------+
   | 18 + u | n      | Zero-padding to make the total header length a         |
   |        |        | multiple of 16 bytes in length.                        |
-  |        |        |    n = u % 16 == 0 ? 0 : 16 - (u % 16)                 |
+  |        |        |    n = u % 16 ? 16 - (u % 16) : 0                      |
   +--------+--------+--------------------------------------------------------+
 
 Everything beyond the header is an opcode, with word length and byte ordering

parrot-svn

@@ -2597 +2597 @@
 t/native_pbc/integer_3.pbc                                  [test]
 t/native_pbc/integer_4.pbc                                  [test]
 t/native_pbc/integer_5.pbc                                  [test]
+t/native_pbc/integer_6.pbc                                  [test]
 t/native_pbc/number.t                                       [test]
 t/native_pbc/number_1.pbc                                   [test]
 t/native_pbc/number_2.pbc                                   [test]
 t/native_pbc/number_3.pbc                                   [test]
 t/native_pbc/number_4.pbc                                   [test]
 t/native_pbc/number_5.pbc                                   [test]
+t/native_pbc/number_6.pbc                                   [test]
 t/native_pbc/string.t                                       [test]
 t/native_pbc/string_1.pbc                                   [test]
 t/native_pbc/string_2.pbc                                   [test]

src/pmc_freeze.c

@@ -558 +558 @@
 {
     ASSERT_ARGS(push_ascii_string)
     const UINTVAL length = Parrot_str_byte_length(interp, s);
-    char * const buffer = (char *)malloc(4*length); /* XXX Why 4?  What does that mean? */
+    char * const buffer = (char *)malloc(OPCODE_T_SIZE*length);
     char *cursor = buffer;
     UINTVAL idx = 0;
 
@@ -1080 +1080 @@
          16 - PACKFILE_HEADER_BYTES % 16 : 0);
 
     info->image_io = mem_allocate_typed(IMAGE_IO);
-    info->image_io->image = s = info->image;
+    info->image_io->image = info->image;
 #if FREEZE_ASCII
     info->image_io->vtable = &ascii_funcs;
 #else
     info->image_io->vtable = &opcode_funcs;
 #endif
     pf = info->image_io->pf = PackFile_new(interp, 0);
+#if TRACE_PACKFILE
+    pf->options = 0; /* 15 to debug freeze */
+#endif
     if (info->what == VISIT_FREEZE_NORMAL ||
         info->what == VISIT_FREEZE_AT_DESTRUCT) {
 
@@ -1216 +1219 @@
     ASSERT_ARGS(thaw_pmc)
     PMC *n;
     IMAGE_IO * const io = info->image_io;
+#if TRACE_PACKFILE
+    PackFile *pf = info->image_io->pf;
+#endif
     int seen = 0;
 
     info->extra_flags = EXTRA_IS_NULL;
     n = VTABLE_shift_pmc(interp, io);
+    TRACE_PRINTF(("thaw_pmc: pmc=0x%x\n", n));
     if (((UINTVAL) n & 3) == 3) {
         /* pmc has extra data */
         info->extra_flags = VTABLE_shift_integer(interp, io);
+        TRACE_PRINTF(("thaw_pmc: pmc extra_flags=0x%x\n", info->extra_flags));
     }
     else if ((UINTVAL) n & 1) {     /* seen PMCs have bit 0 set */
         seen = 1;
@@ -1232 +1240 @@
     }
     else {                          /* type follows */
         *type = VTABLE_shift_integer(interp, io);
+        TRACE_PRINTF(("thaw_pmc: pmc type=%d\n", *type));
         info->last_type = *type;
         if (*type <= 0)
             Parrot_ex_throw_from_c_args(interp, NULL, 1,