# New Ticket Created by Jürgen Bömmels
# Please include the string: [perl #23124]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=23124 >
Hello,
Next patch in the series of PIO refactoring. This time make the
Standard handles PIO_STDIN et al. in the interpreter structure PMCs.
The patch is quite straight forward:
Change the type of the ParrotIOTable and lose some new_io_pmcs.
The main problems were initialization and finalization.
In the initialization code the memory system needs to be up and
running when the PIO-system gets initialised. So I moved PIO_init() is
moved a little down in make_interpreter().
Finalization is a bit more tricky. The standard filehandles must not
be destroyed in the final sweep. Until a proper solution of
DOD-ordering is found (see
http://groups.google.de/groups?selm=71BEC0D4E1DED3118F7A009027B12028034C8D6E%40EXCH_MISSION)
I used a trick of marking only a part of the rootset, the
piodata.
The changes in dod.c are to allow marking of parts of the
rootset. pobject_lives will trace its children in the case that it is
not called from trace_active_PMCs.
bye
boe
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/61785/45530/32a6ea/io15.diff
? log.9392.gz
? test.imc
? mprout.pl
? docs/core_ops.pod
? docs/io_ops.pod
? io/Makefile
? t/src/staticstring.t
? t/src/valgrind.t
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/dod.c,v
retrieving revision 1.65
diff -u -r1.65 dod.c
--- dod.c 23 Jul 2003 18:09:43 -0000 1.65
+++ dod.c 25 Jul 2003 12:50:57 -0000
@@ -31,6 +31,7 @@
#endif
static size_t find_common_mask(size_t val1, size_t val2);
+static void trace_children(struct Parrot_Interp *interpreter, PMC *current);
#if ARENA_DOD_FLAGS
@@ -38,6 +39,7 @@
{
struct Small_Object_Arena *arena = GET_ARENA(obj);
+ PMC *children = NULL;
size_t n = GET_OBJ_N(arena, obj);
size_t ns = n >> ARENA_FLAG_SHIFT;
UINTVAL nm = (n & ARENA_FLAG_MASK) << 2;
@@ -50,14 +52,22 @@
if (*dod_flags & (PObj_is_special_PMC_FLAG << nm)) {
if (((PMC*)obj)->pmc_ext) {
/* put it on the end of the list */
- interpreter->mark_ptr->next_for_GC = (PMC *)obj;
+ if (interpreter->mark_ptr)
+ interpreter->mark_ptr->next_for_GC = (PMC *)obj;
+ else
+ children = (PMC *)obj;
/* Explicitly make the tail of the linked list be
* self-referential */
interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
}
else if (PObj_custom_mark_TEST(obj))
VTABLE_mark(interpreter, (PMC *) obj);
- return;
+ }
+
+ /* children is only set if there isn't already a children trace active */
+ if (children) {
+ trace_children(interpreter, children);
+ interpreter->mark_ptr = NULL;
}
}
@@ -68,6 +78,8 @@
* individual pieces if they have private ones */
void pobject_lives(struct Parrot_Interp *interpreter, PObj *obj)
{
+ PMC *children = NULL;
+
/* if object is live or on free list return */
if (PObj_is_live_or_free_TESTALL(obj)) {
return;
@@ -90,7 +102,10 @@
if (PObj_is_special_PMC_TEST(obj)) {
if (((PMC*)obj)->pmc_ext) {
/* put it on the end of the list */
- interpreter->mark_ptr->next_for_GC = (PMC *)obj;
+ if (interpreter->mark_ptr)
+ interpreter->mark_ptr->next_for_GC = (PMC *)obj;
+ else
+ children = (PMC *)obj;
/* Explicitly make the tail of the linked list be
* self-referential */
interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
@@ -109,6 +124,12 @@
obj, ((Buffer*)obj)->bufstart);
}
#endif
+
+ /* children is only set if there isn't already a children trace active */
+ if (children) {
+ trace_children(interpreter, children);
+ interpreter->mark_ptr = NULL;
+ }
}
#endif
@@ -118,7 +139,7 @@
static void
trace_active_PMCs(struct Parrot_Interp *interpreter)
{
- PMC *current, *prev = NULL;
+ PMC *current;
/* Pointers to the currently being processed PMC, and
* in the previously processed PMC in a loop.
*
@@ -129,14 +150,12 @@
unsigned int i = 0, j = 0;
struct PRegChunk *cur_chunk = 0;
struct Stash *stash = 0;
- UINTVAL mask = PObj_is_PMC_ptr_FLAG | PObj_is_buffer_ptr_FLAG
- | PObj_custom_mark_FLAG;
/* We have to start somewhere, the interpreter globals is a good place */
interpreter->mark_ptr = current = interpreter->iglobals;
/* mark it as used */
- pobject_lives(interpreter, (PObj *)current);
+ pobject_lives(interpreter, (PObj *)interpreter->iglobals);
pobject_lives(interpreter, interpreter->ctx.warns);
/* Now, go run through the PMC registers and mark them as live */
/* First mark the current set. */
@@ -182,13 +201,27 @@
mark_stack(interpreter, stacks[j]);
}
+
+ /* Walk the iodata */
+ Parrot_IOData_mark(interpreter, interpreter->piodata);
+
/* Find important stuff on the system stack */
#if TRACE_SYSTEM_AREAS
trace_system_areas(interpreter);
#endif
-
/* Okay, we've marked the whole root set, and should have a good-sized
* list 'o things to look at. Run through it */
+ trace_children(interpreter, current);
+}
+
+static void
+trace_children(struct Parrot_Interp *interpreter, PMC *current)
+{
+ PMC *prev = NULL;
+ unsigned i = 0;
+ UINTVAL mask = PObj_is_PMC_ptr_FLAG | PObj_is_buffer_ptr_FLAG
+ | PObj_custom_mark_FLAG;
+
for (; current != prev; current = current->next_for_GC) {
UINTVAL bits = PObj_get_FLAGS(current) & mask;
Index: embed.c
===================================================================
RCS file: /cvs/public/parrot/embed.c,v
retrieving revision 1.75
diff -u -r1.75 embed.c
--- embed.c 21 Jul 2003 18:00:24 -0000 1.75
+++ embed.c 25 Jul 2003 12:50:57 -0000
@@ -84,7 +84,7 @@
if (filename == NULL || strcmp(filename, "-") == 0) {
/* read from STDIN */
- io = new_io_pmc(interpreter, PIO_STDIN(interpreter));
+ io = PIO_STDIN(interpreter);
/* read 1k at a time */
program_size = 0;
}
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.179
diff -u -r1.179 interpreter.c
--- interpreter.c 24 Jul 2003 20:20:29 -0000 1.179
+++ interpreter.c 25 Jul 2003 12:50:57 -0000
@@ -680,11 +680,6 @@
* mem_setup_allocator() is called. */
interpreter->flags = flags;
- /* PANIC will fail until this is done */
- SET_NULL(interpreter->piodata);
- PIO_init(interpreter);
-
-
if (is_env_var_set("PARROT_GC_DEBUG")) {
#if ! DISABLE_GC_DEBUG
Interp_flags_SET(interpreter, PARROT_GC_DEBUG_FLAG);
@@ -701,6 +696,10 @@
/* initialize classes */
Parrot_init(interpreter, 0);
+ /* PANIC will fail until this is done */
+ SET_NULL(interpreter->piodata);
+ PIO_init(interpreter);
+
/* Need an empty stash */
interpreter->perl_stash = mem_sys_allocate(sizeof(struct Stash));
interpreter->perl_stash->stash_hash =
@@ -822,6 +821,11 @@
* no DOD run, so everything is considered dead
*/
+ /* XXX boe: This hack explicitly marks the piodata, these filehandles
+ * need to be open until PIO_finish is called
+ */
+ Parrot_IOData_mark(interpreter, interpreter->piodata);
+
if (interpreter->has_early_DOD_PMCs)
free_unused_pobjects(interpreter, interpreter->arena_base->pmc_pool);
@@ -829,6 +833,9 @@
* if the --leak-test commandline was given
*/
+ /* Now the PIOData gets also cleared */
+ PIO_finish(interpreter);
+
if (! (interpreter->parent_interpreter ||
Interp_flags_TEST(interpreter, PARROT_DESTROY_FLAG)))
return;
@@ -884,8 +891,6 @@
stack_destroy(interpreter->ctx.control_stack);
/* intstack */
intstack_free(interpreter, interpreter->ctx.intstack);
-
- PIO_finish(interpreter);
mem_sys_free(interpreter);
}
Index: io.ops
===================================================================
RCS file: /cvs/public/parrot/io.ops,v
retrieving revision 1.29
diff -u -r1.29 io.ops
--- io.ops 21 Jul 2003 18:00:24 -0000 1.29
+++ io.ops 25 Jul 2003 12:50:57 -0000
@@ -104,17 +104,17 @@
=cut
inline op getstdin(out PMC) {
- $1 = new_io_pmc(interpreter, PIO_STDIN(interpreter));
+ $1 = PIO_STDIN(interpreter);
goto NEXT();
}
inline op getstdout(out PMC) {
- $1 = new_io_pmc(interpreter, PIO_STDOUT(interpreter));
+ $1 = PIO_STDOUT(interpreter);
goto NEXT();
}
inline op getstderr(out PMC) {
- $1 = new_io_pmc(interpreter, PIO_STDERR(interpreter));
+ $1 = PIO_STDERR(interpreter);
goto NEXT();
}
@@ -189,8 +189,7 @@
op print(in STR) {
STRING *s = $1;
if (s && string_length(s)) {
- PIO_putps(interpreter, new_io_pmc(interpreter, PIO_STDOUT(interpreter)),
- s);
+ PIO_putps(interpreter, PIO_STDOUT(interpreter), s);
}
goto NEXT();
}
@@ -199,8 +198,7 @@
PMC *p = $1;
STRING *s = (VTABLE_get_string(interpreter, p));
if (s) {
- PIO_putps(interpreter, new_io_pmc(interpreter, PIO_STDOUT(interpreter)),
- s);
+ PIO_putps(interpreter, PIO_STDOUT(interpreter), s);
}
goto NEXT();
}
@@ -232,8 +230,7 @@
op printerr(in STR) {
STRING *s = $1;
if (s && string_length(s)) {
- PIO_putps(interpreter, new_io_pmc(interpreter, PIO_STDERR(interpreter)),
- s);
+ PIO_putps(interpreter, PIO_STDERR(interpreter), s);
}
goto NEXT();
}
@@ -242,8 +239,7 @@
PMC *p = $1;
STRING *s = (VTABLE_get_string(interpreter, p));
if (s) {
- PIO_putps(interpreter, new_io_pmc(interpreter, PIO_STDOUT(interpreter)),
- s);
+ PIO_putps(interpreter, PIO_STDOUT(interpreter), s);
}
goto NEXT();
}
@@ -332,7 +328,7 @@
n = $2;
$1 = string_make(interpreter, NULL, n, NULL, 0, NULL);
memset(($1)->strstart, 0, n);
- nr = PIO_read(interpreter, new_io_pmc(interpreter, PIO_STDIN(interpreter)),
+ nr = PIO_read(interpreter, PIO_STDIN(interpreter),
($1)->strstart, (size_t)n);
if(nr > 0)
($1)->strlen = ($1)->bufused = nr;
Index: trace.c
===================================================================
RCS file: /cvs/public/parrot/trace.c,v
retrieving revision 1.37
diff -u -r1.37 trace.c
--- trace.c 21 Jul 2003 18:00:24 -0000 1.37
+++ trace.c 25 Jul 2003 12:50:57 -0000
@@ -247,7 +247,7 @@
}
/* Flush *stderr* now that we've output the trace info */
- PIO_flush(interpreter, new_io_pmc(interpreter, PIO_STDERR(interpreter)));
+ PIO_flush(interpreter, PIO_STDERR(interpreter));
}
Index: include/parrot/io.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/io.h,v
retrieving revision 1.35
diff -u -r1.35 io.h
--- include/parrot/io.h 21 Jul 2003 18:00:42 -0000 1.35
+++ include/parrot/io.h 25 Jul 2003 12:51:09 -0000
@@ -140,7 +140,7 @@
typedef struct _ParrotIOBuf ParrotIOBuf;
typedef struct _ParrotIO ParrotIO;
typedef struct _ParrotIOData ParrotIOData;
-typedef struct _ParrotIO **ParrotIOTable;
+typedef PMC **ParrotIOTable;
struct _ParrotIO {
PIOHANDLE fd; /* Low level OS descriptor */
@@ -335,6 +335,8 @@
extern INTVAL PIO_eprintf(theINTERP, const char *s, ...);
extern INTVAL PIO_getfd(theINTERP, PMC *io);
extern PIOOFF_T PIO_tell(theINTERP, PMC *io);
+
+extern void Parrot_IOData_mark(theINTERP, ParrotIOData *piodata);
/* Put platform specific macros here if you must */
#ifdef PIO_OS_WIN32
Index: include/parrot/pobj.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pobj.h,v
retrieving revision 1.24
diff -u -r1.24 pobj.h
--- include/parrot/pobj.h 24 Jul 2003 01:16:37 -0000 1.24
+++ include/parrot/pobj.h 25 Jul 2003 12:51:09 -0000
@@ -31,15 +31,15 @@
typedef union UnionVal {
+ struct { /* Buffers structure */
+ void * bufstart;
+ size_t buflen;
+ } b;
INTVAL int_val; /* PMC unionval members */
FLOATVAL num_val;
DPOINTER* struct_val;
struct parrot_string_t * string_val;
PMC* pmc_val;
- struct { /* Buffers structure */
- void * bufstart;
- size_t buflen;
- } b;
} UnionVal;
/* Parrot Object - base class for all others */
Index: io/io.c
===================================================================
RCS file: /cvs/public/parrot/io/io.c,v
retrieving revision 1.48
diff -u -r1.48 io.c
--- io/io.c 21 Jul 2003 18:00:45 -0000 1.48
+++ io/io.c 25 Jul 2003 12:51:09 -0000
@@ -203,6 +203,11 @@
{
ParrotIOLayer *p;
+#if 0
+ /* The ParrotIO-Class must be initialized at this point */
+ Parrot_ParrotIO_class_init(interpreter, enum_class_ParrotIO);
+#endif
+
/* First push the platform specific OS layer */
/* Optimize this to keep a default stack and just
* call copy stack.
@@ -733,8 +738,7 @@
if(interpreter) {
str=Parrot_vsprintf_c(interpreter, s, args);
- ret=PIO_putps(interpreter,
- new_io_pmc(interpreter, PIO_STDOUT(interpreter)), str);
+ ret=PIO_putps(interpreter, PIO_STDOUT(interpreter), str);
}
else {
/* Be nice about this...
@@ -759,8 +763,7 @@
if(interpreter) {
str=Parrot_vsprintf_c(interpreter, s, args);
- ret=PIO_putps(interpreter,
- new_io_pmc(interpreter, PIO_STDERR(interpreter)), str);
+ ret=PIO_putps(interpreter, PIO_STDERR(interpreter), str);
}
else {
/* Be nice about this...
@@ -778,20 +781,32 @@
PIO_getfd(theINTERP, PMC *pmc)
{
INTVAL i;
- ParrotIO *io = PMC_data(pmc);
ParrotIOTable table = ((ParrotIOData*)interpreter->piodata)->table;
for(i = 0; i < PIO_NR_OPEN; i++) {
- if (table[i] == io) return i;
+ if (table[i] == pmc) return i;
if (table[i] == NULL) {
- table[i] = io;
+ table[i] = pmc;
return i;
}
}
/* XXX boe: increase size of the fdtable */
return -1;
+}
+
+void
+Parrot_IOData_mark(theINTERP, ParrotIOData *piodata)
+{
+ INTVAL i;
+ ParrotIOTable table = piodata->table;
+
+ for (i = 0; i < PIO_NR_OPEN; i++) {
+ if (table[i]) {
+ pobject_lives(interpreter, (PObj *)table[i]);
+ }
+ }
}
/*
Index: io/io_buf.c
===================================================================
RCS file: /cvs/public/parrot/io/io_buf.c,v
retrieving revision 1.6
diff -u -r1.6 io_buf.c
--- io/io_buf.c 21 Jul 2003 18:00:45 -0000 1.6
+++ io/io_buf.c 25 Jul 2003 12:51:09 -0000
@@ -72,9 +72,10 @@
PIO_buf_init(theINTERP, ParrotIOLayer *layer)
{
if (PIO_STDOUT(interpreter))
- PIO_buf_setlinebuf(interpreter, layer, PIO_STDOUT(interpreter));
+ PIO_buf_setlinebuf(interpreter, layer,
+ PMC_data(PIO_STDOUT(interpreter)));
if (PIO_STDIN(interpreter))
- PIO_buf_setbuf(interpreter, layer, PIO_STDIN(interpreter),
+ PIO_buf_setbuf(interpreter, layer, PMC_data(PIO_STDIN(interpreter)),
PIO_UNBOUND);
return 0;
}
Index: io/io_unix.c
===================================================================
RCS file: /cvs/public/parrot/io/io_unix.c,v
retrieving revision 1.26
diff -u -r1.26 io_unix.c
--- io/io_unix.c 21 Jul 2003 18:00:45 -0000 1.26
+++ io/io_unix.c 25 Jul 2003 12:51:09 -0000
@@ -88,17 +88,28 @@
{
ParrotIOData *d = GET_INTERP_IOD(interpreter);
if (d != NULL && d->table != NULL) {
- if ((PIO_STDIN(interpreter) =
- PIO_unix_fdopen(interpreter, layer, STDIN_FILENO,
- PIO_F_READ | PIO_F_SHARED))
- && (PIO_STDOUT(interpreter) =
- PIO_unix_fdopen(interpreter, layer, STDOUT_FILENO,
- PIO_F_WRITE | PIO_F_SHARED))
- && (PIO_STDERR(interpreter) =
- PIO_unix_fdopen(interpreter, layer, STDERR_FILENO,
- PIO_F_WRITE | PIO_F_SHARED))
- )
- return 0;
+ ParrotIO *io;
+
+ INTVAL has_early = interpreter->has_early_DOD_PMCs;
+
+ io = PIO_unix_fdopen(interpreter, layer, STDIN_FILENO, PIO_F_READ);
+ if (!io) return -1;
+ PIO_STDIN(interpreter) = new_io_pmc(interpreter, io);
+ PObj_needs_early_DOD_CLEAR(PIO_STDIN(interpreter));
+
+ io = PIO_unix_fdopen(interpreter, layer, STDOUT_FILENO, PIO_F_WRITE);
+ if (!io) return -1;
+ PIO_STDOUT(interpreter) = new_io_pmc(interpreter, io);
+ PObj_needs_early_DOD_CLEAR(PIO_STDOUT(interpreter));
+
+ io = PIO_unix_fdopen(interpreter, layer, STDERR_FILENO, PIO_F_WRITE);
+ if (!io) return -1;
+ PIO_STDERR(interpreter) = new_io_pmc(interpreter, io);
+ PObj_needs_early_DOD_CLEAR(PIO_STDERR(interpreter));
+
+ interpreter->has_early_DOD_PMCs = has_early;
+
+ return 0;
}
return -1;
}
Index: lib/Parrot/Test.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Test.pm,v
retrieving revision 1.41
diff -u -r1.41 Test.pm
--- lib/Parrot/Test.pm 2 Jul 2003 13:48:56 -0000 1.41
+++ lib/Parrot/Test.pm 25 Jul 2003 12:51:12 -0000
@@ -54,6 +54,10 @@
open STDOUT, ">$out" or die "Can't redirect stdout" if $out;
open STDERR, ">$err" or die "Can't redirect stderr" if $err;
+ if (defined $ENV{VALGRIND}) {
+ $command = "$ENV{VALGRIND} $command";
+ }
+
system $command;
my $exit_code = $? >> 8;
