| Paste number 24545: | Does this look right for VOP operand validation? |
| Pasted by: | nyef |
| When: | 3 years, 11 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+IXT |
| Channel: | #lisp |
| Paste contents: |
(let ((vop-name 'sb-vm::call-named))
(let* ((vop-parse (sb-c::vop-parse-or-lose vop-name))
(vop-operands (sb-c::vop-parse-operands vop-parse))
(targetted-operands '()))
;; Phase 1: Check for :target operand lifetime overlap.
(dolist (operand vop-operands)
(let ((target-name (sb-c::operand-parse-target operand)))
(when target-name
(let ((target-operand
(find-if (lambda (x)
(eq target-name
(sb-c::operand-parse-name x)))
vop-operands)))
(pushnew target-operand targetted-operands)
(unless (sb-c::time-spec-order
(sb-c::operand-parse-dies operand)
(sb-c::operand-parse-born target-operand))
(warn "Lifetime of ~A ~A overlaps that of :TARGET ~A."
(sb-c::operand-parse-kind operand)
(sb-c::operand-parse-name operand)
target-name))))))
;; Phase 2: Check for non-:target operand lifetimes that don't
;; overlap a targetted operand.
(dolist (operand targetted-operands)
(dolist (other-operand vop-operands)
(when (and (not (eq operand other-operand))
(not (sb-c::operand-parse-target other-operand))
(sb-c::time-spec-order
(sb-c::operand-parse-born operand)
(sb-c::operand-parse-dies other-operand)))
(warn "Lifetime of non-:TARGET ~A ~A does not overlap :TARGETted ~A ~A."
(sb-c::operand-parse-kind other-operand)
(sb-c::operand-parse-name other-operand)
(sb-c::operand-parse-kind operand)
(sb-c::operand-parse-name operand)))))))
Annotations for this paste:
| Annotation number 1: | This version is a little better, and checks all VOPs in a running system. |
| Pasted by: | nyef |
| When: | 3 years, 11 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+IXT/1 |
| Paste contents: |
(maphash (lambda (vop-name foo) (declare (ignore foo))
(format t "VOP: ~A~%" vop-name)
(let* ((vop-parse (sb-c::vop-parse-or-lose vop-name))
(vop-operands (sb-c::vop-parse-operands vop-parse))
(targetted-operands '()))
;; Phase 1: Check for :target operand lifetime overlap.
(dolist (operand vop-operands)
(let ((target-name (sb-c::operand-parse-target operand)))
(when target-name
(let ((target-operand
(find-if (lambda (x)
(eq target-name
(sb-c::operand-parse-name x)))
vop-operands)))
(pushnew target-operand targetted-operands)
(unless (sb-c::time-spec-order
(sb-c::operand-parse-born target-operand)
(sb-c::operand-parse-dies operand))
(warn "Lifetime of ~A ~A overlaps that of :TARGET ~A."
(sb-c::operand-parse-kind operand)
(sb-c::operand-parse-name operand)
target-name))))))
;; Phase 2: Check for non-:target operand lifetimes that don't
;; overlap a targetted operand.
(dolist (operand targetted-operands)
(dolist (other-operand vop-operands)
(when (and (not (eq operand other-operand))
(not (sb-c::operand-parse-target other-operand))
(sb-c::time-spec-order
(sb-c::operand-parse-born operand)
(sb-c::operand-parse-dies other-operand)))
(warn "Lifetime of non-:TARGET ~A ~A does not overlap :TARGETted ~A ~A."
(sb-c::operand-parse-kind other-operand)
(sb-c::operand-parse-name other-operand)
(sb-c::operand-parse-kind operand)
(sb-c::operand-parse-name operand)))))));)
sb-c::*backend-parsed-vops*)