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