1 /*
2 Copyright (C) 2001-2015, Parrot Foundation.
3 This program is free software. It is subject to the same license as
4 Parrot itself.
5
6 =head1 NAME
7
8 src/packfile.c - Parrot PackFile API
9
10 =head1 DESCRIPTION
11
12 This file represents the public API for the packfile subsystem. It provides
13 several routines for working with PackFile* structures, and various
14 packfile-related PMC types. Any PMC type for which VTABLE_get_pointer returns
15 a PackFile* structure, and VTABLE_set_pointer takes a PackFile* can be used
16 with this system to represent a PackFile*.
17
18 See F<docs/pdds/pdd13_bytecode.pod> for details about the subsystem and the
19 format of bytecode.
20
21 =head2 PackFile Manipulation Functions
22
23 =over 4
24
25 =cut
26
27 */
28
29 #include "pf_private.h"
30 #include "api.str"
31 #include "pmc/pmc_sub.h"
32 #include "pmc/pmc_packfileview.h"
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 PARROT_DEPRECATED
40 static void compile_file(PARROT_INTERP, ARGIN(STRING *path), INTVAL is_pasm)
41 __attribute__nonnull__(1)
42 __attribute__nonnull__(2);
43
44 PARROT_WARN_UNUSED_RESULT
45 PARROT_CANNOT_RETURN_NULL
46 static PackFile_Segment * create_seg(PARROT_INTERP,
47 ARGMOD(PackFile_Directory *dir),
48 pack_file_types t,
49 ARGIN(STRING *name),
50 ARGIN(STRING *file_name),
51 int add)
52 __attribute__nonnull__(1)
53 __attribute__nonnull__(2)
54 __attribute__nonnull__(4)
55 __attribute__nonnull__(5)
56 FUNC_MODIFIES(*dir);
57
58 PARROT_WARN_UNUSED_RESULT
59 PARROT_CAN_RETURN_NULL
60 static PMC* do_1_sub_pragma(PARROT_INTERP,
61 ARGMOD(PMC *sub_pmc),
62 pbc_action_enum_t action)
63 __attribute__nonnull__(1)
64 __attribute__nonnull__(2)
65 FUNC_MODIFIES(*sub_pmc);
66
67 static INTVAL find_const_iter(PARROT_INTERP,
68 ARGMOD(PackFile_Segment *seg),
69 ARGIN_NULLOK(void *user_data))
70 __attribute__nonnull__(1)
71 __attribute__nonnull__(2)
72 FUNC_MODIFIES(*seg);
73
74 PARROT_PURE_FUNCTION
75 PARROT_WARN_UNUSED_RESULT
76 static INTVAL find_pf_ann_idx(
77 ARGIN(PackFile_Annotations *pfa),
78 ARGIN(PackFile_Annotations_Key *key),
79 UINTVAL offs)
80 __attribute__nonnull__(1)
81 __attribute__nonnull__(2);
82
83 static void load_file(PARROT_INTERP, ARGIN(STRING *path))
84 __attribute__nonnull__(1)
85 __attribute__nonnull__(2);
86
87 static void mark_1_bc_seg(PARROT_INTERP, ARGMOD(PackFile_ByteCode *bc))
88 __attribute__nonnull__(1)
89 __attribute__nonnull__(2)
90 FUNC_MODIFIES(*bc);
91
92 static void mark_1_ct_seg(PARROT_INTERP, ARGMOD(PackFile_ConstTable *ct))
93 __attribute__nonnull__(1)
94 __attribute__nonnull__(2)
95 FUNC_MODIFIES(*ct);
96
97 static void PackFile_Header_read_uuid(PARROT_INTERP,
98 ARGMOD(PackFile_Header *self),
99 ARGIN(const opcode_t *packed),
100 size_t packed_size)
101 __attribute__nonnull__(1)
102 __attribute__nonnull__(2)
103 __attribute__nonnull__(3)
104 FUNC_MODIFIES(*self);
105
106 PARROT_WARN_UNUSED_RESULT
107 static int PackFile_Header_unpack(PARROT_INTERP,
108 ARGMOD(PackFile_Header *self),
109 ARGIN(const opcode_t *packed),
110 size_t packed_size,
111 INTVAL pf_options)
112 __attribute__nonnull__(1)
113 __attribute__nonnull__(2)
114 __attribute__nonnull__(3)
115 FUNC_MODIFIES(*self);
116
117 static void PackFile_Header_validate(PARROT_INTERP,
118 ARGIN(const PackFile_Header *self),
119 INTVAL pf_options)
120 __attribute__nonnull__(1)
121 __attribute__nonnull__(2);
122
123 PARROT_CANNOT_RETURN_NULL
124 static PMC * packfile_main(ARGIN(PackFile_ByteCode *bc))
125 __attribute__nonnull__(1);
126
127 static void PackFile_set_header(ARGOUT(PackFile_Header *header))
128 __attribute__nonnull__(1)
129 FUNC_MODIFIES(*header);
130
131 static void pf_do_sub_pragmas(PARROT_INTERP,
132 ARGIN(PMC *pfpmc),
133 pbc_action_enum_t action)
134 __attribute__nonnull__(1)
135 __attribute__nonnull__(2);
136
137 static void push_context(PARROT_INTERP)
138 __attribute__nonnull__(1);
139
140 PARROT_CAN_RETURN_NULL
141 static char * read_pbc_file_bytes_handle(PARROT_INTERP,
142 PIOHANDLE io,
143 INTVAL program_size)
144 __attribute__nonnull__(1);
145
146 PARROT_CAN_RETURN_NULL
147 static PackFile * read_pbc_file_packfile(PARROT_INTERP,
148 ARGIN(STRING * const fullname),
149 INTVAL program_size)
150 __attribute__nonnull__(1)
151 __attribute__nonnull__(2);
152
153 PARROT_CANNOT_RETURN_NULL
154 static PackFile* read_pbc_file_packfile_handle(PARROT_INTERP,
155 ARGIN(STRING * const fullname),
156 PIOHANDLE io,
157 INTVAL program_size)
158 __attribute__nonnull__(1)
159 __attribute__nonnull__(2);
160
161 PARROT_CANNOT_RETURN_NULL
162 static PMC* set_current_sub(PARROT_INTERP)
163 __attribute__nonnull__(1);
164
165 static int sub_pragma(PARROT_INTERP,
166 pbc_action_enum_t action,
167 ARGIN(const PMC *sub_pmc))
168 __attribute__nonnull__(1)
169 __attribute__nonnull__(3);
170
171 #define ASSERT_ARGS_compile_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
172 PARROT_ASSERT_ARG(interp) \
173 , PARROT_ASSERT_ARG(path))
174 #define ASSERT_ARGS_create_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
175 PARROT_ASSERT_ARG(interp) \
176 , PARROT_ASSERT_ARG(dir) \
177 , PARROT_ASSERT_ARG(name) \
178 , PARROT_ASSERT_ARG(file_name))
179 #define ASSERT_ARGS_do_1_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
180 PARROT_ASSERT_ARG(interp) \
181 , PARROT_ASSERT_ARG(sub_pmc))
182 #define ASSERT_ARGS_find_const_iter __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
183 PARROT_ASSERT_ARG(interp) \
184 , PARROT_ASSERT_ARG(seg))
185 #define ASSERT_ARGS_find_pf_ann_idx __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
186 PARROT_ASSERT_ARG(pfa) \
187 , PARROT_ASSERT_ARG(key))
188 #define ASSERT_ARGS_load_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
189 PARROT_ASSERT_ARG(interp) \
190 , PARROT_ASSERT_ARG(path))
191 #define ASSERT_ARGS_mark_1_bc_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
192 PARROT_ASSERT_ARG(interp) \
193 , PARROT_ASSERT_ARG(bc))
194 #define ASSERT_ARGS_mark_1_ct_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
195 PARROT_ASSERT_ARG(interp) \
196 , PARROT_ASSERT_ARG(ct))
197 #define ASSERT_ARGS_PackFile_Header_read_uuid __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
198 PARROT_ASSERT_ARG(interp) \
199 , PARROT_ASSERT_ARG(self) \
200 , PARROT_ASSERT_ARG(packed))
201 #define ASSERT_ARGS_PackFile_Header_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
202 PARROT_ASSERT_ARG(interp) \
203 , PARROT_ASSERT_ARG(self) \
204 , PARROT_ASSERT_ARG(packed))
205 #define ASSERT_ARGS_PackFile_Header_validate __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
206 PARROT_ASSERT_ARG(interp) \
207 , PARROT_ASSERT_ARG(self))
208 #define ASSERT_ARGS_packfile_main __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
209 PARROT_ASSERT_ARG(bc))
210 #define ASSERT_ARGS_PackFile_set_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
211 PARROT_ASSERT_ARG(header))
212 #define ASSERT_ARGS_pf_do_sub_pragmas __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
213 PARROT_ASSERT_ARG(interp) \
214 , PARROT_ASSERT_ARG(pfpmc))
215 #define ASSERT_ARGS_push_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
216 PARROT_ASSERT_ARG(interp))
217 #define ASSERT_ARGS_read_pbc_file_bytes_handle __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
218 PARROT_ASSERT_ARG(interp))
219 #define ASSERT_ARGS_read_pbc_file_packfile __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
220 PARROT_ASSERT_ARG(interp) \
221 , PARROT_ASSERT_ARG(fullname))
222 #define ASSERT_ARGS_read_pbc_file_packfile_handle __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
223 PARROT_ASSERT_ARG(interp) \
224 , PARROT_ASSERT_ARG(fullname))
225 #define ASSERT_ARGS_set_current_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
226 PARROT_ASSERT_ARG(interp))
227 #define ASSERT_ARGS_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
228 PARROT_ASSERT_ARG(interp) \
229 , PARROT_ASSERT_ARG(sub_pmc))
230 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
231 /* HEADERIZER END: static */
232
233 /*
234
235 =item C<void Parrot_pf_destroy(PARROT_INTERP, PackFile *pf)>
236
237 Destroys a C<PackFile>, and frees resources. This does not automatically free
238 garbage collectable objects contained in that packfile (STRING and PMC) if
239 they are referenced from other places.
240
241 Notice that this can cause problems, if a Packfile is destroyed, but some of
242 its contents are not destroyed, but those contents contain indirect references
243 to other things in the packfile which are destroyed. Use with caution.
244
245 =cut
246
247 */
248
249 PARROT_EXPORT
250 void
Parrot_pf_destroy(PARROT_INTERP,ARGMOD (PackFile * pf))251 Parrot_pf_destroy(PARROT_INTERP, ARGMOD(PackFile *pf))
252 {
253 ASSERT_ARGS(Parrot_pf_destroy)
254
255 #ifdef PARROT_HAS_HEADER_SYSMMAN
256 if (pf->is_mmap_ped) {
257 DECL_CONST_CAST;
258 /* Cast the result to void to avoid a warning with
259 * some not-so-standard mmap headers
260 */
261 munmap((void *)PARROT_const_cast(opcode_t *, pf->src), pf->size);
262 }
263 #endif
264
265 mem_gc_free(interp, pf->header);
266 pf->header = NULL;
267 mem_gc_free(interp, pf->dirp);
268 pf->dirp = NULL;
269 Parrot_pf_destroy_segment(interp, &pf->directory.base);
270 return;
271 }
272
273 /*
274
275 =item C<void PackFile_destroy(PARROT_INTERP, PackFile *pf)>
276
277 Deprecated. Use C<Parrot_pf_destroy> instead. GH #1170
278
279 =cut
280
281 */
282
283 PARROT_EXPORT
284 PARROT_DEPRECATED
285 void
PackFile_destroy(PARROT_INTERP,ARGMOD (PackFile * pf))286 PackFile_destroy(PARROT_INTERP, ARGMOD(PackFile *pf))
287 {
288 ASSERT_ARGS(PackFile_destroy)
289 Parrot_pf_destroy(interp, pf);
290 }
291
292 /*
293
294 =item C<INTVAL Parrot_pf_serialized_size(PARROT_INTERP, PackFile *pf)>
295
296 Returns the size, in bytes, that a packfile will be if serialized
297
298 =item C<STRING * Parrot_pf_serialize(PARROT_INTERP, PackFile * const pf)>
299
300 Serialize a PackFile * into a STRING buffer
301
302 =item C<PackFile * Parrot_pf_deserialize(PARROT_INTERP, STRING *str)>
303
304 Deserialize a packfile which is stored in a STRING buffer
305
306 =cut
307
308 */
309
310 PARROT_EXPORT
311 INTVAL
Parrot_pf_serialized_size(PARROT_INTERP,ARGMOD (PackFile * pf))312 Parrot_pf_serialized_size(PARROT_INTERP, ARGMOD(PackFile *pf))
313 {
314 ASSERT_ARGS(Parrot_pf_serialized_size)
315 return Parrot_pf_pack_size(interp, pf);
316 }
317
318 PARROT_EXPORT
319 PARROT_CANNOT_RETURN_NULL
320 STRING *
Parrot_pf_serialize(PARROT_INTERP,ARGIN (PackFile * const pf))321 Parrot_pf_serialize(PARROT_INTERP, ARGIN(PackFile * const pf))
322 {
323 ASSERT_ARGS(Parrot_pf_serialize)
324 STRING *str;
325 /* Calculate required memory */
326 const opcode_t length = Parrot_pf_pack_size(interp, pf) * sizeof (opcode_t);
327 opcode_t * const ptr = (opcode_t*)Parrot_gc_allocate_memory_chunk(interp, length);
328
329 /* And pack it! */
330 Parrot_pf_pack(interp, pf, ptr);
331
332 str = Parrot_str_new_init(interp, (const char*)ptr, length,
333 Parrot_binary_encoding_ptr, 0);
334 Parrot_gc_free_memory_chunk(interp, ptr);
335 return str;
336 }
337
338 PARROT_EXPORT
339 PARROT_CANNOT_RETURN_NULL
340 PackFile *
Parrot_pf_deserialize(PARROT_INTERP,ARGIN (STRING * str))341 Parrot_pf_deserialize(PARROT_INTERP, ARGIN(STRING *str))
342 {
343 ASSERT_ARGS(Parrot_pf_deserialize)
344 PackFile * const pf = Parrot_pf_new(interp, 0);
345 const char * const cstr = Parrot_str_cstring(interp, str);
346 /* XXX -Wcast-align Need to check alignment for RISC, or memcpy */
347 const opcode_t * const ptr = (const opcode_t *)cstr;
348 const int length = Parrot_str_byte_length(interp, str);
349
350 if (!Parrot_pf_unpack(interp, pf, ptr, length)) {
351 Parrot_pf_destroy(interp, pf);
352 Parrot_ex_throw_from_c_noargs(interp,
353 EXCEPTION_MALFORMED_PACKFILE, "Can't unpack packfile");
354 }
355 return pf;
356 }
357
358 /*
359
360 =item C<void Parrot_pf_tag_constant(PARROT_INTERP, PackFile_ConstTable *ct,
361 const int tag_idx, const int const_idx)>
362
363 Tag a constant PMC with a constant STRING
364
365 =cut
366
367 */
368
369 PARROT_EXPORT
370 void
Parrot_pf_tag_constant(PARROT_INTERP,ARGIN (PackFile_ConstTable * ct),const int tag_idx,const int const_idx)371 Parrot_pf_tag_constant(PARROT_INTERP, ARGIN(PackFile_ConstTable *ct),
372 const int tag_idx, const int const_idx)
373 {
374 ASSERT_ARGS(Parrot_pf_tag_constant)
375 int lo, hi, cur;
376 const STRING *tag = ct->str.constants[tag_idx];
377
378 /* allocate space */
379 if (ct->tag_map == NULL) {
380 ct->tag_map = mem_gc_allocate_n_zeroed_typed(interp, 1, PackFile_ConstTagPair);
381 ct->ntags = 1;
382 }
383 else {
384 ct->tag_map = mem_gc_realloc_n_typed_zeroed(interp, ct->tag_map, ct->ntags + 1, ct->ntags,
385 PackFile_ConstTagPair);
386 ct->ntags++;
387 }
388
389 /* find the slot to insert into */
390 lo = 0;
391 cur = 0;
392 hi = ct->ntags - 1;
393 while (lo < hi) {
394 cur = (lo + hi)/2;
395
396 switch (STRING_compare(interp, tag, ct->str.constants[ct->tag_map[cur].tag_idx])) {
397 case -1:
398 lo = ++cur;
399 break;
400 case 0:
401 lo = hi = cur;
402 break;
403 case 1:
404 hi = cur;
405 break;
406 default:
407 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
408 "Non POSIX strcmp");
409 }
410 }
411
412 memmove(&ct->tag_map[cur + 1], &ct->tag_map[cur],
413 ((ct->ntags - 1) - cur) * sizeof (PackFile_ConstTagPair));
414 ct->tag_map[cur].tag_idx = tag_idx;
415 ct->tag_map[cur].const_idx = const_idx;
416 }
417
418 /*
419
420 =item C<PMC * Parrot_pf_subs_by_tag(PARROT_INTERP, PMC * pfpmc, STRING * flag)>
421
422 Get an array of Subs in the packfile by named flag.
423
424 =cut
425
426 */
427
428 PARROT_EXPORT
429 PARROT_CANNOT_RETURN_NULL
430 PMC *
Parrot_pf_subs_by_tag(PARROT_INTERP,ARGIN (PMC * pfpmc),ARGIN (STRING * flag))431 Parrot_pf_subs_by_tag(PARROT_INTERP, ARGIN(PMC * pfpmc), ARGIN(STRING * flag))
432 {
433 ASSERT_ARGS(Parrot_pf_subs_by_tag)
434 PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
435 int mode = 0;
436 PMC * const subs = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
437 if (!pf || !pf->cur_cs || !pf->cur_cs->const_table)
438 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
439 "NULL or invalid packfile");
440
441 if (STRING_equal(interp, flag, CONST_STRING(interp, "load")))
442 mode = 1;
443 else if (STRING_equal(interp, flag, CONST_STRING(interp, "init")))
444 mode = 2;
445 {
446 PackFile_ConstTable * const ct = pf->cur_cs->const_table;
447 opcode_t flag_idx = -1;
448
449 int bottom_lo, bottom_hi, top_lo, top_hi, cur;
450 int i;
451
452 bottom_lo = top_lo = cur = 0;
453 bottom_hi = top_hi = ct->ntags;
454
455 /* find the first match (if any) */
456 while (flag_idx < 0) {
457 if (bottom_lo == top_hi) {
458 /* tag not present */
459 goto done_find_bounds;
460 }
461
462 cur = (bottom_lo + top_hi)/2;
463
464 switch (STRING_compare(interp, flag, ct->str.constants[ct->tag_map[cur].tag_idx])) {
465 case -1:
466 bottom_lo = cur + 1;
467 break;
468 case 0:
469 flag_idx = ct->tag_map[cur].tag_idx;
470 bottom_hi = cur;
471 top_lo = cur + 1;
472 break;
473 case 1:
474 top_hi = cur;
475 break;
476 default:
477 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
478 "Non POSIX strcmp");
479 }
480 }
481
482 /* find the bottom of the map's range with this tag */
483 while (bottom_lo < bottom_hi) {
484 cur = (bottom_lo + bottom_hi)/2;
485 if (ct->tag_map[cur].tag_idx == flag_idx)
486 bottom_hi = cur;
487 else
488 bottom_lo = cur + 1;
489 }
490
491 /* find the top */
492 while (top_lo < top_hi) {
493 cur = (top_lo + top_hi)/2;
494 if (ct->tag_map[cur].tag_idx == flag_idx)
495 top_lo = cur + 1;
496 else
497 top_hi = cur;
498 }
499
500 done_find_bounds:
501 for (i = bottom_lo; i < top_hi; i++)
502 VTABLE_push_pmc(interp, subs, ct->pmc.constants[ct->tag_map[i].const_idx]);
503 }
504
505 /* Backwards compatibility. :load is equivalent to "load" tag. :init is
506 equivalent to "init" tag */
507 if (mode == 1 || mode == 2) {
508 PackFile_ByteCode * const self = pf->cur_cs;
509 PackFile_ConstTable * const ct = self->const_table;
510 STRING * const SUB = CONST_STRING(interp, "Sub");
511 opcode_t i;
512
513 for (i = 0; i < ct->pmc.const_count; ++i) {
514 PMC * const sub_pmc = ct->pmc.constants[i];
515 Parrot_Sub_attributes *sub;
516 int pragmas;
517
518 if (!VTABLE_isa(interp, sub_pmc, SUB))
519 continue;
520 PMC_get_sub(interp, sub_pmc, sub);
521 pragmas = PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK & ~SUB_FLAG_IS_OUTER;
522
523 if (mode == 1 && (pragmas & SUB_FLAG_PF_LOAD))
524 VTABLE_push_pmc(interp, subs, sub_pmc);
525 else if (mode == 2 && Sub_comp_INIT_TEST(sub))
526 VTABLE_push_pmc(interp, subs, sub_pmc);
527 }
528 }
529 return subs;
530 }
531
532 /*
533
534 =item C<PMC * Parrot_pf_single_sub_by_tag(PARROT_INTERP, PMC * pfpmc, STRING *
535 flag)>
536
537 Get a single Sub from the packfile by named flag. If there are more than one
538 Subs with the given flag, it is unspecified which one is returned.
539
540 =cut
541
542 */
543
544 PARROT_EXPORT
545 PARROT_CANNOT_RETURN_NULL
546 PMC *
Parrot_pf_single_sub_by_tag(PARROT_INTERP,ARGIN (PMC * pfpmc),ARGIN (STRING * flag))547 Parrot_pf_single_sub_by_tag(PARROT_INTERP, ARGIN(PMC * pfpmc), ARGIN(STRING * flag))
548 {
549 ASSERT_ARGS(Parrot_pf_single_sub_by_tag)
550
551 /* XXX use custom implementation */
552 PMC * const subs = Parrot_pf_subs_by_tag(interp, pfpmc, flag);
553 return PMC_IS_NULL(subs)
554 ? PMCNULL
555 : VTABLE_get_pmc_keyed_int(interp, subs, 0);
556 }
557
558 /*
559
560 =item C<PMC * Parrot_pf_all_tags_list(PARROT_INTERP, PMC * pfpmc)>
561
562 Return a ResizableStringArray of all tags in the packfile.
563
564 =cut
565
566 */
567
568 PARROT_CANNOT_RETURN_NULL
569 PARROT_WARN_UNUSED_RESULT
570 PMC *
Parrot_pf_all_tags_list(PARROT_INTERP,ARGIN (PMC * pfpmc))571 Parrot_pf_all_tags_list(PARROT_INTERP, ARGIN(PMC * pfpmc))
572 {
573 ASSERT_ARGS(Parrot_pf_all_tags_list)
574 PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
575 PMC * const tags = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
576
577 if (!pf || !pf->cur_cs || !pf->cur_cs->const_table)
578 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
579 "NULL or invalid packfile");
580 {
581 PackFile_ConstTable * const ct = pf->cur_cs->const_table;
582 const opcode_t ntags = ct->ntags;
583 opcode_t i = 0;
584 opcode_t last_seen = -1;
585 for (; i < ntags; i++) {
586 const opcode_t cur_tag = ct->tag_map[i].tag_idx;
587 if (cur_tag == last_seen)
588 continue;
589 VTABLE_push_string(interp, tags, ct->str.constants[cur_tag]);
590 last_seen = cur_tag;
591 }
592 }
593 return tags;
594 }
595
596 /*
597
598 =item C<PMC * Parrot_pf_all_tagged_pmcs(PARROT_INTERP, PMC * pfpmc)>
599
600 Return a hash of all tags in the packfile. Each tag is a key in the hash. Each
601 value is a ResizablePMCArray of pmcs with that tag.
602
603 =cut
604
605 */
606
607 PARROT_CANNOT_RETURN_NULL
608 PARROT_WARN_UNUSED_RESULT
609 PMC *
Parrot_pf_all_tagged_pmcs(PARROT_INTERP,ARGIN (PMC * pfpmc))610 Parrot_pf_all_tagged_pmcs(PARROT_INTERP, ARGIN(PMC * pfpmc))
611 {
612 ASSERT_ARGS(Parrot_pf_all_tagged_pmcs)
613 PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
614 PMC * const taghash = Parrot_pmc_new(interp, enum_class_Hash);
615
616 if (!pf || !pf->cur_cs || !pf->cur_cs->const_table)
617 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
618 "NULL or invalid packfile");
619 {
620 PackFile_ConstTable * const ct = pf->cur_cs->const_table;
621 const opcode_t ntags = ct->ntags;
622 opcode_t i = 0;
623 opcode_t last_seen = -1;
624 STRING * cur_tag_str = NULL;
625 PMC * cur_tag_list = NULL;
626 for (; i < ntags; i++) {
627 const opcode_t cur_tag = ct->tag_map[i].tag_idx;
628 if (cur_tag != last_seen) {
629 cur_tag_str = ct->str.constants[cur_tag];
630 cur_tag_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
631 VTABLE_set_pmc_keyed_str(interp, taghash, cur_tag_str, cur_tag_list);
632 last_seen = cur_tag;
633 }
634 VTABLE_push_pmc(interp, cur_tag_list, ct->pmc.constants[ct->tag_map[i].const_idx]);
635 }
636 }
637 return taghash;
638 }
639
640 /*
641
642 =item C<PMC * Parrot_pf_all_subs(PARROT_INTERP, PMC *pfpmc)>
643
644 Return an array of all Sub PMCs from the packfile
645
646 =cut
647
648 */
649
650 PARROT_CANNOT_RETURN_NULL
651 PARROT_WARN_UNUSED_RESULT
652 PMC *
Parrot_pf_all_subs(PARROT_INTERP,ARGIN (PMC * pfpmc))653 Parrot_pf_all_subs(PARROT_INTERP, ARGIN(PMC *pfpmc))
654 {
655 ASSERT_ARGS(Parrot_pf_all_subs)
656 PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
657 if (!pf || !pf->cur_cs || !pf->cur_cs->const_table)
658 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
659 "NULL or invalid packfile");
660
661 {
662 PackFile_ConstTable * const ct = pf->cur_cs->const_table;
663 PMC * const array = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
664 INTVAL i;
665 STRING * const SUB = CONST_STRING(interp, "Sub");
666 for (i = 0; i < ct->pmc.const_count; ++i) {
667 PMC * const x = ct->pmc.constants[i];
668 if (VTABLE_isa(interp, x, SUB))
669 VTABLE_push_pmc(interp, array, x);
670 }
671 return array;
672 }
673 }
674
675 /*
676
677 =item C<static int sub_pragma(PARROT_INTERP, pbc_action_enum_t action, const PMC
678 *sub_pmc)>
679
680 Checks B<sub_pmc>'s pragmas (e.g. flags like C<:load>, C<:main>, etc.)
681 returning 1 if the sub should be run for C<action>, a C<pbc_action_enum_t>.
682
683 =cut
684
685 */
686
687 static int
sub_pragma(PARROT_INTERP,pbc_action_enum_t action,ARGIN (const PMC * sub_pmc))688 sub_pragma(PARROT_INTERP, pbc_action_enum_t action, ARGIN(const PMC *sub_pmc))
689 {
690 ASSERT_ARGS(sub_pragma)
691
692 /* Note: the const casting is only needed because of the
693 * internal details of the Sub_comp macros.
694 * The assumption is that the TEST versions are in fact const,
695 * so the casts are safe.
696 * These casts are a quick fix to allow parrot build with c++,
697 * a refactor of the macros will be a cleaner solution. */
698 DECL_CONST_CAST;
699 Parrot_Sub_attributes *sub;
700 int todo = 0;
701 const int pragmas = PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK
702 & ~SUB_FLAG_IS_OUTER;
703 PMC_get_sub(interp, PARROT_const_cast(PMC *, sub_pmc), sub);
704 if (!pragmas && !Sub_comp_INIT_TEST(sub))
705 return 0;
706
707 switch (action) {
708 case PBC_MAIN:
709 /* denote MAIN entry in first loaded PASM */
710 if (interp->resume_flag & RESUME_INITIAL)
711 todo = 1;
712
713 /* :init functions need to be called at MAIN time, so return 1 */
714 /* symreg.h:P_INIT */
715 if (Sub_comp_INIT_TEST(sub))
716 todo = 1;
717
718 break;
719 case PBC_LOADED:
720 /* symreg.h:P_LOAD */
721 if (pragmas & SUB_FLAG_PF_LOAD)
722 todo = 1;
723 break;
724 default:
725 break;
726 }
727
728 if (pragmas & (SUB_FLAG_PF_IMMEDIATE | SUB_FLAG_PF_POSTCOMP))
729 todo = 1;
730
731 return todo;
732 }
733
734 /*
735
736 =item C<static PMC* do_1_sub_pragma(PARROT_INTERP, PMC *sub_pmc,
737 pbc_action_enum_t action)>
738
739 Runs autoloaded or immediate bytecode, marking the MAIN subroutine entry.
740
741 =cut
742
743 */
744
745 PARROT_WARN_UNUSED_RESULT
746 PARROT_CAN_RETURN_NULL
747 static PMC*
do_1_sub_pragma(PARROT_INTERP,ARGMOD (PMC * sub_pmc),pbc_action_enum_t action)748 do_1_sub_pragma(PARROT_INTERP, ARGMOD(PMC *sub_pmc), pbc_action_enum_t action)
749 {
750 ASSERT_ARGS(do_1_sub_pragma)
751 Parrot_Sub_attributes *sub;
752 PMC_get_sub(interp, sub_pmc, sub);
753
754 switch (action) {
755 case PBC_IMMEDIATE:
756 /* run IMMEDIATE sub */
757 if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_IMMEDIATE) {
758 void * const lo_var_ptr = interp->lo_var_ptr;
759 PMC *result = PMCNULL;
760
761 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_IMMEDIATE;
762 Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->P", &result);
763
764 /* reset initial flag so MAIN detection works
765 * and reset lo_var_ptr to prev */
766 interp->resume_flag = RESUME_INITIAL;
767 interp->lo_var_ptr = lo_var_ptr;
768 return result;
769 }
770 break;
771 case PBC_POSTCOMP:
772 /* run POSTCOMP sub */
773 if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_POSTCOMP) {
774 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_POSTCOMP;
775 Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->");
776
777 /* reset initial flag so MAIN detection works */
778 interp->resume_flag = RESUME_INITIAL;
779 return NULL;
780 }
781 break;
782
783 case PBC_LOADED:
784 if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_LOAD) {
785 /* only run :init/:load subs once */
786 Sub_comp_INIT_CLEAR(sub);
787 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
788
789 Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->");
790 }
791 break;
792
793 case PBC_MAIN:
794 /* run :init/:load tagged functions */
795 if (Sub_comp_INIT_TEST(sub)) {
796 /* only run :init/:load subs once */
797 Sub_comp_INIT_CLEAR(sub);
798 PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
799
800 Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->");
801 interp->resume_flag = RESUME_INITIAL;
802 }
803 break;
804
805 default:
806 break;
807 }
808
809 return NULL;
810 }
811
812
813 /*
814
815 =item C<static void mark_1_ct_seg(PARROT_INTERP, PackFile_ConstTable *ct)>
816
817 Mark one ConstTable segment for GC.
818
819 =cut
820
821 */
822
823 static void
mark_1_ct_seg(PARROT_INTERP,ARGMOD (PackFile_ConstTable * ct))824 mark_1_ct_seg(PARROT_INTERP, ARGMOD(PackFile_ConstTable *ct))
825 {
826 ASSERT_ARGS(mark_1_ct_seg)
827 opcode_t i;
828
829 if (ct->string_hash)
830 Parrot_hash_mark(interp, ct->string_hash);
831
832 if (ct->pmc_hash)
833 Parrot_hash_mark(interp, ct->pmc_hash);
834
835 for (i = 0; i < ct->str.const_count; i++)
836 Parrot_gc_mark_STRING_alive(interp, ct->str.constants[i]);
837
838 for (i = 0; i < ct->pmc.const_count; i++)
839 Parrot_gc_mark_PMC_alive(interp, ct->pmc.constants[i]);
840 }
841
842
843 /*
844
845 =item C<static void mark_1_bc_seg(PARROT_INTERP, PackFile_ByteCode *bc)>
846
847 Mark gcables in bytecode header.
848
849 =cut
850
851 */
852
853 static void
mark_1_bc_seg(PARROT_INTERP,ARGMOD (PackFile_ByteCode * bc))854 mark_1_bc_seg(PARROT_INTERP, ARGMOD(PackFile_ByteCode *bc))
855 {
856 ASSERT_ARGS(mark_1_bc_seg)
857 size_t i;
858 for (i = 0; i < bc->n_libdeps; i++)
859 Parrot_gc_mark_STRING_alive(interp, bc->libdeps[i]);
860 }
861
862 /*
863
864 =item C<static INTVAL find_const_iter(PARROT_INTERP, PackFile_Segment *seg, void
865 *user_data)>
866
867 Iterates over a PackFile_Directory, marking any constant segments. Internal
868 use only.
869
870 =cut
871
872 */
873
874 static INTVAL
find_const_iter(PARROT_INTERP,ARGMOD (PackFile_Segment * seg),ARGIN_NULLOK (void * user_data))875 find_const_iter(PARROT_INTERP, ARGMOD(PackFile_Segment *seg), ARGIN_NULLOK(void *user_data))
876 {
877 ASSERT_ARGS(find_const_iter)
878
879 Parrot_gc_mark_STRING_alive(interp, seg->name);
880
881 switch (seg->type) {
882 case PF_DIR_SEG:
883 Parrot_pf_map_segments(interp, (const PackFile_Directory *)seg,
884 find_const_iter, user_data);
885 break;
886
887 case PF_CONST_SEG:
888 mark_1_ct_seg(interp, (PackFile_ConstTable *)seg);
889 break;
890
891 case PF_BYTEC_SEG:
892 mark_1_bc_seg(interp, (PackFile_ByteCode *)seg);
893 break;
894
895 default:
896 break;
897 }
898
899 return 0;
900 }
901
902 /*
903
904 =item C<void Parrot_pf_mark_packfile(PARROT_INTERP, PackFile * pf)>
905
906 Mark the contents of a C<PackFile>.
907
908 =cut
909
910 */
911
912 void
Parrot_pf_mark_packfile(PARROT_INTERP,ARGMOD_NULLOK (PackFile * pf))913 Parrot_pf_mark_packfile(PARROT_INTERP, ARGMOD_NULLOK(PackFile * pf))
914 {
915 ASSERT_ARGS(Parrot_pf_mark_packfile)
916
917 if (!pf)
918 return;
919 else {
920 /* locate top level dir */
921 PackFile_Directory * const dir = &pf->directory;
922
923 /* iterate over all dir/segs */
924 Parrot_pf_map_segments(interp, dir, find_const_iter, NULL);
925 }
926 }
927
928 /*
929
930 =item C<PMC * Parrot_pf_get_packfile_main_sub(PARROT_INTERP, PMC * pbc)>
931
932 Get the main function of the bytecode segment, if any.
933
934 =item C<static PMC * packfile_main(PackFile_ByteCode *bc)>
935
936 Access the main function of a bytecode segment.
937
938 =cut
939
940 */
941
942 PARROT_CANNOT_RETURN_NULL
943 PMC *
Parrot_pf_get_packfile_main_sub(PARROT_INTERP,ARGIN (PMC * pbc))944 Parrot_pf_get_packfile_main_sub(PARROT_INTERP, ARGIN(PMC * pbc))
945 {
946 ASSERT_ARGS(Parrot_pf_get_packfile_main_sub)
947 PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pbc);
948 if (pf == NULL || pf->cur_cs == NULL || pf->cur_cs->const_table == NULL)
949 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
950 "Null or invalid PackFile");
951 return packfile_main(pf->cur_cs);
952 }
953
954 PARROT_CANNOT_RETURN_NULL
955 static PMC *
packfile_main(ARGIN (PackFile_ByteCode * bc))956 packfile_main(ARGIN(PackFile_ByteCode *bc))
957 {
958 ASSERT_ARGS(packfile_main)
959 const PackFile_ConstTable * const ct = bc->const_table;
960 if (!ct || !ct->pmc.constants || bc->main_sub < 0)
961 return PMCNULL;
962 return ct->pmc.constants[bc->main_sub];
963 }
964
965 /*
966
967 =item C<static void pf_do_sub_pragmas(PARROT_INTERP, PMC *pfpmc,
968 pbc_action_enum_t action)>
969
970 C<action> is one of C<PBC_LOADED>, C<PBC_INIT>, or C<PBC_MAIN>.
971 These determine which subs get executed at this point. Some rules:
972
973 :immediate subs always execute immediately
974 :postcomp subs always execute immediately
975 :main subs execute when we have the PBC_MAIN action
976 :init subs execute when :main does
977 :load subs execute on PBC_LOAD
978
979 The argument C<eval_pmc> is ignored.
980
981 TODO: This function and the entire underlying mechanism should be deprecated and
982 removed. See GH #428 for details.
983
984 =cut
985
986 */
987
988 static void
pf_do_sub_pragmas(PARROT_INTERP,ARGIN (PMC * pfpmc),pbc_action_enum_t action)989 pf_do_sub_pragmas(PARROT_INTERP, ARGIN(PMC *pfpmc), pbc_action_enum_t action)
990 {
991 ASSERT_ARGS(pf_do_sub_pragmas)
992 PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
993 PackFile_ByteCode * const self = pf->cur_cs;
994 PackFile_ConstTable * const ct = self->const_table;
995 opcode_t i;
996
997 for (i = 0; i < ct->pmc.const_count; ++i) {
998 STRING * const SUB = CONST_STRING(interp, "Sub");
999 PMC * const sub_pmc = ct->pmc.constants[i];
1000
1001 if (VTABLE_isa(interp, sub_pmc, SUB)) {
1002 Parrot_Sub_attributes *sub;
1003
1004 PMC_get_sub(interp, sub_pmc, sub);
1005
1006 if (action == 0)
1007 continue;
1008 if (((PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK)
1009 || (Sub_comp_get_FLAGS(sub) & SUB_COMP_FLAG_MASK))
1010 && sub_pragma(interp, action, sub_pmc)) {
1011 PMC * const result = do_1_sub_pragma(interp, sub_pmc, action);
1012
1013 /* replace Sub PMC with computation results */
1014 if (action == PBC_IMMEDIATE && !PMC_IS_NULL(result)) {
1015 PObj_is_shared_SET(result); /* packfile constants are shared among threads */
1016 ct->pmc.constants[i] = result;
1017 PARROT_GC_WRITE_BARRIER(interp, pfpmc);
1018 }
1019 }
1020 }
1021 }
1022
1023 if (interp->resume_flag & RESUME_INITIAL) {
1024 if (action == PBC_MAIN) {
1025 if (self->main_sub < 0)
1026 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_LIBRARY_ERROR,
1027 "No main sub found");
1028 {
1029 PMC * const mainsub = packfile_main(self);
1030 opcode_t * const ptr = (opcode_t *)VTABLE_get_pointer(interp, mainsub);
1031 Parrot_Sub_attributes *main_attrs;
1032 PMC_get_sub(interp, mainsub, main_attrs);
1033 interp->resume_offset = (ptr - main_attrs->seg->base.data);
1034 }
1035 }
1036 }
1037 }
1038
1039 /*
1040
1041 =item C<void do_sub_pragmas(PARROT_INTERP, PMC *pfpmc, pbc_action_enum_t action,
1042 PMC *eval_pmc)>
1043
1044 This function and the entire underlying mechanism is deprecated and will be
1045 removed. See GH #428 for details.
1046
1047 For now use C<pf_do_sub_pragmas> instead.
1048
1049 =cut
1050
1051 */
1052
1053 PARROT_EXPORT
1054 PARROT_DEPRECATED
1055 void
do_sub_pragmas(PARROT_INTERP,ARGIN (PMC * pfpmc),pbc_action_enum_t action,SHIM (PMC * eval_pmc))1056 do_sub_pragmas(PARROT_INTERP, ARGIN(PMC *pfpmc),
1057 pbc_action_enum_t action, SHIM(PMC *eval_pmc))
1058 {
1059 ASSERT_ARGS(do_sub_pragmas)
1060 pf_do_sub_pragmas(interp, pfpmc, action);
1061 }
1062 /*
1063
1064 =item C<static void PackFile_Header_validate(PARROT_INTERP, const
1065 PackFile_Header *self, INTVAL pf_options)>
1066
1067 Validates a C<PackFile_Header>, ensuring that the magic number is valid and
1068 that Parrot can read this bytecode version.
1069
1070 Raises an exception if the header doesn't validate.
1071
1072 =cut
1073
1074 */
1075
1076 static void
PackFile_Header_validate(PARROT_INTERP,ARGIN (const PackFile_Header * self),INTVAL pf_options)1077 PackFile_Header_validate(PARROT_INTERP, ARGIN(const PackFile_Header *self),
1078 INTVAL pf_options)
1079 {
1080 ASSERT_ARGS(PackFile_Header_validate)
1081
1082 /* Ensure the magic is correct. */
1083 if (memcmp(self->magic, "\376PBC\r\n\032\n", 8) != 0) {
1084 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
1085 "PackFile_Header_validate: Invalid Parrot bytecode file");
1086 }
1087
1088 /* Ensure the bytecode version is one we can read. Currently, we only
1089 * support bytecode versions matching the current one.
1090 *
1091 * tools/dev/pbc_header.pl --upd t/native_pbc/(ASTERISK).pbc
1092 * stamps version and fingerprint in the native tests.
1093 * NOTE: (ASTERISK) is *, we don't want to fool the C preprocessor. */
1094 if (self->bc_major != PARROT_PBC_MAJOR
1095 || self->bc_minor != PARROT_PBC_MINOR) {
1096 if (!(pf_options & PFOPT_UTILS))
1097 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PARROT_USAGE_ERROR,
1098 "PackFile_Header_validate: This Parrot cannot read bytecode "
1099 "files with version %d.%d.",
1100 self->bc_major, self->bc_minor);
1101 }
1102
1103 /* Check wordsize, byte order and floating point number type are valid. */
1104 if (self->wordsize != 4 && self->wordsize != 8) {
1105 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
1106 "PackFile_Header_validate: Invalid wordsize %d\n", self->wordsize);
1107 }
1108
1109 if (self->byteorder != 0 && self->byteorder != 1) {
1110 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
1111 "PackFile_Header_validate: Invalid byte ordering %d\n", self->byteorder);
1112 }
1113
1114 if (self->floattype > FLOATTYPE_MAX) {
1115 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
1116 "PackFile_Header_validate: Invalid floattype %d\n", self->floattype);
1117 }
1118 }
1119
1120
1121 /*
1122
1123 =item C<static void PackFile_Header_read_uuid(PARROT_INTERP, PackFile_Header
1124 *self, const opcode_t *packed, size_t packed_size)>
1125
1126 Reads a C<PackFile_Header>'s UUID from a block of memory and verifies that it
1127 is valid.
1128
1129 =cut
1130
1131 */
1132
1133 static void
PackFile_Header_read_uuid(PARROT_INTERP,ARGMOD (PackFile_Header * self),ARGIN (const opcode_t * packed),size_t packed_size)1134 PackFile_Header_read_uuid(PARROT_INTERP, ARGMOD(PackFile_Header *self),
1135 ARGIN(const opcode_t *packed), size_t packed_size)
1136 {
1137 ASSERT_ARGS(PackFile_Header_read_uuid)
1138
1139 /* Check the UUID type is valid and, if needed, read a UUID. */
1140 if (self->uuid_type == 0) {
1141 /* No UUID; fine, nothing more to do. */
1142 }
1143 else if (self->uuid_type == 1) {
1144 if (packed_size < (size_t) PACKFILE_HEADER_BYTES + self->uuid_size) {
1145 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
1146 "PackFile_Header_read_uuid: Buffer length %d is shorter than PACKFILE_HEADER_BYTES "
1147 "+ uuid_size %d\n", packed_size, PACKFILE_HEADER_BYTES + self->uuid_size);
1148 }
1149
1150 /* Read in the UUID. We'll put it in a NULL-terminated string, just in
1151 * case people use it that way. */
1152 self->uuid_data = mem_gc_allocate_n_typed(interp,
1153 self->uuid_size + 1, unsigned char);
1154
1155 memcpy(self->uuid_data, packed + PACKFILE_HEADER_BYTES,
1156 self->uuid_size);
1157
1158 /* NULL terminate */
1159 self->uuid_data[self->uuid_size] = '\0';
1160 }
1161 else
1162 /* Don't know this UUID type. */
1163 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
1164 "PackFile unpack: Invalid UUID type %d\n", self->uuid_type);
1165 }
1166
1167
1168 /*
1169
1170 =item C<static int PackFile_Header_unpack(PARROT_INTERP, PackFile_Header *self,
1171 const opcode_t *packed, size_t packed_size, INTVAL pf_options)>
1172
1173 Unpacks a C<PackFile_Header> from a block of memory and perform some validation
1174 to check that the head is correct.
1175
1176 Returns size of unpacked header.
1177
1178 =cut
1179
1180 */
1181
1182 PARROT_WARN_UNUSED_RESULT
1183 static int
PackFile_Header_unpack(PARROT_INTERP,ARGMOD (PackFile_Header * self),ARGIN (const opcode_t * packed),size_t packed_size,INTVAL pf_options)1184 PackFile_Header_unpack(PARROT_INTERP, ARGMOD(PackFile_Header *self),
1185 ARGIN(const opcode_t *packed), size_t packed_size,
1186 INTVAL pf_options)
1187 {
1188 ASSERT_ARGS(PackFile_Header_unpack)
1189
1190 /* Verify that the packfile isn't too small to contain a proper header */
1191 if (packed_size < PACKFILE_HEADER_BYTES) {
1192 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
1193 "PackFile unpack: Buffer length %d is shorter than PACKFILE_HEADER_BYTES %d.",
1194 packed_size, PACKFILE_HEADER_BYTES);
1195 }
1196
1197 /* Extract the header. */
1198 memcpy(self, packed, PACKFILE_HEADER_BYTES);
1199
1200 /* Validate the header. */
1201 PackFile_Header_validate(interp, self, pf_options);
1202
1203 /* Extract the header's UUID. */
1204 PackFile_Header_read_uuid(interp, self, packed, packed_size);
1205
1206 /* Return the number of bytes in the header */
1207 return PACKFILE_HEADER_BYTES + self->uuid_size;
1208 }
1209
1210
1211 /*
1212
1213 =item C<opcode_t Parrot_pf_unpack(PARROT_INTERP, PackFile *self, const opcode_t
1214 *packed, size_t packed_size)>
1215
1216 Unpacks a C<PackFile> from a block of memory, ensuring that the magic number is
1217 valid and that Parrot can read this bytecode version, Parrot, and performing
1218 any required endian and word size transforms.
1219
1220 Returns size of unpacked opcodes if everything is okay, else zero (0).
1221
1222 =item C<opcode_t PackFile_unpack(PARROT_INTERP, PackFile *self, const opcode_t
1223 *packed, size_t packed_size)>
1224
1225 Deprecated: Use C<Parrot_pf_unpack> instead. See GH #1170
1226
1227 =cut
1228
1229 */
1230
1231 PARROT_EXPORT
1232 PARROT_WARN_UNUSED_RESULT
1233 opcode_t
Parrot_pf_unpack(PARROT_INTERP,ARGMOD (PackFile * self),ARGIN (const opcode_t * packed),size_t packed_size)1234 Parrot_pf_unpack(PARROT_INTERP, ARGMOD(PackFile *self),
1235 ARGIN(const opcode_t *packed), size_t packed_size)
1236 {
1237 ASSERT_ARGS(Parrot_pf_unpack)
1238 PackFile_Header * const header = self->header;
1239 const opcode_t *cursor;
1240 int header_read_length;
1241
1242 self->src = packed;
1243 self->size = packed_size;
1244
1245 /* Unpack the header */
1246 header_read_length = PackFile_Header_unpack(interp, self->header, packed,
1247 packed_size, self->options);
1248
1249 /* Set cursor to position after what we've read, allowing for padding to a
1250 * 16 byte boundary. */
1251 header_read_length += PAD_16_B(header_read_length);
1252 cursor = packed + (header_read_length / sizeof (opcode_t));
1253
1254 /* Set what transforms we need to do when reading the rest of the file. */
1255 PackFile_assign_transforms(self);
1256
1257 if (self->options & PFOPT_PMC_FREEZE_ONLY)
1258 return cursor - packed;
1259
1260 /* Directory format. */
1261 header->dir_format = PF_fetch_opcode(self, &cursor);
1262
1263 if (header->dir_format != PF_DIR_FORMAT) {
1264 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
1265 "PackFile unpack: Dir format was %d not %d\n",
1266 header->dir_format, PF_DIR_FORMAT);
1267 }
1268
1269 /* Padding. */
1270 (void)PF_fetch_opcode(self, &cursor);
1271 (void)PF_fetch_opcode(self, &cursor);
1272 (void)PF_fetch_opcode(self, &cursor);
1273
1274 self->directory.base.file_offset = (INTVAL)cursor - (INTVAL)self->src;
1275 if (self->options & PFOPT_HEADERONLY)
1276 return cursor - packed;
1277
1278 /* now unpack dir, which unpacks its contents ... */
1279 Parrot_block_GC_mark(interp);
1280 cursor = pf_segment_unpack(interp, &self->directory.base, cursor);
1281 Parrot_unblock_GC_mark(interp);
1282
1283 #ifdef PARROT_HAS_HEADER_SYSMMAN
1284 if (self->is_mmap_ped
1285 && (self->need_endianize || self->need_wordsize)) {
1286 DECL_CONST_CAST;
1287 /* Cast the result to void to avoid a warning with
1288 * some not-so-standard mmap headers
1289 */
1290 munmap((void *)PARROT_const_cast(opcode_t *, self->src), self->size);
1291 self->is_mmap_ped = 0;
1292 }
1293 #endif
1294
1295 return cursor - packed;
1296 }
1297
1298 PARROT_EXPORT
1299 PARROT_WARN_UNUSED_RESULT
1300 PARROT_DEPRECATED
1301 opcode_t
PackFile_unpack(PARROT_INTERP,ARGMOD (PackFile * self),ARGIN (const opcode_t * packed),size_t packed_size)1302 PackFile_unpack(PARROT_INTERP, ARGMOD(PackFile *self),
1303 ARGIN(const opcode_t *packed), size_t packed_size)
1304 {
1305 ASSERT_ARGS(PackFile_unpack)
1306
1307 return Parrot_pf_unpack(interp, self, packed, packed_size);
1308 }
1309
1310 /*
1311
1312 =back
1313
1314 =head2 PackFile Structure Functions
1315
1316 =over 4
1317
1318 =item C<static void PackFile_set_header(PackFile_Header *header)>
1319
1320 Fills a C<PackFile> header with system specific data.
1321
1322 =cut
1323
1324 */
1325
1326 static void
PackFile_set_header(ARGOUT (PackFile_Header * header))1327 PackFile_set_header(ARGOUT(PackFile_Header *header))
1328 {
1329 ASSERT_ARGS(PackFile_set_header)
1330 memcpy(header->magic, "\376PBC\r\n\032\n", 8);
1331 header->wordsize = sizeof (opcode_t);
1332 header->byteorder = PARROT_BIGENDIAN;
1333 header->major = PARROT_MAJOR_VERSION;
1334 header->minor = PARROT_MINOR_VERSION;
1335 header->patch = PARROT_PATCH_VERSION;
1336 header->bc_major = PARROT_PBC_MAJOR;
1337 header->bc_minor = PARROT_PBC_MINOR;
1338 #if NUMVAL_SIZE == 8
1339 header->floattype = FLOATTYPE_8;
1340 #else
1341 # if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN
1342 header->floattype = FLOATTYPE_12;
1343 # else
1344 # if (NUMVAL_SIZE == 16)
1345 header->floattype = FLOATTYPE_16;
1346 # else
1347 Parrot_x_force_error_exit(NULL, 1,
1348 "PackFile_set_header: Unsupported floattype NUMVAL_SIZE=%d,"
1349 " PARROT_BIGENDIAN=%s\n", NUMVAL_SIZE,
1350 PARROT_BIGENDIAN ? "big-endian" : "little-endian");
1351 # endif
1352 # endif
1353 #endif
1354 }
1355
1356
1357 /*
1358
1359 =item C<PackFile * Parrot_pf_new(PARROT_INTERP, INTVAL is_mapped)>
1360
1361 Allocates a new empty C<PackFile> and sets up the directory.
1362
1363 Directory segment:
1364
1365 +----------+----------+----------+----------+
1366 | Segment Header |
1367 | .............. |
1368 +----------+----------+----------+----------+
1369
1370 +----------+----------+----------+----------+
1371 | number of directory items |
1372 +----------+----------+----------+----------+
1373
1374 followed by a sequence of items
1375
1376 +----------+----------+----------+----------+
1377 | Segment type |
1378 +----------+----------+----------+----------+
1379 | "name" |
1380 | ... '\0' padding bytes |
1381 +----------+----------+----------+----------+
1382 | Offset in the file |
1383 +----------+----------+----------+----------+
1384 | Size of the segment |
1385 +----------+----------+----------+----------+
1386
1387 "name" is a NUL-terminated c-string encoded in plain ASCII.
1388
1389 Segment types are defined in F<include/parrot/packfile.h>.
1390
1391 Offset and size are in C<opcode_t>.
1392
1393 A Segment Header has these entries:
1394
1395 - op_count total ops of segment incl. this count
1396 - itype internal type of segment
1397 - id internal id e.g code seg nr
1398 - size size of following op array, 0 if none
1399 * data possibly empty data, or e.g. byte code
1400
1401 =cut
1402
1403 */
1404
1405 PARROT_EXPORT
1406 PARROT_WARN_UNUSED_RESULT
1407 PARROT_CANNOT_RETURN_NULL
1408 PackFile *
Parrot_pf_new(PARROT_INTERP,INTVAL is_mapped)1409 Parrot_pf_new(PARROT_INTERP, INTVAL is_mapped)
1410 {
1411 ASSERT_ARGS(Parrot_pf_new)
1412 PackFile * const pf = mem_gc_allocate_zeroed_typed(interp, PackFile);
1413 pf->header = mem_gc_allocate_zeroed_typed(interp, PackFile_Header);
1414 pf->is_mmap_ped = is_mapped;
1415 pf->options = PFOPT_NONE;
1416
1417 /* fill header with system specific data */
1418 PackFile_set_header(pf->header);
1419
1420 /* Other fields empty for now */
1421 pf->cur_cs = NULL;
1422 pf_register_standard_funcs(pf);
1423
1424 /* create the master directory, all sub-dirs go there */
1425 pf->directory.base.pf = pf;
1426 pf->dirp = (PackFile_Directory *)
1427 Parrot_pf_new_segment(interp, &pf->directory,
1428 PF_DIR_SEG, DIRECTORY_SEGMENT_NAME, 0);
1429 pf->directory = *pf->dirp;
1430
1431 pf->fetch_op = (packfile_fetch_op_t)NULL;
1432 pf->fetch_iv = (packfile_fetch_iv_t)NULL;
1433 pf->fetch_nv = (packfile_fetch_nv_t)NULL;
1434
1435 pf->view = NULL;
1436
1437 return pf;
1438 }
1439
1440 /*
1441
1442 =item C<PackFile * PackFile_new(PARROT_INTERP, INTVAL is_mapped)>
1443
1444 Deprecated: Use C<Parrot_pf_new> instead. See GH #1170
1445
1446 =cut
1447
1448 */
1449
1450 PARROT_EXPORT
1451 PARROT_WARN_UNUSED_RESULT
1452 PARROT_CANNOT_RETURN_NULL
1453 PARROT_DEPRECATED
1454 PackFile *
PackFile_new(PARROT_INTERP,INTVAL is_mapped)1455 PackFile_new(PARROT_INTERP, INTVAL is_mapped)
1456 {
1457 ASSERT_ARGS(PackFile_new)
1458 return Parrot_pf_new(interp, is_mapped);
1459 }
1460
1461 /*
1462
1463 =item C<PMC * Parrot_pf_get_packfile_pmc(PARROT_INTERP, PackFile *pf, STRING
1464 *path)>
1465
1466 Get a new PMC to hold the PackFile* structure. The exact type of PMC returned
1467 is not important, and consuming code should not rely on any particular type
1468 being returned. The only guarantees which are made by this interface are that:
1469
1470 1) The PackFile* structure can be retrieved by VTABLE_get_pointer
1471 2) The PackFile* structure is marked for GC when the PMC is marked for GC
1472
1473 =cut
1474
1475 */
1476
1477 PARROT_EXPORT
1478 PARROT_CANNOT_RETURN_NULL
1479 PMC *
Parrot_pf_get_packfile_pmc(PARROT_INTERP,ARGIN (PackFile * pf),ARGIN (STRING * path))1480 Parrot_pf_get_packfile_pmc(PARROT_INTERP, ARGIN(PackFile *pf), ARGIN(STRING *path))
1481 {
1482 ASSERT_ARGS(Parrot_pf_get_packfile_pmc)
1483 PMC *ptr;
1484
1485 if (pf->view)
1486 return pf->view;
1487
1488 /* We have to block GC here. */
1489 /* XXX We should never-ever have raw PackFile* laying around */
1490 /* XXX But it require a lot of effort to cleanup codebase */
1491 Parrot_block_GC_mark(interp);
1492
1493 ptr = Parrot_pmc_new(interp, enum_class_PackfileView);
1494 VTABLE_set_pointer(interp, ptr, pf);
1495 pf->view = ptr;
1496 VTABLE_set_string_native(interp, ptr, path);
1497
1498 Parrot_unblock_GC_mark(interp);
1499
1500 /* TODO: We shouldn't need to register this here. But, this is a cheap
1501 fix to make sure packfiles aren't getting collected prematurely */
1502 Parrot_pmc_gc_register(interp, ptr);
1503 return ptr;
1504 }
1505
1506
1507 /*
1508
1509 =item C<PMC * Parrot_pf_get_current_packfile(PARROT_INTERP)>
1510
1511 Get the interpreter's currently active PackFile
1512
1513 =cut
1514
1515 */
1516
1517 PARROT_PURE_FUNCTION
1518 PARROT_CANNOT_RETURN_NULL
1519 PMC *
Parrot_pf_get_current_packfile(PARROT_INTERP)1520 Parrot_pf_get_current_packfile(PARROT_INTERP)
1521 {
1522 ASSERT_ARGS(Parrot_pf_get_current_packfile)
1523 if (interp->code)
1524 return Parrot_pf_get_packfile_pmc(interp, interp->code->base.pf, STRINGNULL);
1525 else
1526 return PMCNULL;
1527 }
1528
1529 /*
1530
1531 =item C<PackFile_ByteCode * Parrot_pf_get_current_code_segment(PARROT_INTERP)>
1532
1533 Get's the interpreter's currently active bytecode segment
1534
1535 =cut
1536
1537 */
1538
1539 PARROT_PURE_FUNCTION
1540 PARROT_CAN_RETURN_NULL
1541 PackFile_ByteCode *
Parrot_pf_get_current_code_segment(PARROT_INTERP)1542 Parrot_pf_get_current_code_segment(PARROT_INTERP)
1543 {
1544 ASSERT_ARGS(Parrot_pf_get_current_code_segment)
1545 return interp->code;
1546 }
1547
1548 /*
1549
1550 =item C<void Parrot_pf_set_current_packfile(PARROT_INTERP, PMC *pbc)>
1551
1552 Set's the current packfile for the interpreter.
1553
1554 =cut
1555
1556 */
1557
1558 PARROT_EXPORT
1559 void
Parrot_pf_set_current_packfile(PARROT_INTERP,ARGIN (PMC * pbc))1560 Parrot_pf_set_current_packfile(PARROT_INTERP, ARGIN(PMC *pbc))
1561 {
1562 ASSERT_ARGS(Parrot_pf_set_current_packfile)
1563 if (PMC_IS_NULL(pbc))
1564 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
1565 "Cannot set null packfile");
1566 else {
1567 PackFile * const pf = (PackFile *)VTABLE_get_pointer(interp, pbc);
1568 Parrot_pf_switch_to_cs(interp, pf->cur_cs, 1);
1569 PARROT_GC_WRITE_BARRIER(interp, pbc);
1570 }
1571 }
1572
1573 /*
1574
1575 =item C<PackFile_ByteCode * Parrot_pf_create_default_segments(PARROT_INTERP, PMC
1576 * const pf_pmc, STRING * file_name, int add)>
1577
1578 Create the default seguments for the given packfile. Return the ByteCode
1579 segment created.
1580
1581 =cut
1582
1583 */
1584
1585 PARROT_EXPORT
1586 PARROT_WARN_UNUSED_RESULT
1587 PARROT_CANNOT_RETURN_NULL
1588 PackFile_ByteCode *
Parrot_pf_create_default_segments(PARROT_INTERP,ARGIN (PMC * const pf_pmc),ARGIN (STRING * file_name),int add)1589 Parrot_pf_create_default_segments(PARROT_INTERP, ARGIN(PMC * const pf_pmc),
1590 ARGIN(STRING * file_name), int add)
1591 {
1592 ASSERT_ARGS(Parrot_pf_create_default_segments)
1593
1594 PackFile *pf = (PackFile *)VTABLE_get_pointer(interp, pf_pmc);
1595 PackFile_ByteCode * const cur_cs =
1596 (PackFile_ByteCode *)create_seg(interp, &pf->directory,
1597 PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME, file_name, add);
1598 PARROT_GC_WRITE_BARRIER(interp, pf_pmc);
1599
1600 PARROT_ASSERT(cur_cs);
1601
1602 cur_cs->const_table =
1603 (PackFile_ConstTable *)create_seg(interp, &pf->directory,
1604 PF_CONST_SEG, CONSTANT_SEGMENT_NAME, file_name, add);
1605 PARROT_GC_WRITE_BARRIER(interp, pf_pmc);
1606
1607 cur_cs->const_table->code = cur_cs;
1608
1609
1610 return cur_cs;
1611 }
1612
1613 /*
1614
1615 =item C<PackFile_Debug * Parrot_pf_new_debug_segment(PARROT_INTERP,
1616 PackFile_ByteCode *cs, size_t size)>
1617
1618 Creates and appends (or resizes) a new debug seg for a code segment. Uses the
1619 given size as its size.
1620
1621 =cut
1622
1623 */
1624
1625 PARROT_EXPORT
1626 PARROT_WARN_UNUSED_RESULT
1627 PARROT_CANNOT_RETURN_NULL
1628 PackFile_Debug *
Parrot_pf_new_debug_segment(PARROT_INTERP,ARGMOD (PackFile_ByteCode * cs),size_t size)1629 Parrot_pf_new_debug_segment(PARROT_INTERP, ARGMOD(PackFile_ByteCode *cs), size_t size)
1630 {
1631 ASSERT_ARGS(Parrot_pf_new_debug_segment)
1632 PackFile_Debug *debug;
1633
1634 /* it exists already, resize it */
1635 if (cs->debugs) {
1636 debug = cs->debugs;
1637 debug->base.data = mem_gc_realloc_n_typed(interp, debug->base.data, size, opcode_t);
1638 }
1639 /* create one */
1640 else {
1641 STRING * name;
1642 const int add = (interp->code && interp->code->base.dir);
1643 PMC *current_pfpmc = Parrot_pf_get_current_packfile(interp);
1644 PackFile_Directory * const dir = add
1645 ? interp->code->base.dir
1646 : cs->base.dir
1647 ? cs->base.dir
1648 : &((PackFile*)VTABLE_get_pointer(interp, current_pfpmc))->directory;
1649 PARROT_GC_WRITE_BARRIER(interp, current_pfpmc);
1650
1651 name = Parrot_sprintf_c(interp, "%Ss_DB", cs->base.name);
1652 debug = (PackFile_Debug *)Parrot_pf_new_segment(interp, dir,
1653 PF_DEBUG_SEG, name, add);
1654
1655 debug->base.data = mem_gc_allocate_n_zeroed_typed(interp, size, opcode_t);
1656 debug->code = cs;
1657 cs->debugs = debug;
1658 }
1659
1660 debug->base.size = size;
1661
1662 return debug;
1663 }
1664
1665 /*
1666
1667 =item C<PackFile_Debug * Parrot_new_debug_seg(PARROT_INTERP, PackFile_ByteCode
1668 *cs, size_t size)>
1669
1670 Deprecated: Use C<Parrot_pf_new_debug_segment> instead. GH #1170
1671
1672 =cut
1673
1674 */
1675
1676 PARROT_EXPORT
1677 PARROT_WARN_UNUSED_RESULT
1678 PARROT_CANNOT_RETURN_NULL
1679 PARROT_DEPRECATED
1680 PackFile_Debug *
Parrot_new_debug_seg(PARROT_INTERP,ARGMOD (PackFile_ByteCode * cs),size_t size)1681 Parrot_new_debug_seg(PARROT_INTERP, ARGMOD(PackFile_ByteCode *cs), size_t size)
1682 {
1683 ASSERT_ARGS(Parrot_new_debug_seg)
1684 return Parrot_pf_new_debug_segment(interp, cs, size);
1685 }
1686
1687 /*
1688
1689 =item C<void Parrot_pf_debug_add_mapping(PARROT_INTERP, PackFile_Debug *debug,
1690 opcode_t offset, STRING *filename)>
1691
1692 Adds a bytecode offset to a filename mapping for a PackFile_Debug.
1693
1694 TODO: Refactor this function, it is too large and complicated.
1695
1696 =cut
1697
1698 */
1699
1700 PARROT_EXPORT
1701 void
Parrot_pf_debug_add_mapping(PARROT_INTERP,ARGMOD (PackFile_Debug * debug),opcode_t offset,ARGIN (STRING * filename))1702 Parrot_pf_debug_add_mapping(PARROT_INTERP, ARGMOD(PackFile_Debug *debug),
1703 opcode_t offset, ARGIN(STRING *filename))
1704 {
1705 ASSERT_ARGS(Parrot_pf_debug_add_mapping)
1706 PackFile_ConstTable * const ct = debug->code->const_table;
1707 int insert_pos = 0;
1708
1709 /* If the previous mapping has the same filename, don't record it. */
1710 if (debug->num_mappings) {
1711 const opcode_t prev_filename_n = debug->mappings[debug->num_mappings-1].filename;
1712 if (ct->str.constants[prev_filename_n] &&
1713 STRING_equal(interp, filename,
1714 ct->str.constants[prev_filename_n])) {
1715 return;
1716 }
1717 }
1718
1719 /* Allocate space for the extra entry. */
1720 debug->mappings = mem_gc_realloc_n_typed(interp,
1721 debug->mappings, debug->num_mappings + 1,
1722 PackFile_DebugFilenameMapping);
1723
1724 /* Can it just go on the end? */
1725 if (debug->num_mappings == 0
1726 || offset >= debug->mappings[debug->num_mappings - 1].offset) {
1727 insert_pos = debug->num_mappings;
1728 }
1729 else {
1730 /* Find the right place and shift stuff that's after it. */
1731 int i;
1732
1733 for (i = 0; i < debug->num_mappings; ++i) {
1734 if (debug->mappings[i].offset > offset) {
1735 insert_pos = i;
1736 memmove(debug->mappings + i + 1, debug->mappings + i,
1737 debug->num_mappings - i);
1738 break;
1739 }
1740 }
1741 }
1742
1743 /* Need to put filename in constants table. */
1744 {
1745 /* Set up new entry and insert it. */
1746 PackFile_DebugFilenameMapping *mapping = debug->mappings + insert_pos;
1747 size_t count = ct->str.const_count;
1748 size_t i;
1749
1750 mapping->offset = offset;
1751
1752 /* Check if there is already a constant with this filename */
1753 for (i= 0; i < count; ++i) {
1754 if (STRING_equal(interp, filename, ct->str.constants[i]))
1755 break;
1756 }
1757 if (i < count) {
1758 /* There is one, use it */
1759 count = i;
1760 }
1761 else {
1762 /* Not found, create a new one */
1763 ct->str.const_count++;
1764 ct->str.constants = mem_gc_realloc_n_typed_zeroed(interp, ct->str.constants,
1765 ct->str.const_count, ct->str.const_count - 1, STRING *);
1766 ct->str.constants[ct->str.const_count - 1] = filename;
1767 }
1768
1769 /* Set the mapped value */
1770 mapping->filename = count;
1771 debug->num_mappings = debug->num_mappings + 1;
1772 }
1773 }
1774
1775 /*
1776
1777 =item C<void Parrot_debug_add_mapping(PARROT_INTERP, PackFile_Debug *debug,
1778 opcode_t offset, STRING *filename)>
1779
1780 Deprecated: Use C<Parrot_pf_debug_add_mapping> instead. GH #1170
1781
1782 =cut
1783
1784 */
1785
1786 PARROT_EXPORT
1787 PARROT_DEPRECATED
1788 void
Parrot_debug_add_mapping(PARROT_INTERP,ARGMOD (PackFile_Debug * debug),opcode_t offset,ARGIN (STRING * filename))1789 Parrot_debug_add_mapping(PARROT_INTERP, ARGMOD(PackFile_Debug *debug),
1790 opcode_t offset, ARGIN(STRING *filename))
1791 {
1792 ASSERT_ARGS(Parrot_debug_add_mapping)
1793 Parrot_pf_debug_add_mapping(interp, debug, offset, filename);
1794 }
1795
1796 /*
1797
1798 =item C<STRING * Parrot_pf_debug_pc_to_filename(PARROT_INTERP, const
1799 PackFile_Debug *debug, opcode_t pc)>
1800
1801 Returns the filename of the source for the given position in the bytecode.
1802
1803 =cut
1804
1805 */
1806
1807 PARROT_EXPORT
1808 PARROT_WARN_UNUSED_RESULT
1809 PARROT_CANNOT_RETURN_NULL
1810 STRING *
Parrot_pf_debug_pc_to_filename(PARROT_INTERP,ARGIN (const PackFile_Debug * debug),opcode_t pc)1811 Parrot_pf_debug_pc_to_filename(PARROT_INTERP, ARGIN(const PackFile_Debug *debug),
1812 opcode_t pc)
1813 {
1814 ASSERT_ARGS(Parrot_pf_debug_pc_to_filename)
1815 /* Look through mappings until we find one that maps the passed
1816 bytecode offset. */
1817
1818 int i;
1819 for (i = 0; i < debug->num_mappings; ++i) {
1820 /* If this is the last mapping or the current position is
1821 between this mapping and the next one, return a filename. */
1822 if (i + 1 == debug->num_mappings
1823 || (debug->mappings[i].offset <= pc
1824 && debug->mappings[i + 1].offset > pc))
1825 return debug->code->const_table->str.constants[debug->mappings[i].filename];
1826 }
1827
1828 /* Otherwise, no mappings == no filename. */
1829 return CONST_STRING(interp, "(unknown file)");
1830 }
1831
1832 /*
1833
1834 =item C<STRING * Parrot_debug_pc_to_filename(PARROT_INTERP, const PackFile_Debug
1835 *debug, opcode_t pc)>
1836
1837 Deprecated: Use C<Parrot_pf_debug_pc_to_filename> instead. GH #1170
1838
1839 =cut
1840
1841 */
1842
1843 PARROT_EXPORT
1844 PARROT_WARN_UNUSED_RESULT
1845 PARROT_CANNOT_RETURN_NULL
1846 PARROT_DEPRECATED
1847 STRING *
Parrot_debug_pc_to_filename(PARROT_INTERP,ARGIN (const PackFile_Debug * debug),opcode_t pc)1848 Parrot_debug_pc_to_filename(PARROT_INTERP, ARGIN(const PackFile_Debug *debug),
1849 opcode_t pc)
1850 {
1851 ASSERT_ARGS(Parrot_debug_pc_to_filename)
1852 return Parrot_pf_debug_pc_to_filename(interp, debug, pc);
1853 }
1854
1855 /*
1856
1857 =item C<PackFile_ByteCode * Parrot_pf_switch_to_cs(PARROT_INTERP,
1858 PackFile_ByteCode *new_cs, int really)>
1859
1860 Switches to a bytecode segment C<new_cs>, returning the old segment.
1861
1862 =cut
1863
1864 */
1865
1866 PARROT_EXPORT
1867 PARROT_IGNORABLE_RESULT
1868 PARROT_CANNOT_RETURN_NULL
1869 PackFile_ByteCode *
Parrot_pf_switch_to_cs(PARROT_INTERP,ARGIN (PackFile_ByteCode * new_cs),int really)1870 Parrot_pf_switch_to_cs(PARROT_INTERP, ARGIN(PackFile_ByteCode *new_cs), int really)
1871 {
1872 ASSERT_ARGS(Parrot_pf_switch_to_cs)
1873 PackFile_ByteCode * const cur_cs = interp->code;
1874
1875 if (!new_cs)
1876 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_NO_PREV_CS,
1877 "No code segment to switch to");
1878
1879 interp->code = new_cs;
1880 Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp),
1881 new_cs->const_table);
1882
1883 if (really) {
1884 /* compiling source code uses this function too,
1885 * which gives misleading trace messages */
1886 #ifndef NDEBUG
1887 if (Interp_trace_TEST(interp, PARROT_TRACE_SUB_CALL_FLAG)) {
1888 Interp * const tracer = interp->pdb && interp->pdb->debugger
1889 ? interp->pdb->debugger
1890 : interp;
1891 Parrot_io_eprintf(tracer, "*** switching to %Ss\n",
1892 new_cs->base.name);
1893 }
1894 #endif
1895 prepare_for_run(interp);
1896 return cur_cs;
1897 }
1898
1899 return cur_cs;
1900 }
1901
1902 /*
1903
1904 =item C<PackFile_ByteCode * Parrot_switch_to_cs(PARROT_INTERP, PackFile_ByteCode
1905 *new_cs, int really)>
1906
1907 Deprecated: Use C<Parrot_pf_switch_to_cs> instead. GH #1170
1908
1909 =cut
1910
1911 */
1912
1913 PARROT_EXPORT
1914 PARROT_IGNORABLE_RESULT
1915 PARROT_CANNOT_RETURN_NULL
1916 PARROT_DEPRECATED
1917 PackFile_ByteCode *
Parrot_switch_to_cs(PARROT_INTERP,ARGIN (PackFile_ByteCode * new_cs),int really)1918 Parrot_switch_to_cs(PARROT_INTERP, ARGIN(PackFile_ByteCode *new_cs), int really)
1919 {
1920 ASSERT_ARGS(Parrot_switch_to_cs)
1921 return Parrot_pf_switch_to_cs(interp, new_cs, really);
1922 }
1923
1924 /*
1925
1926 =item C<static INTVAL find_pf_ann_idx(PackFile_Annotations *pfa,
1927 PackFile_Annotations_Key *key, UINTVAL offs)>
1928
1929 Find the index of the active annotation at the given offset.
1930
1931 =cut
1932
1933 */
1934
1935
1936 PARROT_PURE_FUNCTION
1937 PARROT_WARN_UNUSED_RESULT
1938 static INTVAL
find_pf_ann_idx(ARGIN (PackFile_Annotations * pfa),ARGIN (PackFile_Annotations_Key * key),UINTVAL offs)1939 find_pf_ann_idx(ARGIN(PackFile_Annotations *pfa),
1940 ARGIN(PackFile_Annotations_Key *key), UINTVAL offs)
1941 {
1942 ASSERT_ARGS(find_pf_ann_idx)
1943 UINTVAL hi, lo;
1944
1945 lo = key->start;
1946 hi = key->start + key->len;
1947
1948 while (1) {
1949 const UINTVAL mid = (lo + hi) / 2;
1950 const UINTVAL mid_val = pfa->base.data[mid * 2 + ANN_ENTRY_OFF];
1951
1952 if (mid_val < offs) {
1953 if (lo == mid)
1954 return mid; /* end of range search */
1955 lo = mid;
1956 }
1957 else if (mid_val > offs) {
1958 if (hi == key->start)
1959 return -1; /* bottomed out */
1960 hi = mid;
1961 }
1962 else {
1963 /* exact match: retrun prior annotation */
1964 return mid - 1;
1965 }
1966 }
1967 }
1968
1969 /*
1970
1971 =item C<void Parrot_pf_annotations_add_entry(PARROT_INTERP, PackFile_Annotations
1972 *self, opcode_t offset, opcode_t key, opcode_t type, opcode_t value)>
1973
1974 Adds a new bytecode annotation entry. Takes the annotations segment to add the
1975 entry to, the current bytecode offset (assumed to be the greatest one so far in
1976 the currently active group), the annotation key (as an index into the constants
1977 table), the annotation value type (one of PF_ANNOTATION_KEY_TYPE_INT,
1978 PF_ANNOTATION_KEY_TYPE_STR or PF_ANNOTATION_KEY_TYPE_NUM) and the value. The
1979 value will be an integer literal in the case of type being
1980 PF_ANNOTATION_KEY_TYPE_INT, or an index into the constants table otherwise.
1981
1982 =cut
1983
1984 */
1985
1986 PARROT_EXPORT
1987 void
Parrot_pf_annotations_add_entry(PARROT_INTERP,ARGMOD (PackFile_Annotations * self),opcode_t offset,opcode_t key,opcode_t type,opcode_t value)1988 Parrot_pf_annotations_add_entry(PARROT_INTERP, ARGMOD(PackFile_Annotations *self),
1989 opcode_t offset, opcode_t key, opcode_t type, opcode_t value)
1990 {
1991 ASSERT_ARGS(Parrot_pf_annotations_add_entry)
1992 opcode_t key_id = -1;
1993 INTVAL i, idx;
1994
1995 /* See if we already have this key. */
1996 for (i = 0; i < self->num_keys; ++i) {
1997 const opcode_t test_key = self->keys[i].name;
1998 if (key == test_key) {
1999 key_id = i;
2000 break;
2001 }
2002 }
2003
2004 if (key_id == -1) {
2005 /* We do have it. Add key entry. */
2006 if (self->keys)
2007 self->keys = mem_gc_realloc_n_typed_zeroed(interp, self->keys,
2008 1 + self->num_keys, self->num_keys, PackFile_Annotations_Key);
2009 else
2010 self->keys = mem_gc_allocate_n_typed(interp,
2011 1 + self->num_keys, PackFile_Annotations_Key);
2012
2013 key_id = self->num_keys++;
2014
2015 /* Populate it. */
2016 self->keys[key_id].name = key;
2017 self->keys[key_id].type = (pf_ann_key_type_t)type;
2018 self->keys[key_id].start = key_id == 0 ?
2019 0 :
2020 self->keys[key_id - 1].start + self->keys[key_id -1].len;
2021 self->keys[key_id].len = 0;
2022 }
2023 else {
2024 /* Ensure key types are compatible. */
2025 if (self->keys[key_id].type != (pf_ann_key_type_t)type)
2026 Parrot_ex_throw_from_c_args(interp, NULL,
2027 EXCEPTION_INVALID_OPERATION,
2028 "Annotations with different types of value used for key '%S'",
2029 self->code->const_table->str.constants[self->keys[key_id].name]);
2030 }
2031
2032 /* Lookup position where value will be inserted. */
2033 idx = self->keys[key_id].len == 0 ?
2034 self->keys[key_id].start * 2 :
2035 (UINTVAL)(find_pf_ann_idx(self, &self->keys[key_id], offset) + 1) * 2;
2036
2037 /* Extend segment data and shift subsequent data by 2. */
2038 self->base.data = (opcode_t *)mem_sys_realloc(self->base.data,
2039 (self->base.size + 2) * sizeof (opcode_t));
2040 memmove(&self->base.data[idx + 2], &self->base.data[idx],
2041 (self->base.size - idx) * sizeof (opcode_t));
2042 self->base.size += 2;
2043 for (i = key_id + 1; i < self->num_keys; i++)
2044 self->keys[i].start++;
2045
2046 /* Add entry. */
2047 self->base.data[idx + ANN_ENTRY_OFF] = offset;
2048 self->base.data[idx + ANN_ENTRY_VAL] = value;
2049 self->keys[key_id].len++;
2050 }
2051
2052 /*
2053
2054 =item C<void PackFile_Annotations_add_entry(PARROT_INTERP, PackFile_Annotations
2055 *self, opcode_t offset, opcode_t key, opcode_t type, opcode_t value)>
2056
2057 Deprecated: Use C<Parrot_pf_annotations_add_entry> instead. GH #1170
2058
2059 =cut
2060
2061 */
2062
2063 PARROT_EXPORT
2064 PARROT_DEPRECATED
2065 void
PackFile_Annotations_add_entry(PARROT_INTERP,ARGMOD (PackFile_Annotations * self),opcode_t offset,opcode_t key,opcode_t type,opcode_t value)2066 PackFile_Annotations_add_entry(PARROT_INTERP, ARGMOD(PackFile_Annotations *self),
2067 opcode_t offset, opcode_t key, opcode_t type, opcode_t value)
2068 {
2069 ASSERT_ARGS(PackFile_Annotations_add_entry)
2070 Parrot_pf_annotations_add_entry(interp, self, offset, key, type, value);
2071 }
2072
2073 /*
2074
2075 =item C<PMC * Parrot_pf_annotations_lookup(PARROT_INTERP, PackFile_Annotations
2076 *self, opcode_t offset, STRING *name)>
2077
2078 Looks up the annotation(s) in force at the given bytecode offset. If just one
2079 particular annotation is required, it can be passed as C<name>, and the value
2080 will be returned (or a NULL PMC if no annotation of that name is in force).
2081 Otherwise, a Hash will be returned of the all annotations. If there are none in
2082 force, an empty hash will be returned.
2083
2084 =cut
2085
2086 */
2087
2088 PARROT_CANNOT_RETURN_NULL
2089 PMC *
Parrot_pf_annotations_lookup(PARROT_INTERP,ARGIN (PackFile_Annotations * self),opcode_t offset,ARGIN_NULLOK (STRING * name))2090 Parrot_pf_annotations_lookup(PARROT_INTERP, ARGIN(PackFile_Annotations *self),
2091 opcode_t offset, ARGIN_NULLOK(STRING *name))
2092 {
2093 ASSERT_ARGS(Parrot_pf_annotations_lookup)
2094
2095 if (STRING_IS_NULL(name)) {
2096 /* find all annotations for this offset */
2097 PMC * const result = Parrot_pmc_new(interp, enum_class_Hash);
2098 INTVAL i;
2099 for (i = 0; i < self->num_keys; i++) {
2100 STRING * const k = self->code->const_table->str.constants[self->keys[i].name];
2101 PMC * const v = Parrot_pf_annotations_lookup(interp, self, offset, k);
2102 if (!PMC_IS_NULL(v))
2103 VTABLE_set_pmc_keyed_str(interp, result, k, v);
2104 }
2105
2106 return result;
2107 }
2108
2109 else {
2110 PackFile_Annotations_Key *key = NULL;
2111 INTVAL i;
2112 opcode_t val;
2113
2114 for (i = 0; i < self->num_keys; i++) {
2115 STRING * const test_key = self->code->const_table->str.constants[self->keys[i].name];
2116 if (STRING_equal(interp, test_key, name)) {
2117 key = &self->keys[i];
2118 break;
2119 }
2120 }
2121
2122 if (!key)
2123 return PMCNULL; /* no such key */
2124
2125 i = find_pf_ann_idx(self, key, offset);
2126
2127 if (i < 0)
2128 return PMCNULL; /* no active entry */
2129
2130 val = self->base.data[i * 2 + ANN_ENTRY_VAL];
2131
2132 switch (key->type) {
2133 case PF_ANNOTATION_KEY_TYPE_INT:
2134 return Parrot_pmc_box_integer(interp, val);
2135 case PF_ANNOTATION_KEY_TYPE_STR:
2136 return Parrot_pmc_box_string(interp, self->code->const_table->str.constants[val]);
2137 case PF_ANNOTATION_KEY_TYPE_PMC:
2138 return self->code->const_table->pmc.constants[val];
2139 default:
2140 Parrot_warn(interp, PARROT_WARNINGS_ALL_FLAG, "unexpected annotation type found");
2141 return PMCNULL;
2142 }
2143 }
2144 }
2145
2146 /*
2147
2148 =item C<PackFile_Annotations * Parrot_pf_get_annotations_segment(PARROT_INTERP,
2149 PackFile *pf, PackFile_ByteCode *bc)>
2150
2151 Returns the annotations segment. If none exists, create an empty one.
2152
2153 =cut
2154
2155 */
2156
2157 PARROT_EXPORT
2158 PARROT_CANNOT_RETURN_NULL
2159 PackFile_Annotations *
Parrot_pf_get_annotations_segment(PARROT_INTERP,ARGMOD (PackFile * pf),ARGMOD_NULLOK (PackFile_ByteCode * bc))2160 Parrot_pf_get_annotations_segment(PARROT_INTERP, ARGMOD(PackFile *pf),
2161 ARGMOD_NULLOK(PackFile_ByteCode *bc))
2162 {
2163 ASSERT_ARGS(Parrot_pf_get_annotations_segment)
2164 if (bc == NULL)
2165 bc = pf->cur_cs;
2166 if (bc->annotations != NULL)
2167 return bc->annotations;
2168 else {
2169 STRING * const name = Parrot_str_concat(interp, bc->base.name, CONST_STRING(interp, "_ANN"));
2170 PackFile_Directory * const dir = bc->base.dir ? bc->base.dir :
2171 &pf->directory;
2172 PackFile_Annotations * const annotations = (PackFile_Annotations *)
2173 Parrot_pf_new_segment(interp, dir, PF_ANNOTATIONS_SEG, name, 1);
2174 bc->annotations = annotations;
2175 annotations->code = bc;
2176 return annotations;
2177 }
2178 }
2179
2180 /*
2181
2182 =item C<static void push_context(PARROT_INTERP)>
2183
2184 Create a new context to isolate the effects of compiling code or loading pbc.
2185
2186 =cut
2187
2188 */
2189
2190 static void
push_context(PARROT_INTERP)2191 push_context(PARROT_INTERP)
2192 {
2193 ASSERT_ARGS(push_context)
2194 /* TODO: Make these "Arbitrary values" a macro somewhere, for easy tuning */
2195 const UINTVAL regs_used[] = { 2, 2, 2, 2 }; /* Arbitrary values */
2196 const int parrot_hll_id = 0;
2197 PMC * const context = Parrot_push_context(interp, regs_used);
2198 Parrot_pcc_set_HLL(interp, context, parrot_hll_id);
2199 Parrot_pcc_set_namespace(interp, context,
2200 Parrot_hll_get_HLL_namespace(interp, parrot_hll_id));
2201 }
2202
2203 /*
2204
2205 =item C<static void compile_file(PARROT_INTERP, STRING *path, INTVAL is_pasm)>
2206
2207 Compile a PIR or PASM file from source.
2208
2209 Deprecate: Do not use this. The packfile subsystem should not be in the
2210 business of compiling things, and should absolutely not default to any one
2211 particular compiler object (which might not exist). Use compreg opcode to get
2212 a compiler object and the interface there to get a packfile or equivalent.
2213
2214 =cut
2215
2216 */
2217
2218 PARROT_DEPRECATED
2219 static void
compile_file(PARROT_INTERP,ARGIN (STRING * path),INTVAL is_pasm)2220 compile_file(PARROT_INTERP, ARGIN(STRING *path), INTVAL is_pasm)
2221 {
2222 ASSERT_ARGS(compile_file)
2223 PackFile_ByteCode * const cur_code = interp->code;
2224 PMC * compiler;
2225 if (is_pasm)
2226 compiler = Parrot_interp_get_compiler(interp, CONST_STRING(interp, "PASM"));
2227 else
2228 compiler = Parrot_interp_get_compiler(interp, CONST_STRING(interp, "PIR"));
2229 {
2230 PMC * const pf_pmc = Parrot_interp_compile_file(interp, compiler, path);
2231 PMC * const pbc_cache = VTABLE_get_pmc_keyed_int(interp,
2232 interp->iglobals, IGLOBALS_LOADED_PBCS);
2233 PackFile * const pf = (PackFile*) VTABLE_get_pointer(interp, pf_pmc);
2234 PackFile_ByteCode * const cs = pf->cur_cs;
2235
2236 if (cs) {
2237 interp->code = cur_code;
2238 VTABLE_set_pmc_keyed_str(interp, pbc_cache, path, pf_pmc);
2239 pf_do_sub_pragmas(interp, pf_pmc, PBC_LOADED);
2240 }
2241 else {
2242 interp->code = cur_code;
2243 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
2244 "compiler returned NULL ByteCode '%Ss'", path);
2245 }
2246 }
2247 }
2248
2249
2250 /*
2251
2252 =item C<static void load_file(PARROT_INTERP, STRING *path)>
2253
2254 Load a bytecode file and append it to the current packfile directory.
2255
2256 =cut
2257
2258 */
2259
2260 static void
load_file(PARROT_INTERP,ARGIN (STRING * path))2261 load_file(PARROT_INTERP, ARGIN(STRING *path))
2262 {
2263 ASSERT_ARGS(load_file)
2264
2265 PackFile * const pf = Parrot_pf_read_pbc_file(interp, path);
2266 PMC * const pf_pmc = Parrot_pf_get_packfile_pmc(interp, pf, path);
2267
2268 if (!pf_pmc)
2269 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
2270 "Unable to load PBC file %Ss", path);
2271 else {
2272 PMC * const pbc_cache = VTABLE_get_pmc_keyed_int(interp,
2273 interp->iglobals, IGLOBALS_LOADED_PBCS);
2274 STRING * const method = CONST_STRING(interp, "mark_initialized");
2275 STRING * const load_str = CONST_STRING(interp, "load");
2276 VTABLE_set_pmc_keyed_str(interp, pbc_cache, path, pf_pmc);
2277 Parrot_pcc_invoke_method_from_c_args(interp, pf_pmc, method, "S->",
2278 load_str);
2279 pf_do_sub_pragmas(interp, pf_pmc, PBC_LOADED);
2280 }
2281 }
2282
2283 /*
2284
2285 =item C<void Parrot_load_language(PARROT_INTERP, STRING *lang_name)>
2286
2287 Load the compiler libraries for a given high-level language into the
2288 interpreter.
2289
2290 Deprecated: This function should either be renamed to
2291 C<Parrot_pf_load_language>, or should not be exposed through this
2292 API. GH #1170
2293
2294 TODO: Refactor this function and try to reduce the size of it. It is too big.
2295
2296 =cut
2297
2298 */
2299
2300 /*PARROT_DEPRECATED*/
2301 PARROT_EXPORT
2302 void
Parrot_load_language(PARROT_INTERP,ARGIN_NULLOK (STRING * lang_name))2303 Parrot_load_language(PARROT_INTERP, ARGIN_NULLOK(STRING *lang_name))
2304 {
2305 ASSERT_ARGS(Parrot_load_language)
2306 STRING *wo_ext, *file_str, *path, *pbc;
2307 STRING *found_path, *found_ext;
2308 INTVAL name_length;
2309 enum_runtime_ft file_type;
2310 PMC *is_loaded_hash;
2311
2312 if (STRING_IS_NULL(lang_name))
2313 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_LIBRARY_ERROR,
2314 "\"load_language\" no language name");
2315
2316 /* Full path to language library is "abc/abc.pbc". */
2317 pbc = CONST_STRING(interp, "pbc");
2318 wo_ext = Parrot_str_concat(interp, lang_name, CONST_STRING(interp, "/"));
2319 wo_ext = Parrot_str_concat(interp, wo_ext, lang_name);
2320 file_str = Parrot_str_concat(interp, wo_ext, CONST_STRING(interp, "."));
2321 file_str = Parrot_str_concat(interp, file_str, pbc);
2322
2323 /* Check if the language is already loaded */
2324 is_loaded_hash = VTABLE_get_pmc_keyed_int(interp,
2325 interp->iglobals, IGLOBALS_PBC_LIBS);
2326 if (VTABLE_exists_keyed_str(interp, is_loaded_hash, wo_ext))
2327 return;
2328
2329 file_type = PARROT_RUNTIME_FT_LANG;
2330
2331 path = Parrot_locate_runtime_file_str(interp, file_str, file_type);
2332 if (!path)
2333 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
2334 "\"load_language\" couldn't find a compiler module for the language '%Ss'", lang_name);
2335
2336 /* remember wo_ext => full_path mapping */
2337 VTABLE_set_string_keyed_str(interp, is_loaded_hash,
2338 wo_ext, path);
2339
2340 /* Add the include and dynext paths to the global search */
2341
2342 /* Get the base path of the located module */
2343 Parrot_split_path_ext(interp, path, &found_path, &found_ext);
2344 name_length = Parrot_str_length(interp, lang_name);
2345 found_path = STRING_substr(interp, found_path, 0,
2346 Parrot_str_length(interp, found_path)-name_length);
2347
2348 Parrot_lib_add_path(interp, Parrot_str_concat(interp, found_path, CONST_STRING(interp, "include/")),
2349 PARROT_LIB_PATH_INCLUDE);
2350 Parrot_lib_add_path(interp, Parrot_str_concat(interp, found_path, CONST_STRING(interp, "dynext/")),
2351 PARROT_LIB_PATH_DYNEXT);
2352 Parrot_lib_add_path(interp, Parrot_str_concat(interp, found_path, CONST_STRING(interp, "library/")),
2353 PARROT_LIB_PATH_LIBRARY);
2354
2355
2356 /* Check if the file found was actually a bytecode file (.pbc extension) or
2357 * a source file (.pir or .pasm extension. */
2358
2359 push_context(interp);
2360
2361 if (STRING_equal(interp, found_ext, pbc))
2362 load_file(interp, path);
2363 else {
2364 const STRING * pasm_s = CONST_STRING(interp, "pasm");
2365 const INTVAL is_pasm = STRING_equal(interp, found_ext, pasm_s);
2366 compile_file(interp, path, is_pasm);
2367 }
2368
2369 Parrot_pop_context(interp);
2370 }
2371
2372 /*
2373
2374 =item C<void Parrot_load_bytecode(PARROT_INTERP, Parrot_String file_str)>
2375
2376 Load a bytecode, PIR, or PASM file into the interpreter.
2377
2378 Deprecated: This function should either be renamed to
2379 C<Parrot_pf_load_bytecode>, or should not be exposed through this
2380 API. GH #1170
2381
2382 TODO: We need to cleanup the way bytecode is loaded. This probably needs some
2383 major changes.
2384
2385 =cut
2386
2387 */
2388
2389 /* intermediate hook during changes */
2390 /*PARROT_DEPRECATED*/
2391 PARROT_EXPORT
2392 void
Parrot_load_bytecode(PARROT_INTERP,ARGIN_NULLOK (Parrot_String file_str))2393 Parrot_load_bytecode(PARROT_INTERP, ARGIN_NULLOK(Parrot_String file_str))
2394 {
2395 ASSERT_ARGS(Parrot_load_bytecode)
2396 STRING *wo_ext, *ext, *pbc, *path;
2397 STRING *found_path, *found_ext;
2398 PMC *is_loaded_hash;
2399 enum_runtime_ft file_type;
2400
2401 if (STRING_IS_NULL(file_str))
2402 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_LIBRARY_ERROR,
2403 "\"load_bytecode\" no file name");
2404
2405 Parrot_split_path_ext(interp, file_str, &wo_ext, &ext);
2406
2407 /* check if wo_ext is loaded */
2408 is_loaded_hash = VTABLE_get_pmc_keyed_int(interp,
2409 interp->iglobals, IGLOBALS_PBC_LIBS);
2410
2411 if (VTABLE_exists_keyed_str(interp, is_loaded_hash, wo_ext))
2412 return;
2413
2414
2415
2416 pbc = CONST_STRING(interp, "pbc");
2417
2418 if (STRING_equal(interp, ext, pbc))
2419 file_type = PARROT_RUNTIME_FT_PBC;
2420 else
2421 file_type = PARROT_RUNTIME_FT_SOURCE;
2422
2423 path = Parrot_locate_runtime_file_str(interp, file_str, file_type);
2424 if (!path)
2425 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
2426 "\"load_bytecode\" couldn't find file '%Ss'", file_str);
2427
2428 /* remember wo_ext => full_path mapping */
2429 VTABLE_set_string_keyed_str(interp, is_loaded_hash, wo_ext, path);
2430
2431 Parrot_split_path_ext(interp, path, &found_path, &found_ext);
2432
2433 /* Check if the file found was actually a bytecode file (.pbc
2434 * extension) or a source file (.pir or .pasm extension). */
2435
2436 push_context(interp);
2437
2438 if (STRING_equal(interp, found_ext, pbc))
2439 load_file(interp, path);
2440 else {
2441 const STRING * pasm_s = CONST_STRING(interp, "pasm");
2442 const INTVAL is_pasm = STRING_equal(interp, ext, pasm_s);
2443 compile_file(interp, path, is_pasm);
2444 }
2445
2446 Parrot_pop_context(interp);
2447 }
2448
2449 /*
2450
2451 =item C<PMC * Parrot_pf_load_bytecode_search(PARROT_INTERP, STRING *file)>
2452
2453 Load a .pbc bytecode by short name, looking in standard search paths. Return
2454 a PackfileView PMC
2455
2456 =cut
2457
2458 */
2459
2460 PARROT_EXPORT
2461 PARROT_CANNOT_RETURN_NULL
2462 PMC *
Parrot_pf_load_bytecode_search(PARROT_INTERP,ARGIN (STRING * file))2463 Parrot_pf_load_bytecode_search(PARROT_INTERP, ARGIN(STRING *file))
2464 {
2465 ASSERT_ARGS(Parrot_pf_load_bytecode_search)
2466 const enum_runtime_ft file_type = PARROT_RUNTIME_FT_PBC;
2467 PMC * const pbc_cache = VTABLE_get_pmc_keyed_int(interp,
2468 interp->iglobals, IGLOBALS_LOADED_PBCS);
2469 STRING * const path = Parrot_locate_runtime_file_str(interp, file, file_type);
2470 if (STRING_IS_NULL(path))
2471 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
2472 "Cannot find library %Ss", file);
2473
2474 if (VTABLE_exists_keyed_str(interp, pbc_cache, path))
2475 return VTABLE_get_pmc_keyed_str(interp, pbc_cache, path);
2476 else {
2477 PackFile * const pf = Parrot_pf_read_pbc_file(interp, path);
2478 PMC * const pfview = Parrot_pf_get_packfile_pmc(interp, pf, path);
2479 VTABLE_set_pmc_keyed_str(interp, pbc_cache, path, pfview);
2480 return pfview;
2481 }
2482 }
2483
2484 /*
2485
2486 =item C<void Parrot_pf_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, PMC
2487 *eval)>
2488
2489 Calls C<:load>, C<:init>, C<:main>, C<:immediate> and/or C<:postcomp>
2490 subroutines in the current packfile, depending on the value of C<action>.
2491 See C<do_sub_pragmas> for more details.
2492
2493 Use C<Parrot_pf_prepare_packfile_init> and C<Parrot_pf_prepare_packfile_load>
2494 (and any other variants we need to create in the future) instead.
2495
2496 =cut
2497
2498 */
2499
2500 PARROT_EXPORT
2501 void
Parrot_pf_fixup_subs(PARROT_INTERP,pbc_action_enum_t what,SHIM (PMC * eval))2502 Parrot_pf_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, SHIM(PMC *eval))
2503 {
2504 ASSERT_ARGS(Parrot_pf_fixup_subs)
2505 pf_do_sub_pragmas(interp, Parrot_pf_get_current_packfile(interp), what);
2506 }
2507
2508 /*
2509
2510 =item C<void PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, PMC
2511 *eval)>
2512
2513 Deprecated: Use <Parrot_pf_fixup_subs> instead. GH #1170
2514
2515 =cut
2516
2517 */
2518
2519 PARROT_EXPORT
2520 PARROT_DEPRECATED
2521 void
PackFile_fixup_subs(PARROT_INTERP,pbc_action_enum_t what,SHIM (PMC * eval))2522 PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, SHIM(PMC *eval))
2523 {
2524 ASSERT_ARGS(PackFile_fixup_subs)
2525 pf_do_sub_pragmas(interp, Parrot_pf_get_current_packfile(interp), what);
2526 }
2527
2528 /*
2529
2530 =item C<void Parrot_pf_prepare_packfile_init(PARROT_INTERP, PMC * const pfpmc)>
2531
2532 Ready a PackFile which has just been loaded in to Parrot. Sort out the
2533 C<:main> function and trigger C<:init> functions. This is for packfiles which
2534 are intended to be executed as a program.
2535
2536 =cut
2537
2538 */
2539
2540 PARROT_EXPORT
2541 void
Parrot_pf_prepare_packfile_init(PARROT_INTERP,ARGIN (PMC * const pfpmc))2542 Parrot_pf_prepare_packfile_init(PARROT_INTERP, ARGIN(PMC * const pfpmc))
2543 {
2544 ASSERT_ARGS(Parrot_pf_prepare_packfile_init)
2545 if (PMC_IS_NULL(pfpmc))
2546 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
2547 "Could not load packfile: Invalid PMC");
2548 else {
2549 PackFile * const pf = (PackFile *)VTABLE_get_pointer(interp, pfpmc);
2550 if (!pf)
2551 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
2552 "Could not load packfile: Invalid Pointer");
2553 if (!(pf->options & PFOPT_HEADERONLY))
2554 pf_do_sub_pragmas(interp, pfpmc, PBC_MAIN);
2555 }
2556 }
2557
2558 /*
2559
2560 =item C<void Parrot_pf_prepare_packfile_load(PARROT_INTERP, PMC * const pfpmc)>
2561
2562 Ready a PackFile which has just been loaded in to Parrot. Trigger any C<:load>
2563 functions. This is for packfiles which are intended to be used as libraries.
2564
2565 =cut
2566
2567 */
2568
2569 PARROT_EXPORT
2570 void
Parrot_pf_prepare_packfile_load(PARROT_INTERP,ARGIN (PMC * const pfpmc))2571 Parrot_pf_prepare_packfile_load(PARROT_INTERP, ARGIN(PMC * const pfpmc))
2572 {
2573 ASSERT_ARGS(Parrot_pf_prepare_packfile_load)
2574 if (PMC_IS_NULL(pfpmc))
2575 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
2576 "Could not load packfile: Invalid PMC");
2577 else {
2578 PackFile * const pf = (PackFile *)VTABLE_get_pointer(interp, pfpmc);
2579 if (!pf)
2580 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
2581 "Could not load packfile: Invalid Pointer");
2582 if (!(pf->options & PFOPT_HEADERONLY))
2583 pf_do_sub_pragmas(interp, pfpmc, PBC_LOADED);
2584 }
2585 }
2586
2587 /*
2588
2589 =item C<void Parrot_pf_write_pbc_file(PARROT_INTERP, PMC *pf_pmc, STRING
2590 *filename)>
2591
2592 Take a Packfile or PackfileView PMC and write its contents out as a .pbc file
2593
2594 =item C<PackFile * Parrot_pf_read_pbc_file(PARROT_INTERP, STRING * const
2595 fullname)>
2596
2597 Read a F<.pbc> file with the given C<fullname> into a PackFile structure.
2598
2599 =cut
2600
2601 */
2602
2603 PARROT_EXPORT
2604 void
Parrot_pf_write_pbc_file(PARROT_INTERP,ARGIN (PMC * pf_pmc),ARGIN (STRING * filename))2605 Parrot_pf_write_pbc_file(PARROT_INTERP, ARGIN(PMC *pf_pmc), ARGIN(STRING *filename))
2606 {
2607 ASSERT_ARGS(Parrot_pf_write_pbc_file)
2608 PackFile * const pf = (PackFile *)VTABLE_get_pointer(interp, pf_pmc);
2609 if (!pf)
2610 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
2611 "Could not get packfile.");
2612 else {
2613 PIOHANDLE fp;
2614 Parrot_block_GC_mark(interp);
2615 fp = Parrot_io_internal_open(interp, filename, PIO_F_WRITE);
2616 if (fp == PIO_INVALID_HANDLE) {
2617 Parrot_unblock_GC_mark(interp);
2618 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
2619 "Cannot open output file %Ss", filename);
2620 }
2621 else {
2622 const Parrot_Int size = Parrot_pf_pack_size(interp, pf) * sizeof (opcode_t);
2623 opcode_t * const packed = (opcode_t*)mem_sys_allocate(size);
2624 Parrot_pf_pack(interp, pf, packed);
2625 Parrot_io_internal_write(interp, fp, (char *)packed, size);
2626 }
2627 Parrot_io_internal_close(interp, fp);
2628 Parrot_unblock_GC_mark(interp);
2629 }
2630 }
2631
2632 PARROT_EXPORT
2633 PARROT_CANNOT_RETURN_NULL
2634 PackFile *
Parrot_pf_read_pbc_file(PARROT_INTERP,ARGIN_NULLOK (STRING * const fullname))2635 Parrot_pf_read_pbc_file(PARROT_INTERP, ARGIN_NULLOK(STRING * const fullname))
2636 {
2637 ASSERT_ARGS(Parrot_pf_read_pbc_file)
2638 PackFile *pf;
2639 INTVAL program_size;
2640
2641 if (fullname == NULL || STRING_length(fullname) == 0) {
2642 PIOHANDLE stdin_h = Parrot_io_get_standard_piohandle(interp, PIO_STDIN_FILENO);
2643 STRING * const hname = CONST_STRING(interp, "standard input");
2644 pf = read_pbc_file_packfile_handle(interp, hname, stdin_h, 0);
2645 }
2646 else {
2647 /* can't read a file that doesn't exist */
2648 if (!Parrot_file_stat_intval(interp, fullname, STAT_EXISTS))
2649 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2650 "Can't stat %Ss, code %i", fullname, errno);
2651
2652 /* we may need to relax this if we want to read bytecode from pipes */
2653 if (!Parrot_file_stat_intval(interp, fullname, STAT_ISREG))
2654 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2655 "'%Ss' is not a regular file %i", fullname, errno);
2656
2657 /* check that fullname isn't NULL, just in case */
2658 if (!fullname)
2659 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
2660 "Trying to open a NULL filename");
2661
2662 program_size = Parrot_file_stat_intval(interp, fullname, STAT_FILESIZE);
2663 pf = read_pbc_file_packfile(interp, fullname, program_size);
2664 }
2665
2666 return pf;
2667 }
2668
2669
2670 /*
2671
2672 =item C<static PackFile* read_pbc_file_packfile_handle(PARROT_INTERP, STRING *
2673 const fullname, PIOHANDLE io, INTVAL program_size)>
2674
2675 Read a PackFile in from an open PIOHANDLE.
2676
2677 =cut
2678
2679 */
2680
2681 PARROT_CANNOT_RETURN_NULL
2682 static PackFile*
read_pbc_file_packfile_handle(PARROT_INTERP,ARGIN (STRING * const fullname),PIOHANDLE io,INTVAL program_size)2683 read_pbc_file_packfile_handle(PARROT_INTERP, ARGIN(STRING * const fullname),
2684 PIOHANDLE io, INTVAL program_size)
2685 {
2686 ASSERT_ARGS(read_pbc_file_packfile_handle)
2687 char * const program_code = read_pbc_file_bytes_handle(interp, io, program_size);
2688 PackFile * const pf = Parrot_pf_new(interp, 0);
2689 pf->options = 0;
2690
2691 /* XXX -Wcast-align Need to check alignment for RISC, or memcpy */
2692 if (!Parrot_pf_unpack(interp, pf, (opcode_t *)program_code, (size_t)program_size))
2693 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2694 "Can't unpack packfile %Ss", fullname);
2695 return pf;
2696 }
2697
2698 /*
2699
2700 =item C<static char * read_pbc_file_bytes_handle(PARROT_INTERP, PIOHANDLE io,
2701 INTVAL program_size)>
2702
2703 Read in the raw bytes of the packfile into a buffer. The buffer is allocated
2704 with C<mem_gc_realloc_n_typed>, so needs to be freed by the caller.
2705
2706 =cut
2707
2708 */
2709
2710 PARROT_CAN_RETURN_NULL
2711 static char *
read_pbc_file_bytes_handle(PARROT_INTERP,PIOHANDLE io,INTVAL program_size)2712 read_pbc_file_bytes_handle(PARROT_INTERP, PIOHANDLE io, INTVAL program_size)
2713 {
2714 ASSERT_ARGS(read_pbc_file_bytes_handle)
2715 size_t chunk_size = program_size > 0 ? program_size : 1024;
2716 INTVAL wanted = program_size;
2717 size_t read_result;
2718 char *program_code = mem_gc_allocate_n_typed(interp, chunk_size, char);
2719 char *cursor = program_code;
2720 program_size = 0;
2721
2722 while ((read_result = Parrot_io_internal_read(interp, io, cursor, chunk_size)) > 0) {
2723 program_size += read_result;
2724
2725 if (program_size == wanted)
2726 break;
2727
2728 chunk_size = 1024;
2729 program_code = mem_gc_realloc_n_typed(interp, program_code,
2730 program_size + chunk_size, char);
2731
2732 if (!program_code) {
2733 Parrot_io_internal_close(interp, io);
2734 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
2735 "Could not reallocate buffer while reading packfile from PIO");
2736 }
2737
2738 cursor = program_code + program_size;
2739 }
2740
2741 return program_code;
2742 }
2743
2744 /*
2745
2746 =item C<static PackFile * read_pbc_file_packfile(PARROT_INTERP, STRING * const
2747 fullname, INTVAL program_size)>
2748
2749 Read a pbc file into a PackFile*. May use mmap if available or direct reads
2750 from the file.
2751
2752 =cut
2753
2754 */
2755
2756 PARROT_CAN_RETURN_NULL
2757 static PackFile *
read_pbc_file_packfile(PARROT_INTERP,ARGIN (STRING * const fullname),INTVAL program_size)2758 read_pbc_file_packfile(PARROT_INTERP, ARGIN(STRING * const fullname),
2759 INTVAL program_size)
2760 {
2761 ASSERT_ARGS(read_pbc_file_packfile)
2762 char * program_code = NULL;
2763 PackFile * pf;
2764 PIOHANDLE io = Parrot_io_internal_open(interp, fullname, PIO_F_READ);
2765 INTVAL is_mapped = 0;
2766
2767 if (io == PIO_INVALID_HANDLE)
2768 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2769 "Can't open %Ss, code %i", fullname, errno);
2770
2771 /* TODO: Who frees program_code? We don't do it here (And don't need to
2772 if we've mmapped it. Figure out where this is handled and
2773 document it here.
2774 */
2775
2776 #ifndef PARROT_HAS_HEADER_SYSMAN
2777
2778 program_code = read_pbc_file_bytes_handle(interp, io, program_size);
2779
2780 #else
2781
2782 program_code = (char *)mmap(NULL, (size_t)program_size,
2783 PROT_READ, MAP_SHARED, io, (off_t)0);
2784
2785 /* If mmap fails, fall back and try to read the file from the handle
2786 directly.
2787 */
2788 if (program_code == (void *)MAP_FAILED) {
2789 Parrot_warn(interp, PARROT_WARNINGS_IO_FLAG,
2790 "Can't mmap file %s, code %i.\n", fullname, errno);
2791 program_code = read_pbc_file_bytes_handle(interp, fullname, io, program_size);
2792 }
2793 else
2794 is_mapped = 1;
2795
2796 #endif
2797
2798 pf = Parrot_pf_new(interp, is_mapped);
2799 pf->options = 0;
2800
2801 /* XXX -Wcast-align Need to check alignment for RISC, or memcpy */
2802 if (!Parrot_pf_unpack(interp, pf, (opcode_t *)program_code, (size_t)program_size))
2803 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
2804 "Can't unpack packfile %Ss", fullname);
2805
2806 Parrot_io_internal_close(interp, io);
2807 return pf;
2808 }
2809
2810 /*
2811
2812 =item C<static PMC* set_current_sub(PARROT_INTERP)>
2813
2814 Search the fixup table for a PMC matching the argument. On a match,
2815 set up the appropriate context.
2816
2817 If no match, set up a dummy PMC entry. In either case, return a
2818 pointer to the PMC.
2819
2820 =cut
2821
2822 */
2823
2824 /*PARROT_DEPRECATED*/
2825 PARROT_CANNOT_RETURN_NULL
2826 static PMC*
set_current_sub(PARROT_INTERP)2827 set_current_sub(PARROT_INTERP)
2828 {
2829 ASSERT_ARGS(set_current_sub)
2830 PMC *new_sub_pmc;
2831
2832 PackFile_ByteCode * const cur_cs = interp->code;
2833 PackFile_ConstTable * const ct = cur_cs->const_table;
2834 STRING * const SUB = CONST_STRING(interp, "Sub");
2835
2836 opcode_t i;
2837
2838 /*
2839 * Walk the fixup table. The first Sub-like entry should be our
2840 * entry point with the address at our resume_offset.
2841 */
2842 for (i = 0; i < ct->pmc.const_count; i++) {
2843 PMC * const sub_pmc = ct->pmc.constants[i];
2844 if (VTABLE_isa(interp, sub_pmc, SUB)) {
2845 Parrot_Sub_attributes *sub;
2846
2847 PMC_get_sub(interp, sub_pmc, sub);
2848 if (sub->seg == cur_cs) {
2849 const size_t offs = sub->start_offs;
2850
2851 if (offs == interp->resume_offset) {
2852 Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
2853 Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), sub->HLL_id);
2854 return sub_pmc;
2855 }
2856 break;
2857 }
2858 }
2859 }
2860
2861 /* If we didn't find anything, put a dummy PMC into current_sub.
2862 The default values set by Sub.init are appropriate for the
2863 dummy, don't need additional settings. */
2864 new_sub_pmc = Parrot_pmc_new(interp, enum_class_Sub);
2865 Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), new_sub_pmc);
2866
2867 return new_sub_pmc;
2868 }
2869
2870
2871 /*
2872
2873 =item C<void Parrot_pf_execute_bytecode_program(PARROT_INTERP, PMC *pbc, PMC
2874 *args)>
2875
2876 Execute a PackFile* as if it were a main program. This is an entrypoint into
2877 executing a Parrot program, it is not intended (and can be dangerous) if you
2878 try to call it from within a running Parrot program
2879
2880 =cut
2881
2882 */
2883
2884 PARROT_EXPORT
2885 void
Parrot_pf_execute_bytecode_program(PARROT_INTERP,ARGMOD (PMC * pbc),ARGMOD (PMC * args))2886 Parrot_pf_execute_bytecode_program(PARROT_INTERP, ARGMOD(PMC *pbc),
2887 ARGMOD(PMC *args))
2888 {
2889 ASSERT_ARGS(Parrot_pf_execute_bytecode_program)
2890 PMC * const current_pf = Parrot_pf_get_current_packfile(interp);
2891 PMC * main_sub;
2892 PackFile *pf = (PackFile*)VTABLE_get_pointer(interp, pbc);
2893
2894 if (!pf || !pf->cur_cs)
2895 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
2896 "Could not get packfile");
2897
2898 Parrot_pf_set_current_packfile(interp, pbc);
2899 Parrot_pf_prepare_packfile_init(interp, pbc);
2900 main_sub = packfile_main(pf->cur_cs);
2901
2902 /* if no sub was marked being :main, we create a dummy sub with offset 0 */
2903
2904 if (!main_sub)
2905 main_sub = set_current_sub(interp);
2906
2907 VTABLE_set_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_ARGV_LIST, args);
2908 Parrot_cx_begin_execution(interp, main_sub, args);
2909
2910 if (!PMC_IS_NULL(current_pf))
2911 Parrot_pf_set_current_packfile(interp, current_pf);
2912 }
2913
2914 /*
2915
2916 =item C<STRING * Parrot_pf_get_version_string(PARROT_INTERP, PMC * pbc)>
2917
2918 Get a Major.Minor.Patch version number for the given packfile
2919
2920 =cut
2921
2922 */
2923
2924 PARROT_EXPORT
2925 PARROT_CANNOT_RETURN_NULL
2926 STRING *
Parrot_pf_get_version_string(PARROT_INTERP,ARGIN (PMC * pbc))2927 Parrot_pf_get_version_string(PARROT_INTERP, ARGIN(PMC * pbc))
2928 {
2929 ASSERT_ARGS(Parrot_pf_get_version_string)
2930 PackFile * const pf = (PackFile *) VTABLE_get_pointer(interp, pbc);
2931 return Parrot_sprintf_c(interp, "%d.%d.%d",
2932 pf->header->major, pf->header->minor, pf->header->patch);
2933 }
2934
2935 /*
2936
2937 =item C<static PackFile_Segment * create_seg(PARROT_INTERP, PackFile_Directory
2938 *dir, pack_file_types t, STRING *name, STRING *file_name, int add)>
2939
2940 Creates a new PackFile_Segment for the given C<file_name>. See
2941 C<Parrot_pf_new_segment()> for the other arguments.
2942
2943 =cut
2944
2945 */
2946
2947 PARROT_WARN_UNUSED_RESULT
2948 PARROT_CANNOT_RETURN_NULL
2949 static PackFile_Segment *
create_seg(PARROT_INTERP,ARGMOD (PackFile_Directory * dir),pack_file_types t,ARGIN (STRING * name),ARGIN (STRING * file_name),int add)2950 create_seg(PARROT_INTERP, ARGMOD(PackFile_Directory *dir), pack_file_types t,
2951 ARGIN(STRING *name), ARGIN(STRING *file_name), int add)
2952 {
2953 ASSERT_ARGS(create_seg)
2954 STRING * const seg_name = Parrot_sprintf_c(interp, "%Ss_%Ss", name, file_name);
2955 PackFile_Segment * const seg = Parrot_pf_new_segment(interp, dir, t, seg_name, add);
2956 return seg;
2957 }
2958
2959
2960 /*
2961
2962 =back
2963
2964 =head1 HISTORY
2965
2966 Parrot_readbc and Parrot_loadbc renamed. Trace macros, long double and
2967 64-bit conversion work by Reini Urban 2009.
2968
2969 Rework by Melvin; new bytecode format, make bytecode portable. (Do
2970 endian conversion and wordsize transforms on the fly.)
2971
2972 leo applied and modified Juergen Boemmels packfile patch giving an
2973 extensible packfile format with directory reworked again, with common
2974 chunks (C<default_*>).
2975
2976 2003.11.21 leo: moved low level item fetch routines to new
2977 F<pf/pf_items.c>
2978
2979 =cut
2980
2981 */
2982
2983 /*
2984 * Local variables:
2985 * c-file-style: "parrot"
2986 * End:
2987 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
2988 */
2989