]> sourceware.org Git - cgen.git/commitdiff
* fixes to handle 64-bit ints properly
authorFrank Ch. Eigler <fche@redhat.com>
Thu, 21 Sep 2000 20:16:24 +0000 (20:16 +0000)
committerFrank Ch. Eigler <fche@redhat.com>
Thu, 21 Sep 2000 20:16:24 +0000 (20:16 +0000)
2000-09-21  Frank Ch. Eigler  <fche@redhat.com>

* slib/logical.scm: New file from slib.  Provides robust bitwise
logical operations for large integers.
* read.scm: maybe-load it.

ChangeLog
read.scm
slib/logical.scm [new file with mode: 0644]

index 002f2ef10f57dcf8d3052dfcc5da816577a6698c..cea94dfa4990ef338f8f314951c959df5b338dae 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2000-09-21  Frank Ch. Eigler  <fche@redhat.com>
+
+       * slib/logical.scm: New file from slib.  Provides robust bitwise
+       logical operations for large integers.
+       * read.scm: maybe-load it.
+
 2000-09-15  Frank Ch. Eigler  <fche@redhat.com>
 
        * enum.scm (define-full-insn-enum): Filter with keep-isa predicate.
index 2b2ef008b056bd23928164b8b26045587fc394d2..6c1d668ad1cb7bf1d960e4be61df4c800f4d6dd7 100644 (file)
--- a/read.scm
+++ b/read.scm
 
 (maybe-load "pmacros" #f 'define-pmacro)
 (maybe-load "cos" #f 'make)
+(maybe-load "slib/logical" #f 'logical:logand)
 (maybe-load "slib/sort" #f 'sort)
 ; Used to pretty-print debugging messages.
 (maybe-load "slib/pp" #f 'pretty-print)
diff --git a/slib/logical.scm b/slib/logical.scm
new file mode 100644 (file)
index 0000000..a20234f
--- /dev/null
@@ -0,0 +1,168 @@
+;;;; "logical.scm", bit access and operations for integers for Scheme
+;;; Copyright (C) 1991, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define logical:integer-expt
+  (if (defined? 'inexact)
+      expt
+      (lambda (n k)
+       (logical:ipow-by-squaring n k 1 *))))
+
+(define (logical:ipow-by-squaring x k acc proc)
+  (cond ((zero? k) acc)
+       ((= 1 k) (proc acc x))
+       (else (logical:ipow-by-squaring (proc x x)
+                                       (quotient k 2)
+                                       (if (even? k) acc (proc acc x))
+                                       proc))))
+
+(define (logical:logand n1 n2)
+  (cond ((= n1 n2) n1)
+       ((zero? n1) 0)
+       ((zero? n2) 0)
+       (else
+        (+ (* (logical:logand (logical:ash-4 n1) (logical:ash-4 n2)) 16)
+           (vector-ref (vector-ref logical:boole-and (modulo n1 16))
+                       (modulo n2 16))))))
+
+(define (logical:logior n1 n2)
+  (cond ((= n1 n2) n1)
+       ((zero? n1) n2)
+       ((zero? n2) n1)
+       (else
+        (+ (* (logical:logior (logical:ash-4 n1) (logical:ash-4 n2)) 16)
+           (- 15 (vector-ref (vector-ref logical:boole-and
+                                         (- 15 (modulo n1 16)))
+                             (- 15 (modulo n2 16))))))))
+
+(define (logical:logxor n1 n2)
+  (cond ((= n1 n2) 0)
+       ((zero? n1) n2)
+       ((zero? n2) n1)
+       (else
+        (+ (* (logical:logxor (logical:ash-4 n1) (logical:ash-4 n2)) 16)
+           (vector-ref (vector-ref logical:boole-xor (modulo n1 16))
+                       (modulo n2 16))))))
+
+(define (logical:lognot n) (- -1 n))
+
+(define (logical:logtest int1 int2)
+  (not (zero? (logical:logand int1 int2))))
+
+(define (logical:logbit? index int)
+  (logical:logtest (logical:integer-expt 2 index) int))
+
+(define (logical:copy-bit index to bool)
+  (if bool
+      (logical:logior to (logical:ash 1 index))
+      (logical:logand to (logical:lognot (logical:ash 1 index)))))
+
+(define (logical:bit-field n start end)
+  (logical:logand (- (logical:integer-expt 2 (- end start)) 1)
+                 (logical:ash n (- start))))
+
+(define (logical:bitwise-if mask n0 n1)
+  (logical:logior (logical:logand mask n0)
+                 (logical:logand (logical:lognot mask) n1)))
+
+(define (logical:copy-bit-field to start end from)
+  (logical:bitwise-if
+   (logical:ash (- (logical:integer-expt 2 (- end start)) 1) start)
+   (logical:ash from start)
+   to))
+
+(define (logical:ash int cnt)
+  (if (negative? cnt)
+      (let ((n (logical:integer-expt 2 (- cnt))))
+       (if (negative? int)
+           (+ -1 (quotient (+ 1 int) n))
+           (quotient int n)))
+      (* (logical:integer-expt 2 cnt) int)))
+
+(define (logical:ash-4 x)
+  (if (negative? x)
+      (+ -1 (quotient (+ 1 x) 16))
+      (quotient x 16)))
+
+(define (logical:logcount n)
+  (cond ((zero? n) 0)
+       ((negative? n) (logical:logcount (logical:lognot n)))
+       (else
+        (+ (logical:logcount (logical:ash-4 n))
+           (vector-ref '#(0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4)
+                       (modulo n 16))))))
+
+(define (logical:integer-length n)
+  (case n
+    ((0 -1) 0)
+    ((1 -2) 1)
+    ((2 3 -3 -4) 2)
+    ((4 5 6 7 -5 -6 -7 -8) 3)
+    (else (+ 4 (logical:integer-length (logical:ash-4 n))))))
+
+(define logical:boole-xor
+ '#(#(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
+    #(1 0 3 2 5 4 7 6 9 8 11 10 13 12 15 14)
+    #(2 3 0 1 6 7 4 5 10 11 8 9 14 15 12 13)
+    #(3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12)
+    #(4 5 6 7 0 1 2 3 12 13 14 15 8 9 10 11)
+    #(5 4 7 6 1 0 3 2 13 12 15 14 9 8 11 10)
+    #(6 7 4 5 2 3 0 1 14 15 12 13 10 11 8 9)
+    #(7 6 5 4 3 2 1 0 15 14 13 12 11 10 9 8)
+    #(8 9 10 11 12 13 14 15 0 1 2 3 4 5 6 7)
+    #(9 8 11 10 13 12 15 14 1 0 3 2 5 4 7 6)
+    #(10 11 8 9 14 15 12 13 2 3 0 1 6 7 4 5)
+    #(11 10 9 8 15 14 13 12 3 2 1 0 7 6 5 4)
+    #(12 13 14 15 8 9 10 11 4 5 6 7 0 1 2 3)
+    #(13 12 15 14 9 8 11 10 5 4 7 6 1 0 3 2)
+    #(14 15 12 13 10 11 8 9 6 7 4 5 2 3 0 1)
+    #(15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0)))
+
+(define logical:boole-and
+ '#(#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
+    #(0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1)
+    #(0 0 2 2 0 0 2 2 0 0 2 2 0 0 2 2)
+    #(0 1 2 3 0 1 2 3 0 1 2 3 0 1 2 3)
+    #(0 0 0 0 4 4 4 4 0 0 0 0 4 4 4 4)
+    #(0 1 0 1 4 5 4 5 0 1 0 1 4 5 4 5)
+    #(0 0 2 2 4 4 6 6 0 0 2 2 4 4 6 6)
+    #(0 1 2 3 4 5 6 7 0 1 2 3 4 5 6 7)
+    #(0 0 0 0 0 0 0 0 8 8 8 8 8 8 8 8)
+    #(0 1 0 1 0 1 0 1 8 9 8 9 8 9 8 9)
+    #(0 0 2 2 0 0 2 2 8 8 10 10 8 8 10 10)
+    #(0 1 2 3 0 1 2 3 8 9 10 11 8 9 10 11)
+    #(0 0 0 0 4 4 4 4 8 8 8 8 12 12 12 12)
+    #(0 1 0 1 4 5 4 5 8 9 8 9 12 13 12 13)
+    #(0 0 2 2 4 4 6 6 8 8 10 10 12 12 14 14)
+    #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
+
+(define logand logical:logand)
+(define logior logical:logior)
+(define logxor logical:logxor)
+(define lognot logical:lognot)
+(define logtest logical:logtest)
+(define logbit? logical:logbit?)
+(define copy-bit logical:copy-bit)
+(define ash logical:ash)
+(define logcount logical:logcount)
+(define integer-length logical:integer-length)
+(define bit-field logical:bit-field)
+(define bit-extract logical:bit-field)
+(define copy-bit-field logical:copy-bit-field)
+(define ipow-by-squaring logical:ipow-by-squaring)
+(define integer-expt logical:integer-expt)
This page took 0.036887 seconds and 5 git commands to generate.