Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: b9261ad17c
Fetching contributors…

Cannot retrieve contributors at this time

461 lines (334 sloc) 10.698 kB
/*
Copyright (C) 2001-2011, Parrot Foundation.
=head1 NAME
src/pmc/eval.pmc - Dynamic code evaluation
=head1 DESCRIPTION
C<Eval> extends C<Sub> to provide C<eval>-like dynamic code
evaluation and execution.
=cut
*/
#include "pmc/pmc_sub.h"
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC* get_sub(PARROT_INTERP, ARGIN(PMC *self), int idx)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void mark_ct(PARROT_INTERP, ARGIN(PMC *self))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
#define ASSERT_ARGS_get_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self))
#define ASSERT_ARGS_mark_ct __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
pmclass Eval extends Sub provides invokable auto_attrs {
/*
=head2 Vtable functions
=over 4
=item C<void init()>
Initializes a new empty Eval.
=item C<void destroy()>
Destroy the Eval and its associated bytecode.
=item C<void mark()>
Mark this Eval.
=cut
*/
VTABLE void init() {
Parrot_Sub_attributes *sub_data;
SUPER();
PMC_get_sub(INTERP, SELF, sub_data);
sub_data->seg = NULL;
PObj_custom_mark_destroy_SETALL(SELF);
}
VTABLE void destroy() {
/*
* If the compiled code contained any .sub (or .pcc.sub)
* subroutines, these subs got installed in the globals
* during compiling this bytecode segment.
*
* These globals still exist, calling them will segfault
* as the segment is destroyed now.
*
* TT # 1230:
* Walk the fixups, locate globals and nullify the Sub PMC
* This probably needs a pointer into the globals.
*
* OTOH - if the global exists - this eval pmc ought
* to be alive and destroy isn't called.
*/
PackFile_Segment *seg;
PackFile_ByteCode *cur_cs;
Parrot_Sub_attributes *sub_data;
PMC_get_sub(INTERP, SELF, sub_data);
if (!sub_data) {
SUPER();
return;
}
cur_cs = sub_data->seg;
if (!cur_cs) {
SUPER();
return;
}
/* XXX Quick and dirty fix for TT #995 */
#if 0
if ((struct PackFile *)cur_cs == INTERP->initial_pf
|| cur_cs == INTERP->code) {
SUPER();
return;
}
#endif
#if 0
seg = (PackFile_Segment *)cur_cs->const_table;
if (seg) {
PackFile_Segment_destroy(INTERP, seg);
cur_cs->const_table = NULL;
}
seg = (PackFile_Segment *)cur_cs->debugs;
if (seg) {
PackFile_Segment_destroy(INTERP, seg);
cur_cs->debugs = NULL;
}
seg = (PackFile_Segment *)cur_cs;
if (seg)
PackFile_Segment_destroy(INTERP, seg);
#endif
sub_data->seg = NULL;
SUPER();
}
VTABLE void mark() {
SUPER();
mark_ct(INTERP, SELF);
}
/*
=item C<void *get_pointer()>
Returns the address of the associated packfile.
=cut
*/
VTABLE void *get_pointer() {
Parrot_Sub_attributes *sub;
PMC_get_sub(INTERP, SELF, sub);
if (sub) {
PackFile_ByteCode *seg = sub->seg;
if (seg)
return seg->base.pf;
}
return NULL;
}
/*
=item C<opcode_t *invoke(void *next)>
Invokes the first subroutine in the eval code.
=cut
*/
VTABLE opcode_t *invoke(void *next) {
PMC * const sub = SELF.get_pmc_keyed_int(0);
return VTABLE_invoke(INTERP, sub, next);
}
/*
=item C<STRING *get_string>
Get a STRING representing the bytecode for this code segment, suitable
for writing to disc and later loading via C<load_bytecode>.
=cut
*/
VTABLE STRING *get_string() {
Parrot_Sub_attributes *sub;
PackFile *pf = PackFile_new(INTERP, 0);
PackFile_ByteCode *seg;
STRING *res;
size_t size, aligned_size;
PMC_get_sub(INTERP, SELF, sub);
seg = sub->seg;
PackFile_add_segment(INTERP, &pf->directory, (PackFile_Segment *)seg);
if (seg->const_table)
PackFile_add_segment(INTERP, &pf->directory,
(PackFile_Segment *)seg->const_table);
if (seg->debugs)
PackFile_add_segment(INTERP, &pf->directory,
(PackFile_Segment *)seg->debugs);
size = PackFile_pack_size(INTERP, pf) * sizeof (opcode_t);
/*
* work around packfile bug:
* as far as I have checked it the story is:
* - PackFile_pack_size() assumes 16 byte alignment but doesn't
* have the actual start of the code (packed)
* - PackFile_pack() uses 16 bye alignment relative to the start
* of the code, which isn't really the same
* Therefore align code at 16, which should give the desired
* effect
*/
aligned_size = size + 15;
res = Parrot_str_new_init(INTERP, NULL, aligned_size,
Parrot_binary_encoding_ptr, 0);
res->strlen = res->bufused = size;
if ((size_t)(res->strstart) & 0xf) {
char *adr = res->strstart;
adr += 16 - ((size_t)adr & 0xf);
res->strstart = adr;
}
/* We block GC while doing the packing, since GC run during a pack
has been observed to cause problems. There may be a Better Fix.
See http://rt.perl.org/rt3/Ticket/Display.html?id=40410
for example of the problem (note on line that
segfaults, it is *cursor that is pointing to dealloced memory). */
Parrot_block_GC_mark(INTERP);
PackFile_pack(INTERP, pf, (opcode_t *)res->strstart);
Parrot_unblock_GC_mark(INTERP);
/* now remove all segments from directory again and destroy
* the packfile */
pf->directory.num_segments = 0;
PackFile_destroy(INTERP, pf);
return res;
}
/*
=item C<PMC *get_pmc_keyed_int(INTVAL key)>
Returns the Sub PMC of the element at index C<key> or PMCNULL.
=cut
*/
VTABLE PMC *get_pmc_keyed_int(INTVAL key) {
return get_sub(INTERP, SELF, key);
}
/*
=item C<void freeze(PMC *info)>
Archives the evaled code
=item C<void thaw(PMC *info)>
Unarchives the code.
=cut
*/
VTABLE void freeze(PMC *info) {
STRING * const packed = SELF.get_string();
VTABLE_push_string(INTERP, info, packed);
SUPER(info);
}
VTABLE void thaw(PMC *info) {
STRING * const packed = VTABLE_shift_string(INTERP, info);
PackFile *pf;
PMC *pfpmc;
Parrot_Sub_attributes *sub;
size_t i;
SUPER(info);
pf = PackFile_new(INTERP, 0);
pfpmc = Parrot_pf_get_packfile_pmc(INTERP, pf);
if (!PackFile_unpack(INTERP, pf, (opcode_t *)packed->strstart,
packed->strlen))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
"couldn't unpack packfile");
for (i = 0; i < pf->directory.num_segments; ++i) {
PackFile_Segment * const seg = pf->directory.segments[i];
if (seg->type == PF_BYTEC_SEG) {
PMC_get_sub(INTERP, SELF, sub);
sub->seg = (PackFile_ByteCode *)seg;
break;
}
}
pf->directory.num_segments = 0;
/*
* TT #1292 this isn't ok - it seems that the packfile
* gets attached to INTERP->code and is
* destroyed again during interpreter destruction
*/
/* PackFile_destroy(INTERP, pf); */
}
VTABLE INTVAL elements() {
INTVAL n = 0;
Parrot_Sub_attributes *sub;
PackFile_ByteCode *seg;
PMC_get_sub(INTERP, SELF, sub);
seg = sub->seg;
if (seg) {
PackFile_ConstTable *const ct = seg->const_table;
if (ct) {
INTVAL i;
STRING * const SUB = CONST_STRING(interp, "Sub");
for (i = n = 0; i < ct->pmc.const_count; ++i) {
PMC * const x = ct->pmc.constants[i];
if (VTABLE_isa(interp, x, SUB))
++n;
}
}
}
return n;
}
/*
=back
=head2 Methods
=over 4
=item C<get_main()>
Return the main sub, if any, null PMC otherwise.
=cut
*/
METHOD get_main()
{
PMC *mainsub = Parrot_pf_get_packfile_main_sub(INTERP, SELF);
RETURN(PMC * mainsub);
}
}
/*
=back
=head2 Auxiliar functions
=over 4
=item C<static PMC* get_sub(PARROT_INTERP, PMC *self, int idx)>
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC*
get_sub(PARROT_INTERP, ARGIN(PMC *self), int idx)
{
ASSERT_ARGS(get_sub)
Parrot_Sub_attributes *sub;
PackFile_ByteCode *seg;
PMC_get_sub(interp, self, sub);
seg = sub->seg;
if (seg) {
PackFile_ConstTable * const ct = seg->const_table;
if (ct) {
INTVAL i, n;
for (i = n = 0; i < ct->pmc.const_count; ++i) {
STRING * const SUB = CONST_STRING(interp, "Sub");
PMC * const x = ct->pmc.constants[i];
if (VTABLE_isa(interp, x, SUB))
if (!idx--)
return x;
}
}
}
return PMCNULL;
}
/*
=item C<static void mark_ct(PARROT_INTERP, PMC *self)>
=cut
*/
static void
mark_ct(PARROT_INTERP, ARGIN(PMC *self))
{
ASSERT_ARGS(mark_ct)
Parrot_Sub_attributes *sub;
PackFile_ByteCode *seg;
PMC_get_sub(interp, self, sub);
seg = sub->seg;
if (seg) {
const PackFile_ConstTable * const ct = seg->const_table;
if (ct) {
INTVAL i;
for (i = 0; i < ct->pmc.const_count; ++i) {
PMC * const sub = ct->pmc.constants[i];
Parrot_gc_mark_PMC_alive(interp, sub);
}
}
}
}
/*
=back
=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.