This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[perl #85104] TODO test for preserving $^E across signal handlers
[perl5.git]
/
pp_sort.c
diff --git
a/pp_sort.c
b/pp_sort.c
index
813cd2c
..
b65e9eb
100644
(file)
--- a/
pp_sort.c
+++ b/
pp_sort.c
@@
-185,8
+185,8
@@
static IV
dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp)
{
I32 sense;
dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp)
{
I32 sense;
-
register
gptr *b, *p, *q, *t, *p2;
-
register
gptr *last, *r;
+ gptr *b, *p, *q, *t, *p2;
+ gptr *last, *r;
IV runs = 0;
b = list1;
IV runs = 0;
b = list1;
@@
-354,7
+354,7
@@
S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
dVAR;
IV i, run, offset;
I32 sense, level;
dVAR;
IV i, run, offset;
I32 sense, level;
-
register
gptr *f1, *f2, *t, *b, *p;
+ gptr *f1, *f2, *t, *b, *p;
int iwhich;
gptr *aux;
gptr *p1;
int iwhich;
gptr *aux;
gptr *p1;
@@
-392,7
+392,7
@@
S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
list1 = which[iwhich]; /* area where runs are now */
list2 = which[++iwhich]; /* area for merged runs */
do {
list1 = which[iwhich]; /* area where runs are now */
list2 = which[++iwhich]; /* area for merged runs */
do {
-
register
gptr *l1, *l2, *tp2;
+ gptr *l1, *l2, *tp2;
offset = stackp->offset;
f1 = p1 = list1 + offset; /* start of first run */
p = tp2 = list2 + offset; /* where merged run will go */
offset = stackp->offset;
f1 = p1 = list1 + offset; /* start of first run */
p = tp2 = list2 + offset; /* where merged run will go */
@@
-422,7
+422,7
@@
S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
** and -1 when equality should look high.
*/
** and -1 when equality should look high.
*/
-
register
gptr *q;
+ gptr *q;
if (cmp(aTHX_ *f1, *f2) <= 0) {
q = f2; b = f1; t = l1;
sense = -1;
if (cmp(aTHX_ *f1, *f2) <= 0) {
q = f2; b = f1; t = l1;
sense = -1;
@@
-763,7
+763,7
@@
doqsort_all_asserts(
STATIC void /* the standard unstable (u) quicksort (qsort) */
S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
{
STATIC void /* the standard unstable (u) quicksort (qsort) */
S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
{
-
register
SV * temp;
+ SV * temp;
struct partition_stack_entry partition_stack[QSORT_MAX_STACK];
int next_stack_entry = 0;
int part_left;
struct partition_stack_entry partition_stack[QSORT_MAX_STACK];
int next_stack_entry = 0;
int part_left;
@@
-783,10
+783,10
@@
S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
/* Inoculate large partitions against quadratic behavior */
if (num_elts > QSORT_PLAY_SAFE) {
/* Inoculate large partitions against quadratic behavior */
if (num_elts > QSORT_PLAY_SAFE) {
-
register
size_t n;
-
register
SV ** const q = array;
+ size_t n;
+ SV ** const q = array;
for (n = num_elts; n > 1; ) {
for (n = num_elts; n > 1; ) {
-
register
const size_t j = (size_t)(n-- * Drand01());
+ const size_t j = (size_t)(n-- * Drand01());
temp = q[j];
q[j] = q[n];
q[n] = temp;
temp = q[j];
q[j] = q[n];
q[n] = temp;
@@
-1350,8
+1350,8
@@
S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
dVAR;
if ((flags & SORTf_STABLE) != 0) {
{
dVAR;
if ((flags & SORTf_STABLE) != 0) {
-
register
gptr **pp, *q;
-
register
size_t n, j, i;
+ gptr **pp, *q;
+ size_t n, j, i;
gptr *small[SMALLSORT], **indir, tmp;
SVCOMPARE_t savecmp;
if (nmemb <= 1) return; /* sorted trivially */
gptr *small[SMALLSORT], **indir, tmp;
SVCOMPARE_t savecmp;
if (nmemb <= 1) return; /* sorted trivially */
@@
-1432,7
+1432,7
@@
S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
Sort an array. Here is an example:
Sort an array. Here is an example:
- sortsv(AvARRAY(av), av_
len
(av)+1, Perl_sv_cmp_locale);
+ sortsv(AvARRAY(av), av_
top_index
(av)+1, Perl_sv_cmp_locale);
Currently this always uses mergesort. See sortsv_flags for a more
flexible routine.
Currently this always uses mergesort. See sortsv_flags for a more
flexible routine.
@@
-1473,8
+1473,8
@@
Perl_sortsv_flags(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
PP(pp_sort)
{
dVAR; dSP; dMARK; dORIGMARK;
PP(pp_sort)
{
dVAR; dSP; dMARK; dORIGMARK;
-
register
SV **p1 = ORIGMARK+1, **p2;
-
register I32
max, i;
+ SV **p1 = ORIGMARK+1, **p2;
+
SSize_t
max, i;
AV* av = NULL;
HV *stash;
GV *gv;
AV* av = NULL;
HV *stash;
GV *gv;
@@
-1483,6
+1483,7
@@
PP(pp_sort)
OP* const nextop = PL_op->op_next;
I32 overloading = 0;
bool hasargs = FALSE;
OP* const nextop = PL_op->op_next;
I32 overloading = 0;
bool hasargs = FALSE;
+ bool copytmps;
I32 is_xsub = 0;
I32 sorting_av = 0;
const U8 priv = PL_op->op_private;
I32 is_xsub = 0;
I32 sorting_av = 0;
const U8 priv = PL_op->op_private;
@@
-1586,9
+1587,12
@@
PP(pp_sort)
}
else {
if (SvREADONLY(av))
}
else {
if (SvREADONLY(av))
- Perl_croak_no_modify(
aTHX
);
+ Perl_croak_no_modify();
else
else
+ {
SvREADONLY_on(av);
SvREADONLY_on(av);
+ save_pushptr((void *)av, SAVEt_READONLY_OFF);
+ }
p1 = p2 = AvARRAY(av);
sorting_av = 1;
}
p1 = p2 = AvARRAY(av);
sorting_av = 1;
}
@@
-1601,8
+1605,11
@@
PP(pp_sort)
/* shuffle stack down, removing optional initial cv (p1!=p2), plus
* any nulls; also stringify or converting to integer or number as
* required any args */
/* shuffle stack down, removing optional initial cv (p1!=p2), plus
* any nulls; also stringify or converting to integer or number as
* required any args */
+ copytmps = !sorting_av && PL_sortcop;
for (i=max; i > 0 ; i--) {
if ((*p1 = *p2++)) { /* Weed out nulls. */
for (i=max; i > 0 ; i--) {
if ((*p1 = *p2++)) { /* Weed out nulls. */
+ if (copytmps && SvPADTMP(*p1) && !IS_PADGV(*p1))
+ *p1 = sv_mortalcopy(*p1);
SvTEMP_off(*p1);
if (!PL_sortcop) {
if (priv & OPpSORT_NUMERIC) {
SvTEMP_off(*p1);
if (!PL_sortcop) {
if (priv & OPpSORT_NUMERIC) {
@@
-1648,10
+1655,8
@@
PP(pp_sort)
if (!hasargs && !is_xsub) {
SAVESPTR(PL_firstgv);
SAVESPTR(PL_secondgv);
if (!hasargs && !is_xsub) {
SAVESPTR(PL_firstgv);
SAVESPTR(PL_secondgv);
- SAVESPTR(PL_sortstash);
PL_firstgv = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
PL_secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);
PL_firstgv = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
PL_secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);
- PL_sortstash = stash;
SAVESPTR(GvSV(PL_firstgv));
SAVESPTR(GvSV(PL_secondgv));
}
SAVESPTR(GvSV(PL_firstgv));
SAVESPTR(GvSV(PL_secondgv));
}
@@
-1667,7
+1672,7
@@
PP(pp_sort)
if (CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv);
PUSHSUB(cx);
if (!is_xsub) {
if (CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv);
PUSHSUB(cx);
if (!is_xsub) {
-
AV
* const padlist = CvPADLIST(cv);
+
PADLIST
* const padlist = CvPADLIST(cv);
if (++CvDEPTH(cv) >= 2) {
PERL_STACK_OVERFLOW_CHECK();
if (++CvDEPTH(cv) >= 2) {
PERL_STACK_OVERFLOW_CHECK();
@@
-1763,10
+1768,10
@@
S_sortcv(pTHX_ SV *const a, SV *const b)
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
I32 result;
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;
PMOP * const pm = PL_curpm;
OP * const sortop = PL_op;
COP * const cop = PL_curcop;
- SV **pad;
PERL_ARGS_ASSERT_SORTCV;
PERL_ARGS_ASSERT_SORTCV;
@@
-1777,13
+1782,19
@@
S_sortcv(pTHX_ SV *const a, SV *const b)
CALLRUNOPS(aTHX);
PL_op = sortop;
PL_curcop = cop;
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);
if (PL_stack_sp != PL_stack_base + 1) {
assert(PL_stack_sp == PL_stack_base);
- result = SvIV(&PL_sv_undef);
+ 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;
}
}
- else result = SvIV(*PL_stack_sp);
- PL_curpad = pad;
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
@@
-1918,7
+1929,7
@@
S_sv_i_ncmp(pTHX_ SV *const a, SV *const b)
#define SORT_NORMAL_RETURN_VALUE(val) (((val) > 0) ? 1 : ((val) ? -1 : 0))
static I32
#define SORT_NORMAL_RETURN_VALUE(val) (((val) > 0) ? 1 : ((val) ? -1 : 0))
static I32
-S_amagic_ncmp(pTHX_
register SV *const a, register
SV *const b)
+S_amagic_ncmp(pTHX_
SV *const a,
SV *const b)
{
dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
{
dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
@@
-1939,7
+1950,7
@@
S_amagic_ncmp(pTHX_ register SV *const a, register SV *const b)
}
static I32
}
static I32
-S_amagic_i_ncmp(pTHX_
register SV *const a, register
SV *const b)
+S_amagic_i_ncmp(pTHX_
SV *const a,
SV *const b)
{
dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
{
dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
@@
-1960,7
+1971,7
@@
S_amagic_i_ncmp(pTHX_ register SV *const a, register SV *const b)
}
static I32
}
static I32
-S_amagic_cmp(pTHX_
register SV *const str1, register
SV *const str2)
+S_amagic_cmp(pTHX_
SV *const str1,
SV *const str2)
{
dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
{
dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
@@
-1981,7
+1992,7
@@
S_amagic_cmp(pTHX_ register SV *const str1, register SV *const str2)
}
static I32
}
static I32
-S_amagic_cmp_locale(pTHX_
register SV *const str1, register
SV *const str2)
+S_amagic_cmp_locale(pTHX_
SV *const str1,
SV *const str2)
{
dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
{
dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);