]> birchwood-abbey.net Git - mit-scheme.git/commitdiff
rtlgen: Always copy register:value to temp in continuation.
authorTaylor R Campbell <campbell+mit-scheme@mumble.net>
Fri, 22 Apr 2022 08:49:23 +0000 (08:49 +0000)
committerTaylor R Campbell <campbell+mit-scheme@mumble.net>
Sat, 14 May 2022 14:10:30 +0000 (14:10 +0000)
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)

src/compiler/rtlgen/fndvar.scm
src/compiler/rtlgen/rtlgen.scm

index 5ec5c7234a310c538c547419de7219048e61fbea..b69d1ef6c9e50b5140f05bf29200619a6423cc2b 100644 (file)
@@ -86,10 +86,7 @@ USA.
                     (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)
index 3c9737170707bee62d830d0069653376c0872297..7e69839fe9fecf0a17c26909e2e4900e62b67758 100644 (file)
@@ -163,20 +163,12 @@ USA.
                          (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