;;; -*- mode: lisp -*-
;;; $Id: reversefile.cmucl,v 1.7 2001/09/09 01:31:40 doug Exp $
;;; http://www.bagley.org/~doug/shootout/
;;; from Bulent Murtezaoglu

(declaim (optimize (speed 3) (debug 0) (safety 0) (space 0) (compilation-speed 0)))

(defconstant BLOCKSIZE 4096)

(declaim (inline position-rev))
;; I wrote the the function below because the default cmucl image
;; doesn't seem to to have the inline expansion of position available
(defun position-rev (string end char)
  (declare (simple-string string) (fixnum end))
  (declare (inline char=))
  (loop for i from (1- end) downto 0
    do (when (char= (aref string i) char)
     (return-from position-rev i))))

  (declare (inline read-sequence write-string position-rev replace))
  (let ((fp 0)
    (bufsize BLOCKSIZE)
    (buf (make-string BLOCKSIZE)))
    (declare (fixnum bufsize) (simple-string buf))
    (loop for i fixnum = (read-sequence buf *standard-input*
    :start fp :end (+ fp BLOCKSIZE))
      until (= i fp) do
      (setq fp i)
      (when (>; (+ i BLOCKSIZE) bufsize)
    (setq bufsize (* 2 bufsize))
    (let ((tmpbuf (make-string bufsize)))
      (replace tmpbuf buf :start1 0 :end1 fp :start2 0 :end2 fp)
      (setq buf tmpbuf))))
    (loop for i = (1- fp) then j as j = (position-rev buf i #\Newline)
      do (write-string buf *standard-output* :start (if j (1+ j) 0) :end (1+ i))
      while j))