From: William Harold Newman Date: Sun, 14 Oct 2001 00:08:38 +0000 (+0000) Subject: 0.pre7.62: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d1c237164f9bd00879843cba7a79c05449cf50f7;p=sbcl.git 0.pre7.62: added first draft of tests/*clocc-ansi* stuff applied Alexey Dejneka's fixes from sbcl-devel 2001-10-13.. ..exported RETURN-PC-SAVE-OFFSET from SB!VM as per "broken debugger" message ..fixed PARSE-COMPILED-DEBUG-BLOCKS along the lines of "debugger errors" message (DEBUG-FUNCTION vs. DEBUG-FUN, argh!) s/about-to-modify/about-to-modify-symbol-value/ INDEX is in SB-INT now, so it doesn't need package prefixes anywhere any more. exported SC-OFFSET from SB-C --- diff --git a/NEWS b/NEWS index 50ddaf0..962c9d2 100644 --- a/NEWS +++ b/NEWS @@ -892,7 +892,10 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13: ** 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 @@ -902,6 +905,8 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13: :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 @@ -916,11 +921,12 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13: * 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 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 042c224..a2c15c0 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -243,7 +243,7 @@ "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" @@ -827,7 +827,7 @@ retained, possibly temporariliy, because it might be used internally." "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" @@ -1780,7 +1780,8 @@ structure representations" "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" diff --git a/slam.sh b/slam.sh index c7d245e..3cabacf 100644 --- a/slam.sh +++ b/slam.sh @@ -60,4 +60,5 @@ sh make-genesis-2.sh || exit 1 sh make-target-2.sh || exit 1 -echo /ordinary termination of slam.sh +echo //ordinary termination of slam.sh +date diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 9786b0b..7b49208 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -198,7 +198,7 @@ (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) @@ -219,9 +219,9 @@ (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 @@ -380,7 +380,7 @@ ;; 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. @@ -467,10 +467,10 @@ (%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)) @@ -484,7 +484,7 @@ (: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). @@ -730,7 +730,7 @@ #!-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 @@ -739,7 +739,7 @@ #!+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 @@ -753,7 +753,7 @@ #!-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 @@ -763,7 +763,7 @@ #!+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 @@ -1486,16 +1486,17 @@ ;;; 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) @@ -1710,7 +1711,7 @@ 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 diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 7946088..439c382 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -599,11 +599,11 @@ 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 diff --git a/src/code/macros.lisp b/src/code/macros.lisp index 1976274..fe11e84 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -91,7 +91,7 @@ (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" diff --git a/src/code/room.lisp b/src/code/room.lisp index 4c394f8..6d16b35 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -560,9 +560,9 @@ (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)) @@ -649,7 +649,7 @@ (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))) diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index efe46a4..e584925 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -17,80 +17,72 @@ (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)) diff --git a/tests/clocc-ansi-test-known-bugs.lisp b/tests/clocc-ansi-test-known-bugs.lisp new file mode 100644 index 0000000..183d9d7 --- /dev/null +++ b/tests/clocc-ansi-test-known-bugs.lisp @@ -0,0 +1,22 @@ +;;;; 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)) + #()) diff --git a/tests/clocc-ansi.test.sh b/tests/clocc-ansi.test.sh new file mode 100644 index 0000000..b9d8bf8 --- /dev/null +++ b/tests/clocc-ansi.test.sh @@ -0,0 +1,68 @@ +#!/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 +# +# 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 < $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 diff --git a/tests/run-tests.sh b/tests/run-tests.sh index 51cb641..6fe86dd 100644 --- a/tests/run-tests.sh +++ b/tests/run-tests.sh @@ -124,3 +124,4 @@ done # work.) echo '//apparent success (reached end of run-tests.sh normally)' +date diff --git a/version.lisp-expr b/version.lisp-expr index d33187f..321883f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; 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"