February 2004 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp
by Frode Vatvedt Fjeld 20 Feb '04

20 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7329 Modified Files: basic-macros.lisp Log Message: New compiler-macros for car, cdr, and endp. Date: Fri Feb 20 10:10:43 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.3 movitz/losp/muerte/basic-macros.lisp:1.4 --- movitz/losp/muerte/basic-macros.lisp:1.3 Mon Feb 2 08:40:36 2004 +++ movitz/losp/muerte/basic-macros.lisp Fri Feb 20 10:10:43 2004 @@ -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.3 2004/02/02 13:40:36 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.4 2004/02/20 15:10:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -535,48 +535,16 @@ nil)))) (define-compiler-macro car (x) - `(with-inline-assembly-case (:side-effects nil) - (do-case (:ignore :nothing) - (:compile-form (:result-mode :ignore) ,x)) - (do-case (t :eax) - (:compile-form (:result-mode :eax) ,x) - (:globally (:call (:edi (:edi-offset fast-car))))))) + `(let ((cell ,x)) + (with-inline-assembly-case (:side-effects nil) + (do-case (t :register) + (:cons-get :car (:lexical-binding cell) (:result-register)))))) (define-compiler-macro cdr (x) - `(with-inline-assembly-case (:side-effects nil) - (do-case (:ignore :nothing) - (:compile-form (:result-mode :ignore) ,x)) - (do-case (t :eax) - (:compile-form (:result-mode :eax) ,x) - (:globally (:call (:edi (:edi-offset fast-cdr))))))) - -#+ignore -(define-compiler-macro cdr (x) - `(with-inline-assembly-case (:side-effects nil) - (do-case ((:boolean-branch-on-true :boolean-branch-on-false) - :boolean-zf=0) - (:compile-form (:result-mode :eax) ,x) - (:leal (:eax -1) :ecx) - (:testb 3 :cl) - (:jnz '(:sub-program (cdr-failed) - (:int 60))) - (:cmpl :edi (:eax 3))) - (do-case (:ignore :nothing) - (:warn "ignore cdr!")) - (do-case (:ecx :ecx) - (:compile-form (:result-mode :ecx) ,x) - (:decl :ecx) - (:testb 3 :cl) - (:jnz '(:sub-program (cdr-failed) - (:int 60))) - (:movl (:ecx 4) :ecx)) - (do-case (t :register) - (:compile-form (:result-mode :register) ,x) - (:leal ((:result-register) -1) :ecx) - (:testb 3 :cl) - (:jnz '(:sub-program (cdr-failed) - (:int 60))) - (:movl ((:result-register) 3) (:result-register))))) + `(let ((cell ,x)) + (with-inline-assembly-case (:side-effects nil) + (do-case (t :register) + (:cons-get :cdr (:lexical-binding cell) (:result-register)))))) (define-compiler-macro cadr (x) `(car (cdr ,x))) @@ -633,14 +601,13 @@ (:movl :ebx (:eax 3)))) (define-compiler-macro endp (x) - (let ((endp-var (gensym "endp-var-"))) - `(let ((,endp-var ,x)) - (if ,endp-var - (check-type ,endp-var list) - t)))) + `(let ((cell ,x)) + (with-inline-assembly-case (:side-effects nil) + (do-case (t :same) + (:endp (:lexical-binding cell) (:returns-mode)))))) (define-compiler-macro cons (x y) - `(with-inline-assembly (:returns :eax :side-effects t) + `(with-inline-assembly (:returns :eax :side-effects nil :type cons) (:compile-two-forms (:eax :ebx) ,x ,y) (:globally (:call (:edi (:edi-offset fast-cons))))))

1 0

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

20 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv16512 Modified Files: compiler.lisp Log Message: Added :endp extended-code operator. Date: Fri Feb 20 10:08:51 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.30 movitz/compiler.lisp:1.31 --- movitz/compiler.lisp:1.30 Tue Feb 17 15:23:51 2004 +++ movitz/compiler.lisp Fri Feb 20 10:08: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.30 2004/02/17 20:23:51 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.31 2004/02/20 15:08:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -442,6 +442,7 @@ (type-analysis-binding-types analysis)) (setf (binding-store-type binding) (type-analysis-encoded-type analysis)) + #+ignore (when (apply #'encoded-type-singleton (type-analysis-encoded-type analysis)) (warn "Singleton: ~A" binding)) #+ignore @@ -2456,7 +2457,9 @@ (remove-if (lambda (r) (tree-search i r)) free-so-far))) - ((:load-constant :load-lexical :store-lexical :init-lexvar :car :incf-lexvar) + ((:load-constant :load-lexical :store-lexical :init-lexvar + :cons-get :endp :incf-lexvar + :local-function-init) (unless (can-expand-extended-p i frame-map) (return (values nil t))) (let ((exp (expand-extended-code i funobj frame-map))) @@ -2655,8 +2658,8 @@ (or (position-if (lambda (i) (member b (find-read-bindings i))) (cdr init-pc) - :end 5) - 10) + :end 10) + 15) count))))))))) ;; First, make several passes while trying to locate bindings ;; into registers. @@ -3132,7 +3135,6 @@ (dest-location (new-binding-location destination frame-map :default nil))) (cond ((not dest-location) ; unknown, e.g. a borrowed-binding. - (warn "unknown dest-loc for ~A" destination) (append (install-for-single-value binding binding-location :ecx nil) (make-store-lexical result-mode :ecx nil frame-map))) ((eql binding-location dest-location) @@ -5621,49 +5623,98 @@ ;;;;;;;;;;;;;;;;;; car -(define-find-read-bindings :car (x dst &key protect-registers) - (declare (ignore dst protect-registers)) - (when (typep x 'binding) - (list x))) +(define-find-read-bindings :cons-get (op cell dst) + (declare (ignore op dst protect-registers)) + (when (typep cell 'binding) + (list cell))) -(define-extended-code-expander :car (instruction funobj frame-map) - (destructuring-bind (x dst) +(define-extended-code-expander :cons-get (instruction funobj frame-map) + (destructuring-bind (op cell dst) (cdr instruction) - (assert (member dst '(:eax :ebx :ecx :edx))) - (etypecase x - (binding - (let* ((binding (binding-target (ensure-local-binding (binding-target x) funobj))) - (location (new-binding-location (binding-target binding) frame-map)) - (binding-is-list-p (binding-store-subtypep binding 'list))) + (check-type cell lexical-binding) + (check-type dst (member :eax :ebx :ecx :edx)) + (multiple-value-bind (op-offset fast-op fast-op-ebx) + (ecase op + (:car (values (bt:slot-offset 'movitz-cons 'car) + 'fast-car + 'fast-car-ebx)) + (:cdr (values (bt:slot-offset 'movitz-cons 'cdr) + 'fast-cdr + 'fast-cdr-ebx))) + (let* ((binding (binding-target (ensure-local-binding (binding-target cell) funobj))) + (location (new-binding-location (binding-target binding) frame-map)) + (binding-is-list-p (binding-store-subtypep binding 'list))) ;;; (warn "car of loc ~A bind ~A" ;;; location binding) - (cond - ((and binding-is-list-p - (member location '(:eax :ebx :ecx :edx))) - `((:movl (,location -1) ,dst))) - (binding-is-list-p - `(,@(make-load-lexical binding dst funobj nil frame-map) - (:movl (,dst -1) ,dst))) - ((eq location :ebx) - `((,*compiler-global-segment-prefix* - :call (:edi ,(global-constant-offset 'fast-car-ebx))) - ,@(when (not (eq dst :eax)) - `((:movl :eax ,dst))))) - (t `(,@(make-load-lexical binding :eax funobj nil frame-map) - (,*compiler-global-segment-prefix* - :call (:edi ,(global-constant-offset 'fast-car))) - ,@(when (not (eq dst :eax)) - `((:movl :eax ,dst)))))))) - (symbol - (append (case x - (:eax - `((:call (:edi ,(global-constant-offset 'fast-car))))) - (:ebx - `((:call (:edi ,(global-constant-offset 'fast-car-ebx))))) - (t `((:movl ,x :eax) - (:call (:edi ,(global-constant-offset 'fast-car)))))) - (when (not (eq dst :eax)) - `((:movl :eax ,dst)))))))) + (cond + ((and binding-is-list-p + (member location '(:eax :ebx :ecx :edx))) + `((:movl (,location ,op-offset) ,dst))) + (binding-is-list-p + `(,@(make-load-lexical binding dst funobj nil frame-map) + (:movl (,dst ,op-offset) ,dst))) + ((eq location :ebx) + `((,*compiler-global-segment-prefix* + :call (:edi ,(global-constant-offset fast-op-ebx))) + ,@(when (not (eq dst :eax)) + `((:movl :eax ,dst))))) + (t `(,@(make-load-lexical binding :eax funobj nil frame-map) + (,*compiler-global-segment-prefix* + :call (:edi ,(global-constant-offset fast-op))) + ,@(when (not (eq dst :eax)) + `((:movl :eax ,dst)))))))))) + + +;;;;;;;;;;;;;;;;;; endp + +(define-find-read-bindings :endp (cell result-mode) + (declare (ignore result-mode)) + (when (typep cell 'binding) + (list cell))) + +(define-extended-code-expander :endp (instruction funobj frame-map) + (destructuring-bind (cell result-mode) + (cdr instruction) + (check-type cell lexical-binding) + (let* ((binding (binding-target (ensure-local-binding (binding-target cell) funobj))) + (location (new-binding-location (binding-target binding) frame-map)) + (binding-is-list-p (binding-store-subtypep binding 'list)) + (tmp-register (case location + ((:eax :ebx :ecx :edx) + location)))) + ;; (warn "endp of loc ~A bind ~A" location binding) + (cond + ((and binding-is-list-p + (member location '(:eax :ebx :ecx :edx))) + (make-result-and-returns-glue result-mode :boolean-zf=1 + `((:cmpl :edi ,location)))) +;;; ((and binding-is-list-p +;;; (eq (result-mode-type result-mode) +;;; :boolean-branch-on-false)) +;;; (cond +;;; ((member location '(:eax :ebx :ecx :edx)) + ((eq :boolean-branch-on-true (result-mode-type result-mode)) + (let ((tmp-register (or tmp-register :ecx))) + (append (make-load-lexical binding + (cons :boolean-branch-on-false + (cdr result-mode)) + funobj nil frame-map) + (unless binding-is-list-p + (append (make-load-lexical binding tmp-register funobj nil frame-map) + `((:leal (,tmp-register -1) :ecx) + (:testb 3 :cl) + (:jnz '(:sub-program (,(gensym "endp-not-cons-")) + (:int 66))))))))) + (t (let ((tmp-register (or tmp-register :eax))) + (append (make-load-lexical binding tmp-register funobj nil frame-map) + (unless binding-is-list-p + `((:leal (,tmp-register -1) :ecx) + (:testb 3 :cl) + (:jnz '(:sub-program (,(gensym "endp-not-cons-")) + (:int 66))))) + `((:cmpl :edi ,tmp-register)) + (make-result-and-returns-glue result-mode :boolean-zf=1)))))))) + ;;;;;;;;;;;;;;;;;; incf-lexvar

1 0

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

18 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv20576 Modified Files: load.lisp Log Message: Tried to improve GC behavior in allegro. Don't know if it actually works, though. Date: Wed Feb 18 09:42:59 2004 Author: ffjeld Index: movitz/load.lisp diff -u movitz/load.lisp:1.9 movitz/load.lisp:1.10 --- movitz/load.lisp:1.9 Fri Feb 13 17:17:41 2004 +++ movitz/load.lisp Wed Feb 18 09:42:59 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Jan 15 18:40:58 2004 ;;;; -;;;; $Id: load.lisp,v 1.9 2004/02/13 22:17:41 ffjeld Exp $ +;;;; $Id: load.lisp,v 1.10 2004/02/18 14:42:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -46,7 +46,7 @@ (excl:load-system :movitz) (setf excl:*tenured-bytes-limit* #x2000000) (setf (system::gsgc-parameter :generation-spread) 12) - (sys:resize-areas :new (* 16 1024 1024))) + (sys:resize-areas :new (* 64 1024 1024))) #+clisp (load "packages") #+clisp (defconstant movitz::&all 'movitz::&all) ; CLisp has this wonderful bug..

1 0

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

18 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11803 Modified Files: los-closette.lisp Log Message: Added an ignore declaration. Date: Wed Feb 18 09:40:58 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.3 movitz/losp/muerte/los-closette.lisp:1.4 --- movitz/losp/muerte/los-closette.lisp:1.3 Sun Feb 15 08:16:56 2004 +++ movitz/losp/muerte/los-closette.lisp Wed Feb 18 09:40:58 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 23 14:29:10 2002 ;;;; -;;;; $Id: los-closette.lisp,v 1.3 2004/02/15 13:16:56 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.4 2004/02/18 14:40:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1810,7 +1810,7 @@ (generic-function-methods (lambda (gf) (std-gf-slot-value gf 'methods))) (generic-function-method-combination - (lambda (gf) nil)) + (lambda (gf) (declare (ignore gf)) nil)) (accessor-method-slot-definition (lambda (method) (std-slot-value method 'slot-definition)))

1 0

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

18 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2731 Modified Files: simple-streams.lisp Log Message: Added an ignore declaration. Date: Wed Feb 18 09:39:37 2004 Author: ffjeld Index: movitz/losp/muerte/simple-streams.lisp diff -u movitz/losp/muerte/simple-streams.lisp:1.3 movitz/losp/muerte/simple-streams.lisp:1.4 --- movitz/losp/muerte/simple-streams.lisp:1.3 Mon Feb 2 09:55:32 2004 +++ movitz/losp/muerte/simple-streams.lisp Wed Feb 18 09:39:37 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Aug 29 13:39:43 2003 ;;;; -;;;; $Id: simple-streams.lisp,v 1.3 2004/02/02 14:55:32 ffjeld Exp $ +;;;; $Id: simple-streams.lisp,v 1.4 2004/02/18 14:39:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -684,6 +684,7 @@ stream) (defun install-string-output-character-strategy (stream) + (declare (ignore stream)) #| implement me |#) (defun string-read-char-e-crlf (stream eof-error-p eof-value blocking)

1 0

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

18 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15265 Modified Files: setf.lisp Log Message: Removed some dead code. Made setf a proper macro rather than compiler-macro. For historical reasons there are many (nominally) macros that are defined as compiler-macros in movitz, this shouldn't be. Date: Wed Feb 18 09:38:15 2004 Author: ffjeld Index: movitz/losp/muerte/setf.lisp diff -u movitz/losp/muerte/setf.lisp:1.2 movitz/losp/muerte/setf.lisp:1.3 --- movitz/losp/muerte/setf.lisp:1.2 Mon Jan 19 06:23:47 2004 +++ movitz/losp/muerte/setf.lisp Wed Feb 18 09:38:14 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Feb 8 20:43:20 2001 ;;;; -;;;; $Id: setf.lisp,v 1.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: setf.lisp,v 1.3 2004/02/18 14:38:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -151,7 +151,7 @@ ,setter-form))))))) -(define-compiler-macro setf (&environment env &rest pairs) +(defmacro setf (&environment env &rest pairs) (let ((num-pairs (length pairs))) (cond ((= 2 num-pairs) @@ -159,11 +159,6 @@ pairs ;; 5.1.2 Kinds of Places (cond - #+ignore - ((nth-value 1 (movitz::movitz-macroexpand-1 place env)) - ;; 5.1.2.7 Macro forms as places - ;; ..and 5.1.2.8 Symbol Macros as places. - `(setf ,(movitz::movitz-macroexpand-1 place env) ,new-value-form)) ((symbolp place) ; 5.1.2.1 Variable Names as Places (multiple-value-bind (expansion expanded-p) (movitz::movitz-macroexpand-1 place env) @@ -172,9 +167,6 @@ `(setq ,place ,new-value-form)))) (t (multiple-value-bind (tmp-vars tmp-forms store-vars setter-form) (get-setf-expansion place env) - #+ignore - (warn "tmp-vars: ~W, tmp-forms: ~W, store-vars: ~W, setter-form: ~W" - tmp-vars tmp-forms store-vars setter-form) (case (length store-vars) (0 `(progn ,@tmp-forms ,new-value-form nil)) (1 `(let (,@(loop for tmp-var in tmp-vars @@ -188,31 +180,7 @@ collect `(,tmp-var ,tmp-form)) (multiple-value-bind ,store-vars ,new-value-form - ,setter-form)))))) - #+ignore - ((listp place) ; 5.1.2.9 Other Compound Forms as Places - (let ((place-operator (first place)) - (place-args (rest place))) - (multiple-value-bind (newvalue-form newvalue-lets) - (if (movitz:movitz-constantp new-value-form) - (values new-value-form nil) - (let ((newvalue-var (gensym "setf-newvalue"))) - (values newvalue-var - (list (list newvalue-var new-value-form))))) - (multiple-value-bind (place-forms place-lets) - (loop for pa in place-args - as var = (gensym "setf-var") - if (movitz:movitz-constantp pa) - collect pa into forms - else - collect var into forms - and collect (list var pa) into lets - finally (return (values forms lets))) - `(let (,@place-lets ,@newvalue-lets) - (,(movitz::movitz-env-setf-operator-name (movitz::translate-program place-operator - :cl :muerte.cl)) - ,newvalue-form - ,@place-forms))))))))) + ,setter-form))))))))) ((evenp num-pairs) (cons 'progn (loop for (place newvalue) on pairs by #'cddr

1 0

[movitz-cvs] CVS update: movitz/losp/lib/repl.lisp
by Frode Vatvedt Fjeld 18 Feb '04

18 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv30205 Modified Files: repl.lisp Log Message: Added a missing ignore declaration. Date: Wed Feb 18 06:48:20 2004 Author: ffjeld Index: movitz/losp/lib/repl.lisp diff -u movitz/losp/lib/repl.lisp:1.3 movitz/losp/lib/repl.lisp:1.4 --- movitz/losp/lib/repl.lisp:1.3 Mon Jan 19 06:23:44 2004 +++ movitz/losp/lib/repl.lisp Wed Feb 18 06:48:20 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 19 14:58:12 2003 ;;;; -;;;; $Id: repl.lisp,v 1.3 2004/01/19 11:23:44 ffjeld Exp $ +;;;; $Id: repl.lisp,v 1.4 2004/02/18 11:48:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -46,6 +46,7 @@ (handler-bind ((muerte::missing-delimiter (lambda (c) + (declare (ignore c)) (format t "~&> ") (invoke-restart 'muerte::next-line (muerte.readline:contextual-readline *repl-readline-context*)))))

1 0

[movitz-cvs] CVS update: movitz/doc/ideas.txt
by Frode Vatvedt Fjeld 18 Feb '04

18 Feb '04

Update of /project/movitz/cvsroot/movitz/doc In directory common-lisp.net:/tmp/cvs-serv8233 Modified Files: ideas.txt Log Message: Some more loose idease that might be chased later. Date: Wed Feb 18 06:18:31 2004 Author: ffjeld Index: movitz/doc/ideas.txt diff -u movitz/doc/ideas.txt:1.2 movitz/doc/ideas.txt:1.3 --- movitz/doc/ideas.txt:1.2 Thu Jan 15 05:47:57 2004 +++ movitz/doc/ideas.txt Wed Feb 18 06:18:31 2004 @@ -10,7 +10,7 @@ ## Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ## Created at: Fri Dec 12 19:19:39 2003 ## -## $Id: ideas.txt,v 1.2 2004/01/15 10:47:57 ffjeld Exp $ +## $Id: ideas.txt,v 1.3 2004/02/18 11:18:31 ffjeld Exp $ ## ###################################################################### @@ -21,6 +21,9 @@ this would allow for a cache-size of 1 or 2, say. And it'd be possible to determine these cases dynamically. + - It might be feasible to locate some specialization-tables directly + in the instance structure. For example eql-specialized methods. + ** Function calls via symbols @@ -44,3 +47,9 @@ install in the old FS a code-vector that updates the caller function's references to the new FS, before trampolining to the new FS. The performance gain could be substantial. + + +** Caching strategies + + - Might e.g. write-combining or other relaxed memory coherence + models be used, e.g. within one "thread" area?

1 0

[movitz-cvs] CVS update: movitz/special-operators.lisp
by Frode Vatvedt Fjeld 17 Feb '04

17 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19215 Modified Files: special-operators.lisp Log Message: Some more work on register scheduling. I'm starting to see how this should have been designed in the first place. Date: Tue Feb 17 15:24:06 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.13 movitz/special-operators.lisp:1.14 --- movitz/special-operators.lisp:1.13 Sat Feb 14 18:46:56 2004 +++ movitz/special-operators.lisp Tue Feb 17 15:24:06 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.13 2004/02/14 23:46:56 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.14 2004/02/17 20:24:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -568,6 +568,7 @@ (check-type binding lexical-binding) (list binding))))) (let ((code (assembly-macroexpand inline-asm amenv))) + #+ignore (assert (not (and (not side-effects) (tree-search code '(:store-lexical)))) ()

1 0

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

17 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6051 Modified Files: environment.lisp Log Message: Some more work on register scheduling. I'm starting to see how this should have been designed in the first place. Date: Tue Feb 17 15:24:00 2004 Author: ffjeld Index: movitz/environment.lisp diff -u movitz/environment.lisp:1.4 movitz/environment.lisp:1.5 --- movitz/environment.lisp:1.4 Mon Feb 9 19:24:38 2004 +++ movitz/environment.lisp Tue Feb 17 15:24:00 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 3 11:40:15 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: environment.lisp,v 1.4 2004/02/10 00:24:38 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.5 2004/02/17 20:24:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -285,6 +285,7 @@ (image-global-environment *image*)) (defun movitz-env-add-binding (env binding &optional (variable (binding-name binding))) + "Returns the binding." (check-type binding binding) (check-type variable symbol "a variable name") (let ((env (or env *movitz-global-environment*)))

1 0