movitz-cvs April 2004

movitz-cvs@common-lisp.net

1 participants
210 discussions

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13405 Modified Files: io-port.lisp Log Message: Fixed up %io-port-read-succession and %io-port-write-succession substantially, so as to observe the register discipline. Date: Wed Apr 14 12:38:47 2004 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.9 movitz/losp/muerte/io-port.lisp:1.10 --- movitz/losp/muerte/io-port.lisp:1.9 Wed Apr 14 10:39:18 2004 +++ movitz/losp/muerte/io-port.lisp Wed Apr 14 12:38:47 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.9 2004/04/14 14:39:18 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.10 2004/04/14 16:38:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -68,14 +68,7 @@ (define-compiler-macro (setf io-port) (&whole form value port type) (let ((value-var (gensym "(setf io-port)-value-")) - (port-var (gensym "(setf io-port)-port-")) - #+ignore - (value-eax-code (if (not (movitz:movitz-constantp value)) - `((:compile-form (:result-mode :untagged-fixnum-eax) ,value)) - (let ((port-value (movitz:movitz-eval value))) - (check-type port-value (unsigned-byte 16)) - (movitz::make-immediate-move port-value :eax))))) - ;; value-code will put VALUE in eax. + (port-var (gensym "(setf io-port)-port-"))) (cond ((and (movitz:movitz-constantp type) (movitz:movitz-constantp port)) @@ -288,7 +281,9 @@ &environment env) (if (not (movitz:movitz-constantp byte-size env)) form - (let ((byte-size (movitz:movitz-eval byte-size env))) + (let ((port-var (gensym "port-var-")) + (object-var (gensym "object-var-")) + (byte-size (movitz:movitz-eval byte-size env))) (cond ((and (movitz:movitz-constantp offset env) (movitz:movitz-constantp start env) @@ -302,136 +297,158 @@ (:32-bit (assert (= 4 movitz:+movitz-fixnum-factor+)) (if (<= 1 count 20) - `(with-inline-assembly-case () - (do-case (t :eax) - (:compile-two-forms (:edx :ebx) ,port ,object) - (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) + `(let ((,port-var ,port) + (,object-var ,object)) + (with-inline-assembly-case () + (do-case (t :eax) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + ,@(loop for i from start below end + appending + `((:inl :dx :eax) + (:movl :eax (:ebx ,(+ offset (* 4 i)))))) + (:movl :edi :edx) + (:movl :ebx :eax) + (:cld)))) + `(let ((,port-var ,port) + (,object-var ,object)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop end-io-read-loop not-fixnum)) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) (:shrl ,movitz::+movitz-fixnum-shift+ :edx) - ,@(loop for i from start below end - appending - `((:inl :dx :eax) - (:movl :eax (:ebx ,(+ offset (* 4 i)))))) - (:movl :ebx :eax))) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-two-forms (:edx :ebx) ,port ,object) - (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:shrl ,movitz::+movitz-fixnum-shift+ :edx) - (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp) - (:movl ,(cl:* movitz::+movitz-fixnum-factor+ start) :ecx) - io-read-loop - (:cmpl :ecx (:esp)) - (:jbe 'end-io-read-loop) - (:addl 4 :ecx) - (:inl :dx :eax) - (:movl :eax (:ebx ,(+ offset -4) :ecx)) - (:jmp 'io-read-loop) - (:popl :eax) ; increment :esp, and put a lispval in :eax. - end-io-read-loop)))) + (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp) + (:movl ,(cl:* movitz::+movitz-fixnum-factor+ start) :ecx) + io-read-loop + (:cmpl :ecx (:esp)) + (:jbe 'end-io-read-loop) + (:addl 4 :ecx) + (:inl :dx :eax) + (:movl :eax (:ebx ,(+ offset -4) :ecx)) + (:jmp 'io-read-loop) + end-io-read-loop + (:popl :edx) ; increment :esp, and put a lispval in :edx. + (:movl :ebx :eax) + (:cld)))))) (:16-bit (assert (= 4 movitz:+movitz-fixnum-factor+)) (if (and t (<= 1 count 20)) - `(with-inline-assembly-case () - (do-case (t :ebx) - (:compile-two-forms (:edx :ebx) ,port ,object) - (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) + `(let ((,port-var ,port) + (,object-var ,object)) + (with-inline-assembly-case () + (do-case (t :eax) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + ,@(loop for i from start below end + appending + `((:inw :dx :ax) + (:movw :ax (:ebx ,(+ offset (* 2 i)))))) + (:movl :edi :edx) + (:movl :ebx :eax) + (:cld)))) + `(let ((,port-var ,port) + (,object-var ,object)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop end-io-read-loop not-fixnum)) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) (:shrl ,movitz::+movitz-fixnum-shift+ :edx) - (:xorl :eax :eax) - ,@(loop for i from start below end - appending - `((:inw :dx :ax) - (:movw :ax (:ebx ,(+ offset (* 2 i)))))))) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-two-forms (:edx :ebx) ,port ,object) - (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:shrl ,movitz::+movitz-fixnum-shift+ :edx) - ;; (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp) - (:movl ,(cl:* 1 start) :ecx) - (:xorl :eax :eax) - io-read-loop - (:cmpl ,end :ecx) - (:ja 'end-io-read-loop) - (:addl 1 :ecx) - (:inw :dx :ax) - (:movw :ax (:ebx ,(+ offset -2) (:ecx 2))) - (:jmp 'io-read-loop) - end-io-read-loop)))) + (:movl ,(cl:* 1 start) :ecx) + io-read-loop + (:cmpl ,end :ecx) + (:ja 'end-io-read-loop) + (:addl 1 :ecx) + (:inw :dx :ax) + (:movw :ax (:ebx ,(+ offset -2) (:ecx 2))) + (:jmp 'io-read-loop) + end-io-read-loop + (:movl :edi :edx) + (:movl :ebx :eax) + (:cld)))))) (t (error "~S byte-size ~S not implemented." (car form) byte-size))))) ((and (movitz:movitz-constantp offset env)) - (let ((offset (movitz:movitz-eval offset env))) + (let ((start-var (gensym "start-")) + (end-var (gensym "end-")) + (offset (movitz:movitz-eval offset env))) (case byte-size (:8-bit (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-form (:result-mode :push) ,port) - (:compile-form (:result-mode :push) ,object) - (:compile-two-forms (:ecx :eax) ,start ,end) - (:popl :ebx) ; object - (:popl :edx) ; port - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :eax) - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :eax) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:pushl :eax) ; keep end in (:esp) - io-read-loop - (:cmpl :ecx (:esp)) - (:jbe 'end-io-read-loop) - (:inb :dx :al) - (:addl 1 :ecx) - (:movb :al (:ebx ,(+ offset -1) (:ecx 1))) - (:jmp 'io-read-loop) - (:popl :eax) ; increment :esp, and put a lispval in :eax. - end-io-read-loop))) + `(let ((,port-var ,port) + (,object-var ,object) + (,start-var ,start) + (,end-var ,end)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop not-fixnum zero-length)) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:compile-two-forms (:ecx :eax) ,start-var ,end-var) + (:subl :ecx :eax) ; EAX = length + (:jna 'zero-length) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) + (:pushl :eax) ; keep length in (:esp) + io-read-loop + (:inb :dx :al) + (:addl 1 :ecx) + (:subl ,movitz:+movitz-fixnum-factor+ (:esp)) + (:movb :al (:ebx ,(+ offset -1) (:ecx 1))) + (:jnz 'io-read-loop) + (:popl :edx) ; increment :esp, and put a lispval in :edx. + zero-length + (:movl :ebx :eax) + (:cld))))) (:16-bit (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-form (:result-mode :push) ,port) - (:compile-form (:result-mode :push) ,object) - (:compile-two-forms (:ecx :eax) ,start ,end) - (:popl :ebx) ; object - (:popl :edx) ; port - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :eax) - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :eax) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:pushl :eax) ; keep end in (:esp) - io-read-loop - (:cmpl :ecx (:esp)) - (:jbe 'end-io-read-loop) - (:inw :dx :ax) - (:addl 2 :ecx) - (:movw :ax (:ebx ,(+ offset -2) :ecx)) - (:jmp 'io-read-loop) - (:popl :eax) ; increment :esp, and put a lispval in :eax. - end-io-read-loop))) + `(let ((,port-var ,port) + (,object-var ,object) + (,start-var ,start) + (,end-var ,end)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop not-fixnum zero-length)) + (:std) ; only EBX is GC root now + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:compile-two-forms (:ecx :eax) ,start-var ,end-var) + (:subl :ecx :eax) ; EAX = length + (:jna 'zero-length) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) + (:pushl :eax) ; keep end in (:esp) + io-read-loop + (:inw :dx :ax) + (:addl 2 :ecx) + (:subl ,(* 2 movitz:+movitz-fixnum-factor+) (:esp)) + (:movw :ax (:ebx ,(+ offset -2) (:ecx 1))) + (:jnz 'io-read-loop) + (:popl :edx) ; increment :esp, and put a lispval in :edx. + zero-length + (:movl :ebx :eax) + (:cld))))) (:32-bit (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-form (:result-mode :push) ,port) - (:compile-form (:result-mode :push) ,object) - (:compile-two-forms (:ecx :eax) ,start ,end) - (:popl :ebx) ; object - (:popl :edx) ; port - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:pushl :eax) ; keep end in (:esp) - io-read-loop - (:cmpl :ecx (:esp)) - (:jbe 'end-io-read-loop) - (:inl :dx :eax) - (:addl 4 :ecx) - (:movl :eax (:ebx ,(+ offset -4) :ecx)) - (:jmp 'io-read-loop) - (:popl :eax) ; increment :esp, and put a lispval in :eax. - end-io-read-loop))) + `(let ((,port-var ,port) + (,object-var ,object) + (,start-var ,start) + (,end-var ,end)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop end-io-read-loop not-fixnum)) + (:std) ; only EBX is GC root now + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:compile-two-forms (:ecx :eax) ,start-var ,end-var) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:pushl :eax) ; keep end in (:esp) + io-read-loop + (:cmpl :ecx (:esp)) + (:jbe 'end-io-read-loop) + (:inw :dx :ax) + (:addl 4 :ecx) + (:movw :ax (:ebx ,(+ offset -4) :ecx)) + (:jmp 'io-read-loop) + end-io-read-loop + (:popl :edx) ; increment :esp, and put a lispval in :edx. + (:movl :ebx :eax) + (:cld))))) (t (error "~S byte-size ~S not implemented." (car form) byte-size))))) (t (error "Variable offset not implemented.")))))) @@ -451,7 +468,9 @@ &environment env) (if (not (movitz:movitz-constantp byte-size env)) form - (let ((byte-size (movitz:movitz-eval byte-size env))) + (let ((port-var (gensym "port-var-")) + (object-var (gensym "object-var-")) + (byte-size (movitz:movitz-eval byte-size env))) (cond ((and (movitz:movitz-constantp offset env) (movitz:movitz-constantp start env) @@ -465,107 +484,120 @@ (:32-bit (assert (= 4 movitz:+movitz-fixnum-factor+)) (if (<= 1 count 20) - `(with-inline-assembly-case () - (do-case (t :eax) - (:compile-two-forms (:edx :ebx) ,port ,object) - (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) + `(let ((,port-var ,port) + (,object-var ,object)) + (with-inline-assembly-case () + (do-case (t :eax) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + ,@(loop for i from start below end + appending + `((:movl (:ebx ,(+ offset (* 4 i))) :eax) + (:outl :eax :dx))) + (:movl :edi :edx) + (:movl :ebx :eax) + (:cld)))) + `(let ((,port-var ,port) + (,object-var ,object)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop end-io-read-loop not-fixnum)) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) (:shrl ,movitz::+movitz-fixnum-shift+ :edx) - ,@(loop for i from start below end - appending - `((:movl (:ebx ,(+ offset (* 4 i))) :eax) - (:outl :eax :dx))) - (:movl :ebx :eax))) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-two-forms (:edx :ebx) ,port ,object) - (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:shrl ,movitz::+movitz-fixnum-shift+ :edx) - (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp) - (:movl ,(cl:* movitz::+movitz-fixnum-factor+ start) :ecx) - io-read-loop - (:cmpl :ecx (:esp)) - (:jbe 'end-io-read-loop) - (:addl 4 :ecx) - (:movl (:ebx ,(+ offset -4) :ecx) :eax) - (:outl :eax :dx) - (:jmp 'io-read-loop) - (:popl :eax) ; increment :esp, and put a lispval in :eax. - end-io-read-loop)))) + (:movl ,(cl:* movitz::+movitz-fixnum-factor+ start) :ecx) + io-read-loop + (:cmpl :ecx ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; XXX + (:jbe 'end-io-read-loop) + (:addl 4 :ecx) + (:movl (:ebx ,(+ offset -4) :ecx) :eax) + (:outl :eax :dx) + (:jmp 'io-read-loop) + end-io-read-loop + (:movl :edi :edx) + (:movl :ebx :eax) + (:cld)))))) (t (error "~S byte-size ~S not implemented." (car form) byte-size))))) ((and (movitz:movitz-constantp offset env)) - (let ((offset (movitz:movitz-eval offset env))) + (let ((start-var (gensym "start-")) + (end-var (gensym "end-")) + (offset (movitz:movitz-eval offset env))) (case byte-size (:8-bit - (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-form (:result-mode :push) ,port) - (:compile-form (:result-mode :push) ,object) - (:compile-two-forms (:ecx :eax) ,start ,end) - (:popl :ebx) ; object - (:popl :edx) ; port - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :eax) - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :eax) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:pushl :eax) ; keep end in (:esp) - io-read-loop - (:cmpl :ecx (:esp)) - (:jbe 'end-io-read-loop) - (:addl 1 :ecx) - (:movb (:ebx ,(+ offset -1) (:ecx 1)) :al) - (:outb :al :dx) - (:jmp 'io-read-loop) - (:popl :eax) ; increment :esp, and put a lispval in :eax. - end-io-read-loop))) + `(let ((,port-var ,port) + (,object-var ,object) + (,start-var ,start) + (,end-var ,end)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop not-fixnum zero-length)) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:compile-two-forms (:ecx :eax) ,start-var ,end-var) + (:subl :ecx :eax) ; EAX = length + (:jna 'zero-length) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) + (:pushl :eax) ; keep end in (:esp) + io-read-loop + (:addl 1 :ecx) + (:subl ,movitz:+movitz-fixnum-factor+ (:esp)) + (:movb (:ebx ,(+ offset -1) (:ecx 1)) :al) + (:outb :al :dx) + (:jnz 'io-read-loop) + (:popl :edx) ; increment :esp, and put a lispval in :edx. + zero-length + (:movl :ebx :eax) + (:cld))))) (:16-bit - (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-form (:result-mode :push) ,port) - (:compile-form (:result-mode :push) ,object) - (:compile-two-forms (:ecx :eax) ,start ,end) - (:popl :ebx) ; object - (:popl :edx) ; port - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :eax) - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :eax) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:pushl :eax) ; keep end in (:esp) - io-read-loop - (:cmpl :ecx (:esp)) - (:jbe 'end-io-read-loop) - (:addl 2 :ecx) - (:movw (:ebx ,(+ offset -2) :ecx) :ax) - (:outw :ax :dx) - (:jmp 'io-read-loop) - (:popl :eax) ; increment :esp, and put a lispval in :eax. - end-io-read-loop))) + `(let ((,port-var ,port) + (,object-var ,object) + (,start-var ,start) + (,end-var ,end)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop not-fixnum zero-length)) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:compile-two-forms (:ecx :eax) ,start-var ,end-var) + (:subl :ecx :eax) ; EAX = length + (:jna 'zero-length) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) + (:pushl :eax) ; keep end in (:esp) + io-read-loop + (:addl 2 :ecx) + (:subl ,(* 2 movitz:+movitz-fixnum-factor+) (:esp)) + (:movw (:ebx ,(+ offset -2) (:ecx 1)) :ax) + (:outw :ax :dx) + (:jnz 'io-read-loop) + (:popl :edx) ; increment :esp, and put a lispval in :edx. + zero-length + (:movl :ebx :eax) + (:cld))))) (:32-bit (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(with-inline-assembly-case () - (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) - (:compile-form (:result-mode :push) ,port) - (:compile-form (:result-mode :push) ,object) - (:compile-two-forms (:ecx :eax) ,start ,end) - (:popl :ebx) ; object - (:popl :edx) ; port - (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:pushl :eax) ; keep end in (:esp) - io-read-loop - (:cmpl :ecx (:esp)) - (:jbe 'end-io-read-loop) - (:addl 4 :ecx) - (:movl (:ebx ,(+ offset -4) :ecx) :eax) - (:outl :eax :dx) - (:jmp 'io-read-loop) - (:popl :eax) ; increment :esp, and put a lispval in :eax. - end-io-read-loop))) + `(let ((,port-var ,port) + (,object-var ,object) + (,start-var ,start) + (,end-var ,end)) + (with-inline-assembly-case () + (do-case (t :eax :labels (io-read-loop not-fixnum end-io-read-loop)) + (:std) + (:compile-two-forms (:edx :ebx) ,port-var ,object-var) + (:compile-two-forms (:ecx :eax) ,start-var ,end-var) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) + (:pushl :eax) ; keep end in (:esp) + io-read-loop + (:cmpl :ecx (:esp)) + (:jbe 'end-io-read-loop) + (:addl 4 :ecx) + (:movl (:ebx ,(+ offset -4) (:ecx 1)) :eax) + (:outl :eax :dx) + (:jmp 'io-read-loop) + end-io-read-loop + (:popl :edx) ; increment :esp, and put a lispval in :edx. + (:movl :ebx :eax) + (:cld))))) (t (error "~S byte-size ~S not implemented." (car form) byte-size))))) (t (error "Variable offset not implemented."))))))

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4197 Modified Files: io-port.lisp Log Message: Much changed io-port and (setf io-port), so as to observe the register discipline. Date: Wed Apr 14 10:39:18 2004 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.8 movitz/losp/muerte/io-port.lisp:1.9 --- movitz/losp/muerte/io-port.lisp:1.8 Thu Feb 26 06:18:29 2004 +++ movitz/losp/muerte/io-port.lisp Wed Apr 14 10:39:18 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.8 2004/02/26 11:18:29 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.9 2004/04/14 14:39:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -25,30 +25,37 @@ (define-compiler-macro io-port (&whole form port type &environment env) (if (not (movitz:movitz-constantp type env)) form - (ecase (movitz::eval-form type env) + (ecase (movitz:movitz-eval type env) (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) + `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :edx) ,port) - (:andl ,(ash #xffff movitz::+movitz-fixnum-shift+) :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:std) ; only EBX is now GC root + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) (:xorl :eax :eax) - (:inb :dx :al))) + (:inb :dx :al) + (:shll ,movitz:+movitz-fixnum-shift+ :eax) + (:movl :edi :edx) + (:cld))) (:unsigned-byte16 - `(with-inline-assembly (:returns :untagged-fixnum-eax) + `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :edx) ,port) - (:andl ,(ash #xffff movitz::+movitz-fixnum-shift+) :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:std) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) (:xorl :eax :eax) - (:inw :dx :ax))) + (:inw :dx :ax) + (:shll ,movitz:+movitz-fixnum-shift+ :eax) + (:movl :edi :edx))) (:character `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :edx) ,port) - (:andl ,(ash #xffff movitz::+movitz-fixnum-shift+) :edx) + (:std) (:shrl #.movitz::+movitz-fixnum-shift+ :edx) (:xorl :eax :eax) (:inb :dx :al) (:shll 8 :eax) - (:movb ,(movitz::tag :character) :al)))))) + (:movb ,(movitz::tag :character) :al) + (:movl :edi :edx) + (:cld)))))) (defun io-port (port type) (ecase type @@ -60,68 +67,161 @@ (io-port port :character)))) (define-compiler-macro (setf io-port) (&whole form value port type) - (let ((value-code (if (not (movitz:movitz-constantp value)) - `((:compile-form (:result-mode :untagged-fixnum-eax) ,value)) - (let ((port-value (movitz::eval-form value))) - (check-type port-value (unsigned-byte 16)) - (movitz::make-immediate-move port-value :eax))))) + (let ((value-var (gensym "(setf io-port)-value-")) + (port-var (gensym "(setf io-port)-port-")) + #+ignore + (value-eax-code (if (not (movitz:movitz-constantp value)) + `((:compile-form (:result-mode :untagged-fixnum-eax) ,value)) + (let ((port-value (movitz:movitz-eval value))) + (check-type port-value (unsigned-byte 16)) + (movitz::make-immediate-move port-value :eax))))) ;; value-code will put VALUE in eax. (cond ((and (movitz:movitz-constantp type) (movitz:movitz-constantp port)) - (let ((the-port (movitz::eval-form port)) - (the-type (movitz::eval-form type))) + (let ((the-port (movitz:movitz-eval port)) + (the-type (movitz:movitz-eval type))) (etypecase the-port ((unsigned-byte 8) ; short form of outb can be used (ecase the-type (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - ,@value-code - (:outb :al ,the-port))) + `(let ((,value-var ,value)) + (with-inline-assembly-case () + (do-case (:ignore :nothing) + (:std) + (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var) + (:outb :al ,the-port) + (:movl :edi :eax) + (:cld)) + (do-case (t :eax) + (:std) + (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var) + (:outb :al ,the-port) + (:compile-form (:result-mode :eax) ,value-var) + (:cld))))) (:unsigned-byte16 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - ,@value-code - (:outw :ax ,the-port))))) + `(let ((,value-var ,value)) + (with-inline-assembly-case () + (do-case (:ignore :nothing) + (:std) + (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var) + (:outw :ax ,the-port) + (:movl :edi :eax) + (:cld)) + (do-case (t :eax) + (:std) + (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var) + (:outw :ax ,the-port) + (:compile-form (:result-mode :eax) ,value-var) + (:cld))))))) ((unsigned-byte 16) ; indirect (by DX) form of outb must be used (ecase the-type (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - ,@value-code - ,@(movitz::make-immediate-move the-port :edx) - (:outb :al :dx))) + `(let ((,value-var ,value)) + (with-inline-assembly-case () + (do-case (:ignore :nothing) + (:std) + (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var) + ,@(movitz::make-immediate-move the-port :edx) + (:outb :al :dx) + ,@(unless (= 0 (mod the-port 4)) + `((:movl :edi :edx))) + (:movl :edi :eax) + (:cld)) + (do-case (t :eax) + (:std) + (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var) + ,@(movitz::make-immediate-move the-port :edx) + (:outb :al :dx) + ,@(unless (= 0 (mod the-port 4)) + `((:movl :edi :edx))) + (:compile-form (:result-mode :eax) ,value-var) + (:cld))))) (:unsigned-byte16 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - ,@value-code - ,@(movitz::make-immediate-move the-port :edx) - (:outw :ax :dx)))))))) + `(let ((,value-var ,value)) + (with-inline-assembly-case () + (do-case (:ignore :nothing) + (:std) + (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var) + ,@(movitz::make-immediate-move the-port :edx) + (:outw :ax :dx) + ,@(unless (= 0 (mod the-port 4)) + `((:movl :edi :edx))) + (:movl :edi :eax) + (:cld)) + (do-case (t :eax) + (:std) + (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var) + ,@(movitz::make-immediate-move the-port :edx) + (:outw :ax :dx) + ,@(unless (= 0 (mod the-port 4)) + `((:movl :edi :edx))) + (:compile-form (:result-mode :eax) ,value-var) + (:cld)))))))))) ((movitz:movitz-constantp type) - (ecase (movitz::eval-form type) + (ecase (movitz:movitz-eval type) (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - (:compile-form (:result-mode :push) ,port) - ,@value-code - (:popl :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:outb :al :dx))) + `(let ((,value-var ,value) + (,port-var ,port)) + (with-inline-assembly-case () + (do-case (:ignore :nothing) + (:std) + (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var) + (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:outb :al :dx) + (:movl :edi :edx) + (:movl :edi :eax) + (:cld)) + (do-case (t :eax) + (:std) + (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var) + (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:outb :al :dx) + (:movl :edi :edx) + (:compile-form (:result-mode :eax) ,value-var) + (:cld))))) (:unsigned-byte16 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - (:compile-form (:result-mode :push) ,port) - ,@value-code - (:popl :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:outw :ax :dx))) + `(let ((,value-var ,value) + (,port-var ,port)) + (with-inline-assembly-case () + (do-case (:ignore :nothing) + (:std) + (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var) + (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:outw :ax :dx) + (:movl :edi :edx) + (:movl :edi :eax) + (:cld)) + (do-case (t :eax) + (:std) + (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var) + (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:outw :ax :dx) + (:movl :edi :edx) + (:compile-form (:result-mode :eax) ,value-var) + (:cld))))) (:character - `(with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :push) ,port) - (:compile-form (:result-mode :eax) ,value) - (:cmpb #.(movitz::tag :character) :al) - (:jne '(:sub-program (not-a-character) (:int 60))) - (:popl :edx) - (:shrl 8 :eax) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:outb :al :dx) - (:shll 8 :eax) - (:movb 2 :al))))) + `(let ((,value-var ,value) + (,port-var ,port)) + (with-inline-assembly-case () + (do-case (:ignore :nothing) + (:std) + (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var) + (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:shrl 8 :eax) + (:outb :al :dx) + (:movl :edi :edx) + (:movl :edi :eax) + (:cld)) + (do-case (t :eax) + (:std) + (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var) + (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:shrl 8 :eax) + (:outb :al :dx) + (:movl :edi :edx) + (:compile-form (:result-mode :eax) ,value-var) + (:cld))))))) (t form)))) (defun (setf io-port) (value port type)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv30822 Modified Files: compiler.lisp Log Message: Minor changes, mostly to do with knowing about the effect of the :cld and :stc instructions. Date: Wed Apr 14 10:38:14 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.44 movitz/compiler.lisp:1.45 --- movitz/compiler.lisp:1.44 Tue Apr 13 09:03:10 2004 +++ movitz/compiler.lisp Wed Apr 14 10:38:14 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.44 2004/04/13 13:03:10 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.45 2004/04/14 14:38:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1424,7 +1424,7 @@ (non-destructuve-p (c) (let ((c (ignore-instruction-prefixes c))) (and (consp c) - (member (car c) '(:testl :testb :pushl :cmpl :cmpb :frame-map))))) + (member (car c) '(:testl :testb :pushl :cmpl :cmpb :frame-map :std))))) (simple-instruction-p (c) (let ((c (ignore-instruction-prefixes c))) (and (listp c) @@ -1469,14 +1469,14 @@ (preserves-register-p (i register) (let ((i (ignore-instruction-prefixes i))) (and (not (atom i)) - (or (and (member register '(:edx)) - (member (global-funcall-p i) - '(fast-car fast-cdr fast-car-ebx fast-cdr-ebx))) + (or (and (simple-instruction-p i) + (not (eq register (idst i)))) (instruction-is i :frame-map) (branch-instruction-label i) (non-destructuve-p i) - (and (simple-instruction-p i) - (not (eq register (idst i)))))))) + (and (member register '(:edx)) + (member (global-funcall-p i) + '(fast-car fast-cdr fast-car-ebx fast-cdr-ebx))))))) (register-operand (op) (and (member op '(:eax :ebx :ecx :edx :edi)) op)) @@ -1915,6 +1915,11 @@ (setq p (list `(,(car i) ',to))) (explain nil "branch redirect from ~S to ~S" from to) t))) + ;; remove back-to-back std/cld + ((and (instruction-is i :cld) + (instruction-is i2 :std)) + (explain nil "removing back-to-back cld, std.") + (setq p nil next-pc (cddr pc))) ;; remove branch no-ops. ((and (branch-instruction-label i t) (label-here-p (branch-instruction-label i t) @@ -2455,7 +2460,7 @@ (t (case (instruction-is i) ((nil :call) (return nil)) - ((:into)) + ((:into :clc :stc :cld :std)) ((:jnz :je :jne :jz)) ((:outb) (setf free-so-far @@ -2541,7 +2546,6 @@ (multiple-value-call #'encoded-subtypep (values-list (binding-store-type binding)) (type-specifier-encode '(or integer character)))) - (warn "for ecX: ~S" binding) :ecx) ((not (null free-registers-no-ecx)) (first free-registers-no-ecx))

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3793 Modified Files: packages.lisp Log Message: Added symbols. Date: Wed Apr 14 08:41:11 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.14 movitz/packages.lisp:1.15 --- movitz/packages.lisp:1.14 Tue Apr 6 20:34:06 2004 +++ movitz/packages.lisp Wed Apr 14 08:41:11 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.14 2004/04/07 00:34:06 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.15 2004/04/14 12:41:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1293,7 +1293,8 @@ #:+movitz-fixnum-shift+ #:+movitz-fixnum-zmask+ #:+scan-skip-word+ - #:constant0 + #:+code-vector-word-offset+ + #:+code-vector-transient-word+ #:movitz-object-browser-properties #:movitz-heap-object

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2160 Modified Files: image.lisp Log Message: No comment. Date: Wed Apr 14 08:40:26 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.20 movitz/image.lisp:1.21 --- movitz/image.lisp:1.20 Thu Mar 25 20:44:46 2004 +++ movitz/image.lisp Wed Apr 14 08:40:26 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.20 2004/03/26 01:44:46 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.21 2004/04/14 12:40:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1434,6 +1434,7 @@ `(muerte.cl:progn (muerte::with-inline-assembly (:returns :nothing) (:cli) + (:cld) ; clear direction flag => "normal" register GC roots. (:movw ,(1- (* 8 8)) (:esp -6)) (:movl ,(+ (image-ds-segment-base *image*)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23080 Modified Files: movitz.lisp Log Message: Added constant +code-vector-transient-word+. Date: Wed Apr 14 08:37:23 2004 Author: ffjeld Index: movitz/movitz.lisp diff -u movitz/movitz.lisp:1.5 movitz/movitz.lisp:1.6 --- movitz/movitz.lisp:1.5 Fri Feb 13 17:07:21 2004 +++ movitz/movitz.lisp Wed Apr 14 08:37:23 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:52:58 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: movitz.lisp,v 1.5 2004/02/13 22:07:21 ffjeld Exp $ +;;;; $Id: movitz.lisp,v 1.6 2004/04/14 12:37:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -24,6 +24,10 @@ (define-unsigned lu32 4 :little-endian) (defconstant +code-vector-word-offset+ 2) +(defconstant +code-vector-transient-word+ + (ldb (byte 32 0) + (- +code-vector-word-offset+))) + (defconstant +movitz-multiple-values-limit+ 127) (defvar *bq-level* 0)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11289 Modified Files: memref.lisp Log Message: Added :code-vector storage-type for memref and (setf memref). Date: Wed Apr 14 08:31:08 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.11 movitz/losp/muerte/memref.lisp:1.12 --- movitz/losp/muerte/memref.lisp:1.11 Tue Apr 6 20:15:02 2004 +++ movitz/losp/muerte/memref.lisp Wed Apr 14 08:31:08 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.11 2004/04/07 00:15:02 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.12 2004/04/14 12:31:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -207,6 +207,43 @@ (:load-lexical (:lexical-binding ,object-var) :eax) (:addl :ebx :ecx) (:movl (:eax :ecx ,(offset-by 4)) :eax))))))) + (:code-vector + ;; A code-vector is like a normal lisp word pointer, + ;; except it's known to point to a code-vector, and + ;; the pointer value is offset by 2. The trick is to + ;; perform this pointer arithmetics while never + ;; keeping a non-lisp-word pointer in a register. + (cond + ((and (eql 0 index) (eql 0 offset)) + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :ebx) ,object) + (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax) + (:addl (:ebx ,(offset-by 4)) :eax))) + ((eql 0 offset) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:ebx :ecx) ,object ,index) + ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) + `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx)) + (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax) + (:addl (:ebx :ecx ,(offset-by 4)) :eax))) + ((eql 0 index) + `(with-inline-assembly (:returns :eax) + (: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 (error "variable memref type :code-vector not implemented.")) + #+ignore + (t (assert (not (movitz:movitz-constantp offset env))) + (assert (not (movitz:movitz-constantp index env))) + (let ((object-var (gensym "memref-object-"))) + (assert (= 4 movitz:+movitz-fixnum-factor+)) + `(let ((,object-var ,object)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:ecx :ebx) ,offset ,index) + (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) + (:load-lexical (:lexical-binding ,object-var) :eax) + (:addl :ebx :ecx) + (:movl (:eax :ecx ,(offset-by 4)) :eax))))))) (t (error "Unknown memref type: ~S" (movitz::eval-form type nil nil)) form))))))))) @@ -454,6 +491,41 @@ `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx)) (:movl :eax (:ebx :ecx ,(movitz:movitz-eval offset env))))))) (t (let ((value-var (gensym "memref-value-")) + (object-var (gensym "memref-object-"))) + `(let ((,value-var ,value) (,object-var ,object)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index) + (:load-lexical (:lexical-binding ,value-var) :eax) + ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) + `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx)) + (:addl :ebx :ecx) ; index += offset + (:load-lexical (:lexical-binding ,object-var) :ebx) + (:movl :eax (:ebx :ecx)))))))) + (:code-vector + (cond + ((and (movitz:movitz-constantp offset env) + (movitz:movitz-constantp index env)) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) ,value ,object) + (:movl ,movitz:+code-vector-word-offset+ + (:ebx ,(+ (movitz:movitz-eval offset env) + (* 4 (movitz:movitz-eval index env))))) + (:addl :eax (:ebx ,(+ (movitz:movitz-eval offset env) + (* 4 (movitz:movitz-eval index env))))))) + ((movitz:movitz-constantp offset env) + (let ((value-var (gensym "memref-value-"))) + `(let ((,value-var ,value)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:ebx :ecx) ,object ,index) + (:load-lexical (:lexical-binding ,value-var) :eax) + ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2)) + `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx)) + (:movl ,movitz:+code-vector-word-offset+ + (:ebx :ecx ,(movitz:movitz-eval offset env))) + (:addl :eax (:ebx :ecx ,(movitz:movitz-eval offset env))))))) + (t (error "variable (setf memref) type :code-vector not implemented.") + #+ignore + (let ((value-var (gensym "memref-value-")) (object-var (gensym "memref-object-"))) `(let ((,value-var ,value) (,object-var ,object)) (with-inline-assembly (:returns :eax)

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv29291 Modified Files: functions.lisp Log Message: Slight rewrite of some funobj accessors. This still needs work, though. Date: Wed Apr 14 08:25:28 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.7 movitz/losp/muerte/functions.lisp:1.8 --- movitz/losp/muerte/functions.lisp:1.7 Sun Mar 28 12:31:41 2004 +++ movitz/losp/muerte/functions.lisp Wed Apr 14 08:25:27 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.7 2004/03/28 17:31:41 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.8 2004/04/14 12:25:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -84,14 +84,13 @@ (defun funobj-code-vector (funobj) (check-type funobj compiled-function) - (%word-offset (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :lisp) - -2)) + (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :code-vector)) (defun (setf funobj-code-vector) (code-vector funobj) (check-type funobj compiled-function) (check-type code-vector vector-u8) - (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :lisp) - (%word-offset code-vector 2))) + (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :code-vector) + code-vector)) (defun funobj-code-vector%1op (funobj) "This slot is not a lisp value, it is a direct address to code entry point. In practice it is either @@ -274,16 +273,18 @@ "Index ~D out of range, ~S has ~D constants." index funobj (funobj-num-constants funobj)) (if (>= index (funobj-num-jumpers funobj)) (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0) index :lisp) - (without-gc - (with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :untagged-fixnum-ecx) funobj index) - (:movl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) - :ebx) - (:negl :ebx) - (:addl ((:ecx 4) :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0)) - :ebx) - (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :eax) - (:xorl :ebx :ebx))))) + ;; For a jumper, return its offset relative to the code-vector. + ;; This is tricky wrt. to potential GC interrupts, because we're doing + ;; pointer arithmetics. + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ecx) funobj index) + (:movl #.movitz:+code-vector-transient-word+ :ebx) + (:addl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) + :ebx) ; code-vector (word) into ebx + (:subl (:eax :ecx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0)) + :ebx) + (:negl :ebx) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :eax)))) (defun (setf funobj-constant-ref) (value funobj index) (check-type funobj compiled-function) @@ -297,10 +298,10 @@ (assert (below value (length (funobj-code-vector funobj))) (value) "The jumper value ~D is invalid because the code-vector's size is ~D." value (length (funobj-code-vector funobj))) - (without-gc + (progn ;; without-gc (with-inline-assembly (:returns :nothing) - (:compile-two-forms (:eax :untagged-fixnum-ecx) funobj index) - (:leal ((:ecx 4) :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0)) + (:compile-two-forms (:eax :ecx) funobj index) + (:leal (:ecx :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0)) :ebx) ; dest. address into ebx. (:compile-form (:result-mode :untagged-fixnum-ecx) value) (:addl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector))

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18667 Modified Files: basic-macros.lisp Log Message: Removed bogus macro without-gc. Date: Wed Apr 14 08:21:53 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.7 movitz/losp/muerte/basic-macros.lisp:1.8 --- movitz/losp/muerte/basic-macros.lisp:1.7 Tue Apr 13 12:40:53 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Apr 14 08:21:53 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.7 2004/04/13 16:40:53 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.8 2004/04/14 12:21:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -885,14 +885,6 @@ (:andl #x7 :ecx) (:call (:edi (:ecx 4) ,(movitz::global-constant-offset 'fast-class-of))))) -(define-compiler-macro without-gc (&body body) - `(multiple-value-prog1 - (progn (with-inline-assembly (:returns :nothing) (:std)) - ,@body) - (with-inline-assembly (:returns :nothing) (:cld)))) - -;;; - (defmacro std-instance-reader (slot instance-form) (let ((slot (intern (symbol-name slot) :movitz))) `(with-inline-assembly-case () @@ -1010,7 +1002,6 @@ (let ((infinite-loop-label (make-symbol "infinite-loop"))) `(with-inline-assembly (:returns :nothing) ,infinite-loop-label - (:movl #xabbabeef :eax) (:halt) (:jmp ',infinite-loop-label))))

1 0

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

14 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv29310 Modified Files: procfs-image.lisp Log Message: Reflect the new interrupt-frame layout in backtrace. Date: Wed Apr 14 08:11:32 2004 Author: ffjeld Index: movitz/procfs-image.lisp diff -u movitz/procfs-image.lisp:1.4 movitz/procfs-image.lisp:1.5 --- movitz/procfs-image.lisp:1.4 Tue Apr 6 10:35:36 2004 +++ movitz/procfs-image.lisp Wed Apr 14 08:11:32 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Aug 24 11:39:37 2001 ;;;; -;;;; $Id: procfs-image.lisp,v 1.4 2004/04/06 14:35:36 ffjeld Exp $ +;;;; $Id: procfs-image.lisp,v 1.5 2004/04/14 12:11:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -164,6 +164,10 @@ (when (zerop (ldb (byte 2 0) stack-frame)) (get-word (- stack-frame -4)))) +(defun interrupt-frame-index (name) + (- 5 (position name + '(nil :eflags :eip :error-code :exception :ebp nil + :ecx :eax :edx :ebx :esi :edi)))) (defun backtrace () (format t "~&Backtracing from EIP = #x~X: " (image-register32 *image* :eip)) @@ -182,14 +186,13 @@ (return-from backtrace nil)) (write-string "?") (let* ((r (stack-frame-return-address stack-frame)) - (eax (get-word (+ stack-frame 28 8))) - (ecx (get-word (+ stack-frame 24 8))) - (edi (get-word (+ stack-frame 0 8))) - (eip (get-word (+ stack-frame 40 8))) - (exception (get-word (+ stack-frame 32 8))) - (return (get-word (+ stack-frame 52 8)))) - (when r (format t " (ret #x~X {EAX: #x~X, ECX: #x~X, EDI: #x~X, EIP: #x~X, exception ~D, ret: #x~X})" - r eax ecx edi eip exception return)))) + (eax (get-word (+ (* 4 (interrupt-frame-index :eax)) stack-frame))) + (ecx (get-word (+ (* 4 (interrupt-frame-index :ecx)) stack-frame))) + (edi (get-word (+ (* 4 (interrupt-frame-index :edi)) stack-frame))) + (eip (get-word (+ (* 4 (interrupt-frame-index :eip)) stack-frame))) + (exception (get-word (+ (* 4 (interrupt-frame-index :exception)) stack-frame)))) + (when r (format t " (ret #x~X {EAX: #x~X, ECX: #x~X, EDI: #x~X, EIP: #x~X, exception ~D})" + r eax ecx edi eip exception)))) (movitz-symbol (let ((name (movitz-print movitz-name))) (write-string (symbol-name name))

1 0

← Newer
1
...
11
12
13
14
15
16
17
...
21
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs April 2004