Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • cmucl/cmucl
  • pfominykh/cmucl
  • yitzchak/cmucl
  • rkreuter/cmucl
  • cshapiro/cmucl
5 results
Show changes
Commits on Source (9994)
Showing
with 1586 additions and 4302 deletions
((nil
(indent-tabs-mode . t)
(require-final-newline . t)
(tab-width . 8))
(c-mode
(c-basic-offset . 4)))
# http://editorconfig.org
root = true
[*]
indent_style = tab
insert_final_newline = true
tab_width = 8
[*.{c,h}]
indent_size = 4
# Ignore default build directories
# Ignore emacs files
# Ignore fasls
# Ignore files generated by TeX
*.fasl
*.ppcf
*.sparcf
*.sse2f
*.x86f
*~
/test-tmp
build-*
darwin-8bit-[234]
darwin-[234]
linux-8bit-[234]
linux-[234]
sparc-8bit-[234]
sparc-[234]
src/docs/cmu-user/*.aux
src/docs/cmu-user/*.cdx
src/docs/cmu-user/*.cnd
src/docs/cmu-user/*.fdx
src/docs/cmu-user/*.fnd
src/docs/cmu-user/*.idx
src/docs/cmu-user/*.ilg
src/docs/cmu-user/*.log
src/docs/cmu-user/*.out
src/docs/cmu-user/*.pdf
src/docs/cmu-user/*.tdx
src/docs/cmu-user/*.tnd
src/docs/cmu-user/*.toc
src/docs/cmu-user/*.vdx
src/docs/cmu-user/*.vnd
variables:
download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2024/08"
version: "2024-08-x86"
bootstrap: "-B boot-2024-08"
# Default install configuration to download the cmucl tarballs to use
# for building.
.install_template: &install_configuration
stage: install
artifacts:
paths:
- snapshot/
script:
- echo PATH = $PATH
- ls -F /usr/local/bin
- type -all gitlab-runner
# Download binaries. (Do we really need the extras tarball?)
- $CURL -o cmucl-$version-$osname.tar.bz2 $download_url/cmucl-$version-$osname.tar.bz2
- $CURL -o cmucl-$version-$osname.extra.tar.bz2 $download_url/cmucl-$version-$osname.extra.tar.bz2
- mkdir snapshot
- (cd snapshot; tar xjf ../cmucl-$version-$osname.tar.bz2; tar xjf ../cmucl-$version-$osname.extra.tar.bz2)
# Default build configuration to be added to each build stage for each
# OS. This assumes we don't need anything special between OSes, and
# the option '-C ""' is good enough. We also override the default
# build dirs by using the -b option so that we know where the results
# are, independent of OS.
.build_template: &build_configuration
stage: build
artifacts:
paths:
- dist/
- build-2/*.log
- build-3/*.log
- build-4/
# Needed by Linux analyzer stage
- src/lisp/cmucl-version.h
script:
# Do cross compile first
#- bin/create-target.sh xtarget x86_linux_clang
#- bin/create-target.sh xcross x86_linux_clang
#- bin/cross-build-world.sh -crl -B boot-2020-04-1 xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp snapshot/bin/lisp
# Regular build using the cross-compiled result or snapshot. The
# analyzer job requires gcc, so make sure we build with gcc here
# instead of clang.
- bin/build.sh $bootstrap -b build -R -C "" -o snapshot/bin/lisp
# When the result of `git describe` cannot be used as a version
# string, an alternative can be provided with the -V flag
- bin/make-dist.sh -I dist build-4
# Default configuration for running the ansi-tests.
.ansi_test_template: &ansi_test_configuration
stage: ansi-test
artifacts:
paths:
- ansi-test/test.out
script:
- bin/run-ansi-tests.sh -l dist/bin/lisp
# Default configuration for running unit tests.
.unit_test_template: &unit_test_configuration
stage: test
artifacts:
paths:
- ansi-test/test.out
- test.log
script:
- echo LANG = $LANG
- bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log
# Default configuration to test creation of lisp executable and
# testing the exectuable works.
.exec_test_template: &exec_test_configuration
stage: test
script:
# Create an executable and test it by printing the version.
- dist/bin/lisp -eval '(save-lisp "saved-lisp-executable" :executable t)'
- ./saved-lisp-executable --version
# Default configuration for running the benchmarks.
.benchmark_template: &benchmark_configuration
stage: benchmark
artifacts:
paths:
- benchmarks/cl-bench/results
script:
- cd benchmarks/cl-bench
- mkdir tmp
- CMUCL=../../snapshot/bin/lisp ./run-cmucl.sh
- CMUCL=../../dist/bin/lisp ./run-cmucl.sh
- ../../snapshot/bin/lisp -load report
stages:
- install
- build
- test
- ansi-test
- benchmark
- analyze
cache:
#### Linux jobs ####
linux:install:
<<: *install_configuration
tags:
- linux
variables:
osname: "linux"
CURL: "curl"
linux:build:
<<: *build_configuration
tags:
- linux
needs:
- job: linux:install
artifacts: true
linux:cross-build:
stage: build
tags:
- linux
artifacts:
paths:
- xdist/
- linux-2/*.log
- linux-3/*.log
- linux-4/*.log
# The lisp directory is needed for the static analyzer job.
- linux-4/lisp
needs:
# Normally need the linux:install stage to get the compiler to
# use. But for #337, we need the normal build from linux:build to
# do the cross-compile. Once the snapshot is made, we can use
# linux:install instead.
- job: linux:build
#- job: linux:install
artifacts: true
script:
- bin/create-target.sh xtarget
- bin/create-target.sh xcross
- bin/cross-build-world.sh -crl xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp dist/bin/lisp
- bin/build.sh -b xlinux $bootstrap -R -C "" -o "xtarget/lisp/lisp -lib xtarget/lisp"
- bin/make-dist.sh -I xdist xlinux-4
linux:test:
<<: *unit_test_configuration
tags:
- linux
needs:
# Needs artifacts from build (dist/)
- job: linux:build
artifacts: true
linux:exec-test:
<<: *exec_test_configuration
tags:
- linux
needs:
- job: linux:build
artifacts: true
linux:cross-test:
stage: test
tags:
- linux
artifacts:
paths:
- ansi-test/test.out
- cross-test.log
needs:
# Needs artifacts from build (dist/)
- job: linux:cross-build
artifacts: true
script:
- bin/run-unit-tests.sh -l xdist/bin/lisp 2>&1 | tee cross-test.log
linux:ansi-test:
<<: *ansi_test_configuration
tags:
- linux
needs:
# Needs artifacts from build (dist/)
- job: linux:build
artifacts: true
linux:benchmark:
<<: *benchmark_configuration
tags:
- linux
needs:
# Needs artifacts from install (snapshot/) and build (dist/)
- job: linux:install
artifacts: true
- job: linux:build
#### OSX (Mac) jobs ####
osx:install:
<<: *install_configuration
tags:
- macos-virtualbox
variables:
osname: "darwin"
CURL: "/opt/local/bin/curl"
osx:build:
<<: *build_configuration
tags:
- macos-virtualbox
needs:
- job: osx:install
artifacts: true
osx:test:
<<: *unit_test_configuration
tags:
- macos-virtualbox
needs:
# Needs artifacts from build (dist/)
- job: osx:build
artifacts: true
osx:exec-test:
<<: *exec_test_configuration
tags:
- macos-virtualbox
needs:
- job: osx:build
artifacts: true
osx:ansi-test:
<<: *ansi_test_configuration
tags:
- macos-virtualbox
needs:
# Needs artifacts from build (dist/)
- job: osx:build
artifacts: true
osx:benchmark:
<<: *benchmark_configuration
tags:
- macos-virtualbox
needs:
# Needs artifacts from install (snapshot/) and build (dist/)
- job: osx:install
artifacts: true
- job: osx:build
# Optional job that runs the static analyzer. It needs the files from
# the linux-4 directory built in the linux:build job.
linux:static-analyzer:
stage: analyze
when: manual
tags:
- linux
artifacts:
paths:
- analyzer.log
needs:
- job: linux:build
artifacts: true
script:
# Analysis can generate huge amounts of output. For now just save
# the results to the log file instead of also having it go to the
# console. If someday there's less or no output, we can consider
# having the logs go to the console too.
- make -C build-4/lisp clean
- make -C build-4/lisp CFLAGS=-fanalyzer > analyzer.log 2>&1
#### OpenSUSE jobs ####
opensuse:install:
<<: *install_configuration
tags:
- opensuse
variables:
osname: "linux"
CURL: "curl"
opensuse:build:
<<: *build_configuration
tags:
- opensuse
needs:
- job: opensuse:install
artifacts: true
opensuse:test:
<<: *unit_test_configuration
tags:
- opensuse
needs:
# Needs artifacts from build (dist/)
- job: opensuse:build
artifacts: true
opensuse:ansi-test:
<<: *ansi_test_configuration
tags:
- opensuse
needs:
# Needs artifacts from build (dist/)
- job: opensuse:build
artifacts: true
## Describe the bug
A clear and concise description of what the bug is.
## To Reproduce
Steps to reproduce the behavior:
1. Go to '...'
2. Click on '....'
3. Scroll down to '....'
4. See error
## Expected behavior
A clear and concise description of what you expected to happen.
## Screenshots
If applicable, add screenshots to help explain your problem.
## Desktop (please complete the following information):
- OS: [e.g. Linux]
- Version: [e.g. 21e]
## Additional context
Add any other context about the problem here.
/label ~bug
## Describe the feature
Briefly describe the feature you would like see.
## Is there a prototype?
If you have a prototype, provide links to illustrate this addition. This is the best way to propose a new feature.
## Describe the feature in more detail
Provide more information to describe the feature.
/label ~feature
This diff is collapsed.
[![pipeline status](https://gitlab.common-lisp.net/cmucl/cmucl/badges/master/pipeline.svg)](https://gitlab.common-lisp.net/cmucl/cmucl/commits/master)
CMUCL is a free, high performance implementation of the Common Lisp
programming language which runs on most major Unix platforms. It
mainly conforms to the ANSI Common Lisp standard. CMUCL provides a
sophisticated native code compiler; a powerful foreign function
interface; an implementation of CLOS; the Common Lisp Object System;
which includes multimethods; a metaobject protocol; a source-level
debugger and code profiler; and an Emacs-like editor implemented in
Common Lisp. CMUCL is maintained by a team of volunteers collaborating
over the Internet, and is mostly in the public domain.
Here is a summary of its main features:
* support for **static arrays** that are never moved by GC but are
properly removed when no longer referenced.
* **Unicode** support, including many of the most common external
formats such as UTF-8 and support for handling Unix, DOS, and
Mac end-of-line schemes.
* native **double-double floats** including complex double-double
floats and specialized arrays for double-double floats and and
complex double-double floats that give approximately 106 bits
(32 digits) of precision.
* a **sophisticated native-code compiler** which is capable of
powerful type inferences, and generates code competitive in
speed with C compilers.
* **generational garbage collection** on all supported
architectures.
* **multiprocessing capability** on the x86 ports.
* a foreign function interface which allows interfacing with C code
and system libraries, including shared libraries on most platforms,
and direct access to Unix system calls.
* support for interprocess communication and remote procedure calls.
* an implementation of CLOS, the [Common Lisp Object
System](http://en.wikipedia.org/wiki/Common_Lisp_Object_System),
which includes multimethods and a metaobject protocol.
* a graphical source-level debugger using a Motif interface, and a
code profiler.
* an interface to the X11 Window System (CLX), and a sophisticated
graphical widget library ([Garnet](https://www.cs.cmu.edu/~garnet/),
available separately).
* programmer-extensible input and output streams ([Gray
Streams](http://www.nhplace.com/kent/CL/Issues/stream-definition-by-user.html)
and
[simple-streams](http://www.franz.com/support/documentation/current/doc/streams.htm)).
* an Emacs-like editor,
[Hemlock](http://cmucl.org/hemlock/index.html), implemented in
Common Lisp.
* **freely redistributable**: free, with full source code (most of
which is in the public domain) and no strings attached (and no
warranty). Like the GNU/Linux and *BSD operating systems, CMUCL is
maintained and improved by a team of volunteers collaborating over
the Internet.
For the latest news and other information, see [the wiki](https://gitlab.common-lisp.net/cmucl/cmucl/wikis/home).
\ No newline at end of file
This diff is collapsed.
This diff is collapsed.
;;; -*- Mode: Lisp; Package: Compiler -*-
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; Spice Lisp is currently incomplete and under active development.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; The DISASSEMBLE function as described in the Common Lisp manual.
;;;
;;; Written by Don Mathis
;;;
;;;
;;; Modified 11/83 by Robert Rose to put an asterisk before lines
;;; that are branched to.
;;;
;;; Heavily Modified 1/84 to use new instruction set.
;;;
;;; Modified by David B. McDonald to disassemble the Romp instruction
;;; set.
;;;
;;; Hacked by Rob MacLachlan for the interim RT function format. Hopefully
;;; this file will die after the port.
;;;
;;; **********************************************************************
;;;
(in-package 'compiler :use '("LISP" "SYSTEM"))
(export 'lisp::disassemble (find-package 'lisp))
(proclaim '(special romp-4bit-opcode-symbol romp-8bit-opcode-symbol))
;;;; The Main function, DISASSEMBLE
(defun disassemble (function &optional (*standard-output* *standard-output*))
"The argument should be either a function object, a lambda expression, or
a symbol with a function definition. If the relevant function is not a
compiled function, it is first compiled. In any case, the compiled code
is then 'reverse assembled' and printed out in a symbolic format."
(etypecase function
(function
(ecase (%primitive get-vector-subtype function)
((#.%function-entry-subtype #.%function-closure-entry-subtype)
(prin-prelim-info function)
(Output-macro-instructions function (branch-list function)))
(#.%function-closure-subtype
(disassemble (%primitive header-ref function %function-name-slot)))))
(symbol
(disassemble (symbol-function function)))))
;;; PRIN-PRELIM-INFO takes a function object and extracts from it and
;;; prints out the following information:
;;; - The argument list of the function.
;;; - The number of Locals allocated by the function.
;;; - Whether the function does or does not evaluate its arguments.
(defun prin-prelim-info (function)
(format t "~%Disassembly of ~S.~%"
(%primitive header-ref function %function-name-slot))
(format t "~%Its arg list is: ~A.~%"
(%primitive header-ref function %function-entry-arglist-slot)))
;;; OUTPUT-MACRO-INSTRUCTIONS takes a function object and prints out the
;;; corresponding macro. (Not executable macro, just macro that looks good!)
(defun Output-Macro-Instructions (function branches)
(declare (optimize (speed 3) (safety 0)))
(let* ((byte-vector
(%primitive header-ref function %function-code-slot))
(offset
(- (%primitive header-ref function %function-offset-slot)
i-vector-header-size))
(vector-length (length byte-vector)))
(declare (fixnum vector-length))
(do ((i 0))
((= i vector-length))
(declare (fixnum i))
(when (= i offset)
(format t "~&*** Enter here:~%"))
(let* ((opcode (aref byte-vector i))
(symbol (find-symbol-name opcode))
(inst-type (get symbol 'romp-instruction-type)))
(case inst-type
(ji (print-ji-instruction opcode byte-vector i branches)
(setq i (the fixnum (+ i 2))))
(x (print-x-instruction opcode byte-vector i branches)
(setq i (the fixnum (+ i 2))))
(ds (print-ds-instruction opcode byte-vector i branches function)
(setq i (the fixnum (+ i 2))))
(r (print-r-instruction opcode byte-vector i branches)
(setq i (the fixnum (+ i 2))))
(bi (print-bi-instruction opcode byte-vector i branches)
(setq i (the fixnum (+ i 4))))
(ba (print-ba-instruction opcode byte-vector i branches)
(setq i (the fixnum (+ i 4))))
(d (setq i (the fixnum
(+ i (the fixnum
(print-d-instruction opcode byte-vector i
branches function ))))))
(T (error "Illegal instruction type: ~A for instruction ~A.~%"
inst-type symbol)))))))
(defun find-symbol-name (opcode)
(declare (fixnum opcode))
(let ((symbol (svref romp-4bit-opcode-symbol (logand (the fixnum (ash opcode -4)) #xFF))))
(if symbol
symbol
(svref romp-8bit-opcode-symbol opcode))))
;;; BRANCH-LIST is very much like output-macro-instructions,
;;; but instead of actually creating all the instructions it just
;;; creates the branch instruction labels. A list of these labels
;;; is returned.
(defun branch-list (function)
(let* ((byte-vector
(%primitive header-ref function %function-code-slot))
(vector-length (length byte-vector))
(branches nil))
(declare (fixnum vector-length))
(do ((i 0))
((>= i vector-length))
(declare (fixnum i))
(let* ((opcode (aref byte-vector i))
(symbol (find-symbol-name opcode))
(inst-type (get symbol 'romp-instruction-type)))
(case inst-type
(ji (push (the fixnum (+ i (the fixnum (sign-extend-ji byte-vector i)))) branches)
(setq i (the fixnum (+ i 2))))
((x ds r) (setq i (the fixnum (+ i 2))))
(bi (push (the fixnum (+ i (the fixnum (sign-extend-bi byte-vector i)))) branches)
(setq i (the fixnum (+ i 4))))
((ba d) (setq i (the fixnum (+ i 4))))
(T (error "Unknown instruction type: ~A, for instruction ~A.~%"
inst-type symbol)))))
branches))
(defun print-ji-instruction (opcode byte-vector index branches)
(declare (fixnum opcode index))
(format t "~6D~A (~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(if (= (logand opcode #x8) 0) "JNB" "JB")
(romp-condition-code (+ 8 (logand opcode #x7)))
`(**address** ,(the fixnum (+ index (the fixnum (sign-extend-ji byte-vector index)))))))
(defun print-x-instruction (opcode byte-vector index branches)
(declare (fixnum opcode index))
(let* ((rega (get-register-name (logand opcode #xF)))
(operand (aref byte-vector (the fixnum (1+ index))))
(regb (get-register-name (logand (the fixnum (ash operand -4)) #xF)))
(regc (get-register-name (logand operand #xF)))
(star (if (memq index branches) "*" " ")))
(declare (fixnum operand))
(if (eq regc 'NL0)
(cond ((and (eq rega 'NL0) (eq regb 'NL0))
(format t "~6D~A (LR NL0 NL0) ; Padding for previous execute instruction.~%"
index star))
(T (format t "~6D~A (LR ~A ~A)~%"
index (if (memq index branches) "*" " ")
rega regb)))
(format t "~6D~A (CAS ~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
rega regb regc))))
(defun print-ds-instruction (opcode byte-vector index branches function)
(declare (fixnum opcode index))
(let* ((symbol (find-symbol-name opcode))
(operand (aref byte-vector (the fixnum (1+ index))))
(rega (get-register-name (logand (the fixnum (ash operand -4)) #xF)))
(regb (get-register-name (logand operand #xF)))
(offset (ash (logand opcode #xF) 2)))
(declare (fixnum offset operand))
(cond ((and (memq symbol '(ls sts))
(memq regb '(ENV CONT)))
(print-special-access symbol rega regb offset function
index branches))
(T (format t "~6D~A (~A ~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
(get-register-name (logand (the fixnum (ash operand -4)) #xF))
(get-register-name (logand operand #xF))
(case symbol
((ls sts) (ash (logand opcode #xF) 2))
((lhs lhas sths) (ash (logand opcode #xF) 1))
(T (logand opcode #xF))))))))
(defun print-r-instruction (opcode byte-vector index branches)
(declare (fixnum index opcode))
(let* ((symbol (find-symbol-name opcode))
(operand (aref byte-vector (the fixnum (1+ index))))
(rega (logand (the fixnum (ash operand -4)) #xF))
(regb (logand operand #xF)))
(declare (fixnum operand))
(cond ((memq symbol '(inc dec lis mftbil mftbiu mttbil mttbiu
ais cis sis clrbl clrbu setbl setbu
sari sari16 sri sri16 srpi srpi16
sli sli16 slpi slpi16))
(format t "~6D~A (~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
(get-register-name rega)
regb))
((memq symbol '(bbr bbrx bnbr bnbrx))
(format t "~6D~A (~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
(romp-condition-code rega)
(get-register-name regb)))
((memq symbol '(mts mfs))
(format t "~6D~A (~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
rega regb))
((memq symbol '(clrsb setsb))
(format t "~6D~A (~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
rega regb))
(T (format t "~6D~A (~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
(get-register-name rega)
(get-register-name regb))))))
(defun print-bi-instruction (opcode byte-vector index branches)
(declare (fixnum index opcode))
(let* ((symbol (find-symbol-name opcode))
(cc (romp-condition-code
(logand (ash (the fixnum (aref byte-vector (the fixnum (1+ index)))) -4) #xF)))
(label (the fixnum (+ index (the fixnum (sign-extend-bi byte-vector index))))))
(format t "~6D~A (~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol) cc `(**address** ,label))))
(defun print-ba-instruction (opcode byte-vector index branches)
(declare (fixnum index opcode))
(let* ((symbol (find-symbol-name opcode))
(operand (the fixnum (logior (ash (the fixnum (aref byte-vector (the fixnum (1+ index)))) 16)
(ash (the fixnum (aref byte-vector (the fixnum (+ index 2)))) 8)
(the fixnum (aref byte-vector (the fixnum (+ index 3)))))))
(miscop (find-miscop-name operand)))
(format t "~6D~A (~A ~A) ; Call miscop ~A.~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
miscop
miscop))
4)
(defun print-d-instruction (opcode byte-vector index branches function)
(declare (fixnum index opcode))
(let* ((symbol (find-symbol-name opcode))
(operand (aref byte-vector (the fixnum (1+ index))))
(rega (get-register-name (logand (the fixnum (ash operand -4)) #xF)))
(regb (get-register-name (logand operand #xF)))
(offset (sign-extend-d byte-vector index)))
(declare (fixnum offset operand))
(cond ((eq symbol 'ci)
(format t"~6D~A (~A ~A ~A)~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
rega offset)
4)
((and (memq symbol '(l st))
(memq regb '(ENV CONT)))
(print-special-access symbol rega regb offset function
index branches)
4)
(T (format t "~6D~A (~A ~A ~A ~A)~A~%"
index (if (memq index branches) "*" " ")
(symbol-name symbol)
rega regb offset
(if (eq (setq offset (logand offset #xFFFF)) nil-16)
" ; NIL."
(if (eq offset t-16)
" ; T."
"")))
4))))
(defun print-special-access (symbol rega regb offset function index branches)
(declare (fixnum index offset))
(let ((star (if (memq index branches) "*" " "))
(*print-level* 3)
(*print-length* 10))
(cond
((not (eq regb 'ENV))
(format t "~6D~A (~A ~A ~A ~A) ; Stack slot ~D.~%"
index star (symbol-name symbol)
rega regb offset
(ash offset -2)))
((= offset (ash %function-code-slot 2))
(format t "~6D~A (~A ~A ~A ~A) ; Function code.~%"
index star (symbol-name symbol)
rega regb offset))
((= offset (ash %function-offset-slot 2))
(format t "~6D~A (~A ~A ~A ~A) ; Function offset.~%"
index star (symbol-name symbol)
rega regb offset))
(t
(format t "~6D~A (~A ~A ~A ~A) ; Constant: ~S.~%"
index star (symbol-name symbol)
rega regb offset
(%primitive header-ref
(%primitive header-ref function
%function-entry-constants-slot)
(ash (the fixnum
(- offset g-vector-header-size)) -2)))))))
(defun sign-extend-ji (byte-vector index)
(declare (fixnum index))
(let ((byte (aref byte-vector (the fixnum (1+ index)))))
(declare (fixnum byte))
(ash (if (= (logand byte #x80) 0)
byte
(the fixnum (- (the fixnum (1+ (logand (lognot byte) #x7F))))))
1)))
(defun sign-extend-bi (byte-vector index)
(declare (fixnum index))
(let ((int (logior (the fixnum (ash (logand (the fixnum (aref byte-vector (the fixnum (1+ index)))) #xF) 16))
(the fixnum (ash (aref byte-vector (the fixnum (+ index 2))) 8))
(the fixnum (aref byte-vector (the fixnum (+ index 3)))))))
(declare (fixnum int))
(ash (if (= (logand int #x80000) 0)
int
(the fixnum (- (the fixnum (1+ (logand (lognot int) #x7FFFF))))))
1)))
(defun sign-extend-d (byte-vector index)
(declare (fixnum index))
(let ((hword (logior (the fixnum (ash (aref byte-vector (the fixnum (+ index 2))) 8))
(the fixnum (aref byte-vector (the fixnum (+ index 3)))))))
(declare (fixnum hword))
(if (= (logand hword #x8000) 0)
hword
(the fixnum (- (the fixnum (1+ (logand (lognot hword) #xFFFF))))))))
(defun romp-condition-code (cc)
(if (<= 8 cc 16)
(svref '#(pz lt eq gt cz reserved ov tb) (- cc 8))
'??))
(defun get-register-name (reg)
(svref '#(NL0 A0 NL1 A1 A3 A2 SP L0 L1 L2 L3 L4 BS CONT ENV PC) reg))
(defvar miscop-cache NIL)
(defun find-miscop-name (index)
(if (null miscop-cache) (initialize-miscop-cache))
(gethash index miscop-cache))
(defun initialize-miscop-cache ()
(setq miscop-cache (make-hash-table :size 500))
(do-symbols (x (find-package "CLC"))
(let ((v (get x 'lisp::%loaded-address)))
(when v
(setf (gethash v miscop-cache) x))))
(dolist (x lisp::*user-defined-miscops*)
(setf (gethash (get x 'lisp::%loaded-address) miscop-cache) x)))
;;; -*- Mode: Lisp; Package: Compiler -*-
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; Spice Lisp is currently incomplete and under active development.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
(in-package 'compiler)
(export '(asm asm-files) (find-package 'compiler))
(defun asm (f)
(assemble-file (concatenate 'simple-string "miscops:" f ".romp")))
(defun asm-files ()
(asm "abs")
(asm "allocation")
(asm "arith")
(asm "array")
(asm "byte")
(asm "call")
(asm "nlx")
(asm "compare")
(asm "divide")
(asm "gc")
(asm "gcd")
(asm "irrat")
(asm "list")
(asm "logic")
(asm "minus")
(asm "misc")
(asm "multiply")
(asm "negate")
(asm "plus")
(asm "print")
(asm "predicate")
(asm "save")
(asm "stack")
(asm "symbol")
(asm "system")
(asm "truncate"))
This diff is collapsed.
;;; -*- Mode: Lisp; Package: Compiler -*-
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;; This file defines the instruction set for the Common Lisp Romp Assembler
;;; used by the compiler.
;;; Written by David B. McDonald.
(in-package 'Compiler)
(defvar romp-4bit-opcode-symbol (make-array 16))
(defvar romp-8bit-opcode-symbol (make-array 256))
;;; Define-Romp-Instruction defines a Romp instruction to the assembler.
;;; It accepts three arguments:
;;; romp-instruction is a symbol whose pname is the name of a Romp instruction
;;; romp-inst-type specifies the underlying type of the Romp instruction.
;;; it must have one of the following values: JI, X, DS, R, BI, BA,
;;; or D.
;;; romp-code specifies the numeric op code for the instruction.
(defmacro Define-Romp-Instruction (romp-instruction romp-inst-type romp-code)
`(progn (setf (get ',romp-instruction 'romp-instruction-type)
',romp-inst-type)
(setf (get ',romp-instruction 'romp-operation-code)
,romp-code)
,(case romp-inst-type
(ji
`(setf (svref romp-4bit-opcode-symbol 0) ',romp-instruction))
((x ds)
`(setf (svref romp-4bit-opcode-symbol ,romp-code) ',romp-instruction))
((r bi ba d)
`(setf (svref romp-8bit-opcode-symbol ,romp-code) ',romp-instruction))
(T
(error "Illegal instruction type: ~A, for instruction ~A (~A).~%"
romp-inst-type romp-instruction romp-code)))))
;;; Define-Romp-Branch defines a Romp branch instruction to the assembler. It
;;; accepts three arguments:
;;; romp-branch is a symbol whose pname is the name of a branch instruction.
;;; romp-instruction is the underlying romp-instruction that should be used
;;; used to implement the branch instruction.
;;; condition-code specifies the bit of the condition code that should be
;;; be tested to implement the branch.
(defmacro Define-Romp-Branch (romp-branch romp-instruction condition-code)
`(progn (setf (get ',romp-branch 'romp-branch-instruction)
',romp-instruction)
(setf (get ',romp-branch 'romp-condition-code)
,condition-code)))
;;; Define-Condition-Code associates the integer code for a particular condition
;;; code bit with a symbol. It accepts a symbol and a value.
(defmacro Define-Condition-Code (condition-code value)
`(setf (get ',condition-code 'condition-code) ,value))
;;; Storage Access Instructions.
(define-romp-instruction lcs ds #x4)
(define-romp-instruction lc d #xCE)
(define-romp-instruction lhas ds #x5)
(define-romp-instruction lha d #xCA)
(define-romp-instruction lhs r #xEB)
(define-romp-instruction lh d #xDA)
(define-romp-instruction ls ds #x7)
(define-romp-instruction l d #xCD)
(define-romp-instruction lm d #xC9)
(define-romp-instruction tsh d #xCF)
(define-romp-instruction stcs ds #x1)
(define-romp-instruction stc d #xDE)
(define-romp-instruction sths ds #x2)
(define-romp-instruction sth d #xDC)
(define-romp-instruction sts ds #x3)
(define-romp-instruction st d #xDD)
(define-romp-instruction stm d #xD9)
;;; Address Computation Instructions.
(define-romp-instruction cal d #xC8)
(define-romp-instruction cal16 d #xC2)
(define-romp-instruction cau d #xD8)
(define-romp-instruction cas x #x6)
(define-romp-instruction ca16 r #xF3)
(define-romp-instruction inc r #x91)
(define-romp-instruction dec r #x93)
(define-romp-instruction lis r #xA4)
;;; Basic Romp Branch Instructions.
(define-romp-instruction bala ba #x8A)
(define-romp-instruction balax ba #x8B)
(define-romp-instruction bali bi #x8C)
(define-romp-instruction balix bi #x8D)
(define-romp-instruction balr r #xEC)
(define-romp-instruction balrx r #xED)
(define-romp-instruction jb ji #x1)
(define-romp-instruction bb bi #x8E)
(define-romp-instruction bbx bi #x8F)
(define-romp-instruction bbr r #xEE)
(define-romp-instruction bbrx r #xEF)
(define-romp-instruction jnb ji #x0)
(define-romp-instruction bnb bi #x88)
(define-romp-instruction bnbx bi #x89)
(define-romp-instruction bnbr r #xE8)
(define-romp-instruction bnbrx r #xE9)
;;; Romp Trap Instrunctions.
(define-romp-instruction ti d #xCC)
(define-romp-instruction tgte r #xBD)
(define-romp-instruction tlt r #xBE)
;;; Romp Move and Insert Instructions.
(define-romp-instruction mc03 r #xF9)
(define-romp-instruction mc13 r #xFA)
(define-romp-instruction mc23 r #xFB)
(define-romp-instruction mc33 r #xFC)
(define-romp-instruction mc30 r #xFD)
(define-romp-instruction mc31 r #xFE)
(define-romp-instruction mc32 r #xFF)
(define-romp-instruction mftb r #xBC)
(define-romp-instruction mftbil r #x9D)
(define-romp-instruction mftbiu r #x9C)
(define-romp-instruction mttb r #xBF)
(define-romp-instruction mttbil r #x9F)
(define-romp-instruction mttbiu r #x9E)
;;; Romp Arithmetic Instructions.
(define-romp-instruction a r #xE1)
(define-romp-instruction ae r #xF1)
(define-romp-instruction aei d #xD1)
(define-romp-instruction ai d #xC1)
(define-romp-instruction ais r #x90)
(define-romp-instruction abs r #xE0)
(define-romp-instruction onec r #xF4)
(define-romp-instruction twoc r #xE4)
(define-romp-instruction c r #xB4)
(define-romp-instruction cis r #x94)
(define-romp-instruction ci d #xD4)
(define-romp-instruction cl r #xB3)
(define-romp-instruction cli d #xD3)
(define-romp-instruction exts r #xB1)
(define-romp-instruction s r #xE2)
(define-romp-instruction sf r #xB2)
(define-romp-instruction se r #xF2)
(define-romp-instruction sfi d #xD2)
(define-romp-instruction sis r #x92)
(define-romp-instruction d r #xB6)
(define-romp-instruction m r #xE6)
;;; Romp Logical Operations
(define-romp-instruction clrbl r #x99)
(define-romp-instruction clrbu r #x98)
(define-romp-instruction setbl r #x9B)
(define-romp-instruction setbu r #x9A)
(define-romp-instruction n r #xE5)
(define-romp-instruction nilz d #xC5)
(define-romp-instruction nilo d #xC6)
(define-romp-instruction niuz d #xD5)
(define-romp-instruction niuo d #xD6)
(define-romp-instruction o r #xE3)
(define-romp-instruction oil d #xC4)
(define-romp-instruction oiu d #xC3)
(define-romp-instruction x r #xE7)
(define-romp-instruction xil d #xC7)
(define-romp-instruction xiu d #xD7)
(define-romp-instruction clz r #xF5)
;;; Romp Shift Instructions
(define-romp-instruction sar r #xB0)
(define-romp-instruction sari r #xA0)
(define-romp-instruction sari16 r #xA1)
(define-romp-instruction sr r #xB8)
(define-romp-instruction sri r #xA8)
(define-romp-instruction sri16 r #xA9)
(define-romp-instruction srp r #xB9)
(define-romp-instruction srpi r #xAC)
(define-romp-instruction srpi16 r #xAD)
(define-romp-instruction sl r #xBA)
(define-romp-instruction sli r #xAA)
(define-romp-instruction sli16 r #xAB)
(define-romp-instruction slp r #xBB)
(define-romp-instruction slpi r #xAE)
(define-romp-instruction slpi16 r #xAF)
;;; Romp System Control Instructions.
(define-romp-instruction mts r #xB5)
(define-romp-instruction mfs r #x96)
(define-romp-instruction clrsb r #x95)
(define-romp-instruction setsb r #x97)
(define-romp-instruction lps d #xD0)
(define-romp-instruction wait r #xF0)
(define-romp-instruction svc d #xC0)
;;; Romp Input/Output Instructions.
(define-romp-instruction ior d #xCB)
(define-romp-instruction iow d #xDB)
;;; Define bit setting for examining condition codes.
(define-condition-code pz 8)
(define-condition-code lt 9)
(define-condition-code eq 10)
(define-condition-code gt 11)
(define-condition-code cz 12)
(define-condition-code ov 14)
(define-condition-code tb 15)
;;; -*- Package: MIPS -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/alloc.lisp,v 1.2 1990/11/03 17:22:39 wlott Exp $
;;;
;;; Stuff to handle allocating simple objects.
;;;
;;; Written by William Lott.
;;;
(in-package "MIPS")
(define-for-each-primitive-object (obj)
(let* ((options (primitive-object-options obj))
(alloc-trans (getf options :alloc-trans))
(alloc-vop (getf options :alloc-vop alloc-trans))
(header (primitive-object-header obj))
(lowtag (primitive-object-lowtag obj))
(size (primitive-object-size obj))
(variable-length (primitive-object-variable-length obj))
(need-unbound-marker nil))
(collect ((args) (init-forms))
(when (and alloc-vop variable-length)
(args 'extra-words))
(dolist (slot (primitive-object-slots obj))
(let* ((name (slot-name slot))
(offset (slot-offset slot)))
(ecase (getf (slot-options slot) :init :zero)
(:zero)
(:null
(init-forms `(storew null-tn result ,offset ,lowtag)))
(:unbound
(setf need-unbound-marker t)
(init-forms `(storew temp result ,offset ,lowtag)))
(:arg
(args name)
(init-forms `(storew ,name result ,offset ,lowtag))))))
(when (and (null alloc-vop) (args))
(error "Slots ~S want to be initialized, but there is no alloc vop ~
defined for ~S."
(args) (primitive-object-name obj)))
(when alloc-vop
`(define-assembly-routine
(,alloc-vop
(:cost 35)
,@(when alloc-trans
`((:translate ,alloc-trans)))
(:policy :fast-safe))
(,@(let ((arg-offsets (cdr register-arg-offsets)))
(mapcar #'(lambda (name)
(unless arg-offsets
(error "Too many args in ~S" alloc-vop))
`(:arg ,name (descriptor-reg any-reg)
,(pop arg-offsets)))
(args)))
(:temp ndescr non-descriptor-reg nl0-offset)
,@(when (or need-unbound-marker header variable-length)
'((:temp temp non-descriptor-reg nl1-offset)))
(:res result descriptor-reg a0-offset))
(pseudo-atomic (ndescr)
(inst addu result alloc-tn ,lowtag)
,@(cond ((and header variable-length)
`((inst addu temp extra-words (fixnum (1- ,size)))
(inst addu alloc-tn alloc-tn temp)
(inst sll temp temp (- type-bits word-shift))
(inst or temp temp ,header)
(storew temp result 0 ,lowtag)
(inst addu alloc-tn alloc-tn
(+ (fixnum 1) lowtag-mask))
(inst li temp (lognot lowtag-mask))
(inst and alloc-tn alloc-tn temp)))
(variable-length
(error ":REST-P T with no header in ~S?"
(primitive-object-name obj)))
(header
`((inst addu alloc-tn alloc-tn
(pad-data-block ,size))
(inst li temp
,(logior (ash (1- size) type-bits)
(symbol-value header)))
(storew temp result 0 ,lowtag)))
(t
`((inst addu alloc-tn alloc-tn
(pad-data-block ,size)))))
,@(when need-unbound-marker
`((inst li temp unbound-marker-type)))
,@(init-forms)))))))
;;; -*- Package: SPARC -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/alloc.lisp,v 1.1 1990/11/22 11:49:39 wlott Exp $
;;;
;;; Stuff to handle allocating simple objects.
;;;
;;; Written by William Lott.
;;;
(in-package "SPARC")
(define-for-each-primitive-object (obj)
(let* ((options (primitive-object-options obj))
(alloc-trans (getf options :alloc-trans))
(alloc-vop (getf options :alloc-vop alloc-trans))
(header (primitive-object-header obj))
(lowtag (primitive-object-lowtag obj))
(size (primitive-object-size obj))
(variable-length (primitive-object-variable-length obj))
(need-unbound-marker nil))
(collect ((args) (init-forms))
(when (and alloc-vop variable-length)
(args 'extra-words))
(dolist (slot (primitive-object-slots obj))
(let* ((name (slot-name slot))
(offset (slot-offset slot)))
(ecase (getf (slot-options slot) :init :zero)
(:zero)
(:null
(init-forms `(storew null-tn result ,offset ,lowtag)))
(:unbound
(setf need-unbound-marker t)
(init-forms `(storew temp result ,offset ,lowtag)))
(:arg
(args name)
(init-forms `(storew ,name result ,offset ,lowtag))))))
(when (and (null alloc-vop) (args))
(error "Slots ~S want to be initialized, but there is no alloc vop ~
defined for ~S."
(args) (primitive-object-name obj)))
(when alloc-vop
`(define-assembly-routine
(,alloc-vop
(:cost 35)
,@(when alloc-trans
`((:translate ,alloc-trans)))
(:policy :fast-safe))
(,@(let ((arg-offsets (cdr register-arg-offsets)))
(mapcar #'(lambda (name)
(unless arg-offsets
(error "Too many args in ~S" alloc-vop))
`(:arg ,name (descriptor-reg any-reg)
,(pop arg-offsets)))
(args)))
(:temp ndescr non-descriptor-reg nl0-offset)
,@(when (or need-unbound-marker header variable-length)
'((:temp temp non-descriptor-reg nl1-offset)))
(:res result descriptor-reg a0-offset))
(pseudo-atomic (ndescr)
(inst add result alloc-tn ,lowtag)
,@(cond ((and header variable-length)
`((inst add temp extra-words (fixnum (1- ,size)))
(inst add alloc-tn alloc-tn temp)
(inst sll temp temp (- type-bits word-shift))
(inst or temp temp ,header)
(storew temp result 0 ,lowtag)
(inst add alloc-tn (+ (fixnum 1) lowtag-mask))
(inst and alloc-tn (lognot lowtag-mask))))
(variable-length
(error ":REST-P T with no header in ~S?"
(primitive-object-name obj)))
(header
`((inst add alloc-tn (pad-data-block ,size))
(inst li temp
,(logior (ash (1- size) type-bits)
(symbol-value header)))
(storew temp result 0 ,lowtag)))
(t
`((inst add alloc-tn (pad-data-block ,size)))))
,@(when need-unbound-marker
`((inst li temp unbound-marker-type)))
,@(init-forms)))))))
# To modify optimization settings, you can change the $(OPTIMIZE)
# variable below. This is prepended to the lisp source files before
# they are compiled.
#
# Requires GNU Make or equivalent.
SHELL = /bin/sh
OPTIMIZE = "(declaim (optimize (speed 3) (space 1) (safety 0) (debug 0) (compilation-speed 0)))"
FILES := $(patsubst %.lisp,%.olisp, $(wildcard files/*.lisp))
vpath %.lisp files
%.olisp: %.lisp
echo $(OPTIMIZE) > $@
cat $< >> $@
optimize-files: $(FILES)
clean-results:
-rm -f /var/tmp/CL-bench*
clean:
find . \( -name '*.abcl' -o -name '*.cls' -o -name '*.sparcf' -o -name "*.ppcf" -o -name '*.x86f' -o -name '*.lbytef' -o -name "*.err" -o -name '*.fas' -o -name '*.fasl' -o -name "*.faslmt" -o -name '*.lib' -o -name '*.o' -o -name '*.so' -o -name "*.pfsl" -o -name "*.ufsl" -o -name "*.dfsl" -o -name "*.olisp" -o -name "*.dfsl" -o -name "*.fsl" -o -name "*.nfasl" \) -print | xargs rm -f
distclean: clean clean-results
.PHONY: clean clean-results distclean optimize-files
# EOF
=== New in 2004-08-01 ===
Fixes to WALK-LIST/SEQ and WALK-LIST/MESS that were previously
non-deterministic, due to the use of RANDOM in creating the data
structures that they work on.
=== New in 2004-01-03 ===
New tests: SUM-PERMUTATIONS, WALK-LIST/SEQ, WALK-LIST/MESS, COMPILER,
LOAD-FASL. SUM-PERMUTATIONS is inspired by Scheme benchmarks by
Will Clinger. The WALK-LIST/ tests are inspired by Richard Fateman.
A setup file for MCL, contributed by James Anderson.
New ascii-graphical report generator contributed by Johannes
Grödem (file graph-report.lisp).
New PDF report generator using the cl-pdf library (file
pdf-report.lisp)
Improvements to the CMUCL performance-counter code: better
reporting of data. Look for a new version of cpc.lisp that supports
UltraSPARC-III processors.
=== New in 2003-12-05 ===
Split the FPRINT test (speed of printer when writing to a file)
into FPRINT/PRETTY and FPRINT/UGLY. The former does pretty-printing
using PPRINT (and binds other pretty-printer-related variables to
T), whereas the latter disables the pretty-printer. Suggested by
Christopher Rhodes.
=== New in 2003-10-06 ===
Support for Allegro CL, thanks to Kevin Layer. See the file
run-acl.sh and sysdep/setup-acl.lisp.
Fiddle with CPU Performance Counters library on UltraSPARC processors
with CMUCL; see play/cmucl-performance-counters.lisp
Common Lisp benchmarking suite
==============================
This package contains Lisp code intended for performance benchmarking
of different Common Lisp implementations. The tests it runs include
- the well-known Gabriel benchmarks, with a number of bugfixes from
Henry Baker and limited rewriting to bring them a little closer to
modern Common Lisp coding style
- hashtable exercising
- READ-LINE exercising
- mathematical functions: factorial, fibonnaci, ackermann's number
- some bignum-intensive code from Bruno Haible
- various aspects of CLOS: time taken to compile and execute
DEFCLASS forms which create a class hierarchy, instance creation
time, time taken to compile and execute DEFMETHOD forms, execution
of method combinations, both with and without :after methods.
- various operations on arrays, bitvectors and strings
- performance-intensive kernels such as CRC generation and an
implementation of the DEFLATE algorithm
Except for the CLOS COMPILER tests, timings do not include compilation
time. The garbage collector is run before each test to try to make the
timings more repeatable. For certain targets, we assume that the times
reported by GET-INTERNAL-RUN-TIME and GET-INTERNAL-REAL-TIME are
accurate. Timings for a given Common Lisp environment may be quite
sensitive to the optimization settings; these are set at the beginning
of the Makefile.
Common Lisp is a very large language, so it is difficult to evaluate
the performance of all aspects of an implementation. Remember that the
only real benchmark is your application: this code is only
representative of real-life programs to a limited extent.
Running the suite
=================
Each implementation has a run-<impl>.sh file, and a setup-<impl>.lisp
file in the sysdep directory. To execute the test for CMUCL, for
exampe, type
bash run-cmucl.sh
This will create files with the optimization setting requested in the
Makefile, then invoke CMUCL to compile the files (lots of warnings and
compilation notes are to be expected), then run the various tests.
Execution takes quite a while: around 30 minutes on a 1GHz PIII. A
large part of this time is due to the bignum benchmarks, which you can
comment out if they don't interest you. You can also reduce the number
of executions of each particular test by editing the file "tests.lisp"
-- modify the :runs parameter of the DEFBENCH forms in the file
"tests.lisp". For the results to be meaningful, the time for each test
should be more than a second. However, when comparing implementations
it is not the absolute time which counts, but the time relative to the
other implementations. Also note that you may wish to reduce the size
of the problems, particularly in the array sections, because with some
setups (CMUCL on Linux for example), your system may become unusable
if you exceed available RAM. You can do this by editing the file
"tests.lisp" and modifying the arguments to the :code parameters.
Repeat this operation for other implementations you have on your
machine. I have tried it with CMUCL, SBCL, CLISP, OpenMCL, Poplog
CL and LispWorks on various platforms. GCL and ECL are able to run
some of the tests.
If you're not running on a Unix platform, you may not be able to
script the different steps of a run. In this case, follow the
following steps:
1. Say "make clean optimize-lisp" to create source files that contain
optimization declarations. The optimize settings can be changed
in the Makefile.
2. Load the file "generate.lisp" into your implementation. This
should create two files "do-compilation-script.lisp" and
"do-execute-script.lisp", that contain a sequence of compilation
and load steps.
3. Load the file "sysdep/setup-<yourimpl>.lisp", which you may need
to write yourself. This requires a definition of a BENCH-GC
function that triggers a full garbage collection.
4. Load the file "do-compilation-script.lisp" into your
implementation, which should result in all the source files
being compiled.
5. Load the file "do-execute-script.lisp", which should cause all
the tests to be executed.
For each tested implementation, you should have a file in /var/tmp (or
in the current directory on Windows) named "CL-benchmark-<date>".
These files will have the following format:
,---- /var/tmp/CL-benchmark-20010821T2208 ---
| ;; -*- lisp -*- CMU Common Lisp CVS sources, level-1 built 2001-08-22 on maftia1
| ;;
| ;; Implementation *features*:
| ;; (:PCL-STRUCTURES :PORTABLE-COMMONLOOPS :PYTHON :PCL :COMPLEX-FP-VOPS :PPRO
| ;; :PENTIUM :MP :HASH-NEW :RANDOM-MT19937 :PROPAGATE-FUN-TYPE
| ;; :PROPAGATE-FLOAT-TYPE :CONSTRAIN-FLOAT-TYPE :CMU18C :CMU18 :GENCGC :X86
| ;; :LINUX :GLIBC2 :UNIX :COMMON :COMMON-LISP :ANSI-CL :CMU
| ;; :IEEE-FLOATING-POINT)
| ;;
| ;; Function real user sys consed
| ;; ----------------------------------------------------------------
| ;; Boyer 1.50 1.22 0.28 54349520
| ;; Browse 0.97 0.79 0.18 36219256
| ;; DDerviv 0.88 0.50 0.39 67197656
| ;; Deriv 1.64 0.87 0.77 127195824
| ;; Destructive 0.30 0.24 0.05 12819928
| ;; div2-test-1 0.52 0.32 0.20 38398176
| ;; div2-test2 0.66 0.42 0.24 47999936
| ;; FFT 0.40 0.40 0.00 0
| ;; frpoly/fixnum 0.65 0.54 0.10 19172440
| ;; frpoly/bignum 1.54 1.25 0.28 55628704
| ;; frpoly/float 7.59 6.50 1.09 213052408
| ;; Puzzle 0.82 0.82 0.00 0
| ;; CTak 0.81 0.81 0.00 0
| ;; Tak 0.53 0.54 0.00 0
| ;; RTak 0.35 0.36 0.00 0
| ;; takl 1.60 1.60 0.00 0
| ;; stak 1.15 1.14 0.00 0
| ;; fprint 0.25 0.25 0.01 1948416
| ;; fread 0.82 0.68 0.13 28487280
| ;; traverse 5.28 5.24 0.03 4493288
| ;; triangle 2.29 2.28 0.00 499712
| ;; factorial 0.37 0.18 0.20 26120296
| ;; fib 2.39 2.39 0.00 0
| ;; hashtable 0.72 0.69 0.04 9888912
| ;; CLOS/defclass 2.82 2.31 0.12 32757328
| ;; CLOS/defmethod 10.94 10.09 0.55 120612624
| ;; CLOS/instantiate 7.13 6.27 0.86 229048352
| ;; CLOS/methodcalls 6.56 5.22 1.34 301057608
| ;; CLOS/method+after 12.02 11.09 0.93 197058816
| ;; CLOS/complex-methods 0.38 0.38 0.00 286600
| ;; 1D-arrays 2.46 2.17 0.30 60002400
| ;; 2D-arrays 20.57 19.50 1.07 240000240
| ;; bitvectors 18.75 18.51 0.23 50003200
| ;; fill-strings 21.12 15.23 5.88 1000016000
| ;; fill-strings/adjustable 57.10 56.25 0.85 259729520
|
| ("CMU Common Lisp CVS sources, level-1 built 2001-08-22 on maftia1"
| ("fill-strings/adjustable" 57.1 56.25 0.85 259729520)
| ("fill-strings" 21.12 15.23 5.88 1000016000)
| ("bitvectors" 18.75 18.51 0.23 50003200)
| ("2D-arrays" 20.57 19.5 1.07 240000240) ("1D-arrays" 2.46 2.17 0.3 60002400)
| ("CLOS/complex-methods" 0.38 0.38 0.0 286600)
| ("CLOS/method+after" 12.02 11.09 0.93 197058816)
| ("CLOS/methodcalls" 6.56 5.22 1.34 301057608)
| ("CLOS/instantiate" 7.13 6.27 0.86 229048352)
| ("CLOS/defmethod" 10.94 10.09 0.55 120612624)
| ("CLOS/defclass" 2.82 2.31 0.12 32757328) ("hashtable" 0.72 0.69 0.04 9888912)
| ("fib" 2.39 2.39 0.0 0) ("factorial" 0.37 0.18 0.2 26120296)
| ("triangle" 2.29 2.28 0.0 499712) ("traverse" 5.28 5.24 0.03 4493288)
| ("fread" 0.82 0.68 0.13 28487280) ("fprint" 0.25 0.25 0.01 1948416)
| ("stak" 1.15 1.14 0.0 0) ("takl" 1.6 1.6 0.0 0) ("RTak" 0.35 0.36 0.0 0)
| ("Tak" 0.53 0.54 0.0 0) ("CTak" 0.81 0.81 0.0 0) ("Puzzle" 0.82 0.82 0.0 0)
| ("frpoly/float" 7.59 6.5 1.09 213052408)
| ("frpoly/bignum" 1.54 1.25 0.28 55628704)
| ("frpoly/fixnum" 0.65 0.54 0.1 19172440) ("FFT" 0.4 0.4 0.0 0)
| ("div2-test2" 0.66 0.42 0.24 47999936) ("div2-test-1" 0.52 0.32 0.2 38398176)
| ("Destructive" 0.3 0.24 0.05 12819928) ("Deriv" 1.64 0.87 0.77 127195824)
| ("DDerviv" 0.88 0.5 0.39 67197656) ("Browse" 0.97 0.79 0.18 36219256)
| ("Boyer" 1.5 1.22 0.28 54349520))
`----
The first section of the file is intended to be human readable, and
the second section to be READ by a Common Lisp implementation. For
each test, you should see the elapsed user time, and possibly (if this
has been coded for your implementation) elapsed system time and the
number of bytes consed during the test execution.
The data in the different /var/tmp/CL-benchmark-* files is analysed by the
file "report.lisp", to generate a report comparing the performance of
the different implementations. This file needs to be run in a Common
Lisp implementation; the one you use will be considered the
"reference" implementation. In the report which is generated, for each
test the timing for the reference implementation will be shown, as
well as the _relative times_ for each of the other tested
implementations. A relative time means that a score under 1 is better,
and a score of 2 means it is two times slower -- for that test -- than
the reference implementation. If a given test doesn't work in a
particular implementation (for example CLISP doesn't do non-standard
method combination), its entry will be -1.0.
Here is an example of the type of results you can obtain, for x86 and
SPARC:
,---- PentiumIII at 1GHz, 256MB RAM, Linux 2.4.2 ---
|
| Benchmark Reference CLISP CMU C SBCL
| ----------------------------------------------------------------
| BOYER 2.36 4.54 0.67 0.94
| BROWSE 1.04 2.15 0.65 1.04
| DDerviv 1.19 1.96 0.48 1.06
| Deriv 2.27 1.93 0.42 1.04
| DESTRUCTIVE 1.52 2.79 0.89 1.06
| DIV2-TEST-1 1.73 1.84 0.51 1.09
| DIV2-TEST-2 0.85 1.87 0.46 1.12
| FFT 0.22 36.09 1.14 1.14
| FRPOLY/FIXNUM 0.79 5.81 0.81 0.96
| FRPOLY/BIGNUM 1.99 2.03 0.68 0.96
| FRPOLY/FLOAT 0.78 3.79 0.72 0.99
| PUZZLE 0.79 23.09 1.15 9.95
| CTAK 0.86 6.28 1.10 1.06
| TAK 0.91 8.86 1.18 1.34
| RTAK 0.91 8.86 1.13 1.34
| TAKL 1.67 7.33 1.16 1.22
| STAK 1.15 6.66 1.15 1.10
| FPRINT 1.42 1.12 1.05 2.37
| TRAVERSE 4.35 6.75 1.19 1.64
| TRIANGLE 2.01 17.22 1.14 1.27
| CASCOR 4.06 80.47 1.23 0.92
| RICHARDS 0.58 24.78 1.22 1.07
| FACTORIAL 0.50 3.56 0.68 1.38
| FIB 0.39 5.67 1.13 1.08
| BIGNUM/ELEM-100-1000 1.33 0.11 1.02 0.98
| BIGNUM/ELEM-1000-100 6.03 0.07 1.11 0.93
| BIGNUM/ELEM-10000-1 6.14 0.05 1.00 0.93
| BIGNUM/PARI-100-10 1.51 0.06 0.96 0.91
| BIGNUM/PARI-200-5 17.32 0.02 0.99 0.88
| HASH-STRINGS 1.65 3.00 0.82 0.99
| HASH-INTEGERS 0.73 2.30 0.68 1.05
| BOEHM-GC 10.18 3.94 0.39 1.19
| CLOS/defclass 2.64 0.35 0.83 2.33
| CLOS/defmethod 13.93 0.02 0.70 1.94
| CLOS/instantiate 7.23 1.02 0.63 1.39
| CLOS/methodcalls 8.43 1.33 0.50 1.37
| CLOS/method+after 13.90 0.45 0.79 2.64
| CLOS/complex-methods 0.35 -1.00 1.06 5.40
| 1D-ARRAYS 3.74 4.57 0.69 1.26
| 2D-ARRAYS 15.19 3.25 0.92 4.00
| BITVECTORS 2.92 0.61 0.70 0.95
| FILL-STRINGS 10.62 1.15 0.76 3.03
| fill-strings/adjustable 18.13 1.08 0.92 1.65
| BENCH-STRING-CONCAT 9.99 -1.00 0.81 2.34
|
| Reference implementation: CMU Common Lisp 18c
| Impl CLISP: CLISP 2.27 (released 2001-07-17) (built 3204291355) (memory 3205854943)
| Impl CMU C: CMU Common Lisp 18d-pre, level-1 built 2001-12-14 on maftia1
| Impl SBCL : SBCL 0.7.0
| Linux maftia1 2.4.2-2 #1 Sun Apr 8 20:41:30 EDT 2001 i686 unknown
`----
,---- UltraSPARCIIe at 500MHz, 640MB RAM, SunOS 5.8 ---
|
| Benchmark Reference CMU C CLISP
| -----------------------------------------------------
| BOYER 3.98 0.91 8.03
| BROWSE 1.72 0.91 2.85
| DDerviv 2.02 0.75 3.21
| Deriv 3.63 0.81 3.13
| DESTRUCTIVE 3.11 1.01 4.18
| DIV2-TEST-1 2.19 0.83 3.92
| DIV2-TEST-2 1.12 0.82 3.85
| FFT 0.74 1.03 28.86
| FRPOLY/FIXNUM 1.87 1.01 7.89
| FRPOLY/BIGNUM 4.59 1.29 3.07
| FRPOLY/FLOAT 1.65 0.96 5.68
| PUZZLE 2.07 0.95 30.62
| CTAK 2.74 1.01 9.04
| TAK 1.84 1.00 14.08
| RTAK 1.84 1.01 13.95
| TAKL 3.37 1.01 11.63
| STAK 2.32 1.01 8.87
| FPRINT 4.17 1.02 1.12
| TRAVERSE 5.84 0.99 13.74
| TRIANGLE 5.53 0.86 15.57
| CASCOR 10.53 0.73 52.81
| RICHARDS 2.35 0.94 22.46
| FACTORIAL 1.46 1.48 2.88
| FIB 0.94 0.99 6.71
| BIGNUM/ELEM-100-1000 2.80 1.24 0.28
| BIGNUM/ELEM-1000-100 10.14 1.19 0.44
| BIGNUM/ELEM-10000-1 11.38 1.35 0.41
| BIGNUM/PARI-100-10 2.76 1.15 0.09
| BIGNUM/PARI-200-5 27.19 1.06 0.05
| READ-LINE 3.39 1.06 1.19
| HASH-STRINGS 5.42 1.20 2.19
| HASH-INTEGERS 1.61 0.76 2.00
| BOEHM-GC 19.97 0.76 4.14
| CLOS/defclass 4.78 1.01 0.81
| CLOS/defmethod 27.61 0.89 0.03
| CLOS/instantiate 20.93 0.85 1.28
| CLOS/methodcalls 23.62 1.08 1.94
| CLOS/method+after 33.70 1.07 0.78
| CLOS/complex-methods 1.41 0.92 -1.00
| 1D-ARRAYS 10.77 0.92 3.51
| 2D-ARRAYS 56.66 1.40 2.61
| BITVECTORS 5.35 0.86 0.42
| FILL-STRINGS 18.88 1.07 0.97
| fill-strings/adjustable 45.09 1.46 1.41
| BENCH-STRING-CONCAT 48.10 0.90 -1.00
|
| Reference implementation: CMU Common Lisp 18c, Built 2000-11-27
| Impl CMU C: CMU Common Lisp 18d-pre, level-1 built 2001-12-12 on liszt
| Impl CLISP: CLISP 2.27.2 (released 2001-10-05) (built on moustacho)
| SunOS eagles 5.8 Generic_108528-10 sun4u sparc SUNW,Sun-Blade-100
`----
Note that the test suite doesn't take compilation time into account
(except for the CLOS-related tests, where the compiler may be used at
runtime to create effective methods). You can use the time taken to
load do-compilation-script.lisp as a rough proxy for compilation time.
"Life is short and it was not meant to be spent making people feel guilty
about instruction pipelines being only partly full or caches being missed."
-- Kent Pitman in <sfw7ksm3b7k.fsf@shell01.TheWorld.com>
Thanks
======
Raymond Toy, Christophe Rhodes, Peter Van Eynde, Sven Van
Caekenberghe, Christophe Rhodes, Kevin Layers and possibly others that
I have forgotten to note.
Related work
============
- @misc{ gabriel86performance,
author = "R. Gabriel",
title = "Performance and Evaluation of Lisp Systems",
text = "R. P. Gabriel. Performance and Evaluation of Lisp Systems. MIT Press, Cambridge,
Massachusetts, 1986.",
year = "1986" }
- Scheme benchmarks by Will Clinger (Larceny and TwoBit compilers)
<URL:http://www.ccs.neu.edu/home/will/GC/sourcecode.html>
- Bagley's Programming Language Shootout,
<URL:http://www.bagley.org/~doug/shootout/>
Eric Marsden <emarsden@laas.fr>
- convert all physical pathnames to constructed pathnames