seclass

[Sam S. <sd...@gn...>]

Seclass appears to be ignored:

(disassemble (lambda () (= 0 0)))


Disassembly of function :LAMBDA
(CONST 0) = 0
0 required arguments
0 optional arguments
No rest parameter
No keyword parameters
4 byte-code instructions:
0     (CONST&PUSH 0)                      ; 0
1     (CONST&PUSH 0)                      ; 0
2     (CALLSR 1 45)                       ; =
5     (SKIP&RET 1)
NIL

#'= is foldable!

PS. (= 0 x)  ==>  (zerop x), appended

-- 
Sam Steingold (http://www.podval.org/~sds) running w2k
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.honestreporting.com>
"A pint of sweat will save a gallon of blood."          -- George S. Patton


--- compiler.lisp	04 May 2004 08:58:52 -0400	1.188
+++ compiler.lisp	10 May 2004 19:07:04 -0400	
@@ -1965,6 +1965,12 @@
        (* . c-STAR)
        (- . c-MINUS)
        (/ . c-SLASH)
+       (= . c-ARCOMP)
+       (/= . c-ARCOMP)
+       (< . c-ARCOMP)
+       (<= . c-ARCOMP)
+       (> . c-ARCOMP)
+       (>= . c-ARCOMP)
        (SYS::SVSTORE . c-SVSTORE)
        (EQ . c-EQ)
        (EQL . c-EQL)
@@ -6464,6 +6470,32 @@
                         `(,first-part ,(/ const-prod))))
                   ,@other-parts))))))
 
+(defun c-ARCOMP ()
+  (test-list *form* 2)
+  (if (= (length *form*) 3)
+      (multiple-value-bind (v0 consts0-p) (c-constant-number (second *form*))
+        (if (and consts0-p (zerop v0))
+            (c-form (ecase (first *form*)
+                      (= `(ZEROP ,(third *form*)))
+                      (/= `(NOT (ZEROP ,(third *form*))))
+                      (< `(PLUSP ,(third *form*)))
+                      (<= `(NOT (MINUSP ,(third *form*))))
+                      (> `(MINUSP ,(third *form*)))
+                      (>= `(NOT (PLUSP ,(third *form*))))))
+            (multiple-value-bind (v1 consts1-p)
+                (c-constant-number (third *form*))
+              (c-GLOBAL-FUNCTION-CALL-form
+               (if (and consts1-p (zerop v1))
+                   (ecase (first *form*)
+                     (= `(ZEROP ,v0))
+                     (/= `(NOT (ZEROP ,v0)))
+                     (< `(MINUSP ,v0))
+                     (<= `(NOT (PLUSP ,v0)))
+                     (> `(PLUSP ,v0))
+                     (>= `(NOT (MINUSP ,v0)))))
+               `(,(first *form*) ,v0 ,v1)))))
+      (c-GLOBAL-FUNCTION-CALL (first *form*))))
+
 (defun c-SVSTORE ()
   (test-list *form* 4 4)
   ;; (sys::svstore arg1 arg2 arg3) -> (sys::%svstore arg3 arg1 arg2)