spectral-norm Lisp SBCL #6 program

;;    The Computer Language Benchmarks Game
;;    https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
;;
;;    Adapted from the C (gcc) code by Sebastien Loisel
;;    Contributed by Christopher Neufeld 2005-08-19
;;    Modified by Juho Snellman 2005-10-26
;;      * Use SIMPLE-ARRAY instead of ARRAY in declarations
;;      * Rearrange EVAL-A to make it more readable and a bit faster
;;    Modified by Andy Hefner 2008-09-18
;;      * Eliminate array consing
;;      * Clean up type declarations in eval-A
;;    Modified by Isaac Gouy 2019-10-17
;;      * eval-A like C gcc #4 program
;;      * posix-argv like Jon Smith's fannkuch-redux Lisp SBCL #2 program
;;      * deftype suggested by tfb on SO

(deftype int31 (&optional (bits 31))
  `(signed-byte ,bits))

(declaim (inline eval-A))
(defun eval-A (i j)
  (declare (type int31 i j))
  (/ 1.0d0 (+ (ash (* (+ i j) (+ i j 1)) -1) i 1)))

(defun eval-A-times-u (n u)
  (declare (type int31 n)
           (type (simple-array double-float) u))
  (let ((retval (make-array n :element-type 'double-float :initial-element 0.0d0)))
    (dotimes (i n)
      (dotimes (j n)
        (incf (aref retval i) (* (eval-A i j) (aref u j)))))
    retval))

(defun eval-At-times-u (n u)
  (declare (type int31 n)
           (type (simple-array double-float) u))
  (let ((retval (make-array n :element-type 'double-float :initial-element 0.0d0)))
    (dotimes (i n)
      (dotimes (j n)
        (incf (aref retval i) (* (eval-A j i) (aref u j)))))
    retval))

(defun eval-AtA-times-u (n u)
  (eval-At-times-u n (eval-A-times-u n u)))

(defun main () 
  (let* ((args (cdr sb-ext:*posix-argv*))
         (n (parse-integer (car args))))
    (declare (type int31 n))
    (let ((u (make-array n :element-type 'double-float :initial-element 1.0d0))
          (v (make-array n :element-type 'double-float)))
      (declare (type (simple-array double-float) U V))
      (dotimes (i 10)
        (setf v (eval-AtA-times-u n u))
        (setf u (eval-AtA-times-u n v)))
      (let ((vBv 0.0d0)
            (vv 0.0d0))
        (declare (type double-float vBv vv))
        (dotimes (i n)
          (incf vBv (* (aref u i) (aref v i)))
          (incf vv (* (aref v i) (aref v i))))
        (format t "~11,9F~%" (sqrt (the (double-float 0d0) (/ vBv vv)))))))) 

    

NOTES:
64-bit Ubuntu quad core
SBCL 2.4.2


 Mon, 04 Mar 2024 23:38:35 GMT

MAKE:
cp: 'spectralnorm.sbcl-6.sbcl' and './spectralnorm.sbcl-6.sbcl' are the same file
SBCL built with: /opt/src/sbcl-2.4.2/bin/sbcl --userinit /dev/null --batch --eval '(load "spectralnorm.sbcl-6.sbcl_compile")'
### START spectralnorm.sbcl-6.sbcl_compile
(handler-bind ((sb-ext:defconstant-uneql      (lambda (c) (abort c))))      (require :sb-concurrency)      (load (compile-file "spectralnorm.sbcl-6.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t)
### END spectralnorm.sbcl-6.sbcl_compile

; compiling file "/home/dunham/all-benchmarksgame/benchmarksgame_i53330/spectralnorm/tmp/spectralnorm.sbcl-6.sbcl" (written 18 OCT 2019 10:24:40 AM):

; wrote /home/dunham/all-benchmarksgame/benchmarksgame_i53330/spectralnorm/tmp/spectralnorm.sbcl-6.fasl
; compilation finished in 0:00:00.092
### START spectralnorm.sbcl-6.sbcl_run
(main) (quit)
### END spectralnorm.sbcl-6.sbcl_run


3.32s to complete and log all make actions

COMMAND LINE:
 /opt/src/sbcl-2.4.2/bin/sbcl --dynamic-space-size 500 --noinform --core sbcl.core --userinit /dev/null --load spectralnorm.sbcl-6.sbcl_run 5500

PROGRAM OUTPUT:
1.274224153