-;;; -*- Package: ALPHA; Log: C.Log -*-
-;;;
-;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
-;;; Carnegie Mellon University, and has been placed in the public domain.
-;;;
+;;;; the VM definition arithmetic VOPs for the Alpha
-;;;
-;;; **********************************************************************
-;;;
-;;; $Header$
-;;;
-;;; This file contains the VM definition arithmetic VOPs for the MIPS.
-;;;
-;;; Written by Rob MacLachlan
-;;; Converted by Sean Hallgren
-;;;
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
(in-package "SB!VM")
-
-
-
\f
-;;;; Unary operations.
+;;;; unary operations
(define-vop (fixnum-unop)
(:args (x :scs (any-reg)))
(:translate lognot)
(:generator 1
(inst not x res)))
-
-
\f
-;;;; Binary fixnum operations.
+;;;; binary fixnum operations
;;; Assume that any constant operand is the second arg...
(define-binop lognor 1 3 ornot (unsigned-byte 6) (unsigned-byte 8))
(define-binop logand 1 3 and (unsigned-byte 6) (unsigned-byte 8))
(define-binop logxor 1 3 xor (unsigned-byte 6) (unsigned-byte 8))
-
-
-;;; Shifting
-
+\f
+;;;; shifting
(define-vop (fast-ash)
(:note "inline ASH")
(inst and num mask num)
(inst and temp mask temp)
(inst addq num temp res)))
-
-
-;;; Multiply
+\f
+;;;; multiplying
(define-vop (fast-*/fixnum=>fixnum fast-fixnum-binop)
(:temporary (:scs (non-descriptor-reg)) temp)
(:translate *)
(:generator 3
(inst mulq x y r)))
-
-
\f
-;;;; Binary conditional VOPs:
+;;;; binary conditional VOPs
(define-vop (fast-conditional)
(:conditional)
(inst beq temp target)
(inst bne temp target)))))
-;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
-;;; known fixnum.
+;;; EQL/FIXNUM is funny because the first arg can be of any type, not
+;;; just a known fixnum.
(define-conditional-vop eql
(declare (ignore signed))
(inst beq temp target)
(inst bne temp target)))
-;;; These versions specify a fixnum restriction on their first arg. We have
-;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
-;;; the first arg and a higher cost. The reason for doing this is to prevent
-;;; fixnum specific operations from being used on word integers, spuriously
-;;; consing the argument.
-;;;
+;;; These versions specify a fixnum restriction on their first arg. We
+;;; have also generic-eql/fixnum VOPs which are the same, but have no
+;;; restriction on the first arg and a higher cost. The reason for
+;;; doing this is to prevent fixnum specific operations from being
+;;; used on word integers, spuriously consing the argument.
(define-vop (fast-eql/fixnum fast-conditional)
(:args (x :scs (any-reg))
(y :scs (any-reg)))
(:generator 1
(inst and amount #x1f temp)
(inst sll num temp r)))
-
-
\f
-;;;; Bignum stuff.
+;;;; bignum stuff
(define-vop (bignum-length get-header-data)
(:translate sb!bignum::%bignum-length)
(:translate sb!bignum::%bignum-set-length)
(:policy :fast-safe))
-(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-type
+(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
(unsigned-reg) unsigned-num sb!bignum::%bignum-ref)
-(define-full-setter bignum-set * bignum-digits-offset other-pointer-type
+(define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
(unsigned-reg) unsigned-num sb!bignum::%bignum-set #+gengc nil)
(define-vop (digit-0-or-plus)
(:translate sb!bignum::%ashl)
(:generator 1
(inst sll digit count result)))
-
\f
-;;;; Static functions.
+;;;; static functions
-(define-static-function two-arg-gcd (x y) :translate gcd)
-(define-static-function two-arg-lcm (x y) :translate lcm)
+(define-static-fun two-arg-gcd (x y) :translate gcd)
+(define-static-fun two-arg-lcm (x y) :translate lcm)
-(define-static-function two-arg-+ (x y) :translate +)
-(define-static-function two-arg-- (x y) :translate -)
-(define-static-function two-arg-* (x y) :translate *)
-(define-static-function two-arg-/ (x y) :translate /)
+(define-static-fun two-arg-+ (x y) :translate +)
+(define-static-fun two-arg-- (x y) :translate -)
+(define-static-fun two-arg-* (x y) :translate *)
+(define-static-fun two-arg-/ (x y) :translate /)
-(define-static-function two-arg-< (x y) :translate <)
-(define-static-function two-arg-<= (x y) :translate <=)
-(define-static-function two-arg-> (x y) :translate >)
-(define-static-function two-arg->= (x y) :translate >=)
-(define-static-function two-arg-= (x y) :translate =)
-(define-static-function two-arg-/= (x y) :translate /=)
+(define-static-fun two-arg-< (x y) :translate <)
+(define-static-fun two-arg-<= (x y) :translate <=)
+(define-static-fun two-arg-> (x y) :translate >)
+(define-static-fun two-arg->= (x y) :translate >=)
+(define-static-fun two-arg-= (x y) :translate =)
+(define-static-fun two-arg-/= (x y) :translate /=)
-(define-static-function %negate (x) :translate %negate)
+(define-static-fun %negate (x) :translate %negate)
-(define-static-function two-arg-and (x y) :translate logand)
-(define-static-function two-arg-ior (x y) :translate logior)
-(define-static-function two-arg-xor (x y) :translate logxor)
+(define-static-fun two-arg-and (x y) :translate logand)
+(define-static-fun two-arg-ior (x y) :translate logior)
+(define-static-fun two-arg-xor (x y) :translate logxor)
projects / sbcl.git / blobdiff