;; -*- Mode:LISP; Package:si; Base:10; Fonts:CPTFONT -*- ;;; This stuff can not be run in the cold load environment. (Defun LOOP-BACK-TEST (enc &optional no-init-p) "Run a full loop Back test. Unless NO-INIT-P is T, Initialize ENC first." ;; When the controller is on an active Ethernet, it should be initialized to clear out ;; any frames received before the Loop Back test. (Let ((Debug-nubus-addresses nil) (ok nil) (slot (enc-slot enc))) (Format t "~%ETHERNET BOARD LOOP-BACK TEST, Slot ~16R" slot) (*Catch 'Abort-Chaos (if (not no-init-p ) (INITIALIZE enc)) ;Ensure that Controller is initialized. (setq Debug-Nubus-Addresses nil) ;(Init...) turns Debug on. (Loop-back enc 1) ;82586 Internal Loop Back (Format t "~& * Controller Chip ") (When (CHAOS-LOOP-BACK enc "586") (Princ "LOOP BACK OK *") (Loop-Back enc 1 nil) ;82501 Internal Loop Back (Setf (Nubus-Loop-Back enc) 1) (Format t "~& * Serial Link Chip ") (When (CHAOS-LOOP-BACK enc "501") (Princ "LOOP BACK OK *") (Setf (Nubus-Loop-Back enc) 0) ;ENC External Loop Back (Format t "~& * Tranceiver Link ") (When (CHAOS-LOOP-BACK enc "tran") (Princ "LOOP BACK OK *") (Setq OK t) ;All Loop Backs Succeeded OK. ))) (Loop-Back enc 0) (Setf (Nubus-Loop-Back enc) 0) (terpri) OK))) (Defun LOOP-BACK (enc state &optional (int-loop-back t)) ;1/31/84 raf "Set the loopback to STATE (0 = OFF, 1 = ON). If INT-LOOP-BACK is T, set Int loop-back, else set Ext loop-back." (SEND-COMMAND enc (CONFIGURE) cb (Setf (Block-Parameter enc cb 0) #x080B) ;Magic numbers needed to keep current setup (Setf (Block-Parameter enc cb 1) (dpb state (if int-loop-back #o1601 #o1701) #x2600)) ;Magic value to keep current setup. (Setf (Block-parameter enc cb 2) #x6000) (Setf (Block-parameter enc cb 3) #xF200) (Setf (Block-parameter enc cb 4) #x0000) (Setf (Block-parameter enc cb 5) (if (= state 1) 16. 64.))) ;Set min frame len. (Ack-Xmit-Interrupts enc t)) (Defun CHAOS-LOOP-BACK (enc string &optional print-p &aux pkt) ;12/84 RAF "Send a Chaos RFC, with STRING thru the loop-back, which MUST be already turned on." (*Catch 'Loop-Back-Failure (Send-Test-RFC enc Chaos:My-Address string t) (Process-Wait-with-Timeout "ENC Interrupt" 180. ;timeout in 3 seconds. #'(lambda (enc) (= 1 (SCB-CX-Flag enc))) enc) (Unless (and (= 1 (Command-Complete-Flag enc (SCB-CBL-Offset enc))) (= 1 (Command-Error-Flag enc (SCB-CBL-Offset enc))) (= 1 (SCB-CX-Flag enc))) (Princ "Loop back failed at transmit:") (Print-Command-Block-Status enc (SCB-CBL-Offset enc (Enc-SCB enc))) (Print-SCB-Status enc) (*Throw 'Loop-Back-Failure nil)) (Unless (and (= 1 (SCB-FR-Flag enc)) (= 1 (Command-Complete-Flag enc (SCB-Current-Receive-Frame enc))) (= 1 (Command-Error-Flag enc (SCB-Current-Receive-Frame enc)))) (Princ "Loop back failed to receive frame:") (Print-Receive-Frame-Status enc (SCB-Current-Receive-Frame enc)) (Print-SCB-Status enc) (*Throw 'Loop-Back-Failure nil)) (Unwind-Protect (progn (Setq pkt (Receive-Pkt SELF)) (if (not (null pkt)) (let ((same (string-equal string (Chaos:Pkt-String pkt)))) (if (or print-p (not same)) (format t "~&Received String: ~S Sent : ~S" (Chaos:Pkt-String pkt) string)) same) (Princ "No Pkt in the received frame.") (Print-SCB-Status enc) (Print-Command-Block-Status enc (SCB-CBL-Offset enc)) (Print-Receive-Frame-Status enc (SCB-Current-Receive-Frame enc)) nil) ) (Ack-Xmit-Interrupts enc nil) (Ack-Recv-Interrupts enc nil) (if (not (null pkt)) (Chaos:Free-Pkt pkt))))) (Defun SEND-TEST-RFC (enc chaos-address contact &optional ignore &aux pkt) "Send a 'Status' request to the machine at CHAOS-ADDRESS." ;12/84 RAF (Unwind-Protect (Progn (Setq pkt (Chaos:Get-Pkt)) (Chaos:SET-PKT-STRING pkt contact) (Setf (Chaos:PKT-OPCODE pkt) Chaos:RFC-OP) (SETF (Chaos:PKT-SOURCE-ADDRESS PKT) Chaos:MY-ADDRESS) (SETF (Chaos:PKT-SOURCE-INDEX-NUM PKT) 0) (SETF (Chaos:PKT-DEST-ADDRESS PKT) chaos-address) (SETF (Chaos:PKT-DEST-INDEX-NUM PKT) 0) (transmit-frame enc chaos-address Ethernet:Chaos-Ethernet-Type (Chaos:Convert-To-Int-Pkt pkt) (+ 16. (Chaos:Pkt-Nbytes pkt)))) (Chaos:Return-Pkt pkt))) (Defun RECEIVE-PKT (enc) ;12/84 RAF "Returns the next buffer as a Chaos pkt ALLOCATEs the PKT." (multiple-value-bind (ignore ignore type int-pkt) (receive-frame ENC (Chaos:Allocate-Int-Pkt)) (if (= type Ethernet:CHAOS-ETHERNET-TYPE) (Chaos:Convert-to-Pkt int-pkt) (Chaos:Free-Int-Pkt int-pkt) ;try again. (RECEIVE-PKT enc)))) (defun test-receive () (format t "~3&Send Packet:") (mini-send-addr-pkt #o3420 mini-local-host) (format t "~2&Receive Packet:") (receive-ethernet-16b-array mini-addr-pkt) ) (defun receive-nu () (dotimes (i 1000.) (receive-ethernet-16b-array mini-addr-pkt)) ) (defun test-send (seed) (dotimes (i 5.) (aset (+ seed i) mini-pkt (+ i 8.))) (MINI-SEND-PKT 2 10.) ) (defun test-brd () (do () (nil) (format t "~3&start test...") (mini-send-addr-pkt #o3422 mini-local-host) (process-sleep 30.) (format t "~&Looking...") (test-look))) (defun test-look () (do ((pkt (chaos:lambda-get-next-pkt) (chaos:lambda-get-next-pkt))) ((null pkt)) (format t "~&Opcode: ~16r" (ldb 1010 (aref pkt 3))) (chaos:free-int-pkt pkt))) (defun stop-lambda-chaos () (process-disable chaos:receiver)) (defun start-lambda-chaos () (process-enable chaos:receiver)) (defun flush-received-pkts () (do ((x (chaos:lambda-get-next-pkt) (chaos:lambda-get-next-pkt))) ((null x)) (chaos:free-int-pkt x))) ;;; then use chaos:lambda-get-next-pkt (remember to do (chaos:free-int-pkt x) on each one .. if not, (chaos:reset t)