Messages in this thread |  | | Date | Thu, 13 Feb 1997 21:53:27 -0500 (EST) | From | "Richard B. Johnson" <> | Subject | Re: Performance patch for NE Ethernet |
| |
On Thu, 13 Feb 1997, Alan Cox wrote:
> Not all the clones work with outw. Been there, screwed up. We could I > guess go for > > NE2000 clone > Crap NE2000 clone > > in the config >
Nice idea but I don't think it's necessary.
By reading the patch, it is not obvious what I did. I sure wish Paul had run the patch on a spare copy of ne.c rather than treating me as a child (I wish I WAS still a kid tho...).
I have found, working with these things for a very long time, that what some have been thinking has happend when the SNIC locks up the bus is not back-to-back I/O instructions. It's instructions that change the internals of the bus interface state machine. I am attaching a bit of assembly-code that has been in use for 4 or more years for 18 megabytes per second data transfer using two RF Links in ping-pong mode, using two of these SNICS as modulator/demodulators. TWO in parallel flinging data out a common FIFO to get almost double the single device data rate.
Further, I stop remote-DMA and do all sorts of nasty things that are not documented in the manual. This runs in a CAT-Scanner marketed by Philips.
I spent many days on the phone with National Semi trying to find out what was happening. It turns out that all you have to do is to guarantee that nothing touches any registers while a remote DMA is in progress. They revised their 1.2 us chip-to-chip access time warning down to the 300 ns once even THEY found out what was happening.
Cheers, Dick Johnson
Richard B. Johnson Project Engineer Analogic Corporation Voice : (508) 977-3000 ext. 3754 Fax : (508) 532-6097 Modem : (508) 977-6870 Ftp : annonymous@boneserver.analogic.com Email : rjohnson@analogic.com Beware the penguin, Linux version 2.1.26 on an i586 machine.COMMENT * ################################################################## # # # Copyright(c) 1994 - 1997, Analogic Corporation. All rights # # reserved worldwide. # # # # This document contains information proprietary to Analogic # # Corporation. If this product is acquired by or on behalf of # # a unit or agency of the United States Government the follow- # # ing applies: (a) This product was not developed with govern- # # ment funds; (b) is a trade secret of Analogic Corporation # # for all purposes of the Freedom of Information Act; and (c) # # is "Commercial Computer Software". For units of the Depart- # # ment of Defense (DoD), this software is provided only with # # "Restricted Rights" as defined in the DoD supplement to the # # Federal Acquisition Regulations, 52.227-7013(c)(I)(ii). Use, # # duplication, or disclosure is subject to the restrictions # # set forth in subdivision (c)(ii) of the Rights in Technical # # Data and Computer Software clause at 52-227-7013. # # # # Use, duplication, or disclosure of this proprietary document # # without the express permission of Analogic Corporation is # # prohibited. # # # # C O N F I D E N T I A L # # The information contained in or upon this document is the # # property of Analogic Corporation and is considered to be # # proprietary and may not be used by any recipient without # # the specific written permission of Analogic Corporation. # ################################################################## *
SUBTTL RF Ethernet link code PAGE ,132 COMMENT * RFLINK.ASM Created 29-JUN-1992 Richard B. Johnson
This module contains assembly language routines for the RF Link
This source code is to be compiled using one of the following:
Microsoft MASM 5.1 Macro Assembler Borland TASM 2.0 Turbo Assembler SLR Systems OPTASM 1.50 Assembler
Assembly language is NOT portable. There is no way that this could be written so that it is compatible with all assemblers. Note that Microsoft MASM 6.0 is NOT compatible with previous versions and will NOT assemble this code. This is a Microsoft management and design problem.
Abandon hope, all ye who enter herein. Alighieri Dante's Inferno
Modified: 28-SEP-1992 Richard B. Johnson
Fixed bug in _trigger procedure where I was setting the trigger bit when it had already been set. This would cause the NIC to hold the WAIT line for milliseconds or until the previous packet had been transmitted. This would trash memory because refresh was disabled for this entire interval.
Modified 07-NOV-1992 Richard B. Johnson
Added support to keep executing RF_ISR until all events were serviced after the first interrupt gained control. This was necessary because, once control was relinquished with the IRET, a new event would not cause the interrupt to be immediately serviced because the timer tick was a higher priority. The ISR would eventually be executed, but too late and events would be lost.
Modified 09-NOV-1992 Richard B. Johnson
Changed the priority of the interrupt controller so that IRQ2, the cascade interrupt has the highest priority.
Modified 24-NOV-1992 Richard B. Johnson
Added support to remove status information from the downlink data stream and send the remaining packet to the FIFO.
Modified 08-DEC-1992 Richard B. Johnson
Modified just about everything because it was found that the SNIC chip would seize the bus if I checked any status register during certain (unknown) critical periods. This meant that an attempt to determine if it was busy so I could fill the output buffer, would sometimes halt the machine.
The "fix" was to update the chip's internal output buffer only after a transmit packet interrupt. This would guarantee that it would not be busy. Unfortunately, since an interrupt may occur at any time, other portions of code might not have completed updating the data to be transmitted before the chip interrupted and transmitted it. This required additional redesign so that the transmitted buffer can be marked "complete".
Modified 22-DEC-1992 Richard B. Johnson
Changed the method of maintaining the SNIC boundary pointer. It is now permanently set to zero with the Page Start Address set at one. This will force this pointer to always be less than the current address.
Modified 28-DEC-1992 Richard B. Johnson
Removed above modification and fixed a bug in the initialization that kept the data configuration register in the loopback mode.
Modified 31-JAN-1993 Richard B. Johnson Added support to queue the error-logger if some new errors are sent from the DEC card in the Disc Subsystem
Changed code to accommodate new structure length on the returned data because of the redesign of the DEC card
Modified 04-FEB-1993 Richard B. Johnson
Changed down-link interrupt service routine to use a MACRO which is optimized for speed. Modifying MACRO READ_LINK now changes the code in both downlink channels.
Modified the method of handling the SNIC page stop parameter. How uses a mask so a compare and jump on condition is not necessary. this saves 12 processor clocks.
Modified 07-FEB-1993 Richard B. Johnson
Added support to extract Auxiliary DAS data from the downlink packets.
Modified 19-FEB-1993 Richard B. Johnson
Added support to update the position system record number from within the transmitter interrupt service routine.
Modified 21-MAY-1993 Richard B. Johnson Added support for returned Disc Subsystem errors.
Modified 02-MAR-1995 Richard B. Johnson Added support for conditional compilation to detect sequence number errors *
INCLUDE ENET.INC INCLUDE HEADER.INC INCLUDE INTDEF.INC INCLUDE DISCTL.INC INCLUDE ETHER0.INC INCLUDE DASDATA.INC INCLUDE ERRMSG.INC
.286C ; 80286 instructions
INT_USE EQU IRQ9 ; Interrupt we are using BASE EQU 200H ; Base address of the board DNLINK0 EQU BASE ; Downlink port DNLINK1 EQU BASE + 10H ; Downlink port UPLINK EQU BASE + 20H ; Uplink port UPDATA EQU BASE + 32H ; Data port for uplink ADD_LEN EQU SIZE DISC_DEST ; Bytes in an ethernet address WRAP EQU 0FFFH ; Max offset in Global Table SNIC_ADDS EQU 04H ; Two words MAXBUF EQU 0000011111111110B ; Ethernet limit mask MAXALO EQU MAXBUF + SNIC_ADDS ; Data to allocate for buffer _PSTART EQU 1 ; Starting page address _PSTOP EQU 20H ; End of RAM 32 _PMASK EQU _PSTOP - 1 ; Mask for boundry pointer _BNDRY EQU _PSTART ; Boundary pointer _CURR EQU _PSTART ; Current starting page _NEXT_PKT EQU _PSTART ; Next packet address UL$FAIL0 EQU 00000001B ; Uplink failed DL$FAIL0 EQU 00000010B ; Downlink 0 failed DL$FAIL1 EQU 00000100B ; Downlink 1 failed SN$DMABT EQU 00001000B ; DMA aborted LN$SEQNM EQU 00010000B ; Sequence number error KEY_LEN EQU 12 ; Length of key-word data PUBLIC _start_rflink PUBLIC _chk_com_brd PUBLIC _stop_rflink PUBLIC _fix_link PUBLIC _trigger PUBLIC _fifo_eot PUBLIC _get_disc_err PUBLIC _get_disc_err_clr EXTRN _errmsg:FAR EXTRN _tqueue:FAR EXTRN _pos_reset:FAR EXTRN _pos_norm:FAR ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; MACROs for setting Serial Network Controller ports ; OUT_SNC MACRO ADDR, VALUE MOV DX,BX ; Get base address IF VALUE ; If not zero MOV AL,VALUE ; Number into AL ELSE XOR AL,AL ; Clear AL ENDIF IF ADDR ; If not zero ADD DX,ADDR ; Add in offset address ENDIF OUT DX,AL ; Output to port ENDM ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; ; Used to read Serial Network Controller ports. ; IN_SNC MACRO ADDR MOV DX,BX ; Get base address ADD DX,ADDR ; Add in offset address IN AL,DX ; Get port data ENDM ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; ; This MACRO logs any errors. ; LOG_ERROR MACRO ERR_CODE PUSH ERR_CODE ; Put error code on stack PUSH DGROUP ; Segment of the string PUSH OFFSET DGROUP:RF_MODULE ; Module name CALL _errmsg ; Call error logger ADD SP,6 ; Level stack XOR AX,AX ; Clear error code ENDM ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This reads and filters data from the downlink Serial Network ; Controllers. N is the channel, 0 or 1, and M is the other, i.e., ; 1 or 0. ; READ_LINK MACRO N LOCAL DMA_OK, STA_OK, RX_BAD, MAXBF, IMAGE, BNDRY, BNDOK, JUNK ; MOV AL,RD_SEL&N ; Select device 'N' MOV DX,BASE.RDPCA ; Remote DMA path control port OUT DX,AL ; Select it ; ; To avoid hanging the system, we must check if the previous remote ; DMA operation has completed. If it has not completed, we will ; abort it. ; MOV DX,DNLINK&N.CMD ; Pick up command register IN AL,DX ; See if DMA is complete FLUSH ; Chip-to-chip select time bug AND AL,CR_RD2 ; Check abort/complete DMA JNZ DMA_OK ; It has completed MOV AL,CR_RD2 ; Abort complete DMA OUT DX,AL ; Tell controller FLUSH ; Chip-to-chip select time bug MOV DX,BASE.RREAD ; Remote read port IN AX,DX ; Reset PRQ (Note 1, 10.0, pp 1-17) ; MOV AL,(NOT RD_SEL&N) ; Select device NOT 'N' MOV DX,BASE.RDPCA ; Remote DMA path control port OUT DX,AL ; Select it NOT AL ; Toggle the bit OUT DX,AL ; Select it OR BYTE PTR LNK_FAIL, SN$DMABT ; Show DMA was aborted ; ; DMA problem has been fixed. How check the interrupt status register ; and handle either the error or the new data in the SNIC. ; DMA_OK: MOV DX,DNLINK&N.ISR ; Downlink interrupt status port IN AL,DX ; Get status OUT DX,AL ; Clear status register TEST AL,IS_PRX ; Was packet received? JZ RX_BAD ; No ; ; Data was received, now remove our private data from the SNIC then ; send the image data to the FIFO. ; MOV BYTE PTR _chmon&N,TRUE ; Show channel is alive ADD WORD PTR _recvs&N.LW.LO,1 ; Increment receiver count ADC WORD PTR _recvs&N.LW.HI,0 ; Take care of overflow ; MOV DX,DNLINK&N.RSR ; Get downlink receive status IN AL,DX ; Get status MOV CL,AL ; Save receive status ; XOR AL,AL ; Clear low byte MOV AH,BYTE PTR NPK&N ; Address of current packet MOV WORD PTR CURPK,AX ; Save current packet address MOV DX,DNLINK&N.RSAR0 ; Remote start address port OUT DX,AX ; Set it FLUSH ; Chip-to-chip select time bug ; MOV AX,4 ; Two words MOV DX,DNLINK&N.RBCR0 ; Remote byte count register OUT DX,AX ; Set remote byte-count FLUSH ; Chip-to-chip select time bug ; MOV AL,CR_GET ; Remote read MOV DX,DNLINK&N.CMD ; Pick up command register OUT DX,AL ; Set remote read FLUSH ; Chip-to-chip select time bug ; MOV DX,BASE.RREAD ; Remote read port IN AX,DX ; Get first word (status) CMP CL,AL ; Check the status JZ STA_OK ; Status was okay IN AX,DX ; Get next word to complete DMA ; RX_BAD: OR BYTE PTR LNK_FAIL, DL$FAIL&N ; Show downlink failure MOV DX,DS ; Save segment LDS DI,DWORD PTR DGROUP:_history ; Get History structure ADD WORD PTR [DI.DNLNK&N&_ERRORSL],1 ; Accumulate errors ADC WORD PTR [DI.DNLNK&N&_ERRORSH],0 ; Propagate overflow MOV DS,DX ; Restore segment RET ; STA_OK: MOV BYTE PTR NPK&N,AH ; Set next packet address IN AX,DX ; Get byte count AND AX,MAXBUF ; Mask byte count limit MOV WORD PTR _dlink_len&N,AX ; Save the length SUB AX,4 ; What we have already read MOV CX,AX ; Set byte count in counter register MOV DX,DNLINK&N.RBCR0 ; Remote byte count register OUT DX,AX ; Set byte count FLUSH ; Chip-to-chip select time bug ; MOV DX,DNLINK&N.CMD ; Pick up command register MOV AL,CR_GET ; Remote read OUT DX,AL ; Set remote read FLUSH ; Chip-to-chip select time bug ; MOV DI,OFFSET DGROUP:_dnlink_buf&N ; Where to put the data MOV AX,CX ; Save the byte count MOV CX,(DASM_AUX SHR 1) ; Up to, but not including (WORDS) MOV DX,BASE.RREAD ; Remote read port (where to get data) REP INSW ; Read the data MOV CX,AX ; Restore byte count SUB CX,DASM_AUX ; CX = rest of the data ; Check data type CMP BYTE PTR _dnlink_buf&N.DISC_MSG_TYP,DISC_NORM JZ IMAGE ; It's image data SHR CX,1 ; Make a word count REP INSW ; Read the rest of the data JMP BNDRY ; Do the boundary pointer
JUNK: MOV AL,CR_RD2 ; Abort/complete remote DMA MOV DX,DNLINK&N.CMD ; Pick up command register OUT DX,AL ; Tell controller FLUSH ; Chip-to-chip select time bug MOV DX,BASE.RREAD ; Remote read port IN AX,DX ; Reset PRQ (Note 1, 10.0, pp 1-17) JMP SHORT BNDRY ; Do the boundary pointer ; ; The data is image data. Extract the Auxiliary DAS data that we need. ; Note that we do not use a multiply within the ISR. That takes 21 ; clocks. Instead, we index into a table of fixed offsets. ; IMAGE: TEST CX,0FF00H ; Make sure it's real JZ JUNK ; It's junk IN AX,DX ; Get REV_NUMBER IN AX,DX ; Get KEY_WORD AND AX,7 ; Mask off junk MOV CX,BX ; Save nonvolatile register MOV BX,OFFSET DGROUP:KEY_INDEX ; Set offset (2 clocks) XLAT ; Get offset (4 clocks) MOV BX,CX ; Restore old BX register MOV DI,OFFSET DGROUP:_dasd ; Where the data starts ADD DI,AX ; New offset MOV CX,(KEY_LEN SHR 1) ; Number of WORDS per record REP INSW ; Get the AUX data ; ; Aux data has been received. We have to abort/complete the remote ; DMA operation so we can start again for the FIFO ; MOV AL,CR_RD2 ; Abort/complete remote DMA MOV DX,DNLINK&N.CMD ; Pick up command register OUT DX,AL ; Tell controller FLUSH ; Chip-to-chip select time bug MOV DX,BASE.RREAD ; Remote read port IN AX,DX ; Reset PRQ (Note 1, 10.0, pp 1-17) ; ; Now set up remote DMA so FIFO can get its data. ; MOV AX,WORD PTR CURPK ; Get current packet address ADD AX,DASM_AUX ; Set up new offset MOV DX,DNLINK&N.RSAR0 ; Remote start address port OUT DX,AX ; Set it FLUSH ; Chip-to-chip select time bug ; MOV AX,WORD PTR _dlink_len&N ; Get the length SUB AX,DASM_AUX ; Get rid of stuff we don't want MOV DX,DNLINK&N.RBCR0 ; Remote byte count register OUT DX,AX ; Set byte count FLUSH ; Chip-to-chip select time bug ; MOV AL,CR_GET ; Remote read MOV DX,DNLINK&N.CMD ; Pick up command register OUT DX,AL ; Set remote read FLUSH ; Chip-to-chip select time bug ; MOV AL,(NOT RD_SEL&N) ; Select alternate device, signal FIFO MOV DX,BASE.RDPCA ; Remote DMA path control OUT DX,AL ; Select it ; ; FIFO has been signaled. Now check for any change in the error status ; word and queue the error logger if it has changed since the last time ; it was read. ; CMP BYTE PTR _ctx.EBLOCK.DISC_HEAD.DISC_MSG_TYP,DISC_NORM JNZ BNDRY ; Not normal control messages MOV AX,WORD PTR _dnlink_buf&N.DASM_STAT XOR DX,DX ; Clear the mask CMP AX,1 ; Sets CY if it's 0 SBB DX,0 ; Makes DX = 0FFFFH if CY is set AND WORD PTR _ctx.EBLOCK.DISC_HVPS_VOLT,DX AND WORD PTR _ctx.EBLOCK.DISC_XRAY_FCUR,DX OR AX,AX ; Any errors? JZ BNDRY ; No OR WORD PTR LAST_STAT,AX ; Set new status OR WORD PTR _ctx.ENQUE_LOW, TASK0C ; Queue the error logger ; ; Set the boundary pointer for the next packet reception. Note that ; this uses auto-wrap of the ring buffer. We are using page 0 of ; the SNIC and not throwing it away as the documentation advises. ; BNDRY: MOV AL,BYTE PTR NPK&N ; Address of next packet DEC AL ; BNDRY = next_pkt - 1 AND AL,_PMASK ; Auto wrap MOV DX,DNLINK&N.BNDRY ; Get boundary pointer register OUT DX,AL ; Set new value ; ; Record any new Disc RF Link errors that have been sent on the ; downlink packet. ; MOV AL,BYTE PTR _dnlink_buf&N.DISC_MSG_ERR MOV AH,AL ; Copy error count SUB AL,BYTE PTR _last_dsc ; Get last error count MOV BYTE PTR _last_dsc,AH ; Set new value XOR AH,AH ; Clear high byte ; MOV DX,DS ; Save segment LDS DI,DWORD PTR DGROUP:_history ; Get History structure ADD WORD PTR [DI.DISCLK_ERRORSL],AX ; Accumulate errors ADC WORD PTR [DI.DISCLK_ERRORSL],0 ; Propagate overflow MOV DS,DX ; Restore segment ; ENDM ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- CONST SEGMENT WORD PUBLIC 'CONST' UPLNK_ADDR DB 'UPLINK' ; Address of data link. DNLNK_ADDR DB 'DNLINK' ; Address of data link. RF_MODULE DB 'rflink',0 ; Name of module KEY_INDEX DB (KEY_LEN * 0) ; Table of key index values DB (KEY_LEN * 1) DB (KEY_LEN * 2) DB (KEY_LEN * 3) DB (KEY_LEN * 4) DB (KEY_LEN * 5) DB (KEY_LEN * 6) DB (KEY_LEN * 7) CONST ENDS ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; ; Name Align Size ; _BSS SEGMENT WORD PUBLIC 'BSS' COMM NEAR _ctx :BYTE :TYPE(CONTEXT) ; In GBLDATA.C COMM NEAR _dasd :BYTE :TYPE(DASDATA) ; In GBLDATA.C COMM NEAR _pos_data :BYTE :TYPE(POS) ; In GBLDATA.C COMM NEAR _history :BYTE :4 ; In GBLDATA.C file COMM NEAR _chmon0 :BYTE :1 ; It's in GBLDATA.C COMM NEAR _chmon1 :BYTE :1 ; It's in GBLDATA.C COMM NEAR _txmits :BYTE :4 ; It's here only COMM NEAR _recvs0 :BYTE :4 ; It's here only COMM NEAR _recvs1 :BYTE :4 ; It's here only COMM NEAR _dlink_len0 :BYTE :2 ; It's here only COMM NEAR _dlink_len1 :BYTE :2 ; It's here only COMM NEAR _pos_last :BYTE :2 ; It's here only COMM NEAR _last_dsc :BYTE :1 ; It's here only COMM NEAR _dnlink_buf0 :BYTE :MAXALO ; It's here only COMM NEAR _dnlink_buf1 :BYTE :MAXALO ; It's here only _BSS ENDS ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This is the data that we don't want any other procedure to see. ; _DATA SEGMENT WORD PUBLIC 'DATA' OLD_RF_INT DD 0 ; Old RF link interrupt LAST_STAT DW 0 ; Last Disc Subsystem status CURPK DW 0 ; Current packet OLD_RF_MASK DB 0 ; Old controller mask LNK_FAIL DB 0 ; RF/Ethernet link failure NPK0 DB 0 ; Next packet address SNIC 0 NPK1 DB 0 ; Next packet address SNIC 1 _DATA ENDS ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; UTILITY_TEXT SEGMENT WORD PUBLIC 'CODE' ASSUME CS:UTILITY_TEXT ; ; This gets the current disk error status without losing any error ; bits that may change during an interrupt. ; _get_disc_err_clr PROC FAR PUSH DS ; Save segment MOV AX,DGROUP ; Data GROUP MOV DS,AX ; Into data segment XOR AX,AX ; Get zero XCHG AX,WORD PTR LAST_STAT ; Get status POP DS ; Restore segment RET _get_disc_err_clr ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; ; This gets the current disk error status and does not reset the ; statis bits. ; _get_disc_err PROC FAR PUSH DS ; Save segment MOV AX,DGROUP ; Data GROUP MOV DS,AX ; Into data segment MOV AX,WORD PTR LAST_STAT ; Get last status bits POP DS ; Restore segment RET _get_disc_err ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; _fifo_eot PROC FAR MOV DX,234H OUT DX,AL RET _fifo_eot ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This checks if the board is present and installed. ; _chk_com_brd PROC FAR SETUP XOR AH,AH ; Clear high byte MOV AL,BYTE PTR OLD_RF_MASK ; Get communications mask RESTORE _chk_com_brd ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This starts the RF data link. ; _start_rflink PROC FAR SETUP OR AX,0FFFFH ; Assume bad CMP BYTE PTR OLD_RF_MASK,FALSE ; See if it was patched JNZ NPTCH ; Was already patched MOV BYTE PTR LNK_FAIL,FALSE ; Set default flag. MOV DX,BASE.IDENT ; See if board is installed IN AL,DX ; Get interrupt status AND AL,00001111B ; Mask unused bits CMP AL,00001010B ; Check if anybody home JNZ NPTCH ; No board installed ; ; Set up Ethernet transmit block for the Uplink. We need source ; address, destination address, and byte count. ; MOV AX,0FFFFH ; Destination address MOV DI,OFFSET DGROUP:_ctx ; In HOST.C ADD DI,EBLOCK ; Offset of ethernet block MOV CX,(ADD_LEN SHR 1) ; Words in address REP STOSW ; Store destination address ; MOV SI,OFFSET DGROUP:UPLNK_ADDR ; Get offset MOV CX,(ADD_LEN SHR 1) ; Words in address REP MOVSW ; Store destination address ; Set length to transmit MOV WORD PTR [DI],(ETHLEN-DATA_START) ; ; Now patch the interrupt vector. ; PATCH INT_USE, OLD_RF_MASK, OLD_RF_INT, RF_ISR CALL SET_LNK ; Set up the controller INT INT_USE ; Execute the interrupt MOV BYTE PTR NPK0,_NEXT_PKT ; Set the next packet pointer MOV BYTE PTR NPK1,_NEXT_PKT ; Set the next packet pointer XOR AX,AX ; Show good NPTCH: RESTORE _start_rflink ENDP ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This stops the RF Data link (quietly), without crashing the system ; even when high-speed data are still being received. ; _stop_rflink PROC FAR SETUP OR AX,0FFFFH ; Assume bad CMP BYTE PTR OLD_RF_MASK,FALSE ; See if it was patched JZ NPATCH ; Never patched MOV BX,BASE ; Get base address OUT_SNC TWRDB, <CR_RD2 OR CR_STP> ; Page OUT_SNC WCCA, <CC_RSET> ; Reset the chip MOV CX,1200 ; Wait for 50 uS (about) LOOP $ ; Wait here OUT_SNC WCCA, <CC_STOP> ; Reset the chip UNPATCH INT_USE, OLD_RF_MASK, OLD_RF_INT MOV BYTE PTR OLD_RF_MASK,FALSE ; Clear old controller mask XOR AX,AX ; Show good NPATCH: RESTORE _stop_rflink ENDP ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This triggers the transmitter for testing. Note that this must NOT ; be triggered during an internal DMA routine or the NIC will jam ; the PC bus. The calling routine must handle synchronization. ; _trigger PROC FAR PUSH DX MOV DX,BASE.MTCA ; Get manual trigger area OUT DX,AL ; Send anything to port POP DX RET _trigger ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This procedure sets up the Ethernet Controllers for the RF Link. Upon ; entry, BX contains the base address of the controller. If an error ; occurs, return with the base address of the port causing the error. ; Otherwise, return ZF = AX = 0. ; SET_LNK PROC NEAR MOV BX,BASE ; Get base address OUT_SNC TWRDB, <CR_RD2 OR CR_STP> ; Page OUT_SNC WCCA, <CC_RSET> ; Reset the chip MOV CX,1200 ; Wait for 50 uS (about) LOOP $ ; Wait here OUT_SNC WCCA, <CC_ULNK OR CC_PERL> ; Device to ethernet chip OUT_SNC MTCA, 0 ; Turn on the chip ; MOV DX,BASE.SSA ; System status area XOR CX,CX ; Long wait for startup MOV BX,10H ; Number of tries GET_SS: IN AL,DX ; Get system status AND AL,SS_SRDY ; Check for perhipherals ready JNZ AWAKE ; System boards are alive LOOP GET_SS ; Not set yet DEC BX ; Try again JNZ GET_SS ; Continue ; ; Set up the uplink device. Set for interrupt on transmit and data in ; the BYTE mode. ; AWAKE: MOV BYTE PTR NPK0,_NEXT_PKT ; Set the next packet pointer MOV BYTE PTR NPK1,_NEXT_PKT ; Set the next packet pointer MOV BX,UPLINK ; Get uplink address MOV AL,DC_BYT OR DC_LS ; One word wide, BYTE mode CALL SET_NIC ; Initialize the NIC OUT_SNC IMR, IM_XMIT ; Interrupt mask register. ; ; Set up the first downlink device. Set for interrupt on receive, ; with data in WORD mode. ; MOV BX,DNLINK0 ; Get first downlink contr. MOV AL,DC_WTS OR DC_LS OR WRD2 ; Downlinks are in WORD mode CALL SET_NIC ; Initialize the NIC OUT_SNC IMR, IM_RECV ; Interrupt mask register. ; ; Set up the second downlink device. Set for interrupt on receive, ; with data in WORD mode. ; MOV BX,DNLINK1 ; Get second downlink contr. MOV AL,DC_WTS OR DC_LS OR WRD2 ; Downlinks are in WORD mode CALL SET_NIC ; Set second controller OUT_SNC IMR, IM_RECV ; Interrupt mask register. ; ; Set the board so it can be triggered by the position system. ; MOV AX,ETHLEN ; Not okay, set minimum MOV DX,UPLINK.TBCR0 ; Transmit byte count OUT DX,AX ; Set the byte count FLUSH ; Chip-to-chip select time bug MOV BX,BASE ; Get base address OUT_SNC TWRDB, SND_ALL ; Set up for auto send XOR AX,AX ; Show everything went okay RET ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; Program the Network Interface Controller. Upon entry, base port ; address is in BX, and data configuration value is in AL. ; SET_NIC PROC NEAR PUSH AX ; Save data configuration value OUT_SNC IMR, 00H ; Turn off device interrupts. OUT_SNC ISR, 0FFH ; Clear interrupt status register OUT_SNC CMD, <CR_STP> ; Page 0, STOP the chip OUT_SNC RBCR0, 0 ; Clear the remote byte-count OUT_SNC RBCR1, 0 ; High byte WT_RST: IN_SNC ISR ; Get interrupt status AND AL,IS_RST ; Check for reset value JZ WT_RST ; Wait <forever> for reset POP AX ; Restore data configuration value ; MOV DX,BX ; Get base address ADD DX,DCR ; Offset to data config. register OUT DX,AL ; Set configuration register OUT_SNC RBCR0, 0 ; Clear the remote byte-count OUT_SNC RBCR1, 0 ; High byte OUT_SNC RCRR, RC_AB ; Receive Configuration Register. FLUSH ; Chip-to-chip select time bug OUT_SNC TCR, TC_LB0 ; Place the NIC in Loopback mode. FLUSH ; Chip-to-chip select time bug ; ; Initialize the Receive Buffer ring; BNDRY, PSTART, PSTOP. ; OUT_SNC PSTART, _PSTART ; PSTART value OUT_SNC BNDRY, _BNDRY ; Boundary pointer OUT_SNC PSTOP, _PSTOP ; Page stop value OUT_SNC CMD, CR_PAG1 ; Command register to page 1 FLUSH ; Chip-to-chip select time bug ; ; Set physical address registers ; PUSH DS ; Save segment MOV AX,SEG UPLNK_ADDR ; Make addressable LEA SI,UPLNK_ADDR ; Point to uplink address MOV DS,AX ; DS:SI points to physical address MOV DX,BX ; Get base port ADD DX,P1_PAR0 ; Physical address port offset MOV CX,ADD_LEN ; Bytes to write S_PHY: LODSB ; Get physical address OUT DX,AL ; Set port INC DX ; Ready next port LOOP S_PHY ; Do all bytes POP DS ; Restore segment ; ; Set multicast address registers. Multicast addresses are not used ; so they are masked OFF (set to zero). ; MOV DX,BX ; Get base port ADD DX,P1_MAR0 ; Multicast address port offset MOV CX,ADD_LEN ; Bytes to write XOR AL,AL ; Clear AL S_MCA: OUT DX,AL ; Set port INC DX ; Ready next port LOOP S_MCA ; Do all bytes ; OUT_SNC P1_CURR, _CURR ; Set to current page FLUSH ; Chip-to-chip select time bug OUT_SNC CMD, CR_STRT ; Put the NIC in the START mode. FLUSH ; Chip-to-chip select time bug OUT_SNC TCR, TC_NRML ; Set up the normal transmit mode. FLUSH ; Chip-to-chip select time bug OUT_SNC TPSR, 0 ; Transmit page start to page 0 FLUSH ; Chip-to-chip select time bug OUT_SNC ISR, 0FFH ; Clear interrupt status ; ; Clear the error tally counters by reading them and discarding the ; data. ; IN_SNC CNTR0 ; Framing errors counter IN_SNC CNTR1 ; CRC errors counter IN_SNC CNTR2 ; Missed packet errors counter IN_SNC NCR ; Number of collisions IN_SNC TSR ; Transmit status register RET SET_NIC ENDP SET_LNK ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;-=-=-=-=- Start of the world's longest interrupt service routine =-=-=-=- ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This handles the transmit interrupt from channel 0 ; DO_TX0 PROC NEAR MOV DX,UPLINK.ISR ; Get uplink interrupt status IN AL,DX ; Get status OUT DX,AL ; Clear status register TEST AL,IS_PTX ; Was packet transmitted? JNZ TX0 ; Was transmitted OR BYTE PTR LNK_FAIL, UL$FAIL0 ; The first up link PUSH DS LDS DI,DWORD PTR DGROUP:_history ; Get History data structure ADD WORD PTR [DI.UPLNK_ERRORSL],1 ; Accumulate errors ADC WORD PTR [DI.UPLNK_ERRORSH],0 ; Propagate overflow POP DS RET ; TX0: ADD WORD PTR _txmits.LW.LO,1 ; Increment transmit count ADC WORD PTR _txmits.LW.HI,0 ; Take care of overflow ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; ; Fill the SNIC buffer with the data to be sent on the uplink. ; MOV SI,OFFSET DGROUP:_ctx.EBLOCK ; Start of the data to send MOV CX,WORD PTR [SI.DISC_LEN] ; Length of data to send ADD CX,DATA_START ; Ethernet overhead INC CX ; In case an odd count AND CX,0FFFEH ; Make even OR CX,ETHLEN ; Make sure it's long enough MOV AX,CX ; Get byte count MOV DX,UPLINK.TBCR0 ; Transmit byte count OUT DX,AX ; Set the byte count FLUSH ; Chip-to-chip select time bug ; INC AX ; Program for one more MOV DX,UPLINK.RBCR0 ; Remote byte count register OUT DX,AX ; Set the byte count FLUSH ; Chip-to-chip select time bug ; MOV AL,(CR_RD0 OR CR_STA) ; Get remote read command MOV DX,UPLINK.CMD ; Pick up command register OUT DX,AL ; Set remote read FLUSH ; Chip-to-chip select time bug MOV AL,(CR_RD1 OR CR_STA) ; Get remote write command OUT DX,AL ; Set remote write FLUSH ; Chip-to-chip select time bug ; XOR AX,AX ; Clear start address MOV DX,UPLINK.RSAR0 ; Remote start address OUT DX,AX ; Set the start address FLUSH ; Chip-to-chip select time bug ; MOV DX,UPDATA ; Data address REP OUTSB ; Fill the NIC buffer ring CMP BYTE PTR _ctx.EBLOCK.DISC_MSG_TYP,FALSE ; Control record? JZ CTRL ; Control record MOV BYTE PTR _ctx.EBLOCK.DISC_MSG_TYP,TRUE ; Show transmitted CTRL: RET DO_TX0 ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This is the interrupt service routine for the RF Link Ethernet ; controllers. There are presently three possible sources for the ; interrupts, The Uplink (command) channel, and two Downlink (Data) ; channels. Unless you (** REALLY **) know what you are doing, you ; don't want to change any of this! ; RF_ISR PROC FAR PUSHA ; Save general purpose registers SAV_REG DS, ES ; Save segment registers used MOV AX,DGROUP ; Get data GROUP MOV DS,AX ; Into data segment MOV ES,AX ; Into extra segment CLD ; Forwards ; MORE: MOV DX,BASE.WHO_INT ; See who called IN AL,DX ; Get interrupt status AND AL,(DN_INT0 OR DN_INT1 OR UP_INT0) JZ DONE ; Nothing happened while servicing MOV BL,AL ; Save working copy END_INT <INT_USE> ; MACRO to reset controller(s) ; TEST BL,DN_INT0 ; See if the first downlink JZ NO_RX0 ; Not the first downlink CALL DO_RX0 ; Handle the first downlink NO_RX0: TEST BL,DN_INT1 ; See if the second downlink JZ NO_RX1 ; Not the second downlink CALL DO_RX1 ; Handle the second downlink NO_RX1: TEST BL,UP_INT0 ; See if the uplink JZ MORE ; Not the uplink, continue CALL DO_TX0 ; Handle the uplink JMP SHORT MORE ; Check for new status ; DONE: RES_REG DS, ES ; Restore segment registers used POPA ; Restore general purpose registers IRET RF_ISR ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This handles the receive interrupt from channel 0. This is handled ; using the previously-defined MACRO. Unless you (** REALLY **) know ; what you are doing, you don't want to change any of this! ; DO_RX0 PROC NEAR READ_LINK 0 ; MACRO RET DO_RX0 ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This handles the receive interrupt from channel 1. This is handled ; using the previously-defined MACRO. Unless you (** REALLY **) know ; what you are doing, you don't want to change any of this! ; DO_RX1 PROC NEAR READ_LINK 1 ; MACRO RET DO_RX1 ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This procedure is called any time that a link error is discovered. ; It reinitializes the data link and attempts to recover from the ; error. There are three RF Links and four possible errors to be ; handled. The byte LNK_FAIL will contain bits that correspond to ; the failing links. They are: ; LNK_FAIL DB 00001111B ; ||||______ UPLINK ; |||_______ DNLINK0 ; ||________ DNLINK1 ; |_________ Aborted DMA FIX_LNK PROC NEAR CALL _pos_reset ; Turn off position triggers TEST BYTE PTR LNK_FAIL, UL$FAIL0 ; The uplink JZ NO_UL0 ; Not the uplink MOV BX,UPLINK ; Get uplink address MOV AL,DC_BYT OR DC_LS ; One word wide, BYTE mode CALL SET_NIC ; Initialize the NIC OUT_SNC IMR, IM_XMIT ; Interrupt mask register. NO_UL0: TEST BYTE PTR LNK_FAIL, DL$FAIL0 ; The first downlink JZ NO_DL0 ; Not downlink 0 MOV BX,DNLINK0 ; Get first downlink contr. MOV AL,DC_WTS OR DC_LS OR WRD2 ; Downlinks are in WORD mode CALL SET_NIC ; Initialize the NIC MOV BYTE PTR NPK0,_NEXT_PKT ; Set the next packet pointer OUT_SNC IMR, IM_RECV ; Interrupt mask register. NO_DL0: TEST BYTE PTR LNK_FAIL, DL$FAIL1 ; The second downlink JZ NO_DL1 ; Not downlink 1 MOV BX,DNLINK1 ; Get first downlink contr. MOV AL,DC_WTS OR DC_LS OR WRD2 ; Downlinks are in WORD mode CALL SET_NIC ; Initialize the NIC MOV BYTE PTR NPK1,_NEXT_PKT ; Set the next packet pointer OUT_SNC IMR, IM_RECV ; Interrupt mask register NO_DL1: MOV BYTE PTR LNK_FAIL,0 ; Clear all errors INT INT_USE ; Execute the interrupt CALL _pos_norm ; Restart position system RET FIX_LNK ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; This procedure checks for RF Link errors and attempts to fix them ; if any are found. This is queued for the context switcher at 1 ; second intervals as TASK07. ; ; We should not normally have any errors. Therefore, this procedure ; reinitializes the offending SNIC because it assumes that something ; bad must have happened such as an aborted DMA because the Disc ; Subsystem CPU went down. ; _fix_link PROC FAR SETUP XOR AX,AX ; Assume good status CMP BYTE PTR OLD_RF_MASK,FALSE ; See if it's installed JNZ CHK_LN ; Installed, check health JMP SHORT LNK_OK ; Not installed, don't check CHK_LN: CMP BYTE PTR LNK_FAIL,FALSE ; See if any errors JNZ CHK_DM ; Errors exist, check link JMP SHORT LNK_OK ; No errors CHK_DM: TEST BYTE PTR LNK_FAIL, SN$DMABT ; See if DMA was aborted JZ NO_DMA ; DMA bit was not set LOG_ERROR <EDMABT> ; Error code AND BYTE PTR LNK_FAIL,(NOT SN$DMABT) ; Clear error bit ; NO_DMA: TEST BYTE PTR LNK_FAIL,UL$FAIL0 ; Check for uplink failure JZ UL_OK ; Uplink 0 was still okay LOG_ERROR <EUPLNK> ; Error code ; UL_OK: TEST BYTE PTR LNK_FAIL,(DL$FAIL0 OR DL$FAIL1) JZ DL_OK ; Both downlinks were okay LOG_ERROR <EDNLNK> ; Error code ; DL_OK: CALL FIX_LNK ; Fix the links MOV AL,BYTE PTR LNK_FAIL ; Return status OR AL,AL ; See if still okay JZ LNK_OK ; It's still okay ; CALL SET_LNK ; Reinit the whole thing LOG_ERROR <ESNICR> ; Error code MOV AL,BYTE PTR LNK_FAIL ; Return status LNK_OK: XOR AH,AH ; Clear high byte PUSH AX ; Save status PUSH 1 ; Seconds for next queue PUSH (TASK07 SHR 16) ; High word of long word PUSH (TASK07 AND 0FFFFH) ; Low word of long word CALL _tqueue ; Set timer queue ADD SP,6 ; Level stack POP AX ; Restore status RESTORE _fix_link ENDP ; ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- UTILITY_TEXT ENDS END SUBTTL Code
|  |