;;;-*- Mode:LISP; Package:LAMBDA; Lowercase:T; Base:8; Readtable:ZL -*- ;;; ;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc. ;;; (defun memory-setup (&optional (slot (SEND *PROC* :MEM-SLOT))) (cond ((access-path-lmi-serial-protocol *proc*) (format terminal-io "~%ignoring (memory-setup ~s)" slot)) (t (memory-init slot) (send *proc* :bus-slot-write slot 0 105) (send *proc* :bus-slot-write slot 1 -1) (cond ((not (= (send *proc* :bus-slot-read slot 0) 105)) (ferror nil "memory in slot ~s doesnt seem to work" slot))))) SLOT) (DEFCONST MEMORY-ECC-REGISTER-ADR #16RFFDFEB) ;byte address, read only (DEFCONST MEMORY-ERROR-ADDRESS-ADR #16RFFDFFE8) ;read only 24 bits. (DEFCONST MEMORY-ECC-INPUT-LATCH-ADR #16RFFDFEC) ;write only 32 bits (DEFCONST MEMORY-ECC-OUTPUT-LATCH-ADR #16RFFDFE8) ;read only 32 bits. (DEFCONST MEMORY-ECC-CHECK-BIT-REG-ADR #16RFFDFF0) ;write only 8 bits. (DEFCONST MEMORY-CONTROL-REG-ADR #16RFFDFE5) ;read/write. 8 bits. (DEFCONST MEMORY-READ-CHECK-BIT-ADR #16RFFDFE7) ;read only, 8 bits ;;; new memory hacking stuff (defun read-memory-control-reg (slot) (send *proc* :bus-slot-read-byte slot memory-control-reg-adr)) (defun read-memory-control-reg-quad-slot (quad-slot) (send *proc* :bus-quad-slot-read-byte quad-slot memory-control-reg-adr)) (defun write-memory-control-reg (slot data) (send *proc* :bus-slot-write-byte slot memory-control-reg-adr data)) (comment (defun read-memory-control-reg (&optional (slot (SEND *PROC* :MEM-SLOT))) (ldb 1010 (nd-slot-read slot (ash #16rffdfe4 -2)))) (defun write-memory-control-reg (data) (nd-slot-write (SEND *PROC* :MEM-SLOT) (ash #16rffdfe4 -2) (dpb data 1010 0))) ) (defun memory-ecc-register (&optional (slot (SEND *PROC* :MEM-SLOT))) (send *proc* :bus-slot-read-byte slot memory-ecc-register-adr)) ;all these definitions relative to control register byte, ie bits 15-8 of word. (defconst mem-con-ecc-mode (byte 2 0.)) (defconst mem-con-ecc-disable (byte 1 2.)) (defconst mem-con-ecc-correct (byte 1 3.)) (defconst mem-con-wordmd (byte 1 4.)) (defconst mem-con-multiple-single-errors (byte 1 5.)) (defconst mem-con-double-bit-error (byte 1 6.)) (defconst mem-con-single-bit-error (byte 1 7.)) (defun memory-status (&optional slot) (cond ((null slot) (dolist (ent (send *proc* :memory-configuration-list)) (cond ((not (zerop (car ent))) (format t "~%Quad ~s, slot ~s:" (ldb 2204 (cadr ent)) (ldb 1604 (cadr ent))) (memory-status (ldb 1604 (cadr ent))))))) ((eq (car (aref nubus-configuration-array slot)) 'ram-512k) (format t "~&slot ~O is a 2mb board, and doesn't have status" slot)) ((print-memory-control-register (read-memory-control-reg slot)) (cond ((fquery nil "~% Do (memory-init ~o) to clear error? " slot) (memory-init slot) (format t "~2%")))))) (defun memory-status-quad-slot (&optional quad-slot) (cond ((null quad-slot) (dolist (ent (send *proc* :memory-configuration-list)) (cond ((not (zerop (car ent))) (format t "~%Quad ~s, slot ~s:" (ldb 2204 (cadr ent)) (ldb 1604 (cadr ent))) (memory-status-quad-slot (ldb 1610 (cadr ent))))))) (t (let ((type (car (aref nubus-configuration-array (quad-slot-to-configuration-index quad-slot))))) (selectq type (ram-512k (format t "~&slot ~O is a 2mb board, and doesn't have status" quad-slot)) (ram-128k (cond ((print-memory-control-register (read-memory-control-reg-quad-slot quad-slot)) (let ((index (quad-slot-to-configuration-index quad-slot))) (fquery nil "~% Do (memory-init ~o) to clear error? " index) (memory-init index) (format t "~2%"))))) (ram-1024k (format t "~&don't know how to print status for 4mb board in slot ~o" quad-slot)) (t (format t "~&unknown memory board typs ~s in slot ~o" type quad-slot))))))) ;return T if there represents a serious error. (defun print-memory-control-register (control-reg) (let ((error-p nil)) (format t "~% control register=~O" control-reg) (format t "~% ~[normal mode~;diag correct~;diag generate~;initialize~]" (ldb mem-con-ecc-mode control-reg)) (format t "~% ~[errors reported to bus normally~; errors not reported to bus~]" (ldb mem-con-ecc-disable control-reg)) (format t "~% ~[no ecc correction~;normal ecc correction~]" (ldb mem-con-ecc-correct control-reg)) (format t "~[~;~% all writes made into full word writes~]" (ldb mem-con-wordmd control-reg)) (cond ((not (zerop (ldb mem-con-multiple-single-errors control-reg))) (format t "~% multiple single bit errors") (setq error-p t))) (cond ((not (zerop (ldb mem-con-double-bit-error control-reg))) (format t "~% double bit error") (setq error-p t))) (cond ((not (zerop (ldb mem-con-single-bit-error control-reg))) (format t "~% single bit error") (setq error-p t))) error-p)) ;under construction ;(defun fast-setup-memory () ; (write-memory-control (dpb 4 1010 0)) ; (dotimes (i 8.) ; (nd-slot-write 14 0 0)) ; (dotimes (i 8.) ; (nd-slot-write 14 #16r40000 0)) ; ;clear all of memory ; (uload (a-ones ; m-ones ; a-zero ; m-a ; m-b) ; 0 ; ;((M-B) DPB M-ONES (BYTE-FIELD 1 17.) A-ZERO) ;400000 WORDS OF MAIN MEMORY ; (lam-ir-op lam-op-byte ; ;CLEAR-MAIN-MEMORY ; ((M-B) ADD M-B A-ONES) ; ((MD) A-ZERO) ;data to write and also address map page 0. ; ((M-A) LDB M-B (BYTE-FIELD 9 8) A-ZERO) ;get page number within memory. ; ((L2-MAP-CONTROL) DPB M-ONES (BYTE-FIELD 1 9) A-400) ;1400, rw access ; ((L2-MAP-PHYSICAL-PAGE) DPB M-A (BYTE-FIELD 9 0) a-base-physical-page) ; ((VMA-START-WRITE) LDB M-B (BYTE-FIELD 8 0) A-ZERO) ; (CALL-IF-PAGE-FAULT ERROR-PAGE-FAULT) ; (JUMP-NOT-EQUAL M-B A-ZERO CLEAR-MAIN-MEMORY) ; (DEFUN MEMORY-INIT (SLOT) (cond ((access-path-lmi-serial-protocol *proc*) (format t "~%fix memory initialization, memory slot ~s" slot)) (t (selectq (car (aref nubus-configuration-array slot)) (ram-128k (WRITE-MEMORY-CONTROL-REG SLOT #16r04) (LET ((OLD-CONTENTS (send *proc* :bus-slot-read slot 0 t))) (DOTIMES (I 8.) (send *proc* :bus-SLOT-WRITE SLOT 0 0)) (cond (old-contents (send *proc* :bus-slot-write SLOT 0 OLD-CONTENTS)))) ;(DOTIMES (I 8.) ; (ND-SLOT-WRITE SLOT #16r040000 0)) ;TURN ON ECC. MEMORY MAY NOT BE CLEARED YET THO. (WRITE-MEMORY-CONTROL-REG SLOT #16r08)) (ram-512k nil) (t (ferror nil "unknown ram type ~S" (aref nubus-configuration-array slot)))))))