[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Fri Apr 23 13:02:23 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv21872
Modified Files:
integers.lisp
Log Message:
Fixed * a bit.
Date: Fri Apr 23 09:02:23 2004
Author: ffjeld
Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.7 movitz/losp/muerte/integers.lisp:1.8
--- movitz/losp/muerte/integers.lisp:1.7 Fri Apr 16 15:22:21 2004
+++ movitz/losp/muerte/integers.lisp Fri Apr 23 09:02:22 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.7 2004/04/16 19:22:21 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.8 2004/04/23 13:02:22 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -49,7 +49,7 @@
(t (let ((operands
(loop for operand in operands
if (movitz:movitz-constantp operand env)
- sum (movitz::eval-form operand env)
+ sum (movitz:movitz-eval operand env)
into constant-term
else collect operand
into non-constant-operands
@@ -71,24 +71,24 @@
(define-compiler-macro +%2op (&whole form term1 term2)
(cond
((and (movitz:movitz-constantp term1) ; first operand zero?
- (zerop (movitz::eval-form term1)))
+ (zerop (movitz:movitz-eval term1)))
term2) ; (+ 0 x) => x
((and (movitz:movitz-constantp term2) ; second operand zero?
- (zerop (movitz::eval-form term2)))
+ (zerop (movitz:movitz-eval term2)))
term1) ; (+ x 0) => x
((and (movitz:movitz-constantp term1)
(movitz:movitz-constantp term2))
- (+ (movitz::eval-form term1)
- (movitz::eval-form term2))) ; compile-time constant folding.
+ (+ (movitz:movitz-eval term1)
+ (movitz:movitz-eval term2))) ; compile-time constant folding.
((movitz:movitz-constantp term1)
- (let ((constant-term1 (movitz::eval-form term1)))
+ (let ((constant-term1 (movitz:movitz-eval term1)))
(check-type constant-term1 (signed-byte 30))
`(with-inline-assembly (:returns :register :side-effects nil) ; inline
(:compile-form (:result-mode :register) ,term2)
(:addl ,(* movitz::+movitz-fixnum-factor+ constant-term1) (:result-register))
(:into))))
((movitz:movitz-constantp term2)
- (let ((constant-term2 (movitz::eval-form term2)))
+ (let ((constant-term2 (movitz:movitz-eval term2)))
(check-type constant-term2 (signed-byte 30))
`(with-inline-assembly (:returns :register :side-effects nil) ; inline
(:compile-form (:result-mode :register) ,term1)
@@ -164,20 +164,20 @@
(define-compiler-macro -%2op (&whole form minuend subtrahend)
(cond
((and (movitz:movitz-constantp minuend) ; first operand zero?
- (zerop (movitz::eval-form minuend)))
+ (zerop (movitz:movitz-eval minuend)))
`(with-inline-assembly (:returns :register :side-effects nil)
(:compile-form (:result-mode :register) ,subtrahend)
(:negl (:result-register)) ; (- 0 x) => -x
(:into)))
((and (movitz:movitz-constantp subtrahend) ; second operand zero?
- (zerop (movitz::eval-form subtrahend)))
- (movitz::eval-form minuend)) ; (- x 0) => x
+ (zerop (movitz:movitz-eval subtrahend)))
+ (movitz:movitz-eval minuend)) ; (- x 0) => x
((and (movitz:movitz-constantp minuend)
(movitz:movitz-constantp subtrahend))
- (- (movitz::eval-form minuend)
- (movitz::eval-form subtrahend))) ; compile-time constant folding.
+ (- (movitz:movitz-eval minuend)
+ (movitz:movitz-eval subtrahend))) ; compile-time constant folding.
((movitz:movitz-constantp minuend)
- (let ((constant-minuend (movitz::eval-form minuend)))
+ (let ((constant-minuend (movitz:movitz-eval minuend)))
(check-type constant-minuend (signed-byte 30))
`(with-inline-assembly (:returns :register :side-effects nil) ; inline
(:compile-form (:result-mode :register) ,subtrahend)
@@ -186,7 +186,7 @@
(:into)
(:negl (:result-register)))))
((movitz:movitz-constantp subtrahend)
- (let ((constant-subtrahend (movitz::eval-form subtrahend)))
+ (let ((constant-subtrahend (movitz:movitz-eval subtrahend)))
(check-type constant-subtrahend (signed-byte 30))
`(+%2op ,minuend ,(- constant-subtrahend))))
(t `(with-inline-assembly (:returns :eax :side-effects nil)
@@ -254,14 +254,14 @@
(cond
((and (movitz:movitz-constantp min env)
(movitz:movitz-constantp max env))
- (let ((min (movitz::eval-form min env))
- (max (movitz::eval-form max env)))
+ (let ((min (movitz:movitz-eval min env))
+ (max (movitz:movitz-eval max env)))
(check-type min integer)
(check-type max integer)
;; (warn "~D -- ~D" min max)
(cond
((movitz:movitz-constantp x env)
- (<= min (movitz::eval-form x env) max))
+ (<= min (movitz:movitz-eval x env) max))
((< max min)
nil)
((= max min)
@@ -295,7 +295,7 @@
(:adcl 0 :ecx))))))))
#+ignore ; this is buggy.
((movitz:movitz-constantp min env)
- (let ((min (movitz::eval-form min env)))
+ (let ((min (movitz:movitz-eval min env)))
(check-type min integer)
(cond
((minusp min)
@@ -396,7 +396,7 @@
(:compile-form (:result-mode :eax) ,x)
(:testb ,movitz::+movitz-fixnum-zmask+ :al)
(:jnz '(:sub-program (,below-not-integer) (:int 107)))
- (:cmpl ,(* (movitz::eval-form max env)
+ (:cmpl ,(* (movitz:movitz-eval max env)
movitz::+movitz-fixnum-factor+)
:eax))
`(with-inline-assembly (:returns :boolean-cf=1)
@@ -607,8 +607,11 @@
((> 0 count #.(cl:- (cl:1- movitz::+movitz-fixnum-bits+)))
`(with-inline-assembly (:returns :register :side-effects nil :type integer)
, at load-integer
- (:sarl ,(- count) (:result-register))
- (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) (:result-register-low8))))
+ (:andl ,(ldb (byte 32 0)
+ (ash movitz:+movitz-most-positive-fixnum+
+ (- movitz:+movitz-fixnum-shift+ count)))
+ (:result-register))
+ (:sarl ,(- count) (:result-register))))
((minusp count)
`(if (minusp ,integer) -1 0))
(t `(if (= 0 ,integer) 0 (with-inline-assembly (:returns :non-local-exit) (:int 4)))))))))))
@@ -641,12 +644,12 @@
(cond
((and (movitz:movitz-constantp factor1 env)
(movitz:movitz-constantp factor2 env))
- (* (movitz::eval-form factor1 env)
- (movitz::eval-form factor2 env)))
+ (* (movitz:movitz-eval factor1 env)
+ (movitz:movitz-eval factor2 env)))
((movitz:movitz-constantp factor2 env)
- `(*%2op ,(movitz::eval-form factor2 env) ,factor1))
+ `(*%2op ,(movitz:movitz-eval factor2 env) ,factor1))
((movitz:movitz-constantp factor1 env)
- (let ((f1 (movitz::eval-form factor1 env)))
+ (let ((f1 (movitz:movitz-eval factor1 env)))
(check-type f1 integer)
(case f1
(0 `(progn ,factor2 0))
@@ -658,17 +661,17 @@
(:jnz '(:sub-program () (:int 107)))
(:imull ,f1 :eax :eax)
(:into))))))
- (t form)))
+ (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)))
+;;;(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)
(case (length operands)
@@ -723,7 +726,7 @@
(define-compiler-macro truncate%2ops%1ret (&whole form &environment env number divisor)
(cond
((movitz:movitz-constantp divisor env)
- (let ((d (movitz::eval-form divisor env)))
+ (let ((d (movitz:movitz-eval divisor env)))
(check-type d number)
(case d
(0 (error "Truncate by zero."))
@@ -1008,12 +1011,12 @@
(cond
((and (constant-bytespec-p bytespec)
(movitz:movitz-constantp integer env))
- (ldb (byte (movitz::eval-form (second bytespec) env)
- (movitz::eval-form (third bytespec) env))
- (movitz::eval-form integer env))) ; constant folding
+ (ldb (byte (movitz:movitz-eval (second bytespec) env)
+ (movitz:movitz-eval (third bytespec) env))
+ (movitz:movitz-eval integer env))) ; constant folding
((constant-bytespec-p bytespec)
- (let ((size (movitz::eval-form (second bytespec) env))
- (position (movitz::eval-form (third bytespec) env)))
+ (let ((size (movitz:movitz-eval (second bytespec) env))
+ (position (movitz:movitz-eval (third bytespec) env)))
(assert (<= (+ size position) 30))
`(with-inline-assembly (:returns :register :type integer)
(:compile-form (:result-mode :register) ,integer)
@@ -1022,7 +1025,6 @@
,@(unless (zerop position)
`((:shrl ,position (:result-register)))))))
(t form))))
-
(define-setf-expander ldb (bytespec int &environment env)
"Stolen from the Hyperspec example in the define-setf-expander entry."
More information about the Movitz-cvs
mailing list