Changeset 5341

Timestamp:

Oct 13, 2006, 3:54:29 AM (18 years ago)

Author:

Gary Byers

Message:

Use new NUMCMP operator.

File:

• trunk/ccl/compiler/nx1.lisp (modified) (5 diffs)

trunk/ccl/compiler/nx1.lisp

@@ -208 +208 @@
 (defnx1 nx1-ccEQ-unaryop ((characterp)  (endp) (consp) (base-char-p)) (arg)
   (make-acode (%nx1-default-operator) (nx1-immediate :EQ) (nx1-form arg)))
-
-
-
 
 
@@ -595 +592 @@
   (let* ((op *nx-sfname*)
          (both-fixnums (nx-binary-fixnum-op-p num1 num2 env t))
-         (both-natural (nx-binary-natural-op-p num1 num2 env ))
+         (both-natural (nx-binary-natural-op-p num1 num2 env ))
          (both-double-floats
           (let* ((dfloat-1 (nx-form-typep num1 'double-float env))
@@ -613 +610 @@
        (if both-fixnums
          (%nx1-operator %i<>)
-         (if both-natural
-           (%nx1-operator %natural<>)
-           (if both-double-floats
-             (%nx1-operator double-float-compare)
-             (%nx1-operator short-float-compare))))
+         (if both-natural
+           (%nx1-operator %natural<>)
+           (if both-double-floats
+             (%nx1-operator double-float-compare)
+             (%nx1-operator short-float-compare))))
        (make-acode
         (%nx1-operator immediate)
@@ -629 +626 @@
        (nx1-form num1)
        (nx1-form num2))
-      (nx1-treat-as-call whole))))
+      (make-acode (%nx1-operator numcmp)
+                  (make-acode
+                   (%nx1-operator immediate)
+                   (if (eq op '<-2)
+                     :LT
+                     (if (eq op '>=-2)
+                       :GE
+                       (if (eq op '<=-2)
+                         :LE
+                         :GT))))
+                  (nx1-form num1)
+                  (nx1-form num2)))))
 
 (defnx1 nx1-num= ((=-2) (/=-2)) (&whole whole &environment env num1 num2 )
@@ -673 +681 @@
            (nx1-form num1)
            (nx1-form num2))
-          (nx1-treat-as-call whole))))))
+          (make-acode (%nx1-operator numcmp)
+                      (make-acode
+                       (%nx1-operator immediate)     
+                       (if (eq op '=-2)
+                         :EQ
+                         :NE))
+                      (nx1-form num1)
+                      (nx1-form num2)))))))