72:
(DECLAIM (OPTIMIZE ..)) doesn't work properly inside LOCALLY forms.
-73:
- PROCLAIM and DECLAIM don't recognize the ANSI abbreviated type
- declaration syntax for user-defined types, although DECLARE does.
- E.g.
- (deftype foo () '(integer 3 19))
- (defvar *foo*)
- (declaim (foo *foo*)) ; generates warning
- (defun foo+ (x y)
- (declare (foo x y)) ; works OK
- (+ x y))
-
74:
As noted in the ANSI specification for COERCE, (COERCE 3 'COMPLEX)
gives a result which isn't COMPLEX. The result type optimizer
* Fasl file format version numbers have increased again, because
a rearrangement of internal implementation packages made some
dumped symbols in old fasl files unreadable in new cores.
-?? #'(SETF DOCUMENTATION) is now defined.
+?? (DECLAIM (OPTIMIZE ..)) now works.
+* DECLARE/DECLAIM/PROCLAIM logic is more nearly ANSI in general, with
+ many fewer weird special cases.
* Bug #17 (differing COMPILE-FILE behavior between logical and
physical pathnames) has been fixed, and some related misbehavior too,
thanks to a patch from Martin Atzmueller.
+?? #'(SETF DOCUMENTATION) is now defined.
* More compiler warnings in src/runtime/ are gone, thanks to
patches from Martin Atzmueller.
* Martin Atzmueller pointed out that bug 37 was fixed by his patches
;; now? -- WHN 19991206
;; extended declarations..
- "CONSTANT-FUNCTION" "END-BLOCK" "FREEZE-TYPE"
- "INHIBIT-WARNINGS"
- "MAYBE-INLINE" "OPTIMIZE-INTERFACE" "START-BLOCK"
+ "FREEZE-TYPE" "INHIBIT-WARNINGS"
+ "MAYBE-INLINE" "OPTIMIZE-INTERFACE"
;; ..and variables to control compiler policy
"*INLINE-EXPANSION-LIMIT*"
"TYPE-DIFFERENCE" "TYPE-EXPAND"
"TYPE-INTERSECT"
"TYPE-INTERSECTION" "TYPE-SPECIFIER"
- "*STANDARD-TYPE-NAMES*" "TYPE-UNION" "TYPE/=" "TYPE="
+ "TYPE-UNION" "TYPE/=" "TYPE="
"TYPES-INTERSECT" "UNBOUND-SYMBOL-ERROR" "UNBOXED-ARRAY"
"UNDEFINED-SYMBOL-ERROR" "UNION-TYPE" "UNION-TYPE-P"
"UNION-TYPE-TYPES" "UNKNOWN-ERROR"
;;; Call a function with some arguments popped off of the interpreter
;;; stack, and restore the SP to the specifier value.
(defun byte-apply (function num-args restore-sp)
- (declare (function function) (type index num-args))
+ (declare (type function function) (type index num-args))
(let ((start (- (current-stack-pointer) num-args)))
(declare (type stack-pointer start))
(macrolet ((frob ()
;;; always of the desired class. The second result is any existing
;;; LAYOUT for this name.
(defun insured-find-class (name predicate constructor)
- (declare (function predicate constructor))
+ (declare (type function predicate constructor))
(let* ((old (sb!xc:find-class name nil))
(res (if (and old (funcall predicate old))
old
(t (!cold-lose "bogus function in *!REVERSED-COLD-TOPLEVELS*")))))
(/show0 "done with loop over cold toplevel forms and fixups")
- ;; Set sane values again, so that the user sees sane values instead of
- ;; whatever is left over from the last DECLAIM/PROCLAIM.
+ ;; Set sane values again, so that the user sees sane values instead
+ ;; of whatever is left over from the last DECLAIM/PROCLAIM.
(show-and-call !policy-cold-init-or-resanify)
;; Only do this after toplevel forms have run, 'cause that's where
;;; Common Lisp special variables which have SB-XC versions
(proclaim '(special sb!xc:*macroexpand-hook*))
-;;; the Common Lisp defined type specifier symbols
-(declaim (type list *standard-type-names*))
-(defparameter *standard-type-names*
+;;; the Common Lisp defined type spec symbols
+(defparameter *!standard-type-names*
'(array atom bignum bit bit-vector character compiled-function
complex cons double-float extended-char fixnum float function
hash-table integer keyword list long-float nil null number package
(arg0-p (funcall function arg0))
(t (funcall function))))))
-(defun constantly (value &optional (val1 nil val1-p) (val2 nil val2-p)
- &rest more-values)
- #!+sb-doc
- "Builds a function that always returns VALUE, and possibly MORE-VALUES."
- (cond (more-values
- (let ((list (list* value val1 val2 more-values)))
- (lambda ()
- (declare (optimize-interface (speed 3) (safety 0)))
- (values-list list))))
- (val2-p
- (lambda ()
- (declare (optimize-interface (speed 3) (safety 0)))
- (values value val1 val2)))
- (val1-p
- (lambda ()
- (declare (optimize-interface (speed 3) (safety 0)))
- (values value val1)))
- (t
- (lambda ()
- (declare (optimize-interface (speed 3) (safety 0)))
- value))))
+(defun constantly (value)
+ #!+sb-doc
+ "Return a function that always returns VALUE."
+ (lambda ()
+ ;; KLUDGE: This declaration is a hack to make the closure ignore
+ ;; all its arguments without consing a &REST list or anything.
+ ;; Perhaps once DYNAMIC-EXTENT is implemented we won't need to
+ ;; screw around with this kind of thing.
+ (declare (optimize-interface (speed 3) (safety 0)))
+ value))
\f
;;;; macros for (&KEY (KEY #'IDENTITY) (TEST #'EQL TESTP) (TEST-NOT NIL NOTP))
(ecase (fits-on-line-p stream (block-start-section-end next)
force-newlines-p)
((t)
- ;; Just nuke the whole logical block and make it look like one
- ;; nice long literal.
+ ;; Just nuke the whole logical block and make it look
+ ;; like one nice long literal.
(let ((end (block-start-block-end next)))
(expand-tabs stream end)
(setf tail (cdr (member end tail)))))
;;; a test that the host Lisp object OBJECT translates to a target SBCL
;;; type TYPE. (This behavior is needed e.g. to test for the validity of
;;; numeric subtype bounds read when cross-compiling.)
-;;;
-;;; KLUDGE: In classic CMU CL this was wrapped in a (DECLAIM (START-BLOCK
-;;; TYPEP %TYPEP CLASS-CELL-TYPEP)) to make calls efficient. Once I straighten
-;;; out bootstrapping and cross-compiling issues it'd likely be a good idea to
-;;; do this again. -- WHN 19990413
(defun typep (object type)
#!+sb-doc
"Return T iff OBJECT is of type TYPE."
(defmacro !define-type-method ((class method &rest more-methods)
lambda-list &body body)
- #!+sb-doc
- "DEFINE-TYPE-METHOD (Class-Name Method-Name+) Lambda-List Form*"
(let ((name (symbolicate CLASS "-" method "-TYPE-METHOD")))
`(progn
(defun ,name ,lambda-list ,@body)
;;; built-in symbol type specifiers
(/show0 "precomputing built-in symbol type specifiers")
-(precompute-types *standard-type-names*)
+(precompute-types *!standard-type-names*)
;;; FIXME: It should be possible to do this in the cross-compiler,
;;; but currently the cross-compiler's type system is too dain-bramaged to
(:print-object (lambda (x s)
(print-unreadable-object (x s :type t)
(prin1 (namestring (fasl-file-stream x)) s)))))
- ;; The stream we dump to.
+ ;; the stream we dump to
(stream (required-argument) :type stream)
- ;; Hashtables we use to keep track of dumped constants so that we
+ ;; hashtables we use to keep track of dumped constants so that we
;; can get them from the table rather than dumping them again. The
;; EQUAL-TABLE is used for lists and strings, and the EQ-TABLE is
;; used for everything else. We use a separate EQ table to avoid
;; the EQ table.
(equal-table (make-hash-table :test 'equal) :type hash-table)
(eq-table (make-hash-table :test 'eq) :type hash-table)
- ;; The table's current free pointer: the next offset to be used.
+ ;; the table's current free pointer: the next offset to be used
(table-free 0 :type index)
;; an alist (PACKAGE . OFFSET) of the table offsets for each package
;; we have currently located.
(dotimes (i 4)
(write-byte (ldb (byte 8 (* 8 i)) num) stream))))
-;;; Dump NUM to the fasl stream, represented by N bytes. This works for either
-;;; signed or unsigned integers. There's no range checking -- if you don't
-;;; specify enough bytes for the number to fit, this function cheerfully
-;;; outputs the low bytes.
+;;; Dump NUM to the fasl stream, represented by N bytes. This works
+;;; for either signed or unsigned integers. There's no range checking
+;;; -- if you don't specify enough bytes for the number to fit, this
+;;; function cheerfully outputs the low bytes.
(defun dump-integer-as-n-bytes (num bytes file)
(declare (integer num) (type index bytes) (type fasl-file file))
(do ((n num (ash n -8))
(dump-byte (logand n #xff) file))
(values))
-;;; Setting this variable to an (UNSIGNED-BYTE 32) value causes DUMP-FOP to use
-;;; it as a counter and emit a FOP-NOP4 with the counter value before every
-;;; ordinary fop. This can make it easier to follow the progress of FASLOAD
-;;; when debugging/testing/experimenting.
-#!+sb-show (defvar *fop-nop4-count* 0)
+;;; Setting this variable to an (UNSIGNED-BYTE 32) value causes
+;;; DUMP-FOP to use it as a counter and emit a FOP-NOP4 with the
+;;; counter value before every ordinary fop. This can make it easier
+;;; to follow the progress of FASLOAD when
+;;; debugging/testing/experimenting.
+#!+sb-show (defvar *fop-nop4-count* nil)
#!+sb-show (declaim (type (or (unsigned-byte 32) null) *fop-nop4-count*))
-;;; FIXME: The default value here should become NIL once I get the system to
-;;; run.
;;; Dump the FOP code for the named FOP to the specified fasl-file.
;;;
-;;; FIXME: This should be a function, with a compiler macro expansion for the
-;;; common constant-FS case. (Among other things, that'll stop it from
-;;; EVALing ,FILE multiple times.)
+;;; FIXME: This should be a function, with a compiler macro expansion
+;;; for the common constant-FS case. (Among other things, that'll stop
+;;; it from EVALing ,FILE multiple times.)
;;;
-;;; FIXME: Compiler macros, frozen classes, inlining, and similar optimizations
-;;; should be conditional on #!+SB-FROZEN.
+;;; FIXME: Compiler macros, frozen classes, inlining, and similar
+;;; optimizations should be conditional on #!+SB-FROZEN.
(defmacro dump-fop (fs file)
(let* ((fs (eval fs))
(val (get fs 'sb!impl::fop-code)))
(dump-byte ',val ,file))
(error "compiler bug: ~S is not a legal fasload operator." fs))))
-;;; Dump a FOP-Code along with an integer argument, choosing the FOP based
-;;; on whether the argument will fit in a single byte.
+;;; Dump a FOP-Code along with an integer argument, choosing the FOP
+;;; based on whether the argument will fit in a single byte.
;;;
-;;; FIXME: This, like DUMP-FOP, should be a function with a compiler-macro
-;;; expansion.
+;;; FIXME: This, like DUMP-FOP, should be a function with a
+;;; compiler-macro expansion.
(defmacro dump-fop* (n byte-fop word-fop file)
(once-only ((n-n n)
(n-file file))
\f
;;;; LOAD-TIME-VALUE and MAKE-LOAD-FORM support
-;;; Emit a funcall of the function and return the handle for the result.
+;;; Emit a funcall of the function and return the handle for the
+;;; result.
(defun fasl-dump-load-time-value-lambda (fun file)
(declare (type clambda fun) (type fasl-file file))
(let ((handle (gethash (leaf-info fun) (fasl-file-entry-table file))))
(dump-byte 0 file))
(dump-pop file))
-;;; Return T iff CONSTANT has not already been dumped. It's been dumped
-;;; if it's in the EQ table.
+;;; Return T iff CONSTANT has not already been dumped. It's been
+;;; dumped if it's in the EQ table.
(defun fasl-constant-already-dumped (constant file)
(if (or (gethash constant (fasl-file-eq-table file))
(gethash constant (fasl-file-valid-structures file)))
(setf (gethash constant table) handle))
(values))
-;;; Note that the specified structure can just be dumped by enumerating the
-;;; slots.
+;;; Note that the specified structure can just be dumped by
+;;; enumerating the slots.
(defun fasl-validate-structure (structure file)
(setf (gethash structure (fasl-file-valid-structures file)) t)
(values))
;;;; symbol dumping
;;; Return the table index of PKG, adding the package to the table if
-;;; necessary. During cold load, we read the string as a normal string so that
-;;; we can do the package lookup at cold load time.
+;;; necessary. During cold load, we read the string as a normal string
+;;; so that we can do the package lookup at cold load time.
;;;
-;;; KLUDGE: Despite the parallelism in names, the functionality of this
-;;; function is not parallel to other functions DUMP-FOO, e.g. DUMP-SYMBOL
-;;; and DUMP-LIST. -- WHN 19990119
+;;; FIXME: Despite the parallelism in names, the functionality of
+;;; this function is not parallel to other functions DUMP-FOO, e.g.
+;;; DUMP-SYMBOL and DUMP-LIST. The mapping between names and behavior
+;;; should be made more consistent.
(defun dump-package (pkg file)
(declare (type package pkg) (type fasl-file file) (values index)
(inline assoc))
(dump-fop 'sb!impl::fop-list* file)
(dump-byte 255 file)))))
-;;; If N > 255, must build list with one list operator, then list* operators.
+;;; If N > 255, must build list with one LIST operator, then LIST*
+;;; operators.
(defun terminate-undotted-list (n file)
(declare (type index n) (type fasl-file file))
(dump-vector x file)
(dump-multi-dim-array x file)))
-;;; Dump the vector object. If it's not simple, then actually dump a simple
-;;; version of it. But we enter the original in the EQ or EQUAL tables.
+;;; Dump the vector object. If it's not simple, then actually dump a
+;;; simple version of it. But we enter the original in the EQ or EQUAL
+;;; tables.
(defun dump-vector (x file)
(let ((simple-version (if (array-header-p x)
(coerce x 'simple-array)
(t ; harder cases, not supported in cross-compiler
(dump-raw-bytes vec bytes file))))
(dump-signed-vector (size bytes)
- ;; Note: Dumping specialized signed vectors isn't supported in
- ;; the cross-compiler. (All cases here end up trying to call
- ;; DUMP-RAW-BYTES, which isn't provided in the cross-compilation
- ;; host, only on the target machine.)
+ ;; Note: Dumping specialized signed vectors isn't
+ ;; supported in the cross-compiler. (All cases here end
+ ;; up trying to call DUMP-RAW-BYTES, which isn't
+ ;; provided in the cross-compilation host, only on the
+ ;; target machine.)
(unless data-only
(dump-fop 'sb!impl::fop-signed-int-vector file)
(dump-unsigned-32 len file)
(error "internal error, code-length=~D, nwritten=~D"
code-length
nwritten)))
- ;; KLUDGE: It's not clear what this is trying to do, but it looks as though
- ;; it's an implicit undocumented dependence on a 4-byte wordsize which could
- ;; be painful in porting. Note also that there are other undocumented
- ;; modulo-4 things scattered throughout the code and conditionalized
- ;; with GENGC, and I don't know what those do either. -- WHN 19990323
+ ;; KLUDGE: It's not clear what this is trying to do, but it looks as
+ ;; though it's an implicit undocumented dependence on a 4-byte
+ ;; wordsize which could be painful in porting. Note also that there
+ ;; are other undocumented modulo-4 things scattered throughout the
+ ;; code and conditionalized with GENGC, and I don't know what those
+ ;; do either. -- WHN 19990323
#!+gengc (unless (zerop (logand code-length 3))
(dotimes (i (- 4 (logand code-length 3)))
(dump-byte 0 fasl-file)))
(declare (list fixups) (type fasl-file fasl-file))
(dolist (info fixups)
;; FIXME: Packing data with LIST in NOTE-FIXUP and unpacking them
- ;; with FIRST, SECOND, and THIRD here is hard to follow and maintain.
- ;; Perhaps we could define a FIXUP-INFO structure to use instead, and
- ;; rename *FIXUPS* to *FIXUP-INFO-LIST*?
+ ;; with FIRST, SECOND, and THIRD here is hard to follow and
+ ;; maintain. Perhaps we could define a FIXUP-INFO structure to use
+ ;; instead, and rename *FIXUPS* to *FIXUP-INFO-LIST*?
(let* ((kind (first info))
(fixup (second info))
(name (fixup-name fixup))
(flavor (fixup-flavor fixup))
(offset (third info)))
- ;; FIXME: This OFFSET is not what's called OFFSET in
- ;; the FIXUP structure, it's what's called POSN in NOTE-FIXUP.
- ;; (As far as I can tell, FIXUP-OFFSET is not actually an offset,
- ;; it's an internal label used instead of NAME for :CODE-OBJECT
- ;; fixups. Notice that in the :CODE-OBJECT case, NAME is ignored.)
+ ;; FIXME: This OFFSET is not what's called OFFSET in the FIXUP
+ ;; structure, it's what's called POSN in NOTE-FIXUP. (As far as
+ ;; I can tell, FIXUP-OFFSET is not actually an offset, it's an
+ ;; internal label used instead of NAME for :CODE-OBJECT fixups.
+ ;; Notice that in the :CODE-OBJECT case, NAME is ignored.)
(dump-fop 'sb!impl::fop-normal-load fasl-file)
(let ((*cold-load-dump* t))
(dump-object kind fasl-file))
;;; Dump out the constant pool and code-vector for component, push the
;;; result in the table, and return the offset.
;;;
-;;; The only tricky thing is handling constant-pool references to functions.
-;;; If we have already dumped the function, then we just push the code pointer.
-;;; Otherwise, we must create back-patching information so that the constant
-;;; will be set when the function is eventually dumped. This is a bit awkward,
-;;; since we don't have the handle for the code object being dumped while we
-;;; are dumping its constants.
+;;; The only tricky thing is handling constant-pool references to
+;;; functions. If we have already dumped the function, then we just
+;;; push the code pointer. Otherwise, we must create back-patching
+;;; information so that the constant will be set when the function is
+;;; eventually dumped. This is a bit awkward, since we don't have the
+;;; handle for the code object being dumped while we are dumping its
+;;; constants.
;;;
;;; We dump trap objects in any unused slots or forward referenced slots.
(defun dump-code-object (component
;; Dump the offset of the trace table.
(dump-object code-length fasl-file)
- ;; KLUDGE: Now that we don't have GENGC, the trace table is hardwired
- ;; to be empty. Could we get rid of trace tables? What are the
- ;; virtues of GENGC vs. GENCGC vs. whatnot?
+ ;; FIXME: As long as we don't have GENGC, the trace table is
+ ;; hardwired to be empty. So we might be able to get rid of
+ ;; trace tables? However, we should probably wait for the first
+ ;; port to a system where CMU CL uses GENGC to see whether GENGC
+ ;; is really gone. (I.e. maybe other non-X86 ports will want to
+ ;; use it, just as in CMU CL.)
;; Dump the constants, noting any :entries that have to be fixed up.
(do ((i sb!vm:code-constants-offset (1+ i)))
(dump-unsigned-32 num-consts fasl-file)
(dump-unsigned-32 total-length fasl-file))))
- ;; These two dumps are only ones which contribute to our TOTAL-LENGTH
- ;; value.
+ ;; These two dumps are only ones which contribute to our
+ ;; TOTAL-LENGTH value.
(dump-segment code-segment code-length fasl-file)
(dump-i-vector packed-trace-table fasl-file :data-only t)
- ;; DUMP-FIXUPS does its own internal DUMP-FOPs: the bytes it dumps aren't
- ;; included in the TOTAL-LENGTH passed to our FOP-CODE/FOP-SMALL-CODE
- ;; fop.
+ ;; DUMP-FIXUPS does its own internal DUMP-FOPs: the bytes it
+ ;; dumps aren't included in the TOTAL-LENGTH passed to our
+ ;; FOP-CODE/FOP-SMALL-CODE fop.
(dump-fixups fixups fasl-file)
(dump-fop 'sb!impl::fop-sanctify-for-execution fasl-file)
(dump-fop 'sb!impl::fop-sanctify-for-execution file)
(dump-pop file))
-;;; Dump a function-entry data structure corresponding to Entry to File.
-;;; Code-Handle is the table offset of the code object for the component.
+;;; Dump a function-entry data structure corresponding to ENTRY to
+;;; FILE. CODE-HANDLE is the table offset of the code object for the
+;;; component.
;;;
-;;; If the entry is a DEFUN, then we also dump a FOP-FSET so that the cold
-;;; loader can instantiate the definition at cold-load time, allowing forward
-;;; references to functions in top-level forms.
+;;; If the entry is a DEFUN, then we also dump a FOP-FSET so that the
+;;; cold loader can instantiate the definition at cold-load time,
+;;; allowing forward references to functions in top-level forms.
(defun dump-one-entry (entry code-handle file)
(declare (type entry-info entry) (type index code-handle)
(type fasl-file file))
(dump-fop 'sb!impl::fop-fset file))
handle)))
-;;; Alter the code object referenced by Code-Handle at the specified Offset,
-;;; storing the object referenced by Entry-Handle.
+;;; Alter the code object referenced by CODE-HANDLE at the specified
+;;; OFFSET, storing the object referenced by ENTRY-HANDLE.
(defun dump-alter-code-object (code-handle offset entry-handle file)
(declare (type index code-handle entry-handle offset) (type fasl-file file))
(dump-push code-handle file)
file)
(values))
-;;; Dump the code, constants, etc. for component. We pass in the assembler
-;;; fixups, code vector and node info.
+;;; Dump the code, constants, etc. for component. We pass in the
+;;; assembler fixups, code vector and node info.
(defun fasl-dump-component (component
code-segment
code-length
(setf (gethash entry (fasl-file-entry-table file)) entry-handle)
(let ((old (gethash entry (fasl-file-patch-table file))))
- ;; KLUDGE: All this code is shared with FASL-DUMP-BYTE-COMPONENT,
- ;; and should probably be gathered up into a named function
- ;; (DUMP-PATCHES?) called from both functions.
+ ;; FIXME: All this code is shared with
+ ;; FASL-DUMP-BYTE-COMPONENT, and should probably be gathered
+ ;; up into a named function (DUMP-PATCHES?) called from both
+ ;; functions.
(when old
(dolist (patch old)
(dump-alter-code-object (car patch)
(dump-push info-handle file)
(push info-handle (fasl-file-debug-info file))))
- ;; The "trace table" is initialized by loader to hold a list of all byte
- ;; functions in this code object (for debug info.)
+ ;; The "trace table" is initialized by loader to hold a list of
+ ;; all byte functions in this code object (for debug info.)
(dump-object nil file)
;; Dump the constants.
code-handle)))
;;; Dump a BYTE-FUNCTION object. We dump the layout and
-;;; funcallable-instance info, but rely on the loader setting up the correct
-;;; funcallable-instance-function.
+;;; funcallable-instance info, but rely on the loader setting up the
+;;; correct funcallable-instance-function.
(defun dump-byte-function (xep code-handle file)
(let ((nslots (- (get-closure-length xep)
;; 1- for header
(remhash info patch-table))))))
(values))
-;;; Dump a FOP-FUNCALL to call an already dumped top-level lambda at load time.
+;;; Dump a FOP-FUNCALL to call an already dumped top-level lambda at
+;;; load time.
(defun fasl-dump-top-level-lambda-call (fun file)
(declare (type clambda fun) (type fasl-file file))
(let ((handle (gethash (leaf-info fun) (fasl-file-entry-table file))))
(dump-byte 0 file))
(values))
-;;; Compute the correct list of DEBUG-SOURCE structures and backpatch all of
-;;; the dumped DEBUG-INFO structures. We clear the FASL-FILE-DEBUG-INFO,
-;;; so that subsequent components with different source info may be dumped.
+;;; Compute the correct list of DEBUG-SOURCE structures and backpatch
+;;; all of the dumped DEBUG-INFO structures. We clear the
+;;; FASL-FILE-DEBUG-INFO, so that subsequent components with different
+;;; source info may be dumped.
(defun fasl-dump-source-info (info file)
(declare (type source-info info) (type fasl-file file))
(let ((res (debug-source-for-info info))
;;;; dumping structures
(defun dump-structure (struct file)
- ;; FIXME: Probably *DUMP-ONLY-VALID-STRUCTURES* should become constantly T,
- ;; right?
(when *dump-only-valid-structures*
(unless (gethash struct (fasl-file-valid-structures file))
(error "attempt to dump invalid structure:~% ~S~%How did this happen?"
(defknown identity (t) t (movable foldable flushable unsafe)
:derive-type #'result-type-first-arg)
-;;; &OPTIONAL is to agree with the optimization in the interpreter stub.
-(defknown constantly (t &optional t t &rest t) function (movable flushable))
+(defknown constantly (t) function (movable flushable))
(defknown complement (function) function (movable flushable))
\f
;;;; magical compiler frobs
;;; describing the actual function called.
;;;
;;; FIXME: It would be nice to make structure slot accessors be
-;;; ordinary functions (proclaimed as SB-EXT:CONSTANT-FUNCTION, but
-;;; otherwise ordinary).
+;;; ordinary functions.
(defknown %slot-accessor (t) t (flushable))
(defknown %slot-setter (t t) t (unsafe))
\f
;;; If a lambda-var being bound, we intersect the type with the vars
;;; type, otherwise we add a type-restriction on the var. If a symbol
;;; macro, we just wrap a THE around the expansion.
-(defun process-type-declaration (decl res vars)
+(defun process-type-decl (decl res vars)
(declare (list decl vars) (type lexenv res))
(let ((type (specifier-type (first decl))))
(collect ((restr nil cons)
:variables (new-vars))
res))))
-;;; Somewhat similar to Process-Type-Declaration, but handles
+;;; This is somewhat similar to PROCESS-TYPE-DECL, but handles
;;; declarations for function variables. In addition to allowing
;;; declarations for functions being bound, we must also deal with
;;; declarations that constrain the type of lexically apparent
;;; functions.
-(defun process-ftype-declaration (spec res names fvars)
+(defun process-ftype-decl (spec res names fvars)
(declare (list spec names fvars) (type lexenv res))
(let ((type (specifier-type spec)))
(collect ((res nil cons))
;;; Process a special declaration, returning a new LEXENV. A non-bound
;;; special declaration is instantiated by throwing a special variable
;;; into the variables.
-(defun process-special-declaration (spec res vars)
+(defun process-special-decl (spec res vars)
(declare (list spec vars) (type lexenv res))
(collect ((new-venv nil cons))
(dolist (name (cdr spec))
;;; Parse an inline/notinline declaration. If it's a local function we're
;;; defining, set its INLINEP. If a global function, add a new FENV entry.
-(defun process-inline-declaration (spec res fvars)
+(defun process-inline-decl (spec res fvars)
(let ((sense (cdr (assoc (first spec) *inlinep-translations* :test #'eq)))
(new-fenv ()))
(dolist (name (rest spec))
;;; Process an ignore/ignorable declaration, checking for various losing
;;; conditions.
-(defun process-ignore-declaration (spec vars fvars)
+(defun process-ignore-decl (spec vars fvars)
(declare (list spec vars fvars))
(dolist (name (rest spec))
(let ((var (find-in-bindings-or-fbindings name vars fvars)))
#!+sb-doc
"If true, processing of the VALUES declaration is inhibited.")
-;;; Process a single declaration spec, agumenting the specified LEXENV
-;;; Res and returning it as a result. Vars and Fvars are as described in
+;;; Process a single declaration spec, augmenting the specified LEXENV
+;;; RES and returning it as a result. VARS and FVARS are as described in
;;; PROCESS-DECLS.
-(defun process-1-declaration (spec res vars fvars cont)
+(defun process-1-decl (raw-spec res vars fvars cont)
(declare (list spec vars fvars) (type lexenv res) (type continuation cont))
- (case (first spec)
- (special (process-special-declaration spec res vars))
- (ftype
- (unless (cdr spec)
- (compiler-error "No type specified in FTYPE declaration: ~S" spec))
- (process-ftype-declaration (second spec) res (cddr spec) fvars))
- (function
- ;; Handle old style FUNCTION declaration, which is an abbreviation for
- ;; FTYPE. Args are name, arglist, result type.
- (cond ((and (proper-list-of-length-p spec 3 4)
- (listp (third spec)))
- (process-ftype-declaration `(function ,@(cddr spec)) res
- (list (second spec))
- fvars))
- (t
- (process-type-declaration spec res vars))))
- ((inline notinline maybe-inline)
- (process-inline-declaration spec res fvars))
- ((ignore ignorable)
- (process-ignore-declaration spec vars fvars)
- res)
- (optimize
- (make-lexenv
- :default res
- :policy (process-optimize-declaration spec (lexenv-policy res))))
- (optimize-interface
- (make-lexenv
- :default res
- :interface-policy (process-optimize-declaration
- spec
- (lexenv-interface-policy res))))
- (type
- (process-type-declaration (cdr spec) res vars))
- (values
- (if *suppress-values-declaration*
- res
- (let ((types (cdr spec)))
- (do-the-stuff (if (eql (length types) 1)
- (car types)
- `(values ,@types))
- cont res 'values))))
- (dynamic-extent
- (when (policy nil (> speed inhibit-warnings))
- (compiler-note
- "The DYNAMIC-EXTENT declaration is not implemented (ignored)."))
- res)
- (t
- (let ((what (first spec)))
- (cond ((member what *standard-type-names*)
- (process-type-declaration spec res vars))
- ((and (not (and (symbolp what)
- (string= (symbol-name what) "CLASS"))) ; pcl hack
- (or (info :type :kind what)
- (and (consp what) (info :type :translator (car what)))))
- (process-type-declaration spec res vars))
- ((info :declaration :recognized what)
- res)
- (t
- (compiler-warning "unrecognized declaration ~S" spec)
- res))))))
+ (let ((spec (canonized-decl-spec raw-spec)))
+ (case (first spec)
+ (special (process-special-decl spec res vars))
+ (ftype
+ (unless (cdr spec)
+ (compiler-error "No type specified in FTYPE declaration: ~S" spec))
+ (process-ftype-decl (second spec) res (cddr spec) fvars))
+ ((inline notinline maybe-inline)
+ (process-inline-decl spec res fvars))
+ ((ignore ignorable)
+ (process-ignore-decl spec vars fvars)
+ res)
+ (optimize
+ (make-lexenv
+ :default res
+ :policy (process-optimize-decl spec (lexenv-policy res))))
+ (optimize-interface
+ (make-lexenv
+ :default res
+ :interface-policy (process-optimize-decl
+ spec
+ (lexenv-interface-policy res))))
+ (type
+ (process-type-decl (cdr spec) res vars))
+ (values
+ (if *suppress-values-declaration*
+ res
+ (let ((types (cdr spec)))
+ (do-the-stuff (if (eql (length types) 1)
+ (car types)
+ `(values ,@types))
+ cont res 'values))))
+ (dynamic-extent
+ (when (policy nil (> speed inhibit-warnings))
+ (compiler-note
+ "The DYNAMIC-EXTENT declaration is not implemented (ignored)."))
+ res)
+ (t
+ (unless (info :declaration :recognized (first spec))
+ (compiler-warning "unrecognized declaration ~S" raw-spec))
+ res))))
;;; Use a list of DECLARE forms to annotate the lists of LAMBDA-VAR
;;; and FUNCTIONAL structures which are being bound. In addition to
(compiler-error "malformed declaration specifier ~S in ~S"
spec
decl))
- (setq env (process-1-declaration spec env vars fvars cont))))
+ (setq env (process-1-decl spec env vars fvars cont))))
env)
-;;; Return the Specvar for Name to use when we see a local SPECIAL
+;;; Return the SPECVAR for NAME to use when we see a local SPECIAL
;;; declaration. If there is a global variable of that name, then
;;; check that it isn't a constant and return it. Otherwise, create an
;;; anonymous GLOBAL-VAR.
;;; Return a new POLICY containing the policy information represented
;;; by the optimize declaration SPEC. Any parameters not specified are
;;; defaulted from the POLICY argument.
-(declaim (ftype (function (list policy) policy) process-optimize-declaration))
-(defun process-optimize-declaration (spec policy)
+(declaim (ftype (function (list policy) policy) process-optimize-decl))
+(defun process-optimize-decl (spec policy)
(let ((result policy)) ; may have new entries pushed on it below
(dolist (q-and-v-or-just-q (cdr spec))
(multiple-value-bind (quality raw-value)
result)))))
result))
-(defun sb!xc:proclaim (form)
- (unless (consp form)
- (error "malformed PROCLAIM spec: ~S" form))
- (let ((kind (first form))
- (args (rest form)))
+;;; ANSI defines the declaration (FOO X Y) to be equivalent to
+;;; (TYPE FOO X Y) when FOO is a type specifier. This function
+;;; implements that by converting (FOO X Y) to (TYPE FOO X Y).
+(defun canonized-decl-spec (decl-spec)
+ (let ((id (first decl-spec)))
+ (unless (symbolp id)
+ (error "The declaration identifier is not a symbol: ~S" what))
+ (let ((id-is-type (info :type :kind id))
+ (id-is-declared-decl (info :declaration :recognized id)))
+ (cond ((and id-is-type id-is-declared-decl)
+ (compiler-error
+ "ambiguous declaration ~S:~% ~
+ ~S was declared as a DECLARATION, but is also a type name."
+ decl-spec id))
+ (id-is-type
+ (cons 'type decl-spec))
+ (t
+ decl-spec)))))
+
+(defun sb!xc:proclaim (raw-form)
+ (let* ((form (canonized-decl-spec raw-form))
+ (kind (first form))
+ (args (rest form)))
(case kind
(special
(dolist (name args)
(declare (ignore layout))
(setf (class-state subclass) :sealed))))))))
(optimize
- (setq *default-policy*
- (process-optimize-declaration form *default-policy*)))
+ (setq *default-policy* (process-optimize-decl form *default-policy*)))
(optimize-interface
(setq *default-interface-policy*
- (process-optimize-declaration form *default-interface-policy*)))
+ (process-optimize-decl form *default-interface-policy*)))
((inline notinline maybe-inline)
(dolist (name args)
(proclaim-as-function-name name)
(inline :inline)
(notinline :notinline)
(maybe-inline :maybe-inline)))))
- (constant-function
- (let ((info (make-function-info
- :attributes (ir1-attributes movable foldable flushable
- unsafe))))
- (dolist (name args)
- (proclaim-as-function-name name)
- (setf (info :function :info name) info))))
(declaration
(dolist (decl args)
(unless (symbolp decl)
- (error "The declaration to be recognized is not a symbol: ~S" decl))
+ (error "In~% ~S~%the declaration to be recognized is not a ~
+ symbol:~% ~S"
+ form decl))
(setf (info :declaration :recognized decl) t)))
(t
- (cond ((member kind *standard-type-names*)
- (sb!xc:proclaim `(type ,@form))) ; FIXME: ,@ instead of . ,
- ((not (info :declaration :recognized kind))
- (warn "unrecognized proclamation: ~S" form))))))
+ (unless (info :declaration :recognized kind)
+ (compiler-warning "unrecognized declaration ~S" raw-form)))))
(values))
(def-source-transform not (x) `(if ,x nil t))
(def-source-transform null (x) `(if ,x nil t))
-;;; ENDP is just NULL with a LIST assertion.
+;;; ENDP is just NULL with a LIST assertion. The assertion will be
+;;; optimized away when SAFETY optimization is low; hopefully that
+;;; is consistent with ANSI's "should return an error".
(def-source-transform endp (x) `(null (the list ,x)))
-;;; FIXME: Is THE LIST a strong enough assertion for ANSI's "should
-;;; return an error"? (THE LIST is optimized away when safety is low;
-;;; does that satisfy the spec?)
;;; We turn IDENTITY into PROG1 so that it is obvious that it just
;;; returns the first value of its argument. Ditto for VALUES with one
(def-source-transform values (x) `(prog1 ,x))
;;; Bind the values and make a closure that returns them.
-(def-source-transform constantly (value &rest values)
- (let ((temps (make-gensym-list (1+ (length values))))
- (dum (gensym)))
- `(let ,(loop for temp in temps and
- value in (list* value values)
- collect `(,temp ,value))
- #'(lambda (&rest ,dum)
- (declare (ignore ,dum))
- (values ,@temps)))))
+(def-source-transform constantly (value)
+ (let ((rest (gensym "CONSTANTLY-REST-")))
+ `(lambda (&rest ,rest)
+ (declare (ignore ,rest))
+ ,value)))
;;; If the function has a known number of arguments, then return a
;;; lambda with the appropriate fixed number of args. If the
real-add-named-method)
))
-;;; For each of the early functions, arrange to have it point to its early
-;;; definition. Do this in a way that makes sure that if we redefine one
-;;; of the early definitions the redefinition will take effect. This makes
-;;; development easier.
+;;; For each of the early functions, arrange to have it point to its
+;;; early definition. Do this in a way that makes sure that if we
+;;; redefine one of the early definitions the redefinition will take
+;;; effect. This makes development easier.
;;;
-;;; The function which generates the redirection closure is pulled out into
-;;; a separate piece of code because of a bug in ExCL which causes this not
-;;; to work if it is inlined.
+;;; The function which generates the redirection closure is pulled out
+;;; into a separate piece of code because of a bug in ExCL which
+;;; causes this not to work if it is inlined.
;;; FIXME: We no longer need to worry about ExCL now, so we could unscrew this.
(eval-when (:load-toplevel :execute)
-(defun redirect-early-function-internal (real early)
+(defun !redirect-early-function-internal (real early)
(setf (gdefinition real)
(set-function-name
#'(lambda (&rest args)
(dolist (fns *!early-functions*)
(let ((name (car fns))
(early-name (cadr fns)))
- (redirect-early-function-internal name early-name)))
+ (!redirect-early-function-internal name early-name)))
) ; EVAL-WHEN
initargs))
\f
(defmacro defmethod (&rest args &environment env)
- (declare (arglist name
- {method-qualifier}*
- specialized-lambda-list
- &body body))
(multiple-value-bind (name qualifiers lambda-list body)
(parse-defmethod args)
(multiple-value-bind (proto-gf proto-method)
(extract-declarations body env)
(values `(lambda ,unspecialized-lambda-list
,@(when documentation `(,documentation))
- (declare (method-name ,(list name qualifiers specializers)))
- (declare (method-lambda-list ,@lambda-list))
+ (declare (%method-name ,(list name qualifiers specializers)))
+ (declare (%method-lambda-list ,@lambda-list))
,@declarations
,@real-body)
unspecialized-lambda-list specializers))))
method-lambda))
(multiple-value-bind (documentation declarations real-body)
(extract-declarations (cddr method-lambda) env)
- (let* ((name-decl (get-declaration 'method-name declarations))
- (sll-decl (get-declaration 'method-lambda-list declarations))
+ (let* ((name-decl (get-declaration '%method-name declarations))
+ (sll-decl (get-declaration '%method-lambda-list declarations))
(method-name (when (consp name-decl) (car name-decl)))
(generic-function-name (when method-name (car method-name)))
(specialized-lambda-list (or sll-decl (cadr method-lambda))))
(calls (list nil))
(class-declarations
`(declare
- ;; FIXME: These nonstandard (DECLARE (SB-PCL::CLASS FOO BAR))
- ;; declarations should go away but as of 0.6.9.10, it's not
- ;; as simple as just deleting them.
+ ;; These declarations seem to be used by PCL to pass
+ ;; information to itself; when I tried to delete 'em
+ ;; ca. 0.6.10 it didn't work. I'm not sure how
+ ;; they work, but note the (VARIABLE-DECLARATION '%CLASS ..)
+ ;; expression in CAN-OPTIMIZE-ACCESS1. -- WHN 2000-12-30
,@(remove nil
(mapcar (lambda (a s) (and (symbolp s)
(neq s 't)
- `(class ,a ,s)))
+ `(%class ,a ,s)))
parameters
specializers))
;; These TYPE declarations weren't in the original
(unless was-valid-p
(let ((name (if (eq *boot-state* 'complete)
(generic-function-name gf)
- (early-gf-name gf))))
+ (!early-gf-name gf))))
(esetf (gf-precompute-dfun-and-emf-p arg-info)
(let* ((sym (if (atom name) name (cadr name)))
(pkg-list (cons *pcl-package*
(defvar *sgf-name-index*
(!bootstrap-slot-index 'standard-generic-function 'name))
-(defun early-gf-name (gf)
+(defun !early-gf-name (gf)
(instance-ref (get-slots gf) *sgf-name-index*))
(defun gf-lambda-list (gf)
(defun early-method-standard-accessor-slot-name (early-method)
(seventh (fifth early-method)))
-;;; Fetch the specializers of an early method. This is basically just a
-;;; simple accessor except that when the second argument is t, this converts
-;;; the specializers from symbols into class objects. The class objects
-;;; are cached in the early method, this makes bootstrapping faster because
-;;; the class objects only have to be computed once.
+;;; Fetch the specializers of an early method. This is basically just
+;;; a simple accessor except that when the second argument is t, this
+;;; converts the specializers from symbols into class objects. The
+;;; class objects are cached in the early method, this makes
+;;; bootstrapping faster because the class objects only have to be
+;;; computed once.
+;;;
;;; NOTE:
-;;; the second argument should only be passed as T by early-lookup-method.
-;;; this is to implement the rule that only when there is more than one
-;;; early method on a generic function is the conversion from class names
-;;; to class objects done.
-;;; the corresponds to the fact that we are only allowed to have one method
-;;; on any generic function up until the time classes exist.
+;;; The second argument should only be passed as T by
+;;; early-lookup-method. This is to implement the rule that only when
+;;; there is more than one early method on a generic function is the
+;;; conversion from class names to class objects done. This
+;;; corresponds to the fact that we are only allowed to have one
+;;; method on any generic function up until the time classes exist.
(defun early-method-specializers (early-method &optional objectsp)
(if (and (listp early-method)
(eq (car early-method) :early-method))
(add-method gf new)))
;;; This is the early version of ADD-METHOD. Later this will become a
-;;; generic function. See !FIX-EARLY-GENERIC-FUNCTIONS which has special
-;;; knowledge about ADD-METHOD.
+;;; generic function. See !FIX-EARLY-GENERIC-FUNCTIONS which has
+;;; special knowledge about ADD-METHOD.
(defun add-method (generic-function method)
(when (not (fsc-instance-p generic-function))
(error "Early ADD-METHOD didn't get a funcallable instance."))
(error "Early ADD-METHOD didn't get an early method."))
(push method (early-gf-methods generic-function))
(set-arg-info generic-function :new-method method)
- (unless (assoc (early-gf-name generic-function) *!generic-function-fixups*
+ (unless (assoc (!early-gf-name generic-function)
+ *!generic-function-fixups*
:test #'equal)
(update-dfun generic-function)))
(setf (early-gf-methods generic-function)
(remove method (early-gf-methods generic-function)))
(set-arg-info generic-function)
- (unless (assoc (early-gf-name generic-function) *!generic-function-fixups*
+ (unless (assoc (!early-gf-name generic-function)
+ *!generic-function-fixups*
:test #'equal)
(update-dfun generic-function)))
(set-methods gf methods))))
(sb-int:/show "leaving !FIX-EARLY-GENERIC-FUNCTIONS"))
\f
-;;; PARSE-DEFMETHOD is used by DEFMETHOD to parse the &REST argument into
-;;; the 'real' arguments. This is where the syntax of DEFMETHOD is really
-;;; implemented.
+;;; PARSE-DEFMETHOD is used by DEFMETHOD to parse the &REST argument
+;;; into the 'real' arguments. This is where the syntax of DEFMETHOD
+;;; is really implemented.
(defun parse-defmethod (cdr-of-form)
;;(declare (values name qualifiers specialized-lambda-list body))
(let ((name (pop cdr-of-form))
(unparse-specializers (method-specializers specializers-or-method))))
(defun parse-method-or-spec (spec &optional (errorp t))
- ;;(declare (values generic-function method method-name))
(let (gf method name temp)
(if (method-p spec)
(setq method spec
and not allowing any parameter specializers to follow~%~
to follow it."
arg))
- ;; When we are at a lambda-list keyword, the parameters don't
- ;; include the lambda-list keyword; the lambda-list does include
- ;; the lambda-list keyword; and no specializers are allowed to
- ;; follow the lambda-list keywords (at least for now).
+ ;; When we are at a lambda-list keyword, the parameters
+ ;; don't include the lambda-list keyword; the lambda-list
+ ;; does include the lambda-list keyword; and no
+ ;; specializers are allowed to follow the lambda-list
+ ;; keywords (at least for now).
(multiple-value-bind (parameters lambda-list)
(parse-specialized-lambda-list (cdr arglist) t)
(values parameters
(eval-when (:load-toplevel :execute)
(setq *boot-state* 'early))
\f
-;;; FIXME: In here there was a #-CMU definition of SYMBOL-MACROLET which used
-;;; %WALKER stuff. That suggests to me that maybe the code walker stuff was
-;;; only used for implementing stuff like that; maybe it's not needed any more?
-;;; Hunt down what it was used for and see.
+;;; FIXME: In here there was a #-CMU definition of SYMBOL-MACROLET
+;;; which used %WALKER stuff. That suggests to me that maybe the code
+;;; walker stuff was only used for implementing stuff like that; maybe
+;;; it's not needed any more? Hunt down what it was used for and see.
(defmacro with-slots (slots instance &body body)
(let ((in (gensym)))
(third instance)
instance)))
(and (symbolp instance)
- `((declare (variable-rebinding ,in ,instance)))))
+ `((declare (%variable-rebinding ,in ,instance)))))
,in
(symbol-macrolet ,(mapcar #'(lambda (slot-entry)
(let ((variable-name
(third instance)
instance)))
(and (symbolp instance)
- `((declare (variable-rebinding ,in ,instance)))))
+ `((declare (%variable-rebinding ,in ,instance)))))
,in
(symbol-macrolet ,(mapcar #'(lambda (slot-entry)
(let ((variable-name (car slot-entry))
;;; Initialize a class metaobject.
;;;
-;;; FIXME: This and most stuff in this file is probably only needed at init
-;;; time.
+;;; FIXME: This and most stuff in this file is probably only needed at
+;;; init time.
(defun !bootstrap-initialize-class
(metaclass-name class name
class-eq-wrapper source direct-supers direct-subclasses cpl wrapper
(set-slot 'source source)
(set-slot 'type (if (eq class (find-class 't))
t
+ ;; FIXME: Could this just be CLASS instead
+ ;; of `(CLASS ,CLASS)? If not, why not?
+ ;; (See also similar expression in
+ ;; SHARED-INITIALIZE :BEFORE (CLASS).)
`(class ,class)))
(set-slot 'class-eq-specializer
(let ((spec (allocate-standard-instance class-eq-wrapper)))
(let* ((*rebound-effective-method-gensyms*
*global-effective-method-gensyms*)
(name (if (early-gf-p generic-function)
- (early-gf-name generic-function)
+ (!early-gf-name generic-function)
(generic-function-name generic-function)))
(arg-info (cons nreq applyp))
(effective-method-lambda (expand-effective-method-function
;;;; the file defcombin.lisp. This is because EQL methods can't appear in the
;;;; bootstrap.
;;;;
-;;;; The defclass for the METHOD-COMBINATION and STANDARD-METHOD-COMBINATION
-;;;; classes has to appear here for this reason. This code must conform to
-;;;; the code in the file defcombin.lisp, look there for more details.
+;;;; The DEFCLASS for the METHOD-COMBINATION and
+;;;; STANDARD-METHOD-COMBINATION classes has to appear here for this
+;;;; reason. This code must conform to the code in the file
+;;;; defcombin.lisp, look there for more details.
(defun compute-effective-method (generic-function combin applicable-methods)
(standard-compute-effective-method generic-function
combin
applicable-methods))
+;;; FIXME: As of sbcl-0.6.10, the bindings of *INVALID-METHOD-ERROR*
+;;; and *METHOD-COMBINATION-ERROR* are never changed, even within the
+;;; dynamic scope of method combination functions.
(defvar *invalid-method-error*
#'(lambda (&rest args)
(declare (ignore args))
of a method combination function (inside the body of~%~
DEFINE-METHOD-COMBINATION or a method on the generic~%~
function COMPUTE-EFFECTIVE-METHOD).")))
-
(defvar *method-combination-error*
#'(lambda (&rest args)
(declare (ignore args))
; (call-next-method))))
(defun invalid-method-error (&rest args)
- (declare (arglist method format-string &rest format-arguments))
(apply *invalid-method-error* args))
(defun method-combination-error (&rest args)
- (declare (arglist format-string &rest format-arguments))
(apply *method-combination-error* args))
;This definition now appears in defcombin.lisp.
;;; classes has been defined, the real definition of LOAD-DEFCLASS is
;;; installed by the file defclass.lisp
(defmacro defclass (name direct-superclasses direct-slots &rest options)
- (declare (indentation 2 4 3 1))
(expand-defclass name direct-superclasses direct-slots options))
(defun expand-defclass (name supers slots options)
+ ;; FIXME: We should probably just ensure that the relevant
+ ;; DEFVAR/DEFPARAMETERs occur before this definition, rather
+ ;; than locally declaring them SPECIAL.
(declare (special *defclass-times* *boot-state* *the-class-structure-class*))
(setq supers (copy-tree supers)
slots (copy-tree slots)
need to get a fresh lisp (reboot) and then load PCL."))
) ; EVAL-WHEN
\f
-;;; This is like fdefinition on the Lispm. If Common Lisp had something like
-;;; function specs I wouldn't need this. On the other hand, I don't like the
-;;; way this really works so maybe function specs aren't really right either?
-;;;
-;;; I also don't understand the real implications of a Lisp-1 on this sort of
-;;; thing. Certainly some of the lossage in all of this is because these
-;;; SPECs name global definitions.
-;;;
-;;; Note that this implementation is set up so that an implementation which
-;;; has a 'real' function spec mechanism can use that instead and in that way
-;;; get rid of setf generic function names.
+;;; comments from CMU CL version of PCL:
+;;; This is like fdefinition on the Lispm. If Common Lisp had
+;;; something like function specs I wouldn't need this. On the other
+;;; hand, I don't like the way this really works so maybe function
+;;; specs aren't really right either?
+;;; I also don't understand the real implications of a Lisp-1 on this
+;;; sort of thing. Certainly some of the lossage in all of this is
+;;; because these SPECs name global definitions.
+;;; Note that this implementation is set up so that an implementation
+;;; which has a 'real' function spec mechanism can use that instead
+;;; and in that way get rid of setf generic function names.
(defmacro parse-gspec (spec
(non-setf-var . non-setf-case)
(setf-var . setf-case))
- (declare (indentation 1 1))
#+setf (declare (ignore setf-var setf-case))
(once-only (spec)
`(cond (#-setf (symbolp ,spec) #+setf t
(push (list class-name symbol) *built-in-wrapper-symbols*)
symbol)))
\f
-(pushnew 'class *variable-declarations*)
-(pushnew 'variable-rebinding *variable-declarations*)
+(pushnew '%class *variable-declarations*)
+(pushnew '%variable-rebinding *variable-declarations*)
(defun variable-class (var env)
(caddr (variable-declaration 'class var env)))
(defvar *name->class->slotd-table* (make-hash-table))
-;;; This is used by combined methods to communicate the next methods to
-;;; the methods they call. This variable is captured by a lexical variable
-;;; of the methods to give it the proper lexical scope.
+;;; This is used by combined methods to communicate the next methods
+;;; to the methods they call. This variable is captured by a lexical
+;;; variable of the methods to give it the proper lexical scope.
(defvar *next-methods* nil)
(defvar *not-an-eql-specializer* '(not-an-eql-specializer))
(defun accessor-miss-function (gf dfun-info)
(ecase (dfun-info-accessor-type dfun-info)
(reader
- #'(lambda (arg)
- (declare (pcl-fast-call))
- (accessor-miss gf nil arg dfun-info)))
+ (lambda (arg)
+ (accessor-miss gf nil arg dfun-info)))
(writer
- #'(lambda (new arg)
- (declare (pcl-fast-call))
- (accessor-miss gf new arg dfun-info)))))
+ (lambda (new arg)
+ (accessor-miss gf new arg dfun-info)))))
#-sb-fluid (declaim (sb-ext:freeze-type dfun-info))
\f
(funcall (get-dfun-constructor 'emit-checking metatypes applyp)
cache
function
- #'(lambda (&rest args)
- (declare (pcl-fast-call))
- (checking-miss generic-function args dfun-info)))
+ (lambda (&rest args)
+ (checking-miss generic-function args dfun-info)))
cache
dfun-info)))))
(values
(funcall (get-dfun-constructor 'emit-caching metatypes applyp)
cache
- #'(lambda (&rest args)
- (declare (pcl-fast-call))
- (caching-miss generic-function args dfun-info)))
+ (lambda (&rest args)
+ (caching-miss generic-function args dfun-info)))
cache
dfun-info))))
(values
(funcall (get-dfun-constructor 'emit-constant-value metatypes)
cache
- #'(lambda (&rest args)
- (declare (pcl-fast-call))
- (constant-value-miss generic-function args dfun-info)))
+ (lambda (&rest args)
+ (constant-value-miss generic-function args dfun-info)))
cache
dfun-info))))
(defun update-dfun (generic-function &optional dfun cache info)
(let* ((early-p (early-gf-p generic-function))
(gf-name (if early-p
- (early-gf-name generic-function)
+ (!early-gf-name generic-function)
(generic-function-name generic-function)))
(ocache (gf-dfun-cache generic-function)))
(set-dfun generic-function dfun cache info)
;;; You can also provide a method object in the place of the method
;;; spec, in which case that method object will be traced.
;;;
-;;; For untrace-method, if an argument is given, that method is untraced.
+;;; For UNTRACE-METHOD, if an argument is given, that method is untraced.
;;; If no argument is given, all traced methods are untraced.
(defclass traced-method (method)
((method :initarg :method)
(symbol-function name))
|#
\f
-;(defun compile-method (spec)
-; (multiple-value-bind (gf method name)
-; (parse-method-or-spec spec)
-; (declare (ignore gf))
-; (compile name (method-function method))
-; (setf (method-function method) (symbol-function name))))
-
-;;; not used in SBCL
-#|
-(defmacro undefmethod (&rest args)
- (declare (arglist name {method-qualifier}* specializers))
- `(undefmethod-1 ',args))
-
-(defun undefmethod-1 (args)
- (multiple-value-bind (gf method)
- (parse-method-or-spec args)
- (when (and gf method)
- (remove-method gf method)
- method)))
-|#
-
-;;; FIXME: Delete these.
-#|
-(pushnew :pcl *features*)
-(pushnew :portable-commonloops *features*)
-(pushnew :pcl-structures *features*)
-|#
-
-;;; FIXME: This was for some unclean bootstrapping thing we don't
-;;; need in SBCL, right? So we can delete it, right?
-;;; #+cmu
-;;; (when (find-package "OLD-PCL")
-;;; (setf (symbol-function (find-symbol "PRINT-OBJECT" :old-pcl))
-;;; (symbol-function 'sb-pcl::print-object)))
-\f
;;;; MAKE-LOAD-FORM
;; Overwrite the old bootstrap non-generic MAKE-LOAD-FORM function with a
(in-package "SB-PCL")
(declaim (declaration
- ;; FIXME: Since none of these are supported in SBCL, the
- ;; declarations using them are just noise now that this is
- ;; not a portable package any more, and could be deleted.
- values ; I use this so that Zwei can remind
- ; me what values a function returns.
- arglist ; Tells me what the pretty arglist
- ; of something (which probably takes
- ; &REST args) is.
- indentation ; Tells ZWEI how to indent things
- ; like DEFCLASS.
- class
- variable-rebinding
- pcl-fast-call
- method-name
- method-lambda-list))
-
-;;; These are age-old functions which CommonLisp cleaned-up away. They
-;;; probably exist in other packages in all CommonLisp
-;;; implementations, but I will leave it to the compiler to optimize
-;;; into calls to them.
+ ;; These three nonstandard declarations seem to be used
+ ;; privately within PCL itself to pass information around,
+ ;; so we can't just delete them.
+ %class
+ %method-name
+ %method-lambda-list
+ ;; This declaration may also be used within PCL to pass
+ ;; information around, I'm not sure. -- WHN 2000-12-30
+ %variable-rebinding))
+
+;;; comment from CMU CL PCL:
+;;; These are age-old functions which CommonLisp cleaned-up away. They
+;;; probably exist in other packages in all CommonLisp
+;;; implementations, but I will leave it to the compiler to optimize
+;;; into calls to them.
;;;
;;; FIXME: MEMQ, ASSQ, and DELQ are already defined in SBCL, and we should
;;; use those. POSQ and NEQ aren't defined in SBCL, and are used too often
(defmacro posq (item list) `(position ,item ,list :test #'eq))
(defmacro neq (x y) `(not (eq ,x ,y)))
-;;; FIXME: Rename these to CONSTANTLY-T, CONSTANTLY-NIL, and CONSTANTLY-0,
-;;; and boost them up to SB-INT.
+;;; FIXME: Rename these to CONSTANTLY-T, CONSTANTLY-NIL, and
+;;; CONSTANTLY-0, and boost them up to SB-INT.
(defun true (&rest ignore) (declare (ignore ignore)) t)
(defun false (&rest ignore) (declare (ignore ignore)) nil)
(defun zero (&rest ignore) (declare (ignore ignore)) 0)
-;;; ONCE-ONLY does the same thing as it does in zetalisp. I should
-;;; have just lifted it from there but I am honest. Not only that but
-;;; this one is written in Common Lisp. I feel a lot like
-;;; bootstrapping, or maybe more like rebuilding Rome.
+;;; comment from original CMU CL PCL: ONCE-ONLY does the same thing as
+;;; it does in zetalisp. I should have just lifted it from there but I
+;;; am honest. Not only that but this one is written in Common Lisp. I
+;;; feel a lot like bootstrapping, or maybe more like rebuilding Rome.
;;;
;;; FIXME: We should only need one ONCE-ONLY in SBCL, and there's one
;;; in SB-INT already. Can we use only one of these in both places?
body)))
) ; EVAL-WHEN
-;;; FIXME: This seems to only be used to get 'METHOD-NAME and
-;;; METHOD-LAMBDA-LIST declarations. They aren't ANSI. Are they important?
(defun get-declaration (name declarations &optional default)
(dolist (d declarations default)
(dolist (form (cdr d))
(defvar *find-class* (make-hash-table :test 'eq))
-(defun make-constant-function (value)
- #'(lambda (object)
- (declare (ignore object))
- value))
-
(defun function-returning-nil (x)
(declare (ignore x))
nil)
(defmethod shared-initialize :before ((class class) slot-names &key name)
(declare (ignore slot-names name))
+ ;; FIXME: Could this just be CLASS instead of `(CLASS ,CLASS)? If not,
+ ;; why not? (See also similar expression in !BOOTSTRAP-INITIALIZE-CLASS.)
(setf (slot-value class 'type) `(class ,class))
(setf (slot-value class 'class-eq-specializer)
(make-instance 'class-eq-specializer :class class)))
(defvar *slot-name-lists-inner* (make-hash-table :test 'equal))
(defvar *slot-name-lists-outer* (make-hash-table :test 'equal))
-;entries in this are lists of (table . pv-offset-list)
+;;; Entries in this are lists of (table . pv-offset-list).
(defvar *pv-key-to-pv-table-table* (make-hash-table :test 'equal))
(defun intern-pv-table (&key slot-name-lists call-list)
(defvar *pv-table-cache-update-info* nil)
-;called by:
-;(method shared-initialize :after (structure-class t))
-;update-slots
(defun update-pv-table-cache-info (class)
(let ((slot-names-for-pv-table-update nil)
(new-icui nil))
(optimize-writer slots parameter gf-name form)))))
(unless (and (consp (cadr form))
(eq 'instance-accessor-parameter (caadr form)))
- (or #||
- (cond ((and (= len 2) (symbolp fname))
- (let ((gf-name (gethash fname *gf-declared-reader-table*)))
- (when gf-name
- (maybe-optimize-reader))))
- ((= len 3)
- (let ((gf-name (gethash fname *gf-declared-writer-table*)))
- (when gf-name
- (maybe-optimize-writer)))))
- ||#
- (when (and (eq *boot-state* 'complete)
- (generic-function-p gf))
- (let ((methods (generic-function-methods gf)))
- (when methods
- (let* ((gf-name (generic-function-name gf))
- (arg-info (gf-arg-info gf))
- (metatypes (arg-info-metatypes arg-info))
- (nreq (length metatypes))
- (applyp (arg-info-applyp arg-info)))
- (when (null applyp)
- (cond ((= nreq 1)
- (when (some #'standard-reader-method-p methods)
- (maybe-optimize-reader)))
- ((and (= nreq 2)
- (consp gf-name)
- (eq (car gf-name) 'setf))
- (when (some #'standard-writer-method-p methods)
- (maybe-optimize-writer))))))))))))))
+ (when (and (eq *boot-state* 'complete)
+ (generic-function-p gf))
+ (let ((methods (generic-function-methods gf)))
+ (when methods
+ (let* ((gf-name (generic-function-name gf))
+ (arg-info (gf-arg-info gf))
+ (metatypes (arg-info-metatypes arg-info))
+ (nreq (length metatypes))
+ (applyp (arg-info-applyp arg-info)))
+ (when (null applyp)
+ (cond ((= nreq 1)
+ (when (some #'standard-reader-method-p methods)
+ (maybe-optimize-reader)))
+ ((and (= nreq 2)
+ (consp gf-name)
+ (eq (car gf-name) 'setf))
+ (when (some #'standard-writer-method-p methods)
+ (maybe-optimize-writer)))))))))))))
(defun optimize-generic-function-call (form
required-parameters
(declare (ignore required-parameters env slots calls))
(or (and (eq (car form) 'make-instance)
(expand-make-instance-form form))
- #||
- (maybe-expand-accessor-form form required-parameters slots env)
- (let* ((fname (car form))
- (len (length form))
- (gf (if (symbolp fname)
- (and (fboundp fname)
- (unencapsulated-fdefinition fname))
- (and (gboundp fname)
- (gdefinition fname))))
- (gf-name (and (fsc-instance-p gf)
- (if (early-gf-p gf)
- (early-gf-name gf)
- (generic-function-name gf)))))
- (when gf-name
- (multiple-value-bind (nreq restp)
- (get-generic-function-info gf)
- (optimize-gf-call slots calls form nreq restp env))))
- ||#
form))
\f
(defun can-optimize-access (form required-parameters env)
(slot-name (eval (caddr form)))) ; known to be constant
(can-optimize-access1 var required-parameters env type slot-name)))
-;;; FIXME: This looks like an internal helper function for CAN-OPTIMIZE-ACCESS,
-;;; and it is used that way, but
-;;; it's also called bare from several places in the code. Perhaps
-;;; the two functions should be renamed fo CAN-OPTIMIZE-ACCESS-FOR-FORM
-;;; and CAN-OPTIMIZE-ACCESS-FOR-VAR. If so, I'd just as soon use keyword
+;;; FIXME: This looks like an internal helper function for
+;;; CAN-OPTIMIZE-ACCESS, and it is used that way, but it's also called
+;;; bare from several places in the code. Perhaps the two functions
+;;; should be renamed CAN-OPTIMIZE-ACCESS-FOR-FORM and
+;;; CAN-OPTIMIZE-ACCESS-FOR-VAR. If so, I'd just as soon use keyword
;;; args instead of optional ones, too.
(defun can-optimize-access1 (var required-parameters env
&optional type slot-name)
(when (and (consp var) (eq 'the (car var)))
- ;; FIXME: We should assert list of length 3 here. Or maybe we should just
- ;; define EXTRACT-THE, replace the whole
+ ;; FIXME: We should assert list of length 3 here. Or maybe we
+ ;; should just define EXTRACT-THE, replace the whole
;; (WHEN ..)
;; form with
;; (AWHEN (EXTRACT-THE VAR)
;; (SETF VAR IT))
- ;; and then use EXTRACT-THE similarly to clean up the other tests against
- ;; 'THE scattered through the PCL code.
+ ;; and then use EXTRACT-THE similarly to clean up the other tests
+ ;; against 'THE scattered through the PCL code.
(setq var (caddr var)))
(when (symbolp var)
- (let* ((rebound? (caddr (variable-declaration 'variable-rebinding
+ (let* ((rebound? (caddr (variable-declaration '%variable-rebinding
var
env)))
(parameter-or-nil (car (memq (or rebound? var)
required-parameters))))
(when parameter-or-nil
- (let* ((class-name (caddr (variable-declaration 'class
+ (let* ((class-name (caddr (variable-declaration '%class
parameter-or-nil
env)))
(class (find-class class-name nil)))
(defun optimize-slot-boundp (slots sparameter form)
(if sparameter
(destructuring-bind
- ;; FIXME: In CMU CL ca. 19991205, this binding list had a fourth
- ;; element in it, NEW-VALUE. It's hard to see how that could possibly
- ;; be right, since SLOT-BOUNDP has no NEW-VALUE. Since it was causing
- ;; a failure in building PCL for SBCL, so I changed it to match the
- ;; definition of SLOT-BOUNDP (and also to match the list used in the
- ;; similar OPTIMIZE-SLOT-VALUE, above). However, I'm weirded out by
- ;; this, since this is old code which has worked for ages to build
- ;; PCL for CMU CL, so it's hard to see why it should need a patch
- ;; like this in order to build PCL for SBCL. I'd like to return to
- ;; this and find a test case which exercises this function both in
- ;; CMU CL, to see whether it's really a previously-unexercised bug or
- ;; whether I've misunderstood something (and, presumably, patched it
- ;; wrong).
+ ;; FIXME: In CMU CL ca. 19991205, this binding list had a
+ ;; fourth element in it, NEW-VALUE. It's hard to see how
+ ;; that could possibly be right, since SLOT-BOUNDP has no
+ ;; NEW-VALUE. Since it was causing a failure in building PCL
+ ;; for SBCL, so I changed it to match the definition of
+ ;; SLOT-BOUNDP (and also to match the list used in the
+ ;; similar OPTIMIZE-SLOT-VALUE, above). However, I'm weirded
+ ;; out by this, since this is old code which has worked for
+ ;; ages to build PCL for CMU CL, so it's hard to see why it
+ ;; should need a patch like this in order to build PCL for
+ ;; SBCL. I'd like to return to this and find a test case
+ ;; which exercises this function both in CMU CL, to see
+ ;; whether it's really a previously-unexercised bug or
+ ;; whether I've misunderstood something (and, presumably,
+ ;; patched it wrong).
(slot-boundp-symbol instance slot-name-form)
form
(declare (ignore slot-boundp-symbol instance))
(optimize-accessor-call slots :write sparameter gf-name new-value))
form))
-;;; The SLOTS argument is an alist, the CAR of each entry is the name of
-;;; a required parameter to the function. The alist is in order, so the
-;;; position of an entry in the alist corresponds to the argument's position
-;;; in the lambda list.
+;;; The SLOTS argument is an alist, the CAR of each entry is the name
+;;; of a required parameter to the function. The alist is in order, so
+;;; the position of an entry in the alist corresponds to the
+;;; argument's position in the lambda list.
(defun optimize-instance-access (slots
read/write
sparameter
(eq (car form) 'the))
(setq form (caddr form)))
(or (and (symbolp form)
- (let* ((rebound? (caddr (variable-declaration 'variable-rebinding
+ (let* ((rebound? (caddr (variable-declaration '%variable-rebinding
form env)))
(parameter-or-nil (car (assq (or rebound? form) slots))))
(when parameter-or-nil
*unspecific-arg*)))
(defun optimize-gf-call (slots calls gf-call-form nreq restp env)
- (unless (eq (car gf-call-form) 'make-instance) ; needs more work
+ (unless (eq (car gf-call-form) 'make-instance) ; XXX needs more work
(let* ((args (cdr gf-call-form))
(all-args-p (eq (car gf-call-form) 'make-instance))
(non-required-args (nthcdr nreq args))
(define-walker-template instance-accessor-parameter)
(defmacro instance-accessor-parameter (x) x)
-;; It is safe for these two functions to be wrong.
-;; They just try to guess what the most likely case will be.
+;;; It is safe for these two functions to be wrong. They just try to
+;;; guess what the most likely case will be.
(defun generate-fast-class-slot-access-p (class-form slot-name-form)
(let ((class (and (constantp class-form) (eval class-form)))
(slot-name (and (constantp slot-name-form) (eval slot-name-form))))
(standard-class-p class)
(not (eq class *the-class-t*)) ; shouldn't happen, though.
(let ((slotd (find-slot-definition class slot-name)))
- (and slotd (skip-optimize-slot-value-by-class-p class slot-name type))))))
+ (and slotd (skip-optimize-slot-value-by-class-p class
+ slot-name
+ type))))))
(defun skip-optimize-slot-value-by-class-p (class slot-name type)
(let ((slotd (find-slot-definition class slot-name)))
;;; This magic function has quite a job to do indeed.
;;;
-;;; The careful reader will recall that <slots> contains all of the optimized
-;;; slot access forms produced by OPTIMIZE-INSTANCE-ACCESS. Each of these is
-;;; a call to either INSTANCE-READ or INSTANCE-WRITE.
+;;; The careful reader will recall that <slots> contains all of the
+;;; optimized slot access forms produced by OPTIMIZE-INSTANCE-ACCESS.
+;;; Each of these is a call to either INSTANCE-READ or INSTANCE-WRITE.
;;;
-;;; At the time these calls were produced, the first argument was specified as
-;;; the symbol .PV-OFFSET.; what we have to do now is convert those pv-offset
-;;; arguments into the actual number that is the correct offset into the pv.
+;;; At the time these calls were produced, the first argument was
+;;; specified as the symbol .PV-OFFSET.; what we have to do now is
+;;; convert those pv-offset arguments into the actual number that is
+;;; the correct offset into the pv.
;;;
-;;; But first, oh but first, we sort <slots> a bit so that for each argument we
-;;; have the slots in alphabetical order. This canonicalizes the PV-TABLE's a
-;;; bit and will hopefully lead to having fewer PV's floating around. Even if
-;;; the gain is only modest, it costs nothing.
+;;; But first, oh but first, we sort <slots> a bit so that for each
+;;; argument we have the slots in alphabetical order. This
+;;; canonicalizes the PV-TABLE's a bit and will hopefully lead to
+;;; having fewer PV's floating around. Even if the gain is only
+;;; modest, it costs nothing.
(defun slot-name-lists-from-slots (slots calls)
(multiple-value-bind (slots calls) (mutate-slots-and-calls slots calls)
(let* ((slot-name-lists
(symbol-or-cons-lessp (car a) (car b))))))))
(defun sort-slots (slots)
- (mapcar #'(lambda (parameter-entry)
- (cons (car parameter-entry)
- (sort (cdr parameter-entry) ;slot entries
- #'symbol-or-cons-lessp
- :key #'car)))
+ (mapcar (lambda (parameter-entry)
+ (cons (car parameter-entry)
+ (sort (cdr parameter-entry) ;slot entries
+ #'symbol-or-cons-lessp
+ :key #'car)))
slots))
(defun sort-calls (calls)
(sort calls #'symbol-or-cons-lessp :key #'car))
\f
-;;; This needs to work in terms of metatypes and also needs to work for
-;;; automatically generated reader and writer functions.
-;;; -- Automatically generated reader and writer functions use this stuff too.
+;;;; This needs to work in terms of metatypes and also needs to work
+;;;; for automatically generated reader and writer functions.
+;;;; Automatically generated reader and writer functions use this
+;;;; stuff too.
(defmacro pv-binding ((required-parameters slot-name-lists pv-table-symbol)
&body body)
slot-vars pv-parameters))
,@body)))
-;This gets used only when the default make-method-lambda is overriden.
+;;; This gets used only when the default MAKE-METHOD-LAMBDA is overridden.
(defmacro pv-env ((pv calls pv-table-symbol pv-parameters)
&rest forms)
`(let* ((.pv-table. ,pv-table-symbol)
;; don't *think* CMU CL had, or SBCL has, VALUES declarations. If
;; SBCL doesn't have 'em, VALUES should probably be removed from
;; this list.
- '(values method-name method-lambda-list
+ '(values %method-name %method-lambda-list
optimize ftype inline notinline))
(defvar *variable-declarations-with-argument*
- '(class
+ '(%class
type))
(defvar *variable-declarations-without-argument*
'(ignore
ignorable special dynamic-extent
- ;; FIXME: Possibly this entire list and variable should go away.
+ ;; FIXME: Possibly this entire list and variable could go away.
;; If not, certainly we should remove all these built-in typenames
;; from the list, and replace them with a test for "is it a type
;; name?" (CLTL1 allowed only built-in type names as declarations,
;; FIXME: This warning, and perhaps the
;; various *VARIABLE-DECLARATIONS-FOO* and/or
;; *NON-VARIABLE-DECLARATIONS* variables,
- ;; should probably go away now that we're not
+ ;; could probably go away now that we're not
;; trying to be portable between different
- ;; CLTL1 hosts the way PCL was.
+ ;; CLTL1 hosts the way PCL was. (Note that to
+ ;; do this right, we need to be able to handle
+ ;; user-defined (DECLAIM (DECLARATION FOO))
+ ;; stuff.)
(warn "The declaration ~S is not understood by ~S.~@
Please put ~S on one of the lists ~S,~%~S, or~%~S.~@
(Assuming it is a variable declaration without argument)."
,@body)))
',initargs))))
-;;; Use arrays and hash tables and the fngen stuff to make this much better. It
-;;; doesn't really matter, though, because a function returned by this will get
-;;; called only when the user explicitly funcalls a result of method-function.
-;;; BUT, this is needed to make early methods work.
+;;; Use arrays and hash tables and the fngen stuff to make this much
+;;; better. It doesn't really matter, though, because a function
+;;; returned by this will get called only when the user explicitly
+;;; funcalls a result of method-function. BUT, this is needed to make
+;;; early methods work.
(defun method-function-from-fast-function (fmf)
(declare (type function fmf))
(let* ((method-function nil) (pv-table nil)
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.9.13"
+"0.6.9.14"
projects / sbcl.git / commitdiff