;;-*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*-
;;
;; (C) COPYRIGHT 1984,1985,1986 LISP MACHINE, INC
;;
;; MICRO-CODED tests of the LAMBDA processor, PART 1.
;; Only DEF-UTEST forms can be in this file, since it is translated into
;; "C" by the SDU-TRANSLATE-FILE function.
;; 1/11/84 10:07:43 -George Carrette.
;; The Lisp->C translation was generalized by MWT and myself to include
;; defun's of fixed numbers of arguments manipulating simple integer numeric
;; quantities and passing constant strings to functions such as FORMAT and FERROR.
;; 8/29/84 10:18:13 -GJC
(DEF-UTEST FLD-STRAIGHT-CAM "FAST LOAD STRAIGHT CRAM ADDRESS MAP"
:constants ((m-cam-adr 1)
(m-cam-data 7)
(m-temp 8.)
(m-last-loc 2)
(m-zero 3)
(m-parity-count 9.)
(m-shift 10.)
(m-sum 11.)
(m-data-width 12.)
(a-one 4)
(m-first-loc 5)
(M-CAM-READBACK 6)
)
:INPUT-VALUES (((M-MEM m-cam-adr) 7777) ;location to clobber
((M-MEM m-last-loc) 0) ;last locn to clobber.
((M-MEM m-zero) 0) ;constant for DPBing into
((m-mem a-one) 1) ;convenient 1 for increment and decrement
((m-mem m-first-loc) 7777);first location to clobber, last to check
((m-mem m-data-width) 10.))
:error-stops ((fc "failed check in readback loop"))
:START write-loop
:GOOD-STOP gs
:TIME-OUT 30.
:CODE (
write-loop
(lam-ir-op lam-op-jump
lam-ir-jump-cond lam-jump-cond-unc
lam-ir-jump-addr compute-parity
lam-ir-n 1
lam-ir-p 1)
(LAM-IR-OP LAM-OP-BYTE ;((oa-reg-low) dpb m-cam-adr oal-cram-page-number a-3)
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-DPB
LAM-IR-M-SRC m-cam-adr
LAM-IR-BYTL-1 11.
LAM-IR-MROT 18.
LAM-IR-A-SRC m-zero
LAM-IR-FUNC-DEST LAM-FUNC-DEST-IMOD-LOW)
(LAM-IR-OP LAM-OP-JUMP ;(call-xct-next 17)
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR 17
LAM-IR-P 1
LAM-IR-N 0)
(LAM-IR-POPJ-AFTER-NEXT 1 ;(popj-after-next (cram-adr-map) setm m-cam-adr)
LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC m-cam-data
LAM-IR-FUNC-DEST LAM-FUNC-DEST-CRAM-MAP
LAM-IR-SLOW-DEST 1)
(LAM-IR-OP LAM-OP-JUMP ;3 - we popj to here and check if we are done
LAM-IR-JUMP-COND LAM-JUMP-COND-M>A
LAM-IR-M-SRC m-cam-adr
LAM-IR-A-SRC m-last-loc
LAM-IR-JUMP-ADDR write-loop
LAM-IR-N 0)
(LAM-IR-OP LAM-OP-ALU ;4 - decrement the count
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SUB
LAM-IR-M-SRC m-cam-adr
LAM-IR-A-SRC a-one
LAM-IR-M-MEM-DEST m-cam-adr)
;;now run through from the bottom up to the top, checking the contents
;;of the map
check-loop
(lam-ir-op lam-op-jump
lam-ir-jump-cond lam-jump-cond-unc
lam-ir-jump-addr compute-parity
lam-ir-n 1
lam-ir-p 1)
(LAM-IR-OP LAM-OP-BYTE ;((oa-reg-low) dpb m-cam-adr oal-cram-page-number a-3)
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-DPB
LAM-IR-M-SRC m-cam-adr
LAM-IR-BYTL-1 11.
LAM-IR-MROT 18.
LAM-IR-A-SRC m-zero
LAM-IR-FUNC-DEST LAM-FUNC-DEST-IMOD-LOW)
(LAM-IR-OP LAM-OP-JUMP ;(call-xct-next 17)
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR 17
LAM-IR-P 1
LAM-IR-N 0)
(LAM-IR-POPJ-AFTER-NEXT 1 ;(pop-j-after-next)
LAM-IR-OP LAM-OP-byte ;
lam-ir-byte-func lam-byte-func-ldb ;READ BACK CONTENTS OF CAM
LAM-IR-bytl-1 11.
lam-ir-mrot 0.
lam-ir-a-src m-zero
LAM-IR-M-SRC LAM-M-SRC-CRAM-ADR-MAP
LAM-IR-M-MEM-DEST M-CAM-READBACK)
(LAM-IR-OP LAM-OP-JUMP ;jump to fails-check if contents of CAM
;expected data (address with parity)
LAM-IR-JUMP-COND LAM-JUMP-COND-m-neq-A
LAM-IR-M-SRC m-cam-readback
LAM-IR-JUMP-ADDR FAILS-CHECK
LAM-IR-A-SRC m-cam-data
lam-ir-n 1)
(LAM-IR-OP LAM-OP-JUMP ; check if we are done
LAM-IR-JUMP-COND LAM-JUMP-COND-MA
LAM-IR-M-SRC m-data-width
LAM-IR-A-SRC m-parity-count
LAM-IR-JUMP-ADDR parity-loop
LAM-IR-N 1)
(LAM-IR-OP LAM-OP-BYTE
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-ldb
LAM-IR-M-SRC m-cam-adr
LAM-IR-BYTL-1 9.
LAM-IR-MROT 0.
LAM-IR-A-SRC m-zero
LAM-IR-m-mem-DEST m-cam-data)
(LAM-IR-OP LAM-OP-BYTE
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-dpb
LAM-IR-M-SRC m-sum
LAM-IR-BYTL-1 0
LAM-IR-MROT 10.
LAM-IR-A-SRC m-cam-data
LAM-IR-m-mem-DEST m-cam-data)
(lam-ir-op lam-op-jump
lam-ir-jump-cond lam-jump-cond-unc
lam-ir-r 1
lam-ir-n 1)
(lam-ir-halt 1)
))
(DEF-UTEST HALT? "EXECUTE SOME NULL INSTUCTIONS AND THEN HALT"
:START 0
:GOOD-STOP 6
:TIME-OUT 2
:CODE (0
(LAM-IR-OP LAM-OP-ALU) ;0
(LAM-IR-OP LAM-OP-ALU) ;1
(LAM-IR-OP LAM-OP-ALU) ;2
(LAM-IR-OP LAM-OP-ALU) ;3
(LAM-IR-OP LAM-OP-ALU) ;4
(lam-ir-halt 1) ) ;5 PC will be at 6 when we stop
)
;; jump to 20 with next instruction nooped, put a halt after that to catch fall-throughs
;; at 20, put a jump to 40 where the previous instuction is a halt to catch randomness
;; and the subsequent instruction is not nooped. 40 is a good
;; stop. the test instructions modify locations in m-memory, so one should change and the
;; other should remain constant
(DEF-UTEST JUMP-NOOP? "UNCONDITIONAL JUMPS, BOTH XCT-NEXT AND DONT-XCT-NEXT"
:INPUT-VALUES (((M-MEM 1) 37777777777) ;EXPECT THIS TO STAY -1
((M-MEM 2) 37777777777) ;EXPECT THIS TO BE ZEROED
)
:OUTPUT-VALUES (((M-MEM 1) 37777777777 ("m-mem 1 altered, presumably zeroed by instruction"
"which should have been nooped"))
((M-MEM 2) 0 ("m-mem 2 not set to 0 : many possibilities, but"
"test is looking for jump failures or noop stuck on.")))
:START 0
:GOOD-STOP 41
:error-stops ((4 "probably fell through first jump")
(20 "at second jump by randomness")
(23 "probably fell through second jump")
(40 "randomly in front of good stop location"))
:TIME-OUT 2
:CODE (0
(LAM-IR-OP LAM-OP-JUMP ;(JUMP 20)
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR 20
LAM-IR-N 1)
(LAM-IR-OP LAM-OP-ALU ;ZERO M LOC 1 (ERROR IF THIS HAPPPENS)
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETZ
LAM-IR-M-MEM-DEST 1)
(LAM-IR-HALT 1) ;ERROR STOP FOR FALL THROUGHS
17
(LAM-IR-HALT 1) ;ERROR STOP TO PREVENT RANDOM JUMPS
;FROM WINNING BY ACCIDIENT
(LAM-IR-OP LAM-OP-JUMP ;(JUMP 40)
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR 40
LAM-IR-N 0)
(LAM-IR-OP LAM-OP-ALU ;ZERO M LOC 2 (ERROR UNLESS THIS HAPPENS)
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETZ
LAM-IR-M-MEM-DEST 2)
(LAM-IR-HALT 1) ;ANOTHER ERROR STOP FOR FALL THROUGHS
37
(LAM-IR-HALT 1) ;ANOTHER RANDOM JUMP ERROR STOP
40
(LAM-IR-HALT 1) ;GOOD STOP PC = 41
)
)
;; tests of push and pop.
;; the first contains part of the sequence used to write the cram and the
;; cram adr map where we call-xct-next to a location, but the subsequent instruction
;; is a popj-after-next. so we execute the called instruction and then resume at
;; at the third instruction. In the case of actually writing the CAM or CRAM, we
;; magically force noop-next, so that the bogus instruction fetched from the target
;; location nooped. For this diagnostic, lets have that instruction smash a m-mem
;; location, just to show that we were there
(DEF-UTEST CALL-POPJAN? "CALL-XCT-NEXT FOLLOWED BY POPJ AFTER NEXT"
:INPUT-VALUES (((M-MEM 1) 37777777777) ;EXPECT THIS TO BE ZEROED
)
:OUTPUT-VALUES (((M-MEM 1) 0 ("m-mem 1 not set to 0 : many possibilities, but"
"suspect failure to call to location 17 properly.")))
:START 0
:GOOD-STOP 41
:error-stops ((5 "probably fell through final location")
(17 "arrived at call location by randomness")
(21 "probably failed to popj")
(40 "randomly in front of good stop location"))
:TIME-OUT 2
:CODE (0
(LAM-IR-OP LAM-OP-JUMP ;(call-xct-next 17)
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR 17
LAM-IR-P 1
LAM-IR-N 0)
(LAM-IR-POPJ-AFTER-NEXT 1 ;(popj-after-next )
LAM-IR-OP LAM-OP-ALU)
(LAM-IR-OP LAM-OP-JUMP ;(JUMP 40) jump to good location
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR 40
LAM-IR-N 1)
(LAM-IR-OP LAM-OP-ALU) ;dummy instruction,nooped
(LAM-IR-HALT 1) ;ANOTHER ERROR STOP FOR FALL THROUGHS
16
(lam-ir-halt 1) ;ERROR STOP - PREVENTS RANDOMNESS
(LAM-IR-OP LAM-OP-ALU ;ZERO M LOC 1
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETZ
LAM-IR-M-MEM-DEST 1)
(LAM-IR-HALT 1) ;ERROR STOP - PROBABLY FAILED TO POPJ
37
(LAM-IR-HALT 1) ;ANOTHER RANDOM JUMP ERROR STOP
40
(LAM-IR-HALT 1) ;GOOD STOP PC = 41
)
)
(DEFUN FLD-STRAIGHT-MAP (&KEY &OPTIONAL
(N-L2-PAGES 4096.)
(L2-PAGE-OFFSET 0)
(L2C-CONTENTS 1400)
(REFLECTION-PHYSICAL-PAGE 0)
(INDEX (SEND *PROC* :MEM-SLOT)))
(LET* ((quad-slot (configuration-index-to-quad-slot index))
(BASE-PHYSICAL-PAGE (ash quad-slot 14.))) ;+24. to nubus-address, -10. to page.
(FLD-STRAIGHT-L1-AND-CHECK)
(FLD-SML2 0 N-L2-PAGES L2C-CONTENTS
(+ BASE-PHYSICAL-PAGE L2-PAGE-OFFSET)
REFLECTION-PHYSICAL-PAGE)))
(DEF-UTEST FLD-STRAIGHT-L1-AND-CHECK "LOAD THE L1 MAP WITH A STRAIGHT MAP AND VERIFY IT"
:initializers (SET-25-BIT-VIRTUAL-ADDRESS-MODE)
:postializers (CLEAR-25-BIT-VIRTUAL-ADDRESS-MODE) ;FOR NOW.
:CONSTANTS ((M-MAP-DATA 2)
(M-NUMBER-OF-LOC-USED 3)
(M-INCREMENT 4)
(M-FILLER 5)
(NUMBER-OF-LOC-IN-L1-MAP 6)
(M-ONE 7))
:INPUT-VALUES (((M-MEM M-MAP-DATA) 0) ;MAP DATA
((M-MEM M-NUMBER-OF-LOC-USED) 128.) ;NUMBER OF LOCATIONS USED
((M-MEM M-INCREMENT) 20000) ;INCREMENT MD BY THIS TO ADDRESS
;L1-MAP NEXT LOCATION
((M-MEM M-FILLER) 177) ;FILL UNUSED LOCATIONS WITH THIS
((M-MEM NUMBER-OF-LOC-IN-L1-MAP) 4096.) ;NUMBER OF LOCATIONS IN L1-MAP
((M-MEM M-ONE) 1)
(md 0))
:START WRITE-LEVEL-1-MAP-USED-LOCATIONS
:GOOD-STOP GOOD-STOP
:error-stops ((F-TO-C "failed check in readback loop"))
:TIME-OUT 10
:CODE (0
WRITE-LEVEL-1-MAP-USED-LOCATIONS ;((level-1-map) 2@M)
(LAM-IR-M-SRC M-MAP-DATA
lam-ir-op lam-op-alu
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-OB LAM-OB-ALU
LAM-IR-FUNC-DEST LAM-FUNC-DEST-L1-MAP
LAM-IR-SLOW-DEST 1)
(LAM-IR-OB LAM-OB-ALU ;((2@M) M+1 2@M) INCREMENT THE DATA
lam-ir-op lam-op-alu
LAM-IR-M-MEM-DEST M-MAP-DATA
LAM-IR-M-SRC M-MAP-DATA
LAM-IR-ALUF LAM-ALU-M+1)
(LAM-IR-OP LAM-OP-JUMP ;(JUMP-LESS-THAN-XCT-NEXT 2@M 3@A LOC)
LAM-IR-M-SRC M-MAP-DATA ;LOOP UNTIL ALL USED LOCATIONS ARE WRITTEN
LAM-IR-A-SRC M-NUMBER-OF-LOC-USED
LAM-IR-JUMP-COND LAM-JUMP-COND-M=A
LAM-IR-JUMP-ADDR READ-BACK-FILLER-TILL-USED-LOCATIONS
LAM-IR-N 0)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC LAM-M-SRC-MD
lam-ir-a-src m-increment
LAM-IR-ALUF LAM-ALU-SUB
LAM-IR-FUNC-DEST LAM-FUNC-DEST-MD)
;;now we should see that the contents of the m-map-data is the same as the
;;contents of the level 1 map
READ-BACK-M-MAP-DATA-FROM-LEVEL-1-MAP
(LAM-IR-OP LAM-OP-ALU) ;ALLOW MAP TO SETTLE AFTER MD CHANGED.
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-M-SRC LAM-M-SRC-L1-MAP
LAM-IR-A-SRC M-MAP-DATA
LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
LAM-IR-JUMP-ADDR FAILED-TO-CHECK
LAM-IR-N 1)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-MAP-DATA
LAM-IR-A-SRC M-ONE
LAM-IR-ALUF LAM-ALU-sub
LAM-IR-M-MEM-DEST M-MAP-DATA)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-M-SRC M-MAP-DATA
LAM-IR-A-SRC M-ONE
LAM-IR-JUMP-COND LAM-JUMP-COND-M>=A
LAM-IR-JUMP-ADDR READ-BACK-M-MAP-DATA-FROM-LEVEL-1-MAP
LAM-IR-N 0)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC LAM-M-SRC-MD
lam-ir-a-src m-increment
LAM-IR-ALUF LAM-ALU-SUB
LAM-IR-FUNC-DEST LAM-FUNC-DEST-MD)
(LAM-IR-HALT 1)
GOOD-STOP ;stop here if we win
( LAM-IR-HALT 1)
FAILED-TO-CHECK
(LAM-IR-HALT 1)
F-TO-C
(LAM-IR-HALT 1)
))
;assumes first level map set up.
(def-utest FLD-SML2 "FAST-LOAD-STRAIGHT-MAP-LEVEL-2 and verify it"
:arguments (FIRST-PAGE N-PAGES DATA-CONTROL DATA-PHYSICAL-PAGE REFLECTION-PHYSICAL-PAGE)
:constants ((M-A 5) (M-B 6) (M-C 7) (M-D 10) (M-E 11) (M-F 12) (M-ONE 13) (M-TEM 14)
(M-ZERO 15))
:input-values (((m-mem m-a) 'DATA-CONTROL) ;
((m-mem m-b) 'DATA-PHYSICAL-PAGE) ; incremented each time around loop
((m-mem m-c) (ash 1 8.)) ; map address increment
((m-mem m-d) 0) ; COUNT
((m-mem m-e) 'N-PAGES) ;
((M-MEM M-F) 'REFLECTION-PHYSICAL-PAGE) ;XORed each time
((M-MEM M-ONE) 1)
((M-MEM M-TEM) 0)
((M-MEM M-ZERO) 0)
(md '(ash first-page 8.))
)
:time-out 10
:good-stop GOOD-STOP
:error-stops ((L2C-F-C "L2C failed check in readback loop")
(L2P-F-C "L2P failed check in readback loop"))
:start loc
:code (0
LOC
(LAM-IR-OP LAM-OP-ALU) ;GIVE IT EXTRA TIME TO SETTLE.
(LAM-IR-M-SRC M-A ;((LEVEL-2-MAP-CONTROL) M-a)
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-OB LAM-OB-ALU
LAM-IR-FUNC-DEST LAM-FUNC-DEST-L2-MAP-CONTROL
LAM-IR-SLOW-DEST 1)
(LAM-IR-M-SRC M-B ;((LEVEL-2-MAP-PHYSICAL-PAGE) XOR M-B A-F)
LAM-IR-A-SRC M-F
LAM-IR-ALUF LAM-ALU-XOR
LAM-IR-OB LAM-OB-ALU
LAM-IR-FUNC-DEST LAM-FUNC-DEST-L2-MAP-PHYSICAL-PAGE
LAM-IR-SLOW-DEST 1)
(LAM-IR-OB LAM-OB-ALU ;((M-B) M+1 M-B) -data
LAM-IR-M-MEM-DEST M-B
LAM-IR-M-SRC M-B
LAM-IR-ALUF LAM-ALU-M+1)
(LAM-IR-OB LAM-OB-ALU ;((M-D) M+1 M-D) -count
LAM-IR-M-MEM-DEST M-D
LAM-IR-M-SRC M-D
LAM-IR-ALUF LAM-ALU-M+1)
(LAM-IR-OP LAM-OP-JUMP ;(JUMP-LESS-THAN-XCT-NEXT M-D A-E LOC)
LAM-IR-M-SRC M-D
LAM-IR-A-SRC M-E
LAM-IR-JUMP-COND LAM-JUMP-COND-MA
LAM-IR-JUMP-ADDR CHECK-LOOP
LAM-IR-N 1)
(LAM-IR-HALT 1)
GOOD-STOP ;note tag comes after instruction to which it refers.
L2C-FAILED-TO-CHECK
(LAM-IR-HALT 1)
L2C-F-C
L2P-FAILED-TO-CHECK
(LAM-IR-HALT 1)
L2P-F-C
(LAM-IR-OP LAM-OP-ALU)
))
;;
;; the following function is to make sure that the stack is set to zero
;;
(DEF-UTEST clear-micro-stack "CLEAR MICRO STACK"
:constants ((m-count 1)
(a-zero 2)
(a-last 4)
)
:INPUT-VALUES (((M-MEM m-count) 0) ;location to clobber
((M-MEM a-zero) 0) ;value to push in the stack
((M-MEM a-last) 256.) ;number of pushes to do
)
:START init-stack-pointer
:GOOD-STOP gs
:TIME-OUT 2
:CODE (
init-stack-pointer
(lam-ir-op lam-op-alu
lam-ir-ob lam-ob-alu
lam-ir-a-src a-zero
lam-ir-m-src lam-m-src-micro-stack-pop
lam-ir-func-dest lam-func-dest-micro-stack-pointer-if-pop
lam-ir-aluf lam-alu-seta)
zero-loop
(lam-ir-op lam-op-alu
lam-ir-ob lam-ob-alu
lam-ir-a-src a-zero
lam-ir-func-dest lam-func-dest-micro-stack-push
lam-ir-aluf lam-alu-seta)
(lam-ir-op lam-op-alu
lam-ir-ob lam-ob-alu
lam-ir-m-src m-count
lam-ir-m-mem-dest m-count
lam-ir-aluf lam-alu-m+1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-M-neq-A
LAM-IR-M-SRC m-count
LAM-IR-A-SRC a-last
LAM-IR-JUMP-ADDR zero-loop
LAM-IR-N 1)
(lam-ir-halt 1)
gs
(lam-ir-halt 1)))
(DEF-UTEST FAST-CLEAR-MID "CLEAR MID MEMORY"
:CONSTANTS ((M-MID-ADDRESS 1)
(M-DATA 2)
(M-MID-SIZE 3)
(M-ZERO 4)
(m-increment 5)
(m-count 6))
:INPUT-VALUES (((M-MEM M-MID-ADDRESS) 0)
((M-MEM M-ZERO) 0)
((M-MEM M-MID-SIZE) 4096.)
((m-mem m-increment) 100)
((m-mem m-count) 0))
:START ZERO-MID-RAM
:GOOD-STOP GC
:TIME-OUT 2
:CODE (0
ZERO-MID-RAM
;((MD) DPB M-MID-ADDRESS (BYTE-FIELD 20 20) A-MID-ADDRESS)
(LAM-IR-OP LAM-OP-BYTE
LAM-IR-BYTL-1 17
LAM-IR-MROT 20
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-DPB
LAM-IR-A-SRC M-mid-address
LAM-IR-M-SRC M-MID-ADDRESS
LAM-IR-FUNC-DEST LAM-FUNC-DEST-MD
LAM-IR-SLOW-DEST 1)
;((M-DATA) 0)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-A-SRC M-ZERO
LAM-IR-ALUF LAM-ALU-SETA
LAM-IR-M-MEM-DEST M-DATA)
;(SOURCE-TO-MACRO-IR SETM MD)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC LAM-M-SRC-MD
LAM-IR-SOURCE-TO-MACRO-IR 1
LAM-IR-SLOW-DEST 1)
;((MACRO-IR-DECODE) M-DATA)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC M-DATA
LAM-IR-FUNC-DEST LAM-FUNC-DEST-MID
LAM-IR-SLOW-DEST 1)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-MID-ADDRESS
lam-ir-a-src m-increment
LAM-IR-M-MEM-DEST M-MID-ADDRESS
LAM-IR-ALUF LAM-ALU-add)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-count
LAM-IR-M-MEM-DEST M-count
LAM-IR-ALUF LAM-ALU-m+1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-M=1, and SETM otherwise. This is used in combination with
;;SHIFT-Q-RIGHT and OUTPUT-SELECTOR-RIGHTSHIFT-1. Initially the multiplicand
;;is placed in an A-scratchpad location and the multiplier is placed in Q.
;;32 MULTIPLY-STEP operations are executed; as Q shifts to the right each of
;;the bits of the multiplier appear in Q<0>. If the bit is 1, the multiplicand
;;gets added in. The results of each operation go into an M-scratchpad location,
;;which is fed back into the next step. The low bit of each result is shifted
;;into Q. Thus, when the 32 steps have been completed, the Q contains the low
;;32 bits of the product, and the M-scratchpad location contains the high 32 bits.
;; This algorithm needs a slight modification to deal with 2's complement
;;numbers. The sign bit of a 2's complement number has negative weight, so
;;in the last step if Q<0>=1, i.e. the multiplier is negative, a subtraction
;;should be done instead of an addition. The hardware does not provide this,
;;so instead we do a subtraction after the last step, which is
;;adding and then subtracting twice as much, which has the effect of subtracting.
;;Note that this correction only affects the high 32 bits of the product,
;;and can be omitted if we are only looking for a single-precision result.
;;Consider the following code.
;;
;;
;;
;;
;;
;;; Multiply Subroutine. A-MPYR times Q-R, low product to Q-R, high to M-AC.
;;
;;MPY ((M-AC) MULTIPLY-STEP M-ZERO A-MPYR) ;Partial result = 0 in first step
;;(REPEAT 30. ((M-AC) MULTIPLY-STEP M-AC A-MPYR)) ;Do 30 steps
;; (POPJ-IF-BIT-CLEAR-XCT-NEXT ;Return after next if A-MPYR positive
;; (BYTE-FIELD 1 0) Q-R)
;; ((M-AC) MULTIPLY-STEP M-AC A-MPYR) ;The final step
;;
;;
;; (NO-OP) ;Jump delay
;;
;;
;; To multiply numbers of less than 32 bits is also possible. With
;;the same initial conditions, after n steps the high n bits of the Q
;;contain the low n bits of the product, and the remaining bits of the
;;product are in the low bits of the M-scratchpad location. Two BYTE
;;instructions can be used to extract and combine these bits to produce
;;a right-adjusted product, if the numbers are unsigned.
;;
;; this test multiplies 16 bit unsigned numbers, a floating ones times floating ones.
;; it multiplies both in the old style, shift and add, and new style, using the
;; matrix multiplier. because we don't care how fast the old style runs in this
;; case, we do it as a loop, making the code compact and faster to load
(def-utest multiply-16-test "multiplying 16 bits unsigned numbers"
:CONSTANTS ((M-MULTIPLICAND 2)
(M-MULTIPLIER 3)
(M-RESULT 4)
(M-ZERO 5)
(M-ONES 6)
(M-FACTOR 7)
(M-BITS-OVER 8)
(M-OTHER-FACTOR 9)
(M-ZEROS-OR-ONES 10.)
(M-OTHER-RESULT 11.)
(M-16-TIMES 12.)
(M-COUNT 13.)
(M-MASK 14.)
(M-MULT 15.)
(M-ONE 16.)
(M-BITS-OVER-FOR-OTHER-FACTOR 17.)
(M-32-TIMES 18.))
:INPUT-VALUES (((M-MEM M-ZERO) 0)
((M-MEM M-ONES) -1)
((M-MEM M-OTHER-FACTOR) 1)
((M-MEM M-16-TIMES) 16.)
((M-MEM M-MASK) 177777)
((M-MEM M-ONE) 1)
((M-MEM M-32-TIMES) 32.))
:ERROR-STOPS ((NT-EQ-WI-OLD-STY-MULT "FAILED TO CHECK WITH OLD STYLE MULTIPLY")
(NT-EQ-WN-SWA "FAILED TO CHECK FOR COMMUTIVITY OF MULTIPLICATION"))
:START MULTIPLY
:GOOD-STOP GS
:TIME-OUT 10.
:CODE (0
MULTIPLY
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-OTHER-FACTOR
LAM-IR-M-SRC M-ONE
LAM-IR-ALUF LAM-ALU-SETM)
;THIS PART WILL DO FLOATING ONES BY 1.
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-ONES
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-BITS
LAM-IR-N 1
LAM-IR-P 1)
;THIS PART WILL DO FLOATTING ZEROS BY 1.
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-ZEROS
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-BITS
LAM-IR-N 1
LAM-IR-P 1)
;;FLOATING-ZEROS BY FLOATING-ZEROS
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-ALUF LAM-ALU-SETZ)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-ZEROS
LAM-IR-N 1
LAM-IR-P 1)
FLOATING-ZEROS-BY-FLOATING-ZEROS
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR BUILD-OTHER-FACTOR
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-BITS
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-ADDR FLOATING-ZEROS-BY-FLOATING-ZEROS
LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
LAM-IR-M-SRC M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-A-SRC M-16-TIMES
LAM-IR-N 1)
;FLOATING-ONES BY FLOATING-ONES
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-ALUF LAM-ALU-SETZ)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-ONES
LAM-IR-N 1
LAM-IR-P 1)
FLOATING-ONES-BY-FLOATING-ONES
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR BUILD-OTHER-FACTOR
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-BITS
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-ADDR FLOATING-ONES-BY-FLOATING-ONES
LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
LAM-IR-M-SRC M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-A-SRC M-16-TIMES
LAM-IR-N 1)
;; this part now will do floating-zeros by floating-ones and vice versa
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-ALUF LAM-ALU-SETZ)
FLOATING-ONES-BY-FLOATING-ZEROS
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-ONES
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR BUILD-OTHER-FACTOR
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-ZEROS
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR FLOATING-BITS
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-ADDR FLOATING-ONES-BY-FLOATING-ZEROS
LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
LAM-IR-M-SRC M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-A-SRC M-16-TIMES
LAM-IR-N 1)
(LAM-IR-HALT 1)
GS
(LAM-IR-HALT 1)
BUILD-OTHER-FACTOR
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-BITS-OVER
LAM-IR-M-SRC M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-ALUF LAM-ALU-SETM)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR BUILD-FACTOR
LAM-IR-N 0
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-M-MEM-DEST M-BITS-OVER-FOR-OTHER-FACTOR
LAM-IR-ALUF LAM-ALU-M+1)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-MULTIPLICAND
LAM-IR-M-MEM-DEST M-OTHER-FACTOR
LAM-IR-ALUF LAM-ALU-SETM)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-R 1
LAM-IR-N 1)
(LAM-IR-HALT 1)
FLOATING-ZEROS
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC M-ONES
LAM-IR-M-MEM-DEST M-FACTOR)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC M-ZERO
LAM-IR-M-MEM-DEST M-ZEROS-OR-ONES)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-R 1
LAM-IR-N 1)
(LAM-IR-HALT 1)
FLOATING-ONES
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC M-ZERO
LAM-IR-M-MEM-DEST M-FACTOR)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC M-ONES
LAM-IR-M-MEM-DEST M-ZEROS-OR-ONES)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-R 1
LAM-IR-N 1)
(LAM-IR-HALT 1)
FLOATING-BITS
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-BITS-OVER
LAM-IR-ALUF LAM-ALU-SETZ)
FLOATING-BITS-LOOP
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-MULTIPLIER
LAM-IR-M-SRC M-OTHER-FACTOR
LAM-IR-ALUF LAM-ALU-SETM)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR BUILD-FACTOR ;GETS THE NEXT MULTIPLICAND
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR MULTIPLY-FUNCTION
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-RESULT
LAM-IR-M-MEM-DEST M-OTHER-RESULT
LAM-IR-ALUF LAM-ALU-SETM)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-MULTIPLIER
LAM-IR-M-SRC M-MULTIPLICAND
LAM-IR-ALUF LAM-ALU-SETM)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-MULTIPLICAND
LAM-IR-M-SRC M-OTHER-FACTOR
LAM-IR-ALUF LAM-ALU-SETM)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR MULTIPLY-FUNCTION
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
LAM-IR-JUMP-ADDR NOT-EQUAL-WHEN-SWAPPED
LAM-IR-M-SRC M-RESULT
LAM-IR-A-SRC M-OTHER-RESULT
LAM-IR-N 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-JUMP-ADDR OLD-STYLE-MULTIPLY
LAM-IR-N 1
LAM-IR-P 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
LAM-IR-JUMP-ADDR NOT-EQUAL-WITH-OLD-STYLE-MULTIPLY
LAM-IR-M-SRC M-RESULT
LAM-IR-A-SRC M-OTHER-RESULT
LAM-IR-N 1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
LAM-IR-JUMP-ADDR FLOATING-BITS-LOOP
LAM-IR-M-SRC M-BITS-OVER
LAM-IR-A-SRC M-16-TIMES
LAM-IR-N 0)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-BITS-OVER
LAM-IR-M-SRC M-BITS-OVER
LAM-IR-ALUF LAM-ALU-M+1)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-R 1
LAM-IR-N 1)
(LAM-IR-HALT 1)
NOT-EQUAL-WHEN-SWAPPED
(LAM-IR-HALT 1)
NT-EQ-WN-SWA
(LAM-IR-HALT 1)
NOT-EQUAL-WITH-OLD-STYLE-MULTIPLY
(LAM-IR-HALT 1)
NT-EQ-WI-OLD-STY-MULT
(LAM-IR-HALT 1)
BUILD-FACTOR
(LAM-IR-OP LAM-OP-BYTE
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-DPB
LAM-IR-M-SRC M-BITS-OVER
LAM-IR-BYTL-1 5.
LAM-IR-MROT 0.
LAM-IR-A-SRC M-ZERO
LAM-IR-FUNC-DEST LAM-FUNC-DEST-IMOD-LOW)
(LAM-IR-OP LAM-OP-BYTE
LAM-IR-OB LAM-OB-ALU
LAM-IR-A-SRC M-FACTOR
LAM-IR-M-SRC M-ZEROS-OR-ONES
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-DPB
LAM-IR-BYTL-1 0
LAM-IR-M-MEM-DEST M-MULTIPLICAND)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-R 1
LAM-IR-N 1)
(LAM-IR-HALT 1)
MULTIPLY-FUNCTION
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-MULT
LAM-IR-ALUF LAM-ALU-SETZ)
(LAM-IR-OP LAM-OP-BYTE
LAM-IR-OB LAM-OB-ALU
LAM-IR-A-SRC M-MULT
LAM-IR-M-SRC M-MULTIPLICAND
LAM-IR-OB LAM-OB-MSK
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-DPB
LAM-IR-BYTL-1 15.
LAM-IR-MROT 0
LAM-IR-M-MEM-DEST M-MULT) ;variable to use in the new multiplier.
(LAM-IR-OP LAM-OP-BYTE
LAM-IR-OB LAM-OB-ALU
LAM-IR-A-SRC M-MULT
LAM-IR-M-SRC M-MULTIPLIER
LAM-IR-OB LAM-OB-MSK
LAM-IR-BYTE-FUNC LAM-BYTE-FUNC-DPB
LAM-IR-BYTL-1 15.
LAM-IR-MROT 16.
LAM-IR-M-MEM-dest M-MULT)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-FUNC-DEST LAM-FUNC-DEST-MULTIPLIER
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC M-MULT) ;THIS LOADS THE MULTIPLIER
(LAM-IR-OP LAM-OP-ALU ;THIS INSTRUCTION IS ADDED BECAUSE
LAM-IR-OB LAM-OB-ALU ;THE MULTIPLICATION NEEDS
LAM-IR-FUNC-DEST LAM-FUNC-DEST-MULTIPLIER
;ANOTHER CLOCK TO CLOCK THE DATA
;TO THE OUTPUT REGISTER
LAM-IR-ALUF LAM-ALU-SETM ;SOMETHING IS SCREWY WITH
LAM-IR-M-SRC M-MULT) ;SOURCE-FT, SO WE DONT USE IT
(lam-ir-op lam-op-alu)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC LAM-M-SRC-MULTIPLIER
LAM-IR-M-MEM-DEST M-RESULT
LAM-IR-ALUF LAM-ALU-SETM)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-R 1
LAM-IR-N 1)
(LAM-IR-HALT 1)
OLD-STYLE-MULTIPLY
;this is only for 16 bit numbers.
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-MULTIPLIER
LAM-IR-A-SRC M-MASK
LAM-IR-ALUF LAM-ALU-AND ;put the multiplier in q-reg
LAM-IR-Q LAM-Q-LOAD)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-MULT
LAM-IR-M-SRC M-MULTIPLICAND ;makes sure that the high byte is 0
LAM-IR-A-SRC M-MASK
LAM-IR-ALUF LAM-ALU-AND)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-MEM-DEST M-COUNT
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC M-ONE)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU-RIGHT-1
LAM-IR-Q LAM-Q-RIGHT
LAM-IR-M-SRC M-ZERO
LAM-IR-A-SRC M-MULT
LAM-IR-M-MEM-DEST M-RESULT ;first time around the variable used as
LAM-IR-ALUF LAM-ALU-MSTEP) ; partial result should be equal to 0
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-COUNT
LAM-IR-M-MEM-DEST M-COUNT
LAM-IR-ALUF LAM-ALU-M+1)
OLD-STYLE-MULTIPLY-LOOP
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU-RIGHT-1
LAM-IR-Q LAM-Q-RIGHT
LAM-IR-M-SRC M-RESULT
LAM-IR-A-SRC M-MULT
LAM-IR-M-MEM-DEST M-RESULT
LAM-IR-ALUF LAM-ALU-MSTEP)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
LAM-IR-JUMP-ADDR OLD-STYLE-MULTIPLY-LOOP
LAM-IR-M-SRC M-COUNT
LAM-IR-A-SRC M-32-TIMES
LAM-IR-N 0)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC M-COUNT
LAM-IR-M-MEM-DEST M-COUNT
LAM-IR-ALUF LAM-ALU-M+1)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC LAM-M-SRC-Q
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-MEM-DEST M-RESULT)
(LAM-IR-OP LAM-OP-JUMP
LAM-IR-JUMP-COND LAM-JUMP-COND-UNC
LAM-IR-R 1
LAM-IR-N 1)
(LAM-IR-HALT 1)))
(DEFUN MULTIPLY-16-LOOP (&optional (DATA1 0)(data2 377777))
(DISABLE-LAMBDA)
(WIPE-M-MEM)
(WRITE-M-MEM 2 DATA1)
(write-m-mem 5 data2)
(ULOAD ()
0
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-FUNC-DEST LAM-FUNC-DEST-MULTIPLIER
LAM-IR-ALUF LAM-ALU-SETM
LAM-IR-M-SRC 2) ;THIS LOADS THE MULTIPLIER
(LAM-IR-OP LAM-OP-ALU ;THIS INSTRUCTION IS ADDED BECAUSE
LAM-IR-OB LAM-OB-ALU ;THE MULTIPLICATION NEEDS
LAM-IR-FUNC-DEST LAM-FUNC-DEST-MULTIPLIER
;ANOTHER CLOCK TO CLOCK THE DATA
;TO THE OUTPUT REGISTER
LAM-IR-ALUF LAM-ALU-SETM ;SOMETHING IS SCREWY WITH
LAM-IR-M-SRC 5) ;SOURCE-FT, SO WE DONT USE IT
; (lam-ir-op lam-op-alu)
(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-MULTIPLIER
LAM-IR-M-MEM-DEST 3
LAM-IR-ALUF LAM-ALU-SETM)
; (lam-ir-op lam-op-alu)
(LAM-IR-OP LAM-OP-ALU
LAM-IR-OB LAM-OB-ALU
LAM-IR-M-SRC LAM-M-SRC-MULTIPLIER
LAM-IR-M-MEM-DEST 1
LAM-IR-ALUF LAM-ALU-SETM)
(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)
)
(SETUP-MACHINE-TO-START-AT 0))