Commit 38add412 authored by Daniel Kochmański's avatar Daniel Kochmański

pathnames: don't use logical pathnames

Using them caused some problems with abcl (potentially also with
others).
parent 579fb725
......@@ -10,13 +10,25 @@
(error "use metering"))
(let ((root-dir (asdf:system-source-directory '#:cl-bench)))
(defparameter *root-dir* root-dir
"Toplevel directory of the CL-BENCH system.")
(defparameter *misc-dir* (merge-pathnames "misc/" root-dir)
"Directory containing auxilliary files.")
(defparameter *output-dir* (merge-pathnames "output/" root-dir)
"Directory where the results are stored.")
;; don't use logical pathnames (not well supported on all active
;; implementations. These would be the translations if everything
;; would work as expected.
#+(or)
(setf (logical-pathname-translations "bench")
`(("root;*.*.*" ,root-dir)
("test;*.*.*" ,(merge-pathnames "files/" root-dir))
("misc;*.*.*" ,(merge-pathnames "misc/" root-dir))
("result;*.*.*" ,(merge-pathnames "output/" root-dir))
("**;*.*.*" ,(merge-pathnames "**/" root-dir))))
(ensure-directories-exist (merge-pathnames "output/" root-dir)))
("**;*.*.*" ,(merge-pathnames "**/" root-dir)))))
(ensure-directories-exist *output-dir*)
;;; This is disabled after the consultation with the ABCL maintainer
......
......@@ -292,7 +292,7 @@
(defun run-deflate-file ()
(test-deflate-file "bench:misc;message.gz"))
(test-deflate-file (merge-pathnames "message.gz" *misc-dir*)))
;; EOF
;;; misc.lisp
;;;
;;; Time-stamp: <2016-05-13 11:47:06 jack>
;;; Time-stamp: <2016-05-16 11:31:42 jack>
(defpackage :cl-bench.misc
(:use :common-lisp)
......@@ -13,14 +13,14 @@
(in-package :cl-bench.misc)
(defun run-compiler ()
(compile-file #P"bench:test;gabriel.lisp"
(compile-file (merge-pathnames "gabriel.lisp" *misc-dir*)
:print nil
#-gcl :verbose #-gcl nil))
(defun run-fasload ()
(load
(compile-file-pathname
#P"bench:test;gabriel.lisp")))
(merge-pathnames "gabriel.lisp" *misc-dir*))))
;; by Gene Luks (adapted from the Larceny benchmarks)
......
This diff is collapsed.
;;; pdf-report.lisp
;;
;; Author: Eric Marsden <emarsden@laas.fr>
;; Time-stamp: <2016-05-13 12:24:31 jack>
;; Time-stamp: <2016-05-16 11:39:25 jack>
;;
;;
;; When loaded into CMUCL, this should generate a report comparing the
......@@ -45,9 +45,10 @@
;; FIXME annotate each benchmark with estimated allocation volume & peak storage requirement
(defun bench-analysis (&optional (filename #p"bench:result;cl-bench.pdf"))
(defun bench-analysis
(&optional (filename (merge-pathnames "cl-bench.pdf" *output-dir*)))
(let (content data groups implementations benchmarks impl-scores impl-labels)
(dolist (f (directory "bench:result;CL-benchmark*.*"))
(dolist (f (directory (merge-pathnames "CL-benchmark*.*" *output-dir*)))
(ignore-errors
(with-open-file (f f :direction :input)
(let ((*read-eval* nil))
......@@ -116,105 +117,6 @@
(typeset::draw-pages content :margins '(72 72 72 72) :header nil :footer footer)
(pdf:write-document filename)))))
;; (defun bench-analysis (&optional (filename #p"bench:result;cl-bench.pdf"))
;; (let (data groups implementations benchmarks impl-scores impl-labels)
;; (dolist (f (directory "bench:result;CL-benchmark*.*"))
;; (ignore-errors
;; (with-open-file (f f :direction :input)
;; (let ((*read-eval* nil))
;; (push (read f) data)))))
;; (setf data (sort data #'string< :key #'car))
;; (setf implementations (mapcar #'car data))
;; (loop :for b :in *benchmarks*
;; :do (pushnew (benchmark-group b) groups))
;; (setf impl-scores (make-list (length implementations)
;; :initial-element 0))
;; (setf impl-labels (loop :for i :from 0 :below (length implementations)
;; :collect (string (code-char (+ i (char-code #\A))))))
;; (setf benchmarks (reverse (mapcar #'first (cdr (first data)))))
;;
;; ;; FIXME possibly group graphs one group per page
;; ;;
;; ;; add numbers on bars
;; ;;
;; ;; annotate each benchmark with estimated allocation volume & peak storage requirement
;; (pdf:with-document (:author "ric Marsden"
;; :title "cl-bench performance results")
;; (let ((helvetica (pdf:get-font "Helvetica"))
;; (helvetica-bold (pdf:get-font "Helvetica-Bold"))
;; (helvetica-oblique (pdf:get-font "Helvetica-Oblique"))
;; (times (pdf:get-font "Times-Roman"))
;; (page 0)
;; (per-page 0)
;; (page-name ""))
;; (dolist (group groups)
;; (incf page)
;; (setf page-name (format nil "page ~d" page))
;; (pdf:with-page ()
;; (pdf:register-page-reference page-name)
;; (pdf:with-outline-level (group page-name)
;; ;; group name
;; (pdf:in-text-mode
;; (pdf:set-font helvetica-bold 16.0)
;; (pdf:move-text 100 700)
;; (pdf:draw-text (string group)))
;; ;; version number
;; (pdf:in-text-mode
;; (pdf:set-font helvetica-oblique 8)
;; (pdf:move-text 10 10)
;; (pdf:draw-text (format nil "cl-bench version ~A" *version*)))
;; (setf per-page 1)
;; (dolist (bm (remove-if-not (lambda (b) (eql (benchmark-group b) group)) *benchmarks*))
;; (format *debug-io* "Group ~A, benchmark ~A~%" group bm)
;; (let* ((bn (benchmark-name bm))
;; (results (loop :for i :in implementations
;; :collect (let* ((id (cdr (assoc i data :test #'string=)))
;; (ir (third (assoc bn id :test #'string=))))
;; (if (numberp ir) (float ir) -0.02))))
;; (ypos (- 640 (* 150 per-page))))
;; ;; with-column-layout
;; ;; test title
;; (incf per-page)
;; `(pdf:in-text-mode
;; (pdf:set-font helvetica-bold 16.0)
;; (pdf:move-text 100 ,ypos)
;; (pdf:draw-text bn))
;; ;; optional extra description
;; ;; (when (and b (benchmark-long b))
;; ;; (pdf:in-text-mode
;; ;; (pdf:set-font helvetica 12)
;; ;; (pdf:move-text 100 520)
;; ;; (pdf:draw-text (benchmark-long b))))
;; ;; y-axis title
;; ;; (pdf:with-saved-state
;; ;; (pdf:translate 65 350)
;; ;; (pdf:rotate 90)
;; ;; (pdf:in-text-mode
;; ;; (pdf:set-font helvetica 10)
;; ;; (pdf:draw-text "seconds")))
;; (pdf:draw-object
;; (make-instance 'pdf:histogram
;; :x 100 :y ypos
;; :width 100 :height 100
;; :label-names impl-labels
;; :labels&colors '(("ignore" (0.0 0.0 1.0)))
;; :series (list results)
;; :y-axis-options '(:min-value -0.5 :title "seconds")
;; :background-color '(0.9 0.9 0.9)))
;; #+nil
;; (pdf:in-text-mode
;; (pdf:move-text 100 250)
;; (pdf:set-font times 12.0)
;; (dotimes (i (length implementations))
;; (pdf:move-text 0 -14)
;; (pdf:draw-text (format nil "~A: ~A"
;; (nth i impl-labels)
;; (nth i implementations)))))))))))
;; (pdf:write-document filename))))
(bench-analysis)
(quit)
......
;;; report.lisp
;;
;; Author: Eric Marsden <emarsden@laas.fr>
;; Time-stamp: <2016-05-13 12:25:00 jack>
;; Time-stamp: <2016-05-16 11:36:51 jack>
;;
;;
;; When loaded into CMUCL, this should generate a report comparing the
......@@ -21,7 +21,7 @@
(defun bench-analysis ()
(let (data implementations benchmarks)
(dolist (f (directory "bench:result;CL-benchmark*.*"))
(dolist (f (directory (merge-pathnames "CL-benchmark*.*" *output-dir*)))
(ignore-errors
(with-open-file (f f :direction :input)
(let ((*read-eval* nil))
......
......@@ -3,7 +3,7 @@
;; Author: Eric Marsden <emarsden@laas.fr>
;; Maintainer: Daniel Kochmański <daniel@turtleware.eu>
;;
;; Time-stamp: <2016-05-13 19:42:30 jack>
;; Time-stamp: <2016-05-16 11:38:02 jack>
;;
;;
;; The benchmarks consist of
......@@ -123,7 +123,7 @@
(get-decoded-time)
(declare (ignore second))
(format nil "~aCL-benchmark-~d~2,'0d~2,'0dT~2,'0d~2,'0d"
"bench:result;"
(namestring *output-dir*)
year month date hour minute)))
;; grr, CLISP doesn't implement ~<..~:>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment