(in-package "SB!IMPL")
-;;; 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"))
-
;;; something not EQ to anything we might legitimately READ
(defparameter *eof-object* (make-symbol "EOF-OBJECT"))
;;; index leaving the loop range)
(def!type index-or-minus-1 () `(integer -1 (,sb!xc:array-dimension-limit)))
+;;; A couple of VM-related types that are currently used only on the
+;;; alpha platform. -- CSR, 2002-06-24
+(def!type unsigned-byte-with-a-bite-out (s bite)
+ (cond ((eq s '*) 'integer)
+ ((and (integerp s) (> s 0))
+ (let ((bound (ash 1 s)))
+ `(integer 0 ,(- bound bite 1))))
+ (t
+ (error "Bad size specified for UNSIGNED-BYTE type specifier: ~S." s))))
+
+;;; Motivated by the mips port. -- CSR, 2002-08-22
+(def!type signed-byte-with-a-bite-out (s bite)
+ (cond ((eq s '*) 'integer)
+ ((and (integerp s) (> s 1))
+ (let ((bound (ash 1 (1- s))))
+ `(integer ,(- bound) ,(- bound bite 1))))
+ (t
+ (error "Bad size specified for SIGNED-BYTE type specifier: ~S." s))))
+
+(def!type load/store-index (scale lowtag min-offset
+ &optional (max-offset min-offset))
+ `(integer ,(- (truncate (+ (ash 1 16)
+ (* min-offset sb!vm:n-word-bytes)
+ (- lowtag))
+ scale))
+ ,(truncate (- (+ (1- (ash 1 16)) lowtag)
+ (* max-offset sb!vm:n-word-bytes))
+ scale)))
+
;;; the default value used for initializing character data. The ANSI
;;; spec says this is arbitrary, so we use the value that falls
;;; through when we just let the low-level consing code initialize
;; at load time (so that we don't need to teach the cross-compiler
;; how to represent and dump non-STANDARD-CHARs like #\NULL)
(defparameter *default-init-char-form* '(code-char 0)))
-(defconstant default-init-char #.*default-init-char-form*)
;;; CHAR-CODE values for ASCII characters which we care about but
;;; which aren't defined in section "2.1.3 Standard Characters" of the
;;; if so, perhaps implement a DEFTRANSFORM or something to stop it.
;;; (or just find a nicer way of expressing characters portably?) --
;;; WHN 19990713
-(defconstant bell-char-code 7)
-(defconstant tab-char-code 9)
-(defconstant form-feed-char-code 12)
-(defconstant return-char-code 13)
-(defconstant escape-char-code 27)
-(defconstant rubout-char-code 127)
+(def!constant bell-char-code 7)
+(def!constant backspace-char-code 8)
+(def!constant tab-char-code 9)
+(def!constant line-feed-char-code 10)
+(def!constant form-feed-char-code 12)
+(def!constant return-char-code 13)
+(def!constant escape-char-code 27)
+(def!constant rubout-char-code 127)
\f
;;;; type-ish predicates
(symbolp (cadr name))
(null (cddr name)))))
+;;; Signal an error unless NAME is a legal function name.
+(defun legal-fun-name-or-type-error (name)
+ (unless (legal-fun-name-p name)
+ (error 'simple-type-error
+ :datum name
+ :expected-type '(or symbol list)
+ :format-control "invalid function name: ~S"
+ :format-arguments (list name))))
+
;;; Given a function name, return the name for the BLOCK which
;;; encloses its body (e.g. in DEFUN, DEFINE-COMPILER-MACRO, or FLET).
(declaim (ftype (function ((or symbol cons)) symbol) fun-name-block-name))
(defmacro aver (expr)
`(unless ,expr
(%failed-aver ,(format nil "~A" expr))))
+
(defun %failed-aver (expr-as-string)
- (error "~@<internal error, failed AVER: ~2I~_~S~:>" expr-as-string))
+ (bug "~@<failed AVER: ~2I~_~S~:>" expr-as-string))
+
+;;; We need a definition of BUG here for the host compiler to be able
+;;; to deal with BUGs in sbcl. This should never affect an end-user,
+;;; who will pick up the definition that signals a CONDITION of
+;;; condition-class BUG; however, this is not defined on the host
+;;; lisp, but for the target. SBCL developers sometimes trigger BUGs
+;;; in their efforts, and it is useful to get the details of the BUG
+;;; rather than an undefined function error. - CSR, 2002-04-12
+#+sb-xc-host
+(defun bug (format-control &rest format-arguments)
+ (error 'simple-error
+ :format-control "~@< ~? ~:@_~?~:>"
+ :format-arguments `(,format-control
+ ,format-arguments
+ "~@<If you see this and are an SBCL ~
+developer, then it is probable that you have made a change to the ~
+system that has broken the ability for SBCL to compile, usually by ~
+removing an assumed invariant of the system, but sometimes by making ~
+an averrance that is violated (check your code!). If you are a user, ~
+please submit a bug report to the developers' mailing list, details of ~
+which can be found at <http://sbcl.sourceforge.net/>.~:@>"
+ ())))
+
(defmacro enforce-type (value type)
(once-only ((value value))
`(unless (typep ,value ',type)
(%failed-enforce-type ,value ',type))))
+
(defun %failed-enforce-type (value type)
- (error 'simple-type-error
+ (error 'simple-type-error ; maybe should be TYPE-BUG, subclass of BUG?
:value value
:expected-type type
:format-string "~@<~S ~_is not a ~_~S~:>"
projects / sbcl.git / blobdiff