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

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by ffjeld＠common-lisp.net 28 Aug '05

28 Aug '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6231 Modified Files: special-operators-cl.lisp Log Message: Many fixes to the compiler. Basic change is that LET init-forms are compiled with compile-form-unprotected, and that compile-lexical-variable and compile-self-evaluating return binding only as "returns", not in the form of "code". Date: Sun Aug 28 23:03:27 2005 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.47 movitz/special-operators-cl.lisp:1.48 --- movitz/special-operators-cl.lisp:1.47 Sat Aug 20 22:31:15 2005 +++ movitz/special-operators-cl.lisp Sun Aug 28 23:03:27 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.47 2005/08/20 20:31:15 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.48 2005/08/28 21:03:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -85,11 +85,11 @@ :modify-accumulate let-modifies :result-mode :push) `((:pushl :edi)) ; scratch - (compiler-call #'compile-self-evaluating ; binding name + (compiler-call #'compile-form ; binding name :with-stack-used (incf stack-used 2) :env init-env :defaults all - :form var + :form `(muerte.cl:quote ,var) :result-mode :push) (prog1 nil (incf stack-used))) nil t) @@ -103,20 +103,26 @@ (compiler-values-bind (&code init-code &functional-p functional-p &type type &returns init-register &final-form final-form) - (compiler-call #'compile-form-to-register + + (compiler-call #'compile-form-unprotected + :result-mode binding + :env init-env + :extent local-env + :defaults all + :form init-form) + #+ignore + (compiler-call #'compile-form-to-register :env init-env :extent local-env :defaults all :form init-form :modify-accumulate let-modifies) + (when (eq binding init-register) + (setf init-register nil)) ;;; (warn "var ~S, type: ~S" var type) ;;; (warn "var ~S init: ~S.." var init-form) -;;; (print-code 'init -;;; (compiler-call #'compile-form -;;; :env init-env -;;; :defaults all -;;; :form init-form -;;; :result-mode binding)) +;;; (warn "bind: ~S reg: ~S" binding init-register) +;;; (print-code 'init init-code) (list var init-form init-code @@ -127,6 +133,7 @@ init-type) (case init-register (:non-local-exit :edi) + (:multiple-values :eax) (t init-register)) final-form)))))) (setf (stack-used local-env) @@ -221,6 +228,9 @@ ;; This is the best we can do now to determine ;; if target-binding is ever used again. (and (eq result-mode :function) + (not (and (bindingp body-returns) + (binding-eql target-binding + body-returns))) (not (code-uses-binding-p body-code target-binding :load t @@ -261,10 +271,11 @@ :load nil :store t))) ;; replace read-only lexical binding with ;; side-effect-free form - #+ignore (warn "Constant binding: ~S => ~S => ~S" - (binding-name binding) - init-form - (car (type-specifier-singleton type))) + #+ignore + (warn "Constant binding: ~S => ~S => ~S" + (binding-name binding) + init-form + (car (type-specifier-singleton type))) (change-class binding 'constant-object-binding :object (car (type-specifier-singleton type))) (if functional-p @@ -1404,7 +1415,9 @@ :returns :eax)))) (t (compiler-call #'compile-form-unprotected :forward all - :form `(muerte::compiled-cond (,test-form ,then-form) (t ,else-form))))))))) + :form `(muerte::compiled-cond + (,test-form ,then-form) + (muerte.cl::t ,else-form))))))))) (define-special-operator the (&all all &form form) (destructuring-bind (value-type sub-form)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/dp8390.lisp
by ffjeld＠common-lisp.net 28 Aug '05

28 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv5269 Modified Files: dp8390.lisp Log Message: Removed dead code. Date: Sun Aug 28 22:56:00 2005 Author: ffjeld Index: movitz/losp/x86-pc/dp8390.lisp diff -u movitz/losp/x86-pc/dp8390.lisp:1.8 movitz/losp/x86-pc/dp8390.lisp:1.9 --- movitz/losp/x86-pc/dp8390.lisp:1.8 Wed Aug 24 09:33:13 2005 +++ movitz/losp/x86-pc/dp8390.lisp Sun Aug 28 22:56:00 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Sep 18 12:21:36 2002 ;;;; -;;;; $Id: dp8390.lisp,v 1.8 2005/08/24 07:33:13 ffjeld Exp $ +;;;; $Id: dp8390.lisp,v 1.9 2005/08/28 20:56:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -129,14 +129,6 @@ address)) (setf (io-register8x2 dp8390 ($page0-write rbcr1) ($page0-write rbcr0)) size (dp8390 ($page0-write cr)) command)) - nil) - -(defun foo (io-base command size address) - (let ((io-base (the (unsigned-byte #x10) - (let ((check-the-io-base io-base)) - (check-type check-the-io-base (unsigned-byte #x10)) - check-the-io-base)))) - (setf (io-port (+ io-base 0) :unsigned-byte8) #o40)) nil) (defmacro with-dp8390-dma ((dp8390-var rdma-command size &optional address) &body body)

1 0

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

28 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5232 Modified Files: basic-macros.lisp Log Message: Fixed bogus word-nibble. Date: Sun Aug 28 22:53:14 2005 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.64 movitz/losp/muerte/basic-macros.lisp:1.65 --- movitz/losp/muerte/basic-macros.lisp:1.64 Sun Aug 21 15:47:20 2005 +++ movitz/losp/muerte/basic-macros.lisp Sun Aug 28 22:53:13 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.64 2005/08/21 13:47:20 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.65 2005/08/28 20:53:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1083,10 +1083,11 @@ (defmacro word-nibble (word-form nibble) (check-type nibble (integer 0 7)) - `(with-inline-assembly (:returns :untagged-fixnum-eax) + `(with-inline-assembly (:returns :untagged-fixnum-ecx) (:compile-form (:result-mode :eax) ,word-form) - (:shrl ,(* 4 nibble) :eax) - (:andl #xf :eax))) + (:movl :eax :ecx) + (:shrl ,(* 4 nibble) :ecx) + (:andl #xf :ecx))) (define-compiler-macro boundp (symbol) `(with-inline-assembly-case ()

1 0

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

26 Aug '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv10121 Modified Files: packages.lisp Log Message: Export muerte:index. Date: Sat Aug 27 00:50:36 2005 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.53 movitz/packages.lisp:1.54 --- movitz/packages.lisp:1.53 Fri Aug 26 23:40:28 2005 +++ movitz/packages.lisp Sat Aug 27 00:50:36 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.53 2005/08/26 21:40:28 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.54 2005/08/26 22:50:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1099,6 +1099,7 @@ #:fixnump #:newline #:check-the + #:index #:*print-safely*

1 0

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

26 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9154 Modified Files: scavenge.lisp Log Message: Be a bit more conservative about debugging. Date: Sat Aug 27 00:42:43 2005 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.52 movitz/losp/muerte/scavenge.lisp:1.53 --- movitz/losp/muerte/scavenge.lisp:1.52 Fri Aug 26 21:38:19 2005 +++ movitz/losp/muerte/scavenge.lisp Sat Aug 27 00:42:43 2005 @@ -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.52 2005/08/26 19:38:19 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.53 2005/08/26 22:42:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -50,7 +50,9 @@ (let ((code (dpb secondary (byte 8 8) (movitz:tag primary)))) - `(= ,code ,x)))) + `(= ,code ,x))) + (record-scan (x) + #+ignore `(setf *scan-last* ,x))) (do ((verbose *map-header-vals-verbose*) (*scan-last* nil) ; Last scanned object, for debugging. (scan start-location (1+ scan))) @@ -79,12 +81,12 @@ ;; Just skip the bigits (let* ((bigits (memref scan 0 :index 1 :type :unsigned-byte14)) (delta (logior bigits 1))) - (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) + (record-scan (%word-offset scan #.(movitz:tag :other))) (incf scan delta))) ((scavenge-typep x :defstruct) (assert (evenp scan) () "Scanned struct-header ~S at odd location #x~X." x scan) - (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))) + (record-scan (%word-offset scan #.(movitz:tag :other)))) ((scavenge-typep x :run-time-context) (assert (evenp scan) () "Scanned run-time-context-header ~S at odd location #x~X." @@ -102,7 +104,7 @@ (assert (evenp scan) () "Scanned funobj-header ~S at odd location #x~X." (memref scan 0 :type :unsigned-byte32) scan) - (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) + (record-scan (%word-offset scan #.(movitz:tag :other))) ;; Process code-vector pointers specially.. (let* ((old-code-vector (memref (incf scan) 0 :type :code-vector)) (new-code-vector (map-instruction-pointer function scan old-code-vector))) @@ -163,14 +165,14 @@ "Scanned u8-vector-header ~S at odd location #x~X." x scan) (let ((len (memref scan 0 :index 1 :type :lisp))) (check-type len positive-fixnum) - (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) + (record-scan (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (* 2 (truncate (+ 7 len) 8)))))) ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u16)) (assert (evenp scan) () "Scanned u16-vector-header ~S at odd location #x~X." x scan) (let ((len (memref scan 0 :index 1))) (check-type len positive-fixnum) - (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) + (record-scan (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (* 2 (truncate (+ 3 len) 4)))))) ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u32)) (assert (evenp scan) () @@ -178,7 +180,7 @@ (let ((len (memref scan 4))) (assert (typep len 'positive-fixnum) () "Scanned basic-vector at ~S with illegal length ~S." scan len) - (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) + (record-scan (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (logand (1+ len) -2))))) ((scavenge-typep x :basic-vector) (if (or (scavenge-wide-typep x :basic-vector @@ -187,10 +189,10 @@ (scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :indirects))) - (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) + (record-scan (%word-offset scan #.(movitz:tag :other))) (error "Scanned unknown basic-vector-header ~S at location #x~X." x scan))) ((and (eq x 3) (eq x2 0)) - (setf *scan-last* scan) + (record-scan scan) (incf scan) (let ((delta (memref scan 0))) (check-type delta positive-fixnum)

1 0

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

26 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9123 Modified Files: inspect.lisp Log Message: Teach shallow-copy about ratios. Date: Sat Aug 27 00:38:08 2005 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.55 movitz/losp/muerte/inspect.lisp:1.56 --- movitz/losp/muerte/inspect.lisp:1.55 Sat Jun 11 02:02:04 2005 +++ movitz/losp/muerte/inspect.lisp Sat Aug 27 00:38:07 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.55 2005/06/11 00:02:04 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.56 2005/08/26 22:38:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -262,6 +262,9 @@ (copy-funobj old)) (structure-object (copy-structure old)) + (ratio + (make-ratio (%ratio-numerator old) + (%ratio-denominator old))) (run-time-context (%shallow-copy-object old (movitz-type-word-size 'movitz-run-time-context)))))

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/textmode.lisp
by ffjeld＠common-lisp.net 26 Aug '05

26 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv4712 Modified Files: textmode.lisp Log Message: Tweaked textmode-scroll-down. Date: Fri Aug 26 23:42:40 2005 Author: ffjeld Index: movitz/losp/x86-pc/textmode.lisp diff -u movitz/losp/x86-pc/textmode.lisp:1.14 movitz/losp/x86-pc/textmode.lisp:1.15 --- movitz/losp/x86-pc/textmode.lisp:1.14 Wed Nov 24 17:24:36 2004 +++ movitz/losp/x86-pc/textmode.lisp Fri Aug 26 23:42:39 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2000-2004, +;;;; Copyright (C) 2000-2005, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: textmode.lisp @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 9 15:38:56 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: textmode.lisp,v 1.14 2004/11/24 16:24:36 ffjeld Exp $ +;;;; $Id: textmode.lisp,v 1.15 2005/08/26 21:42:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -100,6 +100,7 @@ (move-vga-cursor (setf *cursor-x* (1+ x)) y)))) nil) +#+ignore (defun textmode-copy-line (destination source count) (check-type count (and (integer 0 511) (satisfies evenp))) (check-type source (unsigned-byte 20)) @@ -125,12 +126,36 @@ (defun textmode-scroll-down () (declare (special muerte.lib::*scroll-offset*)) (incf muerte.lib::*scroll-offset*) - (loop with stride = (* 2 *screen-stride*) - for y below (1- *screen-height*) - as src from (+ *screen* stride) by stride - as dst from *screen* by stride - do (textmode-copy-line dst src *screen-width*) - finally (textmode-clear-line 0 (1- *screen-height*))) + (macrolet ((copy-line (destination source count) + `(let ((destination ,destination) + (source ,source) + (count ,count)) + (with-inline-assembly (:returns :nothing) + (:compile-form (:result-mode :edx) destination) + (:compile-form (:result-mode :eax) source) + (:compile-form (:result-mode :ebx) count) + (:std) ; Only EBX is now (potential) GC root + (:andl #x-8 :ebx) ; ..so make sure EBX is a fixnum + (:shrl 2 :eax) + (:shrl 2 :edx) + (:shrl 1 :ebx) + (:jz 'end-copy-loop) + copy-loop + (#.movitz:*compiler-physical-segment-prefix* :movl (:eax :ebx -4) :ecx) + (#.movitz:*compiler-physical-segment-prefix* :movl :ecx (:edx :ebx -4)) + (:subl 4 :ebx) + (:ja 'copy-loop) + end-copy-loop + (:cld))))) + (loop with screen = (check-the fixnum *screen*) + with stride = (* 2 *screen-stride*) + with width = (check-the fixnum *screen-width*) + with height = (1- (check-the fixnum *screen-height*)) + repeat height + as src of-type fixnum from (+ screen stride) by stride + as dst of-type fixnum from screen by stride + do (copy-line dst src width) + finally (textmode-clear-line 0 height))) (signal 'newline)) (defun textmode-clear-line (from-column line)

1 0

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

26 Aug '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4697 Modified Files: compiler.lisp Log Message: Fixed bug in peephole optimizer that would erroneously regard some stack-frame locations as unused. Date: Fri Aug 26 23:42:08 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.159 movitz/compiler.lisp:1.160 --- movitz/compiler.lisp:1.159 Fri Aug 26 21:43:32 2005 +++ movitz/compiler.lisp Fri Aug 26 23:42:08 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.159 2005/08/26 19:43:32 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.160 2005/08/26 21:42:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -567,6 +567,13 @@ (when (and (not (null (type-analysis-thunks analysis))) (not (apply #'encoded-allp (type-analysis-declared-encoded-type analysis)))) + #+ignore + (warn "Trusting ~S, was ~S, because ~S [~S]" + binding + (type-analysis-encoded-type analysis) + (type-analysis-thunks analysis) + (loop for (thunk . thunk-args) in (type-analysis-thunks analysis) + collect (mapcar #'binding-resolved-p thunk-args))) (setf (type-analysis-encoded-type analysis) (type-analysis-declared-encoded-type analysis)) (setf (type-analysis-thunks analysis) nil))) ; Ignore remaining thunks. @@ -1742,6 +1749,8 @@ (stack-frame-operand (twop-dst c op))) (read-stack-frame-p (c) (or (load-stack-frame-p c :movl) + (load-stack-frame-p c :addl) + (load-stack-frame-p c :subl) (load-stack-frame-p c :cmpl) (store-stack-frame-p c :cmpl) (and (consp c) @@ -7044,6 +7053,7 @@ but it's requested to be in ~S." destreg) (let ((srcloc (new-binding-location (binding-target src) frame-map))) + (unless (eql srcloc loc1) (break)) (if (integerp srcloc) `((:addl (:ebp ,(stack-frame-offset srcloc)) ,destreg)

1 0

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

26 Aug '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4667 Modified Files: packages.lisp Log Message: Export muerte:check-the. Date: Fri Aug 26 23:40:29 2005 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.52 movitz/packages.lisp:1.53 --- movitz/packages.lisp:1.52 Thu Aug 11 23:32:55 2005 +++ movitz/packages.lisp Fri Aug 26 23:40:28 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.52 2005/08/11 21:32:55 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.53 2005/08/26 21:40:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1098,6 +1098,7 @@ #:read-key #:fixnump #:newline + #:check-the #:*print-safely*

1 0

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

26 Aug '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv29112 Modified Files: compiler.lisp Log Message: Comment out debug message.. Date: Fri Aug 26 21:43:32 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.158 movitz/compiler.lisp:1.159 --- movitz/compiler.lisp:1.158 Fri Aug 26 21:41:32 2005 +++ movitz/compiler.lisp Fri Aug 26 21:43:32 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.158 2005/08/26 19:41:32 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.159 2005/08/26 19:43:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -6808,7 +6808,7 @@ (loc1 (new-binding-location (binding-target term1) frame-map :default nil))) #+ignore (warn "add: ~A for ~A" instruction result-type) - + #+ignore (warn "add for: ~S is ~A, from ~A/~A and ~A/~A." destination result-type term0 loc0

1 0