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

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

02 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv22163 Modified Files: debugger.lisp Log Message: Changed the signature of interrupt-frame-ref. Date: Wed Jun 2 07:31:20 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.10 movitz/losp/x86-pc/debugger.lisp:1.11 --- movitz/losp/x86-pc/debugger.lisp:1.10 Thu Apr 15 12:57:10 2004 +++ movitz/losp/x86-pc/debugger.lisp Wed Jun 2 07:31:20 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.10 2004/04/15 19:57:10 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.11 2004/06/02 14:31:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -466,7 +466,7 @@ (typecase funobj (integer (let* ((interrupt-frame stack-frame) - (funobj (interrupt-frame-ref interrupt-frame :esi :lisp))) + (funobj (interrupt-frame-ref :esi :lisp 0 interrupt-frame))) (if (and conflate-interrupts conflate ;; When the interrupted function has a stack-frame, conflate it. (typep funobj 'function) @@ -476,9 +476,10 @@ (incf count) (print-leadin stack-frame count conflate-count) (setf conflate-count 0) - (let ((exception (interrupt-frame-ref interrupt-frame :exception - :unsigned-byte32)) - (eip (interrupt-frame-ref interrupt-frame :eip :unsigned-byte32))) + (let ((exception (interrupt-frame-ref :exception :unsigned-byte32 + 0 interrupt-frame)) + (eip (interrupt-frame-ref :eip :unsigned-byte32 + 0 interrupt-frame))) (typecase funobj (function (let ((delta (code-vector-offset (funobj-code-vector funobj) eip)))

1 0

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

02 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22045 Modified Files: scavenge.lisp Log Message: Changed the signature of interrupt-frame-ref. Date: Wed Jun 2 07:31:15 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.7 movitz/losp/muerte/scavenge.lisp:1.8 --- movitz/losp/muerte/scavenge.lisp:1.7 Fri May 21 02:40:19 2004 +++ movitz/losp/muerte/scavenge.lisp Wed Jun 2 07:31:15 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.7 2004/05/21 09:40:19 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.8 2004/06/02 14:31:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -112,7 +112,7 @@ (+ frame (interrupt-frame-index :ecx))) (let* ((interrupt-frame frame) (interrupted-eip-loc - (interrupt-frame-ref interrupt-frame :eip :signed-byte30+2))) + (interrupt-frame-ref :eip :signed-byte30+2 0 interrupt-frame))) ;; 2. Pop to interrupted frame (setf nether-frame frame frame (stack-frame-uplink frame))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by Frode Vatvedt Fjeld 02 Jun '04

02 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv21630 Modified Files: interrupt.lisp Log Message: Changed the signature of interrupt-frame-ref. Date: Wed Jun 2 07:31:01 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.10 movitz/losp/muerte/interrupt.lisp:1.11 --- movitz/losp/muerte/interrupt.lisp:1.10 Wed Jun 2 03:39:59 2004 +++ movitz/losp/muerte/interrupt.lisp Wed Jun 2 07:31:01 2004 @@ -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.10 2004/06/02 10:39:59 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.11 2004/06/02 14:31:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,6 +18,8 @@ (provide :muerte/interrupt) +(defvar *last-interrupt-frame* nil) + (defmacro stack-word (offset) `(with-inline-assembly (:returns :eax) (:movl (:esp ,(* 4 offset)) :eax))) @@ -36,38 +38,31 @@ '(nil :eflags :eip :error-code :exception :ebp nil :ecx :eax :edx :ebx :esi :edi :atomically-status)))) -(define-compiler-macro interrupt-frame-ref (&whole form frame reg type &optional (offset 0) +(define-compiler-macro interrupt-frame-ref (&whole form reg type + &optional (offset 0) + (frame '*last-interrupt-frame*) &environment env) `(memref ,frame (+ (* 4 (interrupt-frame-index ,reg)) ,offset) 0 ,type)) -(defun interrupt-frame-ref (frame reg type &optional (offset 0)) - (interrupt-frame-ref frame reg type offset)) +(defun interrupt-frame-ref (reg type &optional (offset 0) (frame *last-interrupt-frame*)) + (interrupt-frame-ref reg type offset frame)) -(defun (setf interrupt-frame-ref) (x frame reg type) +(defun (setf interrupt-frame-ref) (x reg type &optional (frame *last-interrupt-frame*)) (setf (memref frame (* 4 (interrupt-frame-index reg)) 0 type) x)) (define-primitive-function default-interrupt-trampoline () "Default first-stage interrupt handler." -;;; `(cl:list* 'with-inline-assembly '(:returns :nothing) -;;; (cl:loop :for i :from 0 :to movitz::+idt-size+ -;;; :append (cl:if (cl:member i '(8 10 11 12 13 14 17)) -;;; `(((5) :pushl ,i) -;;; ((5) :jmp 'ok)) -;;; `(((2) :pushl 0) ; replace Error Code -;;; ((2) :pushl ,i) -;;; ((1) :nop) -;;; ((5) :jmp 'ok))))) (macrolet ((do-it () `(with-inline-assembly (:returns :multiple-values) - ,@(loop :for i :from 0 :to movitz::+idt-size+ - :append (cl:if (cl:member i '(8 10 11 12 13 14 17)) - `(((5) :pushl ,i) - ((5) :jmp 'ok)) - `(((2) :pushl 0) ; replace Error Code - ((2) :pushl ,i) - ((1) :nop) - ((5) :jmp 'ok)))) + ,@(loop for i from 0 to movitz::+idt-size+ + append (if (member i '(8 10 11 12 13 14 17)) + `(((5) :pushl ,i) + ((5) :jmp 'ok)) + `(((2) :pushl 0) ; replace Error Code + ((2) :pushl ,i) + ((1) :nop) + ((5) :jmp 'ok)))) ok ;; Stack: ;; 20: Interruptee EFLAGS (later EIP) @@ -202,8 +197,6 @@ ))) (do-it))) -(defvar *last-interrupt-frame* nil) - (defun interrupt-default-handler (number interrupt-frame) (declare (without-check-stack-limit)) (macrolet ((@ (fixnum-address &optional (type :lisp)) @@ -223,7 +216,7 @@ (6 (error "Illegal instruction at ~@Z." $eip)) (13 (error "General protection error. EIP=~@Z, error-code: #x~X, EAX: ~@Z, EBX: ~@Z, ECX: ~@Z" $eip - (interrupt-frame-ref interrupt-frame :error-code :unsigned-byte32) + (interrupt-frame-ref :error-code :unsigned-byte32 0 interrupt-frame) $eax $ebx $ecx)) ((61) ;; EAX failed type in EDX. May be restarted by returning with a new value in EAX. @@ -283,12 +276,12 @@ (error 'unbound-variable :name name)))) ((100);; 101 102 103 104 105) (let ((funobj (@ (+ interrupt-frame (interrupt-frame-index :esi)))) - (code (interrupt-frame-ref interrupt-frame :ecx :unsigned-byte8))) + (code (interrupt-frame-ref :ecx :unsigned-byte8 0 interrupt-frame))) (error 'wrong-argument-count :function funobj :argument-count (if (logbitp 7 code) - (ash (interrupt-frame-ref interrupt-frame - :ecx :unsigned-byte32) + (ash (interrupt-frame-ref :ecx :unsigned-byte32 + 0 interrupt-frame) -24) code)))) (108

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by Frode Vatvedt Fjeld 02 Jun '04

02 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6433 Modified Files: interrupt.lisp Log Message: Added another thread-atomically mechanism, allowing a jumper to be the restart-point. Date: Wed Jun 2 03:39:59 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.9 movitz/losp/muerte/interrupt.lisp:1.10 --- movitz/losp/muerte/interrupt.lisp:1.9 Tue Jun 1 08:17:08 2004 +++ movitz/losp/muerte/interrupt.lisp Wed Jun 2 03:39:59 2004 @@ -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.9 2004/06/01 15:17:08 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.10 2004/06/02 10:39:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -178,6 +178,23 @@ (:xorl :ecx :ecx) ; Do reset status to zero. (:jmp 'normal-return) not-simple-atomical-pf-restart + (:cmpb ,(bt:enum-value 'movitz::atomically-status :restart-jumper) :cl) + (:jne 'not-simple-restart-jumper) + (:testl ,(bt:enum-value 'movitz::atomically-status '(:eax :ebx :ecx :edx)) + :ecx) ; map of registers to restore + (:jnz 'not-simple-restart-jumper) + (:shrl 16 :ecx) ; move atomically-status data into ECX + (:movl (:ebp -24) :eax) ; This is the interruptee's ESI/funobj + (:movl (:eax (:ecx 4) ,(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0)) + :ecx) ; This is the EIP to restart + (:movl :ecx (:ebp 20)) + (:movl (:ebp -32) :ecx) + (:testl ,(bt:enum-value 'movitz::atomically-status :reset-status-p) + :ecx) ; Should we reset status to zero? + (:jnz 'normal-return) + (:xorl :ecx :ecx) ; Do reset status to zero. + (:jmp 'normal-return) + not-simple-restart-jumper ;; Don't know what to do. (:halt) (:int 90)

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 02 Jun '04

02 Jun '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv6383 Modified Files: los0-gc.lisp Log Message: Added another thread-atomically mechanism, allowing a jumper to be the restart-point. Date: Wed Jun 2 03:39:54 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.14 movitz/losp/los0-gc.lisp:1.15 --- movitz/losp/los0-gc.lisp:1.14 Tue Jun 1 08:17:04 2004 +++ movitz/losp/los0-gc.lisp Wed Jun 2 03:39:54 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.14 2004/06/01 15:17:04 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.15 2004/06/02 10:39:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -68,8 +68,8 @@ (:cmpl #x3fff4 :ecx) (:jge '(:sub-program (allocation-failed) ;; Exit thread-atomical -;;; (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) -;;; (:edi (:edi-offset atomically-status)))) + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) (:int 113) ;; This interrupt can be retried. (:jmp 'retry-cons))) @@ -95,62 +95,91 @@ (:ret) not-fixnum retry-cons + (:locally (:movl ,(movitz::atomically-status-simple-pf 'fast-cons t) + (:edi (:edi-offset atomically-status)))) (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) (:movl (:edx 2) :eax) (:cmpl #x3fff4 :eax) (:jge '(:sub-program () + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) (:int 113) ; This interrupt can be retried. (:jmp 'retry-cons))) (:movl ,(dpb 1 (byte 16 16) (movitz:tag :bignum 0)) (:edx :eax 2)) (:movl :ecx (:edx :eax 6)) (:addl 8 :eax) - (:movl :eax (:edx 2)) + (:movl :eax (:edx 2)) ; Commit allocation + ;; Exit thread-atomical + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) (:leal (:edx :eax) :eax) - (:ret) - (:int 107)))) + (:ret)))) (do-it))) (defun los0-malloc-clumps (clumps) - (check-type clumps (integer 0 4000)) - (with-inline-assembly (:returns :eax) - retry - (:compile-form (:result-mode :ebx) clumps) - (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) - (:movl (:edx 2) :ecx) - (:leal ((:ebx 2) :ecx) :eax) - (:cmpl #x3fff4 :eax) - (:jge '(:sub-program () - (:compile-form (:result-mode :ignore) - (stop-and-copy)) - (:jmp 'retry))) - (:movl :eax (:edx 2)) - (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) - (:leal (:edx :ecx 8) :eax) - (:xorl :ecx :ecx) - init-loop ; Now init eax number of clumps. - (:movl :edi (:eax (:ecx 2) -6)) - (:movl :edi (:eax (:ecx 2) -2)) - (:addl 4 :ecx) - (:cmpl :ebx :ecx) - (:jb 'init-loop))) + (check-type clumps (integer 0 16000)) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + retry + (:compile-form (:result-mode :ebx) clumps) + (:declare-label-set retry-jumper (retry)) + (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t) + 'retry-jumper) + (:edi (:edi-offset atomically-status)))) + (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) + (:movl (:edx 2) :ecx) + (:leal ((:ebx 2) :ecx) :eax) + (:cmpl #x3fff4 :eax) + (:jge '(:sub-program () + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) + (:compile-form (:result-mode :ignore) + (stop-and-copy)) + (:jmp 'retry))) + (:movl :eax (:edx 2)) + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) + (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) + (:leal (:edx :ecx 8) :eax) + (:xorl :ecx :ecx) + init-loop ; Now init eax number of clumps. + (:movl :edi (:eax (:ecx 2) -6)) + (:movl :edi (:eax (:ecx 2) -2)) + (:addl 4 :ecx) + (:cmpl :ebx :ecx) + (:jb 'init-loop)))) + (do-it))) (defun los0-malloc-data-clumps (clumps) (check-type clumps (integer 0 4000)) - (with-inline-assembly (:returns :eax) - retry - (:compile-form (:result-mode :ebx) clumps) - (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) - (:movl (:edx 2) :ecx) - (:leal ((:ebx 2) :ecx) :eax) - (:cmpl #x3fff4 :eax) - (:jge '(:sub-program () - (:compile-form (:result-mode :ignore) - (stop-and-copy)) - (:jmp 'retry))) - (:movl :eax (:edx 2)) - (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) - (:leal (:edx :ecx 8) :eax))) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + retry + (:compile-form (:result-mode :ebx) clumps) + (:declare-label-set retry-jumper (retry)) + (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t) + 'retry-jumper) + (:edi (:edi-offset atomically-status)))) + (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) + (:movl (:edx 2) :ecx) + (:leal ((:ebx 2) :ecx) :eax) + (:cmpl #x3fff4 :eax) + (:jge '(:sub-program () + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) + (:compile-form (:result-mode :ignore) + (stop-and-copy)) + (:jmp 'retry))) + (:movl :eax (:edx 2)) + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) + + (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) + (:leal (:edx :ecx 8) :eax)))) + (do-it))) (defun los0-handle-out-of-memory (exception interrupt-frame) (declare (ignore exception interrupt-frame))

1 0

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

02 Jun '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6221 Modified Files: image.lisp Log Message: Added another thread-atomically mechanism, allowing a jumper to be the restart-point. Date: Wed Jun 2 03:39:48 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.33 movitz/image.lisp:1.34 --- movitz/image.lisp:1.33 Tue Jun 1 08:16:49 2004 +++ movitz/image.lisp Wed Jun 2 03:39:48 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.33 2004/06/01 15:16:49 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.34 2004/06/02 10:39:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -452,9 +452,10 @@ :initform (make-segment-descriptor)) (atomically-status :binary-type (define-bitfield atomically-status (lu32) - (((:enum :byte (2 3)) + (((:enum :byte (3 2)) :inactive 0 - :restart-primitive-function 1) ; data = slot-offset of pf. + :restart-primitive-function 1 ; data = slot-offset of pf. + :restart-jumper 2) ; data = ESI-relative jumper number. ((:bits) :reset-status-p 8 :eax 9 :ebx 10 @@ -485,6 +486,16 @@ :movitz))) 4))) registers))) + +(defun atomically-status-jumper-fn (reset-status-p &rest registers) + (lambda (jumper) + (assert (= 0 (mod jumper 4))) + (bt:enum-value 'movitz::atomically-status + (list* :restart-jumper + (cons :reset-status-p + (if reset-status-p 1 0)) + (cons :data (truncate jumper 4)) + registers)))) (defmethod movitz-object-offset ((obj movitz-constant-block)) 0)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by Frode Vatvedt Fjeld 01 Jun '04

01 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23639 Modified Files: interrupt.lisp Log Message: Fixed the atomically stuff to mostly working. Date: Tue Jun 1 08:17:08 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.8 movitz/losp/muerte/interrupt.lisp:1.9 --- movitz/losp/muerte/interrupt.lisp:1.8 Tue Jun 1 06:42:19 2004 +++ movitz/losp/muerte/interrupt.lisp Tue Jun 1 08:17:08 2004 @@ -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.8 2004/06/01 13:42:19 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.9 2004/06/01 15:17:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -164,18 +164,26 @@ restart-atomical-block (:cmpb ,(bt:enum-value 'movitz::atomically-status :restart-primitive-function) :cl) (:jne 'not-simple-atomical-pf-restart) - (:cmpb 0 :ch) ; map of registers to restore + (:testl ,(bt:enum-value 'movitz::atomically-status '(:eax :ebx :ecx :edx)) + :ecx) ; map of registers to restore (:jnz 'not-simple-atomical-pf-restart) (:sarl 16 :ecx) ; move atomically-status data into ECX (:movl (:edi (:ecx 4) ,(- (movitz:tag :null))) :ecx) ; This is the EIP to restart (:movl :ecx (:ebp 20)) + (:movl (:ebp -32) :ecx) + (:testl ,(bt:enum-value 'movitz::atomically-status :reset-status-p) + :ecx) ; Should we reset status to zero? + (:jnz 'normal-return) + (:xorl :ecx :ecx) ; Do reset status to zero. (:jmp 'normal-return) not-simple-atomical-pf-restart ;; Don't know what to do. + (:halt) (:int 90) (:jmp 'not-simple-atomical-pf-restart) - ))))) + ))) + (do-it))) (defvar *last-interrupt-frame* nil)

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 01 Jun '04

01 Jun '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv23601 Modified Files: los0-gc.lisp Log Message: Fixed the atomically stuff to mostly working. Date: Tue Jun 1 08:17:04 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.13 movitz/losp/los0-gc.lisp:1.14 --- movitz/losp/los0-gc.lisp:1.13 Tue Jun 1 06:42:14 2004 +++ movitz/losp/los0-gc.lisp Tue Jun 1 08:17:04 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.13 2004/06/01 13:42:14 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.14 2004/06/01 15:17:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -61,7 +61,7 @@ `(with-inline-assembly (:returns :eax) retry-cons ;; Set up thread-atomical execution - (:locally (:movl ,(movitz::atomically-status-simple-pf 'fast-cons) + (:locally (:movl ,(movitz::atomically-status-simple-pf 'fast-cons t) (:edi (:edi-offset atomically-status)))) (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) (:movl (:edx 2) :ecx)

1 0

[movitz-cvs] CVS update: movitz/stream-image.lisp
by Frode Vatvedt Fjeld 01 Jun '04

01 Jun '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23570 Modified Files: stream-image.lisp Log Message: Fixed the atomically stuff to mostly working. Date: Tue Jun 1 08:16:59 2004 Author: ffjeld Index: movitz/stream-image.lisp diff -u movitz/stream-image.lisp:1.5 movitz/stream-image.lisp:1.6 --- movitz/stream-image.lisp:1.5 Mon May 24 07:58:07 2004 +++ movitz/stream-image.lisp Tue Jun 1 08:16:59 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Aug 27 14:46:50 2001 ;;;; -;;;; $Id: stream-image.lisp,v 1.5 2004/05/24 14:58:07 ffjeld Exp $ +;;;; $Id: stream-image.lisp,v 1.6 2004/06/01 15:16:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -79,7 +79,7 @@ (read-binary 'movitz-symbol (image-stream image))) (:other (setf (image-stream-position image) - (+ 4 (extract-pointer word))) + (+ 0 (extract-pointer word))) (let* ((type-code (read-binary 'u8 (image-stream image))) (type-tag (enum-symbolic-value 'other-type-byte type-code))) (setf (image-stream-position image)

1 0

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

01 Jun '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23551 Modified Files: procfs-image.lisp Log Message: Fixed the atomically stuff to mostly working. Date: Tue Jun 1 08:16:54 2004 Author: ffjeld Index: movitz/procfs-image.lisp diff -u movitz/procfs-image.lisp:1.5 movitz/procfs-image.lisp:1.6 --- movitz/procfs-image.lisp:1.5 Wed Apr 14 05:11:32 2004 +++ movitz/procfs-image.lisp Tue Jun 1 08:16:54 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.5 2004/04/14 12:11:32 ffjeld Exp $ +;;;; $Id: procfs-image.lisp,v 1.6 2004/06/01 15:16:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -177,7 +177,7 @@ (loop with unknown-counter = 0 for stack-frame = (current-stack-frame) then (previous-stack-frame stack-frame) unless (zerop (mod stack-frame 4)) - do (format t "[#x~8,'0x]" stack-frame) + do (format t "[frame #x~8,'0x]" stack-frame) and do (loop-finish) do (let ((movitz-name (funobj-name (stack-frame-funobj stack-frame)))) (typecase movitz-name @@ -191,7 +191,8 @@ (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})" + (when r (format t "#x~X (ret #x~X {EAX: #x~X, ECX: #x~X, EDI: #x~X, EIP: #x~X, exception ~D})" + stack-frame r eax ecx edi eip exception)))) (movitz-symbol (let ((name (movitz-print movitz-name)))

1 0