;;;   -*- Mode:LISP; Package:si; Base:10; Cold-load: T -*-

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

;;; From the file "NuBus-Basic"

;;              MACROS/FUNCTIONS TO READ & WRITE THE NuBUS

;;;
;;; Copyright (c) 1984 Texas Instruments Incorporated  All Rights Reserved
;;;

;; NOTE - %NuBus-Read & %NuBus-Write read & write 32 bit values.  There is not 
;;        currently any support to read or write other data widths.
;;      - SLOT is the upper 8 bits of NuBus address and not just the 4 bit
;;        slot number.

;; NOTE - Substs are used here for efficiency and convenience.
;;        The calls could just as easily been Macros for Functions.

;;----------------------------------------------------------------------------

(Defmacro LO-BYTE (word) `(LDB #o0010 ,word))
(Defmacro HI-BYTE (word) `(LDB #o1010 ,word))
(Defmacro SWAP-BYTES (word) `(DPB (lo-byte ,word) #o1010 (hi-byte ,word)))


(Defsubst LO-16B-WORD-P (addr)
  ;; Returns T if ADDR is the low 16 bits of the quad defined by ADDR.
  ;;  I.e T iff bit 1 is a zero.
  (zerop (ldb #o0101 addr)))

;;----------------------------------------------------------------------------
;; READ AND WRITE NuBUS
;;----------------------------------------------------------------------------
;;
(Defsubst NUBUS-READ (slot addr)
  "Return the 16bit value from NuBus at ADDR in SLOT-address."
  (Ldb (If (lo-16b-word-p addr) #o0020 #o2020)
       (%NuBus-Read slot addr)))


(Defsubst NUBUS-WRITE (slot addr val)
  "Writes a 16 bit value to NuBus.  DO NOT DEPEND on the returned value!"
  (%NuBus-Write slot
                addr
                (Dpb val                        ;Place value in ...
                     (If (lo-16b-word-p addr) #o0020 #o2020)
                     (%NuBus-Read slot addr)    ;...its part of the quad.
                     )))

;; Define (Setf (NuBus-Read slot adr) val).  
(Defsetf NuBus-Read NuBus-Write)                ;valid in Sys 98

;;----------------------------------------------------------------------------
;; READ & WRITE ETHERNET ADDRESS FIELDS.

;; NOTE - Ethernet addresses must be written in the buffer memory in the order
;;        in which they are transmitted and not in the order written on the board.
;;----------------------------------------------------------------------------

(Defsubst ENC-ETHER-ADDRESS (slot addr)
  "Read the Ethernet address at ADDR in SLOT."
  (Let ((temp 0))
    (Setq temp (deposit-byte temp  0  16. (swap-bytes (NuBus-Read slot (+ 4 addr)))))
    (Setq temp (deposit-byte temp 16. 16. (swap-bytes (NuBus-Read slot (+ 2 addr)))))
    (Setq temp (deposit-byte temp 32. 16. (swap-bytes (NuBus-Read slot addr))))
    temp))

(Defsubst SET-ENC-ETHER-ADDRESS (slot addr address)
  "Place ethernet addr, ADDRESS, at ADDR reletive to SLOT."
  (Nubus-Write slot addr       (swap-bytes (ldb #o4020 address)))
  (Nubus-Write slot (+ addr 2) (swap-bytes (ldb #o2020 address)))
  (Nubus-Write slot (+ addr 4) (swap-bytes (ldb #o0020 address))))

;; Define (SETF (ENC-ETHER-ADDRESS s a) value)
(Defsetf Enc-Ether-Address Set-Enc-Ether-Address)

;;----------------------------------------------------------------------------
;; READ & WRITE 24 BIT ADDRESS FIELDS
;;----------------------------------------------------------------------------
  
(Defsubst ADDRESS-FIELD (slot addr)
  "Read a 24 bit Address at ADDR, relative to SLOT, quad aligned."
  (LogAnd #xFFFFFF (%NuBus-Read slot addr)))

(Defsubst WRITE-ADDRESS-FIELD (slot addr address)
  "Place a 24 bit address, ADDRESS, at ADDR reletive to SLOT, quad aligned."
  (%Nubus-Write slot addr
                (DPB (LDB #o3010 (%NuBus-Read slot addr))
                     #o3010 address)))

;; Define (SETF (ADDRESS-FIELD s a) value)
(Defsetf Address-Field Write-Address-Field)

;;----------------------------------------------------------------------------
;; READ & WRITE TO BUFFERS
;;----------------------------------------------------------------------------
  
(Defsubst XFER-WORDS-TO-NuBUS (slot addr array start stop)
  "Copies ARRAY (between START & STOP-1) to the NuBus at SLOT, beginning at ADDR.
   ARRAY must be art16b,
   ADDR must be on quad boundary, START & STOP must be even."
  (Do ((Nuaddr addr (+ 4 nuaddr))
       (I start (+ 2 I)))
      ((>= i Stop))
    (%Nubus-Write slot nuaddr (Dpb (Aref array (1+ I)) #o2020 (Aref array I)))))

(Defsubst XFER-WORDS-FROM-NuBUS (slot addr array start stop)
  "Copies into ARRAY (between START & STOP-1) from the NuBus at SLOT,
 beginning at ADDR.
   ARRAY must be art16b, ADDR must be on quad boundary.
   Will *always* copy an EVEN number of bytes, beginning at START !"
  (Do (value
       (Nuaddr addr (+ 4 nuaddr))
       (I start (+ 2 I)))
      ((>= i Stop))
    (Setq Value (%Nubus-Read slot nuaddr))
    (Aset (Ldb #o0020 value) array i)
    (Aset (Ldb #o2020 value) array (1+ i))))

;;----------------------------------------------------------------------------
;; DEBUG ADDRESS REFERENCES
;;----------------------------------------------------------------------------
;;

(Defvar START-OF-BUFFERS 0)
(Defvar DEBUG-NUBUS-ADDRESSES nil)

;;;(Defun VERIFY-ADDRESS (slot address &optional (min 0) (max #x8000))
;;;  ;; NOTE - Any reference to slot #xFE will not generate a NuBus timeout error.
;;;  ;;  Only references to a slot with no board will give a NuBus timeout.
;;;  (when Debug-nubus-addresses
;;;    (cond ((not (= #xFE slot))
;;;           (cerror ':yes nil nil "Bad slot number ~16r." slot)))
;;;    (cond ((or (< address min) (> address max))
;;;           (cerror ':yes nil nil
;;;                   "NuBus address FE,~16r out of range (~16r - ~16r)."
;;;                   address min max)))))

;;--------------------------------------------------------------------
;;                        GENERAL PURPOSE MACROS
;;                           To Make Life Easier
;;--------------------------------------------------------------------

(Defsubst ROUND-UP-TO-EVEN (addr)
  "Round ADDR up to an even number."
  (Dpb 0 #o0001 (1+ addr)))

(eval-when (eval load compile)
(Defsubst ROUND-UP-TO-QUAD (addr)
  "Round ADDR up to an even multiple of 4."
  (Dpb 0 #o0002 (+ addr 3))))

(Defmacro ON-OFF (value)
  `(If (zerop ,value) "Off" "On"))

(Defmacro CONVERT-TO-WORDS (nbytes)
  `(Ash (1+ ,nbytes) -1))

(defvar *cold-load-debug* nil)

;;; cold load version.
(Defun Ethernet-Wait (whostate function &rest args)
  (when *cold-load-debug* (print whostate))
  ;; for cold-load just spin on function.
  (do () ((apply function args)))
  )

;;; cold load version.
(Defun Ethernet-Wait-with-Timeout (whostate timeout-in-60ths function &rest args)
  (when *cold-load-debug* (print whostate))
  (let ((timeout (%pointer-plus (si:%fixnum-microsecond-time) (* 16667. timeout-in-60ths))))
    (do () ((apply function args) t)
      ;; time-difference isn't in cold load
      (when (> (ldb 23. (%pointer-difference (si:%fixnum-microsecond-time) timeout)) 0)
	;; timed out.
	(return nil))))
  )

;;--------------------------------------------------------------------
;;                             NuBUS MACROS
;;                       To Make Life Still Easier Yet
;;--------------------------------------------------------------------

;; These are compile-time macros used to generate the Functions, etc. in this file.
;; They are not used at run time.


;; The Macros generated by the next two Macros can be used with (SETF (...) ...).
;; The generated MACRO will default the offset field to the System Control Block (SCB).

(defmacro DEF-NuFIELD (name field-offset comment)
  ;;Create a MACRO called NAME to access the field at displacement FIELD-OFFSET.
  ;;The MACRO take 2 args; the TI-NUBUS-ETHERNET-CONTROLLER and base addr of the block.
  `(Defmacro ,NAME (enc  &optional block-offset)
     ,comment
     (if block-offset
         `(NuBus-Read (ENC-slot ,enc) (+ ,',field-offset ,block-offset))
       `(NuBus-Read (ENC-slot ,enc) (+ ,',field-offset (ENC-SCB ,enc)))
       ))
  )

(defmacro DEF-NuBYTEF (name word byte-desc comment)
  ;;Create a MACRO called NAME to access a byte field, described by BYTE-DESC,
  ;; in the field accessed by (WORD ,enc ,base).
  ;;The MACRO take 2 args; the TI-NUBUS-ETHERNET-CONTROLLER and the base addr
  ;;of the block.
  `(Defmacro ,NAME (enc &optional block-base)
     ,comment
     (if block-base
         `(Ldb ,',byte-desc (,',word ,enc ,block-base))
       `(Ldb ,',byte-desc (,',word ,enc (Enc-SCB ,enc)))
       ))
  )

;;--------------------------------------------------------------------

(Defmacro PRINT-FLAG-DOC (state flag base-addr)
  "Sends output to STREAM, and uses ENC (controller."
  `(When (= ,state (,flag enc ,base-addr))
     (terpri stream)
     (princ (documentation #',flag) stream)))

;;; Not for cold load.
;;;(Defmacro ISSUE-COMMAND (enc &Body body)
;;;  "Without interrupts, Ensure that SCB is free, eval BODY to set the command
;;;   & issue the Channel-Attention."
;;;  `(Do ((i 1 (1+ i))
;;;        (INHIBIT-SCHEDULING-FLAG T))
;;;       ((zerop (SCB-Command ,enc))
;;;        ,@body
;;;        (Channel-Attention ,enc))
;;;     (Setq INHIBIT-SCHEDULING-FLAG  nil)
;;;     (when (> i 1000.)
;;;       (cerror ':Yes nil nil
;;;"Previous command to Ethernet Controller did not clear after ~D PROCESS-ALLOW-SCHEDULE"
;;;  i)
;;;       (setq i 1))
;;;     (Process-Allow-Schedule)
;;;     (Setq INHIBIT-SCHEDULING-FLAG  T)))

;;; Cold Load version of the above.
(Defmacro ISSUE-COMMAND (enc &Body body)
  "Ensure that SCB is free, eval BODY to set the command
   & issue the Channel-Attention."
  `(Do ((i 1 (1+ i)))
       ((zerop (SCB-Command ,enc))
        ,@body
        (Channel-Attention ,enc))
     (when (> i 50000.)
;       (print "ISSUE-COMMAND took too long - resetting" si:cold-load-stream)
       (nubus-ethernet-reset)
       (return nil)
       )))

;;; From the file "Nu-Ether-Defs"
;;;
;;; Copyright (c) 1984 Texas Instruments Incorporated  All Rights Reserved
;;;

;;--------------------------------------------------------------------
;;              DESCRIPTION OF NuBUS ETHERNET CONTROLLER
;;--------------------------------------------------------------------

(Defvar Nubus-receive-frame-errors 0)
(Defvar Nubus-receive-frame-error-list nil)

;; Miscellaneous constants which help define the Ethernet environment
(Defconst *MAX-NUMBER-BYTES*   1024. "Max number bytes in a buffer")
                              ;Field allows 16K, we don't have that much space.
(Defconst *INTERRUPT-DRIVEN-P*   nil "T if interrupt driven, NIL if polled.")
                                                ;No interrupt capability yet.

;; Effective size of fields in the buffer memory space
(Defconst SCP-SIZE  10 "Bytes in System Configuration Pointer")
(Defconst ISCP-SIZE #.(Round-up-to-quad  8) "Bytes in Intermediate System Control Pointer")
(Defconst SCB-SIZE  #.(Round-up-to-quad 20) "Bytes in System Control Block")
(Defconst COMMAND-SIZE       #.(Round-up-to-quad 18) "Bytes in a Command Block")
(Defconst RECEIVE-BLOCK-SIZE #.(Round-up-to-quad 22) "Bytes in a Receive Frame Descriptor.")
(Defconst TBD-SIZE  #.(Round-up-to-quad  8) "Bytes in a Transmit Buffer Descriptor")
(Defconst RBD-SIZE  #.(Round-up-to-quad 10) "Bytes in a Receive Buffer Descriptor")
(Defconst DUMP-AREA-SIZE #.(Round-up-to-quad 170) "Bytes required for 586 Dump buffer")


;; Modify following values to change the default description of a NuBus Controller

(Defstruct (NUBUS-ETHERNET-CONTROLLER (:conc-name ENC-))
  ;; All sizes are in Bytes.
  (Request-Lock nil)               ; Mutual exclusion to use the COMMAND UNIT.
  ;; You MUST have this lock before alloc a transmit CB or buffer or issuing an action command.
  (Write-Lock nil)                 ; Mutual exclusion to Write to controller, not used.
  (Slot #xFB)                      ; Slot number of this controller
  (ISCP 0)                         ; Address of Intermediate System Contol Pointer
  (SCB ISCP-Size)                  ; Offset to the System Control Block
  (Config-Register 0)              ; Last value written to Config Register.
  (Memory-Size (* 32 1024.))       ; Size of memory buffer.
  (Transmit-Buffer-Size 56.)       ; Size of the transmit buffers.
  (Transmit-Buffers-Per-Frame 6)   ; Number of buffers per command block.
  (Receive-Buffer-Size 56.)        ; Size of the receive buffers.
  (Receive-Buffers-Per-Frame 8)    ; Number of buffers / Recv. Frame descriptor.
  (Last-RBD -1)                    ; Offset to the last Free RBD.
  (Last-Free-RFD -1)               ; Offset to the last free RFD.
  )

;; Computed "slots" in the Defstruct

(Defmacro ENC-TRANSMIT-FRAME-SIZE (enc)         ; Number bytes / Command Block
  `(+ COMMAND-SIZE
      (* (ENC-Transmit-Buffers-Per-Frame ,enc)
         (+ (ENC-Transmit-Buffer-Size ,enc) TBD-SIZE))))

(Defmacro ENC-RECEIVE-FRAME-SIZE (enc)          ; Number of bytes / Recv. Frame Desc.
  `(+ RECEIVE-BLOCK-SIZE
      (* (ENC-Receive-Buffers-Per-Frame ,enc)
         (+ (ENC-Receive-Buffer-Size ,enc) RBD-SIZE))))

(Defmacro ENC-SCP-ADDR (enc)                    ; location of System Config ptr
  `(- (ENC-Memory-size ,enc) SCP-SIZE))

;;--------------------------------------------------------------------
;;                         BASIC DATA STRUCTURES
;;
;; Note - ALL blocks defined on the following pages MUST start on a Quad
;;        boundary.  The constructor functions all ASSUME that they are
;;        given a valid quad address.  They also assume that their other
;;        parameters are valid.
;;--------------------------------------------------------------------
;;                HARDWARE CONSTANTS FOR THIS CONTROLLER
;;--------------------------------------------------------------------

;; Fixed locations within the NuBus Ether Controller memory
(Defconst *CHANNEL-ATTENTION-ADDR* #x008000 "Hit this address to assert CA")
(Defmacro *CHANNEL-ATTENTION-ADDR* () #x008000)
(Defconst *EVENT-ADDRESS-REGISTER* #x00A000 "Contains address for event register")
(Defconst *CONFIG-REGISTER*        #x00C000 "Address of config register")
(Defmacro *CONFIG-REGISTER* ()     #x00C000)    ; "Address of config register"
(Defconst *SCP-ADDR*               #xFFFFF6 "Address of Sys Config Ptr.")

;; Standard constants for this controller
(Defmacro *NULL-STATUS* ()   0)                 ;"A status word with everything set to nil"
(Defmacro *NORMAL-FINISH* () #xA000)            ;Normal, correct completion.
(Defmacro *NULL-COMMAND* ()  0)                 ;A Null command.
(Defmacro *NULL-CMD-EOL* ()  #x8000)            ;A Null command with End-Of-List on.
(Defmacro *NULL-PTR* ()      #xFFFF)            ;An 82586 nil pointer.

;;--------------------------------------------------------------------
;;                     SYSTEM CONFIGURATION POINTER
;;--------------------------------------------------------------------
;;
;; Note: the SCP always starts at #xFFFFF6 in the chip addr space.

(Defun SET-SCP-SYSBUS-WIDTH (enc bit-width)
  "ENC is the <Slot> address; BIT-WIDTH is bit width of data bus (8 or 16)."
  (NuBus-Write (Enc-slot enc) (ENC-SCP-ADDR enc) (If (= bit-width 8) 1 0)))

(Defun READ-SCP-SYSBUS-WIDTH (enc)
  (Let ((encoded-width (LDB #o0010 (NuBus-Read (Enc-slot enc) (ENC-SCP-ADDR enc)))))
    (Selectq encoded-width
      (0 16)
      (1 8)
      (t (print "Invalid width code for NuBus EtherNet controller")))))

(Defsubst ISCP-ADDRESS (enc)
  "The address of the ISCP in the System Config. Pointer."
  (Address-Field (Enc-slot enc) (+ (ENC-SCP-ADDR enc) 6)))


(Defun PRINT-SCP (enc &optional (stream terminal-io))
  "Prints the values in the SCP of ENC on STREAM."
  (terpri stream) (princ "System Bus Width (bits) = " stream)
  (princ (Read-scp-sysbus-width enc) stream)
  (terpri stream) (princ "ISCP Address = " stream)
  (princ (iscp-address enc) stream))

;;--------------------------------------------------------------------
;;              INTERMEDIATE SYSTEM CONTROL POINTER (ISCP)
;;--------------------------------------------------------------------


(Def-NuField SCB-BUSY-WORD 0 "Low Byte is 1 if busy, 0 otherwise.")
(Def-NuField SCB-OFFSET    2 "Offset of SCB relative to SCB-BASE.")
(Defsubst    SCB-BASE (Enc addr)
  "Base address (relative to slot) for all blocks in buffer area, except buffers."
  (Address-Field (ENC-slot enc) (+ addr 4)))


(Defun INIT-ISCP (enc addr SCB-pointer)
  "Initialize the ISCP to location ADDR.
   SCB-POINTER = offset to SCB, the SCB-Base is assumed to be zero."
  (Setf (ENC-ISCP enc) addr)                    ;Save Address of ISCP in slot.
  (Setf (SCB-BUSY-WORD enc ADDR) #x01)          ;Set board busy
  (Setf (SCB-OFFSET    enc ADDR) SCB-Pointer)   ;set addr of SCB
  (Setf (SCB-BASE      enc ADDR) 0)             ;Base is 0.
  )

(Defun ISCP-BUSYP (enc)
  "Returns T if the ISCP BUSY flag is set for controller ENC."
  (not (zerop (LDB #o0010 (SCB-BUSY-WORD enc (ENC-ISCP enc))))))


(Defun PRINT-ISCP-STATUS (enc &optional (stream terminal-io))
  "Prints the Status of the ISCP of ENC on STREAM."
  (terpri stream) (Princ "Initialization: " stream)
  (princ (If (ISCP-Busyp enc) "In Progress" "Complete") stream))

(Defun PRINT-ISCP (enc &optional (stream terminal-io))
  "Prints the ISCP of ENC on STREAM."
  (Print-ISCP-Status enc stream)
  (terpri stream) (princ "SCB base address = " stream)
  (princ (SCB-Base enc (enc-iscp enc)) stream)
  (terpri stream) (princ "SCB offset address = " stream)
  (princ (SCB-Offset enc (enc-iscp enc)) stream))

;;--------------------------------------------------------------------
;;                  SYSTEM CONTROL BLOCK DEFINITIONS
;;--------------------------------------------------------------------

;; Only first 8 words are standard part of the SCB.  Rest are added for this application.

(Def-NuField SCB-STATUS     0  "SCB Status word (read only).")
(Def-NuField SCB-COMMAND    2  "Read SCB Command word.")
(Def-NuField SCB-CBL-OFFSET 4  "Ptr to Command Block List.")
(Def-NuField SCB-RFA-OFFSET 6  "Ptr to Receive Frame Area.")
(Def-NuField SCB-CRCERRS    8  "CRC Error counter.")
(Def-NuField SCB-ALNERRS   10. "Misaligned frame counter.")
(Def-NuField SCB-RSCERRS   12. "Counter of frames dropped because no buffers available.")
(Def-NuField SCB-OVRNERRS  14. "Counter of frames lost to lack of bus availability.")
(Def-NuField SCB-FREE-CBL  16. "Ptr to list of free Command Blocks.")
(Def-NuField SCB-FREE-TBD  18. "Ptr to list of free Transmit Buffer descriptors.")

(Def-NuBytef SCB-INT-FLAGS  Scb-Status #o1404 "Interrupt status flags")
(Def-NuBytef SCB-CX-FLAG    Scb-Status #o1701 "Interrupted command executed?")
(Def-NuBytef SCB-FR-FLAG    Scb-Status #o1601 "Frame received interrupt")
(Def-NuBytef SCB-CNR-FLAG   Scb-Status #o1501 "Command unit not ready interrupt")
(Def-NuBytef SCB-RNR-FLAG   Scb-Status #o1401 "Receive unit not ready interrupt")
(Def-NuBytef SCB-COMMAND-UNIT-STATUS Scb-Status #o1003 "Status of command unit") 
(Def-NuBytef SCB-RECEIVE-UNIT-STATUS Scb-Status #o0403 "status of command unit")

(Def-NuBytef SCB-ACK-INT  Scb-Command #o1404 "Ack Interrupts command")
(Def-NuBytef SCB-ACK-CX   Scb-Command #o1701 "Ack CX interrupt")
(Def-NuBytef SCB-ACK-FR   Scb-Command #o1601 "Ack FR Interrupt")
(Def-NuBytef SCB-ACK-CNR  Scb-Command #o1501 "Ack CNR Interrupt")
(Def-NuBytef SCB-ACK-RNR  Scb-Command #o1401 "Ack RNR Interrupt")
(Def-NuBytef SCB-CONTROL-COMMAND Scb-Command #o1003 "Control unit command")
(Def-NuBytef SCB-RESET           Scb-Command #o0701 "Reset the controller chip")
(Def-NuBytef SCB-RECEIVE-COMMAND Scb-Command #o0403 "Receive unit command")


(Defmacro SCB-CURRENT-RECEIVE-FRAME (enc)
  "Pointer to the current receive-frame for ENC."
  `(Command-Link ,enc (Enc-Last-Free-RFD ,enc)))

;; Command and Receive Unit States
(Defmacro Idle-State ()      0)
(Defmacro Suspended-State () 1)
(Defmacro Command-Ready ()   2)
(Defmacro No-Resources ()    2)
(Defmacro Receive-Ready ()   4)

;; Transmit & Receive Unit Commands
(Defmacro NOP ()     0)
(Defmacro START ()   1)
(Defmacro RESUME ()  2)
(Defmacro SUSPEND () 3)
(Defmacro ABORT ()   4)

(Defsubst FRAME-RECV-INT-P (enc)  (= 1 (SCB-FR-Flag enc)))

;;--------------------------------------------------------------------
;; INITIALIZE SCB 

(Defun INIT-SCB (enc addr cmd-ptr rec-ptr)
  "Make & initialize the SCB for controller described by ENC.
   Place SCB at ADDR, initialize CBL to CMD-PTR, and RFA to REC-PTR."
  (Setf (Enc-SCB enc) addr)                     ;Remember SCB address.
  (Setf (SCB-Status     enc addr) (*NULL-STATUS*))
  (Setf (SCB-Command    enc addr) (*NULL-COMMAND*))       ;NOP the command word.
  (Setf (SCB-CBL-Offset enc addr) (*NULL-PTR*))
  (Setf (SCB-RFA-Offset enc addr) rec-ptr)
  (Setf (SCB-Free-CBL   enc addr) cmd-ptr)      ;List of free Command Blocks
  (Setf (SCB-Free-TBD   enc addr) (*NULL-PTR*))
  (Reset-SCB-Stats enc)                         ; clear the statistics fields.
  addr)

(Defun RESET-SCB-STATS (enc)
  "Set the Statistics fields for ENC to Zero."
  (Setf (SCB-Crcerrs   enc) 0)            ;Zero CRC errors.
  (Setf (SCB-Alnerrs   enc) 0)            ;Zero alignment errors.
  (Setf (SCB-Rscerrs   enc) 0)            ;Zero frames lost to "no resources"
  (Setf (SCB-Ovrnerrs  enc) 0)            ;Zero frames lost to bus not available
  )

;;--------------------------------------------------------------------
;; PRINT SCB INFO

(Defun PRINT-SCB-STATE (enc &optional (stream terminal-io))
  "Print the entire state of the SCB for ENC."
  (Print-SCB-Status enc stream)
  (Print-CBL-Status enc stream t)               ;print status of 1st item on CBL.
  (Print-RFA-Status enc stream t)
  (terpri stream) (princ "Free Block: " stream) (princ (SCB-Free-CBL enc) stream)
  (terpri stream) (princ "Free Buff : " stream) (princ (SCB-Free-TBD enc) stream)
  (Print-SCB-Stats enc nil stream)              ;Don't reset the counts.
  )

(Defun PRINT-SCB-STATUS (enc &optional (stream terminal-io) &aux (SCB (Enc-SCB enc)))
  "Print the Status of the SCB for ENC on STREAM."
  (terpri stream) (princ "Interrupts Pending: " stream)
  (If (= 0 (SCB-Int-Flags enc scb))
      (Princ "None" stream)
    (If (= 1 (SCB-CX-Flag enc SCB)) (Princ  "CX " stream))
    (If (= 1 (SCB-FR-Flag enc SCB)) (Princ  "FR " stream))
    (If (= 1 (SCB-CNR-Flag enc SCB)) (Princ "CNR " stream))
    (If (= 1 (SCB-RNR-Flag enc SCB)) (Princ "RNR " stream)))
  (terpri stream) (princ "Command Unit = ")
  (princ (select (SCB-Command-Unit-Status enc scb)
	    (((Idle-state))      "Idle")
	    (((Suspended-state)) "Suspended")
	    (((Command-Ready))   "Active")
	    (otherwise       "Invalid State")) stream)
  (terpri stream) (princ "Read Unit = " stream)
  (princ (select (SCB-Receive-Unit-Status enc scb)
	    (((Idle-state))      "Idle")
	    (((Suspended-State)) "Suspended")
	    (((No-Resources))    "No Resources")
	    (((Receive-Ready))   "Ready")
	    (otherwise       "Invalid State")) stream))

(Defun PRINT-SCB-STATS (enc &optional reset-p (stream terminal-io))
  "Print the statistics for the SCB at ENC."
  (terpri stream) (princ "CRC Errors:              " stream) (princ (SCB-CRCerrs enc) stream)
  (terpri stream) (princ "Misaligned Frames:       " stream) (princ (SCB-ALNerrs enc) stream)
  (terpri stream) (princ "Frames lost, no buffers: " stream) (princ (SCB-RscErrs enc) stream)
  (terpri stream) (princ "Frames lost, no bus:     " stream) (princ (SCB-OvrnErrs enc) stream)
  (if reset-p (Reset-Scb-Stats enc)))

;;--------------------------------------------------------------------
;;                     COMMAND BLOCK DEFINITIONS

(Def-NuField COMMAND-STATUS      0 "The Status word of a command block")
(Def-NuField COMMAND-WORD        2 "The Command word of a command block.")
(Def-NuField COMMAND-LINK        4 "Pointer to next command block.")
(Def-NuField COMMAND-BUFFER-PTR  6 "Pointer to 1st buffer of frame.")
;(De-Nufield COMMAND-DESTINATION-ADDR 8 "Ether address field")
(Def-Nufield COMMAND-FRAME-TYPE 14 "Type of frame to transmit.")

(Defsubst COMMAND-DESTINATION-ADDR (enc addr)
  "Ethernet Destination address of this frame."
  (ENC-ETHER-ADDRESS (enc-slot enc) (+ addr 8)))

(Defsubst BLOCK-PARAMETER (enc offset parm-number)
  "PARM-NUMBER (starts at 0) parameter to the command block."
  (NuBus-Read (ENC-slot enc) (+ 6 parm-number parm-number offset)))

;; Additional fields of COMMAND-STATUS

(Def-NuBytef COMMAND-COMPLETE-FLAG Command-Status #o1701 "Command is complete")
(Def-NuBytef COMMAND-BUSY-FLAG     Command-Status #o1601 "Controller executing this command.")
(Def-NuBytef COMMAND-EXECUTION-STATUS Command-Status #o1602 "State of frame block")
(Def-NuBytef COMMAND-STATUS-FIELD  Command-Status #o0016 "Command specific status.")
(Def-NuBytef COMMAND-ERROR-FLAG    Command-Status #o1501 "No error occured during execution.")
   ;; below are transmit errors
(Def-NuBytef COMMAND-ABORT-ERROR   Command-Status #o1401 "Command aborted.")
(Def-NuBytef COMMAND-DIAGNOSE-FAIL Command-Status #o1301 "586 failed DIAGNOSE test")
(Def-NuBytef COMMAND-NO-CARRIER    Command-Status #o1201 "Carrier sense lost, xmit failed.")
(Def-NuBytef COMMAND-NO-CLEAR-SEND Command-Status #o1101 "Xmit failed, lost Clear to Send.")
(Def-NuBytef COMMAND-XMIT-DEFERRED Command-Status #o0701 "Xmit deferred, link activity.")
(Def-NuBytef COMMAND-RETRY-ERROR   Command-Status #o0501 "Number of retries exhausted.")
(Def-NuBytef COMMAND-RETRY-COUNT   Command-Status #o0004 "Number of collisions (retries).")

(Def-NuBytef COMMAND-END-OF-LIST    Command-Word #o1701 "This is last block on list.")
(Def-NuBytef COMMAND-SUSPEND-FLAG   Command-Word #o1601 "Suspend after this block.")
(Def-NuBytef COMMAND-INTERRUPT-FLAG Command-Word #o1501 "Interrupt after this block.")
(Def-NuBytef COMMAND-BLOCK-CMD      Command-Word #o0003 "Command byte.")

;; VALUES for COMMAND-EXECUTION-STATUS
(Defmacro COMMAND-READY-TO-EXECUTE () 0)
(Defmacro COMMAND-EXECUTING ()        1)
(Defmacro COMMAND-COMPLETE ()         2)
;(Defmacro COMMAND-AVAILABLE ()        3)   ; not used

;; COMMAND Numbers for Command-Block-Cmd field.
(Defmacro NOP-COMMAND ()     "NOP command"                                   0)
(Defmacro ADDRESS-SETUP ()   "Load Chip with my address"                     1)
(Defmacro CONFIGURE ()       "Send Configuration parameters to chip"         2)
(Defmacro MULTICAST-SETUP () "Load Chip with Multicast addresses to accept." 3)
(Defmacro TRANSMIT ()        "Transmit a frame"                              4)
(Defmacro TDR-COMMAND ()     "Time Domain Reflectometer test"                5)
(Defmacro DUMP-STATUS ()     "Dump Status registers of 586 chip"             6)
(Defmacro DIAGNOSE-586 ()    "Perform diagnostics on the 586 chip"           7)

;;--------------------------------------------------------------------
;;                     RECEIVE FRAME DEFINITIONS
;;--------------------------------------------------------------------


;; First 5 fields are the same as for a Command Block

;(Def-NuField COMMAND-STATUS      0 "The Status word of a command block")
;(Def-NuField COMMAND-WORD        2 "The Command word of a command block.")
;(Def-NuField COMMAND-LINK        4 "Pointer to next command block.")
;(Def-NuField COMMAND-BUFFER-PTR  6 "Pointer to 1st buffer of frame.")
;(Defsubst    COMMAND-DESTINATION-ADDR (enc addr)
;  "Ethernet Destination address of this frame."
;  (ENC-ETHER-ADDRESS (enc-slot enc) (+ addr 8)))
(Defsubst    RECEIVE-SOURCE-ADDR (enc addr)
  "Ethernet source address of this frame."
  (ENC-ETHER-ADDRESS (enc-slot enc) (+ addr 14)))
(Def-Nufield RECEIVE-FRAME-TYPE 20 "Type of frame received.")

(Def-NuBytef COMMAND-CRC-ERROR     Command-Status #o1301 "CRC error in aligned frame.")
(Def-NuBytef COMMAND-ALIGN-ERROR   Command-Status #o1201 "CRC error in misaligned frame.")
(Def-NuBytef COMMAND-BUFFER-ERROR  Command-Status #o1101 "Ran out of buffer space.")
(Def-NuBytef COMMAND-DMA-ERROR     Command-Status #o1001 "DMA Over(under)run recv (xmit)")
(Def-NuBytef COMMAND-TOO-SHORT     Command-Status #o0701 "Frame too short.")
(Def-NuBytef COMMAND-NO-EOF-ERROR  Command-Status #o0601 "No EOF Flag, for bitstuffing only.")


;;--------------------------------------------------------------------
;;                      BUFFER DEFINITIONS
;;--------------------------------------------------------------------

(Def-NuField BUFFER-COUNT 0 "Number of data bytes in buffer; & flags")
(Def-NuField BUFFER-LINK  2 "Link to next buffer in frame")
(Defsubst    BUFFER-ADDRESS (enc addr)
  "Pointer to Buffer."
  (Address-Field (Enc-slot enc) (+ addr 4)))
(Def-NuField BUFFER-SIZE-WORD  8 "Size of buffer in bytes.") ;Receive buffers only.

(Def-NuBytef BUFFER-BYTE-COUNT   Buffer-Count #o0016 "Number of data bytes in buffer.")
(Def-NuBytef BUFFER-FULL         Buffer-Count #o1601 "Buffer has been filled.")
(Def-NuBytef BUFFER-END-OF-FRAME Buffer-Count #o1701 "This is the last buffer in the frame")

(Def-NuBytef BUFFER-END-OF-FBL   Buffer-Size-Word  #o1701 "End of list marker")
(Def-NuBytef BUFFER-SIZE         Buffer-Size-Word  #o0016 "Size of Buffer in bytes")


(Defun ART16b-TO-BUFFER (enc Descriptor array words-to-copy)
  "Copies ARRAY (an art-16b) to the buffer described at BD.
   Returns NIL if ran out of room, else the address of the last buffer desc. used.
   Does not change the contents past the length of the array.
   *ASSUMES* that WORDS-TO-COPY is <= (Length ARRAY), rounded up to an even number."
  (Do* ((buff-size (Convert-To-Words (ENC-Transmit-buffer-size enc)))
        (slot (Enc-Slot enc))
        (Prev-BD Descriptor BD)                 ; the previous value of BD
        (BD Descriptor (buffer-link enc BD))    ; current buffer descriptor.
        (i 0 next)                              ; Where this buffer begins in ARRAY.
        (next (min words-to-copy buff-size)     ; Next value of I.
              (min words-to-copy (+ next buff-size))))
       ((>= i words-to-copy) Prev-BD)                ; return last buffer desc.
    (If (= BD (*NULL-PTR*)) (Return nil))       ; Error, ran out of buffers.
    (XFER-WORDS-TO-NUBUS slot (buffer-address enc BD) array i next)
    (Setf (Buffer-Count enc BD) (* 2 (- next i)))       ;also clears EOL flag.
    ))

(Defun BUFFER-TO-ART16b (enc descriptor array)
  "Copies the contents of buffer described at DESCRIPTOR to ARRAY (an art-16b).
   Returns NIL if ran out of room, else the number of bytes copied."
  (Declare (Return-List num-bytes-in-array))
  (Do ((array-length (array-length array))
       (i 0 next)                               ;index into array
       next                                     ;Next value of I.
       (BD descriptor
           (if (= 1 (Buffer-end-of-frame enc BD))
               (*NULL-PTR*)                     ;End of buffer list.))
             (Buffer-Link enc BD))))
      ((= (*NULL-PTR*) BD) (* 2 i))             ;Return bytes copied.
    (Setq next (+ i (Convert-To-Words (Buffer-Byte-Count enc BD))))
    (When (> (round-up-to-even next) array-length)
      (Return nil))                             ;Error Return
    (Xfer-words-from-NuBus (ENC-Slot enc) (Buffer-Address enc BD) array i next)))

;;--------------------------------------------------------------------
;;		 PRINT COMMAND & RECEIVE BLOCK STATUS

(Defun PRINT-GENERIC-FRAME-STATUS (enc frame-address &optional (stream terminal-io))
  "Prints the status info common to all frame blocks.
   FRAME-ADDRESS is the address of the frame."
  (When (= 0 (Command-execution-status enc frame-address))
      (terpri stream) (princ "Block is available" stream))
  (Print-Flag-Doc 1  COMMAND-COMPLETE-FLAG frame-address)
  (Print-Flag-Doc 1  COMMAND-BUSY-FLAG     frame-address)
  (Print-Flag-Doc 1  Command-Error-Flag    frame-address))


(Defun PRINT-COMMAND-NAME (enc cmd-block &optional (stream terminal-io))
  (princ (documentation (select (Command-block-cmd enc cmd-block)
                          (((nop-command))     'nop-command)
                          (((address-setup))   'address-setup)
                          (((configure))       'configure)
                          (((multicast-setup)) 'multicast-setup)
                          (((transmit))        'transmit)
                          (((tdr-command))     'tdr-command)
                          (((dump-status))     'dump-status)
                          (((diagnose-586))    'diagnose-586)))
         stream))

(Defun PRINT-COMMAND-BLOCK-STATUS (enc cmd-block &optional (stream terminal-io))
  "Prints the status info for a command block."
  (terpri stream) (princ "COMMAND-BLOCK STATUS: Address = " stream) (princ cmd-block stream)
  (terpri stream) (princ "Command: " stream) (Print-Command-Name enc cmd-block stream)
  (Print-generic-frame-status enc cmd-block stream)
  (Print-Flag-Doc 1  Command-Diagnose-Fail cmd-block)
  (Print-Flag-Doc 1  Command-Abort-Error   cmd-block)
  (Print-Flag-Doc 1  Command-No-Carrier    cmd-block)
  (Print-Flag-Doc 1  Command-No-Clear-send cmd-block)
  (Print-Flag-Doc 1  Command-DMA-Error     cmd-block)
  (Print-Flag-Doc 1  Command-Xmit-Deferred cmd-block)
  (Print-Flag-Doc 1  Command-Retry-Error   cmd-block)
  (When (> 0 (Command-Retry-Count enc cmd-block))
    (terpri stream) (princ "Frame collisions: " stream)
    (princ (Command-Retry-Count enc cmd-block) stream)))


(Defun PRINT-RECEIVE-FRAME-STATUS (enc frame &optional (stream terminal-io))
  "Prints the status info for a receive frame block."
  (terpri stream) (princ "RECEIVE-FRAME STATUS: Address = " stream) (princ frame stream)
  (Print-generic-frame-status enc frame stream)
  (Print-Flag-Doc 1 Command-CRC-Error    frame)
  (Print-Flag-Doc 1 Command-Align-Error  frame)
  (Print-Flag-Doc 1 Command-Buffer-Error frame)
  (Print-Flag-Doc 1 Command-DMA-Error    frame)
  (Print-Flag-Doc 1 Command-Too-Short    frame)
  (Print-Flag-Doc 1 Command-No-EOF-Error frame))


(Defun PRINT-RECEIVE-BUFFER-STATUS (enc buff &optional (stream terminal-io))
  "Prints the state of the receive Buffer at BUFF."
  (terpri stream)
  (princ "Receive Buffer Descriptor: " stream) (princ buff stream)
  (princ ", Buffer: " stream) (princ (Buffer-Address enc buff) stream)
  (princ ", Size (bytes) = " stream) (princ (Buffer-Size enc buff) stream)
  (terpri stream)
  (princ "Actual byte count = " stream) (princ (Buffer-Byte-Count enc buff) stream)
  (Print-Flag-Doc 1 Buffer-Full         buff)
  (Print-Flag-DOc 1 Buffer-End-of-Frame buff))


(Defun PRINT-CBL-STATUS (enc &optional (stream terminal-io) first-only-p)
  "Print the status of the Command-Block List on ENC."
  (terpri stream) (princ "Command Block List (CBL) = " stream)
  (princ (SCB-CBL-Offset enc (Enc-SCB enc)) stream)
  (Unless (= (*NULL-PTR*) (SCB-CBL-Offset enc (Enc-SCB enc)))
    (Do ((CB (SCB-CBL-Offset enc (Enc-SCB enc))
             (Command-Link enc CB)))
        ((or first-only-p (= 1 (Command-End-Of-List enc CB)))
         (Print-Command-Block-Status enc CB stream))
      (Print-Command-Block-Status enc CB stream))))


(Defun PRINT-RFA-STATUS (enc &optional (stream terminal-io) first-only-p)
  "Print the status of the Received Frames on ENC."
  (terpri stream) (princ "Receive Frame Area (RFA) = " stream)
  (princ (SCB-Current-Receive-Frame enc) stream)
  (Do ((RFD (Command-link enc (Enc-last-free-rfd enc))
            (Command-Link enc RFD)))
      ((or first-only-p (= 1 (Command-End-Of-List enc RFD)))
       (Print-Receive-Frame-Status enc RFD stream))
    (Print-Receive-Frame-Status enc RFD stream)))


(Defun PRINT-ALL-RECV-BUFFERS (enc &optional (stream terminal-io) first-only-p)
  "Print the status of the Receive Buffers on ENC."
  (Do ((RBD (Buffer-link enc (Enc-Last-RBD enc))
            (Buffer-Link enc RBD)))
      ((or first-only-p (= 1 (Buffer-End-of-FBL enc RBD)))
       (Print-Receive-Buffer-Status enc RBD stream))
    (Print-Receive-Buffer-Status enc RBD stream)))

;;--------------------------------------------------------------------
;;                           CHIP CONTROL BITS
;;--------------------------------------------------------------------


(Defsubst CHANNEL-ATTENTION (enc)
  "Assert CHANNEL ATTENTION to the NuBus Ethernet Controller for ENC."
  (NuBus-Write (Enc-slot enc) (*CHANNEL-ATTENTION-ADDR*) 1))


(Defstruct (CONFIG-REGISTER (:type :fixnum)
                            (:Conc-name NuBus-))
  ((HW-Reset-p      #o0001)     ;Write Only, Set to 1 to reset board.
   (Master-Enable-p #o0101)     ;NuBus Master Enbabled iff = 1.
   (Fault-LED-p     #o0201)     ;1 => LED on (ON at power up)
   (Loop-Back-p     #o1001)     ;1 => Loop back test
   (Error-while-posting-event-p #o2001)  ;=1 => Bus error while posting event, Read only
   ))

(Defun RESET-HW (enc)
  "Turns the Reset line ON, Hardware turns it off automatically."
  (setf (NuBus-HW-Reset-P (ENC-Config-Register enc)) 1)
  (Nubus-Write (ENC-Slot enc) (*Config-Register*) (ENC-Config-Register enc))
  (setf (NuBus-HW-Reset-P (ENC-Config-Register enc)) 0))


(Defsubst NUBUS-MASTER-ENABLE (enc)
  (Nubus-Master-Enable-p (Nubus-Read (ENC-Slot enc) (*Config-Register*))))

(Defsubst SET-MASTER-ENABLE (enc val)
  (Setf (NuBus-Master-Enable-p (ENC-Config-Register enc)) val)
  (Nubus-Write  (ENC-Slot enc) (*Config-Register*) (ENC-Config-Register enc)))

(Defsetf NUBUS-MASTER-ENABLE SET-MASTER-ENABLE)



(Defsubst NUBUS-FAULT-LED (enc)
  (Nubus-Fault-LED-p (Nubus-Read (ENC-Slot enc) (*Config-Register*))))

(Defsubst SET-Fault-LED (enc val)
  (Setf (NuBus-Fault-LED-p (ENC-Config-Register enc)) val)
  (Nubus-Write  (ENC-Slot enc) (*Config-Register*) (ENC-Config-Register enc)))

(Defsetf NUBUS-Fault-LED SET-Fault-LED)



(Defsubst NUBUS-LOOP-BACK (enc)
  (Nubus-LOOP-BACK-p (Nubus-Read (ENC-Slot enc) (*Config-Register*))))

(Defsubst SET-LOOP-BACK (enc val)
  (Setf (NuBus-LOOP-BACK-p (ENC-Config-Register enc)) val)
  (Nubus-Write  (ENC-Slot enc) (*Config-Register*) (ENC-Config-Register enc)))

(Defsetf NUBUS-LOOP-BACK SET-LOOP-BACK)



(Defsubst NUBUS-Error-while-posting-event (enc)
  (Nubus-Error-while-posting-event-p (Nubus-Read (ENC-Slot enc) (*Config-Register*))))

;;                       PRINT CONTROL SPACE STATUS


(Defun PRINT-CONTROL-SPACE-STATUS (enc &optional (stream terminal-io))
  "Print the last written and the currently read state of ENC on STREAM."
  (Let ((CF (Enc-Config-Register enc)))
    (terpri stream) (terpri stream)
    (princ "CONTROL SPACE BITS    Current  Last-written" stream)

    (terpri stream)
    (princ "     Master Enabled:    " stream)
    (princ (On-off (Nubus-Master-Enable enc)) stream)
    (princ "    " stream)
    (princ (On-off (Nubus-master-enable-p CF)) stream)

    (terpri stream)
    (princ "          Fault LED:    " stream)
    (princ (On-off (Nubus-Fault-led enc)) stream)
    (princ "    " stream)
    (princ (On-off (Nubus-fault-led-p CF)) stream)

    (terpri stream)
    (princ "          Loop Back:    " stream)
    (princ (On-Off (NuBus-Loop-Back enc)) stream)
    (princ "    " stream)
    (princ (On-off (Nubus-Loop-back-p CF)) stream)

    (terpri stream)
    (princ "Error Posting Event:    " stream)
    (princ (On-Off (NuBus-error-while-posting-event enc)) stream)
    ))



(Defun PRINT-STATUS (enc &optional (stream terminal-io))
  "Display Status of the NuBus ETHERNET Controller."
  (terpri stream) (terpri stream)
  (princ "Status of INTEL 82586 ETHERNET Controller on NuBUS" stream)
  (Print-SCP enc stream)
  (Print-ISCP-Status enc stream)
  (Print-SCB-Status enc stream)
  (Print-Control-Space-Status enc stream)
  (terpri stream))

;;; From the file "Nu-Ether"                                                
;;;
;;; Copyright (c) 1984 Texas Instruments Incorporated  All Rights Reserved
;;;

;;;------------------------------------------------------------------------
;;;          DRIVER FOR NuBUS/INTEL 82586 ETHERNET CONTROLLER
;;;
;;;------------------------------------------------------------------------
;;;
;;; This file Implements the Data Link Interface for the NuBus/Intel 82586 Ethernet controller.
;;;
;;;                       ADVERTISED FUNCTIONS
;;;
;;; INITIALIZE       - Creates the buffer memory structures and calls RESET.
;;; RESET            - Resets the control on the chip, board, & memory structures.
;;; TRANSMIT-FRAME   - Transmits one ethernet frame.
;;; RECEIVE-FRAME    - Returns the DEST, SRC, TYPE & DATA values from the next frame.

;;------------------------------------------------------------------------
;;                         SYSTEM DEFINITION
;;
;;------------------------------------------------------------------------

(Defvar Controller :unbound)               ;NuBus Ethernet controller data.
(Defvar my-ethernet-address :unbound)
(Defvar *Ether-Recv-Time* 0)

(Defconst Controller-Memory 32. "Kbytes of buffer memory")

;;(Defconst Ethernet-Slot (+ #xFB %Sysint-Config-Ethernet))
(DefVar Ethernet-Slot   #xF0  "Slot address of NuBus Ethernet controller")

(defun nubus-ethernet-reset ()
  ;; find slot of ethernet card to use.
  (cond ((neq si:processor-type-code si:explorer-type-code)
	 (terpri)
	 (princ "Slot number of Ethernet card:")
	 (let ((answer (read)))
	   (terpri)
	   (princ "In slot ")
	   (let ((*read-base* 16.))
	     (prin1 answer))
	   (setq Ethernet-Slot answer))))
  ;; build controller structure.
  (enable-NuBus-ethernet)
  (initialize controller)
  ;; random line for cold load.
  (setq mini-my-ethernet-address (GET-ETHERNET-ADDRESS))
  )

(Defun ENABLE-NuBUS-ETHERNET ()
;;; None of this for the cold load.
;;;  (Fset 'Ethernet:Initialize     'NuBus:Initialize)
;;;  (Fset 'Ethernet:Reset          'NuBus:Reset)
;;;  (Fset 'Ethernet:Transmit-Frame 'NuBus:Transmit-Frame)
;;;  (Fset 'Ethernet:Receive-Frame  'NuBus:Receive-Frame)
  (Unless (boundp 'CONTROLLER)
    (setq Controller
          (Make-Nubus-Ethernet-Controller slot Ethernet-Slot
                                          memory-size (* 1024. Controller-Memory)))))

;;------------------------------------------------------------------------
;;            INITIALIZATION INTERFACE FOR NuBUS CONTROLLER
;;
;;------------------------------------------------------------------------

(Defun INITIALIZE (enc)
  "Completely (re)initialize the ENC and Reset the controller."
  (Create-Control-Structures enc 4)	   ;setup memory structures w/ 4 xmit frames
  (Reset enc))

(Defun RESET (enc &optional sw-reset-p)
  "Reset & initialize the 586 Ethernet Controller, ENC.
   Use Hardware or Software Reset mechaninsm, depending on SWQ-RESET-P."
  (Reset-Chip enc sw-reset-p)
  (Initialize-Controller enc))


;;; Not for cold load.
;;;(Defmacro SEND-COMMAND (enc command Cmd-blk &Body Body)    ;not yet used
;;;  "Send a command block for command, COMMAND, to the controller ENC.
;;;   BODY is the forms to fill the the command-block,
;;;   CMD-BLK is the symbol bound to the command block inside BODY."
;;;  `(With-Lock ((Enc-Request-Lock ,enc))
;;;     (Let ((,cmd-blk (Alloc-CB ,enc t)))
;;;       ,@body
;;;       (Queue-Command-for-Execution ,enc ,command ,Cmd-Blk))))

;;; Cold-load version of the above.
(Defmacro SEND-COMMAND (enc command Cmd-blk &Body Body)    ;not yet used
  "Send a command block for command, COMMAND, to the controller ENC.
   BODY is the forms to fill the the command-block,
   CMD-BLK is the symbol bound to the command block inside BODY."
  `(Let ((,cmd-blk (Alloc-CB ,enc t)))
     ,@body
     (Queue-Command-for-Execution ,enc ,command ,Cmd-Blk)))

;;------------------------------------------------------------------------
;;            ETHERNET DATALINK INTERFACE FOR NuBUS CONTROLLER
;;
;;------------------------------------------------------------------------

(defun nubus-transmit-ethernet-16b-array (from-ether-host to-ether-host array nwords e-type)
  from-ether-host ; not needed
  (transmit-frame controller to-ether-host e-type array (* 2 nwords)))

(Defun TRANSMIT-FRAME (enc dest type data-array n-bytes)
  "Transmit the DATA-ARRAY (art-16b) to Ether address DEST.
   N-BYTES = number words to transmit
   TYPE   = Ethernet Frame type."
  (SEND-COMMAND enc (Transmit) CB
    (Do ((buff (ALLOC-BUFF enc data-array (Convert-To-Words n-bytes))
               (ALLOC-BUFF enc data-array (Convert-To-Words n-bytes))))
        ((Not (null buff))
         ;; Set up Command Block
         (Setf (Command-Buffer-Ptr       enc cb) buff)
         (Setf (Command-Destination-Addr enc cb) dest)
         (Setf (Command-Frame-Type       enc cb) type))
      (cond ((= (*NULL-PTR*) (SCB-CBL-Offset enc)) ; nothing to deallocate.
             (Free-CB enc CB)
             (ferror nil "Attempt to send a frame larger than total buffer space"))
            (T (Ack-Xmit-Interrupts enc t))))      ; Wait for last command to complete.
    ))

;;; receive frame into array.
(defun nubus-receive-ethernet-16b-array (array)
  (multiple-value-bind (ignore ignore type data)
      (receive-frame controller array)
    (select type
      (#x408 t)
      (#x608  ;; address-resolution-type
       ;; record address; maybe send reply
       ;; defined back in "ether-mini"
       (receive-addr-pkt data)
       nil)))
  )

(defun nubus-mini-pkt-available ()
  (not (zerop (Command-Complete-Flag
		controller
		(SCB-Current-Receive-Frame controller)))))

(Defun RECEIVE-FRAME (enc into-array)
  "Returns the DESTINATION, SOURCE, TYPE and DATA for the next valid frame.
   DATA is returned as an ART16b."
  (Declare (return-list Destination Source Type Data N-Bytes))
  (Do-Named Receive ((start-time (%fixnum-microsecond-time)))
            (())                           ; Loop until a good frame arrives.
    (Let* ((RFD (SCB-Current-Receive-Frame enc))
           (buff (Command-Buffer-Ptr enc rfd)))
      (If (not (zerop (Command-Complete-Flag enc RFD)))    ;Frame is complete?
          (Unwind-Protect
              (If (= (Command-Status enc rfd) (*NORMAL-FINISH*))   ;Recv. completed OK?
                  (Let* ((array into-array) ;; (Ethernet:ALLOCATE-BUFFER))
                         (nbytes (BUFFER-TO-ART16B enc buff array)))
                    (If (not (null nbytes))
                        (Return-From Receive
                          (Command-Destination-Addr enc RFD)
                          (Receive-Source-Addr      enc RFD)
                          (Receive-Frame-Type       enc RFD)
                          array
                          nbytes)
                      (Comment "Should record here that frame was too big")))
                ;; Error in frame, just clear it.
                (incf Nubus-receive-frame-errors)
                (push (Command-Status enc rfd) Nubus-receive-frame-error-list))
            ;; *ALWAYS* Free the Frame Desc. & buffers & restart the Recv. Unit.
            (FREE-RFD-AND-BUFFERS enc rfd buff)
            (Select (SCB-Receive-Unit-Status enc)
              (((Receive-Ready)) nil)
              (otherwise     (Enable-Read enc)))
;;; not in cold load
;;;            (Incf *Ether-Recv-Time*
;;;                  (round (time-difference (%fixnum-microsecond-time) start-time)
;;;                         1000.))
	    )
        (Ethernet-Wait "Await NuBus frame or enable" 'NUBUS-PROCESS-WAIT-FUNCTION enc)
	;; reset start time.
        (setq start-time (%fixnum-microsecond-time))
        (Ack-Recv-Interrupts enc)
        ))))

;;; Not for cold load.
;;;(Defun NuBUS-PROCESS-WAIT-FUNCTION (enc)
;;;  "Return when the Frame-Received-Interrupt is on"
;;;  (And CHAOS:ENABLE (FRAME-RECV-INT-P enc)))

;;; cold load version of the above.
(Defun NuBUS-PROCESS-WAIT-FUNCTION (enc)
  "Return when the Frame-Received-Interrupt is on"
  (FRAME-RECV-INT-P enc))

;;------------------------------------------------------------------------
;;                NuBUS ETHERNET CONTROLLER STRUCTURES
;;                           INITIALIZATION
;;------------------------------------------------------------------------


(Defun RESET-CHIP (enc &optional sw-reset-p)
  "Reset the 586 NuBus controller chip.  Assumes valid control data on board.
   If SW-RESET-P is nil, uses the Control Register line, else uses the SCB."
  (Setf (SCB-Busy-Word enc (ENC-ISCP enc)) 1)
  (Setf (SCB-Command enc (Enc-SCB enc)) (*NULL-COMMAND*))
  (If sw-reset-p
      (Setf (SCB-Reset enc (Enc-SCB enc)) 1)
    (Reset-HW enc))
  (Channel-Attention enc)
  (Unless (Clear-Interrupts enc t 600.)
    (print "Ethernet Controller failed to RESET - Disabling Chaosnet")
    (*Throw 'Abort-Chaos nil)))


(Defun INITIALIZE-CONTROLLER (enc)
  "Initialize the NuBus Board.  Enable Interrupts if *INTERRUPT-DRIVEN-P* is non-NIL."
  (setf (Enc-Request-Lock enc) nil)
  (setf (Enc-Write-Lock   enc) nil)
  (Setf (Nubus-Fault-LED enc) 0)                ;Turn off LED
  (Setf (NuBus-Master-Enable enc) (If *INTERRUPT-DRIVEN-P* 1 0))
  ;; also need to set up the Event Address if Interrupts-p is T !!!
  (Setf (Nubus-Loop-Back enc) 0)
  ;; Eventually the ether address will be read from the Config ROM, but we don't have one.
  (Setup-my-address enc (Setq My-Ethernet-Address (Get-Ethernet-Address enc)))
;;;  (setq DEBUG-NUBUS-ADDRESSES T)
  (Enable-Read enc))


(Defun ENABLE-READ (enc)
  "Enable the NuBus Ether Controller described by ENC, to receive frames."
  (Let ((RFD  (Find-1st-Free-RFD enc (ENC-Last-Free-RFD enc)))
        (buff (Find-1st-Free-RBD enc (ENC-Last-RBD enc))))
    (When (and RFD buff)                   ;Turn Receiver on if there is a buffer & RFD
      (setf (SCB-RFA-Offset enc) RFD)
      (setf (Command-Buffer-ptr enc RFD) buff)
      (Issue-Command enc
        (Setf (SCB-Receive-Command enc) (START))))))

;;------------------------------------------------------------------------
;;                NuBUS ETHERNET COMMANDS
;;------------------------------------------------------------------------


(Defun SETUP-MY-ADDRESS (enc address)
  "Setup the Ethernet ADDRESS for ENC to receive on."
  (SEND-COMMAND enc (ADDRESS-SETUP) CB
    (Setf (Enc-Ether-Address (Enc-slot enc) (+ cb 6))
          address))
  (Ack-Xmit-Interrupts enc t)
  )

;;; Magic ethernet base address + magic cold load chaos address.
(Defun GET-ETHERNET-ADDRESS (&optional ignore)
;  (+ #x080028010000 #o3407)
  (+ #x080028010000
     (if (and (boundp 'chaos:my-address)
	      (numberp chaos:my-address))
	 chaos:my-address
       #o3407)))

;;  >> This implementation places EXACTLY ONE Command Block on the CBL at any one time.  <<
;;     There is no chaining of command blocks.
;;     The reason is that the controller is fast enough that it should be finished with the
;;      previous Command Block before we can get the new one built, much less queued.
;; 
;; ** NOTE **    Make the command value be an arg to here.  All callers set the command value.
(Defun QUEUE-COMMAND-FOR-EXECUTION (enc command cmd-block)
  "Queue the command, COMMAND, at CMD-BLOCK for execution by the controller.
   Sets END-OF-LIST & INTERRUPT to On.  Assumes STATUS is already zeroed."
  (Setf (Command-Word           enc cmd-block) command)
  (Setf (Command-End-of-List    enc cmd-block) 1)
  (Setf (Command-link           enc cmd-block) (*NULL-PTR*))
  (Setf (Command-Interrupt-Flag enc cmd-block) 1)
  (if (not (= (*NULL-PTR*) (SCB-CBL-Offset enc)))
      (Ack-Xmit-Interrupts enc t))         ;Clear the Transmitter if not already done.
  (Issue-Command enc                       ;Ensures ACKing doesn't issue Channel-Attention.
    (Setf (SCB-CBL-Offset      enc) cmd-block)
    (Setf (SCB-Control-Command enc) (START))))

;;------------------------------------------------------------------------
;;                NuBus ETHERNET INTERRUPT HANDLING
;;------------------------------------------------------------------------
;; Transmit Interrupts are handled by the transmitting processes.
;; If this function were to be in an interrupt process (either interrupt or polled),
;; the transmitting functions which now call this would have to check for SCB-CBL-Offset
;; to go *NULL-PTR*.

(Defun ACK-XMIT-INTERRUPTS (enc &optional wait-for-interrupt-p)
  "Acks any Command interrupts that occur and frees any transmit frame."
  ;; ASSERT - Since only One command is queued at a time, If a CX occurs, so must a CNR.
  ;;           And the one & only command MUST be complete.
  ;; ASSERT - If there is a Complete CB on the CBL, there MUST be a CX pending.
  (cond ((and (= 0 (SCB-CX-Flag enc))
	      (= 0 (SCB-CNR-Flag enc))
	      wait-for-interrupt-p)
	 (cond ((null (Ethernet-Wait-with-timeout
			"ENC Xmit interrupt"
			60.
			#'(lambda (enc) (or (= 1 (SCB-CX-Flag enc))
					    (= 1 (SCB-CNR-Flag enc))))
			enc))
;		(print "ack-xmit-interrupts timed out ... resetting" si:cold-load-stream)
		(nubus-ethernet-reset))))

	(t
	 (Issue-Command enc                       ;Clear the interrupts
	   (Setf (SCB-Ack-CX enc) (SCB-CX-Flag enc))
	   (Setf (SCB-Ack-CNR enc) (SCB-CNR-Flag enc))
	   (if (= 1 (SCB-Ack-CX enc))		; If Command Complete interrupt,
	       (Let ((CB (SCB-CBL-Offset enc)))
		 (When (not (= CB (*NULL-PTR*)))    
		   (When (zerop (Command-complete-Flag enc CB))	;Sanity check on 586.
		     (print "Ethernet board did not mark last command as complete.")
		     (print "Freeing the COMMAND-BLOCK anyway."))
		   (Free-CB enc CB)		;Free command block
		   (Setf (SCB-CBL-Offset enc) (*NULL-PTR*)))))))))
    

(Defun ACK-RECV-INTERRUPTS (enc &optional wait-for-interrupt-p)
  "Acks any Receive interrupts that occur."
  (cond (wait-for-interrupt-p
	 (cond ((null (Ethernet-Wait "ENC Recv interrupt"
				     #'(lambda (enc) (or (= 1 (SCB-FR-Flag enc))
							 (= 1 (SCB-RNR-Flag enc))))
				     enc))
		(nubus-ethernet-reset))))
	(t
	 (Issue-Command enc
	   (Setf (SCB-Ack-FR enc) (SCB-FR-Flag enc))
	   (Setf (SCB-Ack-RNR enc) (SCB-RNR-Flag enc))))))
    

(Defun CLEAR-INTERRUPTS (enc &optional wait-for-interrupt-p (time-out 600.))
  "Acks any interrupts that occur. Returns T if OK, NIL if timed out."
  (When (or (not wait-for-interrupt-p)
            (Ethernet-Wait-With-Timeout
              "ENC interrupt"
              time-out
              #'(lambda (enc) (not (zerop (SCB-Int-Flags enc (Enc-SCB enc)))))
              enc))                         ;Returns nil if timed-out, T otherwise.
    (Issue-Command enc
      (Setf (SCB-Ack-Int enc (Enc-SCB enc))
	    (SCB-Int-Flags enc (Enc-SCB enc))))
    T))

;;------------------------------------------------------------------------
;;   INITIALIZE NuBUS ETHERNET DATA STRUCTURES

(Defun CREATE-CONTROL-STRUCTURES (enc nxmit-frames)
  "Initialize all the NuBus Ethernet data structures."
  ;; Eventually this needs to have options added to the arg list to vary the constants below.
;;;  (Setq DEBUG-NUBUS-ADDRESSES nil)
  (Init-ISCP enc 0                     ;Make ISCP at location 0000
             (Create-SCB enc
                         ISCP-Size     ;Make SCB following the ISCP, with 
                         nxmit-frames))
  ;; Initialize the SCP
  (Setf (ISCP-Address enc) 0)	       ;Intermediate. Sys Control Ptr is at loc zero.
  (Set-SCP-Sysbus-Width enc 16)        ;Chip's bus is word mode.
  )


;;   INITIALIZE THE SYSTEM CONTROL BLOCK

(Defun CREATE-SCB (enc addr nxmit-frames)
  "Initialize the SCB, & Buffers in NuBus Memory for a TI NuBus Ethernet Controller.
   ADDR = address of System Control Block in the slot.
   NXMIT-FRAMES = number of transmit frames to make.
   Rest of memory will be used for receive buffers."
  ;; The buffer for the 586 dump immediately follows the SCB
  (let* ((next-addr (+ addr SCB-Size Dump-Area-Size))      ;Start address of buffers.
         (Buffer-Size                      ;Number bytes avail for buffers.
           (- (ENC-Memory-size enc)
              next-addr
              SCP-Size))
         (Xmit-Area-Bytes                  ;Number bytes in transmit area
           (* Nxmit-Frames (ENC-Transmit-Frame-Size enc)))
         (Recv-Area-Bytes                  ;Number bytes in receive area
           (- Buffer-Size Xmit-Area-Bytes))
         (Nrecv-Frames (floor Recv-Area-Bytes      ;num of receive frames to use.
                              (ENC-Receive-Frame-Size enc)))
         )
    (Init-SCB enc addr (*NULL-PTR*) (*NULL-PTR*))
    (setq next-addr
          (Create-CBL enc next-addr Nxmit-Frames)) ; Pushes the CB's on Free-List.
    (setq next-addr
          (Create-RFA enc next-addr Nrecv-Frames))
    (setq START-OF-BUFFERS next-addr)
    (setq next-addr
          (Create-Xmit-Buffers enc
                               next-addr
                               (* NXmit-frames (ENC-Transmit-Buffers-per-frame enc))
                               (ENC-Transmit-Buffer-Size enc))) ;Holds in ENC
    (setq next-addr
          (Create-Receive-Buffers enc
                                  next-addr
                                  (* NRecv-frames (ENC-Receive-Buffers-per-frame enc))
                                  (ENC-Receive-Buffer-Size enc)))
    addr))

;;------------------------------------------------------------------------
;;                   COMMAND BLOCK MANAGEMENT
;;------------------------------------------------------------------------

(defun print-free-cb (enc &optional (stream terminal-io))
  "Print the free command blocks from the Free-CBL"
  (do ((addr (scb-free-cbl enc) (command-link enc addr)))
      ((= (*null-ptr*) addr))
    ;; print cb
    (terpri stream) (princ "Free command block " stream) (princ addr stream)
    (terpri stream) (princ "Status " stream) (princ (Command-Status     enc addr))
    (princ ", command word " stream) (princ (Command-Word       enc addr) stream)
    (princ ", link " stream) (princ (Command-Link       enc addr) stream)
    (princ ", buffer " stream) (princ (Command-Buffer-Ptr enc addr))
    )
  )

(Defsubst INIT-CB (enc addr)
  "Initialize the Command Block at ADDR, & push it on the Free-CBL list.
   Does not initialize the parameter fields."
  (Setf (Command-Status     enc addr) (*NULL-STATUS*))
  (Setf (Command-Word       enc addr) (*NULL-COMMAND*))
  (Setf (Command-Link       enc addr) (SCB-Free-CBL enc))
  (Setf (Command-Buffer-Ptr enc addr) (*NULL-PTR*))
  (Setf (SCB-Free-CBL enc) addr)
  addr)
         

(Defun CREATE-CBL (enc start-addr count)
  "Create COUNT Command-Blocks, starting at START-ADDR.
   Returns the next available address in the buffer emeory area."
  (Do ((size Command-Size)
       (i 0 (1+ i))                        ; loop counter
       (addr start-addr (+ addr size)))    ; address of command block
      ((= i count) addr)                   ; return next available address.
    (Init-CB enc addr)))

;; Free Command Blocks are handled as a stack.
;; CB's are POP'ed to get a free one, and PUSH'ed back on to be returned.

(Defun ALLOC-CB (enc &optional hang-p)
  "Alloc a free Command block.  If HANG-P is not-Nil, hangs til one avail.
   Returns the Command Block ptr, or *NULL-PTR* if none."      
  (Cond
    ((not (= (SCB-Free-CBL enc) (*NULL-PTR*)))     ;From free list
;;; not for cold load
;;;     (Without-Interrupts
       (Prog1 (SCB-Free-CBL enc)
              (Setf (SCB-Free-CBL enc)
                    (Command-Link enc (SCB-Free-CBL enc))))
;;;       )
     )
    (hang-p                                ;wait for current CB to complete
     (Ack-Xmit-Interrupts enc t)
;;; not for cold load
;;;     (Without-Interrupts
       (Prog1 (SCB-Free-CBL enc)
              (Setf (SCB-Free-CBL enc)
                    (Command-Link enc (SCB-Free-CBL enc))))
;;;       )
     )
    (T (*NULL-PTR*))))
             
(Defun FREE-CB (enc CB)
  "Frees the command Block CB, and any associated buffers."
  (if (= (TRANSMIT) (Command-Block-Cmd enc CB))
      (Free-Transmit-Buffers enc (Command-Buffer-Ptr enc CB)))
  (Init-CB enc CB))

;;------------------------------------------------------------------------
;;                      TRANSMIT BUFFER MANAGEMENT
;;------------------------------------------------------------------------

;; Buffers are allocated immediatelly following their Buffer Descriptor.
;; Buffers-sizes must be a multiple of four bytes long.

(Defsubst INIT-TBD (enc addr size)
  "Initialize a Transmit Buffer at ADDR for for controller ENC.
   SIZE = number of bytes in buffer, assumes buffer follows TBD.
   LINK = Next Buffer in frame."
  (Setf (Buffer-Count enc addr) size)    ;also clears End-of-Frame.
  )

(Defun CREATE-XMIT-BUFFERS (enc start-addr count size)
  "Create COUNT buffers & descriptors of SIZE bytes, starting at START-ADDR.
   Returns the address of the first buffer in the list."
  ;; allocates each buffer immediately after its descriptor.
  (setq size (Round-up-to-Quad size))
  (setf (ENC-Transmit-buffer-size enc) size)
  (Do ((i 0 (1+ i))                        ; loop counter
       (addr start-addr (+ addr size TBD-size))    ; address of buffer desc.
       (last-addr (*NULL-PTR*) addr))        ; address of last buffer
      ((= i count)
       (Setf (SCB-Free-TBD enc) last-addr) ; Anchor the list.
       addr)                               ; Return avail address.
    (Setf (Buffer-Link    enc addr) last-addr)
    (Setf (Buffer-Address enc addr) (+ addr TBD-Size))
    (Init-TBD enc addr size)))

;; Free Transmit buffers are handled as a stack.
;; TBD's are POP'ed to get a free one, and PUSH'ed back on to be returned.
  
(Defun ALLOC-BUFF (enc array data-length)
  "Returns the address of the allocated buffer after copying ARRAY into it.
   Returns NIL if not enough space."
;;; not for cold load
;;;  (Without-interrupts
    (Let ((Buff (SCB-Free-TBD enc)))       ;Buffer pointer
      (If (= Buff (*NULL-PTR*)) nil          ;Buffer not available
        (Let ((last-buff (ART16B-TO-BUFFER enc buff array data-length)))
          (If (null last-buff) nil   
            (setf (Buffer-end-of-frame enc last-buff) 1)   ;mark EOL
            (Setf (SCB-Free-TBD enc) (buffer-link enc last-buff))
            buff))))
;;;    )
    )

(Defun FREE-TRANSMIT-BUFFERS (enc start-buff)
  "Frees all buffers in the list rooted at the buffer START-BUFF"
  (When (not (= start-buff (*NULL-PTR*)))
    (Do ((buff start-buff (Buffer-Link enc buff))
         (last-buff nil buff)
         (size (ENC-Transmit-buffer-size enc))
         (EOF 0))
        ((or (= EOF 1) (= buff (*NULL-PTR*)))
         ;;Put buffers back in free list
         (Setf (Buffer-Link enc last-buff)
               (SCB-Free-TBD enc))
         (Setf (SCB-Free-TBD enc)
               start-buff))
      (Setq EOF (Buffer-end-of-frame enc buff))    ;remember EOF state
      (Init-TBD enc buff size))            ;free buffer
    ))

;;------------------------------------------------------------------------
;;                   RECEIVE BUFFER MANAGEMENT
;;------------------------------------------------------------------------

;; Buffers are allocated immediatelly following their Buffer Descriptor.
;; Buffers-sizes must be a multiple of four bytes long.

(Defsubst INIT-RBD (enc addr)
  "Initialize the state of the RBD at ADDR."
  (Setf (Buffer-Count      enc addr) 0)  ;also clears EOF & F flags.
  (Setf (Buffer-End-Of-FBL enc addr) 0))

(Defun CREATE-RECEIVE-BUFFERS (enc start-addr count size)
  "Create COUNT buffers & descriptors of SIZE bytes, starting at START-ADDR."
  (Declare (return-list next-avail-addr))
  ;; allocates each buffer immediately after its descriptor.
  (setq size (Round-up-to-Quad size))
  (Setf (Enc-Last-RBD enc) start-addr)     ; Init this value
  (Do ((i 0 (1+ i))                        ; loop counter
       (addr start-addr (+ addr size  RBD-size)) ; address of buffer desc.
       (last-addr (*NULL-PTR*) addr))        ; address of last buffer
      ((= i count)
       (Setf (Buffer-Link       enc start-addr) last-addr) ;close the list
       (Setf (Buffer-End-of-FBL enc start-addr) 1)        ;make this one the tail
       (Setf (Enc-Last-RBD enc) start-addr)        ;anchor the list
       addr)                               ; Return last buffer made.
    (Setf (Buffer-Link    enc addr) last-addr)
    (Setf (Buffer-Address enc addr) (+ addr RBD-Size))
    (Setf (Buffer-Size    enc addr) size)  ; also clears the End of FBL flag.
    (Init-RBD enc addr)))

(Defsubst FREE-RECEIVE-BUFFERS (enc first-buff)
  "Release all buffers starting at FIRST-BUFF for reuse by the controller.
   FIRST-BUFF *must* not be NULL."
  (Do ((buff first-buff (Buffer-Link enc buff))    ;buffer to release
       (last-buff nil buff)                ;buffer just released
       (EOF  0))                         ;End of frame?
      ((= 1 EOF)
       (Setf (Buffer-End-of-FBL enc last-buff) 1) ;new end of FBL
       (Setf (Buffer-End-of-FBL enc (Enc-Last-RBD enc)) 0)
       (Setf (Enc-Last-RBD enc) last-buff))
    (setq EOF (Buffer-End-of-Frame enc buff))      ;Yes, I know this is an ugly hack
    (Init-RBD enc buff)
    ))


(Defun FIND-1ST-FREE-RBD (enc start-rbd)
  "Returns ptr to 1st Free Buffer Desc, NIL if none.  Starts at START-RBD."
  (Do ((rbd (Buffer-Link enc start-rbd)
            (Buffer-Link enc rbd)))
      ((or (= rbd start-rbd)                   ;kick out on last RBD
           (= (Buffer-Count enc rbd) 0))   ;found an unused Buffer.
       (if (= (Buffer-Count enc rbd) 0) rbd nil))))

;;------------------------------------------------------------------------
;;                   RECEIVE FRAME MANAGEMENT
;;------------------------------------------------------------------------

(Defsubst INIT-RFD (enc RFD)
  "Initialize the Receive Frame Descriptor at RFD for controller ENC and
   Update the List of RFD's and the list pointers.  Returns the address of RFD.
   Does NOT change the LINK, ADDRESS, or TYPE fields."
  (Setf (Command-Status     enc RFD) (*NULL-STATUS*))   ;Enable reuse of this block.
  (Setf (Command-Word       enc RFD) (*NULL-CMD-EOL*))  ;Make this new end of list.
  (Setf (Command-Buffer-Ptr enc RFD) (*NULL-PTR*))      ;Let go of any buffers
  ;; Reset the list pointers
  (Setf (Command-End-of-List enc (Enc-Last-free-RFD enc)) 0)
  (Setf (Enc-Last-Free-RFD enc) RFD)
  RFD
  )

(Defun CREATE-RFA (enc start-addr count &aux size)
  "Create COUNT Receive Frame Descriptors, starting at START-ADDR.
   Returns the next available address in the buffer memory area."
  (setq size Receive-Block-Size)
  (Setf (Enc-Last-Free-RFD enc) start-addr)        ;<HACK> Init this value.
  (Do ((i 0 (1+ i))                        ; loop counter
       (addr start-addr (+ addr size))     ; address of command block
       (last-addr (*NULL-PTR*) addr))        ; address of last block
      ((= i count)
       (Setf (Command-Link enc start-addr) last-addr)      ;close the list
       (Init-RFD enc start-addr)           ; Make '1st' RFD be the tail of the list.
       addr)
    (Init-RFD enc addr)
    (Setf (Command-link enc addr) last-addr)))


(Defun FREE-RFD-AND-BUFFERS (enc rfd buff)
  "Release the RFD and any buffers it points to."
  (Unless (= buff (*NULL-PTR*)) (Free-Receive-Buffers enc buff))
  (Init-RFD enc rfd))

(Defun FIND-1ST-FREE-RFD (enc start-rfd)
  ;;  This may only be called AFTER at least one RFD has been released.
  (Do ((rfd (Command-Link enc start-rfd)
            (Command-Link enc rfd)))
      ((or (= rfd start-rfd)               ;kick out on last RFD
           (= (Command-Status enc rfd) (*NULL-STATUS*)));found a free RFD
       (if (= (Command-Status enc rfd) (*NULL-STATUS*))
           rfd
         nil))))