;;; -*- Mode:LISP; Package:USER; Base:8 -*-

;;; percentage of lossage goes up here as %TV-CLOCK-RATE gets smaller.
;;;


(defun test-probe (name value)
  (let ((old (get name 'test-probe)))
    (cond ((null old)
	   (setf (get name 'test-probe) value)
	   value)
	  ((eql old value)
	   value)
	  ('else
	   (incf (get name 'test-probe-lossage))
	   (format t "~&Lossage at ~S, expecting ~S but got ~S~%" name old value)
	   value))))



(defun clear-probes (&rest l)
  (dolist (name l)
    (setf (get name 'test-probe) nil)
    (setf (get name 'test-probe-lossage) 0)))

	   
	   
	   
(defun losenum (x n)
  (clear-probes 'f 'i2 'exp)
  (do ((first (sqrt x))
       (j 0 (1+ j))
       (losers 0)
       (loser))
      ((= j n)
       (quotient (float losers) j))
    (setq loser (my-sqrt x))
    (unless (= first loser)
      (incf losers)
      (format t "~&Lossage at ~D ~S vs ~S~%" j first loser))))



(defun my-sqrt (number)
  (let ((n (float number)))
    (let ((f (+ n 0.0f0))
	  (i2 (si:%float-double 0 1))		;cons up a new one -- gets munged
	  (exp (- (si:%single-float-exponent n) si:single-float-exponent-offset
		  -2)))
      (setf (si:%single-float-exponent f) si:single-float-exponent-offset)
      (setf (si:%single-float-exponent i2)                            
	    (+ si:single-float-exponent-offset
	       (if (oddp exp)
		   (1+ (dpb (ldb #o0127 exp) #o0027 exp))
		 (dpb (ldb #o0127 exp) #o0027 exp))))
      (test-probe 'f f)
      (test-probe 'i2 i2)
      (test-probe 'exp exp)
      (do ((i 0 (1+ i))
	   (an (* i2 (+ 0.4826004 f (if (oddp exp) -0.25 0.0)))))
	  ((= i 4) an)
	(setq an (* 0.5 (+ an (// n an))))))))