[Openmcl-cvs-notifications] r10496 - /trunk/source/compiler/X86/x862.lisp

[gb at clozure.com]

Author: gb
Date: Tue Aug 19 08:24:21 2008
New Revision: 10496

Log:
There were 2 versions of X862-LONG-CONSTANT-P.  The one that we in
effect (the second one defined in this file) was leftover from MCL,
and allowed strings of length 4 (and symbols whose pnames were of
length 4) to be interpreted as "long" constants (this was leftover
support for "OSTypes"); it also allowed integer constants of unspecified
width and signedness.

Replace that with (and change the one caller to use) X862-INTEGER-CONSTANT-=
P,
which takes an acode form and a mode name and returns an integer if the
form represents an constant integer of the indicated type.

(In other words:

? (#_malloc :four)

> Error: value :FOUR is not of the expected type (UNSIGNED-BYTE 64).

? (defun foo ()
   (#_malloc :four))
FOO

shouldn't work (in compiled code) as an obscure way to allocate
#x666F7572 bytes, and =


? (defun foo ()
    (#_malloc -10))

- and other cases involving integer constants of the wrong width/
signedness - shouldn't work at all.)

Modified:
    trunk/source/compiler/X86/x862.lisp

Modified: trunk/source/compiler/X86/x862.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/x862.lisp (original)
+++ trunk/source/compiler/X86/x862.lisp Tue Aug 19 08:24:21 2008
@@ -2971,14 +2971,16 @@
 =

 =

   =

-(defun x862-long-constant-p (form)
-  (setq form (acode-unwrapped-form form))
-  (or (acode-fixnum-form-p form)
-      (and (acode-p form)
-           (eq (acode-operator form) (%nx1-operator immediate))
-           (setq form (%cadr form))
-           (if (integerp form) =

-             form))))
+(defun x862-integer-constant-p (form mode)
+  (let* ((val =

+         (or (acode-fixnum-form-p (setq form (acode-unwrapped-form form)))
+             (and (acode-p form)
+                  (eq (acode-operator form) (%nx1-operator immediate))
+                  (setq form (%cadr form))
+                  (if (typep form 'integer)
+                    form)))))
+    (and val (%typep val (mode-specifier-type mode)) val)))
+         =

 =

 =

 (defun x86-side-effect-free-form-p (form)
@@ -3031,12 +3033,6 @@
     (x862-formlist seg (car args) (cadr args))))
 =

 =

-
-
-;;; treat form as a 32-bit immediate value and load it into immreg.
-;;; This is the "lenient" version of 32-bit-ness; OSTYPEs and chars
-;;; count, and we don't care about the integer's sign.
-
 (defun x862-unboxed-integer-arg-to-reg (seg form immreg &optional ffi-arg-=
type)
   (let* ((mode (ecase ffi-arg-type
                  ((nil) :natural)
@@ -3050,12 +3046,14 @@
                  (:signed-doubleword :s64)))
          (modeval (gpr-mode-name-value mode)))
     (with-x86-local-vinsn-macros (seg)
-      (let* ((value (x862-long-constant-p form)))
+      (let* ((value (x862-integer-constant-p form mode)))
         (if value
           (progn
             (unless (typep immreg 'lreg)
               (setq immreg (make-unwired-lreg immreg :mode modeval)))
-            (x862-lri seg immreg value)
+            (if (< value 0)
+              (x862-lri seg immreg value)
+              (x862-lriu seg immreg value))
             immreg)
           (progn =

             (x862-one-targeted-reg-form seg form (make-wired-lreg *x862-im=
m0* :mode modeval))))))))
@@ -5153,22 +5151,7 @@
     (x862-make-compound-cd (x862-cd-false cd) (x862-cd-true cd) (logbitp $=
backend-mvpass-bit cd))
     cd))
 =

-(defun x862-long-constant-p (form)
-  (setq form (acode-unwrapped-form form))
-  (or (acode-fixnum-form-p form)
-      (and (acode-p form)
-           (eq (acode-operator form) (%nx1-operator immediate))
-           (setq form (%cadr form))
-           (if (integerp form) =

-             form
-             (progn
-               (if (symbolp form) (setq form (symbol-name form)))
-               (if (and (stringp form) (eql (length form) 4))
-                 (logior (ash (%char-code (char form 0)) 24)
-                         (ash (%char-code (char form 1)) 16)
-                         (ash (%char-code (char form 2)) 8)
-                         (%char-code (char form 3)))
-                 (if (characterp form) (%char-code form))))))))
+
 =

 ;;; execute body, cleanup afterwards (if need to)
 (defun x862-undo-body (seg vreg xfer body old-stack)