#define sv_cmp_static Perl_sv_cmp
#define sv_cmp_locale_static Perl_sv_cmp_locale
-#define SORTHINTS(hintsv) \
- (((hintsv) = GvSV(gv_fetchpv("sort::hints", GV_ADDMULTI, SVt_IV))), \
- (SvIOK(hintsv) ? ((I32)SvIV(hintsv)) : 0))
+#define dSORTHINTS SV *hintsv = GvSV(gv_fetchpv("sort::hints", GV_ADDMULTI, SVt_IV))
+#define SORTHINTS (SvIOK(hintsv) ? ((I32)SvIV(hintsv)) : 0)
#ifndef SMALLSORT
#define SMALLSORT (200)
* problem is subdivided into smaller and smaller parts, the parts
* fit into smaller (and faster) caches. So it doesn't matter how
* many levels of cache exist, quicksort will "find" them, and,
- * as long as smaller is faster, take advanatge of them.
+ * as long as smaller is faster, take advantage of them.
*
* By contrast, consider how the original mergesort algorithm worked.
* Suppose we have five runs (each typically of length 2 after dynprep).
STATIC void
S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
- IV i, run, runs, offset;
+ IV i, run, offset;
I32 sense, level;
+ register gptr *f1, *f2, *t, *b, *p;
int iwhich;
- register gptr *f1, *f2, *t, *b, *p, *tp2, *l1, *l2, *q;
- gptr *aux, *list1, *list2;
+ gptr *aux;
gptr *p1;
gptr small[SMALLSORT];
gptr *which[3];
}
if (nmemb <= SMALLSORT) aux = small; /* use stack for aux array */
- else { New(799,aux,nmemb,gptr); } /* allocate auxilliary array */
+ else { Newx(aux,nmemb,gptr); } /* allocate auxilliary array */
level = 0;
stackp = stack;
stackp->runs = dynprep(aTHX_ base, aux, nmemb, cmp);
* is needed at the next level up. Hop up a level, and,
* as long as stackp->runs is 0, keep merging.
*/
- if ((runs = stackp->runs) == 0) {
+ IV runs = stackp->runs;
+ if (runs == 0) {
+ gptr *list1, *list2;
iwhich = level & 1;
list1 = which[iwhich]; /* area where runs are now */
list2 = which[++iwhich]; /* area for merged runs */
do {
+ register gptr *l1, *l2, *tp2;
offset = stackp->offset;
f1 = p1 = list1 + offset; /* start of first run */
p = tp2 = list2 + offset; /* where merged run will go */
** and -1 when equality should look high.
*/
-
+ register gptr *q;
if (cmp(aTHX_ *f1, *f2) <= 0) {
q = f2; b = f1; t = l1;
sense = -1;
static I32
cmpindir(pTHX_ gptr a, gptr b)
{
- I32 sense;
gptr * const ap = (gptr *)a;
gptr * const bp = (gptr *)b;
+ const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
- if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp)) == 0)
- sense = (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
- return sense;
+ if (sense)
+ return sense;
+ return (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
}
static I32
cmpindir_desc(pTHX_ gptr a, gptr b)
{
- I32 sense;
gptr * const ap = (gptr *)a;
gptr * const bp = (gptr *)b;
+ const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
/* Reverse the default */
- if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp)))
+ if (sense)
return -sense;
/* But don't reverse the stability test. */
return (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
STATIC void
S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
- SV *hintsv;
- if (SORTHINTS(hintsv) & HINT_SORT_STABLE) {
+ dSORTHINTS;
+
+ if (SORTHINTS & HINT_SORT_STABLE) {
register gptr **pp, *q;
register size_t n, j, i;
gptr *small[SMALLSORT], **indir, tmp;
/* Small arrays can use the stack, big ones must be allocated */
if (nmemb <= SMALLSORT) indir = small;
- else { New(1799, indir, nmemb, gptr *); }
+ else { Newx(indir, nmemb, gptr *); }
/* Copy pointers to original array elements into indirect array */
for (n = nmemb, pp = indir, q = list1; n--; ) *pp++ = q++;
{
void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
= S_mergesortsv;
- SV *hintsv;
-
- /* Sun's Compiler (cc: WorkShop Compilers 4.2 30 Oct 1996 C 4.2) used
- to miscompile this function under optimization -O. If you get test
- errors related to picking the correct sort() function, try recompiling
- this file without optimiziation. -- A.D. 4/2002.
- */
- const I32 hints = SORTHINTS(hintsv);
+ dSORTHINTS;
+ const I32 hints = SORTHINTS;
if (hints & HINT_SORT_QUICKSORT) {
sortsvp = S_qsortsv;
}
{
void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
= S_mergesortsv;
- SV *hintsv;
-
- /* Sun's Compiler (cc: WorkShop Compilers 4.2 30 Oct 1996 C 4.2) used
- to miscompile this function under optimization -O. If you get test
- errors related to picking the correct sort() function, try recompiling
- this file without optimiziation. -- A.D. 4/2002.
- */
- const I32 hints = SORTHINTS(hintsv);
+ dSORTHINTS;
+ const I32 hints = SORTHINTS;
if (hints & HINT_SORT_QUICKSORT) {
sortsvp = S_qsortsv;
}
GV *gv;
CV *cv = 0;
I32 gimme = GIMME;
- OP* nextop = PL_op->op_next;
+ OP* const nextop = PL_op->op_next;
I32 overloading = 0;
bool hasargs = FALSE;
I32 is_xsub = 0;
if (gimme != G_ARRAY) {
SP = MARK;
+ EXTEND(SP,1);
RETPUSHUNDEF;
}
if (is_xsub)
PL_sortcop = (OP*)cv;
- else {
+ else
PL_sortcop = CvSTART(cv);
- SAVEVPTR(CvROOT(cv)->op_ppaddr);
- CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
-
- PAD_SET_CUR(CvPADLIST(cv), 1);
- }
}
}
else {
}
}
else {
+ if (SvREADONLY(av))
+ Perl_croak(aTHX_ PL_no_modify);
+ else
+ SvREADONLY_on(av);
p1 = p2 = AvARRAY(av);
sorting_av = 1;
}
CATCH_SET(TRUE);
PUSHSTACKi(PERLSI_SORT);
if (!hasargs && !is_xsub) {
- if (PL_sortstash != stash || !PL_firstgv || !PL_secondgv) {
- SAVESPTR(PL_firstgv);
- SAVESPTR(PL_secondgv);
- PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
- PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
- PL_sortstash = stash;
- }
+ SAVESPTR(PL_firstgv);
+ SAVESPTR(PL_secondgv);
+ SAVESPTR(PL_sortstash);
+ PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
+ PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
+ PL_sortstash = stash;
SAVESPTR(GvSV(PL_firstgv));
SAVESPTR(GvSV(PL_secondgv));
}
cx->cx_type = CXt_SUB;
cx->blk_gimme = G_SCALAR;
PUSHSUB(cx);
- }
- PL_sortcxix = cxstack_ix;
+ if (!is_xsub) {
+ AV* const padlist = CvPADLIST(cv);
+
+ if (++CvDEPTH(cv) >= 2) {
+ PERL_STACK_OVERFLOW_CHECK();
+ pad_push(padlist, CvDEPTH(cv));
+ }
+ SAVECOMPPAD();
+ PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
- if (hasargs && !is_xsub) {
- /* This is mostly copied from pp_entersub */
- AV *av = (AV*)PAD_SVl(0);
+ if (hasargs) {
+ /* This is mostly copied from pp_entersub */
+ AV *av = (AV*)PAD_SVl(0);
+
+ cx->blk_sub.savearray = GvAV(PL_defgv);
+ GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
+ CX_CURPAD_SAVE(cx->blk_sub);
+ cx->blk_sub.argarray = av;
+ }
- cx->blk_sub.savearray = GvAV(PL_defgv);
- GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
- CX_CURPAD_SAVE(cx->blk_sub);
- cx->blk_sub.argarray = av;
+ }
}
+ cx->cx_type |= CXp_MULTICALL;
start = p1 - max;
sortsvp(aTHX_ start, max,
is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
+ if (!(flags & OPf_SPECIAL)) {
+ LEAVESUB(cv);
+ if (!is_xsub)
+ CvDEPTH(cv)--;
+ }
POPBLOCK(cx,PL_curpm);
PL_stack_sp = newsp;
POPSTACK;
if (priv & OPpSORT_REVERSE) {
SV **q = start+max-1;
while (start < q) {
- SV *tmp = *start;
+ SV * const tmp = *start;
*start++ = *q;
*q-- = tmp;
}
}
}
- if (av && !sorting_av) {
+ if (sorting_av)
+ SvREADONLY_off(av);
+ else if (av && !sorting_av) {
/* simulate pp_aassign of tied AV */
SV** const base = ORIGMARK+1;
for (i=0; i < max; i++) {
av_extend(av, max);
for (i=0; i < max; i++) {
SV * const sv = base[i];
- SV **didstore = av_store(av, i, sv);
+ SV ** const didstore = av_store(av, i, sv);
if (SvSMAGICAL(sv))
mg_set(sv);
if (!didstore)
projects / p5sagit/p5-mst-13.2.git / blobdiff