diff --git a/scheme/base.sld b/scheme/base.sld
index 6e899e71..c8238344 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -42,7 +42,7 @@
     vector
     vector-append
     vector-copy
-    ;vector-copy!
+    vector-copy!
     vector-fill!
     vector->list
     vector->string
@@ -201,18 +201,18 @@
                            (vector-set! new-vec i (vector-ref vec i))
                            (loop (+ i 1) new-vec))))))
         (loop start (make-vector (- end start) #f))))
-; TODO:
-;    (define (vector-copy! vec to at from . opts)
-;      (letrec ((len (vector-length vec))
-;               (start (if (> (length opts) 0) (car opts) 0))
-;               (end (if (> (length opts) 1) (cadr opts) len))
-;               (loop (lambda (i)
-;                       (cond
-;                        ((= i end) vec)
-;                        (else
-;                          (vector-set! vec i fill)
-;                          (loop (+ i 1)))))))
-;        (loop start '())))
+    ;; TODO: does not quite meet r7rs spec, should check if vectors overlap
+    (define (vector-copy! to at from . opts)
+      (letrec ((len (vector-length from))
+               (start (if (> (length opts) 0) (car opts) 0))
+               (end (if (> (length opts) 1) (cadr opts) len))
+               (loop (lambda (i-at i-from)
+                       (cond
+                        ((= i-from end) to)
+                        (else
+                          (vector-set! to i-at (vector-ref from i-from))
+                          (loop (+ i-at 1) (+ i-from 1)))))))
+        (loop at start)))
     ;; TODO: this len/start/end/loop pattern is common, could use a macro for it
     (define (vector-fill! vec fill . opts)
       (letrec ((len (vector-length vec))
@@ -224,7 +224,7 @@
                         (else
                           (vector-set! vec i fill)
                           (loop (+ i 1)))))))
-        (loop start '())))
+        (loop start)))
 
     (define (boolean=? b1 b2 . bs)
       (Cyc-obj=? boolean? b1 (cons b2 bs)))
diff --git a/test.scm b/test.scm
index 7f21f630..029f7016 100644
--- a/test.scm
+++ b/test.scm
@@ -15,3 +15,8 @@
 (write (equal? #(1 1 1) (make-vector 3 1)))
 (write '#(1))
 (write '#())
+
+(define a (vector 1 2 3 4 5))
+(define b (vector 10 20 30 40 50))
+(vector-copy! b 1 a 0 2)
+(write (equal? b #(10 1 2 40 50)))