X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Finsts.lisp;h=bc91214fa338e71795ea5a4c903c1b1e2fcd1112;hb=a4c3562138e342465826de31fb8c324ae8a4b594;hp=05f996c5c341552d60e040fc21f737431a077195;hpb=5037c9ac22cbab91eb3cf1ee6261c8589e17e81d;p=sbcl.git

diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp
index 05f996c..bc91214 100644
--- a/src/compiler/alpha/insts.lisp
+++ b/src/compiler/alpha/insts.lisp
@@ -66,9 +66,9 @@
 		dstate))))
 
 (defparameter float-reg-symbols
-  (coerce
-   (loop for n from 0 to 31 collect (make-symbol (format nil "~D" n)))
-   'vector))
+  #.(coerce
+     (loop for n from 0 to 31 collect (make-symbol (format nil "~D" n)))
+     'vector))
 
 (sb!disassem:define-arg-type fp-reg
   :printer (lambda (value stream dstate)
@@ -199,11 +199,15 @@
                               disp)))))
   (define-memory lda   #x08 :lda)
   (define-memory ldah  #x09 :ldah)
+  (define-memory ldbu  #x0a)            ; BWX extension
+  (define-memory ldwu  #x0c)            ; BWX extension
   (define-memory ldl   #x28)
   (define-memory ldq   #x29)
   (define-memory ldl_l #x2a)
   (define-memory ldq_q #x2b)
   (define-memory ldq_u #x0b)
+  (define-memory stw   #x0d)            ; BWX extension
+  (define-memory stb   #x0e)            ; BWX extension
   (define-memory stl   #x2c)
   (define-memory stq   #x2d)
   (define-memory stl_c #x2e)
@@ -357,7 +361,11 @@
   (define-operate mulq/v #x13 #x60)
   (define-operate mull/v #x13 #x40)
   (define-operate umulh  #x13 #x30)
-  (define-operate mulq   #x13 #x20))
+  (define-operate mulq   #x13 #x20)
+
+  (define-operate ctpop  #x1c #x30)     ; CIX extension
+  (define-operate ctlz   #x1c #x32)     ; CIX extension
+  (define-operate cttz   #x1c #x33))    ; CIX extension
 
 
 (macrolet ((define-fp-operate (name op fn &optional (args 3))
@@ -409,14 +417,14 @@
   (define-fp-operate subt #x16 #x0a1)
 
 ;;; IEEE support
-  (defconstant +su+   #x500)		; software, underflow enabled
-  (defconstant +sui+  #x700)		; software, inexact & underflow enabled
-  (defconstant +sv+   #x500)		; software, interger overflow enabled
-  (defconstant +svi+  #x700)
-  (defconstant +rnd+  #x0c0)		; dynamic rounding mode
-  (defconstant +sud+  #x5c0)
-  (defconstant +svid+ #x7c0)
-  (defconstant +suid+ #x7c0)
+  (def!constant +su+   #x500)		; software, underflow enabled
+  (def!constant +sui+  #x700)		; software, inexact & underflow enabled
+  (def!constant +sv+   #x500)		; software, interger overflow enabled
+  (def!constant +svi+  #x700)
+  (def!constant +rnd+  #x0c0)		; dynamic rounding mode
+  (def!constant +sud+  #x5c0)
+  (def!constant +svid+ #x7c0)
+  (def!constant +suid+ #x7c0)
 
   (define-fp-operate cvtqs_su #x16 (logior +su+ #x0bc) 2)
   (define-fp-operate cvtqs_sui #x16 (logior +sui+ #x0bc) 2)
@@ -442,6 +450,9 @@
 (define-instruction trapb (segment)
   (:emitter (emit-lword segment #x63ff0000)))
 
+(define-instruction imb (segment)
+  (:emitter (emit-lword segment #x00000086)))
+
 (define-instruction gentrap (segment code)
   (:printer call-pal ((palcode #xaa0000)))
   (:emitter
@@ -492,10 +503,36 @@
 	 (unless (= high 0)
 	   (inst ldah reg high reg)))))
     ((or (unsigned-byte 32) (signed-byte 64) (unsigned-byte 64))
+     ;; Since it took NJF and CSR a good deal of puzzling to work out
+     ;; (a) what a previous version of this was doing and (b) why it
+     ;; was wrong:
+     ;;
+     ;; write VALUE = a_63 * 2^63 + a_48-62 * 2^48 
+     ;;               + a_47 * 2^47 + a_32-46 * 2^32
+     ;;               + a_31 * 2^31 + a_16-30 * 2^16
+     ;;               + a_15 * 2^15 + a_0-14
+     ;;
+     ;; then, because of the wonders of sign-extension and
+     ;; twos-complement arithmetic modulo 2^64, if a_15 is set, LDA
+     ;; (which sign-extends its argument) will add 
+     ;;
+     ;;    (a_15 * 2^15 + a_0-14 - 65536).  
+     ;;
+     ;; So we need to add that 65536 back on, which is what this
+     ;; LOGBITP business is doing.  The same applies for bits 31 and
+     ;; 47 (bit 63 is taken care of by the fact that all of this
+     ;; arithmetic is mod 2^64 anyway), but we have to be careful that
+     ;; we consider the altered value, not the original value.
+     ;;
+     ;; I think, anyway.  -- CSR, 2003-09-26
      (let* ((value1 (if (logbitp 15 value) (+ value (ash 1 16)) value))
-	    (value2 (if (logbitp 31 value) (+ value (ash 1 32)) value1))
-	    (value3 (if (logbitp 47 value) (+ value (ash 1 48)) value2)))
+	    (value2 (if (logbitp 31 value1) (+ value1 (ash 1 32)) value1))
+	    (value3 (if (logbitp 47 value2) (+ value2 (ash 1 48)) value2)))
        (inst lda reg (ldb (byte 16 32) value2) zero-tn)
+       ;; FIXME: Don't yet understand these conditionals.  If I'm
+       ;; right, surely we can just consider the zeroness of the
+       ;; particular bitfield, not the zeroness of the whole thing?
+       ;; -- CSR, 2003-09-26
        (unless (= value3 0)
 	 (inst ldah reg (ldb (byte 16 48) value3) reg))
        (unless (and (= value2 0) (= value3 0))