+(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))
+