+;;;; Modular functions
+
+(macrolet ((def (name -c-p)
+ (let ((fun32 (intern (format nil "~S-MOD32" name)))
+ (vopu (intern (format nil "FAST-~S/UNSIGNED=>UNSIGNED" name)))
+ (vopcu (intern (format nil "FAST-~S-C/UNSIGNED=>UNSIGNED" name)))
+ (vopf (intern (format nil "FAST-~S/FIXNUM=>FIXNUM" name)))
+ (vopcf (intern (format nil "FAST-~S-C/FIXNUM=>FIXNUM" name)))
+ (vop32u (intern (format nil "FAST-~S-MOD32/UNSIGNED=>UNSIGNED" name)))
+ (vop32f (intern (format nil "FAST-~S-MOD32/FIXNUM=>FIXNUM" name)))
+ (vop32cu (intern (format nil "FAST-~S-MOD32-C/UNSIGNED=>UNSIGNED" name)))
+ (vop32cf (intern (format nil "FAST-~S-MOD32-C/FIXNUM=>FIXNUM" name)))
+ (sfun30 (intern (format nil "~S-SMOD30" name)))
+ (svop30f (intern (format nil "FAST-~S-SMOD30/FIXNUM=>FIXNUM" name)))
+ (svop30cf (intern (format nil "FAST-~S-SMOD30-C/FIXNUM=>FIXNUM" name))))
+ `(progn
+ (define-modular-fun ,fun32 (x y) ,name :unsigned 32)
+ (define-modular-fun ,sfun30 (x y) ,name :signed 30)
+ (define-vop (,vop32u ,vopu) (:translate ,fun32))
+ (define-vop (,vop32f ,vopf) (:translate ,fun32))
+ (define-vop (,svop30f ,vopf) (:translate ,sfun30))
+ ,@(when -c-p
+ `((define-vop (,vop32cu ,vopcu) (:translate ,fun32))
+ (define-vop (,svop30cf ,vopcf) (:translate ,sfun30))))))))
+ (def + t)
+ (def - t)
+ ;; (no -C variant as x86 MUL instruction doesn't take an immediate)
+ (def * nil))
+
+
+(define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
+ fast-ash-c/unsigned=>unsigned)
+ (:translate ash-left-mod32))
+
+(define-vop (fast-ash-left-mod32/unsigned=>unsigned
+ fast-ash-left/unsigned=>unsigned))
+(deftransform ash-left-mod32 ((integer count)
+ ((unsigned-byte 32) (unsigned-byte 5)))
+ (when (sb!c::constant-lvar-p count)
+ (sb!c::give-up-ir1-transform))
+ '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))
+
+(define-vop (fast-ash-left-smod30-c/fixnum=>fixnum
+ fast-ash-c/fixnum=>fixnum)
+ (:translate ash-left-smod30))
+
+(define-vop (fast-ash-left-smod30/fixnum=>fixnum
+ fast-ash-left/fixnum=>fixnum))
+(deftransform ash-left-smod30 ((integer count)
+ ((signed-byte 30) (unsigned-byte 5)))
+ (when (sb!c::constant-lvar-p count)
+ (sb!c::give-up-ir1-transform))
+ '(%primitive fast-ash-left-smod30/fixnum=>fixnum integer count))
+
+(in-package "SB!C")
+
+(defknown sb!vm::%lea-mod32 (integer integer (member 1 2 4 8) (signed-byte 32))
+ (unsigned-byte 32)
+ (foldable flushable movable))
+(defknown sb!vm::%lea-smod30 (integer integer (member 1 2 4 8) (signed-byte 32))
+ (signed-byte 30)
+ (foldable flushable movable))
+
+(define-modular-fun-optimizer %lea ((base index scale disp) :unsigned :width width)
+ (when (and (<= width 32)
+ (constant-lvar-p scale)
+ (constant-lvar-p disp))
+ (cut-to-width base :unsigned width)
+ (cut-to-width index :unsigned width)
+ 'sb!vm::%lea-mod32))
+(define-modular-fun-optimizer %lea ((base index scale disp) :signed :width width)
+ (when (and (<= width 30)
+ (constant-lvar-p scale)
+ (constant-lvar-p disp))
+ (cut-to-width base :signed width)
+ (cut-to-width index :signed width)
+ 'sb!vm::%lea-smod30))
+
+#+sb-xc-host
+(progn
+ (defun sb!vm::%lea-mod32 (base index scale disp)
+ (ldb (byte 32 0) (%lea base index scale disp)))
+ (defun sb!vm::%lea-smod30 (base index scale disp)
+ (mask-signed-field 30 (%lea base index scale disp))))
+#-sb-xc-host
+(progn
+ (defun sb!vm::%lea-mod32 (base index scale disp)
+ (let ((base (logand base #xffffffff))
+ (index (logand index #xffffffff)))
+ ;; can't use modular version of %LEA, as we only have VOPs for
+ ;; constant SCALE and DISP.
+ (ldb (byte 32 0) (+ base (* index scale) disp))))
+ (defun sb!vm::%lea-smod30 (base index scale disp)
+ (let ((base (mask-signed-field 30 base))
+ (index (mask-signed-field 30 index)))
+ ;; can't use modular version of %LEA, as we only have VOPs for
+ ;; constant SCALE and DISP.
+ (mask-signed-field 30 (+ base (* index scale) disp)))))
+
+(in-package "SB!VM")
+
+(define-vop (%lea-mod32/unsigned=>unsigned
+ %lea/unsigned=>unsigned)
+ (:translate %lea-mod32))
+(define-vop (%lea-smod30/fixnum=>fixnum
+ %lea/fixnum=>fixnum)
+ (:translate %lea-smod30))
+
+;;; logical operations
+(define-modular-fun lognot-mod32 (x) lognot :unsigned 32)
+(define-vop (lognot-mod32/unsigned=>unsigned)
+ (:translate lognot-mod32)
+ (:args (x :scs (unsigned-reg unsigned-stack) :target r
+ :load-if (not (and (sc-is x unsigned-stack)
+ (sc-is r unsigned-stack)
+ (location= x r)))))
+ (:arg-types unsigned-num)
+ (:results (r :scs (unsigned-reg)
+ :load-if (not (and (sc-is x unsigned-stack)
+ (sc-is r unsigned-stack)
+ (location= x r)))))
+ (:result-types unsigned-num)
+ (:policy :fast-safe)
+ (:generator 1
+ (move r x)
+ (inst not r)))
+
+(define-modular-fun logxor-mod32 (x y) logxor :unsigned 32)
+(define-vop (fast-logxor-mod32/unsigned=>unsigned
+ fast-logxor/unsigned=>unsigned)
+ (:translate logxor-mod32))
+(define-vop (fast-logxor-mod32-c/unsigned=>unsigned
+ fast-logxor-c/unsigned=>unsigned)
+ (:translate logxor-mod32))
+(define-vop (fast-logxor-mod32/fixnum=>fixnum
+ fast-logxor/fixnum=>fixnum)
+ (:translate logxor-mod32))
+(define-vop (fast-logxor-mod32-c/fixnum=>fixnum
+ fast-logxor-c/fixnum=>fixnum)
+ (:translate logxor-mod32))
+
+(define-source-transform logeqv (&rest args)
+ (if (oddp (length args))
+ `(logxor ,@args)
+ `(lognot (logxor ,@args))))
+(define-source-transform logandc1 (x y)
+ `(logand (lognot ,x) ,y))
+(define-source-transform logandc2 (x y)
+ `(logand ,x (lognot ,y)))
+(define-source-transform logorc1 (x y)
+ `(logior (lognot ,x) ,y))
+(define-source-transform logorc2 (x y)
+ `(logior ,x (lognot ,y)))
+(define-source-transform lognor (x y)
+ `(lognot (logior ,x ,y)))
+(define-source-transform lognand (x y)
+ `(lognot (logand ,x ,y)))
+\f