;;;;;-*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*- ;;; ;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc. ;;; (DEFUN lam-menu () (PROG (CHOICE) TOP (SETQ CHOICE (TV:MENU-CHOOSE '(reset rg-test cm-test mi-test dp-test lam-test-machine lam-run-mtest lam-test-data-paths lam-test-counter-increments lam-test-fast-address-tests rg-menu dp-menu cm-menu mi-menu stepping-menu zam power-up-initialize) "Lambda Diagnostic Functions")) (cond (choice (funcall choice) (go top))))) (defun strt()(reset)(init-tram)) (DEFUN LAM-TEST-MACHINE (&optional (dont-run-dp nil)) (rg-test NIL) (LAM-TEST-DATA-PATHS dont-run-dp) (setup-rg-mode) (setup-dp-mode) (LAM-TEST-COUNTER-INCREMENTS) (BASIC-UTEST) (LAM-TEST-FAST-ADDRESS-TESTS) ) (DEFUN OLD-RG-TEST (&optional (USE-OTHER-BOARDS T)) (cond ((null (access-path-lmi-serial-protocol *proc*)) (test-nd-mode-data-path) (nd-setup-1))) (setup-nubus-configuration) (TEST-CON-REG-DATA-PATH) (TEST-PMR-DATA-PATH) (RESET early-pmr-list) ; (PRINT-REGS) (TEST-TRAM-ADR-DATA-PATH) (TEST-TRAM-DATA-PATH) (FAST-ADDRESS-TEST-TRAM) ;does an (init-tram nil t) afterwards. (TEST-SPY-REG-DATA-PATH) (TEST-HPTR-DATA-PATH) (Test-HRAM-Data-Path) (Fast-Address-Test-Hram) (Cond (USE-OTHER-BOARDS (TEST-RG-MODE) ; (TEST-CSMREG-VIA-CSMRAM-DATA-PATH) (NOOP-UINST-CLOCKS) (INIT-LAMBDA) ;make sure no t.hold (CHANGE-PMR '(FORCE-MI-RESET-L 1)) ;writing L2 maps will not work with this reset ;(after mod to clock uinst.write.l2.maps on MI board) (setup-rg-mode) (TEST-STAT-COUNTER-DATA-PATH) (TEST-AUX-STAT-COUNTER-DATA-PATH) (setup-dp-mode) ; (test-macro-ir-data-path) (TEST-MID-DATA-PATH) ))) (defun OLD-MI-TEST () (cond ((null (access-path-lmi-serial-protocol *proc*)) (test-nd-mode-data-path) (nd-setup-1))) (setup-nubus-configuration) (TEST-CON-REG-DATA-PATH) (TEST-PMR-DATA-PATH) (RESET early-pmr-list) (FAST-ADDRESS-TEST-TRAM) ;does an (init-tram nil t) afterwards. (TEST-SPY-REG-DATA-PATH) (NOOP-UINST-CLOCKS) (Init-Lambda) ;make sure no t.hold (CHANGE-PMR '(FORCE-MI-RESET-L 1)) ;writing L2 maps will not work with this reset ;(after mod to clock ;uinst.write.l2.maps on MI board) (TEST-MD-DATA-PATH) (TEST-VMA-DATA-PATH) (TEST-LEVEL-1-MAP-DATA-PATH) (TEST-LEVEL-2-MAP-PHYSICAL-PAGE-DATA-PATH) (TEST-LEVEL-2-MAP-CONTROL-DATA-PATH) (setup-rg-mode) (setup-dp-mode) (TEST-LOCATION-COUNTER) (test-csmram-data-path) (test-csm-adr-reg-data-path) (TEST-CSMREG-VIA-CSMRAM-DATA-PATH) (format t "~%..........forcing mi board reset") (change-pmr-and-check '(force-mi-reset-l 0)) (FAST-ADDRESS-TEST-CSM) (format t "~%.........changing mi to not be reset") (change-pmr-and-check '(force-mi-reset-l 1)) (FAST-ADDRESS-TEST-LEVEL-1-MAP) (FAST-ADDRESS-TEST-LEVEL-2-MAP-CONTROL) (FAST-ADDRESS-TEST-LEVEL-2-MAP-PHYSICAL-PAGE) (format t "~%.........forcing mi board reset") (change-pmr-and-check '(force-mi-reset-l 0)) ) (defconst cm-test-list '(test-ireg-data-path test-cram-current-data-path test-cram-adr-map-current-data-path (TEST-DATA-PATH "PC" 'PC-ACTOR 16.) ;READY TO EXCECUTE MICROINSTRUCTIONS ;; test-imod-data-path TEST-cram-DATA-PATH TEST-HPTR-VIA-INC-DATA-PATH (TEST-DATA-PATH "CRAM ADR MAP" 'CRAM-ADR-MAP-ACTOR 12.) TEST-PC-INCREMENT TEST-HPTR-INCREMENT ;; test-micro-stack-pointer-decrement ; (TEST-MICRO-STACK-POINTER-INCREMENT) ;too slow for now.***IS THIS STILL TRUE? ;; lam-test-micro-stack ;collection of microstack data path tests ;; COND-JUMP-TEST ;; BASIC-UTEST ;; (ltest cm-address-test-list) )) (defconst dp-test-list '(test-SPY-VIA-DP-DATA-PATH test-spy-reg-via-q-reg-data-path test-spy-reg-via-masker-data-path TEST-M-MEM-DATA-PATH TEST-A-MEM-DATA-PATH TEST-A-MEM-VIA-M-MEM-DATA-PATH test-m-pass-data-path test-a-pass-data-path TEST-PI-PASS-DATA-PATH TEST-PP-PASS-DATA-PATH test-spy-reg-via-a-mem-via-q-reg-data-path test-spy-reg-via-a-mem-via-output-selector-data-path TEST-DISPATCH-DATA-PATH TEST-DISPATCH-CONSTANT-DATA-PATH TEST-DP-MODE TEST-PDL-POINTER TEST-PDL-INDEX TEST-Q-REG-DATA-PATH add-test subtract-test test-output-selector-shift TEST-SHIFTER-LOGIC COND-JUMP-TEST BASIC-UTEST TEST-PDL-POINTER-INCREMENT TEST-PDL-INDEX-INCREMENT test-pdl-pointer-decrement test-pdl-index-decrement (ltest dp-address-test-list) FAST-ADDRESS-TEST-DISPATCH ;SHOULD BE ORGANIZED DIFFERENTLY, BUT ;WE'LL DO THIS FOR NOW )) (DEFCONST MI-TEST-LIST `(NOOP-UINST-CLOCKS INIT-LAMBDA "~%.........changing mi to not be reset" (CHANGE-PMR '(FORCE-MI-RESET-L 1)) TEST-MD-DATA-PATH ;FIX THIS SO IT CHECKS BOARD VERSION ETC TEST-VMA-DATA-PATH TEST-LEVEL-1-MAP-DATA-PATH TEST-LEVEL-2-MAP-PHYSICAL-PAGE-DATA-PATH TEST-LEVEL-2-MAP-CONTROL-DATA-PATH setup-rg-mode setup-dp-mode test-location-counter test-csmram-data-path test-csm-adr-reg-data-path test-csmreg-via-csmram-data-path ;should check for board version ; (TEST-LOCATION-COUNTER-INCREMENT) ;this test doesnt win, see comments near code. ;still hangs machine, even with ;new fake csm program (ltest mi-address-test-list) basic-utest )) (defconst RG-STAND-ALONE-TEST-LIST ;the rg can run these tests without the other boards '(TEST-SPY-REG-DATA-PATH TEST-HPTR-DATA-PATH TEST-HRAM-DATA-PATH FAST-ADDRESS-TEST-HRAM )) (defconst RG-DEPENDENT-TEST-LIST ;you need the other boards working somewhat '(TEST-RG-MODE ;to run these tests setup-rg-mode TEST-STAT-COUNTER-DATA-PATH TEST-AUX-STAT-COUNTER-DATA-PATH reset-mi test-macro-ir-data-path ;;;why doesn't this work? TEST-MID-DATA-PATH TEST-HPTR-INCREMENT (ltest rg-address-test-list) TEST-STAT-COUNTER-INCREMENT TEST-AUX-STAT-COUNTER-INCREMENT TEST-MULTIPLIER-FLOW-THROugh-DATA-PATH TEST-MULTIPLIER-DATA-PATH basic-utest )) (DEFCONST BASIC-UTEST-LIST '(HALT? JUMP-NOOP? CALL-POPJAN?)) (DEFCONST RG-ADDRESS-TEST-LIST '(FAST-ADDRESS-TEST-TRAM ;;;Inits the tram afterwards FAST-ADDRESS-TEST-HRAM FAST-ADDRESS-TEST-HRAM-VIA-PC FAST-ADDRESS-TEST-MID )) (DEFCONST CM-ADDRESS-TEST-LIST '( ;;FAST-ADDRESS-TEST-CRAM-LOW-ADDRESS ;; NEED TO WRITE THIS...LOW 4 BITS! FAST-ADDRESS-TEST-CRAM-ADR-MAP ;;; Loads a straight map after it finishes FAST-ADDRESS-TEST-CRAM FAST-ADDRESS-TEST-CRAM-BANKS FAST-ADDRESS-TEST-DISPATCH FAST-ADDRESS-TEST-US )) (DEFCONST DP-ADDRESS-TEST-LIST '(FAST-ADDRESS-TEST-M-MEM FAST-ADDRESS-TEST-A-MEM FAST-ADDRESS-TEST-A-MEM-VIA-M-MEM FAST-ADDRESS-TEST-PDL-C-PI FAST-ADDRESS-TEST-PDL-C-PP )) (DEFCONST MI-ADDRESS-TEST-LIST '(FAST-ADDRESS-TEST-CSM ;no longer need to worry about random ;memory cycles with the new hardware ;but for back compatibility, we can ;make each test check the pmr and the ;RG board version if neccessary FAST-ADDRESS-TEST-LEVEL-1-MAP FAST-ADDRESS-TEST-LEVEL-2-MAP-CONTROL FAST-ADDRESS-TEST-LEVEL-2-MAP-PHYSICAL-PAGE )) (defun initialize-diag () (cond ((null (access-path-lmi-serial-protocol *proc*)) (test-nd-mode-data-path) (nd-setup-1))) (setup-nubus-configuration) (TEST-CON-REG-DATA-PATH) (TEST-PMR-DATA-PATH) (RESET early-pmr-list) ; (PRINT-REGS) (TEST-TRAM-ADR-DATA-PATH) (TEST-TRAM-DATA-PATH) (FAST-ADDRESS-TEST-TRAM) ;does an (init-tram nil t) afterwards. ) (defvar lambda-diag-stream t) ;this is a hook for later functionality ;where we send output to a buffer (defun LTEST (test-list &OPTIONAL &KEY (BOARD NIL) (INIT NIL)) (AND BOARD (FORMAT LAMBDA-DIAG-STREAM "~% TESTING ~A~%" BOARD)) ;what do we need ;"board" for? (AND INIT (INITIALIZE-DIAG)) (cond ((>= (send *proc* :major-version) 100.) (LET ((PMR (READ-PMR))) (CHANGE-PMR '(SPY-ADDRESS-TRAM-L 0 ALLOW-UINST-CLOCKS 0)) (WRITE-TRAM-ADR 3007) (SM-TICK) (SM-TICK) (WRITE-PMR PMR)) (sm-tick) (sm-tick) )) (loop for test in test-list when (stringp test) ;a cond would be better here so far. do (format lambda-diag-stream test) when (and (not (stringp test)) (atom test)) do (funcall test) WHEN (LISTP TEST) DO (EVAL TEST))) (defun send-tram-to-3007 () (cond ((>= (send *proc* :major-version) 100.) (LET ((PMR (READ-PMR))) (CHANGE-PMR '(SPY-ADDRESS-TRAM-L 0 ALLOW-UINST-CLOCKS 0)) (WRITE-TRAM-ADR 3007) (SM-TICK) (SM-TICK) (WRITE-PMR PMR)) (sm-tick) (sm-tick) ))) (DEFUN CM-TEST (&optional(load-tram t)) (send terminal-io :clear-screen) (LTEST CM-TEST-LIST ':BOARD "CM BOARD" ':INIT load-tram)) (DEFUN DP-TEST () (LTEST DP-TEST-LIST ':BOARD "DP BOARD" ':INIT T)) (DEFUN MI-TEST () (LTEST MI-TEST-LIST ':BOARD "MI BOARD" ':INIT T)) (DEFUN RG-TEST (&OPTIONAL (USE-OTHER-BOARDS NIL)) (LTEST RG-STAnd-ALONE-TEST-LIST ':BOARD "RG BOARD" ':INIT T) (IF USE-OTHER-BOARDS (LTEST RG-DEPENDENT-TEST-LIST))) (DEFUN BASIC-UTEST () (LTEST BASIC-UTEST-LIST)) (DEFUN LAM-TEST-DATA-PATHS (dont-run-dp) (TEST-TREG-VIA-TRAM-DATA-PATH) ;this sometimes wont work if the mi board ;isnt in because of spurious t-holds (test-tram-address-selectors) (TEST-HPTR-DATA-PATH) (NOOP-UINST-CLOCKS) ;READY TO CHECK IREG (TEST-ireg-DATA-PATH) (TEST-DATA-PATH "PC" 'PC-ACTOR 16.) ;READY TO EXCECUTE MICROINSTRUCTIONS (TEST-cram-DATA-PATH) (TEST-HPTR-VIA-INC-DATA-PATH) (TEST-DATA-PATH "CRAM ADR MAP" 'CRAM-ADR-MAP-ACTOR 12.) (cond (dont-run-dp t) (t (TEST-SPY-VIA-DP-DATA-PATH) (test-spy-reg-via-q-reg-data-path) (test-spy-reg-via-masker-data-path) (TEST-M-MEM-DATA-PATH) (TEST-A-MEM-DATA-PATH) (TEST-A-MEM-VIA-M-MEM-DATA-PATH) (test-m-pass-data-path) (test-a-pass-data-path) (test-spy-reg-via-a-mem-via-q-reg-data-path) (test-spy-reg-via-a-mem-via-output-selector-data-path) (TEST-DISPATCH-DATA-PATH) (TEST-DISPATCH-CONSTANT-DATA-PATH) (TEST-DP-MODE) (TEST-PDL-POINTER) (TEST-PDL-INDEX) (TEST-Q-REG-DATA-PATH) (add-test) (subtract-test) (test-output-selector-shift) )) (TEST-RG-MODE) (NOOP-UINST-CLOCKS) (INIT-LAMBDA) ;make sure no t.hold (CHANGE-PMR '(FORCE-MI-RESET-L 1)) (TEST-CSMREG-VIA-CSMRAM-DATA-PATH) (TEST-MD-DATA-PATH) (TEST-VMA-DATA-PATH) (TEST-CSM-ADR-REG-DATA-PATH) (TEST-CSMRAM-DATA-PATH) ;MI board stuff. (LOAD-CSM) ;These two things need to be done to (lam-reset-cache) ;insure that the CSM doesn't come up in ;a funny state and try starting a memory ;cycle - worse, L2-Control Map might even ;come up with a 1 in map.lock.nubus during ;said cycle and totally wedge the bus. ;(NO, WE FIXED THAT SCREW IN HARDWARE) (CHANGE-PMR '(FORCE-MI-RESET-L 1)) ;writing any maps will not work with this reset ;(after mod to clock uinst.write.l2.maps and ; uinst.write.l1.maps on MI board) (TEST-LEVEL-1-MAP-DATA-PATH) (TEST-LEVEL-2-MAP-PHYSICAL-PAGE-DATA-PATH) (TEST-LEVEL-2-MAP-CONTROL-DATA-PATH) (setup-rg-mode) (TEST-STAT-COUNTER-DATA-PATH) (TEST-AUX-STAT-COUNTER-DATA-PATH) (TEST-PDL-BUFFER-DATA-PATH) (lam-test-micro-stack) ;collection of microstack data path tests (setup-dp-mode) (TEST-LOCATION-COUNTER) (test-macro-ir-data-path) (TEST-MID-DATA-PATH) ) (DEFUN OLD-LAM-TEST-FAST-ADDRESS-TESTS NIL (change-pmr-and-check '(force-mi-reset-l 0)) (FAST-ADDRESS-TEST-TRAM) ;;; Loads the tram with a good initial state (FAST-ADDRESS-TEST-CSM) (FAST-ADDRESS-TEST-HRAM) (FAST-ADDRESS-TEST-HRAM-VIA-PC) (FAST-ADDRESS-TEST-CRAM-ADR-MAP) ;;; Loads a straight map after it finishes ; (FAST-ADDRESS-TEST-HIGH-CRAM) ;;; No reason to test this unless latter fails (FAST-ADDRESS-TEST-CRAM) (FAST-ADDRESS-TEST-CRAM-BANKS) (FAST-ADDRESS-TEST-M-MEM) (FAST-ADDRESS-TEST-A-MEM) (FAST-ADDRESS-TEST-A-MEM-VIA-M-MEM) (change-pmr-and-check '(force-mi-reset-l 1)) (FAST-ADDRESS-TEST-LEVEL-1-MAP) (FAST-ADDRESS-TEST-LEVEL-2-MAP-CONTROL) (FAST-ADDRESS-TEST-LEVEL-2-MAP-PHYSICAL-PAGE) (change-pmr-and-check '(force-mi-reset-l 0)) (FAST-ADDRESS-TEST-DISPATCH) (FAST-ADDRESS-TEST-MID) (FAST-ADDRESS-TEST-US) (FAST-ADDRESS-TEST-PDL-C-PI) (FAST-ADDRESS-TEST-PDL-C-PP)) (DEFUN LAM-TEST-FAST-ADDRESS-TESTS () (LTEST RG-ADDRESS-TEST-LIST) (LTEST CM-ADDRESS-TEST-LIST) (LTEST DP-ADDRESS-TEST-LIST) (LTEST MI-ADDRESS-TEST-LIST)) (DEFUN rg-menu () (PROG (CHOICE) TOP (SETQ CHOICE (TV:MENU-CHOOSE '(reset rg-test ))) (cond (choice (funcall choice) (go top))))) (DEFUN stepping-menu () (PROG (CHOICE) TOP (SETQ CHOICE (TV:MENU-CHOOSE '(reset rg-test write-pc-stepping read-a-mem-stepping write-a-mem-stepping read-md-stepping write-md-stepping read-spy-reg-via-dp-stepping write-cram-adr-map-via-dest-stepping write-lc-stepping write-vma-stepping read-vma-stepping write-pi-stepping write-stat-counter-stepping write-mid-stepping write-c-pp-stepping dispatch-stepping dispatch-push-own-address-stepping ))) (cond (choice (apply choice (values-for-arguments choice)) (go top))))) (defun values-for-arguments (function-name &aux (return-string nil)) (prog () (dolist (element (arglist function-name)) (cond ((listp element) t) ((equal element '&optional) t) ((equal element '&aux) t) ((equal element '&key) t) (t (push (prompt-and-read ':read "~%value for ~s? ..." element) return-string)))) (return (nreverse return-string)))) (DEFUN cm-menu () (PROG (CHOICE) TOP (SETQ CHOICE (TV:MENU-CHOOSE '(reset rg-test cm-test cond-jump-test test-imod-data-path ))) (cond (choice (funcall choice)(go top))))) (DEFUN mi-menu () (PROG (CHOICE CHOICES) TOP (SETQ CHOICE (TV:MENU-CHOOSE (SETQ CHOICES '(reset rg-test TEST-MD-DATA-PATH TEST-VMA-DATA-PATH TEST-LEVEL-1-MAP-DATA-PATH TEST-LEVEL-2-MAP-PHYSICAL-PAGE-DATA-PATH TEST-LEVEL-2-MAP-CONTROL-DATA-PATH FAST-ADDRESS-TEST-LEVEL-1-MAP FAST-ADDRESS-TEST-LEVEL-2-MAP-CONTROL FAST-ADDRESS-TEST-LEVEL-2-MAP-PHYSICAL-PAGE ALL )))) (cond ((EQ CHOICE 'ALL) (DOLIST (C CHOICES) (COND ((FBOUNDP C) (FUNCALL C))))) (choice (funcall choice)(go top))))) (DEFUN LAM-TEST-COUNTER-INCREMENTS NIL (TEST-STAT-COUNTER-INCREMENT) (TEST-AUX-STAT-COUNTER-INCREMENT) (TEST-PDL-POINTER-INCREMENT) (TEST-PDL-INDEX-INCREMENT) (TEST-PC-INCREMENT) ; (TEST-MICRO-STACK-POINTER-INCREMENT) ;too slow for now. ; (TEST-LOCATION-COUNTER-INCREMENT) ;this test doesnt win, see comments near code. ;still hangs machine, even with ;new fake csm program (TEST-HPTR-INCREMENT)) (DEFUN LAM-TEST-COUNTER-deCREMENTS NIL (TEST-PDL-POINTER-DECREMENT) (TEST-PDL-INDEX-DECREMENT) (TEST-MICRO-STACK-POINTER-DECREMENT)) (DEFUN TEST-CON-REG-DATA-PATH NIL (TEST-CON-REG)) (DEFUN TEST-PMR-DATA-PATH NIL (TEST-DATA-PATH "PMR" 'PMR-ACTOR 24.)) (DEFUN TEST-nd-mode-DATA-PATH NIL (cond ((= si:processor-type-code si:cadr-type-code) (TEST-DATA-PATH "testing nu-debug mode register" 'ND-MODE-ACTOR 8.)))) (DEFUN TEST-SPY-REG-DATA-PATH NIL (TEST-DATA-PATH "SPY-REG" 'SPY-ACTOR 32.)) (DEFUN TEST-TRAM-ADR-DATA-PATH (&aux old) (setq old (ldb spy-address-tram-l (read-pmr))) (change-pmr '(spy-address-tram-l 0)) (TEST-DATA-PATH "TRAM-ADR" 'TRAM-ADR-ACTOR 12.) (change-pmr `(spy-address-tram-l ,old))) (DEFUN TEST-TRAM-DATA-PATH NIL (TEST-DATA-PATH "TRAM" 'TRAM-DATA-PATH-ACTOR 32.)) (DEFUN TEST-TREG-VIA-TRAM-DATA-PATH NIL (TEST-DATA-PATH "treg-via-tram" 'TREG-VIA-TRAM-DATA-PATH-ACTOR 32.)) (DEFUN TEST-TREG-DATA-PATH NIL (TEST-DATA-PATH "treg" 'TREG-ACTOR 32.)) (DEFUN TEST-COLOR-CSM-DATA-PATH () (TEST-DATA-PATH "COLOR-CSM" 'COLOR-CSM-ACTOR 32.)) (DEFUN TEST-IREG-DATA-PATH () (TEST-DATA-PATH "IREG" 'IREG-ACTOR 60.) (WRITE-IREG 0)) ;just to try and not leave garbage in the ireg (DEFUN TEST-high-IREG-DATA-PATH () (TEST-DATA-PATH "HIGH-IREG" 'high-IREG-ACTOR 32.) (WRITE-IREG 0)) ;just to try and not leave garbage in the ireg (DEFUN TEST-low-IREG-DATA-PATH () (TEST-DATA-PATH "LOW-IREG" 'low-IREG-ACTOR 32.) (WRITE-IREG 0)) ;just to try and not leave garbage in the ireg (DEFUN TEST-CRAM-DATA-PATH () (TEST-DATA-PATH "CRAM" 'CRAM-ACTOR 60.) ;this requires the pc to work (write-ireg 0)) (DEFUN TEST-CRAM-CURRENT-DATA-PATH () (TEST-DATA-PATH "CRAM ADDRESSED BY CURRENT PC" 'CRAM-CURRENT-ACTOR 60.)) ;this doesn't (DEFUN TEST-CRAM-ADR-MAP-DATA-PATH () (TEST-DATA-PATH "CRAM ADR MAP" 'CRAM-ADR-MAP-ACTOR 12. nil 4)) ;this requires the pc to work (DEFUN TEST-CRAM-ADR-MAP-CURRENT-DATA-PATH () (TEST-DATA-PATH "CRAM ADR MAP ADDRESSED BY CURRENT PC" 'CRAM-ADR-MAP-CURRENT-ACTOR 12.)) ;this doesn't (DEFUN TEST-PC-DATA-PATH () (TEST-DATA-PATH "PC" 'PC-ACTOR 16.)) (defun test-multiplier-flow-through-data-path () (test-data-path "MULTIPLIER-LOW-TO-LOW-BITS-FT" 'multiplier-low-to-low-bits-ft-actor 16.) (test-data-path "MULTIPLIER-LOW-TO-HIGH-BITS-FT" 'multiplier-low-to-high-bits-ft-actor 16.) (test-data-path "MULTIPLIER-HIGH-TO-LOW-BITS-FT" 'multiplier-high-to-low-bits-ft-actor 16.) (test-data-path "MULTIPLIER-HIGH-TO-HIGH-BITS-FT" 'multiplier-high-to-high-bits-ft-actor 16.)) (defun test-multiplier-data-path () (test-data-path "MULTIPLIER-LOW-TO-LOW-BITS" 'multiplier-low-to-low-bits-actor 16.) (test-data-path "MULTIPLIER-LOW-TO-HIGH-BITS" 'multiplier-low-to-high-bits-actor 16.) (test-data-path "MULTIPLIER-HIGH-TO-LOW-BITS" 'multiplier-high-to-low-bits-actor 16.) (test-data-path "MULTIPLIER-HIGH-TO-HIGH-BITS" 'multiplier-high-to-high-bits-actor 16.)) (DEFUN TEST-CSMRAM-DATA-PATH () (let ((check-parity nil) (pmr (read-pmr))) (change-pmr-and-check '(force-csm-use-spy-address-l 0)) (TEST-DATA-PATH "CSMRAM" 'CSMRAM-DATA-PATH-ACTOR 32.) (write-pmr pmr))) (defun test-csm-adr-reg-data-path () (test-data-path "CSM ADR REG" 'CSM-ADR-REG-DATA-PATH-ACTOR 12.)) (DEFUN TEST-CSMREG-VIA-CSMRAM-DATA-PATH NIL (RESET-MI) (TEST-DATA-PATH "csmreg-via-csmram" 'CSMREG-VIA-CSMRAM-DATA-PATH-ACTOR 32.) (lam-reset-cache)) (DEFUN TEST-SPY-VIA-DP-DATA-PATH NIL (TEST-DATA-PATH "SPY-REG-VIA-DP" 'SPY-VIA-DP-ACTOR 32.)) (DEFUN TEST-M-MEM-DATA-PATH NIL (TEST-DATA-PATH "M-MEM"'M-MEM-DATA-PATH-ACTOR 32.)) (DEFUN TEST-A-MEM-DATA-PATH NIL (TEST-DATA-PATH "A-MEM"'A-MEM-DATA-PATH-ACTOR 32.)) (DEFUN TEST-A-MEM-VIA-M-MEM-DATA-PATH NIL (TEST-DATA-PATH "A-MEM-VIA-M-MEM" 'A-MEM-VIA-M-MEM-DATA-PATH-ACTOR 32.)) (defun test-m-pass-data-path nil (test-data-path "M-PASS" 'm-pass-actor 32.)) (defun test-PI-pass-data-path nil (test-data-path "PI-PASS" 'PI-pass-actor 32.)) (defun test-PP-pass-data-path nil (test-data-path "PP-PASS" 'PP-pass-actor 32.)) (defun test-a-pass-data-path nil (test-data-path "A-PASS" 'a-pass-actor 32.)) (DEFUN TEST-MD-DATA-PATH NIL (TEST-DATA-PATH "MD" 'MD-ACTOR 32.)) (DEFUN TEST-Q-REG-DATA-PATH NIL (TEST-DATA-PATH "Q-REG" 'Q-REG-ACTOR 32.)) (DEFUN TEST-spy-reg-via-q-reg-data-PATH () (TEST-DATA-PATH "spy-reg-via-q-reg" 'spy-reg-via-q-reg-ACTOR 32.) (WRITE-IREG izero-good-parity)) (defun test-spy-reg-via-masker-data-path () (test-data-path "spy-reg-via-masker" 'spy-reg-via-masker-actor 32.)) (defun test-spy-reg-via-a-mem-via-q-reg-data-path () (test-data-path "spy-reg-via-a-mem-via-q-reg" 'spy-reg-via-a-mem-via-q-reg-actor 32.)) (defun test-spy-reg-via-a-mem-via-output-selector-data-path () (test-data-path "spy-reg-via-a-mem-via-output-selector" 'spy-reg-via-a-mem-via-output-selector-actor 32.)) (DEFUN TEST-VMA-DATA-PATH NIL (TEST-DATA-PATH "VMA" 'VMA-ACTOR 32.)) (DEFUN TEST-LEVEL-1-MAP-DATA-PATH NIL (TEST-DATA-PATH "L1" 'LEVEL-1-map-ACTOR 10.)) (DEFUN TEST-LEVEL-2-MAP-PHYSICAL-PAGE-DATA-PATH NIL (TEST-DATA-PATH "L2-PHYSICAL-PAGE" 'LEVEL-2-map-PHYSICAL-PAGE-ACTOR 24.)) (DEFUN TEST-LEVEL-2-MAP-CONTROL-DATA-PATH NIL (TEST-DATA-PATH "L2-CONTROL" 'LEVEL-2-map-CONTROL-ACTOR 16.)) (DEFUN TEST-STAT-COUNTER-DATA-PATH NIL (TEST-DATA-PATH "STAT-COUNTER" 'STAT-COUNTER-ACTOR 32.)) (DEFUN TEST-AUX-STAT-COUNTER-DATA-PATH NIL (TEST-DATA-PATH "AUX-STAT-COUNTER" 'AUX-STAT-COUNTER-ACTOR 32.)) (DEFUN TEST-PDL-POINTER NIL (TEST-DATA-PATH "PDL-POINTER" 'PDL-POINTER-ACTOR 11.)) (DEFUN TEST-PDL-INDEX NIL (TEST-DATA-PATH "PDL-INDEX" 'PDL-INDEX-ACTOR 11.)) (DEFUN TEST-MICRO-STACK-POINTER-DATA-PATH NIL (TEST-DATA-PATH "MICRO-STACK-POINTER" 'MICRO-STACK-POINTER-ACTOR 8.)) (DEFUN TEST-LOCATION-COUNTER NIL (TEST-DATA-PATH "LOCATION-COUNTER" 'LOCATION-COUNTER-ACTOR 27.)) (defun test-macro-ir-data-path nil (let((pmr (read-pmr))) (change-pmr-and-check '(force-mi-reset-l 1)) (zero-cram 10.) (test-data-path "MACRO-IR" 'macro-ir-actor 32.) (write-pmr pmr))) (DEFUN TEST-MID-DATA-PATH NIL (zero-cram 10.) (TEST-DATA-PATH "MID" 'MID-ACTOR 16.)) (DEFUN TEST-RG-MODE NIL (TEST-DATA-PATH "RG-MODE" 'RG-MODE-ACTOR 12.)) (DEFUN TEST-DP-MODE NIL (TEST-DATA-PATH "DP-MODE" 'DP-MODE-ACTOR 6.)) (DEFUN TEST-STAT-COUNTER-INCREMENT () (change-rg-mode-and-check '(main-stat-clock-control 1 main-stat-count-control-bits 0)) (TEST-COUNTER-INCREMENT "STAT-COUNTER-INCREMENT" 'STAT-COUNTER-ACTOR 32.)) (DEFUN TEST-AUX-STAT-COUNTER-INCREMENT () (change-rg-mode-and-check '(aux-stat-count-control 0)) (TEST-COUNTER-INCREMENT "AUX-STAT-COUNTER-INCREMENT" 'AUX-STAT-COUNTER-ACTOR 32.)) (DEFUN TEST-PDL-POINTER-INCREMENT () (TEST-COUNTER-INCREMENT "PDL-POINTER-INCREMENT" 'PDL-POINTER-ACTOR 11.)) (DEFUN TEST-PDL-INDEX-INCREMENT () (TEST-COUNTER-INCREMENT "PDL-INDEX-INCREMENT" 'PDL-INDEX-ACTOR 11.)) (DEFUN TEST-PC-INCREMENT () (TEST-COUNTER-INCREMENT "MICRO-PC-INCREMENT (tests the IPC to PC data path)" 'PC-ACTOR 16.)) (DEFUN TEST-MICRO-STACK-POINTER-INCREMENT () (TEST-COUNTER-INCREMENT "MICRO-STACK-POINTER-INCREMENT" 'MICRO-STACK-POINTER-ACTOR 8.)) (DEFUN TEST-PDL-POINTER-DECREMENT () (TEST-COUNTER-DECREMENT "PDL-POINTER-DECREMENT" 'PDL-POINTER-ACTOR 11.)) (DEFUN TEST-PDL-INDEX-DECREMENT () (TEST-COUNTER-DECREMENT "PDL-INDEX-DECREMENT" 'PDL-INDEX-ACTOR 11.)) (DEFUN TEST-MICRO-STACK-POINTER-DECREMENT () (TEST-COUNTER-DECREMENT "MICRO-STACK-POINTER-DECREMENT" 'MICRO-STACK-POINTER-ACTOR 8.)) (DEFUN TEST-NUBUS-DATA-PATH NIL (TEST-DATA-PATH "nubus main memory" 'NUBUS-MEMORY-ACTOR 32.)) (DEFUN TEST-LOCATION-COUNTER-INCREMENT () (load-csm ':prgm fake-csm) ;to avoid hangs on memory cycles that get triggered. (TEST-COUNTER-INCREMENT "LOCATION-COUNTER-INCREMENT" 'LOCATION-COUNTER-ACTOR 27.)) (DEFUN TEST-HPTR-INCREMENT () (TEST-COUNTER-INCREMENT "HISTORY-RAM-POINTER-INCREMENT" 'HPTR-ACTOR 10.)) (DEFVAR SUSPECT-BIT-LIST) (DEFVAR DIAG-TRACE T) ;RETURNS T IF IT WORKS, PRINTS MESSAGE AND RETURNS NIL IF IT IS BUSTED. (DEFUN TEST-DATA-PATH (MESSAGE ACTOR NBITS &optional data-path (shift-bits nil)) (if (not (zerop (string-length message))) (FORMAT T "~% ~A" MESSAGE)) (LET ((ABORT-MSG (*catch 'test-data-path-catch (LET ((TEM) (SUSPECT-BIT-LIST NIL) (ZEROS 0) (ONES (SUB1 (DPB 1 (+ (LSH NBITS 6) 0001) 0)))) (COND ((= (SETQ TEM (WRITE-AND-READ ACTOR 0 ZEROS ONES)) (WRITE-AND-READ ACTOR 0 ONES ONES)) (BARF-ABOUT-DATA-PATH MESSAGE ACTOR data-path) (FORMAT T "~&~4TCan't affect it, erroneous value is ~O~%" TEM) NIL) (T (LET ((BITS-NOT-ONE (TEST-DATA-PATH-FLOATING-BITS ACTOR NBITS ZEROS)) (BITS-NOT-ZERO (TEST-DATA-PATH-FLOATING-BITS ACTOR NBITS ONES))) (COND ((AND (NULL BITS-NOT-ONE) (NULL BITS-NOT-ZERO) ;NO ERROR (NULL SUSPECT-BIT-LIST)) T) (T (LET ((ERRONEOUS-BITS ;BITS THAT LOSE, TEST FOR SHORTING (NUMERIC-LIST-UNION BITS-NOT-ONE BITS-NOT-ZERO))) (LET ((STUCK-AT-ZERO (NUMERIC-LIST-DIFFERENCE BITS-NOT-ONE BITS-NOT-ZERO)) (STUCK-AT-ONE (NUMERIC-LIST-DIFFERENCE BITS-NOT-ZERO BITS-NOT-ONE))) (BARF-ABOUT-DATA-PATH MESSAGE ACTOR data-path) (PRINT-BIT-LIST-WITH-MESSAGE "Bits stuck at zero: " STUCK-AT-ZERO shift-bits) (PRINT-BIT-LIST-WITH-MESSAGE "Bits stuck at one: " STUCK-AT-ONE shift-bits) (AND (= (LENGTH ERRONEOUS-BITS) 2) ;MAYBE THEY'RE SHORTED TOGETHER (TEST-DATA-PATH-SHORTED-BIT ACTOR NBITS (CAR ERRONEOUS-BITS))) NIL) (PRINT-BIT-LIST-WITH-MESSAGE "The following bits are also suspected of being losers:" SUSPECT-BIT-LIST shift-bits) )))))))))) (AND (STRINGP ABORT-MSG) (FORMAT LAMBDA-DIAG-STREAM "~A" ABORT-MSG)) ABORT-MSG)) ;RETURN LIST OF BIT NUMBERS WHICH WON'T SET DIFFERENT FROM THE OTHERS. ;ALSO SETS SUSPECT-BIT-LIST TO BITS WHICH ARE NOTICED TO ;BE LOSING WHILE TESTING DIFFERENT BITS. ;NOTE THE NEED TO DO BIGNUM ARITHMETIC. (DEFUN TEST-DATA-PATH-FLOATING-BITS (ACTOR NBITS BACKGROUND) ;FIRST, DETERMINE SENSE OF BIT LOOKING FOR (LET ((BACK-BIT (COND ((ZEROP BACKGROUND) 0) (T 1))) (SET-BIT (COND ((ZEROP BACKGROUND) 1) (T 0))) (MASK (1- (DPB 1 (+ (LSH NBITS 6) 0001) 0)))) (DO ((BITNO 0 (1+ BITNO)) (BITPOS 0001 (+ BITPOS 0100)) (READBACK) (ERROR-LIST NIL)) ((>= BITNO NBITS) ERROR-LIST) (SETQ READBACK (WRITE-AND-READ ACTOR 0 (DPB SET-BIT BITPOS BACKGROUND) MASK)) (DO ((I 0 (1+ I)) (PPSS 0001 (+ PPSS 0100)) (BIT)) ((>= I NBITS)) (and (send terminal-io :tyi-no-hang) (*throw 'test-data-path-catch ".....ABORTING TEST")) (SETQ BIT (LDB PPSS READBACK)) (COND ((= I BITNO) (OR (= SET-BIT BIT) (PUSH I ERROR-LIST))) (T (OR (= BACK-BIT BIT) (FINGER-SUSPECT-BIT I)))))))) (DEFUN FINGER-SUSPECT-BIT (BITNO) (OR (NUMERIC-LIST-MEMQ BITNO SUSPECT-BIT-LIST) (SETQ SUSPECT-BIT-LIST (CONS BITNO SUSPECT-BIT-LIST)))) ;GIVEN A BIT WHICH FAILS, TRY TO PROVE IT IS SHORTED TO SOME OTHER BIT. ;PRINT OUT THE RESULTS AND OUGHT TO REMOVE FROM SUSPECT LIST. ******* ;NOTE THAT FOR NON-COMPLEMENTED TRI-STATE DATA PATHS, 1 SHORTED TO 0 GIVES 0, ;THUS IN THE NORMAL TEST SHORTED BITS LOOK STUCK AT ZERO. ;THIS ONLY TESTS WITH ONES. (DEFUN TEST-DATA-PATH-SHORTED-BIT (ACTOR NBITS BITNO) (DO ((BAD-BIT (DPB 1 (+ (LSH BITNO 6) 0001) 0)) (I 0 (1+ I)) (TEST-BIT 0001 (+ TEST-BIT 100)) (BASE 10.) (*NOPOINT T) (LOSING-BITS NIL)) ((>= I NBITS) (COND ((= (LENGTH LOSING-BITS) 1) (SETQ SUSPECT-BIT-LIST (DELQ (CAR LOSING-BITS) SUSPECT-BIT-LIST)) (FORMAT T "~&~4TBit ~D is shorted to bit ~D~%" BITNO (CAR LOSING-BITS))) (T (FORMAT T "~&~4TBit ~D has problems, can't isolate. Seems as if shorted to bits " BITNO) (PRINT-BIT-LIST LOSING-BITS nil)))) (and (send terminal-io :tyi-no-hang) (*throw 'test-data-path-catch ".....ABORTING TEST")) (LET ((BOTH-BITS (DPB 1 TEST-BIT BAD-BIT))) (COND ((= I BITNO)) ;OF COURSE IT'S SHORTED TO ITSELF! ((= BOTH-BITS (WRITE-AND-READ ACTOR 0 BOTH-BITS)) (PUSH I LOSING-BITS)))))) ;;;GIVEN A COUNTER, WRITES IN ZERO, TICKS IT, AND CHECKS TO MAKE SURE IT INCREMENTED. ;;;THEN IT SHIFTS IN ONES IN THE LOW ORDER BITS ONE BIT AT A TIME, AND CHECKS TO MAKE ;;;SURE THAT EACH BIT OF THE COUNTER CAN INCREMENT. (DEFUN TEST-COUNTER-INCREMENT (MESSAGE ACTOR NBIT &OPTIONAL (ADDRESS 0)) (FORMAT T "~% ~A" MESSAGE) (LET ((ABORT-MSG (*CATCH 'ABORTING (DO* ((BITNO 0 (1+ BITNO)) (ONES (1- (EXPT 2 NBIT))) ;all 32 bits (MASK 0 (1+ (TIMES MASK 2))) ;disgusting, but do you know of a (MASK-PLUS-ONE 1 (1+ MASK))) ;better way to create a moving 32 ((> MASK ONES)) ;bit (i.e., non-fixnum) mask? (AND (send terminal-io :tyi-no-hang)(*THROW 'ABORTING "......ABORTING TEST")) (FUNCALL ACTOR ':WRITE-AND-INCREMENT ADDRESS MASK) (LET ((ACTUAL (FUNCALL ACTOR ':READ ADDRESS))) (COND ((NOT (ZEROP (LOGAND (LOGXOR ACTUAL MASK-PLUS-ONE) ONES))) (FORMAT T "~&ACTOR ~S, wrote ~O, read ~O; should be ~O" ACTOR MASK ACTUAL MASK-PLUS-ONE)) (T ACTUAL))))))) (AND (STRINGP ABORT-MSG) (FORMAT LAMBDA-DIAG-STREAM "~A" ABORT-MSG)) ABORT-MSG)) (DEFUN TEST-COUNTER-deCREMENT (MESSAGE ACTOR NBIT &OPTIONAL (ADDRESS 0)) (FORMAT T "~% ~A" MESSAGE) (LET ((ABORT-MSG (*CATCH 'ABORTING (DO* ((BITNO 0 (1+ BITNO)) (ONES (1- (EXPT 2 NBIT))) ;all 32 bits (MASK 1 (logand ones (ash MASK 1))) (MASK-minus-ONE 0 (1- MASK))) ((> bitno nbit)) (AND (send terminal-io :tyi-no-hang)(*THROW 'ABORTING "......ABORTING TEST")) (FUNCALL ACTOR ':WRITE-AND-decrement ADDRESS MASK) (LET ((ACTUAL (FUNCALL ACTOR ':READ ADDRESS))) (COND ((NOT (ZEROP (LOGAND (LOGXOR ACTUAL MASK-minus-ONE) ONES))) (FORMAT T "~&ACTOR ~S, wrote ~O, read ~O; should be ~O" ACTOR MASK ACTUAL MASK-minus-ONE)) (T ACTUAL))))))) (AND (STRINGP ABORT-MSG) (FORMAT LAMBDA-DIAG-STREAM "~A" ABORT-MSG)) ABORT-MSG)) (DEFUN BARF-ABOUT-DATA-PATH (MESSAGE ACTOR data-path) (format t "~%~4TData path is ~% ~S ~%" data-path) (FORMAT T "~%~4TTesting ~S,~%~6TData path is ~A." ACTOR MESSAGE)) ;;; Numeric list operations (DEFMACRO NUMERIC-LIST-DELQ (N L) `(SETQ ,L (DELQ ,N ,L))) (DEFUN NUMERIC-LIST-MEMQ (N L) (DO ((L L (CDR L))) ((NULL L) NIL) (AND (= (CAR L) N) (RETURN L)))) (DEFUN NUMERIC-LIST-UNION (L1 L2) (DO ((L L1 (CDR L)) (R L2)) ((NULL L) R) (OR (NUMERIC-LIST-MEMQ (CAR L) R) (SETQ R (CONS (CAR L) R))))) (DEFUN NUMERIC-LIST-INTERSECTION (L1 L2) (DO ((L L1 (CDR L)) (R NIL)) ((NULL L) R) (AND (NUMERIC-LIST-MEMQ (CAR L) L2) (SETQ R (CONS (CAR L) R))))) (DEFUN NUMERIC-LIST-DIFFERENCE (L1 L2) (DO ((L L1 (CDR L)) (R NIL)) ((NULL L) R) (OR (NUMERIC-LIST-MEMQ (CAR L) L2) (SETQ R (CONS (CAR L) R))))) (DEFUN WRITE-AND-READ (ACTOR ADR DATA &OPTIONAL (MASK 37777777777)) (FUNCALL ACTOR ':WRITE ADR DATA) (LET ((ACTUAL (FUNCALL ACTOR ':READ ADR))) (COND ((AND DIAG-TRACE (NOT (ZEROP (LOGAND (LOGXOR ACTUAL DATA) MASK)))) (FORMAT T "~&ACTOR ~S, wrote ~O, read ~O" ACTOR DATA ACTUAL))) ACTUAL)) (DEFSELECT (PMR-ACTOR) (:READ (ADDRESS) ADDRESS (READ-PMR-DIRECT)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-PMR-DIRECT DATA))) (DEFSELECT (TRAM-ADR-ACTOR) (:READ (ADDRESS) ADDRESS (READ-TRAM-ADR)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-TRAM-ADR DATA))) (DEFSELECT (SPY-ACTOR) (:READ (ADDRESS) ADDRESS (READ-SPY-REG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-SPY-REG DATA))) (DEFSELECT (SPY-VIA-DP-ACTOR) (:READ (ADDRESS) ADDRESS (READ-SPY-REG-VIA-DP)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-SPY-REG DATA))) (DEFSELECT (IREG-ACTOR) (:READ (ADDRESS) ADDRESS (READ-IREG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-IREG DATA))) (DEFSELECT (HIGH-IREG-ACTOR) (:READ (ADDRESS) ADDRESS (READ-HIGH-IREG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-HIGH-IREG DATA))) (DEFSELECT (LOW-IREG-ACTOR) (:READ (ADDRESS) ADDRESS (READ-LOW-IREG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-LOW-IREG DATA))) (DEFSELECT (CRAM-ACTOR) (:READ (ADDRESS) (READ-CRAM ADDRESS)) (:WRITE (ADDRESS DATA) (WRITE-CRAM ADDRESS DATA))) (DEFSELECT (CRAM-CURRENT-ACTOR) (:READ (ADDRESS) address (READ-CRAM)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-CRAM-AT-CURRENT-PC DATA))) (DEFSELECT (CRAM-ADR-MAP-ACTOR) (:READ (ADDRESS) (READ-CRAM-ADR-MAP ADDRESS)) (:WRITE (ADDRESS DATA) (WRITE-CRAM-ADR-MAP ADDRESS DATA))) (DEFSELECT (CRAM-ADR-MAP-CURRENT-ACTOR) (:READ (ADDRESS) address (READ-CRAM-ADR-MAP)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-CRAM-ADR-MAP-AT-CURRENT-PC DATA))) (defselect (multiplier-low-to-low-bits-actor) (:read (address) address (read-multiplier)) (:write (address data) address (write-multiplier 1 data))) (defselect (multiplier-high-to-high-bits-actor) (:read (address) address (ash (read-multiplier) -15.)) (:write (address data) address (write-multiplier data 100000))) (defselect (multiplier-high-to-low-bits-actor) (:read (address) address (read-multiplier)) (:write (address data) address (write-multiplier data 1))) (defselect (multiplier-low-to-high-bits-actor) (:read (address) address (ash (read-multiplier) -15.)) (:write (address data) address (write-multiplier 100000 data))) (defselect (multiplier-low-to-low-bits-ft-actor) (:read (address) address (read-multiplier-flow-through)) (:write (address data) address (write-multiplier 1 data nil))) (defselect (multiplier-high-to-high-bits-ft-actor) (:read (address) address (ash (read-multiplier-flow-through) -15.)) (:write (address data) address (write-multiplier data 100000 nil))) (defselect (multiplier-high-to-low-bits-ft-actor) (:read (address) address (read-multiplier-flow-through)) (:write (address data) address (write-multiplier data 1 nil))) (defselect (multiplier-low-to-high-bits-ft-actor) (:read (address) address (ash (read-multiplier-flow-through) -15.)) (:write (address data) address (write-multiplier 100000 data nil))) (DEFSELECT (PC-ACTOR) (:READ (ADDRESS) ADDRESS (READ-PC)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-PC DATA 1 nil)) (:WRITE-AND-INCREMENT (ADDRESS DATA) ADDRESS (WRITE-AND-INCREMENT-PC DATA))) (DEFSELECT (M-MEM-DATA-PATH-ACTOR) (:READ (ADDRESS) ADDRESS (READ-M-MEM 1)) ;location 0 in m-mem doesnt really get written so use 1 (:WRITE (ADDRESS DATA) ADDRESS (WRITE-M-MEM 1 DATA))) (DEFSELECT (MD-ACTOR) (:READ (ADDRESS) ADDRESS (READ-MD)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-MD DATA t))) ;dont stop for errors (DEFSELECT (Q-REG-ACTOR) (:READ (ADDRESS) ADDRESS (READ-Q-REG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-Q-REG DATA))) (Defselect (VMA-ACTOR) (:READ (ADDRESS) ADDRESS (READ-VMA)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-VMA DATA))) (DEFSELECT (LEVEL-1-MAP-ACTOR) (:READ (ADDRESS) (READ-LEVEL-1-MAP ADDRESS)) (:WRITE (ADDRESS DATA) (WRITE-LEVEL-1-MAP ADDRESS DATA))) (DEFSELECT (LEVEL-2-MAP-PHYSICAL-PAGE-ACTOR) (:READ (ADDRESS) (READ-LEVEL-2-MAP-PHYSICAL-PAGE ADDRESS)) (:WRITE (ADDRESS DATA) (WRITE-LEVEL-2-MAP-PHYSICAL-PAGE ADDRESS DATA))) (DEFSELECT (LEVEL-2-MAP-CONTROL-ACTOR) (:READ (ADDRESS) (READ-LEVEL-2-MAP-CONTROL ADDRESS)) (:WRITE (ADDRESS DATA) (WRITE-LEVEL-2-MAP-CONTROL ADDRESS DATA))) (DEFSELECT (A-MEM-DATA-PATH-ACTOR) (:READ (ADDRESS) ADDRESS (READ-A-MEM 1)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-A-MEM 1 DATA))) (DEFSELECT (A-MEM-VIA-M-MEM-DATA-PATH-ACTOR) (:READ (ADDRESS) ADDRESS (READ-A-MEM 1)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-M-MEM 1 DATA))) (DEFVAR *PASS-AROUND-DATA* 0) (defselect (A-PASS-ACTOR) (:read (address) address *PASS-AROUND-DATA*) (:write (address data) address (WRITE-SPY-REG DATA) (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW) LAM-IR-M-SRC LAM-M-SRC-SPY-REG ;MOVE IT TO DESIRED PLACE LAM-IR-ALUF LAM-ALU-SETM LAM-IR-OB LAM-OB-ALU LAM-IR-A-MEM-DEST-FLAG 1 LAM-IR-A-MEM-DEST 1) (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-R-NO-CHECK) LAM-IR-A-SRC 1 LAM-IR-ALUF LAM-ALU-SETA LAM-IR-OB LAM-OB-ALU) (SETQ *PASS-AROUND-DATA* (READ-MFO)) (ADVANCE-TO-NEXT-UINST-CLOCK) (FORCE-UINST-CLOCK-LOW) )) (defselect (M-PASS-ACTOR) (:read (address) address *PASS-AROUND-DATA*) (:write (address data) address (WRITE-SPY-REG DATA) (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW) LAM-IR-M-SRC LAM-M-SRC-SPY-REG LAM-IR-ALUF LAM-ALU-SETM LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST 1) ;ADR (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-R-NO-CHECK) LAM-IR-M-SRC 1 LAM-IR-ALUF LAM-ALU-SETM LAM-IR-OB LAM-OB-ALU) (SETQ *PASS-AROUND-DATA* (READ-MFO)) (ADVANCE-TO-NEXT-UINST-CLOCK) (FORCE-UINST-CLOCK-LOW) )) (defselect (PI-PASS-ACTOR) (:read (address) address *PASS-AROUND-DATA*) (:write (address data) address (WRITE-SPY-REG DATA) (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW) LAM-IR-M-SRC LAM-M-SRC-SPY-REG LAM-IR-ALUF LAM-ALU-SETM LAM-IR-OB LAM-OB-ALU LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PI) ;ADR (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-R-NO-CHECK) LAM-IR-M-SRC LAM-M-SRC-C-PI LAM-IR-ALUF LAM-ALU-SETM LAM-IR-OB LAM-OB-ALU) (SETQ *PASS-AROUND-DATA* (READ-MFO)) (ADVANCE-TO-NEXT-UINST-CLOCK) (FORCE-UINST-CLOCK-LOW) )) (defselect (PP-PASS-ACTOR) (:read (address) address *PASS-AROUND-DATA*) (:write (address data) address (WRITE-SPY-REG DATA) (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW) LAM-IR-M-SRC LAM-M-SRC-SPY-REG LAM-IR-ALUF LAM-ALU-SETM LAM-IR-OB LAM-OB-ALU LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PP) ;ADR (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-R-NO-CHECK) LAM-IR-M-SRC LAM-M-SRC-C-PP LAM-IR-ALUF LAM-ALU-SETM LAM-IR-OB LAM-OB-ALU) (SETQ *PASS-AROUND-DATA* (READ-MFO)) (ADVANCE-TO-NEXT-UINST-CLOCK) (FORCE-UINST-CLOCK-LOW) )) (DEFSELECT (TREG-VIA-TRAM-DATA-PATH-ACTOR) (:READ (ADDRESS) ADDRESS (READ-TREG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-TREG-VIA-TRAM DATA))) (DEFSELECT (TREG-ACTOR) (:READ (ADDRESS) ADDRESS (READ-TREG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-TREG DATA))) (DEFSELECT (TRAM-DATA-PATH-ACTOR) (:READ (ADDRESS) ADDRESS (READ-TRAM 1003)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-TRAM 1003 DATA))) (defun tram-loop (&optional (adr 2525) (data 25252525252)) (do (tem) (()) (write-tram adr data) (setq tem (read-tram adr)) (cond ((not (= tem data)) (tyo 101))))) (DEFSELECT (CSMRAM-DATA-PATH-ACTOR) (:READ (ADDRESS) ADDRESS (READ-CSM 1003)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-CSM 1003 DATA))) (DEFSELECT (CSM-ADR-REG-DATA-PATH-ACTOR) (:READ (ADDRESS) ADDRESS (READ-CSM-ADR-REG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-CSM-ADR DATA))) (DEFSELECT (CSMREG-VIA-CSMRAM-DATA-PATH-ACTOR) (:READ (ADDRESS) ADDRESS (READ-CSM-REG)) (:WRITE (ADDRESS DATA) ADDRESS (RESET-MI) (WRITE-CSM-REG-VIA-CSMRAM DATA))) (DEFSELECT (STAT-COUNTER-ACTOR) (:READ (ADDRESS) ADDRESS (READ-STAT-COUNTER)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-STAT-COUNTER DATA)) (:WRITE-AND-INCREMENT (ADDRESS DATA) ADDRESS (WRITE-AND-INCREMENT-STAT-COUNTER DATA))) (DEFSELECT (AUX-STAT-COUNTER-ACTOR) (:READ (ADDRESS) ADDRESS (READ-AUX-STAT-COUNTER)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-AUX-STAT-COUNTER DATA)) (:WRITE-AND-INCREMENT (ADDRESS DATA) ADDRESS (WRITE-AND-INCREMENT-AUX-STAT-COUNTER DATA))) (DEFSELECT (PDL-POINTER-ACTOR) (:READ (ADDRESS) ADDRESS (READ-PP)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-PP DATA)) (:WRITE-AND-INCREMENT (ADDRESS DATA) ADDRESS (WRITE-AND-INCREMENT-PP DATA)) (:write-and-decrement (address data) address (write-and-decrement-pp data))) (DEFSELECT (PDL-INDEX-ACTOR) (:READ (ADDRESS) ADDRESS (READ-PI)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-PI DATA)) (:WRITE-AND-INCREMENT (ADDRESS DATA) ADDRESS (WRITE-AND-INCREMENT-PI DATA)) (:write-and-decrement (address data) address (write-and-decrement-pi data))) (DEFSELECT (MICRO-STACK-POINTER-ACTOR) (:READ (ADDRESS) ADDRESS (READ-USP)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-USP DATA)) (:WRITE-AND-INCREMENT (ADDRESS DATA) ADDRESS (WRITE-AND-INCREMENT-USP DATA)) (:write-and-decrement (address data) address (write-and-decrement-usp data))) (DEFSELECT (LOCATION-COUNTER-ACTOR) (:READ (ADDRESS) ADDRESS (LOGAND 777777777 (ASH (READ-LC) -1.))) ;STRIP OFF THE LOW BIT (:WRITE (ADDRESS DATA) ADDRESS (WRITE-LC (ASH DATA 1.))) ;STRIP OFF THE LOW BIT (:WRITE-AND-INCREMENT (ADDRESS DATA) ADDRESS (WRITE-AND-INCREMENT-LC (ASH DATA 1.)))) ;STRIP OFF THE LOW BIT (DEFSELECT (MID-ACTOR) (:READ (ADDRESS) (READ-MID ADDRESS)) (:WRITE (ADDRESS DATA) (WRITE-MID ADDRESS DATA))) (defselect (macro-ir-actor) (:read (ignore) (read-full-macro-ir)) (:write (ignore data) (write-macro-ir data))) (DEFSELECT (ND-MODE-ACTOR) (:READ (ADDRESS) ADDRESS (READ-ND-MODE)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-ND-MODE DATA))) (DEFSELECT (RG-MODE-ACTOR) (:READ (ADDRESS) ADDRESS (LOGAND 7777 (ASH (READ-RG-MODE) -20.))) ;bits 31-16, bottom 4 bits not writable (:WRITE (ADDRESS DATA) ADDRESS (WRITE-RG-MODE (ASH DATA 20.)))) ;bits 31-16, bottom 4 bits not writable (DEFSELECT (DP-MODE-ACTOR) (:READ (ADDRESS) ADDRESS (READ-DP-MODE)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-DP-MODE DATA))) (DEFUN TEST-DISPATCH (&AUX TEMP) temp (ferror nil "can't work") (comment (DOTIMES (N 377) (WRITE-A-MEM (+ 1000 N) N)) (DOTIMES (N 377) (WRITE-SPY-REG-AND-CHECK (* N 2)) (IF ( (SETQ TEMP (LAMBDA-DISPATCH 1000 10 1)) N) (FORMAT T "~%Wrote ~O,read ~O" N TEMP)))) ) (DEFSELECT (spy-reg-via-Q-REG-ACTOR) (:READ (ADDRESS) ADDRESS (source-Q-REG)) (:WRITE (ADDRESS DATA) ADDRESS (WRITE-Q-REG DATA))) (defselect (spy-reg-via-masker-actor) (:read (address) address (spy-reg-via-masker)) (:write (address data) address (write-spy-reg data))) (defselect (spy-reg-via-a-mem-via-q-reg-actor) (:read (address) address (source-q-reg)) (:write (address data) address (write-q-reg-via-a-mem data))) (defselect (spy-reg-via-a-mem-via-output-selector-actor) (:read (address) address (a-mem-via-output-selector)) (:write (address data) address (a-mem-to-set-a-source data))) (defun execute-tests (test-list) (loop for test in test-list do (funcall test))) (defconst RG-test-list '(test-pmr-data-path)) ;; this test has several sections because the selector inputs come from all over the ;; machine. Some are tied to ground or high and will be simply tested that they are in ;; the correct configuration. the Treg-via-Tram data path must work before this test ;; will succeed. (defun test-tram-address-selectors () (test-t-state-data-path 1)) ;; (test-t-state-data-path 3) ;need to check the grounds and highs ;also halt.request ;also no.op ;uinst.op.code, uinst.ilong ;uinst.slow.destination ;previous.uinst.dest.seq (defun test-t-state-data-path (t-next-select) (write-t-next-select t-next-select) (format t "~% t-state; t-next-select = ~o" t-next-select) (TEST-DATA-PATH "" 'T-state-ACTOR 8.)) (DEFSELECT (t-state-ACTOR) (:READ (ADDRESS) ADDRESS (READ-TRAM-ADR)) (:WRITE (address DATA) address (WRITE-t-state DATA))) (defun write-t-next-select (data) (write-treg-via-tram (dpb data 1002 (read-treg)))) (defun write-t-state (data) (write-treg-via-tram (dpb data 0010 (read-treg)))) (defun test-lc-add () (let ((a-starting-lc 5) (a-ending-lc 6) (a-offset 7) (a-minus-one 10) (m-pretend-macro-ir 11)) (write-m-mem a-ending-lc 10455720) ; ending lc (write-m-mem a-offset -20) ; offset (write-m-mem a-starting-lc 10455740) ; starting lc (write-m-mem a-minus-one -1) (write-m-mem m-pretend-macro-ir -10) (uload (a-ending-lc a-offset a-starting-lc a-minus-one m-pretend-macro-ir) 0 again ; ((lc) a-starting-lc) ; beginning lc (lam-ir-op lam-op-alu lam-ir-a-src a-starting-lc lam-ir-ob lam-ob-alu lam-ir-func-dest lam-func-dest-lc lam-ir-aluf lam-alu-seta) ; ((m-offset) dpb m-pretend-macro-ir (byte-field 8 1) a-minus-one) (lam-ir-op lam-op-byte lam-ir-byte-func lam-byte-func-dpb lam-ir-mrot 1 lam-ir-bytl-1 7 lam-ir-m-src m-pretend-macro-ir lam-ir-a-src a-minus-one lam-ir-m-mem-dest a-offset) ; ((lc) add lc a-offset) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-a-src a-offset lam-ir-m-src lam-m-src-lc lam-ir-func-dest lam-func-dest-lc lam-ir-aluf lam-alu-add) ; (jump-equal lc a-ending-lc again) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m=a lam-ir-m-src lam-m-src-lc lam-ir-a-src a-ending-lc lam-ir-n 1 lam-ir-jump-addr again) ; (jump 2 halt-bit) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr again lam-ir-n 1 lam-ir-halt 1) (lam-ir-op lam-op-alu)) )) (defun pdl-push-loop () (write-m-mem 1 0) (uload () 0 ;(jump-xct-next 0) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr 0 lam-ir-n 0) ;((c-pdl-buffer-pointer-push) 1@m) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-m-mem-dest lam-func-dest-c-pdl-buffer-pointer-push lam-ir-m-src 1) ;(no-op) (lam-ir-op lam-op-alu))) ;keeps pushing things on the stack. halts if pdl pointer ever changes other than ;by incrementing by 1 (defun old-check-pdl-pointer-single-pushes () (write-m-mem 1 0) (write-m-mem 2 0) (write-m-mem 3 4000) (write-m-mem 6 0) (write-m-mem 7 14) (uload () 0 ;((6@m) m+1 6@m) ;randomly count passes. (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-m+1 lam-ir-m-src 6 lam-ir-m-mem-dest 6) ;((1@m) m+1 pdl-buffer-pointer) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-m+1 lam-ir-m-mem-dest 1 lam-ir-m-src lam-m-src-pdl-buffer-pointer) ;(jump-not-equal 1@m 3@a[4000] l) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m-neq-a lam-ir-m-src 1 lam-ir-a-src 3 lam-ir-jump-addr l lam-ir-n 1) ;((1@m) setz) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-m-mem-dest 1 lam-ir-aluf lam-alu-setz lam-ir-halt 1) l ;((c-pdl-buffer-pointer-push) 2@m) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-func-dest lam-func-dest-c-pdl-buffer-pointer-push lam-ir-m-src 2) ;((4@m) pdl-buffer-pointer) ; (lam-ir-op lam-op-alu ; lam-ir-ob lam-ob-alu ; lam-ir-aluf lam-alu-setm ; lam-ir-m-mem-dest 4 ; lam-ir-m-src lam-m-src-pdl-buffer-pointer ; ) ; ;(jump-equal pdl-buffer-pointer 1@a 0) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m=a lam-ir-m-src lam-m-src-pdl-buffer-pointer lam-ir-a-src 1 lam-ir-jump-addr 0 lam-ir-n 1) (lam-ir-op lam-op-alu) ;(jump 0 halt) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr 0 lam-ir-n 1 lam-ir-halt 1) ;(no-op) (lam-ir-op lam-op-alu))) (defun check-pdl-pointer-single-pushes () (write-m-mem 1 0) (write-m-mem 2 0) (write-m-mem 3 4000) (write-m-mem 6 0) (write-m-mem 7 14) (uload () 0 ;((6@m) m+1 6@m) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-m+1 lam-ir-m-src 6 lam-ir-m-mem-dest 6) ;((1@m) m+1 pdl-buffer-pointer) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-m+1 lam-ir-m-mem-dest 1 lam-ir-m-src lam-m-src-pdl-buffer-pointer) ;(jump-not-equal 1@m 3@a[4000] l) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m-neq-a lam-ir-m-src 1 lam-ir-a-src 3 lam-ir-jump-addr l lam-ir-n 1) ;((1@m) setz) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-m-mem-dest 1 lam-ir-aluf lam-alu-setz) l ;((c-pdl-buffer-pointer-push) 2@m) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-func-dest lam-func-dest-c-pdl-buffer-pointer-push lam-ir-m-src 2) ;(jump-equal pdl-buffer-pointer 1@a 0) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m=a lam-ir-m-src lam-m-src-pdl-buffer-pointer lam-ir-a-src 1 lam-ir-jump-addr 0 lam-ir-n 1) ; ;((5@m) pdl-buffer-pointer) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-m-mem-dest 5 lam-ir-m-src lam-m-src-pdl-buffer-pointer) (lam-ir-op lam-op-alu) ;(jump 0 halt) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr 0 lam-ir-n 1 lam-ir-halt 1) ;(no-op) (lam-ir-op lam-op-alu))) ;this works ... (defun simple-check-pdl-pointer-single-pushes () (write-m-mem 1 0) (write-m-mem 2 0) (write-m-mem 3 4000) (write-m-mem 6 0) (write-m-mem 7 14) (uload () 0 ;((1@m) m+1 pdl-buffer-pointer) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-m+1 lam-ir-m-mem-dest 1 lam-ir-m-src lam-m-src-pdl-buffer-pointer) ;(jump-not-equal 1@m 3@a[4000] l) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m-neq-a lam-ir-m-src 1 lam-ir-a-src 3 lam-ir-jump-addr l lam-ir-n 1) ;((1@m) setz) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-m-mem-dest 1 lam-ir-aluf lam-alu-setz ; lam-ir-halt 1 ) l ;((c-pdl-buffer-pointer-push) 2@m) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-func-dest lam-func-dest-c-pdl-buffer-pointer-push lam-ir-m-src 2) (lam-ir-op lam-op-alu) (lam-ir-op lam-op-alu) ;(jump-equal pdl-buffer-pointer 1@a 0) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m=a lam-ir-m-src lam-m-src-pdl-buffer-pointer lam-ir-a-src 1 lam-ir-jump-addr 0 lam-ir-n 1) ; ;((5@m) pdl-buffer-pointer) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-m-mem-dest 5 lam-ir-m-src lam-m-src-pdl-buffer-pointer) (lam-ir-op lam-op-alu) ;(jump 0 halt) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr 0 lam-ir-n 1 lam-ir-halt 1) ;(no-op) (lam-ir-op lam-op-alu))) ;loops doing pops; halts if pointer does anything but decrement by 1 (defun check-pdl-pointer-single-pops () (write-m-mem 1 0) (write-m-mem 2 0) (write-m-mem 3 -1) (write-m-mem 4 3777) (uload () 0 ;((1@m) add pdl-buffer-pointer 3@a[-1]) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-add lam-ir-m-mem-dest 1 lam-ir-m-src lam-m-src-pdl-buffer-pointer lam-ir-a-src 3) ;(jump-not-equal 1@m 3@a[-1] l) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m-neq-a lam-ir-m-src 1 lam-ir-a-src 3 lam-ir-jump-addr l lam-ir-n 1) ;((1@m) 4@m[3777]) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-m-mem-dest 1 lam-ir-aluf lam-alu-setm lam-ir-m-src 4) l ;((2@m) c-pdl-buffer-pointer-pop) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-m-mem-dest 2 lam-ir-m-src lam-m-src-c-pdl-buffer-pointer-pop) ;(jump-equal pdl-buffer-pointer 1@a 0) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m=a lam-ir-m-src lam-m-src-pdl-buffer-pointer lam-ir-a-src 1 lam-ir-jump-addr 0 lam-ir-n 1) ;(jump 0 halt) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr 0 lam-ir-n 1 lam-ir-halt 1) ;(no-op) (lam-ir-op lam-op-alu))) (defun write-zeros-and-ones () (write-m-mem 2 0) (write-m-mem 3 -1) (uload () 0 ;((1@m) 2@m) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-m-src 2 lam-ir-m-mem-dest 1) ;((1@m) 3@m) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-m-src 3 lam-ir-m-mem-dest 1) ;(jump 0) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr 0 lam-ir-n 1) ;(no-op) (lam-ir-op lam-op-alu))) (defun check-pdl-refs () (write-m-mem 2 0) (write-m-mem 3 2) ;constant (write-m-mem 4 3777) ;constant mask (write-pp 0) (uload () 0 (lam-ir-ob lam-ob-alu ;((pdl-index) setz) lam-ir-aluf lam-alu-setz lam-ir-func-dest lam-func-dest-pdl-buffer-pointer) l (lam-ir-ob lam-ob-alu ;initialize ea location of pdl buffer to its address+1 lam-ir-aluf lam-alu-setm lam-ir-m-src lam-m-src-pdl-buffer-pointer lam-ir-func-dest lam-func-dest-c-pdl-buffer-pointer-push) (lam-ir-op lam-op-jump ;(jump-not-equal pdl-buffer-pointer a-zero l) lam-ir-jump-cond lam-jump-cond-m-neq-a lam-ir-jump-addr l lam-ir-m-src lam-m-src-pdl-buffer-pointer lam-ir-a-src 2 lam-ir-n 1) l1 (lam-ir-ob lam-ob-alu ;((1@m) setm c-pdl-buffer-pointer-pop) lam-ir-aluf lam-alu-setm lam-ir-m-mem-dest 1 lam-ir-m-src lam-m-src-c-pdl-buffer-pointer-pop) (lam-ir-op lam-op-jump ;(jump-equal pdl-buffer-pointer 1@a l1) lam-ir-jump-cond lam-jump-cond-m=a lam-ir-jump-addr l1 lam-ir-m-src lam-m-src-pdl-buffer-pointer lam-ir-a-src 1 lam-ir-n 1) (lam-ir-op lam-op-alu) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr l1 lam-ir-halt 1 lam-ir-n 1) (Lam-ir-op lam-op-alu))) (defun write-multiplier (data1 &optional (data2 1)(flow-through t)) (let ((data (+ (ash (logand data1 177777) 20) (logand data2 177777)))) (write-spy-reg data) (lam-execute (write) lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-func-dest lam-func-dest-multiplier lam-ir-m-src lam-m-src-spy-reg lam-ir-aluf lam-alu-setm) (and flow-through (lam-execute (write) lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-func-dest lam-func-dest-multiplier lam-ir-m-src lam-m-src-spy-reg lam-ir-aluf lam-alu-setm)))) (defun read-multiplier () (lam-execute (read) lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-multiplier lam-ir-aluf lam-alu-setm) (read-mfo)) (defun read-multiplier-flow-through () (lam-execute (read) lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-multiplier-ft lam-ir-aluf lam-alu-setm) (read-mfo))