develooper Front page | perl.perl5.porters | Postings from June 2004

Re: sort in scalar context, but broken due to inexperience.

From:
Nick Ing-Simmons
Date:
June 8, 2004 07:59
Subject:
Re: sort in scalar context, but broken due to inexperience.
Message ID:
20040608145931.3957.5@llama.elixent.com
David Nicol <davidnicol@pay2send.com> writes:
>Attached is a patch to pp_sort.c that adds code to give a sortedness
>ratio in scalar context.  


This looks like quite a big change for a return value which we seem
unable to reach consensus on. 
(I would still like sort in scalar context to return min or max value
 - don't care which because one can change cmp function to get the other.)

What can one use your sortedness value for?

>
>Empty and singleton arrays default to a sortedness ratio of 1.
>
>It currently appears to cause the last
>element of the array to be returned rather than the sv_newmortal
>loaded with the ratio, as desired.  
>Because I don't understand how
>exactly pp_sort is returning its return value.

In the usual on the stack way ;-)

values returned are 
  stack[ORIGMARK+1 .. SP] 

(There is a +1 on one end I may have it wrong way round...)

So where you have:

     PL_stack_sp = ORIGMARK + (sorting_av ? 0 : max);
+    if(gimme==G_SCALAR)
+    {
+	SV *r = sv_newmortal();
+	sv_setnv(r,scalar_result);
+	XPUSHs(r);
+    };

You probably want something like:

     PL_stack_sp = ORIGMARK;
     if(gimme==G_SCALAR)
     {
 	SV *r = sv_newmortal();
 	sv_setnv(r,scalar_result);
#if 0        
        SPAGAIN;   # XPUSH is in terms of 'sp' not PL_stack_sp
	XPUSHs(r);
        PUTBACK;   # get the sp back into PL_stack_sp
#else
       /* don't need EXTEND? */
        *++PL_stack_sp = r; 
#endif
     }
    else {
      PL_stack_sp += (sorting_av ? 0 : max);
    }

May be better expressed in terms of MSPAGAIN?

But note that 'sorting_av' thing - what sets that?


    


>Help?

I suspect your stack pointer is in the wrong place.
In an array context list is "left" on the stack having been re-arranged.
In scalar case you need to adjust SP to that just your scalar is 
returned.

>
>
>-- 
>davidnicol@pay2send.com
>"There's a fine line between participation and mockery" -- Scott Adams
>--- CURRENT/pp_sort.c	2004-03-16 12:42:23.000000000 -0600
>+++ ./BUILD_CURRENT/pp_sort.c	2004-06-07 22:22:32.000000000 -0500
>@@ -1423,14 +1423,18 @@
>     OP* nextop = PL_op->op_next;
>     I32 overloading = 0;
>     bool hasargs = FALSE;
>     I32 is_xsub = 0;
>     I32 sorting_av = 0;
>+    I32 j,goodpairs;
>+    double scalar_result = 1.0;
> 
>     if (gimme != G_ARRAY) {
>-	SP = MARK;
>-	RETPUSHUNDEF;
>+	if ( gimme != G_SCALAR ){
>+		SP = MARK;
>+		RETPUSHUNDEF;
>+	};
>     }
> 
>     ENTER;
>     SAVEVPTR(PL_sortcop);
>     if (PL_op->op_flags & OPf_STACKED) {
>@@ -1525,12 +1529,12 @@
> 	    max--;
>     }
>     if (sorting_av)
> 	AvFILLp(av) = max-1;
> 
>-    if (max > 1) {
>-	if (PL_sortcop) {
>+    if (max > 1) { /* max is number of elements */
>+       if (PL_sortcop) {
> 	    PERL_CONTEXT *cx;
> 	    SV** newsp;
> 	    bool oldcatch = CATCH_GET;
> 
> 	    SAVETMPS;
>@@ -1565,19 +1569,41 @@
> 		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;
> 	    }
>-           sortsv(p1-max, max,
>+            if(gimme == G_ARRAY){
>+             sortsv(p1-max, max,
>                   is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
>-
>+	    }
>+            else
>+	    {
>+            /*  sortednesssv(p1-max, max,
>+                  is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
>+	     */
>+		SV ** array;
>+		SVCOMPARE_t compare;
>+		array = p1-max;
>+		compare = (is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv); 
>+		j = 0;
>+		goodpairs = 0;
>+		while (j < max){
>+			i = j++;
>+        		if ((*compare)(aTHX_ array[i], array[j]) <= 0 )
>+				/* in order */
>+				goodpairs++;
>+		};
>+	        scalar_result = (goodpairs / (max - 1));
>+            };
> 	    POPBLOCK(cx,PL_curpm);
> 	    PL_stack_sp = newsp;
> 	    POPSTACK;
> 	    CATCH_SET(oldcatch);
> 	}
>-	else {
>+	else 
>+        {
>+          if (gimme==G_ARRAY){
> 	    MEXTEND(SP, 20);	/* Can't afford stack realloc on signal. */
> 	    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)
>@@ -1586,19 +1612,56 @@
> 			    ? ( overloading
> 				? amagic_cmp_locale
> 				: sv_cmp_locale_static)
> 			    : ( overloading ? amagic_cmp : sv_cmp_static)));
> 	    if (PL_op->op_private & OPpSORT_REVERSE) {
>-		SV **p = sorting_av ? AvARRAY(av) : ORIGMARK+1;
>+	  	SV **p = sorting_av ? AvARRAY(av) : ORIGMARK+1;
> 		SV **q = p+max-1;
> 		while (p < q) {
>-		    SV *tmp = *p;
>+                    SV *tmp = *p;
> 		    *p++ = *q;
> 		    *q-- = tmp;
> 		}
> 	    }
>-	}
>+          }
>+          else /* gimme a G_SCALAR */
>+	  {
>+            /* 
>+	       sortednesssv(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)
>+			    : ( overloading ? amagic_ncmp : sv_ncmp))
>+			: ( IN_LOCALE_RUNTIME
>+			    ? ( overloading
>+				? amagic_cmp_locale
>+				: sv_cmp_locale_static)
>+			    : ( overloading ? amagic_cmp : sv_cmp_static)));
>+	     */
>+		SV ** array;
>+		SVCOMPARE_t compare;
>+		array = (sorting_av ? AvARRAY(av) : ORIGMARK+1); 
>+		compare = ((PL_op->op_private & OPpSORT_NUMERIC)
>+			? ( (PL_op->op_private & OPpSORT_INTEGER)
>+			    ? ( overloading ? amagic_i_ncmp : sv_i_ncmp)
>+			    : ( overloading ? amagic_ncmp : sv_ncmp))
>+			: ( IN_LOCALE_RUNTIME
>+			    ? ( overloading
>+				? amagic_cmp_locale
>+				: sv_cmp_locale_static)
>+			    : ( overloading ? amagic_cmp : sv_cmp_static))); 
>+		j = 0;
>+		goodpairs = 0;
>+		while (j < max){
>+			i = j++;
>+        		if ((*compare)(aTHX_ array[i], array[j]) <= 0 )
>+				/* in order */
>+				goodpairs++;
>+		};
>+	        scalar_result = (goodpairs / (max - 1));
>+	  }
>+        }    
>     }
>     if (av && !sorting_av) {
> 	/* simulate pp_aassign of tied AV */
> 	SV *sv;
> 	SV** base, **didstore;
>@@ -1615,13 +1678,19 @@
> 	    if (SvSMAGICAL(sv))
> 		mg_set(sv);
> 	    if (!didstore)
> 		sv_2mortal(sv);
> 	}
>-    }
>+    };
>     LEAVE;
>     PL_stack_sp = ORIGMARK + (sorting_av ? 0 : max);
>+    if(gimme==G_SCALAR)
>+    {
>+	SV *r = sv_newmortal();
>+	sv_setnv(r,scalar_result);
>+	XPUSHs(r);
>+    };
>     return nextop;
> }
> 
> static I32
> sortcv(pTHX_ SV *a, SV *b)




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About