\ qed.fth
fcode-version3
headers
fload board.fth
: copyright ( -- )
." QED 1.1 " cr
." Copyright 1992-1998 Sun Microsystems, Inc. All Rights Reserved" cr
;
: instance ( -- ) fcode-revision 20001 >=
if instance then
;
\ Create qec device node.
create-qec-properties
fload qec.fth \ qec driver.
\ Create qe0 device node.
new-device
0 create-qe-properties
" network" device-type
fload qeinstance.fth \ qe instance variables.
: dma-sync ( virt-addr dev-addr size -- ) " dma-sync" $call-parent ;
fload qe.fth \ qe driver.
fload qe-package.fth \ qe external methods.
finish-device
\ Create qe1 device node.
new-device
1 create-qe-properties
" network" device-type
fload qeinstance.fth \ qe instance variables.
fload qe-package.fth \ qe external methods.
finish-device
\ Create qe2 device node.
new-device
2 create-qe-properties
" network" device-type
fload qeinstance.fth \ qe instance variables.
fload qe-package.fth \ qe external methods.
finish-device
\ Create qe3 device node.
new-device
3 create-qe-properties
" network" device-type
fload qeinstance.fth \ qe instance variables.
fload qe-package.fth \ qe external methods.
finish-device
end0
\ -----------------------------------------------------------------
\ qec.fth
/locmem #channels / value chmem
chmem 2/ value rxbufsize
fload qed-util.fth \ Not included, refer to example 2.
fload global.h.fth \ Not included.
fload qecmap.fth \ Not included, refer to example 2.
fload qectest.fth \ Not included, refer to example 2.
: reset-qec-global ( -- fail? )
gcr-reset qecg-control! \ Issue global reset.
d# 100 set-ms-timeout
begin
qecg-control@ gcr-reset and
while
ms-timeout? if ." Global reset failed" cr true exit then
repeat
false
;
: qec-init ( -- )
chmem qecg-memsize!
rxbufsize qecg-rxsize!
chmem rxbufsize - qecg-txsize!
gcr-burst16 qecg-control! \ SBus parity disabled, Rx/Tx equal priority.
;
: identify-chip ( -- okay? ) qecg-control@ gcr-mode and gcr-mace = ;
external
: open ( -- true )
map-qec-regs
identify-chip dup if
qec-init
else unmap-qec-regs
then
;
: close ( -- ) qecg if unmap-qec-regs then ;
: selftest ( -- fail? )
qecg ( qecg )
map-qec-regs
qec-reg-test ( qecg success? )
unmap-qec-regs
swap to qecg ( success? )
0= ( fail? )
;
: reset ( -- )
qecg
map-qec-regs
reset-qec-global drop
unmap-qec-regs
to qecg
;
headers
\ -----------------------------------------------------------------
\ qeinstance.fth
\ Define instance words for qe driver.
\ headerless
\ mace.h.fth:
0 instance value mace \ virtual address of Mace registers base
\ channel.h.fth:
0 instance value qecc \ virtual address of Qec channel registers base
\ qemap.fth:
instance variable my-channel# \ qe channel#
my-channel# off
\ qecore.fth:
\ CPU base address of tmd, rmd, tbuf, rbuf rings.
0 instance value cpu-dma-base \ base address of dma memory object viewed by cpu
0 instance value tmd0 \ transmit message descriptor#0
0 instance value rmd0 \ receive message descriptor#0
0 instance value tbuf0 \ base address of transmit buffer
0 instance value rbuf0 \ base address of receive buffers
\ IO (or dvice) base address of tmd, rmd, tbuf, rbuf rings.
0 instance value io-dma-base \ base addr of dma memory object viewed by device
0 instance value io-tmd0 \ transmit message descriptor#0
0 instance value io-rmd0 \ receive message descriptor#0
0 instance value io-tbuf0 \ base address of transmit buffer
0 instance value io-rbuf0 \ base address of receive buffers
\ Required total Dma buffer size for all rings.
0 instance value qe-dma-size \ Amount of memory mapped
\ *** Define required variables ***
instance variable status \ Accumulated channel status word.
instance variable restart? \ Restart? flag on after serious error.
instance variable nextrmd \ Point to next rmd.
instance variable nexttmd \ tmd0 nexttmd !, never changes presently
instance variable mode \ To store loopback control & promiscuous info.
6 instance buffer: this-en-addr \ Contain ethernet address
instance defer .receive-error
instance defer .error
instance defer .transmit-error
\ timed-receive.fth:
instance variable alarmtime
instance defer handle-broadcast-packet
\ qetest.fth:
instance variable qe-verbose? \ Flag for displaying diagnostic message.
qe-verbose? off
instance variable ext-lbt? \ Flag for execution of external loopback test.
ext-lbt? off
\ qe0-package.fth:
6 instance buffer: macbuf \ Contain mac address.
0 instance value obp-tftp \ Contain ihandle of TFTP package.
instance variable qe-nbytes \ Buffer size of higher layer receiver.
instance variable qe-buf \ Buffer address of higher layer receiver.
headers
\ -----------------------------------------------------------------
\ qe.fth
: wlk-test ( mask addr #bits -- success? ) " wlk-test" $call-parent ;
: set-ms-timeout ( #ms -- ) " set-ms-timeout" $call-parent ;
: ms-timeout? ( -- flag ) " ms-timeout?" $call-parent ;
fload mace.h.fth \ Not included.
fload channel.h.fth \ Not included.
fload qemap.fth \ Not included, refer to example 2.
fload qecore.fth
fload timed-receive.fth
fload qeregtest.fth \ Not included, refer to example 2.
fload qetest.fth
fload qe0-package.fth
\ -----------------------------------------------------------------
\ qe0-package.fth
\ Define the required methods for the network qe driver
set-my-channel#
external
: read ( buf len -- -2 | actual-len )
qe0-read
;
: write ( buf len -- actual-len )
qe0-write
;
: selftest ( -- flag ) \ Flag 0 if passes test.
qe0-selftest
;
: watch-net ( -- )
qe0-watch-net
;
: load ( addr -- len )
qe0-load
;
: open ( -- okay? )
qe0-open
;
: close ( -- )
qe0-close
;
: reset ( -- )
qe0-reset
;
headers
\ -----------------------------------------------------------------
\ qecore.fth
\ Main core of QEC/MACE per channel Tx/Rx drivers.
\
\ SQEC has the following features:
\ - Supports four independent IEEE 802.3 10BASE-T twisted pair interfaces.
\ - Supports SBus parity checking.
\ - Supports 32 bit of DVMA addressing.
\ - Automatic rejection/discard of receive/transmit packets
\ when receive/transmit suffers from errors.
\
headerless
\ *** Rx/Tx Ring Descriptor Layout ***
struct ( Rx/Tx Descriptor )
4 field >flags \ OWN, SOP, EOP, size/length
4 field >addr \ buffer address
( total-length ) constant /md
hex
\ Definition for >flag field.
\ Bit[10:0] - Rx for W is buffer size, Rx for R is byte count, Tx for W is byte count.
8000.0000 constant own \ For both Rx & Tx.
4000.0000 constant stp \ For Tx only.
2000.0000 constant enp \ For Tx only.
07ff constant lenmask
\ Value to write to message descriptor to enable it for use
enp stp or own or constant ready
\ *** buffer sizes and counts ***
\ Xmit/receive buffer structure.
\ This structure is organized to meet the following requirements:
\ - starts on an QEBURSTSIZE (64) boundary.
\ - qebuf is an even multiple of QEBURSTSIZE.
\ - qebuf is large enough to contain max frame (1518) plus
\ QEBURSTSIZE for alignment adjustments.
\
\ Similar to the 7990 ethernet controller, the QEC and the Software driver
\ communicate via ring descriptors. There are separate Rx & Tx descriptor
\ rings of 256 entries. Unlike 7990 the number of descriptor entries
\ is not programmable (fixed at 256 entries).
decimal
/md constant /rmd \ rmd size = 8
/md constant /tmd \ tmd size = 8
1792 constant /rbuf \ 7*256 receive buffer size at least 1518+128=1636
1600 constant /tbuf \ transmit buffer size
256 constant #rmds
256 constant #tmds
\ 1 constant #tbufs \ Just allocate one buffer for transmiter buffer pool.
32 constant #rbufs \ # buffers allocated for receiver buffer pool.
#rmds /rmd * value /rmds
#tmds /tmd * value /tmds
headers
: restart?-on ( -- ) restart? on ;
\ Conversion between cpu dma address and io dma address.
: cpu>io-addr ( cpu-addr -- io-addr ) cpu-dma-base - io-dma-base + ;
: io>cpu-addr ( io-addr -- cpu-addr ) io-dma-base - cpu-dma-base + ;
\ buffer# to address calculations
: rmd#>rmdaddr ( n -- addr ) /rmd * rmd0 + ;
: rbuf#>rbufaddr ( n -- addr ) #rbufs mod /rbuf * io-rbuf0 + ;
: tmd#>tmdaddr ( n -- addr ) /tmd * tmd0 + ;
\ address to buffer# calculations
: rmdaddr>rmd# ( addr -- n ) rmd0 - /rmd / ;
\ *** Qe message descriptor ring access ***
\ Get current rx/tx message descriptor ring pointer (on CPU side).
: nextrmd@ ( -- cpu-rmd-addr ) nextrmd @ ;
: nexttmd@ ( -- cpu-tmd-addr ) nexttmd @ ;
\ get location of buffer
: addr@ ( rmd/tmd-addr -- buff-addr ) >addr rl@ ;
: status@ ( rmd/tmd-addr -- statusflag ) >flags rl@ ;
\ gets length of incoming message, receive only
: length@ ( rmdaddr -- messagelength ) >flags rl@ lenmask and ;
\ Set current rx/tx message descriptor ring pointer (on CPU side).
: nextrmd! ( cpu-rmd-addr -- ) nextrmd ! ;
: nexttmd! ( cpu-tmd-addr -- ) nexttmd ! ;
\ Store buffer address into message descriptor
: addr! ( buff-addr rmd/tmd-addr -- ) >addr rl! ;
\ Set length of message to be sent - transmit only
: length! ( length rmd/tmd-addr -- ) >flags rl! ;
\ *** Qe synchronization ***
\ Sync the message descriptor after cpu or device writes it.
: qesynciopb ( md -- )
dup cpu>io-addr /md ( cpu-addr io-addr size )
dma-sync
;
\ Sync the transmitting/received buffer after cpu/device writes it.
: qesyncbuf ( md -- )
dup addr@ dup io>cpu-addr swap ( md cpu-buf-addr io-buf-addr )
rot length@ ( cpu-buf-addr io-buf-addr size )
dma-sync
;
\ The buffer was already put back, put the descriptor in the chip's ready list
: give-buffer ( rmd/tmd-addr -- )
dup >flags dup rl@ ready or swap rl! ( md )
\ Sync the descriptor so the device sees it.
qesynciopb ( )
;
\ *** Qe error handling ***
: get-qe-status ( -- channel-status )
qecc-status@ status @ or dup status !
;
\ get receive errors, receive only
: rerrors@ ( -- errorsflag ) get-qe-status c-rerr-mask and ;
\ gets transmit errors, transmit only
: xerrors@ ( -- errorsflag ) get-qe-status c-terr-mask and ;
\ Clear transmit/receive/all error flags
: clear-terrors ( -- ) status @ c-terr-mask not and status ! ;
: clear-rerrors ( -- ) status @ c-rerr-mask not and status ! ;
: clear-errors ( -- ) status off restart? off ;
: clear-tint ( -- ) status @ c-tint not and status ! ;
\ *** Basic initialization routines ***
\ words to set loopback control mode in UTR(R29) & promiscuous mode in MACCC(R13)
\ Bit<7> to control promiscuous mode, Bits<2:1> to control loopback mode,
\ Bit<0> to test the cable connection.
1 constant m-cable
: set-loop-mode ( -- ) mode @ m-loop-mask and m-rpa or mace-utr! ;
: set-prom-mode ( -- ) mode @ m-prom and mace-maccc! ;
: check-cable-mode? ( -- flag ) mode @ m-cable = ;
: external-loopback? ( -- flag ) mode @ m-loop-mask and m-loop-ext = ;
\ Check existence of no-tpe-test property to initialize disable-tpe-link-test bit.
\ Enable tpe-link-test if the property doesn't exist,
\ or disable tpe-link-test if the property exists.
: init-link-test ( -- )
\ Disable link test for external loopback mode.
external-loopback? if m-dlnktst mace-phycc! exit then
" no-tpe-test" get-my-property if 0
else 2drop m-dlnktst then
mace-phycc!
;
\ Enable/disable tpe-link-test
: setup-link-test ( enable-flag -- )
" no-tpe-test" " get-property" eval if
\ Property doesn't exist, already enabled.
0= if 0 0 " no-tpe-test" property then
else 2drop \ Currently disabled.
if " no-tpe-test" delete-property then
then
;
\
\ After doing a port select of the twisted pair port, the
\ driver needs to give ample time for the MACE to start
\ sending pulses to the hub to mark the link state up.
\ Loop here and check of the link state has gone into a
\ pass state.
\
: link-state-fail? ( -- fail? )
d# 1000 set-ms-timeout
begin
mace-phycc@ m-lnkst and
while
ms-timeout? if
check-cable-mode? if
." failed, transceiver cable problem? or check the hub." cr
true
else
\ m-dlnktst mace-phycc!
false
then
exit
then
repeat
check-cable-mode? if ." passed." cr then
false
;
: set-physical-address ( -- )
m-addrchg mace-iac!
begin mace-iac@ m-addrchg and 0= until
m-phyaddr mace-iac!
\ Store least significant byte first.
this-en-addr 6 bounds do i c@ mace-paddr! loop
0 mace-iac!
;
: set-address ( en-addr len -- )
drop this-en-addr 6 move ;
: set-logaddr-filter ( -- )
m-addrchg mace-iac!
begin mace-iac@ m-addrchg and 0= until
m-logaddr mace-iac!
8 0 do 0 mace-laddrf! loop
0 mace-iac!
;
\ Reset (or stop) the qec channel.
\ Issue a soft reset to the desired Mace.
\ Then issue a soft reset to the desired channel in QEC.
\ Chip reset algorithm:
\ Set the reset bit then wait until the reset bit cleared.
\ Timeout in 0.1 sec if fail.
\
: channel-reset ( -- fail? )
m-swrst mace-biucc! \ Issue Mace reset.
d# 100 set-ms-timeout
begin
mace-biucc@ m-swrst and
while
ms-timeout? if ." Cannot reset Mace" cr true exit then
repeat
c-rst qecc-control! \ Reset QEC channel registers.
d# 100 set-ms-timeout
begin
qecc-control@ c-rst and
while
ms-timeout? if ." Cannot reset QEC channel" cr true exit then
repeat
false
;
\ Initialize a single message descriptor
: rmd-init ( rbufaddr rmdaddr -- )
/rbuf over length! \ Buffer length
addr! \ Buffer address
;
\ Set up the data structures necessary to receive a packet
: init-rxring ( -- )
rmd0 nextrmd!
#rmds 0 do i rbuf#>rbufaddr i rmd#>rmdaddr rmd-init loop
;
\
\ Initially first N=#rbufs descriptors with one-to-one association with a
\ buffer are made ready, the rest (256-N) not ready, then turn on receiver.
\ Whenver a receive buffer is processed, the information is copied out,
\ the buffer will be linked to the ((current+N)%256) entry then make the
\ entry is ready. Ie. The window of N ready descriptor/buffer pair is
\ moving around the ring.
\
: enable-rxring ( -- )
#rbufs 0 do i rmd#>rmdaddr give-buffer loop
;
\ transmit buffer initialize routine
: init-txring ( -- )
tmd0 nexttmd!
#tmds 0 do io-tbuf0 i tmd#>tmdaddr addr! loop
;
\ *** Receive packet routines ***
\ Utility words used in .rerr-text & .terr-text.
: bits ( mask #right-bits -- mask' right-bits )
>r dup /n 8 * r@ - tuck << swap >> ( mask bits ; RS: #bits )
swap r> >> swap ( mask' bits )
;
: 1bit ( mask -- mask' rightest-bit-value ) 1 bits ;
: .rerr-text ( -- )
rerrors@
1bit if ." SBus Rx Error Ack " restart?-on then
1bit if ." SBus Rx Parity " restart?-on then
1bit if ." SBus Rx Late " restart?-on then
1bit if ." Data Buffer Too Small " then
\ 1bit if ." Rx packet Dropped " then
1bit drop \ Skip drop error, happens all the time
1bit drop \ Skip receive interrupt bit.
1bit if ." CRC error " then
1bit if ." Framing error " then
1bit if ." MACE Rx Late Collision " then
1bit if ." MACE FIFO overflow " then
1bit if ." MACE Missed Counter Overflow " then
1bit if ." MACE Runt Counter Overflow " then
1bit if ." MACE Rx Coll Counter Overflow " then
1bit if ." Collision error " then
drop cr
;
: (.receive-error ( -- )
rerrors@ if .rerr-text then
;
' (.receive-error to .receive-error
' (.receive-error to .error
: to-next-rmd ( -- )
/rmd nextrmd +!
nextrmd@ rmd0 - /rmds >= if rmd0 nextrmd! then
;
\ *** Transmit packet routines ***
: to-next-tmd ( -- )
/tmd nexttmd +!
nexttmd@ tmd0 - /tmds >= if tmd0 nexttmd! then
;
\ Ignores the size argument, and uses the standard buffer.
: get-buffer ( dummysize -- buffer )
drop nexttmd@ addr@ ( io-tbuf )
io>cpu-addr ( cpu-tbuf )
;
\ Display time domain reflectometry information
\ : .tdr ( -- ) ;
: .terr-text ( -- )
xerrors@
d# 16 bits drop \ Skip the receiver bits.
1bit if ." SBus Tx Error Ack " restart?-on then
1bit if ." SBus Tx Parity " restart?-on then
1bit if ." SBus Tx Late " restart?-on then
1bit if ." QEC Chained Tx Descriptor Error " restart?-on then
1bit if ." QEC Tx Retry Counter Overflow " then
1bit drop \ Skip transmit interrupt bit
1bit if ." MACE >1518 Babble " then
1bit if ." MACE Jabber " then
1bit if ." MACE FIFO Underflow " then
1bit if ." Tx Late Collision " then
1bit if ." Too Many Retries " then
1bit if ." Lost Carrier (transceiver cable problem?) " then
1bit if ." Excessive Defer " then
drop cr
;
\ print summary of any HARD errors
: (.transmit-error ( -- )
xerrors@ if .terr-text then
;
' (.transmit-error to .transmit-error
\ Set up CPU page maps
: map-qe-buffers ( -- )
#rbufs /rbuf *
\ 2KB (8*256) for tmds & 2KB (8*256) for rmds & 4KB for tbuf
\ ie. one page for tmds & rmds, one page for tbuf, the rest for rbufs.
h# 2000 +
to qe-dma-size
\ Allocate and map that space
qe-dma-size dma-alloc ( dma-addr )
\ Set the addresses of the various DMA regions used by the cpu.
dup to cpu-dma-base
dup to tmd0 h# 800 + ( next-address )
dup to rmd0 h# 800 + ( next-address ) \ Enough for 256 entries
dup to tbuf0 h# 1000 + ( next-address ) \ Enough for max packet
to rbuf0 ( )
tmd0 qe-dma-size false dma-map-in ( io-dma-addr )
\ Set the addresses of the various DMA regions used by the qec chip.
dup to io-dma-base
dup to io-tmd0 h# 800 + ( next-address )
dup to io-rmd0 h# 800 + ( next-address ) \ Enough for 256 entries
dup to io-tbuf0 h# 1000 + ( next-address ) \ Enough for max packet
to io-rbuf0 ( )
;
: unmap-qe-buffers ( -- )
tmd0 io-tmd0 qe-dma-size dma-map-out
tmd0 qe-dma-size dma-free
0 to tmd0
;
\ *** Chips initialization routines ***
\ Initializes the QEC/Mace chips.
: channel-init ( -- fail? )
\ *** Initialize QEC per channel registers.
io-rmd0 qecc-rxring!
io-tmd0 qecc-txring!
c-rintmask qecc-rintmask! \ Mask RINT.
c-tintmask qecc-tintmask! \ Mask XINT.
my-chan# chmem * dup qecc-lmrxwrite! dup qecc-lmrxread!
rxbufsize + dup qecc-lmtxwrite! qecc-lmtxread!
c-qecerrmask qecc-qecerrmask!
c-macerrmask qecc-macerrmask!
\ *** Initialize MACE registers.
\ 0 mace-xmtfc!
m-apadxmt mace-xmtfc! \ Set auto pad transmit for transmit frame control
0 mace-rcvfc! \ Init. receive frame control.
\ Init. Interrupt Mask Register to mask rcvint & cerr and unmask xmtint
\ according QEC spec.
m-cerrm m-rcvintm or mace-imr!
\ Init. Bus Interface Unit Configuration Control to transmit after 64 bytes
\ have been loaded & byte swap.
m-xmtsp64 m-xmtspshift << m-bswp or mace-biucc!
\ Init. FIFO Conf Control to set transmit/receive fifo watermark update
m-xmtfw16 m-rcvfw32 or m-xmtfwu or m-rcvfwu or mace-fifocc!
m-10base-t mace-plscc! \ Select twisted pair mode.
init-link-test \ Init. tpe link test mode.
set-physical-address \ Set mac address.
set-logaddr-filter \ Set logical address filter.
0 mace-iac!
link-state-fail? \ Wait and check the link state marked up.
mace-mpc@ drop \ Read to reset counter and to prevent an invalid int.
set-loop-mode \ Set UTR
set-prom-mode \ Set MACCC
m-apadxmt not mace-xmtfc@ and mace-xmtfc!
m-astrprcv not mace-rcvfc@ and mace-rcvfc!
;
\ Turn on the Mace, ready to tx/rx packets.
: enable-mace ( -- )
m-enxmt m-enrcv or mace-maccc@ or mace-maccc!
;
\ *** Ethernet on/off routines ***
\ Initializes the QEC/Mace chips, allocating the necessary memory,
\ and enabling the transmitter and receiver.
: net-on ( -- flag ) \ true if net-on succeeds
clear-errors
mac-address set-address
channel-reset 0= if
init-txring
init-rxring
channel-init 0= dup if
enable-rxring
enable-mace
then
else false
then
;
\ Stop the activity of this net channel.
: net-off ( -- ) channel-reset drop init-link-test ;
\ *** Main receive routines ***
\
\ Whenver a receive buffer is processed, the information is copied out,
\ the buffer will be linked to the ((current+N)%256)th entry then make the
\ entry is ready ie.the window of N ready descriptor/buffer pair is
\ moving around the ring.
\
\ If 256 (#rmds) is multiples of N (#rbufs=32), we don't need to link the
\ next-ready-rmd with the current processed rx buffer dynamically. They can
\ be set at the initialization time statically. For run time, we just need
\ to make the ((current+N)%256)th rmd ready.
\
: return-buffer ( buf-handle -- )
rmdaddr>rmd# ( [io-rbuf] rmd# )
#rbufs + #rmds mod ( [io-rbuf] next-ready-rmd# )
rmd#>rmdaddr ( [io-rbuf] next-ready-rmd )
dup addr@ over rmd-init ( next-ready-rmd ; Set length )
give-buffer ( ; Make it ready )
to-next-rmd \ Bump SW nextrmd to next one
;
: receive-ready? ( -- packet-waiting? )
restart? @ if net-on drop then
nextrmd@ ( rmd )
\ Sync RMD before CPU looking at it.
dup qesynciopb ( rmd )
status@ own and 0= ( flag )
;
: receive ( -- buf-handle buffer len ) \ len non-zero if packet ok
nextrmd@ dup addr@ ( rmd io-rbuf-addr )
io>cpu-addr ( rmd cpu-rbuf-addr )
over length@ ( rmd cpu-rbuf-addr len )
rerrors@ if
.receive-error clear-rerrors
then
dup if ( rmd cpu-rbuf-addr len )
\ Sync the received buffer before CPU looking at it.
nextrmd@ qesyncbuf ( rmd cpu-rbuf-addr len )
then
;
\ *** Main transmit routines ***
: set-timeout ( interval -- ) get-msecs + alarmtime ! ;
: timeout? ( -- flag ) get-msecs alarmtime @ >= ;
: 10us-wait ( -- ) d# 10 begin 1- dup 0= until drop ;
\ Wait until transmission completed
: send-wait ( -- )
\ Wait the packet to get to the local memory, ready for MACE to xmit.
d# 2000 set-timeout \ 2 second timeout.
begin
get-qe-status
c-tint and \ Transmit interrupt bit set?
timeout? or \ Or timeout?
until
timeout? if
." TINT was not set!" cr true exit
then
\ Transmit completion, sync TMD before looking at it.
nexttmd@ dup qesynciopb ( tmd )
status@ own and if ( flag )
." Tx descriptor still owned by QEC!" cr
then
\ Wait the packet to get to net, make sure at most one xmit packet in MACE FIFO.
d# 1000 set-timeout \ 1 second timeout.
begin
10us-wait
qecc-lmtxwrite@ qecc-lmtxread@ =
timeout? or
until
timeout? if
." Tx packet not out to net!" cr
then
false
;
\ This send routine does not enforce the minimum packet length. It is
\ used by the loopback test routines.
: short-send ( buffer length -- error? )
clear-tint \ Erase tint status bit.
\ discard buffer address, assumes using nexttmd
nip nexttmd@ ( length tmd )
tuck length! ( tmd ; Set length )
\ Sync the transmit buffer so the device sees it.
dup qesyncbuf ( tmd )
give-buffer ( ; Give tmd to chip )
c-tdmd qecc-control! \ Bang the chip, let chip look at it right away
send-wait ( fail? ) \ wait for completion
xerrors@ dup if ( fail? error? )
.transmit-error clear-terrors
then or ( error? )
to-next-tmd ( error? )
restart? @ if net-on drop then ( error? )
c-hard-terr-mask and ( hard-error? )
;
\ Transmit packet routine, no S/W retry on this layer.
: net-send ( buffer length -- error? ) \ error? is contents of chan-status
d# 64 max \ force minimum length to be 64
short-send ( error? )
;
\ -----------------------------------------------------------------
\ timed-receive.fth
\ Implements a network receive that will timeout after a certain interval.
decimal
: multicast? ( handle data-address length -- handle data-address length flag )
\ Check for multicast/broadcast packets
over ( ... data-address )
c@ h# 80 and dup if \ Look at the multicast bit
( handle data-address length multicast? )
handle-broadcast-packet
then
;
: receive-good-packet ( -- [ buffer-handle data-address length ] | 0 )
begin
begin
timeout? if false exit then
receive-ready?
until
receive dup 0=
while
.error 2drop return-buffer
repeat
;
: receive-unicast-packet ( -- [ buffer-handle data-address length ] | 0 )
begin
receive-good-packet dup 0= if exit then
multicast?
while
2drop return-buffer
repeat
;
\ Receive a packet, filtering out broadcast packets and timing
\ out if no packet comes in within a certain time.
: timed-receive ( timeout-msecs -- [ buffer-handle data-address length ] err?)
set-timeout receive-unicast-packet ?dup 0=
;
\ -----------------------------------------------------------------
\ qetest.fth
\ Define Qec/Mace loopback-test, net-init & watch-test routines.
\ This file contains Qec/Mace selftest routines.
\ It defines the following external words:
\ loopback-test ( internal/external-flag -- success? )
\ net-init ( -- success? )
\ watch-test ( -- )
\ Also it defines the following external variable.
\ qe-verbose? - Flag to indicate if want the test messages displayed.
\ ext-lbt? - Flag to indicate if run the external loopback test.
\
\ The algorithm for the loopback test:
\ Set internal or external loopback with no promiscuous mode.
\ Turn on the Qec/Mace Ethernet port.
\ If it succeeds, send out a short packet containing walking 0/1 patterns.
\ If it succeeds, wait for a period, check if receive the loopback packet.
\ If so, verify the length of the received packet is right.
\ Also check if the data of the received packet is right.
\ Return true if everything is fine, otherwise return false.
hex
headerless
create loopback-prototype
ff c, 00 c, \ Ones and zeroes
01 c, 02 c, 04 c, 08 c, 10 c, 20 c, 40 c, 80 c, \ Walking ones
fe c, fd c, fb c, f7 c, ef c, 0df c, 0bf c, 7f c, \ Walking zeroes
55 c, aa c,
: loopback-buffer ( -- addr len )
d# 32 get-buffer ( addr )
mac-address drop over 6 move \ Set source address
mac-address drop over 6 + 6 move \ Set destination address
loopback-prototype over d# 12 + d# 20 move \ Set buffer contents
d# 32
;
: pdump ( addr -- )
base @ >r hex
dup d# 10 bounds do i c@ 3 u.r loop cr
d# 10 + d# 10 bounds do i c@ 3 u.r loop cr
r> base !
;
\ Print loopback control type for verbose mode.
: .loopback ( -- )
mode @ m-loop-mask and
?dup if
dup m-loop-ext = if ." External " drop
else ." Internal " m-loop-intmen = if ." (including Mendec) " then
then
." loopback test -- "
then
;
\ Print loopback control type for non-verbose mode,
\ it is used after any error occurs.
: ?.loopback ( -- )
qe-verbose? @ 0= if .loopback then
;
: switch-off ( -- false ) qe-verbose? off false ;
: bad-rx-data ( buf-handle data-address -- false )
?.loopback
." Received packet contained incorrect data. Expected: " cr
loopback-prototype pdump
." Observed:" cr
d# 12 + pdump
switch-off
;
\ Check the data of the received packet, return true if data is ok.
: check-data ( buf-handle data-address length -- ok? )
drop ( buf-handle data-address )
dup d# 12 + loopback-prototype d# 20 comp
if bad-rx-data
else drop ( buf-handle )
return-buffer
qe-verbose? @ if ." succeeded." cr then
mode off true
then
;
\ Check the length & data of the received packet, return true if data & len ok.
: check-len&data ( buf-handle data-address length -- ok? )
\ The CRC is appended to the packet, thus it is 4 bytes longer than
\ the packet we sent.
dup d# 36 <>
if ?.loopback
." Wrong packet length; expected 36, observed " .d cr
switch-off
else check-data
then
;
headers
\ Run internal or external loopback test, return true if the test passes.
: loopback-test ( internal/external -- pass? )
mode !
qe-verbose? @ if ." " .loopback then
net-on if
loopback-buffer short-send if
?.loopback ." send failed." cr
switch-off
else
d# 2000 timed-receive if
?.loopback
." Did not receive expected loopback packet." cr
switch-off
else ( buf-handle data-address length )
check-len&data
then
then
else
switch-off
then
net-off mode off
;
\ If there is a normal external loopback test, then we don't need this.
\ MACE external loopback test requires a special cable. Don't run external
\ loopback test for selftest & watch-net.
: check-cable? ( -- ok? )
m-cable mode ! ." Link state check -- "
net-on ( success? )
net-off mode off
;
\ Turn on the Ethernet port after pass loopback test.
\ Return true if net-init succeeds, otherwise return false if it fails.
: net-init ( -- flag )
mode @ \ Save requested mode because loopback changes it.
m-loop-int loopback-test
if ( mode-saved ; Pass internal loopback test. )
ext-lbt? @ \ Run external loopback test if the ext-lbt? flag is set.
\ qe internal loopback with mendec is equivalent to external loopback of le.
if m-loop-intmen loopback-test else true then ( mode-saved )
swap mode ! \ Restore the mode.
if net-on \ Pass loopback test, turn on the ethernet port.
else false
then
else mode ! false
then
;
headerless
: wait-for-packet ( -- )
begin key? receive-ready? or until
;
headers
\ Check for incoming Ethernet packets.
\ Use promiscuous mode to check for all incoming packets.
: watch-test ( -- )
." Looking for Ethernet packets." cr
." `.' is a good packet. `X' is a bad packet." cr
." Type any key to stop." cr
begin
wait-for-packet
receive-ready?
if receive
if ." ." else ." X" then
drop return-buffer
then
key? dup if key drop then
until
;
\ -----------------------------------------------------------------
\ qe0-package.fth
\ Implements the architectural interface for the qe driver
headerless
\
\ The network driver uses the standard "obp-tftp" support package for
\ implementation. The "obp-ftfp" package implements the Internet Trivial File
\ Transfer Protocol (TFTP) for use in network booting. The "obp-tftp" package
\ defines the following methods to be used by the network driver:
\ open ( -- okay? )
\ close ( -- )
\ load ( addr -- size )
\ The "obp-tftp" package uses the read and write methods of the network driver
\ for receiving and transmitting packets. The package assums the size of the
\ maximum transfer packet is 1518 bytes. If the network driver needs bigger
\ maximum packet size, then it requires the method "max-transfer" defined,
\ the method will be called by the obp-tftp package to define the maximum
\ transfer packet size.
\
: init-obp-tftp ( -- okay? )
" obp-tftp" find-package if ( phandle )
my-args rot open-package ( ihandle )
else 0
then
dup to obp-tftp ( ihandle | 0 )
dup 0= if
." Can't open OBP standard TFTP package" cr
then
;
: set-my-channel# ( -- )
\ If don't find the channel property, use 0.
" channel#" get-my-property if 0 else decode-int nip nip then
my-channel#!
;
headers
: qe-xmit ( bufaddr nbytes -- #sent )
tuck get-buffer ( nbytes bufaddr ether-buffer )
tuck 3 pick move ( nbytes ether-buffer )
over net-send if drop 0 then ( #sent )
;
: qe-poll ( bufaddr nbytes -- #received )
qe-nbytes ! qe-buf ! ( )
receive-ready? 0= if 0 exit then \ Bail out if no packet ready
receive ?dup if ( rmd ether-buffer length )
dup >r ( rmd ether-buffer length )
qe-nbytes @ min ( rmd ether-buffer length' )
qe-buf @ swap move ( rmd )
return-buffer r> ( #received )
else
drop return-buffer 0 ( 0 )
then
;
: set-vectors ( -- )
['] (.receive-error to .error
['] (.transmit-error to .transmit-error
['] noop to handle-broadcast-packet
;
: map-qe ( -- )
mace 0= if \ Do mapping if it is unmapped.
map-chips
map-qe-buffers
then
;
: unmap-qe ( -- )
mace if \ Do unmapping if it is mapped.
unmap-qe-buffers
unmap-chips
then
;
: qe-loopback-test ( -- flag ) \ flag true if passes test
set-vectors
mode off qe-verbose? on
ext-lbt? on
net-init
ext-lbt? off
dup if net-off drop check-cable? then
qe-verbose? off
;
: (watch-net) ( -- )
map-qe
set-vectors
m-prom mode !
qe-verbose? off
ext-lbt? off
net-init if watch-test net-off then
unmap-qe
;
external
: qe0-read ( buf len -- -2 | actual-len )
qe-poll ?dup 0= if -2 then
;
: qe0-write ( buf len -- actual-len ) qe-xmit ;
: qe0-selftest ( -- flag ) \ Flag 0 if passes test.
map-qe
qe-reg-test ( success? )
if
qe-loopback-test 0= \ Alternate the return flag.
else
true
then ( failure? )
unmap-qe
;
: qe0-watch-net ( -- )
qe0-selftest 0= if (watch-net) then
;
: qe0-load ( addr -- len ) " load" obp-tftp $call-method ;
: qe0-open ( -- okay? )
map-qe
set-vectors
mode off qe-verbose? off
net-init 0= if unmap-qe false exit then
mac-address drop macbuf 6 move \ Update macbuf.
macbuf 6 encode-string " mac-address" property
init-obp-tftp 0= if close false exit then
true
;
: qe0-close ( -- )
obp-tftp ?dup if close-package then
mace if net-off then
unmap-qe
;
: qe0-reset ( -- )
mace if net-off
else map-chips net-off unmap-chips then
;
headers
|
