From: Taylor R Campbell Date: Sun, 30 Dec 2018 21:01:58 +0000 (+0000) Subject: Ensure register:value appears first or last in block. X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~80^2~19 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=29b733f1ec1cdafae05e9b99bb11a7caa7b7ac01;p=mit-scheme.git Ensure register:value appears first or last in block. Either it is the first register referenced, or the last register assigned. This will enable us to use a machine register that is normally available for register allocation, without having to worry that it may be an alias for a live pseudo-register. - In continuations that receive a value through register:value, create a temporary register and make the first instruction be an assignment of register:value to the temporary register, before we the pop-extra. The RTL optimizer avoids propagating this alias so the assignment will stay in place, but later on, the LAP generator will take advantage of the alias to avoid generating additional unnecessary code. - In returns that store a value in register:value, create a temporary register and assign it where we used to assign to register:value, and then store the temporary in register:value as the very last instruction before pop-return after any frame-popping which might involve temporaries. --- diff --git a/src/compiler/rtlgen/opncod.scm b/src/compiler/rtlgen/opncod.scm index deaae4b77..c589948a5 100644 --- a/src/compiler/rtlgen/opncod.scm +++ b/src/compiler/rtlgen/opncod.scm @@ -322,7 +322,12 @@ USA. expressions setup label) cleanup (if error-finish - (error-finish (rtl:make-fetch register:value)) + (let ((temporary (rtl:make-pseudo-register))) + (scfg*scfg->scfg! + (rtl:make-assignment + temporary + (rtl:make-fetch register:value)) + (error-finish (rtl:make-fetch temporary)))) (make-null-cfg))) #| ;; This code is preferable to the above @@ -1680,11 +1685,14 @@ USA. (generate-primitive generic-op (length expressions) expressions setup label) cleanup - (if predicate? - (finish (rtl:make-true-test (rtl:make-fetch register:value))) - (expression-simplify-for-statement - (rtl:make-fetch register:value) - finish)))))))) + (let ((temporary (rtl:make-pseudo-register))) + (scfg*scfg->scfg! + (rtl:make-assignment temporary (rtl:make-fetch register:value)) + (if predicate? + (finish (rtl:make-true-test (rtl:make-fetch temporary))) + (expression-simplify-for-statement + (rtl:make-fetch temporary) + finish)))))))))) (define (generic->fixnum-op generic-op) (case generic-op diff --git a/src/compiler/rtlgen/rgretn.scm b/src/compiler/rtlgen/rgretn.scm index d5bfc5680..533972932 100644 --- a/src/compiler/rtlgen/rgretn.scm +++ b/src/compiler/rtlgen/rgretn.scm @@ -84,14 +84,21 @@ USA. (generate/continuation-entry/pop-extra continuation))) operand continuation) - (scfg-append! - (if (and continuation (continuation/effect? continuation)) - (effect-prefix operand) - ((return-operand/value-generator operand) - (lambda (expression) - (rtl:make-assignment register:value expression)))) - (return-operator/pop-frames context operator 0) - (rtl:make-pop-return))))) + (receive (rising-action conclusion) + (if (and continuation (continuation/effect? continuation)) + (values (effect-prefix operand) (make-null-cfg)) + (let ((temporary (rtl:make-pseudo-register))) + (values + ((return-operand/value-generator operand) + (lambda (expression) + (rtl:make-assignment temporary expression))) + (rtl:make-assignment register:value + (rtl:make-fetch temporary))))) + (scfg-append! + rising-action + (return-operator/pop-frames context operator 0) + conclusion + (rtl:make-pop-return)))))) (define-integrable (continuation/effect? continuation) (eq? continuation-type/effect (continuation/type continuation))) diff --git a/src/compiler/rtlgen/rtlgen.scm b/src/compiler/rtlgen/rtlgen.scm index 7488be6e8..d5a4dc5f6 100644 --- a/src/compiler/rtlgen/rtlgen.scm +++ b/src/compiler/rtlgen/rtlgen.scm @@ -151,28 +151,44 @@ USA. (generate/rgraph (continuation/entry-node continuation) (lambda (node) - (scfg-append! - (if (continuation/avoid-check? continuation) - (rtl:make-continuation-entry label) - (rtl:make-continuation-header label)) - (generate/continuation-entry/pop-extra continuation) - (enumeration-case continuation-type - (continuation/type continuation) - ((PUSH) - (rtl:make-push (rtl:make-fetch register:value))) - ((REGISTER) - (rtl:make-assignment (continuation/register continuation) - (rtl:make-fetch register:value))) - ((VALUE PREDICATE) - (if (continuation/ever-known-operator? continuation) - (rtl:make-assignment (continuation/register continuation) - (rtl:make-fetch register:value)) - (make-null-cfg))) - ((EFFECT) - (make-null-cfg)) - (else - (error "Illegal continuation type" continuation))) - (generate/node node))))) + (define (with-value generator) + (let* ((temporary (rtl:make-pseudo-register)) + (prologue + (rtl:make-assignment temporary + (rtl:make-fetch register:value))) + (intermezzo (generator temporary))) + (values prologue intermezzo))) + (receive (prologue intermezzo) + (enumeration-case continuation-type + (continuation/type continuation) + ((PUSH) + (with-value rtl:make-push)) + ((REGISTER) + (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 + (error "Illegal continuation type" continuation))) + (scfg-append! + (if (continuation/avoid-check? continuation) + (rtl:make-continuation-entry label) + (rtl:make-continuation-header label)) + prologue + (generate/continuation-entry/pop-extra continuation) + intermezzo + (generate/node node)))))) (lambda (rgraph entry-edge) (make-rtl-continuation rgraph