;;; -*- Mode:LISP; Package:LISP-INTERNALS; Base:10; Readtable:CL -*- ;;; see daisy-prom.lisp and daisy-sim.lisp ;;; for code which transfers and runs test vectors on the daisy ;;; see k;trap.lisp for trap vectors ;;; the daisy-prom.lisp code uses nc:link ;;; nc:link differs from cold-link in that it ignores a negative TOFFSET and the ENTRY-POINT to external refs ;;; nc:link sets the starting address ;;; cold-link is in kold-loader.lisp ;;; certain things not allowed in tests ;;; no functional arguments (which would be fixed up by cold-link negative toffset ;;; no code that requires runtime support functions (FUNCALL, etc..) ;;; code lives in top half of virtual memory (implied high bit set, implied low bit off for 64bit instruction pc) ;;; Questions ;;; What is the best way to handle addressing individual words in a two word instruction ?? ;;; The original DAISY-SIM defafun has a jump to location 32 at location 3. ;;; Does the daisy simulation always start at location zero ?? ;;; And if it does why is the jump at location 3 ?? ;;; (Perhaps the last question is answered by studying the trap PAL logic.) ;;; How do I access code locations ??? ;;; Same as data memory locations. ;;; It all depends on how the Memory Map is set up. ;;; We can make the first cluster of virtual memory point to the ;;; same cluster that the code lives in. ;;; Global Registers ??? ;;; perhaps lisp cpnstants ;;; but in general for assembly code don't depend on them #| ;;;**************************************************************** ;;; ;;; K Test Example Boot Code (Lambda side) ;;; ;;;**************************************************************** (defun pseudo-boot () (k-init) (k-kbug:setup-processor-control-register) (k-kbug:setup-memory-control-register) ;; Traps are off here. (k-kbug:direct-map-location-zero) ;; Now, we figure out where to map the initial instructions. (labels ((map-n-instruction-clusters (n physical virtual) (unless (zerop n) (format t "~&Mapping ~X to ~X" virtual physical) (map::write-map virtual (map::inject-map-status (dpb-multiple physical hw:%%map-on-board-address hw:$$map-local hw:%%map-local-memory-bit 0 hw:%%map-volatility 0 hw:%%map-c-trap-bits 0) map::$$map-status-read-only)) (map-n-instruction-clusters (1- n) (1+ physical) (1+ virtual))))) (map-n-instruction-clusters (dpb 0 vinc:%%data-type (boot::read-boot-vector **initial-code-size-in-clusters-bv-offset**)) (ash (dpb 0 vinc:%%data-type (boot::read-boot-vector **initial-code-physical-location-bv-offset**)) -10.) *first-instruction-cluster*)) ;; Size the physical memory (let ((size (k-kbug:find-physical-memory))) ;return size in megabytes. (format t "~%Physical memory = ~8,'0x" size) (write-boot-vector **physical-memory-block-map** size)) ;; Inform the K about the bootprom version (write-boot-vector **bootprom-version** 0.) ;; Mapped in some instructions, jump to them. (hw:jump (read-boot-vector **initial-code-entry-point-bv-offset**)) ) (defun k-reset () "Issue a reset to the K processor and stops the clocks" (do ((foo nil (format t "J100 failed "))) ((= #x100 (k-read-spy-pc))) (k-write-mode 1.) (k-stop) (k-init))) (defun k-init () "Init some registers, and set the PC to #x0100" (k-stop) (k-execute KIH-JUMP #x100) ;; Magic machine unwedger. (dotimes (i 5) ; (k-spy-cmd $$spy-command-reload-instruction) ; (k-spy-cmd $$spy-command-clear-spy-mode) ; (k-spy-cmd $$spy-command-step) ; (k-spy-cmd $$spy-command-set-spy-mode) (k-execute4 kih-jump #x100)) (k-execute KIH-LOAD-VMA 0) (k-execute KIH-LOAD-MAP #x8f) (k-execute3 KIH-JUMP #x100)) (defun k-stop () "Stop the processor clocks, and init spy modes" (k-spy-cmd $$spy-command-stop) (k-spy-cmd $$spy-command-stepmode-full-clock) (k-spy-cmd $$spy-command-set-spy-mode) ; set spy mode (k-spy-cmd $$spy-command-clear-opc-clock) ; clear opc clk (setq k-run-flag nil) (k-read-spy-pc)) (defun setup-processor-control-register () (hw:write-processor-control (dpb-multiple hw:$$icache-set-disable hw:%%processor-control-icache-a-enable hw:$$icache-set-disable hw:%%processor-control-icache-b-enable hw:$$icache-set-disable hw:%%processor-control-icache-z-enable 0 hw:%%processor-control-spare-3 0 hw:%%processor-control-jump-indirect hw:$$floating-point-status-ram-read hw:%%processor-control-floating-point-status-ram-write-enable hw:$$box-mode-normal hw:%%processor-control-box-mode hw:$$run hw:%%processor-control-halt-processor 0 hw:%%processor-control-data-bit 0 hw:%%processor-control-misc 0 hw:%%processor-control-stack-group-number 0 hw:%%processor-control-spare-17 hw:$$call-heap-underflow-trap-disable hw:%%processor-control-heap-underflow-trap-enable hw:$$floating-point-trap-disable hw:%%processor-control-floating-point-trap-enable 0))) (defun setup-memory-control-register () (hw:write-memory-control (dpb-multiple ;; Top bits will be zero, so traps will be off. hw:$$reset-trap-bit-off hw:%%memory-control-reset-trap-bit hw:$$dram-parity-disable hw:%%memory-control-dram-parity-enable hw:$$bootprom-off hw:%%memory-control-bootprom-disable 0 hw:%%memory-control-transporter-mode hw:$$lisp-map-bits hw:%%memory-control-l-c-map-select hw:$$write-normal-parity hw:%%memory-control-write-wrong-parity hw:$$timer-interrupt-disable-reset hw:%%memory-control-16384-interrupt hw:$$timer-interrupt-disable-reset hw:%%memory-control-1024-interrupt hw:$$icache-trap-disable-reset hw:%%memory-control-icache-error-enable hw:$$nubus-transfer-32-bits hw:%%memory-control-nubus-transfer-mode 7. hw:%%memory-control-leds 0))) (defun direct-map-location-zero () (map::write-map 0 (map::inject-map-status (dpb-multiple hw:$$map-local hw:%%map-local-memory-bit 0 hw:%%map-on-board-address map::$$cluster-not-fresh map::%%map-fresh-cluster 0) map:$$map-status-normal))) (defun find-physical-memory (&optional (max-chunk 32.)) (if lam:*local-debugging* (setq max-chunk 16.)) ;better not get bus timeouts in local mode. (labels ((mark-physical-memory (chunk) (if (minusp chunk) (locate-physical-memory 0 0) (progn (k-mem-write (ash chunk 20.) chunk) (mark-physical-memory (1- chunk))))) (locate-physical-memory (chunk map) (cond ((= chunk max-chunk) map) ;check first before you reference! (t (let ((data (k-mem-read (ash chunk 20.)))) (cond ((and (numberp data) (= chunk data)) (locate-physical-memory (1+ chunk) (logior (ash 1. chunk) map))) (t (locate-physical-memory (1+ chunk) map)))))))) (mark-physical-memory (1- max-chunk)))) ;;; K-BOOT calls KBUG-LOAD-COLD-INFO and then WARM-LOAD ;; from KOLD-LOADER (defun fasd-cold-function-info (stream) (let ((count (length cold:*cold-loaded-functions*))) (fasdump:fasd-fixnum-internal count stream) (dolist (fcn cold:*cold-loaded-functions*) (let ((name (nc::ncompiled-function-name fcn))) (format t "~&~3d ~A" (setq count (1- count)) name) (fasdump:fasd-cold-compiled-function-info name (nc::ncompiled-function-local-refs fcn) (nc::ncompiled-function-refs fcn) (nc::ncompiled-function-immediates fcn) (nc::ncompiled-function-entry-points fcn) (nc::ncompiled-function-length fcn) (nc::ncompiled-function-starting-address fcn) stream))))) ;; from NEW-FASDUMP (defun fasd-cold-compiled-function-info (name local-refs refs immediates entry-points length starting-address stream) (fasd-object name stream) (fasd-link-info local-refs refs entry-points stream) (fasd-fixnum-internal length stream) (fasd-fixnum-internal starting-address stream) (fasd-immediates immediates stream)) ;;;**************************************************************** ;;; ;;; K Test Example Boot Code (K side) ;;; ;;;**************************************************************** ;;; This code runs in the K after the cold load is down-loaded ;; from BOOT.LISP (defun cold-boot-function () (hw:write-open-active-return #x101112) ;temp O=10, A=11, R=12 (hw:nop) (prims::setup-initial-values-of-global-registers) (cold-initialize-call-hardware) (event-horizon) (labels ((loop-forever () (trap::illop "Unexpected return from the event horizon.") (loop-forever))) (loop-forever))) (defun event-horizon () (load-up-runtime-global-constants) (modify-icache-enables hw:$$icache-enable-all-sets) (map::direct-map (read-boot-vector **physical-memory-block-map**)) (gc-ram::load-ram (read-boot-vector *initial-gc-ram-data-physical-location*)) (transporter-ram:load-transporter-ram (read-boot-vector *initial-transporter-ram-data-physical-location*)) (datatype-ram:load-initial-datatype-ram) (pcd:create-physical-cluster-data-table) (pcd:initialize-physical-cluster-data *initial-physical-cluster-data-physical-location*) (pcd:free-unused-physical-clusters (read-boot-vector **physical-memory-block-map**)) (map:flush-direct-map) (nubus-stuff::map-in-k-io-cluster) (modify-asynchronous-traps hw:$$trap-enable) (modify-synchronous-traps hw:$$trap-enable) (modify-icache-traps hw:$$trap-enable) (trap::trap-on) (k2::init-kbug) (modify-datatype-traps hw:$$trap-enable) (modify-overflow-traps hw:$$trap-enable) (if (read-boot-vector *cold-load-flag*) (synthesize-cold-load) (trap::illop "I want to call LISP-REINITIALIZE."))) (defun synthesize-cold-load () ;; Make region to hold region-data (synthesize-region-data) ; (trap::illop "Made region data.") (synthesize-area-data) ; (test-tak-with-lights) ; (trap::illop "made area data.") (setq gr::*desperate-consing-area* (area-data:make-area 1. (region-bits:encode-region-bits region-bits:$$region-fixed region-bits:$$region-new-space region-bits:$$region-space-unboxed region-bits:$$region-read-write region-bits:$$scavenge-enabled region-bits:$$region-internal-memory 0.) 1.)) ; (trap::illop "Made desparate-consing-area") ;; Make the default consing area and load up the cons cache. (let ((default-consing-area (area-data:make-area 7. (region-bits:encode-region-bits region-bits:$$region-fixed region-bits:$$region-new-space region-bits:$$region-space-unboxed region-bits:$$region-read-write region-bits:$$scavenge-enabled region-bits:$$region-internal-memory 5.) 5.))) (setq gr:*cons-cache-area* default-consing-area) (setq gr:*structure-cons-cache-area* default-consing-area) (region-data::invalidate-cons-cache) (setq gr:*default-code-area* (area-data:make-area 3 (region-bits:encode-region-bits region-bits:$$region-fixed region-bits:$$region-new-space region-bits:$$region-space-code region-bits:$$region-read-write region-bits:$$scavenge-enabled region-bits:$$region-internal-memory 5.) 5.)) ; (setq gr::*cons-cache-region* -1) ; (setq gr::*structure-cons-cache-region* -1) ; (area-data::get-active-region ; default-consing-area ; region-bits::$$region-space-cons ; region-bits::$$region-new-space ; nil ; 0) ;; (trap::illop "loaded cons cache.") ; (area-data::get-active-region ; default-consing-area ; region-bits::$$region-space-structure ; region-bits::$$region-new-space ; nil ; 0) (setq gr::*default-consing-area* default-consing-area)) (cons::initialize-structure-handles) ;;; The are for the "other side" of dt-right-array-and-left-structure (setq gr:*random-structure* (li:make-structure 1)) (setq gr:*random-array* (array:make-vector 0)) (let ((lisp-name (array::make-string 4))) (array::aset-1 #\L lisp-name 0) (array::aset-1 #\I lisp-name 1) (array::aset-1 #\S lisp-name 2) (array::aset-1 #\P lisp-name 3) ;; Fixup NIL (symbol::%fmakunbound nil) (setf (symbol::symbol-plist 'nil) nil) (setf (symbol::symbol-package nil) lisp-name) ;; Make T (let ((t-print-name (array::make-string 1))) (array::aset-1 #\T t-print-name 0) ;; Put the print name in. (hw::write-md-boxed (cons:make-header vinc:$$dtp-symbol-header t-print-name)) (hw::vma-start-write-boxed gr:*t*) (symbol::%set gr:*t* gr:*t*) (symbol::%fmakunbound gr:*t*) (setf (symbol::symbol-plist gr:*t*) nil) (setf (symbol::symbol-package gr:*t*) lisp-name) (setq gr:*warm-symbols* (cons:cons gr:*t* nil)))) (trap::illop "Cold load finished!") (warm-start) ) (defun warm-start () ;; un-Halt the machine. (hw:write-processor-control (hw:dpb-unboxed 0 hw:%%processor-control-halt-processor (hw:read-processor-control))) (hw:nop) (hw:nop) ;allow relinking (trap:without-traps #'(lambda () (vinc:flush-icache) (modify-asynchronous-traps hw:$$trap-enable) (modify-synchronous-traps hw:$$trap-enable) (k2::init-kbug) (modify-icache-traps hw:$$trap-enable) (modify-datatype-traps hw:$$trap-enable) (modify-overflow-traps hw:$$trap-enable) ;; flush out memory traps (hw:write-md-unboxed 0) (hw:vma-start-write-no-gc-trap-unboxed trap:*magic-garbage-location*) (hw:vma-start-read-no-transport-vma-unboxed-md-unboxed 0) (hw:read-md) )) (trap::trap-on) (li:flush-call-stack)) ;;; This code recieves the Cold-Load Info send down by FASD-COLD-FUNCTION-INFO ;; from WARM-LOADER (defun kbug-load-cold-info () ;implements KBUG-COMMAND-LOAD-COLD-INFO (setq gr:*mini-fasl-byte-counter* 0) (setq gr:*mini-fasl-top-level-opcode-byte-count* gr:*mini-fasl-byte-counter*) (setq gr:*mini-fasl-top-level-opcode* -1) (dotimes (nfcns (mini-fasl-read-fixnum)) (mini-fasl-read-cold-fcn-info))) (defun mini-fasl-read-cold-fcn-info () (let* ((name (mini-fasl-read-object)) (local-refs (read-local-refs)) (refs (read-refs)) (entry-points (read-entry-points)) (length (mini-fasl-read-fixnum)) (pc (mini-fasl-read-fixnum)) (starting-addr (pc->addr pc)) (function (make-compiled-function name entry-points local-refs refs length))) (setf (%compiled-function-code function) (cons:make-pointer vinc:$$dtp-code pc)) ; (setf (%compiled-function-starting-address function) starting-addr) (when (li:symbolp name) (setf (symbol:symbol-function name) function)) (when (>= pc 64.) (map-fault:call-while-allowing-write-in-read-only #'(lambda () (hw:write-md-unboxed cons:code-header-instruction-high) (hw:vma-start-write-no-gc-trap-unboxed (hw:24+ -1 starting-addr)) (cons:store-contents-offset starting-addr -2 function)))) (read-and-link-immediates starting-addr))) (defun read-and-link-immediates (base) (dotimes (i (mini-fasl-read-fixnum)) (write-boxed-immediate (hw:24+ (ash (mini-fasl-read-fixnum) 1.) base) (mini-fasl-read-object)))) (defun write-boxed-immediate (address immediate) (map-fault:call-while-allowing-write-in-read-only #'(lambda () (hw:write-md-boxed immediate) (hw:vma-start-write-boxed address) nil ))) ;;; to see how the K side of the warm-load streams work ;;; look in these files ;;; "jb:kbug2;streams" loaded both on K and lambda ;;; "jb:kbug2;k2" ;;; "jb:k;warm-loader" ;;;**************************************************************** ;;; ;;; K Memory Tests (from kbug;spy-diags.lisp) ;;; ;;;**************************************************************** (defun k-test14 (&aux temp) "Memory Control Register Test." (format t "Starting Test 14 - Memory control register.~%") (k-init) (dotimes (i 31.) (k-execute KIH-LOAD-MCTL (ash 1. i)) (k-execute3 KIH-JUMP #x100) (k-execute KIH-ALU-NOP KIL-READ-MCTL) (k-execute2 KIH-NOP 0.) (setq temp (k-read-spy-mmfio)) (when (not (equal (ash 1. i) temp)) (k-diag-error "TEST-14 MCTL" nil (ash 1. i) temp)))) ;;;**************************************************************** ;;; tests 41,42,43,44 write and read memory from the lambda (defun k-test41 () "Simple memory test - location 0 data patterns." (format t "Starting Test 41 - Memory loc 0 data patterns.~%") (let* (temp (patterns '(0 #xffffffff #x1 #x2 #x4 #x8 #x10 #x20 #x40 #x80 #x100 #x200 #x400 #x800 #x1000 #x2000 #x4000 #x8000 #x10000 #x20000 #x40000 #x80000 #x100000 #x200000 #x400000 #x800000 #x1000000 #x2000000 #x4000000 #x8000000 #x10000000 #x20000000 #x40000000 #x80000000))) (dolist (pat patterns) (k-mem-write 0 pat) (when (not (equal pat (setq temp (k-mem-read 0)))) (k-diag-error "TEST-41 Memory loc 0 data patterns" 0 pat temp))))) (defun k-test42 () "Memory Sizer" (format t "Starting test 42 - Memory sizer.~%") (k-init) (let* ((addr 0) (max (progn (k-execute3 kih-alu-nop kil-read-mstat) (if (equal 1. (ldb (byte 1. 23.) (k-read-spy-mmfio))) 4. 8.))) (temp nil) (gap t)) (setq k-mem-list nil) (dotimes (i max) (setq addr (ash i 22.)) (if (k-test-42-mworks-? addr) (progn (if gap (setq temp addr)) (setq gap nil)) (progn (if (not gap) (setq k-mem-list (nconc k-mem-list (cons (list temp (sub1 addr)) nil)))) (setq gap t)))) (when (not gap) (setq addr (ash max 22.)) (setq k-mem-list (nconc k-mem-list (cons (list temp (sub1 addr)) nil)))) k-mem-list)) (defun k-test-42-mworks-? (addr) (k-mem-write addr #x12345678) (if (equal #x12345678 (k-mem-read addr)) (progn (k-mem-write addr #xedcba987) (if (equal #xedcba987 (k-mem-read addr)) t nil)) nil)) (defun k-test43 (&optional fast) "Memory address test" (format t "Starting Test 43 - Memory address~%") (let* ((temp nil) (m-list (if fast '((0 #x1000)) k-mem-list))) (if (null m-list) (format t "*** Can't run test 43 - Memory not sized~%") (dolist (mrange m-list) (do* ((addr (first mrange) (+ addr 4.)) (max (second mrange))) ((> addr max)) (k-mem-write addr addr))) (dolist (mrange m-list) (do* ((addr (first mrange) (+ addr 4.)) (max (second mrange))) ((> addr max)) (when (not (equal addr (setq temp (k-mem-read addr)))) (k-diag-error "TEST-43 - Memory address" addr addr temp)))) (dolist (mrange m-list) (do* ((addr (first mrange) (+ addr 4.)) (max (second mrange))) ((> addr max)) (k-mem-write addr (logxor #xffffffff addr)))) (dolist (mrange m-list) (do* ((addr (first mrange) (+ addr 4.)) (max (second mrange))) ((> addr max)) (when (not (equal (logxor #xffffffff addr) (setq temp (k-mem-read addr)))) (k-diag-error "TEST-43 - Memory address" addr (logxor #xffffffff addr) temp))))))) (defun k-test44 (&optional (delta #x100000)) "Simple memory test - One word in each bank (actually every Nth)" (format t "Starting Test 44 - First word of each bank (actually every #x~Xth)~%" delta) (k-init) (k-execute kih-load-mctl 0) (k-execute4 kih-jump #x100) (let* (temp (patterns '(0 #xffffffff #x1 #x2 #x4 #x8 #x10 #x20 #x40 #x80 #x100 #x200 #x400 #x800 #x1000 #x2000 #x4000 #x8000 #x10000 #x20000 #x40000 #x80000 #x100000 #x200000 #x400000 #x800000 #x1000000 #x2000000 #x4000000 #x8000000 #x10000000 #x20000000 #x40000000 #x80000000))) (dolist (mrange k-mem-list) (do ((addr (first mrange) (+ addr delta)) (max (second mrange))) ((> addr max)) (dolist (pat patterns) (k-mem-write 0 pat) (when (not (equal pat (setq temp (k-mem-read 0)))) (k-diag-error "TEST-44 Memory Bank data patterns" addr pat temp))))) (dolist (mrange k-mem-list) (do ((addr (first mrange) (+ addr delta)) (max (second mrange))) ((> addr max)) (k-mem-write addr addr))) (dolist (mrange k-mem-list) (do ((addr (first mrange) (+ addr delta)) (max (second mrange))) ((> addr max)) (setq temp (k-mem-read addr)) (when (not (equal temp addr)) (k-diag-error "TEST-44 Memory Bank Addressing" addr addr temp)))))) ;;;**************************************************************** ;;; tests 50,51,52,53,58 run inside the K and check results via the SPY MMFIO (defun k-test50 (&aux temp) "TEST-50 Proc - local memory data test loc 0" (k-init) (format t "Starting Test 50 - Proc - local memory data test loc 0~%") (dotimes (i 32.) (k-execute kih-load-md (ash 1 i)) (k-execute kih-load-vma-sw 0) (k-execute kih-jump #x100) (k-execute kih-load-vma-sr 0) (k-execute kih-jump #x100) (k-execute3 kih-alu-nop kil-read-md) (setq temp (k-read-spy-mmfio)) (when (not (equal temp (ash 1 i))) (k-diag-error "TEST-50 Proc - local mem data" 0 (ash 1 i) temp)))) (defun k-test51 (&optional fast &aux temp) "TEST-51 Proc - local mem data 0-255" (k-init) (format t "Starting Test 51 - Proc - local memory data 0-255~%") (dotimes (pass (if fast 1. 32.)) (dotimes (i 256.) (k-execute kih-load-md (ash 1 (logand 31. (+ pass i)))) (k-execute kih-load-vma-sw i) (k-execute kih-jump #x100)) (dotimes (i 256.) (k-execute kih-load-vma-sr i) (k-execute kih-jump #x100) (k-execute3 kih-alu-nop kil-read-md) (setq temp (k-read-spy-mmfio)) (when (not (equal temp (ash 1 (logand 31. (+ pass i))))) (k-diag-error "TEST-51 Proc - local mem data" i (ash 1 (logand 31. (+ pass i))) temp))))) (defun k-test52 (&optional fast &aux temp) "TEST-52 Proc - local mem address 0-255" (k-init) (format t "Starting Test 52 - Proc - local memory address 0-255~%") (dotimes (pass (if fast 1. 32.)) (dotimes (i 256.) (k-execute kih-load-md (ash 1 (logand i 31.))) (k-execute kih-load-vma-sw i) (k-execute kih-jump #x100)) (dotimes (i 256.) (k-execute kih-load-vma-sr i) (k-execute kih-jump #x100) (k-execute3 kih-alu-nop kil-read-md) (setq temp (k-read-spy-mmfio)) (when (not (equal temp (ash 1 (logand i 31.)))) (k-diag-error "TEST-52 Proc - local mem address" i (ash 1 (logand i 31.)) temp))))) (defun k-test53 (&aux temp pat) "Test-53 Proc - local mem special reads" (k-init) (k-execute kih-load-mctl 0) (k-execute4 kih-jump #x100) (format t "Starting Test 53 - Proc - local mem special reads~%") (k-execute kih-load-g0 0) (k-execute kih-load-md #x55555555) (k-execute kih-load-vma-sw 0) (k-execute2 kih-jump #x100) (k-execute kih-load-md #xAAAAAAAA) (k-execute kih-load-vma-sw 1) (k-execute2 kih-jump #x100) (k-execute kih-load-md 0) (k-execute kih-load-vma-sw 2) (k-execute2 kih-jump #x100) (dotimes (i 16.) (k-execute kih-load-vma-sr 2) (k-execute3 kih-jump #x100) (setq pat (if (zerop (logand 4. i)) #x55555555 #xAAAAAAAA)) (k-execute (logior (ash i 9.) kih-load-vma-sr-r) kil-readr-g0) (when (zerop (logand 8. i)) (k-execute kih-nop 0)) (k-execute3 kih-alu-nop kil-read-md) (setq temp (k-read-spy-mmfio)) (when (not (equal pat temp)) (k-diag-error "TEST-53 VMA-Start-read type" i pat temp)) (k-execute3 kih-alu-nop kil-read-mstat) (setq temp (ldb (byte 2. 13.) (k-read-spy-mmfio))) (setq pat (logand 3. (lognot i))) (when (not (equal pat temp)) (k-diag-error "TEST-53 Memory Cycle Type Status" i pat temp)))) (defun k-test58 (&aux expect result) "TEST-58 Local Memory Parity" (format t "Starting Test 58 - Local Memory Parity~%") (k-init) (k-execute kih-load-pctl 0) (dolist (mrange k-mem-list) (do* ((addr (ash (first mrange) -2.) (+ addr #x100000)) (max (ash (second mrange) -2.))) ((> addr max)) (k-execute2 kih-load-vma addr) (k-execute2 kih-load-map (logior #x8f (ash addr 2))) (dotimes (pbad 2) (dotimes (i 256.) (k-execute kih-load-mctl 0) (k-execute kih-jump #x100) (if (zerop pbad) (k-execute kih-load-mctl #x80000) ;Parity enable (k-execute kih-load-mctl #x84000) ;Write wrong parity (k-execute4 kih-jump #x100) (setq expect (k-test58-genpat i)) (k-execute kih-load-md expect) (k-execute kih-load-vma-sw addr) (k-execute kih-jump #x100) (k-execute kih-load-vma-sr addr) (k-execute kih-jump #x100) (k-execute3 kih-alu-nop kil-read-md) (setq result (k-read-spy-mmfio)) (when (not (equal expect result)) (k-diag-error "Test 58 - Proc Parity (Data error)" addr expect result)) (k-execute3 kih-alu-nop kil-read-mstat) (setq result (ldb (byte 1. 21.) (k-read-spy-mmfio))) (when (not (equal result (- 1. pbad))) (k-diag-error "Test 58 - Proc Parity" addr expect expect))))) (dotimes (i 256.) (k-execute kih-load-mctl 0) (k-execute kih-jump #x100) (k-execute kih-load-mctl #x80000) ;Parity enable (k-execute4 kih-jump #x100) (setq expect (k-test58-genpat i)) (k-mem-write (ash addr 2.) expect) (setq result (k-mem-read (ash addr 2.))) (when (not (numberp result)) (k-diag-error "Test 58 - NUBUS Parity" (ash addr 2.) expect expect)))))) (defun k-test58-genpat (n) (logior n (ash n 8.) (ash n 16.) (ash n 24.))) |#