X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fearly-extensions.lisp;h=68f5e25c3c5477ec137cf501e6b9145b824fc16c;hb=b1de52969f584c63d43fb35da4a8a6a4e0e619f0;hp=e5de12a2813e8d154b9f8495bf468be71778b824;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index e5de12a..68f5e25 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -18,8 +18,22 @@
 
 (in-package "SB!EXT")
 
-(file-comment
-  "$Header$")
+;;; something not EQ to anything we might legitimately READ
+(defparameter *eof-object* (make-symbol "EOF-OBJECT"))
+
+;;; a type used for indexing into arrays, and for related quantities
+;;; like lengths of lists
+;;;
+;;; It's intentionally limited to one less than the
+;;; ARRAY-DIMENSION-LIMIT for efficiency reasons, because in SBCL
+;;; ARRAY-DIMENSION-LIMIT is MOST-POSITIVE-FIXNUM, and staying below
+;;; that lets the system know it can increment a value of this type
+;;; without having to worry about using a bignum to represent the
+;;; result.
+;;;
+;;; (It should be safe to use ARRAY-DIMENSION-LIMIT as an exclusive
+;;; bound because ANSI specifies it as an exclusive bound.)
+(def!type index () `(integer 0 (,sb!xc:array-dimension-limit)))
 
 ;;; the default value used for initializing character data. The ANSI
 ;;; spec says this is arbitrary. CMU CL used #\NULL, which we avoid
@@ -44,20 +58,6 @@
 (defconstant escape-char-code 27)
 (defconstant rubout-char-code 127)
 
-;;; Concatenate together the names of some strings and symbols,
-;;; producing a symbol in the current package.
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (declaim (ftype (function (&rest (or string symbol)) symbol) symbolicate))
-  (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)))
-
 ;;;; miscellaneous iteration extensions
 
 (defmacro dovector ((elt vector &optional result) &rest forms)
@@ -216,6 +216,7 @@
       (let ((fun-name (symbolicate name "-CACHE-CLEAR")))
 	(forms
 	 `(defun ,fun-name ()
+	    (/show0 ,(concatenate 'string "entering " (string fun-name)))
 	    (do ((,n-index ,(- total-size entry-size) (- ,n-index ,entry-size))
 		 (,n-cache ,var-name))
 		((minusp ,n-index))
@@ -228,6 +229,7 @@
 			    `(setf (svref ,n-cache ,i) ,val))
 			(values-indices)
 			default-values))
+	    (/show0 ,(concatenate 'string "leaving " (string fun-name)))
 	    (values)))
 	(forms `(,fun-name)))
 
@@ -335,11 +337,38 @@
 	 (error "not legal as a function name: ~S" function-name))))
 
 ;;; Is X a (possibly-improper) list of at least N elements?
+(declaim (ftype (function (t index)) list-of-length-at-least-p))
 (defun list-of-length-at-least-p (x n)
-  (declare (type (and unsigned-byte fixnum) n))
   (or (zerop n) ; since anything can be considered an improper list of length 0
       (and (consp x)
 	   (list-of-length-at-least-p (cdr x) (1- n)))))
+
+;;; Return a list of N gensyms. (This is a common suboperation in
+;;; macros and other code-manipulating code.)
+(declaim (ftype (function (index) list) make-gensym-list))
+(defun make-gensym-list (n)
+  (loop repeat n collect (gensym)))
+
+;;; ANSI guarantees that some symbols are self-evaluating. 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)
+  (declare (type symbol symbol))
+  (cond ((eq symbol t)
+	 (error "Veritas aeterna. (can't change T)"))
+	((eq symbol nil)
+	 (error "Nihil ex nihil. (can't change NIL)"))
+	((keywordp symbol)
+	 (error "Keyword values can't be changed."))
+	;; (Just because a value is CONSTANTP is not a good enough
+	;; reason to complain here, because we want DEFCONSTANT to
+	;; be able to use this function, and it's legal to DEFCONSTANT
+	;; a constant as long as the new value is EQL to the old
+	;; value.)
+	))
 
 #|
 ;;; REMOVEME when done testing byte cross-compiler