(:res quo any-reg nl2-offset)
(:res rem any-reg nl0-offset))
- (assert (location= rem dividend))
+ (aver (location= rem dividend))
(let ((error (generate-error-code nil division-by-zero-error
dividend divisor)))
(inst cmpwi divisor 0)
(:res quo any-reg nl2-offset)
(:res rem any-reg nl0-offset))
- (assert (location= rem dividend))
+ (aver (location= rem dividend))
(let ((error (generate-error-code nil division-by-zero-error
dividend divisor)))
(inst cmpwi divisor 0)
(%primitive code-instructions code))))
(ecase kind
(:jmp-hint
- (assert (zerop (ldb (byte 2 0) value)))
+ (aver (zerop (ldb (byte 2 0) value)))
#+nil
(setf (sap-ref-16 sap offset)
(logior (sap-ref-16 sap offset)
(logand inst #xffffc000)))
(:load-short
(let ((low-bits (ldb (byte 11 0) value)))
- (assert (<= 0 low-bits (1- (ash 1 4))))
+ (aver (<= 0 low-bits (1- (ash 1 4))))
(logior (ash low-bits 17)
(logand inst #xffe0ffff))))
(:hi
(logand inst #xffe00000)))
(:branch
(let ((bits (ldb (byte 9 2) value)))
- (assert (zerop (ldb (byte 2 0) value)))
+ (aver (zerop (ldb (byte 2 0) value)))
(logior (ash bits 3)
(logand inst #xffe0e002)))))))))
\f
(%primitive sb!c::code-instructions code))))
(ecase kind
(:jump
- (assert (zerop (ash value -28)))
+ (aver (zerop (ash value -28)))
(setf (ldb (byte 26 0) (sap-ref-32 sap offset))
(ash value -2)))
(:lui
(t
(storew null-tn ptr
cons-cdr-slot list-pointer-lowtag)))
- (assert (null (tn-ref-across things)))
+ (aver (null (tn-ref-across things)))
(move res result))))))))
(define-vop (list list-or-list*)
(move ocfp-tn csp-tn)
(let ((defaults (defaults)))
- (assert defaults)
+ (aver defaults)
(assemble (*elsewhere*)
(emit-label default-stack-vals)
(do ((remaining defaults (cdr remaining)))
;;; passed as a more arg, but there is no new-FP, since the arguments
;;; have been set up in the current frame.
(defmacro define-full-call (name named return variable)
- (assert (not (and variable (eq return :tail))))
+ (aver (not (and variable (eq return :tail))))
`(define-vop (,name
,@(when (eq return :unknown)
'(unknown-values-receiver)))
(zero zero-offset)
(null null-offset)
(t
- (assert (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
+ (aver (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
(tn-offset tn))))
(defun fp-reg-tn-encoding (tn)
(moves)))
(defun static-fun-template-vop (num-args num-results)
- (assert (and (<= num-args register-arg-count)
+ (unless (and (<= num-args register-arg-count)
(<= num-results register-arg-count))
- (num-args num-results)
- "Either too many args (~W) or too many results (~W). Max = ~W"
- num-args num-results register-arg-count)
+ (error "either too many args (~W) or too many results (~W); max = ~W"
+ num-args num-results register-arg-count))
(let ((num-temps (max num-args num-results)))
(collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
(dotimes (i num-results)
(define-alien-type-method (values :result-tn) (type)
(let ((values (alien-values-type-values type)))
(when values
- (assert (null (cdr values)))
+ (aver (null (cdr values)))
(invoke-alien-type-method :result-tn (car values)))))
(defun make-arg-tns (type)
(inst compute-code-from-lra code-tn lra-label temp code-tn)
(let ((defaults (defaults)))
- (assert defaults)
+ (aver defaults)
(assemble (*elsewhere*)
(trace-table-entry trace-table-call-site)
DEFAULT-STACK-VALS
;;; the current frame.
;;;
(macrolet ((define-full-call (name named return variable)
- (assert (not (and variable (eq return :tail))))
+ (aver (not (and variable (eq return :tail))))
`(define-vop (,name
,@(when (eq return :unknown)
'(unknown-values-receiver)))
(null null-offset)
(zero zero-offset)
(t
- (assert (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
+ (aver (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
(tn-offset tn))))
(defun fp-reg-tn-encoding (tn)
(declare (type (or fixup (signed-byte 14))))
(cond ((fixup-p disp)
(note-fixup segment :load disp)
- (assert (or (null (fixup-offset disp)) (zerop (fixup-offset disp))))
+ (aver (or (null (fixup-offset disp)) (zerop (fixup-offset disp))))
0)
(t
(dpb (ldb (byte 13 0) disp)
(declare (type (or fixup (signed-byte 5)) disp))
(cond ((fixup-p disp)
(note-fixup segment :load-short disp)
- (assert (or (null (fixup-offset disp)) (zerop (fixup-offset disp))))
+ (aver (or (null (fixup-offset disp)) (zerop (fixup-offset disp))))
0)
(t
(dpb (ldb (byte 4 0) disp)
(declare (type (or fixup (signed-byte 21) (unsigned-byte 21)) value))
(cond ((fixup-p value)
(note-fixup segment :hi value)
- (assert (or (null (fixup-offset value)) (zerop (fixup-offset value))))
+ (aver (or (null (fixup-offset value)) (zerop (fixup-offset value))))
0)
(t
(logior (ash (ldb (byte 5 2) value) 16)
(declare (type (or fixup (signed-byte 17)) disp))
(cond ((fixup-p disp)
(note-fixup segment :branch disp)
- (assert (or (null (fixup-offset disp)) (zerop (fixup-offset disp))))
+ (aver (or (null (fixup-offset disp)) (zerop (fixup-offset disp))))
(values 0 0 0))
(t
(values (ldb (byte 5 11) disp)
(emit-back-patch segment 4
#'(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
- (assert (<= (- (ash 1 16)) disp (1- (ash 1 16))))
+ (aver (<= (- (ash 1 16)) disp (1- (ash 1 16))))
(multiple-value-bind
(w1 w2 w)
(decompose-branch-disp segment disp)
(emit-back-patch segment 4
#'(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
- (assert (<= (- (ash 1 11)) disp (1- (ash 1 11))))
+ (aver (<= (- (ash 1 11)) disp (1- (ash 1 11))))
(let ((w1 (logior (ash (ldb (byte 10 0) disp) 1)
(ldb (byte 1 10) disp)))
(w (ldb (byte 1 11) disp)))
(result-encoding double-p)
(fp-reg-tn-encoding result)
(when side
- (assert double-p)
+ (aver double-p)
(setf double-p nil))
(emit-fp-load/store segment (if double-p #x0B #x09) (reg-tn-encoding base)
(reg-tn-encoding index) 0 (if scale 1 0) 0 0 0
(value-encoding double-p)
(fp-reg-tn-encoding value)
(when side
- (assert double-p)
+ (aver double-p)
(setf double-p nil))
(emit-fp-load/store segment (if double-p #x0B #x09) (reg-tn-encoding base)
(reg-tn-encoding index) 0 (if scale 1 0) 0 0 1
(result-encoding double-p)
(fp-reg-tn-encoding result)
(when side
- (assert double-p)
+ (aver double-p)
(setf double-p nil))
(emit-fp-load/store segment (if double-p #x0B #x09) (reg-tn-encoding base)
(short-disp-encoding segment disp) 0
(value-encoding double-p)
(fp-reg-tn-encoding value)
(when side
- (assert double-p)
+ (aver double-p)
(setf double-p nil))
(emit-fp-load/store segment (if double-p #x0B #x09) (reg-tn-encoding base)
(short-disp-encoding segment disp) 0
(multiple-value-bind
(to-encoding to-double-p)
(fp-reg-tn-encoding to)
- (assert (eq from-double-p to-double-p))
+ (aver (eq from-double-p to-double-p))
(emit-fp-class-0-inst segment #x0C from-encoding 0
(+ 2 (or (position op funops)
(error "Bogus FUNOP: ~S" op)))
(multiple-value-bind
(r2-encoding r2-double-p)
(fp-reg-tn-encoding r2)
- (assert (eq r1-double-p r2-double-p))
+ (aver (eq r1-double-p r2-double-p))
(emit-fp-class-0-inst segment #x0C r1-encoding r2-encoding 0
(if r1-double-p 1 0) 2 0 0 cond)))))
(multiple-value-bind
(r2-encoding r2-double-p)
(fp-reg-tn-encoding r2)
- (assert (eq r1-double-p r2-double-p))
+ (aver (eq r1-double-p r2-double-p))
(multiple-value-bind
(result-encoding result-double-p)
(fp-reg-tn-encoding result)
- (assert (eq r1-double-p result-double-p))
+ (aver (eq r1-double-p result-double-p))
(emit-fp-class-0-inst segment #x0C r1-encoding r2-encoding
(or (position op fbinops)
(error "Bogus FBINOP: ~S" op))
(moves)))
(defun static-fun-template-vop (num-args num-results)
- (assert (and (<= num-args register-arg-count)
+ (unless (and (<= num-args register-arg-count)
(<= num-results register-arg-count))
- (num-args num-results)
- "Either too many args (~D) or too many results (~D). Max = ~D"
- num-args num-results register-arg-count)
+ (error "either too many args (~W) or too many results (~W); max = ~W"
+ num-args num-results register-arg-count))
(let ((num-temps (max num-args num-results)))
(collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
(dotimes (i num-results)
(t
(storew null-tn ptr
cons-cdr-slot list-pointer-lowtag)))
- (assert (null (tn-ref-across things)))
+ (aver (null (tn-ref-across things)))
(move result res))))))))
(define-vop (list list-or-list*)
(move csp-tn ocfp-tn)
(let ((defaults (defaults)))
- (assert defaults)
+ (aver defaults)
(assemble (*elsewhere*)
(emit-label default-stack-vals)
(do ((remaining defaults (cdr remaining)))
;;; the current frame.
;;;
(defmacro define-full-call (name named return variable)
- (assert (not (and variable (eq return :tail))))
+ (aver (not (and variable (eq return :tail))))
`(define-vop (,name
,@(when (eq return :unknown)
'(unknown-values-receiver)))
&body body)
"Do stuff to allocate an other-pointer object of fixed Size with a single
word header having the specified Type-Code. The result is placed in
- Result-TN, Flag-Tn must be wired to NL3-OFFSET, and Temp-TN is a non-
+ Result-TN, Flag-Tn must be wired to NL4-OFFSET, and Temp-TN is a non-
descriptor temp (which may be randomly used by the body.) The body is
placed inside the PSEUDO-ATOMIC, and presumably initializes the object."
`(pseudo-atomic (,flag-tn :extra (pad-data-block ,size))
(moves)))
(defun static-fun-template-vop (num-args num-results)
- (assert (and (<= num-args register-arg-count)
+ (unless (and (<= num-args register-arg-count)
(<= num-results register-arg-count))
- (num-args num-results)
- "Either too many args (~D) or too many results (~D). Max = ~D"
- num-args num-results register-arg-count)
+ (error "either too many args (~W) or too many results (~W); max = ~W"
+ num-args num-results register-arg-count))
(let ((num-temps (max num-args num-results)))
(collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
(dotimes (i num-results)
#!+darwin
(deftransform %alien-funcall ((function type &rest args))
- (assert (sb!c::constant-lvar-p type))
+ (aver (sb!c::constant-lvar-p type))
(let* ((type (sb!c::lvar-value type))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))
- (assert (= (length arg-types) (length args)))
+ (aver (= (length arg-types) (length args)))
;; We need to do something special for 64-bit integer arguments
;; and results.
(if (or (some #'(lambda (type)
;;; more arg, but there is no new-FP, since the arguments have been set up in
;;; the current frame.
(defmacro define-full-call (name named return variable)
- (assert (not (and variable (eq return :tail))))
+ (aver (not (and variable (eq return :tail))))
`(define-vop (,name
,@(when (eq return :unknown)
'(unknown-values-receiver)))
(moves)))
(defun static-fun-template-vop (num-args num-results)
- (assert (and (<= num-args register-arg-count)
+ (unless (and (<= num-args register-arg-count)
(<= num-results register-arg-count))
- (num-args num-results)
- "Either too many args (~W) or too many results (~W). Max = ~W"
- num-args num-results register-arg-count)
+ (error "either too many args (~W) or too many results (~W); max = ~W"
+ num-args num-results register-arg-count))
(let ((num-temps (max num-args num-results)))
(collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
(dotimes (i num-results)
(:generator 1
(let ((offset
(- (* (+ index vector-data-offset) n-word-bytes) other-pointer-lowtag)))
- (assert (typep offset '(signed-byte 16)))
+ (aver (typep offset '(signed-byte 16)))
(inst lwz count count-vector offset)
(inst addi count count 1)
(inst stw count count-vector offset))))
(make-result-state))))))
(deftransform %alien-funcall ((function type &rest args))
- (assert (sb!c::constant-lvar-p type))
+ (aver (sb!c::constant-lvar-p type))
(let* ((type (sb!c::lvar-value type))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))
- (assert (= (length arg-types) (length args)))
+ (aver (= (length arg-types) (length args)))
;; We need to do something special for the following argument
;; types: single-float, double-float, and 64-bit integers. For
;; results, we need something special for 64-bit integer results.
;;; more arg, but there is no new-FP, since the arguments have been set up in
;;; the current frame.
(defmacro define-full-call (name named return variable)
- (assert (not (and variable (eq return :tail))))
+ (aver (not (and variable (eq return :tail))))
`(define-vop (,name
,@(when (eq return :unknown)
'(unknown-values-receiver)))
(error "~S isn't a floating-point register." tn))
(let ((offset (tn-offset tn)))
(cond ((> offset 31)
- (assert (member :sparc-v9 *backend-subfeatures*))
+ (aver (member :sparc-v9 *backend-subfeatures*))
;; No single register encoding greater than reg 31.
- (assert (zerop (mod offset 2)))
+ (aver (zerop (mod offset 2)))
;; Upper bit of the register number is encoded in the low bit.
(1+ (- offset 32)))
(t
(+ (tn-offset loc) 32))
(double-reg
(let ((offset (tn-offset loc)))
- (assert (zerop (mod offset 2)))
+ (aver (zerop (mod offset 2)))
(values (+ offset 32) 2)))
#!+long-float
(long-reg
(let ((offset (tn-offset loc)))
- (assert (zerop (mod offset 4)))
+ (aver (zerop (mod offset 4)))
(values (+ offset 32) 4)))))
(control-registers
96)
(defun emit-relative-branch-integer (segment a op2 cond-or-target target &optional (cc :icc) (pred :pt))
(declare (type integer-condition-register cc))
- (assert (member :sparc-v9 *backend-subfeatures*))
+ (aver (member :sparc-v9 *backend-subfeatures*))
(emit-back-patch segment 4
(lambda (segment posn)
(unless target
offset)))))
(defun emit-relative-branch-fp (segment a op2 cond-or-target target &optional (cc :fcc0) (pred :pt))
- (assert (member :sparc-v9 *backend-subfeatures*))
+ (aver (member :sparc-v9 *backend-subfeatures*))
(emit-back-patch segment 4
(lambda (segment posn)
(unless target
(integer-condition cc)
target))
(t
- (assert (null cc))
+ (aver (null cc))
(emit-format-3-immed segment #b10 (branch-condition condition)
#b111010 0 1 target)))))
(destructuring-bind (&optional fcc pred) args
(emit-relative-branch-fp segment 0 #b101 condition target (or fcc :fcc0) (or pred :pt))))
(t
- (assert (null args))
+ (aver (null args))
(emit-relative-branch segment 0 #b110 condition target t)))))
(define-instruction fbp (segment condition target &optional fcc pred)
(moves)))
(defun static-fun-template-vop (num-args num-results)
- (assert (and (<= num-args register-arg-count)
+ (unless (and (<= num-args register-arg-count)
(<= num-results register-arg-count))
- (num-args num-results)
- "Either too many args (~W) or too many results (~W). Max = ~W"
- num-args num-results register-arg-count)
+ (error "either too many args (~W) or too many results (~W); max = ~W"
+ num-args num-results register-arg-count))
(let ((num-temps (max num-args num-results)))
(collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
(dotimes (i num-results)
(let ((offset
(- (* (+ index vector-data-offset) n-word-bytes)
other-pointer-lowtag)))
- (assert (typep offset '(signed-byte 13)))
+ (aver (typep offset '(signed-byte 13)))
(inst ld count count-vector offset)
(inst add count 1)
(inst st count count-vector offset))))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.0.17"
+"0.9.0.18"
projects / sbcl.git / commitdiff