src/packfile.c

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