Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6862
Modified Files: interrupt.lisp Log Message: Re-wrote software-interrupt as raise-exception.
Date: Tue Jul 27 06:50:08 2004 Author: ffjeld
Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.18 movitz/losp/muerte/interrupt.lisp:1.19 --- movitz/losp/muerte/interrupt.lisp:1.18 Wed Jul 21 18:02:22 2004 +++ movitz/losp/muerte/interrupt.lisp Tue Jul 27 06:50:08 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.18 2004/07/22 01:02:22 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.19 2004/07/27 13:50:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -376,31 +376,28 @@ (with-inline-assembly (:returns :nothing) (:sti)))
-(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>." +(defun raise-exception (exception &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. - ;; 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))))) + (check-type exception (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) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) + (:jnz 'not-0) + (:int 0) + (:jmp 'done) + not-0 + ,@(loop for i from 1 to 255 as label = (gensym (format nil "not-~D" i)) + appending + `((:decl :ecx) + (:jnz ',label) + (:int ,i) + ;; (:jmp 'done) + ,label)) + done))) + (do-it)))