;;; -*- Mode: Lisp; Package: System-Internals; BASE: 8; Cold-load: T -*-

;;; 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* t)

(defun ethernet-reset ()
  (cond ((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 ((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 ((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 ((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 ((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.

(DECLARE (SPECIAL MINI-PKT MINI-PKT-STRING MINI-FILE-ID MINI-OPEN-P MINI-CH-IDX MINI-UNRCHF
		  MINI-LOCAL-INDEX MINI-LOCAL-HOST MINI-REMOTE-INDEX MINI-REMOTE-HOST
		  MINI-IN-PKT-NUMBER MINI-OUT-PKT-NUMBER MINI-EOF-SEEN
		  MINI-DESTINATION-ADDRESS MINI-ROUTING-ADDRESS
		  MINI-PLIST-RECEIVER-POINTER))

;This is the filename (a string) on which MINI-FASLOAD was called.
(DEFVAR MINI-FASLOAD-FILENAME)

(SETQ MINI-DESTINATION-ADDRESS #.(chaos:address-parse "LAM2"))
(SETQ MINI-ROUTING-ADDRESS #.(chaos:address-parse "CADR2")) ; bridge to get there if subnet difrs
(setq mini-local-host 3407) ;host number reserved for cold loading . not used by anyone else
(defvar mini-his-ethernet-address nil) ;gets ether address of bridge
(defvar mini-my-ethernet-address :unbound)
(defvar mini-remote-host nil)

(defvar mini-possible-destinations '#.(mapcar #'(lambda (x) (list x (chaos:address-parse x)))
					      '("LAM2" "LAM8")))

;;; Contact name<space>user<space>password
(DEFVAR 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-array 760
				    :type art-string
				    :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 (base 8) (ibase 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 (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)
  (if-in-lambda
    (arm-ethernet-for-receive))
  (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 201 200) (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 2)		;OPN
	   (MINI-SEND-STS))	;send STS and then retransmit
	  ((OR (= OP 202) (= OP 203)) ;Win or Lose
	   (SETQ MINI-IN-PKT-NUMBER (LOGAND 177777 (1+ MINI-IN-PKT-NUMBER))
		 MINI-OUT-PKT-NUMBER (LOGAND 177777 (1+ MINI-OUT-PKT-NUMBER)))
	   (LET* ((LENGTH (LOGAND 7777 (AREF MINI-PKT 1)))
		  (CR (STRING-SEARCH-CHAR #\CR 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)
				      ;;Discard zero at front of month, so the format
				      ;;matches that produced by PRINT-UNIVERSAL-TIME,
				      ;;and by QFILE before TIMPAR is loaded.
				      (STRING-LEFT-TRIM
					#/0 (SUBSTRING MINI-PKT-STRING (1+ CR) LENGTH)))))
	   (MINI-SEND-STS)	;Acknowledge packet just received
	   (COND ((= OP 202)
		  (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-ARRAY (LOGAND 7777 (AREF MINI-PKT 1))
						':TYPE 'ART-STRING)))
			   (COPY-ARRAY-CONTENTS MINI-PKT-STRING MSG)
			   (MINI-BARF "Connection broken" MSG))))
		  (RETURN OP)))
	   ;; 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)
  (SELECTQ OP
    (:WHICH-OPERATIONS '(:TYI))
    (:TYI (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 14) ;EOF
			(MINI-SEND-STS) ;Acknowledge the EOF
			(SETQ MINI-EOF-SEEN T)
			NIL)		;and tell caller
		       ((= OP 300) ;Data
			(SETQ MINI-CH-IDX 0)
			(MINI-BINARY-STREAM ':TYI))
		       (T (MINI-BARF "Bad opcode received" OP))))))
    (:UNTYI (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 ':TYI)))
    (OTHERWISE (MINI-BARF "Unknown stream operation" OP))))

(DEFUN MINI-ASCII-STREAM (OP &OPTIONAL ARG1)
  (SELECTQ OP
    (:WHICH-OPERATIONS '(:TYI :UNTYI))
    (:TYI (COND (MINI-UNRCHF
		 (PROG1 MINI-UNRCHF (SETQ MINI-UNRCHF NIL)))
		((< MINI-CH-IDX (LOGAND 7777 (AREF MINI-PKT 1)))
		 (PROG1 (AREF MINI-PKT-STRING 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 14) ;EOF
			(MINI-SEND-STS) ;Acknowledge the EOF
			(SETQ MINI-EOF-SEEN T)
			(AND ARG1 (ERROR ARG1))
			NIL)		;and tell caller
		       ((= OP 200) ;Data
			(SETQ MINI-CH-IDX 0)
			(MINI-ASCII-STREAM ':TYI))
		       (T (MINI-BARF "Bad opcode received" OP))))))
    (:UNTYI (SETQ MINI-UNRCHF ARG1))
    (:PATHNAME MINI-FASLOAD-FILENAME)
    (:GENERIC-PATHNAME 'MINI-PLIST-RECEIVER)
    (:INFO MINI-FILE-ID)
    (:CLOSE (DO () (MINI-EOF-SEEN) (MINI-ASCII-STREAM ':TYI)))
    (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
  (LEXPR-FUNCALL #'FERROR 'MINI-BARF 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)
	DO (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 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)
  (SELECTQ 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)))
    (: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 (READ STANDARD-INPUT EOF) (READ STANDARD-INPUT EOF) (EQ FORM EOF)
	(EVAL FORM))
    (OR (SETQ TEM (ASSOC 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 (READ STANDARD-INPUT EOF) (READ STANDARD-INPUT 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 ()
  (terpri)
  (princ "Trying to get remote ether address ")
  (setq mini-his-ethernet-address nil)
  (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 13) mini-local-host)
	      (= (aref array 7) (mini-immediate-address)))
	 (setq mini-his-ethernet-address (get-address-from-array array 4))
	 (terpri)
	 (princ "Changing mini-his-ethernet-address to ")
	 (let ((base 8))
	   (prin1 mini-his-ethernet-address))
	 (princ " = #x")
	 (let ((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 10)	;ar-etarget
  (aset dest-chaos-address array 13))


(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