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

[movitz-cvs] CVS update: movitz/special-operators.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3616 Modified Files: special-operators.lisp Log Message: Fix returned type-specifier to corret pacakge. Date: Thu Oct 21 22:41:56 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.41 movitz/special-operators.lisp:1.42 --- movitz/special-operators.lisp:1.41 Thu Oct 7 14:48:39 2004 +++ movitz/special-operators.lisp Thu Oct 21 22:41:56 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.41 2004/10/07 12:48:39 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.42 2004/10/21 20:41:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -598,7 +598,7 @@ (compiler-values () :code code :returns returns - :type type + :type (translate-program type :muerte.cl :cl) :modifies modifies :functional-p (not side-effects))))))))))))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3571 Modified Files: image.lisp Log Message: Removed dead code. Date: Thu Oct 21 22:40:32 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.71 movitz/image.lisp:1.72 --- movitz/image.lisp:1.71 Sat Sep 25 17:40:30 2004 +++ movitz/image.lisp Thu Oct 21 22:40:32 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.71 2004/09/25 15:40:30 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.72 2004/10/21 20:40:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1457,21 +1457,7 @@ (make-movitz-hash-table expr)) (ratio (make-instance 'movitz-ratio - :value expr) - #+ignore - (let ((slot-descriptions (gethash 'muerte.cl::ratio - (image-struct-slot-descriptions *image*) - nil))) - (unless slot-descriptions - (error "Don't know how to movitz-read ratios (yet)." expr)) - (let ((movitz-object (make-instance 'movitz-struct - :class (muerte::movitz-find-class 'muerte.cl::ratio) - :length (length slot-descriptions)))) - (setf (image-lisp-to-movitz-object *image* expr) movitz-object) - (setf (slot-value movitz-object 'slot-values) - (list (movitz-read (numerator expr)) - (movitz-read (denominator expr)))) - movitz-object))) + :value expr)) (structure-object (let ((slot-descriptions (gethash (type-of expr) (image-struct-slot-descriptions *image*)

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3533 Modified Files: compiler.lisp Log Message: Depreacated the :untagged-fixnum-eax more. It's incompatible with stack discipline. Date: Thu Oct 21 22:38:28 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.101 movitz/compiler.lisp:1.102 --- movitz/compiler.lisp:1.101 Mon Oct 11 15:44:04 2004 +++ movitz/compiler.lisp Thu Oct 21 22:38:28 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.101 2004/10/11 13:44:04 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.102 2004/10/21 20:38:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -51,7 +51,7 @@ "Use this segment prefix when reading a lispval at (potentially) non-local locations.") -(defparameter *compiler-nonlocal-lispval-write-segment-prefix* '(:fs-override) +(defparameter *compiler-nonlocal-lispval-write-segment-prefix* '(:es-override) "Use this segment prefix when writing a lispval at (potentially) non-local locations.") @@ -2607,7 +2607,10 @@ (cdr instruction) (assert (not (getf jumper-sets name)) () "Duplicate jumper declaration for ~S." name) - (setf (getf jumper-sets name) set)))) + (setf (getf jumper-sets name) set))) + (t (when (listp instruction) + (dolist (binding (find-read-bindings instruction)) + (process-binding binding))))) do (let ((sub (instruction-sub-program instruction))) (when sub (process sub)))))) (process code) @@ -4801,6 +4804,7 @@ (values (append code `((:load-lexical ,returns-provided ,desired-result))) desired-result)))) + #+ignore (:untagged-fixnum-eax (case returns-provided (:untagged-fixnum-eax @@ -4977,7 +4981,8 @@ (values code returns-provided)) (:multiple-values (values code :values)) - (t (values (make-result-and-returns-glue :eax returns-provided code) + (t (values (make-result-and-returns-glue :eax returns-provided code + :type type) '(:values 1))))) ((:multiple-values :function) (case (operator returns-provided) @@ -4990,16 +4995,21 @@ (1 (values (append code '((:clc))) :multiple-values)) ((nil) (values code :multiple-values)) - (t (values (append code (make-immediate-move (first (operands returns-provided)) :ecx) '((:stc))) + (t (values (append code + (make-immediate-move (first (operands returns-provided)) :ecx) + '((:stc))) :multiple-values)))) (t (values (append (make-result-and-returns-glue :eax returns-provided - code) + code + :type type + :provider provider + :really-desired desired-result) '((:clc))) :multiple-values))))) (unless new-returns-provided (multiple-value-setq (new-code new-returns-provided glue-side-effects-p) - (case (operator returns-provided) + (ecase (operator returns-provided) (#.+boolean-modes+ (make-result-and-returns-glue desired-result :eax (make-result-and-returns-glue :eax returns-provided code @@ -5009,16 +5019,28 @@ :type type :provider provider)) (:untagged-fixnum-ecx - (case (result-mode-type desired-result) - ((:eax :single-value) - (values (append code - `((:call (:edi ,(global-constant-offset 'box-u32-ecx))))) - desired-result)) - (t (make-result-and-returns-glue desired-result :eax - (make-result-and-returns-glue :eax :untagged-fixnum-ecx code - :provider provider - :really-desired desired-result) - :provider provider)))) + (let ((fixnump (subtypep type `(integer 0 ,+movitz-most-positive-fixnum+)))) + (cond + ((and fixnump + (member (result-mode-type desired-result) '(:eax :ebx :ecx :edx))) + (values (append code + `((:leal ((:ecx ,+movitz-fixnum-factor+)) + ,(result-mode-type desired-result)))) + desired-result)) + ((and (not fixnump) + (member (result-mode-type desired-result) '(:eax :single-value))) + (values (append code + `((:call (:edi ,(global-constant-offset 'box-u32-ecx))))) + desired-result)) + (t (make-result-and-returns-glue + desired-result :eax + (make-result-and-returns-glue :eax :untagged-fixnum-ecx code + :provider provider + :really-desired desired-result + :type type) + :provider provider + :type type))))) + #+ignore (:untagged-fixnum-eax (make-result-and-returns-glue desired-result :eax (make-result-and-returns-glue :eax :untagged-fixnum-eax code @@ -5542,7 +5564,7 @@ (:lexical-binding result-mode) ((:ebx :ecx :edx :esi :push - :untagged-fixnum-eax + ;; :untagged-fixnum-eax :untagged-fixnum-ecx :boolean-branch-on-true :boolean-branch-on-false)

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3487 Modified Files: symbols.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:34:11 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.21 movitz/losp/muerte/symbols.lisp:1.22 --- movitz/losp/muerte/symbols.lisp:1.21 Tue Oct 12 16:45:16 2004 +++ movitz/losp/muerte/symbols.lisp Thu Oct 21 22:34:11 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.21 2004/10/12 14:45:16 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.22 2004/10/21 20:34:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -95,12 +95,12 @@ (defun %unbounded-symbol-function (symbol) (check-type symbol symbol) (memref symbol (movitz-type-slot-offset 'movitz-symbol 'function-value))) - ;; (movitz-accessor symbol movitz-symbol function-value)) (defun (setf symbol-function) (value symbol) (check-type symbol symbol) (check-type value compiled-function) - (setf-movitz-accessor (symbol movitz-symbol function-value) value)) + (setf (memref symbol (movitz-type-slot-offset 'movitz-symbol 'function-value)) + value)) (defun symbol-name (symbol) (get-symbol-slot symbol name string))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3470 Modified Files: primitive-functions.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:34:09 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.46 movitz/losp/muerte/primitive-functions.lisp:1.47 --- movitz/losp/muerte/primitive-functions.lisp:1.46 Thu Oct 7 14:44:17 2004 +++ movitz/losp/muerte/primitive-functions.lisp Thu Oct 21 22:34:09 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.46 2004/10/07 12:44:17 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.47 2004/10/21 20:34:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -306,7 +306,8 @@ (:movl :ebx (:ecx 8)) ; Store VALUE in binding. (:ret) no-binding - (:movl :ebx (:eax #.(bt:slot-offset 'movitz::movitz-symbol 'movitz::value))) + (#.movitz::*compiler-nonlocal-lispval-write-segment-prefix* + :movl :ebx (:eax (:offset movitz-symbol value))) (:ret))) (define-primitive-function keyword-search () @@ -595,9 +596,9 @@ (ratio (find-class 'ratio)) (std-instance - (movitz-accessor object movitz-std-instance class)) + (memref object (movitz-type-slot-offset 'movitz-std-instance 'class))) (standard-gf-instance - (movitz-accessor object movitz-funobj-standard-gf standard-gf-class)) + (memref object (movitz-type-slot-offset 'movitz-funobj-standard-gf 'standard-gf-class))) (string (find-class 'string)) (bit-vector

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3453 Modified Files: los-closette.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:34:06 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.21 movitz/losp/muerte/los-closette.lisp:1.22 --- movitz/losp/muerte/los-closette.lisp:1.21 Sat Sep 25 17:38:47 2004 +++ movitz/losp/muerte/los-closette.lisp Thu Oct 21 22:34:06 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.21 2004/09/25 15:38:47 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.22 2004/10/21 20:34:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -150,37 +150,40 @@ (defun std-gf-instance-class (instance) (check-type instance standard-gf-instance) - (movitz-accessor instance movitz-funobj-standard-gf standard-gf-class)) + (memref instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'standard-gf-class)) + #+ignore (movitz-accessor instance movitz-funobj-standard-gf standard-gf-class)) (defun std-gf-instance-slots (instance) (check-type instance standard-gf-instance) - (movitz-accessor instance movitz-funobj-standard-gf standard-gf-slots)) + (memref instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'standard-gf-slots))) + +(define-compiler-macro std-gf-num-required-arguments (instance) + `(memref ,instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'num-required-arguments))) (defun std-gf-num-required-arguments (instance) (check-type instance standard-gf-instance) - (movitz-accessor instance movitz-funobj-standard-gf num-required-arguments)) - -(define-compiler-macro std-gf-num-required-arguments (instance) - `(movitz-accessor ,instance movitz-funobj-standard-gf num-required-arguments)) + (memref instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'num-required-arguments))) (defun std-gf-classes-to-emf-table (instance) (check-type instance standard-gf-instance) - (movitz-accessor instance movitz-funobj-standard-gf classes-to-emf-table)) + (memref instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'classes-to-emf-table))) (define-compiler-macro std-gf-classes-to-emf-table (instance) - `(movitz-accessor ,instance movitz-funobj-standard-gf classes-to-emf-table)) + `(memref ,instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'classes-to-emf-table))) (defun (setf std-gf-classes-to-emf-table) (value instance) (check-type instance standard-gf-instance) - (setf-movitz-accessor (instance movitz-funobj-standard-gf classes-to-emf-table) value)) + (setf (memref instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'classes-to-emf-table)) + value)) (defun std-gf-eql-specializer-table (instance) (check-type instance standard-gf-instance) - (movitz-accessor instance movitz-funobj-standard-gf eql-specializer-table)) + (memref instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'eql-specializer-table))) (defun (setf std-gf-eql-specializer-table) (value instance) (check-type instance standard-gf-instance) - (setf-movitz-accessor (instance movitz-funobj-standard-gf eql-specializer-table) value)) + (setf (memref instance (movitz-type-slot-offset 'movitz-funobj-standard-gf 'eql-specializer-table)) + value)) (defun set-funcallable-instance-function (funcallable-instance function) "This function is called to set or to change the function of a funcallable instance. @@ -188,13 +191,17 @@ funcallable-instance will run the new function." (check-type funcallable-instance standard-gf-instance) (check-type function function) - (setf-movitz-accessor (funcallable-instance movitz-funobj-standard-gf standard-gf-function) - function) + (setf (memref funcallable-instance (movitz-type-slot-offset 'movitz-funobj-standard-gf + 'standard-gf-function)) + function) +;;; (setf-movitz-accessor (funcallable-instance movitz-funobj-standard-gf standard-gf-function) +;;; function) (values)) (defun funcallable-instance-function (funcallable-instance) (check-type funcallable-instance standard-gf-instance) - (movitz-accessor funcallable-instance movitz-funobj-standard-gf standard-gf-function)) + (memref funcallable-instance (movitz-type-slot-offset 'movitz-funobj-standard-gf + 'standard-gf-function))) (defun instance-slot-p (slot) (eq (slot-definition-allocation slot) :instance)) @@ -868,12 +875,13 @@ `(defun ,name (instance) (with-inline-assembly (:returns :multiple-values) (:compile-form (:result-mode :eax) instance) - (:movl (:eax ,(bt:slot-offset 'movitz::movitz-std-instance 'movitz::slots)) - :eax) - (:movl (:eax ,(+ (bt:slot-offset 'movitz::movitz-basic-vector 'movitz::data) - (* location 4))) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax (:offset movitz-std-instance slots)) :eax) - (:cmpl :eax ,(movitz::make-indirect-reference :edi (movitz::global-constant-offset 'unbound-value))) + (#.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))) (:je '(:sub-program (unbound) (:compile-form (:result-mode :multiple-values) (slot-unbound-trampoline instance ,location)) (:jmp 'done))) @@ -968,7 +976,7 @@ (defclass sequence (t) () (:metaclass built-in-class)) (defclass array (t) () (:metaclass built-in-class)) (defclass character (t) () (:metaclass built-in-class)) -;; (defclass hash-table (t) () (:metaclass built-in-class)) +;;;(defclass hash-table (t) () (:metaclass built-in-class)) ;;;(defclass package (t) () (:metaclass built-in-class)) ;;;(defclass pathname (t) () (:metaclass built-in-class)) ;;;(defclass readtable (t) () (:metaclass built-in-class))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3436 Modified Files: functions.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:34:04 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.23 movitz/losp/muerte/functions.lisp:1.24 --- movitz/losp/muerte/functions.lisp:1.23 Tue Oct 12 16:43:27 2004 +++ movitz/losp/muerte/functions.lisp Thu Oct 21 22:34:04 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.23 2004/10/12 14:43:27 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.24 2004/10/21 20:34:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -307,31 +307,37 @@ (defun funobj-lambda-list (funobj) (check-type funobj function) - (movitz-accessor funobj movitz-funobj lambda-list)) + (memref funobj (movitz-type-slot-offset 'movitz-funobj 'lambda-list))) (defun (setf funobj-lambda-list) (lambda-list funobj) (check-type funobj function) (check-type lambda-list list) - (setf-movitz-accessor (funobj movitz-funobj lambda-list) lambda-list)) + (setf (memref funobj (movitz-type-slot-offset 'movitz-funobj 'lambda-list)) + lambda-list)) (defun funobj-num-constants (funobj) (check-type funobj function) - (movitz-accessor-u16 funobj movitz-funobj num-constants)) + (memref funobj (movitz-type-slot-offset 'movitz-funobj 'num-constants) + :type :unsigned-byte16)) (defun (setf funobj-num-constants) (num-constants funobj) (check-type funobj function) (check-type num-constants (unsigned-byte 16)) - (set-movitz-accessor-u16 funobj movitz-funobj num-constants num-constants)) + (setf (memref funobj (movitz-type-slot-offset 'movitz-funobj 'num-constants) + :type :unsigned-byte16) + num-constants)) (defun funobj-num-jumpers (funobj) (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))) + (memref funobj (movitz-type-slot-offset 'movitz-funobj 'num-jumpers) + :type :unsigned-byte14)) (defun (setf funobj-num-jumpers) (num-jumpers funobj) (check-type funobj function) - (check-type num-jumpers (unsigned-byte 14)) + (setf (memref funobj (movitz-type-slot-offset 'movitz-funobj 'num-jumpers) + :type :unsigned-byte14) + num-jumpers) + #+ignore (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)))))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3419 Modified Files: defstruct.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:34:02 2004 Author: ffjeld Index: movitz/losp/muerte/defstruct.lisp diff -u movitz/losp/muerte/defstruct.lisp:1.15 movitz/losp/muerte/defstruct.lisp:1.16 --- movitz/losp/muerte/defstruct.lisp:1.15 Mon Oct 11 15:52:27 2004 +++ movitz/losp/muerte/defstruct.lisp Thu Oct 21 22:34:02 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.15 2004/10/11 13:52:27 ffjeld Exp $ +;;;; $Id: defstruct.lisp,v 1.16 2004/10/21 20:34:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -56,12 +56,13 @@ (: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) - (:movl (:eax :ebx (:offset movitz-struct slot0)) + `((:compile-form (:result-mode :ecx) slot-number) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax :ecx (:offset movitz-struct slot0)) :eax)) `((:compile-form (:result-mode :untagged-fixnum-ecx) slot-number) - (:movl (:eax (:ecx 4) (:offset movitz-struct slot0)) - :eax)))))) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax (:ecx 4) (:offset movitz-struct slot0)) :eax)))))) (do-it))) (defun (setf structure-ref) (value object slot-number) @@ -83,7 +84,8 @@ (:jae '(:sub-program (out-of-range) (:int 65))) ;; type test passed, write slot (:compile-form (:result-mode :edx) value) - (:movl :edx (:eax :ebx (:offset movitz-struct slot0)))))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :edx (:eax :ebx (:offset movitz-struct slot0)))))) (do-it))) (defun struct-accessor-prototype (object) @@ -101,8 +103,9 @@ ;;; (:jne '(:sub-program (type-error) (:int 66))) ;; type test passed, read slot (:load-constant slot-number :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:movl (:eax (:ecx 4) #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)) +;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax (:ecx 1) #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)) :eax))) (defun (setf struct-accessor-prototype) (value obj) @@ -120,8 +123,9 @@ ;;; (:jne '(:sub-program (type-error) (:int 66))) ;; type test passed, write slot (:load-constant slot-number :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:movl :eax (:ebx (:ecx 4) #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0))))) +;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :eax (:ebx (:ecx 1) #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0))))) (defun list-struct-accessor-prototype (s) (nth 'slot-number s))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3402 Modified Files: cons.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:33:59 2004 Author: ffjeld Index: movitz/losp/muerte/cons.lisp diff -u movitz/losp/muerte/cons.lisp:1.7 movitz/losp/muerte/cons.lisp:1.8 --- movitz/losp/muerte/cons.lisp:1.7 Fri Aug 6 16:46:06 2004 +++ movitz/losp/muerte/cons.lisp Thu Oct 21 22:33:59 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 15:25:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: cons.lisp,v 1.7 2004/08/06 14:46:06 ffjeld Exp $ +;;;; $Id: cons.lisp,v 1.8 2004/10/21 20:33:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -24,8 +24,10 @@ (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl (:eax -1) :ebx) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax -1) :ebx) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:ret))) (define-primitive-function fast-car () @@ -34,7 +36,8 @@ (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl (:eax -1) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax -1) :eax) (:ret))) (define-primitive-function fast-car-ebx () @@ -46,7 +49,8 @@ (:jnz '(:sub-program () (:movl :ebx :eax) (:int 66))) - (:movl (:ebx -1) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:ebx -1) :eax) (:ret))) (define-primitive-function fast-cdr () @@ -55,7 +59,8 @@ (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:ret))) (define-primitive-function fast-cddr () @@ -64,11 +69,13 @@ (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:ret))) (define-primitive-function fast-cdddr () @@ -77,15 +84,18 @@ (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program (not-cons) (:int 61))) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program (not-cons) (:int 61))) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program (not-cons) (:int 61))) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:ret))) (define-primitive-function fast-cdr-ebx () @@ -97,7 +107,8 @@ (:jnz '(:sub-program () (:movl :ebx :eax) (:int 61))) - (:movl (:ebx 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:ebx 3) :eax) (:ret))) ;; Prefetching versions. Only works on .. PII or so and upwards. @@ -109,8 +120,10 @@ (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl (:eax -1) :ebx) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax -1) :ebx) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:ret))) (define-primitive-function prefetching-fast-car () @@ -120,7 +133,8 @@ (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl (:eax -1) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax -1) :eax) (:ret))) (define-primitive-function prefetching-fast-car-ebx () @@ -133,7 +147,8 @@ (:jnz '(:sub-program () (:movl :ebx :eax) (:int 61))) - (:movl (:ebx -1) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:ebx -1) :eax) (:ret))) (define-primitive-function prefetching-fast-cdr () @@ -143,7 +158,8 @@ (:leal (:eax -1) :ecx) (:testb 3 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl (:eax 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax 3) :eax) (:prefetch-nta (:eax)) (:ret))) @@ -157,7 +173,8 @@ (:jnz '(:sub-program () (:movl :ebx :eax) (:int 61))) - (:movl (:ebx 3) :eax) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:ebx 3) :eax) (:prefetch-nta (:eax)) (:ret))) @@ -170,7 +187,8 @@ (:jnz '(:sub-program () (:movl :ebx :eax) (:int 61))) - (:movl :eax (:ebx -1)))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :eax (:ebx -1)))) (defun (setf cdr) (value cell) (with-inline-assembly (:returns :eax) @@ -181,8 +199,8 @@ (:jnz '(:sub-program () (:movl :ebx :eax) (:int 61))) - (:movl :eax (:ebx 3)))) - + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :eax (:ebx 3)))) (defun car (x) (car x)) (defun cdr (x) (cdr x))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3385 Modified Files: basic-macros.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:33:57 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.42 movitz/losp/muerte/basic-macros.lisp:1.43 --- movitz/losp/muerte/basic-macros.lisp:1.42 Mon Oct 11 15:52:18 2004 +++ movitz/losp/muerte/basic-macros.lisp Thu Oct 21 22:33:57 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.42 2004/10/11 13:52:18 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.43 2004/10/21 20:33:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -362,16 +362,20 @@ ',(mapcar #'first clauses))))) (defmacro movitz-accessor (object-form type slot-name) + (warn "movitz-accesor deprecated.") `(with-inline-assembly (:returns :register :side-effects nil) (:compile-form (:result-mode :eax) ,object-form) - (:movl (:eax ,(bt:slot-offset (find-symbol (string type) :movitz) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax ,(bt:slot-offset (find-symbol (string type) :movitz) (find-symbol (string slot-name) :movitz))) (:result-register)))) (defmacro setf-movitz-accessor ((object-form type slot-name) value-form) + (warn "setf-movitz-accesor deprecated.") `(with-inline-assembly (:returns :eax :side-effects t) (:compile-two-forms (:eax :ebx) ,value-form ,object-form) - (:movl :eax (:ebx ,(bt:slot-offset (find-symbol (string type) :movitz) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :eax (:ebx ,(bt:slot-offset (find-symbol (string type) :movitz) (find-symbol (string slot-name) :movitz)))))) (defmacro movitz-accessor-u16 (object-form type slot-name) @@ -563,9 +567,14 @@ (t (if (member type '(standard-gf-instance function pointer atom integer fixnum positive-fixnum cons symbol character null list string vector simple-vector vector-u8 vector-u16 code-vector)) - `(unless (typep ,place ',type) - (with-inline-assembly (:returns :non-local-exit) - (:int 66))) + `(with-inline-assembly (:returns :nothing :labels (fail)) + (:compile-form (:result-mode (:boolean-branch-on-false . check-type-failed)) + (typep ,place ',type)) + (() () '(:sub-program (check-type-failed) (:int 66)))) + #+ignore + `(unless (typep ,place ',type) + (with-inline-assembly (:returns :non-local-exit) + (:int 66))) form)))) (defmacro assert (test-form &optional places datum-form &rest argument-forms) @@ -623,7 +632,8 @@ (:leal (:eax -1) :ecx) (:testb 7 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl :edi (:eax -1))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :edi (:eax -1))) `(with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) ,value ,cell) (:leal (:ebx -1) :ecx) @@ -631,7 +641,8 @@ (:jnz '(:sub-program () (:movl :ebx :eax) (:int 61))) - (:movl :eax (:ebx -1))))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :eax (:ebx -1))))) (define-compiler-macro (setf cdr) (value cell &environment env) (if (and (movitz:movitz-constantp value env) @@ -641,7 +652,8 @@ (:leal (:eax -1) :ecx) (:testb 7 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl :edi (:eax 3))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :edi (:eax 3))) `(with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) ,value ,cell) (:leal (:ebx -1) :ecx) @@ -649,7 +661,8 @@ (:jnz '(:sub-program () (:movl :ebx :eax) (:int 61))) - (:movl :eax (:ebx 3))))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :eax (:ebx 3))))) (define-compiler-macro rplaca (cons object) `(with-inline-assembly (:returns :eax) @@ -657,7 +670,8 @@ (:leal (:eax -1) :ecx) (:testb 7 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl :ebx (:eax -1)))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :ebx (:eax -1)))) (define-compiler-macro rplacd (cons object) `(with-inline-assembly (:returns :eax) @@ -665,7 +679,8 @@ (:leal (:eax -1) :ecx) (:testb 7 :cl) (:jnz '(:sub-program () (:int 61))) - (:movl :ebx (:eax 3)))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :ebx (:eax 3)))) (define-compiler-macro endp (x) `(let ((cell ,x)) @@ -709,7 +724,7 @@ (:leal (:edx -7) :ecx) (:andb 7 :cl) (:jnz 'not-symbol) - (:movl (:edx ,(bt:slot-offset 'movitz::movitz-symbol 'movitz::function-value)) :esi) + (:movl (:edx (:offset movitz-symbol function-value)) :esi) (:jmp 'funobj-ok) not-symbol (:cmpb 7 :cl) @@ -925,7 +940,8 @@ :ecx) (:testb 7 :cl) (:jnz '(:sub-program () (:int 66))) - (:movl ((:result-register) ,(bt:slot-offset 'movitz::movitz-std-instance slot)) + (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl ((:result-register) ,(bt:slot-offset 'movitz::movitz-std-instance slot)) (:result-register)))))) (defmacro std-instance-writer (slot value instance-form) @@ -937,8 +953,8 @@ :ecx) (:testb 7 :cl) (:jnz '(:sub-program () (:int 66))) - (:movl :eax - (:ebx ,(bt:slot-offset 'movitz::movitz-std-instance slot))))))) + (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :eax (:ebx ,(bt:slot-offset 'movitz::movitz-std-instance slot))))))) (define-compiler-macro std-instance-class (instance) `(std-instance-reader class ,instance))

1 0