2 Copyright (C) 2001-2009, Parrot Foundation.
3 This program is free software. It is subject to the same license as
9 src/packfile.c - Parrot PackFile API
13 =head2 PackFile Manipulation Functions
15 This file contains all the functions required for the processing of the
16 structure of a PackFile. It is not intended to understand the byte code
17 stream itself, but merely to dissect and reconstruct data from the
18 various segments. See F<docs/pdds/pdd13_bytecode.pod> for information
19 about the structure of the frozen bytecode.
27 #include "parrot/parrot.h"
28 #include "parrot/embed.h"
29 #include "parrot/extend.h"
30 #include "parrot/packfile.h"
31 #include "parrot/runcore_api.h"
32 #include "../compilers/imcc/imc.h"
33 #include "packfile.str"
34 #include "pmc/pmc_sub.h"
35 #include "pmc/pmc_key.h"
36 #include "pmc/pmc_context.h"
38 /* HEADERIZER HFILE: include/parrot/packfile.h */
40 /* HEADERIZER BEGIN: static */
41 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
43 static void byte_code_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
44 __attribute__nonnull__(1)
45 __attribute__nonnull__(2)
48 PARROT_WARN_UNUSED_RESULT
49 PARROT_CANNOT_RETURN_NULL
50 static PackFile_Segment
* byte_code_new(SHIM_INTERP
,
55 PARROT_WARN_UNUSED_RESULT
56 PARROT_CANNOT_RETURN_NULL
57 static PackFile_Constant
* clone_constant(PARROT_INTERP
,
58 ARGIN(PackFile_Constant
*old_const
))
59 __attribute__nonnull__(1)
60 __attribute__nonnull__(2);
62 static void compile_or_load_file(PARROT_INTERP
,
64 enum_runtime_ft file_type
)
65 __attribute__nonnull__(1)
66 __attribute__nonnull__(2);
68 static void const_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
69 __attribute__nonnull__(1)
70 __attribute__nonnull__(2)
74 PARROT_CANNOT_RETURN_NULL
75 static PackFile_Segment
* const_new(SHIM_INTERP
,
80 PARROT_WARN_UNUSED_RESULT
81 PARROT_CANNOT_RETURN_NULL
82 static PackFile_Segment
* create_seg(PARROT_INTERP
,
83 ARGMOD(PackFile_Directory
*dir
),
86 ARGIN(STRING
*file_name
),
88 __attribute__nonnull__(1)
89 __attribute__nonnull__(2)
90 __attribute__nonnull__(4)
91 __attribute__nonnull__(5)
94 static void default_destroy(ARGMOD(PackFile_Segment
*self
))
95 __attribute__nonnull__(1)
98 static void default_dump(PARROT_INTERP
, ARGIN(const PackFile_Segment
*self
))
99 __attribute__nonnull__(1)
100 __attribute__nonnull__(2);
102 PARROT_WARN_UNUSED_RESULT
103 PARROT_CANNOT_RETURN_NULL
104 static opcode_t
* default_pack(
105 ARGIN(const PackFile_Segment
*self
),
106 ARGOUT(opcode_t
*dest
))
107 __attribute__nonnull__(1)
108 __attribute__nonnull__(2)
109 FUNC_MODIFIES(*dest
);
111 static size_t default_packed_size(ARGIN(const PackFile_Segment
*self
))
112 __attribute__nonnull__(1);
114 PARROT_WARN_UNUSED_RESULT
115 PARROT_CAN_RETURN_NULL
116 static const opcode_t
* default_unpack(
117 ARGMOD(PackFile_Segment
*self
),
118 ARGIN(const opcode_t
*cursor
))
119 __attribute__nonnull__(1)
120 __attribute__nonnull__(2)
121 FUNC_MODIFIES(*self
);
123 static void directory_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
124 __attribute__nonnull__(1)
125 __attribute__nonnull__(2)
126 FUNC_MODIFIES(*self
);
128 static void directory_dump(PARROT_INTERP
,
129 ARGIN(const PackFile_Segment
*self
))
130 __attribute__nonnull__(1)
131 __attribute__nonnull__(2);
133 PARROT_WARN_UNUSED_RESULT
134 PARROT_CANNOT_RETURN_NULL
135 static PackFile_Segment
* directory_new(SHIM_INTERP
,
140 PARROT_WARN_UNUSED_RESULT
141 PARROT_CANNOT_RETURN_NULL
142 static opcode_t
* directory_pack(PARROT_INTERP
,
143 ARGIN(PackFile_Segment
*self
),
144 ARGOUT(opcode_t
*cursor
))
145 __attribute__nonnull__(1)
146 __attribute__nonnull__(2)
147 __attribute__nonnull__(3)
148 FUNC_MODIFIES(*cursor
);
150 PARROT_WARN_UNUSED_RESULT
151 static size_t directory_packed_size(PARROT_INTERP
,
152 ARGMOD(PackFile_Segment
*self
))
153 __attribute__nonnull__(1)
154 __attribute__nonnull__(2)
155 FUNC_MODIFIES(*self
);
157 PARROT_WARN_UNUSED_RESULT
158 PARROT_CANNOT_RETURN_NULL
159 static const opcode_t
* directory_unpack(PARROT_INTERP
,
160 ARGMOD(PackFile_Segment
*segp
),
161 ARGIN(const opcode_t
*cursor
))
162 __attribute__nonnull__(1)
163 __attribute__nonnull__(2)
164 __attribute__nonnull__(3)
165 FUNC_MODIFIES(*segp
);
167 PARROT_WARN_UNUSED_RESULT
168 PARROT_CAN_RETURN_NULL
169 static PMC
* do_1_sub_pragma(PARROT_INTERP
,
170 ARGMOD(PMC
*sub_pmc
),
171 pbc_action_enum_t action
)
172 __attribute__nonnull__(1)
173 __attribute__nonnull__(2)
174 FUNC_MODIFIES(*sub_pmc
);
176 static INTVAL
find_const_iter(PARROT_INTERP
,
177 ARGIN(PackFile_Segment
*seg
),
178 ARGIN_NULLOK(void *user_data
))
179 __attribute__nonnull__(1)
180 __attribute__nonnull__(2);
182 PARROT_WARN_UNUSED_RESULT
183 PARROT_CANNOT_RETURN_NULL
184 static PackFile_Constant
** find_constants(PARROT_INTERP
,
185 ARGIN(PackFile_ConstTable
*ct
))
186 __attribute__nonnull__(1)
187 __attribute__nonnull__(2);
189 PARROT_WARN_UNUSED_RESULT
190 PARROT_CAN_RETURN_NULL
191 static PackFile_FixupEntry
* find_fixup(
192 ARGMOD(PackFile_FixupTable
*ft
),
194 ARGIN(const char *name
))
195 __attribute__nonnull__(1)
196 __attribute__nonnull__(3)
199 static INTVAL
find_fixup_iter(PARROT_INTERP
,
200 ARGIN(PackFile_Segment
*seg
),
201 ARGIN(void *user_data
))
202 __attribute__nonnull__(1)
203 __attribute__nonnull__(2)
204 __attribute__nonnull__(3);
206 static void fixup_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
207 __attribute__nonnull__(1)
208 __attribute__nonnull__(2)
209 FUNC_MODIFIES(*self
);
211 PARROT_WARN_UNUSED_RESULT
212 PARROT_CANNOT_RETURN_NULL
213 static PackFile_Segment
* fixup_new(SHIM_INTERP
,
218 PARROT_WARN_UNUSED_RESULT
219 PARROT_CANNOT_RETURN_NULL
220 static opcode_t
* fixup_pack(PARROT_INTERP
,
221 ARGIN(PackFile_Segment
*self
),
222 ARGOUT(opcode_t
*cursor
))
223 __attribute__nonnull__(1)
224 __attribute__nonnull__(2)
225 __attribute__nonnull__(3)
226 FUNC_MODIFIES(*cursor
);
228 static size_t fixup_packed_size(PARROT_INTERP
,
229 ARGMOD(PackFile_Segment
*self
))
230 __attribute__nonnull__(1)
231 __attribute__nonnull__(2)
232 FUNC_MODIFIES(*self
);
234 PARROT_WARN_UNUSED_RESULT
235 PARROT_CAN_RETURN_NULL
236 static const opcode_t
* fixup_unpack(PARROT_INTERP
,
237 ARGIN(PackFile_Segment
*seg
),
238 ARGIN(const opcode_t
*cursor
))
239 __attribute__nonnull__(1)
240 __attribute__nonnull__(2)
241 __attribute__nonnull__(3);
243 PARROT_CANNOT_RETURN_NULL
244 static PMC
* make_annotation_value_pmc(PARROT_INTERP
,
245 ARGIN(PackFile_Annotations
*self
),
248 __attribute__nonnull__(1)
249 __attribute__nonnull__(2);
251 static void make_code_pointers(ARGMOD(PackFile_Segment
*seg
))
252 __attribute__nonnull__(1)
255 static void mark_1_seg(PARROT_INTERP
, ARGMOD(PackFile_ConstTable
*ct
))
256 __attribute__nonnull__(1)
257 __attribute__nonnull__(2)
260 PARROT_WARN_UNUSED_RESULT
261 PARROT_CAN_RETURN_NULL
262 static PackFile
* PackFile_append_pbc(PARROT_INTERP
,
263 ARGIN_NULLOK(const char *filename
))
264 __attribute__nonnull__(1);
266 static void PackFile_set_header(ARGOUT(PackFile_Header
*header
))
267 __attribute__nonnull__(1)
268 FUNC_MODIFIES(*header
);
270 static void pf_debug_destroy(SHIM_INTERP
, ARGMOD(PackFile_Segment
*self
))
271 __attribute__nonnull__(2)
272 FUNC_MODIFIES(*self
);
274 static void pf_debug_dump(PARROT_INTERP
,
275 ARGIN(const PackFile_Segment
*self
))
276 __attribute__nonnull__(1)
277 __attribute__nonnull__(2);
279 PARROT_WARN_UNUSED_RESULT
280 PARROT_CANNOT_RETURN_NULL
281 static PackFile_Segment
* pf_debug_new(SHIM_INTERP
,
286 PARROT_WARN_UNUSED_RESULT
287 PARROT_CANNOT_RETURN_NULL
288 static opcode_t
* pf_debug_pack(SHIM_INTERP
,
289 ARGMOD(PackFile_Segment
*self
),
290 ARGOUT(opcode_t
*cursor
))
291 __attribute__nonnull__(2)
292 __attribute__nonnull__(3)
294 FUNC_MODIFIES(*cursor
);
296 static size_t pf_debug_packed_size(SHIM_INTERP
,
297 ARGIN(PackFile_Segment
*self
))
298 __attribute__nonnull__(2);
300 PARROT_WARN_UNUSED_RESULT
301 PARROT_CANNOT_RETURN_NULL
302 static const opcode_t
* pf_debug_unpack(PARROT_INTERP
,
303 ARGOUT(PackFile_Segment
*self
),
304 ARGIN(const opcode_t
*cursor
))
305 __attribute__nonnull__(1)
306 __attribute__nonnull__(2)
307 __attribute__nonnull__(3)
308 FUNC_MODIFIES(*self
);
310 static void pf_register_standard_funcs(PARROT_INTERP
, ARGMOD(PackFile
*pf
))
311 __attribute__nonnull__(1)
312 __attribute__nonnull__(2)
315 PARROT_IGNORABLE_RESULT
316 PARROT_CAN_RETURN_NULL
317 static PMC
* run_sub(PARROT_INTERP
, ARGIN(PMC
*sub_pmc
))
318 __attribute__nonnull__(1)
319 __attribute__nonnull__(2);
321 static void segment_init(PARROT_INTERP
,
322 ARGOUT(PackFile_Segment
*self
),
325 __attribute__nonnull__(1)
326 __attribute__nonnull__(2)
327 __attribute__nonnull__(3)
328 __attribute__nonnull__(4)
329 FUNC_MODIFIES(*self
);
331 static void sort_segs(ARGMOD(PackFile_Directory
*dir
))
332 __attribute__nonnull__(1)
335 static int sub_pragma(PARROT_INTERP
,
336 pbc_action_enum_t action
,
337 ARGIN(const PMC
*sub_pmc
))
338 __attribute__nonnull__(1)
339 __attribute__nonnull__(3);
341 #define ASSERT_ARGS_byte_code_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
342 PARROT_ASSERT_ARG(interp) \
343 , PARROT_ASSERT_ARG(self))
344 #define ASSERT_ARGS_byte_code_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
345 #define ASSERT_ARGS_clone_constant __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
346 PARROT_ASSERT_ARG(interp) \
347 , PARROT_ASSERT_ARG(old_const))
348 #define ASSERT_ARGS_compile_or_load_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
349 PARROT_ASSERT_ARG(interp) \
350 , PARROT_ASSERT_ARG(path))
351 #define ASSERT_ARGS_const_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
352 PARROT_ASSERT_ARG(interp) \
353 , PARROT_ASSERT_ARG(self))
354 #define ASSERT_ARGS_const_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
355 #define ASSERT_ARGS_create_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
356 PARROT_ASSERT_ARG(interp) \
357 , PARROT_ASSERT_ARG(dir) \
358 , PARROT_ASSERT_ARG(name) \
359 , PARROT_ASSERT_ARG(file_name))
360 #define ASSERT_ARGS_default_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
361 PARROT_ASSERT_ARG(self))
362 #define ASSERT_ARGS_default_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
363 PARROT_ASSERT_ARG(interp) \
364 , PARROT_ASSERT_ARG(self))
365 #define ASSERT_ARGS_default_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
366 PARROT_ASSERT_ARG(self) \
367 , PARROT_ASSERT_ARG(dest))
368 #define ASSERT_ARGS_default_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
369 PARROT_ASSERT_ARG(self))
370 #define ASSERT_ARGS_default_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
371 PARROT_ASSERT_ARG(self) \
372 , PARROT_ASSERT_ARG(cursor))
373 #define ASSERT_ARGS_directory_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
374 PARROT_ASSERT_ARG(interp) \
375 , PARROT_ASSERT_ARG(self))
376 #define ASSERT_ARGS_directory_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
377 PARROT_ASSERT_ARG(interp) \
378 , PARROT_ASSERT_ARG(self))
379 #define ASSERT_ARGS_directory_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
380 #define ASSERT_ARGS_directory_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
381 PARROT_ASSERT_ARG(interp) \
382 , PARROT_ASSERT_ARG(self) \
383 , PARROT_ASSERT_ARG(cursor))
384 #define ASSERT_ARGS_directory_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
385 PARROT_ASSERT_ARG(interp) \
386 , PARROT_ASSERT_ARG(self))
387 #define ASSERT_ARGS_directory_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
388 PARROT_ASSERT_ARG(interp) \
389 , PARROT_ASSERT_ARG(segp) \
390 , PARROT_ASSERT_ARG(cursor))
391 #define ASSERT_ARGS_do_1_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
392 PARROT_ASSERT_ARG(interp) \
393 , PARROT_ASSERT_ARG(sub_pmc))
394 #define ASSERT_ARGS_find_const_iter __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
395 PARROT_ASSERT_ARG(interp) \
396 , PARROT_ASSERT_ARG(seg))
397 #define ASSERT_ARGS_find_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
398 PARROT_ASSERT_ARG(interp) \
399 , PARROT_ASSERT_ARG(ct))
400 #define ASSERT_ARGS_find_fixup __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
401 PARROT_ASSERT_ARG(ft) \
402 , PARROT_ASSERT_ARG(name))
403 #define ASSERT_ARGS_find_fixup_iter __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
404 PARROT_ASSERT_ARG(interp) \
405 , PARROT_ASSERT_ARG(seg) \
406 , PARROT_ASSERT_ARG(user_data))
407 #define ASSERT_ARGS_fixup_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
408 PARROT_ASSERT_ARG(interp) \
409 , PARROT_ASSERT_ARG(self))
410 #define ASSERT_ARGS_fixup_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
411 #define ASSERT_ARGS_fixup_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
412 PARROT_ASSERT_ARG(interp) \
413 , PARROT_ASSERT_ARG(self) \
414 , PARROT_ASSERT_ARG(cursor))
415 #define ASSERT_ARGS_fixup_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
416 PARROT_ASSERT_ARG(interp) \
417 , PARROT_ASSERT_ARG(self))
418 #define ASSERT_ARGS_fixup_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
419 PARROT_ASSERT_ARG(interp) \
420 , PARROT_ASSERT_ARG(seg) \
421 , PARROT_ASSERT_ARG(cursor))
422 #define ASSERT_ARGS_make_annotation_value_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
423 PARROT_ASSERT_ARG(interp) \
424 , PARROT_ASSERT_ARG(self))
425 #define ASSERT_ARGS_make_code_pointers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
426 PARROT_ASSERT_ARG(seg))
427 #define ASSERT_ARGS_mark_1_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
428 PARROT_ASSERT_ARG(interp) \
429 , PARROT_ASSERT_ARG(ct))
430 #define ASSERT_ARGS_PackFile_append_pbc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
431 PARROT_ASSERT_ARG(interp))
432 #define ASSERT_ARGS_PackFile_set_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
433 PARROT_ASSERT_ARG(header))
434 #define ASSERT_ARGS_pf_debug_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
435 PARROT_ASSERT_ARG(self))
436 #define ASSERT_ARGS_pf_debug_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
437 PARROT_ASSERT_ARG(interp) \
438 , PARROT_ASSERT_ARG(self))
439 #define ASSERT_ARGS_pf_debug_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
440 #define ASSERT_ARGS_pf_debug_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
441 PARROT_ASSERT_ARG(self) \
442 , PARROT_ASSERT_ARG(cursor))
443 #define ASSERT_ARGS_pf_debug_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
444 PARROT_ASSERT_ARG(self))
445 #define ASSERT_ARGS_pf_debug_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
446 PARROT_ASSERT_ARG(interp) \
447 , PARROT_ASSERT_ARG(self) \
448 , PARROT_ASSERT_ARG(cursor))
449 #define ASSERT_ARGS_pf_register_standard_funcs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
450 PARROT_ASSERT_ARG(interp) \
451 , PARROT_ASSERT_ARG(pf))
452 #define ASSERT_ARGS_run_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
453 PARROT_ASSERT_ARG(interp) \
454 , PARROT_ASSERT_ARG(sub_pmc))
455 #define ASSERT_ARGS_segment_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
456 PARROT_ASSERT_ARG(interp) \
457 , PARROT_ASSERT_ARG(self) \
458 , PARROT_ASSERT_ARG(pf) \
459 , PARROT_ASSERT_ARG(name))
460 #define ASSERT_ARGS_sort_segs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
461 PARROT_ASSERT_ARG(dir))
462 #define ASSERT_ARGS_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
463 PARROT_ASSERT_ARG(interp) \
464 , PARROT_ASSERT_ARG(sub_pmc))
465 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
466 /* HEADERIZER END: static */
468 /* offset not in ptr diff, but in byte */
469 #define OFFS(pf, cursor) ((pf) ? ((const char *)(cursor) - (const char *)((pf)->src)) : 0)
471 * Possible values for ALIGN_16
474 * e.g. reading 4 byte wordsize on 8 byte wordsize: possible ptrs end in 0 4 8 c.
475 * offs(c)/8 => 4/8 = 0 => impossible to align with 8 byte ptr.
476 * Limitation TT #254: ALIGN_16 may only be used native, e.g. in the writer,
477 * but not with 64bit reading 32bit!
479 #define ROUND_16(val) (((val) & 0xf) ? 16 - ((val) & 0xf) : 0)
480 #define ALIGN_16(pf, cursor) \
481 (cursor) += ROUND_16(OFFS(pf, cursor))/sizeof (opcode_t)
482 /* pad to 16 in bytes */
483 #define PAD_16_B(size) ((size) % 16 ? 16 - (size) % 16 : 0)
489 =item C<void Parrot_trace_eprintf(const char *s, ...)>
491 Print out an error message. Passes arguments directly to C<vfprintf>.
498 Parrot_trace_eprintf(ARGIN(const char *s
), ...)
500 ASSERT_ARGS(Parrot_trace_eprintf
)
503 vfprintf(stderr
, s
, args
);
511 =item C<void PackFile_destroy(PARROT_INTERP, PackFile *pf)>
513 Deletes a C<PackFile>.
521 PackFile_destroy(PARROT_INTERP
, ARGMOD_NULLOK(PackFile
*pf
))
523 ASSERT_ARGS(PackFile_destroy
)
525 Parrot_io_eprintf(NULL
, "PackFile_destroy: pf == NULL!\n");
529 #ifdef PARROT_HAS_HEADER_SYSMMAN
530 if (pf
->is_mmap_ped
) {
532 /* Cast the result to void to avoid a warning with
533 * some not-so-standard mmap headers, see RT #56110
535 munmap((void *)PARROT_const_cast(opcode_t
*, pf
->src
), pf
->size
);
539 mem_sys_free(pf
->header
);
541 mem_sys_free(pf
->dirp
);
543 PackFile_Segment_destroy(interp
, &pf
->directory
.base
);
550 =item C<static void make_code_pointers(PackFile_Segment *seg)>
552 Makes compact/shorthand pointers.
554 The first segments read are the default segments.
561 make_code_pointers(ARGMOD(PackFile_Segment
*seg
))
563 ASSERT_ARGS(make_code_pointers
)
564 PackFile
* const pf
= seg
->pf
;
569 pf
->cur_cs
= (PackFile_ByteCode
*)seg
;
572 if (!pf
->cur_cs
->fixups
) {
573 pf
->cur_cs
->fixups
= (PackFile_FixupTable
*)seg
;
574 pf
->cur_cs
->fixups
->code
= pf
->cur_cs
;
578 if (!pf
->cur_cs
->const_table
) {
579 pf
->cur_cs
->const_table
= (PackFile_ConstTable
*)seg
;
580 pf
->cur_cs
->const_table
->code
= pf
->cur_cs
;
586 pf
->cur_cs
->debugs
= (PackFile_Debug
*)seg
;
587 pf
->cur_cs
->debugs
->code
= pf
->cur_cs
;
597 =item C<static int sub_pragma(PARROT_INTERP, pbc_action_enum_t action, const PMC
600 Checks B<sub_pmc>'s pragmas (e.g. flags like C<:load>, C<:main>, etc.)
601 returning 1 if the sub should be run for C<action>, a C<pbc_action_enum_t>.
608 sub_pragma(PARROT_INTERP
, pbc_action_enum_t action
, ARGIN(const PMC
*sub_pmc
))
610 ASSERT_ARGS(sub_pragma
)
612 /* Note: the const casting is only needed because of the
613 * internal details of the Sub_comp macros.
614 * The assumption is that the TEST versions are in fact const,
615 * so the casts are safe.
616 * These casts are a quick fix to allow parrot build with c++,
617 * a refactor of the macros will be a cleaner solution. */
619 Parrot_Sub_attributes
*sub
;
621 const int pragmas
= PObj_get_FLAGS(sub_pmc
) & SUB_FLAG_PF_MASK
622 & ~SUB_FLAG_IS_OUTER
;
623 PMC_get_sub(interp
, PARROT_const_cast(PMC
*, sub_pmc
), sub
);
624 if (!pragmas
&& !Sub_comp_INIT_TEST(sub
))
630 /* denote MAIN entry in first loaded PASM */
631 if (interp
->resume_flag
& RESUME_INITIAL
)
634 /* :init functions need to be called at MAIN time, so return 1 */
635 /* symreg.h:P_INIT */
636 if (Sub_comp_INIT_TEST(sub
))
641 /* symreg.h:P_LOAD */
642 if (pragmas
& SUB_FLAG_PF_LOAD
)
649 if (pragmas
& (SUB_FLAG_PF_IMMEDIATE
| SUB_FLAG_PF_POSTCOMP
))
658 =item C<static PMC* run_sub(PARROT_INTERP, PMC *sub_pmc)>
660 Runs the B<sub_pmc> due to its B<:load>, B<:immediate>, ... pragma
666 PARROT_IGNORABLE_RESULT
667 PARROT_CAN_RETURN_NULL
669 run_sub(PARROT_INTERP
, ARGIN(PMC
*sub_pmc
))
672 Parrot_runcore_t
*old_core
= interp
->run_core
;
673 PMC
*retval
= PMCNULL
;
675 /* turn off JIT and prederef - both would act on the whole
676 * PackFile which probably isn't worth the effort */
677 if (PARROT_RUNCORE_JIT_OPS_TEST(interp
->run_core
)
678 || PARROT_RUNCORE_PREDEREF_OPS_TEST(interp
->run_core
))
679 Parrot_runcore_switch(interp
, CONST_STRING(interp
, "fast"));
681 Parrot_pcc_set_constants(interp
, CURRENT_CONTEXT(interp
),
682 interp
->code
->const_table
->constants
);
684 Parrot_pcc_invoke_sub_from_c_args(interp
, sub_pmc
, "->P", &retval
);
685 interp
->run_core
= old_core
;
693 =item C<static PMC* do_1_sub_pragma(PARROT_INTERP, PMC *sub_pmc,
694 pbc_action_enum_t action)>
696 Runs autoloaded or immediate bytecode, marking the MAIN subroutine entry.
702 PARROT_WARN_UNUSED_RESULT
703 PARROT_CAN_RETURN_NULL
705 do_1_sub_pragma(PARROT_INTERP
, ARGMOD(PMC
*sub_pmc
), pbc_action_enum_t action
)
707 ASSERT_ARGS(do_1_sub_pragma
)
708 Parrot_Sub_attributes
*sub
;
709 PMC_get_sub(interp
, sub_pmc
, sub
);
713 /* run IMMEDIATE sub */
714 if (PObj_get_FLAGS(sub_pmc
) & SUB_FLAG_PF_IMMEDIATE
) {
715 void *lo_var_ptr
= interp
->lo_var_ptr
;
718 PObj_get_FLAGS(sub_pmc
) &= ~SUB_FLAG_PF_IMMEDIATE
;
719 result
= run_sub(interp
, sub_pmc
);
721 /* reset initial flag so MAIN detection works
722 * and reset lo_var_ptr to prev */
723 interp
->resume_flag
= RESUME_INITIAL
;
724 interp
->lo_var_ptr
= lo_var_ptr
;
729 /* run POSTCOMP sub */
730 if (PObj_get_FLAGS(sub_pmc
) & SUB_FLAG_PF_POSTCOMP
) {
731 PObj_get_FLAGS(sub_pmc
) &= ~SUB_FLAG_PF_POSTCOMP
;
732 run_sub(interp
, sub_pmc
);
734 /* reset initial flag so MAIN detection works */
735 interp
->resume_flag
= RESUME_INITIAL
;
741 if (PObj_get_FLAGS(sub_pmc
) & SUB_FLAG_PF_LOAD
) {
742 PObj_get_FLAGS(sub_pmc
) &= ~SUB_FLAG_PF_LOAD
;
744 /* if loaded no need for init */
745 Sub_comp_INIT_CLEAR(sub
);
746 run_sub(interp
, sub_pmc
);
750 if (PObj_get_FLAGS(sub_pmc
) & SUB_FLAG_PF_MAIN
) {
751 if ((interp
->resume_flag
& RESUME_INITIAL
)
752 && interp
->resume_offset
== 0) {
753 void *ptr
= VTABLE_get_pointer(interp
, sub_pmc
);
754 const ptrdiff_t code
= (ptrdiff_t) sub
->seg
->base
.data
;
756 interp
->resume_offset
= ((ptrdiff_t)ptr
- code
)
757 / sizeof (opcode_t
*);
759 PObj_get_FLAGS(sub_pmc
) &= ~SUB_FLAG_PF_MAIN
;
760 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), sub_pmc
);
763 Parrot_warn(interp
, PARROT_WARNINGS_ALL_FLAG
,
764 ":main sub not allowed\n");
768 /* run :init tagged functions */
769 if (action
== PBC_MAIN
&& Sub_comp_INIT_TEST(sub
)) {
770 /* if loaded no need for init */
771 Sub_comp_INIT_CLEAR(sub
);
773 /* if inited no need for load */
774 PObj_get_FLAGS(sub_pmc
) &= ~SUB_FLAG_PF_LOAD
;
776 run_sub(interp
, sub_pmc
);
777 interp
->resume_flag
= RESUME_INITIAL
;
788 =item C<static void mark_1_seg(PARROT_INTERP, PackFile_ConstTable *ct)>
790 While the PMCs should be constant, their possible contents such as
791 properties aren't constructed const, so we have to mark them.
798 mark_1_seg(PARROT_INTERP
, ARGMOD(PackFile_ConstTable
*ct
))
800 ASSERT_ARGS(mark_1_seg
)
801 PackFile_Constant
** const constants
= find_constants(interp
, ct
);
804 for (i
= 0; i
< ct
->const_count
; i
++) {
807 switch (constants
[i
]->type
) {
810 pmc
= constants
[i
]->u
.key
;
811 Parrot_gc_mark_PMC_alive(interp
, pmc
);
814 string
= constants
[i
]->u
.string
;
815 Parrot_gc_mark_STRING_alive(interp
, string
);
827 =item C<static INTVAL find_const_iter(PARROT_INTERP, PackFile_Segment *seg, void
830 Iterates over a PackFile_Directory, marking any constant segments. Internal
838 find_const_iter(PARROT_INTERP
, ARGIN(PackFile_Segment
*seg
),
839 ARGIN_NULLOK(void *user_data
))
841 ASSERT_ARGS(find_const_iter
)
842 if (seg
->type
== PF_DIR_SEG
)
843 PackFile_map_segments(interp
, (const PackFile_Directory
*)seg
,
844 find_const_iter
, user_data
);
845 else if (seg
->type
== PF_CONST_SEG
)
846 mark_1_seg(interp
, (PackFile_ConstTable
*)seg
);
854 =item C<void mark_const_subs(PARROT_INTERP)>
856 Iterates over all directories and PackFile_Segments, finding and marking any
864 mark_const_subs(PARROT_INTERP
)
866 ASSERT_ARGS(mark_const_subs
)
867 PackFile_Directory
*dir
;
869 PackFile
* const self
= interp
->initial_pf
;
874 /* locate top level dir */
875 dir
= &self
->directory
;
877 /* iterate over all dir/segs */
878 PackFile_map_segments(interp
, dir
, find_const_iter
, NULL
);
884 =item C<void do_sub_pragmas(PARROT_INTERP, PackFile_ByteCode *self,
885 pbc_action_enum_t action, PMC *eval_pmc)>
887 C<action> is one of C<PBC_PBC>, C<PBC_LOADED>, C<PBC_INIT>, or C<PBC_MAIN>.
888 These determine which subs get executed at this point. Some rules:
890 :immediate subs always execute immediately
891 :postcomp subs always execute immediately
892 :main subs execute when we have the PBC_MAIN or PBC_PBC actions
893 :init subs execute when :main does
894 :load subs execute on PBC_LOAD
896 Also store the C<eval_pmc> in the sub structure, so that the eval PMC is kept
897 alive by living subs.
905 do_sub_pragmas(PARROT_INTERP
, ARGIN(PackFile_ByteCode
*self
),
906 pbc_action_enum_t action
, ARGIN_NULLOK(PMC
*eval_pmc
))
908 ASSERT_ARGS(do_sub_pragmas
)
909 PackFile_FixupTable
* const ft
= self
->fixups
;
910 PackFile_ConstTable
* const ct
= self
->const_table
;
913 TRACE_PRINTF(("PackFile: do_sub_pragmas (action=%d)\n", action
));
915 for (i
= 0; i
< ft
->fixup_count
; i
++) {
916 switch (ft
->fixups
[i
]->type
) {
919 /* offset is an index into const_table holding the Sub PMC */
921 Parrot_Sub_attributes
*sub
;
922 const opcode_t ci
= ft
->fixups
[i
]->offset
;
924 if (ci
< 0 || ci
>= ct
->const_count
)
925 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
926 "Illegal fixup offset (%d) in enum_fixup_sub");
928 sub_pmc
= ct
->constants
[ci
]->u
.key
;
929 PMC_get_sub(interp
, sub_pmc
, sub
);
930 sub
->eval_pmc
= eval_pmc
;
932 if (((PObj_get_FLAGS(sub_pmc
) & SUB_FLAG_PF_MASK
)
933 || (Sub_comp_get_FLAGS(sub
) & SUB_COMP_FLAG_MASK
))
934 && sub_pragma(interp
, action
, sub_pmc
)) {
935 PMC
* const result
= do_1_sub_pragma(interp
, sub_pmc
,
938 /* replace Sub PMC with computation results */
939 if (action
== PBC_IMMEDIATE
&& !PMC_IS_NULL(result
)) {
940 ft
->fixups
[i
]->type
= enum_fixup_none
;
941 ct
->constants
[ci
]->u
.key
= result
;
956 =item C<opcode_t PackFile_unpack(PARROT_INTERP, PackFile *self, const opcode_t
957 *packed, size_t packed_size)>
959 Unpacks a C<PackFile> from a block of memory, ensuring that the magic number is
960 valid and that Parrot can read this bytecode version, Parrot, and performing
961 any required endian and word size transforms.
963 Returns size of unpacked opcodes if everything is okay, else zero (0).
970 PARROT_WARN_UNUSED_RESULT
972 PackFile_unpack(PARROT_INTERP
, ARGMOD(PackFile
*self
),
973 ARGIN(const opcode_t
*packed
), size_t packed_size
)
975 ASSERT_ARGS(PackFile_unpack
)
976 PackFile_Header
* const header
= self
->header
;
977 const opcode_t
*cursor
;
978 int header_read_length
;
981 PackFile
* const pf
= self
;
985 self
->size
= packed_size
;
987 /* Extract the header. */
988 memcpy(header
, packed
, PACKFILE_HEADER_BYTES
);
990 /* Ensure the magic is correct. */
991 if (memcmp(header
->magic
, "\376PBC\r\n\032\n", 8) != 0) {
992 Parrot_io_eprintf(NULL
, "PackFile_unpack: "
993 "This is not a valid Parrot bytecode file\n");
997 /* Ensure the bytecode version is one we can read. Currently, we only
998 * support bytecode versions matching the current one.
1000 * tools/dev/pbc_header.pl --upd t/native_pbc/(ASTERISK).pbc
1001 * stamps version and fingerprint in the native tests.
1002 * NOTE: (ASTERISK) is *, we don't want to fool the C preprocessor. */
1003 if (header
->bc_major
!= PARROT_PBC_MAJOR
1004 || header
->bc_minor
!= PARROT_PBC_MINOR
) {
1005 Parrot_io_eprintf(NULL
, "PackFile_unpack: This Parrot cannot read "
1006 "bytecode files with version %d.%d.\n",
1007 header
->bc_major
, header
->bc_minor
);
1008 if (!(self
->options
& PFOPT_UTILS
))
1012 /* Check wordsize, byte order and floating point number type are valid. */
1013 if (header
->wordsize
!= 4 && header
->wordsize
!= 8) {
1014 Parrot_io_eprintf(NULL
, "PackFile_unpack: Invalid wordsize %d\n",
1019 if (header
->byteorder
!= 0 && header
->byteorder
!= 1) {
1020 Parrot_io_eprintf(NULL
, "PackFile_unpack: Invalid byte ordering %d\n",
1025 if (header
->floattype
> FLOATTYPE_MAX
) {
1026 Parrot_io_eprintf(NULL
, "PackFile_unpack: Invalid floattype %d\n",
1031 /* Describe what was read for debugging. */
1032 TRACE_PRINTF(("PackFile_unpack: Wordsize %d.\n", header
->wordsize
));
1033 TRACE_PRINTF(("PackFile_unpack: Floattype %d (%s).\n",
1035 header
->floattype
== FLOATTYPE_8
1037 : header
->floattype
== FLOATTYPE_16
1039 : FLOATTYPE_12_NAME
));
1040 TRACE_PRINTF(("PackFile_unpack: Byteorder %d (%sendian).\n",
1041 header
->byteorder
, header
->byteorder
? "big " : "little-"));
1043 /* Check the UUID type is valid and, if needed, read a UUID. */
1044 if (header
->uuid_type
== 0) {
1045 /* No UUID; fine, nothing more to do. */
1047 else if (header
->uuid_type
== 1) {
1048 /* Read in the UUID. We'll put it in a NULL-terminated string, just in
1049 * case people use it that way. */
1050 header
->uuid_data
= (unsigned char *)
1051 mem_sys_allocate(header
->uuid_size
+ 1);
1053 memcpy(header
->uuid_data
, packed
+ PACKFILE_HEADER_BYTES
,
1056 /* NULL terminate */
1057 header
->uuid_data
[header
->uuid_size
] = '\0';
1060 /* Don't know this UUID type. */
1061 Parrot_io_eprintf(NULL
, "PackFile_unpack: Invalid UUID type %d\n",
1064 /* Set cursor to position after what we've read, allowing for padding to a
1065 * 16 byte boundary. */
1066 header_read_length
= PACKFILE_HEADER_BYTES
+ header
->uuid_size
;
1067 header_read_length
+= PAD_16_B(header_read_length
);
1068 cursor
= packed
+ (header_read_length
/ sizeof (opcode_t
));
1069 TRACE_PRINTF(("PackFile_unpack: pad=%d\n",
1070 (char *)cursor
- (char *)packed
));
1072 /* Set what transforms we need to do when reading the rest of the file. */
1073 PackFile_assign_transforms(self
);
1075 /* Directory format. */
1076 header
->dir_format
= PF_fetch_opcode(self
, &cursor
);
1078 if (header
->dir_format
!= PF_DIR_FORMAT
) {
1079 Parrot_io_eprintf(NULL
, "PackFile_unpack: Dir format was %d not %d\n",
1080 header
->dir_format
, PF_DIR_FORMAT
);
1085 TRACE_PRINTF(("PackFile_unpack: 3 words padding.\n"));
1086 padding
= PF_fetch_opcode(self
, &cursor
);
1087 padding
= PF_fetch_opcode(self
, &cursor
);
1088 padding
= PF_fetch_opcode(self
, &cursor
);
1091 TRACE_PRINTF(("PackFile_unpack: Directory read, offset %d.\n",
1092 (INTVAL
)cursor
- (INTVAL
)packed
));
1093 self
->directory
.base
.file_offset
= (INTVAL
)cursor
- (INTVAL
)self
->src
;
1094 if (self
->options
& PFOPT_HEADERONLY
)
1095 return cursor
- packed
;
1097 /* now unpack dir, which unpacks its contents ... */
1098 Parrot_block_GC_mark(interp
);
1099 cursor
= PackFile_Segment_unpack(interp
,
1100 &self
->directory
.base
, cursor
);
1101 Parrot_unblock_GC_mark(interp
);
1103 #ifdef PARROT_HAS_HEADER_SYSMMAN
1104 if (self
->is_mmap_ped
1105 && (self
->need_endianize
|| self
->need_wordsize
)) {
1107 /* Cast the result to void to avoid a warning with
1108 * some not-so-standard mmap headers, see RT #56110
1110 munmap((void *)PARROT_const_cast(opcode_t
*, self
->src
), self
->size
);
1111 self
->is_mmap_ped
= 0;
1115 TRACE_PRINTF(("PackFile_unpack: Unpack done.\n"));
1117 return cursor
- packed
;
1123 =item C<INTVAL PackFile_map_segments(PARROT_INTERP, const PackFile_Directory
1124 *dir, PackFile_map_segments_func_t callback, void *user_data)>
1126 Calls the callback function C<callback> for each segment in the directory
1127 C<dir> called. The pointer C<user_data> is included in each call.
1129 If a callback returns non-zero, segment processing stops, returning this value.
1137 PackFile_map_segments(PARROT_INTERP
, ARGIN(const PackFile_Directory
*dir
),
1138 PackFile_map_segments_func_t callback
,
1139 ARGIN_NULLOK(void *user_data
))
1141 ASSERT_ARGS(PackFile_map_segments
)
1144 for (i
= 0; i
< dir
->num_segments
; i
++) {
1145 const INTVAL ret
= callback(interp
, dir
->segments
[i
], user_data
);
1156 =item C<void PackFile_add_segment(PARROT_INTERP, PackFile_Directory *dir,
1157 PackFile_Segment *seg)>
1159 Adds the Segment C<seg> to the directory C<dir>. The PackFile becomes the
1160 owner of the segment; it gets destroyed when the PackFile does.
1168 PackFile_add_segment(SHIM_INTERP
, ARGMOD(PackFile_Directory
*dir
),
1169 ARGIN(PackFile_Segment
*seg
))
1171 ASSERT_ARGS(PackFile_add_segment
)
1172 mem_realloc_n_typed(dir
->segments
, dir
->num_segments
+1, PackFile_Segment
*);
1173 dir
->segments
[dir
->num_segments
] = seg
;
1174 dir
->num_segments
++;
1183 =item C<PackFile_Segment * PackFile_find_segment(PARROT_INTERP,
1184 PackFile_Directory *dir, STRING *name, int sub_dir)>
1186 Finds the segment with the name C<name> in the C<PackFile_Directory> if
1187 C<sub_dir> is true, searches directories recursively. The returned segment is
1188 still owned by the C<PackFile>.
1195 PARROT_WARN_UNUSED_RESULT
1196 PARROT_CAN_RETURN_NULL
1198 PackFile_find_segment(PARROT_INTERP
, ARGIN_NULLOK(PackFile_Directory
*dir
),
1199 ARGIN(STRING
*name
), int sub_dir
)
1201 ASSERT_ARGS(PackFile_find_segment
)
1205 for (i
= 0; i
< dir
->num_segments
; i
++) {
1206 PackFile_Segment
*seg
= dir
->segments
[i
];
1209 if (Parrot_str_equal(interp
, seg
->name
, name
))
1212 if (sub_dir
&& seg
->type
== PF_DIR_SEG
) {
1213 seg
= PackFile_find_segment(interp
,
1214 (PackFile_Directory
*)seg
, name
, sub_dir
);
1229 =item C<PackFile_Segment * PackFile_remove_segment_by_name(PARROT_INTERP,
1230 PackFile_Directory *dir, STRING *name)>
1232 Finds, removes, and returns the segment with name C<name> in the
1233 C<PackFile_Directory>. The caller is responsible for destroying the segment.
1240 PARROT_WARN_UNUSED_RESULT
1241 PARROT_CAN_RETURN_NULL
1243 PackFile_remove_segment_by_name(PARROT_INTERP
, ARGMOD(PackFile_Directory
*dir
),
1244 ARGIN(STRING
*name
))
1246 ASSERT_ARGS(PackFile_remove_segment_by_name
)
1249 for (i
= 0; i
< dir
->num_segments
; i
++) {
1250 PackFile_Segment
* const seg
= dir
->segments
[i
];
1251 if (Parrot_str_equal(interp
, seg
->name
, name
)) {
1252 dir
->num_segments
--;
1254 if (i
!= dir
->num_segments
) {
1255 /* We're not the last segment, so we need to move things */
1256 memmove(&dir
->segments
[i
], &dir
->segments
[i
+1],
1257 (dir
->num_segments
- i
) * sizeof (PackFile_Segment
*));
1272 =head2 PackFile Structure Functions
1276 =item C<static void PackFile_set_header(PackFile_Header *header)>
1278 Fills a C<PackFile> header with system specific data.
1285 PackFile_set_header(ARGOUT(PackFile_Header
*header
))
1287 ASSERT_ARGS(PackFile_set_header
)
1288 memcpy(header
->magic
, "\376PBC\r\n\032\n", 8);
1289 header
->wordsize
= sizeof (opcode_t
);
1290 header
->byteorder
= PARROT_BIGENDIAN
;
1291 header
->major
= PARROT_MAJOR_VERSION
;
1292 header
->minor
= PARROT_MINOR_VERSION
;
1293 header
->patch
= PARROT_PATCH_VERSION
;
1294 header
->bc_major
= PARROT_PBC_MAJOR
;
1295 header
->bc_minor
= PARROT_PBC_MINOR
;
1296 #if NUMVAL_SIZE == 8
1297 header
->floattype
= FLOATTYPE_8
;
1299 # if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN
1300 header
->floattype
= FLOATTYPE_12
;
1302 # if (NUMVAL_SIZE == 16)
1303 header
->floattype
= FLOATTYPE_16
;
1305 exit_fatal(1, "PackFile_set_header: Unsupported floattype NUMVAL_SIZE=%d,"
1306 " PARROT_BIGENDIAN=%s\n", NUMVAL_SIZE
,
1307 PARROT_BIGENDIAN
? "big-endian" : "little-endian");
1316 =item C<PackFile * PackFile_new(PARROT_INTERP, INTVAL is_mapped)>
1318 Allocates a new empty C<PackFile> and sets up the directory.
1322 +----------+----------+----------+----------+
1325 +----------+----------+----------+----------+
1327 +----------+----------+----------+----------+
1328 | number of directory items |
1329 +----------+----------+----------+----------+
1331 followed by a sequence of items
1333 +----------+----------+----------+----------+
1335 +----------+----------+----------+----------+
1337 | ... '\0' padding bytes |
1338 +----------+----------+----------+----------+
1339 | Offset in the file |
1340 +----------+----------+----------+----------+
1341 | Size of the segment |
1342 +----------+----------+----------+----------+
1344 "name" is a NUL-terminated c-string encoded in plain ASCII.
1346 Segment types are defined in F<include/parrot/packfile.h>.
1348 Offset and size are in C<opcode_t>.
1350 A Segment Header has these entries:
1352 - op_count total ops of segment incl. this count
1353 - itype internal type of segment
1354 - id internal id e.g code seg nr
1355 - size size of following op array, 0 if none
1356 * data possibly empty data, or e.g. byte code
1363 PARROT_WARN_UNUSED_RESULT
1364 PARROT_CANNOT_RETURN_NULL
1366 PackFile_new(PARROT_INTERP
, INTVAL is_mapped
)
1368 ASSERT_ARGS(PackFile_new
)
1369 PackFile
* const pf
= mem_allocate_zeroed_typed(PackFile
);
1370 pf
->header
= mem_allocate_zeroed_typed(PackFile_Header
);
1371 pf
->is_mmap_ped
= is_mapped
;
1372 pf
->options
= PFOPT_NONE
;
1374 /* fill header with system specific data */
1375 PackFile_set_header(pf
->header
);
1377 /* Other fields empty for now */
1379 pf_register_standard_funcs(interp
, pf
);
1381 /* create the master directory, all subirs go there */
1382 pf
->directory
.base
.pf
= pf
;
1383 pf
->dirp
= (PackFile_Directory
*)
1384 PackFile_Segment_new_seg(interp
, &pf
->directory
,
1385 PF_DIR_SEG
, DIRECTORY_SEGMENT_NAME
, 0);
1386 pf
->directory
= *pf
->dirp
;
1388 pf
->fetch_op
= (packfile_fetch_op_t
)NULL
;
1389 pf
->fetch_iv
= (packfile_fetch_iv_t
)NULL
;
1390 pf
->fetch_nv
= (packfile_fetch_nv_t
)NULL
;
1398 =item C<PackFile * PackFile_new_dummy(PARROT_INTERP, STRING *name)>
1400 Creates a new (initial) dummy PackFile. This is necessary if the interpreter
1401 doesn't load any bytecode but instead uses C<Parrot_compile_string>.
1408 PARROT_WARN_UNUSED_RESULT
1409 PARROT_CAN_RETURN_NULL
1411 PackFile_new_dummy(PARROT_INTERP
, ARGIN(STRING
*name
))
1413 ASSERT_ARGS(PackFile_new_dummy
)
1415 PackFile
* const pf
= PackFile_new(interp
, 0);
1416 interp
->initial_pf
= pf
;
1417 interp
->code
= pf
->cur_cs
1418 = PF_create_default_segs(interp
, name
, 1);
1426 =item C<void PackFile_funcs_register(PARROT_INTERP, PackFile *pf, UINTVAL type,
1427 const PackFile_funcs funcs)>
1429 Registers the C<pack>/C<unpack>/... functions for a packfile type.
1437 PackFile_funcs_register(SHIM_INTERP
, ARGOUT(PackFile
*pf
), UINTVAL type
,
1438 const PackFile_funcs funcs
)
1440 ASSERT_ARGS(PackFile_funcs_register
)
1441 /* TODO dynamic registering */
1442 pf
->PackFuncs
[type
] = funcs
;
1448 =item C<static const opcode_t * default_unpack(PackFile_Segment *self, const
1451 Unpacks a PackFile given a cursor into PBC. This is the default unpack.
1457 PARROT_WARN_UNUSED_RESULT
1458 PARROT_CAN_RETURN_NULL
1459 static const opcode_t
*
1460 default_unpack(ARGMOD(PackFile_Segment
*self
), ARGIN(const opcode_t
*cursor
))
1462 ASSERT_ARGS(default_unpack
)
1463 DECL_CONST_CAST_OF(opcode_t
);
1465 PackFile
* const pf
= self
->pf
;
1468 self
->op_count
= PF_fetch_opcode(self
->pf
, &cursor
);
1469 self
->itype
= PF_fetch_opcode(self
->pf
, &cursor
);
1470 self
->id
= PF_fetch_opcode(self
->pf
, &cursor
);
1471 self
->size
= PF_fetch_opcode(self
->pf
, &cursor
);
1472 TRACE_PRINTF_VAL(("default_unpack: op_count=%d, itype=%d, id=%d, size=%d.\n",
1473 self
->op_count
, self
->itype
, self
->id
, self
->size
));
1475 if (self
->size
== 0)
1478 /* if the packfile is mmap()ed just point to it if we don't
1479 * need any fetch transforms */
1480 if (self
->pf
->is_mmap_ped
1481 && !self
->pf
->need_endianize
1482 && !self
->pf
->need_wordsize
) {
1483 self
->data
= PARROT_const_cast(opcode_t
*, cursor
);
1484 cursor
+= self
->size
;
1488 /* else allocate mem */
1489 self
->data
= mem_allocate_n_typed(self
->size
, opcode_t
);
1492 Parrot_io_eprintf(NULL
, "PackFile_unpack: Unable to allocate data memory!\n");
1497 if (!self
->pf
->need_endianize
&& !self
->pf
->need_wordsize
) {
1498 mem_sys_memcopy(self
->data
, cursor
, self
->size
* sizeof (opcode_t
));
1499 cursor
+= self
->size
;
1503 TRACE_PRINTF(("default_unpack: pre-fetch %d ops into data\n",
1505 for (i
= 0; i
< (int)self
->size
; i
++) {
1506 self
->data
[i
] = PF_fetch_opcode(self
->pf
, &cursor
);
1507 TRACE_PRINTF(("default_unpack: transformed op[#%d]/%d %u\n",
1508 i
, self
->size
, self
->data
[i
]));
1518 =item C<void default_dump_header(PARROT_INTERP, const PackFile_Segment *self)>
1520 Dumps the header of a given PackFile_Segment.
1527 default_dump_header(PARROT_INTERP
, ARGIN(const PackFile_Segment
*self
))
1529 ASSERT_ARGS(default_dump_header
)
1530 Parrot_io_printf(interp
, "%Ss => [ # offs 0x%x(%d)",
1531 self
->name
, (int)self
->file_offset
, (int)self
->file_offset
);
1532 Parrot_io_printf(interp
, " = op_count %d, itype %d, id %d, size %d, ...",
1533 (int)self
->op_count
, (int)self
->itype
,
1534 (int)self
->id
, (int)self
->size
);
1540 =item C<static void default_dump(PARROT_INTERP, const PackFile_Segment *self)>
1542 Dumps a PackFile_Segment.
1549 default_dump(PARROT_INTERP
, ARGIN(const PackFile_Segment
*self
))
1551 ASSERT_ARGS(default_dump
)
1552 size_t i
= self
->data
? 0: self
->file_offset
+ 4;
1554 default_dump_header(interp
, self
);
1557 Parrot_io_printf(interp
, "\n %04x: ", (int) i
);
1559 for (; i
< (self
->data
? self
->size
:
1560 self
->file_offset
+ self
->op_count
); i
++) {
1563 Parrot_io_printf(interp
, "\n %04x: ", (int) i
);
1565 Parrot_io_printf(interp
, "%08lx ", (unsigned long)
1566 self
->data
? self
->data
[i
] : self
->pf
->src
[i
]);
1569 Parrot_io_printf(interp
, "\n]\n");
1575 =item C<static void pf_register_standard_funcs(PARROT_INTERP, PackFile *pf)>
1577 Registers a PackFile's functions; called from within C<PackFile_new()>.
1584 pf_register_standard_funcs(PARROT_INTERP
, ARGMOD(PackFile
*pf
))
1586 ASSERT_ARGS(pf_register_standard_funcs
)
1587 PackFile_funcs dirf
= {
1590 directory_packed_size
,
1596 PackFile_funcs defaultf
= {
1597 PackFile_Segment_new
,
1598 (PackFile_Segment_destroy_func_t
) NULLfunc
,
1599 (PackFile_Segment_packed_size_func_t
) NULLfunc
,
1600 (PackFile_Segment_pack_func_t
) NULLfunc
,
1601 (PackFile_Segment_unpack_func_t
) NULLfunc
,
1605 PackFile_funcs fixupf
= {
1614 PackFile_funcs constf
= {
1617 PackFile_ConstTable_pack_size
,
1618 PackFile_ConstTable_pack
,
1619 PackFile_ConstTable_unpack
,
1623 PackFile_funcs bytef
= {
1626 (PackFile_Segment_packed_size_func_t
) NULLfunc
,
1627 (PackFile_Segment_pack_func_t
) NULLfunc
,
1628 (PackFile_Segment_unpack_func_t
) NULLfunc
,
1632 const PackFile_funcs debugf
= {
1635 pf_debug_packed_size
,
1641 const PackFile_funcs annotationf
= {
1642 PackFile_Annotations_new
,
1643 PackFile_Annotations_destroy
,
1644 PackFile_Annotations_packed_size
,
1645 PackFile_Annotations_pack
,
1646 PackFile_Annotations_unpack
,
1647 PackFile_Annotations_dump
1650 PackFile_funcs_register(interp
, pf
, PF_DIR_SEG
, dirf
);
1651 PackFile_funcs_register(interp
, pf
, PF_UNKNOWN_SEG
, defaultf
);
1652 PackFile_funcs_register(interp
, pf
, PF_FIXUP_SEG
, fixupf
);
1653 PackFile_funcs_register(interp
, pf
, PF_CONST_SEG
, constf
);
1654 PackFile_funcs_register(interp
, pf
, PF_BYTEC_SEG
, bytef
);
1655 PackFile_funcs_register(interp
, pf
, PF_DEBUG_SEG
, debugf
);
1656 PackFile_funcs_register(interp
, pf
, PF_ANNOTATIONS_SEG
, annotationf
);
1664 =item C<PackFile_Segment * PackFile_Segment_new_seg(PARROT_INTERP,
1665 PackFile_Directory *dir, UINTVAL type, STRING *name, int add)>
1667 Creates a new segment in the given PackFile_Directory of the given C<type> with
1668 the given C<name>. If C<add> is true, adds the segment to the directory.
1675 PARROT_WARN_UNUSED_RESULT
1676 PARROT_CANNOT_RETURN_NULL
1678 PackFile_Segment_new_seg(PARROT_INTERP
, ARGMOD(PackFile_Directory
*dir
),
1679 UINTVAL type
, ARGIN(STRING
*name
), int add
)
1681 ASSERT_ARGS(PackFile_Segment_new_seg
)
1682 PackFile
* const pf
= dir
->base
.pf
;
1683 const PackFile_Segment_new_func_t f
= pf
->PackFuncs
[type
].new_seg
;
1684 PackFile_Segment
* const seg
= (f
)(interp
, pf
, name
, add
);
1686 segment_init(interp
, seg
, pf
, name
);
1690 PackFile_add_segment(interp
, dir
, seg
);
1698 =item C<static PackFile_Segment * create_seg(PARROT_INTERP, PackFile_Directory
1699 *dir, pack_file_types t, STRING *name, STRING *file_name, int add)>
1701 Creates a new PackFile_Segment for the given C<file_name>. See
1702 C<PackFile_Segment_new_seg()> for the other arguments.
1708 PARROT_WARN_UNUSED_RESULT
1709 PARROT_CANNOT_RETURN_NULL
1710 static PackFile_Segment
*
1711 create_seg(PARROT_INTERP
, ARGMOD(PackFile_Directory
*dir
), pack_file_types t
,
1712 ARGIN(STRING
*name
), ARGIN(STRING
*file_name
), int add
)
1714 ASSERT_ARGS(create_seg
)
1715 PackFile_Segment
*seg
;
1718 seg_name
= Parrot_sprintf_c(interp
, "%Ss_%Ss", name
, file_name
);
1719 seg
= PackFile_Segment_new_seg(interp
, dir
, t
, seg_name
, add
);
1726 =item C<PackFile_ByteCode * PF_create_default_segs(PARROT_INTERP, STRING
1727 *file_name, int add)>
1729 Creates the bytecode, constant, and fixup segments for C<file_name>. If C<add>
1730 is true, the current packfile becomes the owner of these segments by adding the
1731 segments to the directory.
1738 PARROT_WARN_UNUSED_RESULT
1739 PARROT_CANNOT_RETURN_NULL
1741 PF_create_default_segs(PARROT_INTERP
, ARGIN(STRING
*file_name
), int add
)
1743 ASSERT_ARGS(PF_create_default_segs
)
1744 PackFile
* const pf
= interp
->initial_pf
;
1745 PackFile_ByteCode
* const cur_cs
=
1746 (PackFile_ByteCode
*)create_seg(interp
, &pf
->directory
,
1747 PF_BYTEC_SEG
, BYTE_CODE_SEGMENT_NAME
, file_name
, add
);
1750 (PackFile_FixupTable
*)create_seg(interp
, &pf
->directory
,
1751 PF_FIXUP_SEG
, FIXUP_TABLE_SEGMENT_NAME
, file_name
, add
);
1753 cur_cs
->fixups
->code
= cur_cs
;
1755 cur_cs
->const_table
=
1756 (PackFile_ConstTable
*)create_seg(interp
, &pf
->directory
,
1757 PF_CONST_SEG
, CONSTANT_SEGMENT_NAME
, file_name
, add
);
1759 cur_cs
->const_table
->code
= cur_cs
;
1767 =item C<void PackFile_Segment_destroy(PARROT_INTERP, PackFile_Segment *self)>
1769 Destroys the given PackFile_Segment.
1777 PackFile_Segment_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
1779 ASSERT_ARGS(PackFile_Segment_destroy
)
1780 const PackFile_Segment_destroy_func_t f
=
1781 self
->pf
->PackFuncs
[self
->type
].destroy
;
1786 /* destroy self after specific */
1787 default_destroy(self
);
1793 =item C<size_t PackFile_Segment_packed_size(PARROT_INTERP, PackFile_Segment
1796 Returns the size of the given segment, when packed, taking into account padding
1805 PackFile_Segment_packed_size(PARROT_INTERP
, ARGIN(PackFile_Segment
*self
))
1807 ASSERT_ARGS(PackFile_Segment_packed_size
)
1808 size_t size
= default_packed_size(self
);
1809 const size_t align
= 16 / sizeof (opcode_t
);
1810 PackFile_Segment_packed_size_func_t f
=
1811 self
->pf
->PackFuncs
[self
->type
].packed_size
;
1814 size
+= (f
)(interp
, self
);
1817 if (align
&& size
% align
)
1818 size
+= (align
- size
% align
);
1826 =item C<opcode_t * PackFile_Segment_pack(PARROT_INTERP, PackFile_Segment *self,
1829 Packs a PackFile_Segment, returning a cursor to the start of the results.
1836 PARROT_WARN_UNUSED_RESULT
1837 PARROT_CANNOT_RETURN_NULL
1839 PackFile_Segment_pack(PARROT_INTERP
, ARGIN(PackFile_Segment
*self
),
1840 ARGIN(opcode_t
*cursor
))
1842 ASSERT_ARGS(PackFile_Segment_pack
)
1843 /*const size_t align = 16 / sizeof (opcode_t);*/
1844 PackFile_Segment_pack_func_t f
=
1845 self
->pf
->PackFuncs
[self
->type
].pack
;
1846 opcode_t
* old_cursor
; /* Used for filling padding with 0 */
1848 PackFile
* const pf
= self
->pf
;
1851 cursor
= default_pack(self
, cursor
);
1854 cursor
= (f
)(interp
, self
, cursor
);
1856 TRACE_PRINTF_ALIGN(("-ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
1857 OFFS(pf
, cursor
), pf
->src
, cursor
));
1858 old_cursor
= cursor
;
1859 ALIGN_16(self
->pf
, cursor
);
1860 /* fill padding with zeros */
1861 while (old_cursor
!= cursor
)
1864 /*if (align && (cursor - self->pf->src) % align)
1865 cursor += align - (cursor - self->pf->src) % align;*/
1866 TRACE_PRINTF_ALIGN(("+ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
1867 OFFS(pf
, cursor
), pf
->src
, cursor
));
1875 =item C<const opcode_t * PackFile_Segment_unpack(PARROT_INTERP, PackFile_Segment
1876 *self, const opcode_t *cursor)>
1878 Unpacks a PackFile_Segment, returning a cursor to the results on success and
1881 All all these functions call the related C<default_*> function.
1883 If a special is defined this gets called after.
1890 PARROT_WARN_UNUSED_RESULT
1891 PARROT_CAN_RETURN_NULL
1893 PackFile_Segment_unpack(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
),
1894 ARGIN(const opcode_t
*cursor
))
1896 ASSERT_ARGS(PackFile_Segment_unpack
)
1897 PackFile_Segment_unpack_func_t f
= self
->pf
->PackFuncs
[self
->type
].unpack
;
1900 PackFile
* const pf
= self
->pf
;
1903 cursor
= default_unpack(self
, cursor
);
1909 TRACE_PRINTF(("PackFile_Segment_unpack: special\n"));
1911 cursor
= (f
)(interp
, self
, cursor
);
1916 offs
= OFFS(self
->pf
, cursor
);
1917 TRACE_PRINTF_ALIGN(("-S ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
1918 offs
, self
->pf
->src
, cursor
));
1919 offs
+= PAD_16_B(offs
);
1920 cursor
= self
->pf
->src
+ offs
/(sizeof (opcode_t
));
1921 TRACE_PRINTF_ALIGN(("+S ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
1922 offs
, self
->pf
->src
, cursor
));
1929 =item C<void PackFile_Segment_dump(PARROT_INTERP, PackFile_Segment *self)>
1931 Dumps the segment C<self>.
1939 PackFile_Segment_dump(PARROT_INTERP
, ARGIN(PackFile_Segment
*self
))
1941 ASSERT_ARGS(PackFile_Segment_dump
)
1942 self
->pf
->PackFuncs
[self
->type
].dump(interp
, self
);
1950 =head2 Standard Directory Functions
1954 =item C<static PackFile_Segment * directory_new(PARROT_INTERP, PackFile *pf,
1955 STRING *name, int add)>
1957 Returns a new C<PackFile_Directory> cast as a C<PackFile_Segment>.
1963 PARROT_WARN_UNUSED_RESULT
1964 PARROT_CANNOT_RETURN_NULL
1965 static PackFile_Segment
*
1966 directory_new(SHIM_INTERP
, SHIM(PackFile
*pf
), SHIM(STRING
*name
), SHIM(int add
))
1968 ASSERT_ARGS(directory_new
)
1970 return (PackFile_Segment
*)mem_allocate_zeroed_typed(PackFile_Directory
);
1976 =item C<static void directory_dump(PARROT_INTERP, const PackFile_Segment *self)>
1978 Dumps the directory C<self>.
1985 directory_dump(PARROT_INTERP
, ARGIN(const PackFile_Segment
*self
))
1987 ASSERT_ARGS(directory_dump
)
1988 const PackFile_Directory
* const dir
= (const PackFile_Directory
*) self
;
1991 default_dump_header(interp
, self
);
1993 Parrot_io_printf(interp
, "\n\t# %d segments\n", dir
->num_segments
);
1995 for (i
= 0; i
< dir
->num_segments
; i
++) {
1996 const PackFile_Segment
* const seg
= dir
->segments
[i
];
1998 Parrot_io_printf(interp
,
1999 "\ttype %d\t%Ss\t", (int)seg
->type
, seg
->name
);
2001 Parrot_io_printf(interp
,
2002 " offs 0x%x(0x%x)\top_count %d\n",
2003 (int)seg
->file_offset
,
2004 (int)seg
->file_offset
* sizeof (opcode_t
),
2005 (int)seg
->op_count
);
2008 Parrot_io_printf(interp
, "]\n");
2010 for (i
= 0; i
< dir
->num_segments
; i
++)
2011 PackFile_Segment_dump(interp
, dir
->segments
[i
]);
2017 =item C<static const opcode_t * directory_unpack(PARROT_INTERP, PackFile_Segment
2018 *segp, const opcode_t *cursor)>
2020 Unpacks the directory from the provided cursor.
2026 PARROT_WARN_UNUSED_RESULT
2027 PARROT_CANNOT_RETURN_NULL
2028 static const opcode_t
*
2029 directory_unpack(PARROT_INTERP
, ARGMOD(PackFile_Segment
*segp
), ARGIN(const opcode_t
*cursor
))
2031 ASSERT_ARGS(directory_unpack
)
2032 PackFile_Directory
* const dir
= (PackFile_Directory
*) segp
;
2033 PackFile
* const pf
= dir
->base
.pf
;
2034 const opcode_t
*pos
;
2039 dir
->num_segments
= PF_fetch_opcode(pf
, &cursor
);
2040 TRACE_PRINTF(("directory_unpack: %ld num_segments\n", dir
->num_segments
));
2041 mem_realloc_n_typed(dir
->segments
, dir
->num_segments
, PackFile_Segment
*);
2043 for (i
= 0; i
< dir
->num_segments
; i
++) {
2044 PackFile_Segment
*seg
;
2050 UINTVAL type
= PF_fetch_opcode(pf
, &cursor
);
2051 if (type
>= PF_MAX_SEG
)
2052 type
= PF_UNKNOWN_SEG
;
2054 TRACE_PRINTF_VAL(("Segment type %d.\n", type
));
2057 buf
= PF_fetch_cstring(pf
, &cursor
);
2058 TRACE_PRINTF_VAL(("Segment name \"%s\".\n", name
));
2061 name
= Parrot_str_new(interp
, buf
, strlen(buf
));
2062 seg
= PackFile_Segment_new_seg(interp
, dir
, type
, name
, 0);
2065 seg
->file_offset
= PF_fetch_opcode(pf
, &cursor
);
2066 TRACE_PRINTF_VAL(("Segment file_offset %ld.\n", seg
->file_offset
));
2068 seg
->op_count
= PF_fetch_opcode(pf
, &cursor
);
2069 TRACE_PRINTF_VAL(("Segment op_count %ld.\n", seg
->op_count
));
2071 if (pf
->need_wordsize
) {
2072 #if OPCODE_T_SIZE == 8
2073 if (pf
->header
->wordsize
== 4)
2074 pos
= pf
->src
+ seg
->file_offset
/ 2;
2076 if (pf
->header
->wordsize
== 8)
2077 pos
= pf
->src
+ seg
->file_offset
* 2;
2080 fprintf(stderr
, "directory_unpack failed: invalid wordsize %d\n",
2081 (int)pf
->header
->wordsize
);
2084 TRACE_PRINTF_VAL(("Segment offset: new pos 0x%x "
2085 "(src=0x%x cursor=0x%x).\n",
2086 OFFS(pf
, pos
), pf
->src
, cursor
));
2089 pos
= pf
->src
+ seg
->file_offset
;
2091 opcode
= PF_fetch_opcode(pf
, &pos
);
2093 if (seg
->op_count
!= opcode
) {
2094 Parrot_io_eprintf(interp
,
2095 "%Ss: Size in directory %d doesn't match size %d "
2096 "at offset 0x%x\n", seg
->name
, (int)seg
->op_count
,
2097 (int)opcode
, (int)seg
->file_offset
);
2101 PackFile_Segment
*last
= dir
->segments
[i
-1];
2102 if (last
->file_offset
+ last
->op_count
!= seg
->file_offset
)
2103 fprintf(stderr
, "section: sections are not back to back\n");
2106 make_code_pointers(seg
);
2108 /* store the segment */
2109 dir
->segments
[i
] = seg
;
2113 offs
= OFFS(pf
, cursor
);
2114 TRACE_PRINTF_ALIGN(("-ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
2115 offs
, pf
->src
, cursor
));
2116 offs
+= PAD_16_B(offs
);
2117 cursor
= pf
->src
+ offs
/(sizeof (opcode_t
));
2118 TRACE_PRINTF_ALIGN(("+ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
2119 offs
, pf
->src
, cursor
));
2121 /* and now unpack contents of dir */
2122 for (i
= 0; cursor
&& i
< dir
->num_segments
; i
++) {
2123 const opcode_t
* const csave
= cursor
;
2125 /* check len again */
2126 size_t tmp
= PF_fetch_opcode(pf
, &cursor
);
2128 /* keep gcc -O silent */
2132 TRACE_PRINTF_VAL(("PackFile_Segment_unpack [%d] tmp len=%d.\n", i
, tmp
));
2133 pos
= PackFile_Segment_unpack(interp
, dir
->segments
[i
], cursor
);
2136 Parrot_io_eprintf(interp
, "PackFile_unpack segment '%Ss' failed\n",
2137 dir
->segments
[i
]->name
);
2141 TRACE_PRINTF_VAL(("PackFile_Segment_unpack ok. pos=0x%x\n", pos
));
2144 /* FIXME bug on 64bit reading 32bit lurking here! TT #254 */
2145 if (pf
->need_wordsize
) {
2146 #if OPCODE_T_SIZE == 8
2147 if (pf
->header
->wordsize
== 4)
2148 delta
= (pos
- cursor
) * 2;
2150 if (pf
->header
->wordsize
== 8)
2151 delta
= (pos
- cursor
) / 2;
2155 delta
= pos
- cursor
;
2157 TRACE_PRINTF_VAL((" delta=%d, pos=0x%x, cursor=0x%x\n",
2158 delta
, pos
, cursor
));
2160 if ((size_t)delta
!= tmp
|| dir
->segments
[i
]->op_count
!= tmp
)
2161 Parrot_io_eprintf(interp
, "PackFile_unpack segment '%Ss' directory length %d "
2162 "length in file %d needed %d for unpack\n",
2163 dir
->segments
[i
]->name
,
2164 (int)dir
->segments
[i
]->op_count
, (int)tmp
,
2175 =item C<static void directory_destroy(PARROT_INTERP, PackFile_Segment *self)>
2177 Destroys the directory.
2184 directory_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
2186 ASSERT_ARGS(directory_destroy
)
2187 PackFile_Directory
* const dir
= (PackFile_Directory
*)self
;
2190 for (i
= 0; i
< dir
->num_segments
; i
++) {
2191 PackFile_Segment
*segment
= dir
->segments
[i
];
2192 /* Prevent repeated destruction */
2193 dir
->segments
[i
] = NULL
;
2195 /* XXX Black magic here.
2196 * There are some failures that looks like a segment directory
2197 * inserted into another. Until that problems gets fixed,
2198 * these checks are a workaround.
2200 if (segment
&& segment
!= self
&& segment
->type
!= PF_DIR_SEG
)
2201 PackFile_Segment_destroy(interp
, segment
);
2204 if (dir
->segments
) {
2205 mem_sys_free(dir
->segments
);
2206 dir
->segments
= NULL
;
2207 dir
->num_segments
= 0;
2214 =item C<static void sort_segs(PackFile_Directory *dir)>
2216 Sorts the segments in C<dir>.
2223 sort_segs(ARGMOD(PackFile_Directory
*dir
))
2225 ASSERT_ARGS(sort_segs
)
2226 const size_t num_segs
= dir
->num_segments
;
2227 PackFile_Segment
*seg
= dir
->segments
[0];
2229 if (seg
->type
!= PF_BYTEC_SEG
) {
2232 for (i
= 1; i
< num_segs
; i
++) {
2233 PackFile_Segment
* const s2
= dir
->segments
[i
];
2234 if (s2
->type
== PF_BYTEC_SEG
) {
2235 dir
->segments
[0] = s2
;
2236 dir
->segments
[i
] = seg
;
2242 seg
= dir
->segments
[1];
2244 if (seg
->type
!= PF_FIXUP_SEG
) {
2247 for (i
= 2; i
< num_segs
; i
++) {
2248 PackFile_Segment
* const s2
= dir
->segments
[i
];
2249 if (s2
->type
== PF_FIXUP_SEG
) {
2250 dir
->segments
[1] = s2
;
2251 dir
->segments
[i
] = seg
;
2258 * Temporary? hack to put ConstantTable in front of other segments.
2259 * This is useful for Annotations because we ensure that constants used
2260 * for keys already available during unpack.
2262 seg
= dir
->segments
[2];
2264 if (seg
->type
!= PF_CONST_SEG
) {
2267 for (i
= 3; i
< num_segs
; i
++) {
2268 PackFile_Segment
* const s2
= dir
->segments
[i
];
2269 if (s2
->type
== PF_CONST_SEG
) {
2270 dir
->segments
[2] = s2
;
2271 dir
->segments
[i
] = seg
;
2281 =item C<static size_t directory_packed_size(PARROT_INTERP, PackFile_Segment
2284 Returns the size of the directory minus the value returned by
2285 C<default_packed_size()>.
2291 PARROT_WARN_UNUSED_RESULT
2293 directory_packed_size(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
2295 ASSERT_ARGS(directory_packed_size
)
2296 PackFile_Directory
* const dir
= (PackFile_Directory
*)self
;
2297 const size_t align
= 16 / sizeof (opcode_t
);
2300 /* need bytecode, fixup, other segs ... */
2303 /* number of segments + default, we need it for the offsets */
2304 size
= 1 + default_packed_size(self
);
2306 for (i
= 0; i
< dir
->num_segments
; i
++) {
2307 char *name
= Parrot_str_to_cstring(interp
, dir
->segments
[i
]->name
);
2308 /* type, offset, size */
2310 size
+= PF_size_cstring(name
);
2311 Parrot_str_free_cstring(name
);
2315 if (align
&& size
% align
)
2316 size
+= (align
- size
% align
);
2318 for (i
= 0; i
< dir
->num_segments
; i
++) {
2321 dir
->segments
[i
]->file_offset
= size
+ self
->file_offset
;
2323 PackFile_Segment_packed_size(interp
, dir
->segments
[i
]);
2324 dir
->segments
[i
]->op_count
= seg_size
;
2328 self
->op_count
= size
;
2330 /* subtract default, it is added in PackFile_Segment_packed_size */
2331 return size
- default_packed_size(self
);
2337 =item C<static opcode_t * directory_pack(PARROT_INTERP, PackFile_Segment *self,
2340 Packs the directory C<self>, using the given cursor.
2346 PARROT_WARN_UNUSED_RESULT
2347 PARROT_CANNOT_RETURN_NULL
2349 directory_pack(PARROT_INTERP
, ARGIN(PackFile_Segment
*self
), ARGOUT(opcode_t
*cursor
))
2351 ASSERT_ARGS(directory_pack
)
2352 PackFile_Directory
* const dir
= (PackFile_Directory
*)self
;
2353 const size_t num_segs
= dir
->num_segments
;
2354 /*const size_t align = 16/sizeof (opcode_t);*/
2356 PackFile
* const pf
= self
->pf
;
2357 opcode_t
* old_cursor
; /* Used for filling padding with 0 */
2359 *cursor
++ = num_segs
;
2361 for (i
= 0; i
< num_segs
; i
++) {
2362 const PackFile_Segment
* const seg
= dir
->segments
[i
];
2363 char *name
= Parrot_str_to_cstring(interp
, seg
->name
);
2364 *cursor
++ = seg
->type
;
2365 cursor
= PF_store_cstring(cursor
, name
);
2366 *cursor
++ = seg
->file_offset
;
2367 *cursor
++ = seg
->op_count
;
2368 Parrot_str_free_cstring(name
);
2371 TRACE_PRINTF_ALIGN(("-ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
2372 OFFS(pf
, cursor
), pf
->src
, cursor
));
2373 old_cursor
= cursor
;
2374 ALIGN_16(pf
, cursor
);
2375 /* fill padding with zeros */
2376 while (old_cursor
!= cursor
)
2378 TRACE_PRINTF_ALIGN(("+ALIGN_16: offset=0x%x src=0x%x cursor=0x%x\n",
2379 OFFS(pf
, cursor
), pf
->src
, cursor
));
2380 /*if (align && (cursor - self->pf->src) % align)
2381 cursor += align - (cursor - self->pf->src) % align;*/
2383 /* now pack all segments into new format */
2384 for (i
= 0; i
< dir
->num_segments
; i
++) {
2385 PackFile_Segment
* const seg
= dir
->segments
[i
];
2387 cursor
= PackFile_Segment_pack(interp
, seg
, cursor
);
2398 =head2 C<PackFile_Segment> Functions
2402 =item C<static void segment_init(PARROT_INTERP, PackFile_Segment *self, PackFile
2405 Initializes the segment C<self> with the provided PackFile and the given name.
2406 Note that this duplicates the given name.
2413 segment_init(PARROT_INTERP
, ARGOUT(PackFile_Segment
*self
), ARGIN(PackFile
*pf
),
2414 ARGIN(STRING
*name
))
2416 ASSERT_ARGS(segment_init
)
2418 self
->type
= PF_UNKNOWN_SEG
;
2419 self
->file_offset
= 0;
2425 self
->name
= Parrot_str_copy(interp
, name
);
2431 =item C<PackFile_Segment * PackFile_Segment_new(PARROT_INTERP, PackFile *pf,
2432 STRING *name, int add)>
2434 Creates a new default section.
2441 PARROT_WARN_UNUSED_RESULT
2442 PARROT_CANNOT_RETURN_NULL
2444 PackFile_Segment_new(SHIM_INTERP
, SHIM(PackFile
*pf
), SHIM(STRING
*name
), SHIM(int add
))
2446 ASSERT_ARGS(PackFile_Segment_new
)
2447 PackFile_Segment
* const seg
= mem_allocate_typed(PackFile_Segment
);
2457 =head2 Default Function Implementations
2459 The default functions are called before the segment specific functions
2460 and can read a block of C<opcode_t> data.
2464 =item C<static void default_destroy(PackFile_Segment *self)>
2466 The default destroy function. Destroys a PackFile_Segment.
2473 default_destroy(ARGMOD(PackFile_Segment
*self
))
2475 ASSERT_ARGS(default_destroy
)
2476 if (!self
->pf
->is_mmap_ped
&& self
->data
) {
2477 mem_sys_free(self
->data
);
2487 =item C<static size_t default_packed_size(const PackFile_Segment *self)>
2489 Returns the default size of the segment C<self>.
2496 default_packed_size(ARGIN(const PackFile_Segment
*self
))
2498 ASSERT_ARGS(default_packed_size
)
2499 /* op_count, itype, id, size */
2500 /* XXX There should be a constant defining this 4, and why */
2501 /* This is the 2nd place in the file that has this */
2502 return 4 + self
->size
;
2508 =item C<static opcode_t * default_pack(const PackFile_Segment *self, opcode_t
2511 Performs the default pack.
2517 PARROT_WARN_UNUSED_RESULT
2518 PARROT_CANNOT_RETURN_NULL
2520 default_pack(ARGIN(const PackFile_Segment
*self
), ARGOUT(opcode_t
*dest
))
2522 ASSERT_ARGS(default_pack
)
2523 *dest
++ = self
->op_count
;
2524 *dest
++ = self
->itype
;
2526 *dest
++ = self
->size
;
2529 STRUCT_COPY_N(dest
, self
->data
, self
->size
);
2531 return dest
+ self
->size
;
2543 =item C<static void byte_code_destroy(PARROT_INTERP, PackFile_Segment *self)>
2545 Destroys the C<PackFile_ByteCode> segment C<self>.
2552 byte_code_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
2554 ASSERT_ARGS(byte_code_destroy
)
2555 PackFile_ByteCode
* const byte_code
= (PackFile_ByteCode
*)self
;
2557 if (byte_code
->prederef
.code
) {
2558 Parrot_free_memalign(byte_code
->prederef
.code
);
2559 byte_code
->prederef
.code
= NULL
;
2561 if (byte_code
->prederef
.branches
) {
2562 mem_sys_free(byte_code
->prederef
.branches
);
2563 byte_code
->prederef
.branches
= NULL
;
2567 byte_code
->fixups
= NULL
;
2568 byte_code
->const_table
= NULL
;
2569 byte_code
->debugs
= NULL
;
2575 =item C<static PackFile_Segment * byte_code_new(PARROT_INTERP, PackFile *pf,
2576 STRING *name, int add)>
2578 Creates a new C<PackFile_ByteCode> segment. Ignores C<pf>, C<name>, and C<add>
2585 PARROT_WARN_UNUSED_RESULT
2586 PARROT_CANNOT_RETURN_NULL
2587 static PackFile_Segment
*
2588 byte_code_new(SHIM_INTERP
, SHIM(PackFile
*pf
), SHIM(STRING
*name
), SHIM(int add
))
2590 ASSERT_ARGS(byte_code_new
)
2591 PackFile_ByteCode
* const byte_code
= mem_allocate_zeroed_typed(PackFile_ByteCode
);
2593 return (PackFile_Segment
*) byte_code
;
2605 =item C<static void pf_debug_destroy(PARROT_INTERP, PackFile_Segment *self)>
2607 Destroys the C<PackFile_Debug> segment C<self>.
2614 pf_debug_destroy(SHIM_INTERP
, ARGMOD(PackFile_Segment
*self
))
2616 ASSERT_ARGS(pf_debug_destroy
)
2617 PackFile_Debug
* const debug
= (PackFile_Debug
*) self
;
2620 /* Free each mapping. */
2621 for (i
= 0; i
< debug
->num_mappings
; i
++)
2622 mem_sys_free(debug
->mappings
[i
]);
2624 /* Free mappings pointer array. */
2625 mem_sys_free(debug
->mappings
);
2626 debug
->mappings
= NULL
;
2627 debug
->num_mappings
= 0;
2633 =item C<static PackFile_Segment * pf_debug_new(PARROT_INTERP, PackFile *pf,
2634 STRING *name, int add)>
2636 Creates and returns a new C<PackFile_Debug> segment. Ignores C<pf>, C<name>,
2643 PARROT_WARN_UNUSED_RESULT
2644 PARROT_CANNOT_RETURN_NULL
2645 static PackFile_Segment
*
2646 pf_debug_new(SHIM_INTERP
, SHIM(PackFile
*pf
), SHIM(STRING
*name
), SHIM(int add
))
2648 ASSERT_ARGS(pf_debug_new
)
2649 PackFile_Debug
* const debug
= mem_allocate_zeroed_typed(PackFile_Debug
);
2651 debug
->mappings
= mem_allocate_typed(PackFile_DebugFilenameMapping
*);
2652 debug
->mappings
[0] = NULL
;
2654 return (PackFile_Segment
*)debug
;
2660 =item C<static size_t pf_debug_packed_size(PARROT_INTERP, PackFile_Segment
2663 Returns the size of the C<PackFile_Debug> segment's filename in C<opcode_t>
2671 pf_debug_packed_size(SHIM_INTERP
, ARGIN(PackFile_Segment
*self
))
2673 ASSERT_ARGS(pf_debug_packed_size
)
2674 PackFile_Debug
* const debug
= (PackFile_Debug
*)self
;
2676 return (debug
->num_mappings
*2) + 1;
2682 =item C<static opcode_t * pf_debug_pack(PARROT_INTERP, PackFile_Segment *self,
2685 Packs the debug segment, using the given cursor.
2691 PARROT_WARN_UNUSED_RESULT
2692 PARROT_CANNOT_RETURN_NULL
2694 pf_debug_pack(SHIM_INTERP
, ARGMOD(PackFile_Segment
*self
), ARGOUT(opcode_t
*cursor
))
2696 ASSERT_ARGS(pf_debug_pack
)
2697 PackFile_Debug
* const debug
= (PackFile_Debug
*)self
;
2698 const int n
= debug
->num_mappings
;
2701 /* Store number of mappings. */
2704 /* Now store each mapping. */
2705 for (i
= 0; i
< n
; i
++) {
2706 /* Bytecode offset and filename. */
2707 *cursor
++ = debug
->mappings
[i
]->offset
;
2708 *cursor
++ = debug
->mappings
[i
]->filename
;
2717 =item C<static const opcode_t * pf_debug_unpack(PARROT_INTERP, PackFile_Segment
2718 *self, const opcode_t *cursor)>
2720 Unpacks a debug segment into a PackFile_Debug structure, given the cursor.
2726 PARROT_WARN_UNUSED_RESULT
2727 PARROT_CANNOT_RETURN_NULL
2728 static const opcode_t
*
2729 pf_debug_unpack(PARROT_INTERP
, ARGOUT(PackFile_Segment
*self
), ARGIN(const opcode_t
*cursor
))
2731 ASSERT_ARGS(pf_debug_unpack
)
2732 PackFile_Debug
* const debug
= (PackFile_Debug
*)self
;
2733 PackFile_ByteCode
*code
;
2736 /* For some reason, we store the source file name in the segment
2737 name. So we can't find the bytecode seg without knowing the filename.
2738 But with the new scheme we can have many file names. For now, just
2739 base this on the name of the debug segment. */
2740 STRING
*code_name
= NULL
;
2743 /* Number of mappings. */
2744 debug
->num_mappings
= PF_fetch_opcode(self
->pf
, &cursor
);
2746 /* Allocate space for mappings vector. */
2747 mem_realloc_n_typed(debug
->mappings
, debug
->num_mappings
+ 1,
2748 PackFile_DebugFilenameMapping
*);
2750 /* Read in each mapping. */
2751 for (i
= 0; i
< debug
->num_mappings
; i
++) {
2752 /* Allocate struct and get offset and filename type. */
2753 debug
->mappings
[i
] =
2754 mem_allocate_typed(PackFile_DebugFilenameMapping
);
2755 debug
->mappings
[i
]->offset
= PF_fetch_opcode(self
->pf
, &cursor
);
2756 debug
->mappings
[i
]->filename
= PF_fetch_opcode(self
->pf
, &cursor
);
2759 /* find seg e.g. CODE_DB => CODE and attach it */
2760 str_len
= Parrot_str_length(interp
, debug
->base
.name
);
2761 code_name
= Parrot_str_substr(interp
, debug
->base
.name
, 0, str_len
- 3, NULL
, 1);
2762 code
= (PackFile_ByteCode
*)PackFile_find_segment(interp
, self
->dir
, code_name
, 0);
2764 if (!code
|| code
->base
.type
!= PF_BYTEC_SEG
) {
2765 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
2766 "Code '%Ss' not found for debug segment '%Ss'\n",
2767 code_name
, self
->name
);
2770 code
->debugs
= debug
;
2779 =item C<static void pf_debug_dump(PARROT_INTERP, const PackFile_Segment *self)>
2781 Dumps a debug segment to a human readable form.
2788 pf_debug_dump(PARROT_INTERP
, ARGIN(const PackFile_Segment
*self
))
2790 ASSERT_ARGS(pf_debug_dump
)
2791 const PackFile_Debug
* const debug
= (const PackFile_Debug
*)self
;
2796 default_dump_header(interp
, self
);
2798 Parrot_io_printf(interp
, "\n mappings => [\n");
2799 for (i
= 0; i
< debug
->num_mappings
; i
++) {
2800 Parrot_io_printf(interp
, " #%d\n [\n", i
);
2801 Parrot_io_printf(interp
, " OFFSET => %d,\n",
2802 debug
->mappings
[i
]->offset
);
2803 Parrot_io_printf(interp
, " FILENAME => %Ss\n",
2804 PF_CONST(debug
->code
, debug
->mappings
[i
]->filename
)->u
.string
);
2805 Parrot_io_printf(interp
, " ],\n");
2808 Parrot_io_printf(interp
, " ]\n");
2810 j
= self
->data
? 0: self
->file_offset
+ 4;
2813 Parrot_io_printf(interp
, "\n %04x: ", (int) j
);
2815 for (; j
< (self
->data
? self
->size
:
2816 self
->file_offset
+ self
->op_count
); j
++) {
2819 Parrot_io_printf(interp
, "\n %04x: ", (int) j
);
2821 Parrot_io_printf(interp
, "%08lx ", (unsigned long)
2822 self
->data
? self
->data
[j
] : self
->pf
->src
[j
]);
2825 Parrot_io_printf(interp
, "\n]\n");
2831 =item C<PackFile_Debug * Parrot_new_debug_seg(PARROT_INTERP, PackFile_ByteCode
2834 Creates and appends (or resizes) a new debug seg for a code segment. Uses the
2835 given size as its size.
2842 PARROT_WARN_UNUSED_RESULT
2843 PARROT_CANNOT_RETURN_NULL
2845 Parrot_new_debug_seg(PARROT_INTERP
, ARGMOD(PackFile_ByteCode
*cs
), size_t size
)
2847 ASSERT_ARGS(Parrot_new_debug_seg
)
2848 PackFile_Debug
*debug
;
2850 /* it exists already, resize it */
2853 mem_realloc_n_typed(debug
->base
.data
, size
, opcode_t
);
2858 const int add
= (interp
->code
&& interp
->code
->base
.dir
);
2859 PackFile_Directory
* const dir
= add
2860 ? interp
->code
->base
.dir
2863 : &interp
->initial_pf
->directory
;
2865 name
= Parrot_sprintf_c(interp
, "%Ss_DB", cs
->base
.name
);
2866 debug
= (PackFile_Debug
*)PackFile_Segment_new_seg(interp
, dir
,
2867 PF_DEBUG_SEG
, name
, add
);
2869 debug
->base
.data
= mem_allocate_n_zeroed_typed(size
, opcode_t
);
2874 debug
->base
.size
= size
;
2882 =item C<void Parrot_debug_add_mapping(PARROT_INTERP, PackFile_Debug *debug,
2883 opcode_t offset, const char *filename)>
2885 Adds a bytecode offset to a filename mapping for a PackFile_Debug.
2893 Parrot_debug_add_mapping(PARROT_INTERP
, ARGMOD(PackFile_Debug
*debug
),
2894 opcode_t offset
, ARGIN(const char *filename
))
2896 ASSERT_ARGS(Parrot_debug_add_mapping
)
2897 PackFile_ConstTable
* const ct
= debug
->code
->const_table
;
2900 /* Allocate space for the extra entry. */
2901 mem_realloc_n_typed(debug
->mappings
, debug
->num_mappings
+ 1,
2902 PackFile_DebugFilenameMapping
*);
2904 /* Can it just go on the end? */
2905 if (debug
->num_mappings
== 0
2906 || offset
>= debug
->mappings
[debug
->num_mappings
- 1]->offset
)
2907 insert_pos
= debug
->num_mappings
;
2909 /* Find the right place and shift stuff that's after it. */
2912 for (i
= 0; i
< debug
->num_mappings
; i
++) {
2913 if (debug
->mappings
[i
]->offset
> offset
) {
2915 memmove(debug
->mappings
+ i
+ 1, debug
->mappings
+ i
,
2916 debug
->num_mappings
- i
);
2922 /* Need to put filename in constants table. */
2924 /* Set up new entry and insert it. */
2925 PackFile_DebugFilenameMapping
*mapping
=
2926 mem_allocate_typed(PackFile_DebugFilenameMapping
);
2927 STRING
*namestr
= Parrot_str_new_init(interp
, filename
, strlen(filename
),
2928 PARROT_DEFAULT_ENCODING
, PARROT_DEFAULT_CHARSET
, 0);
2929 size_t count
= ct
->const_count
;
2932 mapping
->offset
= offset
;
2934 /* Check if there is already a constant with this filename */
2935 for (i
= 0; i
< count
; ++i
) {
2936 if (ct
->constants
[i
]->type
== PFC_STRING
&&
2937 Parrot_str_equal(interp
, namestr
, ct
->constants
[i
]->u
.string
))
2941 /* There is one, use it */
2945 /* Not found, create a new one */
2946 PackFile_Constant
*fnconst
;
2947 ct
->const_count
= ct
->const_count
+ 1;
2948 mem_realloc_n_typed(ct
->constants
, ct
->const_count
, PackFile_Constant
*);
2950 fnconst
= PackFile_Constant_new(interp
);
2951 fnconst
->type
= PFC_STRING
;
2952 fnconst
->u
.string
= Parrot_str_new_init(interp
, filename
, strlen(filename
),
2953 PARROT_DEFAULT_ENCODING
, PARROT_DEFAULT_CHARSET
,
2954 PObj_constant_FLAG
);
2955 ct
->constants
[ct
->const_count
- 1] = fnconst
;
2958 /* Set the mapped value */
2959 mapping
->filename
= count
;
2960 debug
->mappings
[insert_pos
] = mapping
;
2961 debug
->num_mappings
= debug
->num_mappings
+ 1;
2968 =item C<STRING * Parrot_debug_pc_to_filename(PARROT_INTERP, const PackFile_Debug
2969 *debug, opcode_t pc)>
2971 Returns the filename of the source for the given position in the bytecode.
2978 PARROT_WARN_UNUSED_RESULT
2979 PARROT_CANNOT_RETURN_NULL
2981 Parrot_debug_pc_to_filename(PARROT_INTERP
, ARGIN(const PackFile_Debug
*debug
),
2984 ASSERT_ARGS(Parrot_debug_pc_to_filename
)
2985 /* Look through mappings until we find one that maps the passed
2989 for (i
= 0; i
< debug
->num_mappings
; i
++) {
2990 /* If this is the last mapping or the current position is
2991 between this mapping and the next one, return a filename. */
2992 if (i
+ 1 == debug
->num_mappings
2993 || (debug
->mappings
[i
]->offset
<= pc
2994 && debug
->mappings
[i
+ 1]->offset
> pc
))
2995 return PF_CONST(debug
->code
,
2996 debug
->mappings
[i
]->filename
)->u
.string
;
2999 /* Otherwise, no mappings == no filename. */
3000 return string_from_literal(interp
, "(unknown file)");
3006 =item C<void Parrot_switch_to_cs_by_nr(PARROT_INTERP, opcode_t seg)>
3008 Switches the current bytecode segment to the segment keyed by number C<seg>.
3016 Parrot_switch_to_cs_by_nr(PARROT_INTERP
, opcode_t seg
)
3018 ASSERT_ARGS(Parrot_switch_to_cs_by_nr
)
3019 const PackFile_Directory
* const dir
= interp
->code
->base
.dir
;
3020 const size_t num_segs
= dir
->num_segments
;
3025 /* TODO make an index of code segments for faster look up */
3026 for (i
= n
= 0; i
< num_segs
; i
++) {
3027 if (dir
->segments
[i
]->type
== PF_BYTEC_SEG
) {
3029 Parrot_switch_to_cs(interp
, (PackFile_ByteCode
*)
3030 dir
->segments
[i
], 1);
3037 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
3038 "Segment number %d not found\n", (int)seg
);
3044 =item C<PackFile_ByteCode * Parrot_switch_to_cs(PARROT_INTERP, PackFile_ByteCode
3045 *new_cs, int really)>
3047 Switches to a bytecode segment C<new_cs>, returning the old segment.
3054 PARROT_IGNORABLE_RESULT
3055 PARROT_CANNOT_RETURN_NULL
3057 Parrot_switch_to_cs(PARROT_INTERP
, ARGIN(PackFile_ByteCode
*new_cs
), int really
)
3059 ASSERT_ARGS(Parrot_switch_to_cs
)
3060 PackFile_ByteCode
* const cur_cs
= interp
->code
;
3063 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_NO_PREV_CS
,
3064 "No code segment to switch to\n");
3066 /* compiling source code uses this function too,
3067 * which gives misleading trace messages */
3068 if (really
&& Interp_trace_TEST(interp
, PARROT_TRACE_SUB_CALL_FLAG
)) {
3069 Interp
* const tracer
= interp
->pdb
&& interp
->pdb
->debugger
3070 ? interp
->pdb
->debugger
3072 Parrot_io_eprintf(tracer
, "*** switching to %s\n", new_cs
->base
.name
);
3075 interp
->code
= new_cs
;
3076 Parrot_pcc_set_constants(interp
, CURRENT_CONTEXT(interp
), really
3077 ? find_constants(interp
, new_cs
->const_table
)
3078 : new_cs
->const_table
->constants
);
3080 /* new_cs->const_table->constants; */
3081 Parrot_pcc_set_pred_offset(interp
, CURRENT_CONTEXT(interp
),
3082 new_cs
->base
.data
- (opcode_t
*) new_cs
->prederef
.code
);
3085 prepare_for_run(interp
);
3093 =item C<static PackFile_Constant * clone_constant(PARROT_INTERP,
3094 PackFile_Constant *old_const)>
3096 Clones a constant (at least, if it's a Sub PMC), returning the clone.
3102 PARROT_WARN_UNUSED_RESULT
3103 PARROT_CANNOT_RETURN_NULL
3104 static PackFile_Constant
*
3105 clone_constant(PARROT_INTERP
, ARGIN(PackFile_Constant
*old_const
))
3107 ASSERT_ARGS(clone_constant
)
3108 STRING
* const _sub
= CONST_STRING(interp
, "Sub");
3110 if (old_const
->type
== PFC_PMC
3111 && VTABLE_isa(interp
, old_const
->u
.key
, _sub
)) {
3112 PMC
*old_sub_pmc
, *new_sub_pmc
;
3113 Parrot_Sub_attributes
*old_sub
, *new_sub
;
3114 PackFile_Constant
* const ret
= mem_allocate_typed(PackFile_Constant
);
3116 ret
->type
= old_const
->type
;
3117 old_sub_pmc
= old_const
->u
.key
;
3118 new_sub_pmc
= Parrot_thaw_constants(interp
, Parrot_freeze(interp
, old_sub_pmc
));
3120 PMC_get_sub(interp
, new_sub_pmc
, new_sub
);
3121 PMC_get_sub(interp
, old_sub_pmc
, old_sub
);
3122 new_sub
->seg
= old_sub
->seg
;
3124 /* Vtable overrides and methods were already cloned, so don't reclone them. */
3125 if (new_sub
->vtable_index
== -1
3126 && !(old_sub
->comp_flags
& SUB_COMP_FLAG_METHOD
))
3127 Parrot_store_sub_in_namespace(interp
, new_sub_pmc
);
3129 ret
->u
.key
= new_sub_pmc
;
3140 =item C<static PackFile_Constant ** find_constants(PARROT_INTERP,
3141 PackFile_ConstTable *ct)>
3143 Finds the constant table associated with a thread. For now, we need to copy
3144 constant tables because some entries aren't really constant; e.g. subroutines
3145 need to refer to namespace pointers.
3151 PARROT_WARN_UNUSED_RESULT
3152 PARROT_CANNOT_RETURN_NULL
3153 static PackFile_Constant
**
3154 find_constants(PARROT_INTERP
, ARGIN(PackFile_ConstTable
*ct
))
3156 ASSERT_ARGS(find_constants
)
3158 || !interp
->thread_data
3159 || interp
->thread_data
->tid
== 0)
3160 return ct
->constants
;
3163 PackFile_Constant
**new_consts
;
3165 PARROT_ASSERT(interp
->thread_data
);
3167 if (!interp
->thread_data
->const_tables
) {
3168 interp
->thread_data
->const_tables
= parrot_new_pointer_hash(interp
);
3171 tables
= interp
->thread_data
->const_tables
;
3172 new_consts
= (PackFile_Constant
**)parrot_hash_get(interp
, tables
, ct
);
3175 /* need to construct it */
3176 PackFile_Constant
** const old_consts
= ct
->constants
;
3177 INTVAL
const num_consts
= ct
->const_count
;
3180 new_consts
= mem_allocate_n_typed(num_consts
, PackFile_Constant
*);
3182 for (i
= 0; i
< num_consts
; ++i
)
3183 new_consts
[i
] = clone_constant(interp
, old_consts
[i
]);
3185 parrot_hash_put(interp
, tables
, ct
, new_consts
);
3195 =item C<void Parrot_destroy_constants(PARROT_INTERP)>
3197 Destroys the constants for an interpreter.
3205 Parrot_destroy_constants(PARROT_INTERP
)
3207 ASSERT_ARGS(Parrot_destroy_constants
)
3211 if (!interp
->thread_data
)
3214 hash
= interp
->thread_data
->const_tables
;
3219 for (i
= 0; i
<= hash
->mask
; ++i
) {
3220 HashBucket
*bucket
= hash
->bi
[i
];
3223 PackFile_ConstTable
* const table
=
3224 (PackFile_ConstTable
*)bucket
->key
;
3225 PackFile_Constant
** const orig_consts
= table
->constants
;
3226 PackFile_Constant
** const consts
=
3227 (PackFile_Constant
**) bucket
->value
;
3230 for (j
= 0; j
< table
->const_count
; ++j
) {
3231 if (consts
[j
] != orig_consts
[j
])
3232 mem_sys_free(consts
[j
]);
3235 mem_sys_free(consts
);
3236 bucket
= bucket
->next
;
3240 parrot_hash_destroy(interp
, hash
);
3248 =head2 PackFile FixupTable Structure Functions
3252 =item C<void PackFile_FixupTable_clear(PARROT_INTERP, PackFile_FixupTable
3255 Clears a PackFile FixupTable.
3263 PackFile_FixupTable_clear(PARROT_INTERP
, ARGMOD(PackFile_FixupTable
*self
))
3265 ASSERT_ARGS(PackFile_FixupTable_clear
)
3269 Parrot_io_eprintf(interp
, "PackFile_FixupTable_clear: self == NULL!\n");
3273 for (i
= 0; i
< self
->fixup_count
; i
++) {
3274 mem_sys_free(self
->fixups
[i
]->name
);
3275 self
->fixups
[i
]->name
= NULL
;
3277 mem_sys_free(self
->fixups
[i
]);
3278 self
->fixups
[i
] = NULL
;
3281 if (self
->fixup_count
) {
3282 mem_sys_free(self
->fixups
);
3283 self
->fixups
= NULL
;
3286 self
->fixups
= NULL
;
3287 self
->fixup_count
= 0;
3295 =item C<static void fixup_destroy(PARROT_INTERP, PackFile_Segment *self)>
3297 Calls C<PackFile_FixupTable_clear()> with C<self>.
3304 fixup_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
3306 ASSERT_ARGS(fixup_destroy
)
3307 PackFile_FixupTable
* const ft
= (PackFile_FixupTable
*)self
;
3308 PackFile_FixupTable_clear(interp
, ft
);
3314 =item C<static size_t fixup_packed_size(PARROT_INTERP, PackFile_Segment *self)>
3316 I<What does this do?>
3323 fixup_packed_size(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
3325 ASSERT_ARGS(fixup_packed_size
)
3326 PackFile_FixupTable
* const ft
= (PackFile_FixupTable
*)self
;
3330 for (i
= 0; i
< ft
->fixup_count
; i
++) {
3331 /* fixup_entry type */
3333 switch (ft
->fixups
[i
]->type
) {
3334 case enum_fixup_label
:
3335 case enum_fixup_sub
:
3336 size
+= PF_size_cstring(ft
->fixups
[i
]->name
);
3337 size
++; /* offset */
3339 case enum_fixup_none
:
3342 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
3343 "Unknown fixup type\n");
3353 =item C<static opcode_t * fixup_pack(PARROT_INTERP, PackFile_Segment *self,
3356 Packs the fixup table for a given packfile.
3362 PARROT_WARN_UNUSED_RESULT
3363 PARROT_CANNOT_RETURN_NULL
3365 fixup_pack(PARROT_INTERP
, ARGIN(PackFile_Segment
*self
), ARGOUT(opcode_t
*cursor
))
3367 ASSERT_ARGS(fixup_pack
)
3368 PackFile_FixupTable
* const ft
= (PackFile_FixupTable
*)self
;
3371 *cursor
++ = ft
->fixup_count
;
3373 for (i
= 0; i
< ft
->fixup_count
; i
++) {
3374 *cursor
++ = (opcode_t
) ft
->fixups
[i
]->type
;
3375 switch (ft
->fixups
[i
]->type
) {
3376 case enum_fixup_label
:
3377 case enum_fixup_sub
:
3378 cursor
= PF_store_cstring(cursor
, ft
->fixups
[i
]->name
);
3379 *cursor
++ = ft
->fixups
[i
]->offset
;
3381 case enum_fixup_none
:
3384 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
3385 "Unknown fixup type\n");
3395 =item C<static PackFile_Segment * fixup_new(PARROT_INTERP, PackFile *pf, STRING
3398 Returns a new C<PackFile_FixupTable> segment.
3404 PARROT_WARN_UNUSED_RESULT
3405 PARROT_CANNOT_RETURN_NULL
3406 static PackFile_Segment
*
3407 fixup_new(SHIM_INTERP
, SHIM(PackFile
*pf
), SHIM(STRING
*name
), SHIM(int add
))
3409 ASSERT_ARGS(fixup_new
)
3410 PackFile_FixupTable
* const fixup
= mem_allocate_zeroed_typed(PackFile_FixupTable
);
3412 return (PackFile_Segment
*) fixup
;
3418 =item C<static const opcode_t * fixup_unpack(PARROT_INTERP, PackFile_Segment
3419 *seg, const opcode_t *cursor)>
3421 Unpacks a PackFile FixupTable from a block of memory, given a cursor.
3423 Returns one (1) if everything is okay, else zero (0).
3429 PARROT_WARN_UNUSED_RESULT
3430 PARROT_CAN_RETURN_NULL
3431 static const opcode_t
*
3432 fixup_unpack(PARROT_INTERP
, ARGIN(PackFile_Segment
*seg
), ARGIN(const opcode_t
*cursor
))
3434 ASSERT_ARGS(fixup_unpack
)
3435 PackFile_FixupTable
* const self
= (PackFile_FixupTable
*)seg
;
3440 Parrot_io_eprintf(interp
,
3441 "PackFile_FixupTable_unpack: self == NULL!\n");
3445 PackFile_FixupTable_clear(interp
, self
);
3448 self
->fixup_count
= PF_fetch_opcode(pf
, &cursor
);
3450 TRACE_PRINTF(("PackFile_FixupTable_unpack(): %ld entries\n",
3451 self
->fixup_count
));
3453 if (self
->fixup_count
) {
3454 self
->fixups
= (PackFile_FixupEntry
**)mem_sys_allocate_zeroed(
3455 self
->fixup_count
* sizeof (PackFile_FixupEntry
*));
3457 if (!self
->fixups
) {
3458 Parrot_io_eprintf(interp
,
3459 "PackFile_FixupTable_unpack: Could not allocate "
3460 "memory for array!\n");
3461 self
->fixup_count
= 0;
3466 for (i
= 0; i
< self
->fixup_count
; i
++) {
3467 PackFile_FixupEntry
* const entry
=
3469 mem_allocate_typed(PackFile_FixupEntry
);
3471 entry
->type
= PF_fetch_opcode(pf
, &cursor
);
3473 switch (entry
->type
) {
3474 case enum_fixup_label
:
3475 case enum_fixup_sub
:
3476 entry
->name
= PF_fetch_cstring(pf
, &cursor
);
3477 entry
->offset
= PF_fetch_opcode(pf
, &cursor
);
3478 TRACE_PRINTF_VAL(("PackFile_FixupTable_unpack(): type %d, "
3479 "name %s, offset %ld\n",
3480 entry
->type
, entry
->name
, entry
->offset
));
3482 case enum_fixup_none
:
3485 Parrot_io_eprintf(interp
,
3486 "PackFile_FixupTable_unpack: Unknown fixup type %d!\n",
3498 =item C<void PackFile_FixupTable_new_entry(PARROT_INTERP, const char *label,
3499 INTVAL type, opcode_t offs)>
3501 Adds a new fix-up entry with label and type. Creates a new PackFile FixupTable
3510 PackFile_FixupTable_new_entry(PARROT_INTERP
,
3511 ARGIN(const char *label
), INTVAL type
, opcode_t offs
)
3513 ASSERT_ARGS(PackFile_FixupTable_new_entry
)
3514 PackFile_FixupTable
*self
= interp
->code
->fixups
;
3518 self
= (PackFile_FixupTable
*) PackFile_Segment_new_seg(
3519 interp
, interp
->code
->base
.dir
, PF_FIXUP_SEG
,
3520 FIXUP_TABLE_SEGMENT_NAME
, 1);
3522 interp
->code
->fixups
= self
;
3523 self
->code
= interp
->code
;
3526 i
= self
->fixup_count
++;
3527 mem_realloc_n_typed(self
->fixups
, self
->fixup_count
, PackFile_FixupEntry
*);
3529 self
->fixups
[i
] = mem_allocate_typed(PackFile_FixupEntry
);
3530 self
->fixups
[i
]->type
= type
;
3531 self
->fixups
[i
]->name
= mem_sys_strdup(label
);
3532 self
->fixups
[i
]->offset
= offs
;
3538 =item C<static PackFile_FixupEntry * find_fixup(PackFile_FixupTable *ft, INTVAL
3539 type, const char *name)>
3541 Finds the fix-up entry in a given FixupTable C<ft> for C<type> and C<name> and
3544 This ignores directories. For a recursive version see
3545 C<PackFile_find_fixup_entry()>.
3551 PARROT_WARN_UNUSED_RESULT
3552 PARROT_CAN_RETURN_NULL
3553 static PackFile_FixupEntry
*
3554 find_fixup(ARGMOD(PackFile_FixupTable
*ft
), INTVAL type
, ARGIN(const char *name
))
3556 ASSERT_ARGS(find_fixup
)
3558 for (i
= 0; i
< ft
->fixup_count
; i
++) {
3559 if ((INTVAL
)((enum_fixup_t
)ft
->fixups
[i
]->type
) == type
3560 && STREQ(ft
->fixups
[i
]->name
, name
)) {
3561 return ft
->fixups
[i
];
3571 =item C<static INTVAL find_fixup_iter(PARROT_INTERP, PackFile_Segment *seg, void
3574 Internal iterator for C<PackFile_find_fixup_entry>; recurses into directories.
3581 find_fixup_iter(PARROT_INTERP
, ARGIN(PackFile_Segment
*seg
), ARGIN(void *user_data
))
3583 ASSERT_ARGS(find_fixup_iter
)
3584 if (seg
->type
== PF_DIR_SEG
) {
3585 if (PackFile_map_segments(interp
, (PackFile_Directory
*)seg
,
3586 find_fixup_iter
, user_data
))
3589 else if (seg
->type
== PF_FIXUP_SEG
) {
3590 PackFile_FixupEntry
** const e
= (PackFile_FixupEntry
**)user_data
;
3591 PackFile_FixupEntry
* const fe
= (PackFile_FixupEntry
*)find_fixup(
3592 (PackFile_FixupTable
*) seg
, (*e
)->type
, (*e
)->name
);
3606 =item C<PackFile_FixupEntry * PackFile_find_fixup_entry(PARROT_INTERP, INTVAL
3609 Searches the whole PackFile recursively for a fix-up entry with the given
3610 C<type> and C<name>, and returns the found entry or NULL.
3612 This also recurses into directories, compared to the simplier C<find_fixup>
3613 which just searches one PackFile_FixupTable.
3620 PARROT_WARN_UNUSED_RESULT
3621 PARROT_CAN_RETURN_NULL
3622 PackFile_FixupEntry
*
3623 PackFile_find_fixup_entry(PARROT_INTERP
, INTVAL type
, ARGIN(char *name
))
3625 ASSERT_ARGS(PackFile_find_fixup_entry
)
3627 /* TODO make a hash of all fixups */
3628 PackFile_Directory
* const dir
= interp
->code
->base
.dir
;
3629 PackFile_FixupEntry
* const ep
= mem_allocate_typed(PackFile_FixupEntry
);
3634 if (PackFile_map_segments(interp
, dir
, find_fixup_iter
, (void *) ep
))
3645 =head2 PackFile ConstTable Structure Functions
3649 =item C<void PackFile_ConstTable_clear(PARROT_INTERP, PackFile_ConstTable
3652 Clear the C<PackFile_ConstTable> C<self>.
3660 PackFile_ConstTable_clear(PARROT_INTERP
, ARGMOD(PackFile_ConstTable
*self
))
3662 ASSERT_ARGS(PackFile_ConstTable_clear
)
3665 for (i
= 0; i
< self
->const_count
; i
++) {
3666 PackFile_Constant_destroy(interp
, self
->constants
[i
]);
3667 self
->constants
[i
] = NULL
;
3670 if (self
->constants
) {
3671 mem_sys_free(self
->constants
);
3672 self
->constants
= NULL
;
3675 self
->const_count
= 0;
3683 =item C<const opcode_t * PackFile_ConstTable_unpack(PARROT_INTERP,
3684 PackFile_Segment *seg, const opcode_t *cursor)>
3686 Unpacks a PackFile ConstTable from a block of memory. The format is:
3688 opcode_t const_count
3691 Returns cursor if everything is OK, else zero (0).
3698 PARROT_WARN_UNUSED_RESULT
3699 PARROT_CAN_RETURN_NULL
3701 PackFile_ConstTable_unpack(PARROT_INTERP
, ARGIN(PackFile_Segment
*seg
),
3702 ARGIN(const opcode_t
*cursor
))
3704 ASSERT_ARGS(PackFile_ConstTable_unpack
)
3705 PackFile_ConstTable
* const self
= (PackFile_ConstTable
*)seg
;
3706 PackFile
* const pf
= seg
->pf
;
3709 PackFile_ConstTable_clear(interp
, self
);
3711 self
->const_count
= PF_fetch_opcode(pf
, &cursor
);
3713 TRACE_PRINTF(("PackFile_ConstTable_unpack: Unpacking %ld constants\n",
3714 self
->const_count
));
3716 if (self
->const_count
== 0)
3719 self
->constants
= mem_allocate_n_zeroed_typed(self
->const_count
,
3720 PackFile_Constant
*);
3722 if (!self
->constants
) {
3723 Parrot_io_eprintf(interp
,
3724 "PackFile_ConstTable_unpack: Could not allocate memory for array!\n");
3725 self
->const_count
= 0;
3729 for (i
= 0; i
< self
->const_count
; i
++) {
3730 TRACE_PRINTF(("PackFile_ConstTable_unpack(): Unpacking constant %ld/%ld\n",
3731 i
, self
->const_count
));
3732 self
->constants
[i
] = PackFile_Constant_new(interp
);
3734 cursor
= PackFile_Constant_unpack(interp
, self
, self
->constants
[i
],
3744 =item C<static PackFile_Segment * const_new(PARROT_INTERP, PackFile *pf, STRING
3747 Returns a new C<PackFile_ConstTable> segment.
3754 PARROT_CANNOT_RETURN_NULL
3755 static PackFile_Segment
*
3756 const_new(SHIM_INTERP
, SHIM(PackFile
*pf
), SHIM(STRING
*name
), SHIM(int add
))
3758 ASSERT_ARGS(const_new
)
3759 PackFile_ConstTable
* const const_table
= mem_allocate_zeroed_typed(PackFile_ConstTable
);
3761 return (PackFile_Segment
*)const_table
;
3767 =item C<static void const_destroy(PARROT_INTERP, PackFile_Segment *self)>
3769 Destroys the C<PackFile_ConstTable> C<self>.
3776 const_destroy(PARROT_INTERP
, ARGMOD(PackFile_Segment
*self
))
3778 ASSERT_ARGS(const_destroy
)
3779 PackFile_ConstTable
* const ct
= (PackFile_ConstTable
*)self
;
3780 PackFile_ConstTable_clear(interp
, ct
);
3788 =head2 PackFile Constant Structure Functions
3792 =item C<PackFile_Constant * PackFile_Constant_new(PARROT_INTERP)>
3794 Allocates a new empty PackFile Constant.
3796 This is only here so we can make a new one and then do an unpack.
3804 PARROT_CANNOT_RETURN_NULL
3806 PackFile_Constant_new(SHIM_INTERP
)
3808 ASSERT_ARGS(PackFile_Constant_new
)
3809 PackFile_Constant
* const self
= mem_allocate_zeroed_typed(PackFile_Constant
);
3811 self
->type
= PFC_NONE
;
3819 =item C<void PackFile_Constant_destroy(PARROT_INTERP, PackFile_Constant *self)>
3821 Deletes the C<PackFile_Constant> C<self>.
3823 Don't delete C<PMC>s or C<STRING>s. The GC will claim them.
3831 PackFile_Constant_destroy(SHIM_INTERP
, ARGMOD_NULLOK(PackFile_Constant
*self
))
3833 ASSERT_ARGS(PackFile_Constant_destroy
)
3840 =item C<size_t PackFile_Constant_pack_size(PARROT_INTERP, const
3841 PackFile_Constant *self)>
3843 Determines the size of the buffer needed in order to pack the PackFile Constant
3844 into a contiguous region of memory.
3851 PARROT_WARN_UNUSED_RESULT
3853 PackFile_Constant_pack_size(PARROT_INTERP
, ARGIN(const PackFile_Constant
*self
))
3855 ASSERT_ARGS(PackFile_Constant_pack_size
)
3860 switch (self
->type
) {
3862 packed_size
= PF_size_number();
3866 packed_size
= PF_size_string(self
->u
.string
);
3872 for (component
= self
->u
.key
; component
;){
3874 GETATTR_Key_next_key(interp
, component
, component
);
3879 component
= self
->u
.key
; /* the pmc (Sub, ...) */
3882 * TODO create either
3883 * a) a frozen_size freeze entry or
3884 * b) change packout.c so that component size isn't needed
3886 image
= Parrot_freeze(interp
, component
);
3887 packed_size
= PF_size_string(image
);
3891 Parrot_io_eprintf(NULL
,
3892 "Constant_packed_size: Unrecognized type '%c'!\n",
3897 /* Tack on space for the initial type field */
3898 return packed_size
+ 1;
3904 =item C<const opcode_t * PackFile_Constant_unpack(PARROT_INTERP,
3905 PackFile_ConstTable *constt, PackFile_Constant *self, const opcode_t *cursor)>
3907 Unpacks a PackFile Constant from a block of memory. The format is:
3912 Returns cursor if everything is okay, else NULL.
3919 PARROT_WARN_UNUSED_RESULT
3920 PARROT_CAN_RETURN_NULL
3922 PackFile_Constant_unpack(PARROT_INTERP
, ARGIN(PackFile_ConstTable
*constt
),
3923 ARGOUT(PackFile_Constant
*self
), ARGIN(const opcode_t
*cursor
))
3925 ASSERT_ARGS(PackFile_Constant_unpack
)
3926 PackFile
* const pf
= constt
->base
.pf
;
3927 const opcode_t type
= PF_fetch_opcode(pf
, &cursor
);
3929 TRACE_PRINTF(("PackFile_Constant_unpack(): Type is %ld ('%c')...\n",
3934 self
->u
.number
= PF_fetch_number(pf
, &cursor
);
3935 self
->type
= PFC_NUMBER
;
3939 self
->u
.string
= PF_fetch_string(interp
, pf
, &cursor
);
3940 self
->type
= PFC_STRING
;
3944 cursor
= PackFile_Constant_unpack_key(interp
, constt
,
3949 cursor
= PackFile_Constant_unpack_pmc(interp
, constt
,
3953 Parrot_io_eprintf(NULL
,
3954 "Constant_unpack: Unrecognized type '%c' during unpack!\n",
3965 =item C<const opcode_t * PackFile_Constant_unpack_pmc(PARROT_INTERP,
3966 PackFile_ConstTable *constt, PackFile_Constant *self, const opcode_t *cursor)>
3968 Unpacks a constant PMC.
3975 PARROT_WARN_UNUSED_RESULT
3976 PARROT_CANNOT_RETURN_NULL
3978 PackFile_Constant_unpack_pmc(PARROT_INTERP
, ARGIN(PackFile_ConstTable
*constt
),
3979 ARGMOD(PackFile_Constant
*self
), ARGIN(const opcode_t
*cursor
))
3981 ASSERT_ARGS(PackFile_Constant_unpack_pmc
)
3982 PackFile
* const pf
= constt
->base
.pf
;
3983 STRING
*_sub
= CONST_STRING(interp
, "Sub");
3987 /* thawing the PMC needs the real packfile in place */
3988 PackFile_ByteCode
* const cs_save
= interp
->code
;
3989 interp
->code
= pf
->cur_cs
;
3990 image
= PF_fetch_string(interp
, pf
, &cursor
);
3993 * TODO use thaw_constants
3994 * current issue: a constant Sub with attached properties
3995 * doesn't GC mark the properties
3996 * for a constant PMC *all* contents have to be in the constant pools
3998 pmc
= Parrot_thaw(interp
, image
);
4000 /* place item in const_table */
4001 self
->type
= PFC_PMC
;
4004 /* finally place the sub into some namespace stash
4005 * XXX place this code in Sub.thaw ? */
4006 if (VTABLE_isa(interp
, pmc
, _sub
))
4007 Parrot_store_sub_in_namespace(interp
, pmc
);
4010 interp
->code
= cs_save
;
4018 =item C<const opcode_t * PackFile_Constant_unpack_key(PARROT_INTERP,
4019 PackFile_ConstTable *constt, PackFile_Constant *self, const opcode_t *cursor)>
4021 Unpacks a PackFile Constant from a block of memory. The format consists of a
4022 sequence of key atoms, each with the following format:
4027 Returns cursor if everything is OK, else NULL.
4034 PARROT_WARN_UNUSED_RESULT
4035 PARROT_CAN_RETURN_NULL
4037 PackFile_Constant_unpack_key(PARROT_INTERP
, ARGIN(PackFile_ConstTable
*constt
),
4038 ARGMOD(PackFile_Constant
*self
), ARGIN(const opcode_t
*cursor
))
4040 ASSERT_ARGS(PackFile_Constant_unpack_key
)
4041 PackFile
* const pf
= constt
->base
.pf
;
4044 INTVAL components
= (INTVAL
)PF_fetch_opcode(pf
, &cursor
);
4045 int pmc_enum
= enum_class_Key
;
4047 while (components
-- > 0) {
4048 opcode_t type
= PF_fetch_opcode(pf
, &cursor
);
4049 const opcode_t slice_bits
= type
& PF_VT_SLICE_BITS
;
4052 type
&= ~PF_VT_SLICE_BITS
;
4055 SETATTR_Key_next_key(interp
, tail
, constant_pmc_new(interp
, pmc_enum
));
4056 GETATTR_Key_next_key(interp
, tail
, tail
);
4059 head
= tail
= constant_pmc_new(interp
, pmc_enum
);
4061 op
= PF_fetch_opcode(pf
, &cursor
);
4065 key_set_integer(interp
, tail
, op
);
4068 key_set_number(interp
, tail
, constt
->constants
[op
]->u
.number
);
4071 key_set_string(interp
, tail
, constt
->constants
[op
]->u
.string
);
4074 key_set_register(interp
, tail
, op
, KEY_integer_FLAG
);
4077 key_set_register(interp
, tail
, op
, KEY_number_FLAG
);
4080 key_set_register(interp
, tail
, op
, KEY_string_FLAG
);
4083 key_set_register(interp
, tail
, op
, KEY_pmc_FLAG
);
4090 self
->type
= PFC_KEY
;
4099 =item C<PackFile_Segment * PackFile_Annotations_new(PARROT_INTERP, struct
4100 PackFile *pf, STRING *name, int add)>
4102 Creates a new annotations segment structure. Ignores the parameters C<name> and
4109 PARROT_CANNOT_RETURN_NULL
4111 PackFile_Annotations_new(SHIM_INTERP
, SHIM(struct PackFile
*pf
),
4112 SHIM(STRING
*name
), SHIM(int add
))
4114 ASSERT_ARGS(PackFile_Annotations_new
)
4116 /* Allocate annotations structure; create it all zeroed, and we will
4117 * allocate memory for each of the arrays on demand. */
4118 PackFile_Annotations
* const seg
= mem_allocate_zeroed_typed(PackFile_Annotations
);
4119 return (PackFile_Segment
*) seg
;
4125 =item C<void PackFile_Annotations_destroy(PARROT_INTERP, PackFile_Segment *seg)>
4127 Frees all memory associated with an annotations segment.
4134 PackFile_Annotations_destroy(SHIM_INTERP
, ARGMOD(PackFile_Segment
*seg
))
4136 ASSERT_ARGS(PackFile_Annotations_destroy
)
4137 PackFile_Annotations
*self
= (PackFile_Annotations
*)seg
;
4140 /* Free any keys. */
4142 for (i
= 0; i
< self
->num_keys
; i
++)
4143 mem_sys_free(self
->keys
[i
]);
4145 mem_sys_free(self
->keys
);
4148 /* Free any groups. */
4150 for (i
= 0; i
< self
->num_groups
; i
++)
4151 mem_sys_free(self
->groups
[i
]);
4152 mem_sys_free(self
->groups
);
4155 /* Free any entries. */
4156 if (self
->entries
) {
4157 for (i
= 0; i
< self
->num_entries
; i
++)
4158 mem_sys_free(self
->entries
[i
]);
4159 mem_sys_free(self
->entries
);
4166 =item C<size_t PackFile_Annotations_packed_size(PARROT_INTERP, PackFile_Segment
4169 Computes the number of opcode_ts needed to store the passed annotations
4176 PARROT_WARN_UNUSED_RESULT
4178 PackFile_Annotations_packed_size(SHIM_INTERP
, ARGIN(PackFile_Segment
*seg
))
4180 ASSERT_ARGS(PackFile_Annotations_packed_size
)
4181 const PackFile_Annotations
* const self
= (PackFile_Annotations
*)seg
;
4182 return 3 /* Counts. */
4183 + self
->num_keys
* 2 /* Keys. */
4184 + self
->num_groups
* 2 /* Groups. */
4185 + self
->num_entries
* 3; /* Entries. */
4191 =item C<opcode_t * PackFile_Annotations_pack(PARROT_INTERP, PackFile_Segment
4192 *seg, opcode_t *cursor)>
4194 Packs this segment into bytecode.
4200 PARROT_WARN_UNUSED_RESULT
4201 PARROT_CANNOT_RETURN_NULL
4203 PackFile_Annotations_pack(PARROT_INTERP
, ARGIN(PackFile_Segment
*seg
),
4204 ARGMOD(opcode_t
*cursor
))
4206 ASSERT_ARGS(PackFile_Annotations_pack
)
4207 const PackFile_Annotations
* const self
= (PackFile_Annotations
*)seg
;
4210 /* Write key count and any keys. */
4211 *cursor
++ = self
->num_keys
;
4213 for (i
= 0; i
< self
->num_keys
; i
++) {
4214 const PackFile_Annotations_Key
* const key
= self
->keys
[i
];
4215 *cursor
++ = key
->name
;
4216 *cursor
++ = key
->type
;
4219 /* Write group count and any groups. */
4220 *cursor
++ = self
->num_groups
;
4222 for (i
= 0; i
< self
->num_groups
; i
++) {
4223 const PackFile_Annotations_Group
* const group
= self
->groups
[i
];
4224 *cursor
++ = group
->bytecode_offset
;
4225 *cursor
++ = group
->entries_offset
;
4228 /* Write entry count and any entries. */
4229 *cursor
++ = self
->num_entries
;
4231 for (i
= 0; i
< self
->num_entries
; i
++) {
4232 const PackFile_Annotations_Entry
* const entry
= self
->entries
[i
];
4233 *cursor
++ = entry
->bytecode_offset
;
4234 *cursor
++ = entry
->key
;
4235 *cursor
++ = entry
->value
;
4244 =item C<const opcode_t * PackFile_Annotations_unpack(PARROT_INTERP,
4245 PackFile_Segment *seg, const opcode_t *cursor)>
4247 Unpacks this segment from the bytecode.
4253 PARROT_CANNOT_RETURN_NULL
4255 PackFile_Annotations_unpack(PARROT_INTERP
, ARGMOD(PackFile_Segment
*seg
),
4256 ARGIN(const opcode_t
*cursor
))
4258 ASSERT_ARGS(PackFile_Annotations_unpack
)
4259 PackFile_Annotations
*self
= (PackFile_Annotations
*)seg
;
4260 PackFile_ByteCode
*code
;
4263 PackFile
* const pf
= seg
->pf
;
4268 self
->num_keys
= PF_fetch_opcode(seg
->pf
, &cursor
);
4270 TRACE_PRINTF(("PackFile_Annotations_unpack: Unpacking %ld keys\n",
4273 self
->keys
= mem_allocate_n_typed(self
->num_keys
, PackFile_Annotations_Key
*);
4275 for (i
= 0; i
< self
->num_keys
; i
++) {
4276 PackFile_Annotations_Key
* const key
=
4277 self
->keys
[i
] = mem_allocate_typed(PackFile_Annotations_Key
);
4278 key
->name
= PF_fetch_opcode(seg
->pf
, &cursor
);
4279 key
->type
= PF_fetch_opcode(seg
->pf
, &cursor
);
4280 TRACE_PRINTF_VAL(("PackFile_Annotations_unpack: key[%d]/%d name=%s type=%d\n",
4281 i
, self
->num_keys
, key
->name
, key
->type
));
4284 /* Unpack groups. */
4285 self
->num_groups
= PF_fetch_opcode(seg
->pf
, &cursor
);
4286 self
->groups
= mem_allocate_n_typed(self
->num_groups
, PackFile_Annotations_Group
*);
4288 for (i
= 0; i
< self
->num_groups
; i
++) {
4289 PackFile_Annotations_Group
* const group
=
4290 self
->groups
[i
] = mem_allocate_typed(PackFile_Annotations_Group
);
4291 group
->bytecode_offset
= PF_fetch_opcode(seg
->pf
, &cursor
);
4292 group
->entries_offset
= PF_fetch_opcode(seg
->pf
, &cursor
);
4294 "PackFile_Annotations_unpack: group[%d]/%d bytecode_offset=%d entries_offset=%d\n",
4295 i
, self
->num_groups
, group
->bytecode_offset
,
4296 group
->entries_offset
));
4299 /* Unpack entries. */
4300 self
->num_entries
= PF_fetch_opcode(seg
->pf
, &cursor
);
4301 self
->entries
= mem_allocate_n_typed(self
->num_entries
, PackFile_Annotations_Entry
*);
4302 for (i
= 0; i
< self
->num_entries
; i
++) {
4303 PackFile_Annotations_Entry
* const entry
=
4304 self
->entries
[i
] = mem_allocate_typed(PackFile_Annotations_Entry
);
4305 entry
->bytecode_offset
= PF_fetch_opcode(seg
->pf
, &cursor
);
4306 entry
->key
= PF_fetch_opcode(seg
->pf
, &cursor
);
4307 entry
->value
= PF_fetch_opcode(seg
->pf
, &cursor
);
4310 /* Need to associate this segment with the applicable code segment. */
4311 str_len
= Parrot_str_length(interp
, self
->base
.name
);
4312 code_name
= Parrot_str_substr(interp
, self
->base
.name
, 0, str_len
- 4, NULL
, 1);
4313 code
= (PackFile_ByteCode
*)PackFile_find_segment(interp
,
4314 self
->base
.dir
, code_name
, 0);
4316 if (!code
|| code
->base
.type
!= PF_BYTEC_SEG
) {
4317 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
4318 "Code '%s' not found for annotations segment '%s'\n",
4319 code_name
, self
->base
.name
);
4323 code
->annotations
= self
;
4331 =item C<void PackFile_Annotations_dump(PARROT_INTERP, const PackFile_Segment
4334 Produces a dump of the annotations segment.
4341 PackFile_Annotations_dump(PARROT_INTERP
, ARGIN(const PackFile_Segment
*seg
))
4343 ASSERT_ARGS(PackFile_Annotations_dump
)
4344 const PackFile_Annotations
*self
= (const PackFile_Annotations
*)seg
;
4347 default_dump_header(interp
, (const PackFile_Segment
*)self
);
4350 Parrot_io_printf(interp
, "\n keys => [\n");
4351 for (i
= 0; i
< self
->num_keys
; i
++) {
4352 const PackFile_Annotations_Key
* const key
= self
->keys
[i
];
4353 Parrot_io_printf(interp
, " #%d\n [\n", i
);
4354 Parrot_io_printf(interp
, " NAME => %Ss\n",
4355 PF_CONST(self
->code
, key
->name
)->u
.string
);
4356 Parrot_io_printf(interp
, " TYPE => %s\n",
4357 key
->type
== PF_ANNOTATION_KEY_TYPE_INT
? "integer" :
4358 key
->type
== PF_ANNOTATION_KEY_TYPE_STR
? "string" :
4359 key
->type
== PF_ANNOTATION_KEY_TYPE_NUM
? "number" :
4361 Parrot_io_printf(interp
, " ],\n");
4364 Parrot_io_printf(interp
, " ],\n");
4367 Parrot_io_printf(interp
, "\n groups => [\n");
4368 for (i
= 0; i
< self
->num_groups
; i
++) {
4369 const PackFile_Annotations_Group
* const group
= self
->groups
[i
];
4370 Parrot_io_printf(interp
, " #%d\n [\n", i
);
4371 Parrot_io_printf(interp
, " BYTECODE_OFFSET => %d\n",
4372 group
->bytecode_offset
);
4373 Parrot_io_printf(interp
, " ENTRIES_OFFSET => %d\n",
4374 group
->entries_offset
);
4375 Parrot_io_printf(interp
, " ],\n");
4378 Parrot_io_printf(interp
, " ],\n");
4381 Parrot_io_printf(interp
, "\n entries => [\n");
4383 for (i
= 0; i
< self
->num_entries
; i
++) {
4384 const PackFile_Annotations_Entry
* const entry
= self
->entries
[i
];
4385 Parrot_io_printf(interp
, " #%d\n [\n", i
);
4386 Parrot_io_printf(interp
, " BYTECODE_OFFSET => %d\n",
4387 entry
->bytecode_offset
);
4388 Parrot_io_printf(interp
, " KEY => %d\n",
4390 Parrot_io_printf(interp
, " VALUE => %d\n",
4392 Parrot_io_printf(interp
, " ],\n");
4395 Parrot_io_printf(interp
, " ],\n");
4396 Parrot_io_printf(interp
, "],\n");
4402 =item C<void PackFile_Annotations_add_group(PARROT_INTERP, PackFile_Annotations
4403 *self, opcode_t offset)>
4405 Starts a new bytecode annotation group. Takes the offset in the bytecode where
4406 the new annotations group starts.
4413 PackFile_Annotations_add_group(SHIM_INTERP
, ARGMOD(PackFile_Annotations
*self
),
4416 ASSERT_ARGS(PackFile_Annotations_add_group
)
4418 /* Allocate extra space for the group in the groups array. */
4421 (PackFile_Annotations_Group
**)mem_sys_realloc(self
->groups
,
4422 (1 + self
->num_groups
) *
4423 sizeof (PackFile_Annotations_Group
*));
4425 self
->groups
= mem_allocate_n_typed(self
->num_groups
+ 1, PackFile_Annotations_Group
*);
4427 /* Store details. */
4428 self
->groups
[self
->num_groups
] =
4429 mem_allocate_typed(PackFile_Annotations_Group
);
4430 self
->groups
[self
->num_groups
]->bytecode_offset
= offset
;
4431 self
->groups
[self
->num_groups
]->entries_offset
= self
->num_entries
;
4433 /* Increment group count. */
4440 =item C<void PackFile_Annotations_add_entry(PARROT_INTERP, PackFile_Annotations
4441 *self, opcode_t offset, opcode_t key, opcode_t type, opcode_t value)>
4443 Adds a new bytecode annotation entry. Takes the annotations segment to add the
4444 entry to, the current bytecode offset (assumed to be the greatest one so far in
4445 the currently active group), the annotation key (as an index into the constats
4446 table), the annotation value type (one of PF_ANNOTATION_KEY_TYPE_INT,
4447 PF_ANNOTATION_KEY_TYPE_STR or PF_ANNOTATION_KEY_TYPE_NUM) and the value. The
4448 value will be an integer literal in the case of type being
4449 PF_ANNOTATION_KEY_TYPE_INT, or an index into the constants table otherwise.
4456 PackFile_Annotations_add_entry(PARROT_INTERP
, ARGMOD(PackFile_Annotations
*self
),
4457 opcode_t offset
, opcode_t key
, opcode_t type
, opcode_t value
)
4459 ASSERT_ARGS(PackFile_Annotations_add_entry
)
4460 /* See if we already have this key. */
4461 STRING
*key_name
= PF_CONST(self
->code
, key
)->u
.string
;
4462 opcode_t key_id
= -1;
4465 for (i
= 0; i
< self
->num_keys
; i
++) {
4466 STRING
*test_key
= PF_CONST(self
->code
, self
->keys
[i
]->name
)->u
.string
;
4467 if (Parrot_str_equal(interp
, test_key
, key_name
)) {
4474 /* We do have it. Add key entry. */
4477 (PackFile_Annotations_Key
**)mem_sys_realloc(self
->keys
,
4478 (1 + self
->num_keys
) *
4479 sizeof (PackFile_Annotations_Key
*));
4481 self
->keys
= mem_allocate_n_typed(self
->num_keys
+ 1, PackFile_Annotations_Key
*);
4483 key_id
= self
->num_keys
;
4484 self
->keys
[key_id
] = mem_allocate_typed(PackFile_Annotations_Key
);
4488 self
->keys
[key_id
]->name
= key
;
4489 self
->keys
[key_id
]->type
= type
;
4492 /* Ensure key types are compatible. */
4493 if (self
->keys
[key_id
]->type
!= type
)
4494 Parrot_ex_throw_from_c_args(interp
, NULL
,
4495 EXCEPTION_INVALID_OPERATION
,
4496 "Annotations with different types of value used for key '%S'\n",
4500 /* Add annotations entry. */
4503 (PackFile_Annotations_Entry
**)mem_sys_realloc(self
->entries
,
4504 (1 + self
->num_entries
) *
4505 sizeof (PackFile_Annotations_Entry
*));
4508 mem_allocate_n_typed(self
->num_entries
+ 1,
4509 PackFile_Annotations_Entry
*);
4511 self
->entries
[self
->num_entries
] =
4512 mem_allocate_typed(PackFile_Annotations_Entry
);
4513 self
->entries
[self
->num_entries
]->bytecode_offset
= offset
;
4514 self
->entries
[self
->num_entries
]->key
= key_id
;
4515 self
->entries
[self
->num_entries
]->value
= value
;
4517 self
->num_entries
++;
4523 =item C<static PMC * make_annotation_value_pmc(PARROT_INTERP,
4524 PackFile_Annotations *self, INTVAL type, opcode_t value)>
4526 Makes a PMC of the right type holding the value. Helper for
4527 C<PackFile_Annotations_lookup()>.
4533 PARROT_CANNOT_RETURN_NULL
4535 make_annotation_value_pmc(PARROT_INTERP
, ARGIN(PackFile_Annotations
*self
),
4536 INTVAL type
, opcode_t value
)
4538 ASSERT_ARGS(make_annotation_value_pmc
)
4542 case PF_ANNOTATION_KEY_TYPE_INT
:
4543 result
= pmc_new(interp
, enum_class_Integer
);
4544 VTABLE_set_integer_native(interp
, result
, value
);
4546 case PF_ANNOTATION_KEY_TYPE_NUM
:
4547 result
= pmc_new(interp
, enum_class_Float
);
4548 VTABLE_set_number_native(interp
, result
,
4549 PF_CONST(self
->code
, value
)->u
.number
);
4552 result
= pmc_new(interp
, enum_class_String
);
4553 VTABLE_set_string_native(interp
, result
,
4554 PF_CONST(self
->code
, value
)->u
.string
);
4563 =item C<PMC * PackFile_Annotations_lookup(PARROT_INTERP, PackFile_Annotations
4564 *self, opcode_t offset, STRING *key)>
4566 Looks up the annotation(s) in force at the given bytecode offset. If just one
4567 particular annotation is required, it can be passed as key, and the value will
4568 be returned (or a NULL PMC if no annotation of that name is in force).
4569 Otherwise, a Hash will be returned of the all annotations. If there are none in
4570 force, an empty hash will be returned.
4576 PARROT_CANNOT_RETURN_NULL
4578 PackFile_Annotations_lookup(PARROT_INTERP
, ARGIN(PackFile_Annotations
*self
),
4579 opcode_t offset
, ARGIN_NULLOK(STRING
*key
))
4581 ASSERT_ARGS(PackFile_Annotations_lookup
)
4583 INTVAL start_entry
= 0;
4586 /* If we have a key, look up its ID; if we don't find one. */
4587 opcode_t key_id
= -1;
4590 for (i
= 0; i
< self
->num_keys
; i
++) {
4591 STRING
* const test_key
= PF_CONST(self
->code
, self
->keys
[i
]->name
)->u
.string
;
4592 if (Parrot_str_equal(interp
, test_key
, key
)) {
4602 /* Use groups to find search start point. */
4603 for (i
= 0; i
< self
->num_groups
; i
++)
4604 if (offset
< self
->groups
[i
]->bytecode_offset
)
4608 /* Check if the found file was actually bytecode (.pbc extension), or a
4609 * source file (.pir or .pasm extension). */
4611 start_entry
= self
->groups
[i
]->entries_offset
;
4614 /* Look through entries, storing what we find by key and tracking those
4615 * that we have values for. */
4616 opcode_t
*latest_values
= mem_allocate_n_zeroed_typed(self
->num_keys
, opcode_t
);
4617 opcode_t
*have_values
= mem_allocate_n_zeroed_typed(self
->num_keys
, opcode_t
);
4619 for (i
= start_entry
; i
< self
->num_entries
; i
++) {
4620 if (self
->entries
[i
]->bytecode_offset
>= offset
)
4623 latest_values
[self
->entries
[i
]->key
] = self
->entries
[i
]->value
;
4624 have_values
[self
->entries
[i
]->key
] = 1;
4627 /* Create hash of values we have. */
4628 result
= pmc_new(interp
, enum_class_Hash
);
4630 for (i
= 0; i
< self
->num_keys
; i
++) {
4631 if (have_values
[i
]) {
4632 STRING
* const key_name
= PF_CONST(self
->code
, self
->keys
[i
]->name
)->u
.string
;
4633 VTABLE_set_pmc_keyed_str(interp
, result
, key_name
,
4634 make_annotation_value_pmc(interp
, self
, self
->keys
[i
]->type
,
4639 mem_sys_free(latest_values
);
4640 mem_sys_free(have_values
);
4643 /* Look for latest applicable value of the key. */
4644 opcode_t latest_value
= 0;
4645 opcode_t found_value
= 0;
4647 for (i
= start_entry
; i
< self
->num_entries
; i
++) {
4648 if (self
->entries
[i
]->bytecode_offset
>= offset
)
4651 if (self
->entries
[i
]->key
== key_id
) {
4652 latest_value
= self
->entries
[i
]->value
;
4657 /* Did we find anything? */
4661 result
= make_annotation_value_pmc(interp
, self
,
4662 self
->keys
[key_id
]->type
, latest_value
);
4670 =item C<static void compile_or_load_file(PARROT_INTERP, STRING *path,
4671 enum_runtime_ft file_type)>
4673 Either load a bytecode file and append it to the current packfile directory, or
4674 compile a PIR or PASM file from source.
4681 compile_or_load_file(PARROT_INTERP
, ARGIN(STRING
*path
),
4682 enum_runtime_ft file_type
)
4684 ASSERT_ARGS(compile_or_load_file
)
4685 char * const filename
= Parrot_str_to_cstring(interp
, path
);
4687 INTVAL regs_used
[] = { 2, 2, 2, 2 }; /* Arbitrary values */
4688 const int parrot_hll_id
= 0;
4689 PMC
* context
= Parrot_push_context(interp
, regs_used
);
4690 Parrot_pcc_set_HLL(interp
, context
, parrot_hll_id
);
4691 Parrot_pcc_set_namespace(interp
, context
,
4692 Parrot_get_HLL_namespace(interp
, parrot_hll_id
));
4694 if (file_type
== PARROT_RUNTIME_FT_PBC
) {
4695 PackFile
* const pf
= PackFile_append_pbc(interp
, filename
);
4696 Parrot_str_free_cstring(filename
);
4699 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
4700 "Unable to append PBC to the current directory");
4702 mem_sys_free(pf
->header
);
4704 mem_sys_free(pf
->dirp
);
4710 PackFile_ByteCode
* const cs
=
4711 (PackFile_ByteCode
*)IMCC_compile_file_s(interp
,
4713 Parrot_str_free_cstring(filename
);
4716 do_sub_pragmas(interp
, cs
, PBC_LOADED
, NULL
);
4718 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_LIBRARY_ERROR
,
4719 "compiler returned NULL ByteCode '%Ss' - %Ss", path
, err
);
4722 Parrot_pop_context(interp
);
4727 =item C<void Parrot_load_language(PARROT_INTERP, STRING *lang_name)>
4729 Load the compiler libraries for a given high-level language into the
4738 Parrot_load_language(PARROT_INTERP
, ARGIN_NULLOK(STRING
*lang_name
))
4740 ASSERT_ARGS(Parrot_load_language
)
4741 STRING
*wo_ext
, *file_str
, *path
, *pbc
;
4742 STRING
*found_path
, *found_ext
;
4744 enum_runtime_ft file_type
;
4745 PMC
*is_loaded_hash
;
4747 if (STRING_IS_NULL(lang_name
))
4748 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_LIBRARY_ERROR
,
4749 "\"load_language\" no language name");
4751 /* Full path to language library is "abc/abc.pbc". */
4752 pbc
= CONST_STRING(interp
, "pbc");
4753 wo_ext
= Parrot_str_concat(interp
, lang_name
, CONST_STRING(interp
, "/"), 0);
4754 wo_ext
= Parrot_str_append(interp
, wo_ext
, lang_name
);
4755 file_str
= Parrot_str_concat(interp
, wo_ext
, CONST_STRING(interp
, "."), 0);
4756 file_str
= Parrot_str_append(interp
, file_str
, pbc
);
4758 /* Check if the language is already loaded */
4759 is_loaded_hash
= VTABLE_get_pmc_keyed_int(interp
,
4760 interp
->iglobals
, IGLOBALS_PBC_LIBS
);
4761 if (VTABLE_exists_keyed_str(interp
, is_loaded_hash
, wo_ext
))
4764 file_type
= PARROT_RUNTIME_FT_LANG
;
4766 path
= Parrot_locate_runtime_file_str(interp
, file_str
, file_type
);
4768 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_LIBRARY_ERROR
,
4769 "\"load_language\" couldn't find a compiler module for the language '%Ss'", lang_name
);
4771 /* remember wo_ext => full_path mapping */
4772 VTABLE_set_string_keyed_str(interp
, is_loaded_hash
,
4775 /* Add the include and dynext paths to the global search */
4777 /* Get the base path of the located module */
4778 parrot_split_path_ext(interp
, path
, &found_path
, &found_ext
);
4779 name_length
= Parrot_str_length(interp
, lang_name
);
4780 found_path
= Parrot_str_substr(interp
, found_path
, 0,
4781 Parrot_str_length(interp
, found_path
)-name_length
, NULL
, 0);
4783 Parrot_lib_add_path(interp
, Parrot_str_append(interp
, found_path
, CONST_STRING(interp
, "include/")),
4784 PARROT_LIB_PATH_INCLUDE
);
4785 Parrot_lib_add_path(interp
, Parrot_str_append(interp
, found_path
, CONST_STRING(interp
, "dynext/")),
4786 PARROT_LIB_PATH_DYNEXT
);
4787 Parrot_lib_add_path(interp
, Parrot_str_append(interp
, found_path
, CONST_STRING(interp
, "library/")),
4788 PARROT_LIB_PATH_LIBRARY
);
4791 /* Check if the file found was actually a bytecode file (.pbc extension) or
4792 * a source file (.pir or .pasm extension. */
4794 if (Parrot_str_equal(interp
, found_ext
, pbc
))
4795 file_type
= PARROT_RUNTIME_FT_PBC
;
4797 file_type
= PARROT_RUNTIME_FT_SOURCE
;
4799 compile_or_load_file(interp
, path
, file_type
);
4804 =item C<static PackFile * PackFile_append_pbc(PARROT_INTERP, const char
4807 Reads and appends a PBC it to the current directory. Fixes up sub addresses in
4808 newly loaded bytecode and runs C<:load> subs.
4814 PARROT_WARN_UNUSED_RESULT
4815 PARROT_CAN_RETURN_NULL
4817 PackFile_append_pbc(PARROT_INTERP
, ARGIN_NULLOK(const char *filename
))
4819 ASSERT_ARGS(PackFile_append_pbc
)
4820 PackFile
* const pf
= Parrot_pbc_read(interp
, filename
, 0);
4823 PackFile_add_segment(interp
, &interp
->initial_pf
->directory
,
4824 &pf
->directory
.base
);
4826 do_sub_pragmas(interp
, pf
->cur_cs
, PBC_LOADED
, NULL
);
4835 =item C<void Parrot_load_bytecode(PARROT_INTERP, STRING *file_str)>
4837 Load a bytecode, PIR, or PASM file into the interpreter.
4843 /* intermediate hook during changes */
4846 Parrot_load_bytecode(PARROT_INTERP
, ARGIN_NULLOK(STRING
*file_str
))
4848 ASSERT_ARGS(Parrot_load_bytecode
)
4849 STRING
*wo_ext
, *ext
, *pbc
, *path
;
4850 STRING
*found_path
, *found_ext
;
4851 PMC
*is_loaded_hash
;
4852 enum_runtime_ft file_type
;
4854 if (STRING_IS_NULL(file_str
))
4855 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_LIBRARY_ERROR
,
4856 "\"load_bytecode\" no file name");
4858 parrot_split_path_ext(interp
, file_str
, &wo_ext
, &ext
);
4860 /* check if wo_ext is loaded */
4861 is_loaded_hash
= VTABLE_get_pmc_keyed_int(interp
,
4862 interp
->iglobals
, IGLOBALS_PBC_LIBS
);
4864 if (VTABLE_exists_keyed_str(interp
, is_loaded_hash
, wo_ext
))
4867 pbc
= CONST_STRING(interp
, "pbc");
4869 if (Parrot_str_equal(interp
, ext
, pbc
))
4870 file_type
= PARROT_RUNTIME_FT_PBC
;
4872 file_type
= PARROT_RUNTIME_FT_SOURCE
;
4874 path
= Parrot_locate_runtime_file_str(interp
, file_str
, file_type
);
4876 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_LIBRARY_ERROR
,
4877 "\"load_bytecode\" couldn't find file '%Ss'", file_str
);
4879 /* remember wo_ext => full_path mapping */
4880 VTABLE_set_string_keyed_str(interp
, is_loaded_hash
, wo_ext
, path
);
4882 parrot_split_path_ext(interp
, path
, &found_path
, &found_ext
);
4884 /* Check if the file found was actually a bytecode file (.pbc
4885 * extension) or a source file (.pir or .pasm extension). */
4887 if (Parrot_str_equal(interp
, found_ext
, pbc
))
4888 file_type
= PARROT_RUNTIME_FT_PBC
;
4890 file_type
= PARROT_RUNTIME_FT_SOURCE
;
4892 compile_or_load_file(interp
, path
, file_type
);
4898 =item C<void PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, PMC
4901 Calls C<:load>, C<:init>, C<:main>, C<:immediate> and/or C<:postcomp>
4902 subroutines in the current packfile, depending on the value of C<action>.
4903 See C<do_sub_pragmas> for more details.
4911 PackFile_fixup_subs(PARROT_INTERP
, pbc_action_enum_t what
, ARGIN_NULLOK(PMC
*eval
))
4913 ASSERT_ARGS(PackFile_fixup_subs
)
4914 PARROT_CALLIN_START(interp
);
4915 do_sub_pragmas(interp
, interp
->code
, what
, eval
);
4916 PARROT_CALLIN_END(interp
);
4926 Parrot_readbc and Parrot_loadbc renamed. Trace macros, long double and
4927 64-bit conversion work by Reini Urban 2009.
4929 Rework by Melvin; new bytecode format, make bytecode portable. (Do
4930 endian conversion and wordsize transforms on the fly.)
4932 leo applied and modified Juergen Boemmels packfile patch giving an
4933 extensible packfile format with directory reworked again, with common
4934 chunks (C<default_*>).
4936 2003.11.21 leo: moved low level item fetch routines to new
4946 * c-file-style: "parrot"
4948 * vim: expandtab shiftwidth=4: