[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Wed Jul 14 10:03:45 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv27873
Modified Files:
integers.lisp
Log Message:
Fixed bogus implementations of abs, signum, max, and min.
Date: Wed Jul 14 03:03:45 2004
Author: ffjeld
Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.53 movitz/losp/muerte/integers.lisp:1.54
--- movitz/losp/muerte/integers.lisp:1.53 Tue Jul 13 15:43:40 2004
+++ movitz/losp/muerte/integers.lisp Wed Jul 14 03:03:44 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.53 2004/07/13 22:43:40 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.54 2004/07/14 10:03:44 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -938,90 +938,59 @@
`(< ,number 0))
(define-compiler-macro abs (x)
- `(with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) ,x)
- (:testb #.movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program () (:int 107)))
- (:movl :eax :ecx)
- (:addl :ecx :ecx)
- (:sbbl :ecx :ecx)
- (:xorl :ecx :eax)
- (:subl :ecx :eax)))
+ `(let ((x ,x))
+ (if (>= 0 x) x (- x))))
(defun abs (x)
(abs x))
(defun signum (x)
- (with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) x)
- (:testb #.movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program (not-fixnum) (:int 107)))
- (:cdq :eax :edx)
- (:negl :eax)
- (:adcl :edx :edx)
- (:leal ((:edx #.movitz::+movitz-fixnum-factor+)) :eax)))
+ (cond
+ ((> x 0) 1)
+ ((< x 0) -1)
+ (t 0)))
;;;
-(define-compiler-macro max%2op (number1 number2)
- #+ignore
- `(let ((number1 ,number1) (number2 ,number2))
- (if (< number1 number2)
- number2 number1))
- (let ((label (gensym)))
- `(with-inline-assembly (:returns :eax :type fixnum)
- (:compile-two-forms (:eax :ebx) ,number1 ,number2)
- (:movl :ebx :ecx)
- (:orl :eax :ecx)
- (:testb ,movitz::+movitz-fixnum-zmask+ :cl)
- (:jnz '(:sub-program () (:int 107)))
- (:cmpl :eax :ebx)
- (:jl ',label)
- (:movl :ebx :eax)
- ,label)))
-
-
-(defun max%2op (number1 number2)
- (max%2op number1 number2))
-
(define-compiler-macro max (&whole form first-number &rest more-numbers)
(case (length more-numbers)
(0 first-number)
- (1 `(max%2op ,first-number ,(car more-numbers)))
+ (1 `(let ((x ,first-number)
+ (y ,(car more-numbers)))
+ (if (>= x y) x y)))
((2 3 4)
- `(max%2op ,first-number (max , at more-numbers)))
+ `(max ,first-number (max , at more-numbers)))
(t form)))
(defun max (number1 &rest numbers)
- (declare (dynamic-extent numbers))
- (let ((max number1))
- (dolist (x numbers max)
- (when (>= x max)
- (setq max x)))))
-
-(define-compiler-macro min%2op (number1 number2)
- `(let ((number1 ,number1) (number2 ,number2))
- (if (< number1 number2)
- number1 number2)))
-
-(defun min%2op (number1 number2)
- (min%2op number1 number2))
+ (numargs-case
+ (2 (x y) (max x y))
+ (t (number1 &rest numbers)
+ (declare (dynamic-extent numbers))
+ (let ((max number1))
+ (dolist (x numbers max)
+ (when (> x max)
+ (setq max x)))))))
(define-compiler-macro min (&whole form first-number &rest more-numbers)
(case (length more-numbers)
(0 first-number)
- (1 `(min%2op ,first-number ,(car more-numbers)))
+ (1 `(let ((x ,first-number)
+ (y ,(car more-numbers)))
+ (if (<= x y) x y)))
((2 3 4)
- `(min%2op ,first-number (min , at more-numbers)))
+ `(min ,first-number (min , at more-numbers)))
(t form)))
(defun min (number1 &rest numbers)
- (declare (dynamic-extent numbers))
- #+ignore (reduce #'min%2op numbers :initial-value number1)
- (let ((min number1))
- (dolist (x numbers min)
- (when (< x min)
- (setq min x)))))
+ (numargs-case
+ (2 (x y) (min x y))
+ (t (number1 &rest numbers)
+ (declare (dynamic-extent numbers))
+ (let ((min number1))
+ (dolist (x numbers min)
+ (when (< x min)
+ (setq min x)))))))
;; shift
@@ -1138,10 +1107,11 @@
`(* ,(movitz:movitz-eval factor2 env) ,factor1))
((movitz:movitz-constantp factor1 env)
(let ((f1 (movitz:movitz-eval factor1 env)))
- (check-type f1 fixnum)
+ (check-type f1 integer)
(case f1
(0 `(progn ,factor2 0))
(1 factor2)
+;;; (2 `(let ((x ,factor2)) (+ x x)))
(t `(no-macro-call * ,factor1 ,factor2)))))
(t `(no-macro-call * ,factor1 ,factor2)))))
(t `(* (* ,(first operands) ,(second operands)) ,@(cddr operands)))))
@@ -1564,34 +1534,6 @@
(:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
(:btl :ecx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))))))))
(do-it)))
-
-;;;(define-compiler-macro logbitp (&whole form index integer &environment env)
-;;; (if (not (movitz:movitz-constantp index env))
-;;; form
-;;; (let ((index (movitz::movitz-eval index env)))
-;;; (check-type index (integer 0 30))
-;;; `(with-inline-assembly (:returns :boolean-cf=1)
-;;; (:compile-form (:result-mode :eax) ,integer)
-;;; (:testb #.movitz::+movitz-fixnum-zmask+ :al)
-;;; (:jnz '(:sub-program () (:int 107)))
-;;; (:btl ,(+ index movitz::+movitz-fixnum-shift+) :eax)))))
-
-
-;;;(defun logand%2op (x y)
-;;; (with-inline-assembly (:returns :eax)
-;;; (:compile-form (:result-mode :eax) x)
-;;; (:compile-form (:result-mode :ebx) y)
-;;; (:testb #.movitz::+movitz-fixnum-zmask+ :al)
-;;; (:jnz '(:sub-program () (:int 107)))
-;;; (:testb #.movitz::+movitz-fixnum-zmask+ :bl)
-;;; (:jnz '(:sub-program () (:movl :ebx :eax) (:int 107)))
-;;; (:andl :ebx :eax)))
-;;;
-;;;(define-compiler-macro logand%2op (&whole form x y)
-;;; (cond
-;;; ((and (movitz:movitz-constantp x) (movitz:movitz-constantp y))
-;;; (logand (movitz::movitz-eval x) (movitz::movitz-eval y)))
-;;; (t form)))
(define-compiler-macro logand (&whole form &rest integers &environment env)
(let ((constant-folded-integers (loop for x in integers
More information about the Movitz-cvs
mailing list