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

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

21 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26318 Modified Files: arrays.lisp Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:41:58 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.19 movitz/losp/muerte/arrays.lisp:1.20 --- movitz/losp/muerte/arrays.lisp:1.19 Thu May 20 13:41:46 2004 +++ movitz/losp/muerte/arrays.lisp Fri May 21 05:41:58 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.19 2004/05/20 17:41:46 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.20 2004/05/21 09:41:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -186,69 +186,72 @@ (defun aref (vector &rest subscripts) (numargs-case (2 (vector index) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) vector) - (:compile-form (:result-mode :ebx) index) - (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx) - (:testb #.movitz::+movitz-fixnum-zmask+ :bl) - (:jnz '(:sub-program (not-fixnum) (:int 107))) ; index not fixnum - (:andl #.(cl:ash #x000ffff movitz::+movitz-fixnum-shift+) :ebx) - - (:testb 7 :cl) - (:jnz '(:sub-program () - (:compile-form (:result-mode :ignore) - (error "Not a vector: ~S" vector)))) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) vector) + (:compile-form (:result-mode :ebx) index) + (:leal (:eax ,(- (movitz:tag :other))) :ecx) + (:testb ,movitz::+movitz-fixnum-zmask+ :bl) + (:jnz '(:sub-program (not-fixnum) (:int 107))) ; index not fixnum + (:andl ,(ash #x000ffff movitz:+movitz-fixnum-shift+) :ebx) + + (:testb 7 :cl) + (:jnz '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Not a vector: ~S" vector)))) - (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) - (:movzxw (:eax -2) :ecx) - - (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :bx) - (:jae '(:sub-program () - (:compile-form (:result-mode :ignore) - (error "Index ~D out of bounds ~D." index (length vector))))) + (:shrl ,movitz:+movitz-fixnum-shift+ :ebx) + (:movzxw (:eax ,movitz:+other-type-offset+) :ecx) - (:cmpl #.(movitz:vector-type-tag :any-t) :ecx) - (:jne 'not-any-t) - (:movl (:eax (:ebx 4) 2) :eax) - (:jmp 'done) - - not-any-t - (:cmpl #.(movitz:vector-type-tag :character) :ecx) - (:jne 'not-character) - (:movb (:eax :ebx 2) :bl) - (:xorl :eax :eax) - (:movb :bl :ah) - (:movb #.(movitz::tag :character) :al) ; character - (:jmp 'done) + (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :bx) + (:jae '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Index ~D out of bounds ~D." index (length vector))))) + + (:cmpl #.(movitz:vector-type-tag :any-t) :ecx) + (:jne 'not-any-t) + (:movl (:eax (:ebx 4) 2) :eax) + (:jmp 'done) + + not-any-t + (:cmpl #.(movitz:vector-type-tag :character) :ecx) + (:jne 'not-character) + (:movb (:eax :ebx 2) :bl) + (:xorl :eax :eax) + (:movb :bl :ah) + (:movb #.(movitz::tag :character) :al) ; character + (:jmp 'done) - not-character - (:cmpl #.(movitz:vector-type-tag :u8) :ecx) - (:jne 'not-u8) - (:movzxb (:eax :ebx 2) :eax) ; u8 - (:shll #.movitz::+movitz-fixnum-shift+ :eax) - (:jmp 'done) + not-character + (:cmpl #.(movitz:vector-type-tag :u8) :ecx) + (:jne 'not-u8) + (:movzxb (:eax :ebx 2) :eax) ; u8 + (:shll #.movitz::+movitz-fixnum-shift+ :eax) + (:jmp 'done) - not-u8 - (:cmpl #.(movitz:vector-type-tag :u16) :ecx) - (:jne 'not-u16) - (:movzxw (:eax (:ebx 2) 2) :eax) ; u16 - (:jmp 'done) - - not-u16 - (:cmpl #.(movitz:vector-type-tag :u32) :ecx) - (:jne 'not-u32) - (:movl (:eax (:ebx 4) 2) :ecx) ; u32 - (:cmpl #.movitz::+movitz-most-positive-fixnum+ :ecx) - (:jg '(:sub-program (:overflowing-u32) - (:int 107))) - (:leal ((:ecx #.movitz::+movitz-fixnum-factor+)) :eax) - (:jmp 'done) - - not-u32 - (:compile-form (:result-mode :ignore) - (error "Not a vector: ~S" vector)) + not-u8 + (:cmpl #.(movitz:vector-type-tag :u16) :ecx) + (:jne 'not-u16) + (:movzxw (:eax (:ebx 2) 2) :eax) ; u16 + (:jmp 'done) + + not-u16 + (:cmpl ,(movitz:vector-type-tag :u32) :ecx) + (:jne 'not-u32) + (:movl (:eax (:ebx 4) 2) :ecx) ; u32 + (:cmpl ,movitz:+movitz-most-positive-fixnum+ :ecx) + (:jg '(:sub-program (:overflowing-u32) + (:int 107))) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) + (:jmp 'done) + + not-u32 + (:compile-form (:result-mode :ignore) + (error "Not a vector: ~S" vector)) - done)) + done))) + (do-it))) (t (vector &rest subscripts) (declare (ignore vector subscripts)) (error "Multi-dimensional arrays not implemented.")))) @@ -256,82 +259,85 @@ (defun (setf aref) (value vector &rest subscripts) (numargs-case (3 (value vector index) - (with-inline-assembly (:returns :ebx) - (:compile-form (:result-mode :ebx) value) - (:compile-form (:result-mode :eax) vector) - - (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx) - (:testb 7 :cl) - (:jnz '(:sub-program () - (:compile-form (:result-mode :ignore) - (error "Not a vector: ~S" vector)))) - (:movzxw (:eax -2) :edx) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :ebx) + (:compile-form (:result-mode :ebx) value) + (:compile-form (:result-mode :eax) vector) + + (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx) + (:testb 7 :cl) + (:jnz '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Not a vector: ~S" vector)))) + (:movzxw (:eax ,movitz:+other-type-offset+) :edx) - (:compile-form (:result-mode :ecx) index) - (:testb #.movitz::+movitz-fixnum-zmask+ :cl) - (:jnz '(:sub-program () (:int 107))) ; index not fixnum - (:andl #.(cl:ash #xffff movitz::+movitz-fixnum-shift+) :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - - (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :cx) - (:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds - - (:cmpl #.(movitz:vector-type-tag :any-t) :edx) - (:jnz 'not-any-t) - - (:movl :ebx (:eax (:ecx 4) 2)) - (:jmp 'done) - - not-any-t - (:cmpl #.(movitz:vector-type-tag :character) :edx) - (:jnz 'not-character) - (:cmpb #.(movitz:tag :character) :bl) - (:jnz '(:sub-program (not-character-value) - (:compile-form (:result-mode :ignore) - (error "Value not character: ~S" value)))) - (:movb :bh (:eax :ecx 2)) - (:jmp 'done) + (:compile-form (:result-mode :ecx) index) + (:testb #.movitz::+movitz-fixnum-zmask+ :cl) + (:jnz '(:sub-program () (:int 107))) ; index not fixnum + (:andl #.(cl:ash #xffff movitz::+movitz-fixnum-shift+) :ecx) + (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) + + (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :cx) + (:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds + + (:cmpl #.(movitz:vector-type-tag :any-t) :edx) + (:jnz 'not-any-t) + + (:movl :ebx (:eax (:ecx 4) 2)) + (:jmp 'done) + + not-any-t + (:cmpl #.(movitz:vector-type-tag :character) :edx) + (:jnz 'not-character) + (:cmpb #.(movitz:tag :character) :bl) + (:jnz '(:sub-program (not-character-value) + (:compile-form (:result-mode :ignore) + (error "Value not character: ~S" value)))) + (:movb :bh (:eax :ecx 2)) + (:jmp 'done) - not-character - (:cmpl #.(movitz:vector-type-tag :u8) :edx) - (:jnz 'not-u8) - (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xff movitz:+movitz-fixnum-factor+))) :ebx) - (:jnz '(:sub-program (not-u8-value) - (:compile-form (:result-mode :ignore) - (error "Value not (unsigned-byte 8): ~S" value)))) - (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) - (:movb :bl (:eax (:ecx 1) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) - (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) - (:jmp 'done) + not-character + (:cmpl #.(movitz:vector-type-tag :u8) :edx) + (:jnz 'not-u8) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u8-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 8): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movb :bl (:eax (:ecx 1) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) - not-u8 - (:cmpl #.(movitz:vector-type-tag :u16) :edx) - (:jnz 'not-u16) - (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffff movitz:+movitz-fixnum-factor+))) :ebx) - (:jnz '(:sub-program (not-u16-value) - (:compile-form (:result-mode :ignore) - (error "Value not (unsigned-byte 16): ~S" value)))) - (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) - (:movw :bx (:eax (:ecx 2) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) - (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) - (:jmp 'done) - - not-u16 - (:cmpl #.(movitz:vector-type-tag :u32) :edx) - (:jnz 'not-u32) - (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffffffff movitz:+movitz-fixnum-factor+))) :ebx) - (:jnz '(:sub-program (not-u32-value) - (:compile-form (:result-mode :ignore) - (error "Value not (unsigned-byte 32): ~S" value)))) - (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) - (:movl :ebx (:eax (:ecx 4) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) - (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) - (:jmp 'done) - - not-u32 - (:compile-form (:result-mode :ignore) (error "Not a vector: ~S" vector)) - done)) + not-u8 + (:cmpl #.(movitz:vector-type-tag :u16) :edx) + (:jnz 'not-u16) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u16-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 16): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movw :bx (:eax (:ecx 2) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) + + not-u16 + (:cmpl #.(movitz:vector-type-tag :u32) :edx) + (:jnz 'not-u32) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffffffff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u32-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 32): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movl :ebx (:eax (:ecx 4) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) + + not-u32 + (:compile-form (:result-mode :ignore) (error "Not a vector: ~S" vector)) + done))) + (do-it))) (t (value vector &rest subscripts) (declare (ignore value vector subscripts)) (error "Multi-dimensional arrays not implemented."))))

1 0

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

21 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25760 Modified Files: defstruct.lisp Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:41:39 2004 Author: ffjeld Index: movitz/losp/muerte/defstruct.lisp diff -u movitz/losp/muerte/defstruct.lisp:1.7 movitz/losp/muerte/defstruct.lisp:1.8 --- movitz/losp/muerte/defstruct.lisp:1.7 Mon Apr 19 18:38:16 2004 +++ movitz/losp/muerte/defstruct.lisp Fri May 21 05:41:39 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.7 2004/04/19 22:38:16 ffjeld Exp $ +;;;; $Id: defstruct.lisp,v 1.8 2004/05/21 09:41:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -44,52 +44,54 @@ (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:jnz 'fail) - (:cmpb #.(movitz:tag :defstruct) (-2 :eax)) + (:cmpb #.(movitz:tag :defstruct) (:eax #.movitz:+other-type-offset+)) (:jne 'fail) (:load-constant struct-name :ebx) (:cmpl :ebx (:eax #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name))) fail)) (defun structure-ref (object slot-number) - (macrolet ((do-it () - `(with-inline-assembly (:returns :eax) - ;; type test - (:compile-form (:result-mode :eax) object) - (:leal (:eax ,(- (movitz:tag :other))) :ecx) - (:testb 7 :cl) - (:jne '(:sub-program (type-error) (:int 66))) - (:cmpb ,(movitz:tag :defstruct) (-2 :eax)) - (: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 #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)) - :eax)) - `((:compile-form (:result-mode :untagged-fixnum-ecx) slot-number) - (:movl (:eax (:ecx 4) #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)) - :eax)))))) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + ;; type test + (:compile-form (:result-mode :eax) object) + (:leal (:eax ,(- (movitz:tag :other))) :ecx) + (:testb 7 :cl) + (:jne '(:sub-program (type-error) (:int 66))) + (:cmpb ,(movitz:tag :defstruct) (:eax ,movitz:+other-type-offset+)) + (: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 #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)) + :eax)) + `((:compile-form (:result-mode :untagged-fixnum-ecx) slot-number) + (:movl (:eax (:ecx 4) #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)) + :eax)))))) (do-it))) (defun (setf structure-ref) (value object slot-number) - (macrolet ((do-it () - (assert (= 4 movitz::+movitz-fixnum-factor+)) - `(with-inline-assembly (:returns :eax) - ;; type test - (:compile-two-forms (:eax :ebx) object slot-number) - (:leal (:eax ,(- (movitz:tag :other))) :ecx) - (:testb 7 :cl) - (:jne '(:sub-program (type-error) (:int 66))) - (:cmpb ,(movitz:tag :defstruct) (-2 :eax)) - (:jne '(:sub-program (type-error) (:int 66))) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-struct 'movitz::length)) :ecx) - (:leal ((:ecx ,movitz::+movitz-fixnum-factor+)) :ecx) - (:testb ,movitz::+movitz-fixnum-zmask+ :bl) - (:jnz '(:sub-program (not-fixnum) (:int 107))) - (:cmpl :ecx :ebx) - (:jae '(:sub-program (out-of-range) (:int 61))) - ;; type test passed, read slot - (:compile-form (:result-mode :ecx) value) - (:movl :ecx (:eax :ebx #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)))))) + (macrolet + ((do-it () + (assert (= 4 movitz::+movitz-fixnum-factor+)) + `(with-inline-assembly (:returns :eax) + ;; type test + (:compile-two-forms (:eax :ebx) object slot-number) + (:leal (:eax ,(- (movitz:tag :other))) :ecx) + (:testb 7 :cl) + (:jne '(:sub-program (type-error) (:int 66))) + (:cmpb ,(movitz:tag :defstruct) (:eax ,movitz:+other-type-offset+)) + (:jne '(:sub-program (type-error) (:int 66))) + (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-struct 'movitz::length)) :ecx) + (:leal ((:ecx ,movitz::+movitz-fixnum-factor+)) :ecx) + (:testb ,movitz::+movitz-fixnum-zmask+ :bl) + (:jnz '(:sub-program (not-fixnum) (:int 107))) + (:cmpl :ecx :ebx) + (:jae '(:sub-program (out-of-range) (:int 61))) + ;; type test passed, read slot + (:compile-form (:result-mode :ecx) value) + (:movl :ecx (:eax :ebx #.(bt:slot-offset 'movitz::movitz-struct 'movitz::slot0)))))) (do-it))) (defun struct-accessor-prototype (object) @@ -100,7 +102,7 @@ (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:jne '(:sub-program (type-error) (:int 66))) - (:cmpb #.(movitz:tag :defstruct) (-2 :eax)) + (:cmpb #.(movitz:tag :defstruct) (:eax #.movitz:+other-type-offset+)) (:jne '(:sub-program (type-error) (:int 66))) (:load-constant struct-name :ebx) (:cmpl :ebx (:eax #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name))) @@ -119,7 +121,7 @@ (:leal (:ebx #.(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:jnz '(:sub-program (type-error) (:int 66))) - (:cmpb #.(movitz:tag :defstruct) (-2 :ebx)) + (:cmpb #.(movitz:tag :defstruct) (:ebx #.movitz:+other-type-offset+)) (:jne '(:sub-program (type-error) (:int 66))) (:load-constant struct-name :ecx) (:cmpl :ecx (:ebx #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name)))

1 0

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

21 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23841 Modified Files: primitive-functions.lisp Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:41:12 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.16 movitz/losp/muerte/primitive-functions.lisp:1.17 --- movitz/losp/muerte/primitive-functions.lisp:1.16 Wed Apr 21 11:08:36 2004 +++ movitz/losp/muerte/primitive-functions.lisp Fri May 21 05:41: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.16 2004/04/21 15:08:36 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.17 2004/05/21 09:41:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -576,7 +576,7 @@ (define-primitive-function fast-class-of-other () "Return the class of an other object." (with-inline-assembly (:returns :multiple-values) - (:movl (:eax -2) :ecx) + (:movl (:eax #.movitz:+other-type-offset+) :ecx) (:cmpb #.(movitz::tag :std-instance) :cl) (:jne 'not-std-instance) (:movl (:eax #.(bt:slot-offset 'movitz::movitz-std-instance 'movitz::class)) :eax)

1 0

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

21 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20961 Modified Files: basic-macros.lisp Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:40:48 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.18 movitz/losp/muerte/basic-macros.lisp:1.19 --- movitz/losp/muerte/basic-macros.lisp:1.18 Thu May 20 13:43:46 2004 +++ movitz/losp/muerte/basic-macros.lisp Fri May 21 05:40:48 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.18 2004/05/20 17:43:46 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.19 2004/05/21 09:40:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -522,9 +522,10 @@ (:globally (:call (:edi (:edi-offset malloc)))) (:addl ,(if (integerp tag) tag (movitz::tag tag)) :eax) ,@(when (and (eq tag :other) other-tag (not wide-other-tag)) - `((:movb ,(movitz::tag other-tag) (:eax -2)))) + `((:movb ,(movitz::tag other-tag) (:eax ,movitz:+other-type-offset+)))) ,@(when (and (eq tag :other) other-tag wide-other-tag) - `((:movw ,(dpb wide-other-tag (byte 8 8) (movitz::tag other-tag)) (:eax -2)))))) + `((:movw ,(dpb wide-other-tag (byte 8 8) (movitz:tag other-tag)) + (:eax ,movitz:+other-type-offset+)))))) (defmacro check-type (place type &optional type-string) (if (not (stringp type-string)) @@ -693,7 +694,7 @@ (:cmpb 7 :cl) (:jne '(:sub-program (not-funobj) (:int 69))) - (:cmpb ,(movitz::tag :funobj) (:edx -2)) + (:cmpb ,(movitz:tag :funobj) (:edx ,movitz:+other-type-offset+)) (:jne 'not-funobj) (:movl :edx :esi) funobj-ok @@ -743,7 +744,7 @@ (:testb 7 :cl) (:jne '(:sub-program (not-funobj) (:int 69))) - (:cmpb ,(movitz::tag :funobj) (:edx -2)) + (:cmpb ,(movitz::tag :funobj) (:edx ,movitz:+other-type-offset+)) (:jne 'not-funobj) (:movl :edx :esi) funobj-ok @@ -765,7 +766,7 @@ (:cmpb 7 :cl) (:jnz '(:sub-program (not-funobj) (:int 69))) - (:cmpb ,(movitz::tag :funobj) (:edx -2)) + (:cmpb ,(movitz::tag :funobj) (:edx ,movitz:+other-type-offset+)) (:jne 'not-funobj) (:movl :edx :esi) funobj-ok @@ -787,7 +788,7 @@ (:cmpb 7 :cl) (:jnz '(:sub-program (not-funobj) (:int 69))) - (:cmpb ,(movitz::tag :funobj) (:edx -2)) + (:cmpb ,(movitz::tag :funobj) (:edx ,movitz:+other-type-offset+)) (:jne 'not-funobj) (:movl :edx :esi) funobj-ok

1 0

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

21 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19808 Modified Files: scavenge.lisp Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:40:20 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.6 movitz/losp/muerte/scavenge.lisp:1.7 --- movitz/losp/muerte/scavenge.lisp:1.6 Tue Apr 6 20:34:52 2004 +++ movitz/losp/muerte/scavenge.lisp Fri May 21 05:40:19 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.6 2004/04/07 00:34:52 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.7 2004/05/21 09:40:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -54,10 +54,11 @@ (error "Illegal word ~Z at ~S." x scan)) ((scavenge-typep x :funobj) ;; Process code-vector pointer specially.. - (let ((code-vector (%word-offset (memref scan 0 -1 :lisp) -2)) - (num-jumpers (ldb (byte 14 0) (memref scan 0 6 :lisp)))) + (let* ((funobj (%word-offset scan #.(movitz:tag :other))) + (code-vector (funobj-code-vector funobj)) + (num-jumpers (funobj-num-jumpers funobj))) (check-type code-vector vector-u8) - (map-heap-words function (+ scan 4) (+ scan 6)) ; scan funobj's lambda-list and name fields + (map-heap-words function (+ scan 5) (+ scan 7)) ; scan funobj's lambda-list and name (let ((new-code-vector (funcall function code-vector scan))) (check-type new-code-vector vector-u8) (unless (eq code-vector new-code-vector) @@ -65,21 +66,21 @@ (setf (memref scan 0 -1 :lisp) (%word-offset new-code-vector 2)) ;; Do more stuff here to update code-vectors and jumpers )) - (incf scan (+ 6 num-jumpers)))) ; Don't scan the jumpers. + (incf scan (+ 7 num-jumpers)))) ; Don't scan the jumpers. ((scavenge-typep x :infant-object) (error "Scanning an infant object ~Z at ~S." x scan)) ((or (scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u8)) (scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :character))) - (let ((len (memref scan -2 0 :unsigned-byte16))) - (incf scan (* 2 (truncate (+ 7 len) 8))))) + (let ((len (memref scan 2 0 :unsigned-byte16))) + (incf scan (1+ (* 2 (truncate (+ 7 len) 8)))))) ((scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u16)) - (let ((len (memref scan -2 0 :unsigned-byte16))) - (incf scan (* 2 (truncate (+ 3 len) 4))))) + (let ((len (memref scan 2 0 :unsigned-byte16))) + (incf scan (1+ (* 2 (truncate (+ 3 len) 4)))))) ((scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u32)) - (let ((len (memref scan -2 0 :unsigned-byte16))) - (incf scan (* 2 (truncate (+ 1 len) 2))))) + (let ((len (memref scan 2 0 :unsigned-byte16))) + (incf scan (1+ (* 2 (truncate (+ 1 len) 2)))))) ((eq x (fixnum-word 3)) (incf scan) (incf scan (memref scan 0 0 :lisp)))

1 0

[movitz-cvs] CVS update: movitz/bochsrc.txt
by Frode Vatvedt Fjeld 21 May '04

21 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15841 Modified Files: bochsrc.txt Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:40:09 2004 Author: ffjeld Index: movitz/bochsrc.txt diff -u movitz/bochsrc.txt:1.1.1.1 movitz/bochsrc.txt:1.2 --- movitz/bochsrc.txt:1.1.1.1 Tue Jan 13 06:04:59 2004 +++ movitz/bochsrc.txt Fri May 21 05:40:09 2004 @@ -36,5 +36,5 @@ error: action=report # debug: action=report -ips: 3000000 +ips: 2000000 # com1: dev=/dev/ptypv

1 0

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

21 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6114 Modified Files: packages.lisp Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:39:42 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.21 movitz/packages.lisp:1.22 --- movitz/packages.lisp:1.21 Wed Apr 21 12:00:25 2004 +++ movitz/packages.lisp Fri May 21 05:39:40 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.21 2004/04/21 16:00:25 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.22 2004/05/21 09:39:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1284,6 +1284,7 @@ #:dump-image #:other-type-byte + #:+other-type-offset+ #:parse-docstring-and-declarations #:global-constant-offset #:tag #:tag-name

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 21 May '04

21 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3712 Modified Files: storage-types.lisp Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:39:30 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.16 movitz/storage-types.lisp:1.17 --- movitz/storage-types.lisp:1.16 Wed Apr 21 12:22:56 2004 +++ movitz/storage-types.lisp Fri May 21 05:39:30 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.16 2004/04/21 16:22:56 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.17 2004/05/21 09:39:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -84,7 +84,6 @@ (defconstant +fixnum-tags+ '(:even-fixnum :odd-fixnum)) (defparameter +scan-skip-word+ #x00000003) - (defun tag (type) (bt:enum-value 'other-type-byte type)) @@ -165,12 +164,14 @@ ;;; Fixnums (eval-when (:compile-toplevel :execute :load-toplevel) -(defconstant +movitz-fixnum-bits+ 30) -(defconstant +movitz-fixnum-shift+ (- 32 +movitz-fixnum-bits+)) -(defconstant +movitz-fixnum-factor+ (expt 2 +movitz-fixnum-shift+)) -(defconstant +movitz-fixnum-zmask+ (1- +movitz-fixnum-factor+)) -(defconstant +movitz-most-positive-fixnum+ (1- (expt 2 (1- +movitz-fixnum-bits+)))) -(defconstant +movitz-most-negative-fixnum+ (- (expt 2 (1- +movitz-fixnum-bits+))))) + (defconstant +movitz-fixnum-bits+ 30) + (defconstant +movitz-fixnum-shift+ (- 32 +movitz-fixnum-bits+)) + (defconstant +movitz-fixnum-factor+ (expt 2 +movitz-fixnum-shift+)) + (defconstant +movitz-fixnum-zmask+ (1- +movitz-fixnum-factor+)) + (defconstant +movitz-most-positive-fixnum+ (1- (expt 2 (1- +movitz-fixnum-bits+)))) + (defconstant +movitz-most-negative-fixnum+ (- (expt 2 (1- +movitz-fixnum-bits+)))) + + (defparameter +other-type-offset+ -6)) (defun fixnum-integer (word) "For a Movitz word, that must be a fixnum, return the corresponding @@ -325,24 +326,7 @@ ;;; movitz-vectors (define-binary-class movitz-vector (movitz-heap-object-other) - ((flags - :accessor movitz-vector-flags - :initarg :flags - :initform nil - :binary-type (define-bitfield movitz-vector-flags (u8) - (((:bits) :fill-pointer-p 2 - :code-vector-p 3 - :std-instance-slots-p 4)))) - (alignment-power - :binary-lisp-type u8 ; align to 2^(high-nibble+3) + low-nibble - :initform 0 - :initarg :alignment-power - :reader movitz-vector-alignment-power) - (num-elements - :binary-type lu16 - :initarg :num-elements - :reader movitz-vector-num-elements) - (type + ((type :binary-type other-type-byte :reader movitz-vector-type :initform :vector) @@ -360,43 +344,60 @@ :binary-type lu16 :initarg :fill-pointer :accessor movitz-vector-fill-pointer) + (flags + :accessor movitz-vector-flags + :initarg :flags + :initform nil + :binary-type (define-bitfield movitz-vector-flags (u8) + (((:bits) :fill-pointer-p 2 + :code-vector-p 3 + :std-instance-slots-p 4)))) + (alignment-power + :binary-lisp-type u8 ; align to 2^(high-nibble+3) + low-nibble + :initform 0 + :initarg :alignment-power + :reader movitz-vector-alignment-power) + (num-elements + :binary-type lu16 + :initarg :num-elements + :reader movitz-vector-num-elements) (data :binary-lisp-type :label) ; data follows physically here (symbolic-data :initarg :symbolic-data :accessor movitz-vector-symbolic-data)) - (:slot-align type -2)) + (:slot-align type #.+other-type-offset+)) (defun vector-type-tag (element-type) (dpb (enum-value 'movitz-vector-element-type element-type) (byte 8 8) (enum-value 'other-type-byte :vector))) -(define-binary-class movitz-new-vector (movitz-heap-object-other) - ((length - :binary-type u32 - :initarg :length - :accessor movitz-simple-vector-length) - (type - :binary-type other-type-byte - :reader movitz-vector-type) - #+ignore - (element-type - :binary-type (define-enum movitz-vector-element-type (u8) - :any-t 0 - :character 1 - :u8 2 - :u16 3 - :u32 4 - :bit 5) - :initarg :element-type - :reader movitz-vector-element-type) - (data - :binary-lisp-type :label) - (symbolic-data - :initarg :symbolic-data - :accessor movitz-vector-symbolic-data)) - (:slot-align type -2)) +;;;(define-binary-class movitz-new-vector (movitz-heap-object-other) +;;; ((length +;;; :binary-type u32 +;;; :initarg :length +;;; :accessor movitz-simple-vector-length) +;;; (type +;;; :binary-type other-type-byte +;;; :reader movitz-vector-type) +;;; #+ignore +;;; (element-type +;;; :binary-type (define-enum movitz-vector-element-type (u8) +;;; :any-t 0 +;;; :character 1 +;;; :u8 2 +;;; :u16 3 +;;; :u32 4 +;;; :bit 5) +;;; :initarg :element-type +;;; :reader movitz-vector-element-type) +;;; (data +;;; :binary-lisp-type :label) +;;; (symbolic-data +;;; :initarg :symbolic-data +;;; :accessor movitz-vector-symbolic-data)) +;;; (:slot-align type #.+other-type-offset+)) (defun movitz-type-word-size (type) (truncate (sizeof (intern (symbol-name type) :movitz)) 4)) @@ -745,14 +746,7 @@ ;;; Compiled funobj (define-binary-class movitz-funobj (movitz-heap-object-other) - ((code-vector - :binary-type code-vector-word - :initform 'muerte::no-code-vector - :initarg :code-vector - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :accessor movitz-funobj-code-vector) - (type + ((type :binary-type other-type-byte :initform :funobj) (funobj-type @@ -767,6 +761,13 @@ ;; Bit 5: The code-vector's uses-stack-frame-p. :binary-type 'lu16 :initform 0) + (code-vector + :binary-type code-vector-word + :initform 'muerte::no-code-vector + :initarg :code-vector + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :accessor movitz-funobj-code-vector) (code-vector%1op :binary-type code-pointer :initform 'muerte::trampoline-funcall%1op @@ -858,7 +859,7 @@ :initform :default :initarg :entry-protocol :reader funobj-entry-protocol)) - (:slot-align type -2)) + (:slot-align type #.+other-type-offset+)) (defmethod write-binary-record ((obj movitz-funobj) stream) (declare (special *record-all-funobjs*)) @@ -908,12 +909,7 @@ (define-binary-class movitz-funobj-standard-gf (movitz-funobj) ;; This class is binary congruent with movitz-funobj. - ((code-vector - :binary-type code-vector-word - :initform 'muerte::standard-gf-dispatcher - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector) - (type + ((type :binary-type other-type-byte) (funobj-type :binary-type movitz-funobj-type @@ -922,6 +918,11 @@ ;; Bits 0-4: The value of the start-stack-frame-setup label. :binary-type 'lu16 :initform 0) + (code-vector + :binary-type code-vector-word + :initform 'muerte::standard-gf-dispatcher + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector) (code-vector%1op :initform 'muerte::standard-gf-dispatcher%1op :binary-type code-pointer @@ -993,18 +994,11 @@ :map-binary-read-delayed 'movitz-word) (plist :initform nil)) - (:slot-align type -2)) + (:slot-align type #.+other-type-offset+)) (defmethod movitz-funobj-const-list ((funobj movitz-funobj-standard-gf)) nil) -#+ignore -(defun make-movitz-funobj (lambda-list &key (name "")) - (check-type name (or symbol cons)) - (make-instance 'movitz-funobj - :lambda-list lambda-list - :name name)) - (defun make-standard-gf (class slots &key lambda-list (name "unnamed") (function 'muerte::unbound) num-required-arguments @@ -1020,51 +1014,27 @@ ;;; -#+ignore -(define-binary-class movitz-bignum (movitz-heap-object-other) - ((low32 - :binary-lisp-type u32 - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word - :initarg :name) - (type - :binary-lisp-type other-type-byte - :initform :bignum) +(define-binary-class movitz-struct (movitz-heap-object-other) + ((type + :binary-type other-type-byte + :initform :defstruct) (pad :binary-lisp-type 1) (length :binary-lisp-type lu16 :initarg :length - :accessor movitz-bignum-length) - (slot0 :binary-lisp-type :label) ; the slot values follows here. - (slot-values - :initform '() - :initarg :slot-values - :accessor movitz-struct-slot-values)) - (:slot-align type -2)) - -;;; - -(define-binary-class movitz-struct (movitz-heap-object-other) - ((name + :accessor movitz-struct-length) + (name :binary-type word :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word :reader movitz-struct-name :initarg :name) - (type - :binary-type other-type-byte - :initform :defstruct) - (pad :binary-lisp-type 1) - (length - :binary-lisp-type lu16 - :initarg :length - :accessor movitz-struct-length) (slot0 :binary-lisp-type :label) ; the slot values follows here. (slot-values :initform '() :initarg :slot-values :accessor movitz-struct-slot-values)) - (:slot-align type -2)) + (:slot-align type #.+other-type-offset+)) (defmethod update-movitz-object ((movitz-struct movitz-struct) lisp-struct) (declare (ignore lisp-struct)) @@ -1271,15 +1241,15 @@ ;;; std-instance (define-binary-class movitz-std-instance (movitz-heap-object-other) - ((dummy + ((type + :binary-type other-type-byte + :initform :std-instance) + (pad :binary-lisp-type 3) + (dummy :binary-type word :initform *movitz-nil* :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word) - (type - :binary-type other-type-byte - :initform :std-instance) - (pad :binary-lisp-type 3) (class :binary-type word :map-binary-write 'movitz-intern @@ -1292,7 +1262,7 @@ :map-binary-read-delayed 'movitz-word :initarg :slots :accessor movitz-std-instance-slots)) - (:slot-align type -2)) + (:slot-align type #.+other-type-offset+)) ;; (defmethod movitz-object-offset ((obj movitz-std-instance)) (- #x1e))

1 0

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

21 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv25760 Modified Files: image.lisp Log Message: The layout of heap objects has been changed such that the type-code is now the "first" byte in the object. Date: Fri May 21 05:38:52 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.28 movitz/image.lisp:1.29 --- movitz/image.lisp:1.28 Wed May 19 10:59:52 2004 +++ movitz/image.lisp Fri May 21 05:38:52 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.28 2004/05/19 14:59:52 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.29 2004/05/21 09:38:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -569,9 +569,10 @@ (defmethod image-intern-object ((image symbolic-image) object &optional (size (sizeof object))) (assert ; sanity check on "other" storage-types. (or (not (typep object 'movitz-heap-object-other)) - (and (= -6 (slot-offset (type-of object) - (first (binary-record-slot-names (type-of object))))) - (= -2 (slot-offset (type-of object) 'type)))) + (and (= (- (tag :other)) + (slot-offset (type-of object) + (first (binary-record-slot-names (type-of object))))) + (= +other-type-offset+ (slot-offset (type-of object) 'type)))) () "The MOVITZ-HEAP-OBJECT-OTHER type ~A is malformed!" (type-of object)) (etypecase object

1 0

[movitz-cvs] CVS update: movitz/bootblock.lisp
by Frode Vatvedt Fjeld 20 May '04

20 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv20607 Modified Files: bootblock.lisp Log Message: Minor edits. Date: Thu May 20 14:25:12 2004 Author: ffjeld Index: movitz/bootblock.lisp diff -u movitz/bootblock.lisp:1.8 movitz/bootblock.lisp:1.9 --- movitz/bootblock.lisp:1.8 Fri Apr 16 15:15:20 2004 +++ movitz/bootblock.lisp Thu May 20 14:25:12 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:47:19 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: bootblock.lisp,v 1.8 2004/04/16 19:15:20 ffjeld Exp $ +;;;; $Id: bootblock.lisp,v 1.9 2004/05/20 18:25:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -155,7 +155,6 @@ (:movw :bx :es) (:xorw :bx :bx) - (:int #x13) ; Call BIOS routine (:jc 'read-error) (:movzxb :al :ecx) @@ -285,7 +284,7 @@ ;; Data welcome (% format 8 "Loading Movitz ~D..~% " ,(incf *bootblock-build*)) - entering (% format 8 ")~% Enter..") + entering (% format 8 "~% Enter..") error (% format 8 "Failed!)") track-start-msg (% format 8 "(") track-end-msg (% format 8 ")")

1 0