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

[movitz-cvs] CVS update: movitz/losp/muerte/integers.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-serv2677 Modified Files: integers.lisp Log Message: Added some bignum support to +, i.e. two fixnums may now overflow to a bignum. Also changed - a bit. Date: Wed Jun 2 13:34:04 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.13 movitz/losp/muerte/integers.lisp:1.14 --- movitz/losp/muerte/integers.lisp:1.13 Tue Jun 1 06:38:35 2004 +++ movitz/losp/muerte/integers.lisp Wed Jun 2 13:34:04 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.13 2004/06/01 13:38:35 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.14 2004/06/02 20:34:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -28,6 +28,13 @@ (deftype positive-bignum () `(integer ,(1+ movitz:+movitz-most-positive-fixnum+) *)) +(defmacro number-double-dispatch ((x y) &rest clauses) + `(let ((x ,x) (y ,y)) + (cond ,@(loop for ((x-type y-type) . then-body) in clauses + collect `((and (typep x ',x-type) (typep y ',y-type)) + ,@then-body)) + (t (error "Not numbers: ~S or ~S." x y))))) + (defun fixnump (x) (typep x 'fixnum)) @@ -134,16 +141,32 @@ (numargs-case (1 (x) x) (2 (x y) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) x) - (:compile-form (:result-mode :ebx) y) - (:movl :eax :ecx) - (:orl :ebx :ecx) - (:testb #.movitz::+movitz-fixnum-zmask+ :cl) - (:jnz '(:sub-program (not-integer) ; - (:int 107))) - (:addl :ebx :eax) - (:into))) + (macrolet + ((do-it () + `(number-double-dispatch (x y) + ((fixnum fixnum) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) x) + (:compile-form (:result-mode :ebx) y) + (:addl :ebx :eax) + (:jo '(:sub-program (fix-fix-overflow) + (:movl :eax :ecx) + (:jns 'fix-fix-negative) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) + (:call-global-constant box-u32-ecx) + (:jmp 'fix-fix-ok) + fix-fix-negative + (:negl :ecx) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) + (:call-global-constant box-u32-ecx) + (:movl ,(dpb 1 (byte 16 16) + (movitz:tag :bignum #xff)) + (:eax ,movitz:+other-type-offset+)) + (:jmp 'fix-fix-ok) + )) + fix-fix-ok + ))))) + (do-it))) (3 (x y z) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) x) @@ -153,7 +176,8 @@ (:orl :ebx :ecx) (:orl :edx :ecx) (:testb #.movitz::+movitz-fixnum-zmask+ :cl) - (:jnz 'not-integer) + (:jnz '(:sub-program (not-integer) + (:int 107))) (:addl :ebx :eax) (:into) (:addl :edx :eax) @@ -171,62 +195,34 @@ ;;; Subtraction -(define-compiler-macro - (&whole form &rest operands) +(define-compiler-macro - (&whole form &rest operands &environment env) (case (length operands) (0 0) - (1 `(-%2op 0 ,(first operands))) - (2 `(-%2op ,(first operands) ,(second operands))) - (t `(- (-%2op ,(first operands) ,(second operands)) - ,@(cddr operands))))) - - -(define-compiler-macro -%2op (&whole form minuend subtrahend) - (cond - ((and (movitz:movitz-constantp minuend) ; first operand zero? - (zerop (movitz:movitz-eval minuend))) - `(with-inline-assembly (:returns :register :side-effects nil) - (:compile-form (:result-mode :register) ,subtrahend) - (:negl (:result-register)) ; (- 0 x) => -x - (:into))) - ((and (movitz:movitz-constantp subtrahend) ; second operand zero? - (zerop (movitz:movitz-eval subtrahend))) - (movitz:movitz-eval minuend)) ; (- x 0) => x - ((and (movitz:movitz-constantp minuend) - (movitz:movitz-constantp subtrahend)) - (- (movitz:movitz-eval minuend) - (movitz:movitz-eval subtrahend))) ; compile-time constant folding. - ((movitz:movitz-constantp minuend) - (let ((constant-minuend (movitz:movitz-eval minuend))) - (check-type constant-minuend (signed-byte 30)) - `(with-inline-assembly (:returns :register :side-effects nil) ; inline - (:compile-form (:result-mode :register) ,subtrahend) - (:subl ,(* movitz::+movitz-fixnum-factor+ constant-minuend) (:result-register)) - ;;;;;;; NEED CHECKING HERE - (:into) - (:negl (:result-register))))) - ((movitz:movitz-constantp subtrahend) - (let ((constant-subtrahend (movitz:movitz-eval subtrahend))) - (check-type constant-subtrahend (signed-byte 30)) - `(+ ,minuend ,(- constant-subtrahend)))) - (t `(with-inline-assembly (:returns :eax :side-effects nil) - (:compile-two-forms (:eax :ebx) ,minuend ,subtrahend) - (:subl :ebx :eax) - (:into))))) - -(defun -%2op (minuend subtrahend) - (check-type minuend fixnum) - (check-type subtrahend fixnum) - (-%2op minuend subtrahend)) + (1 `(- 0 ,(first operands))) + (2 (let ((minuend (first operands)) + (subtrahend (second operands))) + (cond + ((movitz:movitz-constantp subtrahend env) + `(+ ,minuend ,(- (movitz:movitz-eval subtrahend env)))) + (t form)))) + (t `(- ,(first operands) (+ ,@(rest operands)))))) (defun - (minuend &rest subtrahends) (declare (dynamic-extent subtrahends)) - (if subtrahends - (reduce #'-%2op subtrahends :initial-value minuend) - (-%2op 0 minuend))) + (numargs-case + (2 (minuend subtrahend) + (check-type minuend fixnum) + (check-type subtrahend fixnum) + (with-inline-assembly (:returns :eax :side-effects nil) + (:compile-two-forms (:eax :ebx) minuend subtrahend) + (:subl :ebx :eax) + (:into))) + (t (minuend &rest subtrahends) + (declare (dynamic-extent subtrahends)) + (if subtrahends + (reduce #'- subtrahends :initial-value minuend) + (- 0 minuend))))) -;;;(defmacro decf (place &optional (delta-form 1)) -;;; `(setf ,place (- ,place ,delta-form))) - (define-modify-macro decf (&optional (delta-form 1)) -) ;;; Comparison @@ -775,13 +771,6 @@ (:idivl :ebx :eax :edx) (:shll #.movitz::+movitz-fixnum-shift+ :eax)))))) (t form))) - -(defmacro number-double-dispatch ((x y) &rest clauses) - `(let ((x ,x) (y ,y)) - (cond ,@(loop for ((x-type y-type) . then-body) in clauses - collect `((and (typep x ',x-type) (typep y ',y-type)) - ,@then-body)) - (t (error "Not numbers: ~S or ~S." x y))))) (defun truncate (number &optional (divisor 1)) (numargs-case

1 0

[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