commit 69724f7f5bbd9534829354cfd00fd0084aeff0b4
parent 52d7037d9bfbbefa08fac1575affe07232ae7e78
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 6 Aug 2022 12:24:29 -0400
drv/pc/pci: refactor to allow more fields
The previous approach lead to quite inelegant code when adding more fields.
Diffstat:
5 files changed, 101 insertions(+), 27 deletions(-)
diff --git a/fs/drv/pc/pci.fs b/fs/drv/pc/pci.fs
@@ -1,17 +1,66 @@
\ PCI driver
+?f<< /lib/str.fs
$cf8 const CFGADDR
$cfc const CFGDATA
+$100 const META_FIELDDESC \ data: a string
+
0 value pcibus
0 value pcislot
0 value pcifunc
-0 value pcidevice
-0 value pcivendor
-0 value pciclass
-0 value pcisubclass
-0 value pciprogif
-0 value pcitype
+0 value _readcnt \ how many registers are read in current buffer
+create _buf $50 allot
+0 value _currentlist
+: _
+ current _currentlist ! 4 to+ _currentlist
+ '"' expectchar current 'emeta lladd drop
+ META_FIELDDESC , [compile] S" drop ;
+: pcifield ( off -- ) _buf + &@ _ ;
+: pcifieldw ( off -- ) _buf + &w@ _ ;
+: pcifieldc ( off -- ) _buf + &c@ _ ;
+
+\ Common header
+12 const COMMONFIELDCNT
+create commonfieldlist COMMONFIELDCNT 4 * allot
+commonfieldlist to _currentlist
+
+$00 pcifieldw pci.vendor "Vendor ID"
+$02 pcifieldw pci.device "Device ID"
+$04 pcifieldw pci.command "Command"
+$06 pcifieldw pci.status "Status"
+$08 pcifieldc pci.revision "Revision ID"
+$09 pcifieldc pci.progIF "progIF"
+$0a pcifieldc pci.subclass "Subclass"
+$0b pcifieldc pci.class "Class"
+$0c pcifieldc pci.cachelinesz "Cache Line Size"
+$0d pcifieldc pci.lattimer "Latency Timer"
+$0e pcifieldc pci.hdrtype "Type"
+$0f pcifieldc pci.bist "BIST"
+
+create summaryfields
+ ' pci.vendor , ' pci.device , ' pci.class , ' pci.subclass , ' pci.hdrtype ,
+
+\ Type 0 header
+15 const TYPE0FIELDCNT
+create type0fieldlist TYPE0FIELDCNT 4 * allot
+type0fieldlist to _currentlist
+
+$10 pcifield pci0.bar0 "BAR0"
+$14 pcifield pci0.bar1 "BAR1"
+$18 pcifield pci0.bar2 "BAR2"
+$1c pcifield pci0.bar3 "BAR3"
+$20 pcifield pci0.bar4 "BAR4"
+$24 pcifield pci0.bar5 "BAR5"
+$28 pcifield pci0.cisptr "Cardbus CIS ptr"
+$2c pcifieldw pci0.subsystemvendor "Subsystem Vendor"
+$2e pcifieldw pci0.subsystem "Subsystem ID"
+$30 pcifield pci0.expansionaddr "Expansion Addr"
+$34 pcifieldc pci0.capabiliesptr "Capabilities ptr"
+$3c pcifieldc pci0.interruptline "Interrupt Line"
+$3d pcifieldc pci0.interruptpin "Interrupt PIN"
+$3e pcifieldc pci0.mingrant "Min grant"
+$3f pcifieldc pci0.maxlatency "Max latency"
: pciaddr ( off -- n )
$fc and pcifunc 8 lshift or pcislot 11 lshift or pcibus 16 lshift or
@@ -19,37 +68,44 @@ $cfc const CFGDATA
: _pci@ ( pciaddr -- n ) CFGADDR p! CFGDATA p@ ;
-: pci@ ( bus slot func -- f ) \ returns whether the read yields a valid device
+\\ Read the first register of pci address and return whether it's a valid device
+: pci@ ( bus slot func -- f )
to pcifunc to pcislot to pcibus
- 0 pciaddr _pci@ dup $ffff and to pcivendor 16 rshift to pcidevice
- pcivendor $ffff = if 0 exit then
- 8 pciaddr _pci@ dup 24 rshift $ff and to pciclass
- dup 16 rshift $ff and to pcisubclass 8 rshift $ff and to pciprogif
- $0c pciaddr _pci@ 16 rshift $ff and to pcitype 1 ;
+ 0 to _readcnt 0 pciaddr _pci@ dup -1 = not if ( n )
+ _buf ! 1 to _readcnt 1 else 1+ ( 0 ) then ;
-: pcinextfunc ( -- f )
+\ Ensure that at least "n" registers are read in _buf
+: _ensureread ( n )
+ begin _readcnt over < while
+ _readcnt 4 * dup pciaddr _pci@ ( off n )
+ swap _buf + ! 1 to+ _readcnt repeat ( n ) drop ;
+
+: _nextfunc ( -- f )
begin
1 to+ pcifunc pcifunc 8 < while
pcibus pcislot pcifunc pci@ not while repeat
1 else 0 then ;
-: pcinextslot ( -- f )
+: _nextslot ( -- f )
begin
1 to+ pcislot pcislot $20 < while
pcibus pcislot 0 pci@ not while repeat
1 else 0 then ;
-: .pci ( -- )
+: _getdesc ( 'field -- str )
+ emeta META_FIELDDESC swap findemeta ?dup if 'emetadata else S" ???" then ;
+
+\\ Print current PCI device in a one line summary
+: .pciln ( -- )
pcibus .x1 ':' emit pcislot .x1 '.' emit pcifunc . spc>
- ." Vendor ID " pcivendor .x2 ." Device ID " pcidevice .x2
- ." Class " pciclass .x1 ':' emit pcisubclass .x1
- ." ProgIF " pciprogif .x1 ." Type " pcitype .x1 nl> ;
+ 5 dup _ensureread >r summaryfields begin ( a )
+ @+ dup _getdesc stype spc> execute .x? spc> next drop nl> ;
: .pcislot ( bus slot -- )
0 pci@ if
- .pci pcitype $80 and if \ multi-function
- begin pcinextfunc while .pci repeat then then ;
+ .pciln pci.hdrtype $80 and if \ multi-function
+ begin _nextfunc while .pciln repeat then then ;
: .pcibus ( bus -- )
0 0 pci@ if pcibus pcislot .pcislot then
- begin pcinextslot while pcibus pcislot .pcislot repeat ;
+ begin _nextslot while pcibus pcislot .pcislot repeat ;
diff --git a/fs/lib/nfmt.fs b/fs/lib/nfmt.fs
@@ -6,6 +6,9 @@ create _ ," 0123456789abcdef"
: .x2 dup 8 rshift .x1 .x1 ;
\\ print top of stack in hexadecimal
: .x ( n -- ) dup 16 rshift .x2 .x2 ;
+\\ print in hexadecimal with a width that depends on the value
+: .x? dup $ffff > if .x else dup $ff > if .x2 else .x1 then then ;
+
\ decimal
: _ 10 /mod ( r q ) ?dup if _ then '0' + emit ;
: . ( n -- )
diff --git a/fs/lib/str.fs b/fs/lib/str.fs
@@ -54,11 +54,15 @@ create _ 4 c, ," AZaz"
create _ 6 c, ," AZaz09"
: alnum? ( c -- f ) _ rmatch ;
+\\ Read in< until next non WS and yield it
+: toword ( -- c ) begin in< dup ws? while drop repeat ( c ) ;
+
+\\ Read in<, discarding whitespaces and expect the next char to be "c"
+: expectchar ( c -- )
+ toword over = not if emit abort" expected" else drop then ;
+
\ Create a list of strings (same format as sfind above) with the specified
\ number of elements. Each element must be "quoted" with no space (unless you
\ want them in the string) in the quotes.
\ Example: 3 stringlist mylist "foo" "bar" "hello world!"
-: stringlist create >r begin
- begin in< dup ws? while drop repeat ( c )
- '"' = not if '"' emit abort" expected" then
- [compile] S" drop next 0 c, ;
+: stringlist create >r begin '"' expectchar [compile] S" drop next 0 c, ;
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -66,6 +66,12 @@ current .x
: baz ;
' baz preventry ' bar #eq
+\ metadata and linked lists
+' bar emeta 0 #eq
+42 ' bar emeta findemeta 0 #eq
+' bar 'emeta lladd 42 , ( ll )
+42 ' bar emeta findemeta ( ll ) #eq
+
\ autoloading
floaded #
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -45,6 +45,7 @@
\ Memory
: c@+ ( a -- a+1 c ) dup 1+ swap c@ ;
+: @+ ( a -- a+4 n ) dup 4 + swap @ ;
: c!+ ( c a -- a+1 ) tuck c! 1+ ;
: Ac@+ Ac@ A+ ;
: Ac!+ Ac! A+ ;
@@ -64,6 +65,9 @@
: doer code compile (does) CELLSZ allot ;
: does> r> ( exit current definition ) current 5 + ! ;
: &+ ( n -- ) doer , does> @ + ;
+: &@ ( n -- ) doer , does> @ @ ;
+: &w@ ( n -- ) doer , does> @ w@ ;
+: &c@ ( n -- ) doer , does> @ c@ ;
: &+@ ( n -- ) doer , does> @ + @ ;
: &+! ( n -- ) doer , does> @ + ! ;
: field ( off -- ) doer , does> ( a 'w ) @ + to? ?dup if execute else @ then ;
@@ -115,6 +119,7 @@ alias noop [then]
\ Dictionary
-5 &+@ preventry
-9 &+@ emeta
+-9 &+ 'emeta
: wordlen ( w -- len ) 1- c@ $3f and ;
: wordname[] ( w -- sa sl )
dup wordlen swap 9 - over - ( sl sa ) swap ;
@@ -123,7 +128,7 @@ alias noop [then]
\ Entry metadata
4 &+@ emetatype
-8 &+ 'emeta
+8 &+ 'emetadata
: findemeta ( typeid ll -- ll-or-0 ) begin ( typeid ll )
dup while 2dup emetatype = not while llnext repeat
( success ) then ( typeid ll-or-0 ) nip ;
@@ -134,7 +139,7 @@ alias noop [then]
: \\ nextmeta lladd drop EMETA_DOCLINE , begin in< dup c, LF = until ;
: .doc ( w -- ) emeta begin ( ll )
EMETA_DOCLINE swap findemeta ?dup while ( ll )
- dup 'emeta begin c@+ dup emit LF = until drop llnext repeat ;
+ dup 'emetadata begin c@+ dup emit LF = until drop llnext repeat ;
\ Alias chaining. See doc/usage.
: _ ( 'target 'alias -- )
