;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.51 2007/12/29 22:58:43 edi Exp $

;;; Copyright (c) 2005-2007, Dr. Edmund Weitz.  All rights reserved.

;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:

;;;   * Redistributions of source code must retain the above copyright
;;;     notice, this list of conditions and the following disclaimer.

;;;   * Redistributions in binary form must reproduce the above
;;;     copyright notice, this list of conditions and the following
;;;     disclaimer in the documentation and/or other materials
;;;     provided with the distribution.

;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(in-package :flexi-streams)

(defmacro without-gcing (&body body)
  `(#+openmcl ccl::without-gcing
              #+sbcl sb-sys:without-gcing
              #-(or openmcl sbcl)
              progn
              ,@body))

(defun test-speed ()
  (without-gcing
    (let* ((character-count 10000)
           (octets (make-array character-count :element-type '(unsigned-byte 8))))
      (dotimes (i character-count)
        (setf (aref octets i) (+ 32 (random 96))))
      (format t "testing with latin-1 encoding, streams based~%")
      (time (dotimes (i 100)
              (null (octets-to-string* octets :external-format (make-external-format :latin-1)))))
      (format t "testing with utf-8 encoding, streams based~%")
      (time (dotimes (i 100)
              (null (octets-to-string* octets :external-format (make-external-format :utf-8)))))
      (format t "testing with latin-1 encoding, optimized~%")
      (time (dotimes (i 100)
              (null (octets-to-string octets :external-format (make-external-format :latin-1)))))
      (format t "testing with utf-8 encoding, optimized~%")
      (time (dotimes (i 100)
              (null (octets-to-string octets :external-format (make-external-format :utf-8))))))))

(defmacro profile (&body body)
  #+sbcl
  `(progn
     (sb-profile:reset)
     (progn
       ,@body)
     (sb-profile:report)))
  

(defun profile-speed ()
  #+sbcl
  (sb-profile:profile "FLEX")
  (without-gcing
    (let* ((character-count 1000)
           (octets (make-array character-count :element-type '(unsigned-byte 8))))
      (dotimes (i character-count)
        (setf (aref octets i) (+ 32 (random 96))))
      (format t "profiling with latin-1 encoding, streams based~%")
      (profile (dotimes (i 10)
              (null (octets-to-string* octets :external-format (make-external-format :latin-1)))))
      (format t "profiling with utf-8 encoding, streams based~%")
      (profile (dotimes (i 10)
              (null (octets-to-string* octets :external-format (make-external-format :utf-8)))))
      (format t "profiling with latin-1 encoding, optimized~%")
      (profile (dotimes (i 10)
              (null (octets-to-string octets :external-format (make-external-format :latin-1)))))
      (format t "profiling with utf-8 encoding, optimized~%")
      (profile (dotimes (i 10)
              (null (octets-to-string octets :external-format (make-external-format :utf-8))))))))

(defun fixnum-or-nil (i)
  (and (oddp i) #.(char-code #\f)))

(defun fixnum-and-nil (i)
  (values #.(char-code #\f) (oddp i)))