This is necessary because register:value may be a machine register
available for allocation as a machine temporary (as on x86 where it
is rax).
I had found most (if not all) other cases where register:value needed
to be stashed in a pseudo temporary in a continuation, but I missed
this one: if the continuation is a predicate continuation that first
restores a dynamic link, the code to restore the dynamic link would
ask for a temporary register that might (and did) turn out to be the
same as register:value. Example:
(define (rexists pred thing)
(let tlp ((thing thing))
(pp thing)
(cond ((pred thing) #t)
((vector? thing)
(pp 'here)
(let ((n (vector-length thing)))
(let lp ((i 0))
(cond ((fix:= i n) #f)
((tlp (vector-ref thing i)) ; (*)
(pp 'there)
#t)
(else (lp (fix:+ i 1)))))))
((list? thing)
(any tlp thing))
(else #f))))
The predicate continuation marked (*) had the following code
generated for it (rax is (r 0), where return value lives on entry):
continuation-11:
;; (assign (register #x2d) (post-increment (register 4) 1))
(pop q (r 0))
;; (assign (register #x2e) (object->address (register #x2d)))
(and q (r 0) (r 5))
;; (assign (offset (register 6) (machine-constant 4)) (register #x2e))
(mov q (@ro 6 #x20) (r 0))
;; (eq-test (register 0) (constant #f))
(cmp q (r 0) (&u 0))
(jne (@pcr label-42))
This clobbers rax to restore the dynamic link, so the comparison at
the end compares compares the dynamic link, not the return value as
intended, to #f.
(cherry picked from commit
f38c4ff4c048955585416a774e61352fcd9e5178)
(else
(error "illegal integrated value variable" variable))))
(rtl:make-fetch
- (let ((continuation (reference-context/procedure context)))
- (if (continuation/ever-known-operator? continuation)
- (continuation/register continuation)
- register:value))))))
+ (continuation/register (reference-context/procedure context))))))
(let ((if-locative
(if get-value?
(lambda (locative)
(continuation/type continuation)
((PUSH)
(with-value rtl:make-push))
- ((REGISTER)
+ ((REGISTER VALUE PREDICATE)
(with-value
(lambda (expression)
(rtl:make-assignment
(continuation/register continuation)
expression))))
- ((VALUE PREDICATE)
- (if (continuation/ever-known-operator? continuation)
- (with-value
- (lambda (expression)
- (rtl:make-assignment
- (continuation/register continuation)
- expression)))
- (values (make-null-cfg) (make-null-cfg))))
((EFFECT)
(values (make-null-cfg) (make-null-cfg)))
(else