movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

19 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4443 Modified Files: image.lisp Log Message: Changed the way (find-class '<foo>) is optimized for certain well-known classes. The idea is to avoid the normal hash-table lookup for some often-named classes. Date: Mon Apr 19 11:06:21 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.25 movitz/image.lisp:1.26 --- movitz/image.lisp:1.25 Sat Apr 17 11:33:51 2004 +++ movitz/image.lisp Mon Apr 19 11:06:21 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.25 2004/04/17 15:33:51 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.26 2004/04/19 15:06:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -276,22 +276,35 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) + (complicated-class-of + :binary-type word + :binary-tag :global-function + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-intern) (num-values :binary-type lu32 :initform 0) (values :binary-type #.(* 4 +movitz-multiple-values-limit+)) - (default-interrupt-trampoline :map-binary-write 'movitz-intern-code-vector :binary-tag :primitive-function :map-binary-read-delayed 'movitz-word-code-vector :binary-type code-vector-word) - (complicated-class-of + (classes ; A vector of class meta-objects. + :initform nil ; The first element is the map of corresponding names :binary-type word - :binary-tag :global-function - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-intern) + :map-binary-write (lambda (x type) + (declare (ignore x type)) + (let ((map (image-classes-map *image*))) + (movitz-read-and-intern + (apply #'vector + map + (mapcar (lambda (x) + (funcall 'muerte::movitz-find-class x)) + map)) + 'word))) + :map-binary-read-delayed 'movitz-word) ;; Some well-known classes (the-class-t :binary-type word @@ -301,38 +314,38 @@ (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) 'word)) :map-binary-read-delayed 'movitz-word) - (the-class-fixnum - :binary-type word - :initform 'fixnum - :map-binary-write (lambda (x type) - (declare (ignore type)) - (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) - 'word)) - :map-binary-read-delayed 'movitz-word) - (the-class-cons - :binary-type word - :initform 'cons - :map-binary-write (lambda (x type) - (declare (ignore type)) - (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) - 'word)) - :map-binary-read-delayed 'movitz-word) - (the-class-null - :binary-type word - :initform 'null - :map-binary-write (lambda (x type) - (declare (ignore type)) - (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) - 'word)) - :map-binary-read-delayed 'movitz-word) - (the-class-symbol - :binary-type word - :initform 'symbol - :map-binary-write (lambda (x type) - (declare (ignore type)) - (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) - 'word)) - :map-binary-read-delayed 'movitz-word) +;;; (the-class-fixnum +;;; :binary-type word +;;; :initform 'fixnum +;;; :map-binary-write (lambda (x type) +;;; (declare (ignore type)) +;;; (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) +;;; 'word)) +;;; :map-binary-read-delayed 'movitz-word) +;;; (the-class-cons +;;; :binary-type word +;;; :initform 'cons +;;; :map-binary-write (lambda (x type) +;;; (declare (ignore type)) +;;; (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) +;;; 'word)) +;;; :map-binary-read-delayed 'movitz-word) +;;; (the-class-null +;;; :binary-type word +;;; :initform 'null +;;; :map-binary-write (lambda (x type) +;;; (declare (ignore type)) +;;; (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) +;;; 'word)) +;;; :map-binary-read-delayed 'movitz-word) +;;; (the-class-symbol +;;; :binary-type word +;;; :initform 'symbol +;;; :map-binary-write (lambda (x type) +;;; (declare (ignore type)) +;;; (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) +;;; 'word)) +;;; :map-binary-read-delayed 'movitz-word) (interrupt-handlers :binary-type word :map-binary-write 'movitz-intern @@ -526,6 +539,22 @@ :initform (make-hash-table :test #'equal) :initarg :function-code-sizes :reader function-code-sizes))) + +(defmethod image-classes-map ((image symbolic-image)) + '(muerte.cl:null muerte.cl:cons muerte.cl:fixnum muerte.cl:symbol + muerte.cl:character muerte.cl:function muerte.cl:condition + muerte.cl:vector muerte.cl:string muerte.cl:array + muerte.cl:class muerte.cl:standard-class + muerte.cl:standard-generic-function + muerte:run-time-context + muerte.mop:standard-effective-slot-definition + muerte.mop:funcallable-standard-class + muerte:basic-restart)) + +(defun class-object-offset (name) + (+ (bt:slot-offset 'movitz-vector 'data) + (* 4 (1+ (or (position name (image-classes-map *image*)) + (error "No class named ~S in class-map." name)))))) (defun unbound-value () (declare (special *image*))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp
by Frode Vatvedt Fjeld 19 Apr '04

19 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv928 Modified Files: run-time-context.lisp Log Message: Minor edit. Date: Mon Apr 19 11:05:01 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.5 movitz/losp/muerte/run-time-context.lisp:1.6 --- movitz/losp/muerte/run-time-context.lisp:1.5 Tue Apr 6 20:18:57 2004 +++ movitz/losp/muerte/run-time-context.lisp Mon Apr 19 11:05:01 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.5 2004/04/07 00:18:57 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.6 2004/04/19 15:05:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -65,7 +65,7 @@ (if (not (and (movitz:movitz-constantp slot-name env) (equal context '(current-run-time-context)))) form - (let ((slot-name (movitz::eval-form slot-name env))) + (let ((slot-name (movitz:movitz-eval slot-name env))) (ecase (bt:binary-slot-type 'movitz::movitz-constant-block (intern (symbol-name slot-name) :movitz)) (movitz:word `(with-inline-assembly (:returns :eax)

1 0

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

19 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv22672 Modified Files: packages.lisp Log Message: More symbols. Date: Mon Apr 19 11:04:32 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.19 movitz/packages.lisp:1.20 --- movitz/packages.lisp:1.19 Fri Apr 16 15:21:13 2004 +++ movitz/packages.lisp Mon Apr 19 11:04:32 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.19 2004/04/16 19:21:13 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.20 2004/04/19 15:04:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1186,10 +1186,12 @@ map-active-restarts with-basic-restart - vector-u8 - vector-u16 - vector-u32 - pointer + #:vector-u8 + #:vector-u16 + #:vector-u32 + #:pointer + #:basic-restart + #:run-time-context make-funobj funobj-type

1 0

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

19 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7168 Modified Files: compiler.lisp Log Message: Minor edits. Date: Mon Apr 19 11:02:54 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.54 movitz/compiler.lisp:1.55 --- movitz/compiler.lisp:1.54 Sun Apr 18 19:12:37 2004 +++ movitz/compiler.lisp Mon Apr 19 11:02:53 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.54 2004/04/18 23:12:37 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.55 2004/04/19 15:02:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -63,6 +63,12 @@ (defvar *compiling-function-name*) (defvar muerte.cl:*compile-file-pathname* nil) +(defvar *extended-code-expanders* + (make-hash-table :test #'eq)) + +(defvar *extended-code-find-write-binding-and-type* + (make-hash-table :test #'eq)) + (defconstant +enter-stack-frame-code+ '((:pushl :ebp) (:movl :esp :ebp) @@ -5542,9 +5548,6 @@ (check-type result list "a list of read bindings") result))))) -(defvar *extended-code-find-write-binding-and-type* - (make-hash-table :test #'eq)) - (defmacro define-find-write-binding-and-type (name lambda-list &body body) (let ((defun-name (intern (with-standard-io-syntax @@ -5559,9 +5562,6 @@ (finder (gethash operator *extended-code-find-write-binding-and-type*))) (when finder (funcall finder extended-instruction))))) - -(defvar *extended-code-expanders* - (make-hash-table :test #'eq)) (defmacro define-extended-code-expander (name lambda-list &body body) (let ((defun-name (intern

1 0

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

19 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21868 Modified Files: compiler-types.lisp Log Message: Minor improvements. Date: Sun Apr 18 20:29:35 2004 Author: ffjeld Index: movitz/compiler-types.lisp diff -u movitz/compiler-types.lisp:1.11 movitz/compiler-types.lisp:1.12 --- movitz/compiler-types.lisp:1.11 Sun Apr 18 19:10:30 2004 +++ movitz/compiler-types.lisp Sun Apr 18 20:29:35 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Sep 10 00:40:07 2003 ;;;; -;;;; $Id: compiler-types.lisp,v 1.11 2004/04/18 23:10:30 ffjeld Exp $ +;;;; $Id: compiler-types.lisp,v 1.12 2004/04/19 00:29:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -266,14 +266,14 @@ sub-specs))) (cond ((null sub-specs) - (and complement t)) + (if complement t nil)) ((not (cdr sub-specs)) (if (not complement) (car sub-specs) - (cons 'not (car sub-specs)))) + (list 'not (car sub-specs)))) (t (if (not complement) (cons 'or sub-specs) - (cons 'not (cons 'or sub-specs)))))))) + (list 'not (cons 'or sub-specs)))))))) (defun type-values (codes &key integer-range members include complement) ;; Members: A list of objects explicitly included in type. @@ -376,9 +376,20 @@ `(and ,sub1 ,(encoded-type-decode code0 integer-range0 members0 include0 nil))) include1) nil)) - (t (warn "and with two includes..") - (type-values t)))) - (t (error "Not implemented.")))) + (t ;; (warn "and with two includes: ~S ~S" include0 include1) + (type-values () :include `(and ,(encoded-type-decode code0 integer-range0 members0 + include0 complement0) + ,(encoded-type-decode code1 integer-range1 members1 + include1 complement1)))))) + ((and complement0 complement1) + (multiple-value-bind (code integer-range members include complement) + (encoded-types-or code0 integer-range0 members0 include0 (not complement0) + code1 integer-range1 members1 include1 (not complement1)) + (values code integer-range members include (not complement)))) + (t (type-values () :include `(and ,(encoded-type-decode code0 integer-range0 members0 + include0 complement0) + ,(encoded-type-decode code1 integer-range1 members1 + include1 complement1)))))) (defun encoded-types-or (code0 integer-range0 members0 include0 complement0 code1 integer-range1 members1 include1 complement1)

1 0

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

18 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23169 Modified Files: functions.lisp Log Message: Use the type function rather than compiled-function. Date: Sun Apr 18 19:18:32 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.9 movitz/losp/muerte/functions.lisp:1.10 --- movitz/losp/muerte/functions.lisp:1.9 Thu Apr 15 14:53:15 2004 +++ movitz/losp/muerte/functions.lisp Sun Apr 18 19:18:31 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 12 22:58:54 2002 ;;;; -;;;; $Id: functions.lisp,v 1.9 2004/04/15 18:53:15 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.10 2004/04/18 23:18:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -76,18 +76,18 @@ ;;; funobj object (defun funobj-type (funobj) - (check-type funobj compiled-function) + (check-type funobj function) (with-inline-assembly (:returns :untagged-fixnum-ecx) (:xorl :ecx :ecx) (:compile-form (:result-mode :eax) funobj) (:movb (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:funobj-type)) :cl))) (defun funobj-code-vector (funobj) - (check-type funobj compiled-function) + (check-type funobj function) (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :code-vector)) (defun (setf funobj-code-vector) (code-vector funobj) - (check-type funobj compiled-function) + (check-type funobj function) (check-type code-vector vector-u8) (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :code-vector) code-vector)) @@ -97,7 +97,7 @@ a pointer into the regular code-vector, or it points (with offset 2) to another vector entirely. The former is represented as a lisp integer that is the index into the code-vector, the latter is represented as that vector." - (check-type funobj compiled-function) + (check-type funobj function) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) funobj) (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :ebx) ; EBX = code-vector @@ -119,7 +119,7 @@ done)) ; this cell stores word+2 (defun (setf funobj-code-vector%1op) (code-vector funobj) - (check-type funobj compiled-function) + (check-type funobj function) (etypecase code-vector (vector-u8 (with-inline-assembly (:returns :nothing) @@ -142,7 +142,7 @@ a pointer into the regular code-vector, or it points (with offset 2) to another vector entirely. The former is represented as a lisp integer that is the index into the code-vector, the latter is represented as that vector." - (check-type funobj compiled-function) + (check-type funobj function) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) funobj) (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :ebx) ; EBX = code-vector @@ -164,7 +164,7 @@ done)) (defun (setf funobj-code-vector%2op) (code-vector funobj) - (check-type funobj compiled-function) + (check-type funobj function) (etypecase code-vector (vector-u8 (with-inline-assembly (:returns :nothing) @@ -187,7 +187,7 @@ a pointer into the regular code-vector, or it points (with offset 2) to another vector entirely. The former is represented as a lisp integer that is the index into the code-vector, the latter is represented as that vector." - (check-type funobj compiled-function) + (check-type funobj function) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) funobj) (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :ebx) ; EBX = code-vector @@ -209,7 +209,7 @@ done)) (defun (setf funobj-code-vector%3op) (code-vector funobj) - (check-type funobj compiled-function) + (check-type funobj function) (etypecase code-vector (vector-u8 (with-inline-assembly (:returns :nothing) @@ -228,47 +228,47 @@ code-vector) (defun funobj-name (funobj) - (check-type funobj compiled-function) + (check-type funobj function) (movitz-accessor funobj movitz-funobj name)) (defun (setf funobj-name) (name funobj) - (check-type funobj compiled-function) + (check-type funobj function) ;; (check-type name (or symbol list) (setf-movitz-accessor (funobj movitz-funobj name) name)) (defun funobj-lambda-list (funobj) - (check-type funobj compiled-function) + (check-type funobj function) (movitz-accessor funobj movitz-funobj lambda-list)) (defun (setf funobj-lambda-list) (lambda-list funobj) - (check-type funobj compiled-function) + (check-type funobj function) (check-type lambda-list list) (setf-movitz-accessor (funobj movitz-funobj lambda-list) lambda-list)) (defun funobj-num-constants (funobj) - (check-type funobj compiled-function) + (check-type funobj function) (movitz-accessor-u16 funobj movitz-funobj num-constants)) (defun (setf funobj-num-constants) (num-constants funobj) - (check-type funobj compiled-function) + (check-type funobj function) (check-type num-constants (unsigned-byte 16)) (set-movitz-accessor-u16 funobj movitz-funobj num-constants num-constants)) (defun funobj-num-jumpers (funobj) - (check-type funobj compiled-function) + (check-type funobj function) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) funobj) (:movzxw (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::num-jumpers)) :eax))) (defun (setf funobj-num-jumpers) (num-jumpers funobj) - (check-type funobj compiled-function) + (check-type funobj function) (check-type num-jumpers (unsigned-byte 14)) (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) num-jumpers funobj) (:movw :ax (:ebx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::num-jumpers))))) (defun funobj-constant-ref (funobj index) - (check-type funobj compiled-function) + (check-type funobj function) (assert (below index (funobj-num-constants funobj)) (index) "Index ~D out of range, ~S has ~D constants." index funobj (funobj-num-constants funobj)) (if (>= index (funobj-num-jumpers funobj)) @@ -287,7 +287,7 @@ (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :eax)))) (defun (setf funobj-constant-ref) (value funobj index) - (check-type funobj compiled-function) + (check-type funobj function) (assert (below index (funobj-num-constants funobj)) (index) "Index ~D out of range, ~S has ~D constants." index funobj (funobj-num-constants funobj)) (if (>= index (funobj-num-jumpers funobj)) @@ -311,7 +311,7 @@ value))) (defun funobj-debug-info (funobj) - (check-type funobj compiled-function) + (check-type funobj function) (movitz-accessor-u16 funobj movitz-funobj debug-info)) (defun funobj-frame-num-unboxed (funobj)

1 0

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

18 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv21745 Modified Files: interrupt.lisp Log Message: *** empty log message *** Date: Sun Apr 18 19:17:59 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.6 movitz/losp/muerte/interrupt.lisp:1.7 --- movitz/losp/muerte/interrupt.lisp:1.6 Thu Apr 15 11:23:36 2004 +++ movitz/losp/muerte/interrupt.lisp Sun Apr 18 19:17:58 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.6 2004/04/15 15:23:36 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.7 2004/04/18 23:17:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -166,6 +166,12 @@ $eip (interrupt-frame-ref interrupt-frame :error-code :unsigned-byte32) $eax $ebx $ecx)) + ((61) + ;; EAX failed type in EDX. May be restarted by returning with a new value in EAX. + (with-simple-restart (continue "Retry with a different value.") + (error 'type-error :datum (@ $eax) :expected-type (@ $edx))) + (format *query-io* "Enter a new value: ") + (setf (@ $eax) (read *query-io*))) (68 (warn "EIP: ~@Z EAX: ~@Z EBX: ~@Z ECX: ~@Z EDX: ~@Z" $eip $eax $ebx $ecx $edx) (dotimes (i 100000)

1 0

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

18 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1525 Modified Files: conditions.lisp Log Message: Added a reporter. Date: Sun Apr 18 19:17:36 2004 Author: ffjeld Index: movitz/losp/muerte/conditions.lisp diff -u movitz/losp/muerte/conditions.lisp:1.5 movitz/losp/muerte/conditions.lisp:1.6 --- movitz/losp/muerte/conditions.lisp:1.5 Thu Apr 15 11:11:44 2004 +++ movitz/losp/muerte/conditions.lisp Sun Apr 18 19:17:36 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 20 15:47:04 2002 ;;;; -;;;; $Id: conditions.lisp,v 1.5 2004/04/15 15:11:44 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.6 2004/04/18 23:17:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -94,7 +94,11 @@ :reader type-error-expected-type) (datum :initarg :datum - :reader type-error-datum))) + :reader type-error-datum)) + (:report (lambda (c s) + (format s "The object ~S is not of type ~S." + (type-error-datum c) + (type-error-expected-type c))))) (define-condition control-error (error) ())

1 0

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

18 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30454 Modified Files: common-lisp.lisp Log Message: Minor re-ordering. Date: Sun Apr 18 19:17:04 2004 Author: ffjeld Index: movitz/losp/muerte/common-lisp.lisp diff -u movitz/losp/muerte/common-lisp.lisp:1.4 movitz/losp/muerte/common-lisp.lisp:1.5 --- movitz/losp/muerte/common-lisp.lisp:1.4 Tue Apr 6 20:13:02 2004 +++ movitz/losp/muerte/common-lisp.lisp Sun Apr 18 19:17:04 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:41:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: common-lisp.lisp,v 1.4 2004/04/07 00:13:02 ffjeld Exp $ +;;;; $Id: common-lisp.lisp,v 1.5 2004/04/18 23:17:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -43,11 +43,11 @@ (require :muerte/eval) (require :muerte/los-closette) (require :muerte/environment) -(require :muerte/interrupt) (require :muerte/streams) (require :muerte/restarts) (require :muerte/conditions) (require :muerte/read) +(require :muerte/interrupt) (require :muerte/scavenge) (require :muerte/simple-streams)

1 0

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

18 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13920/losp/muerte Modified Files: defstruct.lisp Log Message: Don't use exception 60. Date: Sun Apr 18 19:16:49 2004 Author: ffjeld Index: movitz/losp/muerte/defstruct.lisp diff -u movitz/losp/muerte/defstruct.lisp:1.5 movitz/losp/muerte/defstruct.lisp:1.6 --- movitz/losp/muerte/defstruct.lisp:1.5 Mon Mar 29 09:53:13 2004 +++ movitz/losp/muerte/defstruct.lisp Sun Apr 18 19:16:49 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Jan 22 13:10:59 2001 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: defstruct.lisp,v 1.5 2004/03/29 14:53:13 ffjeld Exp $ +;;;; $Id: defstruct.lisp,v 1.6 2004/04/18 23:16:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -57,9 +57,9 @@ (:compile-form (:result-mode :eax) object) (:leal (:eax ,(- (movitz:tag :other))) :ecx) (:testb 7 :cl) - (:jne '(:sub-program (type-error) (:int 60))) + (:jne '(:sub-program (type-error) (:int 66))) (:cmpb ,(movitz:tag :defstruct) (-2 :eax)) - (:jne '(:sub-program (type-error) (:int 60))) + (:jne '(:sub-program (type-error) (:int 66))) ;; type test passed, read slot ,@(if (= 4 movitz::+movitz-fixnum-factor+) `((:compile-form (:result-mode :ebx) slot-number) @@ -78,9 +78,9 @@ (:compile-two-forms (:eax :ebx) object slot-number) (:leal (:eax ,(- (movitz:tag :other))) :ecx) (:testb 7 :cl) - (:jne '(:sub-program (type-error) (:int 60))) + (:jne '(:sub-program (type-error) (:int 66))) (:cmpb ,(movitz:tag :defstruct) (-2 :eax)) - (:jne '(:sub-program (type-error) (:int 60))) + (:jne '(:sub-program (type-error) (:int 66))) (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-struct 'movitz::length)) :ecx) (:leal ((:ecx ,movitz::+movitz-fixnum-factor+)) :ecx) (:testb ,movitz::+movitz-fixnum-zmask+ :bl) @@ -99,12 +99,12 @@ (:compile-form (:result-mode :eax) object) (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) - (:jne '(:sub-program (type-error) (:int 60))) + (:jne '(:sub-program (type-error) (:int 66))) (:cmpb #.(movitz:tag :defstruct) (-2 :eax)) - (:jne '(:sub-program (type-error) (:int 60))) + (:jne '(:sub-program (type-error) (:int 66))) (:load-constant struct-name :ebx) (:cmpl :ebx (:eax #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name))) - (:jne '(:sub-program (type-error) (:int 60))) + (:jne '(:sub-program (type-error) (:int 66))) ;; type test passed, read slot (:load-constant slot-number :ecx) (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) @@ -118,12 +118,12 @@ ;; type test (:leal (:ebx #.(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) - (:jnz '(:sub-program (type-error) (:int 60))) + (:jnz '(:sub-program (type-error) (:int 66))) (:cmpb #.(movitz:tag :defstruct) (-2 :ebx)) - (:jne '(:sub-program (type-error) (:int 60))) + (: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 60))) + (:jne '(:sub-program (type-error) (:int 66))) ;; type test passed, write slot (:load-constant slot-number :ecx) (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)

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