movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[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

[movitz-cvs] CVS update: movitz/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-serv23525 Modified Files: image.lisp Log Message: Fixed the atomically stuff to mostly working. Date: Tue Jun 1 08:16:49 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.32 movitz/image.lisp:1.33 --- movitz/image.lisp:1.32 Tue Jun 1 06:42:06 2004 +++ movitz/image.lisp Tue Jun 1 08:16:49 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.32 2004/06/01 13:42:06 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.33 2004/06/01 15:16:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -455,11 +455,11 @@ (((:enum :byte (2 3)) :inactive 0 :restart-primitive-function 1) ; data = slot-offset of pf. - ((:bits) :reset-status-p 7 - :eax 8 - :ebx 9 - :ecx 10 - :edx 11) + ((:bits) :reset-status-p 8 + :eax 9 + :ebx 10 + :ecx 11 + :edx 12) ((:numeric :data 16 16)))) :initform '(:inactive)) (atomically-registers @@ -477,11 +477,13 @@ (cons :reset-status-p (if reset-status-p 1 0)) (cons :data - (truncate (+ (tag :null) - (bt:slot-offset 'movitz-constant-block - (intern (symbol-name pf-name) - :movitz))) - 4)) + (if (not pf-name) + 0 + (truncate (+ (tag :null) + (bt:slot-offset 'movitz-constant-block + (intern (symbol-name pf-name) + :movitz))) + 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-serv10409/losp/muerte Modified Files: interrupt.lisp Log Message: Added concept of "thread-atomical" code, which allows some small section of code to run atomically with respect to the same thread (i.e. should the thread be interrupted for whatever reason). "Atomically" is here used in the sense all-or-nothing. Such code-blocks can still be interrupted, but if so, it will be re-started from some declared starting-point. Date: Tue Jun 1 06:42:19 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.7 movitz/losp/muerte/interrupt.lisp:1.8 --- movitz/losp/muerte/interrupt.lisp:1.7 Sun Apr 18 16:17:58 2004 +++ movitz/losp/muerte/interrupt.lisp Tue Jun 1 06:42:19 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.7 2004/04/18 23:17:58 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.8 2004/06/01 13:42:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -29,12 +29,12 @@ form (- 5 (position name '(nil :eflags :eip :error-code :exception :ebp nil - :ecx :eax :edx :ebx :esi :edi)))))) + :ecx :eax :edx :ebx :esi :edi :atomically-status)))))) (defun interrupt-frame-index (name) (- 5 (position name '(nil :eflags :eip :error-code :exception :ebp nil - :ecx :eax :edx :ebx :esi :edi)))) + :ecx :eax :edx :ebx :esi :edi :atomically-status)))) (define-compiler-macro interrupt-frame-ref (&whole form frame reg type &optional (offset 0) &environment env) @@ -48,100 +48,134 @@ (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+ +;;; `(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))))) - (with-inline-assembly (:returns :multiple-values) - ok - ;; Stack: - ;; 20: Interruptee EFLAGS (later EIP) - ;; 16: Interruptee CS (later EFLAGS) - ;; 12: Interruptee EIP - ;; 8: Error code - ;; 4: Exception number - ;; 0: EBP - (:pushl :ebp) - (:movl :esp :ebp) - (:pushl 0) ; 0 means default-interrupt-trampoline frame - (:pushl :ecx) ; -8 - (:pushl :eax) ; -12 - (:pushl :edx) ; -16 - (:pushl :ebx) ; -20 - (:pushl :esi) ; -24 - (:pushl :edi) ; -28 - - ;; rearrange stack for return - (:movl (:ebp 12) :eax) ; load return address - (:movl (:ebp 20) :ebx) ; load EFLAGS - (:movl :ebx (:ebp 16)) ; EFLAGS at next-to-bottom of stack - (:movl :eax (:ebp 20)) ; return address at bottom of stack - - (:xorl :eax :eax) ; Ensure safe value - (:xorl :edx :edx) ; Ensure safe value - - (:movl ':nil-value :edi) ; We want NIL! + ((5) :jmp 'ok)))) + ok + ;; Stack: + ;; 20: Interruptee EFLAGS (later EIP) + ;; 16: Interruptee CS (later EFLAGS) + ;; 12: Interruptee EIP + ;; 8: Error code + ;; 4: Exception number + ;; 0: EBP + (:pushl :ebp) + (:movl :esp :ebp) + (:pushl 0) ; 0 means default-interrupt-trampoline frame + (:pushl :ecx) ; -8 + (:pushl :eax) ; -12 + (:pushl :edx) ; -16 + (:pushl :ebx) ; -20 + (:pushl :esi) ; -24 + (:pushl :edi) ; -28 + (:movl ':nil-value :edi) ; We want NIL! + (:locally (:pushl (:edi (:edi-offset atomically-status)))) ; -32 + + (:locally (:movl 0 (:edi (:edi-offset atomically-status)))) + + ;; rearrange stack for return + (:movl (:ebp 12) :eax) ; load return address + (:movl (:ebp 20) :ebx) ; load EFLAGS + (:movl :ebx (:ebp 16)) ; EFLAGS at next-to-bottom of stack + (:movl :eax (:ebp 20)) ; return address at bottom of stack + + (:xorl :eax :eax) ; Ensure safe value + (:xorl :edx :edx) ; Ensure safe value + + (:pushl (:ebp 16)) ; EFLAGS + (:pushl :cs) ; push CS + (:call (:pc+ 0)) ; push EIP. + ;; Now add a few bytes to the on-stack EIP so the iret goes to + ;; *DEST* below. + ((4) :addl 5 (:esp)) ; 4 bytes + ((1) :iretd) ; 1 byte - (:pushl (:ebp 16)) ; EFLAGS - (:pushl :cs) ; push CS - (:call (:pc+ 0)) ; push EIP. - ;; Now add a few bytes to the on-stack EIP so the iret goes to - ;; *DEST* below. - ((4) :addl 5 (:esp)) ; 4 bytes - ((1) :iretd) ; 1 byte - - ;; *DEST* iret branches to here. - ;; we're now in the context of the interruptee. + ;; *DEST* iret branches to here. + ;; we're now in the context of the interruptee. - ;; Save/push thread-local values - (:locally (:movl (:edi (:edi-offset num-values)) :ecx)) - (:jecxz 'push-values-done) - (:leal (:edi #.(movitz::global-constant-offset 'values)) :eax) - push-values-loop - (:locally (:pushl (:eax))) - (:addl 4 :eax) - (:subl 1 :ecx) - (:jnz 'push-values-loop) - push-values-done - (:locally (:pushl (:edi (:edi-offset num-values)))) + ;; Save/push thread-local values + (:locally (:movl (:edi (:edi-offset num-values)) :ecx)) + (:jecxz 'push-values-done) + (:leal (:edi #.(movitz::global-constant-offset 'values)) :eax) + push-values-loop + (:locally (:pushl (:eax))) + (:addl 4 :eax) + (:subl 1 :ecx) + (:jnz 'push-values-loop) + push-values-done + (:locally (:pushl (:edi (:edi-offset num-values)))) + + ;; call handler + (:movl (:ebp 4) :ecx) ; interrupt number into ECX + (:locally (:movl (:edi (:edi-offset interrupt-handlers)) :eax)) + (:movl (:eax 2 (:ecx 4)) :esi) ; funobj at (aref EBX interrupt-handlers) into :esi + (:movl :ebp :ebx) ; pass interrupt-frame as arg1 + (:movl (:ebp 4) :ecx) ; pass interrupt number as arg 0. + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) + (:call (:esi ,(bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector%2op))) + + skip-interrupt-handler + ;; Restore thread-local values + (:popl :ecx) + (:locally (:movl :ecx (:edi (:edi-offset num-values)))) + (:jecxz 'pop-values-done) + pop-values-loop + ;; ((:fs-override) :popl (:edi #.(movitz::global-constant-offset 'values) (:ecx 4) -4)) + (:locally (:popl (:edi (:edi-offset values) (:ecx 4) -4))) + (:subl 1 :ecx) + (:jnz 'pop-values-loop) + pop-values-done + + (:movl (:ebp -32) :ecx) ; Check interruptee's atomically status + (:testb :cl :cl) + (:jnz 'restart-atomical-block) + + ;; Interrupted code was non-atomical, the normal case. + normal-return ; With atomically-status-to-restore in ECX + (:locally (:movl :ecx (:edi (:edi-offset atomically-status)))) + (:movl (:ebp -28) :edi) + (:movl (:ebp -24) :esi) + (:movl (:ebp -20) :ebx) + (:movl (:ebp -16) :edx) + (:movl (:ebp -12) :eax) + (:movl (:ebp -8) :ecx) + (:leave) + (:addl 12 :esp) + (:popfl) ; pop EFLAGS + (:ret) ; pop EIP - ;; call handler - (:movl (:ebp 4) :ecx) ; interrupt number into ECX - (:locally (:movl (:edi (:edi-offset interrupt-handlers)) :eax)) - (:movl (:eax 2 (:ecx 4)) :esi) ; funobj at (aref EBX interrupt-handlers) into :esi - (:movl :ebp :ebx) ; pass interrupt-frame as arg1 - (:movl (:ebp 4) :ecx) ; pass interrupt number as arg 0. - (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax) - (:call (:esi #.(movitz::slot-offset 'movitz::movitz-funobj 'movitz::code-vector%2op))) - - skip-interrupt-handler - ;; Restore thread-local values - (:popl :ecx) - (:locally (:movl :ecx (:edi (:edi-offset num-values)))) - (:jecxz 'pop-values-done) - pop-values-loop - ;; ((:fs-override) :popl (:edi #.(movitz::global-constant-offset 'values) (:ecx 4) -4)) - (:locally (:popl (:edi (:edi-offset values) (:ecx 4) -4))) - (:subl 1 :ecx) - (:jnz 'pop-values-loop) - pop-values-done - - (:movl (:ebp -28) :edi) - (:movl (:ebp -24) :esi) - (:movl (:ebp -20) :ebx) - (:movl (:ebp -16) :edx) - (:movl (:ebp -12) :eax) - (:movl (:ebp -8) :ecx) - - (:leave) - (:addl 12 :esp) - (:popfl) ; pop EFLAGS - (:ret))) ; pop EIP + 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 + (: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)) + (:jmp 'normal-return) + not-simple-atomical-pf-restart + ;; Don't know what to do. + (:int 90) + (:jmp 'not-simple-atomical-pf-restart) + ))))) (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-serv10384/losp Modified Files: los0-gc.lisp Log Message: Added concept of "thread-atomical" code, which allows some small section of code to run atomically with respect to the same thread (i.e. should the thread be interrupted for whatever reason). "Atomically" is here used in the sense all-or-nothing. Such code-blocks can still be interrupted, but if so, it will be re-started from some declared starting-point. Date: Tue Jun 1 06:42:14 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.12 movitz/losp/los0-gc.lisp:1.13 --- movitz/losp/los0-gc.lisp:1.12 Mon May 24 12:32:46 2004 +++ movitz/losp/los0-gc.lisp Tue Jun 1 06:42:14 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.12 2004/05/24 19:32:46 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.13 2004/06/01 13:42:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -56,21 +56,33 @@ (define-primitive-function los0-fast-cons () "Allocate a cons cell from nursery-space." - (with-inline-assembly (:returns :eax) - retry-cons - (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) - (:movl (:edx 2) :ecx) - (:cmpl #x3fff4 :ecx) - (:jge '(:sub-program () - (:int 113) - ;; This interrupt can be retried. - (:jmp 'retry-cons))) - (:movl :eax (:edx :ecx 2)) - (:movl :ebx (:edx :ecx 6)) - (:leal (:edx :ecx 3) :eax) - (:addl 8 :ecx) - (:movl :ecx (:edx 2)) - (:ret))) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + retry-cons + ;; Set up thread-atomical execution + (:locally (:movl ,(movitz::atomically-status-simple-pf 'fast-cons) + (:edi (:edi-offset atomically-status)))) + (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) + (:movl (:edx 2) :ecx) + (: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)))) + (:int 113) + ;; This interrupt can be retried. + (:jmp 'retry-cons))) + (:movl :eax (:edx :ecx 2)) + (:movl :ebx (:edx :ecx 6)) + (:addl 8 :ecx) + (:movl :ecx (:edx 2)) ; Commit allocation + ;; Exit thread-atomical + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) + (:leal (:edx :ecx -5) :eax) + (:ret)))) + (do-it))) (define-primitive-function los0-box-u32-ecx () "Make u32 in ECX into a fixnum or bignum."

1 0

[movitz-cvs] CVS update: movitz/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-serv10362 Modified Files: image.lisp Log Message: Added concept of "thread-atomical" code, which allows some small section of code to run atomically with respect to the same thread (i.e. should the thread be interrupted for whatever reason). "Atomically" is here used in the sense all-or-nothing. Such code-blocks can still be interrupted, but if so, it will be re-started from some declared starting-point. Date: Tue Jun 1 06:42:06 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.31 movitz/image.lisp:1.32 --- movitz/image.lisp:1.31 Mon May 24 12:05:59 2004 +++ movitz/image.lisp Tue Jun 1 06:42:06 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.31 2004/05/24 19:05:59 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.32 2004/06/01 13:42:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -450,11 +450,39 @@ (segment-descriptor-7 :binary-type segment-descriptor :initform (make-segment-descriptor)) + (atomically-status + :binary-type (define-bitfield atomically-status (lu32) + (((:enum :byte (2 3)) + :inactive 0 + :restart-primitive-function 1) ; data = slot-offset of pf. + ((:bits) :reset-status-p 7 + :eax 8 + :ebx 9 + :ecx 10 + :edx 11) + ((:numeric :data 16 16)))) + :initform '(:inactive)) + (atomically-registers + :binary-type lu32 + :initform 0) (bochs-flags :binary-type lu32 :initform 0) ) (:slot-align null-cons -1)) + +(defun atomically-status-simple-pf (pf-name reset-status-p &rest registers) + (bt:enum-value 'movitz::atomically-status + (list* :restart-primitive-function + (cons :reset-status-p + (if reset-status-p 1 0)) + (cons :data + (truncate (+ (tag :null) + (bt:slot-offset 'movitz-constant-block + (intern (symbol-name pf-name) + :movitz))) + 4)) + registers))) (defmethod movitz-object-offset ((obj movitz-constant-block)) 0)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.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-serv8756 Modified Files: integers.lisp Log Message: Added bignum support in evenp, and thus also oddp. Date: Tue Jun 1 06:38:35 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.12 movitz/losp/muerte/integers.lisp:1.13 --- movitz/losp/muerte/integers.lisp:1.12 Mon May 24 15:38:03 2004 +++ movitz/losp/muerte/integers.lisp Tue Jun 1 06:38:35 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.12 2004/05/24 22:38:03 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.13 2004/06/01 13:38:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -32,15 +32,28 @@ (typep x 'fixnum)) (defun evenp (x) - (with-inline-assembly (:returns :ebx) - (:compile-form (:result-mode :eax) x) - (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx)) - (:testb #.(cl:1+ (cl:* 2 movitz::+movitz-fixnum-zmask+)) :al) - (:jz 'done) - (:movl :edi :ebx) - (:testb #.movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program (not-fixnum) (:int 107) (:jmp (:pc+ -4)))) - done)) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :ebx) + (:compile-form (:result-mode :eax) x) + (:movl :eax :ecx) + (:andl 7 :ecx) + (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx)) + (:cmpl ,(movitz:tag :even-fixnum) :ecx) + (:je 'done) + (:movl :edi :ebx) + (:cmpl ,(movitz:tag :odd-fixnum) :ecx) + (:je 'done) + (:cmpl ,(movitz:tag :other) :ecx) + (:jnz '(:sub-program (not-integer) + (:int 107))) + (:cmpb ,(movitz:tag :bignum) (:eax ,movitz:+other-type-offset+)) + (:jne 'not-integer) + (:testb 1 (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:jnz 'done) + (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx)) + done))) + (do-it))) (defun oddp (x) (not (evenp x))) @@ -64,6 +77,7 @@ (cons constant-term non-constant-operands)))))) `(+ (+%2op ,(first operands) ,(second operands)) ,@(cddr operands)))))) +#+ignore (defun +%2op (term1 term2) (check-type term1 fixnum) (check-type term2 fixnum) @@ -73,37 +87,36 @@ (:addl :ebx :eax) (:into))) -#+ignore -(define-compiler-macro +%2op (&whole form term1 term2) - (cond - ((and (movitz:movitz-constantp term1) ; first operand zero? - (zerop (movitz:movitz-eval term1))) - term2) ; (+ 0 x) => x - ((and (movitz:movitz-constantp term2) ; second operand zero? - (zerop (movitz:movitz-eval term2))) - term1) ; (+ x 0) => x - ((and (movitz:movitz-constantp term1) - (movitz:movitz-constantp term2)) - (+ (movitz:movitz-eval term1) - (movitz:movitz-eval term2))) ; compile-time constant folding. - ((movitz:movitz-constantp term1) - (let ((constant-term1 (movitz:movitz-eval term1))) - (check-type constant-term1 (signed-byte 30)) - `(with-inline-assembly (:returns :register :side-effects nil) ; inline - (:compile-form (:result-mode :register) ,term2) - (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term1) (:result-register)) - (:into)))) - ((movitz:movitz-constantp term2) - (let ((constant-term2 (movitz:movitz-eval term2))) - (check-type constant-term2 (signed-byte 30)) - `(with-inline-assembly (:returns :register :side-effects nil) ; inline - (:compile-form (:result-mode :register) ,term1) - (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term2) (:result-register)) - (:into)))) - (t `(with-inline-assembly (:returns :eax :side-effects nil) - (:compile-two-forms (:ebx :eax) ,term1 ,term2) - (:addl :ebx :eax) - (:into))))) +;;;(define-compiler-macro +%2op (&whole form term1 term2) +;;; (cond +;;; ((and (movitz:movitz-constantp term1) ; first operand zero? +;;; (zerop (movitz:movitz-eval term1))) +;;; term2) ; (+ 0 x) => x +;;; ((and (movitz:movitz-constantp term2) ; second operand zero? +;;; (zerop (movitz:movitz-eval term2))) +;;; term1) ; (+ x 0) => x +;;; ((and (movitz:movitz-constantp term1) +;;; (movitz:movitz-constantp term2)) +;;; (+ (movitz:movitz-eval term1) +;;; (movitz:movitz-eval term2))) ; compile-time constant folding. +;;; ((movitz:movitz-constantp term1) +;;; (let ((constant-term1 (movitz:movitz-eval term1))) +;;; (check-type constant-term1 (signed-byte 30)) +;;; `(with-inline-assembly (:returns :register :side-effects nil) ; inline +;;; (:compile-form (:result-mode :register) ,term2) +;;; (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term1) (:result-register)) +;;; (:into)))) +;;; ((movitz:movitz-constantp term2) +;;; (let ((constant-term2 (movitz:movitz-eval term2))) +;;; (check-type constant-term2 (signed-byte 30)) +;;; `(with-inline-assembly (:returns :register :side-effects nil) ; inline +;;; (:compile-form (:result-mode :register) ,term1) +;;; (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term2) (:result-register)) +;;; (:into)))) +;;; (t `(with-inline-assembly (:returns :eax :side-effects nil) +;;; (:compile-two-forms (:ebx :eax) ,term1 ,term2) +;;; (:addl :ebx :eax) +;;; (:into))))) (defun 1+ (number) (+ 1 number)) @@ -194,7 +207,7 @@ ((movitz:movitz-constantp subtrahend) (let ((constant-subtrahend (movitz:movitz-eval subtrahend))) (check-type constant-subtrahend (signed-byte 30)) - `(+%2op ,minuend ,(- constant-subtrahend)))) + `(+ ,minuend ,(- constant-subtrahend)))) (t `(with-inline-assembly (:returns :eax :side-effects nil) (:compile-two-forms (:eax :ebx) ,minuend ,subtrahend) (:subl :ebx :eax)

1 0

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

24 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27230 Modified Files: integers.lisp Log Message: Renamed normalize-u32-ecx to box-u32-ecx, and added primitive-function box-u32 that does the inverse. Improved aref and (setf aref) of u32-vectors accordingly. Date: Mon May 24 18:38:10 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.11 movitz/losp/muerte/integers.lisp:1.12 --- movitz/losp/muerte/integers.lisp:1.11 Mon May 24 10:58:51 2004 +++ movitz/losp/muerte/integers.lisp Mon May 24 18:38:03 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.11 2004/05/24 14:58:51 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.12 2004/05/24 22:38:03 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -807,7 +807,7 @@ (:movl :edi :eax) (:cld) (:pushl :edx) - (:call-global-constant normalize-u32-ecx) + (:call-global-constant box-u32-ecx) (:popl :ebx) (:jmp 'done) not-size1 @@ -827,7 +827,7 @@ (:movl :edi :eax) (:cld) (:pushl :edx) - (:call-global-constant normalize-u32-ecx) + (:call-global-constant box-u32-ecx) (:popl :ebx) (:jmp 'done) not-size2

1 0

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

24 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv28476 Modified Files: arrays.lisp Log Message: Renamed normalize-u32-ecx to box-u32-ecx, and added primitive-function box-u32 that does the inverse. Improved aref and (setf aref) of u32-vectors accordingly. Date: Mon May 24 17:51:52 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.21 movitz/losp/muerte/arrays.lisp:1.22 --- movitz/losp/muerte/arrays.lisp:1.21 Mon May 24 10:59:15 2004 +++ movitz/losp/muerte/arrays.lisp Mon May 24 17:51:52 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.21 2004/05/24 14:59:15 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.22 2004/05/24 21:51:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -240,10 +240,7 @@ (:cmpl ,(movitz:vector-type-tag :u32) :ecx) (:jne 'not-u32) (:movl (:eax (:ebx 4) 2) :ecx) ; u32 - (:cmpl ,movitz:+movitz-most-positive-fixnum+ :ecx) - (:jg '(:sub-program (:overflowing-u32) - (:int 107))) - (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) + (:call-global-constant box-u32-ecx) (:jmp 'done) not-u32 @@ -329,15 +326,13 @@ not-u16 (:cmpl ,(movitz:vector-type-tag :u32) :edx) (:jnz 'not-u32) - (:testl ,(ldb (byte 32 0) - (- -1 (* #xffffffff movitz:+movitz-fixnum-factor+))) - :ebx) - (:jnz '(:sub-program (not-u32-value) - (:compile-form (:result-mode :ignore) - (error "Value not (unsigned-byte 32): ~S" value)))) - (:shrl ,movitz:+movitz-fixnum-shift+ :ebx) - (:movl :ebx (:eax (:ecx 4) ,(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) - (:leal ((:ebx ,movitz:+movitz-fixnum-factor+)) :ebx) + ;; EBX=value, EAX=vector, ECX=index + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :edx) + (:xchgl :eax :ebx) + ;; EAX=value, EBX=vector, EDX=index + (:call-global-constant unbox-u32) + (:movl :ecx (:ebx (:edx 1) ,(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:movl :eax :ebx) (:jmp 'done) not-u32

1 0

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

24 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1344 Modified Files: primitive-functions.lisp Log Message: Renamed normalize-u32-ecx to box-u32-ecx, and added primitive-function box-u32 that does the inverse. Improved aref and (setf aref) of u32-vectors accordingly. Date: Mon May 24 15:34:34 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.18 movitz/losp/muerte/primitive-functions.lisp:1.19 --- movitz/losp/muerte/primitive-functions.lisp:1.18 Mon May 24 10:58:56 2004 +++ movitz/losp/muerte/primitive-functions.lisp Mon May 24 15:34:34 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.18 2004/05/24 14:58:56 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.19 2004/05/24 19:34:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -505,8 +505,8 @@ (:ret))) -(define-primitive-function normalize-u32-ecx () - "Make u32 in ECX into a fixnum or bignum." +(define-primitive-function box-u32-ecx () + "Make u32 in ECX into a fixnum or bignum in EAX." (with-inline-assembly (:returns :multiple-values) (:cmpl #.movitz:+movitz-most-positive-fixnum+ :ecx) (:ja 'not-fixnum) @@ -514,6 +514,32 @@ (:ret) not-fixnum (:int 107))) ; not implemented by default! + +(define-primitive-function unbox-u32 () + "Coerce EAX into a u32 in ECX, or signal type error. +Preserve EAX, EBX, and EDX." + (macrolet + ((do-it () + `(with-inline-assembly (:returns :multiple-values) + (:testl ,(logior #x80000000 movitz:+movitz-fixnum-zmask+) + :eax) + (:jnz 'not-fixnum) + (:movl :eax :ecx) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) + (:ret) + not-fixnum + (:leal (:eax ,(- (movitz:tag :other))) :ecx) + (:testb 7 :cl) + (:jnz 'fail) + (:cmpl ,(dpb 1 (byte 16 16) (movitz:tag :bignum 0)) + (:eax ,movitz:+other-type-offset+)) + (:jne 'fail) + (:movl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) + :ecx) + (:ret) + fail + (:int 107)))) + (do-it))) ;;;;

1 0

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

24 May '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv15649 Modified Files: los0-gc.lisp Log Message: Renamed normalize-u32-ecx to box-u32-ecx, and added primitive-function box-u32 that does the inverse. Improved aref and (setf aref) of u32-vectors accordingly. Date: Mon May 24 15:32:46 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.11 movitz/losp/los0-gc.lisp:1.12 --- movitz/losp/los0-gc.lisp:1.11 Mon May 24 10:58:34 2004 +++ movitz/losp/los0-gc.lisp Mon May 24 15:32:46 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.11 2004/05/24 14:58:34 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.12 2004/05/24 19:32:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -72,7 +72,7 @@ (:movl :ecx (:edx 2)) (:ret))) -(define-primitive-function los0-normalize-u32-ecx () +(define-primitive-function los0-box-u32-ecx () "Make u32 in ECX into a fixnum or bignum." (macrolet ((do-it () @@ -157,9 +157,9 @@ (check-type conser vector) (setf (%run-time-context-slot 'muerte::fast-cons) conser)) - (let ((conser (symbol-value 'los0-normalize-u32-ecx))) + (let ((conser (symbol-value 'los0-box-u32-ecx))) (check-type conser vector) - (setf (%run-time-context-slot 'muerte::normalize-u32-ecx) + (setf (%run-time-context-slot 'muerte::box-u32-ecx) conser)) (let ((old-malloc (symbol-function 'muerte:malloc-clumps))) (setf (symbol-function 'muerte:malloc-clumps)

1 0

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