src/packfile.c

   1 /*
   2 Copyright (C) 2001-2009, Parrot Foundation.
   3 This program is free software. It is subject to the same license as
   4 Parrot itself.
   5 $Id$
   6
   7 =head1 NAME
   8
   9 src/packfile.c - Parrot PackFile API
  10
  11 =head1 DESCRIPTION
  12
  13 This file contains all the functions required for the processing of the
  14 structure of a PackFile. It is not intended to understand the byte code
  15 stream itself, but merely to dissect and reconstruct data from the
  16 various segments. See F<docs/pdds/pdd13_bytecode.pod> for information
  17 about the structure of the frozen bytecode.
  18
  19 =head2 PackFile Manipulation Functions
  20
  21 =over 4
  22
  23 =cut
  24
  25 */
  26
  27 #include "parrot/parrot.h"
  28 #include "parrot/embed.h"
  29 #include "parrot/extend.h"
  30 #include "parrot/packfile.h"
  31 #include "parrot/runcore_api.h"
  32 #include "../compilers/imcc/imc.h"
  33 #include "packfile.str"
  34 #include "pmc/pmc_sub.h"
  35 #include "pmc/pmc_key.h"
  36 #include "pmc/pmc_context.h"
  37
  38 /* HEADERIZER HFILE: include/parrot/packfile.h */
  39
  40 /* HEADERIZER BEGIN: static */
  41 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  42
  43 static void byte_code_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
  44         __attribute__nonnull__(1)
  45         __attribute__nonnull__(2)
  46         FUNC_MODIFIES(*self);
  47
  48 PARROT_WARN_UNUSED_RESULT
  49 PARROT_CANNOT_RETURN_NULL
  50 static PackFile_Segment * byte_code_new(SHIM_INTERP,
  51     SHIM(PackFile *pf),
  52     SHIM(STRING *name),
  53     SHIM(int add));
  54
  55 PARROT_WARN_UNUSED_RESULT
  56 PARROT_CANNOT_RETURN_NULL
  57 static PackFile_Constant * clone_constant(PARROT_INTERP,
  58     ARGIN(PackFile_Constant *old_const))
  59         __attribute__nonnull__(1)
  60         __attribute__nonnull__(2);
  61
  62 static void compile_or_load_file(PARROT_INTERP,
  63     ARGIN(STRING *path),
  64     enum_runtime_ft file_type)
  65         __attribute__nonnull__(1)
  66         __attribute__nonnull__(2);
  67
  68 static void const_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
  69         __attribute__nonnull__(1)
  70         __attribute__nonnull__(2)
  71         FUNC_MODIFIES(*self);
  72
  73 PARROT_MALLOC
  74 PARROT_CANNOT_RETURN_NULL
  75 static PackFile_Segment * const_new(SHIM_INTERP,
  76     SHIM(PackFile *pf),
  77     SHIM(STRING *name),
  78     SHIM(int add));
  79
  80 PARROT_WARN_UNUSED_RESULT
  81 PARROT_CANNOT_RETURN_NULL
  82 static PackFile_Segment * create_seg(PARROT_INTERP,
  83     ARGMOD(PackFile_Directory *dir),
  84     pack_file_types t,
  85     ARGIN(STRING *name),
  86     ARGIN(STRING *file_name),
  87     int add)
  88         __attribute__nonnull__(1)
  89         __attribute__nonnull__(2)
  90         __attribute__nonnull__(4)
  91         __attribute__nonnull__(5)
  92         FUNC_MODIFIES(*dir);
  93
  94 static void default_destroy(ARGMOD(PackFile_Segment *self))
  95         __attribute__nonnull__(1)
  96         FUNC_MODIFIES(*self);
  97
  98 static void default_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
  99         __attribute__nonnull__(1)
 100         __attribute__nonnull__(2);
 101
 102 PARROT_WARN_UNUSED_RESULT
 103 PARROT_CANNOT_RETURN_NULL
 104 static opcode_t * default_pack(
 105     ARGIN(const PackFile_Segment *self),
 106     ARGOUT(opcode_t *dest))
 107         __attribute__nonnull__(1)
 108         __attribute__nonnull__(2)
 109         FUNC_MODIFIES(*dest);
 110
 111 static size_t default_packed_size(ARGIN(const PackFile_Segment *self))
 112         __attribute__nonnull__(1);
 113
 114 PARROT_WARN_UNUSED_RESULT
 115 PARROT_CAN_RETURN_NULL
 116 static const opcode_t * default_unpack(
 117     ARGMOD(PackFile_Segment *self),
 118     ARGIN(const opcode_t *cursor))
 119         __attribute__nonnull__(1)
 120         __attribute__nonnull__(2)
 121         FUNC_MODIFIES(*self);
 122
 123 static void directory_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
 124         __attribute__nonnull__(1)
 125         __attribute__nonnull__(2)
 126         FUNC_MODIFIES(*self);
 127
 128 static void directory_dump(PARROT_INTERP,
 129     ARGIN(const PackFile_Segment *self))
 130         __attribute__nonnull__(1)
 131         __attribute__nonnull__(2);
 132
 133 PARROT_WARN_UNUSED_RESULT
 134 PARROT_CANNOT_RETURN_NULL
 135 static PackFile_Segment * directory_new(SHIM_INTERP,
 136     SHIM(PackFile *pf),
 137     SHIM(STRING *name),
 138     SHIM(int add));
 139
 140 PARROT_WARN_UNUSED_RESULT
 141 PARROT_CANNOT_RETURN_NULL
 142 static opcode_t * directory_pack(PARROT_INTERP,
 143     ARGIN(PackFile_Segment *self),
 144     ARGOUT(opcode_t *cursor))
 145         __attribute__nonnull__(1)
 146         __attribute__nonnull__(2)
 147         __attribute__nonnull__(3)
 148         FUNC_MODIFIES(*cursor);
 149
 150 PARROT_WARN_UNUSED_RESULT
 151 static size_t directory_packed_size(PARROT_INTERP,
 152     ARGMOD(PackFile_Segment *self))
 153         __attribute__nonnull__(1)
 154         __attribute__nonnull__(2)
 155         FUNC_MODIFIES(*self);
 156
 157 PARROT_WARN_UNUSED_RESULT
 158 PARROT_CANNOT_RETURN_NULL
 159 static const opcode_t * directory_unpack(PARROT_INTERP,
 160     ARGMOD(PackFile_Segment *segp),
 161     ARGIN(const opcode_t *cursor))
 162         __attribute__nonnull__(1)
 163         __attribute__nonnull__(2)
 164         __attribute__nonnull__(3)
 165         FUNC_MODIFIES(*segp);
 166
 167 PARROT_WARN_UNUSED_RESULT
 168 PARROT_CAN_RETURN_NULL
 169 static PMC* do_1_sub_pragma(PARROT_INTERP,
 170     ARGMOD(PMC *sub_pmc),
 171     pbc_action_enum_t action)
 172         __attribute__nonnull__(1)
 173         __attribute__nonnull__(2)
 174         FUNC_MODIFIES(*sub_pmc);
 175
 176 static INTVAL find_const_iter(PARROT_INTERP,
 177     ARGIN(PackFile_Segment *seg),
 178     ARGIN_NULLOK(void *user_data))
 179         __attribute__nonnull__(1)
 180         __attribute__nonnull__(2);
 181
 182 PARROT_WARN_UNUSED_RESULT
 183 PARROT_CANNOT_RETURN_NULL
 184 static PackFile_Constant ** find_constants(PARROT_INTERP,
 185     ARGIN(PackFile_ConstTable *ct))
 186         __attribute__nonnull__(1)
 187         __attribute__nonnull__(2);
 188
 189 PARROT_WARN_UNUSED_RESULT
 190 PARROT_CAN_RETURN_NULL
 191 static PackFile_FixupEntry * find_fixup(
 192     ARGMOD(PackFile_FixupTable *ft),
 193     INTVAL type,
 194     ARGIN(const char *name))
 195         __attribute__nonnull__(1)
 196         __attribute__nonnull__(3)
 197         FUNC_MODIFIES(*ft);
 198
 199 static INTVAL find_fixup_iter(PARROT_INTERP,
 200     ARGIN(PackFile_Segment *seg),
 201     ARGIN(void *user_data))
 202         __attribute__nonnull__(1)
 203         __attribute__nonnull__(2)
 204         __attribute__nonnull__(3);
 205
 206 static void fixup_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
 207         __attribute__nonnull__(1)
 208         __attribute__nonnull__(2)
 209         FUNC_MODIFIES(*self);
 210
 211 PARROT_WARN_UNUSED_RESULT
 212 PARROT_CANNOT_RETURN_NULL
 213 static PackFile_Segment * fixup_new(SHIM_INTERP,
 214     SHIM(PackFile *pf),
 215     SHIM(STRING *name),
 216     SHIM(int add));
 217
 218 PARROT_WARN_UNUSED_RESULT
 219 PARROT_CANNOT_RETURN_NULL
 220 static opcode_t * fixup_pack(PARROT_INTERP,
 221     ARGIN(PackFile_Segment *self),
 222     ARGOUT(opcode_t *cursor))
 223         __attribute__nonnull__(1)
 224         __attribute__nonnull__(2)
 225         __attribute__nonnull__(3)
 226         FUNC_MODIFIES(*cursor);
 227
 228 static size_t fixup_packed_size(PARROT_INTERP,
 229     ARGMOD(PackFile_Segment *self))
 230         __attribute__nonnull__(1)
 231         __attribute__nonnull__(2)
 232         FUNC_MODIFIES(*self);
 233
 234 PARROT_WARN_UNUSED_RESULT
 235 PARROT_CAN_RETURN_NULL
 236 static const opcode_t * fixup_unpack(PARROT_INTERP,
 237     ARGIN(PackFile_Segment *seg),
 238     ARGIN(const opcode_t *cursor))
 239         __attribute__nonnull__(1)
 240         __attribute__nonnull__(2)
 241         __attribute__nonnull__(3);
 242
 243 PARROT_CANNOT_RETURN_NULL
 244 static PMC * make_annotation_value_pmc(PARROT_INTERP,
 245     ARGIN(PackFile_Annotations *self),
 246     INTVAL type,
 247     opcode_t value)
 248         __attribute__nonnull__(1)
 249         __attribute__nonnull__(2);
 250
 251 static void make_code_pointers(ARGMOD(PackFile_Segment *seg))
 252         __attribute__nonnull__(1)
 253         FUNC_MODIFIES(*seg);
 254
 255 static void mark_1_seg(PARROT_INTERP, ARGMOD(PackFile_ConstTable *ct))
 256         __attribute__nonnull__(1)
 257         __attribute__nonnull__(2)
 258         FUNC_MODIFIES(*ct);
 259
 260 PARROT_WARN_UNUSED_RESULT
 261 PARROT_CAN_RETURN_NULL
 262 static PackFile * PackFile_append_pbc(PARROT_INTERP,
 263     ARGIN_NULLOK(const char *filename))
 264         __attribute__nonnull__(1);
 265
 266 static void PackFile_set_header(ARGOUT(PackFile_Header *header))
 267         __attribute__nonnull__(1)
 268         FUNC_MODIFIES(*header);
 269
 270 static void pf_debug_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *self))
 271         __attribute__nonnull__(2)
 272         FUNC_MODIFIES(*self);
 273
 274 static void pf_debug_dump(PARROT_INTERP,
 275     ARGIN(const PackFile_Segment *self))
 276         __attribute__nonnull__(1)
 277         __attribute__nonnull__(2);
 278
 279 PARROT_WARN_UNUSED_RESULT
 280 PARROT_CANNOT_RETURN_NULL
 281 static PackFile_Segment * pf_debug_new(SHIM_INTERP,
 282     SHIM(PackFile *pf),
 283     SHIM(STRING *name),
 284     SHIM(int add));
 285
 286 PARROT_WARN_UNUSED_RESULT
 287 PARROT_CANNOT_RETURN_NULL
 288 static opcode_t * pf_debug_pack(SHIM_INTERP,
 289     ARGMOD(PackFile_Segment *self),
 290     ARGOUT(opcode_t *cursor))
 291         __attribute__nonnull__(2)
 292         __attribute__nonnull__(3)
 293         FUNC_MODIFIES(*self)
 294         FUNC_MODIFIES(*cursor);
 295
 296 static size_t pf_debug_packed_size(SHIM_INTERP,
 297     ARGIN(PackFile_Segment *self))
 298         __attribute__nonnull__(2);
 299
 300 PARROT_WARN_UNUSED_RESULT
 301 PARROT_CANNOT_RETURN_NULL
 302 static const opcode_t * pf_debug_unpack(PARROT_INTERP,
 303     ARGOUT(PackFile_Segment *self),
 304     ARGIN(const opcode_t *cursor))
 305         __attribute__nonnull__(1)
 306         __attribute__nonnull__(2)
 307         __attribute__nonnull__(3)
 308         FUNC_MODIFIES(*self);
 309
 310 static void pf_register_standard_funcs(PARROT_INTERP, ARGMOD(PackFile *pf))
 311         __attribute__nonnull__(1)
 312         __attribute__nonnull__(2)
 313         FUNC_MODIFIES(*pf);
 314
 315 PARROT_IGNORABLE_RESULT
 316 PARROT_CAN_RETURN_NULL
 317 static PMC* run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
 318         __attribute__nonnull__(1)
 319         __attribute__nonnull__(2);
 320
 321 static void segment_init(PARROT_INTERP,
 322     ARGOUT(PackFile_Segment *self),
 323     ARGIN(PackFile *pf),
 324     ARGIN(STRING *name))
 325         __attribute__nonnull__(1)
 326         __attribute__nonnull__(2)
 327         __attribute__nonnull__(3)
 328         __attribute__nonnull__(4)
 329         FUNC_MODIFIES(*self);
 330
 331 static void sort_segs(ARGMOD(PackFile_Directory *dir))
 332         __attribute__nonnull__(1)
 333         FUNC_MODIFIES(*dir);
 334
 335 static int sub_pragma(PARROT_INTERP,
 336     pbc_action_enum_t action,
 337     ARGIN(const PMC *sub_pmc))
 338         __attribute__nonnull__(1)
 339         __attribute__nonnull__(3);
 340
 341 #define ASSERT_ARGS_byte_code_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 342        PARROT_ASSERT_ARG(interp) \
 343     , PARROT_ASSERT_ARG(self))
 344 #define ASSERT_ARGS_byte_code_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 345 #define ASSERT_ARGS_clone_constant __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 346        PARROT_ASSERT_ARG(interp) \
 347     , PARROT_ASSERT_ARG(old_const))
 348 #define ASSERT_ARGS_compile_or_load_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 349        PARROT_ASSERT_ARG(interp) \
 350     , PARROT_ASSERT_ARG(path))
 351 #define ASSERT_ARGS_const_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 352        PARROT_ASSERT_ARG(interp) \
 353     , PARROT_ASSERT_ARG(self))
 354 #define ASSERT_ARGS_const_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 355 #define ASSERT_ARGS_create_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 356        PARROT_ASSERT_ARG(interp) \
 357     , PARROT_ASSERT_ARG(dir) \
 358     , PARROT_ASSERT_ARG(name) \
 359     , PARROT_ASSERT_ARG(file_name))
 360 #define ASSERT_ARGS_default_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 361        PARROT_ASSERT_ARG(self))
 362 #define ASSERT_ARGS_default_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 363        PARROT_ASSERT_ARG(interp) \
 364     , PARROT_ASSERT_ARG(self))
 365 #define ASSERT_ARGS_default_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 366        PARROT_ASSERT_ARG(self) \
 367     , PARROT_ASSERT_ARG(dest))
 368 #define ASSERT_ARGS_default_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 369        PARROT_ASSERT_ARG(self))
 370 #define ASSERT_ARGS_default_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 371        PARROT_ASSERT_ARG(self) \
 372     , PARROT_ASSERT_ARG(cursor))
 373 #define ASSERT_ARGS_directory_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 374        PARROT_ASSERT_ARG(interp) \
 375     , PARROT_ASSERT_ARG(self))
 376 #define ASSERT_ARGS_directory_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 377        PARROT_ASSERT_ARG(interp) \
 378     , PARROT_ASSERT_ARG(self))
 379 #define ASSERT_ARGS_directory_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 380 #define ASSERT_ARGS_directory_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 381        PARROT_ASSERT_ARG(interp) \
 382     , PARROT_ASSERT_ARG(self) \
 383     , PARROT_ASSERT_ARG(cursor))
 384 #define ASSERT_ARGS_directory_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 385        PARROT_ASSERT_ARG(interp) \
 386     , PARROT_ASSERT_ARG(self))
 387 #define ASSERT_ARGS_directory_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 388        PARROT_ASSERT_ARG(interp) \
 389     , PARROT_ASSERT_ARG(segp) \
 390     , PARROT_ASSERT_ARG(cursor))
 391 #define ASSERT_ARGS_do_1_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 392        PARROT_ASSERT_ARG(interp) \
 393     , PARROT_ASSERT_ARG(sub_pmc))
 394 #define ASSERT_ARGS_find_const_iter __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 395        PARROT_ASSERT_ARG(interp) \
 396     , PARROT_ASSERT_ARG(seg))
 397 #define ASSERT_ARGS_find_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 398        PARROT_ASSERT_ARG(interp) \
 399     , PARROT_ASSERT_ARG(ct))
 400 #define ASSERT_ARGS_find_fixup __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 401        PARROT_ASSERT_ARG(ft) \
 402     , PARROT_ASSERT_ARG(name))
 403 #define ASSERT_ARGS_find_fixup_iter __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 404        PARROT_ASSERT_ARG(interp) \
 405     , PARROT_ASSERT_ARG(seg) \
 406     , PARROT_ASSERT_ARG(user_data))
 407 #define ASSERT_ARGS_fixup_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 408        PARROT_ASSERT_ARG(interp) \
 409     , PARROT_ASSERT_ARG(self))
 410 #define ASSERT_ARGS_fixup_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 411 #define ASSERT_ARGS_fixup_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 412        PARROT_ASSERT_ARG(interp) \
 413     , PARROT_ASSERT_ARG(self) \
 414     , PARROT_ASSERT_ARG(cursor))
 415 #define ASSERT_ARGS_fixup_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 416        PARROT_ASSERT_ARG(interp) \
 417     , PARROT_ASSERT_ARG(self))
 418 #define ASSERT_ARGS_fixup_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 419        PARROT_ASSERT_ARG(interp) \
 420     , PARROT_ASSERT_ARG(seg) \
 421     , PARROT_ASSERT_ARG(cursor))
 422 #define ASSERT_ARGS_make_annotation_value_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 423        PARROT_ASSERT_ARG(interp) \
 424     , PARROT_ASSERT_ARG(self))
 425 #define ASSERT_ARGS_make_code_pointers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 426        PARROT_ASSERT_ARG(seg))
 427 #define ASSERT_ARGS_mark_1_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 428        PARROT_ASSERT_ARG(interp) \
 429     , PARROT_ASSERT_ARG(ct))
 430 #define ASSERT_ARGS_PackFile_append_pbc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 431        PARROT_ASSERT_ARG(interp))
 432 #define ASSERT_ARGS_PackFile_set_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 433        PARROT_ASSERT_ARG(header))
 434 #define ASSERT_ARGS_pf_debug_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 435        PARROT_ASSERT_ARG(self))
 436 #define ASSERT_ARGS_pf_debug_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 437        PARROT_ASSERT_ARG(interp) \
 438     , PARROT_ASSERT_ARG(self))
 439 #define ASSERT_ARGS_pf_debug_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 440 #define ASSERT_ARGS_pf_debug_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 441        PARROT_ASSERT_ARG(self) \
 442     , PARROT_ASSERT_ARG(cursor))
 443 #define ASSERT_ARGS_pf_debug_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 444        PARROT_ASSERT_ARG(self))
 445 #define ASSERT_ARGS_pf_debug_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 446        PARROT_ASSERT_ARG(interp) \
 447     , PARROT_ASSERT_ARG(self) \
 448     , PARROT_ASSERT_ARG(cursor))
 449 #define ASSERT_ARGS_pf_register_standard_funcs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 450        PARROT_ASSERT_ARG(interp) \
 451     , PARROT_ASSERT_ARG(pf))
 452 #define ASSERT_ARGS_run_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 453        PARROT_ASSERT_ARG(interp) \
 454     , PARROT_ASSERT_ARG(sub_pmc))
 455 #define ASSERT_ARGS_segment_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 456        PARROT_ASSERT_ARG(interp) \
 457     , PARROT_ASSERT_ARG(self) \
 458     , PARROT_ASSERT_ARG(pf) \
 459     , PARROT_ASSERT_ARG(name))
 460 #define ASSERT_ARGS_sort_segs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 461        PARROT_ASSERT_ARG(dir))
 462 #define ASSERT_ARGS_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 463        PARROT_ASSERT_ARG(interp) \
 464     , PARROT_ASSERT_ARG(sub_pmc))
 465 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 466 /* HEADERIZER END: static */
 467
 468 /* offset not in ptr diff, but in byte */
 469 #define OFFS(pf, cursor) ((pf) ? ((const char *)(cursor) - (const char *)((pf)->src)) : 0)
 470 /**
 471  * Possible values for ALIGN_16
 472  *   4 (32bit): 0 1 2 3
 473  *   8 (64bit): 0 1
 474  * e.g. reading 4 byte wordsize on 8 byte wordsize: possible ptrs end in 0 4 8 c.
 475  *   offs(c)/8 => 4/8 = 0 => impossible to align with 8 byte ptr.
 476  * Limitation TT #254: ALIGN_16  may only be used native, e.g. in the writer,
 477  * but not with 64bit reading 32bit!
 478  */
 479 #define ROUND_16(val) (((val) & 0xf) ? 16 - ((val) & 0xf) : 0)
 480 #define ALIGN_16(pf, cursor)                                    \
 481     (cursor) += ROUND_16(OFFS(pf, cursor))/sizeof (opcode_t)
 482 /* pad to 16 in bytes */
 483 #define PAD_16_B(size) ((size) % 16 ? 16 - (size) % 16 : 0)
 484
 485 #if TRACE_PACKFILE
 486
 487 /*
 488
 489 =item C<void Parrot_trace_eprintf(const char *s, ...)>
 490
 491 Print out an error message. Passes arguments directly to C<vfprintf>.
 492
 493 =cut
 494
 495 */
 496
 497 void
 498 Parrot_trace_eprintf(ARGIN(const char *s), ...)
 499 {
 500     ASSERT_ARGS(Parrot_trace_eprintf)
 501     va_list args;
 502     va_start(args, s);
 503     vfprintf(stderr, s, args);
 504     va_end(args);
 505 }
 506 #endif
 507
 508
 509 /*
 510
 511 =item C<void PackFile_destroy(PARROT_INTERP, PackFile *pf)>
 512
 513 Deletes a C<PackFile>.
 514
 515 =cut
 516
 517 */
 518
 519 PARROT_EXPORT
 520 void
 521 PackFile_destroy(PARROT_INTERP, ARGMOD_NULLOK(PackFile *pf))
 522 {
 523     ASSERT_ARGS(PackFile_destroy)
 524     if (!pf) {
 525         Parrot_io_eprintf(NULL, "PackFile_destroy: pf == NULL!\n");
 526         return;
 527     }
 528
 529 #ifdef PARROT_HAS_HEADER_SYSMMAN
 530     if (pf->is_mmap_ped) {
 531         DECL_CONST_CAST;
 532         /* Cast the result to void to avoid a warning with
 533          * some not-so-standard mmap headers
 534          */
 535         munmap((void *)PARROT_const_cast(opcode_t *, pf->src), pf->size);
 536     }
 537 #endif
 538
 539     mem_sys_free(pf->header);
 540     pf->header = NULL;
 541     mem_sys_free(pf->dirp);
 542     pf->dirp   = NULL;
 543     PackFile_Segment_destroy(interp, &pf->directory.base);
 544     return;
 545 }
 546
 547
 548 /*
 549
 550 =item C<static void make_code_pointers(PackFile_Segment *seg)>
 551
 552 Makes compact/shorthand pointers.
 553
 554 The first segments read are the default segments.
 555
 556 =cut
 557
 558 */
 559
 560 static void
 561 make_code_pointers(ARGMOD(PackFile_Segment *seg))
 562 {
 563     ASSERT_ARGS(make_code_pointers)
 564     PackFile * const pf = seg->pf;
 565
 566     switch (seg->type) {
 567         case PF_BYTEC_SEG:
 568             if (!pf->cur_cs)
 569                 pf->cur_cs = (PackFile_ByteCode *)seg;
 570             break;
 571         case PF_FIXUP_SEG:
 572             if (!pf->cur_cs->fixups) {
 573                 pf->cur_cs->fixups       = (PackFile_FixupTable *)seg;
 574                 pf->cur_cs->fixups->code = pf->cur_cs;
 575             }
 576             break;
 577         case PF_CONST_SEG:
 578             if (!pf->cur_cs->const_table) {
 579                 pf->cur_cs->const_table       = (PackFile_ConstTable *)seg;
 580                 pf->cur_cs->const_table->code = pf->cur_cs;
 581             }
 582             break;
 583         case PF_UNKNOWN_SEG:
 584             break;
 585         case PF_DEBUG_SEG:
 586             pf->cur_cs->debugs       = (PackFile_Debug *)seg;
 587             pf->cur_cs->debugs->code = pf->cur_cs;
 588             break;
 589         default:
 590             break;
 591     }
 592 }
 593
 594
 595 /*
 596
 597 =item C<static int sub_pragma(PARROT_INTERP, pbc_action_enum_t action, const PMC
 598 *sub_pmc)>
 599
 600 Checks B<sub_pmc>'s pragmas (e.g. flags like C<:load>, C<:main>, etc.)
 601 returning 1 if the sub should be run for C<action>, a C<pbc_action_enum_t>.
 602
 603 =cut
 604
 605 */
 606
 607 static int
 608 sub_pragma(PARROT_INTERP, pbc_action_enum_t action, ARGIN(const PMC *sub_pmc))
 609 {
 610     ASSERT_ARGS(sub_pragma)
 611
 612     /* Note: the const casting is only needed because of the
 613      * internal details of the Sub_comp macros.
 614      * The assumption is that the TEST versions are in fact const,
 615      * so the casts are safe.
 616      * These casts are a quick fix to allow parrot build with c++,
 617      * a refactor of the macros will be a cleaner solution.  */
 618     DECL_CONST_CAST;
 619     Parrot_Sub_attributes *sub;
 620     int         todo    = 0;
 621     const int   pragmas = PObj_get_FLAGS(sub_pmc) &  SUB_FLAG_PF_MASK
 622                                                   & ~SUB_FLAG_IS_OUTER;
 623     PMC_get_sub(interp, PARROT_const_cast(PMC *, sub_pmc), sub);
 624     if (!pragmas && !Sub_comp_INIT_TEST(sub))
 625         return 0;
 626
 627     switch (action) {
 628         case PBC_PBC:
 629         case PBC_MAIN:
 630             /* denote MAIN entry in first loaded PASM */
 631             if (interp->resume_flag & RESUME_INITIAL)
 632                 todo = 1;
 633
 634             /* :init functions need to be called at MAIN time, so return 1 */
 635             /* symreg.h:P_INIT */
 636             if (Sub_comp_INIT_TEST(sub))
 637                 todo = 1;
 638
 639             break;
 640         case PBC_LOADED:
 641             /* symreg.h:P_LOAD */
 642             if (pragmas & SUB_FLAG_PF_LOAD)
 643                 todo = 1;
 644             break;
 645         default:
 646             break;
 647     }
 648
 649     if (pragmas & (SUB_FLAG_PF_IMMEDIATE | SUB_FLAG_PF_POSTCOMP))
 650         todo = 1;
 651
 652     return todo;
 653 }
 654
 655
 656 /*
 657
 658 =item C<static PMC* run_sub(PARROT_INTERP, PMC *sub_pmc)>
 659
 660 Runs the B<sub_pmc> due to its B<:load>, B<:immediate>, ... pragma
 661
 662 =cut
 663
 664 */
 665
 666 PARROT_IGNORABLE_RESULT
 667 PARROT_CAN_RETURN_NULL
 668 static PMC*
 669 run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
 670 {
 671     ASSERT_ARGS(run_sub)
 672     Parrot_runcore_t *old_core = interp->run_core;
 673     PMC              *retval   = PMCNULL;
 674
 675     /* turn off JIT and prederef - both would act on the whole
 676      * PackFile which probably isn't worth the effort */
 677     if (PARROT_RUNCORE_JIT_OPS_TEST(interp->run_core)
 678     ||  PARROT_RUNCORE_PREDEREF_OPS_TEST(interp->run_core))
 679         Parrot_runcore_switch(interp, CONST_STRING(interp, "fast"));
 680
 681     Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp),
 682             interp->code->const_table->constants);
 683
 684     Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->P", &retval);
 685     interp->run_core = old_core;
 686
 687     return retval;
 688 }
 689
 690
 691 /*
 692
 693 =item C<static PMC* do_1_sub_pragma(PARROT_INTERP, PMC *sub_pmc,
 694 pbc_action_enum_t action)>
 695
 696 Runs autoloaded or immediate bytecode, marking the MAIN subroutine entry.
 697
 698 =cut
 699
 700 */
 701
 702 PARROT_WARN_UNUSED_RESULT
 703 PARROT_CAN_RETURN_NULL
 704 static PMC*
 705 do_1_sub_pragma(PARROT_INTERP, ARGMOD(PMC *sub_pmc), pbc_action_enum_t action)
 706 {
 707     ASSERT_ARGS(do_1_sub_pragma)
 708     Parrot_Sub_attributes *sub;
 709     PMC_get_sub(interp, sub_pmc, sub);
 710
 711     switch (action) {
 712         case PBC_IMMEDIATE:
 713             /* run IMMEDIATE sub */
 714             if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_IMMEDIATE) {
 715                 void *lo_var_ptr = interp->lo_var_ptr;
 716                 PMC  *result;
 717
 718                 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_IMMEDIATE;
 719                 result     = run_sub(interp, sub_pmc);
 720
 721                 /* reset initial flag so MAIN detection works
 722                  * and reset lo_var_ptr to prev */
 723                 interp->resume_flag = RESUME_INITIAL;
 724                 interp->lo_var_ptr  = lo_var_ptr;
 725                 return result;
 726             }
 727             break;
 728         case PBC_POSTCOMP:
 729             /* run POSTCOMP sub */
 730             if (PObj_get_FLAGS(sub_pmc) &   SUB_FLAG_PF_POSTCOMP) {
 731                 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_POSTCOMP;
 732                 run_sub(interp, sub_pmc);
 733
 734                 /* reset initial flag so MAIN detection works */
 735                 interp->resume_flag = RESUME_INITIAL;
 736                 return NULL;
 737             }
 738             break;
 739
 740         case PBC_LOADED:
 741             if (PObj_get_FLAGS(sub_pmc) &   SUB_FLAG_PF_LOAD) {
 742                 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
 743
 744                 /* if loaded no need for init */
 745                 Sub_comp_INIT_CLEAR(sub);
 746                 run_sub(interp, sub_pmc);
 747             }
 748             break;
 749         default:
 750             if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MAIN) {
 751                 if ((interp->resume_flag   &  RESUME_INITIAL)
 752                 &&   interp->resume_offset == 0) {
 753                     void           *ptr   = VTABLE_get_pointer(interp, sub_pmc);
 754                     const ptrdiff_t code  = (ptrdiff_t) sub->seg->base.data;
 755
 756                     interp->resume_offset = ((ptrdiff_t)ptr - code)
 757                                           / sizeof (opcode_t *);
 758
 759                     PObj_get_FLAGS(sub_pmc)      &= ~SUB_FLAG_PF_MAIN;
 760                     Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
 761                 }
 762                 else {
 763                     Parrot_warn(interp, PARROT_WARNINGS_ALL_FLAG,
 764                                 ":main sub not allowed\n");
 765                 }
 766             }
 767
 768             /* run :init tagged functions */
 769             if (action == PBC_MAIN && Sub_comp_INIT_TEST(sub)) {
 770                 /* if loaded no need for init */
 771                 Sub_comp_INIT_CLEAR(sub);
 772
 773                 /* if inited no need for load */
 774                 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
 775
 776                 run_sub(interp, sub_pmc);
 777                 interp->resume_flag = RESUME_INITIAL;
 778             }
 779             break;
 780     }
 781
 782     return NULL;
 783 }
 784
 785
 786 /*
 787
 788 =item C<static void mark_1_seg(PARROT_INTERP, PackFile_ConstTable *ct)>
 789
 790 While the PMCs should be constant, their possible contents such as
 791 properties aren't constructed const, so we have to mark them.
 792
 793 =cut
 794
 795 */
 796
 797 static void
 798 mark_1_seg(PARROT_INTERP, ARGMOD(PackFile_ConstTable *ct))
 799 {
 800     ASSERT_ARGS(mark_1_seg)
 801     PackFile_Constant ** const constants = find_constants(interp, ct);
 802     opcode_t i;
 803
 804     for (i = 0; i < ct->const_count; i++) {
 805         PMC    * pmc;
 806         STRING * string;
 807         switch (constants[i]->type) {
 808             case PFC_PMC:
 809             case PFC_KEY:
 810                 pmc = constants[i]->u.key;
 811                 Parrot_gc_mark_PMC_alive(interp, pmc);
 812                 break;
 813             case PFC_STRING:
 814                 string = constants[i]->u.string;
 815                 Parrot_gc_mark_STRING_alive(interp, string);
 816                 break;
 817             default:
 818                 /* Do nothing. */
 819                 break;
 820         }
 821     }
 822 }
 823
 824
 825 /*
 826
 827 =item C<static INTVAL find_const_iter(PARROT_INTERP, PackFile_Segment *seg, void
 828 *user_data)>
 829
 830 Iterates over a PackFile_Directory, marking any constant segments.  Internal
 831 use only.
 832
 833 =cut
 834
 835 */
 836
 837 static INTVAL
 838 find_const_iter(PARROT_INTERP, ARGIN(PackFile_Segment *seg),
 839                                ARGIN_NULLOK(void *user_data))
 840 {
 841     ASSERT_ARGS(find_const_iter)
 842     if (seg->type == PF_DIR_SEG)
 843         PackFile_map_segments(interp, (const PackFile_Directory *)seg,
 844                 find_const_iter, user_data);
 845     else if (seg->type == PF_CONST_SEG)
 846         mark_1_seg(interp, (PackFile_ConstTable *)seg);
 847
 848     return 0;
 849 }
 850
 851
 852 /*
 853
 854 =item C<void mark_const_subs(PARROT_INTERP)>
 855
 856 Iterates over all directories and PackFile_Segments, finding and marking any
 857 constant Subs.
 858
 859 =cut
 860
 861 */
 862
 863 void
 864 mark_const_subs(PARROT_INTERP)
 865 {
 866     ASSERT_ARGS(mark_const_subs)
 867     PackFile_Directory *dir;
 868
 869     PackFile * const self = interp->initial_pf;
 870
 871     if (!self)
 872         return;
 873
 874     /* locate top level dir */
 875     dir = &self->directory;
 876
 877     /* iterate over all dir/segs */
 878     PackFile_map_segments(interp, dir, find_const_iter, NULL);
 879 }
 880
 881
 882 /*
 883
 884 =item C<void do_sub_pragmas(PARROT_INTERP, PackFile_ByteCode *self,
 885 pbc_action_enum_t action, PMC *eval_pmc)>
 886
 887 C<action> is one of C<PBC_PBC>, C<PBC_LOADED>, C<PBC_INIT>, or C<PBC_MAIN>.
 888 These determine which subs get executed at this point. Some rules:
 889
 890  :immediate subs always execute immediately
 891  :postcomp subs always execute immediately
 892  :main subs execute when we have the PBC_MAIN or PBC_PBC actions
 893  :init subs execute when :main does
 894  :load subs execute on PBC_LOAD
 895
 896 Also store the C<eval_pmc> in the sub structure, so that the eval PMC is kept
 897 alive by living subs.
 898
 899 =cut
 900
 901 */
 902
 903 PARROT_EXPORT
 904 void
 905 do_sub_pragmas(PARROT_INTERP, ARGIN(PackFile_ByteCode *self),
 906                pbc_action_enum_t action, ARGIN_NULLOK(PMC *eval_pmc))
 907 {
 908     ASSERT_ARGS(do_sub_pragmas)
 909     PackFile_FixupTable * const ft = self->fixups;
 910     PackFile_ConstTable * const ct = self->const_table;
 911     opcode_t i;
 912
 913     TRACE_PRINTF(("PackFile: do_sub_pragmas (action=%d)\n", action));
 914
 915     for (i = 0; i < ft->fixup_count; i++) {
 916         switch (ft->fixups[i]->type) {
 917             case enum_fixup_sub:
 918             {
 919                 /* offset is an index into const_table holding the Sub PMC */
 920                 PMC           *sub_pmc;
 921                 Parrot_Sub_attributes    *sub;
 922                 const opcode_t ci = ft->fixups[i]->offset;
 923
 924                 if (ci < 0 || ci >= ct->const_count)
 925                     Parrot_ex_throw_from_c_args(interp, NULL, 1,
 926                         "Illegal fixup offset (%d) in enum_fixup_sub");
 927
 928                 sub_pmc       = ct->constants[ci]->u.key;
 929                 PMC_get_sub(interp, sub_pmc, sub);
 930                 sub->eval_pmc = eval_pmc;
 931
 932                 if (((PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK)
 933                 ||   (Sub_comp_get_FLAGS(sub) & SUB_COMP_FLAG_MASK))
 934                 &&    sub_pragma(interp, action, sub_pmc)) {
 935                     PMC * const result = do_1_sub_pragma(interp, sub_pmc,
 936                                                          action);
 937
 938                     /* replace Sub PMC with computation results */
 939                     if (action == PBC_IMMEDIATE && !PMC_IS_NULL(result)) {
 940                         ft->fixups[i]->type      = enum_fixup_none;
 941                         ct->constants[ci]->u.key = result;
 942                     }
 943                 }
 944
 945                 break;
 946             }
 947             default:
 948                 break;
 949         }
 950     }
 951 }
 952
 953
 954 /*
 955
 956 =item C<opcode_t PackFile_unpack(PARROT_INTERP, PackFile *self, const opcode_t
 957 *packed, size_t packed_size)>
 958
 959 Unpacks a C<PackFile> from a block of memory, ensuring that the magic number is
 960 valid and that Parrot can read this bytecode version, Parrot, and performing
 961 any required endian and word size transforms.
 962
 963 Returns size of unpacked opcodes if everything is okay, else zero (0).
 964
 965 =cut
 966
 967 */
 968
 969 PARROT_EXPORT
 970 PARROT_WARN_UNUSED_RESULT
 971 opcode_t
 972 PackFile_unpack(PARROT_INTERP, ARGMOD(PackFile *self),
 973     ARGIN(const opcode_t *packed), size_t packed_size)
 974 {
 975     ASSERT_ARGS(PackFile_unpack)
 976     PackFile_Header * const header = self->header;
 977     const opcode_t         *cursor;
 978     int                     header_read_length;
 979     opcode_t                padding;
 980 #if TRACE_PACKFILE
 981     PackFile        * const pf  = self;
 982 #endif
 983
 984     self->src  = packed;
 985     self->size = packed_size;
 986
 987     /* Extract the header. */
 988     memcpy(header, packed, PACKFILE_HEADER_BYTES);
 989
 990     /* Ensure the magic is correct. */
 991     if (memcmp(header->magic, "\376PBC\r\n\032\n", 8) != 0) {
 992         Parrot_io_eprintf(NULL, "PackFile_unpack: "
 993             "This is not a valid Parrot bytecode file\n");
 994         return 0;
 995     }
 996
 997     /* Ensure the bytecode version is one we can read. Currently, we only
 998      * support bytecode versions matching the current one.
 999      *
1000      * tools/dev/pbc_header.pl --upd t/native_pbc/(ASTERISK).pbc
1001      * stamps version and fingerprint in the native tests.
1002      * NOTE: (ASTERISK) is *, we don't want to fool the C preprocessor. */
1003     if (header->bc_major != PARROT_PBC_MAJOR
1004     ||  header->bc_minor != PARROT_PBC_MINOR) {
1005         Parrot_io_eprintf(NULL, "PackFile_unpack: This Parrot cannot read "
1006             "bytecode files with version %d.%d.\n",
1007             header->bc_major, header->bc_minor);
1008         if (!(self->options & PFOPT_UTILS))
1009             return 0;
1010     }
1011
1012     /* Check wordsize, byte order and floating point number type are valid. */
1013     if (header->wordsize != 4 && header->wordsize != 8) {
1014         Parrot_io_eprintf(NULL, "PackFile_unpack: Invalid wordsize %d\n",
1015                     header->wordsize);
1016         return 0;
1017     }
1018
1019     if (header->byteorder != 0 && header->byteorder != 1) {
1020         Parrot_io_eprintf(NULL, "PackFile_unpack: Invalid byte ordering %d\n",
1021                     header->byteorder);
1022         return 0;
1023     }
1024
1025     if (header->floattype > FLOATTYPE_MAX) {
1026         Parrot_io_eprintf(NULL, "PackFile_unpack: Invalid floattype %d\n",
1027                     header->floattype);
1028         return 0;
1029     }
1030
1031     /* Describe what was read for debugging. */
1032     TRACE_PRINTF(("PackFile_unpack: Wordsize %d.\n", header->wordsize));
1033     TRACE_PRINTF(("PackFile_unpack: Floattype %d (%s).\n",
1034                   header->floattype,
1035                   header->floattype == FLOATTYPE_8
1036                       ? FLOATTYPE_8_NAME
1037                       : header->floattype == FLOATTYPE_16
1038                           ? FLOATTYPE_16_NAME
1039                           : FLOATTYPE_12_NAME));
1040     TRACE_PRINTF(("PackFile_unpack: Byteorder %d (%sendian).\n",
1041                   header->byteorder, header->byteorder ? "big " : "little-"));
1042
1043     /* Check the UUID type is valid and, if needed, read a UUID. */
1044     if (header->uuid_type == 0) {
1045         /* No UUID; fine, nothing more to do. */
1046     }
1047     else if (header->uuid_type == 1) {
1048         /* Read in the UUID. We'll put it in a NULL-terminated string, just in
1049          * case people use it that way. */
1050         header->uuid_data = (unsigned char *)
1051             mem_sys_allocate(header->uuid_size + 1);
1052
1053         memcpy(header->uuid_data, packed + PACKFILE_HEADER_BYTES,
1054             header->uuid_size);
1055
1056         /* NULL terminate */
1057         header->uuid_data[header->uuid_size] = '\0';
1058     }
1059     else
1060         /* Don't know this UUID type. */
1061         Parrot_io_eprintf(NULL, "PackFile_unpack: Invalid UUID type %d\n",
1062                     header->uuid_type);
1063
1064     /* Set cursor to position after what we've read, allowing for padding to a
1065      * 16 byte boundary. */
1066     header_read_length  = PACKFILE_HEADER_BYTES + header->uuid_size;
1067     header_read_length += PAD_16_B(header_read_length);
1068     cursor              = packed + (header_read_length / sizeof (opcode_t));
1069     TRACE_PRINTF(("PackFile_unpack: pad=%d\n",
1070                   (char *)cursor - (char *)packed));
1071
1072     /* Set what transforms we need to do when reading the rest of the file. */
1073     PackFile_assign_transforms(self);
1074
1075     /* Directory format. */
1076     header->dir_format = PF_fetch_opcode(self, &cursor);
1077
1078     if (header->dir_format != PF_DIR_FORMAT) {
1079         Parrot_io_eprintf(NULL, "PackFile_unpack: Dir format was %d not %d\n",
1080                     header->dir_format, PF_DIR_FORMAT);
1081         return 0;
1082     }
1083
1084     /* Padding. */
1085     TRACE_PRINTF(("PackFile_unpack: 3 words padding.\n"));
1086     padding = PF_fetch_opcode(self, &cursor);
1087     padding = PF_fetch_opcode(self, &cursor);
1088     padding = PF_fetch_opcode(self, &cursor);
1089     UNUSED(padding);
1090
1091     TRACE_PRINTF(("PackFile_unpack: Directory read, offset %d.\n",
1092                   (INTVAL)cursor - (INTVAL)packed));
1093     self->directory.base.file_offset = (INTVAL)cursor - (INTVAL)self->src;
1094     if (self->options & PFOPT_HEADERONLY)
1095         return cursor - packed;
1096
1097     /* now unpack dir, which unpacks its contents ... */
1098     Parrot_block_GC_mark(interp);
1099     cursor = PackFile_Segment_unpack(interp,
1100                                      &self->directory.base, cursor);
1101     Parrot_unblock_GC_mark(interp);
1102
1103 #ifdef PARROT_HAS_HEADER_SYSMMAN
1104     if (self->is_mmap_ped
1105     && (self->need_endianize || self->need_wordsize)) {
1106         DECL_CONST_CAST;
1107         /* Cast the result to void to avoid a warning with
1108          * some not-so-standard mmap headers
1109          */
1110         munmap((void *)PARROT_const_cast(opcode_t *, self->src), self->size);
1111         self->is_mmap_ped = 0;
1112     }
1113 #endif
1114
1115     TRACE_PRINTF(("PackFile_unpack: Unpack done.\n"));
1116
1117     return cursor - packed;
1118 }
1119
1120
1121 /*
1122
1123 =item C<INTVAL PackFile_map_segments(PARROT_INTERP, const PackFile_Directory
1124 *dir, PackFile_map_segments_func_t callback, void *user_data)>
1125
1126 Calls the callback function C<callback> for each segment in the directory
1127 C<dir> called. The pointer C<user_data> is included in each call.
1128
1129 If a callback returns non-zero, segment processing stops, returning this value.
1130
1131 =cut
1132
1133 */
1134
1135 PARROT_EXPORT
1136 INTVAL
1137 PackFile_map_segments(PARROT_INTERP, ARGIN(const PackFile_Directory *dir),
1138                        PackFile_map_segments_func_t callback,
1139                        ARGIN_NULLOK(void *user_data))
1140 {
1141     ASSERT_ARGS(PackFile_map_segments)
1142     size_t i;
1143
1144     for (i = 0; i < dir->num_segments; i++) {
1145         const INTVAL ret = callback(interp, dir->segments[i], user_data);
1146         if (ret)
1147             return ret;
1148     }
1149
1150     return 0;
1151 }
1152
1153
1154 /*
1155
1156 =item C<void PackFile_add_segment(PARROT_INTERP, PackFile_Directory *dir,
1157 PackFile_Segment *seg)>
1158
1159 Adds the Segment C<seg> to the directory C<dir>.  The PackFile becomes the
1160 owner of the segment; it gets destroyed when the PackFile does.
1161
1162 =cut
1163
1164 */
1165
1166 PARROT_EXPORT
1167 void
1168 PackFile_add_segment(SHIM_INTERP, ARGMOD(PackFile_Directory *dir),
1169         ARGIN(PackFile_Segment *seg))
1170 {
1171     ASSERT_ARGS(PackFile_add_segment)
1172     mem_realloc_n_typed(dir->segments, dir->num_segments+1, PackFile_Segment *);
1173     dir->segments[dir->num_segments] = seg;
1174     dir->num_segments++;
1175     seg->dir = dir;
1176
1177     return;
1178 }
1179
1180
1181 /*
1182
1183 =item C<PackFile_Segment * PackFile_find_segment(PARROT_INTERP,
1184 PackFile_Directory *dir, STRING *name, int sub_dir)>
1185
1186 Finds the segment with the name C<name> in the C<PackFile_Directory> if
1187 C<sub_dir> is true, searches directories recursively.  The returned segment is
1188 still owned by the C<PackFile>.
1189
1190 =cut
1191
1192 */
1193
1194 PARROT_EXPORT
1195 PARROT_WARN_UNUSED_RESULT
1196 PARROT_CAN_RETURN_NULL
1197 PackFile_Segment *
1198 PackFile_find_segment(PARROT_INTERP, ARGIN_NULLOK(PackFile_Directory *dir),
1199     ARGIN(STRING *name), int sub_dir)
1200 {
1201     ASSERT_ARGS(PackFile_find_segment)
1202     if (dir) {
1203         size_t i;
1204
1205         for (i = 0; i < dir->num_segments; i++) {
1206             PackFile_Segment *seg = dir->segments[i];
1207
1208             if (seg) {
1209                 if (Parrot_str_equal(interp, seg->name, name))
1210                     return seg;
1211
1212                 if (sub_dir && seg->type == PF_DIR_SEG) {
1213                     seg = PackFile_find_segment(interp,
1214                             (PackFile_Directory *)seg, name, sub_dir);
1215
1216                     if (seg)
1217                         return seg;
1218                 }
1219             }
1220         }
1221     }
1222
1223     return NULL;
1224 }
1225
1226
1227 /*
1228
1229 =item C<PackFile_Segment * PackFile_remove_segment_by_name(PARROT_INTERP,
1230 PackFile_Directory *dir, STRING *name)>
1231
1232 Finds, removes, and returns the segment with name C<name> in the
1233 C<PackFile_Directory>.  The caller is responsible for destroying the segment.
1234
1235 =cut
1236
1237 */
1238
1239 PARROT_EXPORT
1240 PARROT_WARN_UNUSED_RESULT
1241 PARROT_CAN_RETURN_NULL
1242 PackFile_Segment *
1243 PackFile_remove_segment_by_name(PARROT_INTERP, ARGMOD(PackFile_Directory *dir),
1244                                 ARGIN(STRING *name))
1245 {
1246     ASSERT_ARGS(PackFile_remove_segment_by_name)
1247     size_t i;
1248
1249     for (i = 0; i < dir->num_segments; i++) {
1250         PackFile_Segment * const seg = dir->segments[i];
1251         if (Parrot_str_equal(interp, seg->name, name)) {
1252             dir->num_segments--;
1253
1254             if (i != dir->num_segments) {
1255                 /* We're not the last segment, so we need to move things */
1256                 memmove(&dir->segments[i], &dir->segments[i+1],
1257                        (dir->num_segments - i) * sizeof (PackFile_Segment *));
1258             }
1259
1260             return seg;
1261         }
1262     }
1263
1264     return NULL;
1265 }
1266
1267
1268 /*
1269
1270 =back
1271
1272 =head2 PackFile Structure Functions
1273
1274 =over 4
1275
1276 =item C<static void PackFile_set_header(PackFile_Header *header)>
1277
1278 Fills a C<PackFile> header with system specific data.
1279
1280 =cut
1281
1282 */
1283
1284 static void
1285 PackFile_set_header(ARGOUT(PackFile_Header *header))
1286 {
1287     ASSERT_ARGS(PackFile_set_header)
1288     memcpy(header->magic, "\376PBC\r\n\032\n", 8);
1289     header->wordsize    = sizeof (opcode_t);
1290     header->byteorder   = PARROT_BIGENDIAN;
1291     header->major       = PARROT_MAJOR_VERSION;
1292     header->minor       = PARROT_MINOR_VERSION;
1293     header->patch       = PARROT_PATCH_VERSION;
1294     header->bc_major    = PARROT_PBC_MAJOR;
1295     header->bc_minor    = PARROT_PBC_MINOR;
1296 #if NUMVAL_SIZE == 8
1297     header->floattype = FLOATTYPE_8;
1298 #else
1299 #  if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN
1300     header->floattype = FLOATTYPE_12;
1301 #  else
1302 #    if (NUMVAL_SIZE == 16)
1303     header->floattype = FLOATTYPE_16;
1304 #    else
1305     exit_fatal(1, "PackFile_set_header: Unsupported floattype NUMVAL_SIZE=%d,"
1306                " PARROT_BIGENDIAN=%s\n", NUMVAL_SIZE,
1307                PARROT_BIGENDIAN ? "big-endian" : "little-endian");
1308 #    endif
1309 #  endif
1310 #endif
1311 }
1312
1313
1314 /*
1315
1316 =item C<PackFile * PackFile_new(PARROT_INTERP, INTVAL is_mapped)>
1317
1318 Allocates a new empty C<PackFile> and sets up the directory.
1319
1320 Directory segment:
1321
1322   +----------+----------+----------+----------+
1323   |    Segment Header                         |
1324   |    ..............                         |
1325   +----------+----------+----------+----------+
1326
1327   +----------+----------+----------+----------+
1328   |    number of directory items              |
1329   +----------+----------+----------+----------+
1330
1331 followed by a sequence of items
1332
1333   +----------+----------+----------+----------+
1334   |    Segment type                           |
1335   +----------+----------+----------+----------+
1336   |    "name"                                 |
1337   |    ...     '\0'       padding bytes       |
1338   +----------+----------+----------+----------+
1339   |    Offset in the file                     |
1340   +----------+----------+----------+----------+
1341   |    Size of the segment                    |
1342   +----------+----------+----------+----------+
1343
1344 "name" is a NUL-terminated c-string encoded in plain ASCII.
1345
1346 Segment types are defined in F<include/parrot/packfile.h>.
1347
1348 Offset and size are in C<opcode_t>.
1349
1350 A Segment Header has these entries:
1351
1352  - op_count     total ops of segment incl. this count
1353  - itype        internal type of segment
1354  - id           internal id e.g code seg nr
1355  - size         size of following op array, 0 if none
1356  * data         possibly empty data, or e.g. byte code
1357
1358 =cut
1359
1360 */
1361
1362 PARROT_EXPORT
1363 PARROT_WARN_UNUSED_RESULT
1364 PARROT_CANNOT_RETURN_NULL
1365 PackFile *
1366 PackFile_new(PARROT_INTERP, INTVAL is_mapped)
1367 {
1368     ASSERT_ARGS(PackFile_new)
1369     PackFile * const pf = mem_allocate_zeroed_typed(PackFile);
1370     pf->header          = mem_allocate_zeroed_typed(PackFile_Header);
1371     pf->is_mmap_ped     = is_mapped;
1372     pf->options         = PFOPT_NONE;
1373
1374     /* fill header with system specific data */
1375     PackFile_set_header(pf->header);
1376
1377     /* Other fields empty for now */
1378     pf->cur_cs = NULL;
1379     pf_register_standard_funcs(interp, pf);
1380
1381     /* create the master directory, all subirs go there */
1382     pf->directory.base.pf = pf;
1383     pf->dirp              = (PackFile_Directory *)
1384         PackFile_Segment_new_seg(interp, &pf->directory,
1385             PF_DIR_SEG, DIRECTORY_SEGMENT_NAME, 0);
1386     pf->directory         = *pf->dirp;
1387
1388     pf->fetch_op = (packfile_fetch_op_t)NULL;
1389     pf->fetch_iv = (packfile_fetch_iv_t)NULL;
1390     pf->fetch_nv = (packfile_fetch_nv_t)NULL;
1391
1392     return pf;
1393 }
1394
1395
1396 /*
1397
1398 =item C<PackFile * PackFile_new_dummy(PARROT_INTERP, STRING *name)>
1399
1400 Creates a new (initial) dummy PackFile. This is necessary if the interpreter
1401 doesn't load any bytecode but instead uses C<Parrot_compile_string>.
1402
1403 =cut
1404
1405 */
1406
1407 PARROT_EXPORT
1408 PARROT_WARN_UNUSED_RESULT
1409 PARROT_CAN_RETURN_NULL
1410 PackFile *
1411 PackFile_new_dummy(PARROT_INTERP, ARGIN(STRING *name))
1412 {
1413     ASSERT_ARGS(PackFile_new_dummy)
1414
1415     PackFile * const pf = PackFile_new(interp, 0);
1416     interp->initial_pf  = pf;
1417     interp->code        = pf->cur_cs
1418                         = PF_create_default_segs(interp, name, 1);
1419
1420     return pf;
1421 }
1422
1423
1424 /*
1425
1426 =item C<void PackFile_funcs_register(PARROT_INTERP, PackFile *pf, UINTVAL type,
1427 const PackFile_funcs funcs)>
1428
1429 Registers the C<pack>/C<unpack>/... functions for a packfile type.
1430
1431 =cut
1432
1433 */
1434
1435 PARROT_EXPORT
1436 void
1437 PackFile_funcs_register(SHIM_INTERP, ARGOUT(PackFile *pf), UINTVAL type,
1438                         const PackFile_funcs funcs)
1439 {
1440     ASSERT_ARGS(PackFile_funcs_register)
1441     /* TODO dynamic registering */
1442     pf->PackFuncs[type] = funcs;
1443 }
1444
1445
1446 /*
1447
1448 =item C<static const opcode_t * default_unpack(PackFile_Segment *self, const
1449 opcode_t *cursor)>
1450
1451 Unpacks a PackFile given a cursor into PBC.  This is the default unpack.
1452
1453 =cut
1454
1455 */
1456
1457 PARROT_WARN_UNUSED_RESULT
1458 PARROT_CAN_RETURN_NULL
1459 static const opcode_t *
1460 default_unpack(ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor))
1461 {
1462     ASSERT_ARGS(default_unpack)
1463     DECL_CONST_CAST_OF(opcode_t);
1464 #if TRACE_PACKFILE
1465     PackFile * const pf  = self->pf;
1466 #endif
1467
1468     self->op_count = PF_fetch_opcode(self->pf, &cursor);
1469     self->itype    = PF_fetch_opcode(self->pf, &cursor);
1470     self->id       = PF_fetch_opcode(self->pf, &cursor);
1471     self->size     = PF_fetch_opcode(self->pf, &cursor);
1472     TRACE_PRINTF_VAL(("default_unpack: op_count=%d, itype=%d, id=%d, size=%d.\n",
1473         self->op_count, self->itype, self->id, self->size));
1474
1475     if (self->size == 0)
1476         return cursor;
1477
1478     /* if the packfile is mmap()ed just point to it if we don't
1479      * need any fetch transforms */
1480     if (self->pf->is_mmap_ped
1481     && !self->pf->need_endianize
1482     && !self->pf->need_wordsize) {
1483         self->data  = PARROT_const_cast(opcode_t *, cursor);
1484         cursor     += self->size;
1485         return cursor;
1486     }
1487
1488     /* else allocate mem */
1489     self->data = mem_allocate_n_typed(self->size, opcode_t);
1490
1491     if (!self->data) {
1492         Parrot_io_eprintf(NULL, "PackFile_unpack: Unable to allocate data memory!\n");
1493         self->size = 0;
1494         return NULL;
1495     }
1496
1497     if (!self->pf->need_endianize && !self->pf->need_wordsize) {
1498         mem_sys_memcopy(self->data, cursor, self->size * sizeof (opcode_t));
1499         cursor += self->size;
1500     }
1501     else {
1502         int i;
1503         TRACE_PRINTF(("default_unpack: pre-fetch %d ops into data\n",
1504                       self->size));
1505         for (i = 0; i < (int)self->size; i++) {
1506             self->data[i] = PF_fetch_opcode(self->pf, &cursor);
1507             TRACE_PRINTF(("default_unpack: transformed op[#%d]/%d %u\n",
1508                           i, self->size, self->data[i]));
1509         }
1510     }
1511
1512     return cursor;
1513 }
1514
1515
1516 /*
1517
1518 =item C<void default_dump_header(PARROT_INTERP, const PackFile_Segment *self)>
1519
1520 Dumps the header of a given PackFile_Segment.
1521
1522 =cut
1523
1524 */
1525
1526 void
1527 default_dump_header(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
1528 {
1529     ASSERT_ARGS(default_dump_header)
1530     Parrot_io_printf(interp, "%Ss => [ # offs 0x%x(%d)",
1531             self->name, (int)self->file_offset, (int)self->file_offset);
1532     Parrot_io_printf(interp, " = op_count %d, itype %d, id %d, size %d, ...",
1533             (int)self->op_count, (int)self->itype,
1534             (int)self->id, (int)self->size);
1535 }
1536
1537
1538 /*
1539
1540 =item C<static void default_dump(PARROT_INTERP, const PackFile_Segment *self)>
1541
1542 Dumps a PackFile_Segment.
1543
1544 =cut
1545
1546 */
1547
1548 static void
1549 default_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
1550 {
1551     ASSERT_ARGS(default_dump)
1552     size_t i = self->data ? 0: self->file_offset + 4;
1553
1554     default_dump_header(interp, self);
1555
1556     if (i % 8)
1557         Parrot_io_printf(interp, "\n %04x:  ", (int) i);
1558
1559     for (; i < (self->data ? self->size :
1560             self->file_offset + self->op_count); i++) {
1561
1562         if (i % 8 == 0)
1563             Parrot_io_printf(interp, "\n %04x:  ", (int) i);
1564
1565         Parrot_io_printf(interp, "%08lx ", (unsigned long)
1566                 self->data ? self->data[i] : self->pf->src[i]);
1567     }
1568
1569     Parrot_io_printf(interp, "\n]\n");
1570 }
1571
1572
1573 /*
1574
1575 =item C<static void pf_register_standard_funcs(PARROT_INTERP, PackFile *pf)>
1576
1577 Registers a PackFile's functions; called from within C<PackFile_new()>.
1578
1579 =cut
1580
1581 */
1582
1583 static void
1584 pf_register_standard_funcs(PARROT_INTERP, ARGMOD(PackFile *pf))
1585 {
1586     ASSERT_ARGS(pf_register_standard_funcs)
1587     PackFile_funcs dirf = {
1588         directory_new,
1589         directory_destroy,
1590         directory_packed_size,
1591         directory_pack,
1592         directory_unpack,
1593         directory_dump
1594     };
1595
1596     PackFile_funcs defaultf = {
1597         PackFile_Segment_new,
1598         (PackFile_Segment_destroy_func_t)     NULLfunc,
1599         (PackFile_Segment_packed_size_func_t) NULLfunc,
1600         (PackFile_Segment_pack_func_t)        NULLfunc,
1601         (PackFile_Segment_unpack_func_t)      NULLfunc,
1602         default_dump
1603     };
1604
1605     PackFile_funcs fixupf = {
1606         fixup_new,
1607         fixup_destroy,
1608         fixup_packed_size,
1609         fixup_pack,
1610         fixup_unpack,
1611         default_dump
1612     };
1613
1614     PackFile_funcs constf = {
1615         const_new,
1616         const_destroy,
1617         PackFile_ConstTable_pack_size,
1618         PackFile_ConstTable_pack,
1619         PackFile_ConstTable_unpack,
1620         default_dump
1621     };
1622
1623     PackFile_funcs bytef = {
1624         byte_code_new,
1625         byte_code_destroy,
1626         (PackFile_Segment_packed_size_func_t) NULLfunc,
1627         (PackFile_Segment_pack_func_t)        NULLfunc,
1628         (PackFile_Segment_unpack_func_t)      NULLfunc,
1629         default_dump
1630     };
1631
1632     const PackFile_funcs debugf = {
1633         pf_debug_new,
1634         pf_debug_destroy,
1635         pf_debug_packed_size,
1636         pf_debug_pack,
1637         pf_debug_unpack,
1638         pf_debug_dump
1639     };
1640
1641     const PackFile_funcs annotationf = {
1642         PackFile_Annotations_new,
1643         PackFile_Annotations_destroy,
1644         PackFile_Annotations_packed_size,
1645         PackFile_Annotations_pack,
1646         PackFile_Annotations_unpack,
1647         PackFile_Annotations_dump
1648     };
1649
1650     PackFile_funcs_register(interp, pf, PF_DIR_SEG,         dirf);
1651     PackFile_funcs_register(interp, pf, PF_UNKNOWN_SEG,     defaultf);
1652     PackFile_funcs_register(interp, pf, PF_FIXUP_SEG,       fixupf);
1653     PackFile_funcs_register(interp, pf, PF_CONST_SEG,       constf);
1654     PackFile_funcs_register(interp, pf, PF_BYTEC_SEG,       bytef);
1655     PackFile_funcs_register(interp, pf, PF_DEBUG_SEG,       debugf);
1656     PackFile_funcs_register(interp, pf, PF_ANNOTATIONS_SEG, annotationf);
1657
1658     return;
1659 }
1660
1661
1662 /*
1663
1664 =item C<PackFile_Segment * PackFile_Segment_new_seg(PARROT_INTERP,
1665 PackFile_Directory *dir, UINTVAL type, STRING *name, int add)>
1666
1667 Creates a new segment in the given PackFile_Directory of the given C<type> with
1668 the given C<name>.  If C<add> is true, adds the segment to the directory.
1669
1670 =cut
1671
1672 */
1673
1674 PARROT_EXPORT
1675 PARROT_WARN_UNUSED_RESULT
1676 PARROT_CANNOT_RETURN_NULL
1677 PackFile_Segment *
1678 PackFile_Segment_new_seg(PARROT_INTERP, ARGMOD(PackFile_Directory *dir),
1679         UINTVAL type, ARGIN(STRING *name), int add)
1680 {
1681     ASSERT_ARGS(PackFile_Segment_new_seg)
1682     PackFile * const                  pf  = dir->base.pf;
1683     const PackFile_Segment_new_func_t f   = pf->PackFuncs[type].new_seg;
1684     PackFile_Segment * const          seg = (f)(interp, pf, name, add);
1685
1686     segment_init(interp, seg, pf, name);
1687     seg->type = type;
1688
1689     if (add)
1690         PackFile_add_segment(interp, dir, seg);
1691
1692     return seg;
1693 }
1694
1695
1696 /*
1697
1698 =item C<static PackFile_Segment * create_seg(PARROT_INTERP, PackFile_Directory
1699 *dir, pack_file_types t, STRING *name, STRING *file_name, int add)>
1700
1701 Creates a new PackFile_Segment for the given C<file_name>.  See
1702 C<PackFile_Segment_new_seg()> for the other arguments.
1703
1704 =cut
1705
1706 */
1707
1708 PARROT_WARN_UNUSED_RESULT
1709 PARROT_CANNOT_RETURN_NULL
1710 static PackFile_Segment *
1711 create_seg(PARROT_INTERP, ARGMOD(PackFile_Directory *dir), pack_file_types t,
1712            ARGIN(STRING *name), ARGIN(STRING *file_name), int add)
1713 {
1714     ASSERT_ARGS(create_seg)
1715     PackFile_Segment *seg;
1716     STRING           *seg_name;
1717
1718     seg_name = Parrot_sprintf_c(interp, "%Ss_%Ss", name, file_name);
1719     seg = PackFile_Segment_new_seg(interp, dir, t, seg_name, add);
1720     return seg;
1721 }
1722
1723
1724 /*
1725
1726 =item C<PackFile_ByteCode * PF_create_default_segs(PARROT_INTERP, STRING
1727 *file_name, int add)>
1728
1729 Creates the bytecode, constant, and fixup segments for C<file_name>. If C<add>
1730 is true, the current packfile becomes the owner of these segments by adding the
1731 segments to the directory.
1732
1733 =cut
1734
1735 */
1736
1737 PARROT_EXPORT
1738 PARROT_WARN_UNUSED_RESULT
1739 PARROT_CANNOT_RETURN_NULL
1740 PackFile_ByteCode *
1741 PF_create_default_segs(PARROT_INTERP, ARGIN(STRING *file_name), int add)
1742 {
1743     ASSERT_ARGS(PF_create_default_segs)
1744     PackFile          * const pf     = interp->initial_pf;
1745     PackFile_ByteCode * const cur_cs =
1746         (PackFile_ByteCode *)create_seg(interp, &pf->directory,
1747             PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME, file_name, add);
1748
1749     cur_cs->fixups       =
1750         (PackFile_FixupTable *)create_seg(interp, &pf->directory,
1751             PF_FIXUP_SEG, FIXUP_TABLE_SEGMENT_NAME, file_name, add);
1752
1753     cur_cs->fixups->code = cur_cs;
1754
1755     cur_cs->const_table  =
1756         (PackFile_ConstTable *)create_seg(interp, &pf->directory,
1757             PF_CONST_SEG, CONSTANT_SEGMENT_NAME, file_name, add);
1758
1759     cur_cs->const_table->code = cur_cs;
1760
1761     return cur_cs;
1762 }
1763
1764
1765 /*
1766
1767 =item C<void PackFile_Segment_destroy(PARROT_INTERP, PackFile_Segment *self)>
1768
1769 Destroys the given PackFile_Segment.
1770
1771 =cut
1772
1773 */
1774
1775 PARROT_EXPORT
1776 void
1777 PackFile_Segment_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
1778 {
1779     ASSERT_ARGS(PackFile_Segment_destroy)
1780     const PackFile_Segment_destroy_func_t f =
1781         self->pf->PackFuncs[self->type].destroy;
1782
1783     if (f)
1784         (f)(interp, self);
1785
1786     /* destroy self after specific */
1787     default_destroy(self);
1788 }
1789
1790
1791 /*
1792
1793 =item C<size_t PackFile_Segment_packed_size(PARROT_INTERP, PackFile_Segment
1794 *self)>
1795
1796 Returns the size of the given segment, when packed, taking into account padding
1797 and alignment.
1798
1799 =cut
1800
1801 */
1802
1803 PARROT_EXPORT
1804 size_t
1805 PackFile_Segment_packed_size(PARROT_INTERP, ARGIN(PackFile_Segment *self))
1806 {
1807     ASSERT_ARGS(PackFile_Segment_packed_size)
1808     size_t size                           = default_packed_size(self);
1809     const size_t align                    = 16 / sizeof (opcode_t);
1810     PackFile_Segment_packed_size_func_t f =
1811         self->pf->PackFuncs[self->type].packed_size;
1812
1813     if (f)
1814         size += (f)(interp, self);
1815
1816     /* pad/align it */
1817     if (align && size % align)
1818         size += (align - size % align);
1819
1820     return size;
1821 }
1822
1823
1824 /*
1825
1826 =item C<opcode_t * PackFile_Segment_pack(PARROT_INTERP, PackFile_Segment *self,
1827 opcode_t *cursor)>
1828
1829 Packs a PackFile_Segment, returning a cursor to the start of the results.
1830
1831 =cut
1832
1833 */
1834
1835 PARROT_EXPORT
1836 PARROT_WARN_UNUSED_RESULT
1837 PARROT_CANNOT_RETURN_NULL
1838 opcode_t *
1839 PackFile_Segment_pack(PARROT_INTERP, ARGIN(PackFile_Segment *self),
1840         ARGIN(opcode_t *cursor))
1841 {
1842     ASSERT_ARGS(PackFile_Segment_pack)
1843     /*const size_t align             = 16 / sizeof (opcode_t);*/
1844     PackFile_Segment_pack_func_t f =
1845         self->pf->PackFuncs[self->type].pack;
1846     opcode_t * old_cursor;          /* Used for filling padding with 0 */
1847 #if TRACE_PACKFILE
1848     PackFile * const pf  = self->pf;
1849 #endif
1850
1851     cursor = default_pack(self, cursor);
1852
1853     if (f)
1854         cursor = (f)(interp, self, cursor);
1855
1856     TRACE_PRINTF_ALIGN(("-ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
1857                         OFFS(pf, cursor), pf->src, cursor));
1858     old_cursor = cursor;
1859     ALIGN_16(self->pf, cursor);
1860     /* fill padding with zeros */
1861     while (old_cursor != cursor)
1862         *old_cursor++ = 0;
1863
1864     /*if (align && (cursor - self->pf->src) % align)
1865       cursor += align - (cursor - self->pf->src) % align;*/
1866     TRACE_PRINTF_ALIGN(("+ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
1867                       OFFS(pf, cursor), pf->src, cursor));
1868
1869     return cursor;
1870 }
1871
1872
1873 /*
1874
1875 =item C<const opcode_t * PackFile_Segment_unpack(PARROT_INTERP, PackFile_Segment
1876 *self, const opcode_t *cursor)>
1877
1878 Unpacks a PackFile_Segment, returning a cursor to the results on success and
1879 NULL otherwise.
1880
1881 All all these functions call the related C<default_*> function.
1882
1883 If a special is defined this gets called after.
1884
1885 =cut
1886
1887 */
1888
1889 PARROT_EXPORT
1890 PARROT_WARN_UNUSED_RESULT
1891 PARROT_CAN_RETURN_NULL
1892 const opcode_t *
1893 PackFile_Segment_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self),
1894         ARGIN(const opcode_t *cursor))
1895 {
1896     ASSERT_ARGS(PackFile_Segment_unpack)
1897     PackFile_Segment_unpack_func_t f = self->pf->PackFuncs[self->type].unpack;
1898     int offs;
1899 #if TRACE_PACKFILE
1900     PackFile * const pf  = self->pf;
1901 #endif
1902
1903     cursor = default_unpack(self, cursor);
1904
1905     if (!cursor)
1906         return NULL;
1907
1908     if (f) {
1909         TRACE_PRINTF(("PackFile_Segment_unpack: special\n"));
1910
1911         cursor = (f)(interp, self, cursor);
1912         if (!cursor)
1913             return NULL;
1914     }
1915
1916     offs = OFFS(self->pf, cursor);
1917     TRACE_PRINTF_ALIGN(("-S ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
1918                         offs, self->pf->src, cursor));
1919     offs += PAD_16_B(offs);
1920     cursor = self->pf->src + offs/(sizeof (opcode_t));
1921     TRACE_PRINTF_ALIGN(("+S ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
1922                         offs, self->pf->src, cursor));
1923     return cursor;
1924 }
1925
1926
1927 /*
1928
1929 =item C<void PackFile_Segment_dump(PARROT_INTERP, PackFile_Segment *self)>
1930
1931 Dumps the segment C<self>.
1932
1933 =cut
1934
1935 */
1936
1937 PARROT_EXPORT
1938 void
1939 PackFile_Segment_dump(PARROT_INTERP, ARGIN(PackFile_Segment *self))
1940 {
1941     ASSERT_ARGS(PackFile_Segment_dump)
1942     self->pf->PackFuncs[self->type].dump(interp, self);
1943 }
1944
1945
1946 /*
1947
1948 =back
1949
1950 =head2 Standard Directory Functions
1951
1952 =over 4
1953
1954 =item C<static PackFile_Segment * directory_new(PARROT_INTERP, PackFile *pf,
1955 STRING *name, int add)>
1956
1957 Returns a new C<PackFile_Directory> cast as a C<PackFile_Segment>.
1958
1959 =cut
1960
1961 */
1962
1963 PARROT_WARN_UNUSED_RESULT
1964 PARROT_CANNOT_RETURN_NULL
1965 static PackFile_Segment *
1966 directory_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(STRING *name), SHIM(int add))
1967 {
1968     ASSERT_ARGS(directory_new)
1969
1970     return (PackFile_Segment *)mem_allocate_zeroed_typed(PackFile_Directory);
1971 }
1972
1973
1974 /*
1975
1976 =item C<static void directory_dump(PARROT_INTERP, const PackFile_Segment *self)>
1977
1978 Dumps the directory C<self>.
1979
1980 =cut
1981
1982 */
1983
1984 static void
1985 directory_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
1986 {
1987     ASSERT_ARGS(directory_dump)
1988     const PackFile_Directory * const dir = (const PackFile_Directory *) self;
1989     size_t i;
1990
1991     default_dump_header(interp, self);
1992
1993     Parrot_io_printf(interp, "\n\t# %d segments\n", dir->num_segments);
1994
1995     for (i = 0; i < dir->num_segments; i++) {
1996         const PackFile_Segment * const seg = dir->segments[i];
1997
1998         Parrot_io_printf(interp,
1999                 "\ttype %d\t%Ss\t", (int)seg->type, seg->name);
2000
2001         Parrot_io_printf(interp,
2002                 " offs 0x%x(0x%x)\top_count %d\n",
2003                 (int)seg->file_offset,
2004                 (int)seg->file_offset * sizeof (opcode_t),
2005                 (int)seg->op_count);
2006     }
2007
2008     Parrot_io_printf(interp, "]\n");
2009
2010     for (i = 0; i < dir->num_segments; i++)
2011         PackFile_Segment_dump(interp, dir->segments[i]);
2012 }
2013
2014
2015 /*
2016
2017 =item C<static const opcode_t * directory_unpack(PARROT_INTERP, PackFile_Segment
2018 *segp, const opcode_t *cursor)>
2019
2020 Unpacks the directory from the provided cursor.
2021
2022 =cut
2023
2024 */
2025
2026 PARROT_WARN_UNUSED_RESULT
2027 PARROT_CANNOT_RETURN_NULL
2028 static const opcode_t *
2029 directory_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *segp), ARGIN(const opcode_t *cursor))
2030 {
2031     ASSERT_ARGS(directory_unpack)
2032     PackFile_Directory * const dir = (PackFile_Directory *) segp;
2033     PackFile           * const pf  = dir->base.pf;
2034     const opcode_t            *pos;
2035     size_t                     i;
2036     int                        offs;
2037
2038     PARROT_ASSERT(pf);
2039     dir->num_segments = PF_fetch_opcode(pf, &cursor);
2040     TRACE_PRINTF(("directory_unpack: %ld num_segments\n", dir->num_segments));
2041     mem_realloc_n_typed(dir->segments, dir->num_segments, PackFile_Segment *);
2042
2043     for (i = 0; i < dir->num_segments; i++) {
2044         PackFile_Segment *seg;
2045         char             *buf;
2046         STRING           *name;
2047         size_t            opcode;
2048
2049         /* get type */
2050         UINTVAL type = PF_fetch_opcode(pf, &cursor);
2051         if (type >= PF_MAX_SEG)
2052             type = PF_UNKNOWN_SEG;
2053
2054         TRACE_PRINTF_VAL(("Segment type %d.\n", type));
2055
2056         /* get name */
2057         buf = PF_fetch_cstring(pf, &cursor);
2058         TRACE_PRINTF_VAL(("Segment name \"%s\".\n", name));
2059
2060         /* create it */
2061         name = Parrot_str_new(interp, buf, strlen(buf));
2062         seg = PackFile_Segment_new_seg(interp, dir, type, name, 0);
2063         mem_sys_free(buf);
2064
2065         seg->file_offset = PF_fetch_opcode(pf, &cursor);
2066         TRACE_PRINTF_VAL(("Segment file_offset %ld.\n", seg->file_offset));
2067
2068         seg->op_count    = PF_fetch_opcode(pf, &cursor);
2069         TRACE_PRINTF_VAL(("Segment op_count %ld.\n", seg->op_count));
2070
2071         if (pf->need_wordsize) {
2072 #if OPCODE_T_SIZE == 8
2073             if (pf->header->wordsize == 4)
2074                 pos = pf->src + seg->file_offset / 2;
2075 #else
2076             if (pf->header->wordsize == 8)
2077                 pos = pf->src + seg->file_offset * 2;
2078 #endif
2079             else {
2080                 fprintf(stderr, "directory_unpack failed: invalid wordsize %d\n",
2081                         (int)pf->header->wordsize);
2082                 return NULL;
2083             }
2084             TRACE_PRINTF_VAL(("Segment offset: new pos 0x%x "
2085                               "(src=0x%x cursor=0x%x).\n",
2086                               OFFS(pf, pos), pf->src, cursor));
2087         }
2088         else
2089             pos = pf->src + seg->file_offset;
2090
2091         opcode = PF_fetch_opcode(pf, &pos);
2092
2093         if (seg->op_count != opcode) {
2094             Parrot_io_eprintf(interp,
2095                      "%Ss: Size in directory %d doesn't match size %d "
2096                      "at offset 0x%x\n", seg->name, (int)seg->op_count,
2097                      (int)opcode, (int)seg->file_offset);
2098         }
2099
2100         if (i) {
2101             PackFile_Segment *last = dir->segments[i-1];
2102             if (last->file_offset + last->op_count != seg->file_offset)
2103                 fprintf(stderr, "section: sections are not back to back\n");
2104         }
2105
2106         make_code_pointers(seg);
2107
2108         /* store the segment */
2109         dir->segments[i] = seg;
2110         seg->dir         = dir;
2111     }
2112
2113     offs = OFFS(pf, cursor);
2114     TRACE_PRINTF_ALIGN(("-ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
2115                       offs, pf->src, cursor));
2116     offs += PAD_16_B(offs);
2117     cursor = pf->src + offs/(sizeof (opcode_t));
2118     TRACE_PRINTF_ALIGN(("+ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
2119                       offs, pf->src, cursor));
2120
2121     /* and now unpack contents of dir */
2122     for (i = 0; cursor && i < dir->num_segments; i++) {
2123         const opcode_t * const csave = cursor;
2124
2125         /* check len again */
2126         size_t tmp   = PF_fetch_opcode(pf, &cursor);
2127
2128         /* keep gcc -O silent */
2129         size_t delta = 0;
2130
2131         cursor = csave;
2132         TRACE_PRINTF_VAL(("PackFile_Segment_unpack [%d] tmp len=%d.\n", i, tmp));
2133         pos    = PackFile_Segment_unpack(interp, dir->segments[i], cursor);
2134
2135         if (!pos) {
2136             Parrot_io_eprintf(interp, "PackFile_unpack segment '%Ss' failed\n",
2137                     dir->segments[i]->name);
2138             return NULL;
2139         }
2140         else {
2141             TRACE_PRINTF_VAL(("PackFile_Segment_unpack ok. pos=0x%x\n", pos));
2142         }
2143
2144         /* FIXME bug on 64bit reading 32bit lurking here! TT #254 */
2145         if (pf->need_wordsize) {
2146 #if OPCODE_T_SIZE == 8
2147             if (pf->header->wordsize == 4)
2148                 delta = (pos - cursor) * 2;
2149 #else
2150             if (pf->header->wordsize == 8)
2151                 delta = (pos - cursor) / 2;
2152 #endif
2153         }
2154         else
2155             delta = pos - cursor;
2156
2157         TRACE_PRINTF_VAL(("  delta=%d, pos=0x%x, cursor=0x%x\n",
2158                           delta, pos, cursor));
2159
2160         if ((size_t)delta != tmp || dir->segments[i]->op_count != tmp)
2161             Parrot_io_eprintf(interp, "PackFile_unpack segment '%Ss' directory length %d "
2162                     "length in file %d needed %d for unpack\n",
2163                     dir->segments[i]->name,
2164                     (int)dir->segments[i]->op_count, (int)tmp,
2165                     (int)delta);
2166         cursor = pos;
2167     }
2168
2169     return cursor;
2170 }
2171
2172
2173 /*
2174
2175 =item C<static void directory_destroy(PARROT_INTERP, PackFile_Segment *self)>
2176
2177 Destroys the directory.
2178
2179 =cut
2180
2181 */
2182
2183 static void
2184 directory_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
2185 {
2186     ASSERT_ARGS(directory_destroy)
2187     PackFile_Directory * const dir = (PackFile_Directory *)self;
2188     size_t i;
2189
2190     for (i = 0; i < dir->num_segments; i++) {
2191         PackFile_Segment *segment = dir->segments[i];
2192         /* Prevent repeated destruction */
2193         dir->segments[i] = NULL;
2194
2195         /* XXX Black magic here.
2196          * There are some failures that looks like a segment directory
2197          * inserted into another. Until that problems gets fixed,
2198          * these checks are a workaround.
2199          */
2200         if (segment && segment != self && segment->type != PF_DIR_SEG)
2201             PackFile_Segment_destroy(interp, segment);
2202     }
2203
2204     if (dir->segments) {
2205         mem_sys_free(dir->segments);
2206         dir->segments = NULL;
2207         dir->num_segments = 0;
2208     }
2209 }
2210
2211
2212 /*
2213
2214 =item C<static void sort_segs(PackFile_Directory *dir)>
2215
2216 Sorts the segments in C<dir>.
2217
2218 =cut
2219
2220 */
2221
2222 static void
2223 sort_segs(ARGMOD(PackFile_Directory *dir))
2224 {
2225     ASSERT_ARGS(sort_segs)
2226     const size_t      num_segs = dir->num_segments;
2227     PackFile_Segment *seg      = dir->segments[0];
2228
2229     if (seg->type != PF_BYTEC_SEG) {
2230         size_t i;
2231
2232         for (i = 1; i < num_segs; i++) {
2233             PackFile_Segment * const s2 = dir->segments[i];
2234             if (s2->type == PF_BYTEC_SEG) {
2235                 dir->segments[0] = s2;
2236                 dir->segments[i] = seg;
2237                 break;
2238             }
2239         }
2240     }
2241
2242     seg = dir->segments[1];
2243
2244     if (seg->type != PF_FIXUP_SEG) {
2245         size_t i;
2246
2247         for (i = 2; i < num_segs; i++) {
2248             PackFile_Segment * const s2 = dir->segments[i];
2249             if (s2->type == PF_FIXUP_SEG) {
2250                 dir->segments[1] = s2;
2251                 dir->segments[i] = seg;
2252                 break;
2253             }
2254         }
2255     }
2256
2257     /* XXX
2258      * Temporary? hack to put ConstantTable in front of other segments.
2259      * This is useful for Annotations because we ensure that constants used
2260      * for keys already available during unpack.
2261      */
2262     seg = dir->segments[2];
2263
2264     if (seg->type != PF_CONST_SEG) {
2265         size_t i;
2266
2267         for (i = 3; i < num_segs; i++) {
2268             PackFile_Segment * const s2 = dir->segments[i];
2269             if (s2->type == PF_CONST_SEG) {
2270                 dir->segments[2] = s2;
2271                 dir->segments[i] = seg;
2272                 break;
2273             }
2274         }
2275     }
2276 }
2277
2278
2279 /*
2280
2281 =item C<static size_t directory_packed_size(PARROT_INTERP, PackFile_Segment
2282 *self)>
2283
2284 Returns the size of the directory minus the value returned by
2285 C<default_packed_size()>.
2286
2287 =cut
2288
2289 */
2290
2291 PARROT_WARN_UNUSED_RESULT
2292 static size_t
2293 directory_packed_size(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
2294 {
2295     ASSERT_ARGS(directory_packed_size)
2296     PackFile_Directory * const dir   = (PackFile_Directory *)self;
2297     const size_t               align = 16 / sizeof (opcode_t);
2298     size_t size, i;
2299
2300     /* need bytecode, fixup, other segs ... */
2301     sort_segs(dir);
2302
2303     /* number of segments + default, we need it for the offsets */
2304     size = 1 + default_packed_size(self);
2305
2306     for (i = 0; i < dir->num_segments; i++) {
2307         char *name = Parrot_str_to_cstring(interp, dir->segments[i]->name);
2308         /* type, offset, size */
2309         size += 3;
2310         size += PF_size_cstring(name);
2311         Parrot_str_free_cstring(name);
2312     }
2313
2314     /* pad/align it */
2315     if (align && size % align)
2316         size += (align - size % align);
2317
2318     for (i = 0; i < dir->num_segments; i++) {
2319         size_t seg_size;
2320
2321         dir->segments[i]->file_offset = size + self->file_offset;
2322         seg_size                      =
2323             PackFile_Segment_packed_size(interp, dir->segments[i]);
2324         dir->segments[i]->op_count    = seg_size;
2325         size += seg_size;
2326     }
2327
2328     self->op_count = size;
2329
2330     /* subtract default, it is added in PackFile_Segment_packed_size */
2331     return size - default_packed_size(self);
2332 }
2333
2334
2335 /*
2336
2337 =item C<static opcode_t * directory_pack(PARROT_INTERP, PackFile_Segment *self,
2338 opcode_t *cursor)>
2339
2340 Packs the directory C<self>, using the given cursor.
2341
2342 =cut
2343
2344 */
2345
2346 PARROT_WARN_UNUSED_RESULT
2347 PARROT_CANNOT_RETURN_NULL
2348 static opcode_t *
2349 directory_pack(PARROT_INTERP, ARGIN(PackFile_Segment *self), ARGOUT(opcode_t *cursor))
2350 {
2351     ASSERT_ARGS(directory_pack)
2352     PackFile_Directory * const dir      = (PackFile_Directory *)self;
2353     const size_t               num_segs = dir->num_segments;
2354     /*const size_t               align    = 16/sizeof (opcode_t);*/
2355     size_t i;
2356     PackFile           * const pf       = self->pf;
2357     opcode_t                 * old_cursor;  /* Used for filling padding with 0 */
2358
2359     *cursor++ = num_segs;
2360
2361     for (i = 0; i < num_segs; i++) {
2362         const PackFile_Segment * const seg = dir->segments[i];
2363         char *name = Parrot_str_to_cstring(interp, seg->name);
2364         *cursor++ = seg->type;
2365         cursor = PF_store_cstring(cursor, name);
2366         *cursor++ = seg->file_offset;
2367         *cursor++ = seg->op_count;
2368         Parrot_str_free_cstring(name);
2369     }
2370
2371     TRACE_PRINTF_ALIGN(("-ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
2372                       OFFS(pf, cursor), pf->src, cursor));
2373     old_cursor = cursor;
2374     ALIGN_16(pf, cursor);
2375     /* fill padding with zeros */
2376     while (old_cursor != cursor)
2377         *old_cursor++ = 0;
2378     TRACE_PRINTF_ALIGN(("+ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
2379                       OFFS(pf, cursor), pf->src, cursor));
2380     /*if (align && (cursor - self->pf->src) % align)
2381       cursor += align - (cursor - self->pf->src) % align;*/
2382
2383     /* now pack all segments into new format */
2384     for (i = 0; i < dir->num_segments; i++) {
2385         PackFile_Segment * const seg = dir->segments[i];
2386
2387         cursor = PackFile_Segment_pack(interp, seg, cursor);
2388     }
2389
2390     return cursor;
2391 }
2392
2393
2394 /*
2395
2396 =back
2397
2398 =head2 C<PackFile_Segment> Functions
2399
2400 =over 4
2401
2402 =item C<static void segment_init(PARROT_INTERP, PackFile_Segment *self, PackFile
2403 *pf, STRING *name)>
2404
2405 Initializes the segment C<self> with the provided PackFile and the given name.
2406 Note that this duplicates the given name.
2407
2408 =cut
2409
2410 */
2411
2412 static void
2413 segment_init(PARROT_INTERP, ARGOUT(PackFile_Segment *self), ARGIN(PackFile *pf),
2414         ARGIN(STRING *name))
2415 {
2416     ASSERT_ARGS(segment_init)
2417     self->pf          = pf;
2418     self->type        = PF_UNKNOWN_SEG;
2419     self->file_offset = 0;
2420     self->op_count    = 0;
2421     self->itype       = 0;
2422     self->size        = 0;
2423     self->data        = NULL;
2424     self->id          = 0;
2425     self->name        = Parrot_str_copy(interp, name);
2426 }
2427
2428
2429 /*
2430
2431 =item C<PackFile_Segment * PackFile_Segment_new(PARROT_INTERP, PackFile *pf,
2432 STRING *name, int add)>
2433
2434 Creates a new default section.
2435
2436 =cut
2437
2438 */
2439
2440 PARROT_EXPORT
2441 PARROT_WARN_UNUSED_RESULT
2442 PARROT_CANNOT_RETURN_NULL
2443 PackFile_Segment *
2444 PackFile_Segment_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(STRING *name), SHIM(int add))
2445 {
2446     ASSERT_ARGS(PackFile_Segment_new)
2447     PackFile_Segment * const seg = mem_allocate_typed(PackFile_Segment);
2448
2449     return seg;
2450 }
2451
2452
2453 /*
2454
2455 =back
2456
2457 =head2 Default Function Implementations
2458
2459 The default functions are called before the segment specific functions
2460 and can read a block of C<opcode_t> data.
2461
2462 =over 4
2463
2464 =item C<static void default_destroy(PackFile_Segment *self)>
2465
2466 The default destroy function.  Destroys a PackFile_Segment.
2467
2468 =cut
2469
2470 */
2471
2472 static void
2473 default_destroy(ARGMOD(PackFile_Segment *self))
2474 {
2475     ASSERT_ARGS(default_destroy)
2476     if (!self->pf->is_mmap_ped && self->data) {
2477         mem_sys_free(self->data);
2478         self->data = NULL;
2479     }
2480
2481     mem_sys_free(self);
2482 }
2483
2484
2485 /*
2486
2487 =item C<static size_t default_packed_size(const PackFile_Segment *self)>
2488
2489 Returns the default size of the segment C<self>.
2490
2491 =cut
2492
2493 */
2494
2495 static size_t
2496 default_packed_size(ARGIN(const PackFile_Segment *self))
2497 {
2498     ASSERT_ARGS(default_packed_size)
2499     /* op_count, itype, id, size */
2500     /* XXX There should be a constant defining this 4, and why */
2501     /* This is the 2nd place in the file that has this */
2502     return 4 + self->size;
2503 }
2504
2505
2506 /*
2507
2508 =item C<static opcode_t * default_pack(const PackFile_Segment *self, opcode_t
2509 *dest)>
2510
2511 Performs the default pack.
2512
2513 =cut
2514
2515 */
2516
2517 PARROT_WARN_UNUSED_RESULT
2518 PARROT_CANNOT_RETURN_NULL
2519 static opcode_t *
2520 default_pack(ARGIN(const PackFile_Segment *self), ARGOUT(opcode_t *dest))
2521 {
2522     ASSERT_ARGS(default_pack)
2523     *dest++ = self->op_count;
2524     *dest++ = self->itype;
2525     *dest++ = self->id;
2526     *dest++ = self->size;
2527
2528     if (self->size)
2529         STRUCT_COPY_N(dest, self->data, self->size);
2530
2531     return dest + self->size;
2532 }
2533
2534
2535 /*
2536
2537 =back
2538
2539 =head2 ByteCode
2540
2541 =over 4
2542
2543 =item C<static void byte_code_destroy(PARROT_INTERP, PackFile_Segment *self)>
2544
2545 Destroys the C<PackFile_ByteCode> segment C<self>.
2546
2547 =cut
2548
2549 */
2550
2551 static void
2552 byte_code_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
2553 {
2554     ASSERT_ARGS(byte_code_destroy)
2555     PackFile_ByteCode * const byte_code = (PackFile_ByteCode *)self;
2556
2557     if (byte_code->prederef.code) {
2558         Parrot_free_memalign(byte_code->prederef.code);
2559         byte_code->prederef.code = NULL;
2560
2561         if (byte_code->prederef.branches) {
2562             mem_sys_free(byte_code->prederef.branches);
2563             byte_code->prederef.branches = NULL;
2564         }
2565     }
2566
2567     byte_code->fixups      = NULL;
2568     byte_code->const_table = NULL;
2569     byte_code->debugs      = NULL;
2570 }
2571
2572
2573 /*
2574
2575 =item C<static PackFile_Segment * byte_code_new(PARROT_INTERP, PackFile *pf,
2576 STRING *name, int add)>
2577
2578 Creates a new C<PackFile_ByteCode> segment.  Ignores C<pf>, C<name>, and C<add>
2579 are ignored.
2580
2581 =cut
2582
2583 */
2584
2585 PARROT_WARN_UNUSED_RESULT
2586 PARROT_CANNOT_RETURN_NULL
2587 static PackFile_Segment *
2588 byte_code_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(STRING *name), SHIM(int add))
2589 {
2590     ASSERT_ARGS(byte_code_new)
2591     PackFile_ByteCode * const byte_code = mem_allocate_zeroed_typed(PackFile_ByteCode);
2592
2593     return (PackFile_Segment *) byte_code;
2594 }
2595
2596
2597 /*
2598
2599 =back
2600
2601 =head2 Debug Info
2602
2603 =over 4
2604
2605 =item C<static void pf_debug_destroy(PARROT_INTERP, PackFile_Segment *self)>
2606
2607 Destroys the C<PackFile_Debug> segment C<self>.
2608
2609 =cut
2610
2611 */
2612
2613 static void
2614 pf_debug_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *self))
2615 {
2616     ASSERT_ARGS(pf_debug_destroy)
2617     PackFile_Debug * const debug = (PackFile_Debug *) self;
2618     int i;
2619
2620     /* Free each mapping. */
2621     for (i = 0; i < debug->num_mappings; i++)
2622         mem_sys_free(debug->mappings[i]);
2623
2624     /* Free mappings pointer array. */
2625     mem_sys_free(debug->mappings);
2626     debug->mappings     = NULL;
2627     debug->num_mappings = 0;
2628 }
2629
2630
2631 /*
2632
2633 =item C<static PackFile_Segment * pf_debug_new(PARROT_INTERP, PackFile *pf,
2634 STRING *name, int add)>
2635
2636 Creates and returns a new C<PackFile_Debug> segment.  Ignores C<pf>, C<name>,
2637 and C<add> ignored.
2638
2639 =cut
2640
2641 */
2642
2643 PARROT_WARN_UNUSED_RESULT
2644 PARROT_CANNOT_RETURN_NULL
2645 static PackFile_Segment *
2646 pf_debug_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(STRING *name), SHIM(int add))
2647 {
2648     ASSERT_ARGS(pf_debug_new)
2649     PackFile_Debug * const debug = mem_allocate_zeroed_typed(PackFile_Debug);
2650
2651     debug->mappings              = mem_allocate_typed(PackFile_DebugFilenameMapping *);
2652     debug->mappings[0]           = NULL;
2653
2654     return (PackFile_Segment *)debug;
2655 }
2656
2657
2658 /*
2659
2660 =item C<static size_t pf_debug_packed_size(PARROT_INTERP, PackFile_Segment
2661 *self)>
2662
2663 Returns the size of the C<PackFile_Debug> segment's filename in C<opcode_t>
2664 units.
2665
2666 =cut
2667
2668 */
2669
2670 static size_t
2671 pf_debug_packed_size(SHIM_INTERP, ARGIN(PackFile_Segment *self))
2672 {
2673     ASSERT_ARGS(pf_debug_packed_size)
2674     PackFile_Debug * const debug = (PackFile_Debug *)self;
2675
2676     return (debug->num_mappings*2) + 1;
2677 }
2678
2679
2680 /*
2681
2682 =item C<static opcode_t * pf_debug_pack(PARROT_INTERP, PackFile_Segment *self,
2683 opcode_t *cursor)>
2684
2685 Packs the debug segment, using the given cursor.
2686
2687 =cut
2688
2689 */
2690
2691 PARROT_WARN_UNUSED_RESULT
2692 PARROT_CANNOT_RETURN_NULL
2693 static opcode_t *
2694 pf_debug_pack(SHIM_INTERP, ARGMOD(PackFile_Segment *self), ARGOUT(opcode_t *cursor))
2695 {
2696     ASSERT_ARGS(pf_debug_pack)
2697     PackFile_Debug * const debug = (PackFile_Debug *)self;
2698     const              int n     = debug->num_mappings;
2699     int i;
2700
2701     /* Store number of mappings. */
2702     *cursor++ = n;
2703
2704     /* Now store each mapping. */
2705     for (i = 0; i < n; i++) {
2706         /* Bytecode offset and filename. */
2707         *cursor++ = debug->mappings[i]->offset;
2708         *cursor++ = debug->mappings[i]->filename;
2709     }
2710
2711     return cursor;
2712 }
2713
2714
2715 /*
2716
2717 =item C<static const opcode_t * pf_debug_unpack(PARROT_INTERP, PackFile_Segment
2718 *self, const opcode_t *cursor)>
2719
2720 Unpacks a debug segment into a PackFile_Debug structure, given the cursor.
2721
2722 =cut
2723
2724 */
2725
2726 PARROT_WARN_UNUSED_RESULT
2727 PARROT_CANNOT_RETURN_NULL
2728 static const opcode_t *
2729 pf_debug_unpack(PARROT_INTERP, ARGOUT(PackFile_Segment *self), ARGIN(const opcode_t *cursor))
2730 {
2731     ASSERT_ARGS(pf_debug_unpack)
2732     PackFile_Debug * const debug = (PackFile_Debug *)self;
2733     PackFile_ByteCode     *code;
2734     int                    i;
2735
2736     /* For some reason, we store the source file name in the segment
2737        name. So we can't find the bytecode seg without knowing the filename.
2738        But with the new scheme we can have many file names. For now, just
2739        base this on the name of the debug segment. */
2740     STRING *code_name = NULL;
2741     size_t str_len;
2742
2743     /* Number of mappings. */
2744     debug->num_mappings = PF_fetch_opcode(self->pf, &cursor);
2745
2746     /* Allocate space for mappings vector. */
2747     mem_realloc_n_typed(debug->mappings, debug->num_mappings + 1,
2748         PackFile_DebugFilenameMapping *);
2749
2750     /* Read in each mapping. */
2751     for (i = 0; i < debug->num_mappings; i++) {
2752         /* Allocate struct and get offset and filename type. */
2753         debug->mappings[i]           =
2754                 mem_allocate_typed(PackFile_DebugFilenameMapping);
2755         debug->mappings[i]->offset   = PF_fetch_opcode(self->pf, &cursor);
2756         debug->mappings[i]->filename = PF_fetch_opcode(self->pf, &cursor);
2757     }
2758
2759     /* find seg e.g. CODE_DB => CODE and attach it */
2760     str_len     = Parrot_str_length(interp, debug->base.name);
2761     code_name   = Parrot_str_substr(interp, debug->base.name, 0, str_len - 3, NULL, 1);
2762     code        = (PackFile_ByteCode *)PackFile_find_segment(interp, self->dir, code_name, 0);
2763
2764     if (!code || code->base.type != PF_BYTEC_SEG) {
2765         Parrot_ex_throw_from_c_args(interp, NULL, 1,
2766             "Code '%Ss' not found for debug segment '%Ss'\n",
2767             code_name, self->name);
2768     }
2769
2770     code->debugs = debug;
2771     debug->code  = code;
2772
2773     return cursor;
2774 }
2775
2776
2777 /*
2778
2779 =item C<static void pf_debug_dump(PARROT_INTERP, const PackFile_Segment *self)>
2780
2781 Dumps a debug segment to a human readable form.
2782
2783 =cut
2784
2785 */
2786
2787 static void
2788 pf_debug_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
2789 {
2790     ASSERT_ARGS(pf_debug_dump)
2791     const PackFile_Debug * const debug = (const PackFile_Debug *)self;
2792
2793     opcode_t i;
2794     size_t   j;
2795
2796     default_dump_header(interp, self);
2797
2798     Parrot_io_printf(interp, "\n  mappings => [\n");
2799     for (i = 0; i < debug->num_mappings; i++) {
2800         Parrot_io_printf(interp, "    #%d\n    [\n", i);
2801         Parrot_io_printf(interp, "        OFFSET => %d,\n",
2802                    debug->mappings[i]->offset);
2803         Parrot_io_printf(interp, "        FILENAME => %Ss\n",
2804                 PF_CONST(debug->code, debug->mappings[i]->filename)->u.string);
2805         Parrot_io_printf(interp, "    ],\n");
2806     }
2807
2808     Parrot_io_printf(interp, "  ]\n");
2809
2810     j = self->data ? 0: self->file_offset + 4;
2811
2812     if (j % 8)
2813         Parrot_io_printf(interp, "\n %04x:  ", (int) j);
2814
2815     for (; j < (self->data ? self->size :
2816             self->file_offset + self->op_count); j++) {
2817
2818         if (j % 8 == 0)
2819             Parrot_io_printf(interp, "\n %04x:  ", (int) j);
2820
2821         Parrot_io_printf(interp, "%08lx ", (unsigned long)
2822                 self->data ? self->data[j] : self->pf->src[j]);
2823     }
2824
2825     Parrot_io_printf(interp, "\n]\n");
2826 }
2827
2828
2829 /*
2830
2831 =item C<PackFile_Debug * Parrot_new_debug_seg(PARROT_INTERP, PackFile_ByteCode
2832 *cs, size_t size)>
2833
2834 Creates and appends (or resizes) a new debug seg for a code segment.  Uses the
2835 given size as its size.
2836
2837 =cut
2838
2839 */
2840
2841 PARROT_EXPORT
2842 PARROT_WARN_UNUSED_RESULT
2843 PARROT_CANNOT_RETURN_NULL
2844 PackFile_Debug *
2845 Parrot_new_debug_seg(PARROT_INTERP, ARGMOD(PackFile_ByteCode *cs), size_t size)
2846 {
2847     ASSERT_ARGS(Parrot_new_debug_seg)
2848     PackFile_Debug *debug;
2849
2850     /* it exists already, resize it */
2851     if (cs->debugs) {
2852         debug = cs->debugs;
2853         mem_realloc_n_typed(debug->base.data, size, opcode_t);
2854     }
2855     /* create one */
2856     else {
2857         STRING * name;
2858         const int add     = (interp->code && interp->code->base.dir);
2859         PackFile_Directory * const dir = add
2860                 ? interp->code->base.dir
2861                 : cs->base.dir
2862                     ? cs->base.dir
2863                     : &interp->initial_pf->directory;
2864
2865         name = Parrot_sprintf_c(interp, "%Ss_DB", cs->base.name);
2866         debug = (PackFile_Debug *)PackFile_Segment_new_seg(interp, dir,
2867                                     PF_DEBUG_SEG, name, add);
2868
2869         debug->base.data = mem_allocate_n_zeroed_typed(size, opcode_t);
2870         debug->code      = cs;
2871         cs->debugs       = debug;
2872     }
2873
2874     debug->base.size = size;
2875
2876     return debug;
2877 }
2878
2879
2880 /*
2881
2882 =item C<void Parrot_debug_add_mapping(PARROT_INTERP, PackFile_Debug *debug,
2883 opcode_t offset, const char *filename)>
2884
2885 Adds a bytecode offset to a filename mapping for a PackFile_Debug.
2886
2887 =cut
2888
2889 */
2890
2891 PARROT_EXPORT
2892 void
2893 Parrot_debug_add_mapping(PARROT_INTERP, ARGMOD(PackFile_Debug *debug),
2894                          opcode_t offset, ARGIN(const char *filename))
2895 {
2896     ASSERT_ARGS(Parrot_debug_add_mapping)
2897     PackFile_ConstTable * const    ct         = debug->code->const_table;
2898     int                            insert_pos = 0;
2899
2900     /* Allocate space for the extra entry. */
2901     mem_realloc_n_typed(debug->mappings, debug->num_mappings + 1,
2902         PackFile_DebugFilenameMapping *);
2903
2904     /* Can it just go on the end? */
2905     if (debug->num_mappings == 0
2906     ||  offset              >= debug->mappings[debug->num_mappings - 1]->offset)
2907         insert_pos = debug->num_mappings;
2908     else {
2909         /* Find the right place and shift stuff that's after it. */
2910         int i;
2911
2912         for (i = 0; i < debug->num_mappings; i++) {
2913             if (debug->mappings[i]->offset > offset) {
2914                 insert_pos = i;
2915                 memmove(debug->mappings + i + 1, debug->mappings + i,
2916                     debug->num_mappings - i);
2917                 break;
2918             }
2919         }
2920     }
2921
2922     /* Need to put filename in constants table. */
2923     {
2924         /* Set up new entry and insert it. */
2925         PackFile_DebugFilenameMapping *mapping =
2926                 mem_allocate_typed(PackFile_DebugFilenameMapping);
2927         STRING *namestr = Parrot_str_new_init(interp, filename, strlen(filename),
2928                 PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET, 0);
2929         size_t count = ct->const_count;
2930         size_t i;
2931
2932         mapping->offset       = offset;
2933
2934         /* Check if there is already a constant with this filename */
2935         for (i= 0; i < count; ++i) {
2936             if (ct->constants[i]->type == PFC_STRING &&
2937                     Parrot_str_equal(interp, namestr, ct->constants[i]->u.string))
2938                 break;
2939         }
2940         if (i < count) {
2941             /* There is one, use it */
2942             count = i;
2943        }
2944        else {
2945             /* Not found, create a new one */
2946             PackFile_Constant             *fnconst;
2947             ct->const_count   = ct->const_count + 1;
2948             mem_realloc_n_typed(ct->constants, ct->const_count, PackFile_Constant *);
2949
2950             fnconst           = PackFile_Constant_new(interp);
2951             fnconst->type     = PFC_STRING;
2952             fnconst->u.string = Parrot_str_new_init(interp, filename, strlen(filename),
2953                     PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET,
2954                     PObj_constant_FLAG);
2955             ct->constants[ct->const_count - 1] = fnconst;
2956         }
2957
2958         /* Set the mapped value */
2959         mapping->filename     = count;
2960         debug->mappings[insert_pos] = mapping;
2961         debug->num_mappings         = debug->num_mappings + 1;
2962     }
2963 }
2964
2965
2966 /*
2967
2968 =item C<STRING * Parrot_debug_pc_to_filename(PARROT_INTERP, const PackFile_Debug
2969 *debug, opcode_t pc)>
2970
2971 Returns the filename of the source for the given position in the bytecode.
2972
2973 =cut
2974
2975 */
2976
2977 PARROT_EXPORT
2978 PARROT_WARN_UNUSED_RESULT
2979 PARROT_CANNOT_RETURN_NULL
2980 STRING *
2981 Parrot_debug_pc_to_filename(PARROT_INTERP, ARGIN(const PackFile_Debug *debug),
2982     opcode_t pc)
2983 {
2984     ASSERT_ARGS(Parrot_debug_pc_to_filename)
2985     /* Look through mappings until we find one that maps the passed
2986        bytecode offset. */
2987
2988     int i;
2989     for (i = 0; i < debug->num_mappings; i++) {
2990         /* If this is the last mapping or the current position is
2991            between this mapping and the next one, return a filename. */
2992        if (i + 1                          == debug->num_mappings
2993        || (debug->mappings[i]->offset     <= pc
2994        &&  debug->mappings[i + 1]->offset >  pc))
2995             return PF_CONST(debug->code,
2996                     debug->mappings[i]->filename)->u.string;
2997     }
2998
2999     /* Otherwise, no mappings == no filename. */
3000     return string_from_literal(interp, "(unknown file)");
3001 }
3002
3003
3004 /*
3005
3006 =item C<void Parrot_switch_to_cs_by_nr(PARROT_INTERP, opcode_t seg)>
3007
3008 Switches the current bytecode segment to the segment keyed by number C<seg>.
3009
3010 =cut
3011
3012 */
3013
3014 PARROT_EXPORT
3015 void
3016 Parrot_switch_to_cs_by_nr(PARROT_INTERP, opcode_t seg)
3017 {
3018     ASSERT_ARGS(Parrot_switch_to_cs_by_nr)
3019     const PackFile_Directory * const dir      = interp->code->base.dir;
3020     const size_t                     num_segs = dir->num_segments;
3021
3022     size_t   i;
3023     opcode_t n;
3024
3025     /* TODO make an index of code segments for faster look up */
3026     for (i = n = 0; i < num_segs; i++) {
3027         if (dir->segments[i]->type == PF_BYTEC_SEG) {
3028             if (n == seg) {
3029                 Parrot_switch_to_cs(interp, (PackFile_ByteCode *)
3030                         dir->segments[i], 1);
3031                 return;
3032             }
3033             n++;
3034         }
3035     }
3036
3037     Parrot_ex_throw_from_c_args(interp, NULL, 1,
3038         "Segment number %d not found\n", (int)seg);
3039 }
3040
3041
3042 /*
3043
3044 =item C<PackFile_ByteCode * Parrot_switch_to_cs(PARROT_INTERP, PackFile_ByteCode
3045 *new_cs, int really)>
3046
3047 Switches to a bytecode segment C<new_cs>, returning the old segment.
3048
3049 =cut
3050
3051 */
3052
3053 PARROT_EXPORT
3054 PARROT_IGNORABLE_RESULT
3055 PARROT_CANNOT_RETURN_NULL
3056 PackFile_ByteCode *
3057 Parrot_switch_to_cs(PARROT_INTERP, ARGIN(PackFile_ByteCode *new_cs), int really)
3058 {
3059     ASSERT_ARGS(Parrot_switch_to_cs)
3060     PackFile_ByteCode * const cur_cs = interp->code;
3061
3062     if (!new_cs)
3063         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NO_PREV_CS,
3064             "No code segment to switch to\n");
3065
3066     /* compiling source code uses this function too,
3067      * which gives misleading trace messages */
3068     if (really && Interp_trace_TEST(interp, PARROT_TRACE_SUB_CALL_FLAG)) {
3069         Interp * const tracer = interp->pdb && interp->pdb->debugger
3070                               ? interp->pdb->debugger
3071                               : interp;
3072         Parrot_io_eprintf(tracer, "*** switching to %s\n", new_cs->base.name);
3073     }
3074
3075     interp->code               = new_cs;
3076     Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), really
3077                                ? find_constants(interp, new_cs->const_table)
3078                                : new_cs->const_table->constants);
3079
3080     /* new_cs->const_table->constants; */
3081     Parrot_pcc_set_pred_offset(interp, CURRENT_CONTEXT(interp),
3082         new_cs->base.data - (opcode_t*) new_cs->prederef.code);
3083
3084     if (really)
3085         prepare_for_run(interp);
3086
3087     return cur_cs;
3088 }
3089
3090
3091 /*
3092
3093 =item C<static PackFile_Constant * clone_constant(PARROT_INTERP,
3094 PackFile_Constant *old_const)>
3095
3096 Clones a constant (at least, if it's a Sub PMC), returning the clone.
3097
3098 =cut
3099
3100 */
3101
3102 PARROT_WARN_UNUSED_RESULT
3103 PARROT_CANNOT_RETURN_NULL
3104 static PackFile_Constant *
3105 clone_constant(PARROT_INTERP, ARGIN(PackFile_Constant *old_const))
3106 {
3107     ASSERT_ARGS(clone_constant)
3108     STRING * const _sub = CONST_STRING(interp, "Sub");
3109
3110     if (old_const->type == PFC_PMC
3111     &&  VTABLE_isa(interp, old_const->u.key, _sub)) {
3112         PMC        *old_sub_pmc, *new_sub_pmc;
3113         Parrot_Sub_attributes *old_sub,     *new_sub;
3114         PackFile_Constant * const ret = mem_allocate_typed(PackFile_Constant);
3115
3116         ret->type = old_const->type;
3117         old_sub_pmc   = old_const->u.key;
3118         new_sub_pmc   = Parrot_thaw_constants(interp, Parrot_freeze(interp, old_sub_pmc));
3119
3120         PMC_get_sub(interp, new_sub_pmc, new_sub);
3121         PMC_get_sub(interp, old_sub_pmc, old_sub);
3122         new_sub->seg = old_sub->seg;
3123
3124         /* Vtable overrides and methods were already cloned, so don't reclone them. */
3125         if (new_sub->vtable_index == -1
3126         && !(old_sub->comp_flags   &  SUB_COMP_FLAG_METHOD))
3127             Parrot_store_sub_in_namespace(interp, new_sub_pmc);
3128
3129         ret->u.key = new_sub_pmc;
3130
3131         return ret;
3132     }
3133
3134     return old_const;
3135 }
3136
3137
3138 /*
3139
3140 =item C<static PackFile_Constant ** find_constants(PARROT_INTERP,
3141 PackFile_ConstTable *ct)>
3142
3143 Finds the constant table associated with a thread. For now, we need to copy
3144 constant tables because some entries aren't really constant; e.g. subroutines
3145 need to refer to namespace pointers.
3146
3147 =cut
3148
3149 */
3150
3151 PARROT_WARN_UNUSED_RESULT
3152 PARROT_CANNOT_RETURN_NULL
3153 static PackFile_Constant **
3154 find_constants(PARROT_INTERP, ARGIN(PackFile_ConstTable *ct))
3155 {
3156     ASSERT_ARGS(find_constants)
3157     if (!n_interpreters
3158     ||  !interp->thread_data
3159     ||  interp->thread_data->tid == 0)
3160         return ct->constants;
3161     else {
3162         Hash               *tables;
3163         PackFile_Constant **new_consts;
3164
3165         PARROT_ASSERT(interp->thread_data);
3166
3167         if (!interp->thread_data->const_tables) {
3168             interp->thread_data->const_tables = parrot_new_pointer_hash(interp);
3169         }
3170
3171         tables     = interp->thread_data->const_tables;
3172         new_consts = (PackFile_Constant **)parrot_hash_get(interp, tables, ct);
3173
3174         if (!new_consts) {
3175             /* need to construct it */
3176             PackFile_Constant ** const old_consts = ct->constants;
3177             INTVAL               const num_consts = ct->const_count;
3178             INTVAL                     i;
3179
3180             new_consts = mem_allocate_n_typed(num_consts, PackFile_Constant *);
3181
3182             for (i = 0; i < num_consts; ++i)
3183                 new_consts[i] = clone_constant(interp, old_consts[i]);
3184
3185             parrot_hash_put(interp, tables, ct, new_consts);
3186         }
3187
3188         return new_consts;
3189     }
3190 }
3191
3192
3193 /*
3194
3195 =item C<void Parrot_destroy_constants(PARROT_INTERP)>
3196
3197 Destroys the constants for an interpreter.
3198
3199 =cut
3200
3201 */
3202
3203 PARROT_EXPORT
3204 void
3205 Parrot_destroy_constants(PARROT_INTERP)
3206 {
3207     ASSERT_ARGS(Parrot_destroy_constants)
3208     UINTVAL i;
3209     Hash *hash;
3210
3211     if (!interp->thread_data)
3212         return;
3213
3214     hash = interp->thread_data->const_tables;
3215
3216     if (!hash)
3217         return;
3218
3219     for (i = 0; i <= hash->mask; ++i) {
3220         HashBucket *bucket = hash->bi[i];
3221
3222         while (bucket) {
3223             PackFile_ConstTable * const table      =
3224                 (PackFile_ConstTable *)bucket->key;
3225             PackFile_Constant ** const orig_consts = table->constants;
3226             PackFile_Constant ** const consts      =
3227                 (PackFile_Constant **) bucket->value;
3228             INTVAL j;
3229
3230             for (j = 0; j < table->const_count; ++j) {
3231                 if (consts[j] != orig_consts[j])
3232                     mem_sys_free(consts[j]);
3233             }
3234
3235             mem_sys_free(consts);
3236             bucket = bucket->next;
3237         }
3238     }
3239
3240     parrot_hash_destroy(interp, hash);
3241 }
3242
3243
3244 /*
3245
3246 =back
3247
3248 =head2 PackFile FixupTable Structure Functions
3249
3250 =over 4
3251
3252 =item C<void PackFile_FixupTable_clear(PARROT_INTERP, PackFile_FixupTable
3253 *self)>
3254
3255 Clears a PackFile FixupTable.
3256
3257 =cut
3258
3259 */
3260
3261 PARROT_EXPORT
3262 void
3263 PackFile_FixupTable_clear(PARROT_INTERP, ARGMOD(PackFile_FixupTable *self))
3264 {
3265     ASSERT_ARGS(PackFile_FixupTable_clear)
3266     opcode_t i;
3267
3268     if (!self) {
3269         Parrot_io_eprintf(interp, "PackFile_FixupTable_clear: self == NULL!\n");
3270         return;
3271     }
3272
3273     for (i = 0; i < self->fixup_count; i++) {
3274         mem_sys_free(self->fixups[i]->name);
3275         self->fixups[i]->name = NULL;
3276
3277         mem_sys_free(self->fixups[i]);
3278         self->fixups[i] = NULL;
3279     }
3280
3281     if (self->fixup_count) {
3282         mem_sys_free(self->fixups);
3283         self->fixups = NULL;
3284     }
3285
3286     self->fixups      = NULL;
3287     self->fixup_count = 0;
3288
3289     return;
3290 }
3291
3292
3293 /*
3294
3295 =item C<static void fixup_destroy(PARROT_INTERP, PackFile_Segment *self)>
3296
3297 Calls C<PackFile_FixupTable_clear()> with C<self>.
3298
3299 =cut
3300
3301 */
3302
3303 static void
3304 fixup_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
3305 {
3306     ASSERT_ARGS(fixup_destroy)
3307     PackFile_FixupTable * const ft = (PackFile_FixupTable *)self;
3308     PackFile_FixupTable_clear(interp, ft);
3309 }
3310
3311
3312 /*
3313
3314 =item C<static size_t fixup_packed_size(PARROT_INTERP, PackFile_Segment *self)>
3315
3316 I<What does this do?>
3317
3318 =cut
3319
3320 */
3321
3322 static size_t
3323 fixup_packed_size(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
3324 {
3325     ASSERT_ARGS(fixup_packed_size)
3326     PackFile_FixupTable * const ft   = (PackFile_FixupTable *)self;
3327     size_t                      size = 1;
3328     opcode_t i;
3329
3330     for (i = 0; i < ft->fixup_count; i++) {
3331         /* fixup_entry type */
3332         size++;
3333         switch (ft->fixups[i]->type) {
3334             case enum_fixup_label:
3335             case enum_fixup_sub:
3336                 size += PF_size_cstring(ft->fixups[i]->name);
3337                 size ++; /* offset */
3338                 break;
3339             case enum_fixup_none:
3340                 break;
3341             default:
3342                 Parrot_ex_throw_from_c_args(interp, NULL, 1,
3343                     "Unknown fixup type\n");
3344         }
3345     }
3346
3347     return size;
3348 }
3349
3350
3351 /*
3352
3353 =item C<static opcode_t * fixup_pack(PARROT_INTERP, PackFile_Segment *self,
3354 opcode_t *cursor)>
3355
3356 Packs the fixup table for a given packfile.
3357
3358 =cut
3359
3360 */
3361
3362 PARROT_WARN_UNUSED_RESULT
3363 PARROT_CANNOT_RETURN_NULL
3364 static opcode_t *
3365 fixup_pack(PARROT_INTERP, ARGIN(PackFile_Segment *self), ARGOUT(opcode_t *cursor))
3366 {
3367     ASSERT_ARGS(fixup_pack)
3368     PackFile_FixupTable * const ft = (PackFile_FixupTable *)self;
3369     opcode_t i;
3370
3371     *cursor++ = ft->fixup_count;
3372
3373     for (i = 0; i < ft->fixup_count; i++) {
3374         *cursor++ = (opcode_t) ft->fixups[i]->type;
3375         switch (ft->fixups[i]->type) {
3376             case enum_fixup_label:
3377             case enum_fixup_sub:
3378                 cursor    = PF_store_cstring(cursor, ft->fixups[i]->name);
3379                 *cursor++ = ft->fixups[i]->offset;
3380                 break;
3381             case enum_fixup_none:
3382                 break;
3383             default:
3384                 Parrot_ex_throw_from_c_args(interp, NULL, 1,
3385                     "Unknown fixup type\n");
3386         }
3387     }
3388
3389     return cursor;
3390 }
3391
3392
3393 /*
3394
3395 =item C<static PackFile_Segment * fixup_new(PARROT_INTERP, PackFile *pf, STRING
3396 *name, int add)>
3397
3398 Returns a new C<PackFile_FixupTable> segment.
3399
3400 =cut
3401
3402 */
3403
3404 PARROT_WARN_UNUSED_RESULT
3405 PARROT_CANNOT_RETURN_NULL
3406 static PackFile_Segment *
3407 fixup_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(STRING *name), SHIM(int add))
3408 {
3409     ASSERT_ARGS(fixup_new)
3410     PackFile_FixupTable * const fixup = mem_allocate_zeroed_typed(PackFile_FixupTable);
3411
3412     return (PackFile_Segment *) fixup;
3413 }
3414
3415
3416 /*
3417
3418 =item C<static const opcode_t * fixup_unpack(PARROT_INTERP, PackFile_Segment
3419 *seg, const opcode_t *cursor)>
3420
3421 Unpacks a PackFile FixupTable from a block of memory, given a cursor.
3422
3423 Returns one (1) if everything is okay, else zero (0).
3424
3425 =cut
3426
3427 */
3428
3429 PARROT_WARN_UNUSED_RESULT
3430 PARROT_CAN_RETURN_NULL
3431 static const opcode_t *
3432 fixup_unpack(PARROT_INTERP, ARGIN(PackFile_Segment *seg), ARGIN(const opcode_t *cursor))
3433 {
3434     ASSERT_ARGS(fixup_unpack)
3435     PackFile_FixupTable * const self = (PackFile_FixupTable *)seg;
3436     PackFile                   *pf;
3437     opcode_t                    i;
3438
3439     if (!self) {
3440         Parrot_io_eprintf(interp,
3441             "PackFile_FixupTable_unpack: self == NULL!\n");
3442         return NULL;
3443     }
3444
3445     PackFile_FixupTable_clear(interp, self);
3446
3447     pf                = self->base.pf;
3448     self->fixup_count = PF_fetch_opcode(pf, &cursor);
3449
3450     TRACE_PRINTF(("PackFile_FixupTable_unpack(): %ld entries\n",
3451         self->fixup_count));
3452
3453     if (self->fixup_count) {
3454         self->fixups = (PackFile_FixupEntry **)mem_sys_allocate_zeroed(
3455             self->fixup_count * sizeof (PackFile_FixupEntry *));
3456
3457         if (!self->fixups) {
3458             Parrot_io_eprintf(interp,
3459                     "PackFile_FixupTable_unpack: Could not allocate "
3460                     "memory for array!\n");
3461             self->fixup_count = 0;
3462             return NULL;
3463         }
3464     }
3465
3466     for (i = 0; i < self->fixup_count; i++) {
3467         PackFile_FixupEntry * const entry           =
3468                                     self->fixups[i] =
3469                                     mem_allocate_typed(PackFile_FixupEntry);
3470
3471         entry->type = PF_fetch_opcode(pf, &cursor);
3472
3473         switch (entry->type) {
3474             case enum_fixup_label:
3475             case enum_fixup_sub:
3476                 entry->name   = PF_fetch_cstring(pf, &cursor);
3477                 entry->offset = PF_fetch_opcode(pf, &cursor);
3478                 TRACE_PRINTF_VAL(("PackFile_FixupTable_unpack(): type %d, "
3479                     "name %s, offset %ld\n",
3480                     entry->type, entry->name, entry->offset));
3481                 break;
3482             case enum_fixup_none:
3483                 break;
3484             default:
3485                 Parrot_io_eprintf(interp,
3486                     "PackFile_FixupTable_unpack: Unknown fixup type %d!\n",
3487                     entry->type);
3488                 return NULL;
3489         }
3490     }
3491
3492     return cursor;
3493 }
3494
3495
3496 /*
3497
3498 =item C<void PackFile_FixupTable_new_entry(PARROT_INTERP, const char *label,
3499 INTVAL type, opcode_t offs)>
3500
3501 Adds a new fix-up entry with label and type.  Creates a new PackFile FixupTable
3502 if none is present.
3503
3504 =cut
3505
3506 */
3507
3508 PARROT_EXPORT
3509 void
3510 PackFile_FixupTable_new_entry(PARROT_INTERP,
3511         ARGIN(const char *label), INTVAL type, opcode_t offs)
3512 {
3513     ASSERT_ARGS(PackFile_FixupTable_new_entry)
3514     PackFile_FixupTable *self = interp->code->fixups;
3515     opcode_t             i;
3516
3517     if (!self) {
3518         self = (PackFile_FixupTable *) PackFile_Segment_new_seg(
3519                 interp, interp->code->base.dir, PF_FIXUP_SEG,
3520                 FIXUP_TABLE_SEGMENT_NAME, 1);
3521
3522         interp->code->fixups = self;
3523         self->code           = interp->code;
3524     }
3525
3526     i = self->fixup_count++;
3527     mem_realloc_n_typed(self->fixups, self->fixup_count, PackFile_FixupEntry *);
3528
3529     self->fixups[i]         = mem_allocate_typed(PackFile_FixupEntry);
3530     self->fixups[i]->type   = type;
3531     self->fixups[i]->name   = mem_sys_strdup(label);
3532     self->fixups[i]->offset = offs;
3533 }
3534
3535
3536 /*
3537
3538 =item C<static PackFile_FixupEntry * find_fixup(PackFile_FixupTable *ft, INTVAL
3539 type, const char *name)>
3540
3541 Finds the fix-up entry in a given FixupTable C<ft> for C<type> and C<name> and
3542 returns it.
3543
3544 This ignores directories. For a recursive version see
3545 C<PackFile_find_fixup_entry()>.
3546
3547 =cut
3548
3549 */
3550
3551 PARROT_WARN_UNUSED_RESULT
3552 PARROT_CAN_RETURN_NULL
3553 static PackFile_FixupEntry *
3554 find_fixup(ARGMOD(PackFile_FixupTable *ft), INTVAL type, ARGIN(const char *name))
3555 {
3556     ASSERT_ARGS(find_fixup)
3557     opcode_t i;
3558     for (i = 0; i < ft->fixup_count; i++) {
3559         if ((INTVAL)((enum_fixup_t)ft->fixups[i]->type) == type
3560         &&  STREQ(ft->fixups[i]->name, name)) {
3561             return ft->fixups[i];
3562         }
3563     }
3564
3565     return NULL;
3566 }
3567
3568
3569 /*
3570
3571 =item C<static INTVAL find_fixup_iter(PARROT_INTERP, PackFile_Segment *seg, void
3572 *user_data)>
3573
3574 Internal iterator for C<PackFile_find_fixup_entry>; recurses into directories.
3575
3576 =cut
3577
3578 */
3579
3580 static INTVAL
3581 find_fixup_iter(PARROT_INTERP, ARGIN(PackFile_Segment *seg), ARGIN(void *user_data))
3582 {
3583     ASSERT_ARGS(find_fixup_iter)
3584     if (seg->type == PF_DIR_SEG) {
3585         if (PackFile_map_segments(interp, (PackFile_Directory *)seg,
3586                     find_fixup_iter, user_data))
3587             return 1;
3588     }
3589     else if (seg->type == PF_FIXUP_SEG) {
3590         PackFile_FixupEntry ** const e  = (PackFile_FixupEntry **)user_data;
3591         PackFile_FixupEntry *  const fe = (PackFile_FixupEntry *)find_fixup(
3592                 (PackFile_FixupTable *) seg, (*e)->type, (*e)->name);
3593
3594         if (fe) {
3595             *e = fe;
3596             return 1;
3597         }
3598     }
3599
3600     return 0;
3601 }
3602
3603
3604 /*
3605
3606 =item C<PackFile_FixupEntry * PackFile_find_fixup_entry(PARROT_INTERP, INTVAL
3607 type, char *name)>
3608
3609 Searches the whole PackFile recursively for a fix-up entry with the given
3610 C<type> and C<name>, and returns the found entry or NULL.
3611
3612 This also recurses into directories, compared to the simplier C<find_fixup>
3613 which just searches one PackFile_FixupTable.
3614
3615 =cut
3616
3617 */
3618
3619 PARROT_EXPORT
3620 PARROT_WARN_UNUSED_RESULT
3621 PARROT_CAN_RETURN_NULL
3622 PackFile_FixupEntry *
3623 PackFile_find_fixup_entry(PARROT_INTERP, INTVAL type, ARGIN(char *name))
3624 {
3625     ASSERT_ARGS(PackFile_find_fixup_entry)
3626
3627     /* TODO make a hash of all fixups */
3628     PackFile_Directory  * const dir = interp->code->base.dir;
3629     PackFile_FixupEntry * const ep  = mem_allocate_typed(PackFile_FixupEntry);
3630
3631     ep->type = type;
3632     ep->name = name;
3633
3634     if (PackFile_map_segments(interp, dir, find_fixup_iter, (void *) ep))
3635         return ep;
3636
3637     return NULL;
3638 }
3639
3640
3641 /*
3642
3643 =back
3644
3645 =head2 PackFile ConstTable Structure Functions
3646
3647 =over 4
3648
3649 =item C<void PackFile_ConstTable_clear(PARROT_INTERP, PackFile_ConstTable
3650 *self)>
3651
3652 Clear the C<PackFile_ConstTable> C<self>.
3653
3654 =cut
3655
3656 */
3657
3658 PARROT_EXPORT
3659 void
3660 PackFile_ConstTable_clear(PARROT_INTERP, ARGMOD(PackFile_ConstTable *self))
3661 {
3662     ASSERT_ARGS(PackFile_ConstTable_clear)
3663     opcode_t i;
3664
3665     for (i = 0; i < self->const_count; i++) {
3666         PackFile_Constant_destroy(interp, self->constants[i]);
3667         self->constants[i] = NULL;
3668     }
3669
3670     if (self->constants) {
3671         mem_sys_free(self->constants);
3672         self->constants = NULL;
3673     }
3674
3675     self->const_count = 0;
3676
3677     return;
3678 }
3679
3680
3681 /*
3682
3683 =item C<const opcode_t * PackFile_ConstTable_unpack(PARROT_INTERP,
3684 PackFile_Segment *seg, const opcode_t *cursor)>
3685
3686 Unpacks a PackFile ConstTable from a block of memory. The format is:
3687
3688   opcode_t const_count
3689   *  constants
3690
3691 Returns cursor if everything is OK, else zero (0).
3692
3693 =cut
3694
3695 */
3696
3697 PARROT_EXPORT
3698 PARROT_WARN_UNUSED_RESULT
3699 PARROT_CAN_RETURN_NULL
3700 const opcode_t *
3701 PackFile_ConstTable_unpack(PARROT_INTERP, ARGIN(PackFile_Segment *seg),
3702         ARGIN(const opcode_t *cursor))
3703 {
3704     ASSERT_ARGS(PackFile_ConstTable_unpack)
3705     PackFile_ConstTable * const self = (PackFile_ConstTable *)seg;
3706     PackFile            * const pf   = seg->pf;
3707     opcode_t                    i;
3708
3709     PackFile_ConstTable_clear(interp, self);
3710
3711     self->const_count = PF_fetch_opcode(pf, &cursor);
3712
3713     TRACE_PRINTF(("PackFile_ConstTable_unpack: Unpacking %ld constants\n",
3714                   self->const_count));
3715
3716     if (self->const_count == 0)
3717         return cursor;
3718
3719     self->constants = mem_allocate_n_zeroed_typed(self->const_count,
3720                 PackFile_Constant *);
3721
3722     if (!self->constants) {
3723         Parrot_io_eprintf(interp,
3724             "PackFile_ConstTable_unpack: Could not allocate memory for array!\n");
3725         self->const_count = 0;
3726         return NULL;
3727     }
3728
3729     for (i = 0; i < self->const_count; i++) {
3730         TRACE_PRINTF(("PackFile_ConstTable_unpack(): Unpacking constant %ld/%ld\n",
3731             i, self->const_count));
3732         self->constants[i] = PackFile_Constant_new(interp);
3733
3734         cursor = PackFile_Constant_unpack(interp, self, self->constants[i],
3735                     cursor);
3736     }
3737
3738     return cursor;
3739 }
3740
3741
3742 /*
3743
3744 =item C<static PackFile_Segment * const_new(PARROT_INTERP, PackFile *pf, STRING
3745 *name, int add)>
3746
3747 Returns a new C<PackFile_ConstTable> segment.
3748
3749 =cut
3750
3751 */
3752
3753 PARROT_MALLOC
3754 PARROT_CANNOT_RETURN_NULL
3755 static PackFile_Segment *
3756 const_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(STRING *name), SHIM(int add))
3757 {
3758     ASSERT_ARGS(const_new)
3759     PackFile_ConstTable * const const_table = mem_allocate_zeroed_typed(PackFile_ConstTable);
3760
3761     return (PackFile_Segment *)const_table;
3762 }
3763
3764
3765 /*
3766
3767 =item C<static void const_destroy(PARROT_INTERP, PackFile_Segment *self)>
3768
3769 Destroys the C<PackFile_ConstTable> C<self>.
3770
3771 =cut
3772
3773 */
3774
3775 static void
3776 const_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
3777 {
3778     ASSERT_ARGS(const_destroy)
3779     PackFile_ConstTable * const ct = (PackFile_ConstTable *)self;
3780     PackFile_ConstTable_clear(interp, ct);
3781 }
3782
3783
3784 /*
3785
3786 =back
3787
3788 =head2 PackFile Constant Structure Functions
3789
3790 =over 4
3791
3792 =item C<PackFile_Constant * PackFile_Constant_new(PARROT_INTERP)>
3793
3794 Allocates a new empty PackFile Constant.
3795
3796 This is only here so we can make a new one and then do an unpack.
3797
3798 =cut
3799
3800 */
3801
3802 PARROT_EXPORT
3803 PARROT_MALLOC
3804 PARROT_CANNOT_RETURN_NULL
3805 PackFile_Constant *
3806 PackFile_Constant_new(SHIM_INTERP)
3807 {
3808     ASSERT_ARGS(PackFile_Constant_new)
3809     PackFile_Constant * const self = mem_allocate_zeroed_typed(PackFile_Constant);
3810
3811     self->type = PFC_NONE;
3812
3813     return self;
3814 }
3815
3816
3817 /*
3818
3819 =item C<void PackFile_Constant_destroy(PARROT_INTERP, PackFile_Constant *self)>
3820
3821 Deletes the C<PackFile_Constant> C<self>.
3822
3823 Don't delete C<PMC>s or C<STRING>s.  The GC will claim them.
3824
3825 =cut
3826
3827 */
3828
3829 PARROT_EXPORT
3830 void
3831 PackFile_Constant_destroy(SHIM_INTERP, ARGMOD_NULLOK(PackFile_Constant *self))
3832 {
3833     ASSERT_ARGS(PackFile_Constant_destroy)
3834     mem_sys_free(self);
3835 }
3836
3837
3838 /*
3839
3840 =item C<size_t PackFile_Constant_pack_size(PARROT_INTERP, const
3841 PackFile_Constant *self)>
3842
3843 Determines the size of the buffer needed in order to pack the PackFile Constant
3844 into a contiguous region of memory.
3845
3846 =cut
3847
3848 */
3849
3850 PARROT_EXPORT
3851 PARROT_WARN_UNUSED_RESULT
3852 size_t
3853 PackFile_Constant_pack_size(PARROT_INTERP, ARGIN(const PackFile_Constant *self))
3854 {
3855     ASSERT_ARGS(PackFile_Constant_pack_size)
3856     PMC    *component;
3857     STRING *image;
3858     size_t  packed_size;
3859
3860     switch (self->type) {
3861         case PFC_NUMBER:
3862             packed_size = PF_size_number();
3863             break;
3864
3865         case PFC_STRING:
3866             packed_size = PF_size_string(self->u.string);
3867             break;
3868
3869         case PFC_KEY:
3870             packed_size = 1;
3871
3872             for (component = self->u.key; component;){
3873                 packed_size += 2;
3874                 GETATTR_Key_next_key(interp, component, component);
3875             }
3876             break;
3877
3878         case PFC_PMC:
3879             component = self->u.key; /* the pmc (Sub, ...) */
3880
3881             /*
3882              * TODO create either
3883              * a) a frozen_size freeze entry or
3884              * b) change packout.c so that component size isn't needed
3885              */
3886             image       = Parrot_freeze(interp, component);
3887             packed_size = PF_size_string(image);
3888             break;
3889
3890         default:
3891             Parrot_io_eprintf(NULL,
3892                     "Constant_packed_size: Unrecognized type '%c'!\n",
3893                     (char)self->type);
3894             return 0;
3895     }
3896
3897     /* Tack on space for the initial type field */
3898     return packed_size + 1;
3899 }
3900
3901
3902 /*
3903
3904 =item C<const opcode_t * PackFile_Constant_unpack(PARROT_INTERP,
3905 PackFile_ConstTable *constt, PackFile_Constant *self, const opcode_t *cursor)>
3906
3907 Unpacks a PackFile Constant from a block of memory. The format is:
3908
3909   opcode_t type
3910   *  data
3911
3912 Returns cursor if everything is okay, else NULL.
3913
3914 =cut
3915
3916 */
3917
3918 PARROT_EXPORT
3919 PARROT_WARN_UNUSED_RESULT
3920 PARROT_CAN_RETURN_NULL
3921 const opcode_t *
3922 PackFile_Constant_unpack(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt),
3923         ARGOUT(PackFile_Constant *self), ARGIN(const opcode_t *cursor))
3924 {
3925     ASSERT_ARGS(PackFile_Constant_unpack)
3926     PackFile * const pf   = constt->base.pf;
3927     const opcode_t   type = PF_fetch_opcode(pf, &cursor);
3928
3929     TRACE_PRINTF(("PackFile_Constant_unpack(): Type is %ld ('%c')...\n",
3930                   type, (char)type));
3931
3932     switch (type) {
3933         case PFC_NUMBER:
3934             self->u.number = PF_fetch_number(pf, &cursor);
3935             self->type     = PFC_NUMBER;
3936             break;
3937
3938         case PFC_STRING:
3939             self->u.string = PF_fetch_string(interp, pf, &cursor);
3940             self->type     = PFC_STRING;
3941             break;
3942
3943         case PFC_KEY:
3944             cursor = PackFile_Constant_unpack_key(interp, constt,
3945                     self, cursor);
3946             break;
3947
3948         case PFC_PMC:
3949             cursor = PackFile_Constant_unpack_pmc(interp, constt,
3950                     self, cursor);
3951             break;
3952         default:
3953             Parrot_io_eprintf(NULL,
3954                     "Constant_unpack: Unrecognized type '%c' during unpack!\n",
3955                     (char)type);
3956             return NULL;
3957     }
3958
3959     return cursor;
3960 }
3961
3962
3963 /*
3964
3965 =item C<const opcode_t * PackFile_Constant_unpack_pmc(PARROT_INTERP,
3966 PackFile_ConstTable *constt, PackFile_Constant *self, const opcode_t *cursor)>
3967
3968 Unpacks a constant PMC.
3969
3970 =cut
3971
3972 */
3973
3974 PARROT_EXPORT
3975 PARROT_WARN_UNUSED_RESULT
3976 PARROT_CANNOT_RETURN_NULL
3977 const opcode_t *
3978 PackFile_Constant_unpack_pmc(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt),
3979         ARGMOD(PackFile_Constant *self), ARGIN(const opcode_t *cursor))
3980 {
3981     ASSERT_ARGS(PackFile_Constant_unpack_pmc)
3982     PackFile * const pf   = constt->base.pf;
3983     STRING          *_sub = CONST_STRING(interp, "Sub");
3984     STRING          *image;
3985     PMC             *pmc;
3986
3987     /* thawing the PMC needs the real packfile in place */
3988     PackFile_ByteCode * const cs_save = interp->code;
3989     interp->code                      = pf->cur_cs;
3990     image                             = PF_fetch_string(interp, pf, &cursor);
3991
3992     /*
3993      * TODO use thaw_constants
3994      * current issue: a constant Sub with attached properties
3995      *                doesn't GC mark the properties
3996      * for a constant PMC *all* contents have to be in the constant pools
3997      */
3998     pmc         = Parrot_thaw(interp, image);
3999
4000     /* place item in const_table */
4001     self->type  = PFC_PMC;
4002     self->u.key = pmc;
4003
4004     /* finally place the sub into some namespace stash
4005      * XXX place this code in Sub.thaw ?  */
4006     if (VTABLE_isa(interp, pmc, _sub))
4007         Parrot_store_sub_in_namespace(interp, pmc);
4008
4009     /* restore code */
4010     interp->code = cs_save;
4011
4012     return cursor;
4013 }
4014
4015
4016 /*
4017
4018 =item C<const opcode_t * PackFile_Constant_unpack_key(PARROT_INTERP,
4019 PackFile_ConstTable *constt, PackFile_Constant *self, const opcode_t *cursor)>
4020
4021 Unpacks a PackFile Constant from a block of memory. The format consists of a
4022 sequence of key atoms, each with the following format:
4023
4024   opcode_t type
4025   opcode_t value
4026
4027 Returns cursor if everything is OK, else NULL.
4028
4029 =cut
4030
4031 */
4032
4033 PARROT_EXPORT
4034 PARROT_WARN_UNUSED_RESULT
4035 PARROT_CAN_RETURN_NULL
4036 const opcode_t *
4037 PackFile_Constant_unpack_key(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt),
4038         ARGMOD(PackFile_Constant *self), ARGIN(const opcode_t *cursor))
4039 {
4040     ASSERT_ARGS(PackFile_Constant_unpack_key)
4041     PackFile * const pf         = constt->base.pf;
4042     PMC             *head       = NULL;
4043     PMC             *tail       = NULL;
4044     INTVAL           components = (INTVAL)PF_fetch_opcode(pf, &cursor);
4045     int              pmc_enum   = enum_class_Key;
4046
4047     while (components-- > 0) {
4048         opcode_t       type       = PF_fetch_opcode(pf, &cursor);
4049         const opcode_t slice_bits = type & PF_VT_SLICE_BITS;
4050         opcode_t        op;
4051
4052         type &= ~PF_VT_SLICE_BITS;
4053
4054         if (tail) {
4055             SETATTR_Key_next_key(interp, tail, constant_pmc_new(interp, pmc_enum));
4056             GETATTR_Key_next_key(interp, tail, tail);
4057         }
4058         else
4059             head = tail = constant_pmc_new(interp, pmc_enum);
4060
4061         op = PF_fetch_opcode(pf, &cursor);
4062
4063         switch (type) {
4064             case PARROT_ARG_IC:
4065                 key_set_integer(interp, tail, op);
4066                 break;
4067             case PARROT_ARG_NC:
4068                 key_set_number(interp, tail, constt->constants[op]->u.number);
4069                 break;
4070             case PARROT_ARG_SC:
4071                 key_set_string(interp, tail, constt->constants[op]->u.string);
4072                 break;
4073             case PARROT_ARG_I:
4074                 key_set_register(interp, tail, op, KEY_integer_FLAG);
4075                 break;
4076             case PARROT_ARG_N:
4077                 key_set_register(interp, tail, op, KEY_number_FLAG);
4078                 break;
4079             case PARROT_ARG_S:
4080                 key_set_register(interp, tail, op, KEY_string_FLAG);
4081                 break;
4082             case PARROT_ARG_P:
4083                 key_set_register(interp, tail, op, KEY_pmc_FLAG);
4084                 break;
4085             default:
4086                 return NULL;
4087         }
4088     }
4089
4090     self->type  = PFC_KEY;
4091     self->u.key = head;
4092
4093     return cursor;
4094 }
4095
4096
4097 /*
4098
4099 =item C<PackFile_Segment * PackFile_Annotations_new(PARROT_INTERP, struct
4100 PackFile *pf, STRING *name, int add)>
4101
4102 Creates a new annotations segment structure. Ignores the parameters C<name> and
4103 C<add>.
4104
4105 =cut
4106
4107 */
4108 PARROT_EXPORT
4109 PARROT_CANNOT_RETURN_NULL
4110 PackFile_Segment *
4111 PackFile_Annotations_new(SHIM_INTERP, SHIM(struct PackFile *pf),
4112         SHIM(STRING *name), SHIM(int add))
4113 {
4114     ASSERT_ARGS(PackFile_Annotations_new)
4115
4116     /* Allocate annotations structure; create it all zeroed, and we will
4117      * allocate memory for each of the arrays on demand. */
4118     PackFile_Annotations * const seg = mem_allocate_zeroed_typed(PackFile_Annotations);
4119     return (PackFile_Segment *) seg;
4120 }
4121
4122
4123 /*
4124
4125 =item C<void PackFile_Annotations_destroy(PARROT_INTERP, PackFile_Segment *seg)>
4126
4127 Frees all memory associated with an annotations segment.
4128
4129 =cut
4130
4131 */
4132
4133 void
4134 PackFile_Annotations_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *seg))
4135 {
4136     ASSERT_ARGS(PackFile_Annotations_destroy)
4137     PackFile_Annotations *self = (PackFile_Annotations *)seg;
4138     INTVAL                i;
4139
4140     /* Free any keys. */
4141     if (self->keys) {
4142         for (i = 0; i < self->num_keys; i++)
4143             mem_sys_free(self->keys[i]);
4144
4145         mem_sys_free(self->keys);
4146     }
4147
4148     /* Free any groups. */
4149     if (self->groups) {
4150         for (i = 0; i < self->num_groups; i++)
4151             mem_sys_free(self->groups[i]);
4152         mem_sys_free(self->groups);
4153     }
4154
4155     /* Free any entries. */
4156     if (self->entries) {
4157         for (i = 0; i < self->num_entries; i++)
4158             mem_sys_free(self->entries[i]);
4159         mem_sys_free(self->entries);
4160     }
4161 }
4162
4163
4164 /*
4165
4166 =item C<size_t PackFile_Annotations_packed_size(PARROT_INTERP, PackFile_Segment
4167 *seg)>
4168
4169 Computes the number of opcode_ts needed to store the passed annotations
4170 segment.
4171
4172 =cut
4173
4174 */
4175
4176 PARROT_WARN_UNUSED_RESULT
4177 size_t
4178 PackFile_Annotations_packed_size(SHIM_INTERP, ARGIN(PackFile_Segment *seg))
4179 {
4180     ASSERT_ARGS(PackFile_Annotations_packed_size)
4181     const PackFile_Annotations * const self = (PackFile_Annotations *)seg;
4182     return 3                      /* Counts. */
4183          + self->num_keys    * 2  /* Keys. */
4184          + self->num_groups  * 2  /* Groups. */
4185          + self->num_entries * 3; /* Entries. */
4186 }
4187
4188
4189 /*
4190
4191 =item C<opcode_t * PackFile_Annotations_pack(PARROT_INTERP, PackFile_Segment
4192 *seg, opcode_t *cursor)>
4193
4194 Packs this segment into bytecode.
4195
4196 =cut
4197
4198 */
4199
4200 PARROT_WARN_UNUSED_RESULT
4201 PARROT_CANNOT_RETURN_NULL
4202 opcode_t *
4203 PackFile_Annotations_pack(PARROT_INTERP, ARGIN(PackFile_Segment *seg),
4204         ARGMOD(opcode_t *cursor))
4205 {
4206     ASSERT_ARGS(PackFile_Annotations_pack)
4207     const PackFile_Annotations * const self = (PackFile_Annotations *)seg;
4208     INTVAL i;
4209
4210     /* Write key count and any keys. */
4211     *cursor++ = self->num_keys;
4212
4213     for (i = 0; i < self->num_keys; i++) {
4214         const PackFile_Annotations_Key * const key = self->keys[i];
4215         *cursor++ = key->name;
4216         *cursor++ = key->type;
4217     }
4218
4219     /* Write group count and any groups. */
4220     *cursor++ = self->num_groups;
4221
4222     for (i = 0; i < self->num_groups; i++) {
4223         const PackFile_Annotations_Group * const group = self->groups[i];
4224         *cursor++ = group->bytecode_offset;
4225         *cursor++ = group->entries_offset;
4226     }
4227
4228     /* Write entry count and any entries. */
4229     *cursor++ = self->num_entries;
4230
4231     for (i = 0; i < self->num_entries; i++) {
4232         const PackFile_Annotations_Entry * const entry = self->entries[i];
4233         *cursor++ = entry->bytecode_offset;
4234         *cursor++ = entry->key;
4235         *cursor++ = entry->value;
4236     }
4237
4238     return cursor;
4239 }
4240
4241
4242 /*
4243
4244 =item C<const opcode_t * PackFile_Annotations_unpack(PARROT_INTERP,
4245 PackFile_Segment *seg, const opcode_t *cursor)>
4246
4247 Unpacks this segment from the bytecode.
4248
4249 =cut
4250
4251 */
4252
4253 PARROT_CANNOT_RETURN_NULL
4254 const opcode_t *
4255 PackFile_Annotations_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *seg),
4256         ARGIN(const opcode_t *cursor))
4257 {
4258     ASSERT_ARGS(PackFile_Annotations_unpack)
4259     PackFile_Annotations *self = (PackFile_Annotations *)seg;
4260     PackFile_ByteCode    *code;
4261     STRING               *code_name;
4262 #if TRACE_PACKFILE
4263     PackFile * const pf  = seg->pf;
4264 #endif
4265     INTVAL               i, str_len;
4266
4267     /* Unpack keys. */
4268     self->num_keys = PF_fetch_opcode(seg->pf, &cursor);
4269
4270     TRACE_PRINTF(("PackFile_Annotations_unpack: Unpacking %ld keys\n",
4271                   self->num_keys));
4272
4273     self->keys     = mem_allocate_n_typed(self->num_keys, PackFile_Annotations_Key *);
4274
4275     for (i = 0; i < self->num_keys; i++) {
4276         PackFile_Annotations_Key * const key =
4277             self->keys[i] = mem_allocate_typed(PackFile_Annotations_Key);
4278         key->name = PF_fetch_opcode(seg->pf, &cursor);
4279         key->type = PF_fetch_opcode(seg->pf, &cursor);
4280         TRACE_PRINTF_VAL(("PackFile_Annotations_unpack: key[%d]/%d name=%s type=%d\n",
4281               i, self->num_keys, key->name, key->type));
4282     }
4283
4284     /* Unpack groups. */
4285     self->num_groups = PF_fetch_opcode(seg->pf, &cursor);
4286     self->groups     = mem_allocate_n_typed(self->num_groups, PackFile_Annotations_Group *);
4287
4288     for (i = 0; i < self->num_groups; i++) {
4289         PackFile_Annotations_Group * const group =
4290             self->groups[i] = mem_allocate_typed(PackFile_Annotations_Group);
4291         group->bytecode_offset = PF_fetch_opcode(seg->pf, &cursor);
4292         group->entries_offset  = PF_fetch_opcode(seg->pf, &cursor);
4293         TRACE_PRINTF_VAL((
4294            "PackFile_Annotations_unpack: group[%d]/%d bytecode_offset=%d entries_offset=%d\n",
4295            i, self->num_groups, group->bytecode_offset,
4296            group->entries_offset));
4297     }
4298
4299     /* Unpack entries. */
4300     self->num_entries = PF_fetch_opcode(seg->pf, &cursor);
4301     self->entries     = mem_allocate_n_typed(self->num_entries, PackFile_Annotations_Entry *);
4302     for (i = 0; i < self->num_entries; i++) {
4303         PackFile_Annotations_Entry * const entry =
4304             self->entries[i]   = mem_allocate_typed(PackFile_Annotations_Entry);
4305         entry->bytecode_offset = PF_fetch_opcode(seg->pf, &cursor);
4306         entry->key             = PF_fetch_opcode(seg->pf, &cursor);
4307         entry->value           = PF_fetch_opcode(seg->pf, &cursor);
4308     }
4309
4310     /* Need to associate this segment with the applicable code segment. */
4311     str_len     = Parrot_str_length(interp, self->base.name);
4312     code_name   = Parrot_str_substr(interp, self->base.name, 0, str_len - 4, NULL, 1);
4313     code        = (PackFile_ByteCode *)PackFile_find_segment(interp,
4314                                 self->base.dir, code_name, 0);
4315
4316     if (!code || code->base.type != PF_BYTEC_SEG) {
4317         Parrot_ex_throw_from_c_args(interp, NULL, 1,
4318             "Code '%s' not found for annotations segment '%s'\n",
4319             code_name, self->base.name);
4320     }
4321
4322     self->code        = code;
4323     code->annotations = self;
4324
4325     return cursor;
4326 }
4327
4328
4329 /*
4330
4331 =item C<void PackFile_Annotations_dump(PARROT_INTERP, const PackFile_Segment
4332 *seg)>
4333
4334 Produces a dump of the annotations segment.
4335
4336 =cut
4337
4338 */
4339
4340 void
4341 PackFile_Annotations_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *seg))
4342 {
4343     ASSERT_ARGS(PackFile_Annotations_dump)
4344     const PackFile_Annotations *self = (const PackFile_Annotations *)seg;
4345     INTVAL                      i;
4346
4347     default_dump_header(interp, (const PackFile_Segment *)self);
4348
4349     /* Dump keys. */
4350     Parrot_io_printf(interp, "\n  keys => [\n");
4351     for (i = 0; i < self->num_keys; i++) {
4352         const PackFile_Annotations_Key * const key = self->keys[i];
4353         Parrot_io_printf(interp, "    #%d\n    [\n", i);
4354         Parrot_io_printf(interp, "        NAME => %Ss\n",
4355                 PF_CONST(self->code, key->name)->u.string);
4356         Parrot_io_printf(interp, "        TYPE => %s\n",
4357                 key->type == PF_ANNOTATION_KEY_TYPE_INT ? "integer" :
4358                 key->type == PF_ANNOTATION_KEY_TYPE_STR ? "string" :
4359                 key->type == PF_ANNOTATION_KEY_TYPE_NUM ? "number" :
4360                 "PMC");
4361         Parrot_io_printf(interp, "    ],\n");
4362     }
4363
4364     Parrot_io_printf(interp, "  ],\n");
4365
4366     /* Dump groups. */
4367     Parrot_io_printf(interp, "\n  groups => [\n");
4368     for (i = 0; i < self->num_groups; i++) {
4369         const PackFile_Annotations_Group * const group = self->groups[i];
4370         Parrot_io_printf(interp, "    #%d\n    [\n", i);
4371         Parrot_io_printf(interp, "        BYTECODE_OFFSET => %d\n",
4372                 group->bytecode_offset);
4373         Parrot_io_printf(interp, "        ENTRIES_OFFSET => %d\n",
4374                 group->entries_offset);
4375         Parrot_io_printf(interp, "    ],\n");
4376     }
4377
4378     Parrot_io_printf(interp, "  ],\n");
4379
4380     /* Dump entries. */
4381     Parrot_io_printf(interp, "\n  entries => [\n");
4382
4383     for (i = 0; i < self->num_entries; i++) {
4384         const PackFile_Annotations_Entry * const entry = self->entries[i];
4385         Parrot_io_printf(interp, "    #%d\n    [\n", i);
4386         Parrot_io_printf(interp, "        BYTECODE_OFFSET => %d\n",
4387                 entry->bytecode_offset);
4388         Parrot_io_printf(interp, "        KEY => %d\n",
4389                 entry->key);
4390         Parrot_io_printf(interp, "        VALUE => %d\n",
4391                 entry->value);
4392         Parrot_io_printf(interp, "    ],\n");
4393     }
4394
4395     Parrot_io_printf(interp, "  ],\n");
4396     Parrot_io_printf(interp, "],\n");
4397 }
4398
4399
4400 /*
4401
4402 =item C<void PackFile_Annotations_add_group(PARROT_INTERP, PackFile_Annotations
4403 *self, opcode_t offset)>
4404
4405 Starts a new bytecode annotation group. Takes the offset in the bytecode where
4406 the new annotations group starts.
4407
4408 =cut
4409
4410 */
4411 PARROT_EXPORT
4412 void
4413 PackFile_Annotations_add_group(SHIM_INTERP, ARGMOD(PackFile_Annotations *self),
4414         opcode_t offset)
4415 {
4416     ASSERT_ARGS(PackFile_Annotations_add_group)
4417
4418     /* Allocate extra space for the group in the groups array. */
4419     if (self->groups)
4420         self->groups =
4421             (PackFile_Annotations_Group **)mem_sys_realloc(self->groups,
4422                 (1 + self->num_groups) *
4423                     sizeof (PackFile_Annotations_Group *));
4424     else
4425         self->groups = mem_allocate_n_typed(self->num_groups + 1, PackFile_Annotations_Group *);
4426
4427     /* Store details. */
4428     self->groups[self->num_groups]                  =
4429                             mem_allocate_typed(PackFile_Annotations_Group);
4430     self->groups[self->num_groups]->bytecode_offset = offset;
4431     self->groups[self->num_groups]->entries_offset  = self->num_entries;
4432
4433     /* Increment group count. */
4434     self->num_groups++;
4435 }
4436
4437
4438 /*
4439
4440 =item C<void PackFile_Annotations_add_entry(PARROT_INTERP, PackFile_Annotations
4441 *self, opcode_t offset, opcode_t key, opcode_t type, opcode_t value)>
4442
4443 Adds a new bytecode annotation entry. Takes the annotations segment to add the
4444 entry to, the current bytecode offset (assumed to be the greatest one so far in
4445 the currently active group), the annotation key (as an index into the constats
4446 table), the annotation value type (one of PF_ANNOTATION_KEY_TYPE_INT,
4447 PF_ANNOTATION_KEY_TYPE_STR or PF_ANNOTATION_KEY_TYPE_NUM) and the value. The
4448 value will be an integer literal in the case of type being
4449 PF_ANNOTATION_KEY_TYPE_INT, or an index into the constants table otherwise.
4450
4451 =cut
4452
4453 */
4454 PARROT_EXPORT
4455 void
4456 PackFile_Annotations_add_entry(PARROT_INTERP, ARGMOD(PackFile_Annotations *self),
4457         opcode_t offset, opcode_t key, opcode_t type, opcode_t value)
4458 {
4459     ASSERT_ARGS(PackFile_Annotations_add_entry)
4460     /* See if we already have this key. */
4461     STRING  *key_name = PF_CONST(self->code, key)->u.string;
4462     opcode_t key_id   = -1;
4463     INTVAL   i;
4464
4465     for (i = 0; i < self->num_keys; i++) {
4466         STRING *test_key = PF_CONST(self->code, self->keys[i]->name)->u.string;
4467         if (Parrot_str_equal(interp, test_key, key_name)) {
4468             key_id = i;
4469             break;
4470         }
4471     }
4472
4473     if (key_id == -1) {
4474         /* We do have it. Add key entry. */
4475         if (self->keys)
4476             self->keys =
4477                 (PackFile_Annotations_Key **)mem_sys_realloc(self->keys,
4478                     (1 + self->num_keys) *
4479                         sizeof (PackFile_Annotations_Key *));
4480         else
4481             self->keys = mem_allocate_n_typed(self->num_keys + 1, PackFile_Annotations_Key *);
4482
4483         key_id             = self->num_keys;
4484         self->keys[key_id] = mem_allocate_typed(PackFile_Annotations_Key);
4485         self->num_keys++;
4486
4487         /* Populate it. */
4488         self->keys[key_id]->name = key;
4489         self->keys[key_id]->type = type;
4490     }
4491     else {
4492         /* Ensure key types are compatible. */
4493         if (self->keys[key_id]->type != type)
4494             Parrot_ex_throw_from_c_args(interp, NULL,
4495                 EXCEPTION_INVALID_OPERATION,
4496                 "Annotations with different types of value used for key '%S'\n",
4497                 key_name);
4498     }
4499
4500     /* Add annotations entry. */
4501     if (self->entries)
4502             self->entries =
4503                 (PackFile_Annotations_Entry **)mem_sys_realloc(self->entries,
4504                     (1 + self->num_entries) *
4505                         sizeof (PackFile_Annotations_Entry *));
4506         else
4507             self->entries =
4508                 mem_allocate_n_typed(self->num_entries + 1,
4509                     PackFile_Annotations_Entry *);
4510
4511     self->entries[self->num_entries]                  =
4512                         mem_allocate_typed(PackFile_Annotations_Entry);
4513     self->entries[self->num_entries]->bytecode_offset = offset;
4514     self->entries[self->num_entries]->key             = key_id;
4515     self->entries[self->num_entries]->value           = value;
4516
4517     self->num_entries++;
4518 }
4519
4520
4521 /*
4522
4523 =item C<static PMC * make_annotation_value_pmc(PARROT_INTERP,
4524 PackFile_Annotations *self, INTVAL type, opcode_t value)>
4525
4526 Makes a PMC of the right type holding the value.  Helper for
4527 C<PackFile_Annotations_lookup()>.
4528
4529 =cut
4530
4531 */
4532
4533 PARROT_CANNOT_RETURN_NULL
4534 static PMC *
4535 make_annotation_value_pmc(PARROT_INTERP, ARGIN(PackFile_Annotations *self),
4536         INTVAL type, opcode_t value)
4537 {
4538     ASSERT_ARGS(make_annotation_value_pmc)
4539     PMC *result;
4540
4541     switch (type) {
4542         case PF_ANNOTATION_KEY_TYPE_INT:
4543             result = pmc_new(interp, enum_class_Integer);
4544             VTABLE_set_integer_native(interp, result, value);
4545             break;
4546         case PF_ANNOTATION_KEY_TYPE_NUM:
4547             result = pmc_new(interp, enum_class_Float);
4548             VTABLE_set_number_native(interp, result,
4549                     PF_CONST(self->code, value)->u.number);
4550             break;
4551         default:
4552             result = pmc_new(interp, enum_class_String);
4553             VTABLE_set_string_native(interp, result,
4554                     PF_CONST(self->code, value)->u.string);
4555     }
4556
4557     return result;
4558 }
4559
4560
4561 /*
4562
4563 =item C<PMC * PackFile_Annotations_lookup(PARROT_INTERP, PackFile_Annotations
4564 *self, opcode_t offset, STRING *key)>
4565
4566 Looks up the annotation(s) in force at the given bytecode offset. If just one
4567 particular annotation is required, it can be passed as key, and the value will
4568 be returned (or a NULL PMC if no annotation of that name is in force).
4569 Otherwise, a Hash will be returned of the all annotations. If there are none in
4570 force, an empty hash will be returned.
4571
4572 =cut
4573
4574 */
4575
4576 PARROT_CANNOT_RETURN_NULL
4577 PMC *
4578 PackFile_Annotations_lookup(PARROT_INTERP, ARGIN(PackFile_Annotations *self),
4579         opcode_t offset, ARGIN_NULLOK(STRING *key))
4580 {
4581     ASSERT_ARGS(PackFile_Annotations_lookup)
4582     PMC   *result;
4583     INTVAL start_entry = 0;
4584     INTVAL i;
4585
4586     /* If we have a key, look up its ID; if we don't find one. */
4587     opcode_t key_id = -1;
4588
4589     if (key) {
4590         for (i = 0; i < self->num_keys; i++) {
4591             STRING * const test_key = PF_CONST(self->code, self->keys[i]->name)->u.string;
4592             if (Parrot_str_equal(interp, test_key, key)) {
4593                 key_id = i;
4594                 break;
4595             }
4596         }
4597
4598         if (key_id == -1)
4599             return PMCNULL;
4600     }
4601
4602     /* Use groups to find search start point. */
4603     for (i = 0; i < self->num_groups; i++)
4604         if (offset < self->groups[i]->bytecode_offset)
4605             break;
4606
4607
4608     /* Check if the found file was actually bytecode (.pbc extension), or a
4609      * source file (.pir or .pasm extension). */
4610         else
4611             start_entry = self->groups[i]->entries_offset;
4612
4613     if (key_id == -1) {
4614         /* Look through entries, storing what we find by key and tracking those
4615          * that we have values for. */
4616         opcode_t *latest_values = mem_allocate_n_zeroed_typed(self->num_keys, opcode_t);
4617         opcode_t *have_values   = mem_allocate_n_zeroed_typed(self->num_keys, opcode_t);
4618
4619         for (i = start_entry; i < self->num_entries; i++) {
4620             if (self->entries[i]->bytecode_offset >= offset)
4621                 break;
4622
4623             latest_values[self->entries[i]->key] = self->entries[i]->value;
4624             have_values[self->entries[i]->key]   = 1;
4625         }
4626
4627         /* Create hash of values we have. */
4628         result = pmc_new(interp, enum_class_Hash);
4629
4630         for (i = 0; i < self->num_keys; i++) {
4631             if (have_values[i]) {
4632                 STRING * const key_name = PF_CONST(self->code, self->keys[i]->name)->u.string;
4633                 VTABLE_set_pmc_keyed_str(interp, result, key_name,
4634                         make_annotation_value_pmc(interp, self, self->keys[i]->type,
4635                                 latest_values[i]));
4636             }
4637         }
4638
4639         mem_sys_free(latest_values);
4640         mem_sys_free(have_values);
4641     }
4642     else {
4643         /* Look for latest applicable value of the key. */
4644         opcode_t latest_value = 0;
4645         opcode_t found_value  = 0;
4646
4647         for (i = start_entry; i < self->num_entries; i++) {
4648             if (self->entries[i]->bytecode_offset >= offset)
4649                 break;
4650
4651             if (self->entries[i]->key == key_id) {
4652                 latest_value = self->entries[i]->value;
4653                 found_value  = 1;
4654             }
4655         }
4656
4657         /* Did we find anything? */
4658         if (!found_value)
4659             result = PMCNULL;
4660         else
4661             result = make_annotation_value_pmc(interp, self,
4662                     self->keys[key_id]->type, latest_value);
4663     }
4664
4665     return result;
4666 }
4667
4668 /*
4669
4670 =item C<static void compile_or_load_file(PARROT_INTERP, STRING *path,
4671 enum_runtime_ft file_type)>
4672
4673 Either load a bytecode file and append it to the current packfile directory, or
4674 compile a PIR or PASM file from source.
4675
4676 =cut
4677
4678 */
4679
4680 static void
4681 compile_or_load_file(PARROT_INTERP, ARGIN(STRING *path),
4682         enum_runtime_ft file_type)
4683 {
4684     ASSERT_ARGS(compile_or_load_file)
4685     char * const filename = Parrot_str_to_cstring(interp, path);
4686
4687     INTVAL regs_used[] = { 2, 2, 2, 2 }; /* Arbitrary values */
4688     const int parrot_hll_id = 0;
4689     PMC * context = Parrot_push_context(interp, regs_used);
4690     Parrot_pcc_set_HLL(interp, context, parrot_hll_id);
4691     Parrot_pcc_set_namespace(interp, context,
4692             Parrot_get_HLL_namespace(interp, parrot_hll_id));
4693
4694     if (file_type == PARROT_RUNTIME_FT_PBC) {
4695         PackFile * const pf = PackFile_append_pbc(interp, filename);
4696         Parrot_str_free_cstring(filename);
4697
4698         if (!pf)
4699             Parrot_ex_throw_from_c_args(interp, NULL, 1,
4700                 "Unable to append PBC to the current directory");
4701
4702         mem_sys_free(pf->header);
4703         pf->header = NULL;
4704         mem_sys_free(pf->dirp);
4705         pf->dirp   = NULL;
4706
4707     }
4708     else {
4709         STRING *err;
4710         PackFile_ByteCode * const cs =
4711             (PackFile_ByteCode *)IMCC_compile_file_s(interp,
4712                 filename, &err);
4713         Parrot_str_free_cstring(filename);
4714
4715         if (cs)
4716             do_sub_pragmas(interp, cs, PBC_LOADED, NULL);
4717         else
4718             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
4719                 "compiler returned NULL ByteCode '%Ss' - %Ss", path, err);
4720     }
4721
4722     Parrot_pop_context(interp);
4723 }
4724
4725 /*
4726
4727 =item C<void Parrot_load_language(PARROT_INTERP, STRING *lang_name)>
4728
4729 Load the compiler libraries for a given high-level language into the
4730 interpreter.
4731
4732 =cut
4733
4734 */
4735
4736 PARROT_EXPORT
4737 void
4738 Parrot_load_language(PARROT_INTERP, ARGIN_NULLOK(STRING *lang_name))
4739 {
4740     ASSERT_ARGS(Parrot_load_language)
4741     STRING *wo_ext, *file_str, *path, *pbc;
4742     STRING *found_path, *found_ext;
4743     INTVAL name_length;
4744     enum_runtime_ft file_type;
4745     PMC *is_loaded_hash;
4746
4747     if (STRING_IS_NULL(lang_name))
4748         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
4749             "\"load_language\" no language name");
4750
4751     /* Full path to language library is "abc/abc.pbc". */
4752     pbc = CONST_STRING(interp, "pbc");
4753     wo_ext   = Parrot_str_concat(interp, lang_name, CONST_STRING(interp, "/"), 0);
4754     wo_ext   = Parrot_str_append(interp, wo_ext, lang_name);
4755     file_str = Parrot_str_concat(interp, wo_ext, CONST_STRING(interp, "."), 0);
4756     file_str = Parrot_str_append(interp, file_str, pbc);
4757
4758     /* Check if the language is already loaded */
4759     is_loaded_hash = VTABLE_get_pmc_keyed_int(interp,
4760         interp->iglobals, IGLOBALS_PBC_LIBS);
4761     if (VTABLE_exists_keyed_str(interp, is_loaded_hash, wo_ext))
4762         return;
4763
4764     file_type = PARROT_RUNTIME_FT_LANG;
4765
4766     path = Parrot_locate_runtime_file_str(interp, file_str, file_type);
4767     if (!path)
4768         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
4769             "\"load_language\" couldn't find a compiler module for the language '%Ss'", lang_name);
4770
4771     /* remember wo_ext => full_path mapping */
4772     VTABLE_set_string_keyed_str(interp, is_loaded_hash,
4773             wo_ext, path);
4774
4775     /* Add the include and dynext paths to the global search */
4776
4777     /* Get the base path of the located module */
4778     parrot_split_path_ext(interp, path, &found_path, &found_ext);
4779     name_length = Parrot_str_length(interp, lang_name);
4780     found_path = Parrot_str_substr(interp, found_path, 0,
4781             Parrot_str_length(interp, found_path)-name_length, NULL, 0);
4782
4783     Parrot_lib_add_path(interp, Parrot_str_append(interp, found_path, CONST_STRING(interp, "include/")),
4784             PARROT_LIB_PATH_INCLUDE);
4785     Parrot_lib_add_path(interp, Parrot_str_append(interp, found_path, CONST_STRING(interp, "dynext/")),
4786             PARROT_LIB_PATH_DYNEXT);
4787     Parrot_lib_add_path(interp, Parrot_str_append(interp, found_path, CONST_STRING(interp, "library/")),
4788             PARROT_LIB_PATH_LIBRARY);
4789
4790
4791     /* Check if the file found was actually a bytecode file (.pbc extension) or
4792      * a source file (.pir or .pasm extension. */
4793
4794     if (Parrot_str_equal(interp, found_ext, pbc))
4795         file_type = PARROT_RUNTIME_FT_PBC;
4796     else
4797         file_type = PARROT_RUNTIME_FT_SOURCE;
4798
4799     compile_or_load_file(interp, path, file_type);
4800 }
4801
4802 /*
4803
4804 =item C<static PackFile * PackFile_append_pbc(PARROT_INTERP, const char
4805 *filename)>
4806
4807 Reads and appends a PBC it to the current directory.  Fixes up sub addresses in
4808 newly loaded bytecode and runs C<:load> subs.
4809
4810 =cut
4811
4812 */
4813
4814 PARROT_WARN_UNUSED_RESULT
4815 PARROT_CAN_RETURN_NULL
4816 static PackFile *
4817 PackFile_append_pbc(PARROT_INTERP, ARGIN_NULLOK(const char *filename))
4818 {
4819     ASSERT_ARGS(PackFile_append_pbc)
4820     PackFile * const pf = Parrot_pbc_read(interp, filename, 0);
4821
4822     if (pf) {
4823         PackFile_add_segment(interp, &interp->initial_pf->directory,
4824                 &pf->directory.base);
4825
4826         do_sub_pragmas(interp, pf->cur_cs, PBC_LOADED, NULL);
4827     }
4828
4829     return pf;
4830 }
4831
4832
4833 /*
4834
4835 =item C<void Parrot_load_bytecode(PARROT_INTERP, STRING *file_str)>
4836
4837 Load a bytecode, PIR, or PASM file into the interpreter.
4838
4839 =cut
4840
4841 */
4842
4843 /* intermediate hook during changes */
4844 PARROT_EXPORT
4845 void
4846 Parrot_load_bytecode(PARROT_INTERP, ARGIN_NULLOK(STRING *file_str))
4847 {
4848     ASSERT_ARGS(Parrot_load_bytecode)
4849     STRING         *wo_ext, *ext, *pbc, *path;
4850     STRING         *found_path, *found_ext;
4851     PMC            *is_loaded_hash;
4852     enum_runtime_ft file_type;
4853
4854     if (STRING_IS_NULL(file_str))
4855         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
4856             "\"load_bytecode\" no file name");
4857
4858     parrot_split_path_ext(interp, file_str, &wo_ext, &ext);
4859
4860     /* check if wo_ext is loaded */
4861     is_loaded_hash = VTABLE_get_pmc_keyed_int(interp,
4862         interp->iglobals, IGLOBALS_PBC_LIBS);
4863
4864     if (VTABLE_exists_keyed_str(interp, is_loaded_hash, wo_ext))
4865         return;
4866
4867     pbc = CONST_STRING(interp, "pbc");
4868
4869     if (Parrot_str_equal(interp, ext, pbc))
4870         file_type = PARROT_RUNTIME_FT_PBC;
4871     else
4872         file_type = PARROT_RUNTIME_FT_SOURCE;
4873
4874     path = Parrot_locate_runtime_file_str(interp, file_str, file_type);
4875     if (!path)
4876         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
4877             "\"load_bytecode\" couldn't find file '%Ss'", file_str);
4878
4879     /* remember wo_ext => full_path mapping */
4880     VTABLE_set_string_keyed_str(interp, is_loaded_hash, wo_ext, path);
4881
4882     parrot_split_path_ext(interp, path, &found_path, &found_ext);
4883
4884     /* Check if the file found was actually a bytecode file (.pbc
4885      * extension) or a source file (.pir or .pasm extension). */
4886
4887     if (Parrot_str_equal(interp, found_ext, pbc))
4888         file_type = PARROT_RUNTIME_FT_PBC;
4889     else
4890         file_type = PARROT_RUNTIME_FT_SOURCE;
4891
4892     compile_or_load_file(interp, path, file_type);
4893 }
4894
4895
4896 /*
4897
4898 =item C<void PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, PMC
4899 *eval)>
4900
4901 Calls C<:load>, C<:init>, C<:main>, C<:immediate> and/or C<:postcomp>
4902 subroutines in the current packfile, depending on the value of C<action>.
4903 See C<do_sub_pragmas> for more details.
4904
4905 =cut
4906
4907 */
4908
4909 PARROT_EXPORT
4910 void
4911 PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, ARGIN_NULLOK(PMC *eval))
4912 {
4913     ASSERT_ARGS(PackFile_fixup_subs)
4914     PARROT_CALLIN_START(interp);
4915     do_sub_pragmas(interp, interp->code, what, eval);
4916     PARROT_CALLIN_END(interp);
4917 }
4918
4919
4920 /*
4921
4922 =back
4923
4924 =head1 HISTORY
4925
4926 Parrot_readbc and Parrot_loadbc renamed. Trace macros, long double and
4927 64-bit conversion work by Reini Urban 2009.
4928
4929 Rework by Melvin; new bytecode format, make bytecode portable. (Do
4930 endian conversion and wordsize transforms on the fly.)
4931
4932 leo applied and modified Juergen Boemmels packfile patch giving an
4933 extensible packfile format with directory reworked again, with common
4934 chunks (C<default_*>).
4935
4936 2003.11.21 leo: moved low level item fetch routines to new
4937 F<pf/pf_items.c>
4938
4939 =cut
4940
4941 */
4942
4943
4944 /*
4945  * Local variables:
4946  *   c-file-style: "parrot"
4947  * End:
4948  * vim: expandtab shiftwidth=4:
4949  */