X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Frepresent.lisp;h=c4b4b862148b8a5413b6889caf253f29665ad826;hb=5ecef987f3847ed5de8c03f66ef9d8ab468af993;hp=77fafaef3e1405e55eb654f103e1884190952fff;hpb=1bfc464c657a8f4ad24ef612f76a38d8f6f1bbad;p=sbcl.git diff --git a/src/compiler/represent.lisp b/src/compiler/represent.lisp index 77fafae..c4b4b86 100644 --- a/src/compiler/represent.lisp +++ b/src/compiler/represent.lisp @@ -100,14 +100,14 @@ (unless (losers) (error "Representation selection flamed out for no obvious reason.~@ - Try again after recompiling the VM definition.")) + Try again after recompiling the VM definition.")) (error "~S is not valid as the ~:R ~:[result~;argument~] to the~@ - ~S VOP, since the TN's primitive type ~S allows SCs:~% ~S~@ - ~:[which cannot be coerced or loaded into the allowed SCs:~ - ~% ~S~;~*~]~:[~;~@ - Current cost info inconsistent with that in effect at compile ~ - time. Recompile.~%Compilation order may be incorrect.~]" + ~S VOP, since the TN's primitive type ~S allows SCs:~% ~S~@ + ~:[which cannot be coerced or loaded into the allowed SCs:~ + ~% ~S~;~*~]~:[~;~@ + Current cost info inconsistent with that in effect at compile ~ + time. Recompile.~%Compilation order may be incorrect.~]" tn pos arg-p (template-name (vop-info (tn-ref-vop ref))) (primitive-type-name ptype) @@ -147,23 +147,23 @@ (no-move-scs i-sc)))) (t (error "Representation selection flamed out for no ~ - obvious reason.")))))) + obvious reason.")))))) (unless (or (load-lose) (no-move-scs) (move-lose)) (error "Representation selection flamed out for no obvious reason.~@ - Try again after recompiling the VM definition.")) + Try again after recompiling the VM definition.")) (error "~S is not valid as the ~:R ~:[result~;argument~] to VOP:~ - ~% ~S~%Primitive type: ~S~@ - SC restrictions:~% ~S~@ - ~@[The primitive type disallows these loadable SCs:~% ~S~%~]~ - ~@[No move VOPs are defined to coerce to these allowed SCs:~ - ~% ~S~%~]~ - ~@[These move VOPs couldn't be used due to operand type ~ - restrictions:~% ~S~%~]~ - ~:[~;~@ - Current cost info inconsistent with that in effect at compile ~ - time. Recompile.~%Compilation order may be incorrect.~]" + ~% ~S~%Primitive type: ~S~@ + SC restrictions:~% ~S~@ + ~@[The primitive type disallows these loadable SCs:~% ~S~%~]~ + ~@[No move VOPs are defined to coerce to these allowed SCs:~ + ~% ~S~%~]~ + ~@[These move VOPs couldn't be used due to operand type ~ + restrictions:~% ~S~%~]~ + ~:[~;~@ + Current cost info inconsistent with that in effect at compile ~ + time. Recompile.~%Compilation order may be incorrect.~]" op-tn pos arg-p (template-name (vop-info (tn-ref-vop op))) (primitive-type-name ptype) @@ -175,8 +175,8 @@ (defun bad-move-arg-error (val pass) (declare (type tn val pass)) - (error "no :MOVE-ARGUMENT VOP defined to move ~S (SC ~S) to ~ - ~S (SC ~S)" + (error "no :MOVE-ARG VOP defined to move ~S (SC ~S) to ~ + ~S (SC ~S)" val (sc-name (tn-sc val)) pass (sc-name (tn-sc pass)))) @@ -186,25 +186,25 @@ ;;;; load time. ;;; FIXME: should probably be conditional on #!+SB-SHOW -(defun check-move-function-consistency () +(defun check-move-fun-consistency () (dotimes (i sc-number-limit) (let ((sc (svref *backend-sc-numbers* i))) (when sc - (let ((moves (sc-move-functions sc))) + (let ((moves (sc-move-funs sc))) (dolist (const (sc-constant-scs sc)) (unless (svref moves (sc-number const)) (warn "no move function defined to load SC ~S from constant ~ - SC ~S" + SC ~S" (sc-name sc) (sc-name const)))) (dolist (alt (sc-alternate-scs sc)) (unless (svref moves (sc-number alt)) (warn "no move function defined to load SC ~S from alternate ~ - SC ~S" + SC ~S" (sc-name sc) (sc-name alt))) - (unless (svref (sc-move-functions alt) i) + (unless (svref (sc-move-funs alt) i) (warn "no move function defined to save SC ~S to alternate ~ - SC ~S" + SC ~S" (sc-name sc) (sc-name alt))))))))) ;;;; representation selection @@ -227,6 +227,7 @@ (defun add-representation-costs (refs scs costs ops-slot costs-slot more-costs-slot write-p) + (declare (type function ops-slot costs-slot more-costs-slot)) (do ((ref refs (tn-ref-next ref))) ((null ref)) (flet ((add-costs (cost) @@ -346,7 +347,7 @@ ;;; If policy indicates, give an efficiency note for doing the ;;; coercion VOP, where OP is the operand we are coercing for and ;;; DEST-TN is the distinct destination in a move. -(defun do-coerce-efficiency-note (vop op dest-tn) +(defun maybe-emit-coerce-efficiency-note (vop op dest-tn) (declare (type vop-info vop) (type tn-ref op) (type (or tn null) dest-tn)) (let* ((note (or (template-note vop) (template-name vop))) (cost (template-cost vop)) @@ -369,20 +370,20 @@ (vop-args op-vop) (vop-results op-vop))) (error "couldn't find op? bug!"))))) - (compiler-note + (compiler-notify "doing ~A (cost ~W)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~ - the ~:R ~:[result~;argument~] of ~A" + the ~:R ~:[result~;argument~] of ~A" note cost name arg-p name pos arg-p op-note))) (t - (compiler-note "doing ~A (cost ~W)~@[ from ~S~]~@[ to ~S~]" - note cost (get-operand-name op-tn t) - (get-operand-name dest-tn nil))))) + (compiler-notify "doing ~A (cost ~W)~@[ from ~S~]~@[ to ~S~]" + note cost (get-operand-name op-tn t) + (get-operand-name dest-tn nil))))) (values)) ;;; Find a move VOP to move from the operand OP-TN to some other ;;; representation corresponding to OTHER-SC and OTHER-PTYPE. SLOT is -;;; the SC slot that we grab from (move or move-argument). WRITE-P +;;; the SC slot that we grab from (move or move-arg). WRITE-P ;;; indicates that OP is a VOP result, so OP is the move result and ;;; other is the arg, otherwise OP is the arg and other is the result. ;;; @@ -453,7 +454,7 @@ (when res (when (>= (vop-info-cost res) *efficiency-note-cost-threshold*) - (do-coerce-efficiency-note res op dest-tn)) + (maybe-emit-coerce-efficiency-note res op dest-tn)) (let ((temp (make-representation-tn ptype scn))) (change-tn-ref-tn op temp) (cond @@ -599,7 +600,7 @@ (res (when (>= (vop-info-cost res) *efficiency-note-cost-threshold*) - (do-coerce-efficiency-note res args y)) + (maybe-emit-coerce-efficiency-note res args y)) (emit-move-template node block res x y vop) (delete-vop vop)) (t