;; DO-STATIC-FUN
(inst lw lip null-tn (static-fun-offset 'two-arg-+))
(inst li nargs (fixnumize 2))
- (inst move ocfp cfp-tn)
+ (move ocfp cfp-tn)
(inst j lip)
- (inst move cfp-tn csp-tn)
+ (move cfp-tn csp-tn t)
DO-ADD
(inst sra temp2 y n-fixnum-tag-bits)
;; DO-STATIC-FUN
(inst lw lip null-tn (static-fun-offset 'two-arg--))
(inst li nargs (fixnumize 2))
- (inst move ocfp cfp-tn)
+ (move ocfp cfp-tn)
(inst j lip)
- (inst move cfp-tn csp-tn)
+ (move cfp-tn csp-tn t)
DO-SUB
(inst sra temp2 y n-fixnum-tag-bits)
(pseudo-atomic (pa-flag :extra (pad-data-block (+ 1 bignum-digits-offset)))
(inst or res alloc-tn other-pointer-lowtag)
(storew temp res 0 other-pointer-lowtag))
-
- (storew lo res bignum-digits-offset other-pointer-lowtag)
-
- ;; Out of here
(inst b DONE)
- (inst nop)
+ (storew lo res bignum-digits-offset other-pointer-lowtag)
TWO-WORDS
(pseudo-atomic (pa-flag :extra (pad-data-block (+ 2 bignum-digits-offset)))
(storew temp res 0 other-pointer-lowtag))
(storew lo res bignum-digits-offset other-pointer-lowtag)
- (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
-
- ;; Out of here
(inst b DONE)
- (inst nop)
+ (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
DO-STATIC-FUN
(inst lw lip null-tn (static-fun-offset 'two-arg-*))
(inst li nargs (fixnumize 2))
- (inst move ocfp cfp-tn)
+ (move ocfp cfp-tn)
(inst j lip)
- (inst move cfp-tn csp-tn)
+ (move cfp-tn csp-tn t)
DONE)
;; DO-STATIC-FUN
(inst lw lip null-tn (static-fun-offset ',static-fn))
(inst li nargs (fixnumize 2))
- (inst move ocfp cfp-tn)
+ (move ocfp cfp-tn)
(inst j lip)
- (inst move cfp-tn csp-tn)
+ (move cfp-tn csp-tn t)
DO-COMPARE
(inst beq temp DONE)
- (inst move res null-tn)
+ (move res null-tn t)
(load-symbol res t)
DONE)))
;; DO-STATIC-FUN
(inst lw lip null-tn (static-fun-offset 'eql))
(inst li nargs (fixnumize 2))
- (inst move ocfp cfp-tn)
+ (move ocfp cfp-tn)
(inst j lip)
- (inst move cfp-tn csp-tn)
+ (move cfp-tn csp-tn t)
RETURN
(inst bne x y DONE)
- (inst move res null-tn)
+ (move res null-tn t)
RETURN-T
(load-symbol res t)
;; DO-STATIC-FUN
(inst lw lip null-tn (static-fun-offset 'two-arg-=))
(inst li nargs (fixnumize 2))
- (inst move ocfp cfp-tn)
+ (move ocfp cfp-tn)
(inst j lip)
- (inst move cfp-tn csp-tn)
+ (move cfp-tn csp-tn t)
RETURN
(inst bne x y DONE)
- (inst move res null-tn)
+ (move res null-tn t)
(load-symbol res t)
DONE)
;; DO-STATIC-FUN
(inst lw lip null-tn (static-fun-offset 'two-arg-/=))
(inst li nargs (fixnumize 2))
- (inst move ocfp cfp-tn)
+ (move ocfp cfp-tn)
(inst j lip)
- (inst move cfp-tn csp-tn)
+ (move cfp-tn csp-tn t)
RETURN
(inst beq x y DONE)
- (inst move res null-tn)
+ (move res null-tn t)
(load-symbol res t)
DONE)
(inst nop)
DEFAULT-A0-AND-ON
- (inst move a0 null-tn)
- (inst move a1 null-tn)
+ (move a0 null-tn)
+ (move a1 null-tn)
DEFAULT-A2-AND-ON
- (inst move a2 null-tn)
+ (move a2 null-tn)
DEFAULT-A3-AND-ON
- (inst move a3 null-tn)
+ (move a3 null-tn)
DEFAULT-A4-AND-ON
- (inst move a4 null-tn)
+ (move a4 null-tn)
DEFAULT-A5-AND-ON
- (inst move a5 null-tn)
+ (move a5 null-tn)
DONE
;; Clear the stack.
(declare (ignore start count))
(let ((error (generate-error-code nil invalid-unwind-error)))
- (inst beq block zero-tn error))
-
+ (inst beq block zero-tn error)
+ (inst nop))
+
(load-symbol-value cur-uwp *current-unwind-protect-block*)
(loadw target-uwp block unwind-block-current-uwp-slot)
(inst bne cur-uwp target-uwp do-uwp)
(loadw tag catch catch-block-tag-slot)
(inst beq tag target exit)
(inst nop)
- (loadw catch catch catch-block-previous-catch-slot)
(inst b loop)
- (inst nop)
+ (loadw catch catch catch-block-previous-catch-slot)
- exit
+ EXIT
- (move target catch)
(inst j (make-fixup 'unwind :assembly-routine))
- (inst nop))
+ (move target catch t))
(note-next-instruction ,vop :call-site)
(inst j (make-fixup ',name :assembly-routine))
(inst nop)
- (emit-return-pc lra-label)
- (note-this-location ,vop :single-value-return)
(without-scheduling ()
- (move csp-tn ocfp-tn)
+ (emit-return-pc lra-label)
+ (note-this-location ,vop :single-value-return)
+ (inst move csp-tn ocfp-tn)
(inst nop))
(inst compute-code-from-lra code-tn code-tn
lra-label ,temp)
(inst bne temp zero-tn done)
(inst srl result number ndesc)
(inst b done)
- (inst move result zero-tn)
+ (move result zero-tn t)
POSITIVE
;; The result-type assures us that this shift will not overflow.
(test (gen-label)))
(move shift arg)
(inst bgez shift test)
- (move res zero-tn)
+ (move res zero-tn t)
(inst b test)
(inst nor shift shift)
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(store-stack-tn nfp-save cur-nfp))
- (move cfunc function)
(inst jal (make-fixup "call_into_c" :foreign))
- (inst nop)
+ (move cfunc function t)
(when cur-nfp
(load-stack-tn cur-nfp nfp-save)))))
;; gets confused.
(without-scheduling ()
(note-this-location vop :single-value-return)
- (move csp-tn ocfp-tn)
+ (inst move csp-tn ocfp-tn)
(inst nop))
(when lra-label
(inst compute-code-from-lra code-tn code-tn lra-label temp)))
;; If there are no stack results, clear the stack now.
(if (> nvals register-arg-count)
(inst addu temp nargs-tn (fixnumize (- register-arg-count)))
- (move csp-tn ocfp-tn)))
+ (move csp-tn ocfp-tn t)))
;; Do the single value calse.
(do ((i 1 (1+ i))
(move (tn-ref-tn val) null-tn))
(when (> nvals register-arg-count)
(inst b default-stack-vals)
- (move ocfp-tn csp-tn))
+ (move ocfp-tn csp-tn t))
(emit-label regs-defaulted)
((null arg))
(storew (first arg) args i))
(move start args)
- (move count nargs)
(inst b done)
- (inst nop)))
+ (move count nargs t)))
(values))
(bytes-needed-for-non-descriptor-stack-frame))))
(inst addu lip return-pc-temp (- n-word-bytes other-pointer-lowtag))
(inst j lip)
- (move cfp-tn ocfp-temp)
+ (move cfp-tn ocfp-temp t)
(trace-table-entry trace-table-normal)))
\f
'((:load-ocfp
(sc-case ocfp
(any-reg
- (inst move ocfp-pass ocfp))
+ (move ocfp-pass ocfp t))
(control-stack
(inst lw ocfp-pass cfp-tn
(ash (tn-offset ocfp)
(:load-return-pc
(sc-case return-pc
(descriptor-reg
- (inst move return-pc-pass return-pc))
+ (move return-pc-pass return-pc t))
(control-stack
(inst lw return-pc-pass cfp-tn
(ash (tn-offset return-pc)
(:frob-nfp
(store-stack-tn nfp-save cur-nfp))
(:save-fp
- (inst move ocfp-pass cfp-tn))
+ (move ocfp-pass cfp-tn t))
(:load-fp
,(if variable
'(move cfp-tn new-fp)
(do-next-filler)
(return)))
+ (do-next-filler)
(note-this-location vop :call-site)
(inst j entry-point)
- (do-next-filler))
+ (inst nop))
,@(ecase return
(:fixed
(move ocfp ocfp-arg)
(move lra lra-arg)
- ;; Clear the number stack if anything is there.
+ ;; Clear the number stack if anything is there and jump to the
+ ;; assembly-routine that does the bliting.
+ (inst j (make-fixup 'tail-call-variable :assembly-routine))
(let ((cur-nfp (current-nfp-tn vop)))
- (when cur-nfp
+ (if cur-nfp
(inst addu nsp-tn cur-nfp
- (bytes-needed-for-non-descriptor-stack-frame))))
-
- ;; And jump to the assembly-routine that does the bliting.
- (inst j (make-fixup 'tail-call-variable :assembly-routine))
- (inst nop)))
+ (bytes-needed-for-non-descriptor-stack-frame))
+ (inst nop)))))
\f
;;;; Unknown values return:
(move ocfp ocfp-arg)
(move lra lra-arg)
(move vals vals-arg)
- (move nvals nvals-arg)
+
(inst j (make-fixup 'return-multiple :assembly-routine))
- (inst nop))
+ (move nvals nvals-arg t))
(trace-table-entry trace-table-normal)))
;; Everything of interest in registers.
(inst blez count do-regs)
;; Initialize dst to be end of stack.
- (move dst csp-tn)
+ (move dst csp-tn t)
;; Initialize src to be end of args.
(inst addu src cfp-tn nargs-tn)
(move count count-arg)
;; Check to see if there are any arguments.
(inst beq count zero-tn done)
- (move result null-tn)
+ (move result null-tn t)
;; We need to do this atomically.
(pseudo-atomic (pa-flag)
(inst addu lip offset object)
(inst sw value lip (- (* instance-slots-offset n-word-bytes)
instance-pointer-lowtag))
- (unless (location= result value)
- (move result value))))
+ (move result value)))
(define-vop (raw-instance-ref/single)
(:translate %raw-instance-ref/single)
(assemble (*elsewhere*)
(emit-label bogus)
(inst b done)
- (move code null-tn)))))
+ (move code null-tn t)))))
(define-vop (code-from-lra code-from-mumble)
(:translate lra-code-header)
is nil)."
(once-only ((n-dst dst)
(n-src src))
- (if always-emit-code-p
- `(inst move ,n-dst ,n-src)
- `(unless (location= ,n-dst ,n-src)
- (inst move ,n-dst ,n-src)))))
+ `(if (location= ,n-dst ,n-src)
+ (when ,always-emit-code-p
+ (inst nop))
+ (inst move ,n-dst ,n-src))))
(defmacro def-mem-op (op inst shift load)
`(defmacro ,op (object base &optional (offset 0) (lowtag 0))
(inst addu ,lip ,function (- (ash simple-fun-code-offset word-shift)
fun-pointer-lowtag))
(inst j ,lip)
- (move code-tn ,function)))
+ (move code-tn ,function t)))
(defmacro lisp-return (return-pc lip &key (offset 0) (frob-code t))
"Return to RETURN-PC. LIP is an interior-reg temporary."
(- (* (1+ ,offset) n-word-bytes) other-pointer-lowtag))
(inst j ,lip)
,(if frob-code
- `(move code-tn ,return-pc)
+ `(move code-tn ,return-pc t)
'(inst nop))))
((= nvals 1)
(let ((no-values (gen-label)))
(inst beq count zero-tn no-values)
- (move (tn-ref-tn values) null-tn)
+ (move (tn-ref-tn values) null-tn t)
(loadw (tn-ref-tn values) start)
(emit-label no-values)))
(t
(any-reg (move new-start dst))
(control-stack (store-stack-tn new-start dst)))
(inst beq num zero-tn done)
+ (inst nop)
(sc-case new-count
- (any-reg (inst move new-count num))
+ (any-reg (move new-count num))
(control-stack (store-stack-tn new-count num)))
;; Copy stuff on stack.
(inst addu dst dst n-word-bytes)
(emit-label done)
- (inst move csp-tn dst))))
+ (move csp-tn dst))))
;;; This VOP is just to force the TNs used in the cleanup onto the stack.
(inst lw entry-point null-tn (static-fun-offset symbol))
(when cur-nfp
(store-stack-tn nfp-save cur-nfp))
- (inst move ocfp cfp-tn)
+ (move ocfp cfp-tn)
(inst compute-lra-from-code lra code-tn lra-label temp)
(note-this-location vop :call-site)
(inst j entry-point)
- (inst move cfp-tn csp-tn)
+ (move cfp-tn csp-tn t)
(emit-return-pc lra-label)
,(collect ((bindings) (links))
(do ((temp (temp-names) (cdr temp))
;; Is it a fixnum?
(inst and temp value 3)
(inst beq temp zero-tn fixnum)
- (inst move temp value)
+ (move temp value t)
;; If not, is it an other pointer?
(inst and temp value lowtag-mask)
(:temporary (:sc non-descriptor-reg) temp)
(:ignore r-moved-ptrs)
(:generator 1
- (inst move src last-preserved-ptr)
- (inst move dest last-nipped-ptr)
- (inst move temp zero-tn)
+ (move src last-preserved-ptr)
+ (move dest last-nipped-ptr)
+ (move temp zero-tn)
(inst sltu temp src csp-tn)
(inst beq temp zero-tn DONE)
(inst nop) ; not strictly necessary
(inst bne temp zero-tn LOOP)
(inst nop)
DONE
- (inst move csp-tn dest)
+ (move csp-tn dest)
(inst sub src src dest)
(loop for moved = moved-ptrs then (tn-ref-across moved)
while moved
(inst addu src context skip)))
(move count num)
(inst beq num zero-tn done)
- (inst move start csp-tn)
- (inst move dst csp-tn)
+ (move start csp-tn t)
+ (move dst csp-tn)
(inst addu csp-tn count)
LOOP
(inst lw temp src)
;;; 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.2.20"
+"0.9.2.21"
projects / sbcl.git / commitdiff