perlio integrations

I integrated now some patches from the perlio branch to the bleadperl.

Change 18616 by jhi@kosh on 2003/02/01 19:43:09

	Integrate from perlio:
	
	[ 18591]
	PERL_IMPLICIT_SYS does NOT vector PerlIO_xxx but PerlSIO_xxx, so
	correct XSUB.h 
	
	[ 18611]
	Michael Schroeder's fix for re-try if stdio ops after 
	interrupts. (Calls to PERL_ASYNC_CHECK added by NI-S).
	
	[ 18612]
	PerlIO friendly version of speed up of $/ = undef case.
	
	[ 18613]
	fflush() before invalidating stdio's fileno.

Affected files ...

... //depot/perl/XSUB.h#70 integrate
... //depot/perl/perlio.c#203 integrate
... //depot/perl/sv.c#620 integrate

Differences ...

==== //depot/perl/XSUB.h#70 (text) ====
Index: perl/XSUB.h
--- perl/XSUB.h.~1~	Sat Feb  1 22:53:57 2003
+++ perl/XSUB.h	Sat Feb  1 22:53:57 2003
@@ -385,32 +385,32 @@
 #    define stdin		PerlSIO_stdin
 #    define stdout		PerlSIO_stdout
 #    define stderr		PerlSIO_stderr
-#    define fopen		PerlIO_open
-#    define fclose		PerlIO_close
-#    define feof		PerlIO_eof
-#    define ferror		PerlIO_error
-#    define fclearerr		PerlIO_clearerr
-#    define getc		PerlIO_getc
-#    define fputc(c, f)		PerlIO_putc(f,c)
-#    define fputs(s, f)		PerlIO_puts(f,s)
-#    define fflush		PerlIO_flush
-#    define ungetc(c, f)	PerlIO_ungetc((f),(c))
-#    define fileno		PerlIO_fileno
-#    define fdopen		PerlIO_fdopen
-#    define freopen		PerlIO_reopen
-#    define fread(b,s,c,f)	PerlIO_read((f),(b),(s*c))
-#    define fwrite(b,s,c,f)	PerlIO_write((f),(b),(s*c))
+#    define fopen		PerlSIO_fopen
+#    define fclose		PerlSIO_fclose
+#    define feof		PerlSIO_feof
+#    define ferror		PerlSIO_ferror
+#    define fclearerr		PerlSIO_clearerr
+#    define getc		PerlSIO_getc
+#    define fputc		PerlSIO_fputc
+#    define fputs		PerlSIO_fputs
+#    define fflush		PerlSIO_fflush
+#    define ungetc		PerlSIO_ungetc
+#    define fileno		PerlSIO_fileno
+#    define fdopen		PerlSIO_fdopen
+#    define freopen		PerlSIO_freopen
+#    define fread		PerlSIO_fread
+#    define fwrite		PerlSIO_fwrite
 #    define setbuf		PerlSIO_setbuf
 #    define setvbuf		PerlSIO_setvbuf
 #    define setlinebuf		PerlSIO_setlinebuf
 #    define stdoutf		PerlSIO_stdoutf
 #    define vfprintf		PerlSIO_vprintf
-#    define ftell		PerlIO_tell
-#    define fseek		PerlIO_seek
-#    define fgetpos		PerlIO_getpos
-#    define fsetpos		PerlIO_setpos
-#    define frewind		PerlIO_rewind
-#    define tmpfile		PerlIO_tmpfile
+#    define ftell		PerlSIO_ftell
+#    define fseek		PerlSIO_fseek
+#    define fgetpos		PerlSIO_fgetpos
+#    define fsetpos		PerlSIO_fsetpos
+#    define frewind		PerlSIO_rewind
+#    define tmpfile		PerlSIO_tmpfile
 #    define access		PerlLIO_access
 #    define chmod		PerlLIO_chmod
 #    define chsize		PerlLIO_chsize

==== //depot/perl/perlio.c#203 (text) ====
Index: perl/perlio.c
--- perl/perlio.c.~1~	Sat Feb  1 22:53:57 2003
+++ perl/perlio.c	Sat Feb  1 22:53:57 2003
@@ -2861,20 +2861,26 @@
 {
     FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
     SSize_t got = 0;
-    if (count == 1) {
-	STDCHAR *buf = (STDCHAR *) vbuf;
-	/*
-	 * Perl is expecting PerlIO_getc() to fill the buffer Linux's
-	 * stdio does not do that for fread()
-	 */
-	int ch = PerlSIO_fgetc(s);
-	if (ch != EOF) {
-	    *buf = ch;
-	    got = 1;
+    for (;;) {
+	if (count == 1) {
+	    STDCHAR *buf = (STDCHAR *) vbuf;
+	    /*
+	     * Perl is expecting PerlIO_getc() to fill the buffer Linux's
+	     * stdio does not do that for fread()
+	     */
+	    int ch = PerlSIO_fgetc(s);
+	    if (ch != EOF) {
+		*buf = ch;
+		got = 1;
+	    }
 	}
+	else
+	    got = PerlSIO_fread(vbuf, 1, count, s);
+	if (got || errno != EINTR)
+	    break;
+	PERL_ASYNC_CHECK();
+	errno = 0;	/* just in case */
     }
-    else
-	got = PerlSIO_fread(vbuf, 1, count, s);
     return got;
 }
 
@@ -2939,8 +2945,16 @@
 SSize_t
 PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    return PerlSIO_fwrite(vbuf, 1, count,
-			  PerlIOSelf(f, PerlIOStdio)->stdio);
+    SSize_t got;
+    for (;;) {
+	got = PerlSIO_fwrite(vbuf, 1, count,
+			      PerlIOSelf(f, PerlIOStdio)->stdio);
+	if (got || errno != EINTR)
+	    break;
+	PERL_ASYNC_CHECK();
+	errno = 0;	/* just in case */
+    }
+    return got;
 }
 
 IV

==== //depot/perl/sv.c#620 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~	Sat Feb  1 22:53:57 2003
+++ perl/sv.c	Sat Feb  1 22:53:57 2003
@@ -6173,10 +6173,18 @@
 	rslen = 1;
     }
     else if (RsSNARF(PL_rs)) {
+    	/* If it is a regular disk file use size from stat() as estimate 
+	   of amount we are going to read - may result in malloc-ing 
+	   more memory than we realy need if layers bellow reduce 
+	   size we read (e.g. CRLF or a gzip layer)
+	 */
 	Stat_t st;
-	if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && st.st_size
-		&& (recsize = st.st_size - PerlIO_tell(fp)))
-	    goto read_record;
+	if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && S_ISREG(st.st_mode))  {
+	    Off_t offset = PerlIO_tell(fp);
+	    if (offset != (Off_t) -1) {
+	     	(void) SvGROW(sv, (STRLEN)((st.st_size - offset) + append + 1));
+	    }
+	}
 	rsptr = NULL;
 	rslen = 0;
     }
@@ -6186,14 +6194,14 @@
 
       /* Grab the size of the record we're getting */
       recsize = SvIV(SvRV(PL_rs));
-
-    read_record:
       buffer = SvGROW(sv, (STRLEN)(recsize + append + 1)) + append;
       /* Go yank in */
 #ifdef VMS
       /* VMS wants read instead of fread, because fread doesn't respect */
       /* RMS record boundaries. This is not necessarily a good thing to be */
-      /* doing, but we've got no other real choice */
+      /* doing, but we've got no other real choice - except avoid stdio
+         as implementation - perhaps write a :vms layer ?
+       */
       bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize);
 #else
       bytesread = PerlIO_read(fp, buffer, recsize);
@@ -6269,8 +6277,13 @@
     /* Here is some breathtakingly efficient cheating */
 
     cnt = PerlIO_get_cnt(fp);			/* get count into register */
-    if ((I32)(SvLEN(sv) - append) <= cnt + 1) { /* make sure we have the room */
-	if (cnt > 80 && (I32)SvLEN(sv) > append) {
+    /* make sure we have the room */
+    if ((I32)(SvLEN(sv) - append) <= cnt + 1) { 
+    	/* Not room for all of it
+	   if we are looking for a separator and room for some 
+	 */
+	if (rslen && cnt > 80 && (I32)SvLEN(sv) > append) {
+	    /* just process what we have room for */ 
 	    shortbuffered = cnt - SvLEN(sv) + append + 1;
 	    cnt -= shortbuffered;
 	}
@@ -6280,7 +6293,7 @@
 	    SvGROW(sv, (STRLEN)(append + (cnt <= 0 ? 2 : (cnt + 1))));
 	}
     }
-    else
+    else 
 	shortbuffered = 0;
     bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
     ptr = (STDCHAR*)PerlIO_get_ptr(fp);
End of Patch.


-- 
Jarkko Hietaniemi <jhi@iki.fi> http://www.iki.fi/jhi/ "There is this special
biologist word we use for 'stable'.  It is 'dead'." -- Jack Cohen

• perlio integrations by Jarkko Hietaniemi