1			/*    doop.c
     2			 *
     3			 *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
     4			 *    2000, 2001, 2002, 2004, 2005, by Larry Wall and others
     5			 *
     6			 *    You may distribute under the terms of either the GNU General Public
     7			 *    License or the Artistic License, as specified in the README file.
     8			 *
     9			 */
    10			
    11			/*
    12			 * "'So that was the job I felt I had to do when I started,' thought Sam."
    13			 */
    14			
    15			/* This file contains some common functions needed to carry out certain
    16			 * ops. For example both pp_schomp() and pp_chomp() - scalar and array
    17			 * chomp operations - call the function do_chomp() found in this file.
    18			 */
    19			
    20			#include "EXTERN.h"
    21			#define PERL_IN_DOOP_C
    22			#include "perl.h"
    23			
    24			#ifndef PERL_MICRO
    25			#include <signal.h>
    26			#endif
    27			
    28			STATIC I32
    29			S_do_trans_simple(pTHX_ SV *sv)
    30	       29541    {
    31	       29541        U8 *s;
    32	       29541        U8 *d;
    33	       29541        const U8 *send;
    34	       29541        U8 *dstart;
    35	       29541        I32 matches = 0;
    36	       29541        const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
    37	       29541        STRLEN len;
    38			
    39	       29541        const short *tbl = (short*)cPVOP->op_pv;
    40	       29541        if (!tbl)
    41	      ######    	Perl_croak(aTHX_ "panic: do_trans_simple line %d",__LINE__);
    42			
    43	       29541        s = (U8*)SvPV(sv, len);
    44	       29541        send = s + len;
    45			
    46			    /* First, take care of non-UTF-8 input strings, because they're easy */
    47	       29541        if (!SvUTF8(sv)) {
    48	      497445    	while (s < send) {
    49	      467915    	    const I32 ch = tbl[*s];
    50	      467915    	    if (ch >= 0) {
    51	      406909    		matches++;
    52	      406909    		*s++ = (U8)ch;
    53				    }
    54				    else
    55	       61006    		s++;
    56				}
    57	       29530    	SvSETMAGIC(sv);
    58	       29530            return matches;
    59			    }
    60			
    61			    /* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */
    62	          11        if (grows)
    63	      ######    	New(0, d, len*2+1, U8);
    64			    else
    65	          11    	d = s;
    66	          11        dstart = d;
    67	          61        while (s < send) {
    68	          50            STRLEN ulen;
    69	          50    	I32 ch;
    70			
    71			        /* Need to check this, otherwise 128..255 won't match */
    72	          50    	const UV c = utf8n_to_uvchr(s, send - s, &ulen, 0);
    73	          50            if (c < 0x100 && (ch = tbl[c]) >= 0) {
    74	          11                matches++;
    75	          11    	    d = uvchr_to_utf8(d, ch);
    76	          11                s += ulen;
    77			        }
    78				else { /* No match -> copy */
    79	          39    	    Move(s, d, ulen, U8);
    80	          39    	    d += ulen;
    81	          39    	    s += ulen;
    82			        }
    83			    }
    84	          11        if (grows) {
    85	      ######    	sv_setpvn(sv, (char*)dstart, d - dstart);
    86	      ######    	Safefree(dstart);
    87			    }
    88			    else {
    89	          11    	*d = '\0';
    90	          11    	SvCUR_set(sv, d - dstart);
    91			    }
    92	          11        SvUTF8_on(sv);
    93	          11        SvSETMAGIC(sv);
    94	          11        return matches;
    95			}
    96			
    97			STATIC I32
    98			S_do_trans_count(pTHX_ SV *sv)
    99	       11608    {
   100	       11608        const U8 *s;
   101	       11608        const U8 *send;
   102	       11608        I32 matches = 0;
   103	       11608        STRLEN len;
   104	       11608        const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
   105			
   106	       11608        const short * const tbl = (short*)cPVOP->op_pv;
   107	       11608        if (!tbl)
   108	      ######    	Perl_croak(aTHX_ "panic: do_trans_count line %d",__LINE__);
   109			
   110	       11608        s = (const U8*)SvPV_const(sv, len);
   111	       11608        send = s + len;
   112			
   113	       11608        if (!SvUTF8(sv))
   114	      506907    	while (s < send) {
   115	      495327                if (tbl[*s++] >= 0)
   116	       54025                    matches++;
   117				}
   118			    else
   119	         132    	while (s < send) {
   120	         104    	    STRLEN ulen;
   121	         104    	    const UV c = utf8n_to_uvchr(s, send - s, &ulen, 0);
   122	         104    	    if (c < 0x100) {
   123	          52    		if (tbl[c] >= 0)
   124	           2    		    matches++;
   125	          52    	    } else if (complement)
   126	          46    		matches++;
   127	         104    	    s += ulen;
   128				}
   129			
   130	       11608        return matches;
   131			}
   132			
   133			STATIC I32
   134			S_do_trans_complex(pTHX_ SV *sv)
   135	       29746    {
   136	       29746        U8 *s;
   137	       29746        U8 *send;
   138	       29746        U8 *d;
   139	       29746        U8 *dstart;
   140	       29746        I32 isutf8;
   141	       29746        I32 matches = 0;
   142	       29746        const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
   143	       29746        const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
   144	       29746        const I32 del = PL_op->op_private & OPpTRANS_DELETE;
   145	       29746        STRLEN len, rlen = 0;
   146			
   147	       29746        const short * const tbl = (short*)cPVOP->op_pv;
   148	       29746        if (!tbl)
   149	      ######    	Perl_croak(aTHX_ "panic: do_trans_complex line %d",__LINE__);
   150			
   151	       29746        s = (U8*)SvPV(sv, len);
   152	       29746        isutf8 = SvUTF8(sv);
   153	       29746        send = s + len;
   154			
   155	       29746        if (!isutf8) {
   156	       29740    	dstart = d = s;
   157	       29740    	if (PL_op->op_private & OPpTRANS_SQUASH) {
   158	         915    	    const U8* p = send;
   159	       11047    	    while (s < send) {
   160	       10132    		const I32 ch = tbl[*s];
   161	       10132    		if (ch >= 0) {
   162	         957    		    *d = (U8)ch;
   163	         957    		    matches++;
   164	         957    		    if (p != d - 1 || *p != *d)
   165	         609    			p = d++;
   166					}
   167	        9175    		else if (ch == -1)	/* -1 is unmapped character */
   168	        9175    		    *d++ = *s;	
   169	      ######    		else if (ch == -2)	/* -2 is delete character */
   170	      ######    		    matches++;
   171	       10132    		s++;
   172				    }
   173				}
   174				else {
   175	      912889    	    while (s < send) {
   176	      884064    		const I32 ch = tbl[*s];
   177	      884064    		if (ch >= 0) {
   178	      ######    		    matches++;
   179	      ######    		    *d++ = (U8)ch;
   180					}
   181	      884064    		else if (ch == -1)	/* -1 is unmapped character */
   182	      855953    		    *d++ = *s;
   183	       28111    		else if (ch == -2)      /* -2 is delete character */
   184	       28111    		    matches++;
   185	      884064    		s++;
   186				    }
   187				}
   188	       29740    	*d = '\0';
   189	       29740    	SvCUR_set(sv, d - dstart);
   190			    }
   191			    else { /* isutf8 */
   192	           6    	if (grows)
   193	      ######    	    New(0, d, len*2+1, U8);
   194				else
   195	           6    	    d = s;
   196	           6    	dstart = d;
   197	           6    	if (complement && !del)
   198	           4    	    rlen = tbl[0x100];
   199			
   200			#ifdef MACOS_TRADITIONAL
   201			#define comp CoMP   /* "comp" is a keyword in some compilers ... */
   202			#endif
   203			
   204	           6    	if (PL_op->op_private & OPpTRANS_SQUASH) {
   205	           2    	    UV pch = 0xfeedface;
   206	          10    	    while (s < send) {
   207	           8    		STRLEN len;
   208	           8    		const UV comp = utf8_to_uvchr(s, &len);
   209	           8    		I32 ch;
   210			
   211	           8    		if (comp > 0xff) {
   212	           3    		    if (!complement) {
   213	           2    			Copy(s, d, len, U8);
   214	           2    			d += len;
   215					    }
   216					    else {
   217	           1    			matches++;
   218	           1    			if (!del) {
   219	           1    			    ch = (rlen == 0) ? comp :
   220							(comp - 0x100 < rlen) ?
   221							tbl[comp+1] : tbl[0x100+rlen];
   222	           1    			    if ((UV)ch != pch) {
   223	           1    				d = uvchr_to_utf8(d, ch);
   224	           1    				pch = (UV)ch;
   225						    }
   226	           1    			    s += len;
   227	           1    			    continue;
   228						}
   229					    }
   230					}
   231	           5    		else if ((ch = tbl[comp]) >= 0) {
   232	           3    		    matches++;
   233	           3    		    if ((UV)ch != pch) {
   234	           2    		        d = uvchr_to_utf8(d, ch);
   235	           2    		        pch = (UV)ch;
   236					    }
   237	           3    		    s += len;
   238	           3    		    continue;
   239					}
   240	           2    		else if (ch == -1) {	/* -1 is unmapped character */
   241	           2    		    Copy(s, d, len, U8);
   242	           2    		    d += len;
   243					}
   244	      ######    		else if (ch == -2)      /* -2 is delete character */
   245	      ######    		    matches++;
   246	           4    		s += len;
   247	           4    		pch = 0xfeedface;
   248				    }
   249				}
   250				else {
   251	          15    	    while (s < send) {
   252	          11    		STRLEN len;
   253	          11    		const UV comp = utf8_to_uvchr(s, &len);
   254	          11    		I32 ch;
   255	          11    		if (comp > 0xff) {
   256	           7    		    if (!complement) {
   257	           2    			Move(s, d, len, U8);
   258	           2    			d += len;
   259					    }
   260					    else {
   261	           5    			matches++;
   262	           5    			if (!del) {
   263	           5    			    if (comp - 0x100 < rlen)
   264	           5    				d = uvchr_to_utf8(d, tbl[comp+1]);
   265						    else
   266	      ######    				d = uvchr_to_utf8(d, tbl[0x100+rlen]);
   267						}
   268					    }
   269					}
   270	           4    		else if ((ch = tbl[comp]) >= 0) {
   271	      ######    		    d = uvchr_to_utf8(d, ch);
   272	      ######    		    matches++;
   273					}
   274	           4    		else if (ch == -1) {	/* -1 is unmapped character */
   275	           2    		    Copy(s, d, len, U8);
   276	           2    		    d += len;
   277					}
   278	           2    		else if (ch == -2)      /* -2 is delete character */
   279	           2    		    matches++;
   280	          11    		s += len;
   281				    }
   282				}
   283	           6    	if (grows) {
   284	      ######    	    sv_setpvn(sv, (char*)dstart, d - dstart);
   285	      ######    	    Safefree(dstart);
   286				}
   287				else {
   288	           6    	    *d = '\0';
   289	           6    	    SvCUR_set(sv, d - dstart);
   290				}
   291	           6    	SvUTF8_on(sv);
   292			    }
   293	       29746        SvSETMAGIC(sv);
   294	       29746        return matches;
   295			}
   296			
   297			STATIC I32
   298			S_do_trans_simple_utf8(pTHX_ SV *sv)
   299	          35    {
   300	          35        U8 *s;
   301	          35        U8 *send;
   302	          35        U8 *d;
   303	          35        U8 *start;
   304	          35        U8 *dstart, *dend;
   305	          35        I32 matches = 0;
   306	          35        const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
   307	          35        STRLEN len;
   308			
   309	          35        SV* const  rv = (SV*)cSVOP->op_sv;
   310	          35        HV* const  hv = (HV*)SvRV(rv);
   311	          35        SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
   312	          35        const UV none = svp ? SvUV(*svp) : 0x7fffffff;
   313	          35        const UV extra = none + 1;
   314	          35        UV final = 0;
   315	          35        UV uv;
   316	          35        I32 isutf8;
   317	          35        U8 hibit = 0;
   318			
   319	          35        s = (U8*)SvPV(sv, len);
   320	          35        isutf8 = SvUTF8(sv);
   321	          35        if (!isutf8) {
   322	           2    	const U8 *t = s, *e = s + len;
   323	           5    	while (t < e) {
   324	           4    	    const U8 ch = *t++;
   325	           4    	    if ((hibit = !NATIVE_IS_INVARIANT(ch)))
   326	           2    		break;
   327				}
   328	           2    	if (hibit)
   329	           1    	    s = bytes_to_utf8(s, &len);
   330			    }
   331	          35        send = s + len;
   332	          35        start = s;
   333			
   334	          35        svp = hv_fetch(hv, "FINAL", 5, FALSE);
   335	          35        if (svp)
   336	           1    	final = SvUV(*svp);
   337			
   338	          35        if (grows) {
   339				/* d needs to be bigger than s, in case e.g. upgrading is required */
   340	           3    	New(0, d, len * 3 + UTF8_MAXBYTES, U8);
   341	           3    	dend = d + len * 3;
   342	           3    	dstart = d;
   343			    }
   344			    else {
   345	          32    	dstart = d = s;
   346	          32    	dend = d + len;
   347			    }
   348			
   349	        1519        while (s < send) {
   350	        1484    	if ((uv = swash_fetch(rv, s, TRUE)) < none) {
   351	        1423    	    s += UTF8SKIP(s);
   352	        1423    	    matches++;
   353	        1423    	    d = uvuni_to_utf8(d, uv);
   354				}
   355	          61    	else if (uv == none) {
   356	          60    	    const int i = UTF8SKIP(s);
   357	          60    	    Move(s, d, i, U8);
   358	          60    	    d += i;
   359	          60    	    s += i;
   360				}
   361	           1    	else if (uv == extra) {
   362	           1    	    s += UTF8SKIP(s);
   363	           1    	    matches++;
   364	           1    	    d = uvuni_to_utf8(d, final);
   365				}
   366				else
   367	      ######    	    s += UTF8SKIP(s);
   368			
   369	        1484    	if (d > dend) {
   370	      ######    	    const STRLEN clen = d - dstart;
   371	      ######    	    const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES;
   372	      ######    	    if (!grows)
   373	      ######    		Perl_croak(aTHX_ "panic: do_trans_simple_utf8 line %d",__LINE__);
   374	      ######    	    Renew(dstart, nlen + UTF8_MAXBYTES, U8);
   375	      ######    	    d = dstart + clen;
   376	      ######    	    dend = dstart + nlen;
   377				}
   378			    }
   379	          35        if (grows || hibit) {
   380	           4    	sv_setpvn(sv, (char*)dstart, d - dstart);
   381	           4    	Safefree(dstart);
   382	           4    	if (grows && hibit)
   383	      ######    	    Safefree(start);
   384			    }
   385			    else {
   386	          31    	*d = '\0';
   387	          31    	SvCUR_set(sv, d - dstart);
   388			    }
   389	          35        SvSETMAGIC(sv);
   390	          35        SvUTF8_on(sv);
   391			
   392	          35        return matches;
   393			}
   394			
   395			STATIC I32
   396			S_do_trans_count_utf8(pTHX_ SV *sv)
   397	           4    {
   398	           4        const U8 *s;
   399	           4        const U8 *start = 0, *send;
   400	           4        I32 matches = 0;
   401	           4        STRLEN len;
   402			
   403	           4        SV* const rv = (SV*)cSVOP->op_sv;
   404	           4        HV* const hv = (HV*)SvRV(rv);
   405	           4        SV** const svp = hv_fetch(hv, "NONE", 4, FALSE);
   406	           4        const UV none = svp ? SvUV(*svp) : 0x7fffffff;
   407	           4        const UV extra = none + 1;
   408	           4        U8 hibit = 0;
   409			
   410	           4        s = (const U8*)SvPV_const(sv, len);
   411	           4        if (!SvUTF8(sv)) {
   412	      ######    	const U8 *t = s;
   413	      ######    	const U8 *e = s + len;
   414	      ######    	while (t < e) {
   415	      ######    	    const U8 ch = *t++;
   416	      ######    	    if ((hibit = !NATIVE_IS_INVARIANT(ch)))
   417	      ######    		break;
   418				}
   419	      ######    	if (hibit)
   420	      ######    	    start = s = bytes_to_utf8(s, &len);
   421			    }
   422	           4        send = s + len;
   423			
   424	          16        while (s < send) {
   425	          12    	UV uv;
   426	          12    	if ((uv = swash_fetch(rv, s, TRUE)) < none || uv == extra)
   427	           4    	    matches++;
   428	          12    	s += UTF8SKIP(s);
   429			    }
   430	           4        if (hibit)
   431	      ######            Safefree(start);
   432			
   433	           4        return matches;
   434			}
   435			
   436			STATIC I32
   437			S_do_trans_complex_utf8(pTHX_ SV *sv)
   438	          10    {
   439	          10        U8 *start, *send;
   440	          10        U8 *d;
   441	          10        I32 matches = 0;
   442	          10        const I32 squash   = PL_op->op_private & OPpTRANS_SQUASH;
   443	          10        const I32 del      = PL_op->op_private & OPpTRANS_DELETE;
   444	          10        const I32 grows    = PL_op->op_private & OPpTRANS_GROWS;
   445	          10        SV * const rv = (SV*)cSVOP->op_sv;
   446	          10        HV * const hv = (HV*)SvRV(rv);
   447	          10        SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
   448	          10        const UV none = svp ? SvUV(*svp) : 0x7fffffff;
   449	          10        const UV extra = none + 1;
   450	          10        UV final = 0;
   451	          10        bool havefinal = FALSE;
   452	          10        STRLEN len;
   453	          10        U8 *dstart, *dend;
   454	          10        U8 hibit = 0;
   455			
   456	          10        U8 *s = (U8*)SvPV(sv, len);
   457	          10        const I32 isutf8 = SvUTF8(sv);
   458	          10        if (!isutf8) {
   459	      ######    	const U8 *t = s;
   460	      ######    	const U8 * const e = s + len;
   461	      ######    	while (t < e) {
   462	      ######    	    const U8 ch = *t++;
   463	      ######    	    if ((hibit = !NATIVE_IS_INVARIANT(ch)))
   464	      ######    		break;
   465				}
   466	      ######    	if (hibit)
   467	      ######    	    s = bytes_to_utf8(s, &len);
   468			    }
   469	          10        send = s + len;
   470	          10        start = s;
   471			
   472	          10        svp = hv_fetch(hv, "FINAL", 5, FALSE);
   473	          10        if (svp) {
   474	           6    	final = SvUV(*svp);
   475	           6    	havefinal = TRUE;
   476			    }
   477			
   478	          10        if (grows) {
   479				/* d needs to be bigger than s, in case e.g. upgrading is required */
   480	           2    	New(0, d, len * 3 + UTF8_MAXBYTES, U8);
   481	           2    	dend = d + len * 3;
   482	           2    	dstart = d;
   483			    }
   484			    else {
   485	           8    	dstart = d = s;
   486	           8    	dend = d + len;
   487			    }
   488			
   489	          10        if (squash) {
   490	           3    	UV puv = 0xfeedface;
   491	          13    	while (s < send) {
   492	          10    	    UV uv = swash_fetch(rv, s, TRUE);
   493				
   494	          10    	    if (d > dend) {
   495	      ######    		const STRLEN clen = d - dstart;
   496	      ######    		const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES;
   497	      ######    		if (!grows)
   498	      ######    		    Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__);
   499	      ######    		Renew(dstart, nlen + UTF8_MAXBYTES, U8);
   500	      ######    		d = dstart + clen;
   501	      ######    		dend = dstart + nlen;
   502				    }
   503	          10    	    if (uv < none) {
   504	           2    		matches++;
   505	           2    		s += UTF8SKIP(s);
   506	           2    		if (uv != puv) {
   507	           1    		    d = uvuni_to_utf8(d, uv);
   508	           1    		    puv = uv;
   509					}
   510	           1    		continue;
   511				    }
   512	           8    	    else if (uv == none) {	/* "none" is unmapped character */
   513	           5    		const int i = UTF8SKIP(s);
   514	           5    		Move(s, d, i, U8);
   515	           5    		d += i;
   516	           5    		s += i;
   517	           5    		puv = 0xfeedface;
   518	           5    		continue;
   519				    }
   520	           3    	    else if (uv == extra && !del) {
   521	           3    		matches++;
   522	           3    		if (havefinal) {
   523	           1    		    s += UTF8SKIP(s);
   524	           1    		    if (puv != final) {
   525	           1    			d = uvuni_to_utf8(d, final);
   526	           1    			puv = final;
   527					    }
   528					}
   529					else {
   530	           2    		    STRLEN len;
   531	           2    		    uv = utf8_to_uvuni(s, &len);
   532	           2    		    if (uv != puv) {
   533	           1    			Move(s, d, len, U8);
   534	           1    			d += len;
   535	           1    			puv = uv;
   536					    }
   537	           2    		    s += len;
   538					}
   539	           2    		continue;
   540				    }
   541	      ######    	    matches++;			/* "none+1" is delete character */
   542	      ######    	    s += UTF8SKIP(s);
   543				}
   544			    }
   545			    else {
   546	          31    	while (s < send) {
   547	          24    	    const UV uv = swash_fetch(rv, s, TRUE);
   548	          24    	    if (d > dend) {
   549	      ######    	        const STRLEN clen = d - dstart;
   550	      ######    		const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES;
   551	      ######    		if (!grows)
   552	      ######    		    Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__);
   553	      ######    		Renew(dstart, nlen + UTF8_MAXBYTES, U8);
   554	      ######    		d = dstart + clen;
   555	      ######    		dend = dstart + nlen;
   556				    }
   557	          24    	    if (uv < none) {
   558	           2    		matches++;
   559	           2    		s += UTF8SKIP(s);
   560	           2    		d = uvuni_to_utf8(d, uv);
   561	           2    		continue;
   562				    }
   563	          22    	    else if (uv == none) {	/* "none" is unmapped character */
   564	          11    		const int i = UTF8SKIP(s);
   565	          11    		Move(s, d, i, U8);
   566	          11    		d += i;
   567	          11    		s += i;
   568	          11    		continue;
   569				    }
   570	          11    	    else if (uv == extra && !del) {
   571	           9    		matches++;
   572	           9    		s += UTF8SKIP(s);
   573	           9    		d = uvuni_to_utf8(d, final);
   574	           9    		continue;
   575				    }
   576	           2    	    matches++;			/* "none+1" is delete character */
   577	           2    	    s += UTF8SKIP(s);
   578				}
   579			    }
   580	          10        if (grows || hibit) {
   581	           2    	sv_setpvn(sv, (char*)dstart, d - dstart);
   582	           2    	Safefree(dstart);
   583	           2    	if (grows && hibit)
   584	      ######    	    Safefree(start);
   585			    }
   586			    else {
   587	           8    	*d = '\0';
   588	           8    	SvCUR_set(sv, d - dstart);
   589			    }
   590	          10        SvUTF8_on(sv);
   591	          10        SvSETMAGIC(sv);
   592			
   593	          10        return matches;
   594			}
   595			
   596			I32
   597			Perl_do_trans(pTHX_ SV *sv)
   598	       71445    {
   599	       71445        STRLEN len;
   600	       71445        const I32 hasutf = (PL_op->op_private &
   601	       71445                        (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
   602			
   603	       71445        if (SvREADONLY(sv)) {
   604	        1065            if (SvIsCOW(sv))
   605	        1055                sv_force_normal_flags(sv, 0);
   606	        1065            if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
   607	           1                Perl_croak(aTHX_ PL_no_modify);
   608			    }
   609	       71444        (void)SvPV_const(sv, len);
   610	       71444        if (!len)
   611	         500    	return 0;
   612	       70944        if (!(PL_op->op_private & OPpTRANS_IDENTICAL)) {
   613	       59332    	if (!SvPOKp(sv))
   614	      ######    	    (void)SvPV_force(sv, len);
   615	       59332    	(void)SvPOK_only_UTF8(sv);
   616			    }
   617			
   618	       70944        DEBUG_t( Perl_deb(aTHX_ "2.TBL\n"));
   619			
   620			    switch (PL_op->op_private & ~hasutf & (
   621					OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|
   622	       70944    		OPpTRANS_SQUASH|OPpTRANS_DELETE|OPpTRANS_COMPLEMENT)) {
   623			    case 0:
   624	       29576    	if (hasutf)
   625	          35    	    return do_trans_simple_utf8(sv);
   626				else
   627	       29541    	    return do_trans_simple(sv);
   628			
   629			    case OPpTRANS_IDENTICAL:
   630			    case OPpTRANS_IDENTICAL|OPpTRANS_COMPLEMENT:
   631	       11612    	if (hasutf)
   632	           4    	    return do_trans_count_utf8(sv);
   633				else
   634	       11608    	    return do_trans_count(sv);
   635			
   636			    default:
   637	       29756    	if (hasutf)
   638	          10    	    return do_trans_complex_utf8(sv);
   639				else
   640	       29746    	    return do_trans_complex(sv);
   641			    }
   642			}
   643			
   644			void
   645			Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **sp)
   646	      790449    {
   647	      790449        SV ** const oldmark = mark;
   648	      790449        register I32 items = sp - mark;
   649	      790449        register STRLEN len;
   650	      790449        STRLEN delimlen;
   651			
   652	      790449        (void) SvPV_const(del, delimlen); /* stringify and get the delimlen */
   653			    /* SvCUR assumes it's SvPOK() and woe betide you if it's not. */
   654			
   655	      790449        mark++;
   656	      790449        len = (items > 0 ? (delimlen * (items - 1) ) : 0);
   657	      790449        SvUPGRADE(sv, SVt_PV);
   658	      790449        if (SvLEN(sv) < len + items) {	/* current length is way too short */
   659	     1600297    	while (items-- > 0) {
   660	     1590638    	    if (*mark && !SvGAMAGIC(*mark) && SvOK(*mark)) {
   661	     1589620    		STRLEN tmplen;
   662	     1589620    		SvPV_const(*mark, tmplen);
   663	     1589620    		len += tmplen;
   664				    }
   665	     1590638    	    mark++;
   666				}
   667	        9659    	SvGROW(sv, len + 1);		/* so try to pre-extend */
   668			
   669	        9659    	mark = oldmark;
   670	        9659    	items = sp - mark;
   671	        9659    	++mark;
   672			    }
   673			
   674	      790449        sv_setpvn(sv, "", 0);
   675			    /* sv_setpv retains old UTF8ness [perl #24846] */
   676	      790449        SvUTF8_off(sv);
   677			
   678	      790449        if (PL_tainting && SvMAGICAL(sv))
   679	        6197    	SvTAINTED_off(sv);
   680			
   681	      790449        if (items-- > 0) {
   682	      758886    	if (*mark)
   683	      758886    	    sv_catsv(sv, *mark);
   684	      758886    	mark++;
   685			    }
   686			
   687	      790449        if (delimlen) {
   688	     2937785    	for (; items > 0; items--,mark++) {
   689	     1395397    	    sv_catsv(sv,del);
   690	     1395397    	    sv_catsv(sv,*mark);
   691				}
   692			    }
   693			    else {
   694	     3365838    	for (; items > 0; items--,mark++)
   695	     1361190    	    sv_catsv(sv,*mark);
   696			    }
   697	      790449        SvSETMAGIC(sv);
   698			}
   699			
   700			void
   701			Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
   702	      582878    {
   703	      582878        STRLEN patlen;
   704	      582878        const char * const pat = SvPV_const(*sarg, patlen);
   705	      582878        bool do_taint = FALSE;
   706			
   707	      582878        SvUTF8_off(sv);
   708	      582878        if (DO_UTF8(*sarg))
   709	          12            SvUTF8_on(sv);
   710	      582878        sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
   711	      582878        SvSETMAGIC(sv);
   712	      582878        if (do_taint)
   713	      ######    	SvTAINTED_on(sv);
   714			}
   715			
   716			/* currently converts input to bytes if possible, but doesn't sweat failure */
   717			UV
   718			Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
   719	     2310689    {
   720	     2310689        STRLEN srclen, len;
   721	     2310689        const unsigned char *s = (const unsigned char *) SvPV_const(sv, srclen);
   722	     2310689        UV retnum = 0;
   723			
   724	     2310689        if (offset < 0)
   725	           1    	return retnum;
   726	     2310688        if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
   727	           5    	Perl_croak(aTHX_ "Illegal number of bits in vec");
   728			
   729	     2310683        if (SvUTF8(sv))
   730	           4    	(void) Perl_sv_utf8_downgrade(aTHX_ sv, TRUE);
   731			
   732	     2310683        offset *= size;	/* turn into bit offset */
   733	     2310683        len = (offset + size + 7) / 8;	/* required number of bytes */
   734	     2310683        if (len > srclen) {
   735	      100509    	if (size <= 8)
   736	       90404    	    retnum = 0;
   737				else {
   738	       10105    	    offset >>= 3;	/* turn into byte offset */
   739	       10105    	    if (size == 16) {
   740	        9838    		if ((STRLEN)offset >= srclen)
   741	        9838    		    retnum = 0;
   742					else
   743	      ######    		    retnum = (UV) s[offset] <<  8;
   744				    }
   745	         267    	    else if (size == 32) {
   746	         267    		if ((STRLEN)offset >= srclen)
   747	         267    		    retnum = 0;
   748	      ######    		else if ((STRLEN)(offset + 1) >= srclen)
   749	      ######    		    retnum =
   750						((UV) s[offset    ] << 24);
   751	      ######    		else if ((STRLEN)(offset + 2) >= srclen)
   752	      ######    		    retnum =
   753						((UV) s[offset    ] << 24) +
   754						((UV) s[offset + 1] << 16);
   755					else
   756	      ######    		    retnum =
   757						((UV) s[offset    ] << 24) +
   758						((UV) s[offset + 1] << 16) +
   759						(     s[offset + 2] <<  8);
   760				    }
   761			#ifdef UV_IS_QUAD
   762				    else if (size == 64) {
   763					if (ckWARN(WARN_PORTABLE))
   764					    Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
   765							"Bit vector size > 32 non-portable");
   766					if (offset >= srclen)
   767					    retnum = 0;
   768					else if (offset + 1 >= srclen)
   769					    retnum =
   770						(UV) s[offset     ] << 56;
   771					else if (offset + 2 >= srclen)
   772					    retnum =
   773						((UV) s[offset    ] << 56) +
   774						((UV) s[offset + 1] << 48);
   775					else if (offset + 3 >= srclen)
   776					    retnum =
   777						((UV) s[offset    ] << 56) +
   778						((UV) s[offset + 1] << 48) +
   779						((UV) s[offset + 2] << 40);
   780					else if (offset + 4 >= srclen)
   781					    retnum =
   782						((UV) s[offset    ] << 56) +
   783						((UV) s[offset + 1] << 48) +
   784						((UV) s[offset + 2] << 40) +
   785						((UV) s[offset + 3] << 32);
   786					else if (offset + 5 >= srclen)
   787					    retnum =
   788						((UV) s[offset    ] << 56) +
   789						((UV) s[offset + 1] << 48) +
   790						((UV) s[offset + 2] << 40) +
   791						((UV) s[offset + 3] << 32) +
   792						(     s[offset + 4] << 24);
   793					else if (offset + 6 >= srclen)
   794					    retnum =
   795						((UV) s[offset    ] << 56) +
   796						((UV) s[offset + 1] << 48) +
   797						((UV) s[offset + 2] << 40) +
   798						((UV) s[offset + 3] << 32) +
   799						((UV) s[offset + 4] << 24) +
   800						((UV) s[offset + 5] << 16);
   801					else
   802					    retnum =
   803						((UV) s[offset    ] << 56) +
   804						((UV) s[offset + 1] << 48) +
   805						((UV) s[offset + 2] << 40) +
   806						((UV) s[offset + 3] << 32) +
   807						((UV) s[offset + 4] << 24) +
   808						((UV) s[offset + 5] << 16) +
   809						(     s[offset + 6] <<  8);
   810				    }
   811			#endif
   812				}
   813			    }
   814	     2210174        else if (size < 8)
   815	     1291377    	retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
   816			    else {
   817	      918797    	offset >>= 3;	/* turn into byte offset */
   818	      918797    	if (size == 8)
   819	      116064    	    retnum = s[offset];
   820	      802733    	else if (size == 16)
   821	      787142    	    retnum =
   822					((UV) s[offset] <<      8) +
   823					      s[offset + 1];
   824	       15591    	else if (size == 32)
   825	       15591    	    retnum =
   826					((UV) s[offset    ] << 24) +
   827					((UV) s[offset + 1] << 16) +
   828					(     s[offset + 2] <<  8) +
   829					      s[offset + 3];
   830			#ifdef UV_IS_QUAD
   831				else if (size == 64) {
   832				    if (ckWARN(WARN_PORTABLE))
   833					Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
   834						    "Bit vector size > 32 non-portable");
   835				    retnum =
   836					((UV) s[offset    ] << 56) +
   837					((UV) s[offset + 1] << 48) +
   838					((UV) s[offset + 2] << 40) +
   839					((UV) s[offset + 3] << 32) +
   840					((UV) s[offset + 4] << 24) +
   841					((UV) s[offset + 5] << 16) +
   842					(     s[offset + 6] <<  8) +
   843					      s[offset + 7];
   844				}
   845			#endif
   846			    }
   847			
   848	     2310683        return retnum;
   849			}
   850			
   851			/* currently converts input to bytes if possible but doesn't sweat failures,
   852			 * although it does ensure that the string it clobbers is not marked as
   853			 * utf8-valid any more
   854			 */
   855			void
   856			Perl_do_vecset(pTHX_ SV *sv)
   857	     1937936    {
   858	     1937936        SV *targ = LvTARG(sv);
   859	     1937936        register I32 offset;
   860	     1937936        register I32 size;
   861	     1937936        register unsigned char *s;
   862	     1937936        register UV lval;
   863	     1937936        I32 mask;
   864	     1937936        STRLEN targlen;
   865	     1937936        STRLEN len;
   866			
   867	     1937936        if (!targ)
   868	      ######    	return;
   869	     1937936        s = (unsigned char*)SvPV_force(targ, targlen);
   870	     1937936        if (SvUTF8(targ)) {
   871				/* This is handled by the SvPOK_only below...
   872				if (!Perl_sv_utf8_downgrade(aTHX_ targ, TRUE))
   873				    SvUTF8_off(targ);
   874				 */
   875	           1    	(void) Perl_sv_utf8_downgrade(aTHX_ targ, TRUE);
   876			    }
   877			
   878	     1937936        (void)SvPOK_only(targ);
   879	     1937936        lval = SvUV(sv);
   880	     1937936        offset = LvTARGOFF(sv);
   881	     1937936        if (offset < 0)
   882	           1    	Perl_croak(aTHX_ "Negative offset to vec in lvalue context");
   883	     1937935        size = LvTARGLEN(sv);
   884	     1937935        if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
   885	      ######    	Perl_croak(aTHX_ "Illegal number of bits in vec");
   886			
   887	     1937935        offset *= size;			/* turn into bit offset */
   888	     1937935        len = (offset + size + 7) / 8;	/* required number of bytes */
   889	     1937935        if (len > targlen) {
   890	      100501    	s = (unsigned char*)SvGROW(targ, len + 1);
   891	      100501    	(void)memzero((char *)(s + targlen), len - targlen + 1);
   892	      100501    	SvCUR_set(targ, len);
   893			    }
   894			
   895	     1937935        if (size < 8) {
   896	     1371724    	mask = (1 << size) - 1;
   897	     1371724    	size = offset & 7;
   898	     1371724    	lval &= mask;
   899	     1371724    	offset >>= 3;			/* turn into byte offset */
   900	     1371724    	s[offset] &= ~(mask << size);
   901	     1371724    	s[offset] |= lval << size;
   902			    }
   903			    else {
   904	      566211    	offset >>= 3;			/* turn into byte offset */
   905	      566211    	if (size == 8)
   906	       69279    	    s[offset  ] = (U8)( lval        & 0xff);
   907	      496932    	else if (size == 16) {
   908	      484403    	    s[offset  ] = (U8)((lval >>  8) & 0xff);
   909	      484403    	    s[offset+1] = (U8)( lval        & 0xff);
   910				}
   911	       12529    	else if (size == 32) {
   912	       12529    	    s[offset  ] = (U8)((lval >> 24) & 0xff);
   913	       12529    	    s[offset+1] = (U8)((lval >> 16) & 0xff);
   914	       12529    	    s[offset+2] = (U8)((lval >>  8) & 0xff);
   915	       12529    	    s[offset+3] = (U8)( lval        & 0xff);
   916				}
   917			#ifdef UV_IS_QUAD
   918				else if (size == 64) {
   919				    if (ckWARN(WARN_PORTABLE))
   920					Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
   921						    "Bit vector size > 32 non-portable");
   922				    s[offset  ] = (U8)((lval >> 56) & 0xff);
   923				    s[offset+1] = (U8)((lval >> 48) & 0xff);
   924				    s[offset+2] = (U8)((lval >> 40) & 0xff);
   925				    s[offset+3] = (U8)((lval >> 32) & 0xff);
   926				    s[offset+4] = (U8)((lval >> 24) & 0xff);
   927				    s[offset+5] = (U8)((lval >> 16) & 0xff);
   928				    s[offset+6] = (U8)((lval >>  8) & 0xff);
   929				    s[offset+7] = (U8)( lval        & 0xff);
   930				}
   931			#endif
   932			    }
   933	     1937935        SvSETMAGIC(targ);
   934			}
   935			
   936			void
   937			Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
   938	       52380    {
   939	       52380        STRLEN len;
   940	       52380        char *s;
   941			
   942	       52380        if (SvTYPE(sv) == SVt_PVAV) {
   943	           5    	register I32 i;
   944	           5    	AV* av = (AV*)sv;
   945	           5    	const I32 max = AvFILL(av);
   946			
   947	          19    	for (i = 0; i <= max; i++) {
   948	          14    	    sv = (SV*)av_fetch(av, i, FALSE);
   949	          14    	    if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
   950	          14    		do_chop(astr, sv);
   951				}
   952	       52375            return;
   953			    }
   954	       52375        else if (SvTYPE(sv) == SVt_PVHV) {
   955	      ######            HV* hv = (HV*)sv;
   956	      ######    	HE* entry;
   957	      ######            (void)hv_iterinit(hv);
   958	      ######            while ((entry = hv_iternext(hv)))
   959	      ######                do_chop(astr,hv_iterval(hv,entry));
   960	       52375            return;
   961			    }
   962	       52375        else if (SvREADONLY(sv)) {
   963	           4            if (SvFAKE(sv)) {
   964			            /* SV is copy-on-write */
   965	           3    	    sv_force_normal_flags(sv, 0);
   966			        }
   967	           4            if (SvREADONLY(sv))
   968	           1                Perl_croak(aTHX_ PL_no_modify);
   969			    }
   970	       52374        s = SvPV(sv, len);
   971	       52356        if (len && !SvPOK(sv))
   972	         504    	s = SvPV_force(sv, len);
   973	       52356        if (DO_UTF8(sv)) {
   974	         257    	if (s && len) {
   975	         257    	    char *send = s + len;
   976	         257    	    char *start = s;
   977	         257    	    s = send - 1;
   978	         515    	    while (s > start && UTF8_IS_CONTINUATION(*s))
   979	         258    		s--;
   980	         257    	    if (utf8_to_uvchr((U8*)s, 0)) {
   981	         257    		sv_setpvn(astr, s, send - s);
   982	         257    		*s = '\0';
   983	         257    		SvCUR_set(sv, s - start);
   984	         257    		SvNIOK_off(sv);
   985	         257    		SvUTF8_on(astr);
   986				    }
   987				}
   988				else
   989	      ######    	    sv_setpvn(astr, "", 0);
   990			    }
   991	       52099        else if (s && len) {
   992	       51979    	s += --len;
   993	       51979    	sv_setpvn(astr, s, 1);
   994	       51979    	*s = '\0';
   995	       51979    	SvCUR_set(sv, len);
   996	       51979    	SvUTF8_off(sv);
   997	       51979    	SvNIOK_off(sv);
   998			    }
   999			    else
  1000	         120    	sv_setpvn(astr, "", 0);
  1001	       52356        SvSETMAGIC(sv);
  1002			}
  1003			
  1004			I32
  1005			Perl_do_chomp(pTHX_ register SV *sv)
  1006	      250958    {
  1007	      250958        register I32 count;
  1008	      250958        STRLEN len;
  1009	      250958        char *s;
  1010	      250958        char *temp_buffer = NULL;
  1011	      250958        SV* svrecode = Nullsv;
  1012			
  1013	      250958        if (RsSNARF(PL_rs))
  1014	           1    	return 0;
  1015	      250957        if (RsRECORD(PL_rs))
  1016	           1          return 0;
  1017	      250956        count = 0;
  1018	      250956        if (SvTYPE(sv) == SVt_PVAV) {
  1019	        1129    	register I32 i;
  1020	        1129    	AV* av = (AV*)sv;
  1021	        1129    	const I32 max = AvFILL(av);
  1022			
  1023	        7934    	for (i = 0; i <= max; i++) {
  1024	        6805    	    sv = (SV*)av_fetch(av, i, FALSE);
  1025	        6805    	    if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
  1026	        6805    		count += do_chomp(sv);
  1027				}
  1028	        1129            return count;
  1029			    }
  1030	      249827        else if (SvTYPE(sv) == SVt_PVHV) {
  1031	      ######            HV* hv = (HV*)sv;
  1032	      ######    	HE* entry;
  1033	      ######            (void)hv_iterinit(hv);
  1034	      ######            while ((entry = hv_iternext(hv)))
  1035	      ######                count += do_chomp(hv_iterval(hv,entry));
  1036	      ######            return count;
  1037			    }
  1038	      249827        else if (SvREADONLY(sv)) {
  1039	           3            if (SvFAKE(sv)) {
  1040			            /* SV is copy-on-write */
  1041	           3    	    sv_force_normal_flags(sv, 0);
  1042			        }
  1043	           3            if (SvREADONLY(sv))
  1044	      ######                Perl_croak(aTHX_ PL_no_modify);
  1045			    }
  1046			
  1047	      249827        if (PL_encoding) {
  1048	         421    	if (!SvUTF8(sv)) {
  1049				/* XXX, here sv is utf8-ized as a side-effect!
  1050				   If encoding.pm is used properly, almost string-generating
  1051				   operations, including literal strings, chr(), input data, etc.
  1052				   should have been utf8-ized already, right?
  1053				*/
  1054	         105    	    sv_recode_to_utf8(sv, PL_encoding);
  1055				}
  1056			    }
  1057			
  1058	      249827        s = SvPV(sv, len);
  1059	      249826        if (s && len) {
  1060	      239658    	s += --len;
  1061	      239658    	if (RsPARA(PL_rs)) {
  1062	           4    	    if (*s != '\n')
  1063	           1    		goto nope;
  1064	           3    	    ++count;
  1065	           8    	    while (len && s[-1] == '\n') {
  1066	           5    		--len;
  1067	           5    		--s;
  1068	           5    		++count;
  1069				    }
  1070				}
  1071				else {
  1072	      239654    	    STRLEN rslen, rs_charlen;
  1073	      239654    	    const char *rsptr = SvPV_const(PL_rs, rslen);
  1074			
  1075	      239654    	    rs_charlen = SvUTF8(PL_rs)
  1076					? sv_len_utf8(PL_rs)
  1077					: rslen;
  1078			
  1079	      239654    	    if (SvUTF8(PL_rs) != SvUTF8(sv)) {
  1080					/* Assumption is that rs is shorter than the scalar.  */
  1081	         680    		if (SvUTF8(PL_rs)) {
  1082					    /* RS is utf8, scalar is 8 bit.  */
  1083	         374    		    bool is_utf8 = TRUE;
  1084	         374    		    temp_buffer = (char*)bytes_from_utf8((U8*)rsptr,
  1085										 &rslen, &is_utf8);
  1086	         374    		    if (is_utf8) {
  1087						/* Cannot downgrade, therefore cannot possibly match
  1088						 */
  1089	           7    			assert (temp_buffer == rsptr);
  1090	           7    			temp_buffer = NULL;
  1091	           7    			goto nope;
  1092					    }
  1093	         367    		    rsptr = temp_buffer;
  1094					}
  1095	         306    		else if (PL_encoding) {
  1096					    /* RS is 8 bit, encoding.pm is used.
  1097					     * Do not recode PL_rs as a side-effect. */
  1098	         290    		   svrecode = newSVpvn(rsptr, rslen);
  1099	         290    		   sv_recode_to_utf8(svrecode, PL_encoding);
  1100	         290    		   rsptr = SvPV_const(svrecode, rslen);
  1101	         290    		   rs_charlen = sv_len_utf8(svrecode);
  1102					}
  1103					else {
  1104					    /* RS is 8 bit, scalar is utf8.  */
  1105	          16    		    temp_buffer = (char*)bytes_to_utf8((U8*)rsptr, &rslen);
  1106	          16    		    rsptr = temp_buffer;
  1107					}
  1108				    }
  1109	      239647    	    if (rslen == 1) {
  1110	      239410    		if (*s != *rsptr)
  1111	      141716    		    goto nope;
  1112	       97694    		++count;
  1113				    }
  1114				    else {
  1115	         237    		if (len < rslen - 1)
  1116	          12    		    goto nope;
  1117	         225    		len -= rslen - 1;
  1118	         225    		s -= rslen - 1;
  1119	         225    		if (memNE(s, rsptr, rslen))
  1120	          99    		    goto nope;
  1121	         126    		count += rs_charlen;
  1122				    }
  1123				}
  1124	       97823    	s = SvPV_force_nolen(sv);
  1125	       97823    	SvCUR_set(sv, len);
  1126	       97823    	*SvEND(sv) = '\0';
  1127	       97823    	SvNIOK_off(sv);
  1128	       97823    	SvSETMAGIC(sv);
  1129			    }
  1130			  nope:
  1131			
  1132	      249826        if (svrecode)
  1133	         290    	 SvREFCNT_dec(svrecode);
  1134			
  1135	      249826        Safefree(temp_buffer);
  1136	      249826        return count;
  1137			}
  1138			
  1139			void
  1140			Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
  1141	       34510    {
  1142			#ifdef LIBERAL
  1143	       34510        register long *dl;
  1144	       34510        register long *ll;
  1145	       34510        register long *rl;
  1146			#endif
  1147	       34510        register char *dc;
  1148	       34510        STRLEN leftlen;
  1149	       34510        STRLEN rightlen;
  1150	       34510        register const char *lc;
  1151	       34510        register const char *rc;
  1152	       34510        register I32 len;
  1153	       34510        I32 lensave;
  1154	       34510        const char *lsave;
  1155	       34510        const char *rsave;
  1156	       34510        const bool left_utf = DO_UTF8(left);
  1157	       34510        const bool right_utf = DO_UTF8(right);
  1158	       34510        I32 needlen = 0;
  1159			
  1160	       34510        if (left_utf && !right_utf)
  1161	      ######    	sv_utf8_upgrade(right);
  1162	       34510        else if (!left_utf && right_utf)
  1163	           1    	sv_utf8_upgrade(left);
  1164			
  1165	       34510        if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
  1166	        7594    	sv_setpvn(sv, "", 0);	/* avoid undef warning on |= and ^= */
  1167	       34510        lsave = lc = SvPV_nomg_const(left, leftlen);
  1168	       34510        rsave = rc = SvPV_nomg_const(right, rightlen);
  1169	       34510        len = leftlen < rightlen ? leftlen : rightlen;
  1170	       34510        lensave = len;
  1171	       34510        if ((left_utf || right_utf) && (sv == left || sv == right)) {
  1172	           3    	needlen = optype == OP_BIT_AND ? len : leftlen + rightlen;
  1173	           3    	Newz(801, dc, needlen + 1, char);
  1174			    }
  1175	       34507        else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
  1176	       34503    	STRLEN n_a;
  1177	       34503    	dc = SvPV_force_nomg(sv, n_a);
  1178	       34503    	if (SvCUR(sv) < (STRLEN)len) {
  1179	        7583    	    dc = SvGROW(sv, (STRLEN)(len + 1));
  1180	        7583    	    (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
  1181				}
  1182	       34503    	if (optype != OP_BIT_AND && (left_utf || right_utf))
  1183	        2184    	    dc = SvGROW(sv, leftlen + rightlen + 1);
  1184			    }
  1185			    else {
  1186	           4    	needlen = ((optype == OP_BIT_AND)
  1187					    ? len : (leftlen > rightlen ? leftlen : rightlen));
  1188	           4    	Newz(801, dc, needlen + 1, char);
  1189	           4    	(void)sv_usepvn(sv, dc, needlen);
  1190	           4    	dc = SvPVX(sv);		/* sv_usepvn() calls Renew() */
  1191			    }
  1192	       34510        SvCUR_set(sv, len);
  1193	       34510        (void)SvPOK_only(sv);
  1194	       34510        if (left_utf || right_utf) {
  1195	        4368    	UV duc, luc, ruc;
  1196	        4368    	char *dcsave = dc;
  1197	        4368    	STRLEN lulen = leftlen;
  1198	        4368    	STRLEN rulen = rightlen;
  1199	        4368    	STRLEN ulen;
  1200			
  1201	        4368    	switch (optype) {
  1202				case OP_BIT_AND:
  1203	        4366    	    while (lulen && rulen) {
  1204	        2184    		luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
  1205	        2184    		lc += ulen;
  1206	        2184    		lulen -= ulen;
  1207	        2184    		ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
  1208	        2184    		rc += ulen;
  1209	        2184    		rulen -= ulen;
  1210	        2184    		duc = luc & ruc;
  1211	        2184    		dc = (char*)uvchr_to_utf8((U8*)dc, duc);
  1212				    }
  1213	        2182    	    if (sv == left || sv == right)
  1214	           1    		(void)sv_usepvn(sv, dcsave, needlen);
  1215	        2182    	    SvCUR_set(sv, dc - dcsave);
  1216	        2182    	    break;
  1217				case OP_BIT_XOR:
  1218	          11    	    while (lulen && rulen) {
  1219	           7    		luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
  1220	           7    		lc += ulen;
  1221	           7    		lulen -= ulen;
  1222	           7    		ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
  1223	           7    		rc += ulen;
  1224	           7    		rulen -= ulen;
  1225	           7    		duc = luc ^ ruc;
  1226	           7    		dc = (char*)uvchr_to_utf8((U8*)dc, duc);
  1227				    }
  1228	        2182    	    goto mop_up_utf;
  1229				case OP_BIT_OR:
  1230	        4367    	    while (lulen && rulen) {
  1231	        2185    		luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
  1232	        2185    		lc += ulen;
  1233	        2185    		lulen -= ulen;
  1234	        2185    		ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
  1235	        2185    		rc += ulen;
  1236	        2185    		rulen -= ulen;
  1237	        2185    		duc = luc | ruc;
  1238	        2185    		dc = (char*)uvchr_to_utf8((U8*)dc, duc);
  1239				    }
  1240				  mop_up_utf:
  1241	        2186    	    if (sv == left || sv == right)
  1242	           2    		(void)sv_usepvn(sv, dcsave, needlen);
  1243	        2186    	    SvCUR_set(sv, dc - dcsave);
  1244	        2186    	    if (rulen)
  1245	           1    		sv_catpvn(sv, rc, rulen);
  1246	        2185    	    else if (lulen)
  1247	           1    		sv_catpvn(sv, lc, lulen);
  1248				    else
  1249	        2184    		*SvEND(sv) = '\0';
  1250				    break;
  1251				}
  1252	        4368    	SvUTF8_on(sv);
  1253	        4368    	goto finish;
  1254			    }
  1255			    else
  1256			#ifdef LIBERAL
  1257	       30142        if (len >= sizeof(long)*4 &&
  1258				!((long)dc % sizeof(long)) &&
  1259				!((long)lc % sizeof(long)) &&
  1260				!((long)rc % sizeof(long)))	/* It's almost always aligned... */
  1261			    {
  1262	        1185    	const I32 remainder = len % (sizeof(long)*4);
  1263	        1185    	len /= (sizeof(long)*4);
  1264			
  1265	        1185    	dl = (long*)dc;
  1266	        1185    	ll = (long*)lc;
  1267	        1185    	rl = (long*)rc;
  1268			
  1269	        1185    	switch (optype) {
  1270				case OP_BIT_AND:
  1271	          33    	    while (len--) {
  1272	          19    		*dl++ = *ll++ & *rl++;
  1273	          19    		*dl++ = *ll++ & *rl++;
  1274	          19    		*dl++ = *ll++ & *rl++;
  1275	          19    		*dl++ = *ll++ & *rl++;
  1276				    }
  1277	           2    	    break;
  1278				case OP_BIT_XOR:
  1279	           8    	    while (len--) {
  1280	           6    		*dl++ = *ll++ ^ *rl++;
  1281	           6    		*dl++ = *ll++ ^ *rl++;
  1282	           6    		*dl++ = *ll++ ^ *rl++;
  1283	           6    		*dl++ = *ll++ ^ *rl++;
  1284				    }
  1285	        1169    	    break;
  1286				case OP_BIT_OR:
  1287	        2345    	    while (len--) {
  1288	        1176    		*dl++ = *ll++ | *rl++;
  1289	        1176    		*dl++ = *ll++ | *rl++;
  1290	        1176    		*dl++ = *ll++ | *rl++;
  1291	        1176    		*dl++ = *ll++ | *rl++;
  1292				    }
  1293				}
  1294			
  1295	        1185    	dc = (char*)dl;
  1296	        1185    	lc = (char*)ll;
  1297	        1185    	rc = (char*)rl;
  1298			
  1299	        1185    	len = remainder;
  1300			    }
  1301			#endif
  1302			    {
  1303	       30142    	switch (optype) {
  1304				case OP_BIT_AND:
  1305	       20377    	    while (len--)
  1306	       18623    		*dc++ = *lc++ & *rc++;
  1307	          59    	    break;
  1308				case OP_BIT_XOR:
  1309	         168    	    while (len--)
  1310	         109    		*dc++ = *lc++ ^ *rc++;
  1311	       28329    	    goto mop_up;
  1312				case OP_BIT_OR:
  1313	      258124    	    while (len--)
  1314	      229795    		*dc++ = *lc++ | *rc++;
  1315				  mop_up:
  1316	       28388    	    len = lensave;
  1317	       28388    	    if (rightlen > (STRLEN)len)
  1318	         298    		sv_catpvn(sv, rsave + len, rightlen - len);
  1319	       28090    	    else if (leftlen > (STRLEN)len)
  1320	        1626    		sv_catpvn(sv, lsave + len, leftlen - len);
  1321				    else
  1322	       26464    		*SvEND(sv) = '\0';
  1323				    break;
  1324				}
  1325			    }
  1326			finish:
  1327	       34510        SvTAINT(sv);
  1328			}
  1329			
  1330			OP *
  1331			Perl_do_kv(pTHX)
  1332	      162614    {
  1333	      162614        dSP;
  1334	      162614        HV *hv = (HV*)POPs;
  1335	      162614        HV *keys;
  1336	      162614        register HE *entry;
  1337	      162614        const I32 gimme = GIMME_V;
  1338	      162614        const I32 dokv =     (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV);
  1339	      162614        const I32 dokeys =   dokv || (PL_op->op_type == OP_KEYS);
  1340	      162614        const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES);
  1341			
  1342	      162614        if (!hv) {
  1343	      ######    	if (PL_op->op_flags & OPf_MOD || LVRET) {	/* lvalue */
  1344	      ######    	    dTARGET;		/* make sure to clear its target here */
  1345	      ######    	    if (SvTYPE(TARG) == SVt_PVLV)
  1346	      ######    		LvTARG(TARG) = Nullsv;
  1347	      ######    	    PUSHs(TARG);
  1348				}
  1349	      ######    	RETURN;
  1350			    }
  1351			
  1352	      162614        keys = hv;
  1353	      162614        (void)hv_iterinit(keys);	/* always reset iterator regardless */
  1354			
  1355	      162614        if (gimme == G_VOID)
  1356	        1215    	RETURN;
  1357			
  1358	      161399        if (gimme == G_SCALAR) {
  1359	        2513    	IV i;
  1360	        2513    	dTARGET;
  1361			
  1362	        2513    	if (PL_op->op_flags & OPf_MOD || LVRET) {	/* lvalue */
  1363	          16    	    if (SvTYPE(TARG) < SVt_PVLV) {
  1364	          16    		sv_upgrade(TARG, SVt_PVLV);
  1365	          16    		sv_magic(TARG, Nullsv, PERL_MAGIC_nkeys, Nullch, 0);
  1366				    }
  1367	          16    	    LvTYPE(TARG) = 'k';
  1368	          16    	    if (LvTARG(TARG) != (SV*)keys) {
  1369	          16    		if (LvTARG(TARG))
  1370	      ######    		    SvREFCNT_dec(LvTARG(TARG));
  1371	          16    		LvTARG(TARG) = SvREFCNT_inc(keys);
  1372				    }
  1373	          16    	    PUSHs(TARG);
  1374	          16    	    RETURN;
  1375				}
  1376			
  1377	        2497    	if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied))
  1378	        2484    	    i = HvKEYS(keys);
  1379				else {
  1380	          13    	    i = 0;
  1381	        1068    	    while (hv_iternext(keys)) i++;
  1382				}
  1383	        2497    	PUSHi( i );
  1384	        2497    	RETURN;
  1385			    }
  1386			
  1387	      158886        EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
  1388			
  1389	      158886        PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
  1390	     2442128        while ((entry = hv_iternext(keys))) {
  1391	     2283242    	SPAGAIN;
  1392	     2283242    	if (dokeys) {
  1393	     2250978    	    SV* sv = hv_iterkeysv(entry);
  1394	     2250978    	    XPUSHs(sv);	/* won't clobber stack_sp */
  1395				}
  1396	     2283242    	if (dovalues) {
  1397	      273576    	    SV *tmpstr;
  1398	      273576    	    PUTBACK;
  1399	      273576    	    tmpstr = hv_iterval(hv,entry);
  1400				    DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
  1401						    (unsigned long)HeHASH(entry),
  1402						    (int)HvMAX(keys)+1,
  1403	      273576    			    (unsigned long)(HeHASH(entry) & HvMAX(keys))));
  1404	      273576    	    SPAGAIN;
  1405	      273576    	    XPUSHs(tmpstr);
  1406				}
  1407	     2283242    	PUTBACK;
  1408			    }
  1409	      158886        return NORMAL;
  1410			}
  1411			
  1412			/*
  1413			 * Local variables:
  1414			 * c-indentation-style: bsd
  1415			 * c-basic-offset: 4
  1416			 * indent-tabs-mode: t
  1417			 * End:
  1418			 *
  1419			 * ex: set ts=8 sts=4 sw=4 noet:
  1420			 */