+(defmacro define-mod-binop ((name prototype) function)
+ `(define-vop (,name ,prototype)
+ (:args (x :target r :scs (unsigned-reg signed-reg)
+ :load-if (not (and (or (sc-is x unsigned-stack)
+ (sc-is x signed-stack))
+ (or (sc-is y unsigned-reg)
+ (sc-is y signed-reg))
+ (or (sc-is r unsigned-stack)
+ (sc-is r signed-stack))
+ (location= x r))))
+ (y :scs (unsigned-reg signed-reg unsigned-stack signed-stack)))
+ (:arg-types untagged-num untagged-num)
+ (:results (r :scs (unsigned-reg signed-reg) :from (:argument 0)
+ :load-if (not (and (or (sc-is x unsigned-stack)
+ (sc-is x signed-stack))
+ (or (sc-is y unsigned-reg)
+ (sc-is y unsigned-reg))
+ (or (sc-is r unsigned-stack)
+ (sc-is r unsigned-stack))
+ (location= x r)))))
+ (:result-types unsigned-num)
+ (:translate ,function)))
+(defmacro define-mod-binop-c ((name prototype) function)
+ `(define-vop (,name ,prototype)
+ (:args (x :target r :scs (unsigned-reg signed-reg)
+ :load-if (not (and (or (sc-is x unsigned-stack)
+ (sc-is x signed-stack))
+ (or (sc-is r unsigned-stack)
+ (sc-is r signed-stack))
+ (location= x r)))))
+ (:info y)
+ (:arg-types untagged-num (:constant (or (unsigned-byte 32) (signed-byte 32))))
+ (:results (r :scs (unsigned-reg signed-reg) :from (:argument 0)
+ :load-if (not (and (or (sc-is x unsigned-stack)
+ (sc-is x signed-stack))
+ (or (sc-is r unsigned-stack)
+ (sc-is r unsigned-stack))
+ (location= x r)))))
+ (:result-types unsigned-num)
+ (:translate ,function)))
+
+(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/WORD=>UNSIGNED" name)))
+ (vop32f (intern (format nil "FAST-~S-MOD32/FIXNUM=>FIXNUM" name)))
+ (vop32cu (intern (format nil "FAST-~S-MOD32-C/WORD=>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 :untagged nil 32)
+ (define-modular-fun ,sfun30 (x y) ,name :tagged t 30)
+ (define-mod-binop (,vop32u ,vopu) ,fun32)
+ (define-vop (,vop32f ,vopf) (:translate ,fun32))
+ (define-vop (,svop30f ,vopf) (:translate ,sfun30))
+ ,@(when -c-p
+ `((define-mod-binop-c (,vop32cu ,vopcu) ,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))