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

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

17 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14930 Modified Files: compiler.lisp Log Message: Added "fast" implementations of cddr and cdddr, in an effort to reduce cal/ret run-time and code-size overhead in list processing. Date: Sat Apr 17 11:33:45 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.52 movitz/compiler.lisp:1.53 --- movitz/compiler.lisp:1.52 Sat Apr 17 10:10:51 2004 +++ movitz/compiler.lisp Sat Apr 17 11:33:45 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.52 2004/04/17 14:10:51 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.53 2004/04/17 15:33:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2054,6 +2054,17 @@ (setq p `((:call (:edi ,(global-constant-offset newf)))) next-pc (nthcdr 2 pc)) (explain nil "Changed [~S ~S] to ~S" i i2 newf))) + ((and (global-funcall-p i '(fast-cdr)) + (global-funcall-p i2 '(fast-cdr)) + (global-funcall-p i3 '(fast-cdr))) + (setq p `((:call (:edi ,(global-constant-offset 'fast-cdddr)))) + next-pc (nthcdr 3 pc)) + (explain nil "Changed (cdr (cdr (cdr :eax))) to (cdddr :eax).")) + ((and (global-funcall-p i '(fast-cdr)) + (global-funcall-p i2 '(fast-cdr))) + (setq p `((:call (:edi ,(global-constant-offset 'fast-cddr)))) + next-pc (nthcdr 2 pc)) + (explain nil "Changed (cdr (cdr :eax)) to (cddr :eax).")) ((and (load-stack-frame-p i) (eq :eax (twop-dst i)) (global-funcall-p i2 '(fast-car fast-cdr)) (preserves-stack-location-p i3 (load-stack-frame-p i))

1 0

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

17 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv10477 Modified Files: compiler.lisp Log Message: Tiny edit. Date: Sat Apr 17 10:10:51 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.51 movitz/compiler.lisp:1.52 --- movitz/compiler.lisp:1.51 Sat Apr 17 10:10:00 2004 +++ movitz/compiler.lisp Sat Apr 17 10:10:51 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.51 2004/04/17 14:10:00 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.52 2004/04/17 14:10:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -739,11 +739,12 @@ have-normalized-ecx-p))) (let ((optimized-function-code (optimize-code function-code - :keep-labels (append (subseq (movitz-funobj-const-list funobj) - 0 (movitz-funobj-num-jumpers funobj)) - '(entry%1op - entry%2op - entry%3op))))) + :keep-labels (append + (subseq (movitz-funobj-const-list funobj) + 0 (movitz-funobj-num-jumpers funobj)) + '(entry%1op + entry%2op + entry%3op))))) (cons numargs optimized-function-code)))))))) (let ((code1 (cdr (assoc 1 code-specs))) (code2 (cdr (assoc 2 code-specs)))

1 0

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

17 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv9897 Modified Files: compiler.lisp Log Message: Be slightly more clever about when to implicitly insert stack-limit-checks. Date: Sat Apr 17 10:10:01 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.50 movitz/compiler.lisp:1.51 --- movitz/compiler.lisp:1.50 Fri Apr 16 19:38:41 2004 +++ movitz/compiler.lisp Sat Apr 17 10:10:00 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.50 2004/04/16 23:38:41 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.51 2004/04/17 14:10:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -728,7 +728,9 @@ (multiple-value-bind (prelude-code have-normalized-ecx-p) (make-compiled-function-prelude stack-frame-size function-env use-stack-frame-p (need-normalized-ecx-p function-env) frame-map - :do-check-stack-p t) + :do-check-stack-p (or (<= 32 stack-frame-size) + (tree-search resolved-code + '(:call)))) (let ((function-code (install-arg-cmp (append prelude-code resolved-code @@ -2702,7 +2704,8 @@ (truncate (or (position-if (lambda (i) (member b (find-read-bindings i))) - (cdr init-pc)) + (cdr init-pc) + #-sbcl :end #-sbcl 10) 15) count))))))))) ;; First, make several passes while trying to locate bindings

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 17 Apr '04

17 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4168 Modified Files: inspect.lisp Log Message: The function check-stack-limit certainly doesn't need to also implicitly check the stack-limit. Date: Sat Apr 17 10:09:07 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.8 movitz/losp/muerte/inspect.lisp:1.9 --- movitz/losp/muerte/inspect.lisp:1.8 Fri Apr 16 10:42:22 2004 +++ movitz/losp/muerte/inspect.lisp Sat Apr 17 10:09:07 2004 @@ -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.8 2004/04/16 14:42:22 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.9 2004/04/17 14:09:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -24,6 +24,7 @@ (:locally (:bound (:edi (:edi-offset stack-bottom)) :esp)))) (defun check-stack-limit () + (declare (without-check-stack-limit)) ; we do it explicitly.. (check-stack-limit)) (defun stack-top ()

1 0

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

17 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27234 Modified Files: typep.lisp Log Message: Tiny edit. Date: Sat Apr 17 10:08:24 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.9 movitz/losp/muerte/typep.lisp:1.10 --- movitz/losp/muerte/typep.lisp:1.9 Fri Apr 16 20:24:00 2004 +++ movitz/losp/muerte/typep.lisp Sat Apr 17 10:08: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.9 2004/04/17 00:24:00 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.10 2004/04/17 14:08:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -311,7 +311,7 @@ (,(car type) ,@(loop for subtype in (cdr type) collect `(typep ,object ',subtype))))) - (t (warn "typep ~A" type))))))) + (t (warn "compiling typep ~A" type))))))) form))))) #+ignore

1 0

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

17 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3360 Modified Files: typep.lisp Log Message: Minor fix. Date: Fri Apr 16 20:24:00 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.8 movitz/losp/muerte/typep.lisp:1.9 --- movitz/losp/muerte/typep.lisp:1.8 Fri Apr 16 20:02:53 2004 +++ movitz/losp/muerte/typep.lisp Fri Apr 16 20:24:00 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.8 2004/04/17 00:02:53 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.9 2004/04/17 00:24:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -266,9 +266,8 @@ :eax))) ((= 1 (logcount (1+ (- upper-limit lower-limit)))) `(with-inline-assembly (:returns :boolean-zf=1) - (:compile-form (:result-mode :eax) ,object) - (:leal (:eax ,(* movitz:+movitz-fixnum-factor+ - (- lower-limit))) + (:compile-form (:result-mode :ecx) ,object) + (:subl ,(* movitz:+movitz-fixnum-factor+ lower-limit) :ecx) (:testl ,(logxor #xffffffff (* movitz:+movitz-fixnum-factor+

1 0

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

17 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24866 Modified Files: typep.lisp Log Message: Teach typep about the eql and cons types. Date: Fri Apr 16 20:02:53 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.7 movitz/losp/muerte/typep.lisp:1.8 --- movitz/losp/muerte/typep.lisp:1.7 Fri Apr 16 19:34:43 2004 +++ movitz/losp/muerte/typep.lisp Fri Apr 16 20:02:53 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.7 2004/04/16 23:34:43 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.8 2004/04/17 00:02:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -293,6 +293,17 @@ movitz:+movitz-fixnum-factor+) :eax) not-fixnum))))))) + ((eql) + `(eql ,object ',(cadr type))) + ((cons) + (destructuring-bind (&optional (car t) (cdr t)) + (cdr type) + (let ((car (if (eq car '*) t car)) + (cdr (if (eq cdr '*) t cdr))) + `(let ((typep-object ,object)) + (and (typep typep-object 'cons) + (typep (car typep-object) ',car) + (typep (cdr typep-object) ',cdr)))))) ((not) (assert (and (cadr type) (not (cddr type)))) `(not (typep ,object ',(cadr type)))) @@ -301,9 +312,12 @@ (,(car type) ,@(loop for subtype in (cdr type) collect `(typep ,object ',subtype))))) - ((not and or) - (warn "typep compilermacro: ~S" type))))))) + (t (warn "typep ~A" type))))))) form))))) + +#+ignore +(defun foo (x) + (typep x '(cons * symbol))) (defmacro define-typep (tname lambda &body body) (let ((fname (format nil "~A-~A" 'typep tname)))

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv25822 Modified Files: compiler.lisp Log Message: Removed some dead code. Date: Fri Apr 16 19:38:41 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.49 movitz/compiler.lisp:1.50 --- movitz/compiler.lisp:1.49 Fri Apr 16 15:20:46 2004 +++ movitz/compiler.lisp Fri Apr 16 19:38:41 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.49 2004/04/16 19:20:46 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.50 2004/04/16 23:38:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -5222,25 +5222,9 @@ ((typep binding 'symbol-macro-binding) (compiler-call #'compile-form-unprotected :forward all - :form (funcall *movitz-macroexpand-hook* (macro-binding-expander (movitz-binding form env)) form env))) + :form (funcall *movitz-macroexpand-hook* + (macro-binding-expander (movitz-binding form env)) form env))) (t (compiler-call #'compile-dynamic-variable :forward all)))))) - -#+old-compiler -(defun ensure-local-binding (binding funobj env) - "Make sure that we have a binding that is local to funobj." - (if (eq funobj (binding-funobj binding)) - binding - (let* ((function-env (find-function-env env funobj)) - (local-binding (make-instance - (ecase (function-env-extent function-env) - (:indefinite-extent 'indefinite-borrowed-binding) - ;; XXXX - (:dynamic-extent 'indefinite-borrowed-binding) - (:lexical-extent 'lexical-borrowed-binding)) - :name (binding-name binding) - :target-binding binding))) - (movitz-environment-add-binding function-env (binding-name binding) local-binding) - local-binding))) (define-compiler compile-lexical-variable (&form variable &result-mode result-mode &env env) (let ((binding (movitz-binding variable env)))

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9968 Modified Files: symbols.lisp Log Message: Added (setf %symbol-global-value). Date: Fri Apr 16 19:36:40 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.10 movitz/losp/muerte/symbols.lisp:1.11 --- movitz/losp/muerte/symbols.lisp:1.10 Fri Apr 16 15:24:20 2004 +++ movitz/losp/muerte/symbols.lisp Fri Apr 16 19:36:40 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.10 2004/04/16 19:24:20 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.11 2004/04/16 23:36:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -61,6 +61,13 @@ (defun %symbol-global-value (symbol) (%symbol-global-value symbol)) + +(define-compiler-macro (setf %symbol-global-value) (value symbol) + `(setf (memref ,symbol ,(bt:slot-offset 'movitz:movitz-symbol 'movitz::value) 0 :lisp) + ,value)) + +(defun (setf %symbol-global-value) (value symbol) + (setf (%symbol-global-value symbol) value)) (defun symbol-function (symbol) (let ((function-value

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24308 Modified Files: primitive-functions.lisp Log Message: Minor edits. Date: Fri Apr 16 19:35:29 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.12 movitz/losp/muerte/primitive-functions.lisp:1.13 --- movitz/losp/muerte/primitive-functions.lisp:1.12 Thu Apr 15 09:07:24 2004 +++ movitz/losp/muerte/primitive-functions.lisp Fri Apr 16 19:35:29 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.12 2004/04/15 13:07:24 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.13 2004/04/16 23:35:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -601,8 +601,6 @@ (find-class (structure-object-name object))) (character (find-class 'character)) - (basic-restart - (find-class 'basic-restart)) (run-time-context (find-class 'run-time-context)) (null @@ -613,6 +611,8 @@ (find-class 'symbol)) (fixnum (find-class 'fixnum)) + (basic-restart + (find-class 'basic-restart)) (tag6 (error "Don't know the class of ~Z with other-type #x~X." object (with-inline-assembly (:returns :untagged-fixnum-ecx)

1 0