diff --git a/collects/tests/racket/benchmarks/shootout/binarytrees.rkt b/collects/tests/racket/benchmarks/shootout/binarytrees.rkt
index 0061679996..77d15a15d6 100644
--- a/collects/tests/racket/benchmarks/shootout/binarytrees.rkt
+++ b/collects/tests/racket/benchmarks/shootout/binarytrees.rkt
@@ -4,51 +4,54 @@
 ;;; http://shootout.alioth.debian.org/
 ;;; Derived from the Chicken variant by Sven Hartrumpf
 
-(require racket/cmdline)
+(require racket/cmdline racket/require (for-syntax racket/base)
+         (filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
+                      racket/unsafe/ops))
 
-(struct node (left val right))
+(struct *leaf (val))
+(struct *node *leaf (left right))
 
-;; Instead of (define-struct leaf (val)):
-(define (leaf val) (node #f val #f))
-(define (leaf? l) (not (node-left l)))
-(define (leaf-val l) (node-val l))
+(define-syntax leaf  (make-rename-transformer #'*leaf))
+(define-syntax leaf? (make-rename-transformer #'*leaf?))
+(define-syntax node  (make-rename-transformer #'*node))
+(define-syntax node? (make-rename-transformer #'*node?))
+(define-syntax-rule (leaf-val l)   (struct-ref l 0))
+(define-syntax-rule (node-left n)  (struct-ref n 1))
+(define-syntax-rule (node-right n) (struct-ref n 2))
 
 (define (make item d)
-  (if (= d 0)
-      (leaf item)
-      (let ((item2 (* item 2))
-            (d2 (- d 1)))
-        (node (make (- item2 1) d2) 
-              item 
-              (make item2 d2)))))
+  (if (fx= d 0)
+    (leaf item)
+    (let ([item2 (fx* item 2)] [d2 (fx- d 1)])
+      (node item (make (fx- item2 1) d2) (make item2 d2)))))
 
 (define (check t)
-  (if (leaf? t)
-      (leaf-val t)
-      (+ (node-val t) (- (check (node-left t)) 
-                         (check (node-right t))))))
+  (let loop ([t t] [acc 0])
+    (let ([acc (fx+ (leaf-val t) acc)])
+      (if (leaf? t)
+        acc
+        (loop (node-right t)
+              (fx+ acc (loop (node-left t) 0)))))))
+
+(define min-depth 4)
 
 (define (main n)
-  (let* ((min-depth 4)
-         (max-depth (max (+ min-depth 2) n)))
-    (let ((stretch-depth (+ max-depth 1)))
+  (let ([max-depth (max (+ min-depth 2) n)])
+    (let ([stretch-depth (+ max-depth 1)])
       (printf "stretch tree of depth ~a\t check: ~a\n"
               stretch-depth
               (check (make 0 stretch-depth))))
-    (let ((long-lived-tree (make 0 max-depth)))
-      (for ((d (in-range 4 (add1 max-depth) 2)))
-        (let ((iterations (arithmetic-shift 1 (+ (- max-depth d) min-depth))))
+    (let ([long-lived-tree (make 0 max-depth)])
+      (for ([d (in-range 4 (+ max-depth 1) 2)])
+        (let ([iterations (expt 2 (+ (- max-depth d) min-depth))])
           (printf "~a\t trees of depth ~a\t check: ~a\n"
                   (* 2 iterations)
                   d
-                  (for/fold ([c 0])
-                            ([i (in-range iterations)])
-                    (+ c 
-                       (check (make i d)) 
-                       (check (make (- i) d)))))))
+                  (for/fold ([c 0]) ([i (in-range iterations)])
+                    (fx+ c (fx+ (check (make i d))
+                                (check (make (fx- 0 i) d))))))))
       (printf "long lived tree of depth ~a\t check: ~a\n"
               max-depth
               (check long-lived-tree)))))
 
-(command-line #:args (n) 
-              (main (string->number n)))
+(command-line #:args (n) (time (main (string->number n))))
diff --git a/collects/tests/racket/benchmarks/shootout/fasta.rkt b/collects/tests/racket/benchmarks/shootout/fasta.rkt
index 3a7d650ff0..fb29076e25 100644
--- a/collects/tests/racket/benchmarks/shootout/fasta.rkt
+++ b/collects/tests/racket/benchmarks/shootout/fasta.rkt
@@ -5,104 +5,113 @@
 ;;
 ;; fasta - benchmark
 ;;
-;; Derived from the Chicken variant, which was
-;; Contributed by Anthony Borla
-
-(require racket/cmdline)
+;; Very loosely based on the Chicken variant by Anthony Borla,
+;; some optimizations taken from the GCC version by Petr Prokhorenkov.
 
 (define +alu+
-  (bytes-append
-   #"GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG"
-   #"GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA"
-   #"CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT"
-   #"ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA"
-   #"GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG"
-   #"AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC"
-   #"AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"))
+  (bytes-append #"GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG"
+                #"GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA"
+                #"CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT"
+                #"ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA"
+                #"GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG"
+                #"AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC"
+                #"AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"))
 
-(define +iub+
-  (list
-   '(#\a . 0.27) '(#\c . 0.12) '(#\g . 0.12) '(#\t . 0.27) '(#\B . 0.02)
-   '(#\D . 0.02) '(#\H . 0.02) '(#\K . 0.02) '(#\M . 0.02) '(#\N . 0.02)
-   '(#\R . 0.02) '(#\S . 0.02) '(#\V . 0.02) '(#\W . 0.02) '(#\Y . 0.02)))
+(define IUB
+  '([#\a 0.27] [#\c 0.12] [#\g 0.12] [#\t 0.27] [#\B 0.02]
+    [#\D 0.02] [#\H 0.02] [#\K 0.02] [#\M 0.02] [#\N 0.02]
+    [#\R 0.02] [#\S 0.02] [#\V 0.02] [#\W 0.02] [#\Y 0.02]))
 
-(define +homosapien+
-  (list
-   '(#\a . 0.3029549426680) '(#\c . 0.1979883004921)
-   '(#\g . 0.1975473066391) '(#\t . 0.3015094502008)))
+(define HOMOSAPIEN
+  '([#\a 0.3029549426680] [#\c 0.1979883004921]
+    [#\g 0.1975473066391] [#\t 0.3015094502008]))
 
-;; -------------
+(define line-length 60)
 
-(define +line-size+ 60)
+;; ----------------------------------------
 
-;; -------------------------------
+(require racket/require racket/require-syntax (for-syntax racket/base))
+(define-require-syntax overriding-in
+  (syntax-rules () [(_ R1 R2) (combine-in R2 (subtract-in R1 R2))]))
+(require (overriding-in
+          racket/flonum
+          (filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
+                       racket/unsafe/ops))
+         racket/cmdline)
 
-(define (make-random seed)
-  (let* ((ia 3877) (ic 29573) (im 139968) (last seed))
-    (lambda (max)
-      (set! last (modulo (+ ic (* last ia)) im))
-      (/ (* max last) im))))
+;; ----------------------------------------
 
-;; -------------------------------
+(define (repeat-fasta header N sequence)
+  (define out (current-output-port))
+  (define len (bytes-length sequence))
+  (define buf (make-bytes (+ len line-length)))
+  (bytes-copy! buf 0 sequence)
+  (bytes-copy! buf len sequence 0 line-length)
+  (display header out)
+  (let loop ([n N] [start 0])
+    (when (fx> n 0)
+      (let ([end (fx+ start (fxmin n line-length))])
+        (write-bytes buf out start end)
+        (newline)
+        (loop (fx- n line-length) (if (fx> end len) (fx- end len) end))))))
 
-(define (make-cumulative-table frequency-table)
-  (let ([cumulative 0.0])
-    (for/list ([x frequency-table])
-      (set! cumulative (+ cumulative (cdr x))) 
-      (cons (char->integer (car x)) cumulative))))
+;; ----------------------------------------
 
-;; -------------
+(define lookup-size 4096)
 
-(define random-next (make-random 42))
-(define +segmarker+ ">")
+(define lookup-size.0 (fx->fl lookup-size))
 
-;; -------------
+(define (fl->fx f) (inexact->exact (flfloor f)))
 
-(define (select-random cumulative-table)
-  (let ((rvalue (random-next 1.0)))
-    (let select-over-threshold ([table cumulative-table])
-      (if (<= rvalue (cdar table))
-          (caar table)
-          (select-over-threshold (cdr table))))))
+(define IA 3877)
+(define IC 29573)
+(define IM 139968)
+(define IM.0 (fx->fl IM))
+(define random-state 42)
 
-;; -------------
+(define (random-next)
+  (set! random-state (fxmodulo (fx+ IC (fx* random-state IA)) IM))
+  (fl/ (fl* lookup-size.0 (fx->fl random-state)) IM.0))
 
-(define (repeat-fasta id desc n_ sequence line-length)
-  (let ((seqlen (bytes-length sequence))
-        (out (current-output-port)))
-    (display (string-append +segmarker+ id " " desc "\n") out)
-    (let loop-o ((n n_) (k 0))
-      (unless (<= n 0) 
-        (let ((m (min n line-length)))
-          (let loop-i ((i 0) (k k))
-            (if (>= i m) 
-                (begin
-                  (newline out)
-                  (loop-o (- n line-length) k))
-                (let ([k (if (= k seqlen) 0 k)])
-                  (write-byte (bytes-ref sequence k) out)
-                  (loop-i (add1 i) (add1 k))))))))))
+(define (make-lookup-vectors frequency-table)
+  (define byte-vec (make-bytes lookup-size))
+  (define cumu-vec (make-flvector lookup-size))
+  (define (set-range from to b)
+    (for ([i (in-range (fl->fx from) (fl->fx (flround to)))])
+      (bytes-set! byte-vec i b)
+      (flvector-set! cumu-vec i from)))
+  (let loop ([t frequency-table] [c 0.0])
+    (unless (null? t)
+      (let ([c1 (fl+ c (fl* lookup-size.0 (cadar t)))])
+        (set-range c c1 (char->integer (caar t)))
+        (loop (cdr t) c1))))
+  (values byte-vec cumu-vec))
 
-;; -------------
+(define (random-fasta header N table)
+  (define out (current-output-port))
+  (define-values (lookup-byte lookup-cumu) (make-lookup-vectors table))
+  (define (n-randoms to)
+    (let loop ([n 0])
+      (when (fx< n to)
+        (let* ([rnd (random-next)]
+               [i (fl->fx rnd)]
+               [i (if (fl< rnd (flvector-ref lookup-cumu i)) (fx- i 1) i)]
+               [b (bytes-ref lookup-byte i)])
+          (bytes-set! buf n b)
+          (loop (fx+ n 1)))))
+    (write-bytes buf out 0 (fx+ to 1)))
+  (define buf (make-bytes (add1 line-length)))
+  (define LF (char->integer #\newline))
+  (bytes-set! buf line-length LF)
+  (display header out)
+  (for ([n (in-range (quotient N line-length))]) (n-randoms line-length))
+  (let ([n (remainder N line-length)])
+    (unless (zero? n) (bytes-set! buf n LF) (n-randoms n)))
+  (void))
 
-(define (random-fasta id desc n_ cumulative-table line-length)
-  (let ((out (current-output-port)))
-    (display (string-append +segmarker+ id " " desc "\n") out)
-    (let loop-o ((n n_))
-      (unless (<= n 0)
-        (for ([i (in-range (min n line-length))])
-          (write-byte (select-random cumulative-table) out))
-        (newline out)
-        (loop-o (- n line-length))))))
+;; ----------------------------------------
 
-;; -------------------------------
-  
-(let ((n (command-line #:args (n) (string->number n))))
-    
-  (repeat-fasta "ONE" "Homo sapiens alu" (* n 2) +alu+ +line-size+)
-  
-  (random-fasta "TWO" "IUB ambiguity codes" (* n 3)
-                (make-cumulative-table +iub+) +line-size+)
-  
-  (random-fasta "THREE" "Homo sapiens frequency" (* n 5)
-                (make-cumulative-table +homosapien+) +line-size+))
+(let ([n (command-line #:args (n) (string->number n))])
+  (repeat-fasta ">ONE Homo sapiens alu\n" (* n 2) +alu+)
+  (random-fasta ">TWO IUB ambiguity codes\n" (* n 3) IUB)
+  (random-fasta ">THREE Homo sapiens frequency\n" (* n 5) HOMOSAPIEN))
diff --git a/collects/tests/racket/benchmarks/shootout/mandelbrot-unsafe.rkt b/collects/tests/racket/benchmarks/shootout/mandelbrot-unsafe.rkt
deleted file mode 100644
index 6e3f7ec84b..0000000000
--- a/collects/tests/racket/benchmarks/shootout/mandelbrot-unsafe.rkt
+++ /dev/null
@@ -1,72 +0,0 @@
-#lang racket/base
-
-;; The Great Computer Language Shootout
-;; http://shootout.alioth.debian.org/
-;;
-;; Derived from the Chicken variant, which was
-;; Contributed by Anthony Borla
-;;
-;; This version uses unsafe operations
-
-(require racket/cmdline
-	 racket/require (for-syntax racket/base)
-	 (filtered-in
-	  (lambda (name) (regexp-replace #rx"unsafe-" name ""))
-	  racket/unsafe/ops))
-
-(define +limit-sqr+ 4.0)
-
-(define +iterations+ 50)
-
-;; -------------------------------
-
-(define (mandelbrot x y n ci)
-  (let ((cr (fl- (fl/ (fl* 2.0 (fx->fl x)) (fx->fl n)) 1.5)))
-    (let loop ((i 0) (zr 0.0) (zi 0.0))
-      (if (fx> i +iterations+)
-          1
-          (cond
-           ((fl> (fl+ (fl* zr zr) (fl* zi zi)) +limit-sqr+) 0)
-           (else (loop (fx+ 1 i) 
-                       (fl+ (fl- (fl* zr zr) (fl* zi zi)) cr) 
-                       (fl+ (fl* 2.0 (fl* zr zi)) ci))))))))
-
-;; -------------------------------
-
-(define (main n)
-  (let ((out (current-output-port)))
-
-    (fprintf out "P4\n~a ~a\n" n n)
-
-    (let loop-y ((y 0))
-
-      (when (fx< y n)
-        
-        (let ([ci (fl- (fl/ (fl* 2.0 (fx->fl y)) (fx->fl n)) 1.0)])
-          
-          (let loop-x ((x 0) (bitnum 0) (byteacc 0))
-
-            (if (fx< x n)
-                (let ([bitnum (fx+ 1 bitnum)]
-                      [byteacc (fx+ (fxlshift byteacc 1) 
-                                           (mandelbrot x y n ci))])
-
-                  (cond
-                   ((fx= bitnum 8)
-                    (write-byte byteacc out)
-                    (loop-x (fx+ 1 x) 0 0))
-                   
-                   [else (loop-x (fx+ 1 x) bitnum byteacc)]))
-
-                (begin
-                  (when (positive? bitnum)
-                    (write-byte (arithmetic-shift byteacc 
-                                                  (- 8 (bitwise-and n #x7))) 
-                                out))
-
-                  (loop-y (add1 y))))))))))
-
-;; -------------------------------
-
-(command-line #:args (n)
-              (main (string->number n)))
diff --git a/collects/tests/racket/benchmarks/shootout/mandelbrot.rkt b/collects/tests/racket/benchmarks/shootout/mandelbrot.rkt
index d5261658c0..7f48888cae 100644
--- a/collects/tests/racket/benchmarks/shootout/mandelbrot.rkt
+++ b/collects/tests/racket/benchmarks/shootout/mandelbrot.rkt
@@ -2,66 +2,55 @@
 
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
-;;
-;; Derived from the Chicken variant, which was
-;; Contributed by Anthony Borla
- 
-(require racket/cmdline
-         racket/flonum)
 
-(define +limit-sqr+ 4.0)
+(require racket/require racket/require-syntax (for-syntax racket/base))
+(define-require-syntax overriding-in
+  (syntax-rules () [(_ R1 R2) (combine-in R2 (subtract-in R1 R2))]))
+(require (overriding-in
+          racket/flonum
+          (filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
+                       racket/unsafe/ops))
+         racket/cmdline)
 
-(define +iterations+ 50)
+(define O (current-output-port))
 
-;; -------------------------------
+(define LIMIT-SQR 4.0)
+(define ITERATIONS 50)
+(define N (command-line #:args (n) (string->number n)))
+(define N.0 (fx->fl N))
+(define 2/N (fl/ 2.0 N.0))
+(define Crs
+  (let ([v (make-flvector N)])
+    (for ([x (in-range N)])
+      (flvector-set! v x (fl- (fl/ (fx->fl (fx* 2 x)) N.0) 1.5)))
+    v))
 
-(define (mandelbrot x y n ci)
-  (let ((cr (fl- (fl/ (fl* 2.0 (->fl x)) (->fl n)) 1.5)))
-    (let loop ((i 0) (zr 0.0) (zi 0.0))
-      (if (> i +iterations+)
-          1
-          (cond
-           ((fl> (fl+ (fl* zr zr) (fl* zi zi)) +limit-sqr+) 0)
-           (else (loop (+ 1 i) 
-                       (fl+ (fl- (fl* zr zr) (fl* zi zi)) cr) 
-                       (fl+ (fl* 2.0 (fl* zr zi)) ci))))))))
+(define-syntax (let-n stx)
+  (syntax-case stx ()
+    [(_ N bindings E)
+     (let loop ([N (syntax-e #'N)] [E #'E])
+       (if (zero? N) E (loop (sub1 N) #`(let bindings #,E))))]))
 
-;; -------------------------------
+(define-syntax-rule (mandelbrot Cr Ci)
+  (let loop ([i 0] [Zr 0.0] [Zi 0.0])
+    (cond [(fl> (fl+ (fl* Zr Zr) (fl* Zi Zi)) LIMIT-SQR) 0]
+          [(fx= i ITERATIONS) 1]
+          [else (let-n 5 ([Zr (fl+ (fl- (fl* Zr Zr) (fl* Zi Zi)) Cr)]
+                          [Zi (fl+ (fl* 2.0 (fl* Zr Zi)) Ci)])
+                  (loop (fx+ i 5) Zr Zi))])))
 
-(define (main n)
-  (let ((out (current-output-port)))
-
-    (fprintf out "P4\n~a ~a\n" n n)
-
-    (let loop-y ((y 0))
-
-      (when (< y n)
-        
-        (let ([ci (fl- (fl/ (fl* 2.0 (->fl y)) (->fl n)) 1.0)])
-          
-          (let loop-x ((x 0) (bitnum 0) (byteacc 0))
-
-            (if (< x n)
-                (let ([bitnum (+ 1 bitnum)]
-                      [byteacc (+ (arithmetic-shift byteacc 1) 
-                                  (mandelbrot x y n ci))])
-
-                  (cond
-                   ((= bitnum 8)
-                    (write-byte byteacc out)
-                    (loop-x (+ 1 x) 0 0))
-                   
-                   [else (loop-x (+ 1 x) bitnum byteacc)]))
-
-                (begin
-                  (when (positive? bitnum)
-                    (write-byte (arithmetic-shift byteacc 
-                                                  (- 8 (bitwise-and n #x7))) 
-                                out))
-
-                  (loop-y (add1 y))))))))))
-
-;; -------------------------------
-
-(command-line #:args (n)
-              (main (string->number n)))
+(fprintf O "P4\n~a ~a\n" N N)
+(let loop-y ([y N])
+  (let ([Ci (fl- (fl* 2/N (fx->fl y)) 1.0)])
+    (let loop-x ([x 0] [bitnum 0] [byteacc 0])
+      (if (fx< x N)
+        (let* ([Cr (flvector-ref Crs x)]
+               [bitnum (fx+ bitnum 1)]
+               [byteacc (fx+ (fxlshift byteacc 1) (mandelbrot Cr Ci))])
+          (cond [(fx= bitnum 8)
+                 (write-byte byteacc O)
+                 (loop-x (fx+ x 1) 0 0)]
+                [else (loop-x (fx+ x 1) bitnum byteacc)]))
+        (begin (when (fx> bitnum 0)
+                 (write-byte (fxlshift byteacc (fx- 8 (fxand N #x7))) O))
+               (when (fx> y 1) (loop-y (fx- y 1))))))))
diff --git a/collects/tests/racket/benchmarks/shootout/pidigits-gmp.rkt b/collects/tests/racket/benchmarks/shootout/pidigits-gmp.rkt
index 97f2f854a8..3639661927 100644
--- a/collects/tests/racket/benchmarks/shootout/pidigits-gmp.rkt
+++ b/collects/tests/racket/benchmarks/shootout/pidigits-gmp.rkt
@@ -4,6 +4,9 @@
 ;; http://shootout.alioth.debian.org/
 ;; Based on the Perl version of the benchmark
 ;; adapted with a GMP interface by Eli Barzilay
+;;
+;; Note that this was later used by several other shootout submissions
+;; without attribution.
 
 (require racket/cmdline
          (for-syntax racket/base)
diff --git a/collects/tests/racket/benchmarks/shootout/reversecomplement.rkt b/collects/tests/racket/benchmarks/shootout/reversecomplement.rkt
index fb70a471b6..7447891415 100644
--- a/collects/tests/racket/benchmarks/shootout/reversecomplement.rkt
+++ b/collects/tests/racket/benchmarks/shootout/reversecomplement.rkt
@@ -3,56 +3,80 @@
 ;; The Computer Language Benchmarks Game
 ;; http://shootout.alioth.debian.org/
 
-(require racket/cmdline)
-
 (define translation (make-vector 128))
 
-(for ([from-to '([a t]
-                 [c g]
-                 [g c]
-                 [t a]
-                 [u a]
-                 [m k]
-                 [r y]
-                 [w w]
-                 [s s]
-                 [y R]
-                 [k M]
-                 [v b]
-                 [h d]
-                 [d h]
-                 [b v]
-                 [n n])])
-  (let ([char (lambda (sym)
-                (string-ref (symbol->string sym) 0))])
-    (let ([from (char (car from-to))]
-          [to (char->integer (char-upcase (char (cadr from-to))))])
-      (vector-set! translation (char->integer from) to)
-      (vector-set! translation (char->integer (char-upcase from)) to))))
+(for ([from (in-string "ACGTUMRWSYKVHDBN")]
+      [to   (in-string "TGCAAKYWSRMBDHVN")])
+  (let ([to (char->integer to)])
+    (vector-set! translation (char->integer from) to)
+    (vector-set! translation (char->integer (char-downcase from)) to)))
 
-(define (output lines)
-  (let* ([str (apply bytes-append lines)]
-         [o (current-output-port)]
-         [len (bytes-length str)])
-    (for ([offset (in-range 0 len 60)])
-      (write-bytes str o offset (min len (+ offset 60)))
-      (newline o))))
+(define I (current-input-port))
+(define O (current-output-port))
 
-(let ([in (current-input-port)])
-  (let loop ([accum null])
-    (let ([l (read-bytes-line in)])
-      (if (eof-object? l)
-          (output accum)
-          (cond
-           [(regexp-match? #rx#"^>" l)
-            (output accum)
-            (printf "~a\n" l)
-            (loop null)]
-           [else
-            (let* ([len (bytes-length l)]
-                   [dest (make-bytes len)])
-              (for ([i (in-range len)])
-                (bytes-set! dest
-                            (- (- len i) 1)
-                            (vector-ref translation (bytes-ref l i))))
-              (loop (cons dest accum)))])))))
+(define marker (char->integer #\>))
+
+(require racket/require (for-syntax racket/base)
+         (filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
+                      racket/unsafe/ops))
+
+(define line-length 60)
+(define buf-size (* 64 1024))
+(define out-buf ; so there's always enough room for newlines
+  (make-bytes (+ buf-size 1 (quotient buf-size line-length))))
+(define LF (char->integer #\newline))
+
+#|
+The basic idea is to read the input in chunks, and keep pointers to
+them, then on output process each chunk to translate and reverse it
+before dumping it out.
+|#
+
+(define (output chunks)
+  (let loop ([chunks chunks] [col line-length])
+    (when (pair? chunks)
+      (let ([chunk (car chunks)])
+        (let ([start  (vector-ref chunk 0)]
+              [end    (vector-ref chunk 1)]
+              [in-buf (vector-ref chunk 2)])
+          (let chunk-loop ([i end] [j 0] [col col])
+            (if (fx> i start)
+              (let* ([i (fx- i 1)] [b (bytes-ref in-buf i)])
+                (if (fx= b LF)
+                  (chunk-loop i j col)
+                  (let ([b (vector-ref translation b)])
+                    (if (fx= 0 col)
+                      (begin (bytes-set! out-buf j LF)
+                             (bytes-set! out-buf (fx+ j 1) b)
+                             (chunk-loop i (fx+ j 2) (fx- line-length 1)))
+                      (begin (bytes-set! out-buf j b)
+                             (chunk-loop i (fx+ j 1) (fx- col 1)))))))
+              (begin (write-bytes out-buf O 0 j)
+                     (loop (cdr chunks) col))))))))
+  (newline O))
+
+(define-syntax case-regexp-posns
+  (syntax-rules (=> else)
+    [(_ rx buf start [id B1 ...] [else B2 ...])
+     (let ([m (regexp-match-positions rx buf start)])
+       (if m (let ([id (car m)]) B1 ...) (begin B2 ...)))]))
+
+(let ([m (regexp-match #rx"^([^\n]+)\n" I)]) (display (car m)))
+
+(let loop ([buf (read-bytes buf-size I)] [start 0] [chunks '()])
+  (if (eof-object? buf)
+    (begin (output chunks) (void))
+    (case-regexp-posns #rx">" buf start
+      [p1 (output (cons (vector start (car p1) buf) chunks))
+          (case-regexp-posns #rx"\n" buf (cdr p1)
+            [p2 (write-bytes buf O (car p1) (cdr p2))
+                (loop buf (cdr p2) '())]
+            [else (write-bytes buf O (car p1))
+                  (let header-loop ()
+                    (let ([buf (read-bytes buf-size I)])
+                      (case-regexp-posns #rx"\n" buf 0
+                        [p2 (write-bytes buf O 0 (cdr p2))
+                            (loop buf (cdr p2) '())]
+                        [else (write-bytes buf O) (header-loop)])))])]
+      [else (loop (read-bytes buf-size I) 0
+                  (cons (vector start (bytes-length buf) buf) chunks))])))