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

;;; Miniature Chaosnet program.  Only good for reading ascii and binary files.
;;; Knows the format of a packet and the Chaosnet opcodes non-symbolically

;;; This file contains the ethernet board independent things.


;;; Board dependencies are here.
(defvar *use-nu-ethernet* nil)   ;t for ti-nubus board, 'share for mini-share mode.

(defun ethernet-reset ()
  (cond ((eq *use-nu-ethernet* 'share)
	 (mini-share-ethernet-reset))
	((or *use-nu-ethernet*
	     (eq si:processor-type-code si:explorer-type-code))
	 (nubus-ethernet-reset))
	(t
	 (3com-ethernet-reset))))

(defun transmit-ethernet-16b-array (from-ether-host to-ether-host array nwords e-type)
  (cond ((eq *use-nu-ethernet* 'share)
	 (mini-share-transmit-16b-array from-ether-host to-ether-host array nwords e-type))
	((or *use-nu-ethernet*
	     (eq si:processor-type-code si:explorer-type-code))
	 (nubus-transmit-ethernet-16b-array from-ether-host to-ether-host array nwords e-type))
	(t
	 (3com-transmit-ethernet-16b-array from-ether-host to-ether-host array nwords e-type))))

(defun receive-ethernet-16b-array (array)
  (cond ((eq *use-nu-ethernet* 'share)
	 (mini-share-receive-ethernet-16b-array array))
	((or *use-nu-ethernet*
	     (eq si:processor-type-code si:explorer-type-code))
	 (nubus-receive-ethernet-16b-array array))
	(t
	 (3com-receive-ethernet-16b-array array))))

(defun receive-ethernet-with-buffer-ready (array)
  (cond ((eq *use-nu-ethernet* 'share)
	 (mini-share-receive-ethernet-16b-array array))
	((or *use-nu-ethernet*
	     (eq si:processor-type-code si:explorer-type-code))
	 (nubus-receive-ethernet-16b-array array))
	(t
	 (3com-receive-ethernet-with-buffer-ready array))))

(defun mini-pkt-available ()
  (cond ((eq *use-nu-ethernet* 'share)
	 (mini-share-pkt-available))
	((or *use-nu-ethernet*
	     (eq si:processor-type-code si:explorer-type-code))
	 (nubus-mini-pkt-available))
	(t
	 (3com-mini-pkt-available))))

;;; end of ethernet board dependencies.

(defvar *mini-pkt*)
(defvar *mini-pkt-string*)
(defvar *mini-file-id*)
(defvar *mini-open-p*)
(defvar *mini-ch-idx*)
(defvar *mini-unrchf*) ;as fixnum
(defvar *mini-local-index*)
(defvar *mini-local-host* #o3407) ;host number reserved for cold loading . not used by anyone else
(defvar *mini-remote-index*)
(defvar *mini-remote-host*)
(defvar *mini-in-pkt-number*)
(defvar *mini-out-pkt-number*)
(defvar *mini-eof-seen*)
(defvar *mini-destination-address* #.(chaos:address-parse "DJ"))
(defvar *mini-routing-address* #.(chaos:address-parse "CADR2")) ; bridge to get there if subnet difrs
(defvar *mini-plist-receiver-pointer*)
;This is the filename (a string) on which MINI-FASLOAD was called.
(defvar *mini-fasload-filename*)
(defvar *mini-his-ethernet-address* nil) ;gets ether address of bridge
(defvar *mini-my-ethernet-address* :unbound)
(defvar mini-possible-destinations '#.(mapcar #'(lambda (x) (list x (chaos:address-parse x)))
					      '("LAM2" "DJ")))
;;; Contact name<space>user<space>password
(defparameter *mini-contact-name* "MINI LISPM ")

;;; Initialization, usually only called once.
(defun mini-init ()
  ;we don't use microcode here anymore, so this doesn't have to be wired
  (setq *mini-pkt* (make-array 400 :type art-16b :leader-length (length chaos-buffer-leader-qs)))
  (setq *mini-pkt-string* (make-string #o760
				       :displaced-to *mini-pkt*
				       :displaced-index-offset 16.))
  (cond ((= 0 (time:%microsecond-time))
	 (terpri)
	 (princ "Type a character: ")
	 (do ((index 0 (1+ index)))
	     ((send terminal-io :tyi-no-hang)
	      (setq *mini-local-index* (ldb (byte 8 0) index)))))
	(t
	 (SETQ *MINI-LOCAL-INDEX* (ldb (byte 8 0) (time:%microsecond-time)))))
  (SETQ *MINI-OPEN-P* NIL)
  (ethernet-reset)
  )

;;; Get a connection to a file server
(DEFUN MINI-OPEN-CONNECTION (&aux (*read-base* 8.) (*print-base* 8.))
  (MINI-INIT)
  (terpri)
  (princ "Choose a bridge:")
  (terpri)
  (do ((n 0 (1+ n))
       (host mini-possible-destinations (cdr host)))
      ((null host))
    (prin1 n)
    (princ "  ")
    (prin1 (caar host))
    (princ "  ")
    (prin1 (cadar host))
    (terpri))
  (princ "Which do you want (in octal): ")
  (let* ((answer (cl:read))
	 (host (nth answer mini-possible-destinations)))
    (princ "Using ")
    (prin1 host)
    (setq *mini-destination-address* (cadr host)))

  (SETQ	*MINI-REMOTE-HOST* *mini-destination-address*
	*MINI-OUT-PKT-NUMBER* 1)

  (cond ((= (LDB 1010 *MINI-LOCAL-HOST*) (LDB 1010 *MINI-REMOTE-HOST*))
	 (SETQ *MINI-ROUTING-ADDRESS* *MINI-REMOTE-HOST*)))
  (SETQ *MINI-LOCAL-INDEX* (1+ *MINI-LOCAL-INDEX*))
  (AND (= *MINI-LOCAL-INDEX* 200000) (SETQ *MINI-LOCAL-INDEX* 1))
  (SETQ *MINI-REMOTE-INDEX* 0
	*MINI-IN-PKT-NUMBER* 0)
  (select-processor
    (:lambda (arm-ethernet-for-receive))
    (:cadr :explorer))
  (get-his-ethernet-address)
  (DO ((RETRY-COUNT 10. (1- RETRY-COUNT)))
      ((ZEROP RETRY-COUNT) (MINI-BARF "RFC fail"))
    ;; Store contact name into packet
    (COPY-ARRAY-CONTENTS *MINI-CONTACT-NAME* *MINI-PKT-STRING*)
    (MINI-SEND-PKT 1 (ARRAY-LENGTH *MINI-CONTACT-NAME*))  ;Send RFC
    (COND ((EQ (MINI-NEXT-PKT NIL) 2)	;Look for a response of OPN
	   (SETQ *MINI-REMOTE-INDEX* (AREF *MINI-PKT* 5)
		 *MINI-IN-PKT-NUMBER* (AREF *MINI-PKT* 6))
	   (SETQ *MINI-OUT-PKT-NUMBER* (1+ *MINI-OUT-PKT-NUMBER*))
	   (MINI-SEND-STS)
	   (SETQ *MINI-OPEN-P* T)
	   (RETURN T)))))	;and exit.  Otherwise, try RFC again.

;;; Send a STS
(DEFUN MINI-SEND-STS ()
  (ASET *MINI-IN-PKT-NUMBER* *MINI-PKT* 10) ;Receipt
  (ASET 1 *MINI-PKT* 11) ;Window size
  (MINI-SEND-PKT 7 4)) ;STS

;;; Open a file for read
(DEFUN MINI-OPEN-FILE (FILENAME BINARY-P)
  (SETQ *MINI-CH-IDX* 1000 *MINI-UNRCHF* NIL *MINI-EOF-SEEN* NIL)
  (OR *MINI-OPEN-P*
      (MINI-OPEN-CONNECTION))
  (DO ((OP)) ;Retransmission loop
      (NIL)
    ;; Send opcode 200 (ascii open) or 201 (binary open) with file name
    (COPY-ARRAY-CONTENTS FILENAME *MINI-PKT-STRING*)
    (MINI-SEND-PKT (IF BINARY-P #o201 #o200) (ARRAY-ACTIVE-LENGTH FILENAME))
    ;; Get back opcode 202 (win) or 203 (lose) or OPN if old STS lost
    (SETQ OP (MINI-NEXT-PKT NIL))
    (COND ((NULL OP))		;no response, retransmit
	  ((= OP #o2)		;OPN
	   (MINI-SEND-STS))	;send STS and then retransmit
	  ((OR (= OP #o202) (= OP #o203)) ;Win or Lose
	   (SETQ *MINI-IN-PKT-NUMBER* (LOGAND #o177777 (1+ *MINI-IN-PKT-NUMBER*))
		 *MINI-OUT-PKT-NUMBER* (LOGAND #o177777 (1+ *MINI-OUT-PKT-NUMBER*)))
	   (LET* ((LENGTH (LOGAND #o7777 (AREF *MINI-PKT* 1)))
		  (CR (STRING-SEARCH-CHAR #/NEWLINE *MINI-PKT-STRING* 0 LENGTH)))
	     ;; Before pathnames and time parsing is loaded, things are stored as strings.
	     (SETQ *MINI-FILE-ID*
		   (CONS (SUBSTRING *MINI-PKT-STRING* 0 CR)
			 (loop for n from (1+ cr) below length
			       as code = (char-int (char *mini-pkt-string* n))
			       with time = 0
			    if ( 0 code 7) ;>> Christ -I- don't know who made this octal...
			      do (setq time (+ (* time 8.) code))
			      ;; enable lossage debugging
			      else (return (substring *mini-pkt-string* (1+ cr) length))
			    finally (return time)))))
	   (MINI-SEND-STS)	;Acknowledge packet just received
	   (COND ((= OP #o202)
		  (RETURN T))
		 (T ;Lose
		  (MINI-BARF *MINI-FILE-ID* FILENAME))))))
  (IF BINARY-P #'MINI-BINARY-STREAM #'MINI-ASCII-STREAM))

;; Doesn't use symbols for packet fields since not loaded yet
;; This sends a packet and doesn't return until it has cleared microcode.
;; You fill in the data part before calling, this fills in the header.
(DEFUN MINI-SEND-PKT (OPCODE N-BYTES)
  (ASET (LSH OPCODE 8) *MINI-PKT* 0)
  (ASET N-BYTES *MINI-PKT* 1)
  (ASET *MINI-REMOTE-HOST* *MINI-PKT* 2)
  (ASET *MINI-REMOTE-INDEX* *MINI-PKT* 3)
  (ASET *MINI-LOCAL-HOST* *MINI-PKT* 4)
  (ASET *MINI-LOCAL-INDEX* *MINI-PKT* 5)
  (ASET *MINI-OUT-PKT-NUMBER* *MINI-PKT* 6) ;PKT#
  (ASET *MINI-IN-PKT-NUMBER* *MINI-PKT* 7)  ;ACK#
  (LET ((WC (+ 8 (CEILING N-BYTES 2) 1))) ;Word count including header and hardware dest word
    (STORE-ARRAY-LEADER WC *MINI-PKT* %CHAOS-LEADER-WORD-COUNT)
    (ASET *MINI-ROUTING-ADDRESS* *MINI-PKT* (1- WC))) ;Store hardware destination

  (transmit-ethernet-16b-array
    *mini-my-ethernet-address*
    *mini-his-ethernet-address*
    *MINI-PKT*
    (max (+ 8 (ceiling n-bytes 2)) 64.) ; must be at least 64. bytes long.
    #x408)
  
;;;  (STORE-ARRAY-LEADER NIL *MINI-PKT* %CHAOS-LEADER-THREAD)
;;;  (STORE (SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-TRANSMIT-LIST) *MINI-PKT*)
;;;  (%CHAOS-WAKEUP)
;;;  (DO ()	;Await completion of transmission
;;;      ((NULL (SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-TRANSMIT-LIST))))
  ;; Disallow use of the packet by the receive side, flush any received packet that snuck in
;;;  (STORE (SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-FREE-LIST) NIL)
;;;  (STORE (SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-RECEIVE-LIST) NIL)
  (COPY-ARRAY-CONTENTS "" *MINI-PKT*))		;Fill with zero

;; Return opcode of next packet other than those that are no good.
;; If the arg is NIL, can return NIL if no packet arrives after a while.
;; If T, waits forever.  Return value is the opcode of the packet in *MINI-PKT*.
(DEFUN MINI-NEXT-PKT (MUST-RETURN-A-PACKET &AUX OP)
  ;flash an extra run light
  (if (zerop (%p-ldb (byte 1 0) (+ %disk-run-light 4)))
      (%p-store-tag-and-pointer (+ %DISK-RUN-LIGHT 4) 7 -74170361)
    (%p-store-tag-and-pointer (+ %disk-run-light 4) 0 0))

  (DO ((TIMEOUT 20. (1- TIMEOUT)))	;A couple seconds
      ((AND (ZEROP TIMEOUT) (NOT MUST-RETURN-A-PACKET)) NIL)
    ;; Enable microcode to receive a packet
;;;    (STORE (SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-FREE-LIST) NIL)
;;;    (STORE (SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-RECEIVE-LIST) NIL)
;;;    (STORE-ARRAY-LEADER NIL *MINI-PKT* %CHAOS-LEADER-THREAD)
;;;    (COPY-ARRAY-CONTENTS "" *MINI-PKT*)		;Fill with zero
;;;    (STORE (SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-FREE-LIST) *MINI-PKT*)
;;;    (%CHAOS-WAKEUP)
;;;    (DO ((N 2000. (1- N)))	;Give it time
;;;	((OR (ZEROP N) (SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-RECEIVE-LIST))))
    (receive-ethernet-16b-array *mini-pkt*)
    (COND (t ;(SYSTEM-COMMUNICATION-AREA %SYS-COM-CHAOS-RECEIVE-LIST)
	   (SETQ OP (LSH (AREF *MINI-PKT* 0) -8))
	   (COND ((AND
		       (= (AREF *MINI-PKT* 2) *MINI-LOCAL-HOST*)
		       (= (AREF *MINI-PKT* 3) *MINI-LOCAL-INDEX*)
		       (OR (AND (MEMQ OP '(14 202 203 200 300))  ;EOF, win, lose, data
				(= (AREF *MINI-PKT* 6) (LOGAND 177777 (1+ *MINI-IN-PKT-NUMBER*))))
			   (MEMQ OP '(2 3 11))))  ;OPN, CLS, LOS
		  ;; This packet not to be ignored, return to caller
		  (COND ((MEMQ OP '(3 11))  ;CLS, LOS
			 (LET ((MSG (MAKE-STRING (LOGAND 7777 (AREF *MINI-PKT* 1)))))
			   (COPY-ARRAY-CONTENTS *MINI-PKT-STRING* MSG)
			   (MINI-BARF "Connection broken" MSG))))
		  (RETURN OP)))
;  (format t "~&Ignoring pkt op ~o from ~a to ~a"
;	  (ash (aref *mini-pkt* 0) -8)
;	  (or (si:get-host-from-address (aref *mini-pkt* 4) :chaos) (aref *mini-pkt* 4))
;	  (or (si:get-host-from-address (aref *mini-pkt* 2) :chaos) (aref *mini-pkt* 2)))
	   ;; This packet to be ignored, get another
	   (AND *MINI-OPEN-P*		;Could be getting a retransmission of
		(MINI-SEND-STS))	; an old pkt due to lost STS
	   ))))

;Stream which does only 16-bit TYI
(DEFUN MINI-BINARY-STREAM (OP &OPTIONAL ARG1)
  (CASE OP
    (:WHICH-OPERATIONS '(:TYI :READ-BYTE :UNTYI :UNREAD-BYTE))
    (:OPERATION-HANDLED-P
     (cond ((memq arg1 '(:tyi :untyi :read-byte :unread-byte))
	    t)))
    (:send-if-handles
      nil)
    ((:TYI :READ-BYTE)
     (COND (*MINI-UNRCHF*
	    (PROG1 *MINI-UNRCHF* (SETQ *MINI-UNRCHF* NIL)))
	   ((< *MINI-CH-IDX* (FLOOR (LOGAND 7777 (AREF *MINI-PKT* 1)) 2))
	    (PROG1 (AREF *MINI-PKT* (+ 10 *MINI-CH-IDX*))
		   (SETQ *MINI-CH-IDX* (1+ *MINI-CH-IDX*))))
	   (T					;Get another packet
	    (MINI-SEND-STS)			;Acknowledge packet just processed
	    (SETQ OP (MINI-NEXT-PKT T))
	    (SETQ *MINI-IN-PKT-NUMBER* (LOGAND 177777 (1+ *MINI-IN-PKT-NUMBER*)))
	    (COND ((= OP #o14)			;EOF
		   (MINI-SEND-STS)		;Acknowledge the EOF
		   (SETQ *MINI-EOF-SEEN* T)
		   NIL)				;and tell caller
		  ((= OP #o300)			;Data
		   (SETQ *MINI-CH-IDX* 0)
		   (MINI-BINARY-STREAM ':TYI))
		  (T (MINI-BARF "Bad opcode received" OP))))))
    ((:UNTYI :UNREAD-CHAR) (SETQ *MINI-UNRCHF* ARG1))
    (:PATHNAME *MINI-FASLOAD-FILENAME*)
    (:GENERIC-PATHNAME 'MINI-PLIST-RECEIVER)
    (:INFO *MINI-FILE-ID*)
    (:CLOSE (DO () (*MINI-EOF-SEEN*) (MINI-BINARY-STREAM :READ-BYTE)))
    (:BYTE-SIZE 16.)
    (OTHERWISE (MINI-BARF "Unknown stream operation" OP))))

(DEFUN MINI-ASCII-STREAM (OP &OPTIONAL ARG1 CODE)
  (CASE OP
    (:WHICH-OPERATIONS '(:TYI :UNTYI :READ-CHAR :UNREAD-CHAR))
    (:OPERATION-HANDLED-P
     (cond ((memq arg1 '(:tyi :untyi :read-char :unread-char))
	    t)))
    (:send-if-handles
      nil)
    ((:TYI :READ-CHAR)
     (COND (*MINI-UNRCHF*
	    (prog1 (if (eq op ':tyi)
		        *MINI-UNRCHF*
		        (int-char *MINI-UNRCHF*))
		   (SETQ *MINI-UNRCHF* NIL)))
	   ((< *MINI-CH-IDX* (LOGAND #o7777 (AREF *MINI-PKT* 1)))
	    (PROG1 (if (eq op 'tyi)
		       (char-int (char *MINI-PKT-STRING* *MINI-CH-IDX*))
		       (char *MINI-PKT-STRING* *MINI-CH-IDX*))
		   (INCF *MINI-CH-IDX*)))
	   (T					;Get another packet
	    (MINI-SEND-STS)			;Acknowledge packet just processed
	    (SETQ CODE (MINI-NEXT-PKT T))
	    (SETQ *MINI-IN-PKT-NUMBER* (LOGAND #o177777 (1+ *MINI-IN-PKT-NUMBER*)))
	    (COND ((= CODE #o14)		;EOF
		   (MINI-SEND-STS)		;Acknowledge the EOF
		   (SETQ *MINI-EOF-SEEN* T)
		   (AND ARG1 (ERROR ARG1))
		   NIL)				;and tell caller
		  ((= CODE #o200)		;Data
		   (SETQ *MINI-CH-IDX* 0)
		   (MINI-ASCII-STREAM OP))
		  (T (MINI-BARF "Bad opcode received" OP))))))
    (:UNTYI (SETQ *MINI-UNRCHF* ARG1))
    (:UNREAD-CHAR (SETQ *MINI-UNRCHF* (CHAR-INT ARG1)))
    (:PATHNAME *MINI-FASLOAD-FILENAME*)
    (:GENERIC-PATHNAME 'MINI-PLIST-RECEIVER)
    (:INFO *MINI-FILE-ID*)
    (:CLOSE (DO () (*MINI-EOF-SEEN*) (MINI-ASCII-STREAM :READ-CHAR)))
    (:BYTE-SIZE 8)
    (OTHERWISE (MINI-BARF "Unknown stream operation" OP))))

(DEFUN MINI-BARF (&REST ARGS)
  (SETQ *MINI-OPEN-P* NIL) ;Force re-open of connection
  ;; If inside the cold load, this will be FERROR-COLD-LOAD, else make debugging easier
  (APPLY #'FERROR ARGS))

;;; Higher-level stuff

;;; Load a file alist as setup by the cold load generator
(DEFUN MINI-LOAD-FILE-ALIST (ALIST)
  (LOOP FOR (FILE PACK QFASLP) IN ALIST
     DO (PRINT FILE)
	(FUNCALL (IF QFASLP #'MINI-FASLOAD #'MINI-READFILE) FILE PACK)))

(DECLARE (SPECIAL *COLD-LOADED-FILE-PROPERTY-LISTS*))

(DEFUN MINI-FASLOAD (*MINI-FASLOAD-FILENAME* PKG
		     &AUX FASL-STREAM TEM)
  
  ;; Set it up so that file properties get remembered for when there are pathnames
  (OR (SETQ TEM (ASSOC-EQUAL *MINI-FASLOAD-FILENAME* *COLD-LOADED-FILE-PROPERTY-LISTS*))
      (PUSH (SETQ TEM (NCONS *MINI-FASLOAD-FILENAME*)) *COLD-LOADED-FILE-PROPERTY-LISTS*))
  (SETQ *MINI-PLIST-RECEIVER-POINTER* TEM)
  ;;Open the input stream in binary mode, and load from it.
  (SETQ FASL-STREAM (MINI-OPEN-FILE *MINI-FASLOAD-FILENAME* T))
  (FASLOAD-INTERNAL FASL-STREAM PKG T)
  ;; FASLOAD Doesn't really read to EOF, must read rest to avoid getting out of phase
  (MINI-CLOSE FASL-STREAM)
  *MINI-FASLOAD-FILENAME*)

(DEFUN MINI-CLOSE (STREAM)
  (DO () (*MINI-EOF-SEEN*)
    (FUNCALL STREAM :TYI)))

;This kludge simulates the behavior of PROPERTY-LIST-MIXIN.
;It is used instead of the generic-pathname in fasloading and readfiling;
;it handles the same messages that generic-pathnames are typically sent.
(DEFUN MINI-PLIST-RECEIVER (OP &REST ARGS)
  (CASE OP
    (:GET (GET *MINI-PLIST-RECEIVER-POINTER* (CAR ARGS)))
    (:GETL (GETL *MINI-PLIST-RECEIVER-POINTER* (CAR ARGS)))
    (:PUTPROP (PUTPROP *MINI-PLIST-RECEIVER-POINTER* (CAR ARGS) (CADR ARGS)))
    (:REMPROP (REMPROP *MINI-PLIST-RECEIVER-POINTER* (CAR ARGS)))
    (:PROPERTY-LIST (CAR *MINI-PLIST-RECEIVER-POINTER*))
    (:PLIST (CAR *MINI-PLIST-RECEIVER-POINTER*))
    (:PUSH-PROPERTY (PUSH (CAR ARGS) (GET *MINI-PLIST-RECEIVER-POINTER* (CADR ARGS))))
    (OTHERWISE
     (PRINT "Bad op to MINI-PLIST-RECEIVER ")
     (PRINT OP)
     (%HALT))))

(DEFUN MINI-READFILE (FILE-NAME PKG &AUX (FDEFINE-FILE-PATHNAME FILE-NAME) TEM)
  (LET ((EOF '(()))
	(*STANDARD-INPUT* (MINI-OPEN-FILE FILE-NAME NIL))
	(*PACKAGE* (PKG-FIND-PACKAGE PKG)))
    (DO ((FORM (CL:READ *STANDARD-INPUT* NIL EOF) (CL:READ *STANDARD-INPUT* NIL EOF)))
	((EQ FORM EOF))
      (EVAL FORM))
    (OR (SETQ TEM (ASSOC-EQUAL FILE-NAME *COLD-LOADED-FILE-PROPERTY-LISTS*))
	(PUSH (SETQ TEM (NCONS FILE-NAME)) *COLD-LOADED-FILE-PROPERTY-LISTS*))
    (LET ((*MINI-PLIST-RECEIVER-POINTER* TEM))
      (SET-FILE-LOADED-ID 'MINI-PLIST-RECEIVER *MINI-FILE-ID* *PACKAGE*))))

(DEFUN MINI-READFILE-bit-bucket (FILE-NAME PKG)
  (LET ((EOF '(()))
	(*STANDARD-INPUT* (MINI-OPEN-FILE FILE-NAME NIL))
	(*PACKAGE* (PKG-FIND-PACKAGE PKG)))
    (DO ((FORM (CL:READ *STANDARD-INPUT* NIL EOF) (CL:READ *STANDARD-INPUT* NIL EOF)))
	((EQ FORM EOF))
      (print form))))

(DEFUN MINI-BOOT ()
  (SETQ *MINI-OPEN-P* NIL)
  (VARIABLE-MAKUNBOUND *MINI-PKT*)
  (VARIABLE-MAKUNBOUND *MINI-PKT-STRING*))

(ADD-INITIALIZATION "MINI" '(MINI-BOOT) '(WARM FIRST))


;;; --------- addr res stuff

(defvar mini-addr-pkt (make-array 512. ':type 'art-16b))

(defun mini-immediate-address ()
  (cond ((= (LDB 1010 *MINI-LOCAL-HOST*) (LDB 1010 *MINI-REMOTE-HOST*))
	 *mini-destination-address*)
	(t *mini-routing-address*)))

(defun get-his-ethernet-address ()
  (setq *mini-his-ethernet-address* nil)
  (cond ((not (eq *use-nu-ethernet* 'share))
	  ;not necessary in share mode since ether conversion done on sharing host.
	 (terpri)
	 (princ "Trying to get remote ether address ")
	 (do ()
	     ((not (null *mini-his-ethernet-address*)))
	   (princ ".")
	   (mini-send-addr-pkt (mini-immediate-address) *mini-local-host*)
	   (dotimes (i 10000)
	     (cond ((mini-pkt-available)
		    (cond ((receive-ethernet-with-buffer-ready mini-addr-pkt)
			   (return t))))
		   ((not (null *mini-his-ethernet-address*))
		    (return t))))
	   ))))

(defun mini-send-addr-pkt (dest-chaos-address source-chaos-address)
  (make-addr-pkt mini-addr-pkt
		 dest-chaos-address
		 source-chaos-address
		 1_8. ; request
		 0)
  (transmit-ethernet-16b-array 
    *mini-my-ethernet-address* -1 mini-addr-pkt 64. #x608))


(defun receive-addr-pkt (array)			;art-16b
  (cond ((and (= (aref array #o13) *mini-local-host*)
	      (= (aref array #o7) (mini-immediate-address)))
	 (setq *mini-his-ethernet-address* (get-address-from-array array 4))
	 (terpri)
	 (princ "Changing *mini-his-ethernet-address* to ")
	 (let ((*print-base* 8))
	   (prin1 *mini-his-ethernet-address*))
	 (princ " = #x")
	 (let ((*print-base* 16.))
	   (prin1 *mini-his-ethernet-address*))
	 (terpri))))

(defun make-addr-pkt (array dest-chaos-address source-chaos-address
		      &optional (opcode 1_8.) (his-ether 0))
		;array is art-16b
  (aset 1_8. array 0)				;ar_hardware
  (aset #x408 array 1)				;ar_protocol = CHAOS
  (aset (logior 6 2_8.) array 2)		;ar_hlength & ar_plength
  (aset opcode array 3)				;ar_opcode
  (put-address-to-array *mini-my-ethernet-address* array 4) ;ar_esender in slots 4, 5, and 6
  (aset source-chaos-address array 7)		;ar_csender
  (put-address-to-array his-ether array #o10)	;ar_etarget
  (aset dest-chaos-address array #o13))


(defun put-address-to-array (addr array place)
  (aset (dpb (ldb 4010 addr) 1010 (ldb 5010 addr)) array place)
  (aset (dpb (ldb 2010 addr) 1010 (ldb 3010 addr)) array (1+ place))
  (aset (dpb (ldb 0010 addr) 1010 (ldb 1010 addr)) array (+ place 2)))

(defun get-address-from-array (array place)
  (let ((word1 (aref array place))
	(word2 (aref array (1+ place)))
	(word3 (aref array (+ place 2))))
    (logior (ash (dpb (ldb 0010 word1) 1010 (ldb 1010 word1)) 32.)
	    (ash (dpb (ldb 0010 word2) 1010 (ldb 1010 word2)) 16.)
	    (dpb (ldb 0010 word3) 1010 (ldb 1010 word3)))))

;;; --------- end of address res stuff