Integrate perlio:

[ 13926]
Nicholas Clark's embed.pl fix for my_socketpair

[ 13923]
Quick fix (after couple of clever fixes failed) for
"accept leaks memory" fail [ID 20011223.001]

p4raw-link: @13926 on //depot/perlio: 706e3e0fa48b7eca83a252c56ee7190a42ea58bd
p4raw-link: @13923 on //depot/perlio: 72f496dcd0fc92435ef5c603c8a681183058a7bc

p4raw-id: //depot/perl@13927

6 files changed, 103 insertions, 27 deletions

diff --git a/embed.h b/embed.h
index b75a8abaa8..560752de2c 100644
--- a/embed.h
+++ b/embed.h
@@ -1230,6 +1230,30 @@
 #define PerlIO_stdout		Perl_PerlIO_stdout
 #define PerlIO_stderr		Perl_PerlIO_stderr
 #endif /* PERLIO_LAYERS */
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+#define PerlIO_close		Perl_PerlIO_close
+#define PerlIO_fill		Perl_PerlIO_fill
+#define PerlIO_fileno		Perl_PerlIO_fileno
+#define PerlIO_eof		Perl_PerlIO_eof
+#define PerlIO_error		Perl_PerlIO_error
+#define PerlIO_flush		Perl_PerlIO_flush
+#define PerlIO_clearerr		Perl_PerlIO_clearerr
+#define PerlIO_set_cnt		Perl_PerlIO_set_cnt
+#define PerlIO_set_ptrcnt	Perl_PerlIO_set_ptrcnt
+#define PerlIO_setlinebuf	Perl_PerlIO_setlinebuf
+#define PerlIO_read		Perl_PerlIO_read
+#define PerlIO_write		Perl_PerlIO_write
+#define PerlIO_unread		Perl_PerlIO_unread
+#define PerlIO_tell		Perl_PerlIO_tell
+#define PerlIO_seek		Perl_PerlIO_seek
+#define PerlIO_get_base		Perl_PerlIO_get_base
+#define PerlIO_get_ptr		Perl_PerlIO_get_ptr
+#define PerlIO_get_bufsiz	Perl_PerlIO_get_bufsiz
+#define PerlIO_get_cnt		Perl_PerlIO_get_cnt
+#define PerlIO_stdin		Perl_PerlIO_stdin
+#define PerlIO_stdout		Perl_PerlIO_stdout
+#define PerlIO_stderr		Perl_PerlIO_stderr
+#endif /* PERLIO_LAYERS */
 #define ck_anoncode		Perl_ck_anoncode
 #define ck_bitop		Perl_ck_bitop
 #define ck_concat		Perl_ck_concat
@@ -2745,7 +2769,7 @@
 #define sv_2pv_flags(a,b,c)	Perl_sv_2pv_flags(aTHX_ a,b,c)
 #define my_atof2(a,b)		Perl_my_atof2(aTHX_ a,b)
 #if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET)
-#define my_socketpair(a,b,c,d)	Perl_my_socketpair(aTHX_ a,b,c,d)
+#define my_socketpair		Perl_my_socketpair
 #endif
 #if defined(USE_PERLIO) && !defined(USE_SFIO)
 #define PerlIO_close(a)		Perl_PerlIO_close(aTHX_ a)
@@ -2771,6 +2795,30 @@
 #define PerlIO_stdout()		Perl_PerlIO_stdout(aTHX)
 #define PerlIO_stderr()		Perl_PerlIO_stderr(aTHX)
 #endif /* PERLIO_LAYERS */
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+#define PerlIO_close(a)		Perl_PerlIO_close(aTHX_ a)
+#define PerlIO_fill(a)		Perl_PerlIO_fill(aTHX_ a)
+#define PerlIO_fileno(a)	Perl_PerlIO_fileno(aTHX_ a)
+#define PerlIO_eof(a)		Perl_PerlIO_eof(aTHX_ a)
+#define PerlIO_error(a)		Perl_PerlIO_error(aTHX_ a)
+#define PerlIO_flush(a)		Perl_PerlIO_flush(aTHX_ a)
+#define PerlIO_clearerr(a)	Perl_PerlIO_clearerr(aTHX_ a)
+#define PerlIO_set_cnt(a,b)	Perl_PerlIO_set_cnt(aTHX_ a,b)
+#define PerlIO_set_ptrcnt(a,b,c)	Perl_PerlIO_set_ptrcnt(aTHX_ a,b,c)
+#define PerlIO_setlinebuf(a)	Perl_PerlIO_setlinebuf(aTHX_ a)
+#define PerlIO_read(a,b,c)	Perl_PerlIO_read(aTHX_ a,b,c)
+#define PerlIO_write(a,b,c)	Perl_PerlIO_write(aTHX_ a,b,c)
+#define PerlIO_unread(a,b,c)	Perl_PerlIO_unread(aTHX_ a,b,c)
+#define PerlIO_tell(a)		Perl_PerlIO_tell(aTHX_ a)
+#define PerlIO_seek(a,b,c)	Perl_PerlIO_seek(aTHX_ a,b,c)
+#define PerlIO_get_base(a)	Perl_PerlIO_get_base(aTHX_ a)
+#define PerlIO_get_ptr(a)	Perl_PerlIO_get_ptr(aTHX_ a)
+#define PerlIO_get_bufsiz(a)	Perl_PerlIO_get_bufsiz(aTHX_ a)
+#define PerlIO_get_cnt(a)	Perl_PerlIO_get_cnt(aTHX_ a)
+#define PerlIO_stdin()		Perl_PerlIO_stdin(aTHX)
+#define PerlIO_stdout()		Perl_PerlIO_stdout(aTHX)
+#define PerlIO_stderr()		Perl_PerlIO_stderr(aTHX)
+#endif /* PERLIO_LAYERS */
 #define ck_anoncode(a)		Perl_ck_anoncode(aTHX_ a)
 #define ck_bitop(a)		Perl_ck_bitop(aTHX_ a)
 #define ck_concat(a)		Perl_ck_concat(aTHX_ a)
diff --git a/embed.pl b/embed.pl
index 515fa11ca4..32e7925b63 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2354,7 +2354,7 @@ Apd	|char*	|sv_pvn_force_flags|SV* sv|STRLEN* lp|I32 flags
 Apd	|char*	|sv_2pv_flags	|SV* sv|STRLEN* lp|I32 flags
 Ap	|char*	|my_atof2	|const char *s|NV* value
 #if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET)
-Ap	|int	|my_socketpair	|int family|int type|int protocol|int fd[2]
+Apn	|int	|my_socketpair	|int family|int type|int protocol|int fd[2]
 #endif
 
 
diff --git a/global.sym b/global.sym
index 4710ebb225..fc51928cc5 100644
--- a/global.sym
+++ b/global.sym
@@ -627,3 +627,25 @@ Perl_PerlIO_get_cnt
 Perl_PerlIO_stdin
 Perl_PerlIO_stdout
 Perl_PerlIO_stderr
+Perl_PerlIO_close
+Perl_PerlIO_fill
+Perl_PerlIO_fileno
+Perl_PerlIO_eof
+Perl_PerlIO_error
+Perl_PerlIO_flush
+Perl_PerlIO_clearerr
+Perl_PerlIO_set_cnt
+Perl_PerlIO_set_ptrcnt
+Perl_PerlIO_setlinebuf
+Perl_PerlIO_read
+Perl_PerlIO_write
+Perl_PerlIO_unread
+Perl_PerlIO_tell
+Perl_PerlIO_seek
+Perl_PerlIO_get_base
+Perl_PerlIO_get_ptr
+Perl_PerlIO_get_bufsiz
+Perl_PerlIO_get_cnt
+Perl_PerlIO_stdin
+Perl_PerlIO_stdout
+Perl_PerlIO_stderr
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index ee5d65abeb..6f8ccc1922 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -1440,6 +1440,17 @@ SV is B<not> incremented.
 =for hackers
 Found in file sv.c
 
+=item newSV
+
+Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
+with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
+macro.
+
+	SV*	newSV(STRLEN len)
+
+=for hackers
+Found in file sv.c
+
 =item NEWSV
 
 Creates a new SV.  A non-zero C<len> parameter indicates the number of
@@ -1453,17 +1464,6 @@ C<id> is an integer id between 0 and 1299 (used to identify leaks).
 =for hackers
 Found in file handy.h
 
-=item newSV
-
-Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
-with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
-macro.
-
-	SV*	newSV(STRLEN len)
-
-=for hackers
-Found in file sv.c
-
 =item newSViv
 
 Creates a new SV and copies an integer into it.  The reference count for the
@@ -3016,22 +3016,22 @@ for a version which guarantees to evaluate sv only once.
 =for hackers
 Found in file sv.h
 
-=item SvUVx
+=item SvUVX
 
-Coerces the given SV to an unsigned integer and returns it. Guarantees to
-evaluate sv only once. Use the more efficient C<SvUV> otherwise.
+Returns the raw value in the SV's UV slot, without checks or conversions.
+Only use when you are sure SvIOK is true. See also C<SvUV()>.
 
-	UV	SvUVx(SV* sv)
+	UV	SvUVX(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvUVX
+=item SvUVx
 
-Returns the raw value in the SV's UV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvUV()>.
+Coerces the given SV to an unsigned integer and returns it. Guarantees to
+evaluate sv only once. Use the more efficient C<SvUV> otherwise.
 
-	UV	SvUVX(SV* sv)
+	UV	SvUVx(SV* sv)
 
 =for hackers
 Found in file sv.h
diff --git a/pp_sys.c b/pp_sys.c
index a8a60bb77a..b14ab9caf8 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2066,7 +2066,7 @@ PP(pp_truncate)
 	else {
 	    SV *sv = POPs;
 	    char *name;
-	  
+	
 	    if (SvTYPE(sv) == SVt_PVGV) {
 	        tmpgv = (GV*)sv;		/* *main::FRED for example */
 		goto do_ftruncate;
@@ -2469,6 +2469,7 @@ PP(pp_accept)
     struct sockaddr saddr;	/* use a struct to avoid alignment problems */
     Sock_size_t len = sizeof saddr;
     int fd;
+    int fd2;
 
     ggv = (GV*)POPs;
     ngv = (GV*)POPs;
@@ -2489,7 +2490,11 @@ PP(pp_accept)
     if (IoIFP(nstio))
 	do_close(ngv, FALSE);
     IoIFP(nstio) = PerlIO_fdopen(fd, "r");
-    IoOFP(nstio) = PerlIO_fdopen(fd, "w");
+    /* FIXME: we dup(fd) here so that refcounting of fd's does not inhibit
+       fclose of IoOFP's FILE * - and hence leak memory.
+       Special treatment of _this_ case of IoIFP != IoOFP seems wrong.
+     */
+    IoOFP(nstio) = PerlIO_fdopen(fd2 = PerlLIO_dup(fd), "w");
     IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
 	if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
@@ -2499,6 +2504,7 @@ PP(pp_accept)
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(fd, F_SETFD, fd > PL_maxsysfd);	/* ensure close-on-exec */
+    fcntl(fd2, F_SETFD, fd2 > PL_maxsysfd);	/* ensure close-on-exec */
 #endif
 
 #ifdef EPOC
@@ -3410,7 +3416,7 @@ PP(pp_chdir)
                 deprecate("chdir('') or chdir(undef) as chdir()");
             tmps = SvPV(*svp, n_a);
         }
-        else {            
+        else {
             PUSHi(0);
             TAINT_PROPER("chdir");
             RETURN;
@@ -4029,7 +4035,7 @@ PP(pp_system)
 	 Pid_t childpid;
 	 int status;
 	 Sigsave_t ihand,qhand;     /* place to save signals during system() */
-	 
+	
 	 if (PL_tainting) {
 	     SV *cmd = NULL;
 	     if (PL_op->op_flags & OPf_STACKED)
@@ -4075,7 +4081,7 @@ PP(pp_system)
 	      if (did_pipes) {
 		   int errkid;
 		   int n = 0, n1;
-		   
+		
 		   while (n < sizeof(int)) {
 			n1 = PerlLIO_read(pp[0],
 					  (void*)(((char*)&errkid)+n),
diff --git a/proto.h b/proto.h
index fee2f9f2e3..9ef7a7ac3c 100644
--- a/proto.h
+++ b/proto.h
@@ -1332,7 +1332,7 @@ PERL_CALLCONV char*	Perl_sv_pvn_force_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags)
 PERL_CALLCONV char*	Perl_sv_2pv_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags);
 PERL_CALLCONV char*	Perl_my_atof2(pTHX_ const char *s, NV* value);
 #if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET)
-PERL_CALLCONV int	Perl_my_socketpair(pTHX_ int family, int type, int protocol, int fd[2]);
+PERL_CALLCONV int	Perl_my_socketpair(int family, int type, int protocol, int fd[2]);
 #endif