Author: chromatic
Date: Tue May 1 19:58:21 2007
New Revision: 18386
Modified:
trunk/src/pmc/addrregistry.pmc
trunk/src/pmc/array.pmc
trunk/src/pmc/bigint.pmc
trunk/src/pmc/closure.pmc
trunk/src/pmc/complex.pmc
trunk/src/pmc/continuation.pmc
trunk/src/pmc/coroutine.pmc
trunk/src/pmc/default.pmc
trunk/src/pmc/exception_handler.pmc
trunk/src/pmc/key.pmc
trunk/src/pmc/lexpad.pmc
trunk/src/pmc/null.pmc
trunk/src/pmc/parrotinterpreter.pmc
trunk/src/pmc/parrotio.pmc
trunk/src/pmc/parrotobject.pmc
trunk/src/pmc/parrotthread.pmc
trunk/src/pmc/pointer.pmc
trunk/src/pmc/retcontinuation.pmc
trunk/src/pmc/string.pmc
trunk/src/pmc/sub.pmc
trunk/src/pmc/super.pmc
trunk/src/pmc/timer.pmc
trunk/src/pmc/vtablecache.pmc
Log:
[PMC] Fix some casting errors that C++ hates.
I am this -> <- close to fixing the signature for VTABLE_invoke(), too.
Modified: trunk/src/pmc/addrregistry.pmc
==============================================================================
--- trunk/src/pmc/addrregistry.pmc (original)
+++ trunk/src/pmc/addrregistry.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2005, The Perl Foundation.
+Copyright (C) 2005-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -90,7 +90,7 @@
void mark() {
if (PMC_struct_val(SELF))
- parrot_mark_hash(INTERP, PMC_struct_val(SELF));
+ parrot_mark_hash(INTERP, (Hash *)PMC_struct_val(SELF));
}
/*
@@ -113,21 +113,21 @@
*/
INTVAL get_integer_keyed(PMC* key) {
- Hash *hash = PMC_struct_val(SELF);
- HashBucket *b;
+ Hash *hash = (Hash *)PMC_struct_val(SELF);
+ HashBucket *b = parrot_hash_get_bucket(INTERP, hash, key);
- b = parrot_hash_get_bucket(INTERP, hash, key);
if (b == NULL)
return 0;
+
return (INTVAL) b->value;
}
INTVAL elements() {
- return parrot_hash_size(INTERP, PMC_struct_val(SELF));
+ return parrot_hash_size(INTERP, (Hash *)PMC_struct_val(SELF));
}
INTVAL get_bool() {
- return parrot_hash_size(INTERP, PMC_struct_val(SELF)) != 0;
+ return parrot_hash_size(INTERP, (Hash *)PMC_struct_val(SELF)) != 0;
}
/*
@@ -195,13 +195,14 @@
return Parrot_Hash_get_iter(INTERP, SELF);
}
- PMC* get_pmc_keyed(PMC* key) {
- Hash *hash = PMC_struct_val(SELF);
+ PMC* get_pmc_keyed(PMC *key) {
+ Hash *hash = (Hash *)PMC_struct_val(SELF);
if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) ==
KEY_hash_iterator_FLAGS) {
- return parrot_hash_get_idx(INTERP, hash, key);
+ return (PMC *)parrot_hash_get_idx(INTERP, hash, key);
}
+
return PMCNULL;
}
}
Modified: trunk/src/pmc/array.pmc
==============================================================================
--- trunk/src/pmc/array.pmc (original)
+++ trunk/src/pmc/array.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2006, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -1250,13 +1250,15 @@
for (i = 0; i < max; ++i) {
PMC *value;
- value = list_get(INTERP, PMC_data(ret), i, enum_type_PMC);
+ value = list_get(INTERP, PMC_data_typed(ret, List *),
+ i, enum_type_PMC);
+
if (!PMC_IS_NULL(value)) {
PMC *new_value;
/* XXX do we need to clone first? */
new_value = VTABLE_share_ro(INTERP, value);
if (new_value != value) {
- list_assign(INTERP, PMC_data(ret),
+ list_assign(INTERP, PMC_data_typed(ret, List *),
i, new_value, enum_type_PMC);
}
}
Modified: trunk/src/pmc/bigint.pmc
==============================================================================
--- trunk/src/pmc/bigint.pmc (original)
+++ trunk/src/pmc/bigint.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2004, The Perl Foundation.
+Copyright (C) 2004-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -96,7 +96,7 @@
static char *
bigint_get_string(Interp *interp, PMC *self, int base) {
size_t n = mpz_sizeinbase(BN(self), base) + 2;
- char *s = mem_sys_allocate(n);
+ char *s = (char *)mem_sys_allocate(n);
return mpz_get_str(s, base, BN(self));
}
Modified: trunk/src/pmc/closure.pmc
==============================================================================
--- trunk/src/pmc/closure.pmc (original)
+++ trunk/src/pmc/closure.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -80,16 +80,16 @@
void set_pointer(void* value) {
struct Parrot_sub * sub = PMC_sub(SELF);
- opcode_t *addr = value;
+ opcode_t *addr = (opcode_t *)value;
sub->start_offs = addr - sub->seg->base.data;
}
- opcode_t* invoke(void* next) {
- struct Parrot_sub * sub = PMC_sub(SELF);
+ opcode_t* invoke(void *in_next) {
+ struct Parrot_sub *sub = PMC_sub(SELF);
PMC *cont, *outer_sub;
+ opcode_t *next = SUPER(in_next);
+ outer_sub = sub->outer_sub;
- next = SUPER(next);
- outer_sub = sub->outer_sub;
if (sub->outer_ctx) {
/* during newclosure, outer's ctx was stored in
* sub->outer_ctx
@@ -124,12 +124,15 @@
* exception
*/
INTERP->current_cont = NEED_CONTINUATION;
+
(void)VTABLE_invoke(INTERP, sub->outer_sub, next);
- caller = CONTEXT(INTERP->ctx);
- cont = caller->current_cont;
- cont->vtable = interp->vtables[enum_class_Continuation];
- sub->outer_ctx = sub->ctx->outer_ctx = caller;
+
+ caller = CONTEXT(INTERP->ctx);
+ cont = caller->current_cont;
+ cont->vtable =
interp->vtables[enum_class_Continuation];
+ sub->outer_ctx = sub->ctx->outer_ctx = caller;
caller->ref_count++;
+
(void)VTABLE_invoke(INTERP, cont, next);
}
}
Modified: trunk/src/pmc/complex.pmc
==============================================================================
--- trunk/src/pmc/complex.pmc (original)
+++ trunk/src/pmc/complex.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2004-2006, The Perl Foundation.
+Copyright (C) 2004-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -287,14 +287,16 @@
=cut
*/
- opcode_t* invoke(void* next) {
+ opcode_t* invoke(void *next) {
int argcP = REG_INT(3);
- PMC *res = pmc_new(INTERP, enum_class_Complex);
+ PMC *res = pmc_new(INTERP, enum_class_Complex);
+
if (argcP == 1) {
- PMC *arg = REG_PMC(5);
- if (arg->vtable->base_type == enum_class_String) {
+ PMC *arg;
+ arg = REG_PMC(5);
+
+ if (arg->vtable->base_type == enum_class_String)
VTABLE_set_string_native(INTERP, res, PMC_str_val(arg));
- }
else
RE(res) = VTABLE_get_number(INTERP, arg);
}
@@ -302,8 +304,9 @@
RE(res) = VTABLE_get_number(INTERP, REG_PMC(5));
IM(res) = VTABLE_get_number(INTERP, REG_PMC(6));
}
+
REG_PMC(5) = res;
- return next;
+ return (opcode_t *)next;
}
/*
Modified: trunk/src/pmc/continuation.pmc
==============================================================================
--- trunk/src/pmc/continuation.pmc (original)
+++ trunk/src/pmc/continuation.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -168,16 +168,16 @@
*/
- void set_pointer(void* value) {
- opcode_t *pos = value;
- struct Parrot_cont * cc = PMC_cont(SELF);
+ void set_pointer(void *value) {
+ opcode_t *pos = (opcode_t *)value;
+ struct Parrot_cont *cc = PMC_cont(SELF);
- cc->address = value;
+ cc->address = (opcode_t *)value;
cc->dynamic_state = INTERP->dynamic_env;
- cc->runloop_id = INTERP->current_runloop_id;
- if (pos && *pos == PARROT_OP_get_results_pc) {
+ cc->runloop_id = INTERP->current_runloop_id;
+
+ if (pos && *pos == PARROT_OP_get_results_pc)
cc->current_results = pos;
- }
else
cc->current_results = NULL;
}
Modified: trunk/src/pmc/coroutine.pmc
==============================================================================
--- trunk/src/pmc/coroutine.pmc (original)
+++ trunk/src/pmc/coroutine.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -108,13 +108,18 @@
PMC* clone() {
struct Parrot_coro * sub;
- PMC* ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
+ PMC* ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
+
PObj_custom_mark_destroy_SETALL(ret);
- sub = mem_sys_allocate(sizeof (struct Parrot_coro));
+
+ sub = mem_allocate_typed(struct Parrot_coro);
PMC_struct_val(ret) = sub;
- PMC_pmc_val(ret) = NULL;
+ PMC_pmc_val(ret) = NULL;
+
memcpy(sub, PMC_sub(SELF), sizeof (struct Parrot_coro));
- sub->name = string_copy(INTERP, sub->name);
+
+ sub->name = string_copy(INTERP, sub->name);
+
return ret;
}
@@ -128,46 +133,47 @@
*/
- opcode_t* invoke(void* next) {
- struct Parrot_coro * co = PMC_coro(SELF);
- parrot_context_t *caller_ctx;
- PackFile_ByteCode *wanted_seg;
+ opcode_t* invoke(void *next) {
+ parrot_context_t *caller_ctx;
+ PackFile_ByteCode *wanted_seg;
struct Stack_Chunk *state;
- opcode_t * dest = co->address;
- parrot_context_t *ctx;
- PMC *ccont;
+ parrot_context_t *ctx;
+ PMC *ccont;
+ struct Parrot_coro *co = PMC_coro(SELF);
+ opcode_t *dest = co->address;
- if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG)) {
+ if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
print_sub_name(INTERP, SELF);
- }
+
if (!co->ctx) {
/* TODO factor out common code with Sub.invoke
* and inherit it
*/
ccont = INTERP->current_cont;
- if (ccont == NEED_CONTINUATION) {
- ccont = (PMC *)new_ret_continuation_pmc(interp, next);
- }
- if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
+ if (ccont == NEED_CONTINUATION)
+ ccont = (PMC *)new_ret_continuation_pmc(interp,
+ (opcode_t *)next);
+
+ if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL)
real_exception(INTERP, NULL, E_Exception,
"tail call to coro not allowed");
- }
+
caller_ctx = CONTEXT(INTERP->ctx);
- /*
- * first time set current sub, cont, object
- */
+
+ /* first time set current sub, cont, object */
Parrot_alloc_context(INTERP, co->n_regs_used);
- co->ctx = ctx = CONTEXT(INTERP->ctx);
- co->dynamic_state = interp->dynamic_env;
- ctx->caller_ctx = caller_ctx;
+
+ co->ctx = ctx = CONTEXT(INTERP->ctx);
+ co->dynamic_state = interp->dynamic_env;
+ ctx->caller_ctx = caller_ctx;
PMC_cont(ccont)->from_ctx = ctx;
- ctx->current_sub = SELF;
- ctx->current_HLL = co->HLL_id;
- ctx->current_namespace = co->namespace_stash;
- ctx->current_cont = ccont;
- ctx->current_object = NULL;
- INTERP->current_object = NULL;
- INTERP->current_cont = NULL;
+ ctx->current_sub = SELF;
+ ctx->current_HLL = co->HLL_id;
+ ctx->current_namespace = co->namespace_stash;
+ ctx->current_cont = ccont;
+ ctx->current_object = NULL;
+ INTERP->current_object = NULL;
+ INTERP->current_cont = NULL;
/* create pad if needed */
if (!PMC_IS_NULL(co->lex_info)) {
@@ -179,34 +185,39 @@
}
PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
- wanted_seg = co->seg;
- co->caller_seg = INTERP->code;
- co->address = co->seg->base.data + co->start_offs;
+ wanted_seg = co->seg;
+ co->caller_seg = INTERP->code;
+ co->address = co->seg->base.data + co->start_offs;
}
+
/* if calling the Coro we need the segment of the Coro */
else if (!(PObj_get_FLAGS(SELF) & SUB_FLAG_CORO_FF)) {
PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
- wanted_seg = co->seg;
+ wanted_seg = co->seg;
+
/* remember segment of caller */
- co->caller_seg = INTERP->code;
- ctx = co->ctx;
+ co->caller_seg = INTERP->code;
+ ctx = co->ctx;
+
/* and the recent call context */
- ccont = ctx->current_cont;
- ctx->caller_ctx = PMC_cont(ccont)->to_ctx = CONTEXT(INTERP->ctx);
+ ccont = ctx->current_cont;
+ ctx->caller_ctx = PMC_cont(ccont)->to_ctx =
CONTEXT(INTERP->ctx);
/* set context to coro context */
- state = interp->dynamic_env;
- interp->dynamic_env = co->dynamic_state;
- co->dynamic_state = state;
- CONTEXT(INTERP->ctx) = ctx;
- INTERP->ctx.bp = ctx->bp;
- INTERP->ctx.bp_ps = ctx->bp_ps;
+ state = interp->dynamic_env;
+ interp->dynamic_env = co->dynamic_state;
+ co->dynamic_state = state;
+ CONTEXT(INTERP->ctx) = ctx;
+ INTERP->ctx.bp = ctx->bp;
+ INTERP->ctx.bp_ps = ctx->bp_ps;
}
else {
PObj_get_FLAGS(SELF) &= ~SUB_FLAG_CORO_FF;
/* switch back to last remembered code seg and context */
- wanted_seg = co->caller_seg;
- ccont = co->ctx->current_cont;
- ctx = PMC_cont(ccont)->to_ctx;
+
+ wanted_seg = co->caller_seg;
+ ccont = co->ctx->current_cont;
+ ctx = PMC_cont(ccont)->to_ctx;
+
if (! ctx) {
/* This still isn't quite right, but it beats segfaulting. See
the "Call an exited coroutine" case in t/pmc/coroutine.t;
the
@@ -216,20 +227,22 @@
real_exception(INTERP, NULL, E_Exception,
"Cannot resume dead coroutine.");
}
- state = interp->dynamic_env;
- interp->dynamic_env = co->dynamic_state;
- co->dynamic_state = state;
+
+ state = interp->dynamic_env;
+ interp->dynamic_env = co->dynamic_state;
+ co->dynamic_state = state;
CONTEXT(INTERP->ctx) = ctx;
- INTERP->ctx.bp = ctx->bp;
- INTERP->ctx.bp_ps = ctx->bp_ps;
+ INTERP->ctx.bp = ctx->bp;
+ INTERP->ctx.bp_ps = ctx->bp_ps;
}
/* toggle address */
- dest = co->address;
+ dest = co->address;
co->address = (opcode_t *)next;
- if (INTERP->code != wanted_seg) {
+
+ if (INTERP->code != wanted_seg)
Parrot_switch_to_cs(INTERP, wanted_seg, 1);
- }
+
return dest;
}
Modified: trunk/src/pmc/default.pmc
==============================================================================
--- trunk/src/pmc/default.pmc (original)
+++ trunk/src/pmc/default.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -942,38 +942,47 @@
return SELF;
}
- PMC* get_attr_str(STRING* name) {
- PMC *p = NULL;
- HashBucket* b;
- /* lets look for props first
+ PMC* get_attr_str(STRING *name) {
+ PMC *p = NULL;
+ HashBucket *b;
+
+ /* let's look for props first
* XXX do we need that in the default object system?
*/
if (SELF->pmc_ext && PMC_metadata(SELF)) {
b = parrot_hash_get_bucket(INTERP, (Hash*) PMC_metadata(SELF),
name);
if (b)
- p = b->value;
+ p = (PMC *)b->value;
}
- if (PMC_IS_NULL(p)) {
- /* may be NCI? */
+
+ /* may be NCI? */
+ if (PMC_IS_NULL(p))
p = VTABLE_find_method(INTERP, SELF, name);
- }
+
if (PMC_IS_NULL(p)) {
/* TODO AttributeError */
}
else if (VTABLE_isa(INTERP, p, CONST_STRING(INTERP, "NCI"))) {
- PMC *bound_meth = VTABLE_clone(INTERP, p);
+ PMC *bound_meth;
+
+ bound_meth = VTABLE_clone(INTERP, p);
bound_meth->vtable = interp->vtables[enum_class_Bound_NCI];
VTABLE_set_pmc(INTERP, bound_meth, SELF);
+
return bound_meth;
}
else if (p->vtable->base_type == enum_class_MultiSub) {
- PMC *bound_meth = pmc_new(INTERP, enum_class_Bound_NCI);
+ PMC *bound_meth;
+
+ bound_meth = pmc_new(INTERP,
enum_class_Bound_NCI);
VTABLE_set_pmc(INTERP, bound_meth, SELF);
- PMC_struct_val(bound_meth) = p;
+ PMC_struct_val(bound_meth) = p;
PObj_get_FLAGS(bound_meth) |= PObj_private0_FLAG;
+
return bound_meth;
}
+
/* TODO bound user functions */
return p;
}
Modified: trunk/src/pmc/exception_handler.pmc
==============================================================================
--- trunk/src/pmc/exception_handler.pmc (original)
+++ trunk/src/pmc/exception_handler.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -28,7 +28,7 @@
opcode_t *dest, parrot_context_t * old_ctx, ...)
{
va_list ap;
- void *next;
+ opcode_t *next;
va_start(ap, old_ctx);
next = parrot_pass_args_fromc(interp, sig, dest, old_ctx, ap);
va_end(ap);
@@ -76,6 +76,7 @@
PMC_struct_val(SELF) = NULL;
}
}
+
PMC* clone() {
PMC *result = SUPER();
PObj_custom_mark_CLEAR(result);
@@ -83,28 +84,32 @@
}
opcode_t* invoke(void* ex) {
- struct Parrot_cont * cc = PMC_cont(SELF);
- PMC *exception = ex;
- parrot_context_t *ex_ctx;
- void *next = NULL;
- opcode_t *results;
+ struct Parrot_cont *cc = PMC_cont(SELF);
+ PMC *exception = (PMC *)ex;
+ opcode_t *next = NULL;
+ parrot_context_t *ex_ctx;
+ opcode_t *results;
+
/* COMPAT: PMC *p5 = REG_PMC(5);*/
assert(cc->to_ctx == cc->from_ctx);
results = cc->current_results;
+
/* clear all results, so that continuation.invoke
* doesn't pass any args #'
*/
cc->to_ctx->current_results = cc->current_results= NULL;
- ex_ctx = CONTEXT(INTERP->ctx);
- next = SUPER(next);
+ ex_ctx = CONTEXT(INTERP->ctx);
+ next = SUPER(next);
+
if (results) {
STRING *message = VTABLE_get_string_keyed_int(INTERP,
exception, 0);
assert(next == results);
- next = pass_exception_args(interp, "PS", next,
- ex_ctx, exception, message);
+ next = pass_exception_args(interp, "PS", next,
+ ex_ctx, exception, message);
}
+
return next;
}
}
Modified: trunk/src/pmc/key.pmc
==============================================================================
--- trunk/src/pmc/key.pmc (original)
+++ trunk/src/pmc/key.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -433,13 +433,17 @@
}
void thawfinish(visit_info *info) {
- PMC *key = SELF, *next;
+ PMC *key = SELF;
+ PMC *next;
+
while (1) {
- next = PMC_data(key);
+ next = (PMC *)PMC_data(key);
+
if (PMC_IS_NULL(next)) {
PMC_data(key) = NULL;
break;
}
+
key = next;
}
}
Modified: trunk/src/pmc/lexpad.pmc
==============================================================================
--- trunk/src/pmc/lexpad.pmc (original)
+++ trunk/src/pmc/lexpad.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2005, The Perl Foundation.
+Copyright (C) 2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -71,14 +71,14 @@
Set the lexical with the given name to value. If the lexical name
doesn't exist, it is created.
-=item C<METHOD PMC* get_lexinfo()>
+=item C<METHOD PMC *get_lexinfo()>
Return the LexInfo PMC, if any or a Null PMC.
=cut
*/
- void init_pmc(PMC* lexinfo) {
+ void init_pmc(PMC *lexinfo) {
PMC_pmc_val(SELF) = lexinfo;
}
@@ -88,7 +88,7 @@
INTVAL elements() {
PMC *info = PMC_pmc_val(SELF);
- return parrot_hash_size(INTERP, PMC_struct_val(info));
+ return parrot_hash_size(INTERP, (Hash *)PMC_struct_val(info));
}
INTVAL exists_keyed_str(STRING* name) {
@@ -97,42 +97,47 @@
(Hash*) PMC_struct_val(info), name) != 0;
}
- INTVAL exists_keyed(PMC* name) {
+ INTVAL exists_keyed(PMC *name) {
STRING *s = key_string(INTERP, name);
return SELF.exists_keyed_str(s);
}
PMC* get_pmc_keyed_str(STRING* name) {
- PMC *info = PMC_pmc_val(SELF);
- Hash *hash = PMC_struct_val(info);
- parrot_context_t *ctx = PMC_struct_val(SELF);
- HashBucket *b = parrot_hash_get_bucket(INTERP, hash, name);
- INTVAL regno;
+ PMC *info = PMC_pmc_val(SELF);
+ Hash *hash = (Hash *)PMC_struct_val(info);
+ parrot_context_t *ctx = PMC_struct_val(SELF);
+ HashBucket *b = parrot_hash_get_bucket(INTERP, hash, name);
+ INTVAL regno;
+
if (!b)
return NULL;
+
regno = (INTVAL) b->value;
+
return CTX_REG_PMC(ctx, regno);
}
- PMC* get_pmc_keyed(PMC* name) {
+ PMC* get_pmc_keyed(PMC *name) {
STRING *s = key_string(INTERP, name);
return SELF.get_pmc_keyed_str(s);
}
- void set_pmc_keyed_str(STRING* name, PMC* value) {
- PMC *info = PMC_pmc_val(SELF);
- Hash *hash = PMC_struct_val(info);
- parrot_context_t *ctx = PMC_struct_val(SELF);
- HashBucket *b = parrot_hash_get_bucket(INTERP, hash, name);
- INTVAL regno;
+ void set_pmc_keyed_str(STRING *name, PMC *value) {
+ PMC *info = PMC_pmc_val(SELF);
+ Hash *hash = (Hash *)PMC_struct_val(info);
+ parrot_context_t *ctx = PMC_struct_val(SELF);
+ HashBucket *b = parrot_hash_get_bucket(INTERP, hash, name);
+ INTVAL regno;
+
if (!b)
real_exception(interp, NULL, LEX_NOT_FOUND,
"Lexical '%Ss' not found", name);
- regno = (INTVAL) b->value;
+
+ regno = (INTVAL) b->value;
CTX_REG_PMC(ctx, regno) = value;
}
- void set_pmc_keyed(PMC* name, PMC* value) {
+ void set_pmc_keyed(PMC *name, PMC *value) {
STRING *s = key_string(INTERP, name);
SELF.set_pmc_keyed_str(s, value);
}
Modified: trunk/src/pmc/null.pmc
==============================================================================
--- trunk/src/pmc/null.pmc (original)
+++ trunk/src/pmc/null.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -46,8 +46,8 @@
return PMCNULL;
}
- void set_pointer(void* p) {
- PMCNULL = p;
+ void set_pointer(void *p) {
+ PMCNULL = (PMC *)p;
}
INTVAL does(STRING* what) {
Modified: trunk/src/pmc/parrotinterpreter.pmc
==============================================================================
--- trunk/src/pmc/parrotinterpreter.pmc (original)
+++ trunk/src/pmc/parrotinterpreter.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -232,10 +232,11 @@
*/
void init_pmc(PMC *parent) {
- Parrot_Interp p = PMC_data(parent);
- if (!PMC_data(SELF)) {
+ Parrot_Interp p = (Parrot_Interp)PMC_data(parent);
+
+ if (!PMC_data(SELF))
create_interp(SELF, p);
- }
+
PMC_struct_val(SELF) = NULL;
}
@@ -277,219 +278,222 @@
*/
- INTVAL get_integer() {
- Parrot_Interp i = PMC_data(SELF);
- return (INTVAL)i->thread_data->tid;
- }
-
-/*
-
-=item C<opcode_t *invoke(void *next)>
-
-Runs the interpreter's byte code.
-
-=cut
-
-*/
+ INTVAL get_integer() {
+ Parrot_Interp i = PMC_data_typed(SELF, Parrot_Interp);
+ return (INTVAL)i->thread_data->tid;
+ }
- opcode_t* invoke(void* next) {
- Interp * new_interp =
- (Interp *)PMC_data(SELF);
- /*
- * setup code
- */
- pt_thread_prepare_for_run(new_interp, interp);
- /*
- * TODO pass arguments from parent (interp)
- * to child (new_interp)
- * by possibly clone of share the arguments
- * r/o args can be passed as is
- */
+ /*
- /* calculate offset and run */
- runops(new_interp, (opcode_t *)PMC_struct_val(SELF) -
- (opcode_t *)interp->code->base.data);
- return next;
- }
+ =item C<opcode_t *invoke(void *next)>
-/*
+ Runs the interpreter's byte code.
-=item C<PMC *get_pmc_keyed_int(INTVAL key)>
+ =cut
-Returns the PMC global value for C<key>.
+ */
-=cut
+ opcode_t* invoke(void* next) {
+ Interp * new_interp =
+ (Interp *)PMC_data(SELF);
+ /*
+ * setup code
+ */
+ pt_thread_prepare_for_run(new_interp, interp);
+ /*
+ * TODO pass arguments from parent (interp)
+ * to child (new_interp)
+ * by possibly clone of share the arguments
+ * r/o args can be passed as is
+ */
-*/
+ /* calculate offset and run */
+ runops(new_interp, (opcode_t *)PMC_struct_val(SELF) -
+ (opcode_t *)interp->code->base.data);
+ return next;
+ }
- PMC* get_pmc_keyed_int(INTVAL key) {
- Interp * new_interp =
- (Interp *)PMC_data(SELF);
- if (key >= 0 && key < IGLOBALS_SIZE)
- return VTABLE_get_pmc_keyed_int(new_interp,
- new_interp->iglobals, key);
- /* quick hack to get the global stash */
- if (key == -1)
- return new_interp->root_namespace;
- return NULL;
- }
+ /*
-/*
+ =item C<PMC *get_pmc_keyed_int(INTVAL key)>
-=item C<PMC *get_pmc_keyed(PMC* key)>
+ Returns the PMC global value for C<key>.
-Introspection interface. C<key> can be:
+ =cut
- "sub" ... return Sub object of this subroutine
- "continuation" ... return Continuation PMC
- "lexpad" ... return lexpad PMC for this sub
- "namespace" ... return namespace PMC for this sub
- "outer" ... return outer sub of this closure
- "<item>"; level ... same for caller <level>
- "outer"; "<item>" ... same for outer level 1
- "outer"; "<item>"; level ... same for outer <level>
+ */
- "globals" ... return global stash
+ PMC* get_pmc_keyed_int(INTVAL key) {
+ Interp * new_interp =
+ (Interp *)PMC_data(SELF);
+ if (key >= 0 && key < IGLOBALS_SIZE)
+ return VTABLE_get_pmc_keyed_int(new_interp,
+ new_interp->iglobals, key);
+ /* quick hack to get the global stash */
+ if (key == -1)
+ return new_interp->root_namespace;
+ return NULL;
+ }
-=cut
+ /*
-*/
+ =item C<PMC *get_pmc_keyed(PMC* key)>
- PMC* get_pmc_keyed(PMC * key) {
- int level = 0;
- PMC* nextkey;
- STRING *item, *s, *outer;
- parrot_context_t *ctx;
- PMC *cont;
+ Introspection interface. C<key> can be:
- item = key_string(interp, key);
- s = CONST_STRING(interp, "globals");
- if (string_equal(interp, item, s) == 0)
- return interp->root_namespace;
- outer = NULL;
- s = CONST_STRING(interp, "outer");
- if (string_equal(interp, item, s) == 0) {
- outer = item;
- nextkey = key_next(INTERP, key);
- if (nextkey && (PObj_get_FLAGS(nextkey) & KEY_string_FLAG)) {
- key = nextkey;
- item = key_string(interp, key);
+ "sub" ... return Sub object of this subroutine
+ "continuation" ... return Continuation PMC
+ "lexpad" ... return lexpad PMC for this sub
+ "namespace" ... return namespace PMC for this sub
+ "outer" ... return outer sub of this closure
+ "<item>"; level ... same for caller <level>
+ "outer"; "<item>" ... same for outer level 1
+ "outer"; "<item>"; level ... same for outer <level>
+
+ "globals" ... return global stash
+
+ =cut
+
+ */
+
+ PMC* get_pmc_keyed(PMC * key) {
+ int level = 0;
+ PMC* nextkey;
+ STRING *item, *s, *outer;
+ parrot_context_t *ctx;
+ PMC *cont;
+
+ item = key_string(interp, key);
+ s = CONST_STRING(interp, "globals");
+ if (string_equal(interp, item, s) == 0)
+ return interp->root_namespace;
+ outer = NULL;
+ s = CONST_STRING(interp, "outer");
+ if (string_equal(interp, item, s) == 0) {
+ outer = item;
+ nextkey = key_next(INTERP, key);
+ if (nextkey && (PObj_get_FLAGS(nextkey) & KEY_string_FLAG)) {
+ key = nextkey;
+ item = key_string(interp, key);
+ }
}
- }
- nextkey = key_next(INTERP, key);
- if (nextkey)
- level = key_integer(interp, nextkey);
- else if (outer)
- level = 1;
- if (level < 0)
- real_exception(interp, NULL, E_ValueError,
- "No such caller depth");
- ctx = CONTEXT(interp->ctx);
- if (outer) {
- for (; level; --level) {
- ctx = ctx->outer_ctx;
- if (!ctx)
- real_exception(interp, NULL, E_ValueError,
- "No such outer depth");
+ nextkey = key_next(INTERP, key);
+ if (nextkey)
+ level = key_integer(interp, nextkey);
+ else if (outer)
+ level = 1;
+ if (level < 0)
+ real_exception(interp, NULL, E_ValueError,
+ "No such caller depth");
+ ctx = CONTEXT(interp->ctx);
+ if (outer) {
+ for (; level; --level) {
+ ctx = ctx->outer_ctx;
+ if (!ctx)
+ real_exception(interp, NULL, E_ValueError,
+ "No such outer depth");
+ }
}
- }
- else {
- for (; level; --level) {
- cont = ctx->current_cont;
- if (PMC_IS_NULL(cont) || !PMC_cont(cont)->seg)
- real_exception(interp, NULL, E_ValueError,
- "No such caller depth");
- ctx = PMC_cont(cont)->to_ctx;
- if (!ctx->current_sub)
- real_exception(interp, NULL, E_ValueError,
- "No such caller depth");
+ else {
+ for (; level; --level) {
+ cont = ctx->current_cont;
+ if (PMC_IS_NULL(cont) || !PMC_cont(cont)->seg)
+ real_exception(interp, NULL, E_ValueError,
+ "No such caller depth");
+ ctx = PMC_cont(cont)->to_ctx;
+ if (!ctx->current_sub)
+ real_exception(interp, NULL, E_ValueError,
+ "No such caller depth");
+ }
}
+ if (item == outer)
+ return ctx->current_sub;
+ s = CONST_STRING(interp, "sub");
+ if (string_equal(interp, item, s) == 0)
+ return ctx->current_sub;
+ s = CONST_STRING(interp, "lexpad");
+ if (string_equal(interp, item, s) == 0)
+ return ctx->lex_pad;
+ s = CONST_STRING(interp, "namespace");
+ if (string_equal(interp, item, s) == 0)
+ return ctx->current_namespace;
+ s = CONST_STRING(interp, "continuation");
+ if (string_equal(interp, item, s) == 0)
+ return VTABLE_clone(interp, ctx->current_cont);
+ real_exception(interp, NULL, E_ValueError,
+ "No such item %Ss", item);
+ return PMCNULL;
}
- if (item == outer)
- return ctx->current_sub;
- s = CONST_STRING(interp, "sub");
- if (string_equal(interp, item, s) == 0)
- return ctx->current_sub;
- s = CONST_STRING(interp, "lexpad");
- if (string_equal(interp, item, s) == 0)
- return ctx->lex_pad;
- s = CONST_STRING(interp, "namespace");
- if (string_equal(interp, item, s) == 0)
- return ctx->current_namespace;
- s = CONST_STRING(interp, "continuation");
- if (string_equal(interp, item, s) == 0)
- return VTABLE_clone(interp, ctx->current_cont);
- real_exception(interp, NULL, E_ValueError,
- "No such item %Ss", item);
- return PMCNULL;
- }
-/*
+ /*
-=item C<INTVAL get_integer_keyed_int(INTVAL key)>
+ =item C<INTVAL get_integer_keyed_int(INTVAL key)>
-Returns the interpreter info for C<key>.
+ Returns the interpreter info for C<key>.
-=cut
+ =cut
-*/
+ */
- INTVAL get_integer_keyed_int(INTVAL key) {
- Interp * new_interp =
- (Interp *)PMC_data(SELF);
- switch (key) {
- case -1:
- return (INTVAL) new_interp->flags;
- default:
- return interpinfo(new_interp, key);
+ INTVAL get_integer_keyed_int(INTVAL key) {
+ Interp * new_interp =
+ (Interp *)PMC_data(SELF);
+ switch (key) {
+ case -1:
+ return (INTVAL) new_interp->flags;
+ default:
+ return interpinfo(new_interp, key);
+ }
}
- }
-
-/*
-=item C<void set_integer_keyed_int(INTVAL key, INTVAL val)>
+ /*
-Sets the interpreter info for C<key> to C<val>.
+ =item C<void set_integer_keyed_int(INTVAL key, INTVAL val)>
-=cut
+ Sets the interpreter info for C<key> to C<val>.
-*/
+ =cut
- void set_integer_keyed_int(INTVAL key, INTVAL val) {
- Interp * new_interp =
- (Interp *)PMC_data(SELF);
- INTVAL allowed;
+ */
- switch (key) {
- case -1: /* set interpreter flags */
- allowed =
- PARROT_BOUNDS_FLAG |
- PARROT_PROFILE_FLAG |
- PARROT_GC_DEBUG_FLAG;
- Parrot_clear_flag(new_interp, allowed);
- Parrot_set_flag(new_interp, val & allowed);
- break;
+ void set_integer_keyed_int(INTVAL key, INTVAL val) {
+ Interp * new_interp =
+ (Interp *)PMC_data(SELF);
+ INTVAL allowed;
+
+ switch (key) {
+ case -1: /* set interpreter flags */
+ allowed =
+ PARROT_BOUNDS_FLAG |
+ PARROT_PROFILE_FLAG |
+ PARROT_GC_DEBUG_FLAG;
+ Parrot_clear_flag(new_interp, allowed);
+ Parrot_set_flag(new_interp, val & allowed);
+ break;
+ }
}
- }
+ /*
+ */
/*
- */
-/*
-=item C<PMC *clone()>
+ =item C<PMC *clone()>
-First attempt to make things running, and to see, where problems may
-arise. Only minimal items are done yet.
+ First attempt to make things running, and to see, where problems may
+ arise. Only minimal items are done yet.
-XXX this should of course call C<Parrot_clone()> and use freeze/thaw.
+ XXX this should of course call C<Parrot_clone()> and use freeze/thaw.
-=cut
+ =cut
-*/
+ */
+
+ PMC* clone() {
+ PMC* dest = pmc_new(INTERP, SELF->vtable->base_type);
+
+ clone_interpreter((Parrot_Interp)PMC_data(dest),
+ (Parrot_Interp)PMC_data(SELF),
PARROT_CLONE_DEFAULT);
- PMC* clone() {
- PMC* dest = pmc_new(INTERP, SELF->vtable->base_type);
- clone_interpreter(PMC_data(dest), PMC_data(SELF),
PARROT_CLONE_DEFAULT);
return dest;
}
@@ -506,15 +510,17 @@
*/
- INTVAL is_equal(PMC* val) {
- Parrot_Interp self, other;
- self = PMC_data(SELF);
- other = PMC_data(val);
+ INTVAL is_equal(PMC *val) {
+ Parrot_Interp self = PMC_data_typed(SELF, Parrot_Interp);
+ Parrot_Interp other = PMC_data_typed(val, Parrot_Interp);
+
if (!self->thread_data && !other->thread_data)
return 1;
+
if (self->thread_data && other->thread_data &&
self->thread_data->tid == other->thread_data->tid)
return 1;
+
return 0;
}
@@ -642,10 +648,10 @@
INTERP->HLL_namespace, i, ns_hash);
}
}
- if (m > n) {
- /* TODO destruct old HLL_info are constants */
+
+ /* TODO destruct old HLL_info are constants */
+ if (m > n)
INTERP->HLL_info = new_info;
- }
}
METHOD void run_gc() {
Modified: trunk/src/pmc/parrotio.pmc
==============================================================================
--- trunk/src/pmc/parrotio.pmc (original)
+++ trunk/src/pmc/parrotio.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -87,13 +87,15 @@
if (!strcmp(l->name, "buf"))
l = l->down;
/* XXX layer is stored twice - which is used when */
- io->stack = PMC_struct_val(pio) = l;
+ io->stack = l;
+ PMC_struct_val(pio) = l;
/* push the layer */
PIO_push_layer_str(INTERP, pio, layer);
}
else {
l = interp->piodata->default_stack;
- io->stack = PMC_struct_val(pio) = l;
+ io->stack = l;
+ PMC_struct_val(pio) = l;
}
}
/* XXX leaks as in ops/io.ops: open */
Modified: trunk/src/pmc/parrotobject.pmc
==============================================================================
--- trunk/src/pmc/parrotobject.pmc (original)
+++ trunk/src/pmc/parrotobject.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -612,10 +612,11 @@
}
void thawfinish(visit_info *info) {
- PMC *_class = SELF->vtable->pmc_class;
+ PMC *_class = SELF->vtable->pmc_class;
PMC *vtable_pmc = get_attrib_num((SLOTTYPE *)PMC_data(_class),
PCD_OBJECT_VTABLE);
- SELF->vtable = PMC_struct_val(vtable_pmc);
+ SELF->vtable = (VTABLE *)PMC_struct_val(vtable_pmc);
+
set_attrib_flags(SELF);
PObj_is_object_SET(SELF);
}
Modified: trunk/src/pmc/parrotthread.pmc
==============================================================================
--- trunk/src/pmc/parrotthread.pmc (original)
+++ trunk/src/pmc/parrotthread.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -64,7 +64,8 @@
INTVAL tid;
tid = VTABLE_get_integer(interp, thread);
- clone_interpreter(PMC_data(thread), interp, clone_flags);
+ clone_interpreter(PMC_data_typed(thread, Parrot_Interp),
+ interp, clone_flags);
interp->flags &= ~PARROT_THR_COPY_INTERP; /* XXX */
pt_thread_run(interp, thread, sub, args);
@@ -132,7 +133,7 @@
/*
* can't allow DOD runs for now
*/
- stop_GC(INTERP, PMC_data(SELF));
+ stop_GC(INTERP, PMC_data_typed(SELF, Parrot_Interp));
}
/*
@@ -148,7 +149,10 @@
void init_pmc(PMC *parent) {
LOCK(interpreter_array_mutex);
SUPER(parent);
- pt_add_to_interpreters(PMC_data(parent), PMC_data(SELF));
+
+ pt_add_to_interpreters(PMC_data_typed(parent, Parrot_Interp),
+ PMC_data_typed(SELF, Parrot_Interp));
+
UNLOCK(interpreter_array_mutex);
/*
* can't allow DOD runs for now
Modified: trunk/src/pmc/pointer.pmc
==============================================================================
--- trunk/src/pmc/pointer.pmc (original)
+++ trunk/src/pmc/pointer.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -128,14 +128,14 @@
*/
STRING* get_string() {
- STRING* ret;
- char *target=mem_sys_allocate(64);
+ STRING *ret;
+ char *target = (char *)mem_sys_allocate(64);
/* XXX Dangerous if you have a 196-bit system or above
(and if you do, you have too comfortable a life and
deserve to be tormented by coredumps). */
sprintf(target, "Pointer=0x%p", PMC_data(SELF));
- ret=string_make(INTERP, target, strlen(target), "iso-8859-1", 0);
+ ret = string_make(INTERP, target, strlen(target), "iso-8859-1", 0);
mem_sys_free(target);
return ret;
Modified: trunk/src/pmc/retcontinuation.pmc
==============================================================================
--- trunk/src/pmc/retcontinuation.pmc (original)
+++ trunk/src/pmc/retcontinuation.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -82,12 +82,12 @@
*/
- opcode_t* invoke(void* next) {
- struct Parrot_cont * cc = PMC_cont(SELF);
- parrot_context_t *from_ctx = cc->from_ctx;
+ opcode_t* invoke(void *in_next) {
+ struct Parrot_cont *cc = PMC_cont(SELF);
+ parrot_context_t *from_ctx = cc->from_ctx;
PackFile_ByteCode * const seg = cc->seg;
+ opcode_t *next = SUPER(in_next);
- next = SUPER(next);
Parrot_free_context(INTERP, from_ctx, 1);
#ifdef NDEBUG
/* the continuation is dead - delete and destroy it */
@@ -111,9 +111,9 @@
*/
cc->to_ctx = NULL;
#endif
- if (INTERP->code != seg) {
+ if (INTERP->code != seg)
Parrot_switch_to_cs(INTERP, seg, 1);
- }
+
return next;
}
Modified: trunk/src/pmc/string.pmc
==============================================================================
--- trunk/src/pmc/string.pmc (original)
+++ trunk/src/pmc/string.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2003, The Perl Foundation.
+Copyright (C) 2003-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -847,7 +847,8 @@
"Can't translate non-ascii");
p = (unsigned char *)src->strstart;
/* TODO verify trans table */
- tr_data = PMC_data(table); /* XXX */
+
+ tr_data = PMC_data_typed(table, INTVAL *); /* XXX */
for (i = 0; i < len; ++i, ++p) {
ch = *p;
ch = (unsigned char)tr_data[ch];
Modified: trunk/src/pmc/sub.pmc
==============================================================================
--- trunk/src/pmc/sub.pmc (original)
+++ trunk/src/pmc/sub.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2006, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -210,16 +210,16 @@
*/
- opcode_t* invoke(void* next) {
- struct Parrot_sub * sub = PMC_sub(SELF);
- parrot_context_t *caller_ctx;
+ opcode_t* invoke(void *next) {
+ struct Parrot_sub *sub = PMC_sub(SELF);
+ parrot_context_t *caller_ctx;
struct Parrot_Context *context;
- PMC *ccont;
- opcode_t *pc;
+ PMC *ccont;
+ opcode_t *pc;
- if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG)) {
+ if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
print_sub_name(INTERP, SELF);
- }
+
/*
* A remark WRT tail calls
*
@@ -242,15 +242,16 @@
* immediately after argument passing.
*
*/
- pc = sub->seg->base.data + sub->start_offs;
- caller_ctx = CONTEXT(INTERP->ctx);
- ccont = INTERP->current_cont;
+ pc = sub->seg->base.data + sub->start_offs;
+ caller_ctx = CONTEXT(INTERP->ctx);
+ ccont = INTERP->current_cont;
INTERP->current_cont = NULL;
- if (ccont == NEED_CONTINUATION) {
- ccont = new_ret_continuation_pmc(interp, next);
- }
+
+ if (ccont == NEED_CONTINUATION)
+ ccont = new_ret_continuation_pmc(interp, (opcode_t *)next);
assert(!PMC_IS_NULL(ccont));
+
/*
* plain subroutine call
* create new context, place it in interpreter
@@ -261,25 +262,25 @@
context = Parrot_dup_context(INTERP, caller_ctx);
else
#endif
- context = Parrot_alloc_context(INTERP, sub->n_regs_used);
- context->current_sub = SELF;
- context->caller_ctx = caller_ctx;
- context->current_pc = pc;
+ context = Parrot_alloc_context(INTERP, sub->n_regs_used);
+ context->current_sub = SELF;
+ context->caller_ctx = caller_ctx;
+ context->current_pc = pc;
context->current_cont = ccont;
+
/* check recursion/call depth */
if (++context->recursion_depth >
INTERP->recursion_limit) {
real_exception(INTERP, next, E_RuntimeError,
"maximum recursion depth exceeded");
}
- /*
- * and copy set context variables
- */
+
+ /* and copy set context variables */
PMC_cont(ccont)->from_ctx = context;
- /*
- * set context of the sub
- */
+
+ /* set context of the sub */
sub->ctx = context;
+
if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER) {
/* don't destroy context */
ccont->vtable = interp->vtables[enum_class_Continuation];
@@ -290,7 +291,8 @@
context->current_object = INTERP->current_object;
INTERP->current_object = NULL;
}
- context->current_HLL = sub->HLL_id;
+
+ context->current_HLL = sub->HLL_id;
context->current_namespace = sub->namespace_stash;
/* create pad if needed
@@ -304,21 +306,26 @@
sub->lex_info);
VTABLE_set_pointer(INTERP, context->lex_pad, context);
}
+
/* switch code segment if needed */
- if (INTERP->code != sub->seg) {
+ if (INTERP->code != sub->seg)
Parrot_switch_to_cs(INTERP, sub->seg, 1);
- }
+
if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
if (!(*pc == PARROT_OP_get_params_pc ||
(*pc == PARROT_OP_push_eh_ic &&
pc[2] == PARROT_OP_get_params_pc))) {
+
/* TODO keep it or resize it */
--context->recursion_depth;
+
PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
- context->caller_ctx = caller_ctx->caller_ctx;
+ context->caller_ctx = caller_ctx->caller_ctx;
+
Parrot_free_context(INTERP, caller_ctx, 1);
}
}
+
return pc;
}
@@ -333,18 +340,19 @@
*/
PMC* clone() {
- struct Parrot_sub * sub;
- PMC* const ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
- /*
- * we have to mark it ourselves
- */
+ struct Parrot_sub *sub;
+ PMC * const ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
+
+ /* we have to mark it ourselves */
PObj_custom_mark_destroy_SETALL(ret);
- sub = mem_sys_allocate(sizeof (struct Parrot_sub));
+ sub = mem_allocate_typed(struct Parrot_sub);
+
/* first set the sub struct, string_copy may cause GC */
PMC_struct_val(ret) = sub;
- PMC_pmc_val(ret) = NULL;
+ PMC_pmc_val(ret) = NULL;
memcpy(sub, PMC_sub(SELF), sizeof (struct Parrot_sub));
- sub->name = string_copy(INTERP, sub->name);
+ sub->name = string_copy(INTERP, sub->name);
+
return ret;
}
Modified: trunk/src/pmc/super.pmc
==============================================================================
--- trunk/src/pmc/super.pmc (original)
+++ trunk/src/pmc/super.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2005-2006, The Perl Foundation.
+Copyright (C) 2005-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -62,7 +62,8 @@
*/
void init() {
- PMC_pmc_val(SELF) = PMC_struct_val(SELF) = PMCNULL;
+ PMC_pmc_val(SELF) = PMCNULL;
+ PMC_struct_val(SELF) = PMCNULL;
}
void init_pmc(PMC *obj) {
Modified: trunk/src/pmc/timer.pmc
==============================================================================
--- trunk/src/pmc/timer.pmc (original)
+++ trunk/src/pmc/timer.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2003, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -84,7 +84,8 @@
static void
add_timer(Interp* interp, PMC *pmc)
{
- parrot_timer_event *t = PMC_struct_val(pmc);
+ parrot_timer_event *t = (parrot_timer_event *)PMC_struct_val(pmc);
+
if (!PMC_IS_NULL(t->sub))
Parrot_new_timer_event(interp, pmc, t->abs_time,
t->interval, t->repeat, t->sub, EVENT_TYPE_TIMER);
@@ -125,9 +126,8 @@
* t->abs_time actually is relative, its converted to an
* absolute time, when the timer is started
*/
- parrot_timer_event *t =
- mem_sys_allocate_zeroed(sizeof (parrot_timer_event));
- PMC_struct_val(SELF) = t;
+ parrot_timer_event *t = mem_allocate_zeroed_typed(parrot_timer_event);
+ PMC_struct_val(SELF) = t;
PObj_active_destroy_SET(SELF);
++INTERP->arena_base->num_early_DOD_PMCs;
}
@@ -186,7 +186,7 @@
*/
void destroy() {
- parrot_timer_event *t = PMC_struct_val(SELF);
+ parrot_timer_event *t = (parrot_timer_event *)PMC_struct_val(SELF);
del_timer(INTERP, SELF);
mem_sys_free(t);
}
@@ -202,7 +202,7 @@
*/
INTVAL get_integer_keyed_int(INTVAL key) {
- parrot_timer_event *t = PMC_struct_val(SELF);
+ parrot_timer_event *t = (parrot_timer_event *)PMC_struct_val(SELF);
switch (key) {
case PARROT_TIMER_SEC:
@@ -228,11 +228,13 @@
*/
PMC* get_pmc_keyed_int(INTVAL key) {
- parrot_timer_event *t = PMC_struct_val(SELF);
+ parrot_timer_event *t = (parrot_timer_event *)PMC_struct_val(SELF);
+
switch (key) {
case PARROT_TIMER_HANDLER:
return t->sub;
}
+
return PMCNULL;
}
@@ -247,12 +249,13 @@
*/
FLOATVAL get_number_keyed_int(INTVAL key) {
- parrot_timer_event *t = PMC_struct_val(SELF);
+ parrot_timer_event *t = (parrot_timer_event *)PMC_struct_val(SELF);
switch (key) {
case PARROT_TIMER_NSEC:
return t->abs_time;
}
+
return -1.0;
}
@@ -267,7 +270,7 @@
*/
void set_integer_keyed_int(INTVAL key, INTVAL value) {
- parrot_timer_event *t = PMC_struct_val(SELF);
+ parrot_timer_event *t = (parrot_timer_event *)PMC_struct_val(SELF);
switch (key) {
case PARROT_TIMER_SEC:
@@ -301,7 +304,8 @@
*/
void set_pmc_keyed_int(INTVAL key, PMC* value) {
- parrot_timer_event *t = PMC_struct_val(SELF);
+ parrot_timer_event *t = (parrot_timer_event *)PMC_struct_val(SELF);
+
switch (key) {
case PARROT_TIMER_HANDLER:
t->sub = value;
@@ -321,7 +325,7 @@
opcode_t* invoke(void *next) {
add_timer(INTERP, SELF);
- return next;
+ return (opcode_t *)next;
}
/*
@@ -335,7 +339,7 @@
*/
void set_number_keyed_int(INTVAL key, FLOATVAL value) {
- parrot_timer_event *t = PMC_struct_val(SELF);
+ parrot_timer_event *t = (parrot_timer_event *)PMC_struct_val(SELF);
switch (key) {
case PARROT_TIMER_NSEC:
Modified: trunk/src/pmc/vtablecache.pmc
==============================================================================
--- trunk/src/pmc/vtablecache.pmc (original)
+++ trunk/src/pmc/vtablecache.pmc Tue May 1 19:58:21 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2004, The Perl Foundation.
+Copyright (C) 2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -26,7 +26,7 @@
void destroy() {
if (NULL != PMC_struct_val(SELF)) {
- Parrot_destroy_vtable(INTERP, PMC_struct_val(SELF));
+ Parrot_destroy_vtable(INTERP, (VTABLE *)PMC_struct_val(SELF));
}
}
