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

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18401 Modified Files: interrupt.lisp Log Message: Renamed int-frame- to interrupt-frame- Date: Tue Apr 6 20:34:47 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.1 movitz/losp/muerte/interrupt.lisp:1.2 --- movitz/losp/muerte/interrupt.lisp:1.1 Tue Apr 6 20:12:23 2004 +++ movitz/losp/muerte/interrupt.lisp Tue Apr 6 20:34:47 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.1 2004/04/07 00:12:23 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.2 2004/04/07 00:34:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,7 +22,7 @@ `(with-inline-assembly (:returns :eax) (:movl (:esp ,(* 4 offset)) :eax))) -(define-compiler-macro int-frame-index (&whole form name &environment env) +(define-compiler-macro interrupt-frame-index (&whole form name &environment env) (let ((name (and (movitz:movitz-constantp name env) (movitz:movitz-eval name env)))) (if (not name) @@ -31,19 +31,20 @@ '(nil :eflags :eip :error-code :exception :ebp nil :ecx :eax :edx :ebx :esi :edi)))))) -(defun int-frame-index (name) +(defun interrupt-frame-index (name) (- 5 (position name '(nil :eflags :eip :error-code :exception :ebp nil :ecx :eax :edx :ebx :esi :edi)))) -(define-compiler-macro int-frame-ref (&whole form frame reg type &optional (offset 0) &environment env) - `(memref ,frame (+ (* 4 (int-frame-index ,reg)) ,offset) 0 ,type)) +(define-compiler-macro interrupt-frame-ref (&whole form frame reg type &optional (offset 0) + &environment env) + `(memref ,frame (+ (* 4 (interrupt-frame-index ,reg)) ,offset) 0 ,type)) -(defun int-frame-ref (frame reg type &optional (offset 0)) - (int-frame-ref frame reg type offset)) +(defun interrupt-frame-ref (frame reg type &optional (offset 0)) + (interrupt-frame-ref frame reg type offset)) -(defun (setf int-frame-ref) (x frame reg type) - (setf (memref frame (* 4 (int-frame-index reg)) 0 type) x)) +(defun (setf interrupt-frame-ref) (x frame reg type) + (setf (memref frame (* 4 (interrupt-frame-index reg)) 0 type) x)) (define-primitive-function default-interrupt-trampoline () "Default first-stage interrupt handler." @@ -118,8 +119,8 @@ (:jnz 'skip-interrupt-handler) ; if it's not a symbol, never mind. (:movl (:eax #.(movitz::slot-offset 'movitz::movitz-symbol 'movitz::function-value)) :esi) ; load new funobj from symbol into ESI - (:movl :ebp :ebx) ; pass INT-frame as arg1 - ;; (:movl :ebx (:ebp -4)) ; put INT-frame as our fake stack-frame's funobj. + (:movl :ebp :ebx) ; pass interrupt-frame as arg1 + ;; (:movl :ebx (:ebp -4)) ; put interrupt-frame as our fake stack-frame's funobj. (:movl (:ebp 4) :eax) ; pass interrupt number as arg 0. (:shll #.movitz::+movitz-fixnum-shift+ :eax) (:call (:esi #.(movitz::slot-offset 'movitz::movitz-funobj 'movitz::code-vector%2op))) @@ -150,18 +151,18 @@ (defvar *last-interrupt-frame* nil) -(defun interrupt-default-handler (number int-frame) +(defun interrupt-default-handler (number interrupt-frame) (declare (without-check-stack-limit)) (macrolet ((@ (fixnum-address &optional (type :lisp)) "Dereference the fixnum-address." `(memref ,fixnum-address 0 0 ,type))) - (let (($eip (+ int-frame (int-frame-index :eip))) - ($eax (+ int-frame (int-frame-index :eax))) - ($ebx (+ int-frame (int-frame-index :ebx))) - ($ecx (+ int-frame (int-frame-index :ecx))) - ($edx (+ int-frame (int-frame-index :edx))) - ($esi (+ int-frame (int-frame-index :esi))) - (*last-interrupt-frame* int-frame)) + (let (($eip (+ interrupt-frame (interrupt-frame-index :eip))) + ($eax (+ interrupt-frame (interrupt-frame-index :eax))) + ($ebx (+ interrupt-frame (interrupt-frame-index :ebx))) + ($ecx (+ interrupt-frame (interrupt-frame-index :ecx))) + ($edx (+ interrupt-frame (interrupt-frame-index :edx))) + ($esi (+ interrupt-frame (interrupt-frame-index :esi))) + (*last-interrupt-frame* interrupt-frame)) (block nil (case number (0 (error "Division by zero.")) @@ -169,7 +170,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 - (int-frame-ref int-frame :error-code :unsigned-byte32) + (interrupt-frame-ref interrupt-frame :error-code :unsigned-byte32) $eax $ebx $ecx)) (68 (warn "EIP: ~@Z EAX: ~@Z EBX: ~@Z ECX: ~@Z EDX: ~@Z" $eip $eax $ebx $ecx $edx) @@ -179,7 +180,7 @@ (dotimes (i 100000) (with-inline-assembly (:returns :nothing) (:nop)))) (66 (error "Unspecified type error at ~@Z in ~S with EAX=~@Z, ECX=~@Z." - $eip (@ (+ int-frame (int-frame-index :esi))) + $eip (@ (+ interrupt-frame (interrupt-frame-index :esi))) $eax $ecx)) (62 (error "Trying to save too many values: ~@Z." $ecx)) ((5 55) @@ -204,7 +205,7 @@ new-bottom) (break "Stack overload exception ~D at ESP=~@Z with bottom #x~X." number - (+ int-frame (int-frame-index :ebp)) + (+ interrupt-frame (interrupt-frame-index :ebp)) old-bottom)) (format *debug-io* "~&Stack-warning: Resetting stack-bottom to #x~X.~%" old-bottom) @@ -222,12 +223,13 @@ (when (symbolp name) (error 'unbound-variable :name name)))) ((100);; 101 102 103 104 105) - (let ((funobj (@ (+ int-frame (int-frame-index :esi)))) - (code (int-frame-ref int-frame :ecx :unsigned-byte8))) + (let ((funobj (@ (+ interrupt-frame (interrupt-frame-index :esi)))) + (code (interrupt-frame-ref interrupt-frame :ecx :unsigned-byte8))) (error 'wrong-argument-count :function funobj :argument-count (if (logbitp 7 code) - (ash (int-frame-ref int-frame :ecx :unsigned-byte32) + (ash (interrupt-frame-ref interrupt-frame + :ecx :unsigned-byte32) -24) code)))) (108

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19936 Modified Files: packages.lisp Log Message: More symbols added. Date: Tue Apr 6 20:34:07 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.13 movitz/packages.lisp:1.14 --- movitz/packages.lisp:1.13 Tue Apr 6 10:35:14 2004 +++ movitz/packages.lisp Tue Apr 6 20:34:06 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.13 2004/04/06 14:35:14 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.14 2004/04/07 00:34:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1104,19 +1104,21 @@ #:*print-safely* - stack-ref - with-each-dynamic-context - stack-frame-uplink - current-stack-frame - current-dynamic-context - stack-frame-funobj - stack-frame-call-site - stack-frame-ref - check-stack-limit + #:stack-ref + #:with-each-dynamic-context + #:stack-frame-uplink + #:current-stack-frame + #:current-dynamic-context + #:stack-frame-funobj + #:stack-frame-call-site + #:stack-frame-ref + #:check-stack-limit + #:interrupt-frame-ref + #:interrupt-handler - *build-number* - *error-no-condition-for-debugger* - formatted-error + #:*build-number* + #:*error-no-condition-for-debugger* + #:formatted-error #:package-object-use-list #:package-object-internal-symbols @@ -1289,6 +1291,7 @@ #:+movitz-fixnum-factor+ #:+movitz-fixnum-shift+ + #:+movitz-fixnum-zmask+ #:+scan-skip-word+ #:constant0

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11575 Modified Files: special-operators.lisp Log Message: There's something funny in my lisp-mode that sometimes causes comments to be messed up like this.. Date: Tue Apr 6 20:21:29 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.17 movitz/special-operators.lisp:1.18 --- movitz/special-operators.lisp:1.17 Wed Mar 31 11:33:25 2004 +++ movitz/special-operators.lisp Tue Apr 6 20:21:28 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.17 2004/03/31 16:33:25 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.18 2004/04/07 00:21:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -711,9 +711,8 @@ as sub-form-result-mode = buried-result-modes then (or (cdr sub-form-result-mode) sub-form-result-mode) - as current-result-mode = (if (endp (cdr sub-form)) all but the - ;; last form have result-mode as - ;; declared + as current-result-mode = (if (endp (cdr sub-form)) + ;; all but the last form have result-mode as declared result-mode (car sub-form-result-mode)) as last-form-p = (endp (cdr sub-form))

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17952 Modified Files: basic-functions.lisp Log Message: Added object-location-offset operator, but I'm not really sure it's useful afterall, so I commented it out for now. Date: Tue Apr 6 20:20:13 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.9 movitz/losp/muerte/basic-functions.lisp:1.10 --- movitz/losp/muerte/basic-functions.lisp:1.9 Wed Mar 31 21:10:38 2004 +++ movitz/losp/muerte/basic-functions.lisp Tue Apr 6 20:20:12 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 18:41:57 2001 ;;;; -;;;; $Id: basic-functions.lisp,v 1.9 2004/04/01 02:10:38 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.10 2004/04/07 00:20:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -340,6 +340,18 @@ (defun object-location (object) "The location is the object's address divided by fixnum-factor." (object-location object)) + +;;;(define-compiler-macro object-location-offset (object) +;;; "The offset from the object's location to it's true address." +;;; `(with-inline-assembly (:returns :register) +;;; (:compile-form (:result-mode :register) ,object) +;;; (:shll ,movitz:+movitz-fixnum-shift+ (:result-register)) +;;; (:andl ,(* movitz:+movitz-fixnum-factor+ +;;; movitz:+movitz-fixnum-zmask+) +;;; (:result-register)))) +;;; +;;;(defun object-location-offset (object) +;;; (object-location-offset object)) (defun halt-cpu () (halt-cpu))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp
by Frode Vatvedt Fjeld 07 Apr '04

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31649 Modified Files: run-time-context.lisp Log Message: Added %run-time-context-ref function. Date: Tue Apr 6 20:18:57 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.4 movitz/losp/muerte/run-time-context.lisp:1.5 --- movitz/losp/muerte/run-time-context.lisp:1.4 Wed Mar 31 11:47:40 2004 +++ movitz/losp/muerte/run-time-context.lisp Tue Apr 6 20:18:57 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.4 2004/03/31 16:47:40 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.5 2004/04/07 00:18:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -116,6 +116,18 @@ (memref context (+ -6 4) index8 :unsigned-byte8) (ldb (byte 8 16) value) (memref context (+ -6 7) index8 :unsigned-byte8) (ldb (byte 6 24) value))))) value)) + +(defun %run-time-context-ref (edi-offset) + "Get a run-time-context slot by its EDI-relative offset." + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) edi-offset) + (:leal (:eax #.(cl:* 1 movitz:+movitz-fixnum-factor+)) :ecx) + (:sarl #.movitz:+movitz-fixnum-shift+ :ecx) + (:testb 3 :cl) + (:jnz '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Illegal edi-offset ~S" edi-offset)))) + (:locally (:movl (:edi :ecx -1) :eax)))) (defun clone-run-time-context (&key (parent (current-run-time-context)) (name :anonymous))

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27042 Modified Files: typep.lisp Log Message: An explicit error is better than an ecase error in typep. Date: Tue Apr 6 20:17:19 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.5 movitz/losp/muerte/typep.lisp:1.6 --- movitz/losp/muerte/typep.lisp:1.5 Mon Mar 29 09:34:20 2004 +++ movitz/losp/muerte/typep.lisp Tue Apr 6 20:17:19 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.5 2004/03/29 14:34:20 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.6 2004/04/07 00:17:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -285,7 +285,7 @@ (defun typep (object type-specifier) (block nil - (etypecase type-specifier + (typecase type-specifier (symbol (let ((typep-function (gethash type-specifier *simple-typespecs*))) (when typep-function

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27042 Modified Files: scavenge.lisp Log Message: Much improved support for scavenging stacks with interrupts on them. Date: Tue Apr 6 20:16:38 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.4 movitz/losp/muerte/scavenge.lisp:1.5 --- movitz/losp/muerte/scavenge.lisp:1.4 Tue Apr 6 10:33:10 2004 +++ movitz/losp/muerte/scavenge.lisp Tue Apr 6 20:16:38 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.4 2004/04/06 14:33:10 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.5 2004/04/07 00:16:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -96,11 +96,80 @@ and frame = (stack-frame-uplink start-stack-frame) then (stack-frame-uplink frame) while (plusp frame) do (let ((funobj (stack-frame-funobj frame t))) - (etypecase funobj - (integer - (error "Don't know how to scavenge across an interrupt frame.")) + #+ignore + (format t "~&fill ~S frame for ~S" + (aref (%run-time-context-slot 'nursery-space) 0) + funobj) + (typecase funobj (function (assert (= 0 (funobj-frame-num-unboxed funobj))) - (map-heap-words function (+ nether-frame 2) frame))))) + (map-heap-words function (+ nether-frame 2) frame)) + ((eql 0) + ;; 1. Scavenge the interrupt-frame + (map-heap-words function + (+ nether-frame 2) + (+ frame (int-frame-index :ecx))) + (let* ((interrupt-frame frame) + (interrupted-eip-loc + (int-frame-ref interrupt-frame :eip :signed-byte30+2))) + ;; 2. Pop to interrupted frame + (setf nether-frame frame + frame (stack-frame-uplink frame)) + (let ((interrupted-funobj (stack-frame-funobj frame)) + (interrupted-esp (+ interrupt-frame 6))) + (assert (typep interrupted-funobj 'function) () + "Interrupted frame was not a normal function: ~S" + interrupted-funobj) + ;; 3. Scavenge the interrupted frame, skipping EFLAGS etc. + (if (location-in-object-p (funobj-code-vector interrupted-funobj) + interrupted-eip-loc) + ;; The simple case: The interruptee matches interrupted EIP + (map-heap-words function interrupted-esp frame) + (let ((primitive-function-vector + (stack-frame-primitive-funcall interrupted-funobj + interrupted-esp + interrupted-eip-loc))) + (if primitive-function-vector + ;; Next simplest case: The interruptee was in a primitive-function, + ;; with the return-address at top of stack. + (map-heap-words function (1+ interrupted-esp) frame) + (error "Don't know how to scavenge across interrupt frame at ~S." + interrupt-frame))))))) + (t (error "Don't know how to scavenge across a frame of kind ~S." funobj))))) (values)) +(defparameter *primitive-funcall-patterns* + '(#xff #x57 (:function-offset :signed8))) + +(defun stack-frame-primitive-funcall (funobj stack-location eip-location) + (let ((return-address (memref stack-location 0 0 :unsigned-byte32)) + (code-vector (funobj-code-vector funobj))) + (multiple-value-bind (return-location return-delta) + (truncate return-address #.movitz:+movitz-fixnum-factor+) + (if (not (location-in-object-p code-vector return-location)) + nil + (multiple-value-bind (success-p type code) + (match-code-pattern *primitive-funcall-patterns* + code-vector (+ (* (- return-location + (object-location code-vector)) + #.movitz:+movitz-fixnum-factor+) + return-delta + -3 -8) + :function-offset) + (if (not success-p) + (warn "mismatch in ~S at ~D from #x~X in ~Z." + funobj + (+ (* (- return-location + (object-location code-vector)) + #.movitz:+movitz-fixnum-factor+) + return-delta + -3 -8) + return-address code-vector) + (let* ((offset (ecase type + (:signed8 + (if (not (logbitp 7 code)) code (- code 256))))) + (primitive-function (%word-offset (%run-time-context-ref offset) -2))) + (check-type primitive-function vector-u8) + (if (not (location-in-object-p primitive-function eip-location)) + nil + primitive-function))))))))

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31200 Modified Files: primitive-functions.lisp Log Message: Minor edits to comments. Date: Tue Apr 6 20:15:45 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.6 movitz/losp/muerte/primitive-functions.lisp:1.7 --- movitz/losp/muerte/primitive-functions.lisp:1.6 Sun Mar 28 20:09:46 2004 +++ movitz/losp/muerte/primitive-functions.lisp Tue Apr 6 20:15:44 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.6 2004/03/29 01:09:46 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.7 2004/04/07 00:15:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -90,13 +90,13 @@ ;;; Dynamic binding: -;;; 12: parent (NIL == #x0) +;;; 12: parent (no parent == #x0) ;;; 8: value ;;; 4: tag = #:unbound (unique value that cannot be a catch tag) ;;; 0: binding name/symbol ;;; Catch exit-point: -;;; 12: parent (NIL == #x0) +;;; 12: parent (no parent == #x0) ;;; 8: eip ;;; 4: catch tag object/word ;;; 0: ebp/stack-frame

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv8835 Modified Files: memref.lisp Log Message: Improve memref a bit more. Date: Tue Apr 6 20:15:05 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.10 movitz/losp/muerte/memref.lisp:1.11 --- movitz/losp/muerte/memref.lisp:1.10 Tue Apr 6 10:25:44 2004 +++ movitz/losp/muerte/memref.lisp Tue Apr 6 20:15:02 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.10 2004/04/06 14:25:44 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.11 2004/04/07 00:15:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -182,15 +182,19 @@ (:jg '(:sub-program () (:int 4))))))))) (:lisp (cond - ((and (eq 0 index) (eq 0 offset)) + ((and (eql 0 index) (eql 0 offset)) `(with-inline-assembly (:returns :register) (:compile-form (:result-mode :register) ,object) (:movl ((:result-register) ,(offset-by 4)) (:result-register)))) - ((eq 0 offset) + ((eql 0 offset) `(with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ecx) ,object ,index) ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx)) + (:movl (:eax :ecx ,(offset-by 4)) :eax))) + ((eql 0 index) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,offset) (:movl (:eax :ecx ,(offset-by 4)) :eax))) (t (assert (not (movitz:movitz-constantp offset env))) (assert (not (movitz:movitz-constantp index env)))

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15041 Modified Files: common-lisp.lisp Log Message: Include :muerte/interrupt. Date: Tue Apr 6 20:13:02 2004 Author: ffjeld Index: movitz/losp/muerte/common-lisp.lisp diff -u movitz/losp/muerte/common-lisp.lisp:1.3 movitz/losp/muerte/common-lisp.lisp:1.4 --- movitz/losp/muerte/common-lisp.lisp:1.3 Mon Mar 29 09:33:01 2004 +++ movitz/losp/muerte/common-lisp.lisp Tue Apr 6 20:13:02 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:41:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: common-lisp.lisp,v 1.3 2004/03/29 14:33:01 ffjeld Exp $ +;;;; $Id: common-lisp.lisp,v 1.4 2004/04/07 00:13:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -43,6 +43,7 @@ (require :muerte/eval) (require :muerte/los-closette) (require :muerte/environment) +(require :muerte/interrupt) (require :muerte/streams) (require :muerte/restarts) (require :muerte/conditions)

1 0