[movitz-cvs] CVS update: movitz/losp/x86-pc/pci.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Thu Nov 25 02:11:36 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/x86-pc
In directory common-lisp.net:/tmp/cvs-serv28011
Modified Files:
pci.lisp
Log Message:
A bit more PCI probing code. I'm starting to figure this out.
Date: Thu Nov 25 03:11:34 2004
Author: ffjeld
Index: movitz/losp/x86-pc/pci.lisp
diff -u movitz/losp/x86-pc/pci.lisp:1.5 movitz/losp/x86-pc/pci.lisp:1.6
--- movitz/losp/x86-pc/pci.lisp:1.5 Tue Nov 23 14:45:51 2004
+++ movitz/losp/x86-pc/pci.lisp Thu Nov 25 03:11:34 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.5 2004/11/23 13:45:51 ffjeld Exp $
+;;;; $Id: pci.lisp,v 1.6 2004/11/25 02:11:34 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -18,6 +18,28 @@
(provide :x86-pc/pci)
+(defun pci-word (designator)
+ "Map an integer or 4-character string to an (unsigned-byte 32)."
+ (etypecase designator
+ ((unsigned-byte 32)
+ designator)
+ ((signed-byte 32)
+ (ldb (byte 32 0) designator))
+ (string
+ (loop for c across designator as i upfrom 0 by 8
+ summing (ash (char-code c) i)))))
+
+(defun pci-string (integer)
+ "Map a 32-bit value to a 4-character string."
+ (check-type integer (or (signed-byte 32)
+ (unsigned-byte 32)))
+ (let ((string (make-string 4)))
+ (setf (char string 0) (code-char (ldb (byte 8 0) integer))
+ (char string 1) (code-char (ldb (byte 8 8) integer))
+ (char string 2) (code-char (ldb (byte 8 16) integer))
+ (char string 3) (code-char (ldb (byte 8 24) integer)))
+ string))
+
(defun find-bios32-base ()
(loop for bios32 from #xe0000 to #xffff0 by 16
if (and (= (memref-int bios32) #x5f32335f)
@@ -29,54 +51,123 @@
return bios32))
(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 init-pci ()
- (setf *bios32-base*
- (find-bios32-base))
- (if (not *bios32-base*)
- (error "No PCI BIOS32 found.")
- (let ((entry (memref-int *bios32-base* :offset 4))
- (revision (memref-int *bios32-base* :offset 8 :type :unsigned-byte8))
- (length (memref-int *bios32-base* :offset 9 :type :unsigned-byte8)))
- (values entry revision length))))
-(defun pci-far-call (address &key (eax 0) (ebx 0) (cs 8))
+(defun pci-far-call (address &key (cs 8) (eax 0) (ebx 0) (ecx 0) (edx 0) (esi 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. (Well, for now only the
-lower 30 bits are actually returned.) The stack discipline is broken during
-this call, so we disable interrupts in a somewhat feeble attempt to avoid trouble."
+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.)
+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))
(without-interrupts
(with-inline-assembly (:returns :multiple-values)
+ ;; Enter atomically mode
+ (:declare-label-set restart-pci-far-call (restart))
+ (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+ (:pushl 'restart-pci-far-call)
+ (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+ (:pushl :ebp)
+ restart
+ (:movl (:esp) :ebp)
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+
(:load-lexical (:lexical-binding cs) :untagged-fixnum-ecx)
(:pushl :ecx) ; Code segment
(:load-lexical (:lexical-binding address) :untagged-fixnum-ecx)
(:pushl :ecx) ; Code address
- (:load-lexical (:lexical-binding ebx) :untagged-fixnum-ecx)
- (:pushl :ecx) ; EBX
(:load-lexical (:lexical-binding eax) :untagged-fixnum-ecx)
- (:movl :ecx :eax)
+ (:pushl :ecx) ; push EAX
+ (:load-lexical (:lexical-binding ebx) :untagged-fixnum-ecx)
+ (:pushl :ecx) ; push EBX
+ (:load-lexical (:lexical-binding edx) :untagged-fixnum-ecx)
+ (:pushl :ecx) ; push EDX
+ (:load-lexical (:lexical-binding esi) :untagged-fixnum-ecx)
+ (:pushl :ecx) ; push ESI
+ (:load-lexical (:lexical-binding ecx) :untagged-fixnum-ecx)
+ (:popl :esi)
+ (:popl :edx)
(:popl :ebx)
+ (:popl :eax)
(:call-segment (:esp))
(:leal (:esp 8) :esp)
- (:andl #xff :eax)
- (:shll 2 :eax)
- (:shll 2 :ebx)
- (:shll 2 :ecx)
- (:shll 2 :edx)
- (:locally (:movl :ecx (:edi (:edi-offset values) 0)))
- (:locally (:movl :edx (:edi (:edi-offset values) 4)))
- (:movl 4 :ecx)
- (:stc))))
-
-(defun pci-directory (eax &optional (ebx 0))
- "Calling with '$PCI' should find the PCI directory."
- (unless *bios32-base*
- (init-pci))
- (let ((eax (etypecase eax
- ((unsigned-byte 32)
- eax)
- (string
- (loop for c across eax as i upfrom 0 by 8
- summing (ash (char-code c) i))))))
- (pci-far-call (memref-int *bios32-base* :offset 4)
- :eax eax :ebx ebx)))
+ (:locally (:movl :edi (:edi (:edi-offset values) 8)))
+ (:jnc 'cf=0)
+ (:locally (:pushl (:edi (:edi-offset t-symbol))))
+ (:locally (:popl (:edi (:edi-offset values) 8)))
+ cf=0
+ (:pushl :eax)
+ (:pushl :ebx)
+ (:pushl :edx)
+ (:locally (:movl 3 (:edi (:edi-offset num-values))))
+ (:call-local-pf box-u32-ecx) ; ECX
+ (:locally (:movl :eax (:edi (:edi-offset values) 0)))
+ (:popl :ecx) ; EDX
+ (:call-local-pf box-u32-ecx)
+ (:locally (:movl :eax (:edi (:edi-offset values) 4)))
+ (:popl :ecx) ; EBX
+ (:call-local-pf box-u32-ecx)
+ (:locally (:movl :eax (:edi (:edi-offset scratch1))))
+ (:popl :ecx) ; EAX
+ (:call-local-pf box-u32-ecx)
+ (:locally (:movl (:edi (:edi-offset scratch1)) :ebx))
+ (:movl 5 :ecx)
+ (:movl (:ebp -4) :esi)
+ (:stc)
+ ;; Exit atomical-mode
+ (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+ (:leal (:esp 16) :esp))))
More information about the Movitz-cvs
mailing list