movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

23 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7511 Modified Files: compiler.lisp Log Message: Minor tweaks. Date: Tue Nov 23 17:10:18 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.115 movitz/compiler.lisp:1.116 --- movitz/compiler.lisp:1.115 Sun Nov 21 13:30:35 2004 +++ movitz/compiler.lisp Tue Nov 23 17:10:17 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.115 2004/11/21 12:30:35 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.116 2004/11/23 16:10:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3484,6 +3484,10 @@ (ecase (operator binding-location) ((:eax :ebx :ecx :edx) `((:pushl ,binding-location))) + (:untagged-fixnum-ecx + `((,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'box-u32-ecx))) + (:pushl :eax))) (:argument-stack (assert (<= 2 (function-argument-argnum binding)) () ":load-lexical argnum can't be ~A." (function-argument-argnum binding)) @@ -6446,6 +6450,9 @@ (result-type (multiple-value-call #'encoded-integer-types-add (values-list (binding-store-type term0)) (values-list (binding-store-type term1))))) +;;; (warn "dest: ~S ~S" +;;; (apply #'encoded-type-decode (binding-store-type destination)) +;;; result-type) (when (binding-lended-p term0) (warn "Add for lend0: ~S" term0)) (when (binding-lended-p term1) @@ -6669,8 +6676,10 @@ (make-branch))) (y-singleton (break "y-singleton")) - ((or (movitz-subtypep x-type '(or fixnum character symbol vector)) - (movitz-subtypep y-type '(or fixnum character symbol vector))) + ((and (not (eq t x-type)) ; this is for bootstrapping purposes. + (not (eq t y-type)) ; .. + (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)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.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-serv7477 Modified Files: symbols.lisp Log Message: New dynamic variable protocol. Date: Tue Nov 23 17:09:34 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.25 movitz/losp/muerte/symbols.lisp:1.26 --- movitz/losp/muerte/symbols.lisp:1.25 Thu Nov 18 18:59:11 2004 +++ movitz/losp/muerte/symbols.lisp Tue Nov 23 17:09:34 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.25 2004/11/18 17:59:11 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.26 2004/11/23 16:09:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -44,16 +44,18 @@ (null nil) (symbol (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) symbol) + (:compile-form (:result-mode :ebx) symbol) (:call-local-pf dynamic-variable-lookup) - (:locally (:cmpl :eax (:edi (:edi-offset unbound-value)))) - (:je '(:sub-program (unbound) (:int 99))))))) + (:cmpl -1 :eax) + (:into))))) +;;; (:locally (:cmpl :eax (:edi (:edi-offset unbound-value)))) +;;; (:je '(:sub-program (unbound) (:int 99))))))) (defun %unbounded-symbol-value (symbol) "Return the symbol's value without checking if it's bound or not." (check-type symbol symbol) (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) symbol) + (:compile-form (:result-mode :ebx) symbol) (:call-local-pf dynamic-variable-lookup) done)) @@ -129,7 +131,7 @@ (defun makunbound (symbol) (setf (symbol-value symbol) - (load-global-constant unbound-value)) + (load-global-constant new-unbound-value)) symbol) (defun fboundp (symbol) @@ -138,7 +140,7 @@ (defun %create-symbol (name &optional (package nil) (plist nil) - (value (load-global-constant unbound-value)) + (value (load-global-constant new-unbound-value)) (function (load-global-constant movitz::unbound-function)) (flags 0)) (eval-when (:compile-toplevel)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.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-serv7451 Modified Files: scavenge.lisp Log Message: Recognize #x7ffffff as unbound-value. Date: Tue Nov 23 17:09:18 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.34 movitz/losp/muerte/scavenge.lisp:1.35 --- movitz/losp/muerte/scavenge.lisp:1.34 Fri Oct 22 09:57:25 2004 +++ movitz/losp/muerte/scavenge.lisp Tue Nov 23 17:09:17 2004 @@ -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.34 2004/10/22 07:57:25 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.35 2004/11/23 16:09:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -53,13 +53,14 @@ (when verbose (format *terminal-io* " [at ~S: ~S]" scan x)) (cond - ((or (and (= 0 x2) (= 2 x)) - (and (= #xffff x2) (= #xfffe x)))) ((let ((tag (ldb (byte 3 0) x))) (or (= tag #.(movitz:tag :null)) (= tag #.(movitz:tag :even-fixnum)) (= tag #.(movitz:tag :odd-fixnum)) (scavenge-typep x :character)))) + ((or (and (= 0 x2) (= 2 x)) + (and (= #xffff x2) (= #xfffe x)) + (and (= #x7fff x2) (= #xffff x)))) ((scavenge-typep x :illegal) (error "Illegal word ~S at ~S." x scan)) ((scavenge-typep x :bignum)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.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-serv7425 Modified Files: primitive-functions.lisp Log Message: New dynamic-variable protocol. Date: Tue Nov 23 17:08:58 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.54 movitz/losp/muerte/primitive-functions.lisp:1.55 --- movitz/losp/muerte/primitive-functions.lisp:1.54 Wed Nov 17 14:33:34 2004 +++ movitz/losp/muerte/primitive-functions.lisp Tue Nov 23 17:08: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.54 2004/11/17 13:33:34 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.55 2004/11/23 16:08:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -162,53 +162,53 @@ ;; Default binding strategy is naive deep binding, so this is a NOP. (:ret))) -(define-primitive-function dynamic-variable-lookup (symbol) - "Load the dynamic value of SYMBOL into EAX." - (with-inline-assembly (:returns :multiple-values) - (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) - (:jecxz 'no-stack-binding) - ;; Be defensive: Verify that ECX is within stack. - (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) - (:cmpl :eax (:ecx)) - (:je 'success) - search-loop - (:movl (:ecx 12) :ecx) ; parent - (:jecxz 'no-stack-binding) - ;; Be defensive: Verify that ECX is within stack. - (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) - (: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-stack-binding - ;; take the global value of SYMBOL, compare it against unbond-value - (:movl :eax :edx) ; Keep symbol in case it's unbound. - (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* - :movl (:eax (:offset movitz-symbol value)) :eax) - (:globally (:cmpl (:edi (:edi-offset unbound-value)) :eax)) - (:je '(:sub-program (unbound) (:int 99))) - (:ret))) +;;;(define-primitive-function dynamic-variable-lookup (symbol) +;;; "Load the dynamic value of SYMBOL into EAX." +;;; (with-inline-assembly (:returns :multiple-values) +;;; (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) +;;; (:jecxz 'no-stack-binding) +;;; ;; Be defensive: Verify that ECX is within stack. +;;; (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) +;;; (:cmpl :eax (:ecx)) +;;; (:je 'success) +;;; search-loop +;;; (:movl (:ecx 12) :ecx) ; parent +;;; (:jecxz 'no-stack-binding) +;;; ;; Be defensive: Verify that ECX is within stack. +;;; (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) +;;; (: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-stack-binding +;;; ;; take the global value of SYMBOL, compare it against unbond-value +;;; (:movl :eax :edx) ; Keep symbol in case it's unbound. +;;; (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* +;;; :movl (:eax (:offset movitz-symbol value)) :eax) +;;; (:globally (:cmpl (:edi (:edi-offset unbound-value)) :eax)) +;;; (:je '(:sub-program (unbound) (:int 99))) +;;; (:ret))) -(define-primitive-function dynamic-variable-lookup-unbound (symbol) - "Load the dynamic value of SYMBOL into EAX. If unbound, return unbound-value." +(define-primitive-function dynamic-variable-lookup (symbol) + "Load the dynamic value of SYMBOL/EBX into EAX. If unbound, return unbound-value." (with-inline-assembly (:returns :multiple-values) (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) (:jecxz 'no-stack-binding) ;; Be defensive: Verify that ECX is within stack. (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) - (:cmpl :eax (:ecx)) + (:cmpl :ebx (:ecx)) (:je 'success) search-loop (:movl (:ecx 12) :ecx) ; parent (:jecxz 'no-stack-binding) ;; Be defensive: Verify that ECX is within stack. (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) - (:cmpl :eax (:ecx)) ; compare name + (:cmpl :ebx (:ecx)) ; compare name (:jne 'search-loop) ;; fall through on success success @@ -217,7 +217,7 @@ no-stack-binding ;; take the global value of SYMBOL, compare it against unbond-value (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* - :movl (:eax (:offset movitz-symbol value)) :eax) + :movl (:ebx (:offset movitz-symbol value)) :eax) (:ret))) (define-primitive-function dynamic-variable-store (symbol value)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.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-serv7373 Modified Files: memref.lisp Log Message: Improved memref :unsigned-byte8 and :unsigned-byte16 a bit. Date: Tue Nov 23 17:07:37 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.38 movitz/losp/muerte/memref.lisp:1.39 --- movitz/losp/muerte/memref.lisp:1.38 Sun Nov 14 23:57:45 2004 +++ movitz/losp/muerte/memref.lisp Tue Nov 23 17:07:37 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.38 2004/11/14 22:57:45 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.39 2004/11/23 16:07:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -73,11 +73,22 @@ (case type (:unsigned-byte8 (cond - ((and (eq 0 offset) (eq 0 index)) + ((and (eql 0 offset) (eql 0 index)) `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8)) (:compile-form (:result-mode :eax) ,object) (:movzxb (:eax ,(offset-by 1)) :ecx))) - ((eq 0 offset) + ((eql 0 index) + (let ((object-var (gensym "memref-object-")) + (offset-var (gensym "memref-offset-"))) + `(let ((,object-var ,object) + (,offset-var ,offset)) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 16)) + (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object-var ,offset-var) + ;; (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) + (:movzxb (:eax :ecx ,(offset-by 1)) :ecx) + )))) + ((eql 0 offset) `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8)) (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,index) (:movzxb (:eax :ecx ,(offset-by 1)) :ecx))) @@ -97,18 +108,30 @@ (:little nil) (:big `((:xchgb :cl :ch)))))) (cond - ((and (eq 0 offset) (eq 0 index)) + ((and (eql 0 offset) (eql 0 index)) `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 16)) (:compile-form (:result-mode :eax) ,object) (:movzxw (:eax ,(offset-by 2)) :ecx) ,@endian-fix-ecx)) - ((eq 0 offset) + ((eql 0 index) + (let ((object-var (gensym "memref-object-")) + (offset-var (gensym "memref-offset-"))) + `(let ((,object-var ,object) + (,offset-var ,offset)) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 16)) + (:compile-two-forms (:eax :ecx) ,object-var ,offset-var) + (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) + (:movzxw (:eax :ecx ,(offset-by 2)) :ecx) + ,@endian-fix-ecx)))) + ((eql 0 offset) (let ((object-var (gensym "memref-object-")) (index-var (gensym "memref-index-"))) `(let ((,object-var ,object) (,index-var ,index)) - (with-inline-assembly (:returns :untagged-fixnum-ecx) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 16)) (:compile-two-forms (:eax :ecx) ,object-var ,index-var) (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx) (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.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-serv7344 Modified Files: los-closette.lisp Log Message: change to new-unbound-value. Date: Tue Nov 23 17:06:37 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.22 movitz/losp/muerte/los-closette.lisp:1.23 --- movitz/losp/muerte/los-closette.lisp:1.22 Thu Oct 21 22:34:06 2004 +++ movitz/losp/muerte/los-closette.lisp Tue Nov 23 17:06:37 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.22 2004/10/21 20:34:06 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.23 2004/11/23 16:06:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -134,7 +134,7 @@ (defun std-allocate-instance (class) (allocate-std-instance class (allocate-slot-storage (count-if 'instance-slot-p (class-slots class)) - (load-global-constant unbound-value)))) + (load-global-constant new-unbound-value)))) (defun allocate-slot-storage (size initial-value) (make-array size :initial-element initial-value)) @@ -881,9 +881,11 @@ (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* :movl (:eax (:offset movitz-basic-vector data ,(* location 4))) :eax) (#.movitz:*compiler-global-segment-prefix* - :cmpl :eax ,(movitz::make-indirect-reference :edi (movitz::global-constant-offset 'unbound-value))) + :cmpl :eax ,(movitz::make-indirect-reference :edi (movitz::global-constant-offset + 'new-unbound-value))) (:je '(:sub-program (unbound) - (:compile-form (:result-mode :multiple-values) (slot-unbound-trampoline instance ,location)) + (:compile-form (:result-mode :multiple-values) + (slot-unbound-trampoline instance ,location)) (:jmp 'done))) (:clc) done))) @@ -923,13 +925,13 @@ (symbol-function (svref *standard-effective-slot-readers* slot-location)) (lambda (instance) (let ((x (standard-instance-access instance slot-location))) - (if (not (eq x (load-global-constant unbound-value))) + (if (not (eq x (load-global-constant new-unbound-value))) x (slot-unbound-trampoline instance slot-location)))))) (funcallable-standard-class (lambda (instance) (let ((x (svref (std-gf-instance-slots instance) slot-location))) - (if (not (eq x (load-global-constant unbound-value))) + (if (not (eq x (load-global-constant new-unbound-value))) x (slot-unbound-trampoline instance slot-location))))))))) @@ -1288,7 +1290,7 @@ (let* ((location (slot-definition-location (find-slot (std-instance-class instance) slot-name))) (slots (std-instance-slots instance)) (val (svref slots location))) - (if (eq (load-global-constant unbound-value) val) + (if (eq (load-global-constant new-unbound-value) val) (error "The slot ~S is unbound in the object ~S." slot-name instance) val))) @@ -1299,7 +1301,7 @@ (let* ((location (slot-definition-location slot)) (slots (std-gf-instance-slots instance)) (val (svref slots location))) - (if (eq (load-global-constant unbound-value) val) + (if (eq (load-global-constant new-unbound-value) val) (error "The slot ~S is unbound in the object ~S." slot-name instance) val)))) @@ -1314,7 +1316,7 @@ (defmethod slot-value-using-class ((class standard-class) object (slot standard-effective-slot-definition)) (let ((x (standard-instance-access object (slot-definition-location slot)))) - (if (eq x (load-global-constant unbound-value)) + (if (eq x (load-global-constant new-unbound-value)) (slot-unbound class object (slot-definition-name slot)) x))) @@ -1323,7 +1325,7 @@ (let* ((location (slot-definition-location slot)) (slots (std-gf-instance-slots object)) (val (svref slots location))) - (if (eq (load-global-constant unbound-value) val) + (if (eq (load-global-constant new-unbound-value) val) (slot-unbound class object (slot-definition-name slot)) val))) @@ -1361,11 +1363,11 @@ (slot-boundp-using-class class object slot)))) (defmethod slot-boundp-using-class ((class standard-class) object (slot standard-effective-slot-definition)) - (not (eq (load-global-constant unbound-value) + (not (eq (load-global-constant new-unbound-value) (standard-instance-access object (slot-definition-location slot))))) (defmethod slot-boundp-using-class ((class funcallable-standard-class) object (slot standard-effective-slot-definition)) - (not (eq (load-global-constant unbound-value) + (not (eq (load-global-constant new-unbound-value) (svref (std-gf-instance-slots object) (slot-definition-location slot))))) (defmethod slot-boundp-using-class ((class built-in-class) object slot) @@ -1381,12 +1383,12 @@ (defmethod slot-makunbound-using-class ((class standard-class) object (slot standard-effective-slot-definition)) (setf (standard-instance-access object (slot-definition-location slot)) - (load-global-constant unbound-value)) + (load-global-constant new-unbound-value)) object) (defmethod slot-makunbound-using-class ((class funcallable-standard-class) object (slot standard-effective-slot-definition)) (setf (svref (std-gf-instance-slots object) (slot-definition-location slot)) - (load-global-constant unbound-value)) + (load-global-constant new-unbound-value)) object) (defmethod slot-makunbound-using-class ((class built-in-class) object slot) @@ -1748,7 +1750,7 @@ ;; (warn "access ~S of ~S at ~S" slot-name class-name location) (assert location) (let ((x (standard-instance-access slot location))) - (if (eq x (load-global-constant unbound-value)) + (if (eq x (load-global-constant new-unbound-value)) (error "The slot ~S is unbound in the ~S ~Z." slot-name class-name slot) x))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.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-serv7318 Modified Files: interrupt.lisp Log Message: Recognize the INTO unbound-variable protocol. Date: Tue Nov 23 17:05:59 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.32 movitz/losp/muerte/interrupt.lisp:1.33 --- movitz/losp/muerte/interrupt.lisp:1.32 Fri Nov 19 21:16:15 2004 +++ movitz/losp/muerte/interrupt.lisp Tue Nov 23 17:05:59 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.32 2004/11/19 20:16:15 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.33 2004/11/23 16:05:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -286,7 +286,15 @@ (case vector (0 (error 'division-by-zero)) (3 (break "Break instruction at ~@Z." $eip)) - (4 (error "Primitive overflow assertion failed.")) + (4 (warn "into ~@Z" $eax) + (if (not (eq (load-global-constant new-unbound-value) + (dereference $eax))) + (error "Primitive overflow assertion failed.") + (let ((name (dereference $ebx))) + (with-simple-restart (new-value "Set the value of ~S." name) + (error 'unbound-variable :name name)) + (format *query-io* "~&Enter a value for ~S: " name) + (setf (dereference $eax) (read *query-io*))))) (6 (error "Illegal instruction at ~@Z." $eip)) (13 (error "General protection error. EIP=~@Z, error-code: #x~X, EAX: ~@Z, EBX: ~@Z, ECX: ~@Z" $eip @@ -360,10 +368,6 @@ (let ((name (dereference $edx))) (when (symbolp name) (error 'undefined-function :name name)))) - (99 - (let ((name (dereference $edx))) - (when (symbolp name) - (error 'unbound-variable :name name)))) ((100);; 101 102 103 104 105) (let ((funobj (dereference (+ dit-frame (dit-frame-index :esi)))) (code (dit-frame-ref nil dit-frame :ecx :unsigned-byte8)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.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-serv7292 Modified Files: integers.lisp Log Message: Try to be a bit more clever in dpb. Date: Tue Nov 23 17:05:25 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.101 movitz/losp/muerte/integers.lisp:1.102 --- movitz/losp/muerte/integers.lisp:1.101 Sun Nov 21 01:10:11 2004 +++ movitz/losp/muerte/integers.lisp Tue Nov 23 17:05:23 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.101 2004/11/21 00:10:11 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.102 2004/11/23 16:05:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2119,8 +2119,12 @@ (defun dpb (newbyte bytespec integer) - (logior (mask-field bytespec (ash newbyte (byte-position bytespec))) - (logandc2 integer (mask-field bytespec -1)))) + (logior (if (= 0 newbyte) + 0 + (mask-field bytespec (ash newbyte (byte-position bytespec)))) + (if (= 0 integer) + 0 + (logandc2 integer (mask-field bytespec -1))))) (defun mask-field (bytespec integer) (ash (ldb bytespec integer) (byte-position bytespec)))

1 0

[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

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs