The remaining special logic in pp_syswrite can be moved into pp_send,

which is actually already 50% syswrite.

p4raw-id: //depot/perl@25999

diff --git a/mathoms.c b/mathoms.c
index 0f82677..9f37371 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -985,6 +985,11 @@ PP(pp_msgrcv)
     return pp_shmwrite();
 }
 
+PP(pp_syswrite)
+{
+    return pp_send();
+}
+
 U8 *
 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
 {

diff --git a/opcode.h b/opcode.h
index bd53d0c..ca93c09 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -979,7 +979,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        MEMBER_TO_FPTR(Perl_pp_sysopen),
        MEMBER_TO_FPTR(Perl_pp_sysseek),
        MEMBER_TO_FPTR(Perl_pp_sysread),
-       MEMBER_TO_FPTR(Perl_pp_syswrite),
+       MEMBER_TO_FPTR(Perl_pp_send),   /* Perl_pp_syswrite */
        MEMBER_TO_FPTR(Perl_pp_send),
        MEMBER_TO_FPTR(Perl_pp_sysread),        /* Perl_pp_recv */
        MEMBER_TO_FPTR(Perl_pp_eof),

diff --git a/opcode.pl b/opcode.pl
index 5b4cd00..13fd314 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -73,6 +73,7 @@ my @raw_alias = (
                 Perl_pp_ftrread => [qw(ftrwrite ftrexec fteread ftewrite
                                        fteexec)],
                 Perl_pp_shmwrite => [qw(msgsnd msgrcv)],
+                Perl_pp_send => ['syswrite'],
                );
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {

diff --git a/pp_sys.c b/pp_sys.c
index 4f95c9c..b31bc34 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1768,20 +1768,6 @@ PP(pp_sysread)
     RETPUSHUNDEF;
 }
 
-PP(pp_syswrite)
-{
-    dVAR; dSP;
-    const int items = (SP - PL_stack_base) - TOPMARK;
-    if (items == 2) {
-       SV *sv;
-        EXTEND(SP, 1);
-       sv = sv_2mortal(newSViv(sv_len(*SP)));
-       PUSHs(sv);
-        PUTBACK;
-    }
-    return pp_send();
-}
-
 PP(pp_send)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
@@ -1789,20 +1775,28 @@ PP(pp_send)
     IO *io;
     SV *bufsv;
     const char *buffer;
-    Size_t length;
+    Size_t length = 0;
     SSize_t retval;
     STRLEN blen;
     MAGIC *mg;
-
+    const int op_type = PL_op->op_type;
+    
     gv = (GV*)*++MARK;
     if (PL_op->op_type == OP_SYSWRITE
        && gv && (io = GvIO(gv))
        && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
     {
        SV *sv;
+
+       if (MARK == SP - 1) {
+           EXTEND(SP, 1000);
+           sv = sv_2mortal(newSViv(sv_len(*SP)));
+           PUSHs(sv);
+           PUTBACK;
+       }
        
-       PUSHMARK(MARK-1);
-       *MARK = SvTIED_obj((SV*)io, mg);
+       PUSHMARK(ORIGMARK);
+       *(ORIGMARK+1) = SvTIED_obj((SV*)io, mg);
        ENTER;
        call_method("WRITE", G_SCALAR);
        LEAVE;
@@ -1814,14 +1808,22 @@ PP(pp_send)
     }
     if (!gv)
        goto say_undef;
+
     bufsv = *++MARK;
+
+    if (op_type == OP_SYSWRITE) {
+       if (MARK >= SP) {
+           length = (Size_t) sv_len(bufsv);
+       } else {
 #if Size_t_size > IVSIZE
-    length = (Size_t)SvNVx(*++MARK);
+           length = (Size_t)SvNVx(*++MARK);
 #else
-    length = (Size_t)SvIVx(*++MARK);
+           length = (Size_t)SvIVx(*++MARK);
 #endif
-    if ((SSize_t)length < 0)
-       DIE(aTHX_ "Negative length");
+           if ((SSize_t)length < 0)
+               DIE(aTHX_ "Negative length");
+       }
+    }
     SETERRNO(0,0);
     io = GvIO(gv);
     if (!io || !IoIFP(io)) {
@@ -1848,7 +1850,7 @@ PP(pp_send)
         buffer = SvPV_const(bufsv, blen);
     }
 
-    if (PL_op->op_type == OP_SYSWRITE) {
+    if (op_type == OP_SYSWRITE) {
        IV offset;
        if (DO_UTF8(bufsv)) {
            /* length and offset are in chars */
@@ -1887,16 +1889,19 @@ PP(pp_send)
        }
     }
 #ifdef HAS_SOCKET
-    else if (SP > MARK) {
-       STRLEN mlen;
-       char * const sockbuf = SvPVx(*++MARK, mlen);
-       /* length is really flags */
-       retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
-                                length, (struct sockaddr *)sockbuf, mlen);
+    else {
+       const int flags = SvIVx(*++MARK);
+       if (SP > MARK) {
+           STRLEN mlen;
+           char * const sockbuf = SvPVx(*++MARK, mlen);
+           retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+                                    flags, (struct sockaddr *)sockbuf, mlen);
+       }
+       else {
+           retval
+               = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
+       }
     }
-    else
-       /* length is really flags */
-       retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
 #else
     else
        DIE(aTHX_ PL_no_sock_func, "send");