Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

2986 lines (2309 sloc) 88.324 kb
/*
Copyright (C) 2001-2015, Parrot Foundation.
This program is free software. It is subject to the same license as
Parrot itself.
=head1 NAME
src/packfile.c - Parrot PackFile API
=head1 DESCRIPTION
This file represents the public API for the packfile subsystem. It provides
several routines for working with PackFile* structures, and various
packfile-related PMC types. Any PMC type for which VTABLE_get_pointer returns
a PackFile* structure, and VTABLE_set_pointer takes a PackFile* can be used
with this system to represent a PackFile*.
See F<docs/pdds/pdd13_bytecode.pod> for details about the subsystem and the
format of bytecode.
=head2 PackFile Manipulation Functions
=over 4
=cut
*/
#include "pf_private.h"
#include "api.str"
#include "pmc/pmc_sub.h"
#include "pmc/pmc_packfileview.h"
/* HEADERIZER HFILE: include/parrot/packfile.h */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_DEPRECATED
static void compile_file(PARROT_INTERP, ARGIN(STRING *path), INTVAL is_pasm)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static PackFile_Segment * create_seg(PARROT_INTERP,
ARGMOD(PackFile_Directory *dir),
pack_file_types t,
ARGIN(STRING *name),
ARGIN(STRING *file_name),
int add)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(4)
__attribute__nonnull__(5)
FUNC_MODIFIES(*dir);
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC* do_1_sub_pragma(PARROT_INTERP,
ARGMOD(PMC *sub_pmc),
pbc_action_enum_t action)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*sub_pmc);
static INTVAL find_const_iter(PARROT_INTERP,
ARGMOD(PackFile_Segment *seg),
ARGIN_NULLOK(void *user_data))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*seg);
PARROT_PURE_FUNCTION
PARROT_WARN_UNUSED_RESULT
static INTVAL find_pf_ann_idx(
ARGIN(PackFile_Annotations *pfa),
ARGIN(PackFile_Annotations_Key *key),
UINTVAL offs)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void load_file(PARROT_INTERP, ARGIN(STRING *path))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void mark_1_bc_seg(PARROT_INTERP, ARGMOD(PackFile_ByteCode *bc))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*bc);
static void mark_1_ct_seg(PARROT_INTERP, ARGMOD(PackFile_ConstTable *ct))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*ct);
static void PackFile_Header_read_uuid(PARROT_INTERP,
ARGMOD(PackFile_Header *self),
ARGIN(const opcode_t *packed),
size_t packed_size)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
FUNC_MODIFIES(*self);
PARROT_WARN_UNUSED_RESULT
static int PackFile_Header_unpack(PARROT_INTERP,
ARGMOD(PackFile_Header *self),
ARGIN(const opcode_t *packed),
size_t packed_size,
INTVAL pf_options)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
FUNC_MODIFIES(*self);
static void PackFile_Header_validate(PARROT_INTERP,
ARGIN(const PackFile_Header *self),
INTVAL pf_options)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_CANNOT_RETURN_NULL
static PMC * packfile_main(ARGIN(PackFile_ByteCode *bc))
__attribute__nonnull__(1);
static void PackFile_set_header(ARGOUT(PackFile_Header *header))
__attribute__nonnull__(1)
FUNC_MODIFIES(*header);
static void pf_do_sub_pragmas(PARROT_INTERP,
ARGIN(PMC *pfpmc),
pbc_action_enum_t action)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void push_context(PARROT_INTERP)
__attribute__nonnull__(1);
PARROT_CAN_RETURN_NULL
static char * read_pbc_file_bytes_handle(PARROT_INTERP,
PIOHANDLE io,
INTVAL program_size)
__attribute__nonnull__(1);
PARROT_CAN_RETURN_NULL
static PackFile * read_pbc_file_packfile(PARROT_INTERP,
ARGIN(STRING * const fullname),
INTVAL program_size)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_CANNOT_RETURN_NULL
static PackFile* read_pbc_file_packfile_handle(PARROT_INTERP,
ARGIN(STRING * const fullname),
PIOHANDLE io,
INTVAL program_size)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_CANNOT_RETURN_NULL
static PMC* set_current_sub(PARROT_INTERP)
__attribute__nonnull__(1);
static int sub_pragma(PARROT_INTERP,
pbc_action_enum_t action,
ARGIN(const PMC *sub_pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(3);
#define ASSERT_ARGS_compile_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(path))
#define ASSERT_ARGS_create_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(dir) \
, PARROT_ASSERT_ARG(name) \
, PARROT_ASSERT_ARG(file_name))
#define ASSERT_ARGS_do_1_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(sub_pmc))
#define ASSERT_ARGS_find_const_iter __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(seg))
#define ASSERT_ARGS_find_pf_ann_idx __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(pfa) \
, PARROT_ASSERT_ARG(key))
#define ASSERT_ARGS_load_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(path))
#define ASSERT_ARGS_mark_1_bc_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(bc))
#define ASSERT_ARGS_mark_1_ct_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(ct))
#define ASSERT_ARGS_PackFile_Header_read_uuid __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self) \
, PARROT_ASSERT_ARG(packed))
#define ASSERT_ARGS_PackFile_Header_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self) \
, PARROT_ASSERT_ARG(packed))
#define ASSERT_ARGS_PackFile_Header_validate __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self))
#define ASSERT_ARGS_packfile_main __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(bc))
#define ASSERT_ARGS_PackFile_set_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(header))
#define ASSERT_ARGS_pf_do_sub_pragmas __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(pfpmc))
#define ASSERT_ARGS_push_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
#define ASSERT_ARGS_read_pbc_file_bytes_handle __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
#define ASSERT_ARGS_read_pbc_file_packfile __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(fullname))
#define ASSERT_ARGS_read_pbc_file_packfile_handle __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(fullname))
#define ASSERT_ARGS_set_current_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
#define ASSERT_ARGS_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(sub_pmc))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
/*
=item C<void Parrot_pf_destroy(PARROT_INTERP, PackFile *pf)>
Destroys a C<PackFile>, and frees resources. This does not automatically free
garbage collectable objects contained in that packfile (STRING and PMC) if
they are referenced from other places.
Notice that this can cause problems, if a Packfile is destroyed, but some of
its contents are not destroyed, but those contents contain indirect references
to other things in the packfile which are destroyed. Use with caution.
=cut
*/
PARROT_EXPORT
void
Parrot_pf_destroy(PARROT_INTERP, ARGMOD(PackFile *pf))
{
ASSERT_ARGS(Parrot_pf_destroy)
#ifdef PARROT_HAS_HEADER_SYSMMAN
if (pf->is_mmap_ped) {
DECL_CONST_CAST;
/* Cast the result to void to avoid a warning with
* some not-so-standard mmap headers
*/
munmap((void *)PARROT_const_cast(opcode_t *, pf->src), pf->size);
}
#endif
mem_gc_free(interp, pf->header);
pf->header = NULL;
mem_gc_free(interp, pf->dirp);
pf->dirp = NULL;
Parrot_pf_destroy_segment(interp, &pf->directory.base);
return;
}
/*
=item C<void PackFile_destroy(PARROT_INTERP, PackFile *pf)>
Deprecated. Use C<Parrot_pf_destroy> instead. GH #1170
=cut
*/
PARROT_EXPORT
PARROT_DEPRECATED
void
PackFile_destroy(PARROT_INTERP, ARGMOD(PackFile *pf))
{
ASSERT_ARGS(PackFile_destroy)
Parrot_pf_destroy(interp, pf);
}
/*
=item C<INTVAL Parrot_pf_serialized_size(PARROT_INTERP, PackFile *pf)>
Returns the size, in bytes, that a packfile will be if serialized
=item C<STRING * Parrot_pf_serialize(PARROT_INTERP, PackFile * const pf)>
Serialize a PackFile * into a STRING buffer
=item C<PackFile * Parrot_pf_deserialize(PARROT_INTERP, STRING *str)>
Deserialize a packfile which is stored in a STRING buffer
=cut
*/
PARROT_EXPORT
INTVAL
Parrot_pf_serialized_size(PARROT_INTERP, ARGMOD(PackFile *pf))
{
ASSERT_ARGS(Parrot_pf_serialized_size)
return Parrot_pf_pack_size(interp, pf);
}
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
STRING *
Parrot_pf_serialize(PARROT_INTERP, ARGIN(PackFile * const pf))
{
ASSERT_ARGS(Parrot_pf_serialize)
STRING *str;
/* Calculate required memory */
const opcode_t length = Parrot_pf_pack_size(interp, pf) * sizeof (opcode_t);
opcode_t * const ptr = (opcode_t*)Parrot_gc_allocate_memory_chunk(interp, length);
/* And pack it! */
Parrot_pf_pack(interp, pf, ptr);
str = Parrot_str_new_init(interp, (const char*)ptr, length,
Parrot_binary_encoding_ptr, 0);
Parrot_gc_free_memory_chunk(interp, ptr);
return str;
}
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PackFile *
Parrot_pf_deserialize(PARROT_INTERP, ARGIN(STRING *str))
{
ASSERT_ARGS(Parrot_pf_deserialize)
PackFile * const pf = Parrot_pf_new(interp, 0);
const opcode_t * const ptr =
(const opcode_t *)Parrot_str_cstring(interp, str);
const int length = Parrot_str_byte_length(interp, str);
if (!Parrot_pf_unpack(interp, pf, ptr, length)) {
Parrot_pf_destroy(interp, pf);
Parrot_ex_throw_from_c_noargs(interp,
EXCEPTION_MALFORMED_PACKFILE, "Can't unpack packfile");
}
return pf;
}
/*
=item C<void Parrot_pf_tag_constant(PARROT_INTERP, PackFile_ConstTable *ct,
const int tag_idx, const int const_idx)>
Tag a constant PMC with a constant STRING
=cut
*/
PARROT_EXPORT
void
Parrot_pf_tag_constant(PARROT_INTERP, ARGIN(PackFile_ConstTable *ct),
const int tag_idx, const int const_idx)
{
ASSERT_ARGS(Parrot_pf_tag_constant)
int lo, hi, cur;
const STRING *tag = ct->str.constants[tag_idx];
/* allocate space */
if (ct->tag_map == NULL) {
ct->tag_map = mem_gc_allocate_n_zeroed_typed(interp, 1, PackFile_ConstTagPair);
ct->ntags = 1;
}
else {
ct->tag_map = mem_gc_realloc_n_typed_zeroed(interp, ct->tag_map, ct->ntags + 1, ct->ntags,
PackFile_ConstTagPair);
ct->ntags++;
}
/* find the slot to insert into */
lo = 0;
cur = 0;
hi = ct->ntags - 1;
while (lo < hi) {
cur = (lo + hi)/2;
switch (STRING_compare(interp, tag, ct->str.constants[ct->tag_map[cur].tag_idx])) {
case -1:
lo = ++cur;
break;
case 0:
lo = hi = cur;
break;
case 1:
hi = cur;
break;
default:
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
"Non POSIX strcmp");
}
}
memmove(&ct->tag_map[cur + 1], &ct->tag_map[cur],
((ct->ntags - 1) - cur) * sizeof (PackFile_ConstTagPair));
ct->tag_map[cur].tag_idx = tag_idx;
ct->tag_map[cur].const_idx = const_idx;
}
/*
=item C<PMC * Parrot_pf_subs_by_tag(PARROT_INTERP, PMC * pfpmc, STRING * flag)>
Get an array of Subs in the packfile by named flag.
=cut
*/
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_pf_subs_by_tag(PARROT_INTERP, ARGIN(PMC * pfpmc), ARGIN(STRING * flag))
{
ASSERT_ARGS(Parrot_pf_subs_by_tag)
PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
int mode = 0;
PMC * const subs = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
if (!pf || !pf->cur_cs || !pf->cur_cs->const_table)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
"NULL or invalid packfile");
if (STRING_equal(interp, flag, CONST_STRING(interp, "load")))
mode = 1;
else if (STRING_equal(interp, flag, CONST_STRING(interp, "init")))
mode = 2;
{
PackFile_ConstTable * const ct = pf->cur_cs->const_table;
opcode_t flag_idx = -1;
int bottom_lo, bottom_hi, top_lo, top_hi, cur;
int i;
bottom_lo = top_lo = cur = 0;
bottom_hi = top_hi = ct->ntags;
/* find the first match (if any) */
while (flag_idx < 0) {
if (bottom_lo == top_hi) {
/* tag not present */
goto done_find_bounds;
}
cur = (bottom_lo + top_hi)/2;
switch (STRING_compare(interp, flag, ct->str.constants[ct->tag_map[cur].tag_idx])) {
case -1:
bottom_lo = cur + 1;
break;
case 0:
flag_idx = ct->tag_map[cur].tag_idx;
bottom_hi = cur;
top_lo = cur + 1;
break;
case 1:
top_hi = cur;
break;
default:
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
"Non POSIX strcmp");
}
}
/* find the bottom of the map's range with this tag */
while (bottom_lo < bottom_hi) {
cur = (bottom_lo + bottom_hi)/2;
if (ct->tag_map[cur].tag_idx == flag_idx)
bottom_hi = cur;
else
bottom_lo = cur + 1;
}
/* find the top */
while (top_lo < top_hi) {
cur = (top_lo + top_hi)/2;
if (ct->tag_map[cur].tag_idx == flag_idx)
top_lo = cur + 1;
else
top_hi = cur;
}
done_find_bounds:
for (i = bottom_lo; i < top_hi; i++)
VTABLE_push_pmc(interp, subs, ct->pmc.constants[ct->tag_map[i].const_idx]);
}
/* Backwards compatibility. :load is equivalent to "load" tag. :init is
equivalent to "init" tag */
if (mode == 1 || mode == 2) {
PackFile_ByteCode * const self = pf->cur_cs;
PackFile_ConstTable * const ct = self->const_table;
STRING * const SUB = CONST_STRING(interp, "Sub");
opcode_t i;
for (i = 0; i < ct->pmc.const_count; ++i) {
PMC * const sub_pmc = ct->pmc.constants[i];
Parrot_Sub_attributes *sub;
int pragmas;
if (!VTABLE_isa(interp, sub_pmc, SUB))
continue;
PMC_get_sub(interp, sub_pmc, sub);
pragmas = PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK & ~SUB_FLAG_IS_OUTER;
if (mode == 1 && (pragmas & SUB_FLAG_PF_LOAD))
VTABLE_push_pmc(interp, subs, sub_pmc);
else if (mode == 2 && Sub_comp_INIT_TEST(sub))
VTABLE_push_pmc(interp, subs, sub_pmc);
}
}
return subs;
}
/*
=item C<PMC * Parrot_pf_single_sub_by_tag(PARROT_INTERP, PMC * pfpmc, STRING *
flag)>
Get a single Sub from the packfile by named flag. If there are more than one
Subs with the given flag, it is unspecified which one is returned.
=cut
*/
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_pf_single_sub_by_tag(PARROT_INTERP, ARGIN(PMC * pfpmc), ARGIN(STRING * flag))
{
ASSERT_ARGS(Parrot_pf_single_sub_by_tag)
/* XXX use custom implementation */
PMC * const subs = Parrot_pf_subs_by_tag(interp, pfpmc, flag);
return PMC_IS_NULL(subs)
? PMCNULL
: VTABLE_get_pmc_keyed_int(interp, subs, 0);
}
/*
=item C<PMC * Parrot_pf_all_tags_list(PARROT_INTERP, PMC * pfpmc)>
Return a ResizableStringArray of all tags in the packfile.
=cut
*/
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC *
Parrot_pf_all_tags_list(PARROT_INTERP, ARGIN(PMC * pfpmc))
{
ASSERT_ARGS(Parrot_pf_all_tags_list)
PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
PMC * const tags = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
if (!pf || !pf->cur_cs || !pf->cur_cs->const_table)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
"NULL or invalid packfile");
{
PackFile_ConstTable * const ct = pf->cur_cs->const_table;
const opcode_t ntags = ct->ntags;
opcode_t i = 0;
opcode_t last_seen = -1;
for (; i < ntags; i++) {
const opcode_t cur_tag = ct->tag_map[i].tag_idx;
if (cur_tag == last_seen)
continue;
VTABLE_push_string(interp, tags, ct->str.constants[cur_tag]);
last_seen = cur_tag;
}
}
return tags;
}
/*
=item C<PMC * Parrot_pf_all_tagged_pmcs(PARROT_INTERP, PMC * pfpmc)>
Return a hash of all tags in the packfile. Each tag is a key in the hash. Each
value is a ResizablePMCArray of pmcs with that tag.
=cut
*/
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC *
Parrot_pf_all_tagged_pmcs(PARROT_INTERP, ARGIN(PMC * pfpmc))
{
ASSERT_ARGS(Parrot_pf_all_tagged_pmcs)
PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
PMC * const taghash = Parrot_pmc_new(interp, enum_class_Hash);
if (!pf || !pf->cur_cs || !pf->cur_cs->const_table)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
"NULL or invalid packfile");
{
PackFile_ConstTable * const ct = pf->cur_cs->const_table;
const opcode_t ntags = ct->ntags;
opcode_t i = 0;
opcode_t last_seen = -1;
STRING * cur_tag_str = NULL;
PMC * cur_tag_list = NULL;
for (; i < ntags; i++) {
const opcode_t cur_tag = ct->tag_map[i].tag_idx;
if (cur_tag != last_seen) {
cur_tag_str = ct->str.constants[cur_tag];
cur_tag_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
VTABLE_set_pmc_keyed_str(interp, taghash, cur_tag_str, cur_tag_list);
last_seen = cur_tag;
}
VTABLE_push_pmc(interp, cur_tag_list, ct->pmc.constants[ct->tag_map[i].const_idx]);
}
}
return taghash;
}
/*
=item C<PMC * Parrot_pf_all_subs(PARROT_INTERP, PMC *pfpmc)>
Return an array of all Sub PMCs from the packfile
=cut
*/
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC *
Parrot_pf_all_subs(PARROT_INTERP, ARGIN(PMC *pfpmc))
{
ASSERT_ARGS(Parrot_pf_all_subs)
PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
if (!pf || !pf->cur_cs || !pf->cur_cs->const_table)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
"NULL or invalid packfile");
{
PackFile_ConstTable * const ct = pf->cur_cs->const_table;
PMC * const array = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
INTVAL i;
STRING * const SUB = CONST_STRING(interp, "Sub");
for (i = 0; i < ct->pmc.const_count; ++i) {
PMC * const x = ct->pmc.constants[i];
if (VTABLE_isa(interp, x, SUB))
VTABLE_push_pmc(interp, array, x);
}
return array;
}
}
/*
=item C<static int sub_pragma(PARROT_INTERP, pbc_action_enum_t action, const PMC
*sub_pmc)>
Checks B<sub_pmc>'s pragmas (e.g. flags like C<:load>, C<:main>, etc.)
returning 1 if the sub should be run for C<action>, a C<pbc_action_enum_t>.
=cut
*/
static int
sub_pragma(PARROT_INTERP, pbc_action_enum_t action, ARGIN(const PMC *sub_pmc))
{
ASSERT_ARGS(sub_pragma)
/* Note: the const casting is only needed because of the
* internal details of the Sub_comp macros.
* The assumption is that the TEST versions are in fact const,
* so the casts are safe.
* These casts are a quick fix to allow parrot build with c++,
* a refactor of the macros will be a cleaner solution. */
DECL_CONST_CAST;
Parrot_Sub_attributes *sub;
int todo = 0;
const int pragmas = PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK
& ~SUB_FLAG_IS_OUTER;
PMC_get_sub(interp, PARROT_const_cast(PMC *, sub_pmc), sub);
if (!pragmas && !Sub_comp_INIT_TEST(sub))
return 0;
switch (action) {
case PBC_MAIN:
/* denote MAIN entry in first loaded PASM */
if (interp->resume_flag & RESUME_INITIAL)
todo = 1;
/* :init functions need to be called at MAIN time, so return 1 */
/* symreg.h:P_INIT */
if (Sub_comp_INIT_TEST(sub))
todo = 1;
break;
case PBC_LOADED:
/* symreg.h:P_LOAD */
if (pragmas & SUB_FLAG_PF_LOAD)
todo = 1;
break;
default:
break;
}
if (pragmas & (SUB_FLAG_PF_IMMEDIATE | SUB_FLAG_PF_POSTCOMP))
todo = 1;
return todo;
}
/*
=item C<static PMC* do_1_sub_pragma(PARROT_INTERP, PMC *sub_pmc,
pbc_action_enum_t action)>
Runs autoloaded or immediate bytecode, marking the MAIN subroutine entry.
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC*
do_1_sub_pragma(PARROT_INTERP, ARGMOD(PMC *sub_pmc), pbc_action_enum_t action)
{
ASSERT_ARGS(do_1_sub_pragma)
Parrot_Sub_attributes *sub;
PMC_get_sub(interp, sub_pmc, sub);
switch (action) {
case PBC_IMMEDIATE:
/* run IMMEDIATE sub */
if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_IMMEDIATE) {
void * const lo_var_ptr = interp->lo_var_ptr;
PMC *result = PMCNULL;
PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_IMMEDIATE;
Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->P", &result);
/* reset initial flag so MAIN detection works
* and reset lo_var_ptr to prev */
interp->resume_flag = RESUME_INITIAL;
interp->lo_var_ptr = lo_var_ptr;
return result;
}
break;
case PBC_POSTCOMP:
/* run POSTCOMP sub */
if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_POSTCOMP) {
PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_POSTCOMP;
Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->");
/* reset initial flag so MAIN detection works */
interp->resume_flag = RESUME_INITIAL;
return NULL;
}
break;
case PBC_LOADED:
if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_LOAD) {
/* only run :init/:load subs once */
Sub_comp_INIT_CLEAR(sub);
PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->");
}
break;
case PBC_MAIN:
/* run :init/:load tagged functions */
if (Sub_comp_INIT_TEST(sub)) {
/* only run :init/:load subs once */
Sub_comp_INIT_CLEAR(sub);
PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->");
interp->resume_flag = RESUME_INITIAL;
}
break;
default:
break;
}
return NULL;
}
/*
=item C<static void mark_1_ct_seg(PARROT_INTERP, PackFile_ConstTable *ct)>
Mark one ConstTable segment for GC.
=cut
*/
static void
mark_1_ct_seg(PARROT_INTERP, ARGMOD(PackFile_ConstTable *ct))
{
ASSERT_ARGS(mark_1_ct_seg)
opcode_t i;
if (ct->string_hash)
Parrot_hash_mark(interp, ct->string_hash);
if (ct->pmc_hash)
Parrot_hash_mark(interp, ct->pmc_hash);
for (i = 0; i < ct->str.const_count; i++)
Parrot_gc_mark_STRING_alive(interp, ct->str.constants[i]);
for (i = 0; i < ct->pmc.const_count; i++)
Parrot_gc_mark_PMC_alive(interp, ct->pmc.constants[i]);
}
/*
=item C<static void mark_1_bc_seg(PARROT_INTERP, PackFile_ByteCode *bc)>
Mark gcables in bytecode header.
=cut
*/
static void
mark_1_bc_seg(PARROT_INTERP, ARGMOD(PackFile_ByteCode *bc))
{
ASSERT_ARGS(mark_1_bc_seg)
size_t i;
for (i = 0; i < bc->n_libdeps; i++)
Parrot_gc_mark_STRING_alive(interp, bc->libdeps[i]);
}
/*
=item C<static INTVAL find_const_iter(PARROT_INTERP, PackFile_Segment *seg, void
*user_data)>
Iterates over a PackFile_Directory, marking any constant segments. Internal
use only.
=cut
*/
static INTVAL
find_const_iter(PARROT_INTERP, ARGMOD(PackFile_Segment *seg), ARGIN_NULLOK(void *user_data))
{
ASSERT_ARGS(find_const_iter)
Parrot_gc_mark_STRING_alive(interp, seg->name);
switch (seg->type) {
case PF_DIR_SEG:
Parrot_pf_map_segments(interp, (const PackFile_Directory *)seg,
find_const_iter, user_data);
break;
case PF_CONST_SEG:
mark_1_ct_seg(interp, (PackFile_ConstTable *)seg);
break;
case PF_BYTEC_SEG:
mark_1_bc_seg(interp, (PackFile_ByteCode *)seg);
break;
default:
break;
}
return 0;
}
/*
=item C<void Parrot_pf_mark_packfile(PARROT_INTERP, PackFile * pf)>
Mark the contents of a C<PackFile>.
=cut
*/
void
Parrot_pf_mark_packfile(PARROT_INTERP, ARGMOD_NULLOK(PackFile * pf))
{
ASSERT_ARGS(Parrot_pf_mark_packfile)
if (!pf)
return;
else {
/* locate top level dir */
PackFile_Directory * const dir = &pf->directory;
/* iterate over all dir/segs */
Parrot_pf_map_segments(interp, dir, find_const_iter, NULL);
}
}
/*
=item C<PMC * Parrot_pf_get_packfile_main_sub(PARROT_INTERP, PMC * pbc)>
Get the main function of the bytecode segment, if any.
=item C<static PMC * packfile_main(PackFile_ByteCode *bc)>
Access the main function of a bytecode segment.
=cut
*/
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_pf_get_packfile_main_sub(PARROT_INTERP, ARGIN(PMC * pbc))
{
ASSERT_ARGS(Parrot_pf_get_packfile_main_sub)
PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pbc);
if (pf == NULL || pf->cur_cs == NULL || pf->cur_cs->const_table == NULL)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
"Null or invalid PackFile");
return packfile_main(pf->cur_cs);
}
PARROT_CANNOT_RETURN_NULL
static PMC *
packfile_main(ARGIN(PackFile_ByteCode *bc))
{
ASSERT_ARGS(packfile_main)
const PackFile_ConstTable * const ct = bc->const_table;
if (!ct || !ct->pmc.constants || bc->main_sub < 0)
return PMCNULL;
return ct->pmc.constants[bc->main_sub];
}
/*
=item C<static void pf_do_sub_pragmas(PARROT_INTERP, PMC *pfpmc,
pbc_action_enum_t action)>
C<action> is one of C<PBC_LOADED>, C<PBC_INIT>, or C<PBC_MAIN>.
These determine which subs get executed at this point. Some rules:
:immediate subs always execute immediately
:postcomp subs always execute immediately
:main subs execute when we have the PBC_MAIN action
:init subs execute when :main does
:load subs execute on PBC_LOAD
The argument C<eval_pmc> is ignored.
TODO: This function and the entire underlying mechanism should be deprecated and
removed. See GH #428 for details.
=cut
*/
static void
pf_do_sub_pragmas(PARROT_INTERP, ARGIN(PMC *pfpmc), pbc_action_enum_t action)
{
ASSERT_ARGS(pf_do_sub_pragmas)
PackFile * const pf = (PackFile*)VTABLE_get_pointer(interp, pfpmc);
PackFile_ByteCode * const self = pf->cur_cs;
PackFile_ConstTable * const ct = self->const_table;
opcode_t i;
for (i = 0; i < ct->pmc.const_count; ++i) {
STRING * const SUB = CONST_STRING(interp, "Sub");
PMC * const sub_pmc = ct->pmc.constants[i];
if (VTABLE_isa(interp, sub_pmc, SUB)) {
Parrot_Sub_attributes *sub;
PMC_get_sub(interp, sub_pmc, sub);
if (action == 0)
continue;
if (((PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MASK)
|| (Sub_comp_get_FLAGS(sub) & SUB_COMP_FLAG_MASK))
&& sub_pragma(interp, action, sub_pmc)) {
PMC * const result = do_1_sub_pragma(interp, sub_pmc, action);
/* replace Sub PMC with computation results */
if (action == PBC_IMMEDIATE && !PMC_IS_NULL(result)) {
PObj_is_shared_SET(result); /* packfile constants are shared among threads */
ct->pmc.constants[i] = result;
PARROT_GC_WRITE_BARRIER(interp, pfpmc);
}
}
}
}
if (interp->resume_flag & RESUME_INITIAL) {
if (action == PBC_MAIN) {
if (self->main_sub < 0)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_LIBRARY_ERROR,
"No main sub found");
{
PMC * const mainsub = packfile_main(self);
opcode_t * const ptr = (opcode_t *)VTABLE_get_pointer(interp, mainsub);
Parrot_Sub_attributes *main_attrs;
PMC_get_sub(interp, mainsub, main_attrs);
interp->resume_offset = (ptr - main_attrs->seg->base.data);
}
}
}
}
/*
=item C<void do_sub_pragmas(PARROT_INTERP, PMC *pfpmc, pbc_action_enum_t action,
PMC *eval_pmc)>
This function and the entire underlying mechanism is deprecated and will be
removed. See GH #428 for details.
For now use C<pf_do_sub_pragmas> instead.
=cut
*/
PARROT_EXPORT
PARROT_DEPRECATED
void
do_sub_pragmas(PARROT_INTERP, ARGIN(PMC *pfpmc),
pbc_action_enum_t action, SHIM(PMC *eval_pmc))
{
ASSERT_ARGS(do_sub_pragmas)
pf_do_sub_pragmas(interp, pfpmc, action);
}
/*
=item C<static void PackFile_Header_validate(PARROT_INTERP, const
PackFile_Header *self, INTVAL pf_options)>
Validates a C<PackFile_Header>, ensuring that the magic number is valid and
that Parrot can read this bytecode version.
Raises an exception if the header doesn't validate.
=cut
*/
static void
PackFile_Header_validate(PARROT_INTERP, ARGIN(const PackFile_Header *self),
INTVAL pf_options)
{
ASSERT_ARGS(PackFile_Header_validate)
/* Ensure the magic is correct. */
if (memcmp(self->magic, "\376PBC\r\n\032\n", 8) != 0) {
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
"PackFile_Header_validate: Invalid Parrot bytecode file");
}
/* Ensure the bytecode version is one we can read. Currently, we only
* support bytecode versions matching the current one.
*
* tools/dev/pbc_header.pl --upd t/native_pbc/(ASTERISK).pbc
* stamps version and fingerprint in the native tests.
* NOTE: (ASTERISK) is *, we don't want to fool the C preprocessor. */
if (self->bc_major != PARROT_PBC_MAJOR
|| self->bc_minor != PARROT_PBC_MINOR) {
if (!(pf_options & PFOPT_UTILS))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PARROT_USAGE_ERROR,
"PackFile_Header_validate: This Parrot cannot read bytecode "
"files with version %d.%d.",
self->bc_major, self->bc_minor);
}
/* Check wordsize, byte order and floating point number type are valid. */
if (self->wordsize != 4 && self->wordsize != 8) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"PackFile_Header_validate: Invalid wordsize %d\n", self->wordsize);
}
if (self->byteorder != 0 && self->byteorder != 1) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"PackFile_Header_validate: Invalid byte ordering %d\n", self->byteorder);
}
if (self->floattype > FLOATTYPE_MAX) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"PackFile_Header_validate: Invalid floattype %d\n", self->floattype);
}
}
/*
=item C<static void PackFile_Header_read_uuid(PARROT_INTERP, PackFile_Header
*self, const opcode_t *packed, size_t packed_size)>
Reads a C<PackFile_Header>'s UUID from a block of memory and verifies that it
is valid.
=cut
*/
static void
PackFile_Header_read_uuid(PARROT_INTERP, ARGMOD(PackFile_Header *self),
ARGIN(const opcode_t *packed), size_t packed_size)
{
ASSERT_ARGS(PackFile_Header_read_uuid)
/* Check the UUID type is valid and, if needed, read a UUID. */
if (self->uuid_type == 0) {
/* No UUID; fine, nothing more to do. */
}
else if (self->uuid_type == 1) {
if (packed_size < (size_t) PACKFILE_HEADER_BYTES + self->uuid_size) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"PackFile_Header_read_uuid: Buffer length %d is shorter than PACKFILE_HEADER_BYTES "
"+ uuid_size %d\n", packed_size, PACKFILE_HEADER_BYTES + self->uuid_size);
}
/* Read in the UUID. We'll put it in a NULL-terminated string, just in
* case people use it that way. */
self->uuid_data = mem_gc_allocate_n_typed(interp,
self->uuid_size + 1, unsigned char);
memcpy(self->uuid_data, packed + PACKFILE_HEADER_BYTES,
self->uuid_size);
/* NULL terminate */
self->uuid_data[self->uuid_size] = '\0';
}
else
/* Don't know this UUID type. */
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"PackFile unpack: Invalid UUID type %d\n", self->uuid_type);
}
/*
=item C<static int PackFile_Header_unpack(PARROT_INTERP, PackFile_Header *self,
const opcode_t *packed, size_t packed_size, INTVAL pf_options)>
Unpacks a C<PackFile_Header> from a block of memory and perform some validation
to check that the head is correct.
Returns size of unpacked header.
=cut
*/
PARROT_WARN_UNUSED_RESULT
static int
PackFile_Header_unpack(PARROT_INTERP, ARGMOD(PackFile_Header *self),
ARGIN(const opcode_t *packed), size_t packed_size,
INTVAL pf_options)
{
ASSERT_ARGS(PackFile_Header_unpack)
/* Verify that the packfile isn't too small to contain a proper header */
if (packed_size < PACKFILE_HEADER_BYTES) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"PackFile unpack: Buffer length %d is shorter than PACKFILE_HEADER_BYTES %d.",
packed_size, PACKFILE_HEADER_BYTES);
}
/* Extract the header. */
memcpy(self, packed, PACKFILE_HEADER_BYTES);
/* Validate the header. */
PackFile_Header_validate(interp, self, pf_options);
/* Extract the header's UUID. */
PackFile_Header_read_uuid(interp, self, packed, packed_size);
/* Return the number of bytes in the header */
return PACKFILE_HEADER_BYTES + self->uuid_size;
}
/*
=item C<opcode_t Parrot_pf_unpack(PARROT_INTERP, PackFile *self, const opcode_t
*packed, size_t packed_size)>
Unpacks a C<PackFile> from a block of memory, ensuring that the magic number is
valid and that Parrot can read this bytecode version, Parrot, and performing
any required endian and word size transforms.
Returns size of unpacked opcodes if everything is okay, else zero (0).
=item C<opcode_t PackFile_unpack(PARROT_INTERP, PackFile *self, const opcode_t
*packed, size_t packed_size)>
Deprecated: Use C<Parrot_pf_unpack> instead. See GH #1170
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
opcode_t
Parrot_pf_unpack(PARROT_INTERP, ARGMOD(PackFile *self),
ARGIN(const opcode_t *packed), size_t packed_size)
{
ASSERT_ARGS(Parrot_pf_unpack)
PackFile_Header * const header = self->header;
const opcode_t *cursor;
int header_read_length;
self->src = packed;
self->size = packed_size;
/* Unpack the header */
header_read_length = PackFile_Header_unpack(interp, self->header, packed,
packed_size, self->options);
/* Set cursor to position after what we've read, allowing for padding to a
* 16 byte boundary. */
header_read_length += PAD_16_B(header_read_length);
cursor = packed + (header_read_length / sizeof (opcode_t));
/* Set what transforms we need to do when reading the rest of the file. */
PackFile_assign_transforms(self);
if (self->options & PFOPT_PMC_FREEZE_ONLY)
return cursor - packed;
/* Directory format. */
header->dir_format = PF_fetch_opcode(self, &cursor);
if (header->dir_format != PF_DIR_FORMAT) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"PackFile unpack: Dir format was %d not %d\n",
header->dir_format, PF_DIR_FORMAT);
}
/* Padding. */
(void)PF_fetch_opcode(self, &cursor);
(void)PF_fetch_opcode(self, &cursor);
(void)PF_fetch_opcode(self, &cursor);
self->directory.base.file_offset = (INTVAL)cursor - (INTVAL)self->src;
if (self->options & PFOPT_HEADERONLY)
return cursor - packed;
/* now unpack dir, which unpacks its contents ... */
Parrot_block_GC_mark(interp);
cursor = pf_segment_unpack(interp, &self->directory.base, cursor);
Parrot_unblock_GC_mark(interp);
#ifdef PARROT_HAS_HEADER_SYSMMAN
if (self->is_mmap_ped
&& (self->need_endianize || self->need_wordsize)) {
DECL_CONST_CAST;
/* Cast the result to void to avoid a warning with
* some not-so-standard mmap headers
*/
munmap((void *)PARROT_const_cast(opcode_t *, self->src), self->size);
self->is_mmap_ped = 0;
}
#endif
return cursor - packed;
}
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_DEPRECATED
opcode_t
PackFile_unpack(PARROT_INTERP, ARGMOD(PackFile *self),
ARGIN(const opcode_t *packed), size_t packed_size)
{
ASSERT_ARGS(PackFile_unpack)
return Parrot_pf_unpack(interp, self, packed, packed_size);
}
/*
=back
=head2 PackFile Structure Functions
=over 4
=item C<static void PackFile_set_header(PackFile_Header *header)>
Fills a C<PackFile> header with system specific data.
=cut
*/
static void
PackFile_set_header(ARGOUT(PackFile_Header *header))
{
ASSERT_ARGS(PackFile_set_header)
memcpy(header->magic, "\376PBC\r\n\032\n", 8);
header->wordsize = sizeof (opcode_t);
header->byteorder = PARROT_BIGENDIAN;
header->major = PARROT_MAJOR_VERSION;
header->minor = PARROT_MINOR_VERSION;
header->patch = PARROT_PATCH_VERSION;
header->bc_major = PARROT_PBC_MAJOR;
header->bc_minor = PARROT_PBC_MINOR;
#if NUMVAL_SIZE == 8
header->floattype = FLOATTYPE_8;
#else
# if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN
header->floattype = FLOATTYPE_12;
# else
# if (NUMVAL_SIZE == 16)
header->floattype = FLOATTYPE_16;
# else
Parrot_x_force_error_exit(NULL, 1,
"PackFile_set_header: Unsupported floattype NUMVAL_SIZE=%d,"
" PARROT_BIGENDIAN=%s\n", NUMVAL_SIZE,
PARROT_BIGENDIAN ? "big-endian" : "little-endian");
# endif
# endif
#endif
}
/*
=item C<PackFile * Parrot_pf_new(PARROT_INTERP, INTVAL is_mapped)>
Allocates a new empty C<PackFile> and sets up the directory.
Directory segment:
+----------+----------+----------+----------+
| Segment Header |
| .............. |
+----------+----------+----------+----------+
+----------+----------+----------+----------+
| number of directory items |
+----------+----------+----------+----------+
followed by a sequence of items
+----------+----------+----------+----------+
| Segment type |
+----------+----------+----------+----------+
| "name" |
| ... '\0' padding bytes |
+----------+----------+----------+----------+
| Offset in the file |
+----------+----------+----------+----------+
| Size of the segment |
+----------+----------+----------+----------+
"name" is a NUL-terminated c-string encoded in plain ASCII.
Segment types are defined in F<include/parrot/packfile.h>.
Offset and size are in C<opcode_t>.
A Segment Header has these entries:
- op_count total ops of segment incl. this count
- itype internal type of segment
- id internal id e.g code seg nr
- size size of following op array, 0 if none
* data possibly empty data, or e.g. byte code
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PackFile *
Parrot_pf_new(PARROT_INTERP, INTVAL is_mapped)
{
ASSERT_ARGS(Parrot_pf_new)
PackFile * const pf = mem_gc_allocate_zeroed_typed(interp, PackFile);
pf->header = mem_gc_allocate_zeroed_typed(interp, PackFile_Header);
pf->is_mmap_ped = is_mapped;
pf->options = PFOPT_NONE;
/* fill header with system specific data */
PackFile_set_header(pf->header);
/* Other fields empty for now */
pf->cur_cs = NULL;
pf_register_standard_funcs(pf);
/* create the master directory, all sub-dirs go there */
pf->directory.base.pf = pf;
pf->dirp = (PackFile_Directory *)
Parrot_pf_new_segment(interp, &pf->directory,
PF_DIR_SEG, DIRECTORY_SEGMENT_NAME, 0);
pf->directory = *pf->dirp;
pf->fetch_op = (packfile_fetch_op_t)NULL;
pf->fetch_iv = (packfile_fetch_iv_t)NULL;
pf->fetch_nv = (packfile_fetch_nv_t)NULL;
pf->view = NULL;
return pf;
}
/*
=item C<PackFile * PackFile_new(PARROT_INTERP, INTVAL is_mapped)>
Deprecated: Use C<Parrot_pf_new> instead. See GH #1170
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PARROT_DEPRECATED
PackFile *
PackFile_new(PARROT_INTERP, INTVAL is_mapped)
{
ASSERT_ARGS(PackFile_new)
return Parrot_pf_new(interp, is_mapped);
}
/*
=item C<PMC * Parrot_pf_get_packfile_pmc(PARROT_INTERP, PackFile *pf, STRING
*path)>
Get a new PMC to hold the PackFile* structure. The exact type of PMC returned
is not important, and consuming code should not rely on any particular type
being returned. The only guarantees which are made by this interface are that:
1) The PackFile* structure can be retrieved by VTABLE_get_pointer
2) The PackFile* structure is marked for GC when the PMC is marked for GC
=cut
*/
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_pf_get_packfile_pmc(PARROT_INTERP, ARGIN(PackFile *pf), ARGIN(STRING *path))
{
ASSERT_ARGS(Parrot_pf_get_packfile_pmc)
PMC *ptr;
if (pf->view)
return pf->view;
/* We have to block GC here. */
/* XXX We should never-ever have raw PackFile* laying around */
/* XXX But it require a lot of effort to cleanup codebase */
Parrot_block_GC_mark(interp);
ptr = Parrot_pmc_new(interp, enum_class_PackfileView);
VTABLE_set_pointer(interp, ptr, pf);
pf->view = ptr;
VTABLE_set_string_native(interp, ptr, path);
Parrot_unblock_GC_mark(interp);
/* TODO: We shouldn't need to register this here. But, this is a cheap
fix to make sure packfiles aren't getting collected prematurely */
Parrot_pmc_gc_register(interp, ptr);
return ptr;
}
/*
=item C<PMC * Parrot_pf_get_current_packfile(PARROT_INTERP)>
Get the interpreter's currently active PackFile
=cut
*/
PARROT_PURE_FUNCTION
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_pf_get_current_packfile(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_pf_get_current_packfile)
if (interp->code)
return Parrot_pf_get_packfile_pmc(interp, interp->code->base.pf, STRINGNULL);
else
return PMCNULL;
}
/*
=item C<PackFile_ByteCode * Parrot_pf_get_current_code_segment(PARROT_INTERP)>
Get's the interpreter's currently active bytecode segment
=cut
*/
PARROT_PURE_FUNCTION
PARROT_CAN_RETURN_NULL
PackFile_ByteCode *
Parrot_pf_get_current_code_segment(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_pf_get_current_code_segment)
return interp->code;
}
/*
=item C<void Parrot_pf_set_current_packfile(PARROT_INTERP, PMC *pbc)>
Set's the current packfile for the interpreter.
=cut
*/
PARROT_EXPORT
void
Parrot_pf_set_current_packfile(PARROT_INTERP, ARGIN(PMC *pbc))
{
ASSERT_ARGS(Parrot_pf_set_current_packfile)
if (PMC_IS_NULL(pbc))
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
"Cannot set null packfile");
else {
PackFile * const pf = (PackFile *)VTABLE_get_pointer(interp, pbc);
Parrot_pf_switch_to_cs(interp, pf->cur_cs, 1);
PARROT_GC_WRITE_BARRIER(interp, pbc);
}
}
/*
=item C<PackFile_ByteCode * Parrot_pf_create_default_segments(PARROT_INTERP, PMC
* const pf_pmc, STRING * file_name, int add)>
Create the default seguments for the given packfile. Return the ByteCode
segment created.
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PackFile_ByteCode *
Parrot_pf_create_default_segments(PARROT_INTERP, ARGIN(PMC * const pf_pmc),
ARGIN(STRING * file_name), int add)
{
ASSERT_ARGS(Parrot_pf_create_default_segments)
PackFile *pf = (PackFile *)VTABLE_get_pointer(interp, pf_pmc);
PackFile_ByteCode * const cur_cs =
(PackFile_ByteCode *)create_seg(interp, &pf->directory,
PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME, file_name, add);
PARROT_GC_WRITE_BARRIER(interp, pf_pmc);
PARROT_ASSERT(cur_cs);
cur_cs->const_table =
(PackFile_ConstTable *)create_seg(interp, &pf->directory,
PF_CONST_SEG, CONSTANT_SEGMENT_NAME, file_name, add);
PARROT_GC_WRITE_BARRIER(interp, pf_pmc);
cur_cs->const_table->code = cur_cs;
return cur_cs;
}
/*
=item C<PackFile_Debug * Parrot_pf_new_debug_segment(PARROT_INTERP,
PackFile_ByteCode *cs, size_t size)>
Creates and appends (or resizes) a new debug seg for a code segment. Uses the
given size as its size.
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PackFile_Debug *
Parrot_pf_new_debug_segment(PARROT_INTERP, ARGMOD(PackFile_ByteCode *cs), size_t size)
{
ASSERT_ARGS(Parrot_pf_new_debug_segment)
PackFile_Debug *debug;
/* it exists already, resize it */
if (cs->debugs) {
debug = cs->debugs;
debug->base.data = mem_gc_realloc_n_typed(interp, debug->base.data, size, opcode_t);
}
/* create one */
else {
STRING * name;
const int add = (interp->code && interp->code->base.dir);
PMC *current_pfpmc = Parrot_pf_get_current_packfile(interp);
PackFile_Directory * const dir = add
? interp->code->base.dir
: cs->base.dir
? cs->base.dir
: &((PackFile*)VTABLE_get_pointer(interp, current_pfpmc))->directory;
PARROT_GC_WRITE_BARRIER(interp, current_pfpmc);
name = Parrot_sprintf_c(interp, "%Ss_DB", cs->base.name);
debug = (PackFile_Debug *)Parrot_pf_new_segment(interp, dir,
PF_DEBUG_SEG, name, add);
debug->base.data = mem_gc_allocate_n_zeroed_typed(interp, size, opcode_t);
debug->code = cs;
cs->debugs = debug;
}
debug->base.size = size;
return debug;
}
/*
=item C<PackFile_Debug * Parrot_new_debug_seg(PARROT_INTERP, PackFile_ByteCode
*cs, size_t size)>
Deprecated: Use C<Parrot_pf_new_debug_segment> instead. GH #1170
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PARROT_DEPRECATED
PackFile_Debug *
Parrot_new_debug_seg(PARROT_INTERP, ARGMOD(PackFile_ByteCode *cs), size_t size)
{
ASSERT_ARGS(Parrot_new_debug_seg)
return Parrot_pf_new_debug_segment(interp, cs, size);
}
/*
=item C<void Parrot_pf_debug_add_mapping(PARROT_INTERP, PackFile_Debug *debug,
opcode_t offset, STRING *filename)>
Adds a bytecode offset to a filename mapping for a PackFile_Debug.
TODO: Refactor this function, it is too large and complicated.
=cut
*/
PARROT_EXPORT
void
Parrot_pf_debug_add_mapping(PARROT_INTERP, ARGMOD(PackFile_Debug *debug),
opcode_t offset, ARGIN(STRING *filename))
{
ASSERT_ARGS(Parrot_pf_debug_add_mapping)
PackFile_ConstTable * const ct = debug->code->const_table;
int insert_pos = 0;
/* If the previous mapping has the same filename, don't record it. */
if (debug->num_mappings) {
const opcode_t prev_filename_n = debug->mappings[debug->num_mappings-1].filename;
if (ct->str.constants[prev_filename_n] &&
STRING_equal(interp, filename,
ct->str.constants[prev_filename_n])) {
return;
}
}
/* Allocate space for the extra entry. */
debug->mappings = mem_gc_realloc_n_typed(interp,
debug->mappings, debug->num_mappings + 1,
PackFile_DebugFilenameMapping);
/* Can it just go on the end? */
if (debug->num_mappings == 0
|| offset >= debug->mappings[debug->num_mappings - 1].offset) {
insert_pos = debug->num_mappings;
}
else {
/* Find the right place and shift stuff that's after it. */
int i;
for (i = 0; i < debug->num_mappings; ++i) {
if (debug->mappings[i].offset > offset) {
insert_pos = i;
memmove(debug->mappings + i + 1, debug->mappings + i,
debug->num_mappings - i);
break;
}
}
}
/* Need to put filename in constants table. */
{
/* Set up new entry and insert it. */
PackFile_DebugFilenameMapping *mapping = debug->mappings + insert_pos;
size_t count = ct->str.const_count;
size_t i;
mapping->offset = offset;
/* Check if there is already a constant with this filename */
for (i= 0; i < count; ++i) {
if (STRING_equal(interp, filename, ct->str.constants[i]))
break;
}
if (i < count) {
/* There is one, use it */
count = i;
}
else {
/* Not found, create a new one */
ct->str.const_count++;
ct->str.constants = mem_gc_realloc_n_typed_zeroed(interp, ct->str.constants,
ct->str.const_count, ct->str.const_count - 1, STRING *);
ct->str.constants[ct->str.const_count - 1] = filename;
}
/* Set the mapped value */
mapping->filename = count;
debug->num_mappings = debug->num_mappings + 1;
}
}
/*
=item C<void Parrot_debug_add_mapping(PARROT_INTERP, PackFile_Debug *debug,
opcode_t offset, STRING *filename)>
Deprecated: Use C<Parrot_pf_debug_add_mapping> instead. GH #1170
=cut
*/
PARROT_EXPORT
PARROT_DEPRECATED
void
Parrot_debug_add_mapping(PARROT_INTERP, ARGMOD(PackFile_Debug *debug),
opcode_t offset, ARGIN(STRING *filename))
{
ASSERT_ARGS(Parrot_debug_add_mapping)
Parrot_pf_debug_add_mapping(interp, debug, offset, filename);
}
/*
=item C<STRING * Parrot_pf_debug_pc_to_filename(PARROT_INTERP, const
PackFile_Debug *debug, opcode_t pc)>
Returns the filename of the source for the given position in the bytecode.
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
STRING *
Parrot_pf_debug_pc_to_filename(PARROT_INTERP, ARGIN(const PackFile_Debug *debug),
opcode_t pc)
{
ASSERT_ARGS(Parrot_pf_debug_pc_to_filename)
/* Look through mappings until we find one that maps the passed
bytecode offset. */
int i;
for (i = 0; i < debug->num_mappings; ++i) {
/* If this is the last mapping or the current position is
between this mapping and the next one, return a filename. */
if (i + 1 == debug->num_mappings
|| (debug->mappings[i].offset <= pc
&& debug->mappings[i + 1].offset > pc))
return debug->code->const_table->str.constants[debug->mappings[i].filename];
}
/* Otherwise, no mappings == no filename. */
return CONST_STRING(interp, "(unknown file)");
}
/*
=item C<STRING * Parrot_debug_pc_to_filename(PARROT_INTERP, const PackFile_Debug
*debug, opcode_t pc)>
Deprecated: Use C<Parrot_pf_debug_pc_to_filename> instead. GH #1170
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PARROT_DEPRECATED
STRING *
Parrot_debug_pc_to_filename(PARROT_INTERP, ARGIN(const PackFile_Debug *debug),
opcode_t pc)
{
ASSERT_ARGS(Parrot_debug_pc_to_filename)
return Parrot_pf_debug_pc_to_filename(interp, debug, pc);
}
/*
=item C<PackFile_ByteCode * Parrot_pf_switch_to_cs(PARROT_INTERP,
PackFile_ByteCode *new_cs, int really)>
Switches to a bytecode segment C<new_cs>, returning the old segment.
=cut
*/
PARROT_EXPORT
PARROT_IGNORABLE_RESULT
PARROT_CANNOT_RETURN_NULL
PackFile_ByteCode *
Parrot_pf_switch_to_cs(PARROT_INTERP, ARGIN(PackFile_ByteCode *new_cs), int really)
{
ASSERT_ARGS(Parrot_pf_switch_to_cs)
PackFile_ByteCode * const cur_cs = interp->code;
if (!new_cs)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_NO_PREV_CS,
"No code segment to switch to");
interp->code = new_cs;
Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp),
new_cs->const_table);
if (really) {
/* compiling source code uses this function too,
* which gives misleading trace messages */
#ifndef NDEBUG
if (Interp_trace_TEST(interp, PARROT_TRACE_SUB_CALL_FLAG)) {
Interp * const tracer = interp->pdb && interp->pdb->debugger
? interp->pdb->debugger
: interp;
Parrot_io_eprintf(tracer, "*** switching to %Ss\n",
new_cs->base.name);
}
#endif
prepare_for_run(interp);
return cur_cs;
}
return cur_cs;
}
/*
=item C<PackFile_ByteCode * Parrot_switch_to_cs(PARROT_INTERP, PackFile_ByteCode
*new_cs, int really)>
Deprecated: Use C<Parrot_pf_switch_to_cs> instead. GH #1170
=cut
*/
PARROT_EXPORT
PARROT_IGNORABLE_RESULT
PARROT_CANNOT_RETURN_NULL
PARROT_DEPRECATED
PackFile_ByteCode *
Parrot_switch_to_cs(PARROT_INTERP, ARGIN(PackFile_ByteCode *new_cs), int really)
{
ASSERT_ARGS(Parrot_switch_to_cs)
return Parrot_pf_switch_to_cs(interp, new_cs, really);
}
/*
=item C<static INTVAL find_pf_ann_idx(PackFile_Annotations *pfa,
PackFile_Annotations_Key *key, UINTVAL offs)>
Find the index of the active annotation at the given offset.
=cut
*/
PARROT_PURE_FUNCTION
PARROT_WARN_UNUSED_RESULT
static INTVAL
find_pf_ann_idx(ARGIN(PackFile_Annotations *pfa),
ARGIN(PackFile_Annotations_Key *key), UINTVAL offs)
{
ASSERT_ARGS(find_pf_ann_idx)
UINTVAL hi, lo;
lo = key->start;
hi = key->start + key->len;
while (1) {
const UINTVAL mid = (lo + hi) / 2;
const UINTVAL mid_val = pfa->base.data[mid * 2 + ANN_ENTRY_OFF];
if (mid_val < offs) {
if (lo == mid)
return mid; /* end of range search */
lo = mid;
}
else if (mid_val > offs) {
if (hi == key->start)
return -1; /* bottomed out */
hi = mid;
}
else {
/* exact match: retrun prior annotation */
return mid - 1;
}
}
}
/*
=item C<void Parrot_pf_annotations_add_entry(PARROT_INTERP, PackFile_Annotations
*self, opcode_t offset, opcode_t key, opcode_t type, opcode_t value)>
Adds a new bytecode annotation entry. Takes the annotations segment to add the
entry to, the current bytecode offset (assumed to be the greatest one so far in
the currently active group), the annotation key (as an index into the constants
table), the annotation value type (one of PF_ANNOTATION_KEY_TYPE_INT,
PF_ANNOTATION_KEY_TYPE_STR or PF_ANNOTATION_KEY_TYPE_NUM) and the value. The
value will be an integer literal in the case of type being
PF_ANNOTATION_KEY_TYPE_INT, or an index into the constants table otherwise.
=cut
*/
PARROT_EXPORT
void
Parrot_pf_annotations_add_entry(PARROT_INTERP, ARGMOD(PackFile_Annotations *self),
opcode_t offset, opcode_t key, opcode_t type, opcode_t value)
{
ASSERT_ARGS(Parrot_pf_annotations_add_entry)
opcode_t key_id = -1;
INTVAL i, idx;
/* See if we already have this key. */
for (i = 0; i < self->num_keys; ++i) {
const opcode_t test_key = self->keys[i].name;
if (key == test_key) {
key_id = i;
break;
}
}
if (key_id == -1) {
/* We do have it. Add key entry. */
if (self->keys)
self->keys = mem_gc_realloc_n_typed_zeroed(interp, self->keys,
1 + self->num_keys, self->num_keys, PackFile_Annotations_Key);
else
self->keys = mem_gc_allocate_n_typed(interp,
1 + self->num_keys, PackFile_Annotations_Key);
key_id = self->num_keys++;
/* Populate it. */
self->keys[key_id].name = key;
self->keys[key_id].type = (pf_ann_key_type_t)type;
self->keys[key_id].start = key_id == 0 ?
0 :
self->keys[key_id - 1].start + self->keys[key_id -1].len;
self->keys[key_id].len = 0;
}
else {
/* Ensure key types are compatible. */
if (self->keys[key_id].type != (pf_ann_key_type_t)type)
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_OPERATION,
"Annotations with different types of value used for key '%S'",
self->code->const_table->str.constants[self->keys[key_id].name]);
}
/* Lookup position where value will be inserted. */
idx = self->keys[key_id].len == 0 ?
self->keys[key_id].start * 2 :
(UINTVAL)(find_pf_ann_idx(self, &self->keys[key_id], offset) + 1) * 2;
/* Extend segment data and shift subsequent data by 2. */
self->base.data = (opcode_t *)mem_sys_realloc(self->base.data,
(self->base.size + 2) * sizeof (opcode_t));
memmove(&self->base.data[idx + 2], &self->base.data[idx],
(self->base.size - idx) * sizeof (opcode_t));
self->base.size += 2;
for (i = key_id + 1; i < self->num_keys; i++)
self->keys[i].start++;
/* Add entry. */
self->base.data[idx + ANN_ENTRY_OFF] = offset;
self->base.data[idx + ANN_ENTRY_VAL] = value;
self->keys[key_id].len++;
}
/*
=item C<void PackFile_Annotations_add_entry(PARROT_INTERP, PackFile_Annotations
*self, opcode_t offset, opcode_t key, opcode_t type, opcode_t value)>
Deprecated: Use C<Parrot_pf_annotations_add_entry> instead. GH #1170
=cut
*/
PARROT_EXPORT
PARROT_DEPRECATED
void
PackFile_Annotations_add_entry(PARROT_INTERP, ARGMOD(PackFile_Annotations *self),
opcode_t offset, opcode_t key, opcode_t type, opcode_t value)
{
ASSERT_ARGS(PackFile_Annotations_add_entry)
Parrot_pf_annotations_add_entry(interp, self, offset, key, type, value);
}
/*
=item C<PMC * Parrot_pf_annotations_lookup(PARROT_INTERP, PackFile_Annotations
*self, opcode_t offset, STRING *name)>
Looks up the annotation(s) in force at the given bytecode offset. If just one
particular annotation is required, it can be passed as C<name>, and the value
will be returned (or a NULL PMC if no annotation of that name is in force).
Otherwise, a Hash will be returned of the all annotations. If there are none in
force, an empty hash will be returned.
=cut
*/
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_pf_annotations_lookup(PARROT_INTERP, ARGIN(PackFile_Annotations *self),
opcode_t offset, ARGIN_NULLOK(STRING *name))
{
ASSERT_ARGS(Parrot_pf_annotations_lookup)
if (STRING_IS_NULL(name)) {
/* find all annotations for this offset */
PMC * const result = Parrot_pmc_new(interp, enum_class_Hash);
INTVAL i;
for (i = 0; i < self->num_keys; i++) {
STRING * const k = self->code->const_table->str.constants[self->keys[i].name];
PMC * const v = Parrot_pf_annotations_lookup(interp, self, offset, k);
if (!PMC_IS_NULL(v))
VTABLE_set_pmc_keyed_str(interp, result, k, v);
}
return result;
}
else {
PackFile_Annotations_Key *key = NULL;
INTVAL i;
opcode_t val;
for (i = 0; i < self->num_keys; i++) {
STRING * const test_key = self->code->const_table->str.constants[self->keys[i].name];
if (STRING_equal(interp, test_key, name)) {
key = &self->keys[i];
break;
}
}
if (!key)
return PMCNULL; /* no such key */
i = find_pf_ann_idx(self, key, offset);
if (i < 0)
return PMCNULL; /* no active entry */
val = self->base.data[i * 2 + ANN_ENTRY_VAL];
switch (key->type) {
case PF_ANNOTATION_KEY_TYPE_INT:
return Parrot_pmc_box_integer(interp, val);
case PF_ANNOTATION_KEY_TYPE_STR:
return Parrot_pmc_box_string(interp, self->code->const_table->str.constants[val]);
case PF_ANNOTATION_KEY_TYPE_PMC:
return self->code->const_table->pmc.constants[val];
default:
Parrot_warn(interp, PARROT_WARNINGS_ALL_FLAG, "unexpected annotation type found");
return PMCNULL;
}
}
}
/*
=item C<PackFile_Annotations * Parrot_pf_get_annotations_segment(PARROT_INTERP,
PackFile *pf, PackFile_ByteCode *bc)>
Returns the annotations segment. If none exists, create an empty one.
=cut
*/
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PackFile_Annotations *
Parrot_pf_get_annotations_segment(PARROT_INTERP, ARGMOD(PackFile *pf),
ARGMOD_NULLOK(PackFile_ByteCode *bc))
{
ASSERT_ARGS(Parrot_pf_get_annotations_segment)
if (bc == NULL)
bc = pf->cur_cs;
if (bc->annotations != NULL)
return bc->annotations;
else {
STRING * const name = Parrot_str_concat(interp, bc->base.name, CONST_STRING(interp, "_ANN"));
PackFile_Directory * const dir = bc->base.dir ? bc->base.dir :
&pf->directory;
PackFile_Annotations * const annotations = (PackFile_Annotations *)
Parrot_pf_new_segment(interp, dir, PF_ANNOTATIONS_SEG, name, 1);
bc->annotations = annotations;
annotations->code = bc;
return annotations;
}
}
/*
=item C<static void push_context(PARROT_INTERP)>
Create a new context to isolate the effects of compiling code or loading pbc.
=cut
*/
static void
push_context(PARROT_INTERP)
{
ASSERT_ARGS(push_context)
/* TODO: Make these "Arbitrary values" a macro somewhere, for easy tuning */
const UINTVAL regs_used[] = { 2, 2, 2, 2 }; /* Arbitrary values */
const int parrot_hll_id = 0;
PMC * const context = Parrot_push_context(interp, regs_used);
Parrot_pcc_set_HLL(interp, context, parrot_hll_id);
Parrot_pcc_set_namespace(interp, context,
Parrot_hll_get_HLL_namespace(interp, parrot_hll_id));
}
/*
=item C<static void compile_file(PARROT_INTERP, STRING *path, INTVAL is_pasm)>
Compile a PIR or PASM file from source.
Deprecate: Do not use this. The packfile subsystem should not be in the
business of compiling things, and should absolutely not default to any one
particular compiler object (which might not exist). Use compreg opcode to get
a compiler object and the interface there to get a packfile or equivalent.
=cut
*/
PARROT_DEPRECATED
static void
compile_file(PARROT_INTERP, ARGIN(STRING *path), INTVAL is_pasm)
{
ASSERT_ARGS(compile_file)
PackFile_ByteCode * const cur_code = interp->code;
PMC * compiler;
if (is_pasm)
compiler = Parrot_interp_get_compiler(interp, CONST_STRING(interp, "PASM"));
else
compiler = Parrot_interp_get_compiler(interp, CONST_STRING(interp, "PIR"));
{
PMC * const pf_pmc = Parrot_interp_compile_file(interp, compiler, path);
PMC * const pbc_cache = VTABLE_get_pmc_keyed_int(interp,
interp->iglobals, IGLOBALS_LOADED_PBCS);
PackFile * const pf = (PackFile*) VTABLE_get_pointer(interp, pf_pmc);
PackFile_ByteCode * const cs = pf->cur_cs;
if (cs) {
interp->code = cur_code;
VTABLE_set_pmc_keyed_str(interp, pbc_cache, path, pf_pmc);
pf_do_sub_pragmas(interp, pf_pmc, PBC_LOADED);
}
else {
interp->code = cur_code;
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
"compiler returned NULL ByteCode '%Ss'", path);
}
}
}
/*
=item C<static void load_file(PARROT_INTERP, STRING *path)>
Load a bytecode file and append it to the current packfile directory.
=cut
*/
static void
load_file(PARROT_INTERP, ARGIN(STRING *path))
{
ASSERT_ARGS(load_file)
PackFile * const pf = Parrot_pf_read_pbc_file(interp, path);
PMC * const pf_pmc = Parrot_pf_get_packfile_pmc(interp, pf, path);
if (!pf_pmc)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"Unable to load PBC file %Ss", path);
else {
PMC * const pbc_cache = VTABLE_get_pmc_keyed_int(interp,
interp->iglobals, IGLOBALS_LOADED_PBCS);
STRING * const method = CONST_STRING(interp, "mark_initialized");
STRING * const load_str = CONST_STRING(interp, "load");
VTABLE_set_pmc_keyed_str(interp, pbc_cache, path, pf_pmc);
Parrot_pcc_invoke_method_from_c_args(interp, pf_pmc, method, "S->",
load_str);
pf_do_sub_pragmas(interp, pf_pmc, PBC_LOADED);
}
}
/*
=item C<void Parrot_load_language(PARROT_INTERP, STRING *lang_name)>
Load the compiler libraries for a given high-level language into the
interpreter.
Deprecated: This function should either be renamed to
C<Parrot_pf_load_language>, or should not be exposed through this
API. GH #1170
TODO: Refactor this function and try to reduce the size of it. It is too big.
=cut
*/
/*PARROT_DEPRECATED*/
PARROT_EXPORT
void
Parrot_load_language(PARROT_INTERP, ARGIN_NULLOK(STRING *lang_name))
{
ASSERT_ARGS(Parrot_load_language)
STRING *wo_ext, *file_str, *path, *pbc;
STRING *found_path, *found_ext;
INTVAL name_length;
enum_runtime_ft file_type;
PMC *is_loaded_hash;
if (STRING_IS_NULL(lang_name))
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_LIBRARY_ERROR,
"\"load_language\" no language name");
/* Full path to language library is "abc/abc.pbc". */
pbc = CONST_STRING(interp, "pbc");
wo_ext = Parrot_str_concat(interp, lang_name, CONST_STRING(interp, "/"));
wo_ext = Parrot_str_concat(interp, wo_ext, lang_name);
file_str = Parrot_str_concat(interp, wo_ext, CONST_STRING(interp, "."));
file_str = Parrot_str_concat(interp, file_str, pbc);
/* Check if the language is already loaded */
is_loaded_hash = VTABLE_get_pmc_keyed_int(interp,
interp->iglobals, IGLOBALS_PBC_LIBS);
if (VTABLE_exists_keyed_str(interp, is_loaded_hash, wo_ext))
return;
file_type = PARROT_RUNTIME_FT_LANG;
path = Parrot_locate_runtime_file_str(interp, file_str, file_type);
if (!path)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
"\"load_language\" couldn't find a compiler module for the language '%Ss'", lang_name);
/* remember wo_ext => full_path mapping */
VTABLE_set_string_keyed_str(interp, is_loaded_hash,
wo_ext, path);
/* Add the include and dynext paths to the global search */
/* Get the base path of the located module */
Parrot_split_path_ext(interp, path, &found_path, &found_ext);
name_length = Parrot_str_length(interp, lang_name);
found_path = STRING_substr(interp, found_path, 0,
Parrot_str_length(interp, found_path)-name_length);
Parrot_lib_add_path(interp, Parrot_str_concat(interp, found_path, CONST_STRING(interp, "include/")),
PARROT_LIB_PATH_INCLUDE);
Parrot_lib_add_path(interp, Parrot_str_concat(interp, found_path, CONST_STRING(interp, "dynext/")),
PARROT_LIB_PATH_DYNEXT);
Parrot_lib_add_path(interp, Parrot_str_concat(interp, found_path, CONST_STRING(interp, "library/")),
PARROT_LIB_PATH_LIBRARY);
/* Check if the file found was actually a bytecode file (.pbc extension) or
* a source file (.pir or .pasm extension. */
push_context(interp);
if (STRING_equal(interp, found_ext, pbc))
load_file(interp, path);
else {
const STRING * pasm_s = CONST_STRING(interp, "pasm");
const INTVAL is_pasm = STRING_equal(interp, found_ext, pasm_s);
compile_file(interp, path, is_pasm);
}
Parrot_pop_context(interp);
}
/*
=item C<void Parrot_load_bytecode(PARROT_INTERP, Parrot_String file_str)>
Load a bytecode, PIR, or PASM file into the interpreter.
Deprecated: This function should either be renamed to
C<Parrot_pf_load_bytecode>, or should not be exposed through this
API. GH #1170
TODO: We need to cleanup the way bytecode is loaded. This probably needs some
major changes.
=cut
*/
/* intermediate hook during changes */
/*PARROT_DEPRECATED*/
PARROT_EXPORT
void
Parrot_load_bytecode(PARROT_INTERP, ARGIN_NULLOK(Parrot_String file_str))
{
ASSERT_ARGS(Parrot_load_bytecode)
STRING *wo_ext, *ext, *pbc, *path;
STRING *found_path, *found_ext;
PMC *is_loaded_hash;
enum_runtime_ft file_type;
if (STRING_IS_NULL(file_str))
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_LIBRARY_ERROR,
"\"load_bytecode\" no file name");
Parrot_split_path_ext(interp, file_str, &wo_ext, &ext);
/* check if wo_ext is loaded */
is_loaded_hash = VTABLE_get_pmc_keyed_int(interp,
interp->iglobals, IGLOBALS_PBC_LIBS);
if (VTABLE_exists_keyed_str(interp, is_loaded_hash, wo_ext))
return;
pbc = CONST_STRING(interp, "pbc");
if (STRING_equal(interp, ext, pbc))
file_type = PARROT_RUNTIME_FT_PBC;
else
file_type = PARROT_RUNTIME_FT_SOURCE;
path = Parrot_locate_runtime_file_str(interp, file_str, file_type);
if (!path)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
"\"load_bytecode\" couldn't find file '%Ss'", file_str);
/* remember wo_ext => full_path mapping */
VTABLE_set_string_keyed_str(interp, is_loaded_hash, wo_ext, path);
Parrot_split_path_ext(interp, path, &found_path, &found_ext);
/* Check if the file found was actually a bytecode file (.pbc
* extension) or a source file (.pir or .pasm extension). */
push_context(interp);
if (STRING_equal(interp, found_ext, pbc))
load_file(interp, path);
else {
const STRING * pasm_s = CONST_STRING(interp, "pasm");
const INTVAL is_pasm = STRING_equal(interp, ext, pasm_s);
compile_file(interp, path, is_pasm);
}
Parrot_pop_context(interp);
}
/*
=item C<PMC * Parrot_pf_load_bytecode_search(PARROT_INTERP, STRING *file)>
Load a .pbc bytecode by short name, looking in standard search paths. Return
a PackfileView PMC
=cut
*/
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_pf_load_bytecode_search(PARROT_INTERP, ARGIN(STRING *file))
{
ASSERT_ARGS(Parrot_pf_load_bytecode_search)
const enum_runtime_ft file_type = PARROT_RUNTIME_FT_PBC;
PMC * const pbc_cache = VTABLE_get_pmc_keyed_int(interp,
interp->iglobals, IGLOBALS_LOADED_PBCS);
STRING * const path = Parrot_locate_runtime_file_str(interp, file, file_type);
if (STRING_IS_NULL(path))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
"Cannot find library %Ss", file);
if (VTABLE_exists_keyed_str(interp, pbc_cache, path))
return VTABLE_get_pmc_keyed_str(interp, pbc_cache, path);
else {
PackFile * const pf = Parrot_pf_read_pbc_file(interp, path);
PMC * const pfview = Parrot_pf_get_packfile_pmc(interp, pf, path);
VTABLE_set_pmc_keyed_str(interp, pbc_cache, path, pfview);
return pfview;
}
}
/*
=item C<void Parrot_pf_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, PMC
*eval)>
Calls C<:load>, C<:init>, C<:main>, C<:immediate> and/or C<:postcomp>
subroutines in the current packfile, depending on the value of C<action>.
See C<do_sub_pragmas> for more details.
Use C<Parrot_pf_prepare_packfile_init> and C<Parrot_pf_prepare_packfile_load>
(and any other variants we need to create in the future) instead.
=cut
*/
PARROT_EXPORT
void
Parrot_pf_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, SHIM(PMC *eval))
{
ASSERT_ARGS(Parrot_pf_fixup_subs)
pf_do_sub_pragmas(interp, Parrot_pf_get_current_packfile(interp), what);
}
/*
=item C<void PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, PMC
*eval)>
Deprecated: Use <Parrot_pf_fixup_subs> instead. GH #1170
=cut
*/
PARROT_EXPORT
PARROT_DEPRECATED
void
PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, SHIM(PMC *eval))
{
ASSERT_ARGS(PackFile_fixup_subs)
pf_do_sub_pragmas(interp, Parrot_pf_get_current_packfile(interp), what);
}
/*
=item C<void Parrot_pf_prepare_packfile_init(PARROT_INTERP, PMC * const pfpmc)>
Ready a PackFile which has just been loaded in to Parrot. Sort out the
C<:main> function and trigger C<:init> functions. This is for packfiles which
are intended to be executed as a program.
=cut
*/
PARROT_EXPORT
void
Parrot_pf_prepare_packfile_init(PARROT_INTERP, ARGIN(PMC * const pfpmc))
{
ASSERT_ARGS(Parrot_pf_prepare_packfile_init)
if (PMC_IS_NULL(pfpmc))
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
"Could not load packfile: Invalid PMC");
else {
PackFile * const pf = (PackFile *)VTABLE_get_pointer(interp, pfpmc);
if (!pf)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
"Could not load packfile: Invalid Pointer");
if (!(pf->options & PFOPT_HEADERONLY))
pf_do_sub_pragmas(interp, pfpmc, PBC_MAIN);
}
}
/*
=item C<void Parrot_pf_prepare_packfile_load(PARROT_INTERP, PMC * const pfpmc)>
Ready a PackFile which has just been loaded in to Parrot. Trigger any C<:load>
functions. This is for packfiles which are intended to be used as libraries.
=cut
*/
PARROT_EXPORT
void
Parrot_pf_prepare_packfile_load(PARROT_INTERP, ARGIN(PMC * const pfpmc))
{
ASSERT_ARGS(Parrot_pf_prepare_packfile_load)
if (PMC_IS_NULL(pfpmc))
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
"Could not load packfile: Invalid PMC");
else {
PackFile * const pf = (PackFile *)VTABLE_get_pointer(interp, pfpmc);
if (!pf)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_MALFORMED_PACKFILE,
"Could not load packfile: Invalid Pointer");
if (!(pf->options & PFOPT_HEADERONLY))
pf_do_sub_pragmas(interp, pfpmc, PBC_LOADED);
}
}
/*
=item C<void Parrot_pf_write_pbc_file(PARROT_INTERP, PMC *pf_pmc, STRING
*filename)>
Take a Packfile or PackfileView PMC and write its contents out as a .pbc file
=item C<PackFile * Parrot_pf_read_pbc_file(PARROT_INTERP, STRING * const
fullname)>
Read a F<.pbc> file with the given C<fullname> into a PackFile structure.
=cut
*/
PARROT_EXPORT
void
Parrot_pf_write_pbc_file(PARROT_INTERP, ARGIN(PMC *pf_pmc), ARGIN(STRING *filename))
{
ASSERT_ARGS(Parrot_pf_write_pbc_file)
PackFile * const pf = (PackFile *)VTABLE_get_pointer(interp, pf_pmc);
if (!pf)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
"Could not get packfile.");
else {
PIOHANDLE fp;
Parrot_block_GC_mark(interp);
fp = Parrot_io_internal_open(interp, filename, PIO_F_WRITE);
if (fp == PIO_INVALID_HANDLE) {
Parrot_unblock_GC_mark(interp);
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"Cannot open output file %Ss", filename);
}
else {
const Parrot_Int size = Parrot_pf_pack_size(interp, pf) * sizeof (opcode_t);
opcode_t * const packed = (opcode_t*)mem_sys_allocate(size);
Parrot_pf_pack(interp, pf, packed);
Parrot_io_internal_write(interp, fp, (char *)packed, size);
}
Parrot_io_internal_close(interp, fp);
Parrot_unblock_GC_mark(interp);
}
}
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PackFile *
Parrot_pf_read_pbc_file(PARROT_INTERP, ARGIN_NULLOK(STRING * const fullname))
{
ASSERT_ARGS(Parrot_pf_read_pbc_file)
PackFile *pf;
INTVAL program_size;
if (fullname == NULL || STRING_length(fullname) == 0) {
PIOHANDLE stdin_h = Parrot_io_get_standard_piohandle(interp, PIO_STDIN_FILENO);
STRING * const hname = CONST_STRING(interp, "standard input");
pf = read_pbc_file_packfile_handle(interp, hname, stdin_h, 0);
}
else {
/* can't read a file that doesn't exist */
if (!Parrot_file_stat_intval(interp, fullname, STAT_EXISTS))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Can't stat %Ss, code %i", fullname, errno);
/* we may need to relax this if we want to read bytecode from pipes */
if (!Parrot_file_stat_intval(interp, fullname, STAT_ISREG))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"'%Ss' is not a regular file %i", fullname, errno);
/* check that fullname isn't NULL, just in case */
if (!fullname)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
"Trying to open a NULL filename");
program_size = Parrot_file_stat_intval(interp, fullname, STAT_FILESIZE);
pf = read_pbc_file_packfile(interp, fullname, program_size);
}
return pf;
}
/*
=item C<static PackFile* read_pbc_file_packfile_handle(PARROT_INTERP, STRING *
const fullname, PIOHANDLE io, INTVAL program_size)>
Read a PackFile in from an open PIOHANDLE.
=cut
*/
PARROT_CANNOT_RETURN_NULL
static PackFile*
read_pbc_file_packfile_handle(PARROT_INTERP, ARGIN(STRING * const fullname),
PIOHANDLE io, INTVAL program_size)
{
ASSERT_ARGS(read_pbc_file_packfile_handle)
char * const program_code = read_pbc_file_bytes_handle(interp, io, program_size);
PackFile * const pf = Parrot_pf_new(interp, 0);
pf->options = 0;
if (!Parrot_pf_unpack(interp, pf, (opcode_t *)program_code, (size_t)program_size))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Can't unpack packfile %Ss", fullname);
return pf;
}
/*
=item C<static char * read_pbc_file_bytes_handle(PARROT_INTERP, PIOHANDLE io,
INTVAL program_size)>
Read in the raw bytes of the packfile into a buffer. The buffer is allocated
with C<mem_gc_realloc_n_typed>, so needs to be freed by the caller.
=cut
*/
PARROT_CAN_RETURN_NULL
static char *
read_pbc_file_bytes_handle(PARROT_INTERP, PIOHANDLE io, INTVAL program_size)
{
ASSERT_ARGS(read_pbc_file_bytes_handle)
size_t chunk_size = program_size > 0 ? program_size : 1024;
INTVAL wanted = program_size;
size_t read_result;
char *program_code = mem_gc_allocate_n_typed(interp, chunk_size, char);
char *cursor = program_code;
program_size = 0;
while ((read_result = Parrot_io_internal_read(interp, io, cursor, chunk_size)) > 0) {
program_size += read_result;
if (program_size == wanted)
break;
chunk_size = 1024;
program_code = mem_gc_realloc_n_typed(interp, program_code,
program_size + chunk_size, char);
if (!program_code) {
Parrot_io_internal_close(interp, io);
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
"Could not reallocate buffer while reading packfile from PIO");
}
cursor = program_code + program_size;
}
return program_code;
}
/*
=item C<static PackFile * read_pbc_file_packfile(PARROT_INTERP, STRING * const
fullname, INTVAL program_size)>
Read a pbc file into a PackFile*. May use mmap if available or direct reads
from the file.
=cut
*/
PARROT_CAN_RETURN_NULL
static PackFile *
read_pbc_file_packfile(PARROT_INTERP, ARGIN(STRING * const fullname),
INTVAL program_size)
{
ASSERT_ARGS(read_pbc_file_packfile)
char * program_code = NULL;
PackFile * pf;
PIOHANDLE io = Parrot_io_internal_open(interp, fullname, PIO_F_READ);
INTVAL is_mapped = 0;
if (io == PIO_INVALID_HANDLE)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Can't open %Ss, code %i", fullname, errno);
/* TODO: Who frees program_code? We don't do it here (And don't need to
if we've mmapped it. Figure out where this is handled and
document it here.
*/
#ifndef PARROT_HAS_HEADER_SYSMAN
program_code = read_pbc_file_bytes_handle(interp, io, program_size);
#else
program_code = (char *)mmap(NULL, (size_t)program_size,
PROT_READ, MAP_SHARED, io, (off_t)0);
/* If mmap fails, fall back and try to read the file from the handle
directly.
*/
if (program_code == (void *)MAP_FAILED) {
Parrot_warn(interp, PARROT_WARNINGS_IO_FLAG,
"Can't mmap file %s, code %i.\n", fullname, errno);
program_code = read_pbc_file_bytes_handle(interp, fullname, io, program_size);
}
else
is_mapped = 1;
#endif
pf = Parrot_pf_new(interp, is_mapped);
pf->options = 0;
if (!Parrot_pf_unpack(interp, pf, (opcode_t *)program_code, (size_t)program_size))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Can't unpack packfile %Ss", fullname);
Parrot_io_internal_close(interp, io);
return pf;
}
/*
=item C<static PMC* set_current_sub(PARROT_INTERP)>
Search the fixup table for a PMC matching the argument. On a match,
set up the appropriate context.
If no match, set up a dummy PMC entry. In either case, return a
pointer to the PMC.
=cut
*/
/*PARROT_DEPRECATED*/
PARROT_CANNOT_RETURN_NULL
static PMC*
set_current_sub(PARROT_INTERP)
{
ASSERT_ARGS(set_current_sub)
PMC *new_sub_pmc;
PackFile_ByteCode * const cur_cs = interp->code;
PackFile_ConstTable * const ct = cur_cs->const_table;
STRING * const SUB = CONST_STRING(interp, "Sub");
opcode_t i;
/*
* Walk the fixup table. The first Sub-like entry should be our
* entry point with the address at our resume_offset.
*/
for (i = 0; i < ct->pmc.const_count; i++) {
PMC * const sub_pmc = ct->pmc.constants[i];
if (VTABLE_isa(interp, sub_pmc, SUB)) {
Parrot_Sub_attributes *sub;
PMC_get_sub(interp, sub_pmc, sub);
if (sub->seg == cur_cs) {
const size_t offs = sub->start_offs;
if (offs == interp->resume_offset) {
Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), sub->HLL_id);
return sub_pmc;
}
break;
}
}
}
/* If we didn't find anything, put a dummy PMC into current_sub.
The default values set by Sub.init are appropriate for the
dummy, don't need additional settings. */
new_sub_pmc = Parrot_pmc_new(interp, enum_class_Sub);
Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), new_sub_pmc);
return new_sub_pmc;
}
/*
=item C<void Parrot_pf_execute_bytecode_program(PARROT_INTERP, PMC *pbc, PMC
*args)>
Execute a PackFile* as if it were a main program. This is an entrypoint into
executing a Parrot program, it is not intended (and can be dangerous) if you
try to call it from within a running Parrot program
=cut
*/
PARROT_EXPORT
void
Parrot_pf_execute_bytecode_program(PARROT_INTERP, ARGMOD(PMC *pbc),
ARGMOD(PMC *args))
{
ASSERT_ARGS(Parrot_pf_execute_bytecode_program)
PMC * const current_pf = Parrot_pf_get_current_packfile(interp);
PMC * main_sub;
PackFile *pf = (PackFile*)VTABLE_get_pointer(interp, pbc);
if (!pf || !pf->cur_cs)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
"Could not get packfile");
Parrot_pf_set_current_packfile(interp, pbc);
Parrot_pf_prepare_packfile_init(interp, pbc);
main_sub = packfile_main(pf->cur_cs);
/* if no sub was marked being :main, we create a dummy sub with offset 0 */
if (!main_sub)
main_sub = set_current_sub(interp);
VTABLE_set_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_ARGV_LIST, args);
Parrot_cx_begin_execution(interp, main_sub, args);
if (!PMC_IS_NULL(current_pf))
Parrot_pf_set_current_packfile(interp, current_pf);
}
/*
=item C<STRING * Parrot_pf_get_version_string(PARROT_INTERP, PMC * pbc)>
Get a Major.Minor.Patch version number for the given packfile
=cut
*/
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
STRING *
Parrot_pf_get_version_string(PARROT_INTERP, ARGIN(PMC * pbc))
{
ASSERT_ARGS(Parrot_pf_get_version_string)
PackFile * const pf = (PackFile *) VTABLE_get_pointer(interp, pbc);
return Parrot_sprintf_c(interp, "%d.%d.%d",
pf->header->major, pf->header->minor, pf->header->patch);
}
/*
=item C<static PackFile_Segment * create_seg(PARROT_INTERP, PackFile_Directory
*dir, pack_file_types t, STRING *name, STRING *file_name, int add)>
Creates a new PackFile_Segment for the given C<file_name>. See
C<Parrot_pf_new_segment()> for the other arguments.
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static PackFile_Segment *
create_seg(PARROT_INTERP, ARGMOD(PackFile_Directory *dir), pack_file_types t,
ARGIN(STRING *name), ARGIN(STRING *file_name), int add)
{
ASSERT_ARGS(create_seg)
STRING * const seg_name = Parrot_sprintf_c(interp, "%Ss_%Ss", name, file_name);
PackFile_Segment * const seg = Parrot_pf_new_segment(interp, dir, t, seg_name, add);
return seg;
}
/*
=back
=head1 HISTORY
Parrot_readbc and Parrot_loadbc renamed. Trace macros, long double and
64-bit conversion work by Reini Urban 2009.
Rework by Melvin; new bytecode format, make bytecode portable. (Do
endian conversion and wordsize transforms on the fly.)
leo applied and modified Juergen Boemmels packfile patch giving an
extensible packfile format with directory reworked again, with common
chunks (C<default_*>).
2003.11.21 leo: moved low level item fetch routines to new
F<pf/pf_items.c>
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
*/
Jump to Line
Something went wrong with that request. Please try again.