[movitz-cvs] CVS movitz/losp/x86-pc
ffjeld
ffjeld at common-lisp.net
Sat Apr 28 16:29:18 UTC 2007
Update of /project/movitz/cvsroot/movitz/losp/x86-pc
In directory clnet:/tmp/cvs-serv23233
Added Files:
pcnet.lisp
Log Message:
The beginnings of a pcnet driver.
--- /project/movitz/cvsroot/movitz/losp/x86-pc/pcnet.lisp 2007/04/28 16:29:18 NONE
+++ /project/movitz/cvsroot/movitz/losp/x86-pc/pcnet.lisp 2007/04/28 16:29:18 1.1
;;;;------------------------------------------------------------------
;;;;
;;;; Copyright (C) 2003, 2005,
;;;; Department of Computer Science, University of Tromso, Norway.
;;;;
;;;; For distribution policy, see the accompanying file COPYING.
;;;;
;;;; Filename: pcnet.lisp
;;;; Description:
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Fri Aug 12 23:39:20 2005
;;;;
;;;; $Id: pcnet.lisp,v 1.1 2007/04/28 16:29:18 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
(provide :x86-pc/pcnet)
(in-package muerte.x86-pc)
(defmacro select (keyform &rest clauses)
(let* ((select-var (gensym "select-key-"))
(cc (loop for (key . consequents) in clauses
collecting
(cond
((member key '(t otherwise))
(cons t consequents))
(t
(cons `(eql ,key ,select-var)
consequents))))))
`(let ((,select-var ,keyform))
(cond , at cc))))
(defmacro $am7990 (reg &optional sub-reg)
(or (cond
((integerp reg)
reg)
((not sub-reg)
(case reg
(:csr0 0) (:csr1 1) (:csr2 2) (:csr3 3)
(:csr88 88) (:csr89 89)
(:bcr49 49) (:bcr32 32) (:bcr33 33) (bcr34 34)))
(t (if (integerp sub-reg)
sub-reg
(case reg
(:csr0
(case sub-reg
(:err #x8000)
(:babl #x4000)
(:cerr #x2000)
(:miss #x1000)
(:merr #x0800)
(:rint #x0400)
(:tint #x0200)
(:idon #x0100)
(:intr #x0080)
(:inea #x0040)
(:rxon #x0020)
(:txon #x0010)
(:tdmd #x0008)
(:stop #x0004)
(:strt #x0002)
(:init #x0001)))
(:csr88
(case sub-reg
(:AMD-MASK #x003)
(:PART-MASK #xffff)
(:|Am79C960| #x0003)
(:|Am79C961| #x2260)
(:|Am79C961A| #x2261)
(:|Am79C965| #x2430)
(:|Am79C970| #x0242)
(:|Am79C970A| #x2621)
(:|Am79C971| #x2623)
(:|Am79C972| #x2624)
(:|Am79C973| #x2625)
(:|Am79C978| #x2626)
))))))
(error "Unknown Am7990 register: ~S~@[ ~S~]" reg sub-reg)))
(defmacro $pcnet (reg)
"PCNet is one Am7990 implementation."
(or (cond
((integerp reg) reg)
(t (case reg
(:rdp #x10)
(:rap #x12)
(:reset #x14)
(:bdp #x16)
(:vsw #x18))))
`($am7990 ,reg)))
(defmacro with-am7990 ((name io-base regdef) &body body)
(let ((pcnet-io (gensym "pcnet-io-")))
`(with-io-register-syntax (,pcnet-io ,io-base)
(macrolet
((,name (op &optional reg)
(ecase op
(:rdp
`(,',pcnet-io (,',regdef :rdp) :unsigned-byte16))
(:csr
`(,',pcnet-io (progn
(setf (,',pcnet-io (,',regdef :rap) :unsigned-byte16)
(,',regdef ,reg))
(,',regdef :rdp))
:unsigned-byte16))
)))
, at body))))
(defmacro with-am7990-ports ((name rap rdp bdp) &body body)
`(macrolet ((,name (reg)
(case reg
(:rap ',rap) (:rdp ',rdp) (:bdp ',bdp)
(t `($am7990 ,reg)))))
, at body))
(defun lance-probe (io-base rap rdp bdp)
(declare (ignorable bdp))
(with-am7990-ports ($lance rap rdp bdp)
(with-am7990 (pcnet io-base $lance)
(setf (pcnet :csr :csr0) ($am7990 :csr0 :stop))
(when (and (/= 0 (logand (pcnet :rdp) ($am7990 :csr0 :stop)))
(= 0 (pcnet :csr :csr3)))
(setf (pcnet :csr :csr0) ($am7990 :csr0 :inea))
(if (/= 0 (logand (pcnet :csr :csr0) ($am7990 :csr0 :inea)))
'c-lance
'lance)))))
(defun am7990-probe (io-base rap rdp bdp)
(let ((type (lance-probe io-base rap rdp bdp)))
(when type
(with-am7990-ports ($ports rap rdp bdp)
(with-am7990 (pcnet io-base $ports)
(let ((chip-id (dpb (pcnet :csr :csr89)
(byte 16 16)
(pcnet :csr :csr88))))
(when (/= 0 (logand chip-id ($am7990 :csr88 :amd-mask)))
(select (ldb (byte 16 12) chip-id)
(($am7990 :csr88 :|Am79C960|) 'PCnet-ISA)
(($am7990 :csr88 :|Am79C961|) 'PCnet-ISAplus)
(($am7990 :csr88 :|Am79C961A|) 'PCnet-ISA-II)
(($am7990 :csr88 :|Am79C965|) (values 'PCnet-32 t))
(($am7990 :csr88 :|Am79C970|) (vaues 'PCnet-PCI t))
(($am7990 :csr88 :|Am79C970A|) (values 'PCnet-PCI-II t))
(($am7990 :csr88 :|Am79C971|) (values 'PCnet-FAST t))
(($am7990 :csr88 :|Am79C972|) (values 'PCnet-FASTplus t))
(($am7990 :csr88 :|Am79C973|) (values 'PCnet-FASTplus t))
(($am7990 :csr88 :|Am79C978|) (values 'PCnet-Home t))
(t type)))))))))
(defclass ne2100-pci (muerte.ethernet:ethernet-device)
())
(defun pcnet-probe-pci ()
(multiple-value-bind (bus device function)
(find-pci-device #x1022 #x2000)
(apply #'attach-ne2100-pci
(pci-device-address-maps bus device function))))
(defun attach-ne2100-pci (&key io &allow-other-keys)
(check-type io (unsigned-byte 16) "an I/O port")
(multiple-value-bind (ic 32bit-p)
(am7990-probe io ($pcnet :rap) ($pcnet :rdp) ($pcnet :bdp))
(when 32bit-p
(make-instance 'ne2100-pci
:mac-address (coerce (loop for i from 0 below 6
collect (io-port (+ io i) :unsigned-byte8))
'muerte.ethernet:mac-address)))))
More information about the Movitz-cvs
mailing list