-(macrolet ((define-modular-backend (fun &optional constantp)
- (collect ((forms))
- (dolist (info '((60 fixnum) (64 unsigned)))
- (destructuring-bind (width regtype) info
- (let ((mfun-name (intern (format nil "~A-MOD~A" fun width)))
- (mvop (intern (format nil "FAST-~A-MOD~A/~A=>~A"
- fun width regtype regtype)))
- (mcvop (intern (format nil "FAST-~A-MOD~A-C/~A=>~A"
- fun width regtype regtype)))
- (vop (intern (format nil "FAST-~A/~A=>~A"
- fun regtype regtype)))
- (cvop (intern (format nil "FAST-~A-C/~A=>~A"
- fun regtype regtype))))
- (forms `(define-modular-fun ,mfun-name (x y) ,fun ,width))
- (forms `(define-vop (,mvop ,vop)
- (:translate ,mfun-name)))
- (when constantp
- (forms `(define-vop (,mcvop ,cvop)
- (:translate ,mfun-name)))))))
- `(progn ,@(forms)))))
- (define-modular-backend + t)
- (define-modular-backend - t)
- (define-modular-backend *) ; FIXME: there exists a
- ; FAST-*-C/FIXNUM=>FIXNUM VOP which
- ; should be used for the MOD60 case,
- ; but the MOD64 case cannot accept
- ; immediate arguments.
- (define-modular-backend logxor t))
+(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 31) (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 ((fun64 (intern (format nil "~S-MOD64" 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)))
+ (vop64u (intern (format nil "FAST-~S-MOD64/WORD=>UNSIGNED" name)))
+ (vop64f (intern (format nil "FAST-~S-MOD64/FIXNUM=>FIXNUM" name)))
+ (vop64cu (intern (format nil "FAST-~S-MOD64-C/WORD=>UNSIGNED" name)))
+ (vop64cf (intern (format nil "FAST-~S-MOD64-C/FIXNUM=>FIXNUM" name)))
+ (sfun61 (intern (format nil "~S-SMOD61" name)))
+ (svop61f (intern (format nil "FAST-~S-SMOD61/FIXNUM=>FIXNUM" name)))
+ (svop61cf (intern (format nil "FAST-~S-SMOD61-C/FIXNUM=>FIXNUM" name))))
+ `(progn
+ (define-modular-fun ,fun64 (x y) ,name :unsigned 64)
+ (define-modular-fun ,sfun61 (x y) ,name :signed 61)
+ (define-mod-binop (,vop64u ,vopu) ,fun64)
+ (define-vop (,vop64f ,vopf) (:translate ,fun64))
+ (define-vop (,svop61f ,vopf) (:translate ,sfun61))
+ ,@(when -c-p
+ `((define-mod-binop-c (,vop64cu ,vopcu) ,fun64)
+ (define-vop (,svop61cf ,vopcf) (:translate ,sfun61))))))))
+ (def + t)
+ (def - t)
+ ;; (no -C variant as x86 MUL instruction doesn't take an immediate)
+ (def * nil))