Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25792
Modified Files: integers.lisp Log Message: Starting work on *.
Date: Sun Jun 6 03:24:29 2004 Author: ffjeld
Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.20 movitz/losp/muerte/integers.lisp:1.21 --- movitz/losp/muerte/integers.lisp:1.20 Sat Jun 5 20:00:13 2004 +++ movitz/losp/muerte/integers.lisp Sun Jun 6 03:24:29 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.20 2004/06/06 03:00:13 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.21 2004/06/06 10:24:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -719,48 +719,36 @@ (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) :al))) (t (if (= 0 integer) 0 (error "Illegal ash count: ~D" count)))))
- ;;; Multiplication
-(define-compiler-macro *%2op (&whole form &environment env factor1 factor2) - (cond - ((and (movitz:movitz-constantp factor1 env) - (movitz:movitz-constantp factor2 env)) - (* (movitz:movitz-eval factor1 env) - (movitz:movitz-eval factor2 env))) - ((movitz:movitz-constantp factor2 env) - `(*%2op ,(movitz:movitz-eval factor2 env) ,factor1)) - ((movitz:movitz-constantp factor1 env) - (let ((f1 (movitz:movitz-eval factor1 env))) - (check-type f1 fixnum) - (case f1 - (0 `(progn ,factor2 0)) - (1 factor2) - (2 `(ash ,factor2 1)) - (t `(with-inline-assembly (:returns :eax :type integer) - (:compile-form (:result-mode :eax) ,factor2) - (:testb #.movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program () (:int 107))) - (:imull ,f1 :eax :eax) - (:into)))))) - (t `(no-macro-call * ,factor1 ,factor2)))) - -;;;(defun *%2op (factor1 factor2) -;;; (check-type factor1 fixnum) -;;; (check-type factor2 fixnum) -;;; (with-inline-assembly (:returns :eax) -;;; (:compile-form (:result-mode :eax) factor1) -;;; (:compile-form (:result-mode :ebx) factor2) -;;; (:sarl #.movitz::+movitz-fixnum-shift+ :eax) -;;; (:imull :ebx :eax :edx) -;;; (:into))) - -(define-compiler-macro * (&whole form &rest operands) +(define-compiler-macro * (&whole form &rest operands &environment env) (case (length operands) (0 0) (1 (first operands)) - (2 `(*%2op ,(first operands) ,(second operands))) - (t `(* (*%2op ,(first operands) ,(second operands)) ,@(cddr operands))))) + (2 (let ((factor1 (first operands)) + (factor2 (second operands))) + (cond + ((and (movitz:movitz-constantp factor1 env) + (movitz:movitz-constantp factor2 env)) + (* (movitz:movitz-eval factor1 env) + (movitz:movitz-eval factor2 env))) + ((movitz:movitz-constantp factor2 env) + `(* ,(movitz:movitz-eval factor2 env) ,factor1)) + ((movitz:movitz-constantp factor1 env) + (let ((f1 (movitz:movitz-eval factor1 env))) + (check-type f1 fixnum) + (case f1 + (0 `(progn ,factor2 0)) + (1 factor2) + (2 `(ash ,factor2 1)) + (t `(with-inline-assembly (:returns :eax :type integer) + (:compile-form (:result-mode :eax) ,factor2) + (:testb #.movitz::+movitz-fixnum-zmask+ :al) + (:jnz '(:sub-program () (:int 107))) + (:imull ,f1 :eax :eax) + (:into)))))) + (t `(no-macro-call * ,factor1 ,factor2))))) + (t `(* (* ,(first operands) ,(second operands)) ,@(cddr operands)))))
(defun * (&rest factors) (numargs-case @@ -782,7 +770,7 @@ (declare (dynamic-extent factors)) (if (null factors) 1 - (reduce '*%2op factors))))) + (reduce '* factors)))))
;;; Division
@@ -1353,7 +1341,7 @@
(defun print-bignum (x) (check-type x bignum) - (loop for i from 0 to (%bignum-bigits x) - do (format t "~8,'0X " (memref x -6 i :unsigned-byte32))) + (dotimes (i (1+ (%bignum-bigits x))) + (format t "~8,'0X " (memref x -6 i :unsigned-byte32))) (terpri) (values))