.MCALL .MODULE .MODULE NQ,VERSION=21,COMMENT=,AUDIT=NO ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. NI$QNA = 1 ;We're building NQ .INCLUDE "SRC:NI.MAC" ;Include the class handler code .SBTTL DEQNA Port Handler Edit History .ENABL LC ;+ ; ; Original version: ; ; V05 (000) 01-Nov-84 Start of coding for DEQNA port support. ; MBG Initial coding completed 3-Dec-84. Now ; testing prior to field test. ; ; V05 (001) 04-Dec-84 Various fixes regarding received frames. Changed ; MBG module name to NQ for sysgen device independance. ; Changed module assembly order. ; ; V05 (002) 05-Dec-84 Too many words being moved for address check. ; MBG Reversed order of address check for performance. ; Access to buffer address table was not accounting ; for table entry size (2 words rather than 1). ; ; V05 (003) 09-Dec-84 Received buffer length incorrectly handled. Was ; MBG using a 2 bit mask for a 3 bit field. Mask used ; was shifted by 1 bit. Also, byte length returned ; does not account for 60. bytes during initial ; incoming address filtering (hardware quirk). ; ; V05 (004) 19-Dec-84 Handler region name needs $ as fourth character. ; MBG Check added to reject installation if on a PRO. ; Transmit code not correctly accounting for transmit ; which succeeds with collisions. ; ; V05 (005) 09-Jan-84 Added code to use station's physical address if ; MBG the source field was zero in a transmit. ; ; V05 (006) 11-Jan-84 If received frame did not end on a word boundary, ; MBG the final byte was being lost. ; ; V05 (007) 16-Jan-85 SET NQ SHOW was causing trap to 4 if DEQNA hardware ; MBG not installed. ; ; V05 (008) 07-Feb-85 Extended memory region is private. Receive ; MBG buffers are now maximum size. Fixed conditional ; which checks for minimum number of receive buffers. ; Enhanced code which processes 'receive list invalid'. ; ; V05 (009) 04-Mar-85 Changes to receive code to return received frame ; MBG length as well as truncation error if user's buffer ; is too short. In order to keep transmit and receive ; symmetric, transmit had to change to add a reserved ; word following the status word and before the frame. ; ; V05 (010) 06-Mar-85 Coding problem in NQOINT, using wrong register to ; MBG access queue element. Also, PAR wrapping problems ; occurred if user buffer started within 4 of end of ; 32-word chunk. ; ; V05 (011) 11-Apr-85 Added transmit watchdog code due to DEQNA hardware ; MBG problem. (transmit during receive collision, phase ; of moon, etc.) ; ; V05 (012) 23-Sep-85 Change of reference to 176 to INSCSR. Added NOP ; MBG to SHOW code for processors which trap late. ; ; V05 (014) 10-Jan-86 Added code to check number of multicast addresses ; MBG in use and report an error if too many for DEQNA. ; Also added use of table size definitions from ; class handler. ; ; V05 (015) 10-Jul-86 Added save/restore of some registers in the ; MBG watchdog timer completion routine. ; ; V05 (016) 24-Apr-89 Added code to ensure removal of global region prior ; MBG to creation. ; ; ; V05 (017) 29-Jan-90 Added definitions for DELQA and SET code to ; MBG report DEQNA vs DELQA ; ; V05 (019) 14-Nov-90 Performance enhancement - Determine address of ; MBG RMON Block Move routine during INIT rather than ; on each received packet. ; ; (020) 24-Aug-91 MBG Performance enhancement - multicast address ; scan need not be done if frame destination is ; not a multicast address. Corrected bug in ; transmit interrupt processing, base transmit ; completion on transmit list invalid instead of ; on descriptor completion. ; ; (016) 2-Jan-97 ARB Add special functions: ; spfun 206 - frame queueing ; spfun 207 - physical ethernet address ; spfun 210 - handler status block ; ;- .SBTTL DEQNA Port Handler Definitions ; Now set the audit trail .AUDIT .NI ;Class handler .AUDIT .NQ ;Port handler ; RT-11 MACROS we're going to use .MCALL .ADDR, .BR .MCALL .INTEN, .FORK .MCALL .TIMIO, .CTIMI .MCALL .READC ; Extended memory region RBCNT = 6. ;Number of receive buffers to allocate BUFSZ =: 1600. ;Size of buffers (bytes) IATSZ =: <14.*UA.ESZ> ;Size of intermediate address table SETSZ =: 200 ;Size of setup buffer (bytes) EMEMSZ = <<+IATSZ+SETSZ>/2+>/KTGRAN .Assume RBCNT GE 2 MESSAGE= ; Feature tests .IIF NDF NQ$WDT NQ$WDT = 0 ;Default watchdog code to disabled ; Timer queue element offsets C.JNUM =: 6 ;Job number C.COMP =: 14 ;Completion routine ; Define some local macros .MACRO BEQ. DST,?LOC BNE LOC JMP DST LOC: .ENDM ;BEQ. .MACRO BNE. DST,?LOC BEQ LOC JMP DST LOC: .ENDM ;BNE. ; Miscellaneous definitions BLOCK0 =: 0 ;Block 0 bias (overlays) BLOCK1 =: 1000 ;Block 1 bias (overlays) .SBTTL DEQNA Port Handler Device Definitions ; Device Control/Status register offsets (from device register base) QN$SAR =: 0 ;Station address prom QN$RAL =: 4 ;Receive BDL address lo QN$RAH =: 6 ;Receive BDL address hi QN$TAL =: 10 ;Transmit BDL address lo QN$TAH =: 12 ;Transmit BDL address hi QN$VEC =: 14 ;Vector address QN$CSR =: 16 ;Control/Status register ; Control/Status register bit definitions CS.RI =: 100000 ;Receive interrupt request (done) ; 040000 ;reserved CS.CA =: 020000 ;Carrier CS.OK =: 010000 ;Fuse ok ; 004000 ;reserved CS.SE =: 002000 ;Sanity timer enable CS.EL =: 001000 ;External loopback enable CS.ILD =: 000400 ;Internal loopback disable CS.XI =: 000200 ;Transmit interrupt request (done) CS.IE =: 000100 ;Interrupt enable CS.RLI =: 000040 ;Receive list invalid CS.XLI =: 000020 ;Transmit list invalid CS.BD =: 000010 ;Boot/Diagnostic ROM dump CS.NXM =: 000004 ;Non-existent memory interrupt CS.SR =: 000002 ;Software reset CS.REN =: 000001 ;Receiver enable ; Vector register bit definitions (Added for DELQA) VC.MS =: 100000 ;Mode select (0 = QNA, 1 = LQA) VC.OS =: 040000 ;Remote boot option switch VC.RS =: 020000 ;Request self-test VC.SS =: 016000 ;Self-test status mask VC.IV =: 001774 ;Interrupt vector mask ; =: 000002 ;reserved VC.ID =: 000001 ;Identity test bit (0 = QNA, 1 = LQA) ; Miscellaneous definitions MAXMLT =: 14. ;Multicast address list maximum .SBTTL DEQNA Port Handler Data Structure Definitions ; Buffer Descriptor List (BDL) format BD.FLG =: 0 ;Flag BD.ADH =: 2 ;Address descriptor bits (hi-order) BD.ADL =: 4 ;Address descriptor bits (lo-order) BD.LEN =: 6 ;Buffer length BD.SW1 =: 10 ;Status word 1 BD.SW2 =: 12 ;Status word 2 BD.ESZ =: 14 ;Size of a buffer descriptor ; Flag word bit definitions FL.INI =: 100000 ;Initialization value FL.USE =: 040000 ;DEQNA is using the buffer ; Address descriptor bit definitions AH.VLD =: 100000 ;Descriptor is valid AH.CHN =: 040000 ;Chain descriptor AH.EOM =: 020000 ;End of message (xmit only) AH.SET =: 010000 ;Setup (xmit only) AH.TER =: 000200 ;Lo byte only termination (xmit only) AH.STA =: 000100 ;Hi byte only start (xmit only) AH.HOM =: 000077 ;Hi-order mask ; Status word 1 bit definitions S1.LN =: 100000 ;Last/Not S1.ERU =: 040000 ;Error/Used ; for Transmit ; 020000 ;reserved S1.LOC =: 010000 ;Loss of carrier S1.NOC =: 004000 ;No carrier S1.STE =: 002000 ;Sanity timer was enabled at power-up S1.ABO =: 001000 ;Transmission was aborted S1.FAI =: 000400 ;Heartbeat collision check failure S1.CCM =: 000360 ;Collision count mask ; 000017 ;reserved ; for Receive S1.ESE =: 020000 ;Setup, ELOOP, IELOOP packet S1.DIS =: 010000 ;Discard (OR of OVF, CRCERR, SHORT) S1.RNT =: 004000 ;Packet is a RUNT S1.RBL =: 003400 ;Receive buffer length <10:08> ; 000370 ;reserved S1.FE =: 000004 ;Framing error S1.CRC =: 000002 ;CRC error S1.OV =: 000001 ;Overflow ; Status word 2 bit definitions ; for Transmit, bits <13:00> contain the time domain reflectometer ; 100 ns resolution count. ; for Receive, bits <07:00> contain bits <07:00> of the receive byte ; length. Bits <10:08> are obtained from status word 1 <10:08>. .SBTTL DEQNA Port Handler Installation Code .ENABL LSB .DRINS NI BR 10$ ;Non-system device installation BR O.BAD ;System device installation 10$: MOV @#SYSPTR,R0 ;R0 -> $RMON BIT #PROS$,CONFG2(R0) ;Running on a PRO? BNE O.BAD ;Yep, so reject installation MOV INSCSR,R0 ;R0 -> DEQNA device register base BIC #CS.SE,QN$CSR(R0) ;Disable sanity timer BIT #CS.OK,QN$CSR(R0) ;Check fuse status BEQ O.BAD ;Apparently blown, disable device ; Now we allocate a region in extended memory for our use MOV @#SYSPTR,R1 ;R1 -> $RMON MOV P1EXT(R1),R0 ;R0 -> PAR1 Externalization routine 20$: .ADDR #NQNAME,R5 ;R5 -> Region name to search for CALL FINDGR(R0) ;Check for existing region BCS 30$ ;None exists, try to create it MOV R1,-(SP) ;Save pointer to RCB BIT #GR.NRF,GR.STA(R1) ;Return memory to free list? BNE 25$ ;Nope... MOV GR.SIZ(R1),R2 ;R2 = Size of region to deallocate MOV GR.ADR(R1),R1 ;R1 -> Region CALL XDEALC(R0) ;Deallocate the region 25$: CLR @(SP)+ ; and free the RCB (size = 0) BR 20$ ;Loop until region not found 30$: MOV R1,R5 ;R5 -> Slot BEQ O.BAD ;None available, reject installation MOV (PC)+,R2 ;R2 = Size of extended memory needed NIXSIZ: .WORD EMEMSZ ; : Size of region to allocate CALL XALLOC(R0) ;Go allocate the space BCS O.BAD ;Couldn't, reject installation MOV R2,(R5)+ ;Build RCB (size) MOV R1,(R5)+ ; (address) MOV #GR.PVT,(R5)+ ; (status) MOV NQNAME,(R5)+ ; (name, first word) MOV NQNAME+2,@R5 ; (name, second word) BR O.GOOD NQNAME: .WORD NI$HND .RAD50 /$ / .DSABL LSB .Assume . LE 400 MESSAGE= .SBTTL DEQNA Port Handler Set Code .DRSET CSR, 160000, O.CSR, OCT .DRSET VECTOR, 500, O.VEC, OCT .DRSET SHOW, O.SHOW/2, GETOVR ; SET NI CSR=octal_address O.CSR: CMP R0,R3 ;Valid CSR address? BLO O.BAD ;Nope, reject the selection MOV R0,INSCSR ;Set the install-time and MOV R0,DISCSR ; display-time CSR's MOV R0,NICSR ;Let the handler know about it O.GOOD: TST (PC)+ ;Good return (c-bit = 0) O.BAD: SEC ;Error return (c-bit = 1) RETURN ; SET NI VECTOR=octal_vector O.VEC: CMP R0,R3 ;Valid VECTOR address? BHIS O.BAD ;Nope, reject the selection MOV R0,NISTRT ;Set the install-time vector MOV R0,NIVEC ;Let the handler know about it BR O.GOOD .SBTTL DEQNA Port handler Set/Install code overlay handler ;+ ; ; GETOVR ; The general purpose overlay handler for Install and Set code. ; Reads the block containing the desired routine and dispatches ; to it via the appropriate entry point. ; ; CALL: ; R3 = address/2 of routine to execute ; ; GETBK1 ; Used to reload the overlayed block1 code. ; ; ** Note ** ; The blocks read by these routines overlay the block1 handler ; code. ; ;- .ENABL LSB GETBK1: MOV #O.EXIT/2,R3 ;Fake GETOVR into executing O.EXIT SWAB R3 MOV #1,SEMTBK ; after reloading block1 BR 5$ GETOVR: CMPB -(R3),-(R3) ;Preadjust R3 for 'NO' adjust NOP ; : filler .ASSUME . EQ GETOVR+4 <;NO entry out of place> CMPB (R3)+,(R3)+ ;Adjust for 'NO' entry point SWAB R3 ;Determine block of overlay MOVB R3,SEMTBK ;Set the block number to read 5$: HNDBLK =: .+2 ADD #.-.,SEMTBK ;Add bias to base of handler file .ADDR #BLOCK1,R5,PUSH ;R5 -> Buffer for overlay MOV R5,SEMTBF ;Set the buffer address MOV (SP)+,R5 ;Restore R5 JSR R0,10$ ;Save R0, R0 -> EMT block SEMTCH: .BYTE 17 ; : Channel SEMTFN: .BYTE 10 ; : Function (read) SEMTBK: .BLKW ; : Block number SEMTBF: .BLKW ; : Buffer address .WORD 256. ; : Word count .WORD 0 ; : Wait-mode I/O 10$: .READC CODE=NOSET ;*** .READW *** MOV (SP)+,R0 ;*C* Restore R0 BCS O.ERR ;In case of error... CLRB R3 ;Reset block, offset in high byte SWAB R3 ;R3 = Word offset to overlay code ASL R3 ;R3 = Byte offset to overlay code ADD SEMTBF,R3 ;R3 -> Overlay code ; *** kludge? *** CMP SEMTBK,#1 ;Did we just restore block 1? BNE 20$ ;Nope, a real overlay ADD #,R3 ;Routine to execute is in block 0 20$: ;*** end kludge? *** JMP @R3 ;Dispatch to routine .DSABL LSB ; Common exit for everyone (including overlays) O.NORM: TST (PC)+ ;Normal return, carry clear O.ERR: SEC ;Error return, carry set RETURN O.EXIT: ROR R2 ;Restore carry from R2 RETURN .Assume . LE 1000 MESSAGE= .SBTTL LOAD - DEQNA Port Handler LOAD Code .SBTTL UNLOAD - DEQNA Port Handler UNLOAD code ;+ ; ; LOAD/UNLOAD ; The DEQNA/DELQA has nothing port-specific that is done at ; this time, this is simply a stub. ; ;- .PSECT SETOVR LOAD:: UNLOAD:: CLC ;Ensure success RETURN .Assume <. - LODOVR> LE 1000 MESSAGE= .SBTTL INIT - OnceOnly Initialization Code ;+ ; ; INIT ; Performs a software reset on the controller. It then saves ; the controllers' ethernet physical address. ; ;- .PSECT NIDVR INIT: MOV NICSR,R0 ;R0 -> DEQNA device register base BIS #CS.SR,QN$CSR(R0) ;Reset = TRUE BIC #CS.SR,QN$CSR(R0) ;Reset = FALSE ; Now we save the physical address MOV NIVEC,QN$VEC(R0) ;Set the vector address .ADDR #NIPHAD,R1 ;R1 -> Physical address MOV #6.,R2 ;R2 = Count 10$: MOV (R0)+,-(SP) ;Get a byte of the physical address MOVB (SP)+,(R1)+ ;Save it DEC R2 ;More to move? BGT 10$ ;Yep... MOV @#SYSPTR,R0 ;R0 -> $RMON MOV P1EXT(R0),R0 ;R0 -> PAR1 externalization routine ADD #BLKMOV,R0 ;R0 -> Block Move routine MOV R0,$BLKMV ;Save it for later... CLC ;Indicate 'channel' is on RETURN .SBTTL RESRNG - Reset Receive Ring Structure ;+ ; ; RESRNG ; [re]Builds the structures which define the status and location ; of the receive buffers to be used by the DEQNA. It then gives ; the address of the head of the chain to the DEQNA. ; ; There is one more descriptor than there are buffers. This last ; descriptor is used to chain back to the first descriptor, producing ; a ring of buffer descriptors. ; ; The last non-chaining descriptor is marked as invalid to prevent the ; DEQNA from overwriting buffers before they may be processed. ; ;- .PSECT NIDVR RESRNG: CALL SAV30 ;Save some registers .ADDR #RCVBDL,R1 ;R1 -> Receive buffer descriptor list .ADDR #BUFADR,R2 ;R2 -> Address/Par table for buffers CLR RCVIDX ;Reset descriptor index MOV #RBCNT,R3 ;R3 = Count of buffers .ADDR #FQELEM,R4 ;R4 -> Fake queue element (at Q$BLKN) MOV #20000,Q$BUFF(R4) ;Start with beginning of MOV NIXADR,Q$PAR(R4) ; PAR1 using base of extended region MOV R1,-(SP) ;Save pointer to first descriptor BR 20$ 10$: ADD #BD.ESZ,R1 ;On to next buffer descriptor 20$: MOV Q$BUFF(R4),(R2)+ ;Save address MOV Q$PAR(R4),(R2)+ ; and PAR1 bias for this buffer .ASSUME BD.FLG EQ 0 MOV #FL.INI,(R1) ;Initialized value, using = FALSE MOV R4,R5 ;Make a copy where MPPHY wants it ADD #Q$BUFF-Q$BLKN,R5 ;Adjust pointer for use by MPPHY CALL @$MPPTR ;Convert to physical address MOV (SP)+,BD.ADL(R1) ;Set the lo-order buffer address MOV (SP)+,R0 ;R0 = Hi-order address (shifted) ASH #-4,R0 ;Shift <09:04> to <05:00> BIC #^C,R0 ;Mask off anything else BIS #AH.VLD,R0 ;Address descriptor valid = TRUE MOV R0,BD.ADH(R1) ;Place it in the descriptor MOV #-,BD.LEN(R1) ;Set the buffer size MOV #S1.LN,BD.SW1(R1) ;Status 1 = not using MOV #S1.LN,BD.SW2(R1) ;Status 2 = unequal bytes ADD #BUFSZ,Q$BUFF(R4) ;On to next buffer CALL FIXPAR ;Ensure correct values in qelement DEC R3 ;More descriptors to do? BGT 10$ ;Yes... MOV Q$BUFF(R4),(R2)+ ;Save address MOV Q$PAR(R4),(R2)+ ; and PAR bias for setup buffer MOV R1,RCVINV ;Save pointer to last descriptor BIC #AH.VLD,BD.ADH(R1) ;Address descriptor valid = FALSE ADD #BD.ESZ,R1 ;Onwards to chaining descriptor MOV (SP)+,BD.ADL(R1) ;Which chains to first one CLR BD.ADH(R1) .ASSUME BD.FLG EQ 0 MOV #FL.INI,(R1)+ ;Initialized value, using = FALSE .ASSUME BD.ADH EQ 2 BIS #,(R1) ;Valid = TRUE, Chain = TRUE MOV NICSR,R0 ;R0 -> DEQNA device register base CALL GETADR ;Get address of buffer descriptor ; at head of chain ; *** ACTION *** Save/set priority around this? MOV R1,QN$RAL(R0) ;Set the address descriptor list CLR QN$RAH(R0) ; address BIS #,QN$CSR(R0) ;Enable interrupts and disable ; internal loopback RETURN .SBTTL ENABLE - Enable Interrupts ;+ ; ; ENABLE ; Entered as a result of the first OPEN PORTAL request. Sets ; the receive buffer descriptor list address to the DEQNA. ; Enables interrupts and disables internal loopback. ; ;- .PSECT NIDVR ENABLE: CALL RESRNG ;Build the receive list MOV #-1,XMITFG ;Ensure transmit MOV #-1,RECVFG ; and receive processes are available CALL SETUP ;Do first-time address filter setup CLC ;Indicate channel is now on RETURN .SBTTL SETUP - Update Address Filtering Table ;+ ; ; SETUP ; Called whenever the unit address table (NIUAT) changes. Builds ; a setup packet in the handler extended region and falls through ; to SNDSET to have it sent to the hardware. ; ;- .PSECT NIDVR SETUP: CALL SAV30 ;Save some registers CALL SAVPAR ;Save PAR1 mapping ; First, we preset the table with our physical address MOV SETADR+2,@#KISAR1 ;Map PAR1 to the SETUP packet area MOV SETADR,R1 ;R1 -> Place to build address table MOV #MAXMLT,R2 ;R2 = Count of addresses to preset 10$: .ADDR #NIPHAD,R0 ;R0 -> Physical address MOV (R0)+,(R1)+ ;Store the address MOV (R0)+,(R1)+ MOV (R0)+,(R1)+ DEC R2 ;More to do? BGT 10$ ;Yep... ; We must also respond to the broadcast address, make that the second ; entry in the table. ADD #,R1 ;Back up to broadcast address entry MOV (R0)+,(R1)+ ;Place it in the table MOV (R0)+,(R1)+ MOV (R0)+,(R1)+ ; Now we move the multicast addresses enabled for each unit into ; the table. MOV #UA.TSZ,R2 ;Count of address entries in NIUAT CLR R3 ;Reset multicast address list count 20$: MOV (R0)+,-(SP) ;Is this entry filled? BIS (R0)+,(SP) BIS (R0)+,(SP)+ ;(R0 -> Next entry) BEQ 30$ ;Entry not filled... SUB #UA.ESZ,R0 ;Back up pointer to start of entry MOV (R0)+,(R1)+ ;And move it to the table MOV (R0)+,(R1)+ MOV (R0)+,(R1)+ ;(R0 -> Next entry) INC R3 ;Count it CMP R3,#MAXMLT ;Too many addresses for this device? BLE 30$ ;Nope... SEC ;Yes, return error to class handler RETURN 30$: DEC R2 ;More to do? BGT 20$ ;Yep... ; Now we build the actual SETUP packet which the DEQNA wants to see MOV SETADR,R0 ;R0 -> Table just built MOV R0,R1 ;Make a copy ADD #IATSZ,R1 ;R1 -> SETUP table to be built MOV #2.,R3 ;R3 = in 2 halves 40$: MOV #7.,R2 ;R2 = Addresses to load per half 50$: INC R1 MOVB (R0)+,(R1) ;Load an address MOVB (R0)+,10(R1) MOVB (R0)+,20(R1) MOVB (R0)+,30(R1) MOVB (R0)+,40(R1) MOVB (R0)+,50(R1) DEC R2 ;More in this half to do? BGT 50$ ;Yes... ADD #71,R1 ;Skip to setup packet start+100 DEC R3 ;Done with first half? BGT 40$ ;Yes, do it again for second .BR SNDSET .SBTTL SNDSET - Build and Send SETUP Packet ;+ ; ; SNDSET ; Used to send the address filtering table to the DEQNA. Entered ; by falling through from SETUP, above. ; ;- SNDSET: MOV SP,SETUFG ;Set 'SETUP packet ready' flag INC XMITFG ;Allocate the transmit process BNE 20$ ;Can't, already in use .ADDR #FQELEM,R4 ;R4 -> Fake queue element MOV SETADR,Q$BUFF(R4) ;Set the setup packet address ADD #IATSZ,Q$BUFF(R4) MOV SETADR+2,Q$PAR(R4) ; and the PAR1 bias CALL FIXPAR ;Normalize the address/par info MOV #SETSZ,R5 ;R5 = SETUP packet size ; *** ACTION *** All multicast goes here ;;; BIS #1,R5 TST NIPMFG ;Promiscuous mode? BEQ 10$ ;Nope... BIS #2,R5 ;Yes, set it 10$: ; *** ACTION *** Led display goes here ;;; BIS #14,R5 ; *** ACTION *** Sanity timer value goes here ;;; BIS #160,R5 ASR R5 ;Convert from byte to word count MOV R5,Q$WCNT(R4) ;Place size in queue element CALLR XMTCOM ;Jump to common transmit code 20$: RETURN .SBTTL DISABL - Disable Interrupts ;+ ; ; DISABL ; Entered as a result of the last CLOSE PORTAL request. Disables ; interrupts and enables internal loopback. ; ;- .PSECT NIDVR DISABL: CALL SAV30 ;Save some registers MOV NICSR,R0 ;R0 -> DEQNA device register base BIC #,QN$CSR(R0) ;Disable interrupts, ; enable internal loopback and ; turn off the receiver .IF NE TIM$IT .IF NE NQ$WDT CALL CTIMER ;Cancel any outstanding timer .ENDC ;NE NQ$WDT .ENDC ;NE TIM$IT RETURN .SBTTL NQABRT - Port Handler Abort Code ;+ ; ; NQABRT ; Entered via job abort or HRESET. Performs port-related abort ; and then calls the class handler abort code. ; ; CALL: ; R4 = Aborting job number ; ;- .PSECT NIDVR NQABRT: .IF NE TIM$IT .IF NE NQ$WDT MOV R5,-(SP) MOV NIOCQE,R5 ;R5 -> Current transmit qelement BEQ 10$ ;None in progress... MOVB Q$JNUM(R5),-(SP) ;Get job/unit number BIC #^C,(SP) ;Strip to job number ASR (SP) ;Shift right for ASR (SP) ; test against aborting job ASR (SP) CMPB R4,(SP)+ ;This element's job aborting? BNE 10$ ;Nope... CALL CTIMER ;Yes, cancel any outstanding timer 10$: MOV (SP)+,R5 .ENDC ;NE NQ$WDT .ENDC ;NE TIM$IT CALLR NIABRT ;Pass control to class handler .SBTTL NIINT - Interrupt Entry Point ;+ ; ; NIINT ; Interrupt entry point. Determines what interrupt occurred ; and dispatches to the appropriate routine. ; ; Interrupts are caused when: ; 1) A frame has been received and the receive status has been ; placed in a receive buffer descriptor. ; 2) A packet has been transmitted and the transmit status has ; been placed in the transmit buffer descriptor. ; ; Dispatches with: ; R4 = CSR contents ; R5 -> DEQNA device base register ; ;- .PSECT NIDVR .DRAST NI,NI$PRI,NQABRT MOV NICSR,R5 ;R5 -> DEQNA device register base ADD #QN$CSR,R5 ;R5 -> DEQNA CSR MOV @R5,R4 ;R4 = Register contents MOV R5,-(SP) ;Save pointer to register MOV R4,-(SP) ; and contents BIT #CS.RI,@SP ;Did we receive something? BEQ 10$ ;Nope... ADD #1,NIIPKT+2 ;Count interrupt ;021 ADC NIIPKT ;021 CALL NQIINT ;Yes, go handle what's available 10$: BIT #CS.XLI,@SP ;Did a transmit complete? BEQ 20$ ;Nope... ADD #1,NIOPKT+2 ;Count interrupt ;021 ADC NIOPKT ;021 CALL NQOINT ;Yes, go complete the request CALL XMIT ; and try to transmit something else 20$: MOV (SP)+,@(SP)+ ;Write back to clear interrupt RETURN .SBTTL NQIINT - Routine to Process Receive Interrupts ;+ ; ; NQIINT ; Entered from interrupt dispatcher. Called to process any ; ethernet frames which have been received. ; ; RECV ; Entered from I/O initialization level after a new receive ; request has been placed on the internal receive queue. ; ; Algorithm for processing received frames: ; ; 1) Determine next buffer to process using descriptor chain ; index, RCVIDX. ; 2) Use address/par info from corresponding entry in BUFADR ; to access extended memory buffer. ; 3) Extract protocol from buffer. ; 4) Scan NIUPT for matching protocol. If none, skip to step ; 8. ; 4.1) Extract destination address from buffer. ; 4.2) Usint index into NIUPT as index into NIUAT, check if ; unit wishes to receive packets with destination address. ; If not, skip to step 8. ; 5) Using index into NIUPT as index into NIUOT, retrieve the ; JOB/UNIT byte. ; 6) Scan the internal receive queue, NIICQE, for the first ; queue element with the same JOB/UNIT byte. If none, skip ; to step 8. ; 7) BLKMOV (using MIN of length requested and length available) ; from extended memory buffer to user's buffer. ; 8) Mark this buffer descriptor as invalid (keeping an end to ; the chain), mark the invalid descriptor as valid and save ; a pointer to the new invalid descriptor. ; 9) Do steps 1-8 again. ; ;- .PSECT NIDVR .ENABL LSB NQIINT: TST NIQCHG ;Is queue being altered? BNE. 190$ ;Yes, defer processing until later RECV: INC RECVFG ;Allocate the receive process BNE. 190$ ;Can't, someone else has it CALL SAV30 ;We need some scratch registers CALL SAVPAR ;We'll be using PAR1 to map to things 10$: CALL GETADR ;Get address of buffer descriptor .ASSUME BD.FLG EQ 0 BIT #FL.USE,(R1) ;Has this descriptor been used? BEQ. 170$ ;Nope... BIT #S1.LN,BD.SW1(R1) ;Last or not used? BEQ 30$ ;Last... BIT #S1.ERU,BD.SW1(R1) ;Not used or used with errors? BEQ. 170$ ;Not used... 20$: CMPB BD.SW2(R1),BD.SW2+1(R1) ;Errors, is DEQNA done with it? BEQ 30$ ;Yes... ;021 21$: DEC RECVFG ;If there is another frame ;021 BPL 10$ ;to process then loop ;021 JMP 170$ ;Nope... ;021 22$: TST NIQUEF ;Donot throw away frames ;021 BNE 21$ ;if frame queueing is enabled ;021 JMP 140$ ;021 ; We get here once we've identified a buffer which the DEQNA has filled 30$: BIT #,BD.SW1(R1) ;Received with errors, or ; SETUP, ELOOP, or IELOOP packet? BNE. 140$ ;Yes, requeue it ; Now we have a packet which is good MOV NIICQE,R4 ;Are there any pending receives? BEQ 22$ ;Nope, check frame queueing ;021 TST NIPMFG ;Promiscuous mode? BNE 120$ ;Yes, don't do protocol/address checks MOV RCVIDX,R2 ;R2 = BDL entry index ASL R2 ;R2 = Offset into BUFADR ASL R2 ; (BUFADR entries are two words) .ADDR #BUFADR,R2,ADD ;R2 -> BUFADR entry for this buffer MOV (R2)+,R0 ;R0 -> Received buffer in handler MOV (R2)+,@#KISAR1 ; extended region ; Does someone at this station desire a packet with this protocol .ADDR #NIUPT,R3 ;R3 -> Unit protocol table MOV R3,-(SP) ;Save the base address for later MOV #UP.TSZ,R2 ;R2 = Count of units to check 40$: .Assume UO.ESZ EQ UP.ESZ TST NIUOT-NIUPT(R3) ;Is this unit open? BEQ 45$ ;Nope... CMP EF.TYP(R0),(R3) ;Does this unit want it? BEQ 50$ ;Yes... 45$: TST (R3)+ ;Nope, on to the next one DEC R2 ;More units to check? BGT 40$ ;Yep... TST (SP)+ ;Nope, discard protocol table address JMP 140$ ;No one wants it, ;021 ; so requeue buffer ;021 50$: MOV R3,R2 ;R2 -> Entry in protocol table SUB (SP)+,R3 ;R3 = Protocol table offset .Assume UP.ESZ EQ 2 ASR R3 ;R3 = Table entry .Assume UO.ESZ EQ UP.ESZ ADD #NIUOT-NIUPT,R2 ;R2 -> Corresponding entry in NIUOT .Assume UO.JOB EQ 0 .Assume UO.OFG EQ 1 TST (R2) ;But is the unit open? BEQ. 140$ ;Nope (?!), requeue packet ;036 BIT #1,EF.DST(R0) ;Multicast address? BEQ 100$ ;Nope, then bypass multicast check .ADDR #NQADDR,R4 ;R4 -> Address check table MOV R4,-(SP) ;Save its address MOV R3,-(SP) ;Save table entry for awhile .ADDR #NIPHAD,R3 ;R3 -> Physical address MOV #*2,R5 ;R5 = Count of words to move ; (Physical and broadcast addresses) 60$: MOV (R3)+,(R4)+ ;Move a word of address DEC R5 ;More to move? BGT 60$ ;Yes... MOV (SP)+,R3 ;R3 = Table entry MUL #UA.ESZ,R3 ;R3 = Address table offset .ADDR #NIUAT,R3,ADD ;R3 -> Address table entry MOV #,R5 ;R5 = Count of words to move ; (Multicast address) 70$: MOV (R3)+,(R4)+ ;Move a word of address DEC R5 ;More to move? BGT 70$ ;Yep... MOV (SP)+,R3 ;R3 -> Base of address check table MOV #3,R4 ;Count of addresses to check ; (Physical, broadcast, multicast) 80$: CMP EF.DST+4(R0),4(R3) ;Match in the low-order address word? BNE 90$ ;Nope... CMP EF.DST+2(R0),2(R3) ;Hope about in the middle word? BNE 90$ ;Nope... .Assume EF.DST EQ 0 CMP (R0),(R3) ;How about the high-order word? BEQ 100$ ;Yep... 90$: ADD #UA.ESZ,R3 ;Nope, on to the next address DEC R4 ;More addresses to check? BGT 80$ ;Yep... BR 140$ ;Nope, requeue the buffer 100$: .ADDR #NIICQE-Q$LINK,R4 ;Set to check internal receive queue 110$: MOV Q$LINK(R4),R4 ;Follow link to next qelement BEQ 22$ ;None - check frame queueing ;021 CMPB (R2),Q$UNIT(R4) ;Should we return buffer to this job? BNE 110$ ;Nope, not the one 120$: MOV BD.SW1(R1),-(SP) ;Get status word one contents BIC #^C<3400>,(SP) ;Strip to RBL<10:08> CLR R5 BISB BD.SW2(R1),R5 ;R5 = RBL<07:00> BIS (SP)+,R5 ;Reconstitute the received frame size ADD #60.,R5 ;Account for bytes not counted during ; address filtering (hardware quirk) MOV R5,-(SP) ;Set to return actual frame length ADD #2,Q$BUFF(R4) ; in word following status word CALL @$PTWRD ;Return it SUB #4,Q$BUFF(R4) ;Correct altered BUFF pointer CALL FIXPAR ;Ensure correct values in qelement INC R5 ;In case of odd-sized frame... ASR R5 ;Convert from byte to word count MOV Q$WCNT(R4),R2 ;R2 = Requested length SUB #2,R2 ;Don't count status and size words CMP R5,R2 ;Enough room for entire frame? BLE 130$ ;Yes... MOV #RC.TRU,-(SP) ;Nope, code = 'Truncation' CALL @$PTWRD SUB #2,Q$BUFF(R4) ;Correct altered BUFF pointer CALL FIXPAR ;Ensure correct values in qelement BIS #HDERR$,@Q$CSW(R4) ;Set the error bit MOV R2,R5 ;And use what is available 130$: MOV RCVIDX,R2 ;R2 = BDL entry index ASL R2 ASL R2 ;R2 = Offset to BUFADR entry .ADDR #BUFADR,R2,ADD ;R2 -> BUFADR entry for this buffer MOV 2(R2),R1 ;R1 = Ethernet buffer PAR1 MOV (R2),R2 ;R2 = Ethernet buffer offset MOV Q$PAR(R4),R3 ;R3 = User's buffer PAR1 MOV R4,-(SP) ;Save qelement pointer MOV Q$BUFF(R4),R4 ;R4 = User's buffer offset ADD #4,R4 ; (accounting for status and frame ; length words) CALL @$BLKMV ;Let the monitor move the data MOV (SP)+,R4 ;R4 -> Qelement which just completed MOVB Q$UNIT(R4),R0 ;Update stats ;021 BIC #^C,R0 ;021 ASL R0 ;021 ASL R0 ;021 .ADDR #NIRUN0,R0,ADD ;021 ADD #1,2(R0) ;021 ADC (R0) ;021 CALL NIIDEQ ;Dequeue it and return it to RT ; with our blessing ; We come here to requeue a buffer which we have finished processing 140$: CALL GETADR ;Get address of buffer descriptor .Assume BD.FLG EQ 0 MOV #FL.INI,(R1) ;Initialize it BIC #AH.VLD,BD.ADH(R1) ;But mark it as invalid MOV #S1.LN,BD.SW1(R1) ;Status word 1 = not using MOV #S1.LN,BD.SW2(R1) ;Status word 2 = unequal bytes MOV RCVINV,R3 ;R3 -> Invalid descriptor BIS #AH.VLD,BD.ADH(R3) ;Make it valid 150$: MOV R1,RCVINV ;Save new invalid descriptor pointer MOV RCVIDX,R1 ;R1 = Buffer descriptor index INC R1 ;RCVIDX = RCVIDX+1 mod RBCNT CMP R1,#RBCNT BLT 160$ SUB #RBCNT,R1 160$: MOV R1,RCVIDX ;Save new buffer descriptor index JMP 10$ ;Now process another buffer ; Here when we have processed the available buffers 170$: MOV #-1,RECVFG ;Deallocate the receive process MOV @#PSW,-(SP) ;Save current priority BIS #340,@#PSW ;Raise priority for the following MOV NICSR,R0 ;;;R0 -> DEQNA device register base BIT #CS.RLI,QN$CSR(R0) ;;;Receive list go invalid? BEQ 180$ ;;;Nope... CALL GETADR ;;;Get pointer to current descriptor MOV R1,QN$RAL(R0) ;;; and give the DEQNA a valid ring CLR QN$RAH(R0) ;;; to get the receiver going again 180$: MOV (SP)+,@#PSW ;;;Return priority to what it was 190$: RETURN .DSABL LSB .SBTTL GETADR - Get Buffer Descriptor Address ;+ ; ; GETADR ; Determines the address of the buffer descriptor at the current ; head of the chain of buffer descriptors. ; ; IMPLICIT INPUT: ; RCVIDX = index into buffer descriptor list of head of chain ; ; RETURNS: ; R1 -> Buffer descriptor ; ;- GETADR: MOV RCVIDX,R1 ;R0 = Buffer descriptor index MUL #BD.ESZ,R1 ;R1 = Descriptor offset .ADDR #RCVBDL,R1,ADD ;R1 -> Buffer descriptor RETURN .SBTTL NQOINT - Routine to Process Transmit Interrupts ;+ ; ; NQOINT ; Entered from interrupt dispatcher. Called when transmit ; request has completed. ; ; XMIT ; Entered from DRBEG level after a new queue element has been ; placed on the internal queue. ; ; XMTCOM ; Entered from SNDSET to have a SETUP packet sent to the ; DEQNA board. ; ;- .PSECT NIDVR .ENABL LSB NQOINT: CALL SAV30 ;Save some registers .ADDR #XMTBDL,R5 ;R5 -> Transmit buffer descriptor .IF NE TIM$IT .IF NE NQ$WDT CALL CTIMER ;Cancel any outstanding timer .ENDC ;NE NQ$WDT .ENDC ;NE TIM$IT MOV #-1,XMITFG ;Deallocate the transmit process BIT #AH.SET,BD.ADH(R5) ;Was it a SETUP packet? BNE 70$ ;Yes, then no one to respond to ; A transmission aborted twice with the same TDR value indicates ; a possible open or short in the cable. ;;; BIT #S1.ABO,BD.SW1(R5) ;Transmit aborted? ;;; BEQ 20$ ;Nope... ; *** ACTION *** Keep track of TDR values for comparison ; *** ACTION *** Hook for error logging ; To report possible open/short circuit 20$: MOV NIOCQE,R4 ;R4 -> Current queue element BEQ 70$ ;None (?!), then transmit something... MOV Q$LINK(R4),NIOCQE ;Link the internal queue forward CLR Q$LINK(R4) ;This one doesn't link anywhere BIT #S1.ERU,BD.SW1(R5) ;Did the transmit fail? BEQ 65$ ;Nope... ; Here if the transmit failed ; Checks for excessive collisions and carrier check 30$: BIT #S1.ABO,BD.SW1(R5) ;Failed due to excessive collisions? BEQ 40$ ;Nope... MOV #,-(SP) ;Code = 'Transmit failed' ;Subcode = 'Excessive collisions' BR 60$ ;Use common error report code 40$: BIT #S1.NOC,BD.SW1(R5) ;No carrier? BEQ 65$ ;Nope, success with collisions MOV #,-(SP) ;Code = 'Transmit failed' ;Subcode = 'Carrier check failed' BR 60$ ;Use common error report code ; Common error reporting point ; (SP) = Status to be returned 60$: BIS #HDERR$,@Q$CSW(R4) ;Set the hard error bit CALL @$PTWRD ;Set the status ; Common request completion point ; R4 -> Queue element to be returned 65$: MOVB Q$UNIT(R4),R0 ;Update stats ;021 BIC #^C,R0 ;021 ASL R0 ;021 ASL R0 ;021 .ADDR #NIXUN0,R0,ADD ;021 ADD #1,2(R0) ;021 ADC (R0) ;021 CALL NIFIN ;Complete the request ;021 70$: RETURN ; Here we check for something to transmit, including SETUP packets XMIT: CALL SAV30 ;Save a few registers CALL SAVPAR ;Save the current PAR1 context TST SETUFG ;Is there a SETUP packet pending? BEQ 80$ ;Nope... CALLR SNDSET ;Yes, go send it 80$: TST NOQCHG ;Is queue being altered? BNE 130$ ;Yes, wait to be entered via XMIT MOV NIOCQE,R4 ;Anything queued to transmit? BEQ 130$ ;Nope... INC XMITFG ;Allocate the transmit process BNE 130$ ;Can't, already in use... TST (PC)+ ;Normal transmit, clear carry XMTCOM: SEC ;SETUP packet transmit, set carry ROL (PC)+ ;Set the local setup flag LSETFG: .WORD 0 ; : Local setup flag .ADDR #XMTBDL,R0 ;R5 -> Transmit buffer descriptor MOV R0,-(SP) ;Save a copy for later .Assume BD.FLG EQ 0 MOV #FL.INI,(R0)+ ;Initialization value TST LSETFG ;Working on a SETUP packet? BNE 90$ ;Yes, address is correct as is ADD #4,Q$BUFF(R4) ;Buffer starts with third word ; (bypass status and reserved words) CALL FIXPAR ;Ensure correct values in qelement MOV Q$PAR(R4),@#KISAR1 ;Map to the ethernet frame in MOV Q$BUFF(R4),R2 ; the user's buffer using PAR1 ADD #EF.SRC,R2 ;R2 -> Ethernet source address field MOV (R2),-(SP) ;Has source been specified? BIS 2(R2),(SP) BIS 4(R2),(SP)+ BNE 90$ ;Yes, don't touch it... .ADDR #NIPHAD,R1 ;R1 -> Station physical address MOV (R1)+,(R2)+ ;Move the physical address into MOV (R1)+,(R2)+ ; the source field of the frame MOV (R1)+,(R2)+ ; to be transmitted 90$: MOV R4,R5 ;MPPHY uses R5 to access the qelement ADD #Q$BUFF-Q$BLKN,R5 ; and needs it pointing to Q.BUFF CALL @$MPPTR ;Convert to physical address SUB #4,Q$BUFF(R4) ;Back up to status word ;(SETUP packet not affected since it ; is using the fake queue element) CALL FIXPAR ;Ensure correct values in qelement MOV (SP)+,R2 ;R2 = Lo-order buffer address MOV (SP)+,R1 ;R1 = Hi-order buffer address ASH #-4,R1 ;Shift to where it's needed BIC #^C,R1 ;Strip to hi-order bits BIS #,R1 ;Valid, End of message TST LSETFG ;Working on a SETUP packet? BEQ 100$ ;Nope... BIS #AH.SET,R1 ;Yes, mark buffer descriptor for SETUP 100$: .Assume BD.ADH EQ 2 MOV R1,(R0)+ ;Set hi-order address descriptor .Assume BD.ADL EQ 4 MOV R2,(R0)+ ;Set lo-order address descriptor MOV Q$WCNT(R4),R1 ;R1 = Word count TST LSETFG ;Working on a SETUP packet? BNE 110$ ;Yes, size is correct as is SUB #2,R1 ;Don't count status or reserved words 110$: NEG R1 ;DEQNA wants size as 2's complement .Assume BD.LEN EQ 6 MOV R1,(R0)+ ;Set the buffer length .Assume BD.SW1 EQ 10 MOV #S1.LN,(R0)+ ;Status word = init value .Assume BD.SW2 EQ 12 CLR (R0)+ ;Status word 2 = 0 ;** End of first descriptor .Assume BD.FLG EQ 0 MOV #FL.INI,(R0)+ ;Initialization value .Assume BD.ADH EQ 2 CLR (R0) ;Valid = FALSE, Chain = FALSE TST LSETFG ;SETUP packet? BEQ 120$ ;Nope... CLR SETUFG ;Yes, reset the 'SETUP pending' flag CLR LSETFG ; and the local flag 120$: MOV (SP)+,R0 ;R0 -> Transmit buffer descriptor MOV NICSR,R1 ;R1 -> DEQNA device register base .IF NE TIM$IT .IF NE NQ$WDT CALL TIMER ;Post the watchdog timer .ENDC ;NE NQ$WDT .ENDC ;NE TIM$IT ; *** ACTION *** Save/set priority around this? MOV R0,QN$TAL(R1) ;Set lo-order CLR QN$TAH(R1) ; and hi-order descriptor address BIS #CS.REN,QN$CSR(R1) ;And enable the receiver 130$: MOV (SP)+,R5 ;Restore previously saved registers MOV (SP)+,R4 ; ... CLC ;In case we're reporting to a call ; to SETUP RETURN .DSABL LSB .IF NE TIM$IT .IF NE NQ$WDT .SBTTL DEQNA Port Handler Watchdog routines ;+ ; ; TIMER ; Used to post a 2 second timer element in order to determine ; if transmit has hung up. (Problem with DEQNA board when ; transmit during receive collision, phase of moon, etc.) ; ; CTIMER ; Used to cancel any outstanding timer element. ; ; XMTTMO ; Watchdog completion routine. Indicates that a transmit ; interrupt has not occurred within two seconds of posting ; the transmit, board is probably wedged. Performs software ; reset of board, rebuilds data structures, enables receiver ; and causes transmit to be reposted. ; ;- TIMER: TST XMTWBK+C.COMP ;Oustanding timer request? BNE 10$ ;Yep, no need for another... MOV NIOCQE,R4 ;R4 -> Current transmit qelement BEQ 10$ ;None... MOVB Q$JNUM(R4),R4 ;Get job/unit number BIC #^C,R4 ;Strip to job number ASR R4 ;Which we shift ASR R4 ; to the right ASR R4 ; three bits MOV R4,XMTWBK+C.JNUM ;Save it for context .ADDR #XMTTMO,R4 ;R4 -> Transmit timeout routine MOV R4,XMTWBK+C.COMP ;Save it as completion routine MOV (SP),-(SP) ;Fake an interrupt by stacking the ; return address MOV @#PSW,2(SP) ;Preserve previous mode BIC #340,2(SP) ; but not the priority .INTEN NI$PRI,PIC ;Now we go to device priority level ; in order to do following fork .FORK NQFBLK ;Must fork for upcoming .TIMIO XMTWBK,0,2*60. ; timer request for 2 seconds 10$: RETURN CTIMER: TST XMTWBK+C.COMP ;Outstanding timer request? BEQ 10$ ;Nope... MOV (SP),-(SP) ;Fake an interrupt by stacking the ; return address MOV @#PSW,2(SP) ;Preserve previous mode BIC #340,2(SP) ; but not the priority .INTEN NI$PRI,PIC ;Now we go to device priority level ; in order to do following fork .FORK NQFBLK ;Must FORK before .CTIMI XMTWBK ; cancelling timer CLR XMTWBK+C.COMP ;Ensure it's inactive 10$: RETURN XMTTMO: CALL SAV30 ;Save R0-R3 MOV R4,-(SP) ; as well as R4 MOV R5,-(SP) ; and R5 CALL INIT ;Re-init the board CALL ENABLE ;Re-enable interrupts CALL XMIT ;Restart the transmit MOV (SP)+,R5 ;Restore R5 MOV (SP)+,R4 ; and R4 RETURN ; (implicit restore of R0-R3) .ENDC ;NE NQ$WDT .ENDC ;NE TIM$IT .SBTTL Port Handler Impure Data Area .PSECT NIDAT NINAME: .WORD NI$HND ;Extended memory handler region name .RAD50 /$ / $BLKMV: .BLKW ;Pointer to RMON Block Move routine RCVIDX: .BLKW ;Index to first valid descriptor RCVINV: .BLKW ;Pointer to invalid descriptor ; Receive buffer descriptor list. There is one more descriptor than there ; are buffers. This last descriptor is used to chain back to the first ; descriptor, producing a ring of buffer descriptors. RCVBDL: .BLKB *BD.ESZ ; Buffer address/par table. A table of two-word entries containing the ; normalized address and PAR values which are used to access the receive ; and setup buffers in the handler extended region. Since the values have ; been normalized, it is possible to address an entire buffer without ; crossing a par boundary. ; ** Begin critical ordering ** BUFADR: .BLKW ;Address/Par values for buffers SETADR: .BLKW 2 ;Address/Par values for SETUP buffer ; ** End critical ordering ** SETUFG: .WORD 0 ; : 'Setup packet pending' flag RECVFG: .WORD -1 ; : 'Receive process available' flag XMITFG: .WORD -1 ; : 'Transmit process available' flag NQECFG: .WORD 0 ; : 'Excessive collision' flag XMTBDL: .BLKB BD.ESZ*2 ;Transmit buffer descriptor list FQELEM: .BLKW 6 ;Fake queue element (enough to ; contain Q$BLKN to Q$PAR equivalents) NQADDR: .BLKW 3*UA.ESZ ;Address check table .IF NE TIM$IT .IF NE NQ$WDT NQFBLK: .WORD 0,0,0,0 ;Transmit watchdog fork block XMTWBK: .WORD 0,0,0 ;Timer block (hi, lo, link) .WORD 0 ;Job number .WORD 177000+NI$COD ;System sequence (ID) .WORD -1 ;System queue element .WORD 0 ;Completion routine address .ENDC ;NE NQ$WDT .ENDC ;NE TIM$IT NISLEN =: <.-NISBLK>/2 ;021 .SBTTL Set Code overlay ;+ ; ; Set code overlay. Loaded and entered via code residing in block ; 0 of the handler. ; ; Determines type of Qbus Ethernet interface (DEQNA vs DELQA), prints ; identification message and station address. ; ; Note: ; o The first contribution to the SETOVR PSECT comes from ; the UNLOAD code in NI. ;- .PSECT SETOVR . = LODOVR + 1000 ;Align to next block OVRBLK =: . ;Base for this overlay .MCALL .ADDR, .PRINT, .TTYOU .MCALL .TRPSE ; SET NQ SHOW O.SHOW: .ADDR #TSAREA,R0 ;R0 -> EMT area for .TRPSET .ADDR #NQNXM,R1 ;R1 -> Our NXM trap routine .TRPSE R0,R1 ;Direct NXM traps to our routine TST @+INSCSR ;Does the hardware exist? NOP ;Some processors trap late BCS S.ERR ;Nope... .ADDR #M.DEQN,R0 ;R0 -> DEQNA id message MOV +INSCSR,R1 ;R1 -> Device register base ADD #QN$VEC,R1 ;R1 -> Vector register BIS #VC.ID,@R1 ;Turn on the ID bit BIT #VC.ID,@R1 ;Is it a DELQA? BEQ 5$ ;Nope, DEQNA... BIC #VC.ID,@R1 ;DELQA, reset the bit .ADDR #M.DELQ,R0 ;Use different message for DELQA 5$: .PRINT .ADDR #M.PADD,R0 ;R0 -> Physical address message .PRINT ;Print it MOV +INSCSR,R1 ;R1 -> Device register base MOV #6.,R2 ;R2 = count of hex pairs to print BR 20$ ;Jump into loop 10$: .TTYOU #'- ;Delimiter 20$: MOV (R1)+,-(SP) ;Get contents of the PROM MOVB (SP),R0 ;Make a copy of it ASR R0 ;Shift down high nybble ASR R0 ASR R0 ASR R0 BIC #^C<17>,R0 ;Strip to just the nybble we want .ADDR #HEX,R0,ADD ;R0 -> Hex character to print .TTYOU (R0) ;Print it MOVB (SP)+,R0 ;Get the byte again BIC #^C<17>,R0 ;Using the low nybble this time .ADDR #HEX,R0,ADD ;R0 -> Hex character to print .TTYOU (R0) ;Print it DEC R2 ;More to do? BGT 10$ ;Yep... .ADDR #M.CRLF,R0 ;Nope, we'll end with a pair .PRINT S.GOOD: TST (PC)+ S.ERR: SEC ROL R2 ;Save carry in R2 JMP +GETBK1 ;Restore block 1 TSAREA: .BLKW 2 ;EMT area for .TRPSET request NQNXM: BIS #1,2(SP) ;Set the carry for return RTI ; and then do so M.DEQN: .ASCII /DEQNA, /<200> M.DELQ: .ASCII /DELQA, /<200> M.PADD: .ASCII /Station address = /<200> M.CRLF: .BYTE 0 HEX: .ASCII /0123456789ABCDEF/ .Assume <.-OVRBLK> LE 1000 MESSAGE= .END