This chapter describes how to implement network device drivers.
Network devices are packet-oriented devices capable of sending and receiving packets addressed according to IEEE 802.2 (Ethernet). OpenBoot firmware typically uses network devices for diskless booting. The standard /obp-tftp support package assists in the implementation of the load method for this device type.
Normally the network device driver would have a one level tree or a two level tree. The user can create a multi-level tree by applying new-device and finish-device.
A one level tree could have several nodes, depending on how many net channels the plug-in card can support, each node corresponds to one net channel.
This chapter shows three sample network device drivers for the Quad Ethernet device card. The device tree structure for the examples is as follows:
Each QED SBus card defines two levels:
Figure 9-1 QED Device Tree
The general pathname (after sbus or sbi) for a qe node is
--------------------
qec@S,20000/qe@C,0 --------------------
where S is the SBus slot number and C is the network channel number.
The network device FCode must declare the network device-type, and must implement the methods open and close, as well as the following methods:
Table 9-1 Required Network Device Properties
------------------------------------------------------------------
Name Typical Value ------------------------------------------------------------------
name " SUNW,my-net"
reg list of registers {device-dependent}
device_type " network"
mac-address 8 0 0x20 0x0c 0xea 0x41 {the MAC address currently
being used.}
------------------------------------------------------------------
Table 9-2 Optional Network Device Properties
--------------------------------------------------------------------------------
Property Name Typical Property Value --------------------------------------------------------------------------------
max-frame-size 0x4000
address-bits 48
slave-burst-sizes 0x7f {depends on the number of entries in the reg property}
local-mac-address 8 0 0x20 0x0c 0xea 0x41 {the built-in Media Access
Control address.}
--------------------------------------------------------------------------------
At minimum, a network device driver need only provide the desired tree structure and to publish all the necessary properties to identify the devices.
Code Example 7 QED Identification ROM Sample
--------------------------------------------------------------------------------------------------
\ QED identification ROM
\ qed-idrom.fth
fcode-version 1
fload board.fth
headers
: copyright ( -- )
." Two-level QED-IDROM 1.1 " cr
." Copyright 1992 - 1995 Sun Microsystems, Inc.. All Rights Reserved" cr
;
: identify-qed ( -- )
create-qec-properties
4 0 do
new-device
i create-qe-properties
finish-device
loop
;
identify-qed
end0
\ -----------------------------------------------------------------
\ board.fth
\ To define required properties for QED devices.
headers
my-address constant my-sbus-addr
my-space constant my-sbus-space
headerless
\ Define the address map.
\ MED Address Map PA[18:0] (totally 512KB address space).
\ h# 00.0000 constant eprom-pa
\ h# 00.8000 constant /eprom \ 32KB used, 64KB total
h# 01.0000 constant mace-regs-offset
h# 01.0000 constant mace0-base
h# 01.4000 constant mace1-base
h# 01.8000 constant mace2-base
h# 01.c000 constant mace3-base
h# 00.4000 constant /mace-regs \ 16KB per channel, 64KB total
h# 02.0000 constant global-regs-offset
h# 01.0000 constant /global-regs \ 64KB total
h# 03.0000 constant channel-regs-offset
h# 03.0000 constant channel0-base
h# 03.4000 constant channel1-base
h# 03.8000 constant channel2-base
h# 03.c000 constant channel3-base
h# 00.4000 constant /channel-regs \ 16KB per channel, 64KB total
h# 04.0000 constant locmem-pa
h# 01.0000 constant /locmem \ 64KB used, 256KB total
\ Real size of mace/qec-global/qec-channel registers.
20 constant /qec-mace-regs
14 constant /qec-global-regs
34 constant /qec-channel-regs
\ Miscellaneous constant definitions.
1 constant #channels
h# 4000 constant max-frame-size ( d# 1536 for le )
d# 48 constant address-bits
\ Hardwired SBus interrupt level for MED.
4 constant sbus-qe-intr
: encode-reg ( addr space size -- addr len ) >r encode-phys r> encode-int encode+ ;
: encode-ranges ( offs bustype phys offset size -- addr len )
r r '>r encode-phys r r r> encode-reg encode+
;
: offsetphysical-addr ( offset -- paddr.lo paddr.hi )
my-sbus-addr + my-sbus-space
;
headers
: create-qec-properties ( -- )
" qec" name
" SUNW,595-3198" encode-string " model" property \ 595-3198-01
global-regs-offset offsetphysical-addr /global-regs encode-reg
locmem-pa offsetphysical-addr /locmem encode-reg encode+
" reg" property
0 0 channel0-base offsetphysical-addr /channel-regs encode-ranges
0 1 channel1-base offsetphysical-addr /channel-regs encode-ranges encode+
0 2 channel2-base offsetphysical-addr /channel-regs encode-ranges encode+
0 3 channel3-base offsetphysical-addr /channel-regs encode-ranges encode+
0 h# 10 mace0-base offsetphysical-addr /mace-regs encode-ranges encode+
0 h# 11 mace1-base offsetphysical-addr /mace-regs encode-ranges encode+
0 h# 12 mace2-base offsetphysical-addr /mace-regs encode-ranges encode+
0 h# 13 mace3-base offsetphysical-addr /mace-regs encode-ranges encode+
" ranges" property
#channels encode-int " #channels" property
\ One interrupt per qec, not one interrupt per channel.
sbus-qe-intr encode-int " interrupts" property
;
: create-qe-properties ( chan# -- )
r
" qe" encode-string " name" property
r@ encode-int " channel#" property
max-frame-size encode-int " max-frame-size" property
address-bits encode-int " address-bits" property
0 r@ /channel-regs encode-reg
0 r@ h# 10 + /mace-regs encode-reg encode+
" reg" property
r drop
;
--------------------------------------------------------------------------------------------------
This version of a network device driver is still non-bootable, but it shows how an intermediate step of driver can be used to debug and test the device during or after development.
The coding techniques shown in this and the following examples are:
Code Example 8 QED Test ROM Sample
-----------------------------------------------------------------------------------
\ QED test ROM.
\ qed-test.fth
fcode-version2
headers
fload board.fth
: copyright ( -- )
." QED-TEST 1.1 " cr
." Copyright 1992 - 1995 Sun Microsystems, Inc.. All Rights Reserved" cr
;
: instance ( -- ) fcode-revision 20001 = if instance then;
\ Create qec device node.
create-qec-properties
fload qec-test.fth \ qec test code.
\ Create qe0 device node.
new-device
0 create-qe-properties
: dma-sync ( virt-addr dev-addr size -- ) " dma-sync" $call-parent ;
\ ***** qe0 instance variables *****
0 instance value mace \ virtual address of Mace registers base
0 instance value qecc \ virtual address of Qec channel registers base
instance variable my-channel# \ qe channel#
my-channel# off
fload qe-test.fth \ qe test code.
\ ***** qe0 external methods *****
external
: selftest ( -- fail? )
qe0-selftest
;
: open ( -- okay? )
qe0-open
;
: close ( -- )
qe0-close
;
: reset ( -- )
qe0-reset
;
headers
finish-device
\ Create qe1 device node.
new-device
1 create-qe-properties
\ ***** qe1 instance variables *****
0 instance value mace \ virtual address of Mace registers base
0 instance value qecc \ virtual address of Qec channel registers base
instance variable my-channel# \ qe channel#
my-channel# off
\ ***** qe1 external methods *****
external
: selftest ( -- fail? )
qe0-selftest
;
: open ( -- okay? )
qe0-open
;
: close ( -- )
qe0-close
;
: reset ( -- )
qe0-reset
;
headers
finish-device
\ Create qe2 device node.
new-device
2 create-qe-properties
\ ***** qe2 instance variables *****
0 instance value mace \ virtual address of Mace registers base
0 instance value qecc \ virtual address of Qec channel registers base
instance variable my-channel# \ qe channel#
my-channel# off
\ ***** qe2 external methods *****
external
: selftest ( -- fail? )
qe0-selftest
;
: open ( -- okay? )
qe0-open
;
: close ( -- )
qe0-close
;
: reset ( -- )
qe0-reset
;
headers
finish-device
\ Create qe3 device node.
new-device
3 create-qe-properties
\ ***** qe3 instance variables *****
0 instance value mace \ virtual address of Mace registers base
0 instance value qecc \ virtual address of Qec channel registers base
instance variable my-channel# \ qe channel#
my-channel# off
\ ***** qe3 external methods *****
external
: selftest ( -- fail? )
qe0-selftest
;
: open ( -- okay? )
qe0-open
;
: close ( -- )
qe0-close
;
: reset ( -- )
qe0-reset
;
headers
finish-device
end0
\ ---------------------------------------------------------------------
\ qec-test.fth
\ Test code for the qec node.
/locmem #channels / value chmem
chmem 2/ value rxbufsize
\ ***** qed utility (from qed-util.fth) *****
: lwrt-rd-cmp ( mask data addr -- success? )
2dup rl! rl@ rot and =
;
: cwrt-rd-cmp ( mask data addr -- success? )
2dup rb! rb@ rot and =
;
instance defer wrt-rd-cmp
' lwrt-rd-cmp to wrt-rd-cmp
d# 32 instance value #bits
external
: wlk-test ( mask addr #bits -- success? )
dup to #bits
d# 32 = if ['] lwrt-rd-cmp else ['] cwrt-rd-cmp then to wrt-rd-cmp
true -rot ( true mask addr )
#bits 0
do ( flag0 mask addr )
over 1 i lshift and ?dup if ( flag0 mask addr data )
r 2dup r swap wrt-rd-cmp false = ( flag0 mask addr flag )
if rot drop false -rot leave then
then
loop
2drop
;
headers
instance variable ms-timeout
external
: set-ms-timeout ( #ms -- ) ms-timeout ! ;
: ms-timeout? ( -- flag )
ms-timeout @ dup if
1- ms-timeout ! 1 ms false
else
drop true
then
;
headers
\ ***** qec global register (from global.h.fth) *****
\
\ QEC Global register set.
\
\ Virtual addresses of QEC global registers.
\ The actual addresses will be assigned later.
0 instance value qecg
hex
\ global control register (RW)
: qecg-control ( -- vaddr ) qecg ;
: qecg-control@ ( -- data ) qecg-control rl@ ;
: qecg-control! ( data -- ) qecg-control rl! ;
headerless
\ For Global Control Register.
f000.0000 constant gcr-mode \ Mode mask
4000.0000 constant gcr-mace \ Mace mode
1 constant gcr-reset \ Reset bit (0), 1 to enable reset.
headers
\ ***** qec map (from qecmap.fth ) *****
0 instance value locmem-base
false value dma-sync?
0 value dma-sync-addr
: find-dma-sync ( -- )
" dma-sync" my-parent ihandlephandle find-method if
true to dma-sync?
to dma-sync-addr
then
;
find-dma-sync
external
: decode-unit ( addr len -- address space ) decode-2int ;
: map-in ( offset slot# #bytes -- virtual ) " map-in" $call-parent ;
: map-out ( addr len -- ) " map-out" $call-parent ;
: dma-map-in ( vaddr n cache? -- devaddr ) " dma-map-in" $call-parent ;
: dma-map-out ( vaddr devaddr n -- ) " dma-map-out" $call-parent ;
: dma-alloc ( size -- addr ) " dma-alloc" $call-parent ;
: dma-free ( addr size -- ) " dma-free" $call-parent ;
\ Dma-sync could be dummy routine if parent device doesn't support.
\ sun4c ROMs may not support it.
: dma-sync ( virt-addr dev-addr size -- )
dma-sync? if
dma-sync-addr my-parent call-package
else
3drop
then
;
headers
: map-qec-regs ( -- )
global-regs-offset my-sbus-addr + my-sbus-space /qec-global-regs
" map-in" $call-parent to qecg
;
: unmap-qec-regs ( -- )
qecg /qec-global-regs " map-out" $call-parent
0 to qecg
;
: map-locmem ( -- )
locmem-pa my-sbus-addr + my-sbus-space /locmem
" map-in" $call-parent to locmem-base
;
: unmap-locmem ( -- )
locmem-base /locmem " map-out" $call-parent
0 to locmem-base
;
\ ***** qec test (from qectest.fth) *****
hex
headerless
\ 18 constant /qec-global-regs
\ Define the mask bits that can be tested for each global register.
create gl-reg-masks
0000.001e , 0000.0000 , 0000.0000 , 0001.e000 ,
0000.f000 , 0000.f000 ,
\ Test Qec global registers.
: gl-reg-test ( -- success? )
true
/qec-global-regs 0 do ( flag0 )
gl-reg-masks i + @
qecg i + d# 32 wlk-test ( flag0 flag )
false = if drop false leave then ( flag0 )
/n +loop
;
\ Perform register test for the qec node.
: qec-reg-test ( -- success? )
diagnostic-mode? if
." Qec register test -- "
then
gl-reg-test
diagnostic-mode? if
dup if ." succeeded." else ." failed." then cr
then
;
headers
\ ***** qec package *****
: 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
;
: identify-chip ( -- okay? )
qecg-control@ gcr-mode and gcr-mace =
;
external
: open ( -- true )
map-qec-regs
identify-chip dup 0= if
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
\ ---------------------------------------------------------------------
\ qe-test.fth
\ Test code for the qe node.
: 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 ;
\ ***** qe map (from qemap.fth) *****
headers
\ instance variable my-channel# my-channel# off
: my-channel#! ( channel# -- ) my-channel# ! ;
: my-chan# ( -- channel# )
my-channel# @
;
: mace-regs ( -- devaddr space size )
my-sbus-addr mace-regs-offset + /mace-regs my-chan# * +
my-sbus-space /qec-mace-regs
;
: map-mace ( -- )
mace-regs " map-in" my-parent $call-method to mace
;
: unmap-mace ( -- )
mace /qec-mace-regs " map-out" my-parent $call-method
0 to mace
;
: channel-regs ( -- devaddr space size )
my-sbus-addr channel-regs-offset + /channel-regs my-chan# * +
my-sbus-space /qec-channel-regs
;
: map-channel ( -- )
channel-regs " map-in" my-parent $call-method to qecc
;
: unmap-channel ( -- )
qecc /qec-channel-regs " map-out" my-parent $call-method
0 to qecc
;
: map-chips ( -- )
mace 0= if \ Do mapping if it is unmapped.
map-mace
map-channel
then
;
: unmap-chips ( -- )
mace if \ Do unmapping if it is mapped.
unmap-channel
unmap-mace
then
;
\ ***** qe test (from qeregtst.fth) *****
hex
\ Define the mask bits that can be tested for each register.
create ch-reg-masks
0000.0004 , 0000.0000 , ffff.f800 , ffff.f800 ,
0000.0001 , 0000.0001 , 001f.001f , 1fc0.3fc0 ,
0000.fffe , 0000.fffe , 0000.fffe , 0000.fffe ,
0000.00ff ,
create mace-reg-masks
00 c, 00 c, 89 c, 00 c, 00 c, 0d c, 00 c, 00 c,
00 c, 67 c, 00 c, 70 c, f3 c, ef c, 04 c, 5f c,
00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c,
00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c,
\ Test Qec per channel registers.
: ch-reg-test ( -- flag )
true
/qec-channel-regs 0 do ( flag0 )
ch-reg-masks i + @
qecc i + d# 32 wlk-test ( flag0 flag )
false = if drop false leave then ( flag0 )
/n +loop
;
\ Test Mace registers.
: mace-reg-test ( -- flag )
true
/qec-mace-regs 0 do ( flag0 )
mace-reg-masks i + c@
mace i + 8 wlk-test ( flag0 flag )
false = if drop false leave then ( flag0 )
loop
;
\ Perform register test for the qe node.
: qe-reg-test ( -- success? )
diagnostic-mode? if
." Qe register test -- "
then
ch-reg-test
mace-reg-test and
diagnostic-mode? if
dup if ." succeeded." else ." failed." then cr
then
;
\ ***** qe0 package *****
headerless
\ For MACE BIU Configuration Control (R11). (RW)
01 constant m-swrst \ software reset
: mace-biucc ( -- vaddr ) h# 0b mace + ;
: mace-biucc@ ( -- data ) mace-biucc rb@ ;
: mace-biucc! ( data -- ) mace-biucc rb! ;
\ For QEC per channel control reg. (RW)
02 constant c-rst
: qecc-control ( -- vaddr ) qecc ;
: qecc-control@ ( -- data ) qecc-control rl@ ;
: qecc-control! ( data -- ) qecc-control rl! ;
headers
: 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#!
;
\ 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
;
external
: qe0-selftest ( -- flag ) \ Flag 0 if passes test.
set-my-channel#
map-chips
qe-reg-test ( success? )
unmap-chips
0= ( fail? )
;
: qe0-open ( -- okay? )
set-my-channel#
mac-address drop 6 encode-string " mac-address" property
true
;
: qe0-close ( -- )
;
: qe0-reset ( -- )
set-my-channel#
map-chips channel-reset drop unmap-chips
;
headers
-----------------------------------------------------------------------------------
The example below shows a complete version of a bootable network driver. It implements the selftest method callable by OpenBoot test commands and the watch-net method callable by OpenBoot watch-net and watch- net-all commands.
Code Example 9 QED Bootable Driver Sample
-------------------------------------------------------------------------------------
\ QED bootable driver
\ qed.fth
fcode-version1
headers
fload board.fth
: copyright ( -- )
." QED 1.1 " cr
." Copyright 1992-1995 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.
: cpuio-addr ( cpu-addr -- io-addr ) cpu-dma-base - io-dma-base + ;
: iocpu-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
: rmdaddrrmd# ( 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 cpuio-addr /md ( cpu-addr io-addr size )
dma-sync
;
\ Sync the transmitting/received buffer after cpu/device writes it.
: qesyncbuf ( md -- )
dup addr@ dup iocpu-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 )
iocpu-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 -- )
rmdaddrrmd# ( [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 )
iocpu-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 algorithme 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
-------------------------------------------------------------------------------------
