Work at SourceForge, help us to make it a better place! We have an immediate need for a Support Technician in our San Francisco or Denver office.
Close
From: Robert E. Brown <bbrown@sp...>  20040205 00:32:06

Enclosed is a patch to src/code/sort.lisp that reduces the number of times %COERCECALLABLETOFUN is invoked when sorting. I've lifted calls to this function out of macro VECTORMERGESORT and STABLESORTLIST and placed them directly in SORT and STABLESORT. bob ==================== Index: src/code/sort.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/sort.lisp,v retrieving revision 1.17 diff c r1.17 sort.lisp *** src/code/sort.lisp 20 Oct 2003 13:31:07 0000 1.17  src/code/sort.lisp 5 Feb 2004 00:23:22 0000 *************** *** 16,23 **** ;;; to generalize the CMU CL code to allow START and END values, this ;;; code has been written from scratch following Chapter 7 of ;;; _Introduction to Algorithms_ by Corman, Rivest, and Shamir. ! (defun sortvector (vector start end predicate key) ! (sortvector vector start end predicate key)) ;;; This is MAYBEINLINE because it's not too hard to have an ;;; application where sorting is a major bottleneck, and inlining it  16,23  ;;; to generalize the CMU CL code to allow START and END values, this ;;; code has been written from scratch following Chapter 7 of ;;; _Introduction to Algorithms_ by Corman, Rivest, and Shamir. ! (defun sortvector (vector start end predicatefun keyfunornil) ! (sortvector vector start end predicatefun keyfunornil)) ;;; This is MAYBEINLINE because it's not too hard to have an ;;; application where sorting is a major bottleneck, and inlining it *************** *** 28,42 **** #!+sbdoc "Destructively sort SEQUENCE. PREDICATE should return nonNIL if ARG1 is to precede ARG2." ! (let ((predicatefunction (%coercecallabletofun predicate)) ! (keyfunction (and key (%coercecallabletofun key)))) (typecase sequence ! (list (stablesortlist sequence predicatefunction keyfunction)) (vector ! (witharraydata ((vector (the vector sequence)) ! (start 0) ! (end (length sequence))) ! (sortvector vector start end predicatefunction keyfunction)) sequence) (t (error 'simpletypeerror  28,45  #!+sbdoc "Destructively sort SEQUENCE. PREDICATE should return nonNIL if ARG1 is to precede ARG2." ! (let ((predicatefun (%coercecallabletofun predicate))) (typecase sequence ! (list ! (stablesortlist sequence ! predicatefun ! (if key (%coercecallabletofun key) #'identity))) (vector ! (let ((keyfunornil (and key (%coercecallabletofun key)))) ! (witharraydata ((vector (the vector sequence)) ! (start 0) ! (end (length sequence))) ! (sortvector vector start end predicatefun keyfunornil))) sequence) (t (error 'simpletypeerror *************** *** 51,70 **** #!+sbdoc "Destructively sort SEQUENCE. PREDICATE should return nonNIL if ARG1 is to precede ARG2." ! (typecase sequence ! (simplevector ! (stablesortsimplevector sequence predicate key)) ! (list ! (stablesortlist sequence predicate key)) ! (vector ! (stablesortvector sequence predicate key)) ! (t ! (error 'simpletypeerror ! :datum sequence ! :expectedtype 'sequence ! :formatcontrol "~S is not a sequence." ! :formatarguments (list sequence))))) ! ;;; APPLYKEYEDPRED saves us a function call sometimes. (evalwhen (:compiletoplevel :execute) (sb!xc:defmacro applykeyedpred (one two pred key)  54,80  #!+sbdoc "Destructively sort SEQUENCE. PREDICATE should return nonNIL if ARG1 is to precede ARG2." ! (let ((predicatefun (%coercecallabletofun predicate))) ! (typecase sequence ! (simplevector ! (stablesortsimplevector sequence ! predicatefun ! (and key (%coercecallabletofun key)))) ! (list ! (stablesortlist sequence ! predicatefun ! (if key (%coercecallabletofun key) #'identity))) ! (vector ! (stablesortvector sequence ! predicatefun ! (and key (%coercecallabletofun key)))) ! (t ! (error 'simpletypeerror ! :datum sequence ! :expectedtype 'sequence ! :formatcontrol "~S is not a sequence." ! :formatarguments (list sequence)))))) ! ;;; APPLYKEYEDPRED saves us a function call sometimes. (evalwhen (:compiletoplevel :execute) (sb!xc:defmacro applykeyedpred (one two pred key) *************** *** 133,150 **** ;;; that is, there are only two runs that can be merged, the first run ;;; starting at the beginning of the list, and the second being the ;;; remaining elements. ! (defun stablesortlist (list pred key) (let ((head (cons :header list)) ; head holds on to everything (n 1) ; bottomup size of lists to be merged unsorted ; unsorted is the remaining list to be ; broken into n size lists and merged list1 ; list1 is one length n list to be merged ! last ; last points to the last visited cell ! (predfun (%coercecallabletofun pred)) ! (keyfun (if key ! (%coercecallabletofun key) ! #'identity))) ! (declare (fixnum n)) (loop ;; Start collecting runs of N at the first element. (setf unsorted (cdr head))  143,157  ;;; that is, there are only two runs that can be merged, the first run ;;; starting at the beginning of the list, and the second being the ;;; remaining elements. ! (defun stablesortlist (list predfun keyfun) (let ((head (cons :header list)) ; head holds on to everything (n 1) ; bottomup size of lists to be merged unsorted ; unsorted is the remaining list to be ; broken into n size lists and merged list1 ; list1 is one length n list to be merged ! last) ; last points to the last visited cell ! (declare (type function predfun keyfun) ! (type fixnum n)) (loop ;; Start collecting runs of N at the first element. (setf unsorted (cdr head)) *************** *** 309,318 **** (declaim (simplevector *mergesorttempvector*)) (defun stablesortsimplevector (vector pred key) ! (declare (simplevector vector)) (vectormergesort vector pred key svref)) (defun stablesortvector (vector pred key) (vectormergesort vector pred key aref)) ;;;; merging  316,329  (declaim (simplevector *mergesorttempvector*)) (defun stablesortsimplevector (vector pred key) ! (declare (type simplevector vector) ! (type function pred) ! (type (or null function) key)) (vectormergesort vector pred key svref)) (defun stablesortvector (vector pred key) + (declare (type function pred) + (type (or null function) key)) (vectormergesort vector pred key aref)) ;;;; merging 