X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fvalues.lisp;h=a04921b7040006fb7cae2e81681267a486aee992;hb=74cf7a4d01664fbf72a662ba093ad67ca243b524;hp=ecee7d0d26183f4ebd9232948486f35671888bdd;hpb=f1acc17f83cdfa9454a53bd0ee9bd0e9b9482817;p=sbcl.git diff --git a/src/compiler/mips/values.lisp b/src/compiler/mips/values.lisp index ecee7d0..a04921b 100644 --- a/src/compiler/mips/values.lisp +++ b/src/compiler/mips/values.lisp @@ -16,6 +16,26 @@ (:generator 1 (move csp-tn ptr))) +(define-vop (%%pop-dx) + (:args (ptr :scs (any-reg))) + (:ignore ptr) + (:generator 1 + (bug "VOP %%POP-DX is not implemented."))) + +(define-vop (%%nip-dx) + (:args (last-nipped-ptr :scs (any-reg) :target dest) + (last-preserved-ptr :scs (any-reg) :target src) + (moved-ptrs :scs (any-reg) :more t)) + (:results (r-moved-ptrs :scs (any-reg) :more t)) + (:temporary (:sc any-reg) src) + (:temporary (:sc any-reg) dest) + (:temporary (:sc non-descriptor-reg) temp) + (:ignore r-moved-ptrs + last-nipped-ptr last-preserved-ptr moved-ptrs + src dest temp) + (:generator 1 + (bug "VOP %%NIP-DX is not implemented."))) + (define-vop (%%nip-values) (:args (last-nipped-ptr :scs (any-reg) :target dest) (last-preserved-ptr :scs (any-reg) :target src) @@ -26,11 +46,10 @@ (: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) (inst sltu temp src csp-tn) - (inst beq temp zero-tn DONE) + (inst beq temp DONE) (inst nop) ; not strictly necessary LOOP (loadw temp src) @@ -38,10 +57,10 @@ (inst add src src n-word-bytes) (storew temp dest -1) (inst sltu temp src csp-tn) - (inst bne temp zero-tn LOOP) + (inst bne temp 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 @@ -70,22 +89,22 @@ (:info nvals) (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (descriptor-reg) - :to (:result 0) - :target start) - start-temp) + :to (:result 0) + :target start) + start-temp) (:generator 20 (move start-temp csp-tn) (inst addu csp-tn csp-tn (* nvals n-word-bytes)) (do ((val vals (tn-ref-across val)) - (i 0 (1+ i))) - ((null val)) + (i 0 (1+ i))) + ((null val)) (let ((tn (tn-ref-tn val))) - (sc-case tn - (descriptor-reg - (storew tn start-temp i)) - (control-stack - (load-stack-tn temp tn) - (storew temp start-temp i))))) + (sc-case tn + (descriptor-reg + (storew tn start-temp i)) + (control-stack + (load-stack-tn temp tn) + (storew temp start-temp i))))) (move start start-temp) (inst li count (fixnumize nvals)))) @@ -96,7 +115,7 @@ (:arg-types list) (:policy :fast-safe) (:results (start :scs (any-reg)) - (count :scs (any-reg))) + (count :scs (any-reg))) (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list) (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) ndescr) @@ -105,7 +124,7 @@ (:generator 0 (move list arg) (move start csp-tn) - + LOOP (inst beq list null-tn done) (loadw temp list cons-car-slot list-pointer-lowtag) @@ -114,10 +133,10 @@ (storew temp csp-tn -1) (inst and ndescr list lowtag-mask) (inst xor ndescr list-pointer-lowtag) - (inst beq ndescr zero-tn loop) + (inst beq ndescr loop) (inst nop) (error-call vop bogus-arg-to-values-list-error list) - + DONE (inst subu count csp-tn start))) @@ -125,14 +144,14 @@ ;;; as function arguments. (define-vop (%more-arg-values) (:args (context :scs (descriptor-reg any-reg) :target src) - (skip :scs (any-reg zero immediate)) - (num :scs (any-reg) :target count)) + (skip :scs (any-reg zero immediate)) + (num :scs (any-reg) :target count)) (:arg-types * positive-fixnum positive-fixnum) (:temporary (:sc any-reg :from (:argument 0)) src) (:temporary (:sc any-reg :from (:argument 2)) dst) (:temporary (:sc descriptor-reg :from (:argument 1)) temp) (:results (start :scs (any-reg)) - (count :scs (any-reg))) + (count :scs (any-reg))) (:generator 20 (sc-case skip (zero @@ -142,14 +161,14 @@ (any-reg (inst addu src context skip))) (move count num) - (inst beq num zero-tn done) - (inst move start csp-tn) - (inst move dst csp-tn) + (inst beq num done) + (move start csp-tn t) + (move dst csp-tn) (inst addu csp-tn count) LOOP (inst lw temp src) - (inst addu src 4) - (inst addu dst 4) + (inst addu src n-word-bytes) + (inst addu dst n-word-bytes) (inst bne dst csp-tn loop) - (inst sw temp dst -4) + (inst sw temp dst (- n-word-bytes)) DONE))