Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv15709
Modified Files:
interrupt.lisp
Log Message:
*** empty log message ***
Date: Thu Nov 11 11:08:45 2004
Author: ffjeld
Index: movitz/losp/muerte/interrupt.lisp
diff -u movitz/losp/muerte/interrupt.lisp:1.29 movitz/losp/muerte/interrupt.lisp:1.30
--- movitz/losp/muerte/interrupt.lisp:1.29 Mon Oct 11 15:52:54 2004
+++ movitz/losp/muerte/interrupt.lisp Thu Nov 11 11:08:44 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.29 2004/10/11 13:52:54 ffjeld Exp $
+;;;; $Id: interrupt.lisp,v 1.30 2004/11/11 10:08:44 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -62,6 +62,14 @@
(defun dit-frame-ref (stack frame reg &optional (type :lisp))
(stack-frame-ref stack frame (dit-frame-index reg) type))
+(define-compiler-macro (setf dit-frame-ref) (&whole form value stack frame reg
+ &optional (type :lisp)
+ &environment env)
+ (if (not (and (movitz:movitz-constantp stack env)
+ (eq nil (movitz:movitz-eval stack env))))
+ form
+ `(setf (memref ,frame (dit-frame-offset ,reg) :type ,type) ,value)))
+
;;;(defun (setf dit-frame-ref) (x reg type &optional (frame *last-dit-frame*))
;;; (setf (memref frame (dit-frame-offset reg) 0 type) x))
@@ -117,7 +125,7 @@
:key #'dit-frame-index)
collect `(:pushl ,reg))
(:locally (:pushl (:edi (:edi-offset scratch1))))
-
+
(:locally (:movl (:edi (:edi-offset nursery-space)) :eax))
(:pushl :eax) ; debug0: nursery-space
(:pushl (:eax 2)) ; debug1: nursery-space's fresh-pointer
@@ -126,9 +134,9 @@
;; Do RET atomicification
(:movl (:ebp ,(dit-frame-offset :eip)) :ecx)
- (:cmpb ,(realpart (ia-x86:asm :ret)) (:ecx))
+ ((:cs-override) :cmpb ,(realpart (ia-x86:asm :ret)) (:ecx))
(:jne 'not-at-ret-instruction)
- (:locally (:movl (:edi (:edi-offset ret-trampoline)) :ecx))
+ (:globally (:movl (:edi (:edi-offset ret-trampoline)) :ecx))
(:movl :ecx (:ebp ,(dit-frame-offset :eip)))
not-at-ret-instruction
@@ -259,6 +267,9 @@
)))
(do-it)))
+
+
+
(defun interrupt-default-handler (vector dit-frame)
(declare (without-check-stack-limit))
(macrolet ((dereference (fixnum-address &optional (type :lisp))
@@ -277,7 +288,7 @@
(3 (break "Break instruction at ~@Z." $eip))
(4 (error "Primitive overflow assertion failed."))
(6 (error "Illegal instruction at ~@Z." $eip))
- (13 (error "General protection error. EIP=~@Z, error-code: #x~X, EAX: ~@Z, EBX: ~@Z, ECX: ~@Z"
+ (13 (error "General protection error. EIP=~@Z, error-code: #x~X, EAX: ~@Z, EBX: ~@Z, ECX: ~@Z"
$eip
(dit-frame-ref nil dit-frame :error-code :unsigned-byte32)
$eax $ebx $ecx))
@@ -309,6 +320,7 @@
(stack (%run-time-context-slot 'movitz::stack-vector))
(real-bottom (- (object-location stack) 2))
(stack-left (- old-bottom real-bottom))
+ (old-es (segment-register :es))
(old-dynamic-env (%run-time-context-slot 'dynamic-env))
(new-bottom (cond
((< stack-left 50)
@@ -325,8 +337,9 @@
(unwind-protect
(progn
(setf (%run-time-context-slot 'stack-bottom) new-bottom
- (%run-time-context-slot 'dynamic-env) 0)
- (format *debug-io* "~&Stack-warning: Bumped stack-bottom by ~D to #x~X. Reset ENV.~%"
+ (%run-time-context-slot 'dynamic-env) 0
+ (segment-register :es) (segment-register :ds))
+ (format *debug-io* "~&Stack-warning: Bumped stack-bottom by ~D to #x~X. Reset ENV and ES.~%"
(- old-bottom new-bottom)
new-bottom)
(break "Stack overload exception ~D at EIP=~@Z, ESP=~@Z, bottom=#x~X, ENV=#x~X."
@@ -337,7 +350,8 @@
(format *debug-io* "~&Stack-warning: Resetting stack-bottom to #x~X.~%"
old-bottom)
(setf (%run-time-context-slot 'stack-bottom) old-bottom
- (%run-time-context-slot 'dynamic-env) old-dynamic-env))))
+ (%run-time-context-slot 'dynamic-env) old-dynamic-env
+ (segment-register :es) old-es))))
(69
(error "Not a function: ~S" (dereference $edx)))
(70