movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

14 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20640 Modified Files: integers.lisp Log Message: Implemented + on negatives in terms of -. Date: Wed Jul 14 05:36:50 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.58 movitz/losp/muerte/integers.lisp:1.59 --- movitz/losp/muerte/integers.lisp:1.58 Wed Jul 14 05:28:06 2004 +++ movitz/losp/muerte/integers.lisp Wed Jul 14 05:36:50 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.58 2004/07/14 12:28:06 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.59 2004/07/14 12:36:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -362,6 +362,12 @@ pfix-pbig-done) )) + (((integer * -1) (integer 0 *)) + (- y (- x))) + (((integer 0 *) (integer * -1)) + (- x (- y))) + (((integer * -1) (integer * -1)) + (+ (- x) (- y))) ))) (do-it))) (t (&rest terms)

1 0

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

14 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19168 Modified Files: integers.lisp Log Message: Remember to return the remainder also, when implementing truncate on negatives in terms of truncate on positives. Date: Wed Jul 14 05:28:06 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.57 movitz/losp/muerte/integers.lisp:1.58 --- movitz/losp/muerte/integers.lisp:1.57 Wed Jul 14 05:16:28 2004 +++ movitz/losp/muerte/integers.lisp Wed Jul 14 05:28:06 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.57 2004/07/14 12:16:28 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.58 2004/07/14 12:28:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1434,11 +1434,17 @@ (setf q (+ q guess) r (- r (* divisor guess)))))))))) (((integer * -1) (integer 0 *)) - (- (truncate (- number) divisor))) + (multiple-value-bind (q r) + (truncate (- number) divisor) + (values (- q) (- r)))) (((integer 0 *) (integer * -1)) - (- (truncate number (- divisor)))) + (multiple-value-bind (q r) + (truncate (- number) divisor) + (values (- q) r))) (((integer * -1) (integer * -1)) - (truncate (- number) (- divisor))) + (multiple-value-bind (q r) + (truncate (- number) divisor) + (values q (- r)))) )))) (defun / (number &rest denominators)

1 0

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

14 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5794 Modified Files: integers.lisp Log Message: Fixed - for negative bignums. Date: Wed Jul 14 05:16:28 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.56 movitz/losp/muerte/integers.lisp:1.57 --- movitz/losp/muerte/integers.lisp:1.56 Wed Jul 14 05:03:58 2004 +++ movitz/losp/muerte/integers.lisp Wed Jul 14 05:16:28 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.56 2004/07/14 12:03:58 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.57 2004/07/14 12:16:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -454,12 +454,10 @@ (:compile-two-forms (:eax :ebx) minuend subtrahend) (:subl :ebx :eax) (:into))) - ((bignum fixnum) + ((positive-bignum fixnum) (+ (- subtrahend) minuend)) - ((fixnum bignum) + ((fixnum positive-bignum) (- (+ (- minuend) subtrahend))) - (((integer 0 *) (integer * -1)) - (+ minuend (- subtrahend))) ((positive-bignum positive-bignum) (cond ((= minuend subtrahend) @@ -485,7 +483,14 @@ (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) (:jc '(:sub-program (should-not-happen) (:int 107))) - )))))))) + ))))) + (((integer 0 *) (integer * -1)) + (+ minuend (- subtrahend))) + (((integer * -1) (integer 0 *)) + (- (+ (- minuend) subtrahend))) + (((integer * -1) (integer * -1)) + (+ minuend (- subtrahend))) + ))) (do-it))) (t (minuend &rest subtrahends) (declare (dynamic-extent subtrahends))

1 0

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

14 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11410 Modified Files: integers.lisp Log Message: Fixed bogus abs compiler-macro. Tuned up gcd a bit. Date: Wed Jul 14 05:03:58 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.55 movitz/losp/muerte/integers.lisp:1.56 --- movitz/losp/muerte/integers.lisp:1.55 Wed Jul 14 04:01:43 2004 +++ movitz/losp/muerte/integers.lisp Wed Jul 14 05:03:58 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.55 2004/07/14 11:01:43 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.56 2004/07/14 12:03:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -942,7 +942,7 @@ (define-compiler-macro abs (x) `(let ((x ,x)) - (if (>= 0 x) x (- x)))) + (if (>= x 0) x (- x)))) (defun abs (x) (abs x)) @@ -1427,7 +1427,14 @@ (setf q (1+ q) r (- r divisor)) (setf q (+ q guess) - r (- r (* divisor guess)))))))))))))) + r (- r (* divisor guess)))))))))) + (((integer * -1) (integer 0 *)) + (- (truncate (- number) divisor))) + (((integer 0 *) (integer * -1)) + (- (truncate number (- divisor)))) + (((integer * -1) (integer * -1)) + (truncate (- number) (- divisor))) + )))) (defun / (number &rest denominators) (declare (dynamic-extent denominators)) @@ -2275,20 +2282,18 @@ (u (abs u) (truncate u 2)) (v (abs v) (truncate v 2))) ((or (oddp u) (oddp v)) - (do ((temp (if (oddp u) (- v) (ash u -1)) - (ash temp -1))) + (do ((temp (if (oddp u) + (- v) + (truncate u 2)) + (truncate temp 2))) (nil) - (declare (fixnum temp)) (when (oddp temp) (if (plusp temp) (setq u temp) (setq v (- temp))) (setq temp (- u v)) (when (zerop temp) - (let ((res (ash u k))) - (declare (type (signed-byte 31) res) - (optimize (inhibit-warnings 3))) - (return res)))))))) + (return (ash u k)))))))) (t (&rest numbers) (declare (dynamic-extent numbers)) (do ((gcd (car numbers)

1 0

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

14 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3713 Modified Files: integers.lisp Log Message: Fixed a bug in fast-compare-two-reals for negative bignums. Improved evenp and oddp, and gcd. Removed bogus compiler-macro for ash. Date: Wed Jul 14 04:01:43 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.54 movitz/losp/muerte/integers.lisp:1.55 --- movitz/losp/muerte/integers.lisp:1.54 Wed Jul 14 03:03:44 2004 +++ movitz/losp/muerte/integers.lisp Wed Jul 14 04:01:43 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.54 2004/07/14 10:03:44 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.55 2004/07/14 11:01:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -41,34 +41,23 @@ (defun fixnump (x) (typep x 'fixnum)) -(defun evenp (x) - (macrolet - ((do-it () - `(with-inline-assembly (:returns :ebx) - (:compile-form (:result-mode :eax) x) - (:movl :eax :ecx) - (:andl 7 :ecx) - (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx)) - (:cmpl ,(movitz:tag :even-fixnum) :ecx) - (:je 'done) - (:movl :edi :ebx) - (:cmpl ,(movitz:tag :odd-fixnum) :ecx) - (:je 'done) - (:cmpl ,(movitz:tag :other) :ecx) - (:jnz '(:sub-program (not-integer) - (:int 107))) - (:cmpb ,(movitz:tag :bignum) (:eax ,movitz:+other-type-offset+)) - (:jne 'not-integer) - (:testb 1 (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jnz 'done) - (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx)) - done))) - (do-it))) +(define-compiler-macro evenp (x) + `(with-inline-assembly (:returns :boolean-zf=1) + (:compile-form (:result-mode :eax) ,x) + (:call-global-constant unbox-u32) + (:testb 1 :cl))) -(defun oddp (x) - (not (evenp x))) +(defun evenp (x) + (evenp x)) +(define-compiler-macro oddp (x) + `(with-inline-assembly (:returns :boolean-zf=0) + (:compile-form (:result-mode :eax) ,x) + (:call-global-constant unbox-u32) + (:testb 1 :cl))) +(defun oddp (x) + (oddp x)) ;;; Types @@ -469,6 +458,8 @@ (+ (- subtrahend) minuend)) ((fixnum bignum) (- (+ (- minuend) subtrahend))) + (((integer 0 *) (integer * -1)) + (+ minuend (- subtrahend))) ((positive-bignum positive-bignum) (cond ((= minuend subtrahend) @@ -494,8 +485,7 @@ (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) (:jc '(:sub-program (should-not-happen) (:int 107))) - ))))) - ))) + )))))))) (do-it))) (t (minuend &rest subtrahends) (declare (dynamic-extent subtrahends)) @@ -571,7 +561,8 @@ (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) (:je 'positive-compare-loop) positive-compare-lsb - ;; Now make the compare unsigned.. + ;; Now we have to make the compare act as unsigned, which is why + ;; we compare zero-extended 16-bit quantities. (:movzxw (:ebx :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) :ecx) ; First compare upper 16 bits. (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) @@ -608,10 +599,22 @@ (:je 'negative-compare-loop) (:ret) negative-compare-lsb ; it's down to the LSB bigits. - (:movl (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) - :ecx) - (:cmpl :ecx - (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + ;; Now we have to make the compare act as unsigned, which is why + ;; we compare zero-extended 16-bit quantities. + (:movzxw (:ebx :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + :ecx) ; First compare upper 16 bits. + (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) + (:movzxw (:eax :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + :ecx) + (:locally (:cmpl :ecx (:edi (:edi-offset scratch0)))) + (:jne 'negative-upper-16-decisive) + (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) ; Then compare lower 16 bits. + (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) + (:movzxw (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) ; Then compare lower 16 bits. + (:locally (:cmpl :ecx (:edi (:edi-offset scratch0)))) + negative-upper-16-decisive (:ret)))) (do-it))) @@ -997,13 +1000,15 @@ (define-compiler-macro ash (&whole form integer count &environment env) (if (not (movitz:movitz-constantp count env)) form - (let ((count (movitz::movitz-eval count env))) + (let ((count (movitz:movitz-eval count env))) (cond ((movitz:movitz-constantp integer env) (ash (movitz::movitz-eval integer env) count)) ((= 0 count) integer) - (t (let ((load-integer `((:compile-form (:result-mode :register) ,integer) + (t form + #+igore + (let ((load-integer `((:compile-form (:result-mode :register) ,integer) (:testb ,movitz::+movitz-fixnum-zmask+ (:result-register-low8)) (:jnz '(:sub-program () (:int 107) (:jmp (:pc+ -4))))))) (cond @@ -2267,9 +2272,9 @@ (2 (u v) ;; Code borrowed from CMUCL. (do ((k 0 (1+ k)) - (u (abs u) (ash u -1)) - (v (abs v) (ash v -1))) - ((oddp (logior u v)) + (u (abs u) (truncate u 2)) + (v (abs v) (truncate v 2))) + ((or (oddp u) (oddp v)) (do ((temp (if (oddp u) (- v) (ash u -1)) (ash temp -1))) (nil)

1 0

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

14 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9184 Modified Files: typep.lisp Log Message: Fixed a bug in typep for types like (integer * 4). Date: Wed Jul 14 03:53:24 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.25 movitz/losp/muerte/typep.lisp:1.26 --- movitz/losp/muerte/typep.lisp:1.25 Thu Jul 8 14:50:03 2004 +++ movitz/losp/muerte/typep.lisp Wed Jul 14 03:53:24 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.25 2004/07/08 21:50:03 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.26 2004/07/14 10:53:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -289,7 +289,7 @@ `(typep ,object 'integer)) ((null lower-limit) `(let ((x ,object)) - (and (typep x 'integer) (<= x upper-limit)))) + (and (typep x 'integer) (<= x ,upper-limit)))) ((and (null upper-limit) (= (1+ movitz:+movitz-most-positive-fixnum+) lower-limit)) `(with-inline-assembly-case ()

1 0

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

14 Jul '04

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 ,@more-numbers))) + `(max ,first-number (max ,@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 ,@more-numbers))) + `(min ,first-number (min ,@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

1 0

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

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13345 Modified Files: scavenge.lisp Log Message: Minor edit. Date: Tue Jul 13 15:44:37 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.17 movitz/losp/muerte/scavenge.lisp:1.18 --- movitz/losp/muerte/scavenge.lisp:1.17 Tue Jul 13 06:00:36 2004 +++ movitz/losp/muerte/scavenge.lisp Tue Jul 13 15:44:37 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.17 2004/07/13 13:00:36 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.18 2004/07/13 22:44:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -150,7 +150,7 @@ (function (assert (= 0 (funobj-frame-num-unboxed funobj))) (map-heap-words function (+ nether-frame 2) frame)) - ((eql 0) + ((eql 0) ; An interrupt-frame? ;; 1. Scavenge the interrupt-frame (map-heap-words function (+ nether-frame 2)

1 0

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

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv32704 Modified Files: restarts.lisp Log Message: Moved the with-simple-restart macro to more-macros.lisp. Date: Tue Jul 13 15:44:10 2004 Author: ffjeld Index: movitz/losp/muerte/restarts.lisp diff -u movitz/losp/muerte/restarts.lisp:1.2 movitz/losp/muerte/restarts.lisp:1.3 --- movitz/losp/muerte/restarts.lisp:1.2 Mon Jan 19 03:23:47 2004 +++ movitz/losp/muerte/restarts.lisp Tue Jul 13 15:44:10 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 28 09:27:13 2003 ;;;; -;;;; $Id: restarts.lisp,v 1.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: restarts.lisp,v 1.3 2004/07/13 22:44:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -198,12 +198,6 @@ (restart-format-control restart) (restart-args restart))))))) restart) - -(defmacro with-simple-restart ((name format-control &rest format-arguments) - &body body) - `(with-basic-restart (,name 'with-simple-restart nil nil - ,format-control ,@format-arguments) - ,@body)) ;;;;

1 0

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

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31826 Modified Files: more-macros.lisp Log Message: Moved the with-simple-restart macro to more-macros.lisp. Date: Tue Jul 13 15:44:05 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.13 movitz/losp/muerte/more-macros.lisp:1.14 --- movitz/losp/muerte/more-macros.lisp:1.13 Tue Jul 13 07:28:05 2004 +++ movitz/losp/muerte/more-macros.lisp Tue Jul 13 15:44:05 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.13 2004/07/13 14:28:05 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.14 2004/07/13 22:44:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -315,6 +315,12 @@ :eax) (:testb 3 :al) ; Just to be sure.. (:jnz '(:sub-program () (:int 63))))) + +(defmacro with-simple-restart ((name format-control &rest format-arguments) + &body body) + `(with-basic-restart (,name 'with-simple-restart nil nil + ,format-control ,@format-arguments) + ,@body)) ;;; Some macros that aren't implemented, and we want to give compiler errors.

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs