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

[movitz-cvs] CVS update: movitz/losp/muerte/more-macros.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-serv11801 Modified Files: more-macros.lisp Log Message: Added macro with-slots. Date: Mon Apr 19 16:01:08 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.5 movitz/losp/muerte/more-macros.lisp:1.6 --- movitz/losp/muerte/more-macros.lisp:1.5 Tue Apr 6 10:05:23 2004 +++ movitz/losp/muerte/more-macros.lisp Mon Apr 19 16:01:08 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.5 2004/04/06 14:05:23 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.6 2004/04/19 20:01:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -292,3 +292,13 @@ (defmacro ignore-errors (&body body) `(handler-case (progn ,@body) (error (c) (values nil c)))) + +(defmacro with-slots (slot-entries instance-form &body declarations-and-forms) + (let ((object-var (gensym "with-slots-object-"))) + `(symbol-macrolet ,(mapcar (lambda (entry) + (let ((var (if (atom entry) entry (car entry))) + (slot (if (atom entry) entry (cadr entry)))) + `(,var (slot-value ,object-var ',slot)))) + slot-entries) + (let ((,object-var ,instance-form)) + ,@declarations-and-forms)))) \ No newline at end of file

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/typep.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-serv18778 Modified Files: typep.lisp Log Message: Added knowledge of the satisfies type in typep's compiler-macro. Date: Mon Apr 19 15:51:01 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.10 movitz/losp/muerte/typep.lisp:1.11 --- movitz/losp/muerte/typep.lisp:1.10 Sat Apr 17 10:08:24 2004 +++ movitz/losp/muerte/typep.lisp Mon Apr 19 15:51:01 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.10 2004/04/17 14:08:24 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.11 2004/04/19 19:51:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -294,6 +294,11 @@ not-fixnum))))))) ((eql) `(eql ,object ',(cadr type))) + ((satisfies) + (destructuring-bind (predicate-name) + (cdr type) + (check-type predicate-name symbol "a satisfies predicate-name") + `(,predicate-name ,object))) ((cons) (destructuring-bind (&optional (car t) (cdr t)) (cdr type)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.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-serv31584 Modified Files: primitive-functions.lisp Log Message: Fixed fast-class-of-null and fast-class-of-character so that they actually do what they're supposed to do. Date: Mon Apr 19 15:49:11 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.14 movitz/losp/muerte/primitive-functions.lisp:1.15 --- movitz/losp/muerte/primitive-functions.lisp:1.14 Mon Apr 19 11:06:38 2004 +++ movitz/losp/muerte/primitive-functions.lisp Mon Apr 19 15:49:11 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.14 2004/04/19 15:06:38 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.15 2004/04/19 19:49:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -561,8 +561,12 @@ (define-primitive-function fast-class-of-character () "Return the class of a character object." (with-inline-assembly (:returns :multiple-values) - (:globally (:movl (:edi (:edi-offset classes)) :eax)) - (:movl (:eax #.(movitz::class-object-offset 'character)) :eax) + (:globally (:movl (:edi (:edi-offset classes)) :ebx)) + (:cmpb #.(movitz:tag :character) :al) + (:jne '(:sub-program () + (:globally (:movl (:edi (:edi-offset complicated-class-of)) :esi)) + (:jmp (:esi #.(bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector%1op))))) + (:movl (:ebx #.(movitz::class-object-offset 'character)) :eax) (:ret))) (define-primitive-function fast-class-of-null ()

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.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-serv23371 Modified Files: primitive-functions.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:38 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.13 movitz/losp/muerte/primitive-functions.lisp:1.14 --- movitz/losp/muerte/primitive-functions.lisp:1.13 Fri Apr 16 19:35:29 2004 +++ movitz/losp/muerte/primitive-functions.lisp Mon Apr 19 11:06:38 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.13 2004/04/16 23:35:29 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.14 2004/04/19 15:06:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -519,21 +519,32 @@ (define-primitive-function fast-class-of-even-fixnum () "Return the class of a fixnum object." (with-inline-assembly (:returns :multiple-values) - (:globally (:movl (:edi (:edi-offset the-class-fixnum)) :eax)) + (:globally (:movl (:edi (:edi-offset classes)) :eax)) + (:movl (:eax #.(movitz::class-object-offset 'fixnum)) :eax) (:ret))) (define-primitive-function fast-class-of-odd-fixnum () "Return the class of a fixnum object." (with-inline-assembly (:returns :multiple-values) - (:globally (:movl (:edi (:edi-offset the-class-fixnum)) :eax)) + (:globally (:movl (:edi (:edi-offset classes)) :eax)) + (:movl (:eax #.(movitz::class-object-offset 'fixnum)) :eax) (:ret))) (define-primitive-function fast-class-of-cons () "Return the class of a cons object." (with-inline-assembly (:returns :multiple-values) - (:globally (:movl (:edi (:edi-offset the-class-cons)) :eax)) + (:globally (:movl (:edi (:edi-offset classes)) :eax)) + (:movl (:eax #.(movitz::class-object-offset 'cons)) :eax) (:ret))) +(define-primitive-function fast-class-of-symbol () + "Return the class of a symbol object." + (with-inline-assembly (:returns :multiple-values) + (:globally (:movl (:edi (:edi-offset classes)) :eax)) + (:movl (:eax #.(movitz::class-object-offset 'symbol)) :eax) + (:ret))) + + (define-primitive-function fast-class-of-std-instance () "Return the class of a std-instance object." (with-inline-assembly (:returns :multiple-values) @@ -550,19 +561,23 @@ (define-primitive-function fast-class-of-character () "Return the class of a character object." (with-inline-assembly (:returns :multiple-values) - (:globally (:movl (:edi (:edi-offset complicated-class-of)) :esi)) - (:jmp (:esi #.(bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector%1op))))) + (:globally (:movl (:edi (:edi-offset classes)) :eax)) + (:movl (:eax #.(movitz::class-object-offset 'character)) :eax) + (:ret))) (define-primitive-function fast-class-of-null () "Return the class of a nil object." (with-inline-assembly (:returns :multiple-values) - (:globally (:movl (:edi (:edi-offset the-class-null)) :eax)) + (:cmpl :edi :eax) + (:jne '(:sub-program () (:int 64))) + (:globally (:movl (:edi (:edi-offset classes)) :eax)) + (:movl (:eax #.(movitz::class-object-offset 'null)) :eax) (:ret))) (define-primitive-function fast-class-of-other () "Return the class of an other object." (with-inline-assembly (:returns :multiple-values) - (:movw (:eax -2) :cx) + (:movl (:eax -2) :ecx) (:cmpb #.(movitz::tag :std-instance) :cl) (:jne 'not-std-instance) (:movl (:eax #.(bt:slot-offset 'movitz::movitz-std-instance 'movitz::class)) :eax) @@ -579,12 +594,6 @@ (:globally (:movl (:edi (:edi-offset complicated-class-of)) :esi)) (:jmp (:esi #.(bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector%1op))))) -(define-primitive-function fast-class-of-symbol () - "Return the class of a symbol object." - (with-inline-assembly (:returns :multiple-values) - (:globally (:movl (:edi (:edi-offset the-class-symbol)) :eax)) - (:ret))) - (defun complicated-class-of (object) (typecase object (std-instance @@ -595,7 +604,7 @@ (find-class 'string)) (vector (find-class 'vector)) - (compiled-function + (function (find-class 'function)) (structure-object (find-class (structure-object-name object)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.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-serv19544 Modified Files: los-closette.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:32 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.7 movitz/losp/muerte/los-closette.lisp:1.8 --- movitz/losp/muerte/los-closette.lisp:1.7 Wed Apr 14 18:01:30 2004 +++ movitz/losp/muerte/los-closette.lisp Mon Apr 19 11:06:32 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.7 2004/04/14 22:01:30 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.8 2004/04/19 15:06:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -208,12 +208,17 @@ (defun (setf find-class) (class class-name) (check-type class (or null class)) + #+ignore (case class-name ((t) (setf (%run-time-context-slot 'the-class-t) class)) (null (setf (%run-time-context-slot 'the-class-null) class)) (symbol (setf (%run-time-context-slot 'the-class-symbol) class)) (fixnum (setf (%run-time-context-slot 'the-class-fixnum) class)) (cons (setf (%run-time-context-slot 'the-class-cons) class))) + (let ((map (load-global-constant classes))) + (when (member class-name (svref map 0)) + (setf (svref map (1+ (position class-name (svref map 0)))) + class))) (if class (setf (gethash class-name *class-table*) class) (remhash class-name *class-table*)) @@ -896,9 +901,6 @@ `(defun ,name (instance) (with-inline-assembly (:returns :multiple-values) (:compile-form (:result-mode :eax) instance) -;;; (:leal (:eax -2) :ecx) -;;; (:testb 7 :cl) -;;; (:jnz '(:sub-program () (:int 68))) (:movl (:eax ,(bt:slot-offset 'movitz::movitz-std-instance 'movitz::slots)) :eax) (:movl (:eax ,(+ (bt:slot-offset 'movitz::movitz-vector 'movitz::data) @@ -1776,11 +1778,6 @@ (warn "CLOS was already bootstrapped: ~S" (get 'clos-bootstrap 'have-bootstrapped))) (setf (get 'clos-bootstrap 'have-bootstrapped) :in-progress) - #+ignore - (setf (runtime-context-slot 'the-class-t) (gethash 't *class-table*) - (runtime-context-slot 'the-class-null) (gethash 'null *class-table*) - (runtime-context-slot 'the-class-symbol) (gethash 'symbol *class-table*) - (runtime-context-slot 'the-class-cons) (gethash 'cons *class-table*)) (let ((real-camuc #'compute-applicable-methods-using-classes) (real-class-slots #'class-slots) (real-class-precedence-list #'class-precedence-list)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.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-serv11596 Modified Files: basic-macros.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:26 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.16 movitz/losp/muerte/basic-macros.lisp:1.17 --- movitz/losp/muerte/basic-macros.lisp:1.16 Sun Apr 18 19:15:53 2004 +++ movitz/losp/muerte/basic-macros.lisp Mon Apr 19 11:06:26 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.16 2004/04/18 23:15:53 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.17 2004/04/19 15:06:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -860,13 +860,26 @@ (declare (ignore errorp)) (if (not (movitz:movitz-constantp symbol env)) form - (case (movitz::translate-program (movitz::eval-form symbol env) :muerte.cl :cl) - ((t) `(load-global-constant the-class-t)) - (fixnum '(load-global-constant the-class-fixnum)) - (null `(load-global-constant the-class-null)) - (symbol '(load-global-constant the-class-symbol)) - (cons '(load-global-constant the-class-cons)) - (t form)))) + (let* ((type (movitz:movitz-eval symbol env)) + (cl-type (movitz::translate-program type :muerte.cl :cl))) + (cond + ((eq t cl-type) + `(load-global-constant the-class-t)) + ((member type (movitz::image-classes-map movitz:*image*)) + `(with-inline-assembly (:returns :register) + (:globally (:movl (:edi (:edi-offset classes)) (:result-register))) + (:movl ((:result-register) ,(movitz::class-object-offset type)) + (:result-register)))) + (t (warn "unknown find-class: ~A" cl-type) + form)) + #+ignore + (case cl-type + ((t) `(load-global-constant the-class-t)) + (fixnum '(load-global-constant the-class-fixnum)) + (null `(load-global-constant the-class-null)) + (symbol '(load-global-constant the-class-symbol)) + (cons '(load-global-constant the-class-cons)) + (t form))))) (define-compiler-macro class-of (object) `(with-inline-assembly (:returns :eax) @@ -886,7 +899,7 @@ (:leal ((:result-register) ,(- (movitz::tag :other))) :ecx) (:testb 7 :cl) - (:jnz '(:sub-program () (:int 68))) + (:jnz '(:sub-program () (:int 66))) (:movl ((:result-register) ,(bt:slot-offset 'movitz::movitz-std-instance slot)) (:result-register)))))) @@ -898,7 +911,7 @@ (:leal (:ebx ,(- (movitz::tag :other))) :ecx) (:testb 7 :cl) - (:jnz '(:sub-program () (:int 68))) + (:jnz '(:sub-program () (:int 66))) (:movl :eax (:ebx ,(bt:slot-offset 'movitz::movitz-std-instance slot))))))) @@ -982,11 +995,6 @@ (:locally (:movl (:edi (:edi-offset ,name)) :ecx))) `(with-inline-assembly (:returns :untagged-fixnum-ecx) (:globally (:movl (:edi (:edi-offset ,name)) :ecx))))) - -;;;(define-compiler-macro (setf %runtime-context-slot) (value slot-name) -;;; `(with-inline-assembly (:returns :eax) -;;; (:compile-form (:result-mode :eax) ,value) -;;; (:movl :eax (:edi ,(movitz::global-constant-offset (movitz::eval-form slot-name)))))) (define-compiler-macro halt-cpu () (let ((infinite-loop-label (make-symbol "infinite-loop")))

1 0

[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