cvsuser 04/05/24 06:47:00
Modified: . MANIFEST
io io.c io_buf.c io_layers.c io_passdown.c
io_private.h io_stdio.c io_unix.c io_win32.c
classes parrotio.pmc
config/gen/makefiles root.in
t/native_pbc string.t
t/op string.t stringu.t
t/pmc perlstring.t
Added: io io_utf8.c
Log:
io_layers 6 - utf8 output layer
* no more default utf8 IO conversion
* to turn on utf8 for output run:
getstdout Px
push Px, 'utf8'
* changed PIO_xxx_write PIO internal API to use STRING*
Revision Changes Path
1.657 +1 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.656
retrieving revision 1.657
diff -u -w -r1.656 -r1.657
--- MANIFEST 24 May 2004 06:30:41 -0000 1.656
+++ MANIFEST 24 May 2004 13:46:41 -0000 1.657
@@ -1805,6 +1805,7 @@
io/io_private.h []
io/io_stdio.c []
io/io_unix.c []
+io/io_utf8.c []
io/io_win32.c []
jit/alpha/core.jit []
jit/alpha/jit_emit.h []
1.90 +21 -7 parrot/io/io.c
Index: io.c
===================================================================
RCS file: /cvs/public/parrot/io/io.c,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -w -r1.89 -r1.90
--- io.c 19 May 2004 14:39:28 -0000 1.89
+++ io.c 24 May 2004 13:46:44 -0000 1.90
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io.c,v 1.89 2004/05/19 14:39:28 leo Exp $
+$Id: io.c,v 1.90 2004/05/24 13:46:44 leo Exp $
=head1 NAME
@@ -332,7 +332,7 @@
fill = 0;
if (!pio_registered_layers) {
- n = 2; /* 2 default layers for now */
+ n = 3; /* 2 default layers for now + utf8 */
pio_registered_layers = mem_sys_allocate(
sizeof(ParrotIOLayer *) * (n + 1));
fill = 1;
@@ -353,6 +353,11 @@
}
}
}
+ if (fill) {
+ assert(pio_registered_layers[2] == NULL);
+ pio_registered_layers[2] = PIO_utf8_register_layer();
+ pio_registered_layers[3] = NULL;
+ }
return 0;
}
@@ -726,9 +731,7 @@
STRING *temp = NULL;
length_read = PIO_read(interpreter, pmc, buffer, len);
- temp = string_make(interpreter, buffer, length_read, "UTF-8", 0);
- /* this is temporary, to make freeze/thaw work */
- Parrot_string_downscale(interpreter, temp, enum_stringrep_one); /* squish it */
+ temp = string_make(interpreter, buffer, length_read, "iso-8859-1", 0);
free(buffer);
@@ -762,11 +765,16 @@
{
ParrotIOLayer *l = PMC_struct_val(pmc);
ParrotIO *io = PMC_data(pmc);
+ STRING fake;
if(!io)
return -1;
- if (io->flags & PIO_F_WRITE)
- return PIO_write_down(interpreter, l, io, buffer, len);
+ if (io->flags & PIO_F_WRITE) {
+ /* TODO skip utf8 translation layers if any */
+ fake.strstart = buffer;
+ fake.bufused = len;
+ return PIO_write_down(interpreter, l, io, &fake);
+ }
else
return 0;
}
@@ -878,6 +886,11 @@
INTVAL
PIO_putps(theINTERP, PMC *pmc, STRING *s)
{
+#if 1
+ ParrotIOLayer *l = PMC_struct_val(pmc);
+ ParrotIO *io = PMC_data(pmc);
+ return PIO_write_down(interpreter, l, io, s);
+#else
UINTVAL length = string_length(interpreter, s);
char *buffer = malloc(4*length);
char *cursor = buffer;
@@ -895,6 +908,7 @@
free(buffer);
return temp;
+#endif
}
/*
1.25 +18 -17 parrot/io/io_buf.c
Index: io_buf.c
===================================================================
RCS file: /cvs/public/parrot/io/io_buf.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- io_buf.c 19 Feb 2004 20:30:10 -0000 1.24
+++ io_buf.c 24 May 2004 13:46:44 -0000 1.25
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io_buf.c,v 1.24 2004/02/19 20:30:10 mrjoltcola Exp $
+$Id: io_buf.c,v 1.25 2004/05/24 13:46:44 leo Exp $
=head1 NAME
@@ -50,7 +50,7 @@
static size_t PIO_buf_read(theINTERP, ParrotIOLayer *l,
ParrotIO *io, void *buffer, size_t len);
static size_t PIO_buf_write(theINTERP, ParrotIOLayer *l,
- ParrotIO *io, const void *buffer, size_t len);
+ ParrotIO *io, STRING *s);
static size_t PIO_buf_peek(theINTERP, ParrotIOLayer *l,
ParrotIO *io, void *buffer);
static PIOOFF_T PIO_buf_seek(theINTERP, ParrotIOLayer *l, ParrotIO *io,
@@ -292,6 +292,7 @@
{
long wrote;
size_t to_write;
+ STRING fake;
/*
* Either buffering is null, disabled, or empty.
*/
@@ -307,8 +308,9 @@
to_write = io->b.next - io->b.startb;
/* Flush to next layer */
- wrote = PIO_write_down(interpreter, PIO_DOWNLAYER(l), io,
- io->b.startb, to_write);
+ fake.strstart = io->b.startb;
+ fake.bufused = to_write;
+ wrote = PIO_write_down(interpreter, PIO_DOWNLAYER(l), io, &fake);
if (wrote == (long)to_write) {
io->b.next = io->b.startb;
/* Release buffer */
@@ -557,8 +559,7 @@
/*
=item C<static size_t
-PIO_buf_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
- const void *buffer, size_t len)>
+PIO_buf_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io, STRING *s)>
The buffer layer's C<Write> function.
@@ -567,11 +568,12 @@
*/
static size_t
-PIO_buf_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
- const void *buffer, size_t len)
+PIO_buf_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io, STRING *s)
{
size_t avail;
long wrote;
+ void *buffer = s->strstart;
+ size_t len = s->bufused;
if (len <= 0)
return 0;
@@ -596,8 +598,7 @@
if (len >= io->b.size) {
/* Write through, skip buffer. */
PIO_buf_flush(interpreter, layer, io);
- wrote = PIO_write_down(interpreter, PIO_DOWNLAYER(layer), io, buffer,
- len);
+ wrote = PIO_write_down(interpreter, PIO_DOWNLAYER(layer), io, s);
if (wrote == (long)len) {
io->fpos += wrote;
return wrote;
1.3 +30 -2 parrot/io/io_layers.c
Index: io_layers.c
===================================================================
RCS file: /cvs/public/parrot/io/io_layers.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- io_layers.c 20 May 2004 09:17:33 -0000 1.2
+++ io_layers.c 24 May 2004 13:46:44 -0000 1.3
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io_layers.c,v 1.2 2004/05/20 09:17:33 leo Exp $
+$Id: io_layers.c,v 1.3 2004/05/24 13:46:44 leo Exp $
=head1 NAME
@@ -41,6 +41,9 @@
{
ParrotIOLayer *new_layer;
+ /*
+ * XXX use managed memory here ?
+ */
new_layer = mem_sys_allocate(sizeof(ParrotIOLayer));
if (proto) {
/* FIXME: Flag here to indicate whether to free strings */
@@ -53,6 +56,7 @@
new_layer->flags = 0;
new_layer->api = NULL;
}
+ new_layer->flags |= PIO_L_LAYER_COPIED;
new_layer->self = 0;
new_layer->up = NULL;
new_layer->down = NULL;
@@ -113,11 +117,18 @@
if (t == layer)
return -1;
}
+ /*
+ * if this is a global layer create a copy first
+ */
+ if (!(io->stack->flags & PIO_L_LAYER_COPIED)) {
+ io->stack = PIO_copy_stack(io->stack);
+ }
layer->down = io->stack;
if (io->stack)
io->stack->up = layer;
io->stack = layer;
+ PMC_struct_val(pmc) = layer;
if (layer->api->Pushed)
(*layer->api->Pushed) (layer, io);
}
@@ -142,6 +153,23 @@
return -1;
}
+void
+PIO_push_layer_str(Interp *interpreter, PMC *pmc, STRING *ls)
+{
+ ParrotIOLayer **t, *l;
+ char *cls = string_to_cstring(interpreter, ls);
+ for (t = pio_registered_layers; *t; ++t)
+ if (!strcmp(cls, (*t)->name))
+ break;
+ string_cstring_free(cls);
+ if (!*t)
+ internal_exception(1, "Layer not found");
+
+ /* make private copy */
+ l = PIO_base_new_layer(*t);
+ PIO_push_layer(interpreter, l, pmc);
+}
+
/*
=item C<ParrotIOLayer *
@@ -206,7 +234,7 @@
ParrotIOLayer *
PIO_copy_stack(ParrotIOLayer *stack)
{
- ParrotIOLayer *ptr_new;
+ ParrotIOLayer *ptr_new = NULL;
ParrotIOLayer **ptr_ptr_new;
ParrotIOLayer *ptr_last = NULL;
ptr_ptr_new = &ptr_new;
1.7 +9 -12 parrot/io/io_passdown.c
Index: io_passdown.c
===================================================================
RCS file: /cvs/public/parrot/io/io_passdown.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- io_passdown.c 19 Feb 2004 20:30:10 -0000 1.6
+++ io_passdown.c 24 May 2004 13:46:44 -0000 1.7
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io_passdown.c,v 1.6 2004/02/19 20:30:10 mrjoltcola Exp $
+$Id: io_passdown.c,v 1.7 2004/05/24 13:46:44 leo Exp $
=head1 NAME
@@ -154,8 +154,7 @@
/*
=item C<size_t
-PIO_write_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io,
- const void * buf, size_t len)>
+PIO_write_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io, STRING *)>
Looks for the implementation of C<Write> and calls it if found,
returning its return value.
@@ -167,12 +166,11 @@
*/
size_t
-PIO_write_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io,
- const void * buf, size_t len)
+PIO_write_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io, STRING *s)
{
while (layer) {
if (layer->api->Write) {
- return layer->api->Write(interpreter, layer, io, buf, len);
+ return layer->api->Write(interpreter, layer, io, s);
}
layer = PIO_DOWNLAYER(layer);
}
@@ -184,7 +182,7 @@
=item C<size_t
PIO_write_async_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io,
- void * buf, size_t len, DummyCodeRef *dummy)>
+ STRING *s, DummyCodeRef *dummy)>
Looks for the implementation of C<WriteASync> and calls it if found,
returning its return value.
@@ -197,12 +195,11 @@
size_t
PIO_write_async_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io,
- void * buf, size_t len, DummyCodeRef *dummy)
+ STRING *s, DummyCodeRef *dummy)
{
while (layer) {
if (layer->api->Write_ASync) {
- return layer->api->Write_ASync(interpreter, layer, io, buf, len,
- dummy);
+ return layer->api->Write_ASync(interpreter, layer, io, s, dummy);
}
layer = PIO_DOWNLAYER(layer);
}
1.12 +20 -11 parrot/io/io_private.h
Index: io_private.h
===================================================================
RCS file: /cvs/public/parrot/io/io_private.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- io_private.h 19 May 2004 14:39:28 -0000 1.11
+++ io_private.h 24 May 2004 13:46:44 -0000 1.12
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io_private.h,v 1.11 2004/05/19 14:39:28 leo Exp $
+$Id: io_private.h,v 1.12 2004/05/24 13:46:44 leo Exp $
=head1 NAME
@@ -67,7 +67,8 @@
* buffering, translation, compression or encryption layers.
*/
#define PIO_L_TERMINAL 0x0001
-#define PIO_L_FASTGETS 0x0002
+#define PIO_L_FASTGETS 0x0002 /* ??? */
+#define PIO_L_LAYER_COPIED 0x0004 /* PMC has private layer */
#define PIO_ACCMODE 0000003
@@ -136,9 +137,9 @@
INTVAL flags);
INTVAL PIO_close_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io);
size_t PIO_write_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io,
- const void * buf, size_t len);
+ STRING *);
size_t PIO_write_async_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io,
- void * buf, size_t len, DummyCodeRef *);
+ STRING *, DummyCodeRef *);
size_t PIO_read_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io,
void * buf, size_t len);
size_t PIO_read_async_down(theINTERP, ParrotIOLayer * layer, ParrotIO * io,
@@ -185,11 +186,9 @@
INTVAL (*Close)(theINTERP, ParrotIOLayer * l,
ParrotIO * io);
size_t (*Write)(theINTERP, ParrotIOLayer * l,
- ParrotIO * io, const void * buf,
- size_t len);
+ ParrotIO * io, STRING *);
size_t (*Write_ASync)(theINTERP, ParrotIOLayer * layer,
- ParrotIO * io, void * buf, size_t len,
- DummyCodeRef *);
+ ParrotIO * io, STRING *, DummyCodeRef *);
size_t (*Read)(theINTERP, ParrotIOLayer * layer,
ParrotIO * io, void * buf, size_t len);
size_t (*Read_ASync)(theINTERP, ParrotIOLayer * layer,
@@ -224,6 +223,7 @@
/* these are defined rather than using NULL because strictly-speaking, ANSI C
* doesn't like conversions between function and non-function pointers. */
+#define PIO_null_init (INTVAL (*)(theINTERP, ParrotIOLayer *))0
#define PIO_null_push_layer (INTVAL (*)(ParrotIOLayer *, ParrotIO *))0
#define PIO_null_pop_layer (INTVAL (*)(ParrotIOLayer *, ParrotIO *))0
#define PIO_null_open (ParrotIO * (*)(theINTERP, ParrotIOLayer *, const char*,
INTVAL))0
@@ -232,11 +232,13 @@
#define PIO_null_open_async (ParrotIO * (*)(theINTERP, ParrotIOLayer *, const char
*, const char *, DummyCodeRef *))0
#define PIO_null_fdopen (ParrotIO * (*)(theINTERP, ParrotIOLayer *, PIOHANDLE,
INTVAL))0
#define PIO_null_close (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *))0
-#define PIO_null_write (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *, const
void *, size_t))0
-#define PIO_null_write_async (size_t (*)(theINTERP, ParrotIOLayer *, ParrotIO *,
void *, size_t, DummyCodeRef *))0
-#define PIO_null_read (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *, const
void *, size_t))0
+#define PIO_null_write (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *,
STRING*))0
+#define PIO_null_write_async (size_t (*)(theINTERP, ParrotIOLayer *, ParrotIO *,
STRING *,DummyCodeRef *))0
+#define PIO_null_read (size_t (*)(theINTERP, ParrotIOLayer *, ParrotIO *, void *,
size_t))0
#define PIO_null_read_async (size_t (*)(theINTERP, ParrotIOLayer *, ParrotIO *,
void *, size_t, DummyCodeRef *))0
#define PIO_null_flush (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *))0
+#define PIO_null_peek (size_t (*)(theINTERP, ParrotIOLayer *, ParrotIO *, void *))0
+#define PIO_null_read_async (size_t (*)(theINTERP, ParrotIOLayer *, ParrotIO *,
void *, size_t, DummyCodeRef *))0
#define PIO_null_seek (PIOOFF_T (*)(theINTERP, ParrotIOLayer *, ParrotIO *,
PIOOFF_T, INTVAL))0
#define PIO_null_tell (PIOOFF_T (*)(theINTERP, ParrotIOLayer *, ParrotIO *))0
#define PIO_null_setbuf (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *,
size_t))0
@@ -246,7 +248,12 @@
#define PIO_null_eof (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *))0
#define PIO_null_socket (ParrotIO * (*)(theINTERP, ParrotIOLayer *, int, int, int))0
+/*
+ * more API XXX should be in io.h when things settle
+ */
+ParrotIOLayer * PIO_utf8_register_layer(void);
+void PIO_push_layer_str(Interp *interpreter, PMC *pmc, STRING *ls);
#endif /* PARROT_IO_PRIVATE_H_GUARD */
@@ -255,9 +262,11 @@
=head1 SEE ALSO
F<io/io_buf.c>,
+F<io/io_layers.c>,
F<io/io_passdown.c>,
F<io/io_stdio.c>,
F<io/io_unix.c>,
+F<io/io_utf8.c>,
F<io/io_win32.c>,
F<io/io.c>.
1.42 +12 -11 parrot/io/io_stdio.c
Index: io_stdio.c
===================================================================
RCS file: /cvs/public/parrot/io/io_stdio.c,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -w -r1.41 -r1.42
--- io_stdio.c 4 Mar 2004 11:15:02 -0000 1.41
+++ io_stdio.c 24 May 2004 13:46:44 -0000 1.42
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io_stdio.c,v 1.41 2004/03/04 11:15:02 mikescott Exp $
+$Id: io_stdio.c,v 1.42 2004/05/24 13:46:44 leo Exp $
=head1 NAME
@@ -55,7 +55,7 @@
static size_t PIO_stdio_read(theINTERP, ParrotIOLayer *layer,
ParrotIO *io, void *buffer, size_t len);
static size_t PIO_stdio_write(theINTERP, ParrotIOLayer *layer,
- ParrotIO *io, const void *buffer, size_t len);
+ ParrotIO *io, STRING *s);
static size_t PIO_stdio_peek(theINTERP, ParrotIOLayer *layer,
ParrotIO *io, void *buffer);
static PIOOFF_T PIO_stdio_seek(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
@@ -361,7 +361,7 @@
=item C<static size_t
PIO_stdio_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
- const void *buffer, size_t len)>
+ STRING *s)>
Desc.
@@ -370,9 +370,10 @@
*/
static size_t
-PIO_stdio_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
- const void *buffer, size_t len)
+PIO_stdio_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io, STRING *s)
{
+ void *buffer = s->strstart;
+ size_t len = s->bufused;
UNUSED(interpreter);
UNUSED(layer);
1.52 +6 -5 parrot/io/io_unix.c
Index: io_unix.c
===================================================================
RCS file: /cvs/public/parrot/io/io_unix.c,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -w -r1.51 -r1.52
--- io_unix.c 9 Apr 2004 20:32:27 -0000 1.51
+++ io_unix.c 24 May 2004 13:46:44 -0000 1.52
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io_unix.c,v 1.51 2004/04/09 20:32:27 dan Exp $
+$Id: io_unix.c,v 1.52 2004/05/24 13:46:44 leo Exp $
=head1 NAME
@@ -59,7 +59,7 @@
static size_t PIO_unix_read(theINTERP, ParrotIOLayer *layer,
ParrotIO *io, void *buffer, size_t len);
static size_t PIO_unix_write(theINTERP, ParrotIOLayer *layer,
- ParrotIO *io, const void *buffer, size_t len);
+ ParrotIO *io, STRING *);
static PIOOFF_T PIO_unix_seek(theINTERP, ParrotIOLayer *l, ParrotIO *io,
PIOOFF_T offset, INTVAL whence);
static PIOOFF_T PIO_unix_tell(theINTERP, ParrotIOLayer *l, ParrotIO *io);
@@ -481,7 +481,7 @@
=item C<static size_t
PIO_unix_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
- const void *buffer, size_t len)>
+ STRING *)>
Calls C<write()> to write C<len> bytes from the memory starting at
C<buffer> to the file descriptor in C<*io>.
@@ -491,13 +491,14 @@
*/
static size_t
-PIO_unix_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
- const void *buffer, size_t len)
+PIO_unix_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io, STRING *s)
{
int err;
size_t bytes;
size_t to_write;
const char *ptr;
+ void *buffer = s->strstart;
+ size_t len = s->bufused;
UNUSED(interpreter);
UNUSED(layer);
1.43 +6 -5 parrot/io/io_win32.c
Index: io_win32.c
===================================================================
RCS file: /cvs/public/parrot/io/io_win32.c,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -w -r1.42 -r1.43
--- io_win32.c 3 Apr 2004 21:19:26 -0000 1.42
+++ io_win32.c 24 May 2004 13:46:44 -0000 1.43
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io_win32.c,v 1.42 2004/04/03 21:19:26 leo Exp $
+$Id: io_win32.c,v 1.43 2004/05/24 13:46:44 leo Exp $
=head1 NAME
@@ -60,7 +60,7 @@
static size_t PIO_win32_read(theINTERP, ParrotIOLayer *layer,
ParrotIO *io, void *buffer, size_t len);
static size_t PIO_win32_write(theINTERP, ParrotIOLayer *layer,
- ParrotIO *io, const void *buffer, size_t len);
+ ParrotIO *io, STRING *);
static PIOOFF_T PIO_win32_seek(theINTERP, ParrotIOLayer *l, ParrotIO *io,
PIOOFF_T off, INTVAL whence);
static PIOOFF_T PIO_win32_tell(theINTERP, ParrotIOLayer *l, ParrotIO *io);
@@ -380,7 +380,7 @@
=item C<static size_t
PIO_win32_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
- const void *buffer, size_t len)>
+ STRING *)>
Calls C<WriteFile()> to write C<len> bytes from the memory starting at
C<buffer> to C<*io>'s file descriptor.
@@ -390,10 +390,11 @@
*/
static size_t
-PIO_win32_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io,
- const void *buffer, size_t len)
+PIO_win32_write(theINTERP, ParrotIOLayer *layer, ParrotIO *io, STRING *s)
{
DWORD countwrote = 0;
+ void *buffer = s->strstart;
+ size_t len = s->bufused;
UNUSED(interpreter);
UNUSED(layer);
1.1 parrot/io/io_utf8.c
Index: io_utf8.c
===================================================================
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
$Id: io_utf8.c,v 1.1 2004/05/24 13:46:44 leo Exp $
=head1 NAME
io/io_utf8.c - IO Layer for UTF8
=head1 DESCRIPTION
Convert output to utf8. Convert input to Parrot's internal string
representation.
*/
/*
=head2 utf8 layer functions
=over 4
=cut
*/
#include "parrot/parrot.h"
#include "io_private.h"
/* Defined at bottom */
static ParrotIOLayerAPI pio_utf8_layer_api;
ParrotIOLayer pio_utf8_layer = {
NULL,
"utf8",
0,
&pio_utf8_layer_api,
0, 0
};
ParrotIOLayer *
PIO_utf8_register_layer(void)
{
return &pio_utf8_layer;
}
void *Parrot_utf8_encode(void *ptr, UINTVAL c);
static size_t
PIO_utf8_write(theINTERP, ParrotIOLayer *l, ParrotIO *io, STRING *s)
{
STRING n;
size_t idx, length = string_length(interpreter, s);
char *buffer = malloc(4*length);
char *cursor = buffer;
for( idx = 0; idx < length; ++idx )
{
cursor = Parrot_utf8_encode(cursor, string_index(interpreter, s, idx));
}
n.strstart = buffer;
n.bufused = cursor - buffer;
return PIO_write_down(interpreter, l->down, io, &n);
}
static ParrotIOLayerAPI pio_utf8_layer_api = {
PIO_null_init,
PIO_base_new_layer,
PIO_base_delete_layer,
PIO_null_push_layer,
PIO_null_pop_layer,
PIO_null_open,
PIO_null_open2,
PIO_null_open3,
PIO_null_open_async,
PIO_null_fdopen,
PIO_null_close,
PIO_utf8_write,
PIO_null_write_async,
PIO_null_read,
PIO_null_read_async,
PIO_null_flush,
PIO_null_peek,
PIO_null_seek,
PIO_null_tell,
PIO_null_setbuf,
PIO_null_setlinebuf,
PIO_null_getcount,
PIO_null_fill,
PIO_null_eof,
0, /* no poll */
0, /* no socket */
0, /* no connect */
0, /* no send */
0 /* no recv */
};
/*
=back
=head1 SEE ALSO
F<io/io_passdown.c>,
F<io/io.c>,
F<io/io_layers.c>,
F<io/io_private.h>.
=head1 HISTORY
Initially written by Leo.
=cut
*/
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
1.21 +14 -1 parrot/classes/parrotio.pmc
Index: parrotio.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotio.pmc,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -w -r1.20 -r1.21
--- parrotio.pmc 19 May 2004 12:44:11 -0000 1.20
+++ parrotio.pmc 24 May 2004 13:46:48 -0000 1.21
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotio.pmc,v 1.20 2004/05/19 12:44:11 leo Exp $
+$Id: parrotio.pmc,v 1.21 2004/05/24 13:46:48 leo Exp $
=head1 NAME
@@ -174,6 +174,19 @@
return string_from_cstring(interpreter, layer->name, 0);
return const_string(interpreter, "");
}
+/*
+
+=item C<void push_string (STRING* value)>
+
+Push the layer name C<value> onto the PIO's layer stack.
+
+=cut
+
+*/
+
+ void push_string (STRING* value) {
+ PIO_push_layer_str(INTERP, SELF, value);
+ }
}
/*
1.215 +4 -1 parrot/config/gen/makefiles/root.in
Index: root.in
===================================================================
RCS file: /cvs/public/parrot/config/gen/makefiles/root.in,v
retrieving revision 1.214
retrieving revision 1.215
diff -u -w -r1.214 -r1.215
--- root.in 21 May 2004 14:03:36 -0000 1.214
+++ root.in 24 May 2004 13:46:50 -0000 1.215
@@ -1,4 +1,4 @@
-# $Id: root.in,v 1.214 2004/05/21 14:03:36 jrieks Exp $
+# $Id: root.in,v 1.215 2004/05/24 13:46:50 leo Exp $
###############################################################################
#
@@ -228,6 +228,7 @@
io/io_buf$(O) \
io/io_layers$(O) \
io/io_unix$(O) \
+ io/io_utf8$(O) \
io/io_win32$(O) \
io/io_stdio$(O) \
io/io_passdown$(O)
@@ -765,6 +766,8 @@
io/io_unix$(O) : $(GENERAL_H_FILES) io/io_private.h
+io/io_utf8$(O) : $(GENERAL_H_FILES) io/io_private.h
+
io/io_win32$(O) : $(GENERAL_H_FILES) io/io_private.h
io/io_stdio$(O) : $(GENERAL_H_FILES) io/io_private.h
1.2 +7 -1 parrot/t/native_pbc/string.t
Index: string.t
===================================================================
RCS file: /cvs/public/parrot/t/native_pbc/string.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- string.t 11 Apr 2004 09:56:29 -0000 1.1
+++ string.t 24 May 2004 13:46:53 -0000 1.2
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: string.t,v 1.1 2004/04/11 09:56:29 leo Exp $
+# $Id: string.t,v 1.2 2004/05/24 13:46:53 leo Exp $
=head1 NAME
@@ -18,6 +18,10 @@
use Parrot::Test tests => 2;
+SKIP:
+{
+ skip("utf8 IO changes", 2);
+
output_is(<<CODE, <<OUTPUT, "angstrom 32 bit PPC BE");
# string_1.pbc s. t/op/string_133
CODE
@@ -29,3 +33,5 @@
CODE
\xe2\x84\xab
OUTPUT
+
+}
1.75 +3 -1 parrot/t/op/string.t
Index: string.t
===================================================================
RCS file: /cvs/public/parrot/t/op/string.t,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -w -r1.74 -r1.75
--- string.t 16 Apr 2004 12:48:32 -0000 1.74
+++ string.t 24 May 2004 13:46:57 -0000 1.75
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: string.t,v 1.74 2004/04/16 12:48:32 leo Exp $
+# $Id: string.t,v 1.75 2004/05/24 13:46:57 leo Exp $
=head1 NAME
@@ -2213,6 +2213,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, "bnots 2");
+ getstdout P0
+ push P0, "utf8"
set S1, "a2c"
bnots S2, S1
print S1
1.4 +23 -3 parrot/t/op/stringu.t
Index: stringu.t
===================================================================
RCS file: /cvs/public/parrot/t/op/stringu.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- stringu.t 14 Apr 2004 09:00:22 -0000 1.3
+++ stringu.t 24 May 2004 13:46:57 -0000 1.4
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: stringu.t,v 1.3 2004/04/14 09:00:22 leo Exp $
+# $Id: stringu.t,v 1.4 2004/05/24 13:46:57 leo Exp $
=head1 NAME
@@ -21,15 +21,19 @@
use Test::More;
output_is( <<'CODE', <<OUTPUT, "angstrom" );
+ getstdout P0
+ push P0, "utf8"
chr S0, 0x212B
- print S0
- print "\n"
+ print P0, S0
+ print P0, "\n"
end
CODE
\xe2\x84\xab
OUTPUT
output_is( <<'CODE', <<OUTPUT, "escaped angstrom" );
+ getstdout P0
+ push P0, "utf8"
set S0, "\x{212b}"
print S0
print "\n"
@@ -39,6 +43,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, "escaped angstrom 2" );
+ getstdout P0
+ push P0, "utf8"
set S0, "aaaaaa\x{212b}"
print S0
print "\n"
@@ -48,6 +54,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, "escaped angstrom 3" );
+ getstdout P0
+ push P0, "utf8"
set S0, "aaaaaa\x{212b}-aaaaaa"
print S0
print "\n"
@@ -57,6 +65,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, 'escaped angstrom 3 \uhhhh' );
+ getstdout P0
+ push P0, "utf8"
set S0, "aaaaaa\u212b-aaaaaa"
print S0
print "\n"
@@ -66,6 +76,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, "MATHEMATICAL BOLD CAPITAL A");
+ getstdout P0
+ push P0, "utf8"
set S0, "aaaaaa\x{1d400}-aaaaaa"
print S0
print "\n"
@@ -75,6 +87,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, 'MATHEMATICAL BOLD CAPITAL A \U');
+ getstdout P0
+ push P0, "utf8"
set S0, "aaaaaa\U0001d400-aaaaaa"
print S0
print "\n"
@@ -84,6 +98,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, "two upscales");
+ getstdout P0
+ push P0, "utf8"
set S0, "aaaaaa\x{212b}-bbbbbb\x{1d400}-cccccc"
print S0
print "\n"
@@ -102,6 +118,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, "two upscales - don't downscale");
+ getstdout P0
+ push P0, "utf8"
set S0, "aaaaaa\x{1d400}-bbbbbb\x{212b}-cccccc"
print S0
print "\n"
@@ -120,6 +138,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, '\cX, \ooo');
+ getstdout P0
+ push P0, "utf8"
set S0, "ok 1\cJ"
print S0
set S0, "ok 2\012"
1.23 +3 -1 parrot/t/pmc/perlstring.t
Index: perlstring.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlstring.t,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -w -r1.22 -r1.23
--- perlstring.t 20 Apr 2004 16:04:30 -0000 1.22
+++ perlstring.t 24 May 2004 13:47:00 -0000 1.23
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlstring.t,v 1.22 2004/04/20 16:04:30 leo Exp $
+# $Id: perlstring.t,v 1.23 2004/05/24 13:47:00 leo Exp $
=head1 NAME
@@ -995,6 +995,8 @@
OUTPUT
output_is( <<'CODE', <<OUTPUT, "bnots 2");
+ getstdout P0
+ push P0, "utf8"
new P1, .PerlString
new P2, .PerlString
set P1, "a2c"
