[svn:parrot] r42997 - branches/context_unify3/src/pmc
bacek at svn.parrot.org
bacek at svn.parrot.org
Fri Dec 11 21:31:06 UTC 2009
Author: bacek
Date: Fri Dec 11 21:31:05 2009
New Revision: 42997
URL: https://trac.parrot.org/parrot/changeset/42997
Log:
Copy ATTRibutes and methods from Context into CallContext.
Modified:
branches/context_unify3/src/pmc/callcontext.pmc
Modified: branches/context_unify3/src/pmc/callcontext.pmc
==============================================================================
--- branches/context_unify3/src/pmc/callcontext.pmc Fri Dec 11 21:30:41 2009 (r42996)
+++ branches/context_unify3/src/pmc/callcontext.pmc Fri Dec 11 21:31:05 2009 (r42997)
@@ -380,7 +380,49 @@
return result;
}
+#include "parrot/packfile.h"
+#include "pmc/pmc_sub.h"
+
pmclass CallContext provides array provides hash auto_attrs {
+ /* Context attributes */
+ ATTR PMC *caller_ctx; /* caller context */
+
+ ATTR void *registers; /* pointer to allocated registers */
+ ATTR Regs_ni bp; /* pointers to FLOATVAL & INTVAL */
+ ATTR Regs_ps bp_ps; /* pointers to PMC & STR */
+
+ ATTR UINTVAL n_regs_used[4]; /* INSP in PBC points to Sub */
+ ATTR PMC *lex_pad; /* LexPad PMC */
+ ATTR PMC *outer_ctx; /* outer context, if a closure */
+
+ /* new call scheme and introspective variables */
+ ATTR PMC *current_sub; /* the Sub we are executing */
+
+ /* for now use a return continuation PMC */
+ ATTR PMC *handlers; /* local handlers for the context */
+ ATTR PMC *current_cont; /* the return continuation PMC */
+ ATTR PMC *current_object; /* current object if a method call */
+ ATTR PMC *current_namespace; /* The namespace we're currently in */
+ ATTR PMC *results_signature; /* non-const results signature PMC */
+ ATTR opcode_t *current_pc; /* program counter of Sub invocation */
+ ATTR opcode_t *current_results; /* ptr into code with get_results opcode */
+ ATTR PMC *current_sig; /* temporary CallContext PMC for active call */
+
+ /* deref the constants - we need it all the time */
+ ATTR struct PackFile_Constant **constants;
+
+ ATTR INTVAL current_HLL; /* see also src/hll.c */
+
+ ATTR UINTVAL warns; /* Keeps track of what warnings
+ * have been activated */
+ ATTR UINTVAL errors; /* fatals that can be turned off */
+ ATTR UINTVAL trace_flags;
+ ATTR UINTVAL recursion_depth; /* Sub call recursion depth */
+
+ /* code->prederefed.code - code->base.data in opcodes
+ * to simplify conversion between code ptrs in e.g. invoke */
+ ATTR size_t pred_offset;
+
/* Storage for arguments */
ATTR struct Pcc_cell *positionals; /* linked list of positionals */
ATTR PMC *type_tuple; /* Cached argument types for MDD */
@@ -431,7 +473,10 @@
STRING *short_sig;
Pcc_cell *positionals;
INTVAL num_positionals;
- PMC *arg_flags, *type_tuple, *return_flags;
+ PMC *arg_flags, *type_tuple, *return_flags, *tmp;
+ UINTVAL i;
+ UINTVAL *n_regs_used;
+ Regs_ps bp_ps;
if (!PMC_data(SELF))
return;
@@ -454,6 +499,55 @@
if (hash)
mark_hash(INTERP, hash);
+
+ GET_ATTR_caller_ctx(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_lex_pad(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_outer_ctx(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_current_sub(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_handlers(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_current_cont(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_current_object(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_current_namespace(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_results_signature(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_current_sig(INTERP, SELF, tmp);
+ Parrot_gc_mark_PMC_alive(INTERP, tmp);
+
+ GET_ATTR_n_regs_used(INTERP, SELF, n_regs_used);
+ if (!n_regs_used)
+ return;
+
+ GET_ATTR_bp_ps(INTERP, SELF, bp_ps);
+ for (i = 0; i < n_regs_used[REGNO_PMC]; ++i) {
+ PMC *p = bp_ps.regs_p[-1L-(i)];
+ /* Original code from CTX_REG_PMC */
+ if (p)
+ Parrot_gc_mark_PMC_alive(interp, p);
+ }
+
+ for (i = 0; i < n_regs_used[REGNO_STR]; ++i) {
+ STRING *s = bp_ps.regs_s[i];
+ if (s)
+ Parrot_gc_mark_STRING_alive(interp, s);
+ }
+
}
VTABLE void destroy() {
@@ -504,6 +598,8 @@
else
mem_sys_free(returns_values);
}
+
+ Parrot_pcc_free_registers(INTERP, SELF);
}
/*
@@ -681,6 +777,38 @@
Retrieves the hash of named arguments.
+=item caller_ctx
+
+return Caller Context
+
+=item lex_pad
+
+return LexPad
+
+=item outer_ctx
+
+return Outer Context
+
+=item current_sub
+
+return current Sub
+
+=item handlers
+
+return list of ExceptioHandlers
+
+=item current_cont
+
+return current Continuation
+
+=item current_object
+
+return current Object (if in method call)
+
+=item current_namespace
+
+return current Namespace
+
=back
=cut
@@ -688,16 +816,42 @@
*/
VTABLE PMC *get_attr_str(STRING *key) {
- PMC *value = PMCNULL;
+ PMC *value = PMCNULL;
+ INTVAL hll;
- if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "named"))) {
+ if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "named")))
value = get_named_names(INTERP, SELF);
- }
- else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "arg_flags"))) {
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "arg_flags")))
GET_ATTR_arg_flags(INTERP, SELF, value);
- }
- else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "return_flags"))) {
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "return_flags")))
GET_ATTR_return_flags(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "caller_ctx")))
+ GET_ATTR_caller_ctx(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "lex_pad")))
+ GET_ATTR_lex_pad(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "outer_ctx")))
+ GET_ATTR_outer_ctx(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_sub")))
+ GET_ATTR_current_sub(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_cont")))
+ GET_ATTR_current_cont(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_object")))
+ GET_ATTR_current_object(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_namespace")))
+ GET_ATTR_current_namespace(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "handlers")))
+ GET_ATTR_handlers(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "results_signature")))
+ GET_ATTR_results_signature(INTERP, SELF, value);
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_HLL"))) {
+ /* This function from src/hash.c. */
+ /* We probably have to move it to more suitable place */
+ GET_ATTR_current_HLL(INTERP, SELF, hll);
+ value = get_integer_pmc(INTERP, hll);
+ }
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_hll"))) {
+ GET_ATTR_current_HLL(INTERP, SELF, hll);
+ value = get_string_pmc(INTERP, Parrot_get_HLL_name(INTERP, hll));
}
else {
/* If unknown attribute name, throw an exception. */
@@ -1319,6 +1473,69 @@
return dest;
}
+
+/*
+
+=item C<PMC *backtrace>
+
+Gets a representation of the backtrace starting from this Context.
+Returns an array of hashes. Each array element represents a caller in
+the backtrace, the most recent caller first. The hash has two keys: C<sub>,
+which holds the PMC representing the sub, and C<annotations> which is a hash
+of the annotations at the point where the exception was thrown for the current
+sub, or for the point of the call a level deeper for the rest.
+
+=cut
+
+*/
+
+ METHOD backtrace(PMC *resume :optional, INTVAL has_resume :opt_flag) {
+ PMC *result = pmc_new(interp, enum_class_ResizablePMCArray);
+ PMC *cur_ctx = SELF;
+ Parrot_Continuation_attributes *cont = has_resume ? PMC_cont(resume) : NULL;
+
+ /* Get starting context, then loop over them. */
+ while (cur_ctx) {
+ PMC *frame = pmc_new(interp, enum_class_Hash);
+ PMC *annotations = NULL;
+ Parrot_Sub_attributes *sub;
+
+ /* Get sub and put it in the hash. */
+ PMC *sub_pmc = Parrot_pcc_get_sub(interp, cur_ctx);
+
+ if (!sub_pmc)
+ sub_pmc = PMCNULL;
+
+ VTABLE_set_pmc_keyed_str(interp, frame, CONST_STRING(interp, "sub"), sub_pmc);
+
+ /* Look up any annotations and put them in the hash. */
+ if (!PMC_IS_NULL(sub_pmc)) {
+ PMC_get_sub(interp, sub_pmc, sub);
+
+ if (sub->seg->annotations) {
+ PackFile_ByteCode *seg = sub->seg;
+ opcode_t *pc = cont && cur_ctx == cont->to_ctx
+ ? cont->address
+ : Parrot_pcc_get_pc(interp, cur_ctx);
+
+ annotations = PackFile_Annotations_lookup(interp,
+ seg->annotations, pc - seg->base.data,
+ NULL);
+ }
+ }
+
+ if (!annotations)
+ annotations = pmc_new(interp, enum_class_Hash);
+
+ VTABLE_set_pmc_keyed_str(interp, frame, CONST_STRING(interp, "annotations"), annotations);
+
+ /* Push frame and go to next caller. */
+ VTABLE_push_pmc(interp, result, frame);
+ cur_ctx = Parrot_pcc_get_caller_ctx(interp, cur_ctx);
+ }
+
+ RETURN(PMC *result);
+ }
/*
=back
More information about the parrot-commits
mailing list