cvsuser 03/06/06 03:06:06
Modified: . core.ops headers.c interpreter.c test_main.c
include/parrot interpreter.h
languages/imcc main.c
Log:
destroy-flag: --leak-test or --destroy-at-end frees all interp mem
Revision Changes Path
1.275 +1 -0 parrot/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.274
retrieving revision 1.275
diff -u -w -r1.274 -r1.275
--- core.ops 30 May 2003 01:06:23 -0000 1.274
+++ core.ops 6 Jun 2003 10:05:45 -0000 1.275
@@ -4338,6 +4338,7 @@
struct Parrot_Interp *new_interp;
struct PMC *new_pmc;
new_interp = make_interpreter((Interp_flags)$2);
+ new_interp->parent_interpreter = interpreter;
new_pmc = new_pmc_header(interpreter);
new_pmc->data = new_interp;
new_pmc->vtable = YOU_LOSE_VTABLE;
1.35 +7 -9 parrot/headers.c
Index: headers.c
===================================================================
RCS file: /cvs/public/parrot/headers.c,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -w -r1.34 -r1.35
--- headers.c 6 Jun 2003 08:29:18 -0000 1.34
+++ headers.c 6 Jun 2003 10:05:45 -0000 1.35
@@ -1,7 +1,7 @@
/* headers.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: headers.c,v 1.34 2003/06/06 08:29:18 leo Exp $
+ * $Id: headers.c,v 1.35 2003/06/06 10:05:45 leo Exp $
* Overview:
* Header management functions. Handles getting of various headers,
* and pool creation
@@ -362,12 +362,6 @@
struct Small_Object_Arena *cur_arena, *next;
int i, j, start;
- /* TODO: -lt make a command line option for cleaning up:
- * - the last interpreter may just die
- * - created interpreters should always get destroyed
- * - move the check to interpreter.c
- */
- return;
/* const/non const COW strings life in different pools
* so in first pass
* COW refcount is done, in 2. refcounting
@@ -407,7 +401,9 @@
if (i == 2 && pool) {
for (cur_arena = pool->last_Arena; cur_arena;) {
next = cur_arena->prev;
-#if ! ARENA_DOD_FLAGS
+#if ARENA_DOD_FLAGS
+ mem_sys_free(cur_arena->dod_flags);
+#else
mem_sys_free(cur_arena->start_objects);
#endif
mem_sys_free(cur_arena);
@@ -421,7 +417,9 @@
pool = interpreter->arena_base->pmc_ext_pool;
for (cur_arena = pool->last_Arena; cur_arena;) {
next = cur_arena->prev;
-#if ! ARENA_DOD_FLAGS
+#if ARENA_DOD_FLAGS
+ mem_sys_free(cur_arena->dod_flags);
+#else
mem_sys_free(cur_arena->start_objects);
#endif
mem_sys_free(cur_arena);
1.155 +10 -1 parrot/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.154
retrieving revision 1.155
diff -u -w -r1.154 -r1.155
--- interpreter.c 6 Jun 2003 08:29:18 -0000 1.154
+++ interpreter.c 6 Jun 2003 10:05:45 -0000 1.155
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: interpreter.c,v 1.154 2003/06/06 08:29:18 leo Exp $
+ * $Id: interpreter.c,v 1.155 2003/06/06 10:05:45 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -480,6 +480,9 @@
SET_NULL(interpreter->piodata);
PIO_init(interpreter);
+ /* must be set after if this is not the first interpreter */
+ SET_NULL(interpreter->parent_interpreter);
+
interpreter->DOD_block_level = 1;
interpreter->GC_block_level = 1;
@@ -620,6 +623,12 @@
struct Stash *stash, *next_stash;
UNUSED(exit_code);
+ /* we destroy all child interpreters and the last one too,
+ * if the --leak-test commandline was given
+ */
+ if (! (interpreter->parent_interpreter ||
+ Interp_flags_TEST(interpreter, PARROT_DESTROY_FLAG)))
+ return;
/* buffer headers, PMCs */
Parrot_destroy_header_pools(interpreter);
1.68 +10 -3 parrot/test_main.c
Index: test_main.c
===================================================================
RCS file: /cvs/public/parrot/test_main.c,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -w -r1.67 -r1.68
--- test_main.c 4 Jun 2003 11:49:46 -0000 1.67
+++ test_main.c 6 Jun 2003 10:05:45 -0000 1.68
@@ -1,7 +1,7 @@
/* test_main.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: test_main.c,v 1.67 2003/06/04 11:49:46 leo Exp $
+ * $Id: test_main.c,v 1.68 2003/06/06 10:05:45 leo Exp $
* Overview:
* A sample test program (and the main function of Parrot)
* Data Structure and Algorithms:
@@ -20,6 +20,9 @@
char *parseflags(Parrot_Interp interpreter, int *argc, char **argv[]);
+#define OPT_GC_DEBUG 128
+#define OPT_DESTROY_FLAG 129
+
static struct longopt_opt_decl options[] = {
{ 'b', 'b', 0, { "--bounds-checks" } },
{ 'd', 'd', 0, { "--debug" } },
@@ -32,7 +35,8 @@
{ 't', 't', 0, { "--trace" } },
{ 'v', 'v', 0, { "--version" } },
{ '.', '.', 0, { "--wait" } },
- {'\0', 128, 0, { "--gc-debug" } },
+ {'\0', OPT_GC_DEBUG, 0, { "--gc-debug" } },
+ {'\0', OPT_DESTROY_FLAG, 0, { "--leak-test", "--destroy-at-end" } },
{'\0', 0, 0, { NULL } }
};
@@ -135,13 +139,16 @@
* attach a debuggger. */
fgetc(stdin);
break;
- case 128:
+ case OPT_GC_DEBUG:
#if DISABLE_GC_DEBUG
Parrot_warn(interpreter, PARROT_WARNINGS_ALL_FLAG,
"PARROT_GC_DEBUG is set but the binary was "
"compiled with DISABLE_GC_DEBUG.");
#endif
setopt(PARROT_GC_DEBUG_FLAG);
+ break;
+ case OPT_DESTROY_FLAG:
+ setopt(PARROT_DESTROY_FLAG);
break;
}
}
1.68 +4 -2 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -w -r1.67 -r1.68
--- interpreter.h 21 May 2003 14:11:37 -0000 1.67
+++ interpreter.h 6 Jun 2003 10:05:52 -0000 1.68
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: interpreter.h,v 1.67 2003/05/21 14:11:37 dan Exp $
+ * $Id: interpreter.h,v 1.68 2003/06/06 10:05:52 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -27,7 +27,8 @@
PARROT_CGOTO_FLAG = 0x40, /* We're using the computed goto runops */
PARROT_GC_DEBUG_FLAG = 0x80, /* We're debugging memory management */
PARROT_EXTERN_CODE_FLAG = 0x100, /* reusing anothers interps code */
- PARROT_SWITCH_FLAG = 0x200 /* We're using the switched runops */
+ PARROT_SWITCH_FLAG = 0x200, /* We're using the switched runops */
+ PARROT_DESTROY_FLAG = 0x400 /* the last interpreter shall cleanup */
} Parrot_Interp_flag;
struct Parrot_Interp;
@@ -167,6 +168,7 @@
PDB_t *pdb; /* Debug system */
void *lo_var_ptr; /* Pointer to memory on runops system stack */
+ struct Parrot_Interp * parent_interpreter;
/* per interpreter global vars */
INTVAL world_inited; /* Parrot_init is done */
1.27 +6 -1 parrot/languages/imcc/main.c
Index: main.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/main.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- main.c 4 Jun 2003 11:49:44 -0000 1.26
+++ main.c 6 Jun 2003 10:06:06 -0000 1.27
@@ -74,6 +74,7 @@
#define unsetopt(flag) Parrot_setflag(interp, flag, 0)
#define OPT_GC_DEBUG 128
+#define OPT_DESTROY_FLAG 129
static struct longopt_opt_decl options[] = {
{ 'b', 'b', 0, { "--bounds-checks" } },
{ 'j', 'j', 0, { "--jit" } },
@@ -96,6 +97,7 @@
{ 'o', 'o', OPTION_required_FLAG, { "--output" } },
{ 'O', 'O', OPTION_required_FLAG, { "--optimize" } },
{ '\0', OPT_GC_DEBUG, 0, { "--gc-debug" } },
+ {'\0', OPT_DESTROY_FLAG, 0, { "--leak_test", "--destroy-at-end" } },
{ 0, 0, 0, { NULL } }
};
@@ -207,6 +209,9 @@
#endif
setopt(PARROT_GC_DEBUG_FLAG);
break;
+ case OPT_DESTROY_FLAG:
+ setopt(PARROT_DESTROY_FLAG);
+ break;
default:
fatal(1, "main", "Invalid flag '%s' used."
