[movitz-cvs] CVS update: movitz/losp/x86-pc/pci.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Fri Nov 26 00:02:40 UTC 2004
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 at 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
More information about the Movitz-cvs
mailing list