** DEFGENERIC with :METHOD options
** bug 126, in (MAKE-STRING N :INITIAL-ELEMENT #\SPACE))
** bug in the optimization of ARRAY-ELEMENT-TYPE
- He also pointed out some bogus old entries in BUGS.
+ He also pointed out some bogus old entries in BUGS, and fixed
+ a number of bugs which came into existence in the pre7 branch
+ (internal to the CVS repository), so that they never showed
+ up in release versions.
?? Old operator names in the style DEF-FOO are now deprecated in favor
of new corresponding names DEFINE-FOO, for consistency with the
naming convention used in the ANSI standard). This mostly affects
:SB-PROPAGATE-FUN-TYPE are no longer considered to be optional
features. Instead, the code that they used to control is always
built into the system.
+?? The value of INTERNAL-TIME-UNITS-PER-SECOND has been increased
+ from 100 to 1000.
* The default value of *BYTES-CONSED-BETWEEN-GCS* has been
doubled, to 4 million. (If your application spends a lot of time
GCing and you have a lot of RAM, you might want to experiment with
* The interpreter, EVAL, has been rewritten. Now it calls the
native compiler for the difficult cases, where it used to call
the old specialized IR1 interpreter code.
-* The doc/cmucl/ directory, containing old CMU CL documentation,
- is no longer part of the base system. SourceForge has shut down
- its anonymous FTP service, and with it my original plan for
- distributing them separately. For now, if you need them you can
- download an old sbcl source release and get them from there.
+* The doc/cmucl/ directory, containing old CMU CL documentation
+ from the time of the fork, is no longer part of the base system.
+ SourceForge has shut down its anonymous FTP service, and with it
+ my original plan for distributing the old CMU CL documentation
+ there. For now, if you need these files you can download an old
+ SBCL source release and extract them from it.
* lots of other tidying up internally: renaming things so that names
are more systematic and consistent, converting C macros to inline
functions, systematizing indentation, making symbol packaging
"RESET-STACK-POINTER" "RESTORE-DYNAMIC-STATE"
"RETURN-MULTIPLE" "SAVE-DYNAMIC-STATE" "SB"
"SB-ALLOCATED-SIZE" "SB-NAME" "SB-OR-LOSE" "SB-P" "SC" "SC-CASE"
- "SC-IS" "SC-NAME" "SC-NUMBER" "SC-NUMBER-OR-LOSE"
+ "SC-IS" "SC-NAME" "SC-NUMBER" "SC-NUMBER-OR-LOSE" "SC-OFFSET"
"SC-OFFSET-OFFSET" "SC-OFFSET-SCN" "SC-OR-LOSE" "SC-P" "SC-SB"
"SET-UNWIND-PROTECT" "SET-VECTOR-SUBTYPE"
"SETUP-CLOSURE-ENVIRONMENT" "SETUP-ENVIRONMENT"
"FEATUREP"
"FLUSH-STANDARD-OUTPUT-STREAMS"
"MAKE-GENSYM-LIST"
- "ABOUT-TO-MODIFY"
+ "ABOUT-TO-MODIFY-SYMBOL-VALUE"
"SYMBOL-SELF-EVALUATING-P"
"PRINT-PRETTY-ON-STREAM-P"
"LOOKS-LIKE-NAME-OF-SPECIAL-VAR-P"
"RATIO-NUMERATOR-SLOT" "RATIO-SIZE" "RATIO-WIDETAG"
"*READ-ONLY-SPACE-FREE-POINTER*"
"REGISTER-SAVE-PENALTY" "RETURN-PC-HEADER-WIDETAG"
- "RETURN-PC-RETURN-POINT-OFFSET" "SANCTIFY-FOR-EXECUTION"
+ "RETURN-PC-RETURN-POINT-OFFSET" "RETURN-PC-SAVE-OFFSET"
+ "SANCTIFY-FOR-EXECUTION"
"SAP-POINTER-SLOT" "SAP-REG-SC-NUMBER" "SAP-SIZE"
"SAP-STACK-SC-NUMBER" "SAP-WIDETAG"
"SIGFPE-HANDLER" "SIGNED-REG-SC-NUMBER" "SIGNED-STACK-SC-NUMBER"
sh make-target-2.sh || exit 1
-echo /ordinary termination of slam.sh
+echo //ordinary termination of slam.sh
+date
(symbol (required-argument) :type symbol)
;; a unique integer identification relative to other variables with the same
;; symbol
- (id 0 :type sb!c::index)
+ (id 0 :type index)
;; Does the variable always have a valid value?
(alive-p nil :type boolean))
(def!method print-object ((debug-var debug-var) stream)
(symbol id alive-p sc-offset save-sc-offset))
(:copier nil))
;; storage class and offset (unexported)
- (sc-offset nil :type sb!c::sc-offset)
+ (sc-offset nil :type sb!c:sc-offset)
;; storage class and offset when saved somewhere
- (save-sc-offset nil :type (or sb!c::sc-offset null)))
+ (save-sc-offset nil :type (or sb!c:sc-offset null)))
;;;; frames
;; This is the component in which the breakpoint lies.
component
;; This is the byte offset into the component.
- (offset nil :type sb!c::index)
+ (offset nil :type index)
;; The original instruction replaced by the breakpoint.
(instruction nil :type (or null (unsigned-byte 32)))
;; A list of user breakpoints at this location.
(%debug-block :unparsed :type (or debug-block (member :unparsed)))
;; This is the number of forms processed by the compiler or loader
;; before the top-level form containing this code-location.
- (%tlf-offset :unparsed :type (or sb!c::index (member :unparsed)))
+ (%tlf-offset :unparsed :type (or index (member :unparsed)))
;; This is the depth-first number of the node that begins
;; code-location within its top-level form.
- (%form-number :unparsed :type (or sb!c::index (member :unparsed))))
+ (%form-number :unparsed :type (or index (member :unparsed))))
(def!method print-object ((obj code-location) str)
(print-unreadable-object (obj str :type t)
(prin1 (debug-fun-name (code-location-debug-fun obj))
(:constructor make-compiled-code-location (pc debug-fun))
(:copier nil))
;; an index into DEBUG-FUN's component slot
- (pc nil :type sb!c::index)
+ (pc nil :type index)
;; a bit-vector indexed by a variable's position in
;; DEBUG-FUN-DEBUG-VARS indicating whether the variable has a
;; valid value at this code-location. (unexported).
#!-x86
(defun get-context-value (frame stack-slot loc)
(declare (type compiled-frame frame) (type unsigned-byte stack-slot)
- (type sb!c::sc-offset loc))
+ (type sb!c:sc-offset loc))
(let ((pointer (frame-pointer frame))
(escaped (compiled-frame-escaped frame)))
(if escaped
#!+x86
(defun get-context-value (frame stack-slot loc)
(declare (type compiled-frame frame) (type unsigned-byte stack-slot)
- (type sb!c::sc-offset loc))
+ (type sb!c:sc-offset loc))
(let ((pointer (frame-pointer frame))
(escaped (compiled-frame-escaped frame)))
(if escaped
#!-x86
(defun (setf get-context-value) (value frame stack-slot loc)
(declare (type compiled-frame frame) (type unsigned-byte stack-slot)
- (type sb!c::sc-offset loc))
+ (type sb!c:sc-offset loc))
(let ((pointer (frame-pointer frame))
(escaped (compiled-frame-escaped frame)))
(if escaped
#!+x86
(defun (setf get-context-value) (value frame stack-slot loc)
(declare (type compiled-frame frame) (type unsigned-byte stack-slot)
- (type sb!c::sc-offset loc))
+ (type sb!c:sc-offset loc))
(let ((pointer (frame-pointer frame))
(escaped (compiled-frame-escaped frame)))
(if escaped
;;; This does some of the work of PARSE-DEBUG-BLOCKS.
(defun parse-compiled-debug-blocks (debug-fun)
- (let* ((debug-fun (compiled-debug-fun-compiler-debug-fun
- debug-fun))
- (var-count (length (debug-fun-debug-vars debug-fun)))
- (blocks (sb!c::compiled-debug-fun-blocks debug-fun))
+ (let* ((var-count (length (debug-fun-debug-vars debug-fun)))
+ (compiler-debug-fun (compiled-debug-fun-compiler-debug-fun
+ debug-fun))
+ (blocks (sb!c::compiled-debug-fun-blocks compiler-debug-fun))
;; KLUDGE: 8 is a hard-wired constant in the compiler for the
;; element size of the packed binary representation of the
;; blocks data.
(live-set-len (ceiling var-count 8))
- (tlf-number (sb!c::compiled-debug-fun-tlf-number debug-fun)))
- (unless blocks (return-from parse-compiled-debug-blocks nil))
+ (tlf-number (sb!c::compiled-debug-fun-tlf-number compiler-debug-fun)))
+ (unless blocks
+ (return-from parse-compiled-debug-blocks nil))
(macrolet ((aref+ (a i) `(prog1 (aref ,a ,i) (incf ,i))))
(with-parsing-buffer (blocks-buffer locations-buffer)
(let ((i 0)
0)))
(svref blocks (1- end)))
(t last))))
- (declare (type sb!c::index i end))
+ (declare (type index i end))
(when (< pc
(compiled-code-location-pc
(svref (compiled-debug-block-code-locations
nil)))
;;; This function is to be called just before a change which would
-;;; affect that. (We don't absolutely have to call this function
-;;; before such changes, since such changes are given as undefined
-;;; behavior. In particular, we don't if the runtime cost would be
-;;; annoying. But otherwise it's nice to do so.)
-(defun about-to-modify (symbol)
+;;; affect the symbol value. (We don't absolutely have to call this
+;;; function before such changes, since such changes are given as
+;;; undefined behavior. In particular, we don't if the runtime cost
+;;; would be annoying. But otherwise it's nice to do so.)
+(defun about-to-modify-symbol-value (symbol)
(declare (type symbol symbol))
(let ((reason (symbol-self-evaluating-p symbol)))
(when reason
(defun sb!c::%defconstant (name value doc)
(unless (symbolp name)
(error "The constant name is not a symbol: ~S" name))
- (about-to-modify name)
+ (about-to-modify-symbol-value name)
(when (looks-like-name-of-special-var-p name)
(style-warn "defining ~S as a constant, even though the name follows~@
the usual naming convention (names like *FOO*) for special variables"
(defun print-allocated-objects (space &key (percent 0) (pages 5)
type larger smaller count
(stream *standard-output*))
- (declare (type (integer 0 99) percent) (type sb!c::index pages)
+ (declare (type (integer 0 99) percent) (type index pages)
(type stream stream) (type spaces space)
- (type (or sb!c::index null) type larger smaller count))
+ (type (or index null) type larger smaller count))
(multiple-value-bind (start-sap end-sap) (space-bounds space)
(let* ((space-start (sap-int start-sap))
(space-end (sap-int end-sap))
(defun list-allocated-objects (space &key type larger smaller count
test)
(declare (type spaces space)
- (type (or sb!c::index null) larger smaller type count)
+ (type (or index null) larger smaller type count)
(type (or function null) test)
(inline map-allocated-objects))
(unless *ignore-after* (setq *ignore-after* (cons 1 2)))
(declaim (maybe-inline get %put getf remprop %putf get-properties keywordp))
-(defun symbol-value (variable)
+(defun symbol-value (symbol)
#!+sb-doc
- "VARIABLE must evaluate to a symbol. This symbol's current special
- value is returned."
+ "Return SYMBOL's current bound value."
(declare (optimize (safety 1)))
- (symbol-value variable))
+ (symbol-value symbol))
-(defun boundp (variable)
+(defun boundp (symbol)
#!+sb-doc
- "VARIABLE must evaluate to a symbol. Return NIL if this symbol is
- unbound, T if it has a value."
- (boundp variable))
+ "Return non-NIL if SYMBOL is bound to a value."
+ (boundp symbol))
-(defun set (variable new-value)
+(defun set (symbol new-value)
#!+sb-doc
- "VARIABLE must evaluate to a symbol. This symbol's special value cell is
- set to the specified new value."
- (declare (type symbol variable))
- (about-to-modify variable)
- (%set-symbol-value variable new-value))
+ "Set SYMBOL's value cell to NEW-VALUE."
+ (declare (type symbol symbol))
+ (about-to-modify-symbol-value symbol)
+ (%set-symbol-value symbol new-value))
(defun %set-symbol-value (symbol new-value)
(%set-symbol-value symbol new-value))
-(defun makunbound (variable)
+(defun makunbound (symbol)
#!+sb-doc
- "VARIABLE must evaluate to a symbol. This symbol is made unbound,
- removing any value it may currently have."
- (set variable
+ "Make SYMBOL unbound, removing any value it may currently have."
+ (set symbol
(%primitive sb!c:make-other-immediate-type
0
sb!vm:unbound-marker-widetag))
- variable)
+ symbol)
+;;; Return the built-in hash value for SYMBOL.
#!+(or x86 mips) ;; only backends for which a symbol-hash vop exists
(defun symbol-hash (symbol)
- #!+sb-doc
- "Return the built-in hash value for symbol."
(symbol-hash symbol))
+;;; Compute the hash value for SYMBOL.
#!-(or x86 mips)
(defun symbol-hash (symbol)
- #!+sb-doc
- "Return the built-in hash value for symbol."
(%sxhash-simple-string (symbol-name symbol)))
-
-(defun symbol-function (variable)
+(defun symbol-function (symbol)
#!+sb-doc
- "VARIABLE must evaluate to a symbol. This symbol's current definition
- is returned. Settable with SETF."
- (raw-definition variable))
+ "Return SYMBOL's current function definition. Settable with SETF."
+ (raw-definition symbol))
(defun fset (symbol new-value)
(declare (type symbol symbol) (type function new-value))
(setf (raw-definition symbol) new-value))
-(defun symbol-plist (variable)
+(defun symbol-plist (symbol)
#!+sb-doc
- "Return the property list of a symbol."
- (symbol-plist variable))
+ "Return SYMBOL's property list."
+ (symbol-plist symbol))
(defun %set-symbol-plist (symbol new-value)
(setf (symbol-plist symbol) new-value))
-(defun symbol-name (variable)
+(defun symbol-name (symbol)
#!+sb-doc
- "Return the print name of a symbol."
- (symbol-name variable))
+ "Return SYMBOL's name as a string."
+ (symbol-name symbol))
-(defun symbol-package (variable)
+(defun symbol-package (symbol)
#!+sb-doc
- "Return the package a symbol is interned in, or NIL if none."
- (symbol-package variable))
+ "Return the package SYMBOL was interned in, or NIL if none."
+ (symbol-package symbol))
(defun %set-symbol-package (symbol package)
(declare (type symbol symbol))
--- /dev/null
+;;;; Set up *BUGID->KNOWNP* for clocc-ansi.test.sh.
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(in-package :cl-user)
+
+;;; bugs, bugs, bugs
+(defvar *bugid->knownp* (make-hash-table))
+(map nil
+ (lambda (bugid)
+ (setf (gethash bugid *bugid->knownp*)
+ t))
+ #())
--- /dev/null
+#!/bin/sh
+
+# Run clocc's ansi-test suite on SBCL.
+#
+# This is implemented as a shell script because ansi-test likes to
+# report its errors on standard output and it's convenient to use the
+# *nix shell tools to extract them.
+
+# clocc = Common Lisp Open Code Collection, available on
+# <http://clocc.sourceforge.net/>
+# ansi-test = one of the subdirectories in clocc, containing lotso tests
+# for ANSI compliance (and the occasional test for CLISP
+# compatibility too:-)
+
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# While most of SBCL is derived from the CMU CL system, the test
+# files (like this one) were written from scratch after the fork
+# from CMU CL.
+#
+# This software is in the public domain and is provided with
+# absolutely no warranty. See the COPYING and CREDITS files for
+# more information.
+
+# Remember where we came from so we can find local support files later.
+originalpwd=`pwd`
+
+# Find clocc ansi-test (or just punt, returning success).
+if [ "$SBCL_CLOCC_ANSI_TEST" = "" ] ; then
+ echo punting clocc ansi-test because SBCL_CLOCC_ANSI_TEST is undefined
+ exit 104
+else
+ cd $SBCL_CLOCC_ANSI_TEST
+fi
+
+# The condition system is for the weak.
+tmpprefix="${TMPDIR:-/tmp}/sbcl-clocc-ansi-test-$$"
+rawfilename="$tmpprefix-raw.tmp"
+bugsfilename="$tmpprefix-bugs.tmp"
+
+# Go SBCL go.
+$SBCL <<EOF | tee $rawfilename
+(in-package :cl-user)
+;;; Tell ansi-test about our known bugs.
+(load "$originalpwd/clocc-ansi-test-known-bugs.lisp")
+;;; Actually run ansi-test.
+(load "tests.lisp")
+;;; Return a special status code to show that we reached the end
+;;; normally instead of taking a dirt nap.
+(sb-ext:quit :unix-status 52)
+EOF
+if [ $? != 52 ]; then
+ echo "failure: SBCL didn't finish running clocc ansi-test."
+ exit 1
+fi
+
+# Klingon programmers detect errors by searching for error tags in
+# standard output.
+if egrep 'ERROR!!' $rawfilename > $bugsfilename; then
+ # new bugs, better luck next time
+ cat $bugsfilename
+ exit 1
+else
+ # only known bugs, happy happy joy joy
+ rm $rawfilename $bugsfilename
+ exit 104
+fi
# work.)
echo '//apparent success (reached end of run-tests.sh normally)'
+date
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.61"
+"0.pre7.62"
projects / sbcl.git / commitdiff