(set! (*s7* 'heap-size) 128000)

(define fsize 100000)
(define ssize 500000)
(define ssize/2 250000)

(if (or (> (*s7* 'major-version) 10) 
	(and (= (*s7* 'major-version) 10) (>= (*s7* 'minor-version) 9)))
    (begin
      (define (call-new-wis)
	(let ((p (open-input-string "asdf")))
	  (do ((i 0 (+ i 1)))
	      ((= i ssize/2))
	    (set! (port-string p) "asdf")
	    (unless (char=? (read-char p) #\a)
	      (format *stderr* "read-char trouble\n"))
	    (unless (char=? (read-char p) #\s)
	      (format *stderr* "read-char trouble\n"))
	    (unless (char=? (read-char p) #\d)
	      (format *stderr* "read-char trouble\n")))
	  (close-input-port p)))
      
      (define (call-new-cwis) 
	(let ((p (open-input-string "asdf"))
	      (a (char->integer #\a))
	      (s (char->integer #\s)))
	  (do ((i 0 (+ i 1)))
	      ((= i ssize/2))
	    (set! (port-string p) "asdf")
	    (unless (= (read-byte p) a)
	      (format *stderr* "call read-char trouble\n"))
	    (unless (= (read-byte p) s)
	      (format *stderr* "call read-char trouble\n"))
	    (unless (= (port-position p) 2)
	      (format *stderr* "cwis position: ~A~%" (port-position p))))
	  (close-input-port p)))

      ;; include the old cases
      (define (wis)
	(with-input-from-string "asdf"
	  (lambda ()
	    (unless (char=? (read-char) #\a)
	      (format *stderr* "read-char trouble\n"))
	    (unless (char=? (read-char) #\s)
	      (format *stderr* "read-char trouble\n"))
	    (unless (char=? (read-char (current-input-port)) #\d)
	      (format *stderr* "current-input-port trouble\n")))))
      
      (define (call-wis) 
	(do ((i 0 (+ i 1)))
	    ((= i ssize/2))
	  (wis)))
      
      (define cwis
	(let ((a (char->integer #\a))
	      (s (char->integer #\s)))
	  (lambda ()
	    (call-with-input-string "asdf"
	      (lambda (p)
		(if (port-closed? p)
		    (format *stderr* "cwis port closed\n"))
		(unless (= (read-byte p) a)
		  (format *stderr* "call read-char trouble\n"))
		(unless (= (read-byte p) s)
		  (format *stderr* "call read-char trouble\n"))
		(unless (= (port-position p) 2)
		  (format *stderr* "cwis position: ~A~%" (port-position p))))))))
      
      (define (call-cwis) 
	(do ((i 0 (+ i 1)))
	    ((= i ssize/2))
	  (cwis))))

    (begin
      (define (wis)
	(with-input-from-string "asdf"
	  (lambda ()
	    (unless (char=? (read-char) #\a)
	      (format *stderr* "read-char trouble\n"))
	    (unless (char=? (read-char) #\s)
	      (format *stderr* "read-char trouble\n"))
	    (unless (char=? (read-char (current-input-port)) #\d)
	      (format *stderr* "current-input-port trouble\n")))))
      
      (define (call-wis) 
	(do ((i 0 (+ i 1)))
	    ((= i ssize))
	  (wis)))
      
      (define cwis
	(let ((a (char->integer #\a))
	      (s (char->integer #\s)))
	  (lambda ()
	    (call-with-input-string "asdf"
	      (lambda (p)
		(if (port-closed? p)
		    (format *stderr* "cwis port closed\n"))
		(unless (= (read-byte p) a)
		  (format *stderr* "call read-char trouble\n"))
		(unless (= (read-byte p) s)
		  (format *stderr* "call read-char trouble\n"))
		(unless (= (port-position p) 2)
		  (format *stderr* "cwis position: ~A~%" (port-position p))))))))
      
      (define (call-cwis) 
	(do ((i 0 (+ i 1)))
	    ((= i ssize))
	  (cwis)))))

(define (wif)
  (with-input-from-file "t923.scm"
    (lambda ()
      (unless (string=? (read-line) "asdf")
	(format *stderr* "file read-char trouble\n"))
      (unless (eq? (read-line) #<eof>)
	(format *stderr* "file read-line eof trouble\n")))))

(define (call-wif) 
  (do ((i 0 (+ i 1)))
      ((= i fsize))
    (wif)))

(define (cwif)
  (call-with-input-file "t923.scm"
    (lambda (p)
      (unless (string=? (port-filename p) "t923.scm")
	(format *stderr* "cxif port filename: ~S~%" (port-filename p)))
      (unless (string=? (read-string 5 p) "asdf\n")
	(format *stderr* "file read-string trouble\n"))
      (unless (eq? (read-string 1 p) #<eof>)
	(format *stderr* "file read-string eof trouble\n")))))

(define (call-cwif) 
  (do ((i 0 (+ i 1)))
      ((= i fsize))
    (cwif)))


(if (or (> (*s7* 'major-version) 10) 
	(and (= (*s7* 'major-version) 10) (>= (*s7* 'minor-version) 9)))
    (begin
      (define (call-new-wos)
	(let ((p (open-output-string)))
	  (do ((i 0 (+ i 1)))
	      ((= i ssize/2))
	    (set! (port-string p) "ab")
	    (unless (string=? (get-output-string p) "ab")
	      (format *stderr* "write-char trouble\n")))
	  (close-output-port p)))

      (define (call-new-cwos)
	(let ((p (open-output-string)))
	  (do ((i 0 (+ i 1)))
	      ((= i ssize/2))
	    (set! (port-string p) "asdf")
	    (unless (string=? (get-output-string p) "asdf")
	      (format *stderr* "call write-string trouble\n")))))

      (define (wos)
	(with-output-to-string
	  (lambda ()
	    (write-char #\a)
	    (write-char #\b)
	    (flush-output-port (current-output-port))
	    (unless (string=? (get-output-string (current-output-port)) "ab")
	      (format *stderr* "write-char trouble\n")))))
      
      (define (call-wos) 
	(do ((i 0 (+ i 1)))
	    ((= i ssize/2))
	  (wos)))
      
      (define (cwos)
	(call-with-output-string
	 (lambda (p)
	   (write-string "asdf" p)
	   (flush-output-port p)
	   (unless (string=? (get-output-string p) "asdf")
	     (format *stderr* "call write-string trouble\n")))))
      
      (define (call-cwos) 
	(do ((i 0 (+ i 1)))
	    ((= i ssize/2))
	  (cwos))))
    (begin
      (define (wos)
	(with-output-to-string
	  (lambda ()
	    (write-char #\a)
	    (write-char #\b)
	    (flush-output-port (current-output-port))
	    (unless (string=? (get-output-string (current-output-port)) "ab")
	      (format *stderr* "write-char trouble\n")))))
      
      (define (call-wos) 
	(do ((i 0 (+ i 1)))
	    ((= i ssize))
	  (wos)))
      
      (define (cwos)
	(call-with-output-string
	 (lambda (p)
	   (write-string "asdf" p)
	   (flush-output-port p)
	   (unless (string=? (get-output-string p) "asdf")
	     (format *stderr* "call write-string trouble\n")))))
      
      (define (call-cwos) 
	(do ((i 0 (+ i 1)))
	    ((= i ssize))
	  (cwos)))))

(define (wof)
  (with-output-to-file "/dev/null"
    (lambda ()
      (write-byte 100)
      (write-byte 101))))

(define (call-wof) 
  (do ((i 0 (+ i 1)))
      ((= i 10))
    (wof)))

(define (cwof)
  (call-with-output-file "/dev/null"
    (lambda (p)
      (newline p))))

(define (call-cwof) 
  (do ((i 0 (+ i 1)))
      ((= i 10))
    (cwof)))

(define (op1)
  (let ((port (open-input-string "(+ 1 2)")))
    (unless (input-port? port)
      (format *stderr* "op1 trouble\n"))
    (unless (char=? (peek-char port) #\()
      (format *stderr "op1 peek-char trouble\n"))
    (unless (equal? (read port) '(+ 1 2))
      (format *stderr* "op1 trouble\n"))
    (close-input-port port)))

(define (call-op1) 
  (do ((i 0 (+ i 1)))
      ((= i ssize))
    (op1)))

(define (op2)
  (let ((port (open-output-string)))
    (unless (output-port? port)
      (format *stderr* "op2 trouble\n"))
    (display "(+ 1 2)" port)
    (newline port)
    (flush-output-port port)
    (unless (string=? (get-output-string port) "(+ 1 2)\n")
      (format *stderr* "op2 trouble: ~S\n" (get-output-string port)))
    (close-output-port port)))

(define (call-op2) 
  (do ((i 0 (+ i 1)))
      ((= i ssize))
    (op2)))

(define (op3)
  (let ((port (open-input-file "t923.scm")))
    (unless (char=? (peek-char port) #\a)
      (format *stderr "op3 peek-char trouble\n"))
    (unless (string=? (read-line port) "asdf")
      (format *stderr* "op3 trouble\n"))
    (unless (string=? (read-line port) "fdsa")
      (format *stderr* "op3 2 trouble\n"))
    (unless (= (port-position port) 10)
      (format *stderr* "op3 pos: ~S~%" (port-position port)))
    (unless (= (port-line-number port) 3) ; 1-based??
      (format *stderr* "op3 line: ~S~%" (port-line-number port)))
    (close-input-port port)))

(define (call-op3) 
  (do ((i 0 (+ i 1)))
      ((= i fsize))
    (op3)))

(define (op4)
  (let ((port (open-output-file "/dev/null")))
    (write "asdf" port)
    (close-output-port port)))

(define (call-op4) 
  (do ((i 0 (+ i 1)))
      ((= i 10))
    (op4)))

#|
(define (funcs)
  (let ((ip (open-input-function
	     (lambda (choice)
	       (case choice
		 ((read peek-char) #\?)
		 ((char-ready?) #f)
		 ((read-char) #\a)
		 ((read-line) "a line"))))))
    (unless (string=? (read-line ip) "a line")
      (format *stderr* "input-function trouble\n"))
    (close-input-port ip))
  (let* ((str ())
	 (op (open-output-function
	      (lambda (c)
		(set! str (cons c str))))))
    (display #\a op)
    (close-output-port op)
    (unless (equal? str '(97))
      (format *stderr* "output-function trouble: ~S\n" str))))

(define (call-funcs) 
  (do ((i 0 (+ i 1)))
      ((= i fsize))
    (funcs)))
|#

(call-with-output-file "t923.scm"
  (lambda (p)
    (display "asdf" p)
    (newline p)))

(call-wis)
(call-cwis)
(call-wif)
(call-cwif)
(call-wos)
(call-cwos)
(call-wof)
(call-cwof)

(when (or (> (*s7* 'major-version) 10) 
	  (and (= (*s7* 'major-version) 10) (>= (*s7* 'minor-version) 9)))
  (call-new-wis)
  (call-new-cwis)
  (call-new-wos)
  (call-new-cwos))

(call-with-output-file "t923.scm"
  (lambda (p)
    (display "asdf\n" p)
    (display "fdsa" p)
    (newline p)))

(call-op1)
(call-op2)
(call-op3)
(call-op4)

;(call-funcs)

;(when (> (*s7* 'profile) 0) (show-profile 200))
(exit)

;; this is dominated by fopen, fwrite, and fclose -- mallocs everywhere!, so I multiplied the string ports by 5