#|
(progn
  (setq t1 (get-internal-real-time))
  (setq PI (calc-pi 100000))
  (setq t2 (get-internal-real-time))
  (- t2 t1))
|#

(defun calc-pi (prec)
  (let ((scale (expt 10 prec)))
    (flet ((* (x y) (round (* x y) scale))
	   (/ (x y) (round (* x scale) y))
	   (sqrt (x) (isqrt (* x scale)))
	   (const (x) (* x scale)))
      (let ((const-1 (const 1))
	    (const-2 (const 2))
	    (const-4 (const 4)))
	(let ((A const-1)
	      (B (/ const-1 (sqrt const-2)))
	      (T (/ const-1 const-4))
	      (X const-1))
	  (dotimes (x (truncate (log prec 2)))
	    (let ((Y A))
	      (setq A (ash (+ A B) -1))
	      (setq B (sqrt (* B Y)))
	      (setq T (- T (* X (let ((tem (- Y A))) (* tem tem)))))
	      (setq X (ash X 1))))
	  (/ (* (+ A B) (+ A B)) (* const-4 T)))))))

(defun calc-pi2 (prec10)
  (let* ((prec2 (ceiling (* (log 10 2) prec10)))
	 (-prec2 (- prec2)))
    (round (* (expt 10 prec10)
	      (flet ((* (x y) (ash (* x y) -prec2))
		     (/ (x y) (round (ash x prec2) y))
		     (sqrt (x) (isqrt (ash x prec2)))
		     (const (x) (ash x prec2)))
		(let ((const-1 (const 1))
		      (const-2 (const 2))
		      (const-4 (const 4)))
		  (let ((A const-1)
			(B (/ const-1 (sqrt const-2)))
			(T (/ const-1 const-4))
			(X const-1))
		    (dotimes (x (truncate (log prec10 2)))
		      (let ((Y A))
			(setq A (ash (+ A B) -1))
			(setq B (sqrt (* B Y)))
			(setq T (- T (* X (let ((tem (- Y A))) (* tem tem)))))
			(setq X (ash X 1))))
		    (/ (* (+ A B) (+ A B)) (* const-4 T))))))
	   (ash 1 prec2))))

