X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=38aa0635b0103963519fed7c83100493d035bdaf;hb=ba38798a5ca26b90647a1993f348806cb32f2d1b;hp=09ec0ca6d5cc38a7e7902ff46d72ce3a15d3203d;hpb=7c07a6f965c51828d8f452b47e0620d8e6cf2959;p=sbcl.git diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp index 09ec0ca..38aa063 100644 --- a/src/code/primordial-extensions.lisp +++ b/src/code/primordial-extensions.lisp @@ -47,7 +47,8 @@ ;;; 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 @@ -67,7 +68,7 @@ ;;;; DO-related stuff which needs to be visible on the cross-compilation host (eval-when (:compile-toplevel :load-toplevel :execute) - (defun do-do-body (varlist endlist decls-and-code bind step name block) + (defun frob-do-body (varlist endlist decls-and-code bind step name block) (let* ((r-inits nil) ; accumulator for reversed list (r-steps nil) ; accumulator for reversed list (label-1 (gensym)) @@ -128,10 +129,22 @@ ;;; EXIT-FORMS are evaluated as a PROGN, with the result being the ;;; value of the DO. (defmacro do-anonymous (varlist endlist &rest body) - (do-do-body varlist endlist body 'let 'psetq 'do-anonymous (gensym))) + (frob-do-body varlist endlist body 'let 'psetq 'do-anonymous (gensym))) ;;;; miscellany +;;; Lots of code wants to get to the KEYWORD package or the +;;; COMMON-LISP package without a lot of fuss, so we cache them in +;;; variables. TO DO: How much does this actually buy us? It sounds +;;; sensible, but I don't know for sure that it saves space or time.. +;;; -- WHN 19990521 +;;; +;;; (The initialization forms here only matter on the cross-compilation +;;; host; In the target SBCL, these variables are set in cold init.) +(declaim (type package *cl-package* *keyword-package*)) +(defvar *cl-package* (find-package "COMMON-LISP")) +(defvar *keyword-package* (find-package "KEYWORD")) + ;;; Concatenate together the names of some strings and symbols, ;;; producing a symbol in the current package. (eval-when (:compile-toplevel :load-toplevel :execute) @@ -246,7 +259,11 @@ ,@(when doc (list doc)))) (defun %defconstant-eqx-value (symbol expr eqx) (flet ((bummer (explanation) - (error "~@" symbol explanation))) + (error "~@" + symbol + expr + explanation + (symbol-value symbol)))) (cond ((not (boundp symbol)) expr) ((not (constantp symbol))