Commit 249a8424 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

sysdep: remove spearate sysdeps in favour of unified file

parent e528492b
;;; setup file for running cl-bench in ArmedBear Lisp
(load "defpackage")
(in-package :cl-bench)
(defun bench-gc () (ext:gc))
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
;; as of 2003-12-05, this is not quite ready yet. In support.lisp we compile
;; various ABL internal packages and the cl-bench packages using
;; JVM::JVM-COMPILE-PACKAGE
#+nil (setq jvm:*auto-compile* t)
(eval-when (:load-toplevel :execute)
(format *debug-io* "Loading JVM compiler ...~%")
(load "/opt/src/cvs-armedbear/j/src/org/armedbear/lisp/jvm.lisp")
(dolist (p '("CL" "SYS" "EXT" "PRECOMPILER"))
(jvm::jvm-compile-package p))
(format *debug-io* "Compiling all cl-bench packages ...~%")
(dolist (p (list-all-packages))
(when (eql 0 (search "CL-BENCH" (package-name p)))
(jvm::jvm-compile-package p))))
;; EOF
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; setup file for cl-bench running in ACL 6.2
;;;
;;; contributed by Kevin Layer
(eval-when (compile eval load) (load "defpackage"))
;; disable for the same tests as Lispworks Personal edition (limited heap size)
(when (search "Trial Edition" (lisp-implementation-type))
(push :lispworks-personal-edition *features*))
(in-package :cl-bench)
(defmacro with-spawned-thread (&body body)
;; run BODY inside a new thread
;;
;; KL: what's the point of running them in a separate process? It sure
;; makes debugging problems harder...
#+ignore
`(mp:process-run-function "cl-bench"
(lambda () ,@body))
#-ignore
`(progn ,@body))
(defun bench-gc () (gc t))
(setq excl:*record-source-file-info* nil)
(setq excl:*load-source-file-info* nil)
(setq excl:*record-xref-info* nil)
(setq excl:*load-xref-info* nil)
(setq excl:*global-gc-behavior* nil)
;; disabled by emarsden: I don't consider this fair
;; (setq excl::*default-rehash-size* 2.0)
;; (setq *print-pretty* nil)
;; for debugging:
#+ignore
(progn
(setf (sys:gsgc-switch :print) t)
(setf (sys:gsgc-switch :verbose) t))
;; EOF
;;; setup file for running cl-bench in CLISP
(load "defpackage")
(in-package :cl-bench)
(setq custom:*warn-on-floating-point-contagion* nil)
(defun bench-gc () (gc))
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
(defun bench-time (fun times name)
(declare (ignore name))
(labels ((merge-2-values (val1 val2)
(if (< internal-time-units-per-second 1000000)
(dpb val1 (byte 16 16) val2) ; TIME_1: AMIGA, DOS, OS/2, UNIX_TIMES
(+ (* val1 internal-time-units-per-second) val2))) ; TIME_2: UNIX sonst, WIN32
(secs (v1 v2 v3 v4)
(/ (- (merge-2-values v1 v2)
(merge-2-values v3 v4))
internal-time-units-per-second)))
(multiple-value-bind (new-real1
new-real2
new-run1
new-run2
new-gc1
new-gc2
new-space1
new-space2
new-gccount)
(sys::%%time)
(dotimes (i times) (funcall fun))
(multiple-value-bind (old-real1
old-real2
old-run1
old-run2
old-gc1
old-gc2
old-space1
old-space2
old-gccount)
(sys::%%time)
;; returns real user sys consed
(values (secs old-real1 old-real2 new-real1 new-real2)
(secs old-run1 old-run2 new-run1 new-run2)
0.0
(- old-gccount new-gccount))))))
;; EOF
;;; setup file for cl-bench running in CMUCL
(load "defpackage")
(in-package :cl-bench)
(setq ext:*bytes-consed-between-gcs* 25000000)
;; to avoid problems when running the bignum code (the default of
;; 40000 is too low for some of the tests)
(setq ext:*intexp-maximum-exponent* 100000)
#+(and mp experimental)
;; run BODY inside a new thread
(defmacro with-spawned-thread (&body body)
`(mp:make-process (lambda () ,@body) :name "cl-bench"))
;; #-mp
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
(defun bench-gc ()
(ext:gc #+gencgc :full #+gencgc t))
;; internals stuff that is mostly for stress-testing CMUCL
;; disable the byte compiler
#+nil (setq ext:*byte-compile-default* nil)
#+nil (setq ext:*block-compile-default* t)
;; testing the dynamic-extent support
#+nil
(setq ext:*trust-dynamic-extent-declarations* t
*suppress-dynamic-extent-safe-closures* t)
#+gencgc
(progn
(alien:def-alien-variable ("gencgc_verbose" gencgc-verbose) c-call::int)
(alien:def-alien-variable ("verify_gens" gencgc-verify-gens) c-call::int)
(alien:def-alien-variable ("pre_verify_gen_0" gencgc-pre-verify-gen0) c-call::int)
(alien:def-alien-variable ("verify_after_free_heap" gencgc-verify-after-free-heap) c-call::int)
(alien:def-alien-variable ("verify_dynamic_code_check" gencgc-verify-dynamic-code-check) c-call::int)
(alien:def-alien-variable ("check_code_fixups" gencgc-check-code-fixups) c-call::int)
(alien:def-alien-variable ("gencgc_zero_check" gencgc-zero-check) c-call::int)
(alien:def-alien-variable ("gencgc_enable_verify_zero_fill" gencgc-enable-verify-zero-fill) c-call::int)
(alien:def-alien-variable ("gencgc_zero_check_during_free_heap"
gencgc-zero-check-during-free-heap) c-call::int)
(defun gencgc-enable-checking ()
(setf gencgc-verify-gens 0)
(dolist (check '(gencgc-pre-verify-gen0
gencgc-verify-after-free-heap
gencgc-verify-dynamic-code-check
gencgc-check-code-fixups
gencgc-zero-check
gencgc-enable-verify-zero-fill
gencgc-zero-check-during-free-heap))
(setf check 1))))
;; enable as much internal checking as possible
(defun ecm-paranoid ()
#+gencgc (gencgc-enable-checking)
(setf c::*check-consistency* t)
(setf c::*always-clear-stack* t)
(setf (gethash "Target for ~S isn't complementary write-p." c::*ignored-errors*) t)
(setf pcl::*check-cache-p* t))
#+nil (ecm-paranoid)
;; adapted from code pulled from src/code/time.lisp
#-(and sparc-v9 performance-counters)
(defun bench-time (fun times name)
(declare (ignore name))
(let (old-run-utime
new-run-utime
old-run-stime
new-run-stime
old-real-time
new-real-time
old-page-faults
new-page-faults
real-time-overhead
run-utime-overhead
run-stime-overhead
old-bytes-consed
new-bytes-consed
cons-overhead)
;; Calculate the overhead...
(multiple-value-setq
(old-run-utime old-run-stime old-page-faults old-bytes-consed)
(lisp::time-get-sys-info))
;; Do it a second time to make sure everything is faulted in.
(multiple-value-setq
(old-run-utime old-run-stime old-page-faults old-bytes-consed)
(lisp::time-get-sys-info))
(multiple-value-setq
(new-run-utime new-run-stime new-page-faults new-bytes-consed)
(lisp::time-get-sys-info))
(setq run-utime-overhead (- new-run-utime old-run-utime))
(setq run-stime-overhead (- new-run-stime old-run-stime))
(setq old-real-time (get-internal-real-time))
(setq old-real-time (get-internal-real-time))
(setq new-real-time (get-internal-real-time))
(setq real-time-overhead (- new-real-time old-real-time))
(setq cons-overhead (- new-bytes-consed old-bytes-consed))
;; Now get the initial times.
(multiple-value-setq
(old-run-utime old-run-stime old-page-faults old-bytes-consed)
(lisp::time-get-sys-info))
(setq old-real-time (get-internal-real-time))
(dotimes (i times)
(funcall fun))
(multiple-value-setq
(new-run-utime new-run-stime new-page-faults new-bytes-consed)
(lisp::time-get-sys-info))
(setq new-real-time (- (get-internal-real-time) real-time-overhead))
;; returns real user sys consed
(values
(max (/ (- new-real-time old-real-time)
(float internal-time-units-per-second))
0.0)
(max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
(max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)
(max (- new-bytes-consed old-bytes-consed) 0))))
#+(and sparc-v9 performance-counters)
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cpc))
#+(and sparc-v9 performance-counters)
(defun bench-time (function times name)
(declare (ignore times))
(with-open-file (dis "/tmp/cmucl-disassembly.txt"
:direction :output
:if-exists :append
:if-does-not-exist :create)
(format dis "~%~% === Disassembly for ~A~%" function)
(disassemble function :stream dis))
(let* ((cpi (cpc::calculate-cpi function))
(icache-miss (cpc::calculate-icache-miss function))
(ecache-miss (cpc::calculate-ecache-miss function))
(stall-icache (cpc::calculate-instruction-stall function))
;; (stall-mispredict (cpc::calculate-mispredict-stall function))
(stall-load (cpc::calculate-load-stall function)))
(with-open-file (out "/tmp/cmucl-cpc.txt"
:direction :output
:if-exists :append
:if-does-not-exist :create)
(format out
";; ~25a ~5,2f [i: ~4,1f ~4,1f ] [e: ~4,1f] ~4,1f~%"
name cpi
(* 100 icache-miss) (* 100 stall-icache)
(* 100 ecache-miss) (* 100 stall-load)))))
;; EOF
;;; setup file for running cl-bench in Corman CL
(defun corman-compile-all-files ()
(dolist (f (directory "files/*.lisp"))
(compile-file f :print nil)))
(defun corman-load-and-run ()
(dolist (f (directory "files/*.fasl"))
(load f))
(bench-run))
;; EOF
;;; setup file for cl-bench running in ECL
;;
;; tested with ECL 0.9
;;
;; see <URL:http://ecls.sf.net/>
(load "defpackage")
(in-package :cl-bench)
(ext:set-limit 'ext:c-stack (* 8 1024 1024))
(defun bench-gc ()
(si:gc t))
#+threads
(defmacro with-spawned-thread (&body body)
`(mp:process-run-function nil #'(lambda () ,@body)))
#-threads
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
;; to autoload the compiler
(compile 'bench-gc)
#-ecl-bytecmp
(setq c::*cc-flags* (concatenate 'string "-I. " c::*cc-flags*))
;; EOF
;;; setup file for running cl-bench in GCL
(load "defpackage.lisp")
(in-package :cl-bench)
(defun bench-gc () (lisp:gbc t))
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
#+older-gcl
(defmacro with-standard-io-syntax (&body body)
`(progn ,@body))
;; EOF
;;; setup file for running cl-bench in lisp500
(load "defpackage")
(in-package :cl-bench)
(defun bench-gc () (cl:gc))
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
;; EOF
;;; setup file for running cl-bench in Lispworks
(load "defpackage")
(in-package :cl-bench)
(hcl:toggle-source-debugging nil)
(defun bench-gc () (hcl:gc-if-needed))
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
;; EOF
;;; setup file for cl-bench running in MCL ;; ;; contributed by James Anderson ;; ;; ;; You may need to increase the heap size allocated for MCL. 96 MB is ;; reported to be sufficient. (load "development:source;cl-bench;defpackage") (in-package :cl-bench) (defun bench-gc () (ccl:gc)) (defmacro with-spawned-thread (&body body) `(progn ,@body)) ;; to ignore comments in Unix-encoded source files (set-macro-character #\; #'(lambda (stream char) (loop (unless (setf char (read-char stream nil nil)) (return)) (when (member char '(#\return #\linefeed)) (return))) (values))) (setf (logical-pathname-translations "cl-bench") `(("**;*.*" ,(make-pathname :directory `(,@(butlast (pathname-directory *load-pathname*)) :wild-inferiors) :name :wild :type :wild)))) ;; disabled by Eric Marsden; I consider this to be cheating #+nil (setq ccl::*CHECK-SLOT-TYPE* nil) ;; EOF
\ No newline at end of file
;;; setup file for cl-bench running in OpenMCL
(load "defpackage")
(in-package :cl-bench)
;; 20 MB heap
(ccl:set-lisp-heap-gc-threshold (ash 2 20))
(defun bench-gc () (ccl:gc))
(setq ccl:*request-terminal-input-via-break* t)
(defvar *thread-pool-lock*
(ccl:make-lock "cl-bench thread pool lock"))
(defvar *thread-pool-semaphore* (ccl:make-semaphore))
(defvar *thread-pool* (list))
(ccl:with-lock-grabbed (*thread-pool-lock*)
(dotimes (i 3)
(push (ccl:make-process "cl-bench") *thread-pool*)
(ccl:signal-semaphore *thread-pool-semaphore*)))
;; run BODY inside a new thread
#+nil
(defmacro with-spawned-thread (&body body)
`(let ((thread nil))
(ccl:wait-on-semaphore *thread-pool-semaphore*)
(ccl:with-lock-grabbed (*thread-pool-lock*)
(setq thread (pop *thread-pool*)))
(format *debug-io* "Acquired process ~A~%" thread)
(assert (ccl::processp thread))
(ccl:process-preset thread
(lambda ()
,@body
(ccl:process-reset ccl:*current-process*)
(ccl:with-lock-grabbed (*thread-pool-lock*)
(push ccl:*current-process* *thread-pool*)
(ccl:signal-semaphore *thread-pool-semaphore*))))
(ccl:process-enable thread)))
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
;; EOF
;;; setup file for cl-bench running in Poplog CL
(in-package :common-lisp-user)
;; see <URL:http://www.cs.bham.ac.uk/research/poplog/doc/lisphelp/storeutils>
;; this is to allow the heap to grow as needed
(cl:require :storeutils)
(setq *max-store-size* nil)
(setf *default-pathname-defaults* #p"temp.lisp")
;; increase the maximum recursion level
(poplog:pop11)
section $-lisp;
uses pop_callstack_lim;
pop_callstack_lim * 10 -> pop_callstack_lim;
endsection;
lisp
(in-package :cl)
(defun compile-file-pathname (pathname)
pathname)
(export 'compile-file-pathname (find-package "CL"))
(load "defpackage")
(in-package :cl-bench)
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
(defun bench-gc () (poplog:gc))
;; EOF
;;; setup file for running cl-bench in SBCL
(load "defpackage")
(in-package :cl-bench)
(setf (sb-ext:bytes-consed-between-gcs) 25000000)
(setq sb-ext:*intexp-maximum-exponent* 100000)
(defun bench-gc ()
(sb-ext:gc #+gencgc :full #+gencgc t))
;; (condition-wait queue lock)
;; (condition-notify queue)
;; run BODY inside a new thread
;; #+sb-thread
;; (defmacro with-spawned-thread (&body body)
;; `(sb-thread:make-thread (lambda () ,@body)))
;;
;; #-sb-thread
(defmacro with-spawned-thread (&body body)
`(progn ,@body))
;; EOF
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