From be310b85bbcfc7fbc58b311f799255493d48437e Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 31 Dec 2018 20:32:37 +0000 Subject: [PATCH] Use BTS to affix single-bit type tags. --- src/compiler/machines/x86-64/rules1.scm | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/src/compiler/machines/x86-64/rules1.scm b/src/compiler/machines/x86-64/rules1.scm index 8dd0daddc..68614917f 100644 --- a/src/compiler/machines/x86-64/rules1.scm +++ b/src/compiler/machines/x86-64/rules1.scm @@ -110,8 +110,15 @@ USA. (CONS-POINTER (MACHINE-CONSTANT (? type)) (REGISTER (? datum)))) (if (zero? type) (assign-register->register target datum) - (let* ((target (standard-move-to-target! datum target)) - (temp (temporary-register-reference))) + (affix-type (standard-move-to-target! datum target) type))) + +(define (affix-type target type) + (if (= 1 (bit-count type)) + (let ((bit (first-set-bit type))) + (assert (<= 0 bit)) + (assert (< bit scheme-type-width)) + (LAP (BTS Q ,target (&U ,(+ scheme-datum-width bit))))) + (let ((temp (temporary-register-reference))) (LAP (MOV Q ,temp (&U ,(make-non-pointer-literal type 0))) (OR Q ,target ,temp))))) @@ -201,27 +208,23 @@ USA. (ENTRY:CONTINUATION (? label)))) (assert (= type type-code:compiled-return)) (let* ((target (target-register-reference target)) - (temp (temporary-register-reference)) (pushed (generate-label 'PUSHED))) (LAP (CALL (@PCR ,pushed)) (JMP (@PCRO ,label 8)) (LABEL ,pushed) (POP Q ,target) - (MOV Q ,temp (&U ,(make-non-pointer-literal type 0))) - (OR Q ,target ,temp)))) + ,@(affix-type target type)))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 4) -1) (CONS-POINTER (MACHINE-CONSTANT (? type)) (ENTRY:CONTINUATION (? label)))) (assert (= type type-code:compiled-return)) - (let* ((temp (temporary-register-reference)) - (pushed (generate-label 'PUSHED))) + (let ((pushed (generate-label 'PUSHED))) (LAP (CALL (@PCR ,pushed)) (JMP (@PCRO ,label 8)) (LABEL ,pushed) - (MOV Q ,temp (&U ,(make-non-pointer-literal type 0))) - (OR Q (@R 4) ,temp)))) + ,@(affix-type (INST-EA (@R 4)) type)))) (define-rule statement (ASSIGN (REGISTER (? target)) (VARIABLE-CACHE (? name))) @@ -430,6 +433,9 @@ USA. (LAP (LEA Q ,target ,source)))) (define (load-pc-relative-address/typed target type label offset) + (LAP (LEA Q ,target (@PCRO ,label ,offset)) + ,@(affix-type target type)) + #| ;++ This is pretty horrid, especially since it happens for every ;++ continuation pushed! None of the alternatives is much good. ;; Twenty bytes, but only three instructions and no extra memory. @@ -437,6 +443,7 @@ USA. (LAP (MOV Q ,temp (&U ,(make-non-pointer-literal type 0))) (LEA Q ,target (@PCRO ,label ,offset)) (OR Q ,target ,temp))) + |# #| ;; Nineteen bytes, but rather complicated (and needs syntax for an ;; addressing mode not presently supported). -- 2.25.1