[openfirmware] r1000 - cpu/x86/pc/neptune dev/dnet
svn at openfirmware.info
svn at openfirmware.info
Tue Nov 11 00:56:29 CET 2008
Author: wmb
Date: 2008-11-11 00:56:29 +0100 (Tue, 11 Nov 2008)
New Revision: 1000
Modified:
cpu/x86/pc/neptune/fw.bth
dev/dnet/dnet.fth
Log:
Neptune ethernet driver - initial checkin of working version.
Modified: cpu/x86/pc/neptune/fw.bth
===================================================================
--- cpu/x86/pc/neptune/fw.bth 2008-11-08 06:01:40 UTC (rev 999)
+++ cpu/x86/pc/neptune/fw.bth 2008-11-10 23:56:29 UTC (rev 1000)
@@ -237,6 +237,31 @@
fload ${BP}/dev/geode/usb.fth
' noop to go-hook \ this is required for accessing USB device from client program (e.g. VME)
+devalias net /ethernet
+
+8 buffer: mac-address-buf
+: random-mac-address ( -- adr len )
+ mac-address-buf @ 0= if
+ \ Get a pseudo-random number
+
+ \ Seed it with the real time clock and the timestamp counter
+ time&date xor xor xor xor xor ( seed )
+ tsc@ xor xor ( seed' )
+
+ \ Scramble it a bit with a linear congruence
+ d# 1103515245 * d# 12345 + h# 7FFFFFFF and ( rn1 )
+ dup mac-address-buf ! ( rn1 )
+ d# 1103515245 * d# 12345 + h# 7FFFFFFF and ( rn2 )
+ mac-address-buf 3 + ! ( )
+
+ \ Turn off the multicast bit and turn on the locally-assigned bit
+ mac-address-buf c@ h# fe and 2 or mac-address-buf c!
+ then
+
+ mac-address-buf 6
+;
+' random-mac-address to system-mac-address
+
\ false to stand-init-debug?
true to stand-init-debug?
Modified: dev/dnet/dnet.fth
===================================================================
--- dev/dnet/dnet.fth 2008-11-08 06:01:40 UTC (rev 999)
+++ dev/dnet/dnet.fth 2008-11-10 23:56:29 UTC (rev 1000)
@@ -1,330 +1,405 @@
-purpose: Ethenet Driver for Lattice Ethernet device (dnet)
+purpose: Driver for DAVE Ethernet FPGA (Lattice IP)
\ See license at end of file
-hex
-headers
+" ethernet" name
+" Lattice,tri-speed-eth" encode-string " compatible" property
+" network" device-type
-: copyright ( -- )
- ." Copyright (c) 2008 Dave Srl. All Rights Reserved." cr
-;
+h# 100000 constant /irq-regs \ Total size of adapter’s register bank
+h# 10000000 constant /mac-regs \ Total size of adapter’s register bank
-\ Register offsets from the adapter’s base address
+\ Define "reg" property
+\ PCI Configuration Space
+my-address my-space encode-phys 0 encode-int encode+ 0 encode-int encode+
-\ TODO remove the following
-0 constant control \ 1 byte W/O - writing one bits causes things to happen
-2 constant unicast-addr \ 6 bytes R/W - Ethernet address for reception
-8 constant xmit-status \ 1 byte - 0 => busy 1 => okay else => error
-9 constant xmit-fifo \ 1 byte - write repetitively to setup packet
-a constant xmit-len \ 16 bits - length of packet to send
-c constant rcv-rdy \ 1 byte - count of waiting packets
-d constant rcv-fifo \ 1 byte - read repetitively to remove first packet
-e constant rcv-len \ 16 bits
-10 constant local-addr \ 6 bytes R/O - Factory-assigned Ethernet address
-\ until here
+\ Memory Space Base Address Register 10
+my-address my-space h# 0200.0010 or encode-phys encode+
+0 encode-int encode+ /irq-regs encode-int encode+
+\ Memory Space Base Address Register 14
+my-address my-space h# 0200.0014 or encode-phys encode+
+0 encode-int encode+ /mac-regs encode-int encode+
-\ dnet register definition
+\ \ PCI Expansion ROM - not present
+\ my-address my-space h# 200.0030 or encode-phys encode+
+\ 0 encode-int encode+ h# 10.0000 encode-int encode+
-0 constant rx-len-fifo
-4 constant rx-data-fifo
-8 constant tx-len-fifo
-c constant rx-data-fifo
+" reg" property
-100 constant verid
-104 constant intr-src
-108 constant intr-enb
-10c constant rx-status
-110 constant tx-status
-114 constant rx-frames-cnt
-118 constant tx-frames-cnt
-11c constant rx-fifo-th
-120 constant tx-fifo-th
-124 constant sys-ctl
-128 constant pause-tmr
+0 instance value chip
+: map-regs ( -- )
+ h# 0040.0000 0 my-space h# 14 + h# 0200.0000 or h# 1000
+ " map-in" $call-parent to chip
+ 2 my-space 4 + " config-w!" $call-parent
+;
+: unmap-regs ( -- )
+ 0 my-space 4 + " config-w!" $call-parent
+ chip h# 1000 " map-out" $call-parent
+;
+: reg@ ( offset -- l ) chip + rl@ ;
+: reg! ( l offset -- ) chip + rl! ;
-200 constant macreg-data
-204 constant macreg-addr
-1 d# 31 << constant macreg-write
+: rx-cmd-fifo@ ( -- l ) 0 reg@ ;
+: rx-data-fifo@ ( -- l ) 4 reg@ ;
+: tx-cmd-fifo! ( l -- ) 8 reg! ;
+: tx-data-fifo! ( l -- ) h# c reg! ;
-\ TODO: dnet rx & tx statistics counter registers
+: capa@ ( -- l ) h# 100 reg@ ;
+1 constant mdio
+2 constant irq
+4 constant gigabit
+8 constant dma
+h# 10 constant rmii
-\ macreg register definition
-0 constant macreg-mode
-2 constant macreg-rxtx-mode
-4 constant macreg-max_pkt_size
-8 constant macreg-igp
-a constant macreg-mac_addr_0
-c constant macreg-mac_addr_1
-e constant macreg-mac_addr_2
-12 constant macreg-tx_rx_sts
-14 constant macreg-gmii_mng_ctl
-16 constant macreg-gmii_mng_dat
+: intr-src@ ( -- l ) h# 104 reg@ ;
+: intr-src! ( l -- ) h# 104 reg! ;
+: intr-enb@ ( -- l ) h# 108 reg@ ;
+: intr-enb! ( l -- ) h# 108 reg! ;
-100000 constant /regs \ Total size of adapter’s register bank
-10000000 constant /real-regs \ Total size of adapter’s register bank
+4 constant tx-dat-ae
+h# 10 constant tx-fifo-f
+h# 100 constant rx-cmd-af
+h# 200 constant rx-cmd-ff
+h# 400 constant rx-data-af
+h# 1000 constant tx-smry
+h# 2000 constant rx-smry
+h# 4000 constant glob-enb
+h# 8000 constant phy
-: map-in ( addr space size -- virt ) " map-in" $call-parent ;
+: rx-status@ ( -- l ) h# 10c reg@ ;
+: rx-status! ( l -- ) h# 10c reg! ;
-: map-out ( virt size -- ) " map-out" $call-parent ;
+1 constant stat-rx-cmd-af
+2 constant stat-rx-cmd-ff
+4 constant stat-rx-data-f
-: my-w@ ( offset -- w ) my-space + " config-w@" $call-parent ;
-: my-w! ( w offset -- ) my-space + " config-w!" $call-parent ;
+: tx-status@ ( -- l ) h# 110 reg@ ;
+: tx-status! ( l -- ) h# 110 reg! ;
-" ethernet" device-name
-" Lattice,tri-speed-eth" encode-string " compatible" property
-" network" device-type
+4 constant stat-tx-data-ae
+h# 10 constant stat-tx-fifo-f
-\ Some of Apple’s Open Firmware implementations have a bug in their map-in method. The
-\ bug causes phys.lo and phys.mid to be treated as absolute addresses rather than
-\ offsets even when working with relocatable addresses.
-\ To overcome this bug, the Open Firmware Working Group in conjunction with Apple has
-\ adopted a workaround that is keyed to the presence or absence of the add-range method
-\ in the PCI node. If the add-range method is present in an Apple ROM, the map-in
-\ method is broken. If the add-range property is absent, the map-in method behaves
-\ correctly.
-\ The following methods allow the FCode driver to accomodate both broken and working
-\ map-in methods.
-: map-in-broken? ( -- flag )
- \ Look for the method that is present when the bug is present
- " add-range" my-parent ihandle>phandle ( adr len phandle )
- find-method dup if nip then ( flag ) \ Discard xt if present
-;
+: rx-fifo-th@ ( -- l ) h# 11c reg@ ;
+: rx-fifo-th! ( l -- ) h# 11c reg! ;
+: tx-fifo-th@ ( -- l ) h# 120 reg@ ;
+: tx-fifo-th! ( l -- ) h# 120 reg! ;
+: sys-ctl@ ( -- l ) h# 124 reg@ ;
+: sys-ctl! ( l -- ) h# 124 reg! ;
-\ Return phys.lo and phys.mid of the address assigned to the PCI base address
-\ register indicated by phys.hi .
-: get-base-address ( phys.hi -- phys.lo phys.mid phys.hi )
- " assigned-addresses" get-my-property if ( phys.hi )
- ." No address property found!" cr
- 0 0 rot exit \ Error exit
- then ( phys.hi adr len )
- rot >r ( adr len ) ( r: phys.hi )
- \ Found assigned-addresses, get address
- begin dup while ( adr len' ) \ Loop over entries
- decode-phys ( adr len' phys.lo phys.mid phys.hi )
- h# ff and r@ h# ff and = if ( adr len' phys.lo phys.mid ) \ This one?
- 2swap 2drop ( phys.lo phys.mid ) \ This is the one
- r> exit ( phys.lo phys.mid phys.hi )
- else ( adr len’ phys.lo phys.mid ) \ Not this one
- 2drop ( adr len’ )
- then ( adr len’ )
- decode-int drop decode-int drop \ Discard boring fields
- repeat
- 2drop ( )
- ." Base address not assigned!" cr
- 0 0 r> ( 0 0 phys.hi )
-;
+8 constant rx-flush
+h# 10 constant tx-flush
-\ String comparision
-: $= ( adr0 len0 adr1 len1 -- equal? )
- 2 pick <> if 3drop false exit then ( adr0 len0 adr1 )
- swap comp 0=
+defer us-delay
+: set-delay ( -- )
+ " us" $find 0= if 2drop ['] ms then to us-delay
;
-\ Define "reg" property
-\ PCI Configuration Space
-my-address my-space encode-phys 0 encode-int encode+ 0 encode-int encode+
+: be-w@ ( adr -- w ) dup 1+ c@ swap c@ bwjoin ;
+: be-w! ( w adr -- w ) >r wbsplit r@ c! r> 1+ c! ;
-\ Memory Space Base Address Register 10
-my-address my-space 0200.0010 or encode-phys encode+
-0 encode-int encode+ /regs encode-int encode+
+: pause-tmr@ ( -- l ) h# 128 reg@ ;
+: pause-tmr! ( l -- ) h# 128 reg! ;
+: rx-fifo-wcnt@ ( -- l ) h# 12c reg@ ;
+: tx-fifo-wcnt@ ( -- l ) h# 130 reg@ ;
-\ Memory Space Base Address Register 14
-my-address my-space 0200.0014 or encode-phys encode+
-0 encode-int encode+ /real-regs encode-int encode+
+: tmac@ ( reg# -- w ) h# 204 reg! 1 us-delay h# 200 reg@ ;
+: tmac! ( w reg# -- ) swap h# 200 reg! h# 8000.0000 or h# 204 reg! 1 us-delay ;
-\ PCI Expansion ROM
-my-address my-space h# 200.0030 or encode-phys encode+
-0 encode-int encode+ h# 10.0000 encode-int encode+
-" reg" property
+: mode@ ( -- w ) 0 tmac@ ;
+: mode! ( w -- ) 0 tmac! ;
--1 instance value chipbase
--1 instance value real-chipbase
+\ Mode register bits
+1 constant gbit-en
+2 constant fc-en
+4 constant rx-en
+8 constant tx-en
-: map-regs ( -- )
- map-in-broken? if
- my-space h# 8200.0010 or get-base-address ( phys.lo phys.mid phys.hi )
- else
- my-address my-space h# 200.0010 or ( phys.lo phys.mid phys.hi )
- then ( phys.lo phys.mid phys.hi )
+: tx-rx-ctl@ ( -- w ) 2 tmac@ ;
+: tx-rx-ctl! ( w -- ) 2 tmac! ;
- /regs map-in to chipbase
- 4 dup my-w@ 2 or swap my-w! \ Enable memory space
- chipbase encode-int " address" property
+\ tx-rx-ctl bits
- map-in-broken? if
- my-space h# 8200.0010 or get-base-address ( phys.lo phys.mid phys.hi )
- else
- my-address my-space h# 200.0014 or ( phys.lo phys.mid phys.hi )
- then ( phys.lo phys.mid phys.hi )
+ 1 constant prms
+ 2 constant discard-fcs
+ 4 constant tx-dis-fcs
+ 8 constant receive-pause
+h# 10 constant receive-mltcst
+h# 20 constant hden
+h# 40 constant drop-control
+h# 80 constant receive-brdcst
+h# 100 constant receive-short
- /real-regs map-in to real-chipbase
- real-chipbase encode-int " real-address" property
+: max-pkt-size@ ( -- w ) 4 tmac@ ;
+: max-pkt-size! ( w -- ) 4 tmac! ;
-;
+: ipg-val@ ( -- w ) 8 tmac@ ;
+: ipg-val! ( w -- ) 8 tmac! ;
-: unmap-regs ( -- )
- 4 dup my-w@ 4 invert and swap my-w! \ Disable memory space
- chipbase /regs map-out -1 to chipbase
- real-chipbase /real-regs map-out -1 to chipbase
- " address" delete-property
+: mac-addr@ ( index -- w ) /w* h# a + tmac@ ;
+: mac-addr! ( n index -- ) /w* h# a + tmac! ;
+
+: set-mac-addr ( adr len -- )
+ drop
+ dup be-w@ 0 mac-addr! wa1+
+ dup be-w@ 1 mac-addr! wa1+
+ be-w@ 2 mac-addr!
;
+: get-mac-addr ( adr 6 -- )
+ drop
+ 0 mac-addr@ over be-w! wa1+
+ 1 mac-addr@ over be-w! wa1+
+ 2 mac-addr@ swap be-w!
+;
-: e@ ( register -- byte ) real-chipbase 4000000 + + rb@ ;
-: e! ( byte register -- ) real-chipbase 4000000 + + rb! ;
-: ew@ ( register -- 16-bits ) real-chipbase 4000000 + + rw@ ;
-: ew! ( 16-bits register -- ) real-chipbase 4000000 + + rw! ;
-: el@ ( register -- 16-bits ) real-chipbase 4000000 + + rl@ ;
-: el! ( 16-bits register -- ) real-chipbase 4000000 + + rl! ;
+: tx-rx-stat@ ( -- w ) h# 12 tmac@ ;
+: tx-rx-stat! ( w -- ) h# 12 tmac! ;
-: mac@ ( register -- 16-bits)
- \ write address to address register
- macreg-addr el!
- \ read data register
- macreg-data el@
-;
+\ tx-rx-stat bits
-: mac! ( 16-bits register -- 16-bits )
- \ write data to data register
- swap macreg-data el!
- \ write address to address register
- macreg-write or macreg-addr el!
+ 1 constant tx-idle
+ 2 constant pause-frame
+ 4 constant crc-error
+ 8 constant error-frame
+h# 10 constant long-frame
+h# 20 constant short-frame
+h# 40 constant ipg-shrink
+h# 80 constant multcst-frame
+h# 100 constant brdcst-frame
+h# 200 constant tagged-frame
+h# 400 constant rx-idle
+: gmii-mng-ctl@ ( -- w ) h# 14 tmac@ ;
+: gmii-mng-ctl! ( w -- ) h# 14 tmac! ;
+
+\ gmii-mng-ctl bits
+
+h# 2000 constant rw-phyreg
+h# 4000 constant cmd-fin
+
+: gmii-mng-dat@ ( -- w ) h# 16 tmac@ ;
+: gmii-mng-dat! ( w -- ) h# 16 tmac! ;
+
+: gmii-wait ( -- )
+ d# 100 0 do
+ gmii-mng-ctl@ cmd-fin and if unloop exit then
+ d# 10 us-delay
+ loop
+ ." Lattice Ethernet - GMII_MNG_CTL stuck busy" cr
+ abort
;
-: control-on ( control-bit -- ) control e@ or control e! ;
-: control-off ( control-bit -- ) invert control e@ and control e! ;
+0 instance value phy#
+: mii-read ( reg -- w )
+ phy# bwjoin gmii-mng-ctl! ( )
+ gmii-wait gmii-mng-dat@
+;
+: mii-write ( n reg -- )
+ swap gmii-mng-dat! ( reg )
+ phy# bwjoin rw-phyreg or gmii-mng-ctl! ( )
+ gmii-wait
+;
+: find-phy ( -- error? )
+ h# 20 0 do
+ i to phy#
+ 2 mii-read h# ffff <> if false unloop exit then
+ loop
+ true
+;
-: reset-chip ( -- ) 1 control e! ;
-: receive-on ( -- ) 2 control-on ;
-: return-buffer ( -- ) 4 control-on ;
-: start-xmit ( -- ) 8 control-on ;
-: promiscuous ( -- ) 10 control-on ;
-: loopback-on ( -- ) 20 control-on ;
-: loopback-off ( -- ) 20 control-off ;
+: vlan-tag@ ( -- w ) h# 32 tmac@ ;
+: vlan-tag! ( w -- ) h# 32 tmac! ;
-: receive-ready? ( -- #pkts-waiting ) rcv-rdy e@ ;
-: wait-for-packet ( -- ) begin key? receive-ready? or until ;
+: mlt-tab@ ( index -- w ) /w* h# 32 + tmac@ ;
+: mlt-tab! ( n index -- ) /w* h# 32 + tmac! ;
-\ Create local-mac-address property from the information in the chip
-map-regs
-6 alloc-mem ( mem-addr )
-6 0 do local-addr i + rb@ over i + c! loop ( mem-addr )
-6 2dup encode-string " local-mac-address" property ( mem-addr 6 )
-free-mem
-unmap-regs
+: paus-op@ ( -- w ) h# 34 tmac@ ;
+: paus-op! ( w -- ) h# 34 tmac! ;
-: initchip ( -- )
- reset-chip
- \ Ask the host system for the station address and give it to the adapter
- mac-address 0 do ( addr )
- dup i + c@ unicast-addr i + e! ( addr )
- loop drop
- receive-on \ Enable reception
+: link-down ( -- )
+ mode@ rx-en tx-en or invert and mode!
;
-: net-init ( -- succeeded? )
- \ loopback-on loopback-test loopback-off if init-chip true else false then
- true
+: set/clear ( val bits set? -- val' )
+ if or else invert and then
;
-\ Check for incoming Ethernet packets while using promiscuous mode.
-: watch-test ( -- )
- ." Looking for Ethernet packets." cr
- ." ’.’ is a good packet. ’X’ is a bad packet." cr
- ." Press any key to stop." cr
- begin
- wait-for-packet
- receive-ready? if
- rcv-len ew@ 8000 and 0= if ." ." else ." X" then
- return-buffer
- then
- key? dup if key drop then
- until
+: link-up ( gigabit? half-duplex? -- )
+ tx-rx-ctl@ hden rot set/clear tx-rx-ctl! ( gigabit? )
+ mode@ gbit-en rot set/clear ( mode' )
+ rx-en tx-en or or mode! ( )
;
-: (watch-net) ( -- )
- map-regs
- promiscuous
- net-init if watch-test reset-chip then
- unmap-regs
+: marvell-fixup ( -- ) h# 4148 h# 18 mii-write ;
+
+: reset-hw ( -- )
+ fc-en mode!
+ d# 20 rx-fifo-th!
+ d# 25 tx-fifo-th!
+ rx-flush tx-flush or sys-ctl!
+ 1 ms
+ 0 sys-ctl!
;
-: le-selftest ( -- passed? )
- net-init
- \ dup if net-off then
+\ String comparision
+: $= ( adr0 len0 adr1 len1 -- equal? )
+ 2 pick <> if 3drop false exit then ( adr0 len0 adr1 )
+ swap comp 0=
;
-external
-: read ( addr requested-len -- actual-len )
- \ Exit if packet not yet available
- receive-ready? 0= if 2drop -2 exit then
- rcv-len ew@ dup 8000 and = if ( addr requested-len packet-len )
- 3drop return-buffer \ Discard bad packet
- -1 exit
- then ( addr requested-len packet-len )
+\ Handle some possible argument values
+0 instance value promiscuous?
- \ Truncate to fit into the supplied buffer
- min ( addr actual-len )
+0 instance value tftp-args
+0 instance value tftp-len
- \ Note: For a DMA-based adapter, the driver would have to synchronize caches (e.g.
- \ with "dma-sync") and copy the packet from the DMA buffer into the result buffer.
+: parse-args ( -- )
+ my-args begin ( rem$ )
+ 2dup to tftp-len to tftp-args ( rem$ )
+ dup while ( rem$ )
+ ascii , left-parse-string ( rem$ head$ )
+ 2dup " promiscuous" $= if true to promiscuous? else ( rem$ head$ )
+\ 2dup " loopback" $= if true to loopback? else ( rem$ head$ )
+ 2drop 2drop exit ( )
+ then ( rem$ head$ )
+ 2drop ( rem$ )
+ repeat ( rem$ )
+ 2drop ( )
+;
- tuck bounds ?do rcv-fifo e@ i c! loop ( actual-len )
- return-buffer ( actual-len )
+\ Wait for autonegotiation complete. Returns true if the link is down.
+: phy-wait ( -- error? )
+ d# 500 0 do
+ 1 mii-read h# 20 and if false unloop exit then
+ 1 ms
+ loop
+ true
;
-: close ( -- ) reset-chip unmap-regs ;
+\ Determine whether to use gigabit mode and half-duplex mode
+\ based on information from the PHY
-: open ( -- ok? )
- map-regs
- mac-address encode-string " mac-address" property
- \ initchip
- \ my-args " promiscuous" $= if promiscuous then
+: link-type ( -- gigabit? half-duplex? )
+ \ Merge together our 1000BT capabilites and the link partner's
+ 9 mii-read 2 lshift d# 10 mii-read and ( bits )
- \ Note: For a DMA-based adapter, the driver would have to allocate DMA memory for
- \ packet buffers, construct buffer descriptor data structures, and possibly
- \ synchronize caches (e.g. with "dma-sync").
- true
+ \ Gigabit if either 1000BT full duplex or 1000BT half duplex
+ dup h# c00 and if \ 1000BT ? ( bits )
+ \ Half duplex if not full duplex
+ true swap h# 800 and 0= ( gigabit? half-duplex? )
+ exit
+ then ( bits )
+ drop ( )
+
+ false ( gigabit? )
+ \ Merge our 10/100BT capabilities and the link partner's
+ 4 mii-read 5 mii-read and ( gigabit? bits )
+
+ \ 100BT FD?
+ dup h# 100 and if drop false exit then ( gigabit? bits )
+
+ \ 100BT HD?
+ dup h# 80 and if drop true exit then ( gigabit? bits )
+
+ \ Half duplex if not 10BT FD
+ h# 40 and 0= ( gigabit? half-duplex? )
;
-: write ( addr len -- actual )
- begin xmit-status e@ 0<> until
- \ Note: For a DMA-based adapter, the driver would have to copy the
- \ packet into the DMA buffer and synchronize caches (e.g. with "dma-sync").
- \ Copy packet into chip
- tuck bounds ?do i c@ xmit-fifo e! loop
- \ Set length register
- dup h# 64 max xmit-len ew!
- start-xmit
+: ?marvell-fix ( -- )
+ 1 mii-read h# 0141 <> if exit then
+ 2 mii-read h# 0cc0 <> if exit then
+ h# 4148 h# 18 mii-write \ LINK1000 as Link LED, TX as activity LED
;
-: load ( addr -- len )
- " obp-tftp" find-package if ( addr phandle )
- my-args rot open-package ( addr ihandle|0 )
- else ( addr )
- 0 ( addr 0 )
- then ( addr ihandle|0 )
- dup 0= abort" Can’t open obp-tftp support package" ( addr ihandle )
+: setup-link ( -- okay? )
+ find-phy if
+ ." Lattice Ethernet: Can't find the PHY" cr
+ false exit
+ then
- >r
- " load" r@ $call-method ( len )
- r> close-package
+ ?marvell-fix
+
+ phy-wait if ." Link down" cr false exit then
+
+ link-type link-up
+ true
;
-: selftest ( -- failed? )
+: init-hw ( -- )
+ reset-hw
+
+ mac-address set-mac-addr
+
+ tx-rx-ctl@
+ promiscuous? if prms or then
+ \ Not supporting multicast yet
+ receive-pause or
+ receive-brdcst or
+ drop-control or
+ discard-fcs or
+ tx-rx-ctl!
+ intr-src@ drop \ Clear IRQs
+ 0 intr-enb! \ Disable IRQs
+;
+: open ( -- okay? )
map-regs
- le-selftest 0=
+ set-delay
+ parse-args
+ init-hw
+ setup-link ( okay? )
+;
+
+: close ( -- )
+ reset-hw \ Includes the effect of link-down
unmap-regs
;
-: watch-net ( -- )
- selftest 0= if (watch-net) then
+: read ( adr len -- actual )
+ rx-fifo-wcnt@ d# 16 rshift if ( adr len )
+ rx-cmd-fifo@ lwsplit ( adr len actual stats )
+ h# df18 and ?dup if ( adr len actual error )
+ ." RX packet error " .x cr ( adr len actual )
+ 3drop -2 exit
+ then ( adr len actual )
+ min tuck ( actual' adr actual' )
+ bounds ?do rx-data-fifo@ i l! /l +loop
+ else
+ 2drop -2
+ then
;
-fcode-end
+d# 2048 constant dnet-fifo-size
+
+: write ( adr len -- actual )
+ tuck ( actual adr len )
+ over 3 and over 3 + + 2 rshift >r ( actual adr len r: #words )
+ dnet-fifo-size r@ - ( actual adr len needed r: #words )
+ begin dup tx-fifo-wcnt@ > until ( actual adr len needed r: #words )
+ drop ( actual adr len )
+ over 3 and d# 16 lshift + swap ( actual tx-cmd adr r: #words )
+ 3 invert and r> /l* bounds ?do ( actual tx-cmd )
+ i l@ tx-data-fifo! ( actual tx-cmd )
+ /l +loop ( actual tx-cmd )
+ tx-cmd-fifo! ( actual )
+;
+
+: load ( adr -- len )
+ " obp-tftp" find-package if ( adr phandle )
+ tftp-args tftp-len rot open-package ( adr ihandle|0 )
+ else ( adr )
+ 0 ( adr 0 )
+ then ( adr ihandle|0 )
+
+ dup 0= if ." Can't open obp-tftp support package" abort then
+ ( adr ihandle )
+
+ >r
+ " load" r@ $call-method ( len )
+ r> close-package
+;
+
\ LICENSE_BEGIN
-\ Copyright (c) 2008 Dave Srl
+\ Copyright (c) 2008 FirmWorks
\
\ Permission is hereby granted, free of charge, to any person obtaining
\ a copy of this software and associated documentation files (the
More information about the openfirmware
mailing list