movitz-cvs November 2004

movitz-cvs@common-lisp.net

1 participants
157 discussions

[movitz-cvs] CVS update: movitz/losp/muerte/bignums.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16046 Modified Files: bignums.lisp Log Message: Renamed the malloc primitive functions. Date: Thu Nov 25 19:05:40 2004 Author: ffjeld Index: movitz/losp/muerte/bignums.lisp diff -u movitz/losp/muerte/bignums.lisp:1.12 movitz/losp/muerte/bignums.lisp:1.13 --- movitz/losp/muerte/bignums.lisp:1.12 Mon Oct 11 15:52:21 2004 +++ movitz/losp/muerte/bignums.lisp Thu Nov 25 19:05:40 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 19:42:57 2004 ;;;; -;;;; $Id: bignums.lisp,v 1.12 2004/10/11 13:52:21 ffjeld Exp $ +;;;; $Id: bignums.lisp,v 1.13 2004/11/25 18:05:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -129,7 +129,7 @@ ;; Now inside atomically section. (:leal ((:ecx 1) ,(* 2 movitz:+movitz-fixnum-factor+)) :eax) ; Number of words - (:call-local-pf get-cons-pointer) + (:call-local-pf cons-non-pointer) (:load-lexical (:lexical-binding bignum) :ebx) ; bignum (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) @@ -158,7 +158,7 @@ (:addl #x40000 (:eax ,movitz:+other-type-offset+)) (:addl ,movitz:+movitz-fixnum-factor+ :ecx) no-expansion - (:call-local-pf cons-commit) + (:call-local-pf cons-commit-non-pointer) ;; Exit atomically block. (:locally (:movl 0 (:edi (:edi-offset atomically-continuation)))) (:leal (:esp 16) :esp)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16028 Modified Files: basic-macros.lisp Log Message: Renamed the malloc primitive functions. Date: Thu Nov 25 19:05:33 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.51 movitz/losp/muerte/basic-macros.lisp:1.52 --- movitz/losp/muerte/basic-macros.lisp:1.51 Thu Nov 25 17:45:33 2004 +++ movitz/losp/muerte/basic-macros.lisp Thu Nov 25 19:05:32 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.51 2004/11/25 16:45:33 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.52 2004/11/25 18:05:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1078,7 +1078,7 @@ (:load-lexical (:lexical-binding ,size-var) :eax) (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation)))) ;; Now inside atomically section. - (:call-local-pf get-cons-pointer) + (:call-local-pf cons-pointer) ,@code ,@(when fixed-size-p `((:load-lexical (:lexical-binding ,size-var) :ecx))) @@ -1105,7 +1105,7 @@ (:load-lexical (:lexical-binding ,size-var) :eax) (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation)))) ;; Now inside atomically section. - (:call-local-pf get-cons-pointer-non-pointer) + (:call-local-pf cons-non-pointer) ,@code ,@(when fixed-size-p `((:load-lexical (:lexical-binding ,size-var) :ecx))) @@ -1132,7 +1132,7 @@ (:load-lexical (:lexical-binding ,size-var) :eax) (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation)))) ;; Now inside atomically section. - (:call-local-pf get-cons-pointer-non-header) + (:call-local-pf cons-non-header) ,@code ,@(when fixed-size-p `((:load-lexical (:lexical-binding ,size-var) :ecx)))

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv16003 Modified Files: los0-gc.lisp Log Message: Renamed the malloc primitive functions. Date: Thu Nov 25 19:05:23 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.42 movitz/losp/los0-gc.lisp:1.43 --- movitz/losp/los0-gc.lisp:1.42 Mon Oct 11 15:51:52 2004 +++ movitz/losp/los0-gc.lisp Thu Nov 25 19:05:23 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.42 2004/10/11 13:51:52 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.43 2004/11/25 18:05:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -132,7 +132,7 @@ (do-it))))) -(define-primitive-function los0-get-cons-pointer () +(define-primitive-function los0-cons-pointer () "Return in EAX the next object location with space for EAX words, with tag 6. Preserve ECX." (macrolet @@ -250,7 +250,7 @@ (setf (%run-time-context-slot ',slot context) code-vector))))) (install-primitive los0-fast-cons muerte::fast-cons) (install-primitive los0-box-u32-ecx muerte::box-u32-ecx) - (install-primitive los0-get-cons-pointer muerte::get-cons-pointer) + (install-primitive los0-cons-pointer muerte::cons-pointer) (install-primitive los0-cons-commit muerte::cons-commit)) (if (eq context (current-run-time-context)) (setf (%run-time-context-slot 'muerte::nursery-space)

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15986 Modified Files: image.lisp Log Message: Renamed the malloc primitive functions. Date: Thu Nov 25 19:05:17 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.82 movitz/image.lisp:1.83 --- movitz/image.lisp:1.82 Thu Nov 25 17:45:13 2004 +++ movitz/image.lisp Thu Nov 25 19:05:17 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.82 2004/11/25 16:45:13 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.83 2004/11/25 18:05:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -290,7 +290,7 @@ :initform 0) (values :binary-type #.(* 4 +movitz-multiple-values-limit+)) - (get-cons-pointer + (cons-pointer :binary-type code-vector-word :initform nil :map-binary-write 'movitz-intern-code-vector @@ -302,7 +302,7 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (get-cons-pointer-non-pointer + (cons-non-pointer :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector @@ -312,7 +312,7 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (get-cons-pointer-non-header + (cons-non-header :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11269 Modified Files: symbols.lisp Log Message: Added -non-header variation of the malloc primitive-functions. Date: Thu Nov 25 17:46:02 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.26 movitz/losp/muerte/symbols.lisp:1.27 --- movitz/losp/muerte/symbols.lisp:1.26 Tue Nov 23 17:09:34 2004 +++ movitz/losp/muerte/symbols.lisp Thu Nov 25 17:46:01 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.26 2004/11/23 16:09:34 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.27 2004/11/25 16:46:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -148,8 +148,8 @@ (let ((sxhash (sxhash name))) (macrolet ((do-it () - `(with-non-pointer-allocation-assembly (6 :fixed-size-p t - :object-register :eax) + `(with-non-header-allocation-assembly + (6 :fixed-size-p t :object-register :eax) (:addl ,(- (movitz:tag :symbol) (movitz:tag :other)) :eax) (:load-lexical (:lexical-binding package) :ebx) (:movl :ebx (:eax (:offset movitz-symbol package))) @@ -182,8 +182,8 @@ (if (or (eq nil symbol) (not copy-properties)) (%create-symbol (symbol-name symbol)) - (with-allocation-assembly (6 :object-register :eax - :fixed-size-p t) + (with-non-header-allocation-assembly + (6 :object-register :eax :fixed-size-p t) (:addl 1 :eax) (:load-lexical (:lexical-binding symbol) :ebx) ;; 0 @@ -204,7 +204,6 @@ ;; 5 (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 20) :ecx) (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 20))))) - (defun symbol-flags (symbol) (etypecase symbol

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11225 Modified Files: primitive-functions.lisp Log Message: Added -non-header variation of the malloc primitive-functions. Date: Thu Nov 25 17:45:48 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.55 movitz/losp/muerte/primitive-functions.lisp:1.56 --- movitz/losp/muerte/primitive-functions.lisp:1.55 Tue Nov 23 17:08:58 2004 +++ movitz/losp/muerte/primitive-functions.lisp Thu Nov 25 17:45:47 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.55 2004/11/23 16:08:58 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.56 2004/11/25 16:45:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -314,6 +314,18 @@ (with-inline-assembly (:returns :multiple-values) (:locally (:jmp (:edi (:edi-offset cons-commit)))))) +(define-primitive-function get-cons-pointer-non-header () + "Return in EAX the next object location with space for EAX non-pointer words, with tag 6. +Preserve ECX." + (with-inline-assembly (:returns :multiple-values) + (:locally (:jmp (:edi (:edi-offset get-cons-pointer)))))) + +(define-primitive-function cons-commit-non-header () + "Return in EAX the next object location with space for EAX non-pointer words, with tag 6. +Preserve ECX." + (with-inline-assembly (:returns :multiple-values) + (:locally (:jmp (:edi (:edi-offset cons-commit)))))) + (defun malloc-initialize (buffer-start buffer-size) "BUFFER-START is the location from which to allocate. BUFFER-SIZE is the number of words in the buffer." @@ -377,7 +389,7 @@ ;; Be defensive: Check that EAX is LISTP. (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 50))) + (:jnz '(:sub-program () (:int 63))) (:cmpl :ebp :eax) ; is cons above stack-frame? (:jge 'return-ok) (:cmpl :esp :eax) ; is cons below stack-frame?

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11165 Modified Files: basic-macros.lisp Log Message: Added -non-header variation of the malloc primitive-functions. Date: Thu Nov 25 17:45:37 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.50 movitz/losp/muerte/basic-macros.lisp:1.51 --- movitz/losp/muerte/basic-macros.lisp:1.50 Tue Nov 23 17:02:34 2004 +++ movitz/losp/muerte/basic-macros.lisp Thu Nov 25 17:45:33 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.50 2004/11/23 16:02:34 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.51 2004/11/25 16:45:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1109,7 +1109,34 @@ ,@code ,@(when fixed-size-p `((:load-lexical (:lexical-binding ,size-var) :ecx))) - (:call-local-pf cons-commit) + (:call-local-pf cons-commit-non-pointer) + (:locally (:movl 0 (:edi (:edi-offset atomically-continuation)))) + (:leal (:esp 16) :esp))))) + +(defmacro with-non-header-allocation-assembly + ((size-form &key object-register size-register fixed-size-p labels) &body code) + (assert (eq object-register :eax)) + (assert (or fixed-size-p (eq size-register :ecx))) + (let ((size-var (gensym "malloc-size-"))) + `(let ((,size-var ,size-form)) + (with-inline-assembly (:returns :eax :labels (retry-alloc retry-jumper ,@labels)) + (:declare-label-set retry-jumper (retry-alloc)) + ;; Set up atomically continuation. + (:locally (:pushl (:edi (:edi-offset :dynamic-env)))) + (:pushl 'retry-jumper) + ;; ..this allows us to detect recursive atomicallies. + (:locally (:pushl (:edi (:edi-offset :atomically-continuation)))) + (:pushl :ebp) + retry-alloc + (:movl (:esp) :ebp) + (:load-lexical (:lexical-binding ,size-var) :eax) + (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation)))) + ;; Now inside atomically section. + (:call-local-pf get-cons-pointer-non-header) + ,@code + ,@(when fixed-size-p + `((:load-lexical (:lexical-binding ,size-var) :ecx))) + (:call-local-pf cons-commit-non-header) (:locally (:movl 0 (:edi (:edi-offset atomically-continuation)))) (:leal (:esp 16) :esp)))))

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11095 Modified Files: image.lisp Log Message: Added -non-header variation of the malloc primitive-functions. Date: Thu Nov 25 17:45:14 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.81 movitz/image.lisp:1.82 --- movitz/image.lisp:1.81 Tue Nov 23 17:10:38 2004 +++ movitz/image.lisp Thu Nov 25 17:45:13 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.81 2004/11/23 16:10:38 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.82 2004/11/25 16:45:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -308,6 +308,16 @@ :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) (cons-commit-non-pointer + :binary-type code-vector-word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + (get-cons-pointer-non-header + :binary-type code-vector-word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + (cons-commit-non-header :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/ip4.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv5975 Modified Files: ip4.lisp Log Message: *** empty log message *** Date: Thu Nov 25 16:06:03 2004 Author: ffjeld Index: movitz/losp/lib/net/ip4.lisp diff -u movitz/losp/lib/net/ip4.lisp:1.14 movitz/losp/lib/net/ip4.lisp:1.15 --- movitz/losp/lib/net/ip4.lisp:1.14 Wed Nov 24 18:28:01 2004 +++ movitz/losp/lib/net/ip4.lisp Thu Nov 25 16:06:02 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 30 13:52:57 2003 ;;;; -;;;; $Id: ip4.lisp,v 1.14 2004/11/24 17:28:01 ffjeld Exp $ +;;;; $Id: ip4.lisp,v 1.15 2004/11/25 15:06:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -492,8 +492,9 @@ (unless *ip4-router* (setf *ip4-router* (ip4-address :129.242.16.1))) ;; This is to announce our presence on the LAN.. - (polling-arp *ip4-router* (lambda () - (eql #\esc (muerte.x86-pc.keyboard:poll-char)))) + (assert (polling-arp *ip4-router* (lambda () + (eql #\esc (muerte.x86-pc.keyboard:poll-char)))) + () "Unable to resolve ~/ip4:pprint-ip4/ by ARP." *ip4-router*) (values *ip4-nic* *ip4-ip*)) (defun ip4-test ()

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/pci.lisp
by Frode Vatvedt Fjeld 25 Nov '04

25 Nov '04

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(a)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))))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs November 2004