Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv28233
Modified Files:
interrupt.lisp
Log Message:
Rename interrupt-frame- to dit-frame
("default-interrupt-trampoline-frame-"). Also, reworked the
default-interrupt-trampoline a bit, re-arranged the frame layout etc.
Date: Thu Aug 12 09:57:15 2004
Author: ffjeld
Index: movitz/losp/muerte/interrupt.lisp
diff -u movitz/losp/muerte/interrupt.lisp:1.19 movitz/losp/muerte/interrupt.lisp:1.20
--- movitz/losp/muerte/interrupt.lisp:1.19 Tue Jul 27 06:50:08 2004
+++ movitz/losp/muerte/interrupt.lisp Thu Aug 12 09:57:15 2004
@@ -10,59 +10,77 @@
;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org>
;;;; Created at: Wed Apr 7 01:50:03 2004
;;;;
-;;;; $Id: interrupt.lisp,v 1.19 2004/07/27 13:50:08 ffjeld Exp $
+;;;; $Id: interrupt.lisp,v 1.20 2004/08/12 16:57:15 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
-(in-package #:muerte)
+(in-package muerte)
(provide :muerte/interrupt)
-(defvar *last-interrupt-frame* nil)
+(defvar *last-dit-frame* nil)
-(defmacro stack-word (offset)
- `(with-inline-assembly (:returns :eax)
- (:movl (:esp ,(* 4 offset)) :eax)))
+(defun dit-frame-esp (dit-frame)
+ (+ dit-frame 6))
-(define-compiler-macro interrupt-frame-index (&whole form name &environment env)
+(defconstant +dit-frame-map+
+ '(nil :eflags :eip :error-code :exception-vector :ebp :funobj
+ :edi
+ :atomically-status
+ :atomically-esp
+ :scratch0
+ :ecx :eax :edx :ebx :esi))
+
+(define-compiler-macro dit-frame-index (&whole form name &environment env)
(let ((name (and (movitz:movitz-constantp name env)
(movitz:movitz-eval name env))))
(if (not name)
form
- (- 5 (position name
- '(nil :eflags :eip :error-code :exception :ebp nil
- :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 :atomically-status))))
+ (- 5 (position name +dit-frame-map+)))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun dit-frame-index (name)
+ (- 5 (position name +dit-frame-map+)))
+ (defun dit-frame-offset (name)
+ (* 4 (dit-frame-index name))))
-(define-compiler-macro interrupt-frame-ref (&whole form reg type
+(define-compiler-macro dit-frame-ref (&whole form reg type
&optional (offset 0)
- (frame '*last-interrupt-frame*)
+ (frame '*last-dit-frame*)
&environment env)
- `(memref ,frame (+ (* 4 (interrupt-frame-index ,reg)) ,offset) 0 ,type))
+ `(memref ,frame (+ (dit-frame-offset ,reg) ,offset) 0 ,type))
-(defun interrupt-frame-ref (reg type &optional (offset 0) (frame *last-interrupt-frame*))
- (interrupt-frame-ref reg type offset frame))
+(defun dit-frame-ref (reg type &optional (offset 0) (frame *last-dit-frame*))
+ (dit-frame-ref reg type offset frame))
-(defun (setf interrupt-frame-ref) (x reg type &optional (frame *last-interrupt-frame*))
- (setf (memref frame (* 4 (interrupt-frame-index reg)) 0 type) x))
+(defun (setf dit-frame-ref) (x reg type &optional (frame *last-dit-frame*))
+ (setf (memref frame (dit-frame-offset reg) 0 type) x))
-(define-primitive-function default-interrupt-trampoline ()
- "Default first-stage interrupt handler."
+(defun dit-frame-casf (dit-frame)
+ "Compute the `currently active stack-frame' when the interrupt occurred."
+ (let ((ebp (dit-frame-ref :ebp :lisp 0 dit-frame))
+ (esp (dit-frame-esp dit-frame)))
+ (if (< esp ebp)
+ ebp
+ (let ((next-ebp (memref ebp 0 0 :lisp)))
+ (check-type next-ebp fixnum)
+ (assert (< esp next-ebp))
+ next-ebp))))
+
+(define-primitive-function (default-interrupt-trampoline :symtab-property t) ()
+ "Default first-stage/trampoline interrupt handler. Assumes the IF flag in EFLAGS
+is off, e.g. because this interrupt/exception is routed through an interrupt gate."
(macrolet
((do-it ()
`(with-inline-assembly (:returns :multiple-values)
- ,@(loop for i from 0 to movitz::+idt-size+
+ ,@(loop for i from 0 to 255
+ append (list i)
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))))
+ `((:pushl ,i)
+ (:jmp 'ok))
+ `((:pushl 0) ; replace Error Code
+ (:pushl ,i)
+ (:jmp 'ok))))
ok
;; Stack:
;; 20: Interruptee EFLAGS (later EIP)
@@ -73,16 +91,16 @@
;; 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 0) ; 0 'funobj' means default-interrupt-trampoline frame
(:pushl :edi) ; -28
(:movl ':nil-value :edi) ; We want NIL!
- (:locally (:pushl (:edi (:edi-offset atomically-status)))) ; -32
- (:locally (:pushl (:edi (:edi-offset atomically-esp)))) ; -36
+ (:locally (:pushl (:edi (:edi-offset atomically-status))))
+ (:locally (:pushl (:edi (:edi-offset atomically-esp))))
+ (:locally (:pushl (:edi (:edi-offset scratch0))))
+ ,@(loop for reg in (sort (copy-list '(:eax :ebx :ecx :edx :esi))
+ #'>
+ :key #'dit-frame-index)
+ collect `(:pushl ,reg))
(:locally (:movl 0 (:edi (:edi-offset atomically-status))))
@@ -110,7 +128,7 @@
;; 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)
+ (:leal (:edi (:offset movitz-run-time-context values)) :eax)
push-values-loop
(:locally (:pushl (:eax)))
(:addl 4 :eax)
@@ -120,12 +138,11 @@
(: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)
+ (:movl (:ebp ,(dit-frame-offset :exception-vector)) :ecx)
+ (:locally (:movl (:edi (:edi-offset exception-handlers)) :eax))
+ (:movl (:eax 2 (:ecx 4)) :esi) ; funobj at (aref ECX exception-handlers) into :esi
+ (:movl :ebp :ebx) ; pass dit-frame as arg1
+ (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) ; pass interrupt number as arg 0.
(:call (:esi ,(bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector%2op)))
skip-interrupt-handler
@@ -140,40 +157,43 @@
(:jnz 'pop-values-loop)
pop-values-done
- (:movl (:ebp -32) :ecx) ; Check interruptee's atomically status
+ (:movl (:ebp ,(dit-frame-offset :atomically-status)) :ecx)
(: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 -36) :ecx) ; Load interruptee's atomically-esp..
- (:locally (:movl :ecx (:edi (:edi-offset atomically-esp)))) ; ..and restore it.
- (:movl (:ebp -28) :edi)
- (:movl (:ebp -24) :esi)
- (:movl (:ebp -20) :ebx)
- (:movl (:ebp -16) :edx)
- (:movl (:ebp -12) :eax)
- (:movl (:ebp -8) :ecx)
- ;; Make stack safe before we exit interrupt-frame..
+ (:movl (:ebp ,(dit-frame-offset :atomically-esp)) :ecx)
+ (:locally (:movl :ecx (:edi (:edi-offset atomically-esp))))
+ (:movl (:ebp ,(dit-frame-offset :scratch0)) :ecx)
+ (:locally (:movl :ecx (:edi (:edi-offset scratch0))))
+ (:movl (:ebp ,(dit-frame-offset :edi)) :edi)
+ (:movl (:ebp ,(dit-frame-offset :esi)) :esi)
+ (:movl (:ebp ,(dit-frame-offset :ebx)) :ebx)
+ (:movl (:ebp ,(dit-frame-offset :edx)) :edx)
+ (:movl (:ebp ,(dit-frame-offset :eax)) :eax)
+ (:movl (:ebp ,(dit-frame-offset :ecx)) :ecx)
+ ;; Make stack safe before we exit dit-frame..
(:movl :edi (:ebp 4))
(:movl :edi (:ebp 8))
(:movl :edi (:ebp 12))
+ (:cli) ; Clear IF in EFLAGS before leaving dit-frame.
(:leave)
(:addl 12 :esp)
- (:popfl) ; pop EFLAGS
+ (:popfl) ; pop EFLAGS (also resets IF)
(:ret) ; pop EIP
restart-atomical-block
(:cmpb ,(bt:enum-value 'movitz::atomically-status :restart-primitive-function) :cl)
(:jne 'not-simple-atomical-pf-restart)
- (:testl #xff00 :ecx) ; map of registers to restore
+ (:testl #xfe00 :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)
+ (:movl (:ebp ,(dit-frame-offset :atomically-status)) :ecx)
(:testl ,(bt:enum-value 'movitz::atomically-status :reset-status-p)
:ecx) ; Should we reset status to zero?
(:jnz 'normal-return)
@@ -187,9 +207,9 @@
(:jnz 'atomically-esp-ok)
;; Generate the correct ESP for interruptee's atomically-esp
(:leal (:ebp 24) :ecx)
- (:movl :ecx (:ebp -36))
+ (:movl :ecx (:ebp ,(dit-frame-offset :atomically-esp)))
atomically-esp-ok
- (:movl (:ebp -32) :ecx)
+ (:movl (:ebp ,(dit-frame-offset :atomically-status)) :ecx)
(:testl ,(bt:enum-value 'movitz::atomically-status :reset-status-p)
:ecx) ; Should we reset status to zero?
(:jnz 'atomically-jumper-return)
@@ -197,22 +217,22 @@
atomically-jumper-return
(:locally (:movl :ecx (:edi (:edi-offset atomically-status))))
- (:movl (:ebp -36) :ecx) ; Load interruptee's atomically-esp..
+ (:movl (:ebp ,(dit-frame-offset :atomically-esp)) :ecx) ; Load interruptee's atomically-esp..
(:locally (:movl :ecx (:edi (:edi-offset atomically-esp)))) ; ..and restore it.
(:testl #x40 (:ebp 16)) ; Test EFLAGS bit DF
(:jnz 'atomically-jumper-return-dirty-registers)
- (:movl (:ebp -28) :edi)
- (:movl (:ebp -24) :esi)
- (:movl (:ebp -16) :edx)
- (:movl (:ebp -12) :eax)
- (:movl (:ebp -8) :ecx)
+ (:movl (:ebp ,(dit-frame-offset :edi)) :edi)
+ (:movl (:ebp ,(dit-frame-offset :esi)) :esi)
+ (:movl (:ebp ,(dit-frame-offset :edx)) :edx)
+ (:movl (:ebp ,(dit-frame-offset :eax)) :eax)
+ (:movl (:ebp ,(dit-frame-offset :ecx)) :ecx)
- (:movl (:ebp -32) :ebx) ; atomically-status..
+ (:movl (:ebp ,(dit-frame-offset :atomically-status)) :ebx) ; atomically-status..
(:shrl ,(- 16 movitz:+movitz-fixnum-shift+) :ebx)
- ;; Make stack safe before we exit interrupt-frame..
+ ;; Make stack safe before we exit dit-frame..
(:movl :edi (:ebp 4))
(:movl :edi (:ebp 8))
(:movl :edi (:ebp 12))
@@ -220,6 +240,7 @@
(:movl :edi (:ebp 20))
(:movl (:ebp 0) :ebp) ; pop stack-frame
(:locally (:movl (:edi (:edi-offset atomically-esp)) :esp)) ; restore ESP
+ ;; XXXX this state isn't covered in the stack discipline!?!
(:jmp (:esi :ebx ,(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0)))
atomically-jumper-return-dirty-registers
@@ -228,20 +249,21 @@
;; DF will be cleared.
(:movl :edi :edx)
(:movl :edi :eax)
- (:movl :edi :ecx)
+ (:movl :edi :ecx)
- (:movl (:ebp -32) :ebx) ; atomically-status..
+ (:movl (:ebp ,(dit-frame-offset :atomically-status)) :ebx)
(:shrl ,(- 16 movitz:+movitz-fixnum-shift+) :ebx)
- ;; Make stack safe before we exit interrupt-frame..
+ ;; Make stack safe before we exit dit-frame..
(:movl :edi (:ebp 4))
(:movl :edi (:ebp 8))
(:movl :edi (:ebp 12))
(:movl :edi (:ebp 16))
(:movl :edi (:ebp 20))
- (:movl (:ebp 0) :ebp) ; pop interrupt-frame
+ (:movl (:ebp 0) :ebp) ; pop dit-frame
(:movl (:ebp -4) :esi)
(:locally (:movl (:edi (:edi-offset atomically-esp)) :esp)) ; restore ESP
+ ;; XXXX this state isn't covered in the stack discipline!?!
(:jmp (:esi :ebx ,(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0)))
not-simple-restart-jumper
@@ -252,27 +274,28 @@
)))
(do-it)))
-(defun interrupt-default-handler (number interrupt-frame)
+(defun interrupt-default-handler (vector dit-frame)
(declare (without-check-stack-limit))
+ (cli)
(macrolet ((dereference (fixnum-address &optional (type :lisp))
"Dereference the fixnum-address."
`(memref ,fixnum-address 0 0 ,type)))
- (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))
+ (let (($eip (+ dit-frame (dit-frame-index :eip)))
+ ($eax (+ dit-frame (dit-frame-index :eax)))
+ ($ebx (+ dit-frame (dit-frame-index :ebx)))
+ ($ecx (+ dit-frame (dit-frame-index :ecx)))
+ ($edx (+ dit-frame (dit-frame-index :edx)))
+ ($esi (+ dit-frame (dit-frame-index :esi)))
+ (*last-dit-frame* dit-frame))
(block nil
- (case number
+ (case vector
(0 (error 'division-by-zero))
(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"
$eip
- (interrupt-frame-ref :error-code :unsigned-byte32 0 interrupt-frame)
+ (dit-frame-ref :error-code :unsigned-byte32 0 dit-frame)
$eax $ebx $ecx))
((60)
;; EAX failed type in EDX. May be restarted by returning with a new value in EAX.
@@ -286,7 +309,7 @@
(64 (error 'type-error :datum (dereference $eax) :expected-type 'integer))
(65 (error 'index-out-of-range :index (dereference $ebx) (dereference $ecx)))
(66 (error "Unspecified type error at ~@Z in ~S with EAX=~@Z, ECX=~@Z."
- $eip (dereference (+ interrupt-frame (interrupt-frame-index :esi)))
+ $eip (dereference (+ dit-frame (dit-frame-index :esi)))
$eax $ecx))
(67 (backtrace :fresh-lines nil :length 6)
(dotimes (i 100000)
@@ -295,6 +318,7 @@
$eip $eax $ebx $ecx $edx)
(dotimes (i 100000)
(with-inline-assembly (:returns :nothing) (:nop))))
+ (70 (error "Unaligned memref access."))
((5 55)
(let* ((old-bottom (prog1 (stack-bottom)
(setf (stack-bottom) 0)))
@@ -317,8 +341,8 @@
(- old-bottom new-bottom)
new-bottom)
(break "Stack overload exception ~D at EIP=~@Z, ESI=~@Z, ESP=~@Z, bottom=#x~X."
- number $eip $esi
- (+ interrupt-frame (interrupt-frame-index :ebp))
+ vector $eip $esi
+ (+ dit-frame (dit-frame-index :ebp))
old-bottom))
(format *debug-io* "~&Stack-warning: Resetting stack-bottom to #x~X.~%"
old-bottom)
@@ -336,13 +360,13 @@
(when (symbolp name)
(error 'unbound-variable :name name))))
((100);; 101 102 103 104 105)
- (let ((funobj (dereference (+ interrupt-frame (interrupt-frame-index :esi))))
- (code (interrupt-frame-ref :ecx :unsigned-byte8 0 interrupt-frame)))
+ (let ((funobj (dereference (+ dit-frame (dit-frame-index :esi))))
+ (code (dit-frame-ref :ecx :unsigned-byte8 0 dit-frame)))
(error 'wrong-argument-count
:function funobj
:argument-count (if (logbitp 7 code)
- (ash (interrupt-frame-ref :ecx :unsigned-byte32
- 0 interrupt-frame)
+ (ash (dit-frame-ref :ecx :unsigned-byte32
+ 0 dit-frame)
-24)
code))))
(108
@@ -353,20 +377,20 @@
(112
(let ((*error-no-condition-for-debugger* t)) ; no space..
(error "Out of memory. Please take out the garbage.")))
- (t (funcall (if (< 16 number 50) #'warn #'error)
+ (t (funcall (if (< 16 vector 50) #'warn #'error)
"Exception occurred: ~D, EIP: ~@Z, EAX: ~@Z, ECX: ~@Z, ESI: ~@Z"
- number $eip $eax $ecx $esi)))
+ vector $eip $eax $ecx $esi)))
nil))))
-(defun exception-handler (n)
- (let ((vector (load-global-constant interrupt-handlers)))
- (svref vector n)))
+(defun exception-handler (vector)
+ (let ((handlers (load-global-constant exception-handlers)))
+ (svref handlers vector)))
-(defun (setf exception-handler) (handler n)
+(defun (setf exception-handler) (handler vector)
(check-type handler function)
- (let ((vector (load-global-constant interrupt-handlers)))
- (setf (svref vector n) handler)))
+ (let ((handlers (load-global-constant exception-handlers)))
+ (setf (svref handlers vector) handler)))
(defun cli ()
(with-inline-assembly (:returns :nothing)
@@ -376,17 +400,17 @@
(with-inline-assembly (:returns :nothing)
(:sti)))
-(defun raise-exception (exception &optional (eax 0) (ebx 0))
+(defun raise-exception (vector &optional (eax 0) (ebx 0))
"Generate a CPU exception, with those values in EAX and EBX."
;; The problem now is that the x86 INT instruction only takes an
;; immediate argument.
- (check-type exception (unsigned-byte 8))
+ (check-type vector (unsigned-byte 8))
(macrolet
((do-it ()
`(with-inline-assembly (:returns :eax)
(:load-lexical (:lexical-binding eax) :eax)
(:load-lexical (:lexical-binding ebx) :ebx)
- (:load-lexical (:lexical-binding exception) :ecx)
+ (:load-lexical (:lexical-binding vector) :ecx)
(:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
(:jnz 'not-0)
(:int 0)
