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

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14368 Modified Files: los-closette.lisp Log Message: Changed the init-form for *standard-effective-slot-readers* from (vector ..) to #(..), so that it's more easily recognized as a constant form. Date: Wed Apr 14 18:01:30 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.6 movitz/losp/muerte/los-closette.lisp:1.7 --- movitz/losp/muerte/los-closette.lisp:1.6 Mon Mar 22 11:38:10 2004 +++ movitz/losp/muerte/los-closette.lisp Wed Apr 14 18:01:30 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.6 2004/03/22 16:38:10 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.7 2004/04/14 22:01:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -912,14 +912,14 @@ done))) (defparameter *standard-effective-slot-readers* - (vector 'standard-effective-slot-reader%0 - 'standard-effective-slot-reader%1 - 'standard-effective-slot-reader%2 - 'standard-effective-slot-reader%3 - 'standard-effective-slot-reader%4 - 'standard-effective-slot-reader%5 - 'standard-effective-slot-reader%6 - 'standard-effective-slot-reader%7) + #(standard-effective-slot-reader%0 + standard-effective-slot-reader%1 + standard-effective-slot-reader%2 + standard-effective-slot-reader%3 + standard-effective-slot-reader%4 + standard-effective-slot-reader%5 + standard-effective-slot-reader%6 + standard-effective-slot-reader%7) "The element at position i is a standard-reader for a slot at position i.")

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv8206 Modified Files: basic-macros.lisp Log Message: Changed the mechanism of define-compile-time-variable. This means that a lot fewer files needs to be executed at boot-time. Date: Wed Apr 14 17:59:35 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.9 movitz/losp/muerte/basic-macros.lisp:1.10 --- movitz/losp/muerte/basic-macros.lisp:1.9 Wed Apr 14 16:03:33 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Apr 14 17:59:34 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.9 2004/04/14 20:03:33 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.10 2004/04/14 21:59:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -135,12 +135,12 @@ `(defparameter ,name ,value ,documentation))) (defmacro define-compile-time-variable (name value) - `(progn - (eval-when (:compile-toplevel) - (defparameter ,name ,value) - ;; (setf (symbol-value ',name) ,value) - (pushnew ',name (movitz::image-compile-time-variables movitz::*image*))) - (defparameter ,name (get-global-property ',name)))) + (let ((the-value (eval value))) + `(progn + (eval-when (:compile-toplevel) + (defparameter ,name ',the-value) + (pushnew ',name (movitz::image-compile-time-variables movitz::*image*))) + (defparameter ,name ',the-value)))) (defmacro let* (var-list &body body) (labels ((expand (rest-vars body)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv1920 Modified Files: eval.lisp Log Message: Re-wrote movitz-constantp more reasonably. Date: Wed Apr 14 17:56:08 2004 Author: ffjeld Index: movitz/eval.lisp diff -u movitz/eval.lisp:1.5 movitz/eval.lisp:1.6 --- movitz/eval.lisp:1.5 Tue Apr 13 12:30:36 2004 +++ movitz/eval.lisp Wed Apr 14 17:56:08 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 2 17:45:05 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: eval.lisp,v 1.5 2004/04/13 16:30:36 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.6 2004/04/14 21:56:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -59,11 +59,7 @@ (defun movitz-constantp (form &optional (environment nil)) (let ((form (translate-program form :cl :muerte.cl))) (typecase form - (boolean t) - (number t) (keyword t) - (character t) - (string t) (symbol (or (movitz-env-get form 'constantp nil environment) (typep (movitz-binding form environment) 'constant-object-binding))) (cons (case (car form) @@ -73,7 +69,8 @@ ((muerte.cl:+ muerte.cl:- muerte.cl:*) (every (lambda (sub-form) (movitz-constantp sub-form environment)) - (cdr form)))))))) + (cdr form))))) + (t t)))) ; anything else is self-evaluating. (defun isconst (x)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23201 Modified Files: primitive-functions.lisp Log Message: In both dynamic-load and dynamic-store I commented out a safety-check that is really superfluous (assuming the dynamic-env linked list is consistent). This should speed up dynamic variable access a bit. Date: Wed Apr 14 16:10:58 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.10 movitz/losp/muerte/primitive-functions.lisp:1.11 --- movitz/losp/muerte/primitive-functions.lisp:1.10 Wed Apr 14 13:54:51 2004 +++ movitz/losp/muerte/primitive-functions.lisp Wed Apr 14 16:10:58 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.10 2004/04/14 17:54:51 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.11 2004/04/14 20:10:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -246,10 +246,10 @@ (:jecxz 'no-stack-binding) (:cmpl :eax (:ecx)) (:je 'success) - (:locally (:movl (:edi (:edi-offset stack-top)) :edx)) +;;; (:locally (:movl (:edi (:edi-offset stack-top)) :edx)) search-loop - (:cmpl :edx (:ecx 12)) - (:jnc '(:sub-program () (:int 97))) +;;; (:cmpl :edx (:ecx 12)) +;;; (:jnc '(:sub-program () (:int 97))) (:movl (:ecx 12) :ecx) ; parent (:jecxz 'no-stack-binding) (:cmpl :eax (:ecx)) ; compare name @@ -276,10 +276,10 @@ (:jecxz 'no-binding) (:cmpl :eax (:ecx)) (:je 'success) - (:locally (:movl (:edi (:edi-offset stack-top)) :edx)) +;;; (:locally (:movl (:edi (:edi-offset stack-top)) :edx)) search-loop - (:cmpl :edx (:ecx 12)) - (:jnc '(:sub-program () (:int 97))) +;;; (:cmpl :edx (:ecx 12)) +;;; (:jnc '(:sub-program () (:int 97))) (:movl (:ecx 12) :ecx) ; parent (:jecxz 'no-binding) (:cmpl :eax (:ecx)) ; compare name

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9893 Modified Files: memref.lisp Log Message: Fixed the most general case for memref type :unsigned-byte32. Date: Wed Apr 14 16:05:27 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.12 movitz/losp/muerte/memref.lisp:1.13 --- movitz/losp/muerte/memref.lisp:1.12 Wed Apr 14 08:31:08 2004 +++ movitz/losp/muerte/memref.lisp Wed Apr 14 16:05:26 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.12 2004/04/14 12:31:08 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.13 2004/04/14 20:05:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -177,9 +177,7 @@ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) (:addl :ebx :ecx) - (:movl (:eax :ecx ,(offset-by 4)) :ecx) - (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx) - (:jg '(:sub-program () (:int 4))))))))) + (:movl (:eax :ecx ,(offset-by 4)) :ecx))))))) (:lisp (cond ((and (eql 0 index) (eql 0 offset)) @@ -335,17 +333,24 @@ (:load-lexical (:lexical-binding ,value-var) :ecx) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) (:movl :ecx (:eax :ebx ,(movitz:movitz-eval offset env))))))) - (t (warn "Compiling unsafely: ~A" form) - `(with-inline-assembly (:returns :untagged-fixnum-eax) - (:compile-form (:result-mode :push) ,object) - (:compile-form (:result-mode :push) ,offset) - (:compile-two-forms (:ebx :eax) ,index ,value) - (:popl :ecx) ; offset - (:shrl ,movitz::+movitz-fixnum-shift+ :eax) - (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) - (:addl :ebx :ecx) ; index += offset - (:popl :ebx) ; object - (:movl :eax (:ebx :ecx)))))) + (t (let ((value-var (gensym "memref-value-")) + (object-var (gensym "memref-object-")) + (offset-var (gensym "memref-offset-")) + (index-var (gensym "memref-index-"))) + (assert (= 4 movitz:+movitz-fixnum-factor+)) + `(let ((,value-var ,value) + (,object-var ,object) + (,offset-var ,offset) + (,index-var ,index)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:edx :untagged-fixnum-ecx) ,index-var ,offset-var) + (:addl :edx :ecx) ; offset+index in ECX + (:compile-two-forms (:eax :ebx) ,value-var ,object-var) + (:std) + (:shrl ,movitz::+movitz-fixnum-shift+ :eax) + (:movl :eax (:ebx :ecx)) + (:shll ,movitz:+movitz-fixnum-shift+ :eax) + (:cld))))))) (:unsigned-byte16 (cond ((and (movitz:movitz-constantp value env)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3183 Modified Files: symbols.lisp Log Message: Boundp was completely bogus (!). Also added a compiler-macro for boundp. Date: Wed Apr 14 16:03:38 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.7 movitz/losp/muerte/symbols.lisp:1.8 --- movitz/losp/muerte/symbols.lisp:1.7 Tue Apr 6 10:30:48 2004 +++ movitz/losp/muerte/symbols.lisp Wed Apr 14 16:03:38 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.7 2004/04/06 14:30:48 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.8 2004/04/14 20:03:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -121,10 +121,7 @@ (movitz-accessor symbol movitz-symbol package)))) (defun boundp (symbol) - (etypecase symbol - (null nil) - (symbol - (not (eq (movitz-accessor symbol movitz-symbol value) 'unbound))))) + (boundp symbol)) (defun makunbound (symbol) (setf (symbol-value symbol)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3077 Modified Files: basic-macros.lisp Log Message: Boundp was completely bogus (!). Also added a compiler-macro for boundp. Date: Wed Apr 14 16:03:33 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.8 movitz/losp/muerte/basic-macros.lisp:1.9 --- movitz/losp/muerte/basic-macros.lisp:1.8 Wed Apr 14 08:21:53 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Apr 14 16:03:33 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.8 2004/04/14 12:21:53 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.9 2004/04/14 20:03:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1026,6 +1026,20 @@ (:compile-form (:result-mode :eax) ,word-form) (:shrl ,(* 4 nibble) :eax) (:andl #xf :eax))) + +(define-compiler-macro boundp (symbol) + `(with-inline-assembly-case () + (do-case (t :boolean-cf=1 :labels (boundp-done)) + (:compile-form (:result-mode :eax) ,symbol) + (:cmpl :edi :eax) + (:je 'boundp-done) ; if ZF=0, then CF=0 + (:call-global-constant dynamic-find-binding) + (:jc 'boundp-done) + (:movl (:eax #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::value)) :eax) + (:globally (:cmpl (:edi (:edi-offset unbound-value)) :eax)) + (:je 'boundp-done) + (:stc) + boundp-done))) (require :muerte/setf)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14694 Modified Files: compiler.lisp Log Message: Fixed some widespread confusion in the compiler about lexical function bindings that don't borrow any lexical bindings. This caused e.g. apropos not to work. Date: Wed Apr 14 15:04:06 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.45 movitz/compiler.lisp:1.46 --- movitz/compiler.lisp:1.45 Wed Apr 14 10:38:14 2004 +++ movitz/compiler.lisp Wed Apr 14 15:04:05 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.45 2004/04/14 14:38:14 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.46 2004/04/14 19:04:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2477,18 +2477,23 @@ (tree-search i r)) free-so-far))) ((:load-constant :load-lexical :store-lexical :init-lexvar - :cons-get :endp :incf-lexvar - :local-function-init) + :cons-get :endp :incf-lexvar) + (assert (gethash (instruction-is i) *extended-code-expanders*)) (unless (can-expand-extended-p i frame-map) (return (values nil t))) (let ((exp (expand-extended-code i funobj frame-map))) - (when (tree-search exp '(:call)) + (when (tree-search exp '(:call :local-function-init)) (return nil)) (setf free-so-far (remove-if (lambda (r) (or (tree-search exp r) (tree-search exp (register32-to-low8 r)))) free-so-far)))) + ((:local-function-init) + (destructuring-bind (binding) + (cdr i) + (unless (typep binding 'funobj-binding) + (return nil)))) (t (warn "Dist ~D stopped by ~A" distance i) (return nil))))) @@ -2651,6 +2656,7 @@ ((typep binding 'constant-object-binding)) ((typep binding 'forwarding-binding)) ((typep binding 'borrowed-binding)) + ((typep binding 'funobj-binding)) ((and (typep binding 'fixed-required-function-argument) (plusp (or (car (gethash binding var-counts)) 0))) (prog1 nil ; may need lending-cons @@ -3109,6 +3115,9 @@ (make-load-constant (constant-object binding) result-mode funobj frame-map)) + (funobj-binding + (make-load-constant (function-binding-funobj binding) + result-mode funobj frame-map)) (borrowed-binding (let ((slot (borrowed-binding-reference-slot binding))) (cond @@ -3375,8 +3384,10 @@ (lend-code (loop for bb in (borrowed-bindings sub-funobj) append (make-lend-lexical bb :edx nil)))) (cond + ((typep function-binding 'funobj-binding) + nil) ((null lend-code) - ;; (warn "null lending") + (warn "null lending") (append (make-load-constant sub-funobj :eax funobj frame-map) (make-store-lexical function-binding :eax nil frame-map))) (t (append (make-load-constant sub-funobj :eax funobj frame-map)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31456 Modified Files: primitive-functions.lisp Log Message: Inlined dynamic-find-binding into dynamic-load and dynamic-store. I expect the stack discipline to state that a primitive-function can't call another primitive-function (in general). Date: Wed Apr 14 13:54:51 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.9 movitz/losp/muerte/primitive-functions.lisp:1.10 --- movitz/losp/muerte/primitive-functions.lisp:1.9 Tue Apr 13 09:28:31 2004 +++ movitz/losp/muerte/primitive-functions.lisp Wed Apr 14 13:54:51 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.9 2004/04/13 13:28:31 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.10 2004/04/14 17:54:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -214,7 +214,8 @@ (define-primitive-function dynamic-find-binding (symbol) "Search the stack for a dynamic binding of SYMBOL. On success, return Carry=1, and the address of the - binding in EAX. On failure, return Carry=0 and EAX unmodified." + binding in EAX. On failure, return Carry=0 and EAX unmodified. + Preserves EBX." (with-inline-assembly (:returns :eax) (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) (:jecxz 'fail) @@ -241,16 +242,29 @@ (define-primitive-function dynamic-load (symbol) "Load the dynamic value of SYMBOL into EAX." (with-inline-assembly (:returns :multiple-values) - (:call-global-constant dynamic-find-binding) - (:movl :eax :edx) - (:jnc 'no-binding) - (:movl (:eax) :eax) + (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) + (:jecxz 'no-stack-binding) + (:cmpl :eax (:ecx)) + (:je 'success) + (:locally (:movl (:edi (:edi-offset stack-top)) :edx)) + search-loop + (:cmpl :edx (:ecx 12)) + (:jnc '(:sub-program () (:int 97))) + (:movl (:ecx 12) :ecx) ; parent + (:jecxz 'no-stack-binding) + (:cmpl :eax (:ecx)) ; compare name + (:jne 'search-loop) + ;; fall through on success + success + (:movl :eax :edx) ; Keep symbol in case it's unbound. + (:movl (:ecx 8) :eax) (:globally (:cmpl (:edi (:edi-offset unbound-value)) :eax)) (:je '(:sub-program (unbound) (:int 99))) (:ret) - no-binding - ;; take the global value of SYMBOL. - (:movl (:eax #.(bt:slot-offset 'movitz::movitz-symbol 'movitz::value)) :eax) + no-stack-binding + ;; take the global value of SYMBOL, compare it against unbond-value + (:movl :eax :edx) ; Keep symbol in case it's unbound. + (:movl (:eax #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::value)) :eax) (:globally (:cmpl (:edi (:edi-offset unbound-value)) :eax)) (:je '(:sub-program (unbound) (:int 99))) (:ret))) @@ -258,26 +272,25 @@ (define-primitive-function dynamic-store (symbol value) "Store VALUE (ebx) in the dynamic binding of SYMBOL (eax)." (with-inline-assembly (:returns :multiple-values) - (:pushl :ebx) ; Save VALUE for later. - (:call-global-constant dynamic-find-binding) - (:jnc 'no-binding) - (:popl :ebx) ; Load back VALUE from stack. + (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) + (:jecxz 'no-binding) + (:cmpl :eax (:ecx)) + (:je 'success) + (:locally (:movl (:edi (:edi-offset stack-top)) :edx)) + search-loop + (:cmpl :edx (:ecx 12)) + (:jnc '(:sub-program () (:int 97))) + (:movl (:ecx 12) :ecx) ; parent + (:jecxz 'no-binding) + (:cmpl :eax (:ecx)) ; compare name + (:jne 'search-loop) + ;; fall through on success + success + (:leal (:ecx 8) :eax) ; location of binding value cell (:movl :ebx (:eax)) ; Store VALUE in binding. (:ret) no-binding - (:popl :ebx) ; Load back VALUE from stack. (:movl :ebx (:eax #.(bt:slot-offset 'movitz::movitz-symbol 'movitz::value))) - (:ret))) - -(define-primitive-function dynamic-boundp (symbol) - "Return NIL iff SYMBOL is not dynamically bound." - (with-inline-assembly (:returns :multiple-values) - (:call-global-constant dynamic-find-binding) - (:jnc 'no-binding) - (:globally (:movl (:edi (:edi-offset t-symbol)) :eax)) - (:ret) - no-binding - (:movl :edi :eax) (:ret))) (define-primitive-function keyword-search ()

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv8769 Modified Files: io-port.lisp Log Message: Pass the &environment on to constantp and eval in the (setf io-port) compiler-macro. Date: Wed Apr 14 12:45:52 2004 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.10 movitz/losp/muerte/io-port.lisp:1.11 --- movitz/losp/muerte/io-port.lisp:1.10 Wed Apr 14 12:38:47 2004 +++ movitz/losp/muerte/io-port.lisp Wed Apr 14 12:45:52 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.10 2004/04/14 16:38:47 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.11 2004/04/14 16:45:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -66,14 +66,14 @@ (:character (io-port port :character)))) -(define-compiler-macro (setf io-port) (&whole form value port type) +(define-compiler-macro (setf io-port) (&whole form value port type &environment env) (let ((value-var (gensym "(setf io-port)-value-")) (port-var (gensym "(setf io-port)-port-"))) (cond - ((and (movitz:movitz-constantp type) - (movitz:movitz-constantp port)) - (let ((the-port (movitz:movitz-eval port)) - (the-type (movitz:movitz-eval type))) + ((and (movitz:movitz-constantp type env) + (movitz:movitz-constantp port env)) + (let ((the-port (movitz:movitz-eval port env)) + (the-type (movitz:movitz-eval type env))) (etypecase the-port ((unsigned-byte 8) ; short form of outb can be used (ecase the-type @@ -151,8 +151,8 @@ `((:movl :edi :edx))) (:compile-form (:result-mode :eax) ,value-var) (:cld)))))))))) - ((movitz:movitz-constantp type) - (ecase (movitz:movitz-eval type) + ((movitz:movitz-constantp type env) + (ecase (movitz:movitz-eval type env) (:unsigned-byte8 `(let ((,value-var ,value) (,port-var ,port))

1 0