February 2005 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19119 Modified Files: interrupt.lisp Log Message: Fixed DIT's restarting of atomically-continuations. Date: Wed Feb 2 08:50:25 2005 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.37 movitz/losp/muerte/interrupt.lisp:1.38 --- movitz/losp/muerte/interrupt.lisp:1.37 Fri Jan 28 09:49:07 2005 +++ movitz/losp/muerte/interrupt.lisp Wed Feb 2 08:50:25 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.37 2005/01/28 08:49:07 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.38 2005/02/02 07:50:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -141,12 +141,12 @@ (:locally (:movl 0 (:edi (:edi-offset atomically-continuation)))) ;; Do RET atomicification - (:movl (:ebp ,(dit-frame-offset :eip)) :ecx) - ((:cs-override) :cmpb ,(realpart (ia-x86:asm :ret)) (:ecx)) - (:jne 'not-at-ret-instruction) - (:globally (:movl (:edi (:edi-offset ret-trampoline)) :ecx)) - (:movl :ecx (:ebp ,(dit-frame-offset :eip))) - not-at-ret-instruction +;;; (:movl (:ebp ,(dit-frame-offset :eip)) :ecx) +;;; ((:cs-override) :cmpb ,(realpart (ia-x86:asm :ret)) (:ecx)) +;;; (:jne 'not-at-ret-instruction) +;;; (:globally (:movl (:edi (:edi-offset ret-trampoline)) :ecx)) +;;; (:movl :ecx (:ebp ,(dit-frame-offset :eip))) +;;; not-at-ret-instruction (:xorl :eax :eax) ; Ensure safe value (:xorl :edx :edx) ; Ensure safe value @@ -251,14 +251,16 @@ (:jnz 'restart-simple-pf) ;; ECX is a throw target aka. next continuation step. - (:locally (:movl :esi (:edi (:edi-offset scratch1)))) + + (:movl :edi :esi) ; before bumping ESP, remove reference to funobj.. + ; ..in case it's stack-allocated. (:movl (:ecx 12) :edx) (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) ; exit to target dynamic-env - (:movl :ecx :esp) ; enter non-local jump stack mode. + (:movl :edi :ebp) ; enter non-local jump stack mode. + (:movl :ecx :esp) ; (:movl (:esp) :ecx) ; target stack-frame EBP (:movl (:ecx -4) :esi) ; get target funobj into ESI - (:movl (:esp 8) :ecx) ; target jumper number (:jmp (:esi :ecx (:offset movitz-funobj constant0)))

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19097 Modified Files: compiler.lisp Log Message: Teach make-compiled-stack-restore about :untagged-fixnum-ecx. Date: Wed Feb 2 08:49:00 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.133 movitz/compiler.lisp:1.134 --- movitz/compiler.lisp:1.133 Mon Jan 31 15:11:14 2005 +++ movitz/compiler.lisp Wed Feb 2 08:48:58 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.133 2005/01/31 14:11:14 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.134 2005/02/02 07:48:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -5369,7 +5369,7 @@ ((:single-value :eax :ebx) (values `((:addl ,(* 4 stack-displacement) :esp)) :multiple-values)))) ; assume this addl will set CF=0 - ((:single-value :eax :ebx :ecx :edx :push :lexical-binding + ((:single-value :eax :ebx :ecx :edx :push :lexical-binding :untagged-fixnum-ecx :boolean :boolean-branch-on-false :boolean-branch-on-true) (ecase returns (#.+boolean-modes+

1 0

[movitz-cvs] CVS update: movitz/bootblock.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19078 Modified Files: bootblock.lisp Log Message: Minor edits: use keyword assembly instructions. Date: Wed Feb 2 08:48:21 2005 Author: ffjeld Index: movitz/bootblock.lisp diff -u movitz/bootblock.lisp:1.10 movitz/bootblock.lisp:1.11 --- movitz/bootblock.lisp:1.10 Wed Jul 7 19:33:04 2004 +++ movitz/bootblock.lisp Wed Feb 2 08:48:21 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001,2000, 2002-2004, +;;;; Copyright (C) 2001,2000, 2002-2005, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: bootblock.lisp @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:47:19 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: bootblock.lisp,v 1.10 2004/07/07 17:33:04 ffjeld Exp $ +;;;; $Id: bootblock.lisp,v 1.11 2005/02/02 07:48:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -35,32 +35,32 @@ (defun mkasm16-bios-print () "Print something to the terminal. [es:si] points to the text" - `((movzxb (:si) :cx) - (incw :si) - (movb #xe :ah) - (movw 7 :bx) - :print-loop - (lodsb) - (int #x10) - (loop ':print-loop) - (ret))) + `((:movzxb (:si) :cx) + (:incw :si) + (:movb #xe :ah) + (:movw 7 :bx) + print-loop + (:lodsb) + (:int #x10) + (:loop 'print-loop) + (:ret))) (defun mkasm16-format-hex () "Format a 16-bit word (in DX) into hex string (in DI)" - `((std) - (movw 4 :cx) - (addw :cx :di) - (decw :di) - :format-loop - (movb :dl :bl) - (andw #x0f bx) - (movb ('hex-table bx) :al) - (stosb) - (shrw :dx 4) - (decw :cx) - (jnz ':format-loop) - (cld) - (ret) + `((:std) + (:movw 4 :cx) + (:addw :cx :di) + (:decw :di) + format-loop + (:movb :dl :bl) + (:andw #x0f bx) + (:movb ('hex-table bx) :al) + (:stosb) + (:shrw :dx 4) + (:decw :cx) + (:jnz 'format-loop) + (:cld) + (:ret) hex-table (% format nil "0123456789abcdef"))) (defconstant +SECTOR-SIZE+ 512)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19046 Modified Files: memref.lisp Log Message: Completed (setf memref :code-vector). Date: Wed Feb 2 08:47:34 2005 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.42 movitz/losp/muerte/memref.lisp:1.43 --- movitz/losp/muerte/memref.lisp:1.42 Tue Jan 25 14:51:36 2005 +++ movitz/losp/muerte/memref.lisp Wed Feb 2 08:47:34 2005 @@ -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.42 2005/01/25 13:51:36 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.43 2005/02/02 07:47:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -774,11 +774,10 @@ (:ebx :ecx ,(movitz:movitz-eval offset env))) (,prefixes :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-")) + (t (let ((value-var (gensym "memref-value-")) (object-var (gensym "memref-object-"))) - `(let ((,value-var ,value) (,object-var ,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) @@ -786,7 +785,8 @@ `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx)) (:addl :ebx :ecx) ; index += offset (:load-lexical (:lexical-binding ,object-var) :ebx) - (:movl :eax (:ebx :ecx))))))))) + (:movl ,movitz:+code-vector-word-offset+ (:ebx :ecx)) + (,prefixes :addl :eax (:ebx :ecx))))))))) (t ;; (warn "Can't handle inline MEMREF: ~S" form) form)))) @@ -812,7 +812,11 @@ (:lisp (if localp (setf (memref object offset :index index :localp t) value) - (setf (memref object offset :index index :localp nil) value))))) + (setf (memref object offset :index index :localp nil) value))) + (:code-vector + (if localp + (setf (memref object offset :index index :localp t :type :code-vector) value) + (setf (memref object offset :index index :localp nil :type :code-vector) value))))) (define-compiler-macro memref-int (&whole form address &key (offset 0) (index 0) (type :unsigned-byte32) (physicalp t)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.lisp
by ffjeld＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1611 Modified Files: primitive-functions.lisp Log Message: Minor edit. Date: Tue Feb 1 08:20:08 2005 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.61 movitz/losp/muerte/primitive-functions.lisp:1.62 --- movitz/losp/muerte/primitive-functions.lisp:1.61 Tue Jan 25 05:54:57 2005 +++ movitz/losp/muerte/primitive-functions.lisp Tue Feb 1 08:20:08 2005 @@ -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.61 2005/01/25 13:54:57 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.62 2005/02/01 16:20:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -73,7 +73,8 @@ (with-inline-assembly (:returns :nothing) (:movl :esi :edx) ; parameter for standard-gf-function. (:movl (:esi ,(bt:slot-offset 'movitz::movitz-funobj-standard-gf - (intern (symbol-name to) :movitz))) :esi) + (intern (symbol-name to) :movitz))) + :esi) (:jmp (:esi ,(bt:slot-offset 'movitz::movitz-funobj (intern (symbol-name forward) :movitz)))))))

1 0