# New Ticket Created by Jürgen Bömmels
# Please include the string: [perl #23252]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=23252 >
Some refactoring in the seek/tell system.
Seek and tell now use both PIOFF_T for the type of the file postion
(No more hi, lo in the API). With wrapper-functions this PIOOFF_T can
be created from one or two INTVALs.
The seek opcode is changed not to return the errorvalue. No
IO-opcode does anything like that. Sometime this will use the
exception mechanism.
The tell opcode is implemented. Two versions are created returning one
or two INTVALS anlog to the seek op.
A test for seek and tell is added to t/pmc/io.t
All tests pass for Linux/i386 and MacOS X (thanks Dan)
Windows is untested but I hope i got the things right.
bye
boe
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/62377/45969/43cb69/io17.diff
Index: io.ops
===================================================================
RCS file: /cvs/public/parrot/io.ops,v
retrieving revision 1.30
diff -u -r1.30 io.ops
--- io.ops 30 Jul 2003 14:59:46 -0000 1.30
+++ io.ops 7 Aug 2003 18:38:18 -0000
@@ -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(out INT, in PMC, in INT, in INT, in INT) {
+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();
+}
+
+=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();
}
Index: include/parrot/io.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/io.h,v
retrieving revision 1.36
diff -u -r1.36 io.h
--- include/parrot/io.h 30 Jul 2003 14:59:51 -0000 1.36
+++ include/parrot/io.h 7 Aug 2003 18:38:18 -0000
@@ -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
Index: io/io.c
===================================================================
RCS file: /cvs/public/parrot/io/io.c,v
retrieving revision 1.49
diff -u -r1.49 io.c
--- io/io.c 30 Jul 2003 14:59:52 -0000 1.49
+++ io/io.c 7 Aug 2003 18:38:18 -0000
@@ -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);
}
/*
Index: io/io_stdio.c
===================================================================
RCS file: /cvs/public/parrot/io/io_stdio.c,v
retrieving revision 1.25
diff -u -r1.25 io_stdio.c
--- io/io_stdio.c 31 Jul 2003 08:30:56 -0000 1.25
+++ io/io_stdio.c 7 Aug 2003 18:38:18 -0000
@@ -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;
}
Index: io/io_unix.c
===================================================================
RCS file: /cvs/public/parrot/io/io_unix.c,v
retrieving revision 1.27
diff -u -r1.27 io_unix.c
--- io/io_unix.c 30 Jul 2003 14:59:52 -0000 1.27
+++ io/io_unix.c 7 Aug 2003 18:38:21 -0000
@@ -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);
Index: io/io_win32.c
===================================================================
RCS file: /cvs/public/parrot/io/io_win32.c,v
retrieving revision 1.25
diff -u -r1.25 io_win32.c
--- io/io_win32.c 31 Jul 2003 18:31:41 -0000 1.25
+++ io/io_win32.c 7 Aug 2003 18:38:22 -0000
@@ -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;
}
Index: t/pmc/io.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/io.t,v
retrieving revision 1.8
diff -u -r1.8 io.t
--- t/pmc/io.t 30 Jul 2003 14:59:57 -0000 1.8
+++ t/pmc/io.t 7 Aug 2003 18:38:22 -0000
@@ -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
