E.g. compiling and loading
(DECLAIM (OPTIMIZE (SAFETY 3)))
(DEFUN FACTORIAL (X) (GAMMA (1+ X)))
- (DECLAIM (FTYPE (FUNCTION (UNSIGNED-BYTE) FACTORIAL)))
+ (DEFUN GAMMA (X) X)
+ (DECLAIM (FTYPE (FUNCTION (UNSIGNED-BYTE)) FACTORIAL))
(DEFUN FOO (X)
(COND ((> (FACTORIAL X) 1.0E6)
(FORMAT T "too big~%"))
fi
# We don't try to be general about this in this script the way we are
-# in make.sh, since (1) we use our command line args as names of files
-# to recompile, and (2) the idiosyncrasies of SBCL command line
-# argument order dependence, the meaninglessness of duplicate --core
-# arguments, and the SBCL-vs-CMUCL dependence of --core/-core argument
-# syntax make it too messy to try deal with arbitrary SBCL commands.
+# in make.sh, since the idiosyncrasies of SBCL command line argument
+# order dependence, the meaninglessness of duplicate --core arguments,
+# and the SBCL-vs-CMUCL dependence of --core/-core argument syntax
+# make it too messy to try deal with arbitrary SBCL_XC_HOST variants.
# So you have no choice:
export SBCL_XC_HOST='sbcl --noprogrammer'
# Instead of doing the full make-host-2.sh, we (1) use after-xc.core
# to rebuild only obviously-out-of-date Lisp files, then (2) run
# GENESIS.
-sbcl --core output/after-xc.core <<'EOF' || exit 1
+sbcl --core output/after-xc.core --sysinit /dev/null --userinit /dev/null <<'EOF' || exit 1
(load "src/cold/slam.lisp")
EOF
# (This ^ used to be
;; Similarly, other things like FDEFINITION or DOCUMENTATION either
;; aren't ours to mess with or are meaningless to mess with. Thus,
;; we punt.
- #+sb-xc-host (declare (ignore def))
+ #+sb-xc-host (declare (ignore def doc))
#-sb-xc-host
(progn
(when (fboundp name)
;;; still useful in the target interpreter, and in the
;;; cross-compilation host.
(defun sb!c::%defmacro (name definition lambda-list doc)
+ (declare (ignore lambda-list))
(sb!c::%%defmacro name definition doc))
;;; (called by SB!C::%DEFMACRO)
\f
;;;; master sequencer function
-(defun loop-sequencer (indexv indexv-type indexv-user-specified-p
- variable variable-type
- sequence-variable sequence-type
- step-hack default-top
- prep-phrases)
+(defun loop-sequencer (indexv indexv-type
+ variable variable-type
+ sequence-variable sequence-type
+ step-hack default-top
+ prep-phrases)
(let ((endform nil) ; Form (constant or variable) with limit value
(sequencep nil) ; T if sequence arg has been provided
(testfn nil) ; endtest function
(defun loop-for-arithmetic (var val data-type kwd)
(loop-sequencer
- var (loop-check-data-type data-type 'real) t
- nil nil nil nil nil nil
- (loop-collect-prepositional-phrases
- '((:from :upfrom :downfrom) (:to :upto :downto :above :below) (:by))
- nil (list (list kwd val)))))
+ var (loop-check-data-type data-type 'real)
+ nil nil nil nil nil nil
+ (loop-collect-prepositional-phrases
+ '((:from :upfrom :downfrom) (:to :upto :downto :above :below) (:by))
+ nil (list (list kwd val)))))
(defun loop-sequence-elements-path (variable data-type prep-phrases
&key
size-function
sequence-type
element-type)
- (multiple-value-bind (indexv indexv-user-specified-p) (named-variable 'index)
+ (multiple-value-bind (indexv) (named-variable 'index)
(let ((sequencev (named-variable 'sequence)))
(list* nil nil ; dummy bindings and prologue
(loop-sequencer
- indexv 'fixnum indexv-user-specified-p
- variable (or data-type element-type)
- sequencev sequence-type
- `(,fetch-function ,sequencev ,indexv)
- `(,size-function ,sequencev)
- prep-phrases)))))
+ indexv 'fixnum
+ variable (or data-type element-type)
+ sequencev sequence-type
+ `(,fetch-function ,sequencev ,indexv)
+ `(,size-function ,sequencev)
+ prep-phrases)))))
\f
;;;; builtin LOOP iteration paths
(post-steps nil))
(multiple-value-bind (other-var other-p)
(named-variable (if (eq which 'hash-key) 'hash-value 'hash-key))
- ;; @@@@ named-variable returns a second value of T if the name was
- ;; actually specified, so clever code can throw away the gensym'ed up
- ;; variable if it isn't really needed. The following is for those
- ;; implementations in which we cannot put dummy NILs into
- ;; multiple-value-setq variable lists.
+ ;; @@@@ NAMED-VARIABLE returns a second value of T if the name
+ ;; was actually specified, so clever code can throw away the
+ ;; GENSYM'ed-up variable if it isn't really needed. The
+ ;; following is for those implementations in which we cannot put
+ ;; dummy NILs into MULTIPLE-VALUE-SETQ variable lists.
(setq other-p t
dummy-predicate-var (loop-when-it-variable))
(let ((key-var nil)
,body))))
`(sb!c::%define-compiler-macro ',name #',def ',lambda-list ,doc)))))
(defun sb!c::%define-compiler-macro (name definition lambda-list doc)
+ (declare (ignore lambda-list))
(sb!c::%%define-compiler-macro name definition doc))
(defun sb!c::%%define-compiler-macro (name definition doc)
(setf (sb!xc:compiler-macro-function name) definition)
(defun do-arg-count-error (error-kind name arg lambda-list minimum maximum)
(multiple-value-bind (fname sb!debug:*stack-top-hint*)
(find-caller-name-and-frame)
+ (declare (ignorable fname))
(error 'defmacro-ll-arg-count-error
:kind error-kind
:name name
;;; Exactly the same as CONSTRAIN-INTEGER-TYPE, but for float numbers.
(defun constrain-float-type (x y greater or-equal)
(declare (type numeric-type x y))
- (declare (ignorable x y)) ; for CROSS-FLOAT-INFINITY-KLUDGE
+ (declare (ignorable x y greater or-equal)) ; for CROSS-FLOAT-INFINITY-KLUDGE
+
(aver (eql (numeric-type-class x) 'float))
(aver (eql (numeric-type-class y) 'float))
#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
;;; BACKEND-TEMPLATE-NAMES to BACKEND-VOPS, and rename %PRIMITIVE to
;;; VOP or %VOP.. -- WHN 2001-06-11
;;; FIXME: Look at doing this ^, it doesn't look too hard actually.
-(def-ir1-translator %primitive ((&whole form name &rest args) start cont)
-
+(def-ir1-translator %primitive ((name &rest args) start cont)
(unless (symbolp name)
(compiler-error "The primitive name ~S is not a symbol." name))
(unless (constantp slot-name)
(error "~S requires its slot-name argument to be a constant"
'accessor-slot-boundp))
- (let* ((slot-name (eval slot-name))
- (sym (slot-boundp-symbol slot-name)))
+ (let* ((slot-name (eval slot-name)))
`(slot-boundp-normal ,object ',slot-name)))
(defun structure-slot-boundp (object)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.30"
+"0.pre7.31"
projects / sbcl.git / commitdiff