Package: sbcl
Version: 2:1.1.2-1
Followup-For: Bug #676979
::::::::::::::::::::::::::::::::::::::::::::::::::::::
nik.lisp
::::::::::::::::::::::::::::::::::::::::::::::::::::::
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *read-default-float-format* 'double-float))
(declaim (inline rnorm rgamma))
(defun rnorm (x y)
(declare (double-float x y))
(* x y))
(defun rgamma (x y)
(declare (double-float x y))
(+ x y))
(defun nik (N thin)
;;(declare (fixnum N thin))
(declare ((integer 0 #.most-positive-fixnum) N thin))
(declare (optimize (speed 3) (safety 1)))
(declare (optimize debug))
(let ((x 0.0) (y 0.0)
(xvec (make-array (* N thin) :element-type '(double-float 0.0 *)
:adjustable nil :fill-pointer nil :displaced-to nil))
(yvec (make-array (* N thin) :element-type 'double-float :adjustable
nil :fill-pointer nil :displaced-to nil)))
(declare (double-float x y))
(declare (type (simple-array (double-float 0.0 *)) xvec))
(declare (type (simple-array double-float) yvec))
(dotimes (i N)
(dotimes (j thin)
(symbol-macrolet ((xval (aref xvec (+ (the fixnum (* i thin)) j)))
(yval (aref yvec (+ (the fixnum (* i thin)) j))))
(setf xval (rgamma 3.0 (/ 1 (+ (* yval yval) 4))))
(setf yval (rnorm (/ 1 (+ xval 1)) (/ 1 (sqrt (+ (* 2 xval) 2)))))
(setf x xval)
(setf y yval)))
;;(format t "~a ~a ~a~%" i x y)
)))
(defun main (N)
(loop repeat 100
do (nik N 1000)
(room)
(write-line "---"))
(write-line "--- After full GC ---")
(gc :full t)
(room))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;file ends
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-- System Information:
Debian Release: 6.0.6
APT prefers stable-updates
APT policy: (500, 'stable-updates'), (500, 'stable'), (50, 'unstable'), (50,
'testing'), (1, 'experimental')
Architecture: i386 (i686)
Kernel: Linux 2.6.32-5-vserver-686-bigmem (SMP w/2 CPU cores)
Locale: LANG=en_US.UTF-8, LC_CTYPE=en_US.UTF-8 (charmap=UTF-8)
Shell: /bin/sh linked to /bin/bash
Versions of packages sbcl depends on:
ii libc6 2.11.3-4
ii zlib1g 1:1.2.3.4.dfsg-3
Versions of packages sbcl recommends:
ii binfmt-support 1.2.18
Versions of packages sbcl suggests:
ii sbcl-doc 2:1.0.56.0-1
ii sbcl-source 2:1.0.56.0-1
ii slime 1:20120525-2
-- no debconf information
--
To UNSUBSCRIBE, email to debian-bugs-dist-requ...@lists.debian.org
with a subject of "unsubscribe". Trouble? Contact listmas...@lists.debian.org
