diff --git a/pkgs/racket-doc/scribblings/reference/pairs.scrbl b/pkgs/racket-doc/scribblings/reference/pairs.scrbl
index e40a2cf723..c2e579b59c 100644
--- a/pkgs/racket-doc/scribblings/reference/pairs.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/pairs.scrbl
@@ -528,7 +528,7 @@ which takes two elements of @racket[lst] and returns a true value if the
 first is less (i.e., should be sorted earlier) than the second.
 
 The sort is stable; if two elements of @racket[lst] are ``equal''
-(i.e., @racket[proc] does not return a true value when given the pair in
+(i.e., @racket[less-than?] does not return a true value when given the pair in
 either order), then the elements preserve their relative order from
 @racket[lst] in the output list.  To preserve this guarantee, use
 @racket[sort] with a strict comparison functions (e.g., @racket[<] or
diff --git a/pkgs/racket-doc/scribblings/reference/vectors.scrbl b/pkgs/racket-doc/scribblings/reference/vectors.scrbl
index bef5ff8dbd..dd0d12994f 100644
--- a/pkgs/racket-doc/scribblings/reference/vectors.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/vectors.scrbl
@@ -366,5 +366,56 @@ Like @racket[vector-member], but finds an element using @racket[eq?].
 (vector-memq 9 (vector 1 2 3 4))
 ]}
 
+@defproc[(vector-sort [vec vector?]
+                      [less-than? (any/c any/c . -> . any/c)]
+                      [start exact-nonnegative-integer? 0]
+                      [end exact-nonnegative-integer? (vector-length vec)]
+                      [#:key key (any/c . -> . any/c) (λ (x) x)]
+                      [#:cache-keys? cache-keys? boolean? #f])
+         vector?]{
+
+ Like @racket[sort], but operates on vectors; a 
+ @emph{fresh} vector of length @racket[(- end start)] is
+ returned containing the elements from indices 
+ @racket[start] (inclusive) through @racket[end] (exclusive)
+ of @racket[vec], but in sorted order (i.e., @racket[vec] is
+ not modified). This sort is stable (i.e., the order of ``equal''
+ elements is preserved).
+ 
+@mz-examples[#:eval vec-eval
+(define v1 (vector 4 3 2 1))
+(vector-sort v1 <)
+v1
+(define v2 (vector '(4) '(3) '(2) '(1)))
+(vector-sort v2 < 1 3 #:key car)
+v2]
+
+@history[#:added "6.6.0.5"]{}
+}
+
+@defproc[(vector-sort! [vec (and/c vector? (not/c immutable?))]
+                       [less-than? (any/c any/c . -> . any/c)]
+                       [start exact-nonnegative-integer? 0]
+                       [end exact-nonnegative-integer? (vector-length vec)]
+                       [#:key key (any/c . -> . any/c) (λ (x) x)]
+                       [#:cache-keys? cache-keys? boolean? #f])
+         void?]{
+
+ Like @racket[vector-sort], but @emph{updates} indices
+ @racket[start] (inclusive) through @racket[end] (exclusive)
+ of @racket[vec] by sorting them according to the @racket[less-than?]
+ procedure.
+
+@mz-examples[#:eval vec-eval
+(define v1 (vector 4 3 2 1))
+(vector-sort! v1 <)
+v1
+(define v2 (vector '(4) '(3) '(2) '(1)))
+(vector-sort! v2 < 1 3 #:key car)
+v2]
+
+@history[#:added "6.6.0.5"]{}
+}
+
 
 @close-eval[vec-eval]
diff --git a/pkgs/racket-test-core/tests/racket/vector.rktl b/pkgs/racket-test-core/tests/racket/vector.rktl
index b5f8c744a6..5775d3ee66 100644
--- a/pkgs/racket-test-core/tests/racket/vector.rktl
+++ b/pkgs/racket-test-core/tests/racket/vector.rktl
@@ -229,4 +229,197 @@
   (err/rt-test (vector-map (lambda (x) x) #() #() #()) (check-regs #rx"vector-map" #rx"mismatch between procedure arity")))
 
 
+;; ---------- vector-sort basic ----------
+(test #("a" "b" "c" "c" "d" "e" "f")
+      vector-sort
+      #("d" "f" "e" "c" "a" "c" "b")
+      string<?)
+(test #("a" "c" "e")
+      vector-sort
+      #("d" "f" "e" "c" "a" "c" "b")
+      string<?
+      2
+      5)
+(test #(("a") ("c") ("e"))
+      vector-sort
+      #(("d") ("f") ("e") ("c") ("a") ("c") ("b"))
+      string<?
+      2
+      5
+      #:key car)
+(test #(("a") ("c") ("e"))
+      vector-sort
+      #(("d") ("f") ("e") ("c") ("a") ("c") ("b"))
+      string<?
+      2
+      5
+      #:key car
+      #:cache-keys? #t)
+
+(let ()
+  (define (car< x y) (< (car x) (car y)))
+  (define (random-vec n range)
+    (build-vector n (λ _ (list (random range)))))
+  ;; sort a vector, then sort it with a #:key and with #:cache-keys?
+  ;; and make sure they're all doing the same thing
+  (define (vector-sort* v [start 0] [end (vector-length v)])
+    (let ([v1 (vector-sort v car< start end)]
+          [v2 (vector-sort v < start end #:key car)]
+          [v3 (vector-sort v < start end #:key car #:cache-keys? #t)])
+      (test #t equal? v1 v2)
+      (test #t equal? v1 v3)
+      v1))
+  (define (test-sort len times)
+    (or (zero? times)
+        ;; build a random vector, sort it, check that it's sorted
+        (and (let* ([rand (random-vec len (if (even? times) 1000000 10))]
+                    [sorted (vector-sort* rand)])
+               (and (= len (vector-length sorted))
+                    (or (<= len 1)
+                        (let loop ([i 0] [i+1 1])
+                          (or (= i+1 len)
+                              (and (let ([ival   (car (vector-ref sorted i))]
+                                         [i+1val (car (vector-ref sorted i+1))])
+                                     (<= ival i+1val))
+                                   (loop (add1 i) (add1 i+1))))))))
+             (test-sort len (sub1 times)))))
+  (test #t test-sort    1  10)
+  (test #t test-sort    2  20)
+  (test #t test-sort    3  60)
+  (test #t test-sort    4 100)
+  (test #t test-sort    5 100)
+  (test #t test-sort   10 100)
+  (test #t test-sort  100 100)
+  (test #t test-sort 1000 100)
+  ;; test stability for vector-sort
+  (test #((1) (2) (3 a) (3 b) (3 c)) vector-sort* #((3 a) (1) (3 b) (2) (3 c)))
+  ;; test short lists (+ stable)
+  (test #() vector-sort* #())
+  (test #((1 1)) vector-sort* #((1 1)))
+  (test #((1 2) (1 1)) vector-sort* #((1 2) (1 1)))
+  (test #((1) (2)) vector-sort* #((2) (1)))
+  (for-each (λ (v) (test #((0 3) (1 1) (1 2)) vector-sort* v))
+            '(#((1 1) (1 2) (0 3))
+              #((1 1) (0 3) (1 2))
+              #((0 3) (1 1) (1 2))))
+  (for-each (λ (v) (test #((0 2) (0 3) (1 1)) vector-sort* v))
+            '(#((1 1) (0 2) (0 3))
+              #((0 2) (1 1) (0 3))
+              #((0 2) (0 3) (1 1))))
+  ;; exhaustive tests for 2 and 3 item lists
+  (for-each (λ (v) (test #((1 x) (2 y)) vector-sort* v))
+            '(#((1 x) (2 y))
+              #((2 y) (1 x))))
+  (for-each (λ (v) (test #((1 x) (2 y) (3 z)) vector-sort* v))
+            '(#((1 x) (2 y) (3 z))
+              #((2 y) (1 x) (3 z))
+              #((2 y) (3 z) (1 x))
+              #((3 z) (2 y) (1 x))
+              #((3 z) (1 x) (2 y))
+              #((1 x) (3 z) (2 y))))
+  (test #((2)) vector-sort* #((4) (2) (1) (3)) 1 2)
+  (test #((1) (2)) vector-sort* #((4) (2) (1) (3)) 1 3)
+  (test #((1) (2) (3)) vector-sort* #((4) (2) (1) (3)) 1 4)
+  (test #((1) (2) (4)) vector-sort* #((4) (2) (1) (3)) 0 3)
+  (test #((1) (2) (3) (4) (5) (6) (7) (8)) vector-sort*
+        #((4) (2) (1) (3) (6) (5) (8) (7) (10) (9))
+        0 8)
+  (test #((1) (3) (5) (6) (7) (8) (9) (10)) vector-sort*
+        #((4) (2) (1) (3) (6) (5) (8) (7) (10) (9))
+        2 10)
+
+  (define ((check-regs . regexps) exn)
+    (and (exn:fail? exn)
+         (andmap (λ (reg) (regexp-match reg (exn-message exn)))
+                 regexps)))
+
+  (err/rt-test (vector-sort! (list 1) <) (check-regs #rx"vector-sort!" #rx"vector" #rx"immutable"))
+  (err/rt-test (vector-sort! #(1) <) (check-regs #rx"vector-sort!" #rx"vector" #rx"immutable"))
+  (err/rt-test (vector-sort (list 1) <) (check-regs #rx"vector-sort" #rx"vector"))
+  (err/rt-test (vector-sort! (vector 1) 1) (check-regs #rx"vector-sort!" #rx"any/c any/c . -> . any/c"))
+  (err/rt-test (vector-sort (vector 1) 1) (check-regs #rx"vector-sort" #rx"any/c any/c . -> . any/c"))
+  (err/rt-test (vector-sort! (vector 1) (λ (x) x)) (check-regs #rx"vector-sort!" #rx"any/c any/c . -> . any/c"))
+  (err/rt-test (vector-sort (vector 1) (λ (x) x)) (check-regs #rx"vector-sort" #rx"any/c any/c . -> . any/c"))
+  (err/rt-test (vector-sort! (vector 1) < #:key 42) (check-regs #rx"vector-sort!" #rx"any/c . -> . any/c"))
+  (err/rt-test (vector-sort! (vector 1) < #:key <) (check-regs #rx"vector-sort!" #rx"any/c . -> . any/c"))
+  (err/rt-test (vector-sort (vector 1) < #:key 42) (check-regs #rx"vector-sort" #rx"any/c . -> . any/c"))
+  (err/rt-test (vector-sort (vector 1) < #:key <) (check-regs #rx"vector-sort" #rx"any/c . -> . any/c")))
+
+;; ---------- vector-sort! actually mutates arg, and vector-sort does not  ----------
+;; verify underlying vector is sorted
+(let ([v (vector 3 2 1)])
+  (vector-sort! v <)
+  (test #t
+        equal?
+        v
+        (vector 1 2 3)))
+(let ([v (vector "d" "f" "e" "c" "a" "c" "b")])
+  (vector-sort! v string<? 2 5)
+  (test #t
+        equal?
+        v
+        (vector "d" "f" "a" "c" "e" "c" "b")))
+;; verify underlying vector is unchanged
+(let ([v (vector 3 2 1)])
+  (vector-sort v <)
+  (test #t
+        equal?
+        v
+        (vector 3 2 1)))
+(let ([v (vector "d" "f" "e" "c" "a" "c" "b")])
+  (vector-sort v string<? 2 5)
+  (test #t
+        equal?
+        v
+        (vector "d" "f" "e" "c" "a" "c" "b")))
+
+;; test #:key and #:cache-keys?
+(let ()
+  (define v #((0) (9) (1) (8) (2) (7) (3) (6) (4) (5)))
+  (define sorted #((0) (1) (2) (3) (4) (5) (6) (7) (8) (9)))
+  (test sorted vector-sort v < #:key car)
+  (let ([c1 0] [c2 0] [touched '()])
+    (test sorted
+          vector-sort v (λ (x y) (set! c1 (add1 c1)) (< x y))
+          #:key (λ (x)
+                  (set! c2 (add1 c2))
+                  (set! touched (cons x touched))
+                  (car x)))
+    ;; test that the number of key uses is half the number of comparisons
+    (test #t = (* 2 c1) c2)
+    ;; and that this is larger than the number of items in the list
+    (test #t < (vector-length v) c2)
+    ;; and that every item was touched
+    (test null remove* touched (vector->list v)))
+  (let ([c 0] [touched '()])
+    ;; now cache the keys
+    (test sorted
+          vector-sort v <
+          #:key (λ (x)
+                  (set! c (add1 c))
+                  (set! touched (cons x touched))
+                  (car x))
+          #:cache-keys? #t)
+    ;; test that the number of key uses is the same as the list length
+    (test #t = c (vector-length v))
+    ;; and that every item was touched
+    (test null remove* touched (vector->list v)))
+  (let* ([c 0] [getkey (λ (x) (set! c (add1 c)) x)])
+    ;; either way, we never use the key proc on no arguments
+    (test #() vector-sort #() < #:key getkey #:cache-keys? #f)
+    (test #() vector-sort #() < #:key getkey #:cache-keys? #t)
+    (test #t = c 0)
+    ;; we also don't use it for 1-arg lists
+    (test #(1) vector-sort #(1) < #:key getkey #:cache-keys? #f)
+    (test #t = c 0)
+    ;; but we do use it once if caching happens (it's a consistent interface)
+    (test #(1) vector-sort #(1) < #:key getkey #:cache-keys? #t)
+    (test #t = c 1)
+    ;; check a few other short lists
+    (test #(1 2) vector-sort #(2 1) < #:key getkey #:cache-keys? #t)
+    (test #(1 2 3) vector-sort #(2 3 1) < #:key getkey #:cache-keys? #t)
+    (test #(1 2 3 4) vector-sort #(4 2 3 1) < #:key getkey #:cache-keys? #t)
+    (test #t = c 10)))
+
+
 (report-errs)
diff --git a/racket/collects/racket/private/sort.rkt b/racket/collects/racket/private/sort.rkt
index c7a66ca291..ae824ba9db 100644
--- a/racket/collects/racket/private/sort.rkt
+++ b/racket/collects/racket/private/sort.rkt
@@ -2,7 +2,11 @@
 
 (#%require "small-scheme.rkt" "define.rkt" (for-syntax "stxcase-scheme.rkt"))
 
-(#%provide sort)
+;; note, these are the raw interfaces --- user-facing definitions
+;; are exported from private/list.rkt and vector.rkt
+(#%provide sort
+           vector-sort
+           vector-sort!)
 
 #|
 
@@ -17,11 +21,6 @@ function, or precompiled versions with inlinable common comparison
 predicates) -- they are local macros so they're not left in the compiled
 code.
 
-Note that there is no error checking on the arguments -- the `sort' function
-that this module provide is then wrapped up by a keyworded version in
-"racket/private/list.rkt", and that's what everybody sees.  The wrapper is
-doing these checks.
-
 |#
 
 ;; This code works with unsafe operations, if there are problems, the commented
@@ -31,192 +30,390 @@ doing these checks.
            (rename '#%unsafe i= unsafe-fx=)
            (rename '#%unsafe i< unsafe-fx<)
            (rename '#%unsafe i<= unsafe-fx<=)
+           (rename '#%unsafe i> unsafe-fx>)
+           (rename '#%unsafe i>= unsafe-fx>=)
            (rename '#%unsafe i>> unsafe-fxrshift)
+           (rename '#%unsafe i<< unsafe-fxlshift)
            (rename '#%unsafe vref unsafe-vector-ref)
-           (rename '#%unsafe vset! unsafe-vector-set!))
+           (rename '#%unsafe vset! unsafe-vector-set!)
+           (rename '#%unsafe ucar unsafe-car)
+           (rename '#%unsafe ucdr unsafe-cdr)
+           (rename '#%unsafe unsafe-fl< unsafe-fl<)
+           (rename '#%unsafe unsafe-fl<= unsafe-fl<=)
+           (rename '#%unsafe unsafe-fl> unsafe-fl>)
+           (rename '#%unsafe unsafe-fl>= unsafe-fl>=))
 
-(define sort (let ()
+(define-values (sort
+                vector-sort
+                vector-sort!)
+(let ()
 
-(define-syntax define-syntax-rule
-  (syntax-rules ()
-    [(dr (foo . pattern) template)
-     (define-syntax foo (syntax-rules () [(_ . pattern) template]))]))
+  (define-syntax define-syntax-rule
+    (syntax-rules ()
+      [(dr (foo . pattern) template)
+       (define-syntax foo (syntax-rules () [(_ . pattern) template]))]))
+  
+  ;; Use this to make it safe:
+  ;;(define-syntax-rule (i+ x y) (+ x y))
+  ;;(define-syntax-rule (i- x y) (- x y))
+  ;;(define-syntax-rule (i= x y) (= x y))
+  ;;(define-syntax-rule (i< x y) (< x y))
+  ;;(define-syntax-rule (i<= x y) (<= x y))
+  ;;(define-syntax-rule (i>> x y) (arithmetic-shift x (- y)))
+  ;;(define-syntax-rule (i<< x y) (arithmetic-shift x y))
+  ;;(define-syntax-rule (vref v i) (vector-ref v i))
+  ;;(define-syntax-rule (vset! v i x) (vector-set! v i x))
+  ;;(define ucar car)
+  ;;(define ucdr cdr)
 
-;; Use this to make it safe:
-;; (define-syntax-rule (i+ x y) (+ x y))
-;; (define-syntax-rule (i- x y) (- x y))
-;; (define-syntax-rule (i= x y) (= x y))
-;; (define-syntax-rule (i< x y) (< x y))
-;; (define-syntax-rule (i<= x y) (<= x y))
-;; (define-syntax-rule (i>> x y) (arithmetic-shift x (- y)))
-;; (define-syntax-rule (vref v i) (vector-ref v i))
-;; (define-syntax-rule (vset! v i x) (vector-set! v i x))
-
-(define-syntax-rule (sort-internal-body v *<? n has-getkey? getkey)
-  (let* ([n/2- (i>> n 1)] [n/2+ (i- n n/2-)])
-    (define-syntax-rule (<? x y)
-      (if has-getkey? (*<? (getkey x) (getkey y)) (*<? x y)))
-    (define-syntax-rule (ref n) (vref v n))
-    (define-syntax-rule (set! n x) (vset! v n x))
-
-    (define-syntax-rule (merge lo? A1 A2 B1 B2 C1)
-      (let ([b2 B2])
-        (let loop ([a1 A1] [b1 B1] [c1 C1])
-          (let ([x (ref a1)] [y (ref b1)])
-            (if (if lo? (not (<? y x)) (<? x y))
-              (begin (set! c1 x)
-                     (let ([a1 (i+ a1 1)] [c1 (i+ c1 1)])
-                       (when (i< c1 b1) (loop a1 b1 c1))))
-              (begin (set! c1 y)
-                     (let ([b1 (i+ b1 1)] [c1 (i+ c1 1)])
-                       (if (i<= b2 b1)
-                         (let loop ([a1 a1] [c1 c1])
-                           (when (i< c1 b1)
-                             (set! c1 (ref a1))
-                             (loop (i+ a1 1) (i+ c1 1))))
-                         (loop a1 b1 c1)))))))))
-
-    (define-syntax-rule (copying-insertionsort Alo Blo n)
-      ;; n is never 0
-      (begin (set! Blo (ref Alo))
-             (let iloop ([i 1])
-               (when (i< i n)
-                 (let ([ref-i (ref (i+ Alo i))])
-                   (let jloop ([j (i+ Blo i)])
-                     (let ([ref-j-1 (ref (i- j 1))])
-                       (if (and (i< Blo j) (<? ref-i ref-j-1))
-                         (begin (set! j ref-j-1) (jloop (i- j 1)))
-                         (begin (set! j ref-i) (iloop (i+ i 1)))))))))))
-
-    (define (copying-mergesort Alo Blo n)
-      (cond
-        ;; n is never 0, smaller values are more frequent
-        [(i= n 1) (set! Blo (ref Alo))]
-        [(i= n 2) (let ([x (ref Alo)] [y (ref (i+ Alo 1))])
-                    (if (<? y x)
-                      (begin (set! Blo y) (set! (i+ Blo 1) x))
-                      (begin (set! Blo x) (set! (i+ Blo 1) y))))]
-        ;; insertion sort for small chunks (not much difference up to ~30)
-        [(i< n 16) (copying-insertionsort Alo Blo n)]
-        [else (let* ([n/2- (i>> n 1)] [n/2+ (i- n n/2-)])
-                (let ([Amid1 (i+ Alo n/2-)]
-                      [Amid2 (i+ Alo n/2+)]
-                      [Bmid1 (i+ Blo n/2-)])
-                  (copying-mergesort Amid1 Bmid1 n/2+)
-                  (copying-mergesort Alo Amid2 n/2-)
-                  (merge #t Amid2 (i+ Alo n) Bmid1 (i+ Blo n) Blo)))]))
-
-    (let ([Alo 0] [Amid1 n/2-] [Amid2 n/2+] [Ahi n] [B1lo n])
-      (copying-mergesort Amid1 B1lo n/2+)
-      (unless (zero? n/2-) (copying-mergesort Alo Amid2 n/2-))
-      (merge #f B1lo (i+ B1lo n/2+) Amid2 Ahi Alo))))
-
-(define sort-internals (make-hasheq))
-(define _
-  (let ()
-    (define-syntax-rule (precomp <? more ...)
-      (let ([proc (lambda (vec n) (sort-internal-body vec <? n #f #f))])
-        (hash-set! sort-internals <? proc)
-        (hash-set! sort-internals more proc) ...))
-    (precomp < <=)
-    (precomp > >=)
-    (precomp string<? string<=?)
-    (precomp string-ci<? string-ci<=?)
-    (precomp keyword<?)))
-
-(define-syntax sort-internal
-  (syntax-rules ()
-    [(_ <? vec n)
-     (let ([si (hash-ref sort-internals <? #f)])
-       (if si
-         ;; use a precompiled function if found
-         (si vec n)
-         ;; otherwise, use the generic code
-         (let () (sort-internal-body vec <? n #f #f))))]
-    [(_ <? vec n getkey)
-     (let () (sort-internal-body vec <? n #t getkey))]))
-
-(define-syntax-rule (sort-body lst *<? has-getkey? getkey cache-keys?)
-  (let ([n (length lst)])
-    (define-syntax-rule (<? x y)
-      (if has-getkey? (*<? (getkey x) (getkey y)) (*<? x y)))
-    (cond
-      ;; trivial case
-      [(= n 0) lst]
-      ;; below we can assume a non-empty input list
-      [cache-keys?
-       ;; decorate while converting to a vector, and undecorate when going
-       ;; back, always do this for consistency
-       (let ([vec (make-vector (+ n (ceiling (/ n 2))))])
-         ;; list -> decorated-vector
-         (let loop ([i 0] [lst lst])
-           (when (pair? lst)
-             (let ([x (car lst)])
-               (vector-set! vec i (cons (getkey x) x))
-               (loop (add1 i) (cdr lst)))))
-         ;; sort
-         (sort-internal *<? vec n car)
-         ;; decorated-vector -> list
-         (let loop ([i n] [r '()])
-           (let ([i (sub1 i)])
-             (if (< i 0) r (loop i (cons (cdr (vector-ref vec i)) r))))))]
-      ;; trivial cases
-      [(< n 2) lst]
-      ;; check if the list is already sorted (which can be common, eg,
-      ;; directory lists)
-      [(let loop ([last (car lst)] [next (cdr lst)])
-         (or (null? next)
-             (and (not (<? (car next) last))
-                  (loop (car next) (cdr next)))))
-       lst]
-      ;; below we can assume an unsorted list
-      ;; inlined case, for optimization of short lists
-      [(<= n 3)
-       (if (= n 2)
-         ;; (because of the above test, we can assume that the input is
-         ;; unsorted)
-         (list (cadr lst) (car lst))
-         (let ([a (car lst)] [b (cadr lst)] [c (caddr lst)])
-           ;; General note: we need a stable sort, so we should always compare
-           ;; (<? later-item earlier-item) since it gives more information.  A
-           ;; good way to see that we have good code is to check that each
-           ;; permutation appears exactly once.  This means that n=4 will have
-           ;; 23 cases, so don't bother.  (Homework: write a macro to generate
-           ;; code for a specific N.  Bonus: prove correctness.  Extra bonus:
-           ;; prove optimal solution.  Extra extra bonus: prove optimal
-           ;; solution exists, extract macro from proof.)
-           (let ([a (car lst)] [b (cadr lst)] [c (caddr lst)])
-             (if (<? b a)
-               ;; b<a
-               (if (<? c b)
-                 (list c b a)
-                 ;; b<a, b<=c
-                 (if (<? c a) (list b c a) (list b a c)))
-               ;; a<=b, so c<b (b<=c is impossible due to above test)
-               (if (<? c a) (list c a b) (list a c b))))))]
-      [else (let ([vec (make-vector (+ n (ceiling (/ n 2))))])
-              ;; list -> vector
-              (let loop ([i 0] [lst lst])
-                (when (pair? lst)
-                  (vector-set! vec i (car lst))
-                  (loop (add1 i) (cdr lst))))
+  (define-syntax-rule (i/2 x) (i>> x 1))
+  (define-syntax-rule (i*2 x) (i<< x 1))
+  
+  (define-syntax-rule (sort-internal-body A less-than? n key)
+    (let ()
+      ;; comparison & vector access macros
+      (define-syntax-rule (<? x y)
+        (if key
+            (less-than? (key x) (key y))
+            (less-than? x y)))
+      (define-syntax-rule (ref index) (vref A index))
+      (define-syntax-rule (set! index val) (vset! A index val))
+      ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      ;; Stable Sort (Mergesort)
+      ;; (used by `sort', `vector-sort', and `vector-sort!')
+      ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+      ;; Based on "Fast mergesort implementation based on half-copying merge algorithm",
+      ;; Cezary Juszczak, http://kicia.ift.uni.wroc.pl/algorytmy/mergesortpaper.pdf
+      ;; Written in Racket by Eli Barzilay.  (Note: the reason for the seemingly
+      ;; redundant pointer arithmetic in that paper is dealing with cases of uneven
+      ;; number of elements.)
+      (let* ([n/2- (i/2 n)]
+             [n/2+ (i- n n/2-)])
+        ;; - - - - - - - - - - - - - - - - - - -
+        ;; Merge
+        ;; - - - - - - - - - - - - - - - - - - -
+        (define-syntax-rule (merge lo? A1 A2 B1 B2 C1)
+          (let ([b2 B2])
+            (let loop ([a1 A1] [b1 B1] [c1 C1])
+              (let ([x (ref a1)] [y (ref b1)])
+                (if (if lo? (not (<? y x)) (<? x y))
+                    (begin (set! c1 x)
+                           (let ([a1 (i+ a1 1)] [c1 (i+ c1 1)])
+                             (when (i< c1 b1) (loop a1 b1 c1))))
+                    (begin (set! c1 y)
+                           (let ([b1 (i+ b1 1)] [c1 (i+ c1 1)])
+                             (if (i<= b2 b1)
+                                 (let loop ([a1 a1] [c1 c1])
+                                   (when (i< c1 b1)
+                                     (set! c1 (ref a1))
+                                     (loop (i+ a1 1) (i+ c1 1))))
+                                 (loop a1 b1 c1)))))))))
+        
+        ;; - - - - - - - - - - - - - - - - - - -
+        ;; copying-insertionsort
+        ;; - - - - - - - - - - - - - - - - - - -
+        (define-syntax-rule (copying-insertionsort Alo Blo n)
+          ;; n is never 0
+          (begin (set! Blo (ref Alo))
+                 (let iloop ([i 1])
+                   (when (i< i n)
+                     (let ([ref-i (ref (i+ Alo i))])
+                       (let jloop ([j (i+ Blo i)])
+                         (let ([ref-j-1 (ref (i- j 1))])
+                           (if (and (i< Blo j) (<? ref-i ref-j-1))
+                               (begin (set! j ref-j-1) (jloop (i- j 1)))
+                               (begin (set! j ref-i) (iloop (i+ i 1)))))))))))
+        
+        ;; - - - - - - - - - - - - - - - - - - -
+        ;; Mergesort
+        ;; - - - - - - - - - - - - - - - - - - -
+        (define (copying-mergesort Alo Blo n)
+          (cond
+            ;; n is never 0, smaller values are more frequent
+            [(i= n 1) (set! Blo (ref Alo))]
+            [(i= n 2) (let ([x (ref Alo)] [y (ref (i+ Alo 1))])
+                        (if (<? y x)
+                            (begin (set! Blo y) (set! (i+ Blo 1) x))
+                            (begin (set! Blo x) (set! (i+ Blo 1) y))))]
+            ;; insertion sort for small chunks (not much difference up to ~30)
+            [(i< n 16) (copying-insertionsort Alo Blo n)]
+            [else (let* ([n/2- (i/2 n)]
+                         [n/2+ (i- n n/2-)])
+                    (let ([Amid1 (i+ Alo n/2-)]
+                          [Amid2 (i+ Alo n/2+)]
+                          [Bmid1 (i+ Blo n/2-)])
+                      (copying-mergesort Amid1 Bmid1 n/2+)
+                      (copying-mergesort Alo Amid2 n/2-)
+                      (merge #t Amid2 (i+ Alo n) Bmid1 (i+ Blo n) Blo)))]))
+        ;; start the sorting!
+        (let ([Alo 0] [Amid1 n/2-] [Amid2 n/2+] [Ahi n] [B1lo n])
+          (copying-mergesort Amid1 B1lo n/2+)
+          (unless (zero? n/2-) (copying-mergesort Alo Amid2 n/2-))
+          (merge #f B1lo (i+ B1lo n/2+) Amid2 Ahi Alo)))))
+  
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+  ;; Precompiling of standard comparison functions
+  ;; for standard data types
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+  (define precompiled-sorts
+    (let ([sorts (make-hasheq)])
+      (define-syntax-rule (precomp less-than? more ...)
+        (let ([sort-proc
+               (λ (A n) (sort-internal-body A less-than? n #f))])
+          (hash-set! sorts less-than? sort-proc)
+          (hash-set! sorts more sort-proc) ...))
+      ;; for comparison ops provided by racket/base we build
+      ;; fast precompiled versions
+      (precomp unsafe-fl< unsafe-fl<=)
+      (precomp unsafe-fl> unsafe-fl>=)
+      (precomp i< i<=)
+      (precomp i> i>=)
+      (precomp < <=)
+      (precomp > >=)
+      (precomp string<? string<=?)
+      (precomp string>? string>=?)
+      (precomp string-ci<? string-ci<=?)
+      (precomp string-ci>? string-ci>=?)
+      (precomp char<? char<=?)
+      (precomp char>? char>=?)
+      (precomp keyword<?)
+      (make-immutable-hasheq (hash-map sorts cons))))
+  
+  (define (generic-sort A less-than? n)
+    (sort-internal-body A less-than? n #f))
+  
+  (define (generic-sort/key A less-than? n key)
+    (sort-internal-body A less-than? n key))
+  
+  (define-syntax (sort-internal stx)
+    (syntax-case stx ()
+      [(_ vec less-than? n #:key #f)
+       #'(let ([precomp (hash-ref precompiled-sorts less-than? #f)])
+           (if precomp
+               ;; use a precompiled function if found
+               (precomp vec n)
+               ;; otherwise, use the generic code
+               (generic-sort vec less-than? n)))]
+      [(_ vec less-than? n #:key key)
+       #'(generic-sort/key vec less-than? n key)]))
+  
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+  ;; List Sorting Definition Body
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+  
+  (define-syntax (list-sort-body stx)
+    (syntax-case stx ()
+      [(_ lst less-than? #:key key #:cache-keys? cache-keys?)
+       #'(let ([n (length lst)])
+           (define-syntax-rule (<? x y)
+             (if key
+                 (less-than? (key x) (key y))
+                 (less-than? x y)))
+           (cond
+             ;; trivial cases (where we know there is no caching to be done)
+             [(i= n 0) lst]
+             ;; below we can assume a non-empty input list
+             ;; if we know statically this is not a cache-keys? use
+             ;; case, don't include this case in the cond
+             [cache-keys?
+              ;; decorate while converting to a vector, and undecorate when going
+              ;; back, always do this for consistency
+              (let ([vec (make-vector (+ n (ceiling (/ n 2))))])
+                ;; list -> decorated-vector
+                (let loop ([i 0] [lst lst])
+                  (when (pair? lst)
+                    (let ([x (car lst)])
+                      (vset! vec i (cons (key x) x))
+                      (loop (i+ i 1) (cdr lst)))))
+                ;; sort
+                (sort-internal vec less-than? n #:key ucar)
+                ;; decorated-vector -> list
+                (let loop ([i n] [r '()])
+                  (let ([i (i- i 1)])
+                    (if (i< i 0)
+                        r
+                        (loop i (cons (ucdr (vref vec i)) r))))))]
+             ;; check if the list is already sorted (which can be common, eg,
+             ;; directory lists)
+             [(let loop ([last (car lst)] [next (cdr lst)])
+                (or (null? next)
+                    (and (not (<? (ucar next) last))
+                         (loop (ucar next) (ucdr next)))))
+              lst]
+             ;; below we can assume an unsorted list
+             ;; inlined case, for optimization of short lists
+             [(i<= n 3)
+              (cond
+                [(i= n 1) lst]
+                [(i= n 2)
+                 ;; (because of the above test, we know lst is unsorted)
+                 (list (cadr lst) (car lst))]
+                [else
+                 (let ([a (car lst)] [b (cadr lst)] [c (caddr lst)])
+                   ;; General note: we need a stable sort, so we should always compare
+                   ;; (<? later-item earlier-item) since it gives more information.
+                   ;; Good code should have each permutation appears exactly once.
+                   ;; This means that n=4 will have 23 cases, so don't bother.                 
+                   (if (<? b a)
+                       ;; b<a
+                       (if (<? c b)
+                           (list c b a)
+                           ;; b<a, b<=c
+                           (if (<? c a) (list b c a) (list b a c)))
+                       ;; a<=b, so c<b (b<=c is impossible due to above test)
+                       (if (<? c a) (list c a b) (list a c b))))])]
+             [else (let ([vec (make-vector (+ n (ceiling (/ n 2))))])
+                     ;; list -> vector
+                     (let loop ([i 0] [lst lst])
+                       (when (pair? lst)
+                         (vector-set! vec i (car lst))
+                         (loop (add1 i) (cdr lst))))
+                     ;; sort
+                     (sort-internal vec less-than? n #:key key)
+                     ;; vector -> list
+                     (let loop ([i n] [r '()])
+                       (let ([i (sub1 i)])
+                         (if (< i 0) r (loop i (cons (vector-ref vec i) r))))))]))]))
+  
+  
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+  ;; Vector Sorting Definition Body
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+  
+  (define-syntax (vector-sort-body stx)
+    (syntax-case stx ()
+      [(_ src-vec less-than? start end
+          #:key key
+          #:cache-keys? cache-keys?
+          #:constructive? constructive?)
+       #'(let ([n (- end start)])
+           (define-syntax-rule (<? x y)
+             (if key
+                 (less-than? (key x) (key y))
+                 (less-than? x y)))
+           (define-syntax-rule (swap! A i j)
+             (let ([tmp (vref A  i)])
+               (vset! A i (vref A  j))
+               (vset! A j tmp)))
+           (define dst-vec (if constructive? (make-vector n) src-vec))
+           (define dst-start (if constructive? 0 start))
+           (cond
+             ;; trivial case (where we know we don't even need to cache a key)
+             [(i= n 0) (void)]
+             ;; below we can assume a non-empty input vector
+             ;; if we statically know we're not caching keys, don't
+             ;; include this case in the cond
+             [cache-keys?
+              ;; decorate while converting to a vector for sorting,
+              ;; and undecorate when going back, always do this for
+              ;; consistency
+              (define work-vec (make-vector (+ n (ceiling (/ n 2))) #t))
+              ;; vector -> decorated-vector
+              (let loop ([i 0])
+                (when (i< i n)
+                  (let ([x (vref src-vec (i+ i start))])
+                    (vset! work-vec i (cons (key x) x)))
+                  (loop (i+ i 1))))
               ;; sort
-              (if getkey
-                (sort-internal *<? vec n getkey)
-                (sort-internal *<? vec n))
-              ;; vector -> list
-              (let loop ([i n] [r '()])
-                (let ([i (sub1 i)])
-                  (if (< i 0) r (loop i (cons (vector-ref vec i) r))))))])))
+              (sort-internal work-vec less-than? n #:key ucar)
+              ;; decorated-vector -> vector
+              (let loop ([i 0])
+                (when (i< i n)
+                  (vset! dst-vec (i+ i dst-start) (ucdr (vref work-vec i)))
+                  (loop (i+ i 1))))]
+             ;; check if the vector is already sorted
+             [(let loop ([prev-val (vref src-vec start)]
+                         [next-index (i+ start 1)])
+                (or (i= next-index end)
+                    (let ([next-val (vref src-vec next-index)])
+                      (and (not (<? next-val prev-val))
+                           (loop next-val (i+ next-index 1))))))
+              (when constructive?
+                (vector-copy! dst-vec dst-start src-vec start end))]
+             ;; other easy/small cases
+             ;; below we can assume an unsorted list
+             ;; inlined case, for optimization of short lists
+             [(i<= n 3)
+              (when constructive?
+                (vector-copy! dst-vec dst-start src-vec start end))
+              (cond
+                [(i= n 1) (void)]
+                [(i= n 2)
+                 ;; (because of the above test, we know lst is unsorted)
+                 (swap! dst-vec
+                        (i+ dst-start 0)
+                        (i+ dst-start 1))]
+                [else
+                 (let ([a (vref dst-vec (i+ dst-start 0))]
+                       [b (vref dst-vec (i+ dst-start 1))]
+                       [c (vref dst-vec (i+ dst-start 2))])
+                   (cond
+                     [(<? b a)
+                      (cond
+                        [(<? c b)
+                         (vset! dst-vec (i+ dst-start 0) c)
+                         (vset! dst-vec (i+ dst-start 2) a)]
+                        [(<? c a)
+                         (vset! dst-vec (i+ dst-start 0) b)
+                         (vset! dst-vec (i+ dst-start 1) c)
+                         (vset! dst-vec (i+ dst-start 2) a)]
+                        [else (vset! dst-vec (i+ dst-start 0) b)
+                              (vset! dst-vec (i+ dst-start 1) a)])]
+                     [(<? c a) (vset! dst-vec (i+ dst-start 0) c)
+                               (vset! dst-vec (i+ dst-start 1) a)
+                               (vset! dst-vec (i+ dst-start 2) b)]
+                     [else  (vset! dst-vec (i+ dst-start 1) c)
+                            (vset! dst-vec (i+ dst-start 2) b)]))])]
+             [else
+              (let ([work-vec (make-vector (+ n (ceiling (/ n 2))) #f)])
+                ;; src vector -> work-vector (to do merge sort in)
+                (vector-copy! work-vec 0 src-vec start end)
+                ;; sort!
+                (sort-internal work-vec less-than? n #:key key)
+                ;; work-vector -> dst vector
+                (vector-copy! dst-vec dst-start work-vec 0 n))])
+           (if constructive?
+               dst-vec
+               (void)))]))
+  
+  
+  ;; macro for defining the various vector-sort case-lambdas
+  (define-syntax-rule (vector-sort-case-lambda sort-name #:constructive? constructive?)
+    (case-lambda
+      [(vec less-than? start end)
+       (vector-sort-body vec less-than? start end
+                         #:key #f
+                         #:cache-keys? #f
+                         #:constructive? constructive?)]
+      [(vec less-than? start end getkey cache-keys?)
+       (if (and getkey (not (eq? values getkey)))
+           (vector-sort-body vec less-than? start end
+                             #:key getkey
+                             #:cache-keys? cache-keys?
+                             #:constructive? constructive?)
+           (sort-name vec less-than? start end))]))
+  
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+  ;; Actual Sorting Function Definitions
+  ;; - - - - - - - - - - - - - - - - - - - - - - - -
+  
+  ;; Finally, these are the provided `sort' values
+  (values
+   ;; sort
+   (case-lambda
+     [(lst less-than?)
+      (list-sort-body lst less-than? #:key #f #:cache-keys? #f)]
+     [(lst less-than? getkey)
+      (if (and getkey (not (eq? values getkey)))
+          (sort lst less-than? getkey #f)
+          (sort lst less-than?))]
+     [(lst less-than? getkey cache-keys?)
+      (if (and getkey (not (eq? values getkey)))
+          (list-sort-body lst less-than? #:key getkey #:cache-keys? cache-keys?)
+          (sort lst less-than?))])
+   ;; vector-sort
+   (vector-sort-case-lambda vector-sort #:constructive? #t)
+   ;; vector-sort!
+   (vector-sort-case-lambda vector-sort! #:constructive? #f))
 
-;; Finally, this is the provided `sort' value
-(case-lambda
-  [(lst <?) (sort-body lst <? #f #f #f)]
-  [(lst <? getkey)
-   (if (and getkey (not (eq? values getkey)))
-     (sort lst <? getkey #f) (sort lst <?))]
-  [(lst <? getkey cache-keys?)
-   (if (and getkey (not (eq? values getkey)))
-     (sort-body lst <? #t getkey cache-keys?) (sort lst <?))])
-
-)))
+))) ;; end of module
diff --git a/racket/collects/racket/vector.rkt b/racket/collects/racket/vector.rkt
index a52bc057ab..640ef86599 100644
--- a/racket/collects/racket/vector.rkt
+++ b/racket/collects/racket/vector.rkt
@@ -5,8 +5,13 @@
          vector-take-right vector-drop-right vector-split-at-right
          vector-filter vector-filter-not
          vector-count vector-argmin vector-argmax
-         vector-member vector-memq vector-memv)
-(require racket/unsafe/ops)
+         vector-member vector-memq vector-memv
+         vector-sort vector-sort!)
+(require racket/unsafe/ops
+         (for-syntax racket/base)
+         (rename-in (except-in "private/sort.rkt" sort)
+                    [vector-sort! raw-vector-sort!]
+                    [vector-sort raw-vector-sort])) 
 
 (define (vector-set*! v . pairs)
   (unless (even? (length pairs))
@@ -23,11 +28,14 @@
   (vector-copy! new-v 0 v start end)
   new-v)
 
+
 (define (vector-copy v [start 0] [end (and (vector? v) (vector-length v))])
   (unless (vector? v)
     (raise-argument-error 'vector-copy "vector?" v))
   (unless (exact-nonnegative-integer? start)
     (raise-argument-error 'vector-copy "exact-nonnegative-integer?" start))
+  (unless (exact-nonnegative-integer? end)
+    (raise-argument-error 'vector-copy "exact-nonnegative-integer?" end))
   (let ([len (vector-length v)])
     (cond
       [(= len 0)
@@ -231,3 +239,54 @@
 (vm-mk vector-member equal?)
 (vm-mk vector-memq eq?)
 (vm-mk vector-memv eqv?)
+
+(define-syntax-rule (perform-common-sort-arg-checks name vec less? start end getkey)
+  (let ()
+    ;; check other args are valid
+    (unless (exact-nonnegative-integer? start)
+      (raise-argument-error 'name "exact-nonnegative-integer?" start))
+    (unless (exact-nonnegative-integer? end)
+      (raise-argument-error 'name "exact-nonnegative-integer?" end))
+    (unless (and (procedure? less?) (procedure-arity-includes? less? 2))
+      (raise-argument-error 'name "(any/c any/c . -> . any/c)" less?))
+    (when (and getkey (not (and (procedure? getkey)
+                                (procedure-arity-includes? getkey 1))))
+      (raise-argument-error 'name "(any/c . -> . any/c)" getkey))
+    (let ([len (vector-length vec)])
+      (unless (and (<= 0 start len))
+        (raise-range-error 'name "vector" "starting " start vec 0 len))
+      (unless (and (<= start end len))
+        (raise-range-error 'name "vector" "ending " end vec start len 0)))))
+
+
+
+;; vector sort
+(define (vector-sort vec less? [start 0] [end #f]
+                     #:key [getkey #f] #:cache-keys? [cache-keys? #f])
+  ;; is the input vector the right kind? (mutable vs immutable allowed?)
+  (unless (vector? vec)
+    (raise-argument-error 'vector-sort "vector?" vec))
+  
+  ;; calulate end if not provided
+  (let ([end (or end (vector-length vec))])
+    (perform-common-sort-arg-checks vector-sort vec less? start end getkey)
+    (if getkey
+        (raw-vector-sort vec less? start end getkey cache-keys?)
+        (raw-vector-sort vec less? start end))))
+
+;; vector sort
+(define (vector-sort! vec less? [start 0] [end #f]
+                      #:key [getkey #f]
+                      #:cache-keys? [cache-keys? #f])
+  ;; is the input vector the right kind? (mutable vs immutable allowed?)
+  (unless (and (vector? vec) (not (immutable? vec)))
+    (raise-argument-error 'vector-sort!
+                          "(and/c vector? (not/c immutable?))"
+                          vec))
+  
+  ;; calulate end if not provided
+  (let ([end (or end (vector-length vec))])
+    (perform-common-sort-arg-checks vector-sort! vec less? start end getkey)
+    (if getkey
+        (raw-vector-sort! vec less? start end getkey cache-keys?)
+        (raw-vector-sort! vec less? start end))))