From 8d344e3e57673a7c678a1daf0c8a5f11c220a8f9 Mon Sep 17 00:00:00 2001 From: Brian Ingerson Date: Sat, 29 Sep 2001 10:41:13 -0700 Subject: [PATCH] Patch to put qsortsv in the public API Message-ID: <20010929174113.A30223@ttul.org> p4raw-id: //depot/perl@12276 --- embed.h | 4 ++-- embed.pl | 2 +- global.sym | 1 + pod/perlapi.pod | 56 ++++++++++++++++++++++++++++++++++---------------------- pp_ctl.c | 22 ++++++++++++++++------ proto.h | 2 +- 6 files changed, 55 insertions(+), 32 deletions(-) diff --git a/embed.h b/embed.h index c19e445..87bdd03 100644 --- a/embed.h +++ b/embed.h @@ -401,6 +401,7 @@ #define mess Perl_mess #define vmess Perl_vmess #define qerror Perl_qerror +#define sortsv Perl_sortsv #define mg_clear Perl_mg_clear #define mg_copy Perl_mg_copy #define mg_find Perl_mg_find @@ -1006,7 +1007,6 @@ #define save_lines S_save_lines #define doeval S_doeval #define doopen_pmc S_doopen_pmc -#define qsortsv S_qsortsv #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) #define do_maybe_phash S_do_maybe_phash @@ -1936,6 +1936,7 @@ #endif #define vmess(a,b) Perl_vmess(aTHX_ a,b) #define qerror(a) Perl_qerror(aTHX_ a) +#define sortsv(a,b,c) Perl_sortsv(aTHX_ a,b,c) #define mg_clear(a) Perl_mg_clear(aTHX_ a) #define mg_copy(a,b,c,d) Perl_mg_copy(aTHX_ a,b,c,d) #define mg_find(a,b) Perl_mg_find(aTHX_ a,b) @@ -2518,7 +2519,6 @@ #define save_lines(a,b) S_save_lines(aTHX_ a,b) #define doeval(a,b) S_doeval(aTHX_ a,b) #define doopen_pmc(a,b) S_doopen_pmc(aTHX_ a,b) -#define qsortsv(a,b,c) S_qsortsv(aTHX_ a,b,c) #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) #define do_maybe_phash(a,b,c,d,e) S_do_maybe_phash(aTHX_ a,b,c,d,e) diff --git a/embed.pl b/embed.pl index e4dae1b..bc4ccfa 100755 --- a/embed.pl +++ b/embed.pl @@ -1472,6 +1472,7 @@ p |char* |mem_collxfrm |const char* s|STRLEN len|STRLEN* xlen Afp |SV* |mess |const char* pat|... Ap |SV* |vmess |const char* pat|va_list* args p |void |qerror |SV* err +Apd |void |sortsv |SV ** array|size_t num_elts|SVCOMPARE_t f Apd |int |mg_clear |SV* sv Apd |int |mg_copy |SV* sv|SV* nsv|const char* key|I32 klen Apd |MAGIC* |mg_find |SV* sv|int type @@ -2107,7 +2108,6 @@ s |I32 |dopoptosub_at |PERL_CONTEXT* cxstk|I32 startingblock s |void |save_lines |AV *array|SV *sv s |OP* |doeval |int gimme|OP** startop s |PerlIO *|doopen_pmc |const char *name|const char *mode -s |void |qsortsv |SV ** array|size_t num_elts|SVCOMPARE_t f #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) diff --git a/global.sym b/global.sym index ab477a0..28d86a5 100644 --- a/global.sym +++ b/global.sym @@ -219,6 +219,7 @@ Perl_grok_oct Perl_markstack_grow Perl_mess Perl_vmess +Perl_sortsv Perl_mg_clear Perl_mg_copy Perl_mg_find diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 12abd71..cf54c9a 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2021,6 +2021,18 @@ Recursively unlocks a shared sv. =for hackers Found in file sharedsv.c +=item sortsv + + +Sort an array in place. Here is an example: + + sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale); + + void sortsv(SV ** array, size_t num_elts, SVCOMPARE_t f) + +=for hackers +Found in file pp_ctl.c + =item SP Stack pointer. This is usually handled by C. See C and @@ -2385,22 +2397,22 @@ which guarantees to evaluate sv only once. =for hackers Found in file sv.h -=item SvNVx +=item SvNVX -Coerces the given SV to a double and returns it. Guarantees to evaluate -sv only once. Use the more efficent C otherwise. +Returns the raw value in the SV's NV slot, without checks or conversions. +Only use when you are sure SvNOK is true. See also C. - NV SvNVx(SV* sv) + NV SvNVX(SV* sv) =for hackers Found in file sv.h -=item SvNVX +=item SvNVx -Returns the raw value in the SV's NV slot, without checks or conversions. -Only use when you are sure SvNOK is true. See also C. +Coerces the given SV to a double and returns it. Guarantees to evaluate +sv only once. Use the more efficent C otherwise. - NV SvNVX(SV* sv) + NV SvNVx(SV* sv) =for hackers Found in file sv.h @@ -2594,21 +2606,21 @@ Like C, but converts sv to uft8 first if necessary. =for hackers Found in file sv.h -=item SvPVX +=item SvPVx -Returns a pointer to the physical string in the SV. The SV must contain a -string. +A version of C which guarantees to evaluate sv only once. - char* SvPVX(SV* sv) + char* SvPVx(SV* sv, STRLEN len) =for hackers Found in file sv.h -=item SvPVx +=item SvPVX -A version of C which guarantees to evaluate sv only once. +Returns a pointer to the physical string in the SV. The SV must contain a +string. - char* SvPVx(SV* sv, STRLEN len) + char* SvPVX(SV* sv) =for hackers Found in file sv.h @@ -2815,19 +2827,19 @@ false, defined or undefined. Does not handle 'get' magic. =for hackers Found in file sv.h -=item svtype +=item SvTYPE -An enum of flags for Perl types. These are found in the file B -in the C enum. Test these flags with the C macro. +Returns the type of the SV. See C. + + svtype SvTYPE(SV* sv) =for hackers Found in file sv.h -=item SvTYPE - -Returns the type of the SV. See C. +=item svtype - svtype SvTYPE(SV* sv) +An enum of flags for Perl types. These are found in the file B +in the C enum. Test these flags with the C macro. =for hackers Found in file sv.h diff --git a/pp_ctl.c b/pp_ctl.c index 8b320bf..54587e9 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1018,8 +1018,8 @@ PP(pp_sort) cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; } - qsortsv((myorigmark+1), max, - is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv); + sortsv((myorigmark+1), max, + is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv); POPBLOCK(cx,PL_curpm); PL_stack_sp = newsp; @@ -1030,8 +1030,8 @@ PP(pp_sort) else { if (max > 1) { MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ - qsortsv(ORIGMARK+1, max, - (PL_op->op_private & OPpSORT_NUMERIC) + sortsv(ORIGMARK+1, max, + (PL_op->op_private & OPpSORT_NUMERIC) ? ( (PL_op->op_private & OPpSORT_INTEGER) ? ( overloading ? amagic_i_ncmp : sv_i_ncmp) : ( overloading ? amagic_ncmp : sv_ncmp)) @@ -4036,8 +4036,18 @@ dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, SVCOMPARE_t cmp) ** They make convenient temporary pointers in other places. */ -STATIC void -S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp) +/* +=for apidoc sortsv + +Sort an array in place. Here is an example: + + sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale); + +=cut +*/ + +void +Perl_sortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp) { int i, run; int sense; diff --git a/proto.h b/proto.h index 9c1115c..44e0a03 100644 --- a/proto.h +++ b/proto.h @@ -459,6 +459,7 @@ PERL_CALLCONV SV* Perl_mess(pTHX_ const char* pat, ...) ; PERL_CALLCONV SV* Perl_vmess(pTHX_ const char* pat, va_list* args); PERL_CALLCONV void Perl_qerror(pTHX_ SV* err); +PERL_CALLCONV void Perl_sortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t f); PERL_CALLCONV int Perl_mg_clear(pTHX_ SV* sv); PERL_CALLCONV int Perl_mg_copy(pTHX_ SV* sv, SV* nsv, const char* key, I32 klen); PERL_CALLCONV MAGIC* Perl_mg_find(pTHX_ SV* sv, int type); @@ -1098,7 +1099,6 @@ STATIC I32 S_dopoptosub_at(pTHX_ PERL_CONTEXT* cxstk, I32 startingblock); STATIC void S_save_lines(pTHX_ AV *array, SV *sv); STATIC OP* S_doeval(pTHX_ int gimme, OP** startop); STATIC PerlIO * S_doopen_pmc(pTHX_ const char *name, const char *mode); -STATIC void S_qsortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t f); #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) -- 2.7.4