?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
tagged release 0.7.1
[parrot.git] / src / packfile.c
blobe70f8987597da28212da3757b6e2cba264c3bafb
1 /*
2 Copyright (C) 2001-2008, The Perl Foundation.
3 This program is free software. It is subject to the same license as
4 Parrot itself.
5 $Id$
6
7 =head1 NAME
8
9 src/packfile.c - Parrot PackFile API
10
11 =head1 DESCRIPTION
12
13 =head2 PackFile Manipulation Functions
14
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/parrotbyte.pod> for information about the
19 structure of the frozen bytecode.
20
21 =over 4
22
23 =cut
24
25 */
26
27 #include "parrot/parrot.h"
28 #include "parrot/embed.h"
29 #include "parrot/packfile.h"
30 #include "jit.h"
31 #include "../compilers/imcc/imc.h"
32 #include "packfile.str"
33
34 /* HEADERIZER HFILE: include/parrot/packfile.h */
35
36 /* HEADERIZER BEGIN: static */
37 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
38
39 static void byte_code_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *self))
40 __attribute__nonnull__(2)
41 FUNC_MODIFIES(*self);
42
43 PARROT_WARN_UNUSED_RESULT
44 PARROT_CANNOT_RETURN_NULL
45 static PackFile_Segment * byte_code_new(SHIM_INTERP,
46 SHIM(PackFile *pf),
47 SHIM(const char *name),
48 SHIM(int add));
49
50 PARROT_WARN_UNUSED_RESULT
51 PARROT_CANNOT_RETURN_NULL
52 static PackFile_Constant * clone_constant(PARROT_INTERP,
53 ARGIN(PackFile_Constant *old_const))
54 __attribute__nonnull__(1)
55 __attribute__nonnull__(2);
56
57 static void const_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
58 __attribute__nonnull__(1)
59 __attribute__nonnull__(2)
60 FUNC_MODIFIES(*self);
61
62 PARROT_MALLOC
63 PARROT_CANNOT_RETURN_NULL
64 static PackFile_Segment * const_new(SHIM_INTERP,
65 SHIM(PackFile *pf),
66 SHIM(const char *name),
67 SHIM(int add));
68
69 PARROT_WARN_UNUSED_RESULT
70 PARROT_CANNOT_RETURN_NULL
71 static PackFile_Segment * create_seg(PARROT_INTERP,
72 ARGMOD(PackFile_Directory *dir),
73 pack_file_types t,
74 ARGIN(const char *name),
75 ARGIN(const char *file_name),
76 int add)
77 __attribute__nonnull__(1)
78 __attribute__nonnull__(2)
79 __attribute__nonnull__(4)
80 __attribute__nonnull__(5)
81 FUNC_MODIFIES(*dir);
82
83 static void default_destroy(ARGMOD(PackFile_Segment *self))
84 __attribute__nonnull__(1)
85 FUNC_MODIFIES(*self);
86
87 static void default_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
88 __attribute__nonnull__(1)
89 __attribute__nonnull__(2);
90
91 PARROT_WARN_UNUSED_RESULT
92 PARROT_CANNOT_RETURN_NULL
93 static opcode_t * default_pack(
94 ARGIN(const PackFile_Segment *self),
95 ARGOUT(opcode_t *dest))
96 __attribute__nonnull__(1)
97 __attribute__nonnull__(2)
98 FUNC_MODIFIES(*dest);
99
100 static size_t default_packed_size(ARGIN(const PackFile_Segment *self))
101 __attribute__nonnull__(1);
102
103 PARROT_WARN_UNUSED_RESULT
104 PARROT_CAN_RETURN_NULL
105 static const opcode_t * default_unpack(
106 ARGMOD(PackFile_Segment *self),
107 ARGIN(const opcode_t *cursor))
108 __attribute__nonnull__(1)
109 __attribute__nonnull__(2)
110 FUNC_MODIFIES(*self);
111
112 static void directory_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
113 __attribute__nonnull__(1)
114 __attribute__nonnull__(2)
115 FUNC_MODIFIES(*self);
116
117 static void directory_dump(PARROT_INTERP,
118 ARGIN(const PackFile_Segment *self))
119 __attribute__nonnull__(1)
120 __attribute__nonnull__(2);
121
122 PARROT_WARN_UNUSED_RESULT
123 PARROT_CANNOT_RETURN_NULL
124 static PackFile_Segment * directory_new(SHIM_INTERP,
125 SHIM(PackFile *pf),
126 SHIM(const char *name),
127 SHIM(int add));
128
129 PARROT_WARN_UNUSED_RESULT
130 PARROT_CANNOT_RETURN_NULL
131 static opcode_t * directory_pack(PARROT_INTERP,
132 ARGIN(PackFile_Segment *self),
133 ARGOUT(opcode_t *cursor))
134 __attribute__nonnull__(1)
135 __attribute__nonnull__(2)
136 __attribute__nonnull__(3)
137 FUNC_MODIFIES(*cursor);
138
139 static size_t directory_packed_size(PARROT_INTERP,
140 ARGMOD(PackFile_Segment *self))
141 __attribute__nonnull__(1)
142 __attribute__nonnull__(2)
143 FUNC_MODIFIES(*self);
144
145 PARROT_WARN_UNUSED_RESULT
146 PARROT_CANNOT_RETURN_NULL
147 static const opcode_t * directory_unpack(PARROT_INTERP,
148 ARGMOD(PackFile_Segment *segp),
149 ARGIN(const opcode_t *cursor))
150 __attribute__nonnull__(1)
151 __attribute__nonnull__(2)
152 __attribute__nonnull__(3)
153 FUNC_MODIFIES(*segp);
154
155 PARROT_WARN_UNUSED_RESULT
156 PARROT_CAN_RETURN_NULL
157 static PMC* do_1_sub_pragma(PARROT_INTERP,
158 ARGMOD(PMC *sub_pmc),
159 pbc_action_enum_t action)
160 __attribute__nonnull__(1)
161 __attribute__nonnull__(2)
162 FUNC_MODIFIES(*sub_pmc);
163
164 static INTVAL find_const_iter(PARROT_INTERP,
165 ARGIN(PackFile_Segment *seg),
166 ARGIN_NULLOK(void *user_data))
167 __attribute__nonnull__(1)
168 __attribute__nonnull__(2);
169
170 PARROT_WARN_UNUSED_RESULT
171 PARROT_CANNOT_RETURN_NULL
172 static PackFile_Constant ** find_constants(PARROT_INTERP,
173 ARGIN(PackFile_ConstTable *ct))
174 __attribute__nonnull__(1)
175 __attribute__nonnull__(2);
176
177 PARROT_WARN_UNUSED_RESULT
178 PARROT_CAN_RETURN_NULL
179 static PackFile_FixupEntry * find_fixup(
180 ARGMOD(PackFile_FixupTable *ft),
181 INTVAL type,
182 ARGIN(const char *name))
183 __attribute__nonnull__(1)
184 __attribute__nonnull__(3)
185 FUNC_MODIFIES(*ft);
186
187 static INTVAL find_fixup_iter(PARROT_INTERP,
188 ARGIN(PackFile_Segment *seg),
189 ARGIN(void *user_data))
190 __attribute__nonnull__(1)
191 __attribute__nonnull__(2)
192 __attribute__nonnull__(3);
193
194 static void fixup_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
195 __attribute__nonnull__(1)
196 __attribute__nonnull__(2)
197 FUNC_MODIFIES(*self);
198
199 PARROT_WARN_UNUSED_RESULT
200 PARROT_CANNOT_RETURN_NULL
201 static PackFile_Segment * fixup_new(SHIM_INTERP,
202 SHIM(PackFile *pf),
203 SHIM(const char *name),
204 SHIM(int add));
205
206 PARROT_WARN_UNUSED_RESULT
207 PARROT_CANNOT_RETURN_NULL
208 static opcode_t * fixup_pack(PARROT_INTERP,
209 ARGIN(PackFile_Segment *self),
210 ARGOUT(opcode_t *cursor))
211 __attribute__nonnull__(1)
212 __attribute__nonnull__(2)
213 __attribute__nonnull__(3)
214 FUNC_MODIFIES(*cursor);
215
216 static size_t fixup_packed_size(PARROT_INTERP,
217 ARGMOD(PackFile_Segment *self))
218 __attribute__nonnull__(1)
219 __attribute__nonnull__(2)
220 FUNC_MODIFIES(*self);
221
222 PARROT_WARN_UNUSED_RESULT
223 PARROT_CAN_RETURN_NULL
224 static const opcode_t * fixup_unpack(PARROT_INTERP,
225 ARGIN(PackFile_Segment *seg),
226 ARGIN(const opcode_t *cursor))
227 __attribute__nonnull__(1)
228 __attribute__nonnull__(2)
229 __attribute__nonnull__(3);
230
231 static void make_code_pointers(ARGMOD(PackFile_Segment *seg))
232 __attribute__nonnull__(1)
233 FUNC_MODIFIES(*seg);
234
235 static void mark_1_seg(PARROT_INTERP, ARGMOD(PackFile_ConstTable *ct))
236 __attribute__nonnull__(1)
237 __attribute__nonnull__(2)
238 FUNC_MODIFIES(*ct);
239
240 PARROT_WARN_UNUSED_RESULT
241 PARROT_CAN_RETURN_NULL
242 static PackFile * PackFile_append_pbc(PARROT_INTERP,
243 ARGIN_NULLOK(const char *filename))
244 __attribute__nonnull__(1);
245
246 static void PackFile_set_header(ARGOUT(PackFile_Header *header))
247 __attribute__nonnull__(1)
248 FUNC_MODIFIES(*header);
249
250 static void pf_debug_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *self))
251 __attribute__nonnull__(2)
252 FUNC_MODIFIES(*self);
253
254 static void pf_debug_dump(PARROT_INTERP,
255 ARGIN(const PackFile_Segment *self))
256 __attribute__nonnull__(1)
257 __attribute__nonnull__(2);
258
259 PARROT_WARN_UNUSED_RESULT
260 PARROT_CANNOT_RETURN_NULL
261 static PackFile_Segment * pf_debug_new(SHIM_INTERP,
262 SHIM(PackFile *pf),
263 SHIM(const char *name),
264 SHIM(int add));
265
266 PARROT_WARN_UNUSED_RESULT
267 PARROT_CANNOT_RETURN_NULL
268 static opcode_t * pf_debug_pack(SHIM_INTERP,
269 ARGMOD(PackFile_Segment *self),
270 ARGOUT(opcode_t *cursor))
271 __attribute__nonnull__(2)
272 __attribute__nonnull__(3)
273 FUNC_MODIFIES(*self)
274 FUNC_MODIFIES(*cursor);
275
276 static size_t pf_debug_packed_size(SHIM_INTERP,
277 ARGIN(PackFile_Segment *self))
278 __attribute__nonnull__(2);
279
280 PARROT_WARN_UNUSED_RESULT
281 PARROT_CANNOT_RETURN_NULL
282 static const opcode_t * pf_debug_unpack(PARROT_INTERP,
283 ARGOUT(PackFile_Segment *self),
284 ARGIN(const opcode_t *cursor))
285 __attribute__nonnull__(1)
286 __attribute__nonnull__(2)
287 __attribute__nonnull__(3)
288 FUNC_MODIFIES(*self);
289
290 static void pf_register_standard_funcs(PARROT_INTERP, ARGMOD(PackFile *pf))
291 __attribute__nonnull__(1)
292 __attribute__nonnull__(2)
293 FUNC_MODIFIES(*pf);
294
295 PARROT_IGNORABLE_RESULT
296 PARROT_CAN_RETURN_NULL
297 static PMC* run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
298 __attribute__nonnull__(1)
299 __attribute__nonnull__(2);
300
301 static void segment_init(
302 ARGOUT(PackFile_Segment *self),
303 ARGIN(PackFile *pf),
304 ARGIN(const char *name))
305 __attribute__nonnull__(1)
306 __attribute__nonnull__(2)
307 __attribute__nonnull__(3)
308 FUNC_MODIFIES(*self);
309
310 static void sort_segs(ARGMOD(PackFile_Directory *dir))
311 __attribute__nonnull__(1)
312 FUNC_MODIFIES(*dir);
313
314 static int sub_pragma(PARROT_INTERP,
315 pbc_action_enum_t action,
316 ARGIN(const PMC *sub_pmc))
317 __attribute__nonnull__(1)
318 __attribute__nonnull__(3);
319
320 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
321 /* HEADERIZER END: static */
322
323 #if EXEC_CAPABLE
324 extern int Parrot_exec_run;
325 #endif
326
327 #define TRACE_PACKFILE 0
328
329 #define ROUND_16(val) (((val) & 0xf) ? 16 - ((val) & 0xf) : 0)
330 #define ALIGN_16(st, cursor) \
331 (cursor) += ROUND_16((const char *)(cursor) - (const char *)(st))/sizeof (opcode_t)
332
333 /*
334
335 =item C<void PackFile_destroy>
336
337 Delete a C<PackFile>.
338
339 =cut
340
341 */
342
343 PARROT_API
344 void
345 PackFile_destroy(PARROT_INTERP, ARGMOD_NULLOK(PackFile *pf))
346 {
347 if (!pf) {
348 PIO_eprintf(NULL, "PackFile_destroy: pf == NULL!\n");
349 return;
350 }
351
352 #ifdef PARROT_HAS_HEADER_SYSMMAN
353 if (pf->is_mmap_ped) {
354 DECL_CONST_CAST;
355 /* Cast the result to void to avoid a warning with
356 * some not-so-standard mmap headers, see RT#56110
357 */
358 munmap((void *)PARROT_const_cast(opcode_t *, pf->src), pf->size);
359 }
360 #endif
361
362 mem_sys_free(pf->header);
363 pf->header = NULL;
364 mem_sys_free(pf->dirp);
365 pf->dirp = NULL;
366 PackFile_Segment_destroy(interp, &pf->directory.base);
367 return;
368 }
369
370
371 /*
372
373 =item C<static void make_code_pointers>
374
375 Make compat/shorthand pointers.
376
377 The first segments read are the default segments.
378
379 =cut
380
381 */
382
383 static void
384 make_code_pointers(ARGMOD(PackFile_Segment *seg))
385 {
386 PackFile * const pf = seg->pf;
387
388 switch (seg->type) {
389 case PF_BYTEC_SEG:
390 if (!pf->cur_cs)
391 pf->cur_cs = (PackFile_ByteCode *)seg;
392 break;
393 case PF_FIXUP_SEG:
394 if (!pf->cur_cs->fixups) {
395 pf->cur_cs->fixups = (PackFile_FixupTable *)seg;
396 pf->cur_cs->fixups->code = pf->cur_cs;
397 }
398 break;
399 case PF_CONST_SEG:
400 if (!pf->cur_cs->const_table) {
401 pf->cur_cs->const_table = (PackFile_ConstTable *)seg;
402 pf->cur_cs->const_table->code = pf->cur_cs;
403 }
404 break;
405 case PF_UNKNOWN_SEG:
406 if (memcmp(seg->name, "PIC_idx", 7) == 0)
407 pf->cur_cs->pic_index = seg;
408 break;
409 case PF_DEBUG_SEG:
410 pf->cur_cs->debugs = (PackFile_Debug *)seg;
411 pf->cur_cs->debugs->code = pf->cur_cs;
412 break;
413 default:
414 break;
415 }
416 }
417
418
419 /*
420
421 =item C<static int sub_pragma>
422
423 Check B<sub_pmc>'s pragmas (e.g. flags like C<:load>, C<:main>, etc.) returning
424 1 if the sub should be run for C<action>, a C<pbc_action_enum_t>.
425
426 =cut
427
428 */
429
430 static int
431 sub_pragma(PARROT_INTERP, pbc_action_enum_t action, ARGIN(const PMC *sub_pmc))
432 {
433 int todo = 0;
434 int pragmas = PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK
435 & ~SUB_FLAG_IS_OUTER;
436
437 if (!pragmas && !Sub_comp_INIT_TEST(sub_pmc))
438 return 0;
439
440 switch (action) {
441 case PBC_PBC:
442 case PBC_MAIN:
443 /* denote MAIN entry in first loaded PASM */
444 if (interp->resume_flag & RESUME_INITIAL)
445 todo = 1;
446
447 /* :init functions need to be called at MAIN time, so return 1 */
448 if (Sub_comp_INIT_TEST(sub_pmc)) /* symreg.h:P_INIT */
449 todo = 1;
450
451 break;
452 case PBC_LOADED:
453 if (pragmas & SUB_FLAG_PF_LOAD) /* symreg.h:P_LOAD */
454 todo = 1;
455 break;
456 default:
457 break;
458 }
459
460 if (pragmas & (SUB_FLAG_PF_IMMEDIATE | SUB_FLAG_PF_POSTCOMP))
461 todo = 1;
462
463 return todo;
464 }
465
466
467 /*
468
469 =item C<static PMC* run_sub>
470
471 Run the B<sub_pmc> due to its B<:load>, B<:immediate>, ... pragma
472
473 =cut
474
475 */
476
477 PARROT_IGNORABLE_RESULT
478 PARROT_CAN_RETURN_NULL
479 static PMC*
480 run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
481 {
482 const INTVAL old = interp->run_core;
483 PMC *retval;
484
485 /*
486 * turn off JIT and prederef - both would act on the whole
487 * PackFile which isn't worth the effort - probably
488 */
489 if (interp->run_core != PARROT_CGOTO_CORE
490 && interp->run_core != PARROT_SLOW_CORE
491 && interp->run_core != PARROT_FAST_CORE)
492 interp->run_core = PARROT_FAST_CORE;
493
494 CONTEXT(interp)->constants = interp->code->const_table->constants;
495
496 retval = (PMC *)Parrot_runops_fromc_args(interp, sub_pmc, "P");
497 interp->run_core = old;
498
499 return retval;
500 }
501
502
503 /*
504
505 =item C<static PMC* do_1_sub_pragma>
506
507 Run autoloaded or immediate bytecode, mark MAIN subroutine entry
508
509 =cut
510
511 */
512
513 PARROT_WARN_UNUSED_RESULT
514 PARROT_CAN_RETURN_NULL
515 static PMC*
516 do_1_sub_pragma(PARROT_INTERP, ARGMOD(PMC *sub_pmc), pbc_action_enum_t action)
517 {
518 Parrot_sub const *sub = PMC_sub(sub_pmc);
519
520 switch (action) {
521 case PBC_IMMEDIATE:
522 /* run IMMEDIATE sub */
523 if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_IMMEDIATE) {
524 void *lo_var_ptr = interp->lo_var_ptr;
525 PMC *result;
526
527 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_IMMEDIATE;
528 result = run_sub(interp, sub_pmc);
529
530 /*
531 * reset initial flag so MAIN detection works
532 * and reset lo_var_ptr to prev
533 */
534 interp->resume_flag = RESUME_INITIAL;
535 interp->lo_var_ptr = lo_var_ptr;
536 return result;
537 }
538 break;
539 case PBC_POSTCOMP:
540 /* run POSTCOMP sub */
541 if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_POSTCOMP) {
542 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_POSTCOMP;
543 run_sub(interp, sub_pmc);
544
545 /* reset initial flag so MAIN detection works */
546 interp->resume_flag = RESUME_INITIAL;
547 return NULL;
548 }
549 break;
550
551 case PBC_LOADED:
552 if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_LOAD) {
553 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
554
555 /* if loaded no need for init */
556 Sub_comp_INIT_CLEAR(sub_pmc);
557 run_sub(interp, sub_pmc);
558 }
559 break;
560 default:
561 if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MAIN) {
562 if ((interp->resume_flag & RESUME_INITIAL)
563 && interp->resume_offset == 0) {
564 const ptrdiff_t code = (ptrdiff_t) sub->seg->base.data;
565 void *ptr = VTABLE_get_pointer(interp, sub_pmc);
566
567 interp->resume_offset = ((ptrdiff_t)ptr - code)
568 / sizeof (opcode_t *);
569
570 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_MAIN;
571 CONTEXT(interp)->current_sub = sub_pmc;
572 }
573 else {
574 /* XXX which warn_class */
575 Parrot_warn(interp, PARROT_WARNINGS_ALL_FLAG,
576 ":main sub not allowed\n");
577 }
578 }
579
580 /* run :init tagged functions */
581 if (action == PBC_MAIN && Sub_comp_INIT_TEST(sub_pmc)) {
582 /* if loaded no need for init */
583 Sub_comp_INIT_CLEAR(sub_pmc);
584
585 /* if inited no need for load */
586 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
587
588 run_sub(interp, sub_pmc);
589 interp->resume_flag = RESUME_INITIAL;
590 }
591 break;
592 }
593 return NULL;
594 }
595
596
597 /*
598
599 =item C<static void mark_1_seg>
600
601 While the PMCs should be constant, their possible contents such as
602 properties aren't constructed const, so we have to mark them.
603
604 =cut
605
606 */
607
608 static void
609 mark_1_seg(PARROT_INTERP, ARGMOD(PackFile_ConstTable *ct))
610 {
611 opcode_t i;
612 PackFile_Constant ** const constants = find_constants(interp, ct);
613
614 for (i = 0; i < ct->const_count; i++) {
615 if (constants[i]->type == PFC_PMC) {
616 PMC * const pmc = constants[i]->u.key;
617 if (pmc)
618 pobject_lives(interp, (PObj *)pmc);
619 }
620 }
621 }
622
623
624 /*
625
626 =item C<static INTVAL find_const_iter>
627
628 RT#48260: Not yet documented!!!
629
630 =cut
631
632 */
633
634 static INTVAL
635 find_const_iter(PARROT_INTERP, ARGIN(PackFile_Segment *seg),
636 ARGIN_NULLOK(void *user_data))
637 {
638 if (seg->type == PF_DIR_SEG)
639 PackFile_map_segments(interp, (const PackFile_Directory *)seg,
640 find_const_iter, user_data);
641 else if (seg->type == PF_CONST_SEG)
642 mark_1_seg(interp, (PackFile_ConstTable *)seg);
643
644 return 0;
645 }
646
647
648 /*
649
650 =item C<void mark_const_subs>
651
652 RT#48260: Not yet documented!!!
653
654 =cut
655
656 */
657
658 void
659 mark_const_subs(PARROT_INTERP)
660 {
661 PackFile_Directory *dir;
662
663 PackFile * const self = interp->initial_pf;
664
665 if (!self)
666 return;
667
668 /* locate top level dir */
669 dir = &self->directory;
670
671 /* iterate over all dir/segs */
672 PackFile_map_segments(interp, dir, find_const_iter, NULL);
673 }
674
675
676 /*
677
678 =item C<void do_sub_pragmas>
679
680 C<action> is one of C<PBC_PBC>, C<PBC_LOADED>, C<PBC_INIT>, or C<PBC_MAIN>.
681 Also store the C<eval_pmc> in the sub structure, so that the eval PMC is kept
682 alive by living subs.
683
684 =cut
685
686 */
687
688 PARROT_API
689 void
690 do_sub_pragmas(PARROT_INTERP, ARGIN(PackFile_ByteCode *self),
691 pbc_action_enum_t action, ARGIN_NULLOK(PMC *eval_pmc))
692 {
693 opcode_t i;
694 PackFile_FixupTable * const ft = self->fixups;
695 PackFile_ConstTable * const ct = self->const_table;
696
697 #if TRACE_PACKFILE
698 PIO_eprintf(NULL, "PackFile: do_sub_pragmas (action=%d)\n", action);
699 #endif
700
701 for (i = 0; i < ft->fixup_count; i++) {
702 switch (ft->fixups[i]->type) {
703 case enum_fixup_sub:
704 {
705 /*
706 * offset is an index into the const_table holding the Sub PMC
707 */
708 const opcode_t ci = ft->fixups[i]->offset;
709 PMC *sub_pmc;
710
711 if (ci < 0 || ci >= ct->const_count)
712 Parrot_ex_throw_from_c_args(interp, NULL, 1,
713 "Illegal fixup offset (%d) in enum_fixup_sub");
714
715 sub_pmc = ct->constants[ci]->u.key;
716 PMC_sub(sub_pmc)->eval_pmc = eval_pmc;
717
718 if (((PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK)
719 || (Sub_comp_get_FLAGS(sub_pmc) & SUB_COMP_FLAG_MASK))
720 && sub_pragma(interp, action, sub_pmc)) {
721 PMC * const result = do_1_sub_pragma(interp,
722 sub_pmc, action);
723
724 /* replace Sub PMC with computation results */
725 if (action == PBC_IMMEDIATE && !PMC_IS_NULL(result)) {
726 ft->fixups[i]->type = enum_fixup_none;
727 ct->constants[ci]->u.key = result;
728 }
729 }
730 break;
731 }
732 case enum_fixup_label:
733 /* fill in current bytecode seg */
734 ft->fixups[i]->seg = self;
735 break;
736 default:
737 break;
738 }
739 }
740 }
741
742
743 /*
744
745 =item C<opcode_t PackFile_unpack>
746
747 Unpack a C<PackFile> from a block of memory, ensuring the the magic number is
748 valid, the bytecode version can be read by this Parrot and doing any endian
749 and word size transforms that are required.
750
751 Returns size of unpacked if everything is OK, else zero (0).
752
753 =cut
754
755 */
756
757 PARROT_API
758 PARROT_WARN_UNUSED_RESULT
759 opcode_t
760 PackFile_unpack(PARROT_INTERP, ARGMOD(PackFile *self),
761 ARGIN(const opcode_t *packed), size_t packed_size)
762 {
763 PackFile_Header * const header = self->header;
764 const opcode_t *cursor;
765 int header_read_length;
766 opcode_t padding;
767
768 self->src = packed;
769 self->size = packed_size;
770
771 /* Extract the header. */
772 memcpy(header, packed, PACKFILE_HEADER_BYTES);
773
774 /* Ensure the magic is correct. */
775 if (memcmp(header->magic, "\376PBC\r\n\032\n", 8) != 0) {
776 PIO_eprintf(NULL, "PackFile_unpack: "
777 "This is not a valid Parrot bytecode file\n");
778 return 0;
779 }
780
781 /* Ensure the bytecode version is one we can read. Currently, we only
782 * support bytecode versions matching the current one. */
783 if (header->bc_major != PARROT_PBC_MAJOR
784 && header->bc_minor != PARROT_PBC_MINOR) {
785 PIO_eprintf(NULL, "PackFile_unpack: This Parrot cannot read bytecode "
786 "files with version %d.%d.\n", header->bc_major, header->bc_minor);
787 return 0;
788 }
789
790 /* Check wordsize, byte order and floating point number type are valid. */
791 if (header->wordsize != 4 && header->wordsize != 8) {
792 PIO_eprintf(NULL, "PackFile_unpack: Invalid wordsize %d\n",
793 header->wordsize);
794 return 0;
795 }
796
797 if (header->byteorder != 0 && header->byteorder != 1) {
798 PIO_eprintf(NULL, "PackFile_unpack: Invalid byte ordering %d\n",
799 header->byteorder);
800 return 0;
801 }
802
803 if (header->floattype != 0 && header->floattype != 1) {
804 PIO_eprintf(NULL, "PackFile_unpack: Invalid floattype %d\n",
805 header->floattype);
806 return 0;
807 }
808
809 /* Describe what was read for debugging. */
810 #if TRACE_PACKFILE
811 PIO_eprintf(NULL, "PackFile_unpack: Wordsize %d.\n", header->wordsize);
812 PIO_eprintf(NULL, "PackFile_unpack: Floattype %d (%s).\n",
813 header->floattype,
814 header->floattype ?
815 "x86 little endian 12 byte long double" :
816 "IEEE-754 8 byte double");
817 PIO_eprintf(NULL, "PackFile_unpack: Byteorder %d (%sendian).\n",
818 header->byteorder, header->byteorder ? "big " : "little-");
819 #endif
820
821 /* Check the UUID type is valid and, if needed, read a UUID. */
822 if (header->uuid_type == 0) {
823 /* No UUID; fine, nothing more to do. */
824 }
825 else if (header->uuid_type == 1) {
826 /* Read in the UUID. We'll put it in a NULL-terminated string, just in
827 * case pepole use it that way. */
828 header->uuid_data = (unsigned char *)
829 mem_sys_allocate(header->uuid_size + 1);
830
831 memcpy(header->uuid_data, packed + PACKFILE_HEADER_BYTES,
832 header->uuid_size);
833
834 /* NULL terminate */
835 header->uuid_data[header->uuid_size] = 0;
836 }
837 else {
838 /* Don't know this UUID type. */
839 PIO_eprintf(NULL, "PackFile_unpack: Invalid UUID type %d\n",
840 header->uuid_type);
841 }
842
843 /* Set cursor to position after what we've read, allowing for padding to a
844 * 16 byte boundary. */
845 header_read_length = PACKFILE_HEADER_BYTES + header->uuid_size;
846 header_read_length += header_read_length % 16 ?
847 16 - header_read_length % 16 : 0;
848 cursor = packed + (header_read_length / sizeof (opcode_t));
849
850 /* Set what transforms we need to do when reading the rest of the file. */
851 PackFile_assign_transforms(self);
852
853 /* Directory format. */
854 header->dir_format = PF_fetch_opcode(self, &cursor);
855
856 if (header->dir_format != PF_DIR_FORMAT) {
857 PIO_eprintf(NULL, "PackFile_unpack: Dir format was %d not %d\n",
858 header->dir_format, PF_DIR_FORMAT);
859 return 0;
860 }
861
862 /* Padding. */
863 padding = PF_fetch_opcode(self, &cursor);
864 padding = PF_fetch_opcode(self, &cursor);
865 padding = PF_fetch_opcode(self, &cursor);
866 UNUSED(padding);
867
868 #if TRACE_PACKFILE
869 PIO_eprintf(NULL, "PackFile_unpack: Directory read, offset %d.\n",
870 (INTVAL)cursor - (INTVAL)packed);
871 #endif
872
873 self->directory.base.file_offset = (INTVAL)cursor - (INTVAL)self->src;
874
875 /* now unpack dir, which unpacks its contents ... */
876 Parrot_block_GC_mark(interp);
877 cursor = PackFile_Segment_unpack(interp,
878 &self->directory.base, cursor);
879 Parrot_unblock_GC_mark(interp);
880
881 #ifdef PARROT_HAS_HEADER_SYSMMAN
882 if (self->is_mmap_ped
883 && (self->need_endianize || self->need_wordsize)) {
884 DECL_CONST_CAST;
885 /* Cast the result to void to avoid a warning with
886 * some not-so-standard mmap headers, see RT#56110
887 */
888 munmap((void *)PARROT_const_cast(opcode_t *, self->src), self->size);
889 self->is_mmap_ped = 0;
890 }
891 #endif
892
893 #if TRACE_PACKFILE
894 PIO_eprintf(NULL, "PackFile_unpack: Unpack done.\n");
895 #endif
896
897 return cursor - packed;
898 }
899
900
901 /*
902
903 =item C<INTVAL PackFile_map_segments>
904
905 For each segment in the directory C<dir> the callback function C<callback> is
906 called. The pointer C<user_data> is included in each call.
907
908 If a callback returns non-zero the processing of segments is stopped,
909 and this value is returned.
910
911 =cut
912
913 */
914
915 PARROT_API
916 INTVAL
917 PackFile_map_segments(PARROT_INTERP, ARGIN(const PackFile_Directory *dir),
918 PackFile_map_segments_func_t callback,
919 ARGIN_NULLOK(void *user_data))
920 {
921 size_t i;
922
923 for (i = 0; i < dir->num_segments; i++) {
924 const INTVAL ret = callback(interp, dir->segments[i], user_data);
925 if (ret)
926 return ret;
927 }
928
929 return 0;
930 }
931
932
933 /*
934
935 =item C<INTVAL PackFile_add_segment>
936
937 Adds the Segment C<seg> to the directory C<dir>. The PackFile becomes the
938 owner of the segment; it gets destroyed when the packfile does.
939
940 =cut
941
942 */
943
944 PARROT_API
945 INTVAL
946 PackFile_add_segment(SHIM_INTERP, ARGMOD(PackFile_Directory *dir),
947 ARGIN(PackFile_Segment *seg))
948 {
949 mem_realloc_n_typed(dir->segments, dir->num_segments+1, PackFile_Segment *);
950 dir->segments[dir->num_segments] = seg;
951 dir->num_segments++;
952 seg->dir = dir;
953
954 return 0;
955 }
956
957
958 /*
959
960 =item C<PackFile_Segment * PackFile_find_segment>
961
962 Finds the segment with the name C<name> in the C<PackFile_Directory> if
963 C<sub_dir> is true, directories are searched recursively. The segment is
964 returned, but its still owned by the C<PackFile>.
965
966 =cut
967
968 */
969
970 PARROT_API
971 PARROT_WARN_UNUSED_RESULT
972 PARROT_CAN_RETURN_NULL
973 PackFile_Segment *
974 PackFile_find_segment(PARROT_INTERP, ARGIN_NULLOK(PackFile_Directory *dir),
975 ARGIN(const char *name), int sub_dir)
976 {
977 if (dir) {
978 size_t i;
979
980 for (i = 0; i < dir->num_segments; i++) {
981 PackFile_Segment *seg = dir->segments[i];
982
983 if (seg) {
984 if (STREQ(seg->name, name))
985 return seg;
986
987 if (sub_dir && seg->type == PF_DIR_SEG) {
988 seg = PackFile_find_segment(interp,
989 (PackFile_Directory *)seg, name, sub_dir);
990
991 if (seg)
992 return seg;
993 }
994 }
995 }
996 }
997
998 return NULL;
999 }
1000
1001
1002 /*
1003
1004 =item C<PackFile_Segment * PackFile_remove_segment_by_name>
1005
1006 Finds and removes the segment with name C<name> in the C<PackFile_Directory>.
1007 The segment is returned and must be destroyed by the user.
1008
1009 =cut
1010
1011 */
1012
1013 PARROT_API
1014 PARROT_WARN_UNUSED_RESULT
1015 PARROT_CAN_RETURN_NULL
1016 PackFile_Segment *
1017 PackFile_remove_segment_by_name(SHIM_INTERP, ARGMOD(PackFile_Directory *dir),
1018 ARGIN(const char *name))
1019 {
1020 size_t i;
1021
1022 for (i = 0; i < dir->num_segments; i++) {
1023 PackFile_Segment * const seg = dir->segments[i];
1024 if (STREQ(seg->name, name)) {
1025 dir->num_segments--;
1026
1027 if (i != dir->num_segments) {
1028 /* We're not the last segment, so we need to move things */
1029 memmove(&dir->segments[i], &dir->segments[i+1],
1030 (dir->num_segments - i) * sizeof (PackFile_Segment *));
1031 }
1032
1033 return seg;
1034 }
1035 }
1036
1037 return NULL;
1038 }
1039
1040
1041 /*
1042
1043 =back
1044
1045 =head2 PackFile Structure Functions
1046
1047 =over 4
1048
1049 =item C<static void PackFile_set_header>
1050
1051 Fill a C<PackFile> header with system specific data.
1052
1053 =cut
1054
1055 */
1056
1057 static void
1058 PackFile_set_header(ARGOUT(PackFile_Header *header))
1059 {
1060 memcpy(header->magic, "\376PBC\r\n\032\n", 8);
1061 header->wordsize = sizeof (opcode_t);
1062 header->byteorder = PARROT_BIGENDIAN;
1063 header->major = PARROT_MAJOR_VERSION;
1064 header->minor = PARROT_MINOR_VERSION;
1065 header->patch = PARROT_PATCH_VERSION;
1066 header->bc_major = PARROT_PBC_MAJOR;
1067 header->bc_minor = PARROT_PBC_MINOR;
1068 #if NUMVAL_SIZE == 8
1069 header->floattype = 0;
1070 #else /* if XXX */
1071 header->floattype = 1;
1072 #endif
1073 }
1074
1075
1076 /*
1077
1078 =item C<PackFile * PackFile_new>
1079
1080 Allocate a new empty C<PackFile> and setup the directory.
1081
1082 Directory segment:
1083
1084 +----------+----------+----------+----------+
1085 | Segment Header |
1086 | .............. |
1087 +----------+----------+----------+----------+
1088
1089 +----------+----------+----------+----------+
1090 | number of directory items |
1091 +----------+----------+----------+----------+
1092
1093 followed by a sequence of items
1094
1095 +----------+----------+----------+----------+
1096 | Segment type |
1097 +----------+----------+----------+----------+
1098 | "name" |
1099 | ... '\0' padding bytes |
1100 +----------+----------+----------+----------+
1101 | Offset in the file |
1102 +----------+----------+----------+----------+
1103 | Size of the segment |
1104 +----------+----------+----------+----------+
1105
1106 "name" is a NUL-terminated c-string encoded in plain ASCII.
1107
1108 Segment types are defined in F<include/parrot/packfile.h>.
1109
1110 Offset and size are in C<opcode_t>.
1111
1112 A Segment Header has these entries:
1113
1114 - op_count total ops of segment incl. this count
1115 - itype internal type of segment
1116 - id internal id e.g code seg nr
1117 - size size of following op array, 0 if none
1118 * data possibly empty data, or e.g. byte code
1119
1120 =cut
1121
1122 */
1123
1124 PARROT_API
1125 PARROT_WARN_UNUSED_RESULT
1126 PARROT_CANNOT_RETURN_NULL
1127 PackFile *
1128 PackFile_new(PARROT_INTERP, INTVAL is_mapped)
1129 {
1130 PackFile * const pf = mem_allocate_zeroed_typed(PackFile);
1131 pf->header = mem_allocate_zeroed_typed(PackFile_Header);
1132 pf->is_mmap_ped = is_mapped;
1133
1134 /* fill header with system specific data */
1135 PackFile_set_header(pf->header);
1136
1137 /* Other fields empty for now */
1138 pf->cur_cs = NULL;
1139 pf_register_standard_funcs(interp, pf);
1140
1141 /* create the master directory, all subirs go there */
1142 pf->directory.base.pf = pf;
1143 pf->dirp = (PackFile_Directory *)
1144 PackFile_Segment_new_seg(interp, &pf->directory,
1145 PF_DIR_SEG, DIRECTORY_SEGMENT_NAME, 0);
1146 pf->directory = *pf->dirp;
1147
1148 pf->fetch_op = (packfile_fetch_op_t)NULL;
1149 pf->fetch_iv = (packfile_fetch_iv_t)NULL;
1150 pf->fetch_nv = (packfile_fetch_nv_t)NULL;
1151
1152 return pf;
1153 }
1154
1155
1156 /*
1157
1158 =item C<PackFile * PackFile_new_dummy>
1159
1160 Create a new (initial) dummy PackFile. This is necessary if the interpreter
1161 doesn't load any bytecode but instead uses C<Parrot_compile_string>.
1162
1163 =cut
1164
1165 */
1166
1167 PARROT_API
1168 PARROT_WARN_UNUSED_RESULT
1169 PARROT_CAN_RETURN_NULL
1170 PackFile *
1171 PackFile_new_dummy(PARROT_INTERP, ARGIN(const char *name))
1172 {
1173 PackFile * const pf = PackFile_new(interp, 0);
1174 /* XXX PackFile_new needs to die on NULL, or else we have to check here */
1175
1176 interp->initial_pf = pf;
1177 interp->code = pf->cur_cs = PF_create_default_segs(interp, name, 1);
1178
1179 return pf;
1180 }
1181
1182
1183 /*
1184
1185 =item C<INTVAL PackFile_funcs_register>
1186
1187 Register the C<pack>/C<unpack>/... functions for a packfile type.
1188
1189 =cut
1190
1191 */
1192
1193 PARROT_API
1194 INTVAL
1195 PackFile_funcs_register(SHIM_INTERP, ARGOUT(PackFile *pf), UINTVAL type,
1196 const PackFile_funcs funcs)
1197 {
1198 /* TODO dynamic registering */
1199 pf->PackFuncs[type] = funcs;
1200 return 1;
1201 }
1202
1203
1204 /*
1205
1206 =item C<static const opcode_t * default_unpack>
1207
1208 The default unpack function.
1209
1210 =cut
1211
1212 */
1213
1214 PARROT_WARN_UNUSED_RESULT
1215 PARROT_CAN_RETURN_NULL
1216 static const opcode_t *
1217 default_unpack(ARGMOD(PackFile_Segment *self), ARGIN(const opcode_t *cursor))
1218 {
1219 DECL_CONST_CAST_OF(opcode_t);
1220
1221 self->op_count = PF_fetch_opcode(self->pf, &cursor);
1222 self->itype = PF_fetch_opcode(self->pf, &cursor);
1223 self->id = PF_fetch_opcode(self->pf, &cursor);
1224 self->size = PF_fetch_opcode(self->pf, &cursor);
1225
1226 if (self->size == 0)
1227 return cursor;
1228
1229 /* if the packfile is mmap()ed just point to it if we don't
1230 * need any fetch transforms */
1231 if (self->pf->is_mmap_ped
1232 && !self->pf->need_endianize
1233 && !self->pf->need_wordsize) {
1234 self->data = PARROT_const_cast(opcode_t *, cursor);
1235 cursor += self->size;
1236 return cursor;
1237 }
1238
1239 /* else allocate mem */
1240 self->data = mem_allocate_n_typed(self->size, opcode_t);
1241
1242 if (!self->data) {
1243 PIO_eprintf(NULL, "PackFile_unpack: Unable to allocate data memory!\n");
1244 self->size = 0;
1245 return NULL;
1246 }
1247
1248 if (!self->pf->need_endianize && !self->pf->need_wordsize) {
1249 mem_sys_memcopy(self->data, cursor, self->size * sizeof (opcode_t));
1250 cursor += self->size;
1251 }
1252 else {
1253 int i;
1254 for (i = 0; i < (int)self->size; i++) {
1255 self->data[i] = PF_fetch_opcode(self->pf, &cursor);
1256 #if TRACE_PACKFILE
1257 PIO_eprintf(NULL, "op[#%d] %u\n", i, self->data[i]);
1258 #endif
1259 }
1260 }
1261
1262 return cursor;
1263 }
1264
1265
1266 /*
1267
1268 =item C<void default_dump_header>
1269
1270 The default dump header function.
1271
1272 =cut
1273
1274 */
1275
1276 void
1277 default_dump_header(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
1278 {
1279 PIO_printf(interp, "%s => [ # offs 0x%x(%d)",
1280 self->name, (int)self->file_offset, (int)self->file_offset);
1281 PIO_printf(interp, " = op_count %d, itype %d, id %d, size %d, ...",
1282 (int)self->op_count, (int)self->itype,
1283 (int)self->id, (int)self->size);
1284 }
1285
1286
1287 /*
1288
1289 =item C<static void default_dump>
1290
1291 The default dump function.
1292
1293 =cut
1294
1295 */
1296
1297 static void
1298 default_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
1299 {
1300 size_t i = self->data ? 0: self->file_offset + 4;
1301
1302 default_dump_header(interp, self);
1303
1304 if (i % 8)
1305 PIO_printf(interp, "\n %04x: ", (int) i);
1306
1307 for (; i < (self->data ? self->size :
1308 self->file_offset + self->op_count); i++) {
1309
1310 if (i % 8 == 0)
1311 PIO_printf(interp, "\n %04x: ", (int) i);
1312
1313 PIO_printf(interp, "%08lx ", (unsigned long)
1314 self->data ? self->data[i] : self->pf->src[i]);
1315 }
1316
1317 PIO_printf(interp, "\n]\n");
1318 }
1319
1320
1321 /*
1322
1323 =item C<static void pf_register_standard_funcs>
1324
1325 Called from within C<PackFile_new()> register the standard functions.
1326
1327 =cut
1328
1329 */
1330
1331 static void
1332 pf_register_standard_funcs(PARROT_INTERP, ARGMOD(PackFile *pf))
1333 {
1334 PackFile_funcs dirf = {
1335 directory_new,
1336 directory_destroy,
1337 directory_packed_size,
1338 directory_pack,
1339 directory_unpack,
1340 directory_dump
1341 };
1342
1343 PackFile_funcs defaultf = {
1344 PackFile_Segment_new,
1345 (PackFile_Segment_destroy_func_t) NULLfunc,
1346 (PackFile_Segment_packed_size_func_t) NULLfunc,
1347 (PackFile_Segment_pack_func_t) NULLfunc,
1348 (PackFile_Segment_unpack_func_t) NULLfunc,
1349 default_dump
1350 };
1351
1352 PackFile_funcs fixupf = {
1353 fixup_new,
1354 fixup_destroy,
1355 fixup_packed_size,
1356 fixup_pack,
1357 fixup_unpack,
1358 default_dump
1359 };
1360
1361 PackFile_funcs constf = {
1362 const_new,
1363 const_destroy,
1364 PackFile_ConstTable_pack_size,
1365 PackFile_ConstTable_pack,
1366 PackFile_ConstTable_unpack,
1367 default_dump
1368 };
1369
1370 PackFile_funcs bytef = {
1371 byte_code_new,
1372 byte_code_destroy,
1373 (PackFile_Segment_packed_size_func_t) NULLfunc,
1374 (PackFile_Segment_pack_func_t) NULLfunc,
1375 (PackFile_Segment_unpack_func_t) NULLfunc,
1376 default_dump
1377 };
1378
1379 const PackFile_funcs debugf = {
1380 pf_debug_new,
1381 pf_debug_destroy,
1382 pf_debug_packed_size,
1383 pf_debug_pack,
1384 pf_debug_unpack,
1385 pf_debug_dump
1386 };
1387 PackFile_funcs_register(interp, pf, PF_DIR_SEG, dirf);
1388 PackFile_funcs_register(interp, pf, PF_UNKNOWN_SEG, defaultf);
1389 PackFile_funcs_register(interp, pf, PF_FIXUP_SEG, fixupf);
1390 PackFile_funcs_register(interp, pf, PF_CONST_SEG, constf);
1391 PackFile_funcs_register(interp, pf, PF_BYTEC_SEG, bytef);
1392 PackFile_funcs_register(interp, pf, PF_DEBUG_SEG, debugf);
1393
1394 return;
1395 }
1396
1397
1398 /*
1399
1400 =item C<PackFile_Segment * PackFile_Segment_new_seg>
1401
1402 Create a new segment.
1403
1404 =cut
1405
1406 */
1407
1408 PARROT_API
1409 PARROT_WARN_UNUSED_RESULT
1410 PARROT_CANNOT_RETURN_NULL
1411 PackFile_Segment *
1412 PackFile_Segment_new_seg(PARROT_INTERP, ARGMOD(PackFile_Directory *dir),
1413 UINTVAL type, ARGIN(const char *name), int add)
1414 {
1415 PackFile * const pf = dir->base.pf;
1416 const PackFile_Segment_new_func_t f = pf->PackFuncs[type].new_seg;
1417 PackFile_Segment * const seg = (f)(interp, pf, name, add);
1418
1419 segment_init(seg, pf, name);
1420 seg->type = type;
1421
1422 if (add)
1423 PackFile_add_segment(interp, dir, seg);
1424
1425 return seg;
1426 }
1427
1428
1429 /*
1430
1431 =item C<static PackFile_Segment * create_seg>
1432
1433 RT#48260: Not yet documented!!!
1434
1435 =cut
1436
1437 */
1438
1439 PARROT_WARN_UNUSED_RESULT
1440 PARROT_CANNOT_RETURN_NULL
1441 static PackFile_Segment *
1442 create_seg(PARROT_INTERP, ARGMOD(PackFile_Directory *dir), pack_file_types t,
1443 ARGIN(const char *name), ARGIN(const char *file_name), int add)
1444 {
1445 PackFile_Segment *seg;
1446
1447 const size_t len = strlen(name) + strlen(file_name) + 2;
1448 char * const buf = (char *)mem_sys_allocate(len);
1449
1450 snprintf(buf, len, "%s_%s", name, file_name);
1451 seg = PackFile_Segment_new_seg(interp, dir, t, buf, add);
1452 mem_sys_free(buf);
1453 return seg;
1454 }
1455
1456
1457 /*
1458
1459 =item C<PackFile_ByteCode * PF_create_default_segs>
1460
1461 Create bytecode, constant, and fixup segment for C<file_nam>. If C<add> is
1462 true, the current packfile becomes the owner of these segments by adding the
1463 segments to the directory.
1464
1465 =cut
1466
1467 */
1468
1469 PARROT_API
1470 PARROT_WARN_UNUSED_RESULT
1471 PARROT_CANNOT_RETURN_NULL
1472 PackFile_ByteCode *
1473 PF_create_default_segs(PARROT_INTERP, ARGIN(const char *file_name), int add)
1474 {
1475 PackFile * const pf = interp->initial_pf;
1476 PackFile_ByteCode * const cur_cs =
1477 (PackFile_ByteCode *)create_seg(interp, &pf->directory,
1478 PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME, file_name, add);
1479
1480 cur_cs->fixups =
1481 (PackFile_FixupTable *)create_seg(interp, &pf->directory,
1482 PF_FIXUP_SEG, FIXUP_TABLE_SEGMENT_NAME, file_name, add);
1483
1484 cur_cs->fixups->code = cur_cs;
1485
1486 cur_cs->const_table =
1487 (PackFile_ConstTable *)create_seg(interp, &pf->directory,
1488 PF_CONST_SEG, CONSTANT_SEGMENT_NAME, file_name, add);
1489
1490 cur_cs->const_table->code = cur_cs;
1491
1492 cur_cs->pic_index = create_seg(interp, &pf->directory,
1493 PF_UNKNOWN_SEG, "PIC_idx", file_name, add);
1494
1495 return cur_cs;
1496 }
1497
1498
1499 /*
1500
1501 =item C<void PackFile_Segment_destroy>
1502
1503 RT#48260: Not yet documented!!!
1504
1505 =cut
1506
1507 */
1508
1509 PARROT_API
1510 void
1511 PackFile_Segment_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
1512 {
1513 const PackFile_Segment_destroy_func_t f =
1514 self->pf->PackFuncs[self->type].destroy;
1515
1516 if (f)
1517 (f)(interp, self);
1518
1519 /* destroy self after specific */
1520 default_destroy(self);
1521 }
1522
1523
1524 /*
1525
1526 =item C<size_t PackFile_Segment_packed_size>
1527
1528 RT#48260: Not yet documented!!!
1529
1530 =cut
1531
1532 */
1533
1534 PARROT_API
1535 size_t
1536 PackFile_Segment_packed_size(PARROT_INTERP, ARGIN(PackFile_Segment *self))
1537 {
1538 size_t size = default_packed_size(self);
1539 const size_t align = 16 / sizeof (opcode_t);
1540 PackFile_Segment_packed_size_func_t f =
1541 self->pf->PackFuncs[self->type].packed_size;
1542
1543 if (f)
1544 size += (f)(interp, self);
1545
1546 /* pad/align it */
1547 if (align && size % align)
1548 size += (align - size % align);
1549
1550 return size;
1551 }
1552
1553
1554 /*
1555
1556 =item C<opcode_t * PackFile_Segment_pack>
1557
1558 RT#48260: Not yet documented!!!
1559
1560 =cut
1561
1562 */
1563
1564 PARROT_API
1565 PARROT_WARN_UNUSED_RESULT
1566 PARROT_CANNOT_RETURN_NULL
1567 opcode_t *
1568 PackFile_Segment_pack(PARROT_INTERP, ARGIN(PackFile_Segment *self),
1569 ARGIN(opcode_t *cursor))
1570 {
1571 const size_t align = 16 / sizeof (opcode_t);
1572 PackFile_Segment_pack_func_t f =
1573 self->pf->PackFuncs[self->type].pack;
1574
1575 cursor = default_pack(self, cursor);
1576
1577 if (f)
1578 cursor = (f)(interp, self, cursor);
1579
1580 if (align && (cursor - self->pf->src) % align)
1581 cursor += align - (cursor - self->pf->src) % align;
1582
1583 return cursor;
1584 }
1585
1586
1587 /*
1588
1589 =item C<const opcode_t * PackFile_Segment_unpack>
1590
1591 All all these functions call the related C<default_*> function.
1592
1593 If a special is defined this gets called after.
1594
1595 =cut
1596
1597 */
1598
1599 PARROT_API
1600 PARROT_WARN_UNUSED_RESULT
1601 PARROT_CAN_RETURN_NULL
1602 const opcode_t *
1603 PackFile_Segment_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *self),
1604 ARGIN(const opcode_t *cursor))
1605 {
1606 PackFile_Segment_unpack_func_t f = self->pf->PackFuncs[self->type].unpack;
1607
1608 cursor = default_unpack(self, cursor);
1609
1610 if (!cursor)
1611 return NULL;
1612
1613 if (f) {
1614 cursor = (f)(interp, self, cursor);
1615 if (!cursor)
1616 return NULL;
1617 }
1618
1619 ALIGN_16(self->pf->src, cursor);
1620 return cursor;
1621 }
1622
1623
1624 /*
1625
1626 =item C<void PackFile_Segment_dump>
1627
1628 Dumps the segment C<self>.
1629
1630 =cut
1631
1632 */
1633
1634 PARROT_API
1635 void
1636 PackFile_Segment_dump(PARROT_INTERP, ARGIN(PackFile_Segment *self))
1637 {
1638 self->pf->PackFuncs[self->type].dump(interp, self);
1639 }
1640
1641
1642 /*
1643
1644 =back
1645
1646 =head2 Standard Directory Functions
1647
1648 =over 4
1649
1650 =item C<static PackFile_Segment * directory_new>
1651
1652 Returns a new C<PackFile_Directory> cast as a C<PackFile_Segment>.
1653
1654 =cut
1655
1656 */
1657
1658 PARROT_WARN_UNUSED_RESULT
1659 PARROT_CANNOT_RETURN_NULL
1660 static PackFile_Segment *
1661 directory_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(const char *name), SHIM(int add))
1662 {
1663
1664 return (PackFile_Segment *)mem_allocate_zeroed_typed(PackFile_Directory);
1665 }
1666
1667
1668 /*
1669
1670 =item C<static void directory_dump>
1671
1672 Dumps the directory C<self>.
1673
1674 =cut
1675
1676 */
1677
1678 static void
1679 directory_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
1680 {
1681 const PackFile_Directory * const dir = (const PackFile_Directory *) self;
1682 size_t i;
1683
1684 default_dump_header(interp, self);
1685
1686 PIO_printf(interp, "\n\t# %d segments\n", dir->num_segments);
1687
1688 for (i = 0; i < dir->num_segments; i++) {
1689 const PackFile_Segment * const seg = dir->segments[i];
1690
1691 PIO_printf(interp,
1692
1693 "\ttype %d\t%s\t", (int)seg->type, seg->name);
1694 PIO_printf(interp,
1695 " offs 0x%x(0x%x)\top_count %d\n",
1696 (int)seg->file_offset,
1697 (int)seg->file_offset * sizeof (opcode_t),
1698 (int)seg->op_count);
1699 }
1700
1701 PIO_printf(interp, "]\n");
1702
1703 for (i = 0; i < dir->num_segments; i++)
1704 PackFile_Segment_dump(interp, dir->segments[i]);
1705 }
1706
1707
1708 /*
1709
1710 =item C<static const opcode_t * directory_unpack>
1711
1712 Unpacks the directory.
1713
1714 =cut
1715
1716 */
1717
1718 PARROT_WARN_UNUSED_RESULT
1719 PARROT_CANNOT_RETURN_NULL
1720 static const opcode_t *
1721 directory_unpack(PARROT_INTERP, ARGMOD(PackFile_Segment *segp), ARGIN(const opcode_t *cursor))
1722 {
1723 PackFile_Directory * const dir = (PackFile_Directory *) segp;
1724 PackFile * const pf = dir->base.pf;
1725 const opcode_t *pos;
1726 size_t i;
1727
1728 dir->num_segments = PF_fetch_opcode(pf, &cursor);
1729 mem_realloc_n_typed(dir->segments, dir->num_segments, PackFile_Segment *);
1730
1731 for (i = 0; i < dir->num_segments; i++) {
1732 PackFile_Segment *seg;
1733 char *name;
1734 size_t opcode;
1735
1736 /* get type */
1737 UINTVAL type = PF_fetch_opcode(pf, &cursor);
1738
1739 if (type >= PF_MAX_SEG)
1740 type = PF_UNKNOWN_SEG;
1741
1742 #if TRACE_PACKFILE
1743 PIO_eprintf(NULL, "Segment type %d.\n", type);
1744 #endif
1745 /* get name */
1746 name = PF_fetch_cstring(pf, &cursor);
1747
1748 #if TRACE_PACKFILE
1749 PIO_eprintf(NULL, "Segment name \"%s\".\n", name);
1750 #endif
1751
1752 /* create it */
1753 seg = PackFile_Segment_new_seg(interp, dir, type, name, 0);
1754 mem_sys_free(name);
1755
1756 seg->file_offset = PF_fetch_opcode(pf, &cursor);
1757 seg->op_count = PF_fetch_opcode(pf, &cursor);
1758
1759 if (pf->need_wordsize) {
1760 #if OPCODE_T_SIZE == 8
1761 if (pf->header->wordsize == 4)
1762 pos = pf->src + seg->file_offset / 2;
1763 #else
1764 if (pf->header->wordsize == 8)
1765 pos = pf->src + seg->file_offset * 2;
1766 #endif
1767 }
1768 else
1769 pos = pf->src + seg->file_offset;
1770
1771 opcode = PF_fetch_opcode(pf, &pos);
1772
1773 if (seg->op_count != opcode) {
1774 fprintf(stderr,
1775 "%s: Size in directory %d doesn't match size %d "
1776 "at offset 0x%x\n", seg->name, (int)seg->op_count,
1777 (int)opcode, (int)seg->file_offset);
1778 }
1779
1780 if (i) {
1781 PackFile_Segment *last = dir->segments[i-1];
1782 if (last->file_offset + last->op_count != seg->file_offset) {
1783 fprintf(stderr, "%s: sections are not back to back\n",
1784 "section");
1785 }
1786 }
1787
1788 make_code_pointers(seg);
1789
1790 /* store the segment */
1791 dir->segments[i] = seg;
1792 seg->dir = dir;
1793 }
1794
1795 ALIGN_16(pf->src, cursor);
1796
1797 /* and now unpack contents of dir */
1798 for (i = 0; cursor && i < dir->num_segments; i++) {
1799 const opcode_t * const csave = cursor;
1800
1801 /* check len again */
1802 size_t tmp = PF_fetch_opcode(pf, &cursor);
1803
1804 /* keep gcc -O silent */
1805 size_t delta = 0;
1806
1807 cursor = csave;
1808 pos = PackFile_Segment_unpack(interp, dir->segments[i], cursor);
1809
1810 if (!pos) {
1811 fprintf(stderr, "PackFile_unpack segment '%s' failed\n",
1812 dir->segments[i]->name);
1813 return 0;
1814 }
1815
1816 if (pf->need_wordsize) {
1817 #if OPCODE_T_SIZE == 8
1818 if (pf->header->wordsize == 4)
1819 delta = (pos - cursor) * 2;
1820 #else
1821 if (pf->header->wordsize == 8)
1822 delta = (pos - cursor) / 2;
1823 #endif
1824 }
1825 else
1826 delta = pos - cursor;
1827
1828 if ((size_t)delta != tmp || dir->segments[i]->op_count != tmp)
1829 fprintf(stderr, "PackFile_unpack segment '%s' directory length %d "
1830 "length in file %d needed %d for unpack\n",
1831 dir->segments[i]->name,
1832 (int)dir->segments[i]->op_count, (int)tmp,
1833 (int)delta);
1834 cursor = pos;
1835 }
1836
1837 return cursor;
1838 }
1839
1840
1841 /*
1842
1843 =item C<static void directory_destroy>
1844
1845 Destroys the directory.
1846
1847 =cut
1848
1849 */
1850
1851 static void
1852 directory_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
1853 {
1854 PackFile_Directory * const dir = (PackFile_Directory *)self;
1855 size_t i;
1856
1857 for (i = 0; i < dir->num_segments; i++)
1858 PackFile_Segment_destroy(interp, dir->segments[i]);
1859
1860 if (dir->segments) {
1861 mem_sys_free(dir->segments);
1862 dir->segments = NULL;
1863 }
1864 }
1865
1866
1867 /*
1868
1869 =item C<static void sort_segs>
1870
1871 Sorts the segments in C<dir>.
1872
1873 =cut
1874
1875 */
1876
1877 static void
1878 sort_segs(ARGMOD(PackFile_Directory *dir))
1879 {
1880 const size_t num_segs = dir->num_segments;
1881 PackFile_Segment *seg = dir->segments[0];
1882
1883 if (seg->type != PF_BYTEC_SEG) {
1884 size_t i;
1885
1886 for (i = 1; i < num_segs; i++) {
1887 PackFile_Segment * const s2 = dir->segments[i];
1888 if (s2->type == PF_BYTEC_SEG) {
1889 dir->segments[0] = s2;
1890 dir->segments[i] = seg;
1891 break;
1892 }
1893 }
1894 }
1895
1896 seg = dir->segments[1];
1897
1898 if (seg->type != PF_FIXUP_SEG) {
1899 size_t i;
1900
1901 for (i = 2; i < num_segs; i++) {
1902 PackFile_Segment * const s2 = dir->segments[i];
1903 if (s2->type == PF_FIXUP_SEG) {
1904 dir->segments[1] = s2;
1905 dir->segments[i] = seg;
1906 break;
1907 }
1908 }
1909 }
1910 }
1911
1912
1913 /*
1914
1915 =item C<static size_t directory_packed_size>
1916
1917 Returns the size of the directory minus the value returned by
1918 C<default_packed_size()>.
1919
1920 =cut
1921
1922 */
1923
1924 static size_t
1925 directory_packed_size(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
1926 {
1927 PackFile_Directory * const dir = (PackFile_Directory *)self;
1928 const size_t align = 16 / sizeof (opcode_t);
1929 size_t size, i;
1930
1931 /* need bytecode, fixup, other segs ... */
1932 sort_segs(dir);
1933
1934 /* number of segments + default, we need it for the offsets */
1935 size = 1 + default_packed_size(self);
1936
1937 for (i = 0; i < dir->num_segments; i++) {
1938 /* type, offset, size */
1939 size += 3;
1940 size += PF_size_cstring(dir->segments[i]->name);
1941 }
1942
1943 /* pad/align it */
1944 if (align && size % align)
1945 size += (align - size % align);
1946
1947 for (i = 0; i < dir->num_segments; i++) {
1948 size_t seg_size;
1949
1950 dir->segments[i]->file_offset = size + self->file_offset;
1951 seg_size =
1952 PackFile_Segment_packed_size(interp, dir->segments[i]);
1953 dir->segments[i]->op_count = seg_size;
1954 size += seg_size;
1955 }
1956
1957 self->op_count = size;
1958
1959 /* subtract default, it is added in PackFile_Segment_packed_size */
1960 return size - default_packed_size(self);
1961 }
1962
1963
1964 /*
1965
1966 =item C<static opcode_t * directory_pack>
1967
1968 Packs the directory C<self>.
1969
1970 =cut
1971
1972 */
1973
1974 PARROT_WARN_UNUSED_RESULT
1975 PARROT_CANNOT_RETURN_NULL
1976 static opcode_t *
1977 directory_pack(PARROT_INTERP, ARGIN(PackFile_Segment *self), ARGOUT(opcode_t *cursor))
1978 {
1979 PackFile_Directory * const dir = (PackFile_Directory *)self;
1980 size_t i;
1981 size_t align;
1982 const size_t num_segs = dir->num_segments;
1983
1984 *cursor++ = num_segs;
1985
1986 for (i = 0; i < num_segs; i++) {
1987 const PackFile_Segment * const seg = dir->segments[i];
1988 *cursor++ = seg->type;
1989 cursor = PF_store_cstring(cursor, seg->name);
1990 *cursor++ = seg->file_offset;
1991 *cursor++ = seg->op_count;
1992 }
1993 align = 16/sizeof (opcode_t);
1994 if (align && (cursor - self->pf->src) % align)
1995 cursor += align - (cursor - self->pf->src) % align;
1996
1997 /* now pack all segments into new format */
1998 for (i = 0; i < dir->num_segments; i++) {
1999 PackFile_Segment * const seg = dir->segments[i];
2000
2001 cursor = PackFile_Segment_pack(interp, seg, cursor);
2002 }
2003
2004 return cursor;
2005 }
2006
2007 /*
2008
2009 =back
2010
2011 =head2 C<PackFile_Segment> Functions
2012
2013 =over 4
2014
2015 =item C<static void segment_init>
2016
2017 Initializes the segment C<self>.
2018
2019 =cut
2020
2021 */
2022
2023 static void
2024 segment_init(ARGOUT(PackFile_Segment *self), ARGIN(PackFile *pf),
2025 ARGIN(const char *name))
2026 {
2027 self->pf = pf;
2028 self->type = PF_UNKNOWN_SEG;
2029 self->file_offset = 0;
2030 self->op_count = 0;
2031 self->itype = 0;
2032 self->size = 0;
2033 self->data = NULL;
2034 self->id = 0;
2035 self->name = str_dup(name);
2036 }
2037
2038 /*
2039
2040 =item C<PackFile_Segment * PackFile_Segment_new>
2041
2042 Create a new default section.
2043
2044 =cut
2045
2046 */
2047
2048 PARROT_API
2049 PARROT_WARN_UNUSED_RESULT
2050 PARROT_CANNOT_RETURN_NULL
2051 PackFile_Segment *
2052 PackFile_Segment_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(const char *name), SHIM(int add))
2053 {
2054 PackFile_Segment * const seg = mem_allocate_typed(PackFile_Segment);
2055
2056 return seg;
2057 }
2058
2059 /*
2060
2061 =back
2062
2063 =head2 Default Function Implementations
2064
2065 The default functions are called before the segment specific functions
2066 and can read a block of C<opcode_t> data.
2067
2068 =over 4
2069
2070 =item C<static void default_destroy>
2071
2072 The default destroy function.
2073
2074 =cut
2075
2076 */
2077
2078 static void
2079 default_destroy(ARGMOD(PackFile_Segment *self))
2080 {
2081 if (!self->pf->is_mmap_ped && self->data) {
2082 mem_sys_free(self->data);
2083 self->data = NULL;
2084 }
2085 if (self->name) {
2086 mem_sys_free(self->name);
2087 self->name = NULL;
2088 }
2089 mem_sys_free(self);
2090 }
2091
2092 /*
2093
2094 =item C<static size_t default_packed_size>
2095
2096 Returns the default size of the segment C<self>.
2097
2098 =cut
2099
2100 */
2101
2102 static size_t
2103 default_packed_size(ARGIN(const PackFile_Segment *self))
2104 {
2105 /* op_count, itype, id, size */
2106 /* XXX There should be a constant defining this 4, and why */
2107 /* This is the 2nd place in the file that has this */
2108 return 4 + self->size;
2109 }
2110
2111 /*
2112
2113 =item C<static opcode_t * default_pack>
2114
2115 Performs the default pack.
2116
2117 =cut
2118
2119 */
2120
2121 PARROT_WARN_UNUSED_RESULT
2122 PARROT_CANNOT_RETURN_NULL
2123 static opcode_t *
2124 default_pack(ARGIN(const PackFile_Segment *self), ARGOUT(opcode_t *dest))
2125 {
2126 *dest++ = self->op_count;
2127 *dest++ = self->itype;
2128 *dest++ = self->id;
2129 *dest++ = self->size;
2130 if (self->size)
2131 STRUCT_COPY_N(dest, self->data, self->size);
2132 return dest + self->size;
2133 }
2134
2135 /*
2136
2137 =back
2138
2139 =head2 ByteCode
2140
2141 =over 4
2142
2143 =item C<static void byte_code_destroy>
2144
2145 Destroys the C<PackFile_ByteCode> segment C<self>.
2146
2147 =cut
2148
2149 */
2150
2151 static void
2152 byte_code_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *self))
2153 {
2154 PackFile_ByteCode * const byte_code = (PackFile_ByteCode *)self;
2155
2156 #ifdef HAS_JIT
2157 Parrot_destroy_jit(byte_code->jit_info);
2158 #endif
2159 parrot_PIC_destroy(byte_code);
2160 if (byte_code->prederef.code) {
2161 Parrot_free_memalign(byte_code->prederef.code);
2162 byte_code->prederef.code = NULL;
2163 if (byte_code->prederef.branches) {
2164 mem_sys_free(byte_code->prederef.branches);
2165 byte_code->prederef.branches = NULL;
2166 }
2167 }
2168 byte_code->fixups = NULL;
2169 byte_code->const_table = NULL;
2170 byte_code->pic_index = NULL;
2171 byte_code->debugs = NULL;
2172 }
2173
2174 /*
2175
2176 =item C<static PackFile_Segment * byte_code_new>
2177
2178 New C<PackFile_ByteCode> segment.
2179
2180 C<pf> and C<add> are ignored.
2181
2182 =cut
2183
2184 */
2185
2186 PARROT_WARN_UNUSED_RESULT
2187 PARROT_CANNOT_RETURN_NULL
2188 static PackFile_Segment *
2189 byte_code_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(const char *name), SHIM(int add))
2190 {
2191 PackFile_ByteCode * const byte_code = mem_allocate_zeroed_typed(PackFile_ByteCode);
2192
2193 return (PackFile_Segment *) byte_code;
2194 }
2195
2196 /*
2197
2198 =back
2199
2200 =head2 Debug Info
2201
2202 =over 4
2203
2204 =item C<static void pf_debug_destroy>
2205
2206 Destroys the C<PackFile_Debug> segment C<self>.
2207
2208 =cut
2209
2210 */
2211
2212 static void
2213 pf_debug_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *self))
2214 {
2215 PackFile_Debug * const debug = (PackFile_Debug *) self;
2216 int i;
2217
2218 /* Free each mapping. */
2219 for (i = 0; i < debug->num_mappings; i++)
2220 mem_sys_free(debug->mappings[i]);
2221
2222 /* Free mappings pointer array. */
2223 mem_sys_free(debug->mappings);
2224 debug->mappings = NULL;
2225 debug->num_mappings = 0;
2226 }
2227
2228 /*
2229
2230 =item C<static PackFile_Segment * pf_debug_new>
2231
2232 Returns a new C<PackFile_Debug> segment.
2233
2234 C<pf> and C<add> ignored.
2235
2236 =cut
2237
2238 */
2239
2240 PARROT_WARN_UNUSED_RESULT
2241 PARROT_CANNOT_RETURN_NULL
2242 static PackFile_Segment *
2243 pf_debug_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(const char *name), SHIM(int add))
2244 {
2245 PackFile_Debug * const debug = mem_allocate_zeroed_typed(PackFile_Debug);
2246
2247 debug->mappings = mem_allocate_typed(PackFile_DebugMapping *);
2248 debug->mappings[0] = NULL;
2249
2250 return (PackFile_Segment *)debug;
2251 }
2252
2253 /*
2254
2255 =item C<static size_t pf_debug_packed_size>
2256
2257 Returns the size of the C<PackFile_Debug> segment's filename in
2258 C<opcode_t> units.
2259
2260 =cut
2261
2262 */
2263
2264 static size_t
2265 pf_debug_packed_size(SHIM_INTERP, ARGIN(PackFile_Segment *self))
2266 {
2267 PackFile_Debug * const debug = (PackFile_Debug *)self;
2268 int size = 0;
2269 int i;
2270
2271 /* Size of mappings count. */
2272 size += 1;
2273
2274 /* Size of entries in mappings list. */
2275 for (i = 0; i < debug->num_mappings; i++) {
2276 /* Bytecode offset and mapping type */
2277 size += 2;
2278
2279 /* Mapping specific stuff. */
2280 switch (debug->mappings[i]->mapping_type) {
2281 case PF_DEBUGMAPPINGTYPE_FILENAME:
2282 case PF_DEBUGMAPPINGTYPE_SOURCESEG:
2283 size += 1;
2284 break;
2285 case PF_DEBUGMAPPINGTYPE_NONE:
2286 default:
2287 break;
2288 }
2289 }
2290
2291 return size;
2292 }
2293
2294 /*
2295
2296 =item C<static opcode_t * pf_debug_pack>
2297
2298 Pack the debug segment.
2299
2300 =cut
2301
2302 */
2303
2304 PARROT_WARN_UNUSED_RESULT
2305 PARROT_CANNOT_RETURN_NULL
2306 static opcode_t *
2307 pf_debug_pack(SHIM_INTERP, ARGMOD(PackFile_Segment *self), ARGOUT(opcode_t *cursor))
2308 {
2309 PackFile_Debug * const debug = (PackFile_Debug *)self;
2310 int i;
2311 const int n = debug->num_mappings;
2312
2313 /* Store number of mappings. */
2314 *cursor++ = n;
2315
2316 /* Now store each mapping. */
2317 for (i = 0; i < n; i++) {
2318 /* Bytecode offset and mapping type */
2319 *cursor++ = debug->mappings[i]->offset;
2320 *cursor++ = debug->mappings[i]->mapping_type;
2321
2322 /* Mapping specific stuff. */
2323 switch (debug->mappings[i]->mapping_type) {
2324 case PF_DEBUGMAPPINGTYPE_FILENAME:
2325 *cursor++ = debug->mappings[i]->u.filename;
2326 break;
2327 case PF_DEBUGMAPPINGTYPE_SOURCESEG:
2328 *cursor++ = debug->mappings[i]->u.source_seg;
2329 break;
2330 case PF_DEBUGMAPPINGTYPE_NONE:
2331 default:
2332 break;
2333 }
2334 }
2335
2336 return cursor;
2337 }
2338
2339 /*
2340
2341 =item C<static const opcode_t * pf_debug_unpack>
2342
2343 Unpack a debug segment into a PackFile_Debug structure.
2344
2345 =cut
2346
2347 */
2348
2349 PARROT_WARN_UNUSED_RESULT
2350 PARROT_CANNOT_RETURN_NULL
2351 static const opcode_t *
2352 pf_debug_unpack(PARROT_INTERP, ARGOUT(PackFile_Segment *self), ARGIN(const opcode_t *cursor))
2353 {
2354 PackFile_Debug * const debug = (PackFile_Debug *)self;
2355 PackFile_ByteCode *code;
2356 int i;
2357
2358 /* For some reason, we store the source file name in the segment
2359 name. So we can't find the bytecode seg without knowing the filename.
2360 But with the new scheme we can have many file names. For now, just
2361 base this on the name of the debug segment. */
2362 char *code_name = NULL;
2363 size_t str_len;
2364
2365 /* Number of mappings. */
2366 debug->num_mappings = PF_fetch_opcode(self->pf, &cursor);
2367
2368 /* Allocate space for mappings vector. */
2369 mem_realloc_n_typed(debug->mappings, debug->num_mappings+1, PackFile_DebugMapping *);
2370
2371 /* Read in each mapping. */
2372 for (i = 0; i < debug->num_mappings; i++) {
2373 /* Allocate struct and get offset and mapping type. */
2374 debug->mappings[i] = mem_allocate_typed(PackFile_DebugMapping);
2375 debug->mappings[i]->offset = PF_fetch_opcode(self->pf, &cursor);
2376 debug->mappings[i]->mapping_type = PF_fetch_opcode(self->pf, &cursor);
2377
2378 /* Read mapping specific stuff. */
2379 switch (debug->mappings[i]->mapping_type) {
2380 case PF_DEBUGMAPPINGTYPE_FILENAME:
2381 debug->mappings[i]->u.filename =
2382 PF_fetch_opcode(self->pf, &cursor);
2383 break;
2384 case PF_DEBUGMAPPINGTYPE_SOURCESEG:
2385 debug->mappings[i]->u.source_seg =
2386 PF_fetch_opcode(self->pf, &cursor);
2387 break;
2388 case PF_DEBUGMAPPINGTYPE_NONE:
2389 default:
2390 break;
2391 }
2392 }
2393
2394 /*
2395 * find seg e.g. CODE_DB => CODE
2396 * and attach it
2397 */
2398 code_name = str_dup(debug->base.name);
2399 str_len = strlen(code_name);
2400 code_name[str_len - 3] = 0;
2401 code = (PackFile_ByteCode *)PackFile_find_segment(interp,
2402 self->dir, code_name, 0);
2403 if (!code || code->base.type != PF_BYTEC_SEG) {
2404 Parrot_ex_throw_from_c_args(interp, NULL, 1,
2405 "Code '%s' not found for debug segment '%s'\n",
2406 code_name, self->name);
2407 }
2408
2409 code->debugs = debug;
2410 debug->code = code;
2411
2412 mem_sys_free(code_name);
2413 return cursor;
2414 }
2415
2416
2417 /*
2418
2419 =item C<static void pf_debug_dump>
2420
2421 Dumps a debug segment to a human readable form.
2422
2423 =cut
2424
2425 */
2426
2427 static void
2428 pf_debug_dump(PARROT_INTERP, ARGIN(const PackFile_Segment *self))
2429 {
2430 opcode_t i;
2431 size_t j;
2432 const PackFile_Debug * const debug = (const PackFile_Debug *)self;
2433
2434 default_dump_header(interp, self);
2435
2436 PIO_printf(interp, "\n mappings => [\n");
2437 for (i = 0; i < debug->num_mappings; i++) {
2438 PIO_printf(interp, " #%d\n [\n", i);
2439 PIO_printf(interp, " OFFSET => %d,\n",
2440 debug->mappings[i]->offset);
2441 switch (debug->mappings[i]->mapping_type) {
2442 case PF_DEBUGMAPPINGTYPE_NONE:
2443 PIO_printf(interp, " MAPPINGTYPE => NONE\n");
2444 break;
2445 case PF_DEBUGMAPPINGTYPE_FILENAME:
2446 {
2447 char *filename;
2448
2449 PIO_printf(interp, " MAPPINGTYPE => FILENAME,\n");
2450 filename = string_to_cstring(interp, PF_CONST(debug->code,
2451 debug->mappings[i]->u.filename)->u.string);
2452 PIO_printf(interp, " FILENAME => %s\n", filename);
2453 string_cstring_free(filename);
2454 }
2455 break;
2456 case PF_DEBUGMAPPINGTYPE_SOURCESEG:
2457 PIO_printf(interp, " MAPPINGTYPE => SOURCESEG,\n");
2458 PIO_printf(interp, " SOURCESEG => %d\n",
2459 debug->mappings[i]->u.source_seg);
2460 break;
2461 default:
2462 break;
2463 }
2464 PIO_printf(interp, " ],\n");
2465 }
2466
2467 PIO_printf(interp, " ]\n");
2468
2469 j = self->data ? 0: self->file_offset + 4;
2470 if (j % 8)
2471 PIO_printf(interp, "\n %04x: ", (int) j);
2472
2473 for (; j < (self->data ? self->size :
2474 self->file_offset + self->op_count); j++) {
2475 if (j % 8 == 0) {
2476 PIO_printf(interp, "\n %04x: ", (int) j);
2477 }
2478 PIO_printf(interp, "%08lx ", (unsigned long)
2479 self->data ? self->data[j] : self->pf->src[j]);
2480 }
2481 PIO_printf(interp, "\n]\n");
2482 }
2483
2484 /*
2485
2486 =item C<PackFile_Debug * Parrot_new_debug_seg>
2487
2488 Create and append (or resize) a new debug seg for a code segment.
2489
2490 =cut
2491
2492 */
2493
2494 PARROT_API
2495 PARROT_WARN_UNUSED_RESULT
2496 PARROT_CANNOT_RETURN_NULL
2497 PackFile_Debug *
2498 Parrot_new_debug_seg(PARROT_INTERP, ARGMOD(PackFile_ByteCode *cs), size_t size)
2499 {
2500 PackFile_Debug *debug;
2501
2502 if (cs->debugs) { /* it exists already, resize it */
2503 debug = cs->debugs;
2504 mem_realloc_n_typed(debug->base.data, size, opcode_t);
2505 }
2506 else { /* create one */
2507 const size_t len = strlen(cs->base.name) + 4;
2508 char * const name = (char *)mem_sys_allocate(len);
2509 const int add = (interp->code && interp->code->base.dir);
2510 PackFile_Directory * const dir =
2511 add
2512 ? interp->code->base.dir
2513 : cs->base.dir
2514 ? cs->base.dir
2515 : &interp->initial_pf->directory;
2516
2517 snprintf(name, len, "%s_DB", cs->base.name);
2518 debug = (PackFile_Debug *)PackFile_Segment_new_seg(interp, dir, PF_DEBUG_SEG, name, add);
2519 mem_sys_free(name);
2520
2521 debug->base.data = mem_allocate_n_zeroed_typed(size, opcode_t);
2522 debug->code = cs;
2523 cs->debugs = debug;
2524 }
2525 debug->base.size = size;
2526 return debug;
2527 }
2528
2529 /*
2530
2531 =item C<void Parrot_debug_add_mapping>
2532
2533 Add a bytecode offset to filename/source segment mapping. mapping_type may be
2534 one of PF_DEBUGMAPPINGTYPE_NONE (in which case the last two parameters are
2535 ignored), PF_DEBUGMAPPINGTYPE_FILENAME (in which case filename must be given)
2536 or PF_DEBUGMAPPINGTYPE_SOURCESEG (in which case source_seg should contains the
2537 number of the source segment in question).
2538
2539 =cut
2540
2541 */
2542
2543 PARROT_API
2544 void
2545 Parrot_debug_add_mapping(PARROT_INTERP, ARGMOD(PackFile_Debug *debug),
2546 opcode_t offset, int mapping_type,
2547 ARGIN(const char *filename), int source_seg)
2548 {
2549 PackFile_DebugMapping *mapping;
2550 PackFile_ConstTable * const ct = debug->code->const_table;
2551 int insert_pos = 0;
2552
2553 /* Allocate space for the extra entry. */
2554 mem_realloc_n_typed(debug->mappings, debug->num_mappings+1, PackFile_DebugMapping *);
2555
2556 /* Can it just go on the end? */
2557 if (debug->num_mappings == 0 ||
2558 offset >= debug->mappings[debug->num_mappings - 1]->offset)
2559 {
2560 insert_pos = debug->num_mappings;
2561 }
2562 else {
2563 /* Find the right place and shift stuff that's after it. */
2564 int i;
2565 for (i = 0; i < debug->num_mappings; i++) {
2566 if (debug->mappings[i]->offset > offset) {
2567 insert_pos = i;
2568 memmove(debug->mappings + i + 1, debug->mappings + i,
2569 debug->num_mappings - i);
2570 break;
2571 }
2572 }
2573 }
2574
2575 /* Set up new entry and insert it. */
2576 mapping = mem_allocate_typed(PackFile_DebugMapping);
2577 mapping->offset = offset;
2578 mapping->mapping_type = mapping_type;
2579
2580 switch (mapping_type) {
2581 case PF_DEBUGMAPPINGTYPE_FILENAME:
2582 {
2583 PackFile_Constant *fnconst;
2584
2585 /* Need to put filename in constants table. */
2586 ct->const_count = ct->const_count + 1;
2587 mem_realloc_n_typed(ct->constants, ct->const_count, PackFile_Constant *);
2588 fnconst = PackFile_Constant_new(interp);
2589 fnconst->type = PFC_STRING;
2590 fnconst->u.string = string_make_direct(interp, filename,
2591 strlen(filename), PARROT_DEFAULT_ENCODING,
2592 PARROT_DEFAULT_CHARSET, PObj_constant_FLAG);
2593 ct->constants[ct->const_count - 1] = fnconst;
2594 mapping->u.filename = ct->const_count - 1;
2595 }
2596 break;
2597 case PF_DEBUGMAPPINGTYPE_SOURCESEG:
2598 mapping->u.source_seg = source_seg;
2599 break;
2600 case PF_DEBUGMAPPINGTYPE_NONE:
2601 default:
2602 break;
2603 }
2604
2605 debug->mappings[insert_pos] = mapping;
2606 debug->num_mappings = debug->num_mappings + 1;
2607 }
2608
2609 /*
2610
2611 =item C<STRING * Parrot_debug_pc_to_filename>
2612
2613 Take a position in the bytecode and return the filename of the source for
2614 that position.
2615
2616 =cut
2617
2618 */
2619
2620 PARROT_API
2621 PARROT_WARN_UNUSED_RESULT
2622 PARROT_CANNOT_RETURN_NULL
2623 STRING *
2624 Parrot_debug_pc_to_filename(PARROT_INTERP, ARGIN(const PackFile_Debug *debug), opcode_t pc)
2625 {
2626 /* Look through mappings until we find one that maps the passed
2627 bytecode offset. */
2628 int i;
2629 for (i = 0; i < debug->num_mappings; i++) {
2630 /* If this is the last mapping or the current position is
2631 between this mapping and the next one, return a filename. */
2632 if (i + 1 == debug->num_mappings ||
2633 (debug->mappings[i]->offset <= pc &&
2634 debug->mappings[i+1]->offset > pc))
2635 {
2636 switch (debug->mappings[i]->mapping_type) {
2637 case PF_DEBUGMAPPINGTYPE_NONE:
2638 return CONST_STRING(interp, "(unknown file)");
2639 case PF_DEBUGMAPPINGTYPE_FILENAME:
2640 return PF_CONST(debug->code,
2641 debug->mappings[i]->u.filename)->u.string;
2642 case PF_DEBUGMAPPINGTYPE_SOURCESEG:
2643 return CONST_STRING(interp, "(unknown file)");
2644 default:
2645 continue;
2646 }
2647 }
2648 }
2649
2650 /* Otherwise, no mappings = no filename. */
2651 return CONST_STRING(interp, "(unknown file)");
2652 }
2653
2654 /*
2655
2656 =item C<void Parrot_switch_to_cs_by_nr>
2657
2658 Switch to byte code segment number C<seg>.
2659
2660 =cut
2661
2662 */
2663
2664 PARROT_API
2665 void
2666 Parrot_switch_to_cs_by_nr(PARROT_INTERP, opcode_t seg)
2667 {
2668 const PackFile_Directory * const dir = interp->code->base.dir;
2669 const size_t num_segs = dir->num_segments;
2670 size_t i;
2671 opcode_t n;
2672
2673 /* TODO make an index of code segments for faster look up */
2674 for (i = n = 0; i < num_segs; i++) {
2675 if (dir->segments[i]->type == PF_BYTEC_SEG) {
2676 if (n == seg) {
2677 Parrot_switch_to_cs(interp, (PackFile_ByteCode *)
2678 dir->segments[i], 1);
2679 return;
2680 }
2681 n++;
2682 }
2683 }
2684
2685 Parrot_ex_throw_from_c_args(interp, NULL, 1, "Segment number %d not found\n",
2686 (int) seg);
2687 }
2688
2689 /*
2690
2691 =item C<PackFile_ByteCode * Parrot_switch_to_cs>
2692
2693 Switch to a byte code segment C<new_cs>, returning the old segment.
2694
2695 =cut
2696
2697 */
2698
2699 PARROT_API
2700 PARROT_IGNORABLE_RESULT
2701 PARROT_CANNOT_RETURN_NULL
2702 PackFile_ByteCode *
2703 Parrot_switch_to_cs(PARROT_INTERP, ARGIN(PackFile_ByteCode *new_cs), int really)
2704 {
2705 PackFile_ByteCode * const cur_cs = interp->code;
2706
2707 if (!new_cs)
2708 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NO_PREV_CS,
2709 "No code segment to switch to\n");
2710
2711 /* compiling source code uses this function too,
2712 * which gives misleading trace messages
2713 */
2714 if (really && Interp_trace_TEST(interp, PARROT_TRACE_SUB_CALL_FLAG)) {
2715 Interp * const tracer = interp->debugger ?
2716 interp->debugger : interp;
2717 PIO_eprintf(tracer, "*** switching to %s\n",
2718 new_cs->base.name);
2719 }
2720 interp->code = new_cs;
2721 CONTEXT(interp)->constants =
2722 really ? find_constants(interp, new_cs->const_table) :
2723 new_cs->const_table->constants;
2724 /* new_cs->const_table->constants; */
2725 CONTEXT(interp)->pred_offset =
2726 new_cs->base.data - (opcode_t*) new_cs->prederef.code;
2727 if (really)
2728 prepare_for_run(interp);
2729 return cur_cs;
2730 }
2731
2732 /*
2733
2734 =item C<static PackFile_Constant * clone_constant>
2735
2736 RT#48260: Not yet documented!!!
2737
2738 =cut
2739
2740 */
2741
2742 PARROT_WARN_UNUSED_RESULT
2743 PARROT_CANNOT_RETURN_NULL
2744 static PackFile_Constant *
2745 clone_constant(PARROT_INTERP, ARGIN(PackFile_Constant *old_const))
2746 {
2747 STRING * const _sub = interp->vtables[enum_class_Sub]->whoami;
2748
2749 if (old_const->type == PFC_PMC
2750 && VTABLE_isa(interp, old_const->u.key, _sub)) {
2751 PMC *old_sub;
2752 PMC *new_sub;
2753 PackFile_Constant * const ret = mem_allocate_typed(PackFile_Constant);
2754
2755 ret->type = old_const->type;
2756
2757 old_sub = old_const->u.key;
2758 new_sub = Parrot_thaw_constants(interp,
2759 Parrot_freeze(interp, old_sub));
2760
2761 PMC_sub(new_sub)->seg = PMC_sub(old_sub)->seg;
2762
2763 /* Vtable overrides and methods were already cloned, so don't reclone them. */
2764 if (PMC_sub(new_sub)->vtable_index == -1
2765 && !(PMC_sub(old_sub)->comp_flags & SUB_COMP_FLAG_METHOD)) {
2766 Parrot_store_sub_in_namespace(interp, new_sub);
2767 }
2768
2769 ret->u.key = new_sub;
2770
2771 return ret;
2772 }
2773 else {
2774 return old_const;
2775 }
2776 }
2777
2778 /*
2779
2780 =item C<static PackFile_Constant ** find_constants>
2781
2782 Find the constant table associated with a thread. For now, we need to copy
2783 constant tables because some entries aren't really constant; e.g.
2784 subroutines need to reference namespace pointers.
2785
2786 =cut
2787
2788 */
2789
2790 PARROT_WARN_UNUSED_RESULT
2791 PARROT_CANNOT_RETURN_NULL
2792 static PackFile_Constant **
2793 find_constants(PARROT_INTERP, ARGIN(PackFile_ConstTable *ct))
2794 {
2795 if (!n_interpreters || !interp->thread_data ||
2796 interp->thread_data->tid == 0) {
2797 return ct->constants;
2798 }
2799 else {
2800 Hash *tables;
2801 PackFile_Constant **new_consts;
2802
2803 PARROT_ASSERT(interp->thread_data);
2804
2805 if (!interp->thread_data->const_tables) {
2806 interp->thread_data->const_tables = mem_allocate_typed(Hash);
2807 parrot_new_pointer_hash(interp,
2808 &interp->thread_data->const_tables);
2809 }
2810
2811 tables = interp->thread_data->const_tables;
2812 new_consts = (PackFile_Constant **)parrot_hash_get(interp, tables, ct);
2813
2814 if (!new_consts) {
2815 /* need to construct it */
2816 INTVAL const num_consts = ct->const_count;
2817 PackFile_Constant ** const old_consts = ct->constants;
2818 INTVAL i;
2819
2820 new_consts = (PackFile_Constant **)mem_sys_allocate(
2821 sizeof (PackFile_Constant *) * num_consts);
2822
2823 for (i = 0; i < num_consts; ++i) {
2824 new_consts[i] = clone_constant(interp, old_consts[i]);
2825 }
2826
2827 parrot_hash_put(interp, tables, ct, new_consts);
2828 }
2829
2830 return new_consts;
2831 }
2832 }
2833
2834 /*
2835
2836 =item C<void Parrot_destroy_constants>
2837
2838 RT#48260: Not yet documented!!!
2839
2840 =cut
2841
2842 */
2843
2844 PARROT_API
2845 void
2846 Parrot_destroy_constants(PARROT_INTERP)
2847 {
2848 UINTVAL i;
2849 Hash *hash;
2850 if (!interp->thread_data) {
2851 return;
2852 }
2853
2854 hash = interp->thread_data->const_tables;
2855
2856 if (!hash) {
2857 return;
2858 }
2859
2860 for (i = 0; i <= hash->mask; ++i) {
2861 HashBucket *bucket = hash->bi[i];
2862 while (bucket) {
2863 PackFile_ConstTable * const table =
2864 (PackFile_ConstTable *)bucket->key;
2865 PackFile_Constant ** const orig_consts = table->constants;
2866 PackFile_Constant ** const consts =
2867 (PackFile_Constant **) bucket->value;
2868 INTVAL const const_count = table->const_count;
2869 INTVAL i;
2870
2871 for (i = 0; i < const_count; ++i) {
2872 if (consts[i] != orig_consts[i]) {
2873 mem_sys_free(consts[i]);
2874 }
2875 }
2876 mem_sys_free(consts);
2877 bucket = bucket->next;
2878 }
2879 }
2880
2881 parrot_hash_destroy(interp, hash);
2882 }
2883
2884 /*
2885
2886 =back
2887
2888 =head2 PackFile FixupTable Structure Functions
2889
2890 =over 4
2891
2892 =item C<void PackFile_FixupTable_clear>
2893
2894 Clear a PackFile FixupTable.
2895
2896 =cut
2897
2898 */
2899
2900 PARROT_API
2901 void
2902 PackFile_FixupTable_clear(PARROT_INTERP, ARGMOD(PackFile_FixupTable *self))
2903 {
2904 opcode_t i;
2905 if (!self) {
2906 PIO_eprintf(interp, "PackFile_FixupTable_clear: self == NULL!\n");
2907 return;
2908 }
2909
2910 for (i = 0; i < self->fixup_count; i++) {
2911 mem_sys_free(self->fixups[i]->name);
2912 self->fixups[i]->name = NULL;
2913 mem_sys_free(self->fixups[i]);
2914 self->fixups[i] = NULL;
2915 }
2916
2917 if (self->fixup_count) {
2918 mem_sys_free(self->fixups);
2919 self->fixups = NULL;
2920 }
2921
2922 self->fixups = NULL;
2923 self->fixup_count = 0;
2924
2925 return;
2926 }
2927
2928 /*
2929
2930 =item C<static void fixup_destroy>
2931
2932 Just calls C<PackFile_FixupTable_clear()> with C<self>.
2933
2934 =cut
2935
2936 */
2937
2938 static void
2939 fixup_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
2940 {
2941 PackFile_FixupTable * const ft = (PackFile_FixupTable *)self;
2942 PackFile_FixupTable_clear(interp, ft);
2943 }
2944
2945 /*
2946
2947 =item C<static size_t fixup_packed_size>
2948
2949 I<What does this do?>
2950
2951 RT#48260: Not yet documented!!!
2952
2953 =cut
2954
2955 */
2956
2957 static size_t
2958 fixup_packed_size(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
2959 {
2960 PackFile_FixupTable * const ft = (PackFile_FixupTable *)self;
2961 size_t size;
2962 opcode_t i;
2963
2964 size = 1; /* fixup_count */
2965 for (i = 0; i < ft->fixup_count; i++) {
2966 size++; /* fixup_entry type */
2967 switch (ft->fixups[i]->type) {
2968 case enum_fixup_label:
2969 case enum_fixup_sub:
2970 size += PF_size_cstring(ft->fixups[i]->name);
2971 size ++; /* offset */
2972 break;
2973 case enum_fixup_none:
2974 break;
2975 default:
2976 Parrot_ex_throw_from_c_args(interp, NULL, 1, "Unknown fixup type\n");
2977 }
2978 }
2979 return size;
2980 }
2981
2982 /*
2983
2984 =item C<static opcode_t * fixup_pack>
2985
2986 I<What does this do?>
2987
2988 RT#48260: Not yet documented!!!
2989
2990 =cut
2991
2992 */
2993
2994 PARROT_WARN_UNUSED_RESULT
2995 PARROT_CANNOT_RETURN_NULL
2996 static opcode_t *
2997 fixup_pack(PARROT_INTERP, ARGIN(PackFile_Segment *self), ARGOUT(opcode_t *cursor))
2998 {
2999 PackFile_FixupTable * const ft = (PackFile_FixupTable *)self;
3000 opcode_t i;
3001
3002 *cursor++ = ft->fixup_count;
3003 for (i = 0; i < ft->fixup_count; i++) {
3004 *cursor++ = (opcode_t) ft->fixups[i]->type;
3005 switch (ft->fixups[i]->type) {
3006 case enum_fixup_label:
3007 case enum_fixup_sub:
3008 cursor = PF_store_cstring(cursor, ft->fixups[i]->name);
3009 *cursor++ = ft->fixups[i]->offset;
3010 break;
3011 case enum_fixup_none:
3012 break;
3013 default:
3014 Parrot_ex_throw_from_c_args(interp, NULL, 1, "Unknown fixup type\n");
3015 }
3016 }
3017 return cursor;
3018 }
3019
3020 /*
3021
3022 =item C<static PackFile_Segment * fixup_new>
3023
3024 Returns a new C<PackFile_FixupTable> segment.
3025
3026 =cut
3027
3028 */
3029
3030 PARROT_WARN_UNUSED_RESULT
3031 PARROT_CANNOT_RETURN_NULL
3032 static PackFile_Segment *
3033 fixup_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(const char *name), SHIM(int add))
3034 {
3035 PackFile_FixupTable * const fixup = mem_allocate_zeroed_typed(PackFile_FixupTable);
3036
3037 return (PackFile_Segment *) fixup;
3038 }
3039
3040 /*
3041
3042 =item C<static const opcode_t * fixup_unpack>
3043
3044 Unpack a PackFile FixupTable from a block of memory.
3045
3046 Returns one (1) if everything is OK, else zero (0).
3047
3048 =cut
3049
3050 */
3051
3052 PARROT_WARN_UNUSED_RESULT
3053 PARROT_CAN_RETURN_NULL
3054 static const opcode_t *
3055 fixup_unpack(PARROT_INTERP, ARGIN(PackFile_Segment *seg), ARGIN(const opcode_t *cursor))
3056 {
3057 opcode_t i;
3058 PackFile *pf;
3059 PackFile_FixupTable * const self = (PackFile_FixupTable *)seg;
3060
3061 if (!self) {
3062 PIO_eprintf(interp, "PackFile_FixupTable_unpack: self == NULL!\n");
3063 return NULL;
3064 }
3065
3066 PackFile_FixupTable_clear(interp, self);
3067
3068 pf = self->base.pf;
3069 self->fixup_count = PF_fetch_opcode(pf, &cursor);
3070
3071 if (self->fixup_count) {
3072 self->fixups = (PackFile_FixupEntry **)mem_sys_allocate_zeroed(
3073 self->fixup_count * sizeof (PackFile_FixupEntry *));
3074
3075 if (!self->fixups) {
3076 PIO_eprintf(interp,
3077 "PackFile_FixupTable_unpack: Could not allocate "
3078 "memory for array!\n");
3079 self->fixup_count = 0;
3080 return NULL;
3081 }
3082 }
3083
3084 for (i = 0; i < self->fixup_count; i++) {
3085 PackFile_FixupEntry * const entry =
3086 self->fixups[i] =
3087 mem_allocate_typed(PackFile_FixupEntry);
3088 entry->type = PF_fetch_opcode(pf, &cursor);
3089 switch (entry->type) {
3090 case enum_fixup_label:
3091 case enum_fixup_sub:
3092 entry->name = PF_fetch_cstring(pf, &cursor);
3093 entry->offset = PF_fetch_opcode(pf, &cursor);
3094 break;
3095 case enum_fixup_none:
3096 break;
3097 default:
3098 PIO_eprintf(interp,
3099 "PackFile_FixupTable_unpack: Unknown fixup type %d!\n",
3100 entry->type);
3101 return NULL;
3102 }
3103 }
3104
3105 return cursor;
3106 }
3107
3108 /*
3109
3110 =item C<void PackFile_FixupTable_new_entry>
3111
3112 I<What does this do?>
3113
3114 RT#48260: Not yet documented!!!
3115
3116 =cut
3117
3118 */
3119
3120 PARROT_API
3121 void
3122 PackFile_FixupTable_new_entry(PARROT_INTERP,
3123 ARGIN(const char *label), INTVAL type, opcode_t offs)
3124 {
3125 PackFile_FixupTable *self = interp->code->fixups;
3126 opcode_t i;
3127
3128 if (!self) {
3129 self = (PackFile_FixupTable *) PackFile_Segment_new_seg(
3130 interp,
3131 interp->code->base.dir, PF_FIXUP_SEG,
3132 FIXUP_TABLE_SEGMENT_NAME, 1);
3133 interp->code->fixups = self;
3134 self->code = interp->code;
3135 }
3136 i = self->fixup_count++;
3137 mem_realloc_n_typed(self->fixups, self->fixup_count, PackFile_FixupEntry *);
3138
3139 self->fixups[i] = mem_allocate_typed(PackFile_FixupEntry);
3140 self->fixups[i]->type = type;
3141 self->fixups[i]->name = str_dup(label);
3142 self->fixups[i]->offset = offs;
3143 self->fixups[i]->seg = self->code;
3144 }
3145
3146 /*
3147
3148 =item C<static PackFile_FixupEntry * find_fixup>
3149
3150 Finds the fix-up entry for C<name> and returns it.
3151
3152 =cut
3153
3154 */
3155
3156 PARROT_WARN_UNUSED_RESULT
3157 PARROT_CAN_RETURN_NULL
3158 static PackFile_FixupEntry *
3159 find_fixup(ARGMOD(PackFile_FixupTable *ft), INTVAL type, ARGIN(const char *name))
3160 {
3161 opcode_t i;
3162 for (i = 0; i < ft->fixup_count; i++) {
3163 if ((INTVAL)((enum_fixup_t)ft->fixups[i]->type) == type &&
3164 STREQ(ft->fixups[i]->name, name)) {
3165 ft->fixups[i]->seg = ft->code;
3166 return ft->fixups[i];
3167 }
3168 }
3169 return NULL;
3170 }
3171
3172 /*
3173
3174 =item C<static INTVAL find_fixup_iter>
3175
3176 I<What does this do?>
3177
3178 RT#48260: Not yet documented!!!
3179
3180 =cut
3181
3182 */
3183
3184 static INTVAL
3185 find_fixup_iter(PARROT_INTERP, ARGIN(PackFile_Segment *seg), ARGIN(void *user_data))
3186 {
3187 if (seg->type == PF_DIR_SEG) {
3188 if (PackFile_map_segments(interp, (PackFile_Directory *)seg,
3189 find_fixup_iter, user_data))
3190 return 1;
3191 }
3192 else if (seg->type == PF_FIXUP_SEG) {
3193 PackFile_FixupEntry ** const e = (PackFile_FixupEntry **)user_data;
3194 PackFile_FixupEntry * const fe = (PackFile_FixupEntry *)find_fixup(
3195 (PackFile_FixupTable *) seg, (*e)->type, (*e)->name);
3196 if (fe) {
3197 *e = fe;
3198 return 1;
3199 }
3200 }
3201 return 0;
3202 }
3203
3204 /*
3205
3206 =item C<PackFile_FixupEntry * PackFile_find_fixup_entry>
3207
3208 I<What does this do?>
3209
3210 RT#48260: Not yet documented!!!
3211
3212 =cut
3213
3214 */
3215
3216 PARROT_API
3217 PARROT_WARN_UNUSED_RESULT
3218 PARROT_CAN_RETURN_NULL
3219 PackFile_FixupEntry *
3220 PackFile_find_fixup_entry(PARROT_INTERP, INTVAL type, ARGIN(char *name))
3221 {
3222 /* TODO make a hash of all fixups */
3223 PackFile_Directory * const dir = interp->code->base.dir;
3224 PackFile_FixupEntry * const ep = mem_allocate_typed(PackFile_FixupEntry);
3225 int found;
3226
3227 ep->type = type;
3228 ep->name = name;
3229 found = PackFile_map_segments(interp, dir, find_fixup_iter, (void *) ep);
3230 return found ? ep : NULL;
3231 }
3232
3233 /*
3234
3235 =back
3236
3237 =head2 PackFile ConstTable Structure Functions
3238
3239 =over 4
3240
3241 =item C<void PackFile_ConstTable_clear>
3242
3243 Clear the C<PackFile_ConstTable> C<self>.
3244
3245 =cut
3246
3247 */
3248
3249 PARROT_API
3250 void
3251 PackFile_ConstTable_clear(PARROT_INTERP, ARGMOD(PackFile_ConstTable *self))
3252 {
3253 opcode_t i;
3254
3255 for (i = 0; i < self->const_count; i++) {
3256 PackFile_Constant_destroy(interp, self->constants[i]);
3257 self->constants[i] = NULL;
3258 }
3259
3260 if (self->constants) {
3261 mem_sys_free(self->constants);
3262 self->constants = NULL;
3263 }
3264
3265 self->const_count = 0;
3266
3267 return;
3268 }
3269
3270 #if EXEC_CAPABLE
3271 PackFile_Constant *exec_const_table;
3272 #endif
3273
3274 /*
3275
3276 =item C<const opcode_t * PackFile_ConstTable_unpack>
3277
3278 Unpack a PackFile ConstTable from a block of memory. The format is:
3279
3280 opcode_t const_count
3281 * constants
3282
3283 Returns cursor if everything is OK, else zero (0).
3284
3285 =cut
3286
3287 */
3288
3289 PARROT_API
3290 PARROT_WARN_UNUSED_RESULT
3291 PARROT_CAN_RETURN_NULL
3292 const opcode_t *
3293 PackFile_ConstTable_unpack(PARROT_INTERP, ARGOUT(PackFile_Segment *seg),
3294 ARGIN(const opcode_t *cursor))
3295 {
3296 opcode_t i;
3297 PackFile_ConstTable * const self = (PackFile_ConstTable *)seg;
3298 PackFile * const pf = seg->pf;
3299
3300 PackFile_ConstTable_clear(interp, self);
3301
3302 self->const_count = PF_fetch_opcode(pf, &cursor);
3303
3304 #if TRACE_PACKFILE
3305 PIO_eprintf(interp,
3306 "PackFile_ConstTable_unpack: Unpacking %ld constants\n",
3307 self->const_count);
3308 #endif
3309
3310 if (self->const_count == 0) {
3311 return cursor;
3312 }
3313
3314 self->constants = (PackFile_Constant **)mem_sys_allocate_zeroed(
3315 self->const_count * sizeof (PackFile_Constant *));
3316
3317 if (!self->constants) {
3318 PIO_eprintf(interp,
3319 "PackFile_ConstTable_unpack: Could not allocate "
3320 "memory for array!\n");
3321 self->const_count = 0;
3322 return NULL;
3323 }
3324
3325 for (i = 0; i < self->const_count; i++) {
3326 #if TRACE_PACKFILE
3327 PIO_eprintf(interp,
3328 "PackFile_ConstTable_unpack(): Unpacking constant %ld\n", i);
3329 #endif
3330
3331 #if EXEC_CAPABLE
3332 if (Parrot_exec_run)
3333 self->constants[i] = &exec_const_table[i];
3334 else
3335 #endif
3336 self->constants[i] = PackFile_Constant_new(interp);
3337
3338 cursor = PackFile_Constant_unpack(interp, self, self->constants[i],
3339 cursor);
3340 }
3341 return cursor;
3342 }
3343
3344 /*
3345
3346 =item C<static PackFile_Segment * const_new>
3347
3348 Returns a new C<PackFile_ConstTable> segment.
3349
3350 =cut
3351
3352 */
3353
3354 PARROT_MALLOC
3355 PARROT_CANNOT_RETURN_NULL
3356 static PackFile_Segment *
3357 const_new(SHIM_INTERP, SHIM(PackFile *pf), SHIM(const char *name), SHIM(int add))
3358 {
3359 PackFile_ConstTable * const const_table = mem_allocate_zeroed_typed(PackFile_ConstTable);
3360
3361 return (PackFile_Segment *)const_table;
3362 }
3363
3364 /*
3365
3366 =item C<static void const_destroy>
3367
3368 Destroys the C<PackFile_ConstTable> C<self>.
3369
3370 =cut
3371
3372 */
3373
3374 static void
3375 const_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
3376 {
3377 PackFile_ConstTable * const ct = (PackFile_ConstTable *)self;
3378
3379 PackFile_ConstTable_clear(interp, ct);
3380 }
3381
3382 /*
3383
3384 =back
3385
3386 =head2 PackFile Constant Structure Functions
3387
3388 =over 4
3389
3390 =item C<PackFile_Constant * PackFile_Constant_new>
3391
3392 Allocate a new empty PackFile Constant.
3393
3394 This is only here so we can make a new one and then do an unpack.
3395
3396 =cut
3397
3398 */
3399
3400 PARROT_API
3401 PARROT_MALLOC
3402 PARROT_CANNOT_RETURN_NULL
3403 PackFile_Constant *
3404 PackFile_Constant_new(SHIM_INTERP)
3405 {
3406 PackFile_Constant * const self =
3407 mem_allocate_zeroed_typed(PackFile_Constant);
3408
3409 self->type = PFC_NONE;
3410
3411 return self;
3412 }
3413
3414 /*
3415
3416 =item C<void PackFile_Constant_destroy>
3417
3418 Delete the C<PackFile_Constant> C<self>.
3419
3420 Don't delete C<PMC>s or C<STRING>s, they are destroyed via DOD/GC.
3421
3422 =cut
3423
3424 */
3425
3426 PARROT_API
3427 void
3428 PackFile_Constant_destroy(SHIM_INTERP, ARGMOD_NULLOK(PackFile_Constant *self))
3429 {
3430 mem_sys_free(self);
3431 }
3432
3433 /*
3434
3435 =item C<size_t PackFile_Constant_pack_size>
3436
3437 Determine the size of the buffer needed in order to pack the PackFile
3438 Constant into a contiguous region of memory.
3439
3440 =cut
3441
3442 */
3443
3444 PARROT_API
3445 PARROT_WARN_UNUSED_RESULT
3446 size_t
3447 PackFile_Constant_pack_size(PARROT_INTERP, ARGIN(const PackFile_Constant *self))
3448 {
3449 size_t packed_size;
3450 PMC *component;
3451 STRING *image;
3452
3453 switch (self->type) {
3454
3455 case PFC_NUMBER:
3456 packed_size = PF_size_number();
3457 break;
3458
3459 case PFC_STRING:
3460 packed_size = PF_size_string(self->u.string);
3461 break;
3462
3463 case PFC_KEY:
3464 packed_size = 1;
3465
3466 for (component = self->u.key; component;
3467 component = (PMC *)PMC_data(component))
3468 packed_size += 2;
3469 break;
3470
3471 case PFC_PMC:
3472 component = self->u.key; /* the pmc (Sub, ...) */
3473
3474 /*
3475 * TODO create either
3476 * a) a frozen_size freeze entry or
3477 * b) change packout.c so that component size isn't needed
3478 */
3479 image = Parrot_freeze(interp, component);
3480 packed_size = PF_size_string(image);
3481 break;
3482
3483 default:
3484 PIO_eprintf(NULL,
3485 "Constant_packed_size: Unrecognized type '%c'!\n",
3486 (char)self->type);
3487 return 0;
3488 }
3489
3490 /* Tack on space for the initial type field */
3491 return packed_size + 1;
3492 }
3493
3494 /*
3495
3496 =item C<const opcode_t * PackFile_Constant_unpack>
3497
3498 Unpack a PackFile Constant from a block of memory. The format is:
3499
3500 opcode_t type
3501 * data
3502
3503 Returns cursor if everything is OK, else zero (0).
3504
3505 =cut
3506
3507 */
3508
3509 PARROT_API
3510 PARROT_WARN_UNUSED_RESULT
3511 PARROT_CAN_RETURN_NULL
3512 const opcode_t *
3513 PackFile_Constant_unpack(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt),
3514 ARGOUT(PackFile_Constant *self), ARGIN(const opcode_t *cursor))
3515 {
3516 PackFile * const pf = constt->base.pf;
3517 const opcode_t type = PF_fetch_opcode(pf, &cursor);
3518
3519 /* #define TRACE_PACKFILE 1 */
3520 #if TRACE_PACKFILE
3521 PIO_eprintf(NULL, "PackFile_Constant_unpack(): Type is %ld ('%c')...\n",
3522 type, (char)type);
3523 #endif
3524
3525 switch (type) {
3526 case PFC_NUMBER:
3527 self->u.number = PF_fetch_number(pf, &cursor);
3528 self->type = PFC_NUMBER;
3529 break;
3530
3531 case PFC_STRING:
3532 self->u.string = PF_fetch_string(interp, pf, &cursor);
3533 self->type = PFC_STRING;
3534 break;
3535
3536 case PFC_KEY:
3537 cursor = PackFile_Constant_unpack_key(interp, constt,
3538 self, cursor);
3539 break;
3540
3541 case PFC_PMC:
3542 cursor = PackFile_Constant_unpack_pmc(interp, constt,
3543 self, cursor);
3544 break;
3545 default:
3546 PIO_eprintf(NULL,
3547 "Constant_unpack: Unrecognized type '%c' during unpack!\n",
3548 (char)type);
3549 return NULL;
3550 }
3551 return cursor;
3552 }
3553
3554 /*
3555
3556 =item C<const opcode_t * PackFile_Constant_unpack_pmc>
3557
3558 Unpack a constant PMC.
3559
3560 =cut
3561
3562 */
3563
3564 PARROT_API
3565 PARROT_WARN_UNUSED_RESULT
3566 PARROT_CANNOT_RETURN_NULL
3567 const opcode_t *
3568 PackFile_Constant_unpack_pmc(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt),
3569 ARGMOD(PackFile_Constant *self), ARGIN(const opcode_t *cursor))
3570 {
3571 PackFile * const pf = constt->base.pf;
3572 STRING *image, *_sub;
3573 PMC *pmc;
3574
3575 /*
3576 * thawing the PMC needs the real packfile in place
3577 */
3578 PackFile_ByteCode * const cs_save = interp->code;
3579 interp->code = pf->cur_cs;
3580
3581 image = PF_fetch_string(interp, pf, &cursor);
3582 /*
3583 * TODO use thaw_constants
3584 * current issue: a constant Sub with attached properties
3585 * doesn't DOD mark the properties
3586 * for a constant PMC *all* contents have to be in the constant pools
3587 */
3588 pmc = Parrot_thaw(interp, image);
3589
3590 /* place item in const_table */
3591 self->type = PFC_PMC;
3592 self->u.key = pmc;
3593
3594 _sub = CONST_STRING(interp, "Sub"); /* CONST_STRING */
3595 if (VTABLE_isa(interp, pmc, _sub)) {
3596 /*
3597 * finally place the sub into some namespace stash
3598 * XXX place this code in Sub.thaw ?
3599 */
3600 Parrot_store_sub_in_namespace(interp, pmc);
3601 }
3602 /*
3603 * restore code
3604 */
3605 interp->code = cs_save;
3606 return cursor;
3607 }
3608
3609 /*
3610
3611 =item C<const opcode_t * PackFile_Constant_unpack_key>
3612
3613 Unpack a PackFile Constant from a block of memory. The format consists
3614 of a sequence of key atoms, each with the following format:
3615
3616 opcode_t type
3617 opcode_t value
3618
3619 Returns cursor if everything is OK, else zero (0).
3620
3621 =cut
3622
3623 */
3624
3625 PARROT_API
3626 PARROT_WARN_UNUSED_RESULT
3627 PARROT_CAN_RETURN_NULL
3628 const opcode_t *
3629 PackFile_Constant_unpack_key(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt),
3630 ARGMOD(PackFile_Constant *self), ARGIN(const opcode_t *cursor))
3631 {
3632 PackFile * const pf = constt->base.pf;
3633 int pmc_enum = enum_class_Key;
3634
3635 INTVAL components = (INTVAL)PF_fetch_opcode(pf, &cursor);
3636 PMC *head = NULL;
3637 PMC *tail = NULL;
3638
3639 while (components-- > 0) {
3640 opcode_t type = PF_fetch_opcode(pf, &cursor);
3641 const opcode_t slice_bits = type & PF_VT_SLICE_BITS;
3642 opcode_t op;
3643
3644 type &= ~PF_VT_SLICE_BITS;
3645 if (!head && slice_bits) {
3646 pmc_enum = enum_class_Slice;
3647 }
3648 if (tail) {
3649 PMC_data(tail)
3650 = constant_pmc_new_noinit(interp, pmc_enum);
3651 tail = (PMC *)PMC_data(tail);
3652 }
3653 else {
3654 head = tail = constant_pmc_new_noinit(interp, pmc_enum);
3655 }
3656
3657 VTABLE_init(interp, tail);
3658
3659 op = PF_fetch_opcode(pf, &cursor);
3660 switch (type) {
3661 case PARROT_ARG_IC:
3662 key_set_integer(interp, tail, op);
3663 break;
3664 case PARROT_ARG_NC:
3665 key_set_number(interp, tail, constt->constants[op]->u.number);
3666 break;
3667 case PARROT_ARG_SC:
3668 key_set_string(interp, tail, constt->constants[op]->u.string);
3669 break;
3670 case PARROT_ARG_I:
3671 key_set_register(interp, tail, op, KEY_integer_FLAG);
3672 break;
3673 case PARROT_ARG_N:
3674 key_set_register(interp, tail, op, KEY_number_FLAG);
3675 break;
3676 case PARROT_ARG_S:
3677 key_set_register(interp, tail, op, KEY_string_FLAG);
3678 break;
3679 case PARROT_ARG_P:
3680 key_set_register(interp, tail, op, KEY_pmc_FLAG);
3681 break;
3682 default:
3683 return NULL;
3684 }
3685 if (slice_bits) {
3686 if (slice_bits & PF_VT_START_SLICE)
3687 PObj_get_FLAGS(tail) |= KEY_start_slice_FLAG;
3688 if (slice_bits & PF_VT_END_SLICE)
3689 PObj_get_FLAGS(tail) |= KEY_end_slice_FLAG;
3690 if (slice_bits & (PF_VT_START_ZERO | PF_VT_END_INF))
3691 PObj_get_FLAGS(tail) |= KEY_inf_slice_FLAG;
3692 }
3693 }
3694
3695 self->type = PFC_KEY;
3696 self->u.key = head;
3697
3698 return cursor;
3699 }
3700
3701 /*
3702
3703 =item C<static PackFile * PackFile_append_pbc>
3704
3705 Read a PBC and append it to the current directory
3706 Fixup sub addresses in newly loaded bytecode and run :load subs.
3707
3708 =cut
3709
3710 */
3711
3712 PARROT_WARN_UNUSED_RESULT
3713 PARROT_CAN_RETURN_NULL
3714 static PackFile *
3715 PackFile_append_pbc(PARROT_INTERP, ARGIN_NULLOK(const char *filename))
3716 {
3717 PackFile * const pf = Parrot_readbc(interp, filename);
3718 if (!pf)
3719 return NULL;
3720 PackFile_add_segment(interp, &interp->initial_pf->directory,
3721 &pf->directory.base);
3722 do_sub_pragmas(interp, pf->cur_cs, PBC_LOADED, NULL);
3723 return pf;
3724 }
3725
3726 /*
3727
3728 =item C<void Parrot_load_bytecode>
3729
3730 Load and append a bytecode, IMC or PASM file into interpreter.
3731
3732 Load some bytecode (PASM, PIR, PBC ...) and append it to the current
3733 directory.
3734
3735 =cut
3736
3737 */
3738
3739 /*
3740 * intermediate hook during changes
3741 */
3742
3743 PARROT_API
3744 void
3745 Parrot_load_bytecode(PARROT_INTERP, ARGIN_NULLOK(STRING *file_str))
3746 {
3747 char *filename;
3748 STRING *wo_ext, *ext, *pbc, *path;
3749 enum_runtime_ft file_type;
3750 PMC *is_loaded_hash;
3751
3752 if (STRING_IS_NULL(file_str))
3753 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
3754 "\"load_bytecode\" no file name");
3755
3756 parrot_split_path_ext(interp, file_str, &wo_ext, &ext);
3757 /* check if wo_ext is loaded */
3758 is_loaded_hash = VTABLE_get_pmc_keyed_int(interp,
3759 interp->iglobals, IGLOBALS_PBC_LIBS);
3760 if (VTABLE_exists_keyed_str(interp, is_loaded_hash, wo_ext))
3761 return;
3762 pbc = CONST_STRING(interp, "pbc");
3763 if (string_equal(interp, ext, pbc) == 0)
3764 file_type = PARROT_RUNTIME_FT_PBC;
3765 else
3766 file_type = PARROT_RUNTIME_FT_SOURCE;
3767
3768 path = Parrot_locate_runtime_file_str(interp, file_str, file_type);
3769 if (!path)
3770 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
3771 "\"load_bytecode\" couldn't find file '%Ss'", file_str);
3772
3773 /* remember wo_ext => full_path mapping */
3774 VTABLE_set_string_keyed_str(interp, is_loaded_hash,
3775 wo_ext, path);
3776 filename = string_to_cstring(interp, path);
3777 if (file_type == PARROT_RUNTIME_FT_PBC) {
3778 PackFile *pf = PackFile_append_pbc(interp, filename);
3779 string_cstring_free(filename);
3780
3781 if (!pf)
3782 Parrot_ex_throw_from_c_args(interp, NULL, 1,
3783 "Unable to append PBC to the current directory");
3784 }
3785 else {
3786 STRING *err;
3787 PackFile_ByteCode * const cs =
3788 (PackFile_ByteCode *)IMCC_compile_file_s(interp,
3789 filename, &err);
3790 string_cstring_free(filename);
3791
3792 if (cs)
3793 do_sub_pragmas(interp, cs, PBC_LOADED, NULL);
3794 else
3795 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
3796 "compiler returned NULL ByteCode '%Ss' - %Ss", file_str, err);
3797 }
3798 }
3799
3800 /*
3801
3802 =item C<void PackFile_fixup_subs>
3803
3804 Run :load or :immediate subroutines for the current code segment.
3805 If C<eval> is given, set this is the owner of the subroutines.
3806
3807 =cut
3808
3809 */
3810
3811 PARROT_API
3812 void
3813 PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, ARGIN_NULLOK(PMC *eval))
3814 {
3815 do_sub_pragmas(interp, interp->code, what, eval);
3816 }
3817
3818 /*
3819
3820 =back
3821
3822 =head1 HISTORY
3823
3824 Rework by Melvin; new bytecode format, make bytecode portable. (Do
3825 endian conversion and wordsize transforms on the fly.)
3826
3827 leo applied and modified Juergen Boemmels packfile patch giving an
3828 extensible packfile format with directory reworked again, with common
3829 chunks (C<default_*>).
3830
3831 2003.11.21 leo: moved low level item fetch routines to new
3832 F<pf/pf_items.c>
3833
3834 =cut
3835
3836 */
3837
3838
3839 /*
3840 * Local variables:
3841 * c-file-style: "parrot"
3842 * End:
3843 * vim: expandtab shiftwidth=4:
3844 */
parrot vm git mirror