(in-package "SB!INT")
\f
+;;;; target constants which need to appear as early as possible
+
+;;; an internal tag for marking empty slots, which needs to be defined
+;;; as early as possible because it appears in macroexpansions for
+;;; iteration over hash tables
+;;;
+;;; CMU CL 18b used :EMPTY for this purpose, which was somewhat nasty
+;;; since it's easily accessible to the user, so that e.g.
+;;; (DEFVAR *HT* (MAKE-HASH-TABLE))
+;;; (SETF (GETHASH :EMPTY *HT*) :EMPTY)
+;;; (MAPHASH (LAMBDA (K V) (FORMAT T "~&~S ~S~%" K V)))
+;;; gives no output -- oops!
+;;;
+;;; FIXME: It'd probably be good to use the unbound marker for this.
+;;; However, there might be some gotchas involving assumptions by
+;;; e.g. AREF that they're not going to return the unbound marker,
+;;; 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
+;;; 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
+(defconstant +empty-ht-slot+ '%empty-ht-slot%)
+;;; 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
+;;; now we just don't worry about it. If for some reason it becomes
+;;; worrisome and the magic value needs replacement:
+;;; * The replacement value needs to be LOADable with EQL preserved,
+;;; so that macroexpansion for WITH-HASH-TABLE-ITERATOR will work
+;;; when compiled into a file and loaded back into SBCL.
+;;; (Thus, just uninterning %EMPTY-HT-SLOT% doesn't work.)
+;;; * The replacement value needs to be acceptable to the
+;;; low-level gencgc.lisp hash table scavenging code.
+;;; * The change will break binary compatibility, since comparisons
+;;; against the value used at the time of compilation are wired
+;;; into FASL files.
+;;; -- WHN 20000622
+\f
;;;; DO-related stuff which needs to be visible on the cross-compilation host
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless ,(first endlist) (go ,label-1))
(return-from ,block (progn ,@(rest endlist))))))))))
+;;; This is like DO, except it has no implicit NIL block. Each VAR is
+;;; initialized in parallel to the value of the specified INIT form.
+;;; On subsequent iterations, the VARS are assigned the value of the
+;;; STEP form (if any) in parallel. The TEST is evaluated before each
+;;; evaluation of the body FORMS. When the TEST is true, the
+;;; EXIT-FORMS are evaluated as a PROGN, with the result being the
+;;; value of the DO.
(defmacro do-anonymous (varlist endlist &rest body)
- #!+sb-doc
- "DO-ANONYMOUS ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
- Like DO, but has no implicit NIL block. Each Var is initialized in parallel
- to the value of the specified Init form. On subsequent iterations, the Vars
- are assigned the value of the Step form (if any) in parallel. The Test is
- evaluated before each evaluation of the body Forms. When the Test is true,
- the Exit-Forms are evaluated as a PROGN, with the result being the value
- of the DO."
(do-do-body varlist endlist body 'let 'psetq 'do-anonymous (gensym)))
\f
;;;; miscellany
;;; Concatenate together the names of some strings and symbols,
;;; producing a symbol in the current package.
-(defun symbolicate (&rest things)
- (values (intern (apply #'concatenate
- 'string
- (mapcar #'string things)))))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun symbolicate (&rest things)
+ (values (intern (apply #'concatenate
+ 'string
+ (mapcar #'string things))))))
;;; like SYMBOLICATE, but producing keywords
(defun keywordicate (&rest things)
(let ((*package* *keyword-package*))
(apply #'symbolicate things)))
-;;; Access *PACKAGE* in a way which lets us recover if someone has
+;;; Access *PACKAGE* in a way which lets us recover when someone has
;;; done something silly like (SETF *PACKAGE* :CL-USER). (Such an
-;;; assignment is undefined behavior, so it's sort of reasonable for it
-;;; to cause the system to go totally insane afterwards, but it's
-;;; a fairly easy mistake to make, so let's try to recover gracefully
+;;; assignment is undefined behavior, so it's sort of reasonable for
+;;; it to cause the system to go totally insane afterwards, but it's a
+;;; fairly easy mistake to make, so let's try to recover gracefully
;;; instead.)
(defun sane-package ()
(let ((maybe-package *package*))
;; Then complain.
(error 'simple-type-error
:datum maybe-package
- :expected-type 'package
+ :expected-type '(and package (satisfies package-name))
:format-control
- "~S can't be a ~S:~% ~S has been reset to ~S"
- :format-arguments (list '*package* (type-of maybe-package)
+ "~@<~S can't be a ~A: ~2I~_~S has been reset to ~S.~:>"
+ :format-arguments (list '*package*
+ (if (packagep maybe-package)
+ "deleted package"
+ (type-of maybe-package))
'*package* really-package)))))))
;;; Give names to elements of a numeric sequence.
(if (consp id)
(values (car id) (cdr id))
(values id nil))
- ;; (This could be SYMBOLICATE, except that due to
- ;; bogobootstrapping issues SYMBOLICATE isn't defined yet.)
(push `(defconstant ,(symbolicate prefix root suffix)
,(+ start (* step index))
,@docs)
,expr-tmp))
(error "already bound differently: ~S")))
(t
- (defconstant ,symbol ,expr-tmp ,@(when doc `(,doc)))))))
+ (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
projects / sbcl.git / blobdiff