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

Modified Files: pci.lisp Log Message: Now, scan-pci-bus prints some info about each device it can find on that bus.

Date: Fri Nov 26 01:02:39 2004 Author: ffjeld

Index: movitz/losp/x86-pc/pci.lisp diff -u movitz/losp/x86-pc/pci.lisp:1.6 movitz/losp/x86-pc/pci.lisp:1.7 --- movitz/losp/x86-pc/pci.lisp:1.6 Thu Nov 25 03:11:34 2004 +++ movitz/losp/x86-pc/pci.lisp Fri Nov 26 01:02:39 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Sun Dec 14 22:33:42 2003 ;;;; -;;;; $Id: pci.lisp,v 1.6 2004/11/25 02:11:34 ffjeld Exp $ +;;;; $Id: pci.lisp,v 1.7 2004/11/26 00:02:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -53,64 +53,9 @@ (defvar *bios32-base* nil) (defvar *pcibios-entry* nil)

-(defun find-bios32-pci () - (let ((bios32-base (find-bios32-base))) - (assert bios32-base "No bios32 found.") - (multiple-value-bind (eax ebx ecx edx) - (pci-far-call (memref-int bios32-base :offset 4) - :eax (pci-word "$PCI")) - (declare (ignore ecx)) - (ecase (ldb (byte 8 0) eax) - (#x80 (error "The PCI bios32 service isn't present.")) - (#x81 (error "The PCI bios32 service doesn't exist.")) - (#x00 (+ ebx edx)))))) - -(defun pci-bios-present () - (multiple-value-bind (eax ebx ecx edx cf) - (pci-far-call (find-bios32-pci) :eax #xb101) - (values (pci-string edx) - (ldb (byte 8 8) eax) ; AH: Present status - (ldb (byte 8 0) eax) ; AL: Hardware mechanism - (ldb (byte 8 8) ebx) ; BH: Interface Level Major Version - (ldb (byte 8 0) ebx) ; BL: Interface Level Minor Version - (ldb (byte 8 0) ecx)))) ; CL: Number of last PCI bus in the system - -(defun find-pci-device (vendor device &optional (index 0)) - (multiple-value-bind (eax ebx ecx edx cf) - (pci-far-call (find-bios32-pci) - :eax #xb102 - :ecx device - :edx vendor - :esi index) - (unless cf - (values (ldb (byte 8 8) ebx) ; Bus - (ldb (byte 5 3) ebx) ; Device - (ldb (byte 3 0) ebx) ; Function - (ecase (ldb (byte 8 8) eax) - (#x00 :successful) - (#x86 :device-not-found) - (#x83 :bad-vendor-id)))))) - -(defun find-pci-class-code (class-code &optional (index 0)) - (multiple-value-bind (eax ebx ecx edx cf) - (pci-far-call (find-bios32-pci) - :eax #xb103 - :ecx class-code - :esi index) - (declare (ignore ecx edx)) - (unless cf - (values (ldb (byte 8 8) ebx) ; Bus - (ldb (byte 5 3) ebx) ; Device - (ldb (byte 3 0) ebx) ; Function - (ecase (ldb (byte 8 8) eax) - (#x00 :successful) - (#x86 :device-not-found)))))) - - -(defun pci-far-call (address &key (cs 8) (eax 0) (ebx 0) (ecx 0) (edx 0) (esi 0)) +(defun pci-far-call (address &key (cs 8) (eax 0) (ebx 0) (ecx 0) (edx 0) (esi 0) (edi 0)) "Make a 'far call' to cs:address with the provided values for eax and ebx. -Returns the values of registers AL, EBX, ECX, and EDX, and status of CF. - (NB: For now only the lower 30 bits of registers are actually returned.) +Returns the values of registers EAX, EBX, ECX, and EDX, and status of CF. The stack discipline is broken during this call, so we disable interrupts in a somewhat feeble attempt to avoid trouble." (check-type address (unsigned-byte 32)) @@ -125,7 +70,7 @@ restart (:movl (:esp) :ebp) (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation)))) - + (:pushl :edi) ; Save EDI so we can restore it later. (:load-lexical (:lexical-binding cs) :untagged-fixnum-ecx) (:pushl :ecx) ; Code segment (:load-lexical (:lexical-binding address) :untagged-fixnum-ecx) @@ -138,13 +83,17 @@ (:pushl :ecx) ; push EDX (:load-lexical (:lexical-binding esi) :untagged-fixnum-ecx) (:pushl :ecx) ; push ESI + (:load-lexical (:lexical-binding edi) :untagged-fixnum-ecx) + (:pushl :ecx) ; push EDI (:load-lexical (:lexical-binding ecx) :untagged-fixnum-ecx) + (:popl :edi) (:popl :esi) (:popl :edx) (:popl :ebx) (:popl :eax) (:call-segment (:esp)) - (:leal (:esp 8) :esp) + (:leal (:esp 8) :esp) ; Skip cs:address + (:popl :edi) ; First of all, restore EDI! (:locally (:movl :edi (:edi (:edi-offset values) 8))) (:jnc 'cf=0) (:locally (:pushl (:edi (:edi-offset t-symbol)))) @@ -171,3 +120,153 @@ ;; Exit atomical-mode (:locally (:movl 0 (:edi (:edi-offset atomically-continuation)))) (:leal (:esp 16) :esp)))) + +(defun find-bios32-pci () + (let ((bios32-base (find-bios32-base))) + (assert bios32-base "No bios32 found.") + (multiple-value-bind (eax ebx ecx edx) + (pci-far-call (memref-int bios32-base :offset 4) + :eax (pci-word "$PCI")) + (declare (ignore ecx)) + (ecase (ldb (byte 8 0) eax) + (#x80 (error "The PCI bios32 service isn't present.")) + (#x81 (error "The PCI bios32 service doesn't exist.")) + (#x00 (+ ebx edx)))))) + +(defun pci-bios-present () + (multiple-value-bind (eax ebx ecx edx cf) + (pci-far-call (find-bios32-pci) :eax #xb101) + (values (pci-string edx) + (ldb (byte 8 8) eax) ; AH: Present status + (ldb (byte 8 0) eax) ; AL: Hardware mechanism + (ldb (byte 8 8) ebx) ; BH: Interface Level Major Version + (ldb (byte 8 0) ebx) ; BL: Interface Level Minor Version + (ldb (byte 8 0) ecx)))) ; CL: Number of last PCI bus in the system + +(defun find-pci-device (vendor device &optional (index 0)) + (multiple-value-bind (eax ebx ecx edx cf) + (pci-far-call (find-bios32-pci) + :eax #xb102 + :ecx device + :edx vendor + :esi index) + (unless cf + (values (ldb (byte 8 8) ebx) ; Bus + (ldb (byte 5 3) ebx) ; Device + (ldb (byte 3 0) ebx) ; Function + (ecase (ldb (byte 8 8) eax) + (#x00 :successful) + (#x86 :device-not-found) + (#x83 :bad-vendor-id)))))) + +(defun find-pci-class-code (class-code &optional (index 0)) + (multiple-value-bind (eax ebx ecx edx cf) + (pci-far-call (find-bios32-pci) + :eax #xb103 + :ecx class-code + :esi index) + (declare (ignore ecx edx)) + (unless cf + (values (ldb (byte 8 8) ebx) ; Bus + (ldb (byte 5 3) ebx) ; Device + (ldb (byte 3 0) ebx) ; Function + (pci-return-code eax))))) + +(defun pci-return-code (code) + (ecase (ldb (byte 8 8) code) + (#x00 :successful) + (#x81 :function-not-supported) + (#x83 :bad-vendor-id) + (#x86 :device-not-found) + (#x87 :bad-register-number))) + +(defun pci-location (bus device function) + "Compute 16-bit location from bus, device, and function numbers." + (dpb bus (byte 8 8) (dpb device (byte 5 3) (ldb (byte 3 0) function)))) + +(defun pci-class (code) + "Return the symbolic class-code sub-class code, and interface, if known." + (let* ((decode-table + #((:pre-pci2.0-device + :non-vga :vga-compatible) + (:mass-storage + :scsi :ide :floppy :ipi :raid) + (:network + :ethernet :token-ring :fddi :atm) + (:display + (:non-xga :vga :8514) :xga) + (:multimedia + :video :audio) + (:memory + :ram :flash) + (:bridge + :host/pci :pci/isa :pci/eisa :pci/micro-channel + :pci/pci :pci/pcmcia :pci/nubus :pci/cardbus) + (:simple-communication + (:serial-port :xt :16450 :16550) + (:parallel-port :generic :bi-directional :ecp-1.x)) + (:base-system-peripheral + (:pic :generic :isa :eisa) + (:dma :generic :isa :eisa) + (:timer :generic :isa :eisa) + (:rtc :generic :isa)) + (:input + :keyboard :digitizer :mouse) + (:docking-station + :generic) + (:processor + :386 :486 :pentium nil nil nil nil nil nil nil nil nil nil nil nil nil + :alpha nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + :powerpc nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + :co-processor) + (:serial-bus + :firewire :access.bus :ssa :usb :fibre-channel))) + (class-code (ldb (byte 8 16) code)) + (class-table (and (< class-code (length decode-table)) + (svref decode-table class-code))) + (sub-class-table (nth (ldb (byte 8 8) code) (cdr class-table))) + (sub-class sub-class-table) + (sub-class-if (when (consp sub-class) + (setf sub-class (pop sub-class-table)) + (nth (ldb (byte 8 0) code) sub-class-table)))) + (values (car class-table) sub-class sub-class-if))) + +(defun pci-bios-read-configuration-word (bus device function register) + (multiple-value-bind (eax ebx ecx edx cf) + (pci-far-call (find-bios32-pci) + :eax #xb109 + :ebx (pci-location bus device function) + :edi register) + (declare (ignore ebx edx)) + (unless cf + (values (ldb (byte 16 0) ecx) (pci-return-code eax))))) + +(defun pci-bios-read-configuration-dword (bus device function register) + (multiple-value-bind (eax ebx ecx edx cf) + (pci-far-call (find-bios32-pci) + :eax #xb10a + :ebx (pci-location bus device function) + :edi register) + (declare (ignore ebx edx)) + (unless cf + (values ecx (pci-return-code eax))))) + +(defun scan-pci-bus (bus) + (loop for device from 0 to 31 + do (multiple-value-bind (vendor-id return-code) + (pci-bios-read-configuration-word bus device 0 0) + (when (and vendor-id + (not (= vendor-id #xffff)) + (eq :successful return-code)) + (let ((device-id (pci-bios-read-configuration-word bus device 0 2)) + (status (pci-bios-read-configuration-word bus device 0 6)) + (class-rev (pci-bios-read-configuration-dword bus device 0 8))) + (format *query-io* + "~&~D: Vendor #x~X, ID #x~X, Class #x~X, Rev. ~D, Status #x~X.~%" + device vendor-id device-id + (ldb (byte 24 8) class-rev) + (ldb (byte 8 0) class-rev) + status) + (format *query-io* " Class:~{ ~@[~A~]~}" + (multiple-value-list (pci-class (ldb (byte 24 8) class-rev)))))))) + (values)) \ No newline at end of file