;;; -*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*- ;;; ;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc. ;;; (DEFUN DIVIDE-TEST-LOOP (DIVIDEND DIVISOR CORRECT-QUOTIENT CORRECT-REMAINDER &optional (TRIALS 1000) &AUX (A-DIVISOR 1002) ;semi-symbolic register definitions (A-DIVIDEND 1001) (A-CORRECT-REMAINDER 1003) (A-CORRECT-QUOTIENT 1004) (A-BAD-REMAINDER 1005) (A-BAD-QUOTIENT 1006) (M-WINS 20) (M-LOSSES 21) (M-TRIALS 22) ;(R1 4) ;(R2 6) ;(R3 10) ;(RZERO 2) ;location of words of all ZEROs (BEG 0)) ;location in CRAM of start of program (WRITE-A-MEM A-DIVISOR DIVISOR) (WRITE-A-MEM A-DIVIDEND DIVIDEND) (WRITE-A-MEM A-CORRECT-REMAINDER CORRECT-REMAINDER) (write-a-mem a-bad-remainder 0) (WRITE-A-MEM A-CORRECT-QUOTIENT CORRECT-QUOTIENT) (write-a-mem a-bad-quotient 0) (WRITE-M-MEM M-WINS 0) (WRITE-M-MEM M-LOSSES 0) (WRITE-M-MEM M-TRIALS TRIALS) (LET ((LAM-NUMBER-OF-SAVED-OPCS 0)) (PROG (CHAR) (LAM-REGISTER-DEPOSIT RASA BEG) (LAM-REGISTER-DEPOSIT RAGO 0) L (COND ((SETQ CHAR (send terminal-io :tyi-no-hang)) (FORMAT T "~%ABORTING") (LAM-REGISTER-DEPOSIT RASTOP 0) (signal 'sys:abort :format-string "Divide test aborted.")) ((ZEROP (LAM-REGISTER-EXAMINE RAGO)) (GO X))) (PROCESS-SLEEP 10. "Divide Test Wait") (GO L) X (LAM-REGISTER-DEPOSIT RASTOP 0) (RETURN (LIST (READ-M-MEM M-WINS) (READ-M-MEM M-LOSSES) CORRECT-QUOTIENT (READ-A-MEM A-BAD-QUOTIENT) CORRECT-REMAINDER (READ-A-MEM A-BAD-REMAINDER)))))) (DEFUN Dtest (DIVIDEND DIVISOR CORRECT-QUOTIENT CORRECT-REMAINDER &optional (TRIALS 1000) &AUX (A-DIVISOR 1002) ;semi-symbolic register definitions (A-DIVIDEND 1001) (A-CORRECT-REMAINDER 1003) (A-CORRECT-QUOTIENT 1004) (A-BAD-REMAINDER 1005) (A-BAD-QUOTIENT 1006) (M-WINS 20) (M-LOSSES 21) (M-TRIALS 22) ;(R1 4) ;(R2 6) ;(R3 10) ;(RZERO 2) ;location of words of all ZEROs ;(BEG 0) ;location in CRAM of start of program ) (dotimes (i 200) (write-a-mem (+ 1000 i) 0)) (WRITE-A-MEM A-DIVISOR DIVISOR) (WRITE-A-MEM A-DIVIDEND DIVIDEND) (WRITE-A-MEM A-CORRECT-REMAINDER CORRECT-REMAINDER) (write-a-mem a-bad-remainder 0) (WRITE-A-MEM A-CORRECT-QUOTIENT CORRECT-QUOTIENT) (write-a-mem a-bad-quotient 0) (WRITE-M-MEM M-WINS 0) (WRITE-M-MEM M-LOSSES 0) (WRITE-M-MEM M-TRIALS TRIALS) (setup-machine-to-start-at 0)) (DEFUN DIVIDE-TEST-SETUP (&AUX (A-DIVISOR 1002) ;specify where the addresses live (A-DIVIDEND 1001) (A-CORRECT-REMAINDER 1003) (A-CORRECT-QUOTIENT 1004) (A-BAD-REMAINDER 1005) (A-BAD-QUOTIENT 1006) (M-WINS 20) (M-LOSSES 21) (M-TRIALS 22) (R1 4) (R2 6) (R3 10) (RZERO 2) ;location of words of all ZEROs (BEG 0)) ;location in CRAM of start of program (WIPE-M-MEM) (WRITE-M-MEM RZERO 0) (ULOAD (A-DIVISOR A-DIVIDEND A-CORRECT-REMAINDER A-CORRECT-QUOTIENT A-BAD-REMAINDER A-BAD-QUOTIENT M-WINS M-LOSSES M-TRIALS R1 R2 R3 RZERO BEG) ;calling routine loop ;M-WINS counts wins, M-losses counts losses. Do M-TRIALS number of trials. BEG (LAM-IR-OP LAM-OP-ALU LAM-IR-A-SRC A-DIVIDEND ;{dividend to R1} LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-SETA) (LAM-IR-OP LAM-OP-ALU LAM-IR-A-SRC A-DIVISOR ;Divisor to R2 LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R2 LAM-IR-ALUF LAM-ALU-SETA) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR DIVIDE LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-P 1 LAM-IR-N 1 LAM-IR-SPARE-BIT 1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR LOSE LAM-IR-M-SRC R1 LAM-IR-A-SRC A-CORRECT-REMAINDER LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A LAM-IR-N 1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR LOSE LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-A-SRC A-CORRECT-QUOTIENT LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A LAM-IR-N 1) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-WINS LAM-IR-M-MEM-DEST M-WINS LAM-IR-ALUF LAM-ALU-M+1) END-LOOP (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-TRIALS LAM-IR-A-SRC RZERO LAM-IR-M-MEM-DEST M-TRIALS LAM-IR-ALUF LAM-ALU-M-A-1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR BEG LAM-IR-M-SRC M-TRIALS LAM-IR-A-SRC RZERO LAM-IR-JUMP-COND LAM-JUMP-COND-M>A LAM-IR-N 1) HALT-LOC (LAM-IR-OP LAM-OP-JUMP ;Normal halt here when thru. Inspect M-WINS and M-LOSSES LAM-IR-HALT 1 ; to see what happened. LAM-IR-JUMP-ADDR HALT-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) LOSE (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC R1 LAM-IR-A-MEM-DEST-FLAG 1 LAM-IR-A-MEM-DEST A-BAD-REMAINDER LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-A-MEM-DEST-FLAG 1 LAM-IR-A-MEM-DEST A-BAD-QUOTIENT LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-LOSSES LAM-IR-M-MEM-DEST M-LOSSES LAM-IR-ALUF LAM-ALU-M+1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR END-LOOP LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) DIVIDE ;;Divide two numbers. This routine taken from UCADR 108. ;;DIVIDEND R1, DIVISOR in R2 ;;Quotient ends in Q, REMAINDER in R1. (LAM-IR-OP LAM-OP-JUMP ;(JUMP-GREATER-OR-EQUAL-XCT-NEXT M-1 A-ZERO DIV1) LAM-IR-M-SRC R1 ;the dividend LAM-IR-A-SRC RZERO LAM-IR-JUMP-ADDR DIV1-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-M>=A LAM-IR-N 0) (LAM-IR-OB LAM-OB-ALU ;((M-3 Q-R) M-1) LAM-IR-M-SRC R1 LAM-IR-ALUF LAM-ALU-SETM LAM-IR-Q LAM-Q-LOAD LAM-IR-M-MEM-DEST R3) (LAM-IR-M-SRC RZERO ;((Q-R) SUB M-ZERO A-1) LAM-IR-A-SRC R1 LAM-IR-OB LAM-OB-ALU LAM-IR-ALUF LAM-ALU-SUB LAM-IR-Q LAM-Q-LOAD) DIV1-LOC (LAM-IR-M-SRC RZERO ;DIV1 ((R1) DIVIDE-FIRST-STEP M-ZERO R2) LAM-IR-A-SRC R2 ; {Do the first divide-step, and place LAM-IR-OB LAM-OB-ALU-LEFT-1 ; the result LAM-IR-M-MEM-DEST R1 ; left-shifted into R1 -- which will start LAM-IR-ALUF LAM-ALU-DFSTEP ; becoming the remainder -- and also left- LAM-IR-SLOW-DEST 1 LAM-IR-Q LAM-Q-LEFT) ; shift the Q-register. The Q-register will ; get the compliment of the sign-bit of this ; subtraction shifted into its low order bit ; . In this first step, this bit ; indicates DIVIDE-OVERFLOW ... (LAM-IR-OP LAM-OP-JUMP ;DIV1A (JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R DIVIDE-BY-ZERO) LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-BIT-TEST LAM-JUMP-IF-BIT-SET LAM-IR-MROT 0 LAM-IR-JUMP-ADDR DIVIDE-BY-ZERO-STOP LAM-IR-P 1 LAM-IR-N 1) ; {For 31 times (as we have already done one ; divide-step, do the rest of the loop for the ; 32 bit word divide-stepping -- note that we add ; the result of last step's shifting into R1 each ; time, so the first step plus these 31 do 32 shifts, ; and these 31 steps plus the last do the appropriate ; operations on R1) ...} (LAM-IR-M-SRC R1 ;((R1) DIVIDE-STEP R1 R2) LAM-IR-A-SRC R2 ;{In each step of the divide, another bit LAM-IR-OB LAM-OB-ALU-LEFT-1 ; of the dividend moves from to LAM-IR-M-MEM-DEST R1 ; the low order bit of the output selector ; bus , to be written into R1 for LAM-IR-ALUF LAM-ALU-DSTEP ; the next divide-step} LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) ;;; Divide step is complicated. What it does is left-shift the dividend ;;; and subtract the divisor from the dividend (just as in long division). ;;; After the initial divide-step, which tests the sign of the dividend and ;;; does the first left-shift, the main divide-step routine continues. As the Q-register ;;; left-shifts, the low-order bit of the Q-register gets the inverted high-order ;;; bit of the ALU bus -. Also, if the Output Selector bus ;;; is also left-shifting, the value of the high-order Q-register bit goes ;;; to the Output Selector bus low-order bit . The ALU bus feeds the Q-register ;;; directly, not through the Output Selector bus. ;;; The cycle proceeds as follows - we look at the Q-register (which has been left- ;;; shifted during the last operation, causing its low order bit to become ;;; the inverted sign bit of the previous ALU instruction, and its high bit ;;; [since the Output Selector Bus was also left-shifted last operation] to have ;;; been involved as the low order bit of the previous ALU instruction). ;;; If it is negative (0), indicating that previous operation was successful, ;;; i.e. the divisor "went into" the shifted dividend, ;;; we subtract the divisor from a M-scratchpad location that originally had the ;;; sign of the dividend, and left-shift the result (thus shifting into ;;; the low bit of the output the next high bit of the Q-register -- ;;; you can see how this shifts all the Q-register slowly into the bottom bits of ;;; the M-scratchpad location as it gets smaller and shifted over each subtraction). ;;; If it is positive, indicating the the previous subtract overflowed the result ;;; (i.e., we subtracted too much), then we simply ADD this cycle instead of subtract ;;; [very clever -- we need to undo the previous subtract of the divisor and then ;;; subtract the current divisor (since the dividend has left-shifted, we can think ;;; of the divisor as right-shifted from what it was, and thus one-half ;;; as large). If we stop to think, if we add one-half the old divisor (its current ;;; value), the result is the same, and we save an operation]. ;;; During the last operation, we should not automatically shift the result after ;;; the final subtract, as it is not only unnecessary but wrong - we would get the ;;; M-memory location (the remainder) multiplied by two. ;;; Note now that as each inverted sign bit of the previous ALU operation is shifted ;;; slowly into the bottom bits of the Q-register , we build up the quotient ;;; of the division. (LAM-IR-M-SRC R1 ;((R1) DIVIDE-LAST-STEP R1 R2) LAM-IR-A-SRC R2 ;{In the last divide step, we don't LAM-IR-OB LAM-OB-ALU ; left shift the remainder -- so the LAM-IR-M-MEM-DEST R1 ; result in R1 is the real remainder, LAM-IR-ALUF LAM-ALU-DSTEP ; not the remainder left-shifted one.} LAM-IR-Q LAM-Q-LEFT) (LAM-IR-OP LAM-OP-JUMP ;(JUMP-LESS-OR-EQUAL-XCT-NEXT M-ZERO R3 DIV2) LAM-IR-M-SRC RZERO LAM-IR-A-SRC R3 LAM-IR-JUMP-ADDR DIV2-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-M<=A LAM-IR-N 0) (LAM-IR-M-SRC R1 ;((R1) DIVIDE-REMAINDER-CORRECTION-STEP R1 R2) LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-RSTEP) (LAM-IR-M-SRC RZERO ;((R1) SUB M-ZERO R1) LAM-IR-A-SRC R1 LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-SUB) DIV2-LOC (LAM-IR-M-SRC R2 ;DIV2 ((R3) XOR R2 R3) LAM-IR-A-SRC R3 ;{The sign of the quotient should be LAM-IR-OB LAM-OB-ALU ; the XOR of the signs of the dividend LAM-IR-M-MEM-DEST R3 ; and the divisor} LAM-IR-ALUF LAM-ALU-XOR) (LAM-IR-OP LAM-OP-JUMP ;(POPJ-LESS-OR-EQUAL M-ZERO R3) LAM-IR-M-SRC RZERO ;{If the sign of the quotient is positive LAM-IR-A-SRC R3 ; then the positive quotient is already LAM-IR-JUMP-COND LAM-JUMP-COND-M<=A ; okay, the sign of the dividend has been LAM-IR-R 1 ; made positive, so we can just return LAM-IR-N 1) ; to the calling loop} (LAM-IR-OP LAM-OP-ALU ;(POPJ-AFTER-NEXT (R3) Q-R) LAM-IR-OB LAM-OB-ALU LAM-IR-POPJ-AFTER-NEXT 1 LAM-IR-M-SRC LAM-M-SRC-Q ;{If the sign of the quotient is negative, LAM-IR-M-MEM-DEST R3 LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-M-SRC RZERO ;((Q-R) SUB M-ZERO R3) LAM-IR-A-SRC R3 ;{Subtract the quotient from zero LAM-IR-OB LAM-OB-ALU ; to invert its sign and put it LAM-IR-ALUF LAM-ALU-SUB ; back in the Q-register -- this LAM-IR-Q LAM-Q-LOAD) ; inverts the sign of the quotient if ; the XOR of the dividend and divisor ; was negative, and we always return ; with a positive remainder} DIVIDE-BY-ZERO-STOP (LAM-IR-OP LAM-OP-JUMP LAM-IR-HALT 1 LAM-IR-JUMP-ADDR DIVIDE-BY-ZERO-STOP LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) )) ;use MD or VMA instead of a M-MEM location for R1. An instruction had to be ; added since MD, etc, is not available on A side. (DEFUN DIVIDE-TEST-SETUP-TO-MD-OR-VMA (&optional setup-to-vma no-hold &AUX (A-DIVISOR 1002) ;specify where the addresses live (A-DIVIDEND 1001) (A-CORRECT-REMAINDER 1003) (A-CORRECT-QUOTIENT 1004) (A-BAD-REMAINDER 1005) (A-BAD-QUOTIENT 1006) (M-WINS 20) (M-LOSSES 21) (M-TRIALS 22) (fsrc nil) (fdest nil) ; (R1 4) (tr1 4) (R2 6) (R3 10) (RZERO 2) ;location of words of all ZEROs (BEG 0)) ;location in CRAM of start of program (setq fsrc (cond (setup-to-vma lam-m-src-vma) (no-hold lam-m-src-md-no-hold) (t lam-m-src-md)) fdest (cond (setup-to-vma lam-func-dest-vma) (t lam-func-dest-md))) (FORMAT T "~%SETTING UP FOR ~:[MD~;VMA~], ~:[NO HOLD~;NORMAL HOLD~]" SETUP-TO-VMA NO-HOLD) (WIPE-M-MEM) (WRITE-M-MEM RZERO 0) (ULOAD (A-DIVISOR A-DIVIDEND A-CORRECT-REMAINDER A-CORRECT-QUOTIENT A-BAD-REMAINDER A-BAD-QUOTIENT M-WINS M-LOSSES M-TRIALS R2 R3 RZERO BEG TR1 fsrc fdest) ;calling routine loop ;M-WINS counts wins, M-losses counts losses. Do M-TRIALS number of trials. BEG (LAM-IR-OP LAM-OP-ALU LAM-IR-A-SRC A-DIVIDEND ;{dividend to R1} LAM-IR-OB LAM-OB-ALU ; LAM-IR-M-MEM-DEST R1 lam-ir-func-dest fdest LAM-IR-ALUF LAM-ALU-SETA) (LAM-IR-OP LAM-OP-ALU LAM-IR-A-SRC A-DIVISOR ;Divisor to R2 LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R2 LAM-IR-ALUF LAM-ALU-SETA) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR DIVIDE LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-P 1 LAM-IR-N 1 LAM-IR-SPARE-BIT 1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR LOSE LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC A-CORRECT-REMAINDER LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A LAM-IR-N 1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR LOSE LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-A-SRC A-CORRECT-QUOTIENT LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A LAM-IR-N 1) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-WINS LAM-IR-M-MEM-DEST M-WINS LAM-IR-ALUF LAM-ALU-M+1) END-LOOP (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-TRIALS LAM-IR-A-SRC RZERO LAM-IR-M-MEM-DEST M-TRIALS LAM-IR-ALUF LAM-ALU-M-A-1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR BEG LAM-IR-M-SRC M-TRIALS LAM-IR-A-SRC RZERO LAM-IR-JUMP-COND LAM-JUMP-COND-M>A LAM-IR-N 1) HALT-LOC (LAM-IR-OP LAM-OP-JUMP ;Normal halt here when thru. Inspect M-WINS and M-LOSSES LAM-IR-HALT 1 ; to see what happened. LAM-IR-JUMP-ADDR HALT-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) LOSE (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-MEM-DEST-FLAG 1 LAM-IR-A-MEM-DEST A-BAD-REMAINDER LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-A-MEM-DEST-FLAG 1 LAM-IR-A-MEM-DEST A-BAD-QUOTIENT LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-LOSSES LAM-IR-M-MEM-DEST M-LOSSES LAM-IR-ALUF LAM-ALU-M+1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR END-LOOP LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) DIVIDE ;;Divide two numbers. This routine taken from UCADR 108. ;;DIVIDEND R1, DIVISOR in R2 ;;Quotient ends in Q, REMAINDER in R1. (LAM-IR-OP LAM-OP-JUMP ;(JUMP-GREATER-OR-EQUAL-XCT-NEXT M-1 A-ZERO DIV1) LAM-IR-M-SRC fsrc ;R1 ;the dividend LAM-IR-A-SRC RZERO LAM-IR-JUMP-ADDR DIV1-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-M>=A LAM-IR-N 0) (LAM-IR-OB LAM-OB-ALU ;((M-3 Q-R) M-1) LAM-IR-M-SRC fsrc ;R1 LAM-IR-ALUF LAM-ALU-SETM LAM-IR-Q LAM-Q-LOAD LAM-IR-M-MEM-DEST R3) (lam-ir-m-src fsrc ;((r1) setm fsrc) lam-ir-ob lam-ob-alu lam-ir-m-mem-dest tr1 lam-ir-aluf lam-alu-setm) (LAM-IR-M-SRC RZERO ;((Q-R) SUB M-ZERO A-1) LAM-IR-A-SRC TR1 LAM-IR-OB LAM-OB-ALU LAM-IR-ALUF LAM-ALU-SUB LAM-IR-Q LAM-Q-LOAD) DIV1-LOC (LAM-IR-M-SRC RZERO ;DIV1 ((R1) DIVIDE-FIRST-STEP M-ZERO R2) LAM-IR-A-SRC R2 ; {Do the first divide-step, and place LAM-IR-OB LAM-OB-ALU-LEFT-1 ; the result ; LAM-IR-M-MEM-DEST R1 ; left-shifted into R1 -- which will start lam-ir-func-dest fdest LAM-IR-ALUF LAM-ALU-DFSTEP ; becoming the remainder -- and also left- LAM-IR-SLOW-DEST 1 LAM-IR-Q LAM-Q-LEFT) ; shift the Q-register. The Q-register will ; get the compliment of the sign-bit of this ; subtraction shifted into its low order bit ; . In this first step, this bit ; indicates DIVIDE-OVERFLOW ... (LAM-IR-OP LAM-OP-JUMP ;DIV1A (JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R DIVIDE-BY-ZERO) LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-BIT-TEST LAM-JUMP-IF-BIT-SET LAM-IR-MROT 0 LAM-IR-JUMP-ADDR DIVIDE-BY-ZERO-STOP LAM-IR-P 1 LAM-IR-N 1) ; {For 31 times (as we have already done one ; divide-step, do the rest of the loop for the ; 32 bit word divide-stepping -- note that we add ; the result of last step's shifting into R1 each ; time, so the first step plus these 31 do 32 shifts, ; and these 31 steps plus the last do the appropriate ; operations on R1) ...} (LAM-IR-M-SRC fsrc ;R1 ;((R1) DIVIDE-STEP R1 R2) LAM-IR-A-SRC R2 ;{In each step of the divide, another bit LAM-IR-OB LAM-OB-ALU-LEFT-1 ; of the dividend moves from to ; LAM-IR-M-MEM-DEST R1 ; the low order bit of the output selector lam-ir-func-dest fdest ; bus , to be written into R1 for LAM-IR-ALUF LAM-ALU-DSTEP ; the next divide-step} LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (LAM-IR-M-SRC fsrc ;R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 lam-ir-func-dest fdest ;LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) ;;; Divide step is complicated. What it does is left-shift the dividend ;;; and subtract the divisor from the dividend (just as in long division). ;;; After the initial divide-step, which tests the sign of the dividend and ;;; does the first left-shift, the main divide-step routine continues. As the Q-register ;;; left-shifts, the low-order bit of the Q-register gets the inverted high-order ;;; bit of the ALU bus -. Also, if the Output Selector bus ;;; is also left-shifting, the value of the high-order Q-register bit goes ;;; to the Output Selector bus low-order bit . The ALU bus feeds the Q-register ;;; directly, not through the Output Selector bus. ;;; The cycle proceeds as follows - we look at the Q-register (which has been left- ;;; shifted during the last operation, causing its low order bit to become ;;; the inverted sign bit of the previous ALU instruction, and its high bit ;;; [since the Output Selector Bus was also left-shifted last operation] to have ;;; been involved as the low order bit of the previous ALU instruction). ;;; If it is negative (0), indicating that previous operation was successful, ;;; i.e. the divisor "went into" the shifted dividend, ;;; we subtract the divisor from a M-scratchpad location that originally had the ;;; sign of the dividend, and left-shift the result (thus shifting into ;;; the low bit of the output the next high bit of the Q-register -- ;;; you can see how this shifts all the Q-register slowly into the bottom bits of ;;; the M-scratchpad location as it gets smaller and shifted over each subtraction). ;;; If it is positive, indicating the the previous subtract overflowed the result ;;; (i.e., we subtracted too much), then we simply ADD this cycle instead of subtract ;;; [very clever -- we need to undo the previous subtract of the divisor and then ;;; subtract the current divisor (since the dividend has left-shifted, we can think ;;; of the divisor as right-shifted from what it was, and thus one-half ;;; as large). If we stop to think, if we add one-half the old divisor (its current ;;; value), the result is the same, and we save an operation]. ;;; During the last operation, we should not automatically shift the result after ;;; the final subtract, as it is not only unnecessary but wrong - we would get the ;;; M-memory location (the remainder) multiplied by two. ;;; Note now that as each inverted sign bit of the previous ALU operation is shifted ;;; slowly into the bottom bits of the Q-register , we build up the quotient ;;; of the division. (LAM-IR-M-SRC fsrc ;((R1) DIVIDE-LAST-STEP R1 R2) LAM-IR-A-SRC R2 ;{In the last divide step, we don't LAM-IR-OB LAM-OB-ALU ; left shift the remainder -- so the ; LAM-IR-M-MEM-DEST R1 ; result in R1 is the real remainder, lam-ir-func-dest fdest LAM-IR-ALUF LAM-ALU-DSTEP ; not the remainder left-shifted one.} LAM-IR-Q LAM-Q-LEFT) (LAM-IR-OP LAM-OP-JUMP ;(JUMP-LESS-OR-EQUAL-XCT-NEXT M-ZERO R3 DIV2) LAM-IR-M-SRC RZERO LAM-IR-A-SRC R3 LAM-IR-JUMP-ADDR DIV2-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-M<=A LAM-IR-N 0) (LAM-IR-M-SRC fsrc ;R1 ;((R1) DIVIDE-REMAINDER-CORRECTION-STEP R1 R2) LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU ; LAM-IR-M-MEM-DEST R1 lam-ir-func-dest fdest LAM-IR-ALUF LAM-ALU-RSTEP) (lam-ir-m-src fsrc ;((r1) setm fsrc) lam-ir-ob lam-ob-alu lam-ir-m-mem-dest tr1 lam-ir-aluf lam-alu-setm) (LAM-IR-M-SRC RZERO ;((R1) SUB M-ZERO R1) LAM-IR-A-SRC TR1 LAM-IR-OB LAM-OB-ALU ;LAM-IR-M-MEM-DEST R1 LAM-IR-FUNC-DEST FDEST LAM-IR-ALUF LAM-ALU-SUB) DIV2-LOC (LAM-IR-M-SRC R2 ;DIV2 ((R3) XOR R2 R3) LAM-IR-A-SRC R3 ;{The sign of the quotient should be LAM-IR-OB LAM-OB-ALU ; the XOR of the signs of the dividend LAM-IR-M-MEM-DEST R3 ; and the divisor} LAM-IR-ALUF LAM-ALU-XOR) (LAM-IR-OP LAM-OP-JUMP ;(POPJ-LESS-OR-EQUAL M-ZERO R3) LAM-IR-M-SRC RZERO ;{If the sign of the quotient is positive LAM-IR-A-SRC R3 ; then the positive quotient is already LAM-IR-JUMP-COND LAM-JUMP-COND-M<=A ; okay, the sign of the dividend has been LAM-IR-R 1 ; made positive, so we can just return LAM-IR-N 1) ; to the calling loop} (LAM-IR-OP LAM-OP-ALU ;(POPJ-AFTER-NEXT (R3) Q-R) LAM-IR-OB LAM-OB-ALU LAM-IR-POPJ-AFTER-NEXT 1 LAM-IR-M-SRC LAM-M-SRC-Q ;{If the sign of the quotient is negative, LAM-IR-M-MEM-DEST R3 LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-M-SRC RZERO ;((Q-R) SUB M-ZERO R3) LAM-IR-A-SRC R3 ;{Subtract the quotient from zero LAM-IR-OB LAM-OB-ALU ; to invert its sign and put it LAM-IR-ALUF LAM-ALU-SUB ; back in the Q-register -- this LAM-IR-Q LAM-Q-LOAD) ; inverts the sign of the quotient if ; the XOR of the dividend and divisor ; was negative, and we always return ; with a positive remainder} DIVIDE-BY-ZERO-STOP (LAM-IR-OP LAM-OP-JUMP LAM-IR-HALT 1 LAM-IR-JUMP-ADDR DIVIDE-BY-ZERO-STOP LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) )) (DEFUN DIVIDE-TEST-diag-setup (&AUX (A-DIVISOR 1002) ;specify where the addresses live (A-DIVIDEND 1001) (A-CORRECT-REMAINDER 1003) (A-CORRECT-QUOTIENT 1004) (A-BAD-REMAINDER 1005) (A-BAD-QUOTIENT 1006) (M-WINS 20) (M-LOSSES 21) (M-TRIALS 22) (R1 4) (R2 6) (R3 10) (RZERO 2) ;location of words of all ZEROs (BEG 0)) ;location in CRAM of start of program (WIPE-M-MEM) (WRITE-M-MEM RZERO 0) (ULOAD (A-DIVISOR A-DIVIDEND A-CORRECT-REMAINDER A-CORRECT-QUOTIENT A-BAD-REMAINDER A-BAD-QUOTIENT M-WINS M-LOSSES M-TRIALS R1 R2 R3 RZERO BEG) ;calling routine loop ;M-WINS counts wins, M-losses counts losses. Do M-TRIALS number of trials. BEG (LAM-IR-OP LAM-OP-ALU LAM-IR-A-SRC A-DIVIDEND ;{dividend to R1} LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-SETA) (LAM-IR-OP LAM-OP-ALU LAM-IR-A-SRC A-DIVISOR ;Divisor to R2 LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R2 LAM-IR-ALUF LAM-ALU-SETA) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR DIVIDE LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-P 1 LAM-IR-N 1 LAM-IR-SPARE-BIT 1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR LOSE LAM-IR-M-SRC R1 LAM-IR-A-SRC A-CORRECT-REMAINDER LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A LAM-IR-N 1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR LOSE LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-A-SRC A-CORRECT-QUOTIENT LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A LAM-IR-N 1) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-WINS LAM-IR-M-MEM-DEST M-WINS LAM-IR-ALUF LAM-ALU-M+1) END-LOOP (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-TRIALS LAM-IR-A-SRC RZERO LAM-IR-M-MEM-DEST M-TRIALS LAM-IR-ALUF LAM-ALU-M-A-1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR BEG LAM-IR-M-SRC M-TRIALS LAM-IR-A-SRC RZERO LAM-IR-JUMP-COND LAM-JUMP-COND-M>A LAM-IR-N 1) HALT-LOC (LAM-IR-OP LAM-OP-JUMP ;Normal halt here when thru. Inspect M-WINS and M-LOSSES LAM-IR-HALT 1 ; to see what happened. LAM-IR-JUMP-ADDR HALT-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) LOSE (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC R1 LAM-IR-A-MEM-DEST-FLAG 1 LAM-IR-A-MEM-DEST A-BAD-REMAINDER LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-A-MEM-DEST-FLAG 1 LAM-IR-A-MEM-DEST A-BAD-QUOTIENT LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC M-LOSSES LAM-IR-M-MEM-DEST M-LOSSES LAM-IR-ALUF LAM-ALU-M+1) (LAM-IR-OP LAM-OP-JUMP LAM-IR-JUMP-ADDR END-LOOP LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) DIVIDE ;;Divide two numbers. This routine taken from UCADR 108. ;;DIVIDEND R1, DIVISOR in R2 ;;Quotient ends in Q, REMAINDER in R1. (LAM-IR-OP LAM-OP-JUMP ;(JUMP-GREATER-OR-EQUAL-XCT-NEXT M-1 A-ZERO DIV1) LAM-IR-M-SRC R1 ;the dividend LAM-IR-A-SRC RZERO LAM-IR-JUMP-ADDR DIV1-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-M>=A LAM-IR-N 0) (LAM-IR-OB LAM-OB-ALU ;((M-3 Q-R) M-1) LAM-IR-M-SRC R1 LAM-IR-ALUF LAM-ALU-SETM LAM-IR-Q LAM-Q-LOAD LAM-IR-M-MEM-DEST R3) (LAM-IR-M-SRC RZERO ;((Q-R) SUB M-ZERO A-1) LAM-IR-A-SRC R1 LAM-IR-OB LAM-OB-ALU LAM-IR-ALUF LAM-ALU-SUB LAM-IR-Q LAM-Q-LOAD) DIV1-LOC (LAM-IR-M-SRC RZERO ;DIV1 ((R1) DIVIDE-FIRST-STEP M-ZERO R2) LAM-IR-A-SRC R2 ; {Do the first divide-step, and place LAM-IR-OB LAM-OB-ALU-LEFT-1 ; the result LAM-IR-M-MEM-DEST R1 ; left-shifted into R1 -- which will start LAM-IR-ALUF LAM-ALU-DFSTEP ; becoming the remainder -- and also left- LAM-IR-SLOW-DEST 1 LAM-IR-Q LAM-Q-LEFT) ; shift the Q-register. The Q-register will ; get the compliment of the sign-bit of this ; subtraction shifted into its low order bit ; . In this first step, this bit ; indicates DIVIDE-OVERFLOW ... (LAM-IR-OP LAM-OP-JUMP ;DIV1A (JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R DIVIDE-BY-ZERO) LAM-IR-M-SRC LAM-M-SRC-Q LAM-IR-BIT-TEST LAM-JUMP-IF-BIT-SET LAM-IR-MROT 0 LAM-IR-JUMP-ADDR DIVIDE-BY-ZERO-STOP LAM-IR-P 1 LAM-IR-N 1) ; {For 31 times (as we have already done one ; divide-step, do the rest of the loop for the ; 32 bit word divide-stepping -- note that we add ; the result of last step's shifting into R1 each ; time, so the first step plus these 31 do 32 shifts, ; and these 31 steps plus the last do the appropriate ; operations on R1) ...} (LAM-IR-M-SRC R1 ;((R1) DIVIDE-STEP R1 R2) LAM-IR-A-SRC R2 ;{In each step of the divide, another bit LAM-IR-OB LAM-OB-ALU-LEFT-1 ; of the dividend moves from to LAM-IR-M-MEM-DEST R1 ; the low order bit of the output selector ; bus , to be written into R1 for LAM-IR-ALUF LAM-ALU-DSTEP ; the next divide-step} LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1101) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1102) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1103) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1104) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1105) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1106) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1107) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1110) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1111) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1112) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1113) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1114) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1115) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1116) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1117) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1120) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1121) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1122) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1123) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1124) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1125) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1126) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1127) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1130) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1131) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1132) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1133) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1134) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1135) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1136) (LAM-IR-M-SRC R1 LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU-LEFT-1 LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-DSTEP LAM-IR-Q LAM-Q-LEFT) (lam-ir-ob lam-ob-alu lam-ir-m-src lam-m-src-q lam-ir-aluf lam-alu-setm lam-ir-a-mem-dest-flag 1 lam-ir-a-mem-dest 1137) ;;; Divide step is complicated. What it does is left-shift the dividend ;;; and subtract the divisor from the dividend (just as in long division). ;;; After the initial divide-step, which tests the sign of the dividend and ;;; does the first left-shift, the main divide-step routine continues. As the Q-register ;;; left-shifts, the low-order bit of the Q-register gets the inverted high-order ;;; bit of the ALU bus -. Also, if the Output Selector bus ;;; is also left-shifting, the value of the high-order Q-register bit goes ;;; to the Output Selector bus low-order bit . The ALU bus feeds the Q-register ;;; directly, not through the Output Selector bus. ;;; The cycle proceeds as follows - we look at the Q-register (which has been left- ;;; shifted during the last operation, causing its low order bit to become ;;; the inverted sign bit of the previous ALU instruction, and its high bit ;;; [since the Output Selector Bus was also left-shifted last operation] to have ;;; been involved as the low order bit of the previous ALU instruction). ;;; If it is negative (0), indicating that previous operation was successful, ;;; i.e. the divisor "went into" the shifted dividend, ;;; we subtract the divisor from a M-scratchpad location that originally had the ;;; sign of the dividend, and left-shift the result (thus shifting into ;;; the low bit of the output the next high bit of the Q-register -- ;;; you can see how this shifts all the Q-register slowly into the bottom bits of ;;; the M-scratchpad location as it gets smaller and shifted over each subtraction). ;;; If it is positive, indicating the the previous subtract overflowed the result ;;; (i.e., we subtracted too much), then we simply ADD this cycle instead of subtract ;;; [very clever -- we need to undo the previous subtract of the divisor and then ;;; subtract the current divisor (since the dividend has left-shifted, we can think ;;; of the divisor as right-shifted from what it was, and thus one-half ;;; as large). If we stop to think, if we add one-half the old divisor (its current ;;; value), the result is the same, and we save an operation]. ;;; During the last operation, we should not automatically shift the result after ;;; the final subtract, as it is not only unnecessary but wrong - we would get the ;;; M-memory location (the remainder) multiplied by two. ;;; Note now that as each inverted sign bit of the previous ALU operation is shifted ;;; slowly into the bottom bits of the Q-register , we build up the quotient ;;; of the division. (LAM-IR-M-SRC R1 ;((R1) DIVIDE-LAST-STEP R1 R2) LAM-IR-A-SRC R2 ;{In the last divide step, we don't LAM-IR-OB LAM-OB-ALU ; left shift the remainder -- so the LAM-IR-M-MEM-DEST R1 ; result in R1 is the real remainder, LAM-IR-ALUF LAM-ALU-DSTEP ; not the remainder left-shifted one.} LAM-IR-Q LAM-Q-LEFT) (LAM-IR-OP LAM-OP-JUMP ;(JUMP-LESS-OR-EQUAL-XCT-NEXT M-ZERO R3 DIV2) LAM-IR-M-SRC RZERO LAM-IR-A-SRC R3 LAM-IR-JUMP-ADDR DIV2-LOC LAM-IR-JUMP-COND LAM-JUMP-COND-M<=A LAM-IR-N 0) (LAM-IR-M-SRC R1 ;((R1) DIVIDE-REMAINDER-CORRECTION-STEP R1 R2) LAM-IR-A-SRC R2 LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-RSTEP) (LAM-IR-M-SRC RZERO ;((R1) SUB M-ZERO R1) LAM-IR-A-SRC R1 LAM-IR-OB LAM-OB-ALU LAM-IR-M-MEM-DEST R1 LAM-IR-ALUF LAM-ALU-SUB) DIV2-LOC (LAM-IR-M-SRC R2 ;DIV2 ((R3) XOR R2 R3) LAM-IR-A-SRC R3 ;{The sign of the quotient should be LAM-IR-OB LAM-OB-ALU ; the XOR of the signs of the dividend LAM-IR-M-MEM-DEST R3 ; and the divisor} LAM-IR-ALUF LAM-ALU-XOR) (LAM-IR-OP LAM-OP-JUMP ;(POPJ-LESS-OR-EQUAL M-ZERO R3) LAM-IR-M-SRC RZERO ;{If the sign of the quotient is positive LAM-IR-A-SRC R3 ; then the positive quotient is already LAM-IR-JUMP-COND LAM-JUMP-COND-M<=A ; okay, the sign of the dividend has been LAM-IR-R 1 ; made positive, so we can just return LAM-IR-N 1) ; to the calling loop} (LAM-IR-OP LAM-OP-ALU ;(POPJ-AFTER-NEXT (R3) Q-R) LAM-IR-OB LAM-OB-ALU LAM-IR-POPJ-AFTER-NEXT 1 LAM-IR-M-SRC LAM-M-SRC-Q ;{If the sign of the quotient is negative, LAM-IR-M-MEM-DEST R3 LAM-IR-ALUF LAM-ALU-SETM) (LAM-IR-M-SRC RZERO ;((Q-R) SUB M-ZERO R3) LAM-IR-A-SRC R3 ;{Subtract the quotient from zero LAM-IR-OB LAM-OB-ALU ; to invert its sign and put it LAM-IR-ALUF LAM-ALU-SUB ; back in the Q-register -- this LAM-IR-Q LAM-Q-LOAD) ; inverts the sign of the quotient if ; the XOR of the dividend and divisor ; was negative, and we always return ; with a positive remainder} DIVIDE-BY-ZERO-STOP (LAM-IR-OP LAM-OP-JUMP LAM-IR-HALT 1 LAM-IR-JUMP-ADDR DIVIDE-BY-ZERO-STOP LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU) )) (defvar *divide-test-divisor*) (defvar *divide-test-dividend*) (defvar *divide-test-correct-quotient*) (defvar *divide-test-correct-remainder*) (DEFUN DIAG-DIVIDE-TEST () (DIVIDE-TEST 100 100000. T)) (defun divide-test (&optional (trials 100) (trials-per-run 100000.) (DIAG-SETUP NIL) ;OR DIAG OR MD OR MD-NO-HOLD OR VMA &aux old-pmr) (COND ((EQ DIAG-SETUP 'DIAG) (DIVIDE-TEST-DIAG-SETUP)) ((EQ DIAG-SETUP 'MD) (DIVIDE-TEST-SETUP-TO-MD-OR-VMA NIL)) ((EQ DIAG-SETUP 'MD-NO-HOLD) (DIVIDE-TEST-SETUP-TO-MD-OR-VMA NIL T)) ((EQ DIAG-SETUP 'VMA) (DIVIDE-TEST-SETUP-TO-MD-OR-VMA T)) (T (divide-test-setup))) (setq old-pmr (read-pmr)) ; (enable-parity-stop) ;we really should do this with dp parity on (LET ((ABORT-MSG (*CATCH 'ABORTING (dotimes (c trials) (AND (send terminal-io :TYI-NO-HANG)(*THROW 'ABORTING "......ABORTING TEST")) l (setq *divide-test-divisor* (random) *divide-test-dividend* (random)) ;choose a random dividend and (cond ((zerop *divide-test-divisor*) ;a random, non-zero divisor (go l))) (let ((r3 (random))) ;randomly pick signs for the dividend (cond ((= 1 (ldb 01 r3)) ;and divisor (setq *divide-test-divisor* (minus *divide-test-divisor*)))) (cond ((= 1 (ldb 0101 r3)) (setq *divide-test-dividend* (minus *divide-test-dividend*))))) ;compute the correct quotient and remainder (setq *divide-test-correct-quotient* (// *divide-test-dividend* *divide-test-divisor*) *divide-test-correct-remainder* (\ *divide-test-dividend* *divide-test-divisor*)) ;load the variables, proceed the ucode, ;wait for stop (let* ((ans (divide-test-loop *divide-test-dividend* *divide-test-divisor* *divide-test-correct-quotient* *divide-test-correct-remainder* trials-per-run)) (wins (first ans)) (losses (second ans)) (quotient (fourth ans)) (remainder (sixth ans))) ;we get an error if the number of ;wins is not equal to the number of ;trials or if the number of losses is ;not zero. (cond ((or (not (= wins trials-per-run)) (not (zerop losses))) (format t "Error: while dividing ~s, by ~s~%~ got ~s with a remainder of ~S~%when correct quotient was ~s~%~ and correct remainder was ~s,~% won ~s, lost ~s" *divide-test-dividend* *divide-test-divisor* quotient remainder *divide-test-correct-quotient* *divide-test-correct-remainder* wins losses) (format t "~%~% to debug this error in lam, this information ~ may be useful:~%~%~ program starts at pc = 0~%~%~ some constants are saved in high a-mem~%~ divisor 1002@A~%~ dividend 1001@A~%~ correct remainder 1003@A~%~ correct quotient 1004@A~%~%~ the last bad results are also stored in high a-mem~%~ bad remainder 1005@A~%~ bad quotient 1006@A~%~%~ in m-mem, we store variables actively used by the program~%~ wins 20@M~%~ losses 21@M~%~ trials-per-run 22@M (typically starts at 303240, counts to 0)~%~ r1 4@M starts as the dividend, winds up with the quotient~%~ r2 6@m holds the divisor during the trial~%~ r3 10@m quotient ends up here~%~ zeros 2@M (a word of all zeros)") (cond ((not (= trials-per-run (+ wins losses))) (format t "~%~% **something is screwy here because ~ trials-per-run is ~O but wins plus losses is ~O" trials-per-run (+ wins losses)) (break "divide-test-failure")) ((break "divide-test-failure")))) ) ))))) (AND (STRINGP ABORT-MSG)(FORMAT LAMBDA-DIAG-STREAM "~A" ABORT-MSG)) (write-pmr old-pmr) ;restore the old state, disabling ;parity stop if it was off before ABORT-MSG)) (defun divide-test-repeat (&optional (trials-per-run 1000000)) (divide-test-loop *divide-test-dividend* *divide-test-divisor* *divide-test-correct-quotient* *divide-test-correct-remainder* trials-per-run)) (defun divide-test-repeat-forever () (do () (()) (print (divide-test-repeat 10000000)))) (defun divide-test-save () (format t " (setq *divide-test-dividend* ~s *divide-test-divisor* ~s *divide-test-correct-quotient* ~s *divide-test-correct-remainder* ~s)" *divide-test-dividend* *divide-test-divisor* *divide-test-correct-quotient* *divide-test-correct-remainder*) (list *divide-test-dividend* *divide-test-divisor* *divide-test-correct-quotient* *divide-test-correct-remainder*)) (defun divide-test-restore (list) (setq *divide-test-dividend* (car list) *divide-test-divisor* (cadr list) *divide-test-correct-quotient* (caddr list) *divide-test-correct-remainder* (cadddr list))) (defun batch-divide-test () (do ((i 1 (1+ i))) (()) (divide-test) (format t "~d. divide-test worked again. execute-cycle-doubled-in-tram = ~a" i execute-cycle-doubled-in-tram) (setq execute-cycle-doubled-in-tram (not execute-cycle-doubled-in-tram)) (init-tram))) ;;now for some more arithmetic; if divide test fails, we need to break it down into ;;componants (defun subtract-test (&aux result) ;for now, subtract a number from itself ;and get zero (format t "~%SUBTRACT TEST") (LET ((ABORT-MSG (*CATCH 'ABORTING (do* ((data 1 (ash data 1))) ((= data 40000000000)) (AND (send terminal-io :TYI-NO-HANG) (*THROW 'ABORTING ".....ABORTING TEST")) (cond (( 0 (setq result (lam-subtract data data))) (format t "~%bad subtract for ~o, got ~o instead of 0, bad bits are" data result) (print-bits result))))))) (AND (STRINGP ABORT-MSG) (FORMAT LAMBDA-DIAG-STREAM "~A" ABORT-MSG)) ABORT-MSG)) (defun lam-subtract (data1 data2) ;subtract data2 from data1 (write-a-mem 4 data2) (write-m-mem 5 data1) (lam-execute (read) lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-a-src 4 lam-ir-m-src 5 lam-ir-aluf lam-alu-sub) (read-mfo)) (defun add-test (&aux actual expected) ;for now,add a number to itself ;and get it doubled (FORMAT T "~%ADD TEST") (LET ((ABORT-MSG (*CATCH 'ABORTING (do* ((data 1 (ash data 1))) (( data 20000000000)) (AND (send terminal-io :tyi-NO-HANG) (*THROW 'ABORTING ".....ABORTING TEST")) (cond (( (setq expected (+ data data)) (setq actual (lam-add data data))) (format t "~%bad add for ~o, got ~o instead of ~o, bad bits are" data actual expected) (print-bits (logxor expected actual)))))))) (AND (STRINGP ABORT-MSG) (FORMAT LAMBDA-DIAG-STREAM "~A" ABORT-MSG)) ABORT-MSG)) (defun lam-add (data1 data2) ;add data2 and data1 (write-a-mem 4 data2) (write-m-mem 5 data1) (lam-execute (read) lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-a-src 4 lam-ir-m-src 5 lam-ir-aluf lam-alu-add) (read-mfo)) (defun fast-subtract-test (&optional (already-loaded nil)) (let* ((result-list (test-subtract-loop already-loaded)) (stop-pc (first result-list)) (up-counter (second result-list)) (down-counter (third result-list)) (seed (fourth result-list)) (ptemp (fifth result-list)) (ntemp (sixth result-list)) (-ntemp (seventh result-list)) (good-stop (first (last result-list))) (num-up-counter (32b-to-num up-counter)) (num-down-counter (32b-to-num down-counter)) (num-seed (32b-to-num seed)) (num-ptemp (32b-to-num ptemp)) (num-ntemp (32b-to-num ntemp)) (num-minus-ntemp (32b-to-num -ntemp)) ) (if (= stop-pc good-stop) (format t "~%subtract-test ok") (cond ((= stop-pc 1) (format t "~%Probably a bad transfer, stopped at pc=1")) ((= stop-pc 3) (format t "~%Stopped at pc = 3, indicating an error")) (t (format t "~%Unknown stop, pc = ~O . Does this really run~ basic-utest? yuck." stop-pc))) (format t "~%this test starts with 32 locations in A memory~%~ (starting at 100) filled with interesting numbers.~%~ These are used as the starting point for two math~%~ routines. These two routines should give the same~%~ result; if they dont, we go to the error halt.~%~ We save the intermediate values in m-memory, so here~%~ is a reconstruction of the error. (If you didnt stop~%~ at the error-stop, pc = 3, this is probably still worth~%~ looking at, but dont take it too seriously)~%~ The interesting number is taken from A-mem and~%~ stored at 13@M. call it the SEED. SEED = ~O {~O}~%~ There are two counters, the up-counter at 1@M~%~ and the down-counter at 2@M. They start together at~%~ zero, so down-counter should always be the negative~%~ of up-counter.~%~ UP-COUNTER = ~O {~O} DOWN-COUNTER = ~O {~O}~%~ UP-COUNTER + SEED = PTEMP (10@M)~%~ [~O + ~O = ~O] which is {~O + ~O = ~O}~%~ DOWN-COUNTER - SEED = NTEMP (11@M)~%~ [~O - ~O = ~O] which is {~O + ~O = ~O}~%~ Since UP-COUNTER = -DOWN-COUNTER, we should find~%~ that PTEMP = -NTEMP. So subtract NTEMP from 0 (4@M)~%~ 0 - NTEMP = -NTEMP (12@M)~%~ [ 0 - ~O = ~O] which is {0 - ~O = ~O}~%~ and finally we check the result~%~ [ ~O = ~O ???] or { ~O = ~O ???}~%" seed num-seed up-counter num-up-counter down-counter num-down-counter up-counter seed ptemp num-up-counter num-seed num-ptemp down-counter seed ntemp num-down-counter num-seed num-ntemp ntemp -ntemp num-ntemp num-minus-ntemp ptemp -ntemp num-ptemp num-minus-ntemp ) (if ( num-up-counter (- 0 num-down-counter)) (format t "~%***** notice that up-counter is ~O but -down-counter is ~O" num-up-counter (- 0 num-down-counter))) (if ( num-ptemp (+ num-up-counter num-seed)) (format t "~%****** notice that ptemp is ~o but up-counter + seed should ~ be ~o" num-ptemp (+ num-up-counter num-seed))) (if ( num-ntemp (- num-down-counter num-seed)) (format t "~%****** notice that ntemp is ~o but down-counter - seed should ~ be ~o" num-ntemp (- num-down-counter num-seed))) (if ( num-minus-ntemp (- 0 num-ntemp)) (format t "~%******* notice that -ntemp is ~O but 0 - ntemp should be ~O" num-minus-ntemp (- 0 num-ntemp))) ))) (defun 32b-to-num (word) (cond ((= 1 (ldb 3701 word)) (- 0 (+ 1 (logxor word 37777777777)))) (t word))) (defvar *saved-stop-loc-for-test-subtract-loop* nil) ;holds the next to the last location ;of the program loaded by test-subtract-loop ;so that the "already-loaded" feature ;can work (DEFUN TEST-SUBTRACT-LOOP (&optional (already-loaded nil) &AUX (NINTER 32.) stop-loc) stop-loc (DISABLE-LAMBDA) (if (not already-loaded) (FAST-LOAD-STRAIGHT-MAP)) (format t "~%...Loading A-mem and M-mem with constants~%") ;initialize A memory (DOTIMES (C NINTER) ;load a-mem with the results of 32 subtracts ;where we subtract a number with one bit set ;from all ones (WRITE-A-MEM (+ C 100) (LOGAND 37777777777 (MINUS (ASH 1 C))))) (WRITE-M-MEM 1 0) ;UP COUNTER (WRITE-M-MEM 2 0) ;DOWN COUNTER (WRITE-M-MEM 3 1) ;CONSTANT (WRITE-M-MEM 4 0) ;ZERO (write-m-mem 10 0) ;10 "POSITIVE" TEMP (ptemp) (write-m-mem 11 0) ;11 "NEGATIVE" TEMP (ntemp) (write-m-mem 12 0) ;12 USED FOR FINAL COMPARISION (- ntemp) (write-m-mem 13 0) ;13 SEED (WRITE-USP 0) ;initialize usp (cond ((not already-loaded) (format t "~%...Loading subtract-loop microcode~%") (ULOAD () 0 (LAM-IR-OP LAM-OP-JUMP ;stray transfer LAM-IR-JUMP-ADDR 0 LAM-IR-N 1 LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-HALT 1) (LAM-IR-OP LAM-OP-ALU) 2 (LAM-IR-OP LAM-OP-JUMP ;bad compare LAM-IR-JUMP-ADDR 2 LAM-IR-N 1 LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-HALT 1) (LAM-IR-OP LAM-OP-ALU) 10 (LAM-IR-OP LAM-OP-ALU ;start location LAM-IR-OB LAM-OB-ALU ;((1@m) add 1@m 3@a[1]) LAM-IR-M-SRC 1 LAM-IR-A-SRC 3 LAM-IR-ALUF LAM-ALU-ADD LAM-IR-M-MEM-DEST 1) (LAM-IR-OP LAM-OP-ALU ;((2@m) sub 2@m 3@a[1]) LAM-IR-OB LAM-OB-ALU LAM-IR-M-SRC 2 LAM-IR-A-SRC 3 LAM-IR-ALUF LAM-ALU-SUB LAM-IR-M-MEM-DEST 2) (LAM-IR-OP LAM-OP-JUMP ;jump to 20 LAM-IR-JUMP-ADDR 20 LAM-IR-N 1 LAM-IR-JUMP-COND LAM-JUMP-COND-UNC) (LAM-IR-OP LAM-OP-ALU) ) (LET ((C-MEM-ADR 20) (A-MEM-ADR 100)) ;why dont we use imod? (DOTIMES (C NINTER) (SETQ C-MEM-ADR (1+ (ULOAD (C-MEM-ADR A-MEM-ADR) C-MEM-ADR (LAM-IR-OP LAM-OP-ALU ;((10@m) setm 1@m) LAM-IR-OB LAM-OB-ALU LAM-IR-ALUF LAM-ALU-SETM LAM-IR-M-SRC 1 LAM-IR-M-MEM-DEST 10) (LAM-IR-OP LAM-OP-ALU ;((11@m) setm 2@m) LAM-IR-OB LAM-OB-ALU LAM-IR-ALUF LAM-ALU-SETM LAM-IR-M-SRC 2 LAM-IR-M-MEM-DEST 11) (lam-ir-op lam-op-alu ;((13@m) seta seed) lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-seta lam-ir-a-src a-mem-adr lam-ir-m-mem-dest 13) (LAM-IR-OP LAM-OP-ALU ;((10@m) add 10@m 13@a) LAM-IR-OB LAM-OB-ALU LAM-IR-ALUF LAM-ALU-ADD LAM-IR-M-SRC 10 LAM-IR-A-SRC 13 LAM-IR-M-MEM-DEST 10) (LAM-IR-OP LAM-OP-ALU ;((11@m) sub 11@m 13@a) LAM-IR-OB LAM-OB-ALU LAM-IR-ALUF LAM-ALU-SUB LAM-IR-M-SRC 11 LAM-IR-A-SRC 13 LAM-IR-M-MEM-DEST 11) (LAM-IR-OP LAM-OP-ALU ;((12@m) sub 4@m 11@a) LAM-IR-OB LAM-OB-ALU LAM-IR-ALUF LAM-ALU-SUB LAM-IR-M-SRC 4 ;0 LAM-IR-A-SRC 11 LAM-IR-M-MEM-DEST 12) (LAM-IR-OP LAM-OP-JUMP ;jump to error halt LAM-IR-JUMP-ADDR 2 LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A LAM-IR-M-SRC 12 LAM-IR-A-SRC 10 LAM-IR-N 1 LAM-IR-P 1) (LAM-IR-OP LAM-OP-ALU)))) (SETQ A-MEM-ADR (+ A-MEM-ADR 1))) ;increment a-mem loc (if (not already-loaded) (setq *saved-stop-loc-for-test-subtract-loop* (+ 1 c-mem-adr))) (ULOAD (C-MEM-ADR) C-MEM-ADR (LAM-IR-OP LAM-OP-JUMP ;jump 10... LAM-IR-JUMP-ADDR 10 LAM-IR-JUMP-COND LAM-JUMP-COND-UNC LAM-IR-N 1) (LAM-IR-OP LAM-OP-ALU))))) (format t "~%...Set processor to start at pc = 10~%") (SETUP-MACHINE-TO-START-AT 10) ;start at initial pop (LET ((LAM-NUMBER-OF-SAVED-OPCS 0)) (PROG (CHAR) (LAM-REGISTER-DEPOSIT RASA 10) (format t "~%.....Accelerate to warp speed, Mr. Sulu. ~ ~% ....Aye, Captain.~%") (LAM-REGISTER-DEPOSIT RAGO 0) L (COND ((SETQ CHAR (send terminal-io :tyi-no-hang)) (FORMAT T "~%ABORTING") (LAM-REGISTER-DEPOSIT RASTOP 0) (signal 'sys:abort :format-string "subtract test aborted.")) ((ZEROP (LAM-REGISTER-EXAMINE RAGO)) (GO X))) (PROCESS-SLEEP 10. "Subtract Test Wait") (GO L) X (LAM-REGISTER-DEPOSIT RASTOP 0) (RETURN (LIST (lam-register-examine rapc) ;stop-pc (READ-M-MEM 1) ;up-counter (READ-M-MEM 2) ;down-counter (read-m-mem 13) ;seed (read-m-mem 10) ;ptemp (read-m-mem 11) ;ntemp (read-m-mem 12) ;-ntemp *saved-stop-loc-for-test-subtract-loop* ;good stop location )))) ) (defun test-output-selector-shift () (test-data-path "alu-shift-left" 'alu-shift-left-actor 32.) (test-data-path "alu-shift-right" 'alu-shift-right-actor 31.)) (DEFSELECT (alu-shift-left-ACTOR) (:READ (ADDRESS) ADDRESS (READ-left-shifted)) (:WRITE (ADDRESS DATA) ADDRESS (write-before-left-shift DATA))) (defun read-left-shifted () (lam-execute (read) lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu-left-1 lam-ir-m-src lam-m-src-spy-reg lam-ir-aluf lam-alu-setm) (read-mfo)) (defun write-before-left-shift (data) (write-q-reg (ash data 37)) (write-spy-reg (ash data -1))) ;must setup the spy reg after the q ;as the q write uses the spy reg (DEFSELECT (alu-shift-right-ACTOR) ;for the moment, we only check 31 bits (:READ (ADDRESS) ADDRESS ;since i dont see an easy way to force (read-right-shifted)) ;alu.32 to the right value (:WRITE (ADDRESS DATA) ADDRESS (WRITE-before-right-shift DATA))) (defun read-right-shifted () (lam-execute (read) lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu-right-1 lam-ir-m-src lam-m-src-spy-reg lam-ir-aluf lam-alu-setm) (read-mfo)) (defun write-before-right-shift (data) (write-spy-reg (ash data 1)))