Upgrade to Encode 2.08.

[p5sagit/p5-mst-13.2.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index d6f095b..3071f1b 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,7 +1,7 @@
 /*    pp_sys.c
  *
  *    Copyright (C) 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -15,6 +15,15 @@
  * a rumour and a trouble as of great engines throbbing and labouring.
  */
 
+/* This file contains system pp ("push/pop") functions that
+ * execute the opcodes that make up a perl program. A typical pp function
+ * expects to find its arguments on the stack, and usually pushes its
+ * results onto the stack, hence the 'pp' terminology. Each OP structure
+ * contains a pointer to the relevant pp_foo() function.
+ *
+ * By 'system', we mean ops which interact with the OS, such as pp_open().
+ */
+
 #include "EXTERN.h"
 #define PERL_IN_PP_SYS_C
 #include "perl.h"
@@ -1247,9 +1256,9 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
     ENTER;
     SAVETMPS;
 
-    push_return(retop);
     PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
     PUSHFORMAT(cx);
+    cx->blk_sub.retop = retop;
     PAD_SET_CUR(CvPADLIST(cv), 1);
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
@@ -1425,7 +1434,7 @@ PP(pp_leavewrite)
     /* bad_ofp: */
     PL_formtarget = PL_bodytarget;
     PUTBACK;
-    return pop_return();
+    return cx->blk_sub.retop;
 }
 
 PP(pp_prtf)
@@ -1656,7 +1665,10 @@ PP(pp_sysread)
     }
     if (DO_UTF8(bufsv)) {
        /* convert offset-as-chars to offset-as-bytes */
-       offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
+       if (offset >= (int)blen)
+           offset += SvCUR(bufsv) - blen;
+       else
+           offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
     }
  more_bytes:
     bufsize = SvCUR(bufsv);
@@ -1820,7 +1832,11 @@ PP(pp_send)
     }
 
     if (PerlIO_isutf8(IoIFP(io))) {
-       buffer = SvPVutf8(bufsv, blen);
+       if (!SvUTF8(bufsv)) {
+           bufsv = sv_2mortal(newSVsv(bufsv));
+           buffer = sv_2pvutf8(bufsv, &blen);
+       } else
+           buffer = SvPV(bufsv, blen);
     }
     else {
         if (DO_UTF8(bufsv)) {