[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/04: Rework the way immediate encodings are calculated
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/04: Rework the way immediate encodings are calculated. |
Date: |
Tue, 4 Aug 2020 03:50:24 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit daf3e88a817f630dcbc4520f434e91f3d504f962
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Sat Aug 1 15:24:59 2020 +0200
Rework the way immediate encodings are calculated.
* module/system/base/types/internal.scm (scm->immediate-bits):
(immediate-bits->scm, sign-extend, truncate-bits): New public
routines.
* module/system/vm/assembler.scm (immediate-bits): Reimplement in terms
of scm->immediate-bits and similar.
(X8_S8_I16, X8_S8_ZI16): Rework operand encodings.
(load-constant): Use truncate-bits to determine which cases apply.
---
module/system/base/types/internal.scm | 53 +++++++++++++++++++++++++--
module/system/vm/assembler.scm | 67 +++++++++--------------------------
2 files changed, 67 insertions(+), 53 deletions(-)
diff --git a/module/system/base/types/internal.scm
b/module/system/base/types/internal.scm
index 9e4e4cc..768deae 100644
--- a/module/system/base/types/internal.scm
+++ b/module/system/base/types/internal.scm
@@ -1,5 +1,5 @@
;;; Details on internal value representation.
-;;; Copyright (C) 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
+;;; Copyright (C) 2014, 2015, 2017, 2018, 2020 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as published by
@@ -61,7 +61,12 @@
%tc16-flonum
%tc16-complex
%tc16-fraction
- visit-heap-tags))
+ visit-heap-tags
+
+ scm->immediate-bits
+ immediate-bits->scm
+ truncate-bits
+ sign-extend))
;;; Commentary:
;;;
@@ -182,6 +187,50 @@
(visit-immediate-tags define-tag)
(visit-heap-tags define-tag)
+(define (scm->immediate-bits x)
+ "If @var{x} is of a type that could be encoded as an immediate, return
+that bit pattern, or @code{#f} otherwise.. Note that the immediate bits
+may not fit into a word on the target platform."
+ (cond
+ ((exact-integer? x) (logior %tc2-fixnum (ash x 2)))
+ ((char? x) (logior %tc8-char (ash (char->integer x) 8)))
+ ((eq? x #f) %tc16-false)
+ ((eq? x #nil) %tc16-nil)
+ ((eq? x '()) %tc16-null)
+ ((eq? x #t) %tc16-true)
+ ((unspecified? x) %tc16-unspecified)
+ ;; FIXME: %tc16-undefined.
+ ((eof-object? x) %tc16-eof)
+ (else #f)))
+
+(define (immediate-bits->scm imm)
+ "Return the SCM object corresponding to the immediate encoding
+@code{imm}. Note that this value should be sign-extended already."
+ (define-syntax-rule (define-predicate name pred mask tag)
+ (define (pred) (eqv? (logand imm mask) tag)))
+ (visit-immediate-tags define-predicate)
+ (cond
+ ((fixnum?) (ash imm -2))
+ ((char?) (integer->char (ash imm -8)))
+ ((eq-false?) #f)
+ ((eq-nil?) #nil)
+ ((eq-null?) '())
+ ((eq-true?) #t)
+ ((unspecified?) (if #f #f))
+ ((eof-object?) the-eof-object)
+ (else (error "invalid immediate" imm))) )
+
+(define (sign-extend x bits)
+ (case (ash x (- 1 bits))
+ ((0) x)
+ ((1) (- x (ash 1 bits)))
+ (else (error "value does not fit in bits" x bits))))
+
+(define (truncate-bits x bits signed?)
+ (let ((x' (logand x (1- (ash 1 bits)))))
+ (and (eq? x (if signed? (sign-extend x' bits) x'))
+ x')))
+
;; See discussion in tags.h and boolean.h.
(eval-when (expand)
(let ()
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index ae527dd..8f67cac 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -640,6 +640,10 @@ later by the linker."
(reloc (make-reloc 's32 label start (- pos start))))
(set-asm-relocs! asm (cons reloc (asm-relocs asm)))))
+(define (immediate-bits asm x)
+ (let ((bits (scm->immediate-bits x)))
+ (and bits (truncate-bits bits (* 8 (asm-word-size asm)) #t))))
+
@@ -682,11 +686,11 @@ later by the linker."
(record-label-reference asm label)
(emit asm opcode))
((X8_S8_I16 a imm)
- (emit asm (pack-u8-u8-u16 opcode a (immediate-bits asm imm))))
+ (let ((bits (truncate-bits (scm->immediate-bits imm) 16 #f)))
+ (emit asm (pack-u8-u8-u16 opcode a bits))))
((X8_S8_ZI16 a imm)
- (emit asm (pack-u8-u8-u16 opcode a
- (signed-bits asm (immediate-bits asm imm)
- 16))))
+ (let ((bits (truncate-bits (scm->immediate-bits imm) 16 #t)))
+ (emit asm (pack-u8-u8-u16 opcode a bits))))
((X8_S12_S12 a b)
(emit asm (pack-u8-u12-u12 opcode a b)))
((X8_S12_C12 a b)
@@ -1207,48 +1211,6 @@ lists. This procedure can be called many times before
calling
;;; to the table.
;;;
-(define (immediate-bits asm x)
- "Return the bit pattern to write into the buffer if @var{x} is
-immediate, and @code{#f} otherwise."
- (define tc2-int 2)
- (if (exact-integer? x)
- ;; Object is an immediate if it is a fixnum on the target.
- (call-with-values (lambda ()
- (case (asm-word-size asm)
- ((4) (values (- #x20000000)
- #x1fffffff))
- ((8) (values (- #x2000000000000000)
- #x1fffffffFFFFFFFF))
- (else (error "unexpected word size"))))
- (lambda (fixnum-min fixnum-max)
- (and (<= fixnum-min x fixnum-max)
- (let ((fixnum-bits (if (negative? x)
- (+ fixnum-max 1 (logand x fixnum-max))
- x)))
- (logior (ash fixnum-bits 2) tc2-int)))))
- ;; Otherwise, the object will be immediate on the target if and
- ;; only if it is immediate on the host. Except for integers,
- ;; which we handle specially above, any immediate value is an
- ;; immediate on both 32-bit and 64-bit targets.
- (let ((bits (object-address x)))
- (and (not (zero? (logand bits 6)))
- bits))))
-
-(define (signed-bits asm uimm n)
- "Given the immediate-bits encoding @var{uimm}, return its bit pattern
-if it can be restricted to a sign-extended bitfield of @var{n} bits, or
-@code{#f} otherwise."
- (let* ((all-bits (1- (ash 1 (* (asm-word-size asm) 8))))
- (fixed-bits (1- (ash 1 n)))
- (sign-bits (lognot (ash fixed-bits -1))))
- (cond
- ((eqv? (logand all-bits sign-bits) (logand uimm sign-bits))
- (logand uimm fixed-bits))
- ((zero? (logand uimm sign-bits))
- uimm)
- (else
- #f))))
-
(define-record-type <stringbuf>
(make-stringbuf string)
stringbuf?
@@ -1405,17 +1367,20 @@ returned instead."
(define-macro-assembler (load-constant asm dst obj)
(cond
- ((immediate-bits asm obj)
+ ((scm->immediate-bits obj)
=> (lambda (bits)
(cond
- ((and (< dst 256) (signed-bits asm bits 16))
+ ((and (< dst 256) (truncate-bits bits 16 #t))
(emit-make-immediate asm dst obj))
- ((and (< dst 256) (zero? (ash bits -16)))
+ ((and (< dst 256) (truncate-bits bits 16 #f))
(emit-make-short-immediate asm dst obj))
- ((zero? (ash bits -32))
+ ((truncate-bits bits 32 (eqv? (asm-word-size asm) 4))
(emit-make-long-immediate asm dst obj))
+ ((and (eqv? (asm-word-size asm) 8)
+ (truncate-bits bits 64 #t))
+ (emit-make-long-long-immediate asm dst obj))
(else
- (emit-make-long-long-immediate asm dst obj)))))
+ (emit-static-ref asm dst (intern-non-immediate asm obj))))))
((statically-allocatable? obj)
(emit-make-non-immediate asm dst (intern-non-immediate asm obj)))
(else