From d865375bc5a17e11b985b857a29dd2dee1248a90 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Tue, 15 Jan 2019 16:37:11 +0000 Subject: [PATCH] Use a temporary if necessary in AFFIX-TYPE. --- src/compiler/machines/aarch64/lapgen.scm | 11 +++++------ src/compiler/machines/aarch64/rules1.scm | 3 ++- src/compiler/machines/aarch64/rules3.scm | 9 ++++++--- 3 files changed, 13 insertions(+), 10 deletions(-) diff --git a/src/compiler/machines/aarch64/lapgen.scm b/src/compiler/machines/aarch64/lapgen.scm index c831b08ee..8c7354dbd 100644 --- a/src/compiler/machines/aarch64/lapgen.scm +++ b/src/compiler/machines/aarch64/lapgen.scm @@ -393,9 +393,7 @@ USA. (LAP ,@(load-unsigned-immediate temp imm) ,@(add temp)))))) -(define (affix-type target type datum) - ;; Note: This must NOT use regnum:scratch-0 or regnum:scratch-1! - ;; This is used by closure headers to tag the incoming entry. +(define (affix-type target type datum get-temporary) (assert (<= scheme-type-width 16)) (assert (<= 48 scheme-datum-width)) (cond ((zero? type) @@ -410,10 +408,11 @@ USA. ;; ;; XXX If we know the top few bits of the datum are zero, we ;; could use a single MOVK instruction. - (let ((imm (shift-left type (- 16 scheme-type-width))) + (let ((temp (if (= target datum) (get-temporary) target)) + (imm (shift-left type (- 16 scheme-type-width))) (shift 48)) - (LAP (MOVZ X ,target (LSL (&U ,imm) ,shift)) - (ORR X ,target ,target ,datum)))))) + (LAP (MOVZ X ,temp (LSL (&U ,imm) ,shift)) + (ORR X ,target ,temp ,datum)))))) (define (object->type target source) (let ((lsb scheme-datum-width) diff --git a/src/compiler/machines/aarch64/rules1.scm b/src/compiler/machines/aarch64/rules1.scm index a75955d84..4574854fc 100644 --- a/src/compiler/machines/aarch64/rules1.scm +++ b/src/compiler/machines/aarch64/rules1.scm @@ -68,7 +68,8 @@ USA. (REGISTER (? datum)))) (standard-unary target datum (lambda (target datum) - (affix-type target type datum)))) + (affix-type target type datum + (lambda () (allocate-temporary-register! 'GENERAL)))))) (define-rule statement (ASSIGN (REGISTER (? target)) (OBJECT->TYPE (REGISTER (? source)))) diff --git a/src/compiler/machines/aarch64/rules3.scm b/src/compiler/machines/aarch64/rules3.scm index ec7fbb4a8..c8abd3746 100644 --- a/src/compiler/machines/aarch64/rules3.scm +++ b/src/compiler/machines/aarch64/rules3.scm @@ -527,7 +527,8 @@ USA. (LAP ,@(make-external-label internal-entry-code-word external-label) ;; regnum:applicand holds the untagged entry address. ;; Push and tag it. - ,@(affix-type regnum:applicand type regnum:applicand) + ,@(affix-type regnum:applicand type regnum:applicand + (lambda () regnum:scratch-0)) ,@(push regnum:applicand) (LABEL ,internal-label))) (cond ((zero? nentries) @@ -602,7 +603,8 @@ USA. ;; offsets without pre/post-increment. ,@(add-immediate Free Free (* 8 size)) ;; Set the last component to be the relocation reference point. - ,@(affix-type temp type-code:compiled-entry target) + ,@(affix-type temp type-code:compiled-entry target + (lambda () (allocate-temporary-register! 'GENERAL))) (STR X ,temp (POST+ ,Free (& 8)))))) (define (generate/cons-multiclosure target nentries size entries) @@ -639,7 +641,8 @@ USA. ;; offsets without pre/post-increment. ,@(add-immediate Free Free (* 8 size)) ;; Set the last component to be the relocation reference point. - ,@(affix-type temp type-code:compiled-entry target) + ,@(affix-type temp type-code:compiled-entry target + (lambda () (allocate-temporary-register! 'GENERAL))) (STR X ,temp (POST+ ,Free (& 8)))))) (define (generate-closure-entry label padding min max offset temp) -- 2.25.1