summaryrefslogtreecommitdiff
path: root/perlio.c
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2000-10-29 20:05:29 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>2000-10-29 20:05:29 +0000
commitb1ef6e3bd726972447a8b536231f096656903bb3 (patch)
treea3fcd060c38e7214e491c0d2ce916405151937ba /perlio.c
parent02f66e2f9235025f08502389e56df70aa71733c0 (diff)
downloadperl-b1ef6e3bd726972447a8b536231f096656903bb3.tar.gz
PerlIO passes all tests.
p4raw-id: //depot/perlio@7484
Diffstat (limited to 'perlio.c')
-rw-r--r--perlio.c50
1 files changed, 24 insertions, 26 deletions
diff --git a/perlio.c b/perlio.c
index 6224b767fd..cf93f9951d 100644
--- a/perlio.c
+++ b/perlio.c
@@ -90,6 +90,7 @@ PerlIO_init(void)
/* Implement all the PerlIO interface ourselves.
*/
+/* We _MUST_ have <unistd.h> if we are using lseek() and may have large files */
#ifdef I_UNISTD
#include <unistd.h>
#endif
@@ -97,7 +98,6 @@ PerlIO_init(void)
#undef printf
void PerlIO_debug(char *fmt,...) __attribute__((format(printf,1,2)));
-
void
PerlIO_debug(char *fmt,...)
{
@@ -137,7 +137,7 @@ PerlIO_debug(char *fmt,...)
struct _PerlIO
{
- IV flags;
+ IV flags; /* Various flags for state */
IV fd; /* Maybe pointer on some OSes */
int oflags; /* open/fcntl flags */
STDCHAR *buf; /* Start of buffer */
@@ -145,11 +145,12 @@ struct _PerlIO
STDCHAR *ptr; /* Current position in buffer */
Size_t bufsiz; /* Size of buffer */
Off_t posn; /* Offset of f->buf into the file */
- int oneword;
+ int oneword; /* An if-all-else-fails area as a buffer */
};
-int _perlio_size = 0;
+/* Table of pointers to the PerlIO structs (malloc'ed) */
PerlIO **_perlio = NULL;
+int _perlio_size = 0;
void
PerlIO_alloc_buf(PerlIO *f)
@@ -164,10 +165,12 @@ PerlIO_alloc_buf(PerlIO *f)
}
f->ptr = f->buf;
f->end = f->ptr;
- PerlIO_debug(__FUNCTION__ " f=%p b=%p p=%p e=%p\n",
- f,f->buf,f->ptr,f->end);
}
+
+/* This "flush" is akin to sfio's sync in that it handles files in either
+ read or write state
+*/
#undef PerlIO_flush
int
PerlIO_flush(PerlIO *f)
@@ -179,6 +182,7 @@ PerlIO_flush(PerlIO *f)
f,f->flags,(f->ptr-f->buf),f->buf,f->ptr);
if (f->flags & PERLIO_F_WRBUF)
{
+ /* write() the buffer */
STDCHAR *p = f->buf;
int count;
while (p < f->ptr)
@@ -196,20 +200,16 @@ PerlIO_flush(PerlIO *f)
}
}
f->posn += (p - f->buf);
- PerlIO_debug(__FUNCTION__ "(w) f=%p p=%ld\n",f,(long)f->posn);
}
else if (f->flags & PERLIO_F_RDBUF)
{
+ /* Note position change */
f->posn += (f->ptr - f->buf);
if (f->ptr < f->end)
{
+ /* We did not consume all of it */
f->posn = lseek(f->fd,f->posn,SEEK_SET);
}
- PerlIO_debug(__FUNCTION__ "(r+) f=%p p=%ld\n",f,(long)f->posn);
- }
- else
- {
- PerlIO_debug(__FUNCTION__ "(?) f=%p p=%ld\n",f,(long)f->posn);
}
f->ptr = f->end = f->buf;
f->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
@@ -279,6 +279,7 @@ PerlIO_oflags(const char *mode)
PerlIO *
PerlIO_allocate(void)
{
+ /* Find a free slot in the table, growing table as necessary */
PerlIO *f;
int i = 0;
while (1)
@@ -376,6 +377,7 @@ PerlIO_close(PerlIO *f)
void
PerlIO_cleanup(void)
{
+ /* Close all the files */
int i;
PerlIO_debug(__FUNCTION__ "\n");
for (i=_perlio_size-1; i >= 0; i--)
@@ -536,15 +538,14 @@ PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
{
if (f)
{
- dTHX;
if (!f->buf)
PerlIO_alloc_buf(f);
f->ptr = ptr;
- assert(f->ptr >= f->buf);
- if (PerlIO_get_cnt(f) != cnt)
+ if (PerlIO_get_cnt(f) != cnt || f->ptr < f->buf)
{
dTHX;
- assert(PerlIO_get_cnt(f) != cnt);
+ assert(PerlIO_get_cnt(f) == cnt);
+ assert(f->ptr >= f->buf);
}
f->flags |= PERLIO_F_RDBUF;
}
@@ -624,13 +625,9 @@ PerlIO_eof(PerlIO *f)
char *
PerlIO_getname(PerlIO *f, char *buf)
{
-#ifdef VMS
- return fgetname(f,buf);
-#else
dTHX;
Perl_croak(aTHX_ "Don't know how to get file name");
return NULL;
-#endif
}
#undef PerlIO_ungetc
@@ -640,7 +637,6 @@ PerlIO_ungetc(PerlIO *f, int ch)
if (f->buf && (f->flags & PERLIO_F_RDBUF) && f->ptr > f->buf)
{
*--(f->ptr) = ch;
- PerlIO_debug(__FUNCTION__ " f=%p c=%c\n",f,ch);
return ch;
}
PerlIO_debug(__FUNCTION__ " f=%p c=%c - cannot\n",f,ch);
@@ -702,7 +698,7 @@ PerlIO_getc(PerlIO *f)
STDCHAR buf;
int count = PerlIO_read(f,&buf,1);
if (count == 1)
- return buf;
+ return (unsigned char) buf;
return -1;
}
@@ -754,7 +750,7 @@ PerlIO_write(PerlIO *f, const void *vbuf, Size_t count)
if ((SSize_t) count < avail)
avail = count;
f->flags |= PERLIO_F_WRBUF;
- if (1 || (f->flags & PERLIO_F_LINEBUF))
+ if (f->flags & PERLIO_F_LINEBUF)
{
while (avail > 0)
{
@@ -803,8 +799,7 @@ PerlIO_tell(PerlIO *f)
Off_t posn = f->posn;
if (f->buf)
posn += (f->ptr - f->buf);
- PerlIO_debug(__FUNCTION__ " f=%p r=%ld b=%p p=%p e=%ld\n",
- f,(long)f->posn,f->buf,f->ptr,(long)posn);
+ PerlIO_debug(__FUNCTION__ " f=%p b=%ld a=%ld\n",f,(long)f->posn,(long)posn);
return posn;
}
@@ -879,12 +874,13 @@ PerlIO *
PerlIO_tmpfile(void)
{
dTHX;
+ /* I have no idea how portable mkstemp() is ... */
SV *sv = newSVpv("/tmp/PerlIO_XXXXXX",0);
int fd = mkstemp(SvPVX(sv));
PerlIO *f = NULL;
if (fd >= 0)
{
- PerlIO *f = PerlIO_fdopen(fd,"w+");
+ f = PerlIO_fdopen(fd,"w+");
if (f)
{
f->flags |= PERLIO_F_TEMP;
@@ -900,6 +896,7 @@ PerlIO *
PerlIO_importFILE(FILE *f, int fl)
{
int fd = fileno(f);
+ /* Should really push stdio discipline when we have them */
return PerlIO_fdopen(fd,"r+");
}
@@ -908,6 +905,7 @@ FILE *
PerlIO_exportFILE(PerlIO *f, int fl)
{
PerlIO_flush(f);
+ /* Should really push stdio discipline when we have them */
return fdopen(PerlIO_fileno(f),"r+");
}