/srcpci-en.txt
\                                                                    shacham
\ Ethernet PCI NIC driver (3Com 3c905B)
only
vocabulary net
only extensions also net definitions

32 constant #PCI   6 constant #MAC   1540 constant #PKT

struct xldat   intcell media   intcell cap   intcell xcvr   intcell baseport
endstruct
create xldata  xldat.size allot

create pcislot $FFFF ,  \ default to no XL present

create macaddr  #MAC allot align \ byte array in network order
create enbrdcst   $FF c, $FF c, $FF c, $FF c, $FF c, $FF c, align \ broadcast

defer delay







\                                                                    shacham
128 constant #XLRX   256 dup constant #XLTX   1 - constant #XLTXMSK
  7 constant #FRAGS   60 constant #XLTXMIN

struct xlfrag   int32 addr   int32 len   endstruct
struct xlrxlist   int32 next  int32 status   int32 frag>addr
   int32 frag>len   endstruct
struct xltxlist   int32 next  int32 status
   xlfrag.size #FRAGS * bytes frags   endstruct

struct xlstats   intcell lost   intcell sq_err   intcell tx_multi_col
   intcell tx_single_col   intcell tx_late_col   intcell rx_overrun
   intcell tx_frames_ok   intcell rx_frames_ok   intcell tx_deferred
   intcell upper_ok   intcell rx_bytes   intcell tx_bytes
   intcell status   intcell rx_ok   intcell rx_err   intcell tx_req
   intcell tx_overrun   intcell tx_ok    intcell tx_bad   intcell tx_eoc
   intcell rx_eoc   intcell rx_rol   intcell notrdy   intcell eenotrdy
 endstruct







\ mbuf                                                               shacham
struct m_hdr   int32 mh_next   int32 mh_nxtpkt    int32 mh_data
   int32 mh_len   int16 mh_type   int16 mh_flags   endstruct
struct m_pkthdr   int32 rcvif   int32 len   int32 header
   int32 csum_flags   int32 csum_data   int32 tags   endstruct
m_hdr.size m_pkthdr.size + constant #MHDR
2048 constant #MBUF

: m_data ( m -- a )  m_hdr>mh_data @ ;
: m_init ( l m -- )  dup >r over #MHDR + erase \ clear mbuf header and packet
   r@ #MHDR + r@ m_hdr>mh_data !
   dup r@ m_hdr>mh_len !   3 r@ m_hdr>mh_flags c!
   1 r@ m_hdr>mh_type c!   r> m_hdr.size + m_pkthdr>len ! ;

: m_adjlen ( m l -- )  >r dup m_hdr>mh_len dup @ r@ - swap !
   m_hdr.size + m_pkthdr>len dup @ r> - swap ! ;
: m_adj ( m l -- )  over m_hdr>mh_data over swap +!   m_adjlen ;

struct m_st   intcell get   intcell free   intcell rxget   intcell txfree
 endstruct
create mstat  m_st.size allot
: m_get ( l -- m )  #MBUF 1 cells - bkalloc tuck   m_init   mstat m_st>get inc ;
: m_freem ( m -- )  bkfree   mstat m_st>free inc ;


\                                                                    shacham
create xlrxlst    xlrxlist.size 1+ #XLRX * allot
create xltxlst    xltxlist.size 1+ #XLTX * allot
variable xlrxalg  \ 8-byte aligned xlrxlst
variable xltxalg  \ 8-byte aligned xltxlst

create xlst       xlstats.size allot

variable xlrxhead
variable xltxhead   variable xltxtail   variable xltxcnt   variable xltxmin















\ PCI generic access                                                 shacham
: pcien ( slot reg -- port )  tuck $FC and swap 11 lshift + $80000000 + $CF8
   outl   3 and $CFC + ;

: pciid ( slot -- u )  0 pcien inl dup if   dup -1 = if   drop 0   then   then ;

: pcicls ( slot -- u )  8 pcien inl 8 rshift   dup if   dup $F870FF and if
   drop 0   then   then ;

: pcihdr ( slot -- u )  14 pcien inb dup $7E and if   drop $7E   then ;

: pcibus ( slot -- )  4 pcien dup inw 7 or swap outw ;

\ pcishow      Show range n2 to n1 PCI slots (nonoperational word...)
: pcishow ( n1 n2 -- )  base @ -rot hex   do
             i pciid ?dup if   cr   ." slot " i .   ."  id  " .
             i pcicls ?dup if   ."  class " .   then
             i pcihdr dup $7E <> if   ."  header " .   else   drop   then
           then   loop   base ! ;






\ XL access                                                          shacham
: xlreg  ( u -- n )  xldata xldat>baseport @ +   ;
: xlcmd  ( u -- )  $E xlreg outw ;
: xlrdy ( -- )  1000 0 do   $E xlreg inw $1000 and 0= if   unloop exit   then
   loop   xlst xlstats>notrdy inc ;
: xlcmdrdy ( u -- )  xlcmd   xlrdy ;
: xlcmdwt ( u -- )  xlcmd   100 delay   xlrdy ;
: xleepwt  ( -- )  1000 0 do   $A xlreg inw $8000 and 0= if   unloop exit
   then   loop   xlst xlstats>eenotrdy inc ;
: xlwin  ( u -- )  $800 + xlcmd ;
: xlinb2  ( u -- n )  dup xlreg inb swap 1+ xlreg inb 8 lshift + ;
: xleeprom  ( u -- n )  $80 + $A xlreg outw   xleepwt   $C xlreg inw   ;
: xlstop ( -- )  $1800 xlcmd   $B000 xlcmd   $7000 xlcmd   $4000 xlcmdrdy
  $5000 xlcmd   $B800 xlcmd 2 delay   $6801 xlcmd   $7800 xlcmd   $7000 xlcmd ;
: xlrxrst ( -- )  $2800 xlcmdwt ;
: xltxrst ( -- )  $5800 xlcmdwt ;
: xlreset ( -- )  0 xlcmdrdy   xlrxrst   xltxrst   100 delay ;
: xleepcfg ( -- )  0 xlwin
   macaddr 3 0 do   i xleeprom 2dup 8 rshift swap c! over 1+ c! 2 +   loop drop
   $10 xleeprom   xldata xldat>cap !
   $13 xleeprom   $F0 and xldata xldat>xcvr ! ;
: xlcoax ( -- )  3 xlwin   $B800 xlcmd ;
: xlcfg ( -- )  3 xlwin   8 xlreg inw xldata xldat>media !
   0 xlreg inl   $FF0FFFFF and $800000 + 0 xlreg outl   xlcoax ;

\                                                                    vandys
: xlfind? ( -- bool )  #PCI 0 do   i pciid $905510B7 = if
   i pcislot !   i $10 pcien inl $FFF0 and xldata xldat>baseport !   i pcibus
   unloop true exit   then   loop   false ;
: xl? ( -- bool )  #PCI pcislot @ > ;

: xlattach ( -- )  xlfind? if   xlreset   xleepcfg   xlcfg   then ;
: xldetach ( -- )  xl? if   xlreset   xlstop   then ;

: xlstat ( -- )  6 xlwin   xlst 10 0 do   i xlreg inb over +! 4 +   loop
   14 10 do   i xlinb2 over +! 4 + 2   +loop   14 xlinb2 swap !
   4 xlwin $C xlreg inb drop   7 xlwin ;













\                                                                    shacham
: xladdr ( -- )  2 xlwin   macaddr #MAC 0 do   dup c@ i xlreg outb 1+   loop
   drop   12 #MAC do   0 i xlreg outw   2 +loop ;
: xltxthr ( -- )  #PKT 8 rshift $2F xlreg outb
   xltxmin @ $9800 + xlcmd   $C000 #PKT 4 rshift or xlcmd ;
: xlrxfltr ( -- )  $8005 xlcmd ;
: xlrxaddr ( -- )  $3000 xlcmdrdy   xlrxalg @ dup xlrxhead !
   $38 xlreg outl   $3001 xlcmdrdy ;

: xltxi2a ( n -- a )  xltxlist.size * xltxalg @ + ;
: xltxi& ( n -- n' )  #XLTXMSK and ;
: xltxcura ( n -- )  xltxi2a $24 xlreg outl ;
: xltxpoll ( -- )  64 $2D xlreg outb ;
: xltxaddr ( -- )  xltxpoll   $3002 xlcmdrdy   0 xltxcura   $3003 xlcmdrdy ;
: xltxen ( -- )  $4800 xlcmdrdy ;

: xlpkt ( -- )  3 xlwin   #PKT 4 xlreg outw ;
: xlstaten ( -- )  4 xlwin   $40 6 xlreg outw   $A800 xlcmd ;
: xlinten ( -- )  $68FF xlcmd   $687 $7800 + xlcmd   $687 $7000 + xlcmd ;
: xlrxthr ( -- )  $8800 #PKT 2 rshift + xlcmd   $20 $20 xlreg outw ;

: (align8) ( a -- a' )  7 + $FFFFFFF8 and ;



\                                                                    shacham
: xlrxmget ( l -- )  #PKT m_get   m_data over xlrxlist>frag>addr !
   #MBUF $80000000 + swap xlrxlist>frag>len !   mstat m_st>rxget inc ;

: xlrxinit ( -- )  xlrxlst (align8) dup xlrxalg !   #XLRX 0 do
    dup xlrxlist.size erase   dup xlrxmget
    i 1+ #XLRX = if   xlrxalg @   else   dup xlrxlist.size +   then
    tuck swap xlrxlist>next !
   loop   drop ;

: xltxinit ( -- )  xltxlst (align8) dup xltxalg !   dup xltxlist.size erase
   $20000000 swap xltxlist>status !   1 xltxhead !   1 xltxtail !
   0 xltxcnt !   #XLTXMIN xltxmin ! ;
: xlbufclr ( -- )  xlst xlstats.size erase ;

: xlinit ( -- )  xl? if   xlbufclr
   xlstop   xlrxrst   xltxrst 10 delay   xladdr   xlrxinit   xltxinit   xltxthr
   xlrxfltr   xlrxaddr   xltxaddr   xlcoax   xlpkt   $B000 xlcmd   xlstat
   xlstaten   ( xlinten )   xlrxthr
   xltxen   $2000 xlcmdrdy   7 xlwin   then ;





\ receive                                                            shacham
: xlrxok? ( st -- len T | F )  dup $4000 and 0= if   dup $8000 and 0<> if
   $1FFF and dup #PKT 4 + swap > if   true exit   then   then   then
   drop false ;
: xlrxeoc ( -- )  $38 xlreg inl 0<> if   $30 xlreg inl $2000 and 0= if
   exit   then   then   xlrxaddr   xlst xlstats>rx_eoc inc ;
: (l4ok) ( mp f -- mp f' )  $C00 or   over m_pkthdr>csum_data $FFFF swap ! ;
: xlrxip ( mp st -- )  >r
   r@ $20000000 and 21 rshift   r@ $02000000 and 16 rshift $200 xor or
   r@ $44000000 and $40000000 = if   (l4ok)   then
   r> $88000000 and $80000000 = if   (l4ok)   then
   swap m_pkthdr>csum_flags ! ;
defer etherin
: xlrx ( -- )  xlrxhead @ begin
   dup xlrxlist>status @ ?dup while
     tuck xlrxok? if   xlst xlstats>rx_ok inc
       over xlrxlist>frag>addr @ #MHDR - 2dup m_hdr>mh_len !
       dup >r m_hdr.size + tuck m_pkthdr>len !   rot xlrxip \ r> dup etherin
       dup xlrxmget   r> etherin ( 0 swap m_init )
     else   nip   xlst xlstats>rx_err inc   then
     0 over xlrxlist>status !   xlrxlist>next @ dup xlrxhead !
     dup xlrxalg @ = if   xlst xlstats>rx_rol inc   then
   repeat   drop   xlrxeoc ;


\ transmit                                                           shacham
: xltxovr? ( -- bool )  3 #XLTX xltxcnt @ - > ;

: xltxip ( m l -- )  swap m_hdr.size + m_pkthdr>csum_flags @ 7 and 25 lshift
   $10000000 or ( over xltxlist>status @ or ) swap xltxlist>status ! ;

: xltxenc ( m l -- bool )  2dup dup xltxlist>frags   #FRAGS 0 do
     >r over m_hdr>mh_len @ ( 2dup swap xltxlist>status +! ) \ accumulate len
     r@ xlfrag>len !                        \ fragment length
     over m_data r@ xlfrag>addr !           \ and data address
     swap m_hdr>mh_next @ dup 0= if         \ next mbuf in chain
       2drop r> xlfrag>len dup @ $80000000 or swap !  \ mark last frag
       xltxip   unloop false exit    then   \ add ip flags, all done
     swap r> xlfrag.size +                  \ next frag
  loop   2drop 2drop true ;                 \ too many frags

: xltx ( m -- )  dup 0= if   drop xlst xlstats>tx_bad inc exit   then
   xltxovr? if   drop xlst xlstats>tx_overrun inc exit   then
   xltxhead @ xltxi2a dup xltxlist.size erase
   xltxenc if   xlst xlstats>tx_bad inc exit   then
   xltxhead @ 1- xltxi& xltxi2a xltxlist>next xltxhead @ xltxi2a swap !
   xltxhead dup @ 1+ xltxi& swap !   xltxcnt inc   xlst xlstats>tx_req inc ;



\                                                                    shacham
: xltxfree ( l -- )  xltxlist>frags   #FRAGS 0 do
     dup xlfrag>addr @ ?dup 0= if   unloop drop exit   then
     #MHDR - m_freem   mstat m_st>txfree inc   xlfrag.size +   loop   drop ;

: xltxeof ( -- )  xltxhead @ xltxtail @ begin
    2dup = if   2drop exit   then
    dup xltxi2a dup xltxlist>status @ $10000 and 0= if   drop 2drop exit   then
    xltxfree   1+ xltxi& dup xltxtail !   -1 xltxcnt +!   xlst xlstats>tx_ok inc
   again ;

: xltxeoc ( -- )  #XLTX 0 do  \ avoid an infinite loop
     $1B xlreg inb ?dup 0= if   unloop exit   then
     $32 and ?dup 0<> if
       xltxrst   xltxtail @ xltxcura   xltxpoll
       $10 and 0<> if   #XLTXMIN xltxmin +!   then   xltxthr
       xlst xlstats>tx_eoc inc   then
     xltxen   $3003 xlcmd   1 $1B xlreg outb
   loop   ." xl txeoc - too many events" ;

: xltimer ( -- )  xlrx   xltxeof   xltxeoc   xlstat ;




\                                                                    shacham
: htons ( u -- u' )  dup 8 lshift $FF00 and   swap 8 rshift $FF and   or ;
: ntohs ( u -- u' )  htons ;
: hton ( u -- u' )  dup htons 16 lshift   swap 16 rshift htons   or ;
: ntoh ( u -- u' )  hton ;
: htonl ( u -- u' )  hton ;
: ntohl ( u -- u' )  hton ;

: htons! ( u a -- )  over 8 rshift over c!   1+ c! ;
















\ Ethernet                                                           vandys
2 constant #TYPE   $800 constant ENIP   $806 constant ENARP
1500 constant #ENDATA
struct ether   #MAC bytes dhost   #MAC bytes shost   #TYPE bytes type
endstruct
struct enstats   intcell ok   intcell shrt   intcell u   intcell xmt   endstruct
create enst   enstats.size allot
defer ip_input   defer arpinput   defer arprslv
:noname ( m -- )  dup m_hdr>mh_len @ ether.size > if   enst enstats>ok inc
     dup m_data ether>type @ ntohs   over ether.size m_adj
     dup ENIP = if   drop   ip_input   exit   then
     ENARP = if   arpinput   exit   then
     m_freem   enst enstats>u inc
   else   m_freem   enst enstats>shrt inc   then ; is etherin

: enoutraw ( m -- )  xltx ;
: enhdr ( d s t a -- )  >r r@ ether>type htons!
   r@ ether>shost #MAC cmove   r> ether>dhost #MAC cmove ;

: enbuild ( m ha -- )  over ether.size negate m_adj
   swap >r macaddr ENIP r> m_data enhdr ;

: enout ( m dst -- )  arprslv ?dup 0= if   m_freem   else
   over swap enbuild   enoutraw   enst enstats>xmt inc   then ;

\                                                                    shacham

: entxtst ( -- )  17 m_get >r                \ init mbuf
   enbrdcst macaddr 3 r@ m_data enhdr        \ Ethernet header
   $E3 r@ m_data ether.size + 2 + c!         \ Ethernet load
   r> enoutraw ;                             \ xmit

: pci-en-init ( -- )  enst enstats.size erase   mstat m_st.size erase ;

only