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

[movitz-cvs] CVS update: movitz/losp/muerte/eval.lisp
by Frode Vatvedt Fjeld 18 Aug '04

18 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15555 Modified Files: eval.lisp Log Message: Fixed interpreted setq and setf to deal with lexical variables, according to Alessio Stalla's bug-report. Date: Wed Aug 18 13:16:27 2004 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.9 movitz/losp/muerte/eval.lisp:1.10 --- movitz/losp/muerte/eval.lisp:1.9 Wed Jun 16 00:37:17 2004 +++ movitz/losp/muerte/eval.lisp Wed Aug 18 13:16:26 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.9 2004/06/16 07:37:17 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.10 2004/08/18 20:16:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -366,28 +366,38 @@ (unless b (error "Go-tag ~S is not visible." tag)) (throw (cdr b) (values tag)))) +(defun eval-set-variable (variable-name value env) + "Perform e.g. (setq <variable-name> <value>) according to <env>. Return <value>." + (check-type variable-name symbol "a variable name") + (if (symbol-special-variable-p variable-name) + (set variable-name value) + (let ((binding (env-binding env variable-name))) + (if binding + (setf (cdr binding) value) + ;; We could emit a warning here, or whatever. + (set variable-name value))))) (defun eval-setq (form env) (do* ((p (cdr form) (cddr p)) - (value nil)) - ((null p) value) + (final-value nil)) + ((null p) final-value) (assert (cdr p) (form) "Odd number of arguments to setq: ~W" form) - (setf value - (set (car p) (eval-form (cadr p) env))))) + (setf final-value + (eval-set-variable (car p) (eval-form (cadr p) env) env)))) (defun eval-setf (form env) (do* ((p (cdr form) (cddr p)) - (value nil)) - ((null p) value) + (final-value nil)) + ((null p) final-value) (assert (cdr p) (form) "Odd number of arguments to setf: ~W" form) - (setf value + (setf final-value (let ((place (first p)) (value-form (second p))) (if (symbolp place) - (set place (eval-form value-form env)) - ;; eval subvalues before value-form.. + (eval-set-variable place (eval-form value-form env) env) + ;; eval place's subforms before value-form.. (let ((place-subvalues (eval-arglist (cdr place) env))) (apply (lookup-setf-function (caar p)) (eval-form value-form env)

1 0

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

18 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv8448 Modified Files: integers.lisp Log Message: Make (* <fixnum> <bignum>) observe the register discipline, i.e. by exchanging the usage of ECX and ESI. Date: Wed Aug 18 02:50:33 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.92 movitz/losp/muerte/integers.lisp:1.93 --- movitz/losp/muerte/integers.lisp:1.92 Mon Aug 16 08:26:36 2004 +++ movitz/losp/muerte/integers.lisp Wed Aug 18 02:50:33 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.92 2004/08/16 15:26:36 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.93 2004/08/18 09:50:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -333,6 +333,7 @@ (define-compiler-macro =%2op (n1 n2 &environment env) (cond + #+ignore ((movitz:movitz-constantp n1 env) (let ((n1 (movitz:movitz-eval n1 env))) (etypecase n1 @@ -353,6 +354,7 @@ `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil) (:compile-two-forms (:eax :ebx) ,n1 ,n2) (:call-global-pf fast-compare-two-reals)))))) + #+ignore ((movitz:movitz-constantp n2 env) `(=%2op ,n2 ,n1)) (t `(eql ,n1 ,n2)))) @@ -1137,39 +1139,39 @@ (:store-lexical (:lexical-binding r) :eax :type bignum) (:movl :eax :ebx) ; r into ebx - (:xorl :ecx :ecx) ; counter + (:xorl :esi :esi) ; counter (:xorl :edx :edx) ; initial carry (:std) ; Make EAX, EDX, ESI non-GC-roots. - (:compile-form (:result-mode :esi) x) - (:sarl ,movitz:+movitz-fixnum-shift+ :esi) + (:compile-form (:result-mode :ecx) x) + (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) (:jns 'multiply-loop) - (:negl :esi) ; can't overflow + (:negl :ecx) ; can't overflow multiply-loop - (:movl :edx (:ebx (:ecx 1) ; new + (:movl :edx (:ebx (:esi 1) ; new (:offset movitz-bignum bigit0))) (:compile-form (:result-mode :ebx) y) - (:movl (:ebx (:ecx 1) (:offset movitz-bignum bigit0)) + (:movl (:ebx (:esi 1) (:offset movitz-bignum bigit0)) :eax) - (:mull :esi :eax :edx) + (:mull :ecx :eax :edx) (:compile-form (:result-mode :ebx) r) - (:addl :eax (:ebx :ecx (:offset movitz-bignum bigit0))) + (:addl :eax (:ebx :esi (:offset movitz-bignum bigit0))) (:adcl 0 :edx) - (:addl 4 :ecx) - (:cmpw :cx (:ebx (:offset movitz-bignum length))) + (:addl 4 :esi) + (:cmpw :si (:ebx (:offset movitz-bignum length))) (:ja 'multiply-loop) (:testl :edx :edx) (:jz 'no-carry-expansion) - (:movl :edx (:ebx :ecx (:offset movitz-bignum bigit0))) - (:addl 4 :ecx) - (:movw :cx (:ebx (:offset movitz-bignum length))) + (:movl :edx (:ebx :esi (:offset movitz-bignum bigit0))) + (:addl 4 :esi) + (:movw :si (:ebx (:offset movitz-bignum length))) no-carry-expansion + (:leal (:esi ,movitz:+movitz-fixnum-factor+) + :ecx) ; Put bignum length into ECX (:movl (:ebp -4) :esi) (:movl :ebx :eax) (:movl :edi :edx) (:cld) ; EAX, EDX, and ESI are GC roots again. - (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) - :ecx) (:call-local-pf cons-commit) (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status))))

1 0

[movitz-cvs] CVS update: public_html/index.html
by Frode Vatvedt Fjeld 18 Aug '04

18 Aug '04

Update of /project/movitz/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv31136 Modified Files: index.html Log Message: *** empty log message *** Date: Wed Aug 18 02:27:57 2004 Author: ffjeld Index: public_html/index.html diff -u public_html/index.html:1.19 public_html/index.html:1.20 --- public_html/index.html:1.19 Wed Jul 7 17:14:35 2004 +++ public_html/index.html Wed Aug 18 02:27:57 2004 @@ -15,6 +15,13 @@ <h3>Most recent news</h3> + <p> <i>August 18, 2004:</i> Movitz finally runs in <a + href="http://fabrice.bellard.free.fr/qemu/">QEMU</a>, which is a very + nice x86 emulator. It uses some sort of JIT technique, so it's much + faster than Bochs. There was a bug in QEMU's (version 0.6.0) + emulation of the x86 <tt>bounds</tt> instruction, which didn't agree + with Movitz, and which is now fixed in QEMU's CVS. + <p> <i>July 8, 2004:</i> The data-structure for vectors has been changed. The vectors length is now represented by a fixnum, increasing the maximum length from <tt>#xffff</tt> to

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 18 Aug '04

18 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv27437 Modified Files: image.lisp Log Message: Remove fast-eql from run-time-context. Date: Wed Aug 18 02:15:15 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.64 movitz/image.lisp:1.65 --- movitz/image.lisp:1.64 Tue Aug 10 06:25:16 2004 +++ movitz/image.lisp Wed Aug 18 02:15:14 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.64 2004/08/10 13:25:16 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.65 2004/08/18 09:15:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -265,12 +265,6 @@ :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) (fast-compare-real-fixnum - :binary-type code-vector-word - :initform nil - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (fast-eql :binary-type code-vector-word :initform nil :map-binary-write 'movitz-intern-code-vector

1 0

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

16 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18914 Modified Files: memref.lisp Log Message: Fixed (memref .. :character) used EBX in an undisciplined way. Date: Mon Aug 16 16:15:12 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.26 movitz/losp/muerte/memref.lisp:1.27 --- movitz/losp/muerte/memref.lisp:1.26 Thu Aug 12 10:00:29 2004 +++ movitz/losp/muerte/memref.lisp Mon Aug 16 16:15:12 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.26 2004/08/12 17:00:29 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.27 2004/08/16 23:15:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -187,11 +187,11 @@ (cond ((eq 0 offset) `(with-inline-assembly (:returns :eax) - (:compile-two-forms (:ecx :ebx) ,object ,index) + (:compile-two-forms (:ebx :ecx) ,object ,index) (:xorl :eax :eax) (:movb ,(movitz:tag :character) :al) - (:sarl ,movitz::+movitz-fixnum-shift+ :ebx) ; scale index - (:movb (:ecx :ebx ,(offset-by 1)) :ah))) + (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale index + (:movb (:ebx :ecx ,(offset-by 1)) :ah))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) (with-inline-assembly (:returns :eax)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp
by Frode Vatvedt Fjeld 16 Aug '04

16 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30595 Modified Files: functions.lisp Log Message: Fixed funobj-code-vector%{1,2,3}op to not assume code-vectors are all #x100 bytes long, and to be somewhat resistant to GC activiy. Date: Mon Aug 16 08:28:07 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.17 movitz/losp/muerte/functions.lisp:1.18 --- movitz/losp/muerte/functions.lisp:1.17 Tue Jul 20 05:58:34 2004 +++ movitz/losp/muerte/functions.lisp Mon Aug 16 08:28:07 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 12 22:58:54 2002 ;;;; -;;;; $Id: functions.lisp,v 1.17 2004/07/20 12:58:34 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.18 2004/08/16 15:28:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -115,24 +115,31 @@ as that vector." (check-type funobj function) (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) funobj) - (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :ebx) ; EBX = code-vector - (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%1op)) :eax) ; EAX = code-vector%1op - ;; determine if EAX is a pointer into EBX - (:cmpl :ebx :eax) + retry + (:declare-label-set retry-jumper (retry)) + (:locally (:movl '(:funcall #.(movitz::atomically-status-jumper-fn t) + 'retry-jumper) + (:edi (:edi-offset atomically-status)))) + (:compile-form (:result-mode :ebx) funobj) + (:movl (:ebx (:offset movitz-funobj code-vector)) :eax) ; EAX = code-vector + (:movl (:ebx (:offset movitz-funobj code-vector%1op)) :ecx) + ;; determine if ECX is a pointer into EBX + (:subl :eax :ecx) (:jl 'return-vector) - (:andb #xf8 :bl) - (:addl #x100 :ebx) - (:cmpl :ebx :eax) + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :ecx) + (:cmpl (:ebx (:offset movitz-basic-vector num-elements)) :ecx) (:jg 'return-vector) ;; return the integer offset EAX-EBX - (:subl #x100 :ebx) - (:subl :ebx :eax) - (:shll #.movitz:+movitz-fixnum-shift+ :eax) + (:movl :ecx :eax) (:jmp 'done) - return-vector - (:subl 2 :eax) - done)) ; this cell stores word+2 + return-vector + (:testl 7 (:ebx (:offset movitz-funobj code-vector%1op))) + (:jnz '(:sub-program () (:int 63))) + (:movl #xfffffffe :eax) + (:addl (:ebx (:offset movitz-funobj code-vector%1op)) :eax) + done + (:locally (:movl #.(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))))) ; this cell stores word+2 (defun (setf funobj-code-vector%1op) (code-vector funobj) (check-type funobj function) @@ -160,24 +167,31 @@ as that vector." (check-type funobj function) (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) funobj) - (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :ebx) ; EBX = code-vector - (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%2op)) :eax) ; EAX = code-vector%1op - ;; determine if EAX is a pointer into EBX - (:cmpl :ebx :eax) + retry + (:declare-label-set retry-jumper (retry)) + (:locally (:movl '(:funcall #.(movitz::atomically-status-jumper-fn t) + 'retry-jumper) + (:edi (:edi-offset atomically-status)))) + (:compile-form (:result-mode :ebx) funobj) + (:movl (:ebx (:offset movitz-funobj code-vector)) :eax) ; EAX = code-vector + (:movl (:ebx (:offset movitz-funobj code-vector%2op)) :ecx) + ;; determine if ECX is a pointer into EBX + (:subl :eax :ecx) (:jl 'return-vector) - (:andb #xf8 :bl) - (:addl #x100 :ebx) - (:cmpl :ebx :eax) + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :ecx) + (:cmpl (:ebx (:offset movitz-basic-vector num-elements)) :ecx) (:jg 'return-vector) ;; return the integer offset EAX-EBX - (:subl #x100 :ebx) - (:subl :ebx :eax) - (:shll #.movitz:+movitz-fixnum-shift+ :eax) + (:movl :ecx :eax) (:jmp 'done) - return-vector - (:subl 2 :eax) - done)) + return-vector + (:testl 7 (:ebx (:offset movitz-funobj code-vector%2op))) + (:jnz '(:sub-program () (:int 63))) + (:movl #xfffffffe :eax) + (:addl (:ebx (:offset movitz-funobj code-vector%2op)) :eax) + done + (:locally (:movl #.(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))))) (defun (setf funobj-code-vector%2op) (code-vector funobj) (check-type funobj function) @@ -205,24 +219,31 @@ as that vector." (check-type funobj function) (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) funobj) - (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :ebx) ; EBX = code-vector - (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%3op)) :eax) ; EAX = code-vector%1op - ;; determine if EAX is a pointer into EBX - (:cmpl :ebx :eax) + retry + (:declare-label-set retry-jumper (retry)) + (:locally (:movl '(:funcall #.(movitz::atomically-status-jumper-fn t) + 'retry-jumper) + (:edi (:edi-offset atomically-status)))) + (:compile-form (:result-mode :ebx) funobj) + (:movl (:ebx (:offset movitz-funobj code-vector)) :eax) ; EAX = code-vector + (:movl (:ebx (:offset movitz-funobj code-vector%3op)) :ecx) + ;; determine if ECX is a pointer into EBX + (:subl :eax :ecx) (:jl 'return-vector) - (:andb #xf8 :bl) - (:addl #x100 :ebx) - (:cmpl :ebx :eax) + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :ecx) + (:cmpl (:ebx (:offset movitz-basic-vector num-elements)) :ecx) (:jg 'return-vector) ;; return the integer offset EAX-EBX - (:subl #x100 :ebx) - (:subl :ebx :eax) - (:shll #.movitz:+movitz-fixnum-shift+ :eax) + (:movl :ecx :eax) (:jmp 'done) - return-vector - (:subl 2 :eax) - done)) + return-vector + (:testl 7 (:ebx (:offset movitz-funobj code-vector%3op))) + (:jnz '(:sub-program () (:int 63))) + (:movl #xfffffffe :eax) + (:addl (:ebx (:offset movitz-funobj code-vector%3op)) :eax) + done + (:locally (:movl #.(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))))) (defun (setf funobj-code-vector%3op) (code-vector funobj) (check-type funobj function)

1 0

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

16 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7880 Modified Files: integers.lisp Log Message: Fixed complicated-eql, which was very broken for bignums. And therefore = was also broken. And therefore also - and many other operators. Date: Mon Aug 16 08:26:36 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.91 movitz/losp/muerte/integers.lisp:1.92 --- movitz/losp/muerte/integers.lisp:1.91 Wed Aug 4 05:59:23 2004 +++ movitz/losp/muerte/integers.lisp Mon Aug 16 08:26:36 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.91 2004/08/04 12:59:23 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.92 2004/08/16 15:26:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -159,7 +159,7 @@ (:jne 'done) ;; Ok.. we have two bignums of identical sign and size. (:shrl 16 :ecx) - (:movl :ecx :edx) ; counter + (:leal (:ecx 4) :edx) ; counter compare-loop (:subl ,movitz:+movitz-fixnum-factor+ :edx) (:jz 'done) @@ -187,39 +187,6 @@ (:movl :edi :eax) (:clc) ))) - (do-it))) - - -(define-primitive-function fast-eql (x y) - "Compare EAX and EBX under EQL, result in ZF. -Preserve EAX and EBX." - (macrolet - ((do-it () - `(with-inline-assembly (:returns :nothing) ; unspecified - (:cmpl :eax :ebx) ; EQ? - (:je 'done) - (:leal (:eax ,(- (movitz:tag :other))) :ecx) - (:testb 7 :cl) - (:jne 'done) - (:leal (:ebx ,(- (movitz:tag :other))) :ecx) - (:testb 7 :cl) - (:jne 'done) - (:movl (:eax ,movitz:+other-type-offset+) :ecx) - (:cmpb ,(movitz:tag :bignum) :cl) - (:jne 'done) - (:cmpl :ecx (:ebx ,movitz:+other-type-offset+)) - (:jne 'done) - ;; Ok.. we have two bignums of identical sign and size. - (:shrl 16 :ecx) - (:movl :ecx :edx) ; counter - compare-loop - (:subl ,movitz:+movitz-fixnum-factor+ :edx) - (:jz 'done) - (:movl (:eax :edx (:offset movitz-bignum bigit0 -4)) :ecx) - (:cmpl :ecx (:ebx :edx (:offset movitz-bignum bigit0 -4))) - (:je 'compare-loop) - done - (:ret)))) (do-it))) (define-primitive-function fast-compare-fixnum-real (n1 n2)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/sequences.lisp
by Frode Vatvedt Fjeld 16 Aug '04

16 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9984 Modified Files: sequences.lisp Log Message: Added a type declaration. Date: Mon Aug 16 01:26:41 2004 Author: ffjeld Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.16 movitz/losp/muerte/sequences.lisp:1.17 --- movitz/losp/muerte/sequences.lisp:1.16 Thu Aug 12 10:01:26 2004 +++ movitz/losp/muerte/sequences.lisp Mon Aug 16 01:26:40 2004 @@ -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.16 2004/08/12 17:01:26 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.17 2004/08/16 08:26:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -74,7 +74,8 @@ (list (do ((x sequence (cdr x)) (length 0 (1+ length))) - ((null x) length))))) + ((null x) length) + (declare (index length)))))) (defun length%list (sequence) (do ((length 0 (1+ length))

1 0

[movitz-cvs] CVS update: movitz/procfs-image.lisp
by Frode Vatvedt Fjeld 16 Aug '04

16 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv32160 Modified Files: procfs-image.lisp Log Message: Minor tweam of procfs debugging. Date: Mon Aug 16 01:25:29 2004 Author: ffjeld Index: movitz/procfs-image.lisp diff -u movitz/procfs-image.lisp:1.15 movitz/procfs-image.lisp:1.16 --- movitz/procfs-image.lisp:1.15 Thu Aug 12 08:42:00 2004 +++ movitz/procfs-image.lisp Mon Aug 16 01:25:28 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Aug 24 11:39:37 2001 ;;;; -;;;; $Id: procfs-image.lisp,v 1.15 2004/08/12 15:42:00 ffjeld Exp $ +;;;; $Id: procfs-image.lisp,v 1.16 2004/08/16 08:25:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -179,7 +179,7 @@ ((or movitz-funobj movitz-struct movitz-std-instance) object) (t (movitz-print object)))) - (t (c) (list :word-error word c))))) + (serious-condition (c) (list :word-error word c))))) (defun backtrace (&key (reqs t) print-frames print-returns spartan) (format t "~&Backtracing from EIP = #x~X: "

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 16 Aug '04

16 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24962 Modified Files: compiler.lisp Log Message: Make the compiler work when *compiler-do-type-inference* is NIL. Fixed a bug in the :add extended-code expander; it didn't work well for lended bindings. Date: Mon Aug 16 01:24:56 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.94 movitz/compiler.lisp:1.95 --- movitz/compiler.lisp:1.94 Sat Aug 14 10:47:04 2004 +++ movitz/compiler.lisp Mon Aug 16 01:24:56 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.94 2004/08/14 17:47:04 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.95 2004/08/16 08:24:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -72,7 +72,7 @@ "Spend time and effort performing type inference and optimization.") (defvar *compiler-produce-defensive-code* t - "Try make code be extra cautious.") + "Try to make code be extra cautious.") (defvar *compiler-trust-user-type-declarations-p* t) @@ -381,7 +381,24 @@ (defun analyze-bindings (toplevel-funobj) "Figure out usage of bindings in a toplevel funobj. Side-effects each binding's binding-store-type." - (when *compiler-do-type-inference* + (if (not *compiler-do-type-inference*) + (labels + ((analyze-code (code) + (dolist (instruction code) + (when (listp instruction) + (let ((binding + (find-written-binding-and-type instruction))) + (when binding + (setf (binding-store-type binding) + (multiple-value-list (type-specifier-encode t))))) + (analyze-code (instruction-sub-program instruction))))) + (analyze-funobj (funobj) + (loop for (nil . function-env) in (function-envs funobj) + do (analyze-code (extended-code function-env))) + (loop for function-binding in (sub-function-binding-usage funobj) by #'cddr + do (analyze-funobj (function-binding-funobj function-binding))) + funobj)) + (analyze-funobj toplevel-funobj)) (let ((binding-usage (make-hash-table :test 'eq))) (labels ((binding-resolved-p (binding) (let ((analysis (gethash binding binding-usage))) @@ -6283,9 +6300,9 @@ ((and (type-specifier-singleton type0) (symbolp loc1) (integerp destination-location)) - `((:addl ,(movitz-immediate-value (car (type-specifier-singleton type0))) - ,loc1) - (:movl ,loc1 (:ebp ,(stack-frame-offset destination-location))))) + (append `((:addl ,(movitz-immediate-value (car (type-specifier-singleton type0))) + ,loc1)) + (make-store-lexical destination loc1 nil frame-map))) (t ;;; (warn "ADD: ~A/~S = ~A/~S + ~A/~S,~%~A ~A" ;;; destination-location

1 0