cvsuser 03/07/30 07:59:57
Modified: . build_nativecall.pl call_list.txt dod.c embed.c
interpreter.c io.ops trace.c
classes parrotio.pmc
include/parrot io.h
io io.c io_buf.c io_unix.c
jit/i386 jit_emit.h
t/pmc io.t
Log:
io16 = 23034 + 23124 by Juergen Boemmels
Revision Changes Path
1.19 +12 -8 parrot/build_nativecall.pl
Index: build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_nativecall.pl,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- build_nativecall.pl 28 Jul 2003 02:52:31 -0000 1.18
+++ build_nativecall.pl 30 Jul 2003 14:59:46 -0000 1.19
@@ -36,6 +36,7 @@
t => "char *",
v => "void",
I => "struct Parrot_Interp *",
+ P => "PMC *"
);
my (%other_decl) = (p => "PMC *final_destination = pmc_new(interpreter,
enum_class_UnManagedStruct);");
@@ -86,7 +87,7 @@
/* nci.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: build_nativecall.pl,v 1.18 2003/07/28 02:52:31 scog Exp $
+ * $Id: build_nativecall.pl,v 1.19 2003/07/30 14:59:46 leo Exp $
* Overview:
* Native Call Interface routines. The code needed to build a
* parrot to C call frame is in here
@@ -220,6 +221,9 @@
/I/ && do {
return "interpreter";
};
+ /P/ && do {my $regnum = $reg_ref->{p}++;
+ return "PMC_REG($regnum)";
+ };
}
1.9 +8 -0 parrot/call_list.txt
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/call_list.txt,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- call_list.txt 18 Jan 2003 09:14:30 -0000 1.8
+++ call_list.txt 30 Jul 2003 14:59:46 -0000 1.9
@@ -13,6 +13,7 @@
# t - character string
# PMC reg stuff
# p - data pointer from PMC (on store into a new UnManagedStruct PMC)
+# P - pointer to a PMC-register
# special stuff
# I - Parrot_Interp param
#
@@ -39,3 +40,10 @@
i pppp
i ppi
p It
+# These are needed for parrotio.pmc
+i IP
+v IP
+i IPi
+i IPii
+i IPiii
+i IPt
1.67 +42 -9 parrot/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/dod.c,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -w -r1.66 -r1.67
--- dod.c 28 Jul 2003 13:37:55 -0000 1.66
+++ dod.c 30 Jul 2003 14:59:46 -0000 1.67
@@ -1,7 +1,7 @@
/* dod.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.c,v 1.66 2003/07/28 13:37:55 leo Exp $
+ * $Id: dod.c,v 1.67 2003/07/30 14:59:46 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@ -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 */
+ 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 */
+ 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, int trace_stack)
{
- 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,14 +201,28 @@
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
if (trace_stack)
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;
1.79 +2 -2 parrot/embed.c
Index: embed.c
===================================================================
RCS file: /cvs/public/parrot/embed.c,v
retrieving revision 1.78
retrieving revision 1.79
diff -u -w -r1.78 -r1.79
--- embed.c 29 Jul 2003 23:31:06 -0000 1.78
+++ embed.c 30 Jul 2003 14:59:46 -0000 1.79
@@ -1,7 +1,7 @@
/* embed.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: embed.c,v 1.78 2003/07/29 23:31:06 grunblatt Exp $
+ * $Id: embed.c,v 1.79 2003/07/30 14:59:46 leo Exp $
* Overview:
* The Parrot embedding interface.
* Data Structure and Algorithms:
@@ -87,7 +87,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;
}
1.183 +9 -4 parrot/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.182
retrieving revision 1.183
diff -u -w -r1.182 -r1.183
--- interpreter.c 28 Jul 2003 21:52:59 -0000 1.182
+++ interpreter.c 30 Jul 2003 14:59:46 -0000 1.183
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.c,v 1.182 2003/07/28 21:52:59 scog Exp $
+ * $Id: interpreter.c,v 1.183 2003/07/30 14:59:46 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -688,7 +688,6 @@
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);
@@ -826,6 +825,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);
@@ -833,6 +837,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;
@@ -888,8 +895,6 @@
stack_destroy(interpreter->ctx.control_stack);
/* intstack */
intstack_free(interpreter, interpreter->ctx.intstack);
-
- PIO_finish(interpreter);
mem_sys_free(interpreter);
}
1.30 +8 -12 parrot/io.ops
Index: io.ops
===================================================================
RCS file: /cvs/public/parrot/io.ops,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- io.ops 21 Jul 2003 18:00:24 -0000 1.29
+++ io.ops 30 Jul 2003 14:59:46 -0000 1.30
@@ -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;
1.38 +2 -2 parrot/trace.c
Index: trace.c
===================================================================
RCS file: /cvs/public/parrot/trace.c,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -w -r1.37 -r1.38
--- trace.c 21 Jul 2003 18:00:24 -0000 1.37
+++ trace.c 30 Jul 2003 14:59:46 -0000 1.38
@@ -1,7 +1,7 @@
/* trace.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: trace.c,v 1.37 2003/07/21 18:00:24 chromatic Exp $
+ * $Id: trace.c,v 1.38 2003/07/30 14:59:46 leo Exp $
* Overview:
* Tracing support for runops_cores.c.
* Data Structure and Algorithms:
@@ -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));
}
1.6 +62 -1 parrot/classes/parrotio.pmc
Index: parrotio.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotio.pmc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- parrotio.pmc 21 Jul 2003 18:00:29 -0000 1.5
+++ parrotio.pmc 30 Jul 2003 14:59:48 -0000 1.6
@@ -1,7 +1,7 @@
/* ParrotIO.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotio.pmc,v 1.5 2003/07/21 18:00:29 chromatic Exp $
+ * $Id: parrotio.pmc,v 1.6 2003/07/30 14:59:48 leo Exp $
* Overview:
* These are the vtable functions for Parrot IO
* Data Structure and Algorithms:
@@ -13,12 +13,66 @@
#include "parrot/parrot.h"
+static void
+enter_nci_method(struct Parrot_Interp *interpreter, PMC *method_table,
+ void *func, const char *name, const char *proto)
+{
+ PMC *method;
+
+ method = pmc_new(interpreter, enum_class_NCI);
+ VTABLE_set_string_keyed(interpreter, method, func,
+ string_make(interpreter, proto, strlen(proto),
+ NULL, 0, NULL));
+ VTABLE_set_pmc_keyed(interpreter, method_table,
+ key_new_string(interpreter,
+ string_make(interpreter, name,
+ strlen(name), NULL,
+ 0, NULL)),
+ method);
+}
+
+void Parrot_NCI_class_init(Parrot_Interp, int);
+void Parrot_PerlHash_class_init(Parrot_Interp, int);
+void Parrot_PerlUndef_class_init(Parrot_Interp, int);
+
pmclass ParrotIO {
STRING* name () {
return whoami;
}
+ void class_init () {
+ PMC *method_table;;
+
+ /* These classes are needed now so make sure they are inited */
+ Parrot_NCI_class_init(interp, enum_class_NCI);
+ Parrot_PerlHash_class_init(interp, enum_class_PerlHash);
+ Parrot_PerlUndef_class_init(interp, enum_class_PerlUndef);
+
+ method_table = pmc_new(INTERP, enum_class_PerlHash);
+
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_close), "close", "iIP");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_flush), "flush", "vIP");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_read), "read", "iIPii");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_write), "write", "iIPii");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_setbuf), "setbuf", "iIPi");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_setlinebuf), "setlinebuf", "iIP");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_puts), "puts", "iIPt");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_seek), "seek", "iIPiii");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_eof), "eof", "iIP");
+
+ ((ParrotIOData *)(INTERP->piodata))->method_table = method_table;
+ }
+
void init () {
PObj_active_destroy_SET(SELF);
PObj_needs_early_DOD_SET(SELF);
@@ -42,5 +96,12 @@
INTVAL get_bool() {
return !PIO_eof(INTERP, SELF);
+ }
+
+ PMC* find_method (STRING* name) {
+ PMC* method_table = ((ParrotIOData *)(INTERP->piodata))->method_table;
+
+ return VTABLE_get_pmc_keyed(INTERP, method_table,
+ key_new_string(INTERP, name));
}
}
1.36 +5 -2 parrot/include/parrot/io.h
Index: io.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/io.h,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -w -r1.35 -r1.36
--- io.h 21 Jul 2003 18:00:42 -0000 1.35
+++ io.h 30 Jul 2003 14:59:51 -0000 1.36
@@ -1,7 +1,7 @@
/* io.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io.h,v 1.35 2003/07/21 18:00:42 chromatic Exp $
+ * $Id: io.h,v 1.36 2003/07/30 14:59:51 leo Exp $
* Overview:
* Parrot IO subsystem
* Data Structure and Algorithms:
@@ -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 */
@@ -166,6 +166,7 @@
struct _ParrotIOData {
ParrotIOTable table;
ParrotIOLayer *default_stack;
+ PMC *method_table;
};
@@ -335,6 +336,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
1.49 +33 -24 parrot/io/io.c
Index: io.c
===================================================================
RCS file: /cvs/public/parrot/io/io.c,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -w -r1.48 -r1.49
--- io.c 21 Jul 2003 18:00:45 -0000 1.48
+++ io.c 30 Jul 2003 14:59:52 -0000 1.49
@@ -1,7 +1,7 @@
/* io.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io.c,v 1.48 2003/07/21 18:00:45 chromatic Exp $
+ * $Id: io.c,v 1.49 2003/07/30 14:59:52 leo Exp $
* Overview:
* This is the Parrot IO subsystem API. Generic IO stuff
* goes here, each specific layer goes in its own file...
@@ -119,20 +119,7 @@
{
/* Has interp been initialized already? */
if (interpreter->piodata) {
- /* memsub system is up and running:
- * TODO: create stdio PMCs and store them away for later
- */
- return;
- }
-
- interpreter->piodata = mem_sys_allocate(sizeof(ParrotIOData));
- if (interpreter->piodata == NULL)
- internal_exception(PIO_ERROR, "PIO alloc piodata failure.");
- GET_INTERP_IOD(interpreter)->default_stack = NULL;
- GET_INTERP_IOD(interpreter)->table = alloc_pio_array(PIO_NR_OPEN);
- if (GET_INTERP_IOD(interpreter)->table == NULL)
- internal_exception(PIO_ERROR, "PIO alloc table failure.");
-
+ /* memsub system is up and running: */
/* Init IO stacks and handles for interp instance. */
if (PIO_init_stacks(interpreter) != 0) {
internal_exception(PIO_ERROR, "PIO init stacks failed.");
@@ -146,6 +133,18 @@
if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
PIO_eprintf(NULL, "PIO: IO system initialized.\n");
}
+
+ return;
+ }
+
+ interpreter->piodata = mem_sys_allocate(sizeof(ParrotIOData));
+ if (interpreter->piodata == NULL)
+ internal_exception(PIO_ERROR, "PIO alloc piodata failure.");
+ GET_INTERP_IOD(interpreter)->default_stack = NULL;
+ GET_INTERP_IOD(interpreter)->table = alloc_pio_array(PIO_NR_OPEN);
+ if (GET_INTERP_IOD(interpreter)->table == NULL)
+ internal_exception(PIO_ERROR, "PIO alloc table failure.");
+
}
void
@@ -733,8 +732,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 +757,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 +775,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]);
+ }
+ }
}
/*
1.8 +4 -3 parrot/io/io_buf.c
Index: io_buf.c
===================================================================
RCS file: /cvs/public/parrot/io/io_buf.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- io_buf.c 29 Jul 2003 19:01:37 -0000 1.7
+++ io_buf.c 30 Jul 2003 14:59:52 -0000 1.8
@@ -1,7 +1,7 @@
/* io_buf.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io_buf.c,v 1.7 2003/07/29 19:01:37 scog Exp $
+ * $Id: io_buf.c,v 1.8 2003/07/30 14:59:52 leo Exp $
* Overview:
* The "buf" layer of Parrot IO. Buffering and all the fun stuff.
*
@@ -69,9 +69,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;
}
1.27 +23 -12 parrot/io/io_unix.c
Index: io_unix.c
===================================================================
RCS file: /cvs/public/parrot/io/io_unix.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- io_unix.c 21 Jul 2003 18:00:45 -0000 1.26
+++ io_unix.c 30 Jul 2003 14:59:52 -0000 1.27
@@ -1,7 +1,7 @@
/* io_unix.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io_unix.c,v 1.26 2003/07/21 18:00:45 chromatic Exp $
+ * $Id: io_unix.c,v 1.27 2003/07/30 14:59:52 leo Exp $
* Overview:
* This is the Parrot IO UNIX layer. May be changed to
* include other platforms if that platform is similar
@@ -88,16 +88,27 @@
{
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))
- )
+ 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;
1.74 +7 -2 parrot/jit/i386/jit_emit.h
Index: jit_emit.h
===================================================================
RCS file: /cvs/public/parrot/jit/i386/jit_emit.h,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -w -r1.73 -r1.74
--- jit_emit.h 29 Jul 2003 20:04:14 -0000 1.73
+++ jit_emit.h 30 Jul 2003 14:59:54 -0000 1.74
@@ -3,7 +3,7 @@
*
* i386
*
- * $Id: jit_emit.h,v 1.73 2003/07/29 20:04:14 grunblatt Exp $
+ * $Id: jit_emit.h,v 1.74 2003/07/30 14:59:54 leo Exp $
*/
#include <assert.h>
@@ -2659,7 +2659,7 @@
const char *typs[] = {
"lisc", /* I */
"t", /* S */
- "p", /* P */
+ "pP", /* P */
"fd" /* N */
};
int first_reg = 5;
@@ -2764,6 +2764,11 @@
emitm_movl_m_r(pc, emit_EAX, emit_EAX, 0, 1,
offsetof(struct PMC_EXT, data));
#endif
+ emitm_pushl_r(pc, emit_EAX);
+ break;
+ case 'P': /* push PMC * */
+ jit_emit_mov_rm_i(pc, emit_EAX,
+ &PMC_REG(count_regs(sig, signature->strstart)));
emitm_pushl_r(pc, emit_EAX);
break;
case 'v':
1.8 +11 -1 parrot/t/pmc/io.t
Index: io.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/io.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- io.t 28 Jul 2003 19:31:47 -0000 1.7
+++ io.t 30 Jul 2003 14:59:57 -0000 1.8
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 17;
+use Parrot::Test tests => 18;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "open/close");
@@ -259,4 +259,14 @@
1.000000
foo
This is a test
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', 'puts method');
+ set S5, "ok\n"
+ getstdout P5
+ find_method P0, P5, "puts"
+ invoke
+ end
+CODE
+ok
OUTPUT
