cvsuser 03/08/09 00:22:23
Modified: include/parrot io.h
. io.ops
io io.c io_stdio.c io_unix.c io_win32.c
t/pmc io.t
Log:
23252: io17 - seek, tell by Juergen Boemmels
Revision Changes Path
1.37 +7 -6 parrot/include/parrot/io.h
Index: io.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/io.h,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -w -r1.36 -r1.37
--- io.h 30 Jul 2003 14:59:51 -0000 1.36
+++ io.h 9 Aug 2003 07:22:16 -0000 1.37
@@ -1,7 +1,7 @@
/* io.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io.h,v 1.36 2003/07/30 14:59:51 leo Exp $
+ * $Id: io.h,v 1.37 2003/08/09 07:22:16 leo Exp $
* Overview:
* Parrot IO subsystem
* Data Structure and Algorithms:
@@ -250,8 +250,7 @@
INTVAL (*Flush)(theINTERP, ParrotIOLayer * layer,
ParrotIO * io);
INTVAL (*Seek)(theINTERP, ParrotIOLayer * layer,
- ParrotIO * io, INTVAL hi, INTVAL lo,
- INTVAL whence);
+ ParrotIO * io, PIOOFF_T offset, INTVAL whence);
PIOOFF_T (*Tell)(theINTERP, ParrotIOLayer * layer,
ParrotIO * io);
INTVAL (*SetBuf)(theINTERP, ParrotIOLayer * layer,
@@ -283,7 +282,7 @@
#define PIO_null_read (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *, const
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_seek (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *, INTVAL,
INTVAL, INTVAL))0
+#define PIO_null_seek (INTVAL (*)(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
#define PIO_null_setlinebuf (INTVAL (*)(theINTERP, ParrotIOLayer *, ParrotIO *))0
@@ -326,8 +325,7 @@
extern INTVAL PIO_setbuf(theINTERP, PMC *, size_t);
extern INTVAL PIO_setlinebuf(theINTERP, PMC *);
extern INTVAL PIO_puts(theINTERP, PMC *, const char *);
-extern INTVAL PIO_seek(theINTERP, PMC *, INTVAL hi,
- INTVAL lo, INTVAL whence);
+extern INTVAL PIO_seek(theINTERP, PMC *, PIOOFF_T offset, INTVAL whence);
extern INTVAL PIO_eof(theINTERP, PMC *);
extern INTVAL PIO_putps(theINTERP, PMC *io, STRING *s);
@@ -359,6 +357,9 @@
# define PIO_getblksize(x) PIO_stdio_getblksize(x)
#endif
+PIOOFF_T PIO_make_offset(INTVAL offset);
+PIOOFF_T PIO_make_offset32(INTVAL hi, INTVAL lo);
+PIOOFF_T PIO_make_offset_pmc(theINTERP, PMC *pmc);
#endif
1.31 +49 -12 parrot/io.ops
Index: io.ops
===================================================================
RCS file: /cvs/public/parrot/io.ops,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- io.ops 30 Jul 2003 14:59:46 -0000 1.30
+++ io.ops 9 Aug 2003 07:22:20 -0000 1.31
@@ -378,30 +378,67 @@
##########################################
-=item B<seek>(out INT, in PMC, in INT, in INT)
+=item B<seek>(in PMC, in INT, in INT)
-32bit seek:
-Set file position to offset $3 on IO stream $2. 'whence' is
-indicated by the value in $4.
+seek:
+Set file position to offset $2 on IO stream $1. 'whence' is
+indicated by the value in $3.
-=item B<seek>(out INT, in PMC, in INT, in INT, in INT)
+=item B<seek>(in PMC, in INT, in INT, in INT)
64bit seek:
-Set file position to offset ($3 << 32 | $4) on IO stream $2. 'whence' is
-indicated by the value in $4.
+Set file position to offset ($2 << 32 | $3) on IO stream $1. 'whence' is
+indicated by the value in $4. This allows 64-bit seeks with only 32-bit
+INTVALS.
=cut
-op seek(out INT, in PMC, in INT, in INT) {
- if ($2) {
- $1 = (INTVAL)PIO_seek(interpreter, $2, 0, $3, $4);
+op seek(in PMC, in INT, in INT) {
+ if ($1) {
+ if (PIO_seek(interpreter, $1, PIO_make_offset($2), $3) < 0) {
+ /* XXX: seek error */
+ }
+ }
+ goto NEXT();
+}
+
+op seek(in PMC, in INT, in INT, in INT) {
+ if ($1) {
+ if (PIO_seek(interpreter, $1, PIO_make_offset32($2, $3), $4) < 0) {
+ /* XXX: seek error */
+ }
}
goto NEXT();
}
-op seek(out INT, in PMC, in INT, in INT, in INT) {
+=item B<tell>(out INT, in PMC)
+
+tell:
+Get the current file position of stream $2 and store it in $1.
+On systems where INTVAL is 32bit the result will be truncated if the
+position is beyond 2 GiB
+
+=item B<tell>(out INT, out INT, in PMC)
+
+64bit tell:
+Get the current file positon of stream $3 in two parts of 32-bit each
+($1 = pos >> 32, $2 = pos & 0xffff).
+
+=cut
+
+op tell(out INT, in PMC) {
if ($2) {
- $1 = (INTVAL)PIO_seek(interpreter, $2, $3, $4, $5);
+ $1 = (INTVAL)PIO_tell(interpreter, $2);
+ }
+ goto NEXT();
+}
+
+op tell(out INT, out INT, in PMC) {
+ if ($3) {
+ PIOOFF_T pos;
+ pos = PIO_tell(interpreter, $3);
+ $1 = (INTVAL)(pos >> 32);
+ $2 = (INTVAL)(pos & 0xffff);
}
goto NEXT();
}
1.50 +23 -6 parrot/io/io.c
Index: io.c
===================================================================
RCS file: /cvs/public/parrot/io/io.c,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -w -r1.49 -r1.50
--- io.c 30 Jul 2003 14:59:52 -0000 1.49
+++ io.c 9 Aug 2003 07:22:22 -0000 1.50
@@ -1,7 +1,7 @@
/* io.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io.c,v 1.49 2003/07/30 14:59:52 leo Exp $
+ * $Id: io.c,v 1.50 2003/08/09 07:22:22 leo Exp $
* Overview:
* This is the Parrot IO subsystem API. Generic IO stuff
* goes here, each specific layer goes in its own file...
@@ -620,19 +620,17 @@
/*
- * 64 bit support wrapper. Some platforms/filesystems don't
- * support large files. Pass hi as 0 for 32bit seek. There is
- * a 1 and 2 arg version of seek opcode.
+ * Iterate down the stack to the first layer implementing "Seek" API
*/
INTVAL
-PIO_seek(theINTERP, PMC *pmc, INTVAL hi, INTVAL lo, INTVAL w)
+PIO_seek(theINTERP, PMC *pmc, PIOOFF_T offset, INTVAL w)
{
ParrotIOLayer *l = pmc->cache.struct_val;
while (l) {
if (l->api->Seek) {
ParrotIO *io = PMC_data(pmc);
- return (*l->api->Seek) (interpreter, l, io, hi, lo, w);
+ return (*l->api->Seek) (interpreter, l, io, offset, w);
}
l = PIO_DOWNLAYER(l);
}
@@ -801,6 +799,25 @@
pobject_lives(interpreter, (PObj *)table[i]);
}
}
+}
+
+PIOOFF_T
+PIO_make_offset(INTVAL offset)
+{
+ return offset;
+}
+
+PIOOFF_T
+PIO_make_offset32(INTVAL hi, INTVAL lo)
+{
+ return ((PIOOFF_T)hi << 32) | lo;
+}
+
+PIOOFF_T
+PIO_make_offset_pmc(theINTERP, PMC *pmc)
+{
+ /* XXX: Maybe use bignums here */
+ return VTABLE_get_integer(interpreter, pmc);
}
/*
1.26 +4 -5 parrot/io/io_stdio.c
Index: io_stdio.c
===================================================================
RCS file: /cvs/public/parrot/io/io_stdio.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -w -r1.25 -r1.26
--- io_stdio.c 31 Jul 2003 08:30:56 -0000 1.25
+++ io_stdio.c 9 Aug 2003 07:22:22 -0000 1.26
@@ -1,7 +1,7 @@
/* io_stdio.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io_stdio.c,v 1.25 2003/07/31 08:30:56 leo Exp $
+ * $Id: io_stdio.c,v 1.26 2003/08/09 07:22:22 leo Exp $
* Overview:
* This is the Parrot IO STDIO layer. This may provide a subset of
* full functionality, but must compile on any system with the
@@ -52,7 +52,7 @@
INTVAL PIO_stdio_puts(theINTERP, ParrotIOLayer *l, ParrotIO *io,
const char *s);
INTVAL PIO_stdio_seek(theINTERP, ParrotIOLayer *l, ParrotIO *io,
- INTVAL hi, INTVAL lo, INTVAL whence);
+ PIOOFF_T offset, INTVAL whence);
PIOOFF_T PIO_stdio_tell(theINTERP, ParrotIOLayer *l, ParrotIO *io);
@@ -237,16 +237,15 @@
/*
* Hard seek
- * FIXME: 64bit support, ignoring 'hi' 32bits for now
*/
INTVAL
PIO_stdio_seek(theINTERP, ParrotIOLayer *l, ParrotIO *io,
- INTVAL hi, INTVAL lo, INTVAL whence)
+ PIOOFF_T offset, INTVAL whence)
{
PIOOFF_T pos;
errno = 0;
- if ((pos = fseek(io->fd, (PIOOFF_T)lo, whence)) >= 0) {
+ if ((pos = fseek(io->fd, offset, whence)) >= 0) {
io->lpos = io->fpos;
io->fpos = pos;
}
1.28 +4 -10 parrot/io/io_unix.c
Index: io_unix.c
===================================================================
RCS file: /cvs/public/parrot/io/io_unix.c,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- io_unix.c 30 Jul 2003 14:59:52 -0000 1.27
+++ io_unix.c 9 Aug 2003 07:22:22 -0000 1.28
@@ -1,7 +1,7 @@
/* io_unix.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io_unix.c,v 1.27 2003/07/30 14:59:52 leo Exp $
+ * $Id: io_unix.c,v 1.28 2003/08/09 07:22:22 leo Exp $
* Overview:
* This is the Parrot IO UNIX layer. May be changed to
* include other platforms if that platform is similar
@@ -50,7 +50,7 @@
ParrotIO *io, const void *buffer, size_t len);
INTVAL PIO_unix_puts(theINTERP, ParrotIOLayer *l, ParrotIO *io, const char *s);
INTVAL PIO_unix_seek(theINTERP, ParrotIOLayer *l, ParrotIO *io,
- INTVAL hi, INTVAL lo, INTVAL whence);
+ PIOOFF_T offset, INTVAL whence);
PIOOFF_T PIO_unix_tell(theINTERP, ParrotIOLayer *l, ParrotIO *io);
@@ -386,23 +386,17 @@
/*
* Hard seek
- * FIXME: 64bit support, ignoring 'hi' 32bits for now
*/
INTVAL
PIO_unix_seek(theINTERP, ParrotIOLayer *l, ParrotIO *io,
- INTVAL hi, INTVAL lo, INTVAL whence)
+ PIOOFF_T offset, INTVAL whence)
{
PIOOFF_T pos;
errno = 0;
- /* Whenever Configure defines a constant we can use here. */
-# ifndef _HAVE_LARGEFILESUPPORT_BLAH
- if ((pos = lseek(io->fd, (PIOOFF_T)lo, whence)) >= 0) {
+ if ((pos = lseek(io->fd, offset, whence)) >= 0) {
io->lpos = io->fpos;
io->fpos = pos;
}
-# else
- /* Use llseek, lseek64, etc. from Configure */
-# endif
/* Seek clears EOF */
io->flags &= ~PIO_F_EOF;
return (((INTVAL)pos != -1) ? 0 : -1);
1.26 +8 -8 parrot/io/io_win32.c
Index: io_win32.c
===================================================================
RCS file: /cvs/public/parrot/io/io_win32.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -w -r1.25 -r1.26
--- io_win32.c 31 Jul 2003 18:31:41 -0000 1.25
+++ io_win32.c 9 Aug 2003 07:22:22 -0000 1.26
@@ -1,7 +1,7 @@
/* io_win32.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: io_win32.c,v 1.25 2003/07/31 18:31:41 scog Exp $
+ * $Id: io_win32.c,v 1.26 2003/08/09 07:22:22 leo Exp $
* Overview:
* This is the Parrot IO OS layer for Win32 platforms.
* Data Structure and Algorithms:
@@ -308,18 +308,18 @@
*/
INTVAL
PIO_win32_seek(theINTERP, ParrotIOLayer *l, ParrotIO *io,
- INTVAL hi, INTVAL lo, INTVAL whence)
+ PIOOFF_T off, INTVAL whence)
{
- LARGE_INTEGER p, offset;
- offset.LowPart = lo;
- offset.HighPart = hi;
- p.LowPart = SetFilePointer(io->fd, offset.LowPart,
+ LARGE_INTEGER offset;
+ offset.QuadPart = off;
+ /* offset.HighPart gets overwritten */
+ offset.LowPart = SetFilePointer(io->fd, offset.LowPart,
&offset.HighPart, whence);
- if (p.LowPart == 0xFFFFFFFF && (GetLastError() != NO_ERROR)) {
+ if (offset.LowPart == 0xFFFFFFFF && (GetLastError() != NO_ERROR)) {
/* Error - exception */
return -1;
}
- io->fpos = p.QuadPart;
+ io->fpos = offset.QuadPart;
return 0;
}
1.9 +19 -1 parrot/t/pmc/io.t
Index: io.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/io.t,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- io.t 30 Jul 2003 14:59:57 -0000 1.8
+++ io.t 9 Aug 2003 07:22:23 -0000 1.9
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 18;
+use Parrot::Test tests => 19;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "open/close");
@@ -269,4 +269,22 @@
end
CODE
ok
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', 'seek/tell');
+ open P0, "temp.file", ">"
+ print P0, "Hello "
+ tell I0, P0
+ print P0, "World!"
+ seek P0, I0, 0
+ print P0, "Parrot!\n"
+ close P0
+ print "ok 1\n"
+ open P0, "temp.file", "<"
+ read S0, P0, 65635
+ print S0
+ end
+CODE
+ok 1
+Hello Parrot!
OUTPUT
