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

[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

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.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-serv2604 Modified Files: arrays.lisp Log Message: Minor edits. Date: Thu Oct 21 22:30:08 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.45 movitz/losp/muerte/arrays.lisp:1.46 --- movitz/losp/muerte/arrays.lisp:1.45 Mon Oct 11 15:52:12 2004 +++ movitz/losp/muerte/arrays.lisp Thu Oct 21 22:30:07 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.45 2004/10/11 13:52:12 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.46 2004/10/21 20:30:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -764,8 +764,9 @@ (:addl 4 :ecx) (:andl -8 :ecx) (:jz 'init-done) + (:load-lexical (:lexical-binding initial-element) :edx) init-loop - (:movl :edi (:eax (:offset movitz-basic-vector data) :ecx -4)) + (:movl :edx (:eax (:offset movitz-basic-vector data) :ecx -4)) (:subl 4 :ecx) (:jnz 'init-loop) init-done @@ -779,6 +780,7 @@ (cond (initial-contents (replace array initial-contents)) + #+ignore (initial-element (dotimes (i dimension) (setf (svref%unsafe array i) initial-element))))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv2447 Modified Files: debugger.lisp Log Message: Typo: slot-value should be symbol-value. Date: Thu Oct 21 22:27:00 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.26 movitz/losp/x86-pc/debugger.lisp:1.27 --- movitz/losp/x86-pc/debugger.lisp:1.26 Sat Sep 25 17:53:25 2004 +++ movitz/losp/x86-pc/debugger.lisp Thu Oct 21 22:27:00 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.26 2004/09/25 15:53:25 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.27 2004/10/21 20:27:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -500,7 +500,7 @@ (cond ((eq 0 casf-funobj) (values 'default-interrupt-trampoline - (code-vector-offset (slot-value 'default-interrupt-trampoline) + (code-vector-offset (symbol-value 'default-interrupt-trampoline) eip))) ((not (typep casf-funobj 'function)) ;; Hm.. very suspicius

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.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-serv25516 Modified Files: memref.lisp Log Message: Added :signed-byte8 to memref-int compiler-macro. Date: Thu Oct 21 18:31:36 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.34 movitz/losp/muerte/memref.lisp:1.35 --- movitz/losp/muerte/memref.lisp:1.34 Wed Oct 20 12:51:06 2004 +++ movitz/losp/muerte/memref.lisp Thu Oct 21 18:31:35 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.34 2004/10/20 10:51:06 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.35 2004/10/21 16:31:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -785,6 +785,23 @@ (:addl :ebx :ecx) (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address (,prefixes :movzxb (:ecx) :ecx))))))) + (:signed-byte8 + (cond + ((and (eq 0 offset) (eq 0 index)) + `(with-inline-assembly (:returns :ecx :type (signed-byte 8)) + (:compile-form (:result-mode :untagged-fixnum-ecx) ,address) + (,prefixes :movsxb (:ecx) :ecx) + (:shll ,movitz:+movitz-fixnum-shift+ :ecx))) + (t (let ((address-var (gensym "memref-int-address-"))) + `(let ((,address-var ,address)) + (with-inline-assembly (:returns :ecx :type (signed-byte 8)) + (:compile-two-forms (:eax :ecx) ,offset ,index) + (:load-lexical (:lexical-binding ,address-var) :ebx) + (:addl :eax :ecx) + (:addl :ebx :ecx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address + (,prefixes :movsxb (:ecx) :ecx) + (:shll ,movitz:+movitz-fixnum-shift+ :ecx))))))) (:unsigned-byte16 (cond ((and (eq 0 offset) (eq 0 index))

1 0

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

20 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6012 Modified Files: memref.lisp Log Message: Improved (memref :code-vector), and bug-fixed (memref-int :unsigned-byte8) which in fact behaved as :unsigned-byte16. Date: Wed Oct 20 12:51:07 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.33 movitz/losp/muerte/memref.lisp:1.34 --- movitz/losp/muerte/memref.lisp:1.33 Tue Oct 12 16:52:07 2004 +++ movitz/losp/muerte/memref.lisp Wed Oct 20 12:51:06 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.33 2004/10/12 14:52:07 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.34 2004/10/20 10:51:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -316,6 +316,20 @@ (:compile-two-forms (:ebx :untagged-fixnum-ecx) ,object ,offset) (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax) (:addl (:ebx :ecx ,(offset-by 4)) :eax))) + (t (let ((object-var (gensym "memref-object-")) + (offset-var (gensym "memref-offset-")) + (index-var (gensym "memref-index-"))) + `(let ((,object-var ,object) + (,offset-var ,offset) + (,index-var ,index)) + (with-inline-assembly (:returns :eax) + (:load-lexical (:lexical-binding ,offset-var) :untagged-fixnum-ecx) + (:load-lexical (:lexical-binding ,object-var) :ebx) + (:load-lexical (:lexical-binding ,index-var) :edx) + (:addl :edx :ecx) + (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax) + (:addl (:ebx :ecx ,(offset-by 4)) :eax))))) + #+ignore (t (error "variable memref type :code-vector not implemented.")) #+ignore (t (assert (not (movitz:movitz-constantp offset env))) @@ -341,12 +355,13 @@ (:character (memref object offset :index index :type :character)) (:unsigned-byte8 (memref object offset :index index :type :unsigned-byte8)) (:location (memref object offset :index index :type :location)) - (:unsigned-byte14 (memref object offset :index index :type :unsigned-byte14)) (:unsigned-byte16 (ecase endian ((:host :little) (memref object offset :index index :type :unsigned-byte16 :endian :little)) ((:big) - (memref object offset :index index :type :unsigned-byte16 :endian :big)))))) + (memref object offset :index index :type :unsigned-byte16 :endian :big)))) + (:code-vector (memref object offset :index index :type :code-vector)) + (:unsigned-byte14 (memref object offset :index index :type :unsigned-byte14)))) ;;; (:signed-byte30+2 (memref object offset index :signed-byte30+2)) ;;; (:unsigned-byte29+3 (memref object offset index :unsigned-byte29+3)))) @@ -756,18 +771,20 @@ (:unsigned-byte8 (cond ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :untagged-fixnum-ecx) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 8)) (:compile-form (:result-mode :untagged-fixnum-ecx) ,address) - (,prefixes :movzxw (:ecx) :ecx))) + (,prefixes :movzxb (:ecx) :ecx))) (t (let ((address-var (gensym "memref-int-address-"))) `(let ((,address-var ,address)) - (with-inline-assembly (:returns :untagged-fixnum-ecx) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 8)) (:compile-two-forms (:eax :ecx) ,offset ,index) (:load-lexical (:lexical-binding ,address-var) :ebx) (:addl :eax :ecx) (:addl :ebx :ecx) (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address - (,prefixes :movzxw (:ecx) :ecx))))))) + (,prefixes :movzxb (:ecx) :ecx))))))) (:unsigned-byte16 (cond ((and (eq 0 offset) (eq 0 index))

1 0

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

12 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27208 Modified Files: memref.lisp Log Message: Have memref provide the correct type in more cases. I.e. an :unsigned-byte16 memref becomes a (unsigned-byte 16) type etc. Date: Tue Oct 12 16:52:07 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.32 movitz/losp/muerte/memref.lisp:1.33 --- movitz/losp/muerte/memref.lisp:1.32 Mon Oct 11 15:53:01 2004 +++ movitz/losp/muerte/memref.lisp Tue Oct 12 16:52:07 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.32 2004/10/11 13:53:01 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.33 2004/10/12 14:52:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -98,7 +98,8 @@ (:big `((:xchgb :cl :ch)))))) (cond ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :untagged-fixnum-ecx) + `(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)) @@ -118,7 +119,8 @@ `(let ((,object-var ,object) (,offset-var ,offset) (,index-var ,index)) - (with-inline-assembly (:returns :untagged-fixnum-ecx) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 16)) (:compile-two-forms (:ecx :ebx) ,offset-var ,index-var) (:leal (:ecx (:ebx 2)) :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) @@ -217,18 +219,18 @@ (assert (= 4 movitz::+movitz-fixnum-factor+)) (cond ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :ecx) + `(with-inline-assembly (:returns :ecx :type (unsigned-byte 29)) (:compile-form (:result-mode :eax) ,object) (:movl (:eax ,(offset-by 4)) :ecx) (:andl -4 :ecx))) ((eq 0 offset) - `(with-inline-assembly (:returns :ecx) + `(with-inline-assembly (:returns :ecx :type (unsigned-byte 29)) (:compile-two-forms (:eax :ecx) ,object ,index) (:movl (:eax :ecx ,(offset-by 4)) :ecx) (:andl -4 :ecx))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) - (with-inline-assembly (:returns :ecx) + (with-inline-assembly (:returns :ecx :type (unsigned-byte 29)) (:compile-two-forms (:ecx :ebx) ,offset ,index) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) @@ -241,16 +243,19 @@ (assert (= 4 movitz::+movitz-fixnum-factor+)) (cond ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :untagged-fixnum-ecx) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) (:compile-form (:result-mode :eax) ,object) (:movl (:eax ,(offset-by 4)) :ecx))) ((eq 0 offset) - `(with-inline-assembly (:returns :untagged-fixnum-ecx) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) (:compile-two-forms (:eax :ecx) ,object ,index) (:movl (:eax :ecx ,(offset-by 4)) :ecx))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) - (with-inline-assembly (:returns :untagged-fixnum-ecx) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) (:compile-two-forms (:ecx :ebx) ,offset ,index) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:load-lexical (:lexical-binding ,object-var) :eax)

1 0