From: Perl 5 Porters Date: Thu, 3 Oct 1996 20:31:46 +0000 (-0400) Subject: perl 5.003_06: sv.c X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=16660edb8096eecedc92b4cfa57f100a175c7962;p=p5sagit%2Fp5-mst-13.2.git perl 5.003_06: sv.c Restore the 5.003 gv_fullname() and gv_efullname() functions. Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements "keys %hash = 50_000;" (or other integer-evaluable sizes) for pre-sizing hashes. I've only moved the patch forward from when I first did it. I'm sure the code in hv_ksplit could be improved. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) From: Charles Bailey Subject: VMS patches to 5.003_05 I've added some DEBUG_Ps to sv.c which give a trace of the fast I/O fiddling with stdio in sv_gets(). These were useful to me in setting up the VMS fast I/O, and I left them in in case they're useful to someone in the future. However, if you think it overloads -DP too much, feel free to drop it. (-DP already adds a profile of op usage to its advertised output.) Date: Mon, 7 Oct 1996 22:03:00 +0300 From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. sv_cmp() sprouted a LC_COLLATE branch. --- diff --git a/sv.c b/sv.c index 9f5e505..b155eee 100644 --- a/sv.c +++ b/sv.c @@ -2154,6 +2154,9 @@ I32 namlen; case 'i': mg->mg_virtual = &vtbl_isaelem; break; + case 'k': + mg->mg_virtual = &vtbl_nkeys; + break; case 'L': SvRMAGICAL_on(sv); mg->mg_virtual = 0; @@ -2611,39 +2614,91 @@ register SV *str2; char *pv2; STRLEN cur2; + if (lc_collate_active) { /* NOTE: this is the LC_COLLATE branch */ + if (!str1) { pv1 = ""; cur1 = 0; - } - else + } else { pv1 = SvPV(str1, cur1); + { + STRLEN cur1x; + char * pv1x = mem_collxfrm(pv1, cur1, &cur1x); + + pv1 = pv1x; + cur1 = cur1x; + } + } + if (!str2) { pv2 = ""; cur2 = 0; + } else { + pv2 = SvPV(str2, cur2); + + { + STRLEN cur2x; + char * pv2x = mem_collxfrm(pv2, cur2, &cur2x); + + pv2 = pv2x; + cur2 = cur2x; + } } + + if (!cur1) { + Safefree(pv2); + return cur2 ? -1 : 0; + } + + if (!cur2) { + Safefree(pv1); + return 1; + } + + retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2); + + Safefree(pv1); + Safefree(pv2); + + if (retval) + return retval < 0 ? -1 : 1; + + if (cur1 == cur2) + return 0; else + return cur1 < cur2 ? -1 : 1; + + } else { /* NOTE: this is the non-LC_COLLATE branch */ + + if (!str1) { + pv1 = ""; + cur1 = 0; + } else + pv1 = SvPV(str1, cur1); + + if (!str2) { + pv2 = ""; + cur2 = 0; + } else pv2 = SvPV(str2, cur2); if (!cur1) return cur2 ? -1 : 0; + if (!cur2) return 1; - if (cur1 < cur2) { - /*SUPPRESS 560*/ - if (retval = memcmp((void*)pv1, (void*)pv2, cur1)) - return retval < 0 ? -1 : 1; - else - return -1; - } - /*SUPPRESS 560*/ - else if (retval = memcmp((void*)pv1, (void*)pv2, cur2)) + retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2); + + if (retval) return retval < 0 ? -1 : 1; - else if (cur1 == cur2) + + if (cur1 == cur2) return 0; else - return 1; + return cur1 < cur2 ? -1 : 1; + } } char * @@ -2712,6 +2767,15 @@ I32 append; STRLEN bpx; I32 shortbuffered; +#if defined(VMS) && defined(PERLIO_IS_STDIO) + /* An ungetc()d char is handled separately from the regular + * buffer, so we getc() it back out and stuff it in the buffer. + */ + i = PerlIO_getc(fp); + if (i == EOF) return 0; + *(--((*fp)->_ptr)) = (unsigned char) i; + (*fp)->_cnt++; +#endif /* Here is some breathtakingly efficient cheating */ @@ -2731,6 +2795,11 @@ I32 append; shortbuffered = 0; bp = (STDCHAR*)SvPVX(sv) + append; /* move these two too to registers */ ptr = (STDCHAR*)PerlIO_get_ptr(fp); + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: entering, ptr=%d, cnt=%d\n",ptr,cnt)); + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: entering: FILE * thinks ptr=%d, cnt=%d, base=%d\n", + PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), PerlIO_get_base(fp))); for (;;) { screamer: if (cnt > 0) { @@ -2759,14 +2828,26 @@ I32 append; continue; } + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: going to getc, ptr=%d, cnt=%d\n",ptr,cnt)); PerlIO_set_ptrcnt(fp, ptr, cnt); /* deregisterize cnt and ptr */ - /* This used to call 'filbuf' in stdio form, but as that behaves like getc - when cnt <= 0 we use PerlIO_getc here to avoid another abstraction. - This may also avoid issues with different named 'filbuf' equivalents + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: pre: FILE * thinks ptr=%d, cnt=%d, base=%d\n", + PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), PerlIO_get_base(fp))); + /* This used to call 'filbuf' in stdio form, but as that behaves like + getc when cnt <= 0 we use PerlIO_getc here to avoid another + abstraction. This may also avoid issues with different named + 'filbuf' equivalents, though Configure tries to handle them now + anyway. */ i = PerlIO_getc(fp); /* get more characters */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: post: FILE * thinks ptr=%d, cnt=%d, base=%d\n", + PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), PerlIO_get_base(fp))); cnt = PerlIO_get_cnt(fp); ptr = (STDCHAR*)PerlIO_get_ptr(fp); /* reregisterize cnt and ptr */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: after getc, ptr=%d, cnt=%d\n",ptr,cnt)); if (i == EOF) /* all done for ever? */ goto thats_really_all_folks; @@ -2789,9 +2870,17 @@ thats_all_folks: thats_really_all_folks: if (shortbuffered) cnt += shortbuffered; + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: quitting, ptr=%d, cnt=%d\n",ptr,cnt)); PerlIO_set_ptrcnt(fp, ptr, cnt); /* put these back or we're in trouble */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: end: FILE * thinks ptr=%d, cnt=%d, base=%d\n", + PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), PerlIO_get_base(fp))); *bp = '\0'; SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: done, len=%d, string=|%.*s|\n", + SvCUR(sv),SvCUR(sv),SvPVX(sv))); } else { @@ -2808,7 +2897,10 @@ screamer2: } else { cnt = PerlIO_read(fp,(char*)buf, sizeof(buf)); - i = cnt ? (U8)buf[cnt - 1] : EOF; + /* Accomodate broken VAXC compiler, which applies U8 cast to + * both args of ?: operator, causing EOF to change into 255 + */ + if (cnt) { i = (U8)buf[cnt - 1]; } else { i = EOF; } } if (append) @@ -3222,7 +3314,7 @@ I32 lref; SV *tmpsv; ENTER; tmpsv = NEWSV(704,0); - gv_efullname(tmpsv, gv, Nullch); + gv_efullname3(tmpsv, gv, Nullch); newSUB(start_subparse(), newSVOP(OP_CONST, 0, tmpsv), Nullop,