Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv737

Modified Files: interrupt.lisp Log Message: Moved much stuff from :x86-pc/interrupt to :muerte/interrupt, because it's really a required part of Muerte.

Date: Tue Apr 6 20:12:28 2004 Author: ffjeld

Index: movitz/losp/x86-pc/interrupt.lisp diff -u movitz/losp/x86-pc/interrupt.lisp:1.8 movitz/losp/x86-pc/interrupt.lisp:1.9 --- movitz/losp/x86-pc/interrupt.lisp:1.8 Tue Apr 6 10:42:11 2004 +++ movitz/losp/x86-pc/interrupt.lisp Tue Apr 6 20:12:28 2004 @@ -10,12 +10,11 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri May 4 18:08:50 2001 ;;;; -;;;; $Id: interrupt.lisp,v 1.8 2004/04/06 14:42:11 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.9 2004/04/07 00:12:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

(require :x86-pc/pic8259) -(require :x86-pc/debugger) (provide :x86-pc/interrupt)

(in-package muerte.x86-pc) @@ -25,250 +24,6 @@ (:movb #x20 :al) (:outb :al #x20)))

-(defmacro stack-word (offset) - `(with-inline-assembly (:returns :eax) - (:movl (:esp ,(* 4 offset)) :eax))) - -(define-compiler-macro int-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 - '(:eip :eflags nil :error-code :exception :ebp nil - :ecx :eax :edx :ebx :esi :edi) - #+ignore '(:edi :esi :ebp :esp :ebx :edx :ecx :eax - :exception :error-code - :eip :cs :eflags)))))) - -(defun int-frame-index (name) - (- 5 (position name - '(:eip :eflags nil :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)) - -(defun int-frame-ref (frame reg type &optional (offset 0)) - (int-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)) - -(define-primitive-function muerte::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))))) - (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! - - (: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. - -;;; (:pushl :eax) ; fake stack-frame return address -;;; (:pushl :ebp) ; set up fake stack-frame -;;; (:movl :esp :ebp) ; (GIVES EBP OFFSET 8 RELATIVE TO NUMBERS ABOVE!!) -;;; (:pushl :edi) ; A fake "funobj" for the fake stack-frame.. -;;; ; ..the int-frame will be put here shortly. - - ;; 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) :ebx) ; interrupt number into EBX - (:locally (:movl (:edi (:edi-offset interrupt-handlers)) :eax)) - (:movl (:eax 2 (:ebx 4)) :eax) ; symbol at (aref EBX interrupt-handlers) into :esi - (:leal (:eax -7) :ecx) - (:testb 7 :cl) - (: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 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))) - - 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) - -;;; (:leal (:ebp 8) :esp) -;;; (:popal) ; pop interruptee's registers -;;; (:addl 12 :esp) ; skip stack-hole - (:popfl) ; pop EFLAGS - (:ret))) ; pop EIP - -(defvar *last-interrupt-frame* nil) - -(defun muerte::interrupt-default-handler (number int-frame) - (declare (muerte::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)) - (block nil - (case number - (0 (error "Division by zero.")) - (3 (break "Break instruction at ~@Z." $eip)) - (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) - $eax $ebx $ecx)) - (68 (warn "EIP: ~@Z EAX: ~@Z EBX: ~@Z ECX: ~@Z EDX: ~@Z" - $eip $eax $ebx $ecx $edx) - (dotimes (i 100000) - (with-inline-assembly (:returns :nothing) (:nop)))) - (67 (muerte.debug:backtrace :fresh-lines nil :length 6) - (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))) - $eax $ecx)) - (62 (error "Trying to save too many values: ~@Z." $ecx)) - ((5 55) - (let* ((stack (muerte::%run-time-context-slot 'movitz::stack-vector)) - (old-bottom (muerte::stack-bottom)) - (real-bottom (- (object-location stack) 2)) - (stack-left (- old-bottom real-bottom)) - (new-bottom (cond - ((< stack-left 10) - (princ "Halting CPU due to stack exhaustion.") - (muerte::halt-cpu)) - ((<= stack-left 256) - (format *debug-io* - "~&This is your LAST chance to pop off stack.~%") - real-bottom) - (t (+ real-bottom (truncate stack-left 2)))))) ; Cushion the fall.. - (unwind-protect - (progn - (setf (muerte::stack-bottom) new-bottom) - (format *debug-io* "~&Stack-warning: Bumped stack-bottom by ~D to #x~X.~%" - (- old-bottom new-bottom) - new-bottom) - (break "Stack overload exception ~D at ESP=~@Z with bottom #x~X." - number - (+ int-frame (int-frame-index :ebp)) - old-bottom)) - (format *debug-io* "~&Stack-warning: Resetting stack-bottom to #x~X.~%" - old-bottom) - (setf (muerte::stack-bottom) old-bottom)))) - (69 - (error "Not a function: ~S" (@ $edx))) - (70 - (error "[EIP=~@Z] Index ~@Z out of bounds ~@Z for ~S." $eip $ecx $ebx (@ $eax))) - (98 - (let ((name (@ $ecx))) - (when (symbolp name) - (error 'undefined-function :name name)))) - (99 - (let ((name (@ $edx))) - (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))) - (error 'muerte:wrong-argument-count - :function funobj - :argument-count (if (logbitp 7 code) - (ash (int-frame-ref int-frame :ecx :unsigned-byte32) - -24) - code)))) - (108 - (error 'throw-error :tag (@ $eax))) - (110 - ;; (print-dynamic-context); what's this? - (throw :debugger nil)) - (112 - (setf (%run-time-context-slot 'nursery-space) - (memref (%run-time-context-slot 'nursery-space) -6 3 :lisp)) - (error "Out of memory. Please take out the garbage.")) - (t (funcall (if (< 16 number 50) #'warn #'error) - "Exception occurred: ~D, EIP: ~@Z, EAX: ~@Z, ECX: ~@Z, ESI: ~@Z" - number $eip $eax $ecx $esi))) - nil)))) - - -;;; (with-inline-assembly (:returns :nothing) (:movb #x47 (#xb8045)) -;;; (:addb #x01 (#xb8044)))) - - (defun idt-init () (init-pic8259 32 40) (setf (pic8259-irq-mask) #xffff) @@ -284,24 +39,6 @@ (setf (pic8259-irq-mask) #xfffe) (with-inline-assembly (:returns :nothing) (:sti)))

-(defun cli () - (with-inline-assembly (:returns :nothing) - (:cli))) - -(defun sti () - (with-inline-assembly (:returns :nothing) - (:sti))) - -(defun interrupt-handler (n) - (let ((vector (load-global-constant interrupt-handlers))) - (svref vector n))) - -(defun (setf interrupt-handler) (handler n) - (check-type handler symbol) - (assert (fboundp handler)) - (let ((vector (load-global-constant interrupt-handlers))) - (setf (svref vector n) handler))) - (defparameter *timer-counter* 0)

(defun timer-handler (number int-frame) @@ -312,31 +49,3 @@ (pic8259-end-of-interrupt 0))

-(define-primitive-function primitive-software-interrupt () - "A primitive code-vector that generates software interrupts." - (macrolet ((make-software-interrupt-code () - (cons 'progn - (loop for vector from 0 to 255 - collect `(with-inline-assembly (:returns :nothing) - ;; Each code-entry is 2+1+1=4 bytes. - ((2) :int ,vector) - ((1) :ret) - ((1) :nop)))))) - (make-software-interrupt-code))) - -(defun software-interrupt (interrupt-vector &optional (eax 0) (ebx 0)) - "Generate software-interrupt number <interrupt-vector>." - ;; The problem now is that the x86 INT instruction only takes an - ;; immediate argument. - ;; Hence the primitive-function primitive-software-interrupt. - (check-type interrupt-vector (unsigned-byte 8)) - (let ((code-vector (symbol-value 'primitive-software-interrupt))) - (check-type code-vector vector) - (with-inline-assembly-case () - (do-case (t :nothing) - (:compile-two-forms (:ecx :edx) interrupt-vector code-vector) - (:leal (:edx :ecx 2) :ecx) - (:compile-two-forms (:eax :ebx) eax ebx) - (:shrl 2 :eax) - (:shrl 2 :ebx) - (:call :ecx)))))