;;;-*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*-


;;; Copyright LISP Machine, Inc. 1986
;;;   See filename "Copyright.Text" for		
;;; licensing and release information.


(defconst chaos-ethernet-type #x408 "ethernet type code for chaos protocol") ; =2010
(defconst address-resolution-type #x608 "ethernet type for address resolution") ; 3010

(defconst 3com-mebase #x30000 "address of 3com ethernet controller")
(defconst 3com-mecsr 3com-mebase "control/status register for 3com interface")
(defconst 3com-meback (+ 2 3com-mecsr) "jam backoff counter for 3com interface")
(defconst 3com-address-rom (+ 3com-mebase #x400) "3com ethernet address ROM")
(defconst 3com-address-ram (+ 3com-mebase #x600) "3com ethernet address RAM")
(defconst 3com-transmit-buffer (+ 3com-mebase #x800) "3com transmit buffer")
(defconst 3com-buffer-a (+ 3com-mebase #x1000) "3com receive buffer A")
(defconst 3com-buffer-b (+ 3com-mebase #x1800) "3com receive buffer B")
(defconst 3com-me-buffer-size 2048. "number of bytes in a buffer")

(DEFUN TEMP-BYTE (OVER NBITS) ;this definition compatible common lisp -NO IT ISNT, change it back
  "Creates a byte pointer from its arguments.
The first argument specifies the size of byte; the second is the number of bits from the
right of the number that the byte starts."
  (DPB OVER 0609 NBITS))	;"Make a byte pointer" 

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

(defconst bbsw (temp-byte 7. 1))		;set if buffer B belongs to ether.
(defconst absw (temp-byte 6. 1))		;set if buffer A belongs to ether.
 (defconst a+b-bsw (temp-byte 6. 2))		; both of the above.
(defconst tbsw (temp-byte 5. 1))		;set if transmit buffer belongs to ether.
(defconst jam (temp-byte 4. 1))			;writing 1 clears jam.
 (defconst tbsw+jam (temp-byte 4 2))
(defconst amsw (temp-byte 3. 1))		;address in RAM is valid
(defconst rbba (temp-byte 2. 1))		;A/B receive buffer ordering.
   ; bit 1 not used
(defconst reset (temp-byte 0. 1))		;reset the controller.
(defconst binten (temp-byte 15. 1))		;enable interrupts on buffer B.
(defconst ainten (temp-byte 14. 1))		;enable interrupts on buffer A.
(defconst tinten (temp-byte 13. 1))		;enable interrupts on transmit buffer.
(defconst jinten (temp-byte 12. 1))		;enable interrupts on jam.
(defconst pa (temp-byte 8. 4))		;which frame addresses to accept


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

(defun write-3com-csr (new-csr)
  (bus-write (+ (ash sdu-quad-slot 24.)
		3com-mecsr)		;byte address
	     new-csr))

(defun read-3com-csr ()
  (bus-read (+ (ash sdu-quad-slot 24.)
	       3com-mecsr)))		;byte address

(defun print-3com-csr ()
  (let ((csr (read-3com-csr)))
    (format t "~%Buf B belongs to ether: ~40t~d" (ldb bbsw csr))
    (format t "~%Buf A belongs to ether: ~40t~d" (ldb absw csr))
    (format t "~%Transmit buf belongs to ether: ~40t~d" (ldb tbsw csr))
    (format t "~%Jam: ~40t~d" (ldb jam csr))
    (format t "~%RAM valid: ~40t~d" (ldb amsw csr))
    (format t "~%A/B buffer ordering: ~40t~d" (ldb rbba csr))
    (format t "~%reset: ~40t~d" (ldb reset csr))	;probably write only
    (format t "~%Enable interrupts on B buffer: ~40t~d" (ldb binten csr))
    (format t "~%Enable interrupts on A buffer: ~40t~d" (ldb ainten csr))
    (format t "~%Enable interrupts on transmit buffer: ~40t~d" (ldb tinten csr))
    (format t "~%Enable interrupts on JAM: ~40t~d" (ldb jinten csr))
    (format t "~%pa: ~40t~d" (ldb pa csr))))

(defun reset-jam ()
  (cond ((not (zerop (ldb jam (read-3com-csr))))
	 (write-3com-csr (dpb 1 reset 0))
	 (write-3com-csr 3com-csr-background-bits)
	 )))

(defun arm-3com-buffers ()
  (write-3com-csr (dpb 1 absw 3com-csr-background-bits))
  (write-3com-csr (dpb 1 bbsw 3com-csr-background-bits)))

(defun print-3com-buffer (buf &optional (nwords 4))
  (let ((adr (if (eq buf 'a) 3com-buffer-a 3com-buffer-b)))
    (format t "~&ethernet header: ~20t")
    (dotimes (i nwords)
      (if (zerop (logand i 3)) (format t "~&"))
      (format t "  ~16,2,'0r  ~16,2,'0r  ~16,2,'0r  ~16,2,'0r"
	      (multibus-byte-read (+ adr (* 4 i)))
	      (multibus-byte-read (+ adr (* 4 i) 1))
	      (multibus-byte-read (+ adr (* 4 i) 2))
	      (multibus-byte-read (+ adr (* 4 i) 3))))))

(defconst %%3com-buffer-header-nbytes 0013)
(defconst %%3com-buffer-header-framing-error 1301)
(defconst %%3com-buffer-header-address-match 1401)
(defconst %%3com-buffer-header-range-error 1501)
(defconst %%3com-buffer-header-broadcast 1601)
(defconst %%3com-buffer-header-fcs-error 1701)

(defun print-3com-rcv-header (data)
  (format t "~&nbytes ~d." (ldb %%3com-buffer-header-nbytes data))
  (format t "~&framing-error ~s" (ldb %%3com-buffer-header-framing-error data))
  (format t "~&address-match ~s" (ldb %%3com-buffer-header-address-match data))
  (format t "~&range-error ~s" (ldb %%3com-buffer-header-range-error data))
  (format t "~&broadcast ~s" (ldb %%3com-buffer-header-broadcast data))
  (format t "~&fsc-error ~s" (ldb %%3com-buffer-header-fcs-error data)))

(defun print-xmit-buffer ()
  (let ((offset (dpb (multibus-byte-read  3com-transmit-buffer)
		     1010
		     (multibus-byte-read (1+ 3com-transmit-buffer)))))
    (format t "offset = ~s ~:* #x~16r; " offset)
    (dotimes (i 30)
      (format t "~16r " (multibus-byte-read (+ 3com-transmit-buffer offset i))))))