Skip to content
Browse files

Move code-running functions out of src/packfile/api.c

  • Loading branch information...
1 parent 6fb2a10 commit 74168f90b3e4fcdef38b17f9e971c90d4bb6a47d @Kristaba Kristaba committed with cotto Jan 1, 2011
Showing with 377 additions and 286 deletions.
  1. +11 −0 config/gen/makefiles/root.in
  2. +0 −11 include/parrot/packfile.h
  3. +5 −2 src/embed.c
  4. +6 −2 src/embed/api.c
  5. +1 −270 src/packfile/api.c
  6. +310 −0 src/packfile/execute.c
  7. +41 −0 src/packfile/packfile_private.h
  8. +3 −1 src/pmc/eval.pmc
View
11 config/gen/makefiles/root.in
@@ -491,6 +491,7 @@ INTERP_O_FILES = \
src/oo$(O) \
src/platform$(O) \
src/packfile/object_serialization$(O) \
+ src/packfile/execute$(O) \
src/pmc$(O) \
src/runcore/main$(O) \
src/runcore/cores$(O) \
@@ -695,6 +696,7 @@ STR_FILES = \
#IF(has_extra_nci_thunks): src/nci/extra_thunks.str \
src/nci/signatures.str \
src/packfile/api.str \
+ src/packfile/execute.str \
src/packfile/object_serialization.str \
src/packfile/pf_items.str \
src/pmc.str \
@@ -1597,6 +1599,7 @@ src/multidispatch$(O) : \
src/packfile/api$(O) : \
src/packfile/api.str \
src/packfile/api.c \
+ src/packfile/packfile_private.h \
include/pmc/pmc_sub.h \
include/pmc/pmc_key.h \
include/pmc/pmc_parrotlibrary.h \
@@ -1616,6 +1619,14 @@ src/packfile/api$(O) : \
$(PARROT_H_HEADERS) \
$(INC_DIR)/runcore_api.h
+src/packfile/execute$(O) : \
+ $(PARROT_H_HEADERS) \
+ src/packfile/execute.str \
+ src/packfile/execute.c \
+ src/packfile/packfile_private.h \
+ include/pmc/pmc_sub.h
+
+
src/packfile/output$(O) : $(PARROT_H_HEADERS) include/pmc/pmc_key.h src/packfile/output.c
src/packfile/pf_items$(O) : \
View
11 include/parrot/packfile.h
@@ -629,14 +629,6 @@ void PackFile_ConstTable_dump(PARROT_INTERP,
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
-void do_sub_pragmas(PARROT_INTERP,
- ARGIN(PackFile_ByteCode *self),
- pbc_action_enum_t action,
- ARGIN_NULLOK(PMC *eval_pmc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_EXPORT
void PackFile_add_segment(PARROT_INTERP,
ARGMOD(PackFile_Directory *dir),
ARGMOD(PackFile_Segment *seg))
@@ -925,9 +917,6 @@ const opcode_t * PackFile_Annotations_unpack(PARROT_INTERP,
void Parrot_trace_eprintf(ARGIN(const char *s), ...)
__attribute__nonnull__(1);
-#define ASSERT_ARGS_do_sub_pragmas __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(self))
#define ASSERT_ARGS_PackFile_add_segment __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(dir) \
View
7 src/embed.c
@@ -563,8 +563,11 @@ Parrot_pbc_read(PARROT_INTERP, ARGIN_NULLOK(const char *fullname), const int deb
}
/* Set :main routine */
- if (!(pf->options & PFOPT_HEADERONLY))
- do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL);
+ if (!(pf->options & PFOPT_HEADERONLY)) {
+ if (pf->cur_cs != NULL)
+ Parrot_pbc_load(interp, pf);
+ PackFile_fixup_subs(interp, PBC_PBC, NULL);
+ }
/* Prederefing the sub/the bytecode is done in switch_to_cs before
* actual usage of the segment */
View
8 src/embed/api.c
@@ -329,7 +329,9 @@ Parrot_api_load_bytecode_file(Parrot_PMC interp_pmc,
PackFile * const pf = Parrot_pbc_read(interp, filename, 0);
if (!pf)
Parrot_ex_throw_from_c_args(interp, NULL, 1, "Could not load packfile");
- do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL);
+ if (pf->cur_cs != NULL)
+ Parrot_pbc_load(interp, pf);
+ PackFile_fixup_subs(interp, PBC_PBC, NULL);
*pbc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, *pbc, pf);
EMBED_API_CALLOUT(interp_pmc, interp)
@@ -362,7 +364,9 @@ Parrot_api_load_bytecode_bytes(Parrot_PMC interp_pmc,
if (!PackFile_unpack(interp, pf, (const opcode_t *)pbc, bytecode_size))
Parrot_ex_throw_from_c_args(interp, NULL, 1, "could not unpack packfile");
- do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL);
+ if (pf->cur_cs != NULL)
+ Parrot_pbc_load(interp, pf);
+ PackFile_fixup_subs(interp, PBC_PBC, NULL);
*pbcpmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, *pbcpmc, pf);
EMBED_API_CALLOUT(interp_pmc, interp);
View
271 src/packfile/api.c
@@ -36,6 +36,7 @@ about the structure of the frozen bytecode.
#include "pmc/pmc_callcontext.h"
#include "pmc/pmc_parrotlibrary.h"
#include "parrot/oplib/core_ops.h"
+#include "packfile_private.h"
/* HEADERIZER HFILE: include/parrot/packfile.h */
@@ -194,15 +195,6 @@ static const opcode_t * directory_unpack(PARROT_INTERP,
__attribute__nonnull__(3)
FUNC_MODIFIES(*segp);
-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,
ARGIN(PackFile_Segment *seg),
ARGIN_NULLOK(void *user_data))
@@ -305,12 +297,6 @@ static void pf_register_standard_funcs(PARROT_INTERP, ARGMOD(PackFile *pf))
__attribute__nonnull__(2)
FUNC_MODIFIES(*pf);
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-static PMC* run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
static void segment_init(
ARGOUT(PackFile_Segment *self),
ARGIN(PackFile *pf),
@@ -324,12 +310,6 @@ static void sort_segs(ARGMOD(PackFile_Directory *dir))
__attribute__nonnull__(1)
FUNC_MODIFIES(*dir);
-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_byte_code_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self))
@@ -394,9 +374,6 @@ static int sub_pragma(PARROT_INTERP,
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(segp) \
, PARROT_ASSERT_ARG(cursor))
-#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))
@@ -443,18 +420,12 @@ static int sub_pragma(PARROT_INTERP,
#define ASSERT_ARGS_pf_register_standard_funcs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(pf))
-#define ASSERT_ARGS_run_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(sub_pmc))
#define ASSERT_ARGS_segment_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(self) \
, PARROT_ASSERT_ARG(pf) \
, PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_sort_segs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(dir))
-#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 */
@@ -586,191 +557,6 @@ make_code_pointers(ARGMOD(PackFile_Segment *seg))
/*
-=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_PBC:
- 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* run_sub(PARROT_INTERP, PMC *sub_pmc)>
-
-Runs the B<sub_pmc> due to its B<:load>, B<:immediate>, ... pragma
-
-=cut
-
-*/
-
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-static PMC*
-run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
-{
- ASSERT_ARGS(run_sub)
- Parrot_runcore_t *old_core = interp->run_core;
- PMC *retval = PMCNULL;
-
- Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp),
- interp->code->const_table);
-
- Parrot_ext_call(interp, sub_pmc, "->P", &retval);
- interp->run_core = old_core;
-
- return retval;
-}
-
-
-/*
-
-=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 *lo_var_ptr = interp->lo_var_ptr;
- PMC *result;
-
- PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_IMMEDIATE;
- result = run_sub(interp, sub_pmc);
-
- /* 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;
- run_sub(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) {
- PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
-
- /* if loaded no need for init */
- Sub_comp_INIT_CLEAR(sub);
- run_sub(interp, sub_pmc);
- }
- break;
- default:
- if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MAIN) {
- if ((interp->resume_flag & RESUME_INITIAL)
- && interp->resume_offset == 0) {
- void *ptr = VTABLE_get_pointer(interp, sub_pmc);
- const ptrdiff_t code = (ptrdiff_t) sub->seg->base.data;
-
- interp->resume_offset = ((ptrdiff_t)ptr - code)
- / sizeof (opcode_t *);
-
- PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_MAIN;
- Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
- }
- else {
- Parrot_warn(interp, PARROT_WARNINGS_ALL_FLAG,
- ":main sub not allowed\n");
- }
- }
-
- /* run :init tagged functions */
- if (action == PBC_MAIN && Sub_comp_INIT_TEST(sub)) {
- /* if loaded no need for init */
- Sub_comp_INIT_CLEAR(sub);
-
- /* if inited no need for load */
- PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
-
- run_sub(interp, sub_pmc);
- interp->resume_flag = RESUME_INITIAL;
- }
- break;
- }
-
- return NULL;
-}
-
-
-/*
-
=item C<static void mark_1_ct_seg(PARROT_INTERP, PackFile_ConstTable *ct)>
While the PMCs should be constant, their possible contents such as
@@ -887,62 +673,7 @@ mark_const_subs(PARROT_INTERP)
}
-/*
-
-=item C<void do_sub_pragmas(PARROT_INTERP, PackFile_ByteCode *self,
-pbc_action_enum_t action, PMC *eval_pmc)>
-
-C<action> is one of C<PBC_PBC>, 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 or PBC_PBC actions
- :init subs execute when :main does
- :load subs execute on PBC_LOAD
-
-Also store the C<eval_pmc> in the sub structure, so that the eval PMC is kept
-alive by living subs.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-do_sub_pragmas(PARROT_INTERP, ARGIN(PackFile_ByteCode *self),
- pbc_action_enum_t action, ARGIN_NULLOK(PMC *eval_pmc))
-{
- ASSERT_ARGS(do_sub_pragmas)
- PackFile_ConstTable * const ct = self->const_table;
- opcode_t i;
-
- TRACE_PRINTF(("PackFile: do_sub_pragmas (action=%d)\n", action));
-
- for (i = 0; i < ct->pmc.const_count; ++i) {
- STRING * const SUB = CONST_STRING(interp, "Sub");
- PMC *sub_pmc = ct->pmc.constants[i];
-
- if (VTABLE_isa(interp, sub_pmc, SUB)) {
- Parrot_Sub_attributes *sub;
- PMC_get_sub(interp, sub_pmc, sub);
- sub->eval_pmc = eval_pmc;
-
- 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)) {
- ct->pmc.constants[i] = result;
- }
- }
- }
- }
-}
/*
View
310 src/packfile/execute.c
@@ -0,0 +1,310 @@
+/*
+Copyright (C) 2001-2010, Parrot Foundation.
+This program is free software. It is subject to the same license as
+Parrot itself.
+
+=head1 NAME
+
+src/packfile/execute.c - Parrot PackFile API
+
+=head1 DESCRIPTION
+
+This file contain some private functions relating to executing functions.
+
+=cut
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/packfile.h"
+#include "pmc/pmc_sub.h"
+#include "packfile_private.h"
+#include "parrot/runcore_api.h"
+#include "execute.str"
+
+
+
+/* HEADERIZER HFILE: src/packfile/packfile_private.h */
+
+/* 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* 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);
+
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+static PMC* run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+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_do_1_sub_pragma __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(sub_pmc))
+#define ASSERT_ARGS_run_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(sub_pmc))
+#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<static PMC* run_sub(PARROT_INTERP, PMC *sub_pmc)>
+
+Runs the B<sub_pmc> due to its B<:load>, B<:immediate>, ... pragma
+
+=cut
+
+*/
+
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+static PMC*
+run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
+{
+ ASSERT_ARGS(run_sub)
+ Parrot_runcore_t *old_core = interp->run_core;
+ PMC *retval = PMCNULL;
+
+ Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp),
+ interp->code->const_table);
+
+ Parrot_ext_call(interp, sub_pmc, "->P", &retval);
+ interp->run_core = old_core;
+
+ return retval;
+}
+
+
+/*
+
+=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 *lo_var_ptr = interp->lo_var_ptr;
+ PMC *result;
+
+ PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_IMMEDIATE;
+ result = run_sub(interp, sub_pmc);
+
+ /* 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;
+ run_sub(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) {
+ PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
+
+ /* if loaded no need for init */
+ Sub_comp_INIT_CLEAR(sub);
+ run_sub(interp, sub_pmc);
+ }
+ break;
+ default:
+ if (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_MAIN) {
+ if ((interp->resume_flag & RESUME_INITIAL)
+ && interp->resume_offset == 0) {
+ void *ptr = VTABLE_get_pointer(interp, sub_pmc);
+ const ptrdiff_t code = (ptrdiff_t) sub->seg->base.data;
+
+ interp->resume_offset = ((ptrdiff_t)ptr - code)
+ / sizeof (opcode_t *);
+
+ PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_MAIN;
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
+ }
+ else {
+ Parrot_warn(interp, PARROT_WARNINGS_ALL_FLAG,
+ ":main sub not allowed\n");
+ }
+ }
+
+ /* run :init tagged functions */
+ if (action == PBC_MAIN && Sub_comp_INIT_TEST(sub)) {
+ /* if loaded no need for init */
+ Sub_comp_INIT_CLEAR(sub);
+
+ /* if inited no need for load */
+ PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_LOAD;
+
+ run_sub(interp, sub_pmc);
+ interp->resume_flag = RESUME_INITIAL;
+ }
+ break;
+ }
+
+ return NULL;
+}
+
+
+/*
+
+=item C<void do_sub_pragmas(PARROT_INTERP, PackFile_ByteCode *self,
+pbc_action_enum_t action, PMC *eval_pmc)>
+
+C<action> is one of C<PBC_PBC>, 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 or PBC_PBC actions
+ :init subs execute when :main does
+ :load subs execute on PBC_LOAD
+
+Also store the C<eval_pmc> in the sub structure, so that the eval PMC is kept
+alive by living subs.
+
+=cut
+
+*/
+
+void
+do_sub_pragmas(PARROT_INTERP, ARGIN(PackFile_ByteCode *self),
+ pbc_action_enum_t action, ARGIN_NULLOK(PMC *eval_pmc))
+{
+ ASSERT_ARGS(do_sub_pragmas)
+ PackFile_ConstTable * const ct = self->const_table;
+ opcode_t i;
+
+ TRACE_PRINTF(("PackFile: do_sub_pragmas (action=%d)\n", action));
+
+ for (i = 0; i < ct->pmc.const_count; ++i) {
+ STRING * const SUB = CONST_STRING(interp, "Sub");
+ PMC *sub_pmc = ct->pmc.constants[i];
+
+ if (VTABLE_isa(interp, sub_pmc, SUB)) {
+ Parrot_Sub_attributes *sub;
+
+ PMC_get_sub(interp, sub_pmc, sub);
+ sub->eval_pmc = eval_pmc;
+
+ 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)) {
+ ct->pmc.constants[i] = result;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+
+=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_PBC:
+ 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;
+}
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
+ */
View
41 src/packfile/packfile_private.h
@@ -0,0 +1,41 @@
+/*
+Copyright (C) 2001-2010, Parrot Foundation.
+This program is free software. It is subject to the same license as
+Parrot itself.
+
+=head1 NAME
+
+src/packfile/packfile_private.h - private header file for the packfile subsystem
+
+=head1 DESCRIPTION
+
+This is a private header file for the packfile subsystem. It contains definitions
+that are only for use in the packfile and don't need to be included in the rest of
+Parrot.
+*/
+
+
+
+/* HEADERIZER BEGIN: src/packfile/execute.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+void do_sub_pragmas(PARROT_INTERP,
+ ARGIN(PackFile_ByteCode *self),
+ pbc_action_enum_t action,
+ ARGIN_NULLOK(PMC *eval_pmc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+#define ASSERT_ARGS_do_sub_pragmas __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: src/packfile/execute.c */
+
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
+ */
View
4 src/pmc/eval.pmc
@@ -325,7 +325,9 @@ Unarchives the code.
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
"couldn't unpack packfile");
- do_sub_pragmas(INTERP, pf->cur_cs, PBC_PBC, SELF);
+ if (pf->cur_cs != NULL)
+ Parrot_pbc_load(interp, pf);
+ PackFile_fixup_subs(INTERP, PBC_PBC, SELF);
for (i = 0; i < pf->directory.num_segments; ++i) {
seg = pf->directory.segments[i];

0 comments on commit 74168f9

Please sign in to comment.
Something went wrong with that request. Please try again.