cvsuser 04/06/24 01:02:20
Modified: classes closure.pmc sub.pmc
include/parrot interpreter.h warnings.h
src inter_create.c pmc.c sub.c
Log:
misc cleanup
* get rid of bogus COWed warning and error Buffers
* faster pmc_type
Revision Changes Path
1.17 +1 -2 parrot/classes/closure.pmc
Index: closure.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/closure.pmc,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- closure.pmc 24 Mar 2004 17:01:10 -0000 1.16
+++ closure.pmc 24 Jun 2004 08:02:10 -0000 1.17
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: closure.pmc,v 1.16 2004/03/24 17:01:10 leo Exp $
+$Id: closure.pmc,v 1.17 2004/06/24 08:02:10 leo Exp $
=head1 NAME
@@ -55,7 +55,6 @@
void mark () {
struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_sub(SELF);
mark_stack(INTERP, sub->ctx.pad_stack);
- SUPER(); /* mark warns ... in class Sub */
}
1.45 +5 -21 parrot/classes/sub.pmc
Index: sub.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sub.pmc,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -w -r1.44 -r1.45
--- sub.pmc 22 Jun 2004 14:31:37 -0000 1.44
+++ sub.pmc 24 Jun 2004 08:02:10 -0000 1.45
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sub.pmc,v 1.44 2004/06/22 14:31:37 leo Exp $
+$Id: sub.pmc,v 1.45 2004/06/24 08:02:10 leo Exp $
=head1 NAME
@@ -87,7 +87,7 @@
void init () {
PMC_sub(SELF) = new_sub(INTERP, sizeof(struct Parrot_Sub));
PMC_struct_val(SELF) = NULL;
- PObj_custom_mark_destroy_SETALL(SELF);
+ PObj_active_destroy_SET(SELF);
PObj_get_FLAGS(SELF) &= ~PObj_private1_FLAG;
#if 0
if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG))
@@ -111,21 +111,6 @@
mem_sys_free(sub);
}
-/*
-
-=item C<void mark()>
-
-Marks the subroutine as live.
-
-=cut
-
-*/
-
- void mark () {
- struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_sub(SELF);
- pobject_lives(INTERP, sub->ctx.warns);
- pobject_lives(INTERP, sub->ctx.errors);
- }
/*
@@ -199,8 +184,8 @@
void* invoke (void* next) {
struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_sub(SELF);
- interpreter->ctx.warns = sub->ctx.warns;
- if (++interpreter->ctx.recursion_depth > interpreter->recursion_limit) {
+ if (++interpreter->ctx.recursion_depth >
+ interpreter->recursion_limit) {
real_exception(interpreter, next, 100,
"maximum recursion depth exceeded");
}
@@ -226,10 +211,9 @@
PMC* clone () {
struct Parrot_Sub * sub;
PMC* ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
- PObj_custom_mark_destroy_SETALL(ret);
+ PObj_active_destroy_SET(ret);
sub = PMC_sub(ret) = mem_sys_allocate(sizeof(struct Parrot_Sub));
memcpy(sub, PMC_sub(SELF), sizeof(struct Parrot_Sub));
- buffer_mark_COW(sub->ctx.warns);
PMC_struct_val(ret) = PMC_struct_val(SELF);
return ret;
}
1.140 +3 -3 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.139
retrieving revision 1.140
diff -u -w -r1.139 -r1.140
--- interpreter.h 22 Jun 2004 14:31:41 -0000 1.139
+++ interpreter.h 24 Jun 2004 08:02:17 -0000 1.140
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.139 2004/06/22 14:31:41 leo Exp $
+ * $Id: interpreter.h,v 1.140 2004/06/24 08:02:17 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -138,9 +138,9 @@
struct Stack_Chunk *user_stack; /* Base of the scratch stack */
struct Stack_Chunk *control_stack; /* Base of the flow control stack */
IntStack intstack; /* Base of the regex stack */
- Buffer * warns; /* Keeps track of what warnings
+ UINTVAL warns; /* Keeps track of what warnings
* have been activated */
- Buffer * errors; /* fatals that can be turned off */
+ UINTVAL errors; /* fatals that can be turned off */
UINTVAL current_class_offset; /* Offset into the class array of the
currently found method */
UINTVAL recursion_depth; /* Sub call resursion depth */
1.18 +4 -8 parrot/include/parrot/warnings.h
Index: warnings.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/warnings.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- warnings.h 22 Apr 2004 08:55:06 -0000 1.17
+++ warnings.h 24 Jun 2004 08:02:17 -0000 1.18
@@ -26,15 +26,11 @@
/* &end_gen */
#define PARROT_we_on(we, interp, flag) do { \
- (interp)->ctx.we = buffer_unmake_COW(interp, (interp)->ctx.we); \
- ( (*(UINTVAL *) PObj_bufstart((interp)->ctx.we)) |= (flag)); \
- } while (0)
+ (interp)->ctx.we |= (flag); } while (0)
#define PARROT_we_off(we, interp, flag) do { \
- (interp)->ctx.we = buffer_unmake_COW(interp, (interp)->ctx.we); \
- ( (*(UINTVAL *) PObj_bufstart((interp)->ctx.we)) &= ~(flag)); \
- } while (0)
+ (interp)->ctx.we &= ~(flag); } while (0)
#define PARROT_we_test(we, interp, flag) \
- ( (*(UINTVAL *) PObj_bufstart((interp)->ctx.we)) & (flag))
+ (interp)->ctx.we & (flag)
#define PARROT_WARNINGS_on(interp, flag) PARROT_we_on(warns, interp, flag)
#define PARROT_WARNINGS_off(interp, flag) PARROT_we_off(warns, interp, flag)
1.5 +1 -7 parrot/src/inter_create.c
Index: inter_create.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_create.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- inter_create.c 23 Jun 2004 07:14:38 -0000 1.4
+++ inter_create.c 24 Jun 2004 08:02:20 -0000 1.5
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_create.c,v 1.4 2004/06/23 07:14:38 leo Exp $
+$Id: inter_create.c,v 1.5 2004/06/24 08:02:20 leo Exp $
=head1 NAME
@@ -165,15 +165,9 @@
/* context data */
/* Initialize interpreter's flags */
- interpreter->ctx.warns = new_buffer_header(interpreter);
- Parrot_allocate(interpreter, interpreter->ctx.warns,
- sizeof(struct warnings_t));
PARROT_WARNINGS_off(interpreter, PARROT_WARNINGS_ALL_FLAG);
/* same with errors */
- interpreter->ctx.errors = new_buffer_header(interpreter);
- Parrot_allocate(interpreter, interpreter->ctx.errors,
- sizeof(struct warnings_t));
PARROT_ERRORS_off(interpreter, PARROT_ERRORS_ALL_FLAG);
/* undefined globals are errors by default */
PARROT_ERRORS_on(interpreter, PARROT_ERRORS_GLOBALS_FLAG);
1.83 +7 -18 parrot/src/pmc.c
Index: pmc.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc.c,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -w -r1.82 -r1.83
--- pmc.c 23 Jun 2004 07:14:38 -0000 1.82
+++ pmc.c 24 Jun 2004 08:02:20 -0000 1.83
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc.c,v 1.82 2004/06/23 07:14:38 leo Exp $
+$Id: pmc.c,v 1.83 2004/06/24 08:02:20 leo Exp $
=head1 NAME
@@ -449,24 +449,13 @@
INTVAL
pmc_type(Parrot_Interp interp, STRING *name)
{
- INTVAL return_val;
- int w = PARROT_WARNINGS_test(interp, PARROT_WARNINGS_UNDEF_FLAG);
- PMC *classname_hash;
- /*
- * turn undef warns on - the compiler uses this function to
- * probe for PMC types
- */
- PARROT_WARNINGS_off(interp, PARROT_WARNINGS_UNDEF_FLAG);
- classname_hash = interp->class_hash;
-
- return_val = VTABLE_get_integer_keyed_str(interp, classname_hash, name);
- if (w)
- PARROT_WARNINGS_on(interp, PARROT_WARNINGS_UNDEF_FLAG);
+ HashBucket *bucket;
+ PMC *classname_hash = interp->class_hash;
- if (return_val == enum_type_undef) {
- return_val = Parrot_get_datatype_enum(interp, name);
- }
- return return_val;
+ bucket = hash_get_bucket(interp, PMC_struct_val(classname_hash), name);
+ if (bucket)
+ return PMC_int_val((PMC*) bucket->value);
+ return Parrot_get_datatype_enum(interp, name);
}
1.63 +2 -10 parrot/src/sub.c
Index: sub.c
===================================================================
RCS file: /cvs/public/parrot/src/sub.c,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -w -r1.62 -r1.63
--- sub.c 20 Jun 2004 08:10:24 -0000 1.62
+++ sub.c 24 Jun 2004 08:02:20 -0000 1.63
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sub.c,v 1.62 2004/06/20 08:10:24 leo Exp $
+$Id: sub.c,v 1.63 2004/06/24 08:02:20 leo Exp $
=head1 NAME
@@ -58,8 +58,6 @@
struct Parrot_Context *dest, struct Parrot_Context *src)
{
memcpy(dest, src, sizeof(*src));
- buffer_mark_COW(dest->warns); /* XXX */
- buffer_mark_COW(dest->errors);
}
/*
@@ -100,8 +98,6 @@
mark_register_stack(interpreter, ctx->num_reg_stack);
mark_string_register_stack(interpreter, ctx->string_reg_stack);
mark_pmc_register_stack(interpreter, ctx->pmc_reg_stack);
- pobject_lives(interpreter, ctx->warns);
- pobject_lives(interpreter, ctx->errors);
}
/*
@@ -203,7 +199,7 @@
swap_context(Interp *interp, struct PMC *sub)
{
struct Stack_Chunk * tmp_stack = NULL;
- Buffer * warns;
+ UINTVAL warns;
struct Parrot_Coroutine* co = (struct Parrot_Coroutine *)PMC_sub(sub);
struct Parrot_Context *ctx = &co->ctx;
Stack_Chunk_t *reg_top;
@@ -280,10 +276,6 @@
/* Using system memory until I figure out GC issues */
struct Parrot_Sub *newsub =
mem_sys_allocate_zeroed(size);
- newsub->ctx.warns = interp->ctx.warns;
- newsub->ctx.errors = interp->ctx.errors;
- buffer_mark_COW(interp->ctx.warns);
- buffer_mark_COW(interp->ctx.errors);
newsub->seg = interp->code->cur_cs;
return newsub;
}
