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 -------------------------------------------------------------------------------------