Category : Files from Magazines
Archive   : SNOOP.ZIP
Filename : NE2000.ASM

 
Output of file : NE2000.ASM contained in archive : SNOOP.ZIP
; *************************************************************************************************
; *
; * Title: NE2000.ASM
; * Copyright (c) October 1992, Ryu Consulting
; * Written by Rahner James
; *
; * This file contains the functions to support low-level NE2000 access
; *
; * Notes:
; * NIC = Network Interface Controller
; *
; *************************************************************************************************

include ne2000.inc


NIC_ID_START equ 0 ; Starting address of the network ID number burned into the board
NIC_RAM_START equ (16*1024) ; Starting address of the internal RAM used by the NIC
ifdef CPU286
RAM_SIZE equ (16*1024) ; Size of the RAM used by the NIC in a 16-bit system
else
RAM_SIZE equ (8*1024) ; Size of the RAM used by the NIC in a 8-bit system
endif
START_XMIT_BUFFER equ NIC_RAM_START ; Start the transmission area at the beginning of the RAM
XMIT_BUFFER_SIZE equ 1500 ; Maximum size of a transmitted packet in the IEEE 802.3 specification
TOTAL_TRANSMIT_BUFFERS equ 2 ; Number of buffers used to transmit data packets
START_RECV_BUFFER equ START_XMIT_BUFFER + ((((XMIT_BUFFER_SIZE+255)/256)*TOTAL_TRANSMIT_BUFFERS)*256)
RECV_BUFFER_SIZE equ 256
TOTAL_RECV_BUFFERS equ (RAM_SIZE - START_RECV_BUFFER) / RECV_BUFFER_SIZE
MIN_PACKET_SIZE equ 46 ; Minimum size of a transmission packet


.data
; *************************************************************************************************
; *
; * Global and Static
; *
; *************************************************************************************************

public IRQ_Number, Base_Port, DMA_Channel, Int_Count, NE2000_Address, NIC_Normal_Recv_Config
public Total_Unread_Buffers, Total_Xmit_Buffers, Total_Xmit_Packets, Total_Recv_Packets
public Total_Xmit_Errors, Total_Recv_Errors, Total_Missed_Packets, Tick_Count
extern _Screen_Segment:word


IRQ_Number db 12 ; IRQ number to use for the NE-2000
DMA_Channel db 3 ; DMA Channel to use
Base_Port dw 300h ; Base port of the interface board

Time_Started dw 0
Tick_Count dw 0,0

Xmit_Buffer_Ptr dd 0 ; -> to the NIC_ECB_S of the current buffer being transmitted
Last_Xmit_Buffer dd 0 ; -> last transmission buffer
Next_Unread_Buffer dd 0 ; -> next buffer to read
Last_Unread_Buffer dd 0 ; -> most recently received buffer
Total_Unread_Buffers dw 0 ; Number of buffers that have received data in them
Total_Xmit_Buffers dw 0 ; Number of buffers to transmit

Total_Xmit_Errors dw 0 ; Number of transmission errors
Total_Recv_Errors dw 0 ; Number of reception errors
Total_Xmit_Packets dd 0 ; Number of packets that have been transmitted successfully
Total_Recv_Packets dd 0 ; Number of packets that have been received successfully
Total_Missed_Packets dw 0 ; Number of packets that have been missed because of memory allocation problems

Int_Count dw 0,0 ; Number of interrupts
In_ISR_ne2000 db 0 ; Set if in the ISR

even
Int_Vector_Ptr dw 0 ; Points to the vector slot used for our IRQ
Old_Int_Vector dw 0,0 ; Holds the previous INT vector
Old_21_Value db 0 ; First interrupt controller's mask value before we installed ourselves
Old_A1_Value db 0 ; Second interrupt controller's mask value before we installed ourselves
Our_21_Bit db 0 ; Mask bit for our interrupt on first interrupt controller
Our_A1_Bit db 0 ; Mask bit for our interrupt on second interrupt controller
Not_Our_21_Bit db 0 ; NOT of mask bit for our interrupt on first interrupt controller
Not_Our_A1_Bit db 0 ; NOT of mask bit for our interrupt on second interrupt controller

Interface_Initialized db 0 ; Set to !0 if the interface board has been initialized
NIC_Semaphore db 0 ; Set to !0 if in the middle of pulling data from the NIC
Xmit_Retries db 0 ; Number of times tried to transmit the last packet

; *
; * Transmission related variables
; *

even
NIC_Xmit_Page_Start dw START_XMIT_BUFFER ; Start of the transmission buffer
Current_Xmit_Ptr dw START_XMIT_BUFFER ; -> buffer that is currently being sent
Waiting_Xmit_Ptr dw START_XMIT_BUFFER + ((XMIT_BUFFER_SIZE + 255) AND 0FF00h) ; -> buffer to move data into

; *
; * Reception related variables
; *

NIC_Page_Start dw START_RECV_BUFFER ; Start of the reception ring buffer
NIC_Page_Stop dw START_RECV_BUFFER + (TOTAL_RECV_BUFFERS * RECV_BUFFER_SIZE)
NIC_Boundary dw START_RECV_BUFFER + ((TOTAL_RECV_BUFFERS - 1) * RECV_BUFFER_SIZE)
NIC_Current_Page dw START_RECV_BUFFER ; Current buffer for the reception of bytes
NIC_Rem_Start_Address dw START_RECV_BUFFER ; Current buffer to pull from

; *
; * Configuration related variables
; *

NIC_Normal_Recv_Config db ACCEPT_BROADCAST ; Reception: Broadcast Packets accepted
NIC_Normal_Xmit_Config db 0 ; CRC appended, no loopback, no auto disable, normal collision
NIC_Data_Config db WORD_TRANSFER+LOOPBACK+FIFO_THRESHOLD4 ; 16-bit transfers, no loopback, 4 word FIFO (49h)
NIC_INT_Enable db 0

even
NE2000_Address db 6 dup(0) ; If !0 before reset, this will be used instead of the ROM version
db 10 dup(0) ; More stuff past the node ID

Recv_Header_Buffer PACKET_HEADER_S <> ; Buffer in which to place the first part of a reception
db 16 dup(0)
Null_Read_Task db size TASK_S dup(0) ; Task structure to use for NULL allocation on a read
db 16 dup(0)
First_Write_Task db size TASK_S dup(0) ; Task structure to use for sending the first transmission packet to the NIC
db 16 dup(0)
Second_Write_Task db size TASK_S dup(0) ; Task structure to use for sending the second transmission packet to the NIC
even
Null_Read_Ptr dd 0 ; -> to the Null Read task packet
First_Write_Ptr dd 0 ; -> task for the first write task
Second_Write_Ptr dd 0 ; -> task for the second write task

even
Seq_String db 0d9h,0d9h, 0c1h,0c1h, 0c0h,0c0h, 0c3h,0c3h, 0dah,0dah, 0c2h,0c2h, 0bfh,0bfh, 0b4h,0b4h, 0
Seq_Ptr dw Seq_String


.code

extern alloc_NIC_ecb:near, free_NIC_ecb:near
extern add_task:near

Old_Tick_Vector dd 0

; *************************************************************************************************
; *

; * NIC_ECB_T FAR *READ_PACKET( void )
; * Gets the next packet from the receive queue
; *
; * Given:
; * nothing
; *
; * Returns:
; * ES:DI -> next packet from the queue or NULL if none are available
; * When the application receives control of the packet it is decoupled
; * from the internal queue. It is up to the application free the packet
; * to the memory manager for later use.
; *
; *************************************************************************************************
read_packet proc uses ax
pushf
cli
les di, Next_Unread_Buffer ; ES:DI -> next buffer available

mov ax, es:[di].NIC_ECB_S.next
mov word ptr Next_Unread_Buffer+2, ax
dec Total_Unread_Buffers
jg done_read_packet ; Quit if there was more than one available

mov word ptr Next_Unread_Buffer, 0
mov word ptr Next_Unread_Buffer+2, 0
mov word ptr Last_Unread_Buffer, 0
mov word ptr Last_Unread_Buffer+2, 0
jz done_read_packet ; Skip if there was only one

xor di, di
mov es, di
mov Total_Unread_Buffers, di
jmp short done10_read_packet

done_read_packet:
mov es:[di].NIC_ECB_S.flags, ECB_OWNER_APP

; Maybe IPX specific
mov ax, es:[di].NIC_ECB_S.ipx_length
xchg ah, al
mov es:[di].NIC_ECB_S.ipx_length, ax
mov ax, es:[di].NIC_ECB_S.dest_socket
xchg ah, al
mov es:[di].NIC_ECB_S.dest_socket, ax
mov ax, es:[di].NIC_ECB_S.src_socket
xchg ah, al
mov es:[di].NIC_ECB_S.src_socket, ax

done10_read_packet:
popf
ret

read_packet endp


; *************************************************************************************************
; *
; * WRITE_TASK
; * Called by the task manager with pointer to task to process for writing
; *
; * Given:
; * DX:AX -> task packet
; *
; * Returns:
; * AX is destroyed
; *
; *************************************************************************************************
write_task proc far uses es di
mov es, dx ; ES:DI -> our packet
mov di, ax

cmp NIC_Semaphore, 0 ; See if it's being used right now
jz write10_task ; Skip if we are

sti
dec es:[di].TASK_S.priority ; Give it a lower priority
jg @F ; Skip if not 0 or negative
mov es:[di].TASK_S.priority, WRITE_PRIORITY
@@: call add_task
jmp short done_write_task

; *
; * Here if packet data can be moved to NIC transmit or waiting buffer
; *
write10_task:
mov es:[di].TASK_S.status, 0 ; Signal done with this task packet
les di, es:[di].TASK_S.buffer ; ES:DI -> ECB
mov NIC_Semaphore, 1
cmp es:[di].NIC_ECB_S.completion, 1 ; See if we put this in the first slot
jne write30_task ; Skip if this is a waiting packet

mov word ptr es:[di].NIC_ECB_S.in_use, IU_PROCESSING

call move_to_NIC_send
write20_task:
call start_transmission ; Start the transmission of the current packet
jmp short done_write_task

; *
; * Here if packet is to be sent to the waiting area
; *
write30_task:
call move_to_NIC_waiting
cli
mov es:[di].NIC_ECB_S.in_use, IU_PROCESSING
cmp es:[di].NIC_ECB_S.completion, 1
sti
je write20_task

done_write_task:
ret

write_task endp


; *************************************************************************************************
; *
; * MOVE_TO_NIC_SEND
; * Moves a NIC_ECB into the transmission buffer
; *
; * Given:
; * ES:DI[0] -> packet to send
; * Base_Port = base port address of the NIC
; *
; * Returns:
; * AX = 0 if all went well
; *
; *************************************************************************************************
move_to_NIC_send proc uses bx cx dx si
mov Xmit_Retries, MAX_XMIT_RETRIES
mov ax, Current_Xmit_Ptr ; AX -> buffer to put the data into
move10_to_NIC::
sti
mov bx, Base_Port
lea dx, [bx].NIC_S.remote_start ; DX -> Remote Start Address Register 0 (308, page 0)
out dx, al
DELAY
inc dx ; DX -> Remote Start Address Register 1 (309, page 0)
mov al, ah
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 0 (30A, page 0)
mov ax, es:[di].NIC_ECB_S.NIC_length
inc ax ; Round up
and al, 0feh ; and truncate
mov cx, ax
add ax, 14 ; Add in the space for the destination and source ID's and packet length

out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 1 (30B, page 0)
mov al, ah
out dx, al
DELAY

mov dx, bx ; DX -> Command Register (300)
mov al, START+ABORT+PAGE0 ; Start, Abort
out dx, al
DELAY
mov al, START+REMOTE_WRITE+PAGE0 ; Start, Remote Write
out dx, al
DELAY

lea dx, [bx].NIC_S.data_port ; DX -> data port (310h, page 0)
lea si, [di].NIC_ECB_S.node ; ES:SI -> destination
cld
ifdef CPU286
push ds
mov ax, es ; DS = ES
mov ds, ax
outsw ; Do the destination address
outsw
outsw

mov ax, word ptr ss:NE2000_Address ; Do our source address
out dx, ax
mov ax, word ptr ss:NE2000_Address+2
out dx, ax
mov ax, word ptr ss:NE2000_Address+4
out dx, ax

mov ax, cx ; Do the count
xchg ah, al
out dx, ax

lea si, [di].NIC_ECB_S.checksum
inc cx ; Round up
shr cx, 1
rep outsw
pop ds
else
push cx
mov cx, 6
@@: lods byte ptr es:[si]
out dx, al
loop @B
mov si, offset NE2000_Address
mov cx, 6
@@: lods byte ptr es:[si]
out dx, al
loop @B
pop cx
mov ax, cx
out dx, al
mov al, ch
out dx, al

lea si, [di].NIC_ECB_S.checksum
@@: lods byte ptr es:[si]
out dx, al
loop @B
endif
xor ax, ax
mov NIC_Semaphore, al
ret
move_to_NIC_send endp


; *************************************************************************************************
; *
; * MOVE_TO_NIC_WAITING
; * Moves a NIC_ECB into the next transmission waiting buffer
; *
; * Given:
; * ES:DI[0] -> packet to send
; * Base_Port = base port address of the NIC
; *
; * Returns:
; * AX = 0 if all went well
; *
; *************************************************************************************************
move_to_NIC_waiting proc uses bx cx dx si
mov ax, Waiting_Xmit_Ptr ; AX -> buffer to put the data into
jmp move10_to_NIC

move_to_NIC_waiting endp


; *************************************************************************************************
; *
; * START_TRANSMISSION
; * Starts the transmission of a packet currently pointed to by Current_Xmit_Ptr
; *
; * Given:
; * Base_Port = base port address of the NIC
; *
; * Returns:
; * AX = 0 if all went well
; *
; *************************************************************************************************
start_transmission proc uses bx dx es
mov bx, Base_Port ; BX -> base port address of the NIC
lea dx, [bx].NIC_S.xmit_page_start ; DX -> Transmit Page Start register (304h, page 0)
mov al, byte ptr Current_Xmit_Ptr+1
out dx, al
DELAY

les bx, Xmit_Buffer_Ptr ; First in the queue is the one transmitting
mov es:[bx].NIC_ECB_S.in_use, IU_SENDING ; Tell everyone we are sending it
mov ax, es:[bx].NIC_ECB_S.NIC_length

cmp ax, MIN_PACKET_SIZE ; See if it is enough
jae @F ; Skip if it is
mov ax, MIN_PACKET_SIZE
@@: add ax, 15
and al, 0FEh
inc dx ; DX -> Transmit Byte Count 0 register (305h, page 0)
out dx, al
DELAY
inc dx ; DX -> Transmit Byte Count 1 register (306h, page 0)
mov al, ah
out dx, al
DELAY

mov dx, Base_Port ; DX -> Command register (300h)
mov al, START+XMIT_PACKET+ABORT+PAGE0
out dx, al

xor ax, ax
ret
start_transmission endp


; *************************************************************************************************
; *
; * int RESET_NIC( void )
; * Reset the NIC and the NE-2000 interface board
; *
; * Given:
; * Base_Port = base port address of the NIC
; *
; * Returns:
; * AX = 0 if reset OKay, Z set
; * AX = -1 if interface is not there or is not responding, NZ set
; * All other registers intact
; *
; *************************************************************************************************
reset_nic proc uses bx dx
cli
mov bx, Base_Port ; BX -> base port of the NIC

lea dx, [bx].NIC_S.reset ; DX -> NE-2000 reset port
in al, dx ; Reset the interface
DELAY
mov dx, bx ; DX -> command port
mov al, 21h ; Reset NIC, Abort/Complete Remote DMA, Page 0
out dx, al
DELAY

in al, dx ; See if it was set
cmp al, 21h ; This register is read/write
je @F

or ax, -1
jmp done_reset_nic

@@:
; *
; * Setup things according to the NIC manual
; *
; * 1) Program Command Register for Page 0 (21h)

mov dx, bx ; DX -> command port
mov al, STOP+ABORT+PAGE0 ; Stop NIC, Abort/Complete Remote DMA, Page 0
out dx, al
DELAY

; * 2) Initialize Data Configuration Register

lea dx, [bx].NIC_S.data_config ; DX -> Data Configuration register (30Eh, page 0)
mov al, NIC_Data_Config
out dx, al
DELAY

; * 3) Clear Remote Byte Count registers

lea dx, [bx].NIC_S.remote_count ; DX -> Remote Byte Count register 0 (30Ah, page 0)
xor ax, ax
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count register 1 (30Bh, page 0)
out dx, al
DELAY

; * 4) Initialize the receive register

lea dx, [bx].NIC_S.recv_config ; DX -> Receive Configuration register (30Ch, page 0)
mov al, NIC_Normal_Recv_Config ; AL = Broadcast Packets accepted
out dx, al
DELAY

; * 5) Place NIC in Loopback mode 1 or 2

lea dx, [bx].NIC_S.xmit_config ; DX -> Transmit Configuration register (30Dh, page 0)
mov al, INTERNAL_LOOPBACK
out dx, al
DELAY

; * 6) Initialize Receive Buffer ring

lea dx, [bx].NIC_S.page_start ; DX -> Page Start register (301h, page 0)
mov NIC_Page_Start, START_RECV_BUFFER
mov al, START_RECV_BUFFER/256
out dx, al
DELAY
inc dx ; DX -> Page Stop register (302h, page 0)
mov NIC_Page_Stop, NIC_RAM_START + RAM_SIZE
mov al, (NIC_RAM_START + RAM_SIZE) shr 8
out dx, al
DELAY
inc dx ; DX -> Boundary Pointer register (303h, page 0)
mov NIC_Boundary, (NIC_RAM_START + RAM_SIZE) - RECV_BUFFER_SIZE
mov al, ((NIC_RAM_START + RAM_SIZE) - RECV_BUFFER_SIZE) shr 8
out dx, al
DELAY

; * 8) Initialize the interrupt mask (out of order)

lea dx, [bx].NIC_S.int_mask ; DX -> Interrupt mask register (30Fh, page 0)
xor ax, ax ; Disable all interrupts
mov NIC_Int_Enable, al
out dx, al
DELAY

; * 7) Clear interrupt status register (out of order)

lea dx, [bx].NIC_S.int_status ; DX -> Interrupt Status register (307h, page 0)
dec ax ; Clear all pending interrupts
out dx, al
DELAY

; * 9) Initialize the physical address and current point, in page 1

mov dx, bx ; DX -> command port
mov al, STOP+ABORT+PAGE1 ; Stop NIC, Abort/Complete Remote DMA, Page 1
out dx, al
DELAY

inc dx ; Send out the first node ID byte
mov al, NE2000_Address
out dx, al
DELAY
inc dx ; Send out the 2nd node ID byte
mov al, NE2000_Address+1
out dx, al
DELAY
inc dx ; Send out the 3rd node ID byte
mov al, NE2000_Address+2
out dx, al
DELAY
inc dx ; Send out the 4th node ID byte
mov al, NE2000_Address+3
out dx, al
DELAY
inc dx ; Send out the 5th node ID byte
mov al, NE2000_Address+4
out dx, al
DELAY
inc dx ; Send out the 6th node ID byte
mov al, NE2000_Address+5
out dx, al
DELAY

inc dx ; DX -> Current Page register (307h, page 1)
mov NIC_Current_Page, START_RECV_BUFFER
mov al, START_RECV_BUFFER shr 8
out dx, al
DELAY

; * 10) Put NIC in start mode

mov dx, bx ; DX -> command port
mov al, START+ABORT+PAGE0 ; Start NIC, Abort/Complete Remote DMA, Page 0
out dx, al
DELAY

; * 11) Initialize the Transmit Configuration Register

lea dx, [bx].NIC_S.xmit_config ; DX -> Transmit Configuration register (30Dh, page 0)
mov al, NIC_Normal_Xmit_Config
out dx, al

xor ax, ax
done_reset_nic:
sti
ret

reset_nic endp


; *************************************************************************************************
; *
; * int START_NE2000_INTERRUPTS( void )
; * Sets up the NIC, INT vectors, and timer 0 for interrupts
; *
; * Given:
; * Base_Port = base port address of the NIC
; * IRQ_Number = IRQ number to use
; *
; * Returns:
; * AX = 0 if interrupt set OKay
; * All other registers preserved
; *
; *************************************************************************************************
start_ne2000_interrupts proc uses bx cx dx es
xor ax, ax
cmp Old_Int_Vector+2, ax ; See if we are already installed
jnz done_start_interrupts ; Quit if we are

cli
mov es, ax ; ES -> base segment
mov cx, ax ; CX = 0
in al, 21h ; Get the low mask
mov Old_21_Value, al
in al, 0a1h ; Get the high mask
mov Old_A1_Value, al

mov cl, IRQ_Number ; CL = IRQ number
mov al, 1
rol al, cl ; AL = bit mask for the INT controller

cmp cl, 8 ; See if IRQ 0-7
jnc high_interrupt ; Jump if between 8-15 inclusive

mov Our_21_Bit, al ; Save our mask
and Old_21_Value, al
not al
mov Not_Our_21_Bit, al
mov Our_A1_Bit, 0 ; Don't worry about the second controller
mov Not_Our_A1_Bit, -1
mov Old_A1_Value, 0

and al, Old_21_Value ; Unmask the interrupt
out 21h, al

mov bx, cx ; BX = IRQ number
add bx, 8 ; IRQ 0 starts at vector 8
jmp short both_interrupts ; Skip to the rest

high_interrupt:
mov Our_A1_Bit, al ; Save our mask
and Old_A1_Value, al
not al
mov Not_Our_A1_Bit, al
mov Our_21_Bit, 0 ; Don't worry about the first controller
mov Not_Our_21_Bit, -1
mov Old_21_Value, 0

and al, Old_A1_Value ; Unmask the interrupt
out 0A1h, al

mov bx, cx ; BX = IRQ number
add bx, 70h-8 ; IRQ 8 starts at vector 70h

both_interrupts:
ifdef CPU286
shl bx, 2 ; BX *= 4
else
add bx, bx
add bx, bx
endif
mov Int_Vector_Ptr, bx ; Save the pointer for later

mov ax, offset isr_ne2000
mov cx, cs
xchg ax, es:[bx] ; AX = old offset
xchg cx, es:[bx+2] ; CX = old segment
mov Old_Int_Vector, ax
mov Old_Int_Vector+2, cx

mov bx, Base_Port ; BX -> base port address
lea dx, [bx].NIC_S.int_mask ; DX -> Interrupt Mask Register (30F, page 0)
mov al, PACKET_RECEIVED+PACKET_XMITTED+RECEIVE_ERROR+XMIT_ERROR+OVERWRITE_WARNING
mov NIC_INT_Enable, al ; Save it for later
out dx, al
DELAY

lea dx, [bx].NIC_S.int_status ; DX -> Interrupt Status Register (307, page 0)
or ax, -1 ; Clear all interrupts
out dx, al

inc ax ; AX = 0 for good return
sti

done_start_interrupts:
ret

start_ne2000_interrupts endp


; *************************************************************************************************
; *
; * int STOP_NE2000_INTERRUPTS( void )
; * Stops all interrupt generation and processing for the NIC
; *
; * Given:
; * Base_Port = base port address of the NIC
; * Old_Int_Vector = vector for old interrupt vector
; *
; * Returns:
; * AX = 0 if interrupt stopped OKay
; * All other registers preserved
; *
; *************************************************************************************************
stop_ne2000_interrupts proc uses bx cx dx es
xor ax, ax
cmp Old_Int_Vector+2, ax ; See if we are already installed
jz @F

cli
mov es, ax ; ES -> base segment
mov cx, ax ; CX = 0
in al, 21h ; Get the low mask
or al, Old_21_Value ; Mask that interrupt if it was before
DELAY
out 21h, al

in al, 0A1h ; Get the high mask
or al, Old_A1_Value ; Mask that interrupt if it was before
DELAY
out 0A1h, al

mov ax, cx ; AX = 0
mov bx, Int_Vector_Ptr ; BX -> INT vector to restore
xchg Old_Int_Vector, ax
xchg Old_Int_Vector+2, cx
mov es:[bx], ax ; AX = old offset
mov es:[bx+2], cx ; CX = old segment
xor ax, ax

@@: mov bx, Base_Port ; BX -> base port address
lea dx, [bx].NIC_S.int_mask ; DX -> Interrupt Mask Register (30F, page 0)
out dx, al
DELAY

lea dx, [bx].NIC_S.int_status ; DX -> Interrupt Status Register (307, page 0)
dec ax ; AX = -1 to clear all the interrupts
out dx, al

inc ax ; AX = 0
sti

ret

stop_ne2000_interrupts endp


; *************************************************************************************************
; *
; * int KILL_RECEPTIONS( void )
; * Stops all receptions processed by the NIC and destroys all currently received packets
; *
; * Given:
; * Base_Port = base port address of the NIC
; * Old_Int_Vector = vector for old interrupt vector
; *
; * Returns:
; * AX = 0 if interrupt stopped OKay
; * All other registers preserved
; *
; *************************************************************************************************
kill_receptions proc
xor ax, ax
ret

kill_receptions endp


; *************************************************************************************************
; *
; * int KILL_TRANSMISSIONS( void )
; * Stops all transmissions from the NIC and destroys all packets that are buffered to be transmitted
; *
; * Given:
; * Base_Port = base port address of the NIC
; * Old_Int_Vector = vector for old interrupt vector
; *
; * Returns:
; * AX = 0 if interrupt stopped OKay
; * All other registers preserved
; *
; *************************************************************************************************
kill_transmissions proc

xor ax, ax
ret

kill_transmissions endp


; *************************************************************************************************
; *
; * int INIT_NE2000( void )
; * Initializes the NE-2000 interface and readies it for any further I/O
; *
; * Given:
; * IRQ_Number = IRQ number to use
; * DMA_Channel = DMA channel to use, not supported at this moment
; * Base_Port = base port address of the NIC
; *
; * Returns:
; * 0 if all was installed and eveything is ready
; * -1 = couldn't find the interface
; * -3 = bad memory in the I/O buffer
; *
; * Note:
; * This function may be called at any time and may be used to bring the NE-2000
; * back to some known state if things get too weird
; *
; *************************************************************************************************
init_ne2000 proc uses bx cx dx di si es

mov ax, @Data ; ES = Data segment
mov es, ax

call stop_ne2000_interrupts ; Stops all interrupts from the NIC and the NE-2000
call reset_nic ; Resets the NIC and the NE-2000
jz @F
ret

@@: cmp Interface_Initialized,0 ; See if we have already been initialized
jz @F ; Skip if we haven't

call kill_receptions ; Stops all receptions and eliminates the packets buffered
call kill_transmissions ; Stops all transmissions and eliminates the packets to be sent
mov Interface_Initialized,0 ; Haven't been initialized, yet

@@: call start_time_isr
xor ax, ax ; AX = 0 to clear out some variables

mov Int_Vector_Ptr, ax
mov Old_Int_Vector, ax
mov Old_Int_Vector+2, ax
mov Old_21_Value, al
mov Old_A1_Value, al
mov Our_21_Bit, al
mov Our_A1_Bit, al
mov Not_Our_21_Bit, al
mov Not_Our_A1_Bit, al
mov NIC_Semaphore, al
mov Xmit_Retries, al
mov word ptr Xmit_Buffer_Ptr, ax
mov word ptr Xmit_Buffer_Ptr+2, ax

mov bx, Base_Port ; BX -> base port address
@@: cmp NE2000_Address, 0 ; See if we have a preset node address
jnz init10_ne2000 ; Skip getting the address

lea dx, [bx].NIC_S.remote_start ; DX -> Remote Start Address Register 0 (308, page 0)
xor ax, ax ; Start at address 0 to get the node ID
out dx, al
DELAY
inc dx ; DX -> Remote Start Address Register 1 (309, page 0)
out dx, al
DELAY
lea dx, [bx].NIC_S.remote_count ; DX -> Remote Byte Count Register 0 (30A, page 0)
mov al, 32 ; Make a count of 32 bytes to get 16, weird adapter
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 1 (30B, page 0)
mov al, ah
out dx, al
DELAY

lea dx, [bx].NIC_S.xmit_config ; DX -> Transmit Configuration Register (30D, page 0)
out dx, al
DELAY

mov dx, bx ; DX -> command port
mov al, START+REMOTE_READ+PAGE0 ; Start, Remote Read, Page 0 (0Ah)
out dx, al
DELAY

; *
; * Get the NE-2000 node ID
; *
mov di, offset NE2000_Address
mov cx, 16 ; Get 16 bytes (node ID, dlink name, WW?)
lea dx, [bx].NIC_S.data_port ; DX -> data port (310)
cld
ifdef CPU286
rep insb
else
@@: in al, dx ; AL = ID byte
stosb ; Store it
loop @B
endif
call reset_nic
jz init10_ne2000
ret

init10_ne2000:
; *
; * Test the I/O buffer by reading and writing a chunk o' data
; *
lea dx, [bx].NIC_S.remote_start ; DX -> Remote Start Address Register 0 (308, page 0)
mov ax, NIC_RAM_START ; Start at RAM beginning
out dx, al
DELAY
inc dx ; DX -> Remote Start Address Register 1 (309, page 0)
mov al, ah
out dx, al
DELAY
lea dx, [bx].NIC_S.remote_count ; DX -> Remote Byte Count Register 0 (30A, page 0)
mov ax, RAM_SIZE ; Make a count of entire RAM size
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 1 (30B, page 0)
mov al, ah
out dx, al
DELAY

mov dx, bx ; DX -> Command Register (300)
mov al, START+ABORT+PAGE0 ; Start, Abort
out dx, al
DELAY
mov al, START+REMOTE_WRITE+PAGE0 ; Start, Remote Write
out dx, al
DELAY

mov cx, RAM_SIZE/2 ; CX = number of words in the RAM area
lea dx, [bx].NIC_S.data_port ; DX -> data port
@@: mov ax, cx
not ax
out dx, ax
loop @B

; *
; * Now read them back in and see if they compare
; *
lea dx, [bx].NIC_S.remote_start ; DX -> Remote Start Address Register 0 (308, page 0)
mov ax, NIC_RAM_START ; Start at RAM beginning
out dx, al
DELAY
inc dx ; DX -> Remote Start Address Register 1 (309, page 0)
mov al, ah
out dx, al
DELAY
lea dx, [bx].NIC_S.remote_count ; DX -> Remote Byte Count Register 0 (30A, page 0)
mov ax, RAM_SIZE ; Make a count of entire RAM size
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 1 (30B, page 0)
mov al, ah
out dx, al
DELAY

mov dx, bx ; DX -> Command Register (300)
mov al, START+ABORT+PAGE0 ; Start, Abort
out dx, al
DELAY
mov al, START+REMOTE_READ+PAGE0 ; Start, Remote Write
out dx, al
DELAY

lea dx, [bx].NIC_S.data_port ; DX -> data port
mov cx, RAM_SIZE/2 ; CX = number of words in the RAM area
@@: in ax, dx ; Compare a word at a time
not ax
cmp ax, cx
loope @B
je init30_interface ; Skip if all is well

jcxz init20_interface
@@: in ax, dx
loop @B

init20_interface:
call stop_time_isr
mov ax, -3 ; Bad data compare
sti
ret

init30_interface:
lea dx, [bx].NIC_S.remote_count ; DX -> Remote Byte Count Register 0 (30A, page 0)
mov ax, cx ; AX = 0
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 1 (30B, page 0)
out dx, al
DELAY

mov dx, bx ; DX -> Command Register (300)
mov al, START+ABORT+PAGE0
out dx, al
DELAY

mov NIC_Xmit_Page_Start, START_XMIT_BUFFER ; Start of the transmission buffer
mov Current_Xmit_Ptr, START_XMIT_BUFFER ; -> buffer that is currently being sent
mov Waiting_Xmit_Ptr, START_XMIT_BUFFER + ((XMIT_BUFFER_SIZE + 255) AND 0FF00h) ; -> buffer to move data into

mov ax, ds
mov es, ax

mov bx, offset Null_Read_Task ; Setup memory for any NULL reads
ifdef CPU286
shr bx, 4
else
shr bx, cl
endif
add bx, ax
mov word ptr Null_Read_Ptr+2, bx
mov word ptr Null_Read_Ptr, 0
mov bx, offset First_Write_Task ; Setup for the first transmission buffer
ifdef CPU286
shr bx, 4
else
shr bx, cl
endif
add bx, ax
mov word ptr First_Write_Ptr+2, bx
mov word ptr First_Write_Ptr, 0
mov bx, offset Second_Write_Task ; Setup for the second transmission buffer
ifdef CPU286
shr bx, 4
else
shr bx, cl
endif
add bx, ax
mov word ptr Second_Write_Ptr+2, bx
mov word ptr Second_Write_Ptr, 0

xor ax, ax ; Clear the Task packets
les di, Null_Read_Ptr
mov cx, (size TASK_S)/2
rep stosw
les di, First_Write_Ptr
mov cx, (size TASK_S)/2
rep stosw
les di, Second_Write_Ptr
mov cx, (size TASK_S)/2
rep stosw

; *
; * Setup the NULL read task
; *
les di, Null_Read_Ptr ; ES:DI -> task packet for Null read
mov word ptr es:[di].TASK_S.function, offset do_null_read
mov word ptr es:[di].TASK_S.function+2, cs

; *
; * Setup the first write task
; *
les di, First_Write_Ptr
mov es:[di].TASK_S.priority, WRITE_PRIORITY
mov word ptr es:TASK_S.function, offset write_task
mov word ptr es:TASK_S.function+2, cs

; *
; * Setup the second write task
; *
les di, Second_Write_Ptr
mov es:[di].TASK_S.priority, WRITE_PRIORITY
mov word ptr es:TASK_S.function, offset write_task
mov word ptr es:TASK_S.function+2, cs

call start_ne2000_interrupts
mov Interface_Initialized, 1 ; It has been initialized

xor ax, ax ; Return AX = 0
sti ; Enable interrupts
ret

init_ne2000 endp


; *************************************************************************************************
; *
; * int READ_PACKET_FROM_NIC( void )
; * Pulls a chunk of data in from the NIC buffer
; *
; * Given:
; * BP -> base port address of NE-2000
; * DS = our data segment
; * ES = ???
; * Interrupts have been disabled
; *
; * Returns:
; * 0 if everything got pulled in OK
; * Interrupts enabled
; *
; *************************************************************************************************
read_packet_from_NIC proc uses cx dx di si es

add word ptr Total_Recv_Packets, 1 ; Increment the receive packet count
adc word ptr Total_Recv_Packets+2, 0

lea dx, [bp].NIC_S.remote_start ; DX -> Remote Start Address Register 0 (308, page 0)
mov ax, NIC_Rem_Start_Address ; AX = start address in the NIC buffer
out dx, al
DELAY
inc dx ; DX -> Remote Start Address Register 1 (309, page 0)
mov al, ah
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 0 (30A, page 0)
mov ax, size PACKET_HEADER_S
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 1 (30B, page 0)
mov al, ah
out dx, al
DELAY

mov ax, ds ; ES:DI -> header buffer
mov es, ax
mov di, offset Recv_Header_Buffer
mov si, di ; SI -> buffer to use later

mov dx, bp ; DX -> Command Register (300)
mov al, START+REMOTE_READ+PAGE0
out dx, al
DELAY

lea dx, [bp].NIC_S.data_port ; DX -> data port
ifdef CPU286
mov cx, (size PACKET_HEADER_S) / 2 ; Convert to words
rep insw
else
mov cx, size PACKET_HEADER_S
@@: in al, dx
stosb
loop @B
endif
mov al, Recv_Header_Buffer.next_packet ; Set for next packet to read
mov byte ptr NIC_Rem_Start_Address+1, al

mov cx, Recv_Header_Buffer.count ; CX = number of bytes to pull from NIC
add cx, NIC_ECB_S.checksum
call alloc_NIC_ecb ; Sets up a chunk of memory, sets ES -> to it, register preserved, DI=0
jc alloc_pull_into_ether ; Pull the packet into the bit bucket

mov es:NIC_ECB_S.next, 0 ; We are at the end of the line
mov es:NIC_ECB_S.flags, ECB_OWNER_DRIVER ; Owned by the driver at first
mov word ptr es:NIC_ECB_S.esr, di
mov word ptr es:NIC_ECB_S.esr+2, di
mov word ptr es:NIC_ECB_S.in_use, IU_PROCESSING
mov ax, word ptr Recv_Header_Buffer.source
mov word ptr es:NIC_ECB_S.node, ax
mov ax, word ptr Recv_Header_Buffer.source+2
mov word ptr es:NIC_ECB_S.node+2, ax
mov ax, word ptr Recv_Header_Buffer.source+4
mov word ptr es:NIC_ECB_S.node+4, ax
mov ax, Recv_Header_Buffer.count
mov word ptr es:NIC_ECB_S.NIC_length, ax

cli
cmp word ptr Next_Unread_Buffer+2, di ; See if we are the first
jnz @F ; Skip if we aren't
mov word ptr Next_Unread_Buffer+2, es ; Make us the first and last
mov word ptr Next_Unread_Buffer, di
mov word ptr Last_Unread_Buffer+2, es
mov word ptr Last_Unread_Buffer, di
mov Total_Unread_Buffers, 1
jmp short read15_packet

@@: mov ax, es ; Save ES
mov di, ax
xchg word ptr Last_Unread_Buffer+2, ax
mov es, ax
mov word ptr es:NIC_ECB_S.next, di ; Point last tail to us
mov es, di
inc Total_Unread_Buffers

read15_packet:
sti
mov di, NIC_ECB_S.checksum ; DI -> place to start pulling data in from the NIC
sub cx, (size PACKET_HEADER_S)-1 ; CX = number of bytes to pull
shr cx, 1
mov ax, cx
add ax, ax ; AX = number of bytes to pull

; *
; * Set up the NIC to read the rest of the data
; *
lea dx, [bp].NIC_S.remote_count ; DX -> Remote Byte Count Register 0 (30A, page 0)
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 1 (30B, page 0)
mov al, ah
out dx, al
DELAY
mov dx, bp ; DX -> Command Register (300)
mov al, START+REMOTE_READ+PAGE0
out dx, al
DELAY

lea dx, [bp].NIC_S.data_port ; DX -> data port (310)
ifdef CPU286
rep insw
else
@@: in ax, dx
stosw
loop @B
endif

read20_packet:
mov al, byte ptr NIC_Rem_Start_Address+1
dec al
cmp al, byte ptr NIC_Page_Start+1 ; See if we need to wrap
jae @F
mov al, byte ptr NIC_Boundary+1
@@: lea dx, [bp].NIC_S.boundary_ptr
out dx, al
jmp short done_read_packet

alloc_pull_into_ether:
inc Total_Missed_Packets ; Bump the missed packet indicator
pull_into_ether:
mov cx, Recv_Header_Buffer.count ; CX = number of bytes to pull from NIC
jcxz read20_packet
shr cx, 1
jz read20_packet
mov ax, cx
add ax, ax ; AX = number of bytes to pull

lea dx, [bp].NIC_S.remote_count ; DX -> Remote Byte Count Register 0 (30A, page 0)
out dx, al
DELAY
inc dx ; DX -> Remote Byte Count Register 1 (30B, page 0)
mov al, ah
out dx, al
DELAY
lea dx, [bp].NIC_S.remote_start ; DX -> Remote Start Address Register 0 (308, page 0)
mov al, 12h
out dx, al
DELAY
mov dx, bp ; DX -> Command Register (300)
mov al, START+REMOTE_READ+PAGE0
out dx, al
DELAY

lea dx, [bp].NIC_S.data_port ; DX -> data port (310)
@@: in ax, dx
loop @B
jmp read20_packet

done_read_packet:
xor ax, ax
mov NIC_Semaphore, 0
sti

ret
read_packet_from_NIC endp


; *************************************************************************************************
; *
; * READ_TASK
; * Task to get the next received buffer from the NIC
; *
; * Given:
; * DX:AX -> task packet that triggered this function
; *
; * Returns:
; * Next packet moved from NIC buffer to an ECB
; *
; *************************************************************************************************
read_task proc far

cmp NIC_Semaphore, 0 ; See if it's being used right now
jnz read10_task ; Skip if we are
mov NIC_Semaphore, 1

sti
push es
push di
mov es, dx
mov di, ax
call free_NIC_ecb ; No more need for this memory chunk
pop di
pop es
push bp
mov bp, Base_Port
call read_packet_from_NIC ; Buffer the data packet
pop bp
jmp short done_read_task

read10_task:
sti
push es
push di
mov es, dx
mov di, ax
call add_task
pop di
pop es
done_read_task:
ret

read_task endp


; *************************************************************************************************
; *
; * DO_NULL_READ
; * Task to get the next received buffer from the NIC
; *
; * Given:
; * DX:AX -> task packet that triggered this function
; *
; * Returns:
; * Next packet moved from NIC buffer to an ECB
; *
; *************************************************************************************************
do_null_read proc far

cmp NIC_Semaphore, 0 ; See if it's being used right now
jnz done_null_read ; Quit if its being used right now
mov NIC_Semaphore, 1

push es
push di
mov es, dx
mov di, ax
dec word ptr es:[di].TASK_S.buffer
pop di
pop es
sti
push bp
mov bp, Base_Port
call read_packet_from_NIC ; Buffer the data packet
pop bp

done_null_read:
sti
ret

do_null_read endp


; *************************************************************************************************
; *
; * void START_TIME_ISR( void )
; * Sets up the ticker 08 intercept
; *
; * Given:
; * Vector 08 must be a valid insertion point
; *
; * Returns:
; * Inserts our tick vector in the chain if not done so already
; * Saves all registers
; *
; *************************************************************************************************
start_time_isr proc uses ax bx es

mov ax, word ptr Old_Tick_Vector ; See if already inserted
or ax, word ptr Old_Tick_Vector+2
jnz done_start_ticks

xor ax, ax ; Zero the internal ticker
mov Tick_Count, ax
mov Tick_Count+2, ax
mov es, ax
mov ax, offset time_isr ; Set up our internal ticker
mov bx, cs
cli
xchg es:[8*4], ax ; Change timer interrupt vectors
xchg es:[8*4]+2, bx
mov word ptr Old_Tick_Vector, ax
mov word ptr Old_Tick_Vector+2, bx
mov Time_Started, -1
sti

done_start_ticks:
ret
start_time_isr endp


; *************************************************************************************************
; *
; * void STOP_TIME_ISR( void )
; * Removes the ticker from the tick linked list
; *
; * Given:
; * DS = current data segment
; *
; * Returns:
; * 08h revectored to old value
; * All register are preserved
; *
; *************************************************************************************************
stop_time_isr proc uses ax bx es

cmp Time_Started, 0 ; See if it has been installed
jz done_stop_ticks

xor ax, ax ; ES -> base segment
xor bx, bx
mov es, ax
cli
xchg ax, word ptr Old_Tick_Vector
xchg bx, word ptr Old_Tick_Vector+2
mov es:[8*4], ax
mov es:[8*4]+2, bx
mov Time_Started, 0
sti

done_stop_ticks:
ret
stop_time_isr endp


; *************************************************************************************************
; *
; * ISR_NE2000
; * Interrupt Service Routine for NE-2000
; *
; * Given:
; * nothing
; *
; * Returns:
; * In_ISR_ne2000 = !0 while in ISR and not CLI'ed
; *
; *************************************************************************************************
isr_ne2000 proc far uses ax bx dx ds es si bp

mov ax, @Data
mov ds, ax

mov bp, Base_Port ; BP -> base port address
lea dx, [bp].NIC_S.int_mask ; DX -> interrupt mask register (30F, page 0)
xor al, al
out dx, al

mov al, 20h
out 20h, al
cmp IRQ_Number, 8 ; See if we need to do the next INT controller
jb @F
out 0a0h, al

@@: cmp In_ISR_ne2000, 0 ; See if we are in it already
jz @F ; Skip if we aren't
jmp done10_isr_ne2000 ; Quit if we are

@@: mov In_ISR_ne2000, 1 ; Signal our inness
sti
add Int_Count, 1 ; Increment our interrupt counter
adc Int_Count+2, 0

isr_loop:
lea dx, [bp].NIC_S.int_status ; DX -> interrupt status register
cli
in al, dx

test al, PACKET_RECEIVED ; See if we got a packet we have to retrieve
jz no_received_packet ; Skip if not a received packet

; *
; * Process any received packets here
; *
cmp NIC_Semaphore, 0 ; See if it's being used right now
mov al, PACKET_RECEIVED ; Clear the interrupt either way
out dx, al
jnz @F ; Skip if we are

mov NIC_Semaphore, 1
sti
call read_packet_from_NIC ; Buffer the data packet
jmp isr_loop

@@: sti
push cx
mov cx, size TASK_S ; CX = size of task packet
call alloc_NIC_ecb ; Sets up a chunk of memory, sets ES -> to it, register preserved, DI=0
pop cx
jnc @F ; Skip if CARRY is not set

push di
les di, Null_Read_Ptr ; ES:DI -> NULL read task packet
inc word ptr es:[di].TASK_S.buffer
cmp es:[di].TASK_S.status, 0 ; If 0, then we need to start it
jz isr05_loop
pop di
jmp isr_loop

@@: mov es:TASK_S.priority, READ_PRIORITY
mov word ptr es:TASK_S.function, offset read_task
mov word ptr es:TASK_S.function+2, cs

push di
xor di, di
isr05_loop:
call add_task
pop di
jmp isr_loop ; Loop for next interrupt reason

no_received_packet:
test al, PACKET_XMITTED ; See if there was a transmitted packet
jz process_errors

; *
; * Process any post transmissions here
; *
add word ptr Total_Xmit_Packets, 1
add word ptr Total_Xmit_Packets+2, 0

mov al, PACKET_XMITTED ; Clear the interrupt
out dx, al
mov ax, IU_DONE+(CC_SUCCESS shl 8)

isr10_loop:
les si, Xmit_Buffer_Ptr ; ES:SI -> NIC_ECB_S of the just transmitted buffer
mov word ptr es:[si].NIC_ECB_S.in_use, ax
and es:[si].NIC_ECB_S.flags, not ECB_FREE_XMIT
mov ax, word ptr es:[si].NIC_ECB_S.esr
or ax, word ptr es:[si].NIC_ECB_S.esr+2
jz @F
call es:[si].NIC_ECB_S.esr
@@: cmp es:[si].NIC_ECB_S.next, 0 ; Are there any more packets to transmit
jnz isr20_loop ; Skip if there more packets

test es:[si].NIC_ECB_S.flags, ECB_FREE_XMIT
jz @F
push di
mov di, si
call free_NIC_ecb
pop di
@@: mov word ptr Xmit_Buffer_Ptr, 0
mov word ptr Xmit_Buffer_Ptr+2, 0
mov word ptr Last_Xmit_Buffer, 0
mov word ptr Last_Xmit_Buffer+2, 0
mov Total_Xmit_Buffers, 0
short_back_to_isr_loop:
sti
jmp isr_loop

isr20_loop:
dec Total_Xmit_Buffers
mov ax, es:[si].NIC_ECB_S.next ; AX = segment of the next packet
mov word ptr Xmit_Buffer_Ptr+2, ax ; Bring the next one to the forefront
mov word ptr Xmit_Buffer_Ptr, 0

test es:[si].NIC_ECB_S.flags, ECB_FREE_XMIT
jz @F
push di
mov di, si
call free_NIC_ecb
pop di
@@: les si, Xmit_Buffer_Ptr ; ES:SI -> packet that should be in the waiting buffer
mov ax, Waiting_Xmit_Ptr ; Swap the current and waiting transmit registers
xchg Current_Xmit_Ptr, ax

cmp es:[si].NIC_ECB_S.in_use, IU_PROCESSING ; See if we can transmit
jne @F ; Skip if we can't transmit right away

mov Xmit_Retries, MAX_XMIT_RETRIES ; Set the retry count
call start_transmission ; Send it

@@: mov es:[si].NIC_ECB_S.completion, 1 ; Signal that this is ready for transmission
cmp es:[si].NIC_ECB_S.next, 0 ; See if end of the line
jz short_back_to_isr_loop

push di ; Save DI
mov es, es:[si].NIC_ECB_S.next ; ES -> next in line
mov es:[si].NIC_ECB_S.completion, 2 ; Signal that this is ready for the waiting buffer
push es
push si
les di, First_Write_Ptr
cmp es:[di].TASK_S.status, 0 ; See if this task packet is free
jz @F ; Skip if it is the 1st write
les di, Second_Write_Ptr
@@: mov es:TASK_S.priority, WRITE_PRIORITY
mov word ptr es:TASK_S.function, offset write_task
mov word ptr es:TASK_S.function+2, cs
pop word ptr es:TASK_S.buffer ; Restore the pointer to our ECB
pop word ptr es:TASK_S.buffer+2
call add_task
pop di ; Restore DI
jmp isr_loop

process_errors:
and al, 1Fh ; See if there is any error here
jz done_isr_ne2000 ; Quit if there is none

; *
; * All errors processed here
; *
sti
test al, XMIT_ERROR ; See if there was an error in transmission
jz process_recv_error ; Skip if a reception error

mov al, XMIT_ERROR ; Clear that interrupt
out dx, al

dec Xmit_Retries ; One less possible retry
jz @F ; Process the final failure, then do the next transmission in line
call start_transmission ; Transmit the current packet again
jmp isr_loop

@@: mov ax, IU_DONE+(CC_UNDELIVERED shl 8)
inc Total_Xmit_Errors
jmp isr10_loop

process_recv_error:
inc Total_Recv_Errors ; Bump the receive error count
mov al, RECEIVE_ERROR+OVERWRITE_WARNING
out dx, al
jmp isr_loop

; *
; * End the ISR here
; *
done_isr_ne2000:
mov In_ISR_ne2000, 0 ; Get rid of our semaphore
lea dx, [bp].NIC_S.int_mask
mov al, PACKET_RECEIVED+CRC_ERROR+FRAME_ALLIGNMENT_ERROR+FIFO_OVERRUN+MISSED_PACKET
out dx, al

done10_isr_ne2000:
iret

isr_ne2000 endp


; *************************************************************************************************
; *
; * void far TIME_ISR( void )
; * This is the timer tick interrupt service routine
; * Given:
; * nothing
; * Returns:
; * TIME_TOTAL_TICKS is incremented
; *
; *************************************************************************************************
even
time_isr proc far

push ds
push ax
push di

mov ax, @Data
mov ds, ax ; DS -> our segment
; *
; * Now do the time calculations
; *
add Tick_Count, 1 ; Increment the ticker
adc Tick_Count+2, 0

mov di, Seq_Ptr
mov al, [di]
inc di
or al, al
jnz @F
mov di, offset Seq_String+1
mov al, Seq_String
@@: mov Seq_Ptr, di
mov ds, _Screen_Segment
mov ds:[0], al

pop di
pop ax
pop ds
jmp dword ptr cs:[Old_Tick_Vector]

time_isr endp


end



  3 Responses to “Category : Files from Magazines
Archive   : SNOOP.ZIP
Filename : NE2000.ASM

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/