Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv23870
Modified Files: defstruct.lisp Log Message: Better errors from struct accessors.
--- /project/movitz/cvsroot/movitz/losp/muerte/defstruct.lisp 2008/04/19 12:43:50 1.20 +++ /project/movitz/cvsroot/movitz/losp/muerte/defstruct.lisp 2008/04/21 19:39:08 1.21 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Jan 22 13:10:59 2001 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: defstruct.lisp,v 1.20 2008/04/19 12:43:50 ffjeld Exp $ +;;;; $Id: defstruct.lisp,v 1.21 2008/04/21 19:39:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -95,10 +95,12 @@ (:compile-form (:result-mode :eax) object) (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) - (:jne '(:sub-program (type-error) (:int 66))) + (:jne '(:sub-program (type-error) + (:load-constant struct-name :edx) + (:int 59))) (:cmpb #.(movitz:tag :defstruct) (:eax #.movitz:+other-type-offset+)) - (:jne '(:sub-program (type-error) (:int 66))) - (:load-constant struct-name :ebx) + (:jne 'type-error) +;; (:load-constant struct-name :ebx) ;;; (:cmpl :ebx (:eax #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name))) ;;; (:jne '(:sub-program (type-error) (:int 66))) ;; type test passed, read slot @@ -115,12 +117,14 @@ ;; type test (:leal (:ebx #.(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) - (:jnz '(:sub-program (type-error) (:int 66))) + (:jnz '(:sub-program (type-error) + (:load-constant struct-name :edx) + (:movl :ebx :eax) + (:int 59))) (:cmpb #.(movitz:tag :defstruct) (:ebx #.movitz:+other-type-offset+)) - (:jne '(:sub-program (type-error) (:int 66))) - (:load-constant struct-name :ecx) -;;; (:cmpl :ecx (:ebx #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name))) -;;; (:jne '(:sub-program (type-error) (:int 66))) + (:jne 'type-error) +;; (:cmpl :edx (:ebx (:offset movitz-struct name))) +;; (:jne 'type-error) ;; type test passed, write slot (:load-constant slot-number :ecx) ;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) @@ -173,7 +177,8 @@ (:type (push parameter (getf collector :type))) (:initial-offset (push parameter (getf collector :initial-offset))) (:print-object (push parameter (getf collector :print-object))) - (:print-function (push parameter (getf collector :print-function)))))) + (:print-function (push parameter (getf collector :print-function))) + (:include (push (cdr option) (getf collector :include)))))) ((cons symbol (cons * cons)) (ecase (car option) (:include (push (cdr option) (getf collector :include)))