July 2004 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/more-macros.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17151 Modified Files: more-macros.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:34 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.14 movitz/losp/muerte/more-macros.lisp:1.15 --- movitz/losp/muerte/more-macros.lisp:1.14 Tue Jul 13 15:44:05 2004 +++ movitz/losp/muerte/more-macros.lisp Tue Jul 20 01:54:34 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.14 2004/07/13 22:44:05 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.15 2004/07/20 08:54:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -322,12 +322,31 @@ ,format-control ,@format-arguments) ,@body)) +(define-compiler-macro %run-time-context-slot (&whole form &environment env slot-name + &optional (context '(current-run-time-context))) + (if (not (and (movitz:movitz-constantp slot-name env) + (equal context '(current-run-time-context)))) + form + (let ((slot-name (movitz::eval-form slot-name env))) + (ecase (bt:binary-slot-type 'movitz::movitz-constant-block (intern (symbol-name slot-name) :movitz)) + (movitz::word + `(with-inline-assembly (:returns :eax) + (:locally (:movl (:edi (:edi-offset ,slot-name)) :eax)))) + (movitz::code-vector-word + `(with-inline-assembly (:returns :eax) + (:locally (:movl (:edi (:edi-offset ,slot-name)) :eax)) + (:subl ,movitz::+code-vector-word-offset+ :eax))) + (movitz::lu32 + `(with-inline-assembly (:returns :untagged-fixnum-ecx) + (:locally (:movl (:edi (:edi-offset ,slot-name)) :ecx)))))))) + ;;; Some macros that aren't implemented, and we want to give compiler errors. (defmacro define-unimplemented-macro (name) `(defmacro ,name (&rest args) (declare (ignore args)) - (error ,(format nil "Macro ~A is not implemented yet." name)))) + (with-simple-restart (continue "Proceed with a NIL expansion for ~S." ',name) + (error "Macro ~S is not implemented yet." ',name)))) (define-unimplemented-macro with-open-file) (define-unimplemented-macro restart-case)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17083 Modified Files: memref.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:29 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.20 movitz/losp/muerte/memref.lisp:1.21 --- movitz/losp/muerte/memref.lisp:1.20 Mon Jul 19 02:56:57 2004 +++ movitz/losp/muerte/memref.lisp Tue Jul 20 01:54:29 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.20 2004/07/19 09:56:57 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.21 2004/07/20 08:54:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -628,9 +628,9 @@ (:shll 2 :ecx) (:addl :ebx :eax) (:into) - (:testb ,(cl:mask-field (cl:byte (cl:+ 2 movitz::+movitz-fixnum-shift+) 0) -1) + (:testb ,(mask-field (byte (+ 2 movitz::+movitz-fixnum-shift+) 0) -1) :al) - (:jnz '(:sub-program (unaligned) (:int 63))) + (:jnz '(:sub-program () (:int 63))) (:addl :ecx :eax) (:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale down address (,prefixes :movl (:eax) :ecx) @@ -806,7 +806,9 @@ ,@(unless (= 0 start2) `((:addl ,(* start2 movitz::+movitz-fixnum-factor+) :ebx))) (:testb ,movitz::+movitz-fixnum-zmask+ :dl) - (:jnz '(:sub-program (no-fixnum) (:int 107))) + (:jnz '(:sub-program () + (:movl :edx :eax) + (:int 64))) copy-loop (:movl (:ebx :edx) :ecx) (:movl :ecx (:eax :edx)) @@ -824,7 +826,9 @@ (:testl :edx :edx) (:jz 'done) (:testb ,movitz::+movitz-fixnum-zmask+ :dl) - (:jnz '(:sub-program (no-fixnum) (:int 107))) + (:jnz '(:sub-program () + (:movl :edx :eax) + (:int 64))) copy-loop (:movl (:ebx :edx) :ecx) (:movl :ecx (:eax :edx))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16980 Modified Files: los-closette.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:24 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.14 movitz/losp/muerte/los-closette.lisp:1.15 --- movitz/losp/muerte/los-closette.lisp:1.14 Thu Jul 15 14:07:13 2004 +++ movitz/losp/muerte/los-closette.lisp Tue Jul 20 01:54:24 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 23 14:29:10 2002 ;;;; -;;;; $Id: los-closette.lisp,v 1.14 2004/07/15 21:07:13 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.15 2004/07/20 08:54:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -983,7 +983,7 @@ (defclass rational (real) () (:metaclass built-in-class)) (defclass integer (rational) () (:metaclass built-in-class)) (defclass fixnum (integer) () (:metaclass built-in-class)) -(defclass ratio (rational) () (:metaclass built-in-class)) +;; (defclass ratio (rational) () (:metaclass built-in-class)) (defclass float (real) () (:metaclass built-in-class)) (defclass complex (number) () (:metaclass built-in-class))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16690 Modified Files: interrupt.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:19 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.15 movitz/losp/muerte/interrupt.lisp:1.16 --- movitz/losp/muerte/interrupt.lisp:1.15 Sun Jul 18 16:48:22 2004 +++ movitz/losp/muerte/interrupt.lisp Tue Jul 20 01:54:19 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.15 2004/07/18 23:48:22 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.16 2004/07/20 08:54:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -282,6 +282,8 @@ (setf (@ $eax) (read *query-io*))) (62 (error "Trying to save too many values: ~@Z." $ecx)) (63 (error "Primitive assertion error. EIP=~@Z, ESI=~@Z." $eip $esi)) + (64 (error 'type-error :datum (@ $eax) :expected-type 'integer)) + (65 (error 'index-out-of-range :index (@ $ebx) (@ $ecx))) (66 (error "Unspecified type error at ~@Z in ~S with EAX=~@Z, ECX=~@Z." $eip (@ (+ interrupt-frame (interrupt-frame-index :esi))) $eax $ecx))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16373 Modified Files: integers.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:15 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.78 movitz/losp/muerte/integers.lisp:1.79 --- movitz/losp/muerte/integers.lisp:1.78 Mon Jul 19 06:59:31 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 20 01:54:14 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.78 2004/07/19 13:59:31 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.79 2004/07/20 08:54:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -48,7 +48,7 @@ (:leal (:eax ,(- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:jnz '(:sub-program (n1-not-bignum) - (:int 107))) + (:int 64))) (:movl (:eax ,movitz:+other-type-offset+) :ecx) (:cmpb ,(movitz:tag :bignum) :cl) (:jne 'n1-not-bignum) @@ -60,7 +60,8 @@ (:leal (:ebx ,(- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:jnz '(:sub-program (n2-not-bignum) - (:int 107))) + (:movl :ebx :eax) + (:int 64))) (:movl (:ebx ,movitz:+other-type-offset+) :ecx) (:cmpb ,(movitz:tag :bignum) :cl) (:jne 'n2-not-bignum) @@ -184,8 +185,8 @@ (:leal (:ebx ,(- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:jnz '(:sub-program (not-integer) - (:int 107) - (:jmp 'not-integer))) + (:movl :ebx :eax) + (:int 64))) (:movl (:ebx ,movitz:+other-type-offset+) :ecx) (:cmpw ,(movitz:tag :bignum 0) :cx) (:jne 'not-plusbignum) @@ -211,8 +212,7 @@ (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:jnz '(:sub-program (not-integer) - (:int 107) - (:jmp 'not-integer))) + (:int 64))) (:movl (:eax #.movitz:+other-type-offset+) :ecx) (:cmpw #.(movitz:tag :bignum 0) :cx) (:jne 'not-plusbignum) @@ -1351,17 +1351,27 @@ )))) (defun / (number &rest denominators) - (declare (dynamic-extent denominators)) - (cond - ((null denominators) - (make-ratio 1 number)) - ((null (cdr denominators)) - (multiple-value-bind (q r) - (truncate number (first denominators)) - (if (= 0 r) - q - (error "Don't know how to divide ~S by ~S." number (first denominators))))) - (t (/ number (reduce '* denominators))))) + (numargs-case + (1 (x) + (make-rational 1 x)) + (2 (x y) + (multiple-value-bind (q r) + (truncate x y) + (if (= 0 r) + q + (make-rational x y)))) + (t (number &rest denominators) + (declare (dynamic-extent denominators)) + (cond + ((null denominators) + (make-rational 1 number)) + ((null (cdr denominators)) + (multiple-value-bind (q r) + (truncate number (first denominators)) + (if (= 0 r) + q + (make-rational number (first denominators))))) + (t (/ number (reduce '* denominators))))))) (defun round (number &optional (divisor 1)) "Mathematical rounding."

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/defstruct.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15777 Modified Files: defstruct.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:09 2004 Author: ffjeld Index: movitz/losp/muerte/defstruct.lisp diff -u movitz/losp/muerte/defstruct.lisp:1.9 movitz/losp/muerte/defstruct.lisp:1.10 --- movitz/losp/muerte/defstruct.lisp:1.9 Thu Jul 15 14:06:55 2004 +++ movitz/losp/muerte/defstruct.lisp Tue Jul 20 01:54:09 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Jan 22 13:10:59 2001 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: defstruct.lisp,v 1.9 2004/07/15 21:06:55 ffjeld Exp $ +;;;; $Id: defstruct.lisp,v 1.10 2004/07/20 08:54:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -64,10 +64,10 @@ ;; type test passed, read slot ,@(if (= 4 movitz::+movitz-fixnum-factor+) `((:compile-form (:result-mode :ebx) slot-number) - (:movl (:eax :ebx #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)) + (:movl (:eax :ebx (:offset movitz-struct slot0)) :eax)) `((:compile-form (:result-mode :untagged-fixnum-ecx) slot-number) - (:movl (:eax (:ecx 4) #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)) + (:movl (:eax (:ecx 4) (:offset movitz-struct slot0)) :eax)))))) (do-it))) @@ -86,12 +86,12 @@ (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-struct 'movitz::length)) :ecx) (:leal ((:ecx ,movitz::+movitz-fixnum-factor+)) :ecx) (:testb ,movitz::+movitz-fixnum-zmask+ :bl) - (:jnz '(:sub-program (not-fixnum) (:int 107))) + (:jnz '(:sub-program (not-fixnum) (:movl :ebx :eax) (:int 64))) (:cmpl :ecx :ebx) - (:jae '(:sub-program (out-of-range) (:int 61))) - ;; type test passed, read slot - (:compile-form (:result-mode :ecx) value) - (:movl :ecx (:eax :ebx #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)))))) + (:jae '(:sub-program (out-of-range) (:int 65))) + ;; type test passed, write slot + (:compile-form (:result-mode :edx) value) + (:movl :edx (:eax :ebx (:offset movitz-struct slot0)))))) (do-it))) (defun struct-accessor-prototype (object)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/conditions.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14208 Modified Files: conditions.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:05 2004 Author: ffjeld Index: movitz/losp/muerte/conditions.lisp diff -u movitz/losp/muerte/conditions.lisp:1.8 movitz/losp/muerte/conditions.lisp:1.9 --- movitz/losp/muerte/conditions.lisp:1.8 Mon Jul 12 00:54:30 2004 +++ movitz/losp/muerte/conditions.lisp Tue Jul 20 01:54:05 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 20 15:47:04 2002 ;;;; -;;;; $Id: conditions.lisp,v 1.8 2004/07/12 07:54:30 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.9 2004/07/20 08:54:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -130,6 +130,18 @@ (funobj-name (condition-function c)) (funobj-lambda-list (condition-function c)) (condition-argument-count c))))) + +(define-condition index-out-of-range (error) + ((index + :initarg :index + :reader condition-index) + (range + :initarg :range + :reader condition-range)) + (:report (lambda (c s) + (format s "Index ~D is beyond range 0-~D." + (condition-index c) + (condition-range c))))) (define-condition stream-error (error) ((stream

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/characters.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13312 Modified Files: characters.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:00 2004 Author: ffjeld Index: movitz/losp/muerte/characters.lisp diff -u movitz/losp/muerte/characters.lisp:1.3 movitz/losp/muerte/characters.lisp:1.4 --- movitz/losp/muerte/characters.lisp:1.3 Sun Apr 18 16:16:44 2004 +++ movitz/losp/muerte/characters.lisp Tue Jul 20 01:54:00 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Feb 5 19:05:01 2001 ;;;; -;;;; $Id: characters.lisp,v 1.3 2004/04/18 23:16:44 ffjeld Exp $ +;;;; $Id: characters.lisp,v 1.4 2004/07/20 08:54:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -33,7 +33,7 @@ (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) code) (:testb #.movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program (not-fixnum) (:int 107))) + (:jnz '(:sub-program (not-fixnum) (:int 64))) (:shll #.(cl:- 8 movitz::+movitz-fixnum-shift+) :eax) (:movb #.(movitz::tag :character) :al)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/bignums.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12833 Modified Files: bignums.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:53:56 2004 Author: ffjeld Index: movitz/losp/muerte/bignums.lisp diff -u movitz/losp/muerte/bignums.lisp:1.4 movitz/losp/muerte/bignums.lisp:1.5 --- movitz/losp/muerte/bignums.lisp:1.4 Mon Jul 19 07:44:21 2004 +++ movitz/losp/muerte/bignums.lisp Tue Jul 20 01:53:56 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 19:42:57 2004 ;;;; -;;;; $Id: bignums.lisp,v 1.4 2004/07/19 14:44:21 ffjeld Exp $ +;;;; $Id: bignums.lisp,v 1.5 2004/07/20 08:53:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -36,7 +36,7 @@ (:movl (:eax ,movitz:+other-type-offset+) :ecx) (:shrl 16 :ecx) (:jz '(:sub-program (should-never-happen) - (:int 107))) + (:int 63))) shrink-loop (:cmpl 4 :ecx) (:je 'shrink-no-more) @@ -54,9 +54,9 @@ (:jmp 'done))) shrink-done (:testb 3 :cl) - (:jnz '(:sub-program () (:int 107))) + (:jnz '(:sub-program () (:int 63))) (:testw :cx :cx) - (:jz '(:sub-program () (:int 107))) + (:jz '(:sub-program () (:int 63))) (:movw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length))) done ))) @@ -64,14 +64,14 @@ (defun copy-bignum (old) (check-type old bignum) - (let* ((length (ceiling (bignum-integer-length old) 32)) + (let* ((length (%bignum-bigits old)) (new (malloc-non-pointer-words (1+ length)))) (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) new old) (:compile-form (:result-mode :edx) length) copy-bignum-loop - (:movl (:ebx :edx #.movitz:+other-type-offset+) :ecx) - (:movl :ecx (:eax :edx #.movitz:+other-type-offset+)) + (:movl (:ebx :edx (:offset movitz-bignum type)) :ecx) + (:movl :ecx (:eax :edx (:offset movitz-bignum type))) (:subl 4 :edx) (:jnc 'copy-bignum-loop))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arithmetic-macros.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11680 Modified Files: arithmetic-macros.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:53:50 2004 Author: ffjeld Index: movitz/losp/muerte/arithmetic-macros.lisp diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.3 movitz/losp/muerte/arithmetic-macros.lisp:1.4 --- movitz/losp/muerte/arithmetic-macros.lisp:1.3 Sun Jul 18 17:14:53 2004 +++ movitz/losp/muerte/arithmetic-macros.lisp Tue Jul 20 01:53:50 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 13:42:46 2004 ;;;; -;;;; $Id: arithmetic-macros.lisp,v 1.3 2004/07/19 00:14:53 ffjeld Exp $ +;;;; $Id: arithmetic-macros.lisp,v 1.4 2004/07/20 08:53:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -93,7 +93,6 @@ (max (movitz:movitz-eval max env))) (check-type min fixnum) (check-type max fixnum) - ;; (warn "~D -- ~D" min max) (cond ((movitz:movitz-constantp x env) (<= min (movitz:movitz-eval x env) max)) @@ -108,14 +107,14 @@ `(with-inline-assembly (:returns :boolean-cf=1) (:compile-form (:result-mode :eax) ,x) (:testb ,movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program () (:int 107))) + (:jnz '(:sub-program () (:int 64))) (:cmpl ,(* (1+ max) movitz::+movitz-fixnum-factor+) :eax))) (t `(do-result-mode-case () (:booleans (with-inline-assembly (:returns :boolean-zf=0) (:compile-form (:result-mode :eax) ,x) (:testb ,movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program () (:int 107))) + (:jnz '(:sub-program () (:int 64))) (:cmpl ,(* min movitz::+movitz-fixnum-factor+) :eax) (:sbbl :ecx :ecx) (:cmpl ,(* (1+ max) movitz::+movitz-fixnum-factor+) :eax) @@ -123,7 +122,7 @@ (t (with-inline-assembly (:returns (:boolean-ecx 1 0)) (:compile-form (:result-mode :eax) ,x) (:testb ,movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program () (:int 107))) + (:jnz '(:sub-program () (:int 64))) (:cmpl ,(* min movitz::+movitz-fixnum-factor+) :eax) (:sbbl :ecx :ecx) (:cmpl ,(* (1+ max) movitz::+movitz-fixnum-factor+) :eax) @@ -132,22 +131,21 @@ (and (<= ,min x) (<= x ,max)))))) (define-compiler-macro below (&whole form x max &environment env) - (let ((below-not-integer (gensym "below-not-integer-"))) - (if (movitz:movitz-constantp max env) - `(with-inline-assembly (:returns :boolean-cf=1) - (:compile-form (:result-mode :eax) ,x) - (:testb ,movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program (,below-not-integer) (:int 107))) - (:cmpl ,(* (movitz:movitz-eval max env) - movitz::+movitz-fixnum-factor+) - :eax)) + (if (movitz:movitz-constantp max env) `(with-inline-assembly (:returns :boolean-cf=1) - (:compile-two-forms (:eax :ebx) ,x ,max) - (:movl :eax :ecx) - (:orl :ebx :ecx) - (:testb ,movitz::+movitz-fixnum-zmask+ :cl) - (:jnz '(:sub-program (,below-not-integer) (:int 107))) - (:cmpl :ebx :eax))))) + (:compile-form (:result-mode :eax) ,x) + (:testb ,movitz::+movitz-fixnum-zmask+ :al) + (:jnz '(:sub-program () (:int 64))) + (:cmpl ,(* (movitz:movitz-eval max env) + movitz::+movitz-fixnum-factor+) + :eax)) + `(with-inline-assembly (:returns :boolean-cf=1) + (:compile-two-forms (:eax :ebx) ,x ,max) + (:testb ,movitz::+movitz-fixnum-zmask+ :al) + (:jnz '(:sub-program () (:int 64))) + (:testb ,movitz::+movitz-fixnum-zmask+ :bl) + (:jnz '(:sub-program () (:movl :ebx :eax) (:int 64))) + (:cmpl :ebx :eax)))) (define-compiler-macro zerop (number) `(= 0 ,number))

1 0