/* pp_sort.c
*
- * Copyright (c) 1991-2002, Larry Wall
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, 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.
PP(pp_sort)
{
dSP; dMARK; dORIGMARK;
- register SV **up;
- SV **myorigmark = ORIGMARK;
- register I32 max;
+ register SV **p1 = ORIGMARK+1, **p2;
+ register I32 max, i;
+ AV* av = Nullav;
HV *stash;
GV *gv;
CV *cv = 0;
I32 overloading = 0;
bool hasargs = FALSE;
I32 is_xsub = 0;
+ I32 sorting_av = 0;
if (gimme != G_ARRAY) {
SP = MARK;
else if (gv) {
SV *tmpstr = sv_newmortal();
gv_efullname3(tmpstr, gv, Nullch);
- DIE(aTHX_ "Undefined sort subroutine \"%s\" called",
- SvPVX(tmpstr));
+ DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
+ tmpstr);
}
else {
DIE(aTHX_ "Undefined subroutine in sort");
SAVEVPTR(CvROOT(cv)->op_ppaddr);
CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
- SAVEVPTR(PL_curpad);
- PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+ PAD_SET_CUR(CvPADLIST(cv), 1);
}
}
}
stash = CopSTASH(PL_curcop);
}
- up = myorigmark + 1;
- while (MARK < SP) { /* This may or may not shift down one here. */
- /*SUPPRESS 560*/
- if ((*up = *++MARK)) { /* Weed out nulls. */
- SvTEMP_off(*up);
- if (!PL_sortcop && !SvPOK(*up)) {
+ /* optimiser converts "@a = sort @a" to "sort \@a";
+ * in case of tied @a, pessimise: push (@a) onto stack, then assign
+ * result back to @a at the end of this function */
+ if (PL_op->op_private & OPpSORT_INPLACE) {
+ assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
+ (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */
+ av = (AV*)(*SP);
+ max = AvFILL(av) + 1;
+ if (SvMAGICAL(av)) {
+ MEXTEND(SP, max);
+ p2 = SP;
+ for (i=0; i < (U32)max; i++) {
+ SV **svp = av_fetch(av, i, FALSE);
+ *SP++ = (svp) ? *svp : Nullsv;
+ }
+ }
+ else {
+ p1 = p2 = AvARRAY(av);
+ sorting_av = 1;
+ }
+ }
+ else {
+ p2 = MARK+1;
+ max = SP - MARK;
+ }
+
+ /* shuffle stack down, removing optional initial cv (p1!=p2), plus any
+ * nulls; also stringify any args */
+ for (i=max; i > 0 ; i--) {
+ if ((*p1 = *p2++)) { /* Weed out nulls. */
+ SvTEMP_off(*p1);
+ if (!PL_sortcop && !SvPOK(*p1)) {
STRLEN n_a;
- if (SvAMAGIC(*up))
+ if (SvAMAGIC(*p1))
overloading = 1;
else
- (void)sv_2pv(*up, &n_a);
+ (void)sv_2pv(*p1, &n_a);
}
- up++;
+ p1++;
}
+ else
+ max--;
}
- max = --up - myorigmark;
- if (PL_sortcop) {
- if (max > 1) {
+ if (sorting_av)
+ AvFILLp(av) = max-1;
+
+ if (max > 1) {
+ if (PL_sortcop) {
PERL_CONTEXT *cx;
SV** newsp;
bool oldcatch = CATCH_GET;
PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
PL_sortstash = stash;
}
-#ifdef USE_5005THREADS
- sv_lock((SV *)PL_firstgv);
- sv_lock((SV *)PL_secondgv);
-#endif
SAVESPTR(GvSV(PL_firstgv));
SAVESPTR(GvSV(PL_secondgv));
}
cx->cx_type = CXt_SUB;
cx->blk_gimme = G_SCALAR;
PUSHSUB(cx);
- if (!CvDEPTH(cv))
- (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
}
PL_sortcxix = cxstack_ix;
if (hasargs && !is_xsub) {
/* This is mostly copied from pp_entersub */
- AV *av = (AV*)PL_curpad[0];
+ AV *av = (AV*)PAD_SVl(0);
-#ifndef USE_5005THREADS
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_5005THREADS */
- cx->blk_sub.oldcurpad = PL_curpad;
+ CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
}
- sortsv((myorigmark+1), max,
+ sortsv(p1-max, max,
is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
POPBLOCK(cx,PL_curpm);
POPSTACK;
CATCH_SET(oldcatch);
}
- }
- else {
- if (max > 1) {
+ else {
MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */
- sortsv(ORIGMARK+1, max,
+ sortsv(sorting_av ? AvARRAY(av) : ORIGMARK+1, max,
(PL_op->op_private & OPpSORT_NUMERIC)
? ( (PL_op->op_private & OPpSORT_INTEGER)
? ( overloading ? amagic_i_ncmp : sv_i_ncmp)
: sv_cmp_locale_static)
: ( overloading ? amagic_cmp : sv_cmp_static)));
if (PL_op->op_private & OPpSORT_REVERSE) {
- SV **p = ORIGMARK+1;
- SV **q = ORIGMARK+max;
+ SV **p = sorting_av ? AvARRAY(av) : ORIGMARK+1;
+ SV **q = p+max-1;
while (p < q) {
SV *tmp = *p;
*p++ = *q;
}
}
}
+ if (av && !sorting_av) {
+ /* simulate pp_aassign of tied AV */
+ SV *sv;
+ SV** base, **didstore;
+ for (base = ORIGMARK+1, i=0; i < max; i++) {
+ sv = NEWSV(28,0);
+ sv_setsv(sv, base[i]);
+ base[i] = sv;
+ }
+ av_clear(av);
+ av_extend(av, max);
+ for (i=0; i < max; i++) {
+ sv = base[i];
+ didstore = av_store(av, i, sv);
+ if (SvSMAGICAL(sv))
+ mg_set(sv);
+ if (!didstore)
+ sv_2mortal(sv);
+ }
+ }
LEAVE;
- PL_stack_sp = ORIGMARK + max;
+ PL_stack_sp = ORIGMARK + (sorting_av ? 0 : max);
return nextop;
}
I32 result;
AV *av;
-#ifdef USE_5005THREADS
- av = (AV*)PL_curpad[0];
-#else
av = GvAV(PL_defgv);
-#endif
if (AvMAX(av) < 1) {
SV** ary = AvALLOC(av);