API tools faq
paste
Guest User

Untitled

a guest
Nov 18th, 2017
89
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.03 KB | None | 0 0
raw download clone embed print report
  1. diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
  2. index 539642a..b9e0972 100644
  3. --- a/src/compiler/ir1opt.lisp
  4. +++ b/src/compiler/ir1opt.lisp
  5. @@ -1903,7 +1903,7 @@
  6. ((let ((use (lvar-uses arg)))
  7. (when (ref-p use)
  8. (let ((leaf (ref-leaf use)))
  9. - (when (and (constant-reference-p use)
  10. + (when (and nil;(constant-reference-p use)
  11. (csubtypep (leaf-type leaf)
  12. ;; (NODE-DERIVED-TYPE USE) would
  13. ;; be better -- APD, 2003-05-15
  14. diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
  15. index e95b565..bb51c60 100644
  16. --- a/src/compiler/ir1util.lisp
  17. +++ b/src/compiler/ir1util.lisp
  18. @@ -519,7 +519,13 @@
  19. (and (trivial-lambda-var-ref-p use)
  20. (let ((uses (lvar-uses (trivial-lambda-var-ref-lvar use))))
  21. (or (eq use uses)
  22. - (lvar-good-for-dx-p (trivial-lambda-var-ref-lvar use) dx component))))))
  23. + (lvar-good-for-dx-p (trivial-lambda-var-ref-lvar use) dx component))))
  24. + (and (ref-p use)
  25. + (let ((leaf (ref-leaf use)))
  26. + (or (lambda-p leaf)
  27. + (and (constant-p leaf)
  28. + (and (consp (constant-value leaf))
  29. + (every #'lambda-p (constant-value leaf)))))))))
  30.  
  31. (defun lvar-good-for-dx-p (lvar dx &optional component)
  32. (let ((uses (lvar-uses lvar))) ; TODO use ENSURE-LIST? or is it too slow?
  33. @@ -659,13 +665,26 @@
  34. (unless (eq other lvar)
  35. (handle-nested-dynamic-extent-lvars
  36. dx other recheck-component)))))))
  37. - (cons (cons dx lvar)
  38. - (if (listp uses) ; TODO use ENSURE-LIST? or is it too slow?
  39. - (loop for use in uses
  40. - when (use-good-for-dx-p use dx recheck-component)
  41. - nconc (recurse use))
  42. - (when (use-good-for-dx-p uses dx recheck-component)
  43. - (recurse uses)))))))
  44. + (cond ((and (ref-p uses)
  45. + (lambda-p (ref-leaf uses)))
  46. + (setf (leaf-extent (functional-entry-fun (ref-leaf uses))) dx)
  47. + (list (cons dx (car (combination-args
  48. + (lambda-allocator (functional-entry-fun (ref-leaf uses))))))))
  49. + ((and (ref-p uses)
  50. + (and (constant-p (ref-leaf uses))
  51. + (and (consp (constant-value (ref-leaf uses)))
  52. + (every #'lambda-p (constant-value (ref-leaf uses))))))
  53. + (setf (leaf-extent (car (constant-value (ref-leaf uses)))) dx)
  54. + (list (cons dx (car (combination-args
  55. + (lambda-allocator (car (constant-value (ref-leaf uses)))))))))
  56. + (t
  57. + (cons (cons dx lvar)
  58. + (if (listp uses) ; TODO use ENSURE-LIST? or is it too slow?
  59. + (loop for use in uses
  60. + when (use-good-for-dx-p use dx recheck-component)
  61. + nconc (recurse use))
  62. + (when (use-good-for-dx-p uses dx recheck-component)
  63. + (recurse uses)))))))))
  64.  
  65. ;;;;; BLOCK UTILS
  66.  
  67. diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
  68. index 9fc2db2..47a5a9e 100644
  69. --- a/src/compiler/locall.lisp
  70. +++ b/src/compiler/locall.lisp
  71. @@ -1238,9 +1238,10 @@
  72. (reoptimize-call dest)
  73. (setf (functional-kind clambda)
  74. (if (mv-combination-p dest) :mv-let :let))
  75. - (when (combination-p dest) ; mv-combinations are too hairy
  76. - ; for me to handle - PK 2012-05-30
  77. - (substitute-let-funargs dest clambda component))))
  78. + ;; (when (combination-p dest) ; mv-combinations are too hairy
  79. + ;; ; for me to handle - PK 2012-05-30
  80. + ;; (substitute-let-funargs dest clambda component))
  81. + ))
  82. t))))
  84. ;;;; tail local calls and assignments
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!