August 2005 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS update: movitz/losp/los0.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv5233 Modified Files: los0.lisp Log Message: sync Date: Wed Aug 24 09:32:56 2005 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.47 movitz/losp/los0.lisp:1.48 --- movitz/losp/los0.lisp:1.47 Thu Aug 11 23:33:08 2005 +++ movitz/losp/los0.lisp Wed Aug 24 09:32:54 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.47 2005/08/11 21:33:08 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.48 2005/08/24 07:32:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1351,7 +1351,7 @@ (setf (global-segment-descriptor-table) (muerte::dump-global-segment-table :entries 16))) - (install-los0-consing :kb-size 500) + (install-los0-consing :kb-size (* 10 1024)) #+ignore (install-los0-consing :kb-size (max 50 (truncate (- extended-memsize 2048) 2))))

1 0

[movitz-cvs] CVS update: movitz/losp/ll-testing.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv5218 Modified Files: ll-testing.lisp Log Message: sync Date: Wed Aug 24 09:32:52 2005 Author: ffjeld Index: movitz/losp/ll-testing.lisp diff -u movitz/losp/ll-testing.lisp:1.11 movitz/losp/ll-testing.lisp:1.12 --- movitz/losp/ll-testing.lisp:1.11 Thu Aug 11 23:33:01 2005 +++ movitz/losp/ll-testing.lisp Wed Aug 24 09:32:52 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 14 08:18:43 2005 ;;;; -;;;; $Id: ll-testing.lisp,v 1.11 2005/08/11 21:33:01 ffjeld Exp $ +;;;; $Id: ll-testing.lisp,v 1.12 2005/08/24 07:32:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -237,4 +237,6 @@ (:locally (:pushl (:edi (:edi-offset raw-scratch0)))) ; reset eflags (:popfl) (:jmp (:esi (:offset movitz-funobj code-vector)))))) + +

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/typep.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5055 Modified Files: typep.lisp Log Message: Rearranged some code to have movitz build cleanly. Date: Wed Aug 24 09:31:57 2005 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.50 movitz/losp/muerte/typep.lisp:1.51 --- movitz/losp/muerte/typep.lisp:1.50 Sun Aug 21 19:59:18 2005 +++ movitz/losp/muerte/typep.lisp Wed Aug 24 09:31:57 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.50 2005/08/21 17:59:18 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.51 2005/08/24 07:31:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -691,9 +691,6 @@ (deftype bit () '(integer 0 1)) - -(deftype index (&optional (step 1)) - `(integer 0 ,(- #x1fffffff step))) (defun type-of (x) (class-name (class-of x)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette-compiler.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5039 Modified Files: los-closette-compiler.lisp Log Message: Rearranged some code to have movitz build cleanly. Date: Wed Aug 24 09:31:48 2005 Author: ffjeld Index: movitz/losp/muerte/los-closette-compiler.lisp diff -u movitz/losp/muerte/los-closette-compiler.lisp:1.18 movitz/losp/muerte/los-closette-compiler.lisp:1.19 --- movitz/losp/muerte/los-closette-compiler.lisp:1.18 Sun Aug 21 15:47:53 2005 +++ movitz/losp/muerte/los-closette-compiler.lisp Wed Aug 24 09:31:47 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 29 13:15:11 2002 ;;;; -;;;; $Id: los-closette-compiler.lisp,v 1.18 2005/08/21 13:47:53 ffjeld Exp $ +;;;; $Id: los-closette-compiler.lisp,v 1.19 2005/08/24 07:31:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -27,7 +27,8 @@ (define-compile-time-variable *the-slots-of-standard-class* nil) (define-compile-time-variable *the-position-of-standard-effective-slots* nil) (define-compile-time-variable *the-class-standard-class* nil) - +(define-compile-time-variable *the-standard-method-combination* nil) + (eval-when (:compile-toplevel) ; extends to EOF (defvar *classes-with-old-slot-definitions* nil) @@ -524,7 +525,7 @@ (slots (std-instance-slots instance))) (setf (svref slots location) (muerte::translate-program value :cl :muerte.cl)))) - (defun movitz-slot-vale (object slot-name) + (defun movitz-slot-value (object slot-name) (std-slot-value object (translate-program slot-name :cl :muerte.cl))) (defun (setf movitz-slot-value) (new-value object slot-name)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5020 Modified Files: integers.lisp Log Message: Rearranged some code to have movitz build cleanly. Date: Wed Aug 24 09:31:40 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.107 movitz/losp/muerte/integers.lisp:1.108 --- movitz/losp/muerte/integers.lisp:1.107 Fri Aug 12 23:37:42 2005 +++ movitz/losp/muerte/integers.lisp Wed Aug 24 09:31:40 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.107 2005/08/12 21:37:42 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.108 2005/08/24 07:31:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -256,71 +256,6 @@ ;;; -(defmacro define-number-relational (name 2op-name condition &key (defun-p t) 3op-name) - `(progn - ,(when condition - `(define-compiler-macro ,2op-name (n1 n2 &environment env) - (cond - ((and (movitz:movitz-constantp n1 env) - (movitz:movitz-constantp n2 env)) - (list ',2op-name (movitz:movitz-eval n1 env) (movitz:movitz-eval n2 env))) - ((movitz:movitz-constantp n1 env) - (let ((n1 (movitz::movitz-eval n1 env))) - (check-type n1 number) - (if (typep n1 '(signed-byte 30)) - `(with-inline-assembly (:returns ,,condition :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-pf fast-compare-fixnum-real)) - `(with-inline-assembly (:returns ,,condition :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-pf fast-compare-two-reals))))) - ((movitz:movitz-constantp n2 env) - (let ((n2 (movitz:movitz-eval n2 env))) - (check-type n2 number) - (if (typep n2 '(signed-byte 30)) - `(with-inline-assembly (:returns ,,condition :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-pf fast-compare-real-fixnum)) - `(with-inline-assembly (:returns ,,condition :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-pf fast-compare-two-reals))))) - (t `(with-inline-assembly (:returns ,,condition :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-pf fast-compare-two-reals)))))) - - (defun ,2op-name (n1 n2) - (,2op-name n1 n2)) - - (define-compiler-macro ,name (&whole form number &rest more-numbers) - (case (length more-numbers) - (0 `(progn ,number t)) - (1 `(,',2op-name ,number ,(first more-numbers))) - ,@(when 3op-name - `((2 `(,',3op-name ,number ,(first more-numbers) ,(second more-numbers))))) - (t #+ignore (when (= 2 (length more-numbers)) - (warn "3op: ~S" form)) - `(and (,',2op-name ,number ,(first more-numbers)) - (,',name ,@more-numbers))))) - - ,(when defun-p - `(defun ,name (number &rest more-numbers) - (declare (dynamic-extent more-numbers)) - (cond - ((null more-numbers) - (check-type number fixnum) - t) - ((not (cdr more-numbers)) - (,2op-name number (first more-numbers))) - (t (and (,2op-name number (first more-numbers)) - (do ((p more-numbers (cdr p))) - ((not (cdr p)) t) - (unless (,2op-name (car p) (cadr p)) - (return nil)))))))))) - -(define-number-relational >= >=%2op :boolean-greater-equal) -(define-number-relational > >%2op :boolean-greater) -(define-number-relational < <%2op :boolean-less) -(define-number-relational <= <=%2op :boolean-less-equal :3op-name <=%3op) ;;; Unsigned @@ -402,45 +337,6 @@ (defun oddp (x) (compiler-macro-call oddp x)) -;;; Types - -(define-typep integer (x &optional (min '*) (max '*)) - (and (typep x 'integer) - (or (eq min '*) (<= min x)) - (or (eq max '*) (<= x max)))) - -(deftype signed-byte (&optional (size '*)) - (cond - ((eq size '*) - 'integer) - ((typep size '(integer 1 *)) - (list 'integer - (- (ash 1 (1- size))) - (1- (ash 1 (1- size))))) - (t (error "Illegal size for signed-byte.")))) - -(deftype unsigned-byte (&optional (size '*)) - (cond - ((eq size '*) - '(integer 0)) - ((typep size '(integer 1 *)) - (list 'integer 0 (1- (ash 1 size)))) - (t (error "Illegal size for unsigned-byte.")))) - -(define-typep rational (x &optional (lower-limit '*) (upper-limit '*)) - (and (typep x 'rational) - (or (eq lower-limit '*) - (<= lower-limit x)) - (or (eq upper-limit '*) - (<= x upper-limit)))) - -(deftype real (&optional (lower-limit '*) (upper-limit '*)) - `(or (integer ,lower-limit ,upper-limit) - (rational ,lower-limit ,upper-limit))) - - -(define-simple-typep (bit bitp) (x) - (or (eq x 0) (eq x 1))) ;;;

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arithmetic-macros.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5005 Modified Files: arithmetic-macros.lisp Log Message: Rearranged some code to have movitz build cleanly. Date: Wed Aug 24 09:31:34 2005 Author: ffjeld Index: movitz/losp/muerte/arithmetic-macros.lisp diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.10 movitz/losp/muerte/arithmetic-macros.lisp:1.11 --- movitz/losp/muerte/arithmetic-macros.lisp:1.10 Sat Aug 20 22:23:34 2005 +++ movitz/losp/muerte/arithmetic-macros.lisp Wed Aug 24 09:31:34 2005 @@ -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.10 2005/08/20 20:23:34 ffjeld Exp $ +;;;; $Id: arithmetic-macros.lisp,v 1.11 2005/08/24 07:31:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -20,6 +20,8 @@ (in-package muerte) +;;; + (defmacro number-double-dispatch ((x y) &rest clauses) `(let ((x ,x) (y ,y)) (cond ,@(loop for ((x-type y-type) . then-body) in clauses @@ -499,3 +501,115 @@ (define-compiler-macro %ratio-denominator (x) `(memref ,x (movitz-type-slot-offset 'movitz-ratio 'denominator))) +;;; + +(defmacro define-number-relational (name 2op-name condition &key (defun-p t) 3op-name) + `(progn + ,(when condition + `(define-compiler-macro ,2op-name (n1 n2 &environment env) + (cond + ((and (movitz:movitz-constantp n1 env) + (movitz:movitz-constantp n2 env)) + (list ',2op-name (movitz:movitz-eval n1 env) (movitz:movitz-eval n2 env))) + ((movitz:movitz-constantp n1 env) + (let ((n1 (movitz::movitz-eval n1 env))) + (check-type n1 number) + (if (typep n1 '(signed-byte 30)) + `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-fixnum-real)) + `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-two-reals))))) + ((movitz:movitz-constantp n2 env) + (let ((n2 (movitz:movitz-eval n2 env))) + (check-type n2 number) + (if (typep n2 '(signed-byte 30)) + `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-real-fixnum)) + `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-two-reals))))) + (t `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-two-reals)))))) + + (defun ,2op-name (n1 n2) + (,2op-name n1 n2)) + + (define-compiler-macro ,name (&whole form number &rest more-numbers) + (case (length more-numbers) + (0 `(progn ,number t)) + (1 `(,',2op-name ,number ,(first more-numbers))) + ,@(when 3op-name + `((2 `(,',3op-name ,number ,(first more-numbers) ,(second more-numbers))))) + (t #+ignore (when (= 2 (length more-numbers)) + (warn "3op: ~S" form)) + `(and (,',2op-name ,number ,(first more-numbers)) + (,',name ,@more-numbers))))) + + ,(when defun-p + `(defun ,name (number &rest more-numbers) + (declare (dynamic-extent more-numbers)) + (cond + ((null more-numbers) + (check-type number fixnum) + t) + ((not (cdr more-numbers)) + (,2op-name number (first more-numbers))) + (t (and (,2op-name number (first more-numbers)) + (do ((p more-numbers (cdr p))) + ((not (cdr p)) t) + (unless (,2op-name (car p) (cadr p)) + (return nil)))))))))) + +(define-number-relational >= >=%2op :boolean-greater-equal) +(define-number-relational > >%2op :boolean-greater) +(define-number-relational < <%2op :boolean-less) +(define-number-relational <= <=%2op :boolean-less-equal :3op-name <=%3op) + +;;; Types + +(define-typep integer (x &optional (min '*) (max '*)) + (and (typep x 'integer) + (or (eq min '*) (<= min x)) + (or (eq max '*) (<= x max)))) + +(deftype unsigned-byte (&optional (size '*)) + (cond + ((eq size '*) + '(integer 0)) + ((typep size '(integer 1 *)) + ;; The funcall is a hack not to invoke compiler machinery + ;; that depends on the unsigned-byte type being defined. + (list 'integer 0 (funcall '- (ash 1 size) 1))) + (t (error "Illegal size for unsigned-byte.")))) + +(deftype signed-byte (&optional (size '*)) + (cond + ((eq size '*) + 'integer) + ((typep size '(integer 1 *)) + (list 'integer + (- (ash 1 (1- size))) + (1- (ash 1 (1- size))))) + (t (error "Illegal size for signed-byte.")))) + +(define-typep rational (x &optional (lower-limit '*) (upper-limit '*)) + (and (typep x 'rational) + (or (eq lower-limit '*) + (<= lower-limit x)) + (or (eq upper-limit '*) + (<= x upper-limit)))) + +(deftype real (&optional (lower-limit '*) (upper-limit '*)) + `(or (integer ,lower-limit ,upper-limit) + (rational ,lower-limit ,upper-limit))) + + +(define-simple-typep (bit bitp) (x) + (or (eq x 0) (eq x 1))) + +(deftype index (&optional (step 1)) + `(integer 0 ,(- #x1fffffff step)))

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4621 Modified Files: compiler.lisp Log Message: Working on add and type inference. Date: Wed Aug 24 09:30:46 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.156 movitz/compiler.lisp:1.157 --- movitz/compiler.lisp:1.156 Tue Aug 23 23:42:07 2005 +++ movitz/compiler.lisp Wed Aug 24 09:30:45 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.156 2005/08/23 21:42:07 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.157 2005/08/24 07:30:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -7023,26 +7023,75 @@ (binding-lended-p (binding-target term1))))) (t (warn "Unknown fixnum add: ~S" instruction) (make-default-add)))) - #+ignore ((and (movitz-subtypep result-type '(unsigned-byte 32)) (movitz-subtypep type0 'fixnum) (movitz-subtypep type1 'fixnum)) - (cond - ((and (not (binding-lended-p (binding-target term0))) - (not (binding-lended-p (binding-target term1))) - (not (and (bindingp destination) - (binding-lended-p (binding-target destination))))) + (flet ((mkadd (src srcloc destreg) + (if (integerp srcloc) + `((:addl (:ebp ,(stack-frame-offset srcloc)) + ,destreg)) + (ecase (operator srcloc) + ((:eax :ebx :ecx :edx) + `((:addl ,srcloc ,destreg))) + ((:argument-stack) + `((:addl (:ebx ,(argument-stack-offset src)) + ,destreg))) + )))) (cond ((and (not constant0) (not constant1) - (member destination-location '(:eax :ebx :edx))) - (print-code instruction - (append (make-load-lexical term0 :untagged-fixnum-ecx funobj nil frame-map) - `((,*compiler-local-segment-prefix* - :movl :ecx (:edi ,(global-constant-offset 'raw-scratch0)))) - ))) - (t (make-default-add)))) - (t (make-default-add)))) + (not (binding-lended-p (binding-target term0))) + (not (binding-lended-p (binding-target term1))) + (not (and (bindingp destination) + (binding-lended-p (binding-target destination))))) + (cond +;;; ((and (not (eq loc0 :untagged-fixnum-ecx)) +;;; (not (eq loc1 :untagged-fixnum-ecx)) +;;; (not (eq destination-location :untagged-fixnum-ecx))) +;;; (let ((tmpreg (cond +;;; ((member destination-location '(:eax :ebx :ecx :edx)) +;;; destination-location) +;;; ((some (lambda (x) (and (not (eq x loc0)) (not (eq x loc1)))) +;;; '(:ecx :edx :eax :ebx))) +;;; (t :ecx))) +;;; (no-overflow (gensym "no-overflow-"))) +;;; (append (make-load-lexical term0 :eax funobj nil frame-map) +;;; (mkadd term1 loc1 :eax) +;;; `((:jnc ',no-overflow) +;;; (:movl :eax :ecx) +;;; (:rcrl 1 :ecx) +;;; (:shrl 1 :ecx) +;;; (,*compiler-local-segment-prefix* +;;; :call (:edi ,(global-constant-offset 'box-u32-ecx))) +;;; ,no-overflow)) + (t (make-default-add) + #+ignore + (append (make-load-lexical term0 :untagged-fixnum-ecx funobj nil frame-map) + `((,*compiler-local-segment-prefix* + :movl :ecx (:edi ,(global-constant-offset 'raw-scratch0)))) + (make-load-lexical term1 :untagged-fixnum-ecx funobj nil frame-map) + `((,*compiler-local-segment-prefix* + :addl (:edi ,(global-constant-offset 'raw-scratch0)) :ecx)) + (if (integerp destination-location) + `((,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'box-u32-ecx))) + (:movl :eax (:ebp ,(stack-frame-offset destination-location)))) + (ecase (operator destination-location) + ((:untagged-fixnum-ecx) + nil) + ((:eax) + `((,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'box-u32-ecx))))) + ((:ebx :ecx :edx) + `((,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'box-u32-ecx))) + (:movl :eax ,destination-location))) + ((:argument-stack) + `((,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'box-u32-ecx))) + (:movl :eax (:ebp ,(argument-stack-offset + (binding-target destination)))))))))))) + (t (make-default-add))))) (t (make-default-add))))))))) ;;;;;;;

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4368 Modified Files: memref.lisp Log Message: Added (require typep) so we can do some type-inferring. Date: Wed Aug 24 09:30:14 2005 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.47 movitz/losp/muerte/memref.lisp:1.48 --- movitz/losp/muerte/memref.lisp:1.47 Tue May 24 08:33:35 2005 +++ movitz/losp/muerte/memref.lisp Wed Aug 24 09:30:14 2005 @@ -10,10 +10,11 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.47 2005/05/24 06:33:35 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.48 2005/08/24 07:30:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ +(require :muerte/typep) (provide :muerte/memref) (in-package muerte)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/packages.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4168 Modified Files: packages.lisp Log Message: Added some (declare index) to hash-table-iter-vars. Date: Wed Aug 24 09:29:41 2005 Author: ffjeld Index: movitz/losp/muerte/packages.lisp diff -u movitz/losp/muerte/packages.lisp:1.10 movitz/losp/muerte/packages.lisp:1.11 --- movitz/losp/muerte/packages.lisp:1.10 Mon May 30 00:03:06 2005 +++ movitz/losp/muerte/packages.lisp Wed Aug 24 09:29:40 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 30 15:19:43 2001 ;;;; -;;;; $Id: packages.lisp,v 1.10 2005/05/29 22:03:06 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.11 2005/08/24 07:29:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -143,7 +143,8 @@ (setf ,package-hash-var internals) (go ,loop-tag)))))))))) -(defmacro do-external-symbols ((var &optional (package *package*) result-form) &body declarations-and-body) +(defmacro do-external-symbols + ((var &optional (package *package*) result-form) &body declarations-and-body) (let ((next-var (gensym)) (more-var (gensym)) (key-var (gensym))) @@ -170,6 +171,7 @@ (t (let ((x (pop ,use-list-var))) (and x (package-object-external-symbols x))))))) ((not ,hash-table-var) ,result-form) + (declare (index ,state-var)) (with-hash-table-iterator (,next-var ,hash-table-var) (do () (nil) (multiple-value-bind (,more-var ,key-var ,var) (,next-var) @@ -177,7 +179,6 @@ (if ,more-var (let () ,@declarations-and-body) (return)))))))) - (defun apropos (string &optional package) (flet ((apropos-symbol (symbol string)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/sequences.lisp
by ffjeld＠common-lisp.net 24 Aug '05

24 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4141 Modified Files: sequences.lisp Log Message: Fixed typo decare -> declare. Date: Wed Aug 24 09:29:00 2005 Author: ffjeld Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.26 movitz/losp/muerte/sequences.lisp:1.27 --- movitz/losp/muerte/sequences.lisp:1.26 Tue Aug 23 19:58:19 2005 +++ movitz/losp/muerte/sequences.lisp Wed Aug 24 09:28:59 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.26 2005/08/23 17:58:19 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.27 2005/08/24 07:28:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -813,12 +813,12 @@ (do ((i start1 (1+ i)) (j start2 (1+ j))) ((>= i end1) sequence-1) - (decare (index i j)) + (declare (index i j)) (setf (sequence-1-ref i) (sequence-2-ref j)))) (t (do ((i start1 (1+ i)) (j start2 (1+ j))) ((>= j end2) sequence-1) - (decare (index i j)) + (declare (index i j)) (setf (sequence-1-ref i) (sequence-2-ref j)))))))) (list (with-subvector-accessor (sequence-1-ref sequence-1 start1 end1)

1 0