;;; and there's also the noted-below problem that the C-level code
;;; contains implicit assumptions about this marker.
;;;
-;;; KLUDGE: Note that as of version 0.6.6 there's a dependence in the
+;;; KLUDGE: Note that as of version 0.pre7 there's a dependence in the
;;; gencgc.c code on this value being a symbol. (This is only one of
-;;; many nasty dependencies between that code and this, alas.)
-;;; -- WHN 2001-02-28
+;;; several nasty dependencies between that code and this, alas.)
+;;; -- WHN 2001-08-17
;;;
;;; FIXME: We end up doing two DEFCONSTANT forms because (1) LispWorks
;;; needs EVAL-WHEN wrapped around DEFCONSTANT, and (2) SBCL's
;;; interpreter to go away, which is waiting for sbcl-0.7.x..
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +empty-ht-slot+ '%empty-ht-slot%))
-(defconstant +empty-ht-slot+ '#.+empty-ht-slot+) ; egads.. See FIXME above.
+;;; We shouldn't need this mess now that EVAL-WHEN works.
+#+nil (defconstant +empty-ht-slot+ '#.+empty-ht-slot+) ; egads.. See FIXME above.
;;; KLUDGE: Using a private symbol still leaves us vulnerable to users
;;; getting nonconforming behavior by messing around with
;;; DO-ALL-SYMBOLS. That seems like a fairly obscure problem, so for
(type-of maybe-package))
'*package* really-package)))))))
+;;; Access *DEFAULT-PATHNAME-DEFAULTS*, issuing a warning if its value
+;;; is silly. (Unlike the vaguely-analogous SANE-PACKAGE, we don't
+;;; actually need to reset the variable when it's silly, since even
+;;; crazy values of *DEFAULT-PATHNAME-DEFAULTS* don't leave the system
+;;; in a state where it's hard to recover interactively.)
+(defun sane-default-pathname-defaults ()
+ (let* ((dfd *default-pathname-defaults*)
+ (dfd-dir (pathname-directory dfd)))
+ ;; It's generally not good to use a relative pathname for
+ ;; *DEFAULT-PATHNAME-DEFAULTS*, since relative pathnames
+ ;; are defined by merging into a default pathname (which is,
+ ;; by default, *DEFAULT-PATHNAME-DEFAULTS*).
+ (when (and (consp dfd-dir)
+ (eql (first dfd-dir) :relative))
+ (warn
+ "~@<~S is a relative pathname. (But we'll try using it anyway.)~@:>"
+ '*default-pathname-defaults*))
+ dfd))
+
;;; Give names to elements of a numeric sequence.
(defmacro defenum ((&key (prefix "") (suffix "") (start 0) (step 1))
&rest identifiers)
;;; structure for each object file which contains code referring to
;;; the value, plus perhaps one more copy bound to the SYMBOL-VALUE of
;;; the constant. If you don't want that to happen, you should
-;;; probably use DEFPARAMETER instead.
+;;; probably use DEFPARAMETER instead; or if you truly desperately
+;;; need to avoid runtime indirection through a symbol, you might be
+;;; able to do something with LOAD-TIME-VALUE or MAKE-LOAD-FORM.
(defmacro defconstant-eqx (symbol expr eqx &optional doc)
- (let ((expr-tmp (gensym "EXPR-TMP-")))
- `(progn
- ;; When we're building the cross-compiler, and in most
- ;; situations even when we're running the cross-compiler,
- ;; all we need is a nice portable definition in terms of the
- ;; ANSI Common Lisp operations.
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (let ((,expr-tmp ,expr))
- (cond ((boundp ',symbol)
- (unless (and (constantp ',symbol)
- (funcall ,eqx
- (symbol-value ',symbol)
- ,expr-tmp))
- (error "already bound differently: ~S")))
- (t
- (defconstant ,symbol
- ;; KLUDGE: This is a very ugly hack, to be able to
- ;; build SBCL with CMU CL (2.4.19), because there
- ;; seems to be some confusion in CMU CL about
- ;; ,EXPR-TEMP at EVAL-WHEN time ... -- MNA 2000-02-23
- #-cmu ,expr-tmp
- #+cmu ,expr
- ,@(when doc `(,doc)))))))
- ;; The #+SB-XC :COMPILE-TOPLEVEL situation is special, since we
- ;; want to define the symbol not just in the cross-compilation
- ;; host Lisp (which was handled above) but also in the
- ;; cross-compiler (which we will handle now).
- ;;
- ;; KLUDGE: It would probably be possible to do this fairly
- ;; cleanly, in a way parallel to the code above, if we had
- ;; SB!XC:FOO versions of all the primitives CL:FOO used above
- ;; (e.g. SB!XC:BOUNDP, SB!XC:SYMBOL-VALUE, and
- ;; SB!XC:DEFCONSTANT), and took care to call them. But right
- ;; now we just hack around in the guts of the cross-compiler
- ;; instead. -- WHN 2000-11-03
- #+sb-xc
- (eval-when (:compile-toplevel)
- (let ((,expr-tmp ,symbol))
- (unless (and (eql (info :variable :kind ',symbol) :constant)
- (funcall ,eqx
- (info :variable :constant-value ',symbol)
- ,expr-tmp))
- (sb!c::%defconstant ',symbol ,expr-tmp ,doc)))))))
+ `(defconstant ,symbol
+ (%defconstant-eqx-value ',symbol ,expr ,eqx)
+ ,@(when doc (list doc))))
+(defun %defconstant-eqx-value (symbol expr eqx)
+ (flet ((bummer (explanation)
+ (error "~@<bad DEFCONSTANT-EQX ~S ~2I~_~S: ~2I~_~A ~S~:>"
+ symbol
+ expr
+ explanation
+ (symbol-value symbol))))
+ (cond ((not (boundp symbol))
+ expr)
+ ((not (constantp symbol))
+ (bummer "already bound as a non-constant"))
+ ((not (funcall eqx (symbol-value symbol) expr))
+ (bummer "already bound as a different constant value"))
+ (t
+ (symbol-value symbol)))))