static I32
cmp_desc(pTHX_ gptr const a, gptr const b)
{
- dVAR;
return -PL_sort_RealCmp(aTHX_ a, b);
}
STATIC void
S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
- dVAR;
IV i, run, offset;
I32 sense, level;
gptr *f1, *f2, *t, *b, *p;
}
}
}
-done:
+ done:
if (aux != small) Safefree(aux); /* free iff allocated */
if (flags) {
PL_sort_RealCmp = savecmp; /* Restore current comparison routine, if any */
elements in the middle of the partition, those are the ones we
pick here (conveniently pointed at by u_right, pc_left, and
u_left). The values of the left, center, and right elements
- are refered to as l c and r in the following comments.
+ are referred to as l c and r in the following comments.
*/
#ifdef QSORT_ORDER_GUESS
static I32
cmpindir(pTHX_ gptr const a, gptr const b)
{
- dVAR;
gptr * const ap = (gptr *)a;
gptr * const bp = (gptr *)b;
const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
static I32
cmpindir_desc(pTHX_ gptr const a, gptr const b)
{
- dVAR;
gptr * const ap = (gptr *)a;
gptr * const bp = (gptr *)b;
const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
STATIC void
S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
- dVAR;
if ((flags & SORTf_STABLE) != 0) {
gptr **pp, *q;
size_t n, j, i;
PP(pp_sort)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
SV **p1 = ORIGMARK+1, **p2;
SSize_t max, i;
AV* av = NULL;
GV *gv;
CV *cv = NULL;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
OP* const nextop = PL_op->op_next;
I32 overloading = 0;
bool hasargs = FALSE;
SAVEVPTR(PL_sortcop);
if (flags & OPf_STACKED) {
if (flags & OPf_SPECIAL) {
- OP *nullop = cLISTOP->op_first->op_sibling; /* pass pushmark */
+ OP *nullop = OpSIBLING(cLISTOP->op_first); /* pass pushmark */
assert(nullop->op_type == OP_NULL);
PL_sortcop = nullop->op_next;
}
for (i=max; i > 0 ; i--) {
if ((*p1 = *p2++)) { /* Weed out nulls. */
if (copytmps && SvPADTMP(*p1)) {
- assert(!IS_PADGV(*p1));
*p1 = sv_mortalcopy(*p1);
}
SvTEMP_off(*p1);
SAVESPTR(GvSV(PL_secondgv));
}
+ gimme = G_SCALAR;
PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
if (!(flags & OPf_SPECIAL)) {
cx->cx_type = CXt_SUB;
- cx->blk_gimme = G_SCALAR;
/* If our comparison routine is already active (CvDEPTH is
* is not 0), then PUSHSUB does not increase the refcount,
* so we have to do it ourselves, because the LEAVESUB fur-
static I32
S_sortcv(pTHX_ SV *const a, SV *const b)
{
- dVAR;
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
I32 result;
- SV *resultsv;
PMOP * const pm = PL_curpm;
- OP * const sortop = PL_op;
COP * const cop = PL_curcop;
PERL_ARGS_ASSERT_SORTCV;
PL_stack_sp = PL_stack_base;
PL_op = PL_sortcop;
CALLRUNOPS(aTHX);
- PL_op = sortop;
PL_curcop = cop;
- if (PL_stack_sp != PL_stack_base + 1) {
- assert(PL_stack_sp == PL_stack_base);
- resultsv = &PL_sv_undef;
- }
- else resultsv = *PL_stack_sp;
- if (SvNIOK_nog(resultsv)) result = SvIV(resultsv);
- else {
- ENTER;
- SAVEVPTR(PL_curpad);
- PL_curpad = 0;
- result = SvIV(resultsv);
- LEAVE;
- }
+ /* entry zero of a stack is always PL_sv_undef, which
+ * simplifies converting a '()' return into undef in scalar context */
+ assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
+ result = SvIV(*PL_stack_sp);
+
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
static I32
S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
{
- dVAR;
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
I32 result;
AV * const av = GvAV(PL_defgv);
PMOP * const pm = PL_curpm;
- OP * const sortop = PL_op;
COP * const cop = PL_curcop;
- SV **pad;
PERL_ARGS_ASSERT_SORTCV_STACKED;
PL_stack_sp = PL_stack_base;
PL_op = PL_sortcop;
CALLRUNOPS(aTHX);
- PL_op = sortop;
PL_curcop = cop;
- pad = PL_curpad; PL_curpad = 0;
- if (PL_stack_sp != PL_stack_base + 1) {
- assert(PL_stack_sp == PL_stack_base);
- result = SvIV(&PL_sv_undef);
- }
- else result = SvIV(*PL_stack_sp);
- PL_curpad = pad;
+ /* entry zero of a stack is always PL_sv_undef, which
+ * simplifies converting a '()' return into undef in scalar context */
+ assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
+ result = SvIV(*PL_stack_sp);
+
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
static I32
S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
{
- dVAR; dSP;
+ dSP;
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
CV * const cv=MUTABLE_CV(PL_sortcop);
*++SP = b;
PUTBACK;
(void)(*CvXSUB(cv))(aTHX_ cv);
- if (PL_stack_sp != PL_stack_base + 1)
- Perl_croak(aTHX_ "Sort subroutine didn't return single value");
+ /* entry zero of a stack is always PL_sv_undef, which
+ * simplifies converting a '()' return into undef in scalar context */
+ assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
result = SvIV(*PL_stack_sp);
+
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
static I32
S_amagic_ncmp(pTHX_ SV *const a, SV *const b)
{
- dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
PERL_ARGS_ASSERT_AMAGIC_NCMP;
static I32
S_amagic_i_ncmp(pTHX_ SV *const a, SV *const b)
{
- dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
PERL_ARGS_ASSERT_AMAGIC_I_NCMP;
static I32
S_amagic_cmp(pTHX_ SV *const str1, SV *const str2)
{
- dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
PERL_ARGS_ASSERT_AMAGIC_CMP;
return sv_cmp(str1, str2);
}
+#ifdef USE_LOCALE_COLLATE
+
static I32
S_amagic_cmp_locale(pTHX_ SV *const str1, SV *const str2)
{
- dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
PERL_ARGS_ASSERT_AMAGIC_CMP_LOCALE;
return sv_cmp_locale(str1, str2);
}
+#endif
+
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff