;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Cold-Load:T; Base:8; Readtable:ZL -*-

;;; This file contains the definitions for the mini ethernet system
;;; that are specific to the 3com ethernet board hosted on the multibus.

;;; these use plus because + may be funbound in the cold load!!.  Problem is it's
;;; set up by the crash list, and the order of evaluation is not assured.
(defconst 3com-mebase #x30000 "address of 3com ethernet controller")
(defconst 3com-mecsr 3com-mebase "control/status register for 3com interface")
(defconst 3com-meback (plus 2 3com-mecsr) "jam backoff counter for 3com interface")
(defconst 3com-address-rom (plus 3com-mebase #x400) "3com ethernet address ROM")
(defconst 3com-address-ram (plus 3com-mebase #x600) "3com ethernet address RAM")
(defconst 3com-transmit-buffer (plus 3com-mebase #x800) "3com transmit buffer")
(defconst 3com-buffer-a (plus 3com-mebase #x1000) "3com receive buffer A")
(defconst 3com-buffer-b (plus 3com-mebase #x1800) "3com receive buffer B")
(defconst 3com-meahdr 3com-buffer-a "header word of 3com buffer A")
(defconst 3com-mebhdr 3com-buffer-b "header word of 3com buffer B")

;;; Note: this code operates with the byte-ordering switch ON on the 3-COM board.
;;;  This sets "low byte first" mode, like the 8086 and unlike the 68000.
;;;  Setting it this way means data CAN be read from packet buffers with 32 bit transfers.
;;;  This is NOT the way the board was shipped by 3-COM.
;;;  This means the pictures in the manual are byte reversed!
;;;  In particular, the byte offset words in the buffer headers are byte reversed!!!

;;; The #. s below avoid bombout because byte is a defsubst and not in the cold load.
(defconst bbsw #.(byte 1 7))		;set if buffer B belongs to ether.
(defconst absw #.(byte 1 6))		;set if buffer A belongs to ether.
(defconst tbsw #.(byte 1 5))		;set if transmit buffer belongs to ether.
(defconst jam #.(byte 1 4))			;writing 1 clears jam.
(defconst amsw #.(byte 1 3))		;address in RAM is valid
(defconst rbba #.(byte 1 2))		;A/B receive buffer ordering.
   ; bit 1 not used
(defconst reset #.(byte 1 0))		;reset the controller.
(defconst binten #.(byte 1 15.))		;enable interrupts on buffer B.
(defconst ainten #.(byte 1 14.))		;enable interrupts on buffer A.
(defconst tinten #.(byte 1 13.))		;enable interrupts on transmit buffer.
(defconst jinten #.(byte 1 12.))		;enable interrupts on jam.
(defconst pa #.(byte 4 8.))		;which frame addresses to accept

(defconst 3com-csr-background-bits (logior (dpb 7 pa 0) (dpb 1 amsw 0)))


(defun arm-ethernet-for-receive ()
  (arm-3com-receive-buffer ABSW)
  (arm-3com-receive-buffer BBSW))

(defun write-3com-csr (new-csr)
;   (%multibus-write-8 3com-mecsr new-csr)
  (%multibus-write-16 3com-mecsr new-csr))

(defun read-3com-csr ()
  (%multibus-read-16 3com-mecsr))

(defun 3com-ethernet-reset ()
  (write-3com-csr 1)		;reset
  (setq *mini-my-ethernet-address* 0)
  (dotimes (i 6)
    (let ((next-byte (%multibus-read-8 (+ 3com-address-rom i))))
      (%multibus-write-8 (+ 3com-address-ram i) next-byte)
      (setq *mini-my-ethernet-address*
	    (dpb next-byte 0010 (ash *mini-my-ethernet-address* 8.)))))
  ;set up normal csr - address RAM valid, receive MINE + Broadcast packets
  (write-3com-csr 3com-csr-background-bits))

(defun wait-for-3com-buffer ()
  (do ()
      ((3com-mini-pkt-available))))

;;; multibus 3com receive buffer contains
;;; buffer-base:    meahdr (note byte reversed!!)
;;;          +2:    destination
;;;          +8:    source
;;;         +14:    type
;;;         +16:    data


(defun write-lambda-3com-frame-header (buffer-base offset source destination type)
  (setq offset (- offset 14.))
  (%multibus-write-8 (1+ buffer-base) (ldb 0010 offset)) ;offset reg is reversed!!!
  (%multibus-write-8  buffer-base (ldb 1010 offset))
  (%multibus-write-8 (+ buffer-base offset ) (ldb 5010 destination))
  (%multibus-write-8 (+ buffer-base offset 1) (ldb 4010 destination))
  (%multibus-write-8 (+ buffer-base offset 2) (ldb 3010 destination))
  (%multibus-write-8 (+ buffer-base offset 3) (ldb 2010 destination))
  (%multibus-write-8 (+ buffer-base offset 4) (ldb 1010 destination))
  (%multibus-write-8 (+ buffer-base offset 5) (ldb 0010 destination))

  (%multibus-write-8 (+ buffer-base offset 6) (ldb 5010 source))
  (%multibus-write-8 (+ buffer-base offset 7) (ldb 4010 source))
  (%multibus-write-8 (+ buffer-base offset 10) (ldb 3010 source))
  (%multibus-write-8 (+ buffer-base offset 11) (ldb 2010 source))
  (%multibus-write-8 (+ buffer-base offset 12) (ldb 1010 source))
  (%multibus-write-8 (+ buffer-base offset 13) (ldb 0010 source))
  
  (%multibus-write-8 (+ buffer-base offset 14) (ldb 0010 type))
  (%multibus-write-8 (+ buffer-base offset 15) (ldb 1010 type)))

(defun 3com-transmit-ethernet-16b-array (from-ether-host to-ether-host array nwords e-type)
  (let* ((physical-size (max (* nwords 2) 60.))
	 (offset (- 2048. physical-size))
	 (beginning-address (+ 3com-transmit-buffer offset)))
    (prog (csr start-time)
	  (setq start-time (%fixnum-microsecond-time))
       l  (setq csr (read-3com-csr))
	  (cond ((not (zerop (ldb jam csr)))
	       ;;(write-3com-csr (dpb 1 jam 3com-csr-background-bits))	;reset jam
		 (write-3com-csr (dpb 1 reset 0))
		 (write-3com-csr 3com-csr-background-bits)
		 (go l))
		((not (zerop (ldb tbsw csr)))
		 (cond ((> (time-difference (%fixnum-microsecond-time)
					    start-time)
			   100000.)
			(return nil))		;give up.
		       (t (go l)))))
	  (do ((adr beginning-address (+ adr 2))
	       (from-index 0 (1+ from-index))
	       (n (* nwords 2) (1- n)))
	      ((zerop n))
	    (let ((data (aref array from-index)))
	      (%multibus-write-8 adr (ldb 0010 data))
	      (%multibus-write-8 (1+ adr) (ldb 1010 data))))
	  (write-lambda-3com-frame-header 3com-transmit-buffer
					  offset
					  from-ether-host
					  to-ether-host
					  e-type)
	  (write-3com-csr (dpb 1 tbsw 3com-csr-background-bits))
	  (do ()
	      ((or (zerop (ldb tbsw (read-3com-csr)))
		   (not (zerop (ldb jam (read-3com-csr)))))))
	  (cond ((not (zerop (ldb jam (read-3com-csr))))
		 (write-3com-csr (dpb 1 reset 0))
		 (write-3com-csr 3com-csr-background-bits))))))

(defun 3com-mini-pkt-available ()
  (or (zerop (ldb absw (read-3com-csr)))
      (zerop (ldb bbsw (read-3com-csr)))))

(defun 3com-receive-ethernet-16b-array (array)
  (wait-for-3com-buffer)
  (do ((got-one nil))
      ((not (null got-one)) array)
    (setq got-one (receive-ethernet-with-buffer-ready array))))

(defun 3com-receive-ethernet-with-buffer-ready (array &aux got-one)
  (cond ((zerop (ldb absw (read-3com-csr)))
	 (setq got-one (receive-3com-ethernet-pkt-into-array 3com-buffer-a array))
	 (arm-3com-receive-buffer ABSW))
	((zerop (ldb bbsw (read-3com-csr)))
	 (setq got-one (receive-3com-ethernet-pkt-into-array 3com-buffer-b array))
	 (arm-3com-receive-buffer BBSW)))
  got-one)

(DEFUN ARM-3COM-RECEIVE-BUFFER (BYTE-PTR)
  (PROG ()
    L   (COND ((NOT (ZEROP (LDB TBSW (READ-3COM-CSR))))
	       (cond ((not (zerop (ldb jam (read-3com-csr))))
		      ;; (write-3com-csr (dpb 1 jam 3com-csr-background-bits))
		      (write-3com-csr (dpb 1 reset 0))
		      (write-3com-csr 3com-csr-background-bits)))
	       (GO L)))
        (WITHOUT-INTERRUPTS
	  (COND ((NOT (ZEROP (LDB TBSW (READ-3COM-CSR))))
		 (GO L)))
	  (write-3com-csr (dpb 1 BYTE-PTR 3com-csr-background-bits)))))


(defun 3com-get-ethernet-packet-type (buffer-base)
  (dpb (%multibus-read-8 (+ buffer-base 17))
       (byte 8. 8.)
       (%multibus-read-8 (+ buffer-base 16))))

;returns nil if the packet is not an interesting chaos packet
(defun receive-3com-ethernet-pkt-into-array (buffer-base array)
  (cond ((not (zerop (logand 250 (%multibus-read-8 buffer-base)))) ;fcs error, etc
	 nil)
	(t
	 (let ((type (3com-get-ethernet-packet-type buffer-base)))
	   (select type
	     (#x408 ;chaos-ethernet-type
	      (do ((adr (+ buffer-base 16.) (+ adr 2))
		   (wd-count 0 (1+ wd-count)))
		  ((>= wd-count 374)) ;chaos:max-words-per-pkt
		(aset (dpb (%multibus-read-8 (+ adr 1))
			   (byte 8. 8.)
			   (%multibus-read-8 adr))
		      array
		      wd-count))
;code to reread and check
;	      (do ((adr (+ buffer-base 16.) (+ adr 2))
;		   (wd-count 0 (1+ wd-count)))
;		  ((>= wd-count 374)) ;chaos:max-words-per-pkt
;		(if (or (not (= (%multibus-read-8 adr) (ldb (byte 8 0) (aref array wd-count))))
;			(not (= (%multibus-read-8 (+ adr 1)) (ldb (byte 8 8) (aref array wd-count)))))
;		    (ferror nil "read differently second time")))
	      t)
	     (#x608 ;address-resolution-type
	      ;;copy received data into pkt
	      (do ((adr (+ buffer-base 16.) (+ adr 2))
		   (wd-count 0 (1+ wd-count)))
		  ((>= wd-count 374))
		(aset (dpb (%multibus-read-8 (+ adr 1))
			   (byte 8. 8.)
			   (%multibus-read-8 adr))
		      array
		      wd-count))
	      (receive-addr-pkt array)		;record address; maybe send reply
	      nil))))))