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

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

23 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7262 Modified Files: inspect.lisp Log Message: Changed the dynamic-env a bit, reflect this in with-each-dynamic-context. Date: Tue Nov 23 17:03:35 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.43 movitz/losp/muerte/inspect.lisp:1.44 --- movitz/losp/muerte/inspect.lisp:1.43 Mon Oct 11 15:52:44 2004 +++ movitz/losp/muerte/inspect.lisp Tue Nov 23 17:03:35 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.43 2004/10/11 13:52:44 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.44 2004/11/23 16:03:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -103,6 +103,7 @@ "Only use this if you know what you're doing. See run-time.lisp." (let ((context (gensym "dynamic-context-")) (tag (gensym "dynamic-tag-")) + (name (gensym "dynamic-name-")) (bind-clause (find :binding clauses :key #'caar)) (catch-clause (find :catch clauses :key #'caar)) (up-clause (find :unwind-protect clauses :key #'caar)) @@ -110,10 +111,12 @@ `(do ((,context ,(if start-context start-context '(current-dynamic-context)) (dynamic-context-uplink ,context))) ((not (plusp ,context)) ,result) - (let ((,tag (dynamic-context-tag ,context))) + (let ((,tag (dynamic-context-tag ,context)) + (,name (stack-frame-ref nil ,context 0 :lisp))) + (declare (ignorable ,name)) (cond ,@(when bind-clause - `(((eq ,tag (load-global-constant unbound-value)) + `(((symbolp ,name) (multiple-value-bind ,(cdar bind-clause) (values ,context (stack-frame-ref nil ,context 0 :lisp)

1 0

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

23 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7235 Modified Files: basic-macros.lisp Log Message: *** empty log message *** Date: Tue Nov 23 17:02:34 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.49 movitz/losp/muerte/basic-macros.lisp:1.50 --- movitz/losp/muerte/basic-macros.lisp:1.49 Sat Nov 20 00:07:49 2004 +++ movitz/losp/muerte/basic-macros.lisp Tue Nov 23 17:02: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.49 2004/11/19 23:07:49 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.50 2004/11/23 16:02:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1042,12 +1042,12 @@ (define-compiler-macro boundp (symbol) `(with-inline-assembly-case () (do-case (t :boolean-zf=0 :labels (boundp-done)) - (:compile-form (:result-mode :eax) ,symbol) - (:leal (:eax ,(- (movitz:tag :symbol))) :ecx) + (:compile-form (:result-mode :ebx) ,symbol) + (:leal (:ebx ,(- (movitz:tag :symbol))) :ecx) (:testb 7 :cl) (:jne '(:sub-program () (:int 66))) (:call-local-pf dynamic-variable-lookup) - (:globally (:cmpl (:edi (:edi-offset unbound-value)) :eax))))) + (:globally (:cmpl (:edi (:edi-offset new-unbound-value)) :eax))))) (defmacro define-global-variable (name init-form &optional docstring) "A global variable will be accessed by ignoring local bindings."

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arithmetic-macros.lisp
by Frode Vatvedt Fjeld 23 Nov '04

23 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6603 Modified Files: arithmetic-macros.lisp Log Message: *** empty log message *** Date: Tue Nov 23 17:00:21 2004 Author: ffjeld Index: movitz/losp/muerte/arithmetic-macros.lisp diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.8 movitz/losp/muerte/arithmetic-macros.lisp:1.9 --- movitz/losp/muerte/arithmetic-macros.lisp:1.8 Mon Oct 11 15:52:04 2004 +++ movitz/losp/muerte/arithmetic-macros.lisp Tue Nov 23 17:00:20 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 13:42:46 2004 ;;;; -;;;; $Id: arithmetic-macros.lisp,v 1.8 2004/10/11 13:52:04 ffjeld Exp $ +;;;; $Id: arithmetic-macros.lisp,v 1.9 2004/11/23 16:00:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -95,18 +95,21 @@ (movitz:movitz-constantp max env)) (let ((min (movitz:movitz-eval min env)) (max (movitz:movitz-eval max env))) - (check-type min fixnum) - (check-type max fixnum) (cond ((movitz:movitz-constantp x env) (<= min (movitz:movitz-eval x env) max)) ((< max min) - nil) + `(progn ,x nil)) ((= max min) `(= ,x ,min)) ((minusp min) `(let ((x ,x)) (and (<= ,min x) (<= x ,max)))) + ((or (not (typep min 'fixnum)) + (not (typep max 'fixnum))) + `(let ((x ,x)) + (and (<=%2op ,min x) + (<=%2op x ,max)))) ((= 0 min) `(with-inline-assembly (:returns :boolean-cf=1) (:compile-form (:result-mode :eax) ,x)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/pci.lisp
by Frode Vatvedt Fjeld 23 Nov '04

23 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31374 Modified Files: pci.lisp Log Message: Some basic functions for interfacing the PCI bios32. Date: Tue Nov 23 14:45:53 2004 Author: ffjeld Index: movitz/losp/x86-pc/pci.lisp diff -u movitz/losp/x86-pc/pci.lisp:1.4 movitz/losp/x86-pc/pci.lisp:1.5 --- movitz/losp/x86-pc/pci.lisp:1.4 Sun Nov 14 23:58:02 2004 +++ movitz/losp/x86-pc/pci.lisp Tue Nov 23 14:45:51 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Dec 14 22:33:42 2003 ;;;; -;;;; $Id: pci.lisp,v 1.4 2004/11/14 22:58:02 ffjeld Exp $ +;;;; $Id: pci.lisp,v 1.5 2004/11/23 13:45:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,13 +18,65 @@ (provide :x86-pc/pci) -(defun find-bios32 () +(defun find-bios32-base () (loop for bios32 from #xe0000 to #xffff0 by 16 if (and (= (memref-int bios32) #x5f32335f) (loop with checksum = 0 - ;; initially (warn "PCI magic found at #x~X" bios32) as i from 0 below (* 16 (memref-int bios32 :offset 9 :type :unsigned-byte8)) do (incf checksum (memref-int bios32 :offset i :type :unsigned-byte8)) finally (return (= 0 (ldb (byte 8 0 ) checksum))))) return bios32)) + +(defvar *bios32-base* nil) + +(defun init-pci () + (setf *bios32-base* + (find-bios32-base)) + (if (not *bios32-base*) + (error "No PCI BIOS32 found.") + (let ((entry (memref-int *bios32-base* :offset 4)) + (revision (memref-int *bios32-base* :offset 8 :type :unsigned-byte8)) + (length (memref-int *bios32-base* :offset 9 :type :unsigned-byte8))) + (values entry revision length)))) + +(defun pci-far-call (address &key (eax 0) (ebx 0) (cs 8)) + "Make a 'far call' to cs:address with the provided values for eax and ebx. +Returns the values of registers AL, EBX, ECX, and EDX. (Well, for now only the +lower 30 bits are actually returned.) The stack discipline is broken during +this call, so we disable interrupts in a somewhat feeble attempt to avoid trouble." + (without-interrupts + (with-inline-assembly (:returns :multiple-values) + (:load-lexical (:lexical-binding cs) :untagged-fixnum-ecx) + (:pushl :ecx) ; Code segment + (:load-lexical (:lexical-binding address) :untagged-fixnum-ecx) + (:pushl :ecx) ; Code address + (:load-lexical (:lexical-binding ebx) :untagged-fixnum-ecx) + (:pushl :ecx) ; EBX + (:load-lexical (:lexical-binding eax) :untagged-fixnum-ecx) + (:movl :ecx :eax) + (:popl :ebx) + (:call-segment (:esp)) + (:leal (:esp 8) :esp) + (:andl #xff :eax) + (:shll 2 :eax) + (:shll 2 :ebx) + (:shll 2 :ecx) + (:shll 2 :edx) + (:locally (:movl :ecx (:edi (:edi-offset values) 0))) + (:locally (:movl :edx (:edi (:edi-offset values) 4))) + (:movl 4 :ecx) + (:stc)))) + +(defun pci-directory (eax &optional (ebx 0)) + "Calling with '$PCI' should find the PCI directory." + (unless *bios32-base* + (init-pci)) + (let ((eax (etypecase eax + ((unsigned-byte 32) + eax) + (string + (loop for c across eax as i upfrom 0 by 8 + summing (ash (char-code c) i)))))) + (pci-far-call (memref-int *bios32-base* :offset 4) + :eax eax :ebx ebx)))

1 0

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

21 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv20233 Modified Files: compiler.lisp Log Message: Changed the way the unbound value is checked for at dynamic lookup: If the unbound-value is #x7fffffff, we can make and unbound variable trigger an exception like this: (:cmpl -1 :eax) (:into). Date: Sun Nov 21 13:30:36 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.114 movitz/compiler.lisp:1.115 --- movitz/compiler.lisp:1.114 Sat Nov 20 18:43:13 2004 +++ movitz/compiler.lisp Sun Nov 21 13:30:35 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.114 2004/11/20 17:43:13 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.115 2004/11/21 12:30:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -65,6 +65,9 @@ the system ensures one way or another that there can be no pointers below this size.") +(defvar *compiler-use-into-unbound-protocol* t + "Use #x7fffffff as the <unbound-value> and thereby the INTO +instruction for checking whether a value is the unbound value.") (defvar *compiler-compile-eval-whens* t "When encountering (eval-when (:compile-toplevel) <code>), @@ -5614,24 +5617,42 @@ :functional-p t :modifies nil :final-form form - :code `((:load-constant ,form :eax) - (,*compiler-local-segment-prefix* - :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) - (,*compiler-local-segment-prefix* - :cmpl :eax (:edi ,(global-constant-offset 'unbound-value))) - (:je '(:sub-program () (:int 99)))))) + :code (if *compiler-use-into-unbound-protocol* + `((:load-constant ,form :ebx) + (,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) + (:cmpl -1 :eax) + (:into)) + (let ((not-unbound (gensym "not-unbound-"))) + `((:load-constant ,form :ebx) + (,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) + (,*compiler-local-segment-prefix* + :cmpl :eax (:edi ,(global-constant-offset 'unbound-value))) + (:jne ',not-unbound) + (:int 99) + ,not-unbound))))) (t (check-type binding dynamic-binding) (compiler-values () :returns :eax :functional-p t :modifies nil :final-form form - :code `((:load-constant ,form :eax) - (,*compiler-local-segment-prefix* - :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) - (,*compiler-local-segment-prefix* - :cmpl :eax (:edi ,(global-constant-offset 'unbound-value))) - (:je '(:sub-program () (:int 99)))))))))) + :code (if *compiler-use-into-unbound-protocol* + `((:load-constant ,form :ebx) + (,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) + (:cmpl -1 :eax) + (:into)) + (let ((not-unbound (gensym "not-unbound-"))) + `((:load-constant ,form :ebx) + (,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) + (,*compiler-local-segment-prefix* + :cmpl :eax (:edi ,(global-constant-offset 'unbound-value))) + (:jne ',not-unbound) + (:int 99) + ,not-unbound))))))))) (define-compiler compile-lambda-form (&form form) "3.1.2.2.4 Lambda Forms"

1 0

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

21 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13043 Modified Files: integers.lisp Log Message: Minor tweaking of isqrt. Date: Sun Nov 21 01:10:11 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.100 movitz/losp/muerte/integers.lisp:1.101 --- movitz/losp/muerte/integers.lisp:1.100 Tue Oct 12 16:43:55 2004 +++ movitz/losp/muerte/integers.lisp Sun Nov 21 01:10:11 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.100 2004/10/12 14:43:55 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.101 2004/11/21 00:10:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2192,18 +2192,18 @@ (defun isqrt (natural) "=> natural-root" - (etypecase natural - ((eql 0) 0) - ((integer 1 *) - (let ((r 1)) - (do ((next-r (truncate (+ r (truncate natural r)) 2) - (truncate (+ r (truncate natural r)) 2))) - ((typep (- next-r r) '(integer 0 1)) - (let ((r+1 (1+ r))) - (if (<= (* r+1 r+1) natural) - r+1 - r))) - (setf r next-r)))))) + (check-type natural (integer 0 *)) + (if (= 0 natural) + 0 + (let ((r 1)) + (do ((next-r (truncate (+ r (truncate natural r)) 2) + (truncate (+ r (truncate natural r)) 2))) + ((typep (- next-r r) '(integer 0 1)) + (let ((r+1 (1+ r))) + (if (<= (* r+1 r+1) natural) + r+1 + r))) + (setf r next-r))))) (defun expt (base-number power-number) "Take base-number to the power-number."

1 0

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

20 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv22974 Modified Files: compiler.lisp Log Message: Fixed some lisp-val to untagged-fixnum-ecx conversions. Date: Sat Nov 20 18:43:19 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.113 movitz/compiler.lisp:1.114 --- movitz/compiler.lisp:1.113 Sat Nov 20 02:29:52 2004 +++ movitz/compiler.lisp Sat Nov 20 18:43:13 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.113 2004/11/20 01:29:52 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.114 2004/11/20 17:43:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3377,8 +3377,8 @@ ((:ebx :ecx :edx :esi) `((:movl :eax ,result-mode))) ((:eax :single-value) nil) (:untagged-fixnum-ecx - `((:movl :eax :ecx) - (:sarl ,movitz:+movitz-fixnum-shift+ :ecx))))) + `((,*compiler-global-segment-prefix* + :call (:edi ,(global-constant-offset 'unbox-u32))))))) ((:ebx :ecx :edx) (assert (not indirect-p)) (unless (eq result-mode lexb-location) @@ -4836,27 +4836,14 @@ (values (append code `((:load-lexical ,returns-provided ,desired-result))) desired-result)))) - #+ignore - (:untagged-fixnum-eax - (case returns-provided - (:untagged-fixnum-eax - (values code :untagged-fixnum-eax)) - ((:eax :single-value :multiple-values :function) - (values (append code - `((:testb ,+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program (not-an-integer) (:int 107))) ; - (:sarl ,+movitz-fixnum-shift+ :eax))) - :untagged-fixnum-eax)))) (:untagged-fixnum-ecx (case returns-provided (:untagged-fixnum-ecx (values code :untagged-fixnum-ecx)) ((:eax :single-value :multiple-values :function) (values (append code - `((:testb ,+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program (not-an-integer) (:int 107))) ; - (:movl :eax :ecx) - (:sarl ,+movitz-fixnum-shift+ :ecx))) + `((,*compiler-global-segment-prefix* + :call (:edi ,(global-constant-offset 'unbox-u32))))) :untagged-fixnum-ecx)) (:ecx (values (append code

1 0

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

20 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22773 Modified Files: more-macros.lisp Log Message: Added member compiler-macro. Date: Sat Nov 20 18:36:07 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.20 movitz/losp/muerte/more-macros.lisp:1.21 --- movitz/losp/muerte/more-macros.lisp:1.20 Wed Sep 22 19:48:00 2004 +++ movitz/losp/muerte/more-macros.lisp Sat Nov 20 18:36:07 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.20 2004/09/22 17:48:00 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.21 2004/11/20 17:36:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -134,6 +134,32 @@ ((null ,cons-var) ,result-form) (let ((,var (pop ,cons-var))) ,@declarations-and-body)))) + +(define-compiler-macro member (&whole form item list &key (key ''identity) (test ''eql) + &environment env) + (let* ((test (or (and (movitz:movitz-constantp test env) + (translate-program (movitz:movitz-eval test env) :muerte.cl :cl)) + (and (consp test) (eq 'function (car test)) + (cadr test)))) + (key (or (and (movitz:movitz-constantp key env) + (translate-program (movitz:movitz-eval key env) :muerte.cl :cl)) + (and (consp key) (eq 'function (car key)) + (cadr key))))) + (cond + ((and test (symbolp test) (eq key 'identity)) + `(do ((item ,item) + (p ,list (cdr p))) + ((endp p) nil) + (when (,test (car p) item) + (return p)))) + ((and test (symbolp test) + key (symbolp key)) + `(do ((item ,item) + (p ,list (cdr p))) + ((endp p) nil) + (when (,test (car p) (,key item)) + (return p)))) + (t form)))) (defmacro letf* (bindings &body body &environment env) "Does what one might expect, saving the old values and setting the generalized

1 0

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

20 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2421 Modified Files: compiler.lisp Log Message: Tweaked eql some more. Date: Sat Nov 20 02:29:54 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.112 movitz/compiler.lisp:1.113 --- movitz/compiler.lisp:1.112 Sat Nov 20 00:56:14 2004 +++ movitz/compiler.lisp Sat Nov 20 02:29:52 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.112 2004/11/19 23:56:14 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.113 2004/11/20 01:29:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2575,8 +2575,11 @@ (defun instruction-uncontinues-p (instruction) "Is it impossible for control to return after instruction?" - (member (instruction-is instruction) - '(:jmp :ret))) + (or (member (instruction-is instruction) + '(:jmp :ret)) + (member instruction + '((:int 100)) + :test #'equalp))) (defun sub-environment-p (env1 env2) (cond @@ -6589,7 +6592,7 @@ (rotatef x y) (rotatef x-type y-type) (rotatef x-singleton y-singleton)) - (let (;;(x-loc (new-binding-location (binding-target x) frame-map :default nil)) + (let (;; (x-loc (new-binding-location (binding-target x) frame-map :default nil)) (y-loc (new-binding-location (binding-target y) frame-map :default nil))) #+ignore (warn "eql ~S/~S ~S/~S" @@ -6617,7 +6620,6 @@ (case (operator return-mode) (:boolean-branch-on-false (when (not eql) - (warn "constant eql ~S to ~S" instruction (operands return-mode)) `((:jmp ',(operands return-mode))))) (t (break "Constant EQL: ~S ~S" (car x-singleton) (car y-singleton)))))) ((and x-singleton @@ -6652,15 +6654,22 @@ (movitz-immediate-value (car x-singleton)) y-loc))) (make-branch)))) + ((and x-singleton + (typep (car x-singleton) 'movitz-symbol) + (member y-loc '(:eax :ebx :edx))) + (append (make-load-constant (car x-singleton) y-loc funobj frame-map :op :cmpl) + (make-branch))) (y-singleton (break "y-singleton")) - ((or (movitz-subtypep x-type 'fixnum) - (movitz-subtypep x-type 'character) - (movitz-subtypep y-type 'fixnum) - (movitz-subtypep y-type 'character)) + ((or (movitz-subtypep x-type '(or fixnum character symbol vector)) + (movitz-subtypep y-type '(or fixnum character symbol vector))) (append (make-load-eax-ebx) `((:cmpl :eax :ebx)) (make-branch))) + #+ignore + ((warn "eql ~S/~S ~S/~S" + x x-loc + y y-loc)) ((eq :boolean-branch-on-false (operator return-mode)) (let ((eql-done (gensym "eql-done-")) (on-false-label (operands return-mode)))

1 0

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

19 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv29209 Modified Files: compiler.lisp Log Message: Fixed bug in :cons-get expander. Date: Sat Nov 20 00:56:15 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.111 movitz/compiler.lisp:1.112 --- movitz/compiler.lisp:1.111 Sat Nov 20 00:06:58 2004 +++ movitz/compiler.lisp Sat Nov 20 00:56:14 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.111 2004/11/19 23:06:58 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.112 2004/11/19 23:56:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -6234,13 +6234,13 @@ (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) + #+ignore (warn "car of loc ~A bind ~A" + location binding) (cond ((and binding-is-list-p (member location '(:eax :ebx :ecx :edx))) - `(,*compiler-nonlocal-lispval-read-segment-prefix* - (:movl (,location ,op-offset) ,dst))) + `((,*compiler-nonlocal-lispval-read-segment-prefix* + :movl (,location ,op-offset) ,dst))) (binding-is-list-p `(,@(make-load-lexical binding dst funobj nil frame-map) (,*compiler-nonlocal-lispval-read-segment-prefix*

1 0