;;; CADR Main Memory Test Microcode.			-*-Fundamental-*-

(SETQ MMTEST '(

(LOCALITY M-MEM)

M-GARBAGE	(0)
M-HUNOZ		(0)
M-ZERO		(0)
M-ONES		(0)

M-A		(0)
M-B		(0)
M-C		(0)
M-D		(0)
M-S		(0)

M-1	(0)
M-2	(0)

M-LOOP-COUNT	(0)

(LOCALITY A-MEM)

A-GARBAGE	(0)
A-HUNOZ		(0)
A-ZERO		(0)
A-ONES		(0)

A-A		(0)
A-B		(0)
A-C		(0)
A-D		(0)
A-S		(0)

A-1	(0)
A-2	(0)

A-LOOP-COUNT	(0)

(LOC 40)

A-TEM1			(0)
A-TEM2			(0)
A-TEM3			(0)

A-MAIN-MEMORY-SIZE	(0)

(LOCALITY I-MEM)
(LOC 6)
I-MEM-LOC-6			;Define this symbol.
	(JUMP-NOT-EQUAL-XCT-NEXT Q-R A-ZERO I-MEM-LOC-6) ;This code also appears in the RAM
       ((Q-R) ADD Q-R A-ONES)
I-MEM-LOC-10
	(JUMP HALT-CONS I-MEM-LOC-10)	;Foo, should be in RAM by now
    (ERROR-TABLE FAILED-TO-JUMP-INTO-RAM)

(LOC 100) 

BEG	(JUMP GO)

;;; Error halts:
;;; Put a NO-OP before each error halt so that they will be at even addresses
;;; and the 2 possible values in the PC lights will agree except for the low bit.

	(NO-OP)
ERROR-BAD-BIT
	(JUMP HALT-CONS ERROR-BAD-BIT)
    (ERROR-TABLE ERROR-BAD-BIT)

	(NO-OP)
ERROR-ADD-LOSES
	(JUMP HALT-CONS ERROR-ADD-LOSES)
    (ERROR-TABLE ERROR-ADD-LOSES)

	(NO-OP)
ERROR-A-MEM
	(JUMP HALT-CONS ERROR-A-MEM)
    (ERROR-TABLE ERROR-A-MEM)

	(NO-OP)
ERROR-M-MEM
	(JUMP HALT-CONS ERROR-M-MEM)
    (ERROR-TABLE ERROR-M-MEM)

	(NO-OP)
ERROR-LEVEL-1-MAP
	(JUMP HALT-CONS ERROR-LEVEL-1-MAP)
    (ERROR-TABLE ERROR-LEVEL-1-MAP)

	(NO-OP)
ERROR-PAGE-FAULT
	(JUMP HALT-CONS ERROR-PAGE-FAULT)
    (ERROR-TABLE ERROR-PAGE-FAULT)

	(NO-OP)
ERROR-BAD-LABEL
	(JUMP HALT-CONS ERROR-BAD-LABEL)
    (ERROR-TABLE ERROR-BAD-LABEL)

	(NO-OP)
ERROR-NO-MICR
	(JUMP HALT-CONS ERROR-NO-MICR)
    (ERROR-TABLE ERROR-NO-MICR)

	(NO-OP)
ERROR-BAD-SECTION-TYPE
	(JUMP HALT-CONS ERROR-BAD-SECTION-TYPE)
    (ERROR-TABLE ERROR-BAD-SECTION-TYPE)

	(NO-OP)
ERROR-BAD-ADDRESS
	(JUMP HALT-CONS ERROR-BAD-ADDRESS)
    (ERROR-TABLE ERROR-BAD-ADDRESS)

	(NO-OP)
ERROR-END-OF-PARTITION
	(JUMP HALT-CONS ERROR-END-OF-PARTITION)
    (ERROR-TABLE ERROR-END-OF-PARTITION)

	(NO-OP)
ERROR-DISK-ERROR
	(JUMP HALT-CONS ERROR-DISK-ERROR)
    (ERROR-TABLE ERROR-DISK-ERROR)

	(NO-OP)
ERROR-DIVIDE-BY-ZERO
	(JUMP HALT-CONS ERROR-DIVIDE-BY-ZERO)
    (ERROR-TABLE ERROR-DIVIDE-BY-ZERO)

	(NO-OP)
ERROR-PDL-BUFFER
	(JUMP HALT-CONS ERROR-PDL-BUFFER)
    (ERROR-TABLE ERROR-PDL-BUFFER)

	(NO-OP)
ERROR-PDL-BUFFER-POINTER
	(JUMP HALT-CONS ERROR-PDL-BUFFER-POINTER)
    (ERROR-TABLE ERROR-PDL-BUFFER-POINTER)

;;; Program starts here.  Create M-ZERO and M-ONES, and check the hardware a little.
GO	((M-ZERO Q-R) SETZ)		;Make all zeros.  Result to Q-R, not to depend on M mem

	(JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 1) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 2) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 3) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 4) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 5) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 6) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 7) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 10) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 11) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 12) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 13) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 14) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 15) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 16) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 17) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 20) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 21) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 22) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 23) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 24) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 25) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 26) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 27) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 30) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 31) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 32) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 33) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 34) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 35) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 36) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 37) Q-R ERROR-BAD-BIT)

	((M-ONES Q-R) SETO)		;Make all ones, in Q-R not to trust M Mem
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 0) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 1) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 2) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 3) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 4) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 5) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 6) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 7) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 10) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 11) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 12) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 13) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 14) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 15) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 16) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 17) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 20) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 21) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 22) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 23) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 24) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 25) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 26) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 27) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 30) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 31) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 32) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 33) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 34) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 35) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 36) Q-R ERROR-BAD-BIT)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 37) Q-R ERROR-BAD-BIT)
;;; ALU and Shifter don't drop or pick bits.
;;; Test M-mem, A-mem, and M=A logic
	(JUMP-NOT-EQUAL Q-R A-ONES ERROR-A-MEM)
	(JUMP-NOT-EQUAL M-ONES A-ONES ERROR-M-MEM)
	((Q-R) SETZ)
	(JUMP-NOT-EQUAL Q-R A-ZERO ERROR-A-MEM)
	(JUMP-NOT-EQUAL M-ZERO A-ZERO ERROR-M-MEM)
;;; See if all carries in ALU really carry.
	((Q-R) ADD M-ONES A-ZERO ALU-CARRY-IN-ONE)
	(JUMP-NOT-EQUAL Q-R A-ZERO ERROR-ADD-LOSES)
;;; Another simple carry test
	((Q-R) ADD M-ONES A-ONES)
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R ERROR-ADD-LOSES)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 1) Q-R ERROR-ADD-LOSES)
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 37) Q-R ERROR-ADD-LOSES)
;;; Prepare to test pdl buffer.  Care required since no pass-around path.
	((C-PDL-BUFFER-POINTER-PUSH) M-ZERO)
	((C-PDL-BUFFER-POINTER-PUSH) M-ONES)
;;; This verifies that -1 + -1 is -2 and also tests the byte hardware a little
	((MD) (BYTE-FIELD 37 1) Q-R A-ONES)
	(JUMP-NOT-EQUAL MD A-ONES ERROR-ADD-LOSES)
;;; Foo, the byte hardware could be tested a little bit better than that!
	(JUMP-NOT-EQUAL C-PDL-BUFFER-POINTER-POP A-ONES ERROR-PDL-BUFFER)
	(JUMP-NOT-EQUAL C-PDL-BUFFER-POINTER-POP A-ZERO ERROR-PDL-BUFFER)

;PDL-BUFFER-TIMING-TEST
	((M-LOOP-COUNT) (A-CONSTANT 20000))
PT0	((M-A) A-ONES)
	(CALL WIPE-PDL-BUFFER)
	((M-A) (A-CONSTANT -2))
(REPEAT 40 
	((PDL-BUFFER-INDEX) (A-CONSTANT 1252))
	((C-PDL-BUFFER-INDEX) M-A)
	((PDL-BUFFER-INDEX) (A-CONSTANT 525))
	((PDL-BUFFER-INDEX) (A-CONSTANT 1252))
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 REPEAT-COUNT) C-PDL-BUFFER-INDEX ERROR-PDL-BUFFER)
	((M-A) DPB M-A (BYTE-FIELD 37 1) A-ONES)  ;EFFECTIVELY ROT M-A BY ONE
)
	((PDL-BUFFER-INDEX) (A-CONSTANT 1252))
	((C-PDL-BUFFER-INDEX) A-ONES)	;FIX PDL BUFFER BACK TO ALL ONES
	((M-A) (A-CONSTANT -2))		;DO IT AGAIN WITH ADDRESS BITS ALTERNATE WAY
(REPEAT 40 
	((PDL-BUFFER-INDEX) (A-CONSTANT 525))
	((C-PDL-BUFFER-INDEX) M-A)
	((PDL-BUFFER-INDEX) (A-CONSTANT 1252))
	((PDL-BUFFER-INDEX) (A-CONSTANT 525))
	(JUMP-IF-BIT-SET (BYTE-FIELD 1 REPEAT-COUNT) C-PDL-BUFFER-INDEX ERROR-PDL-BUFFER)
	((M-A) DPB M-A (BYTE-FIELD 37 1) A-ONES)  ;EFFECTIVELY ROT M-A BY ONE
)

	((M-A) A-ZERO)
	(CALL WIPE-PDL-BUFFER)
	((M-A) (A-CONSTANT 1))
(REPEAT 40 
	((PDL-BUFFER-INDEX) (A-CONSTANT 1252))
	((C-PDL-BUFFER-INDEX) M-A)
	((PDL-BUFFER-INDEX) (A-CONSTANT 525))
	((PDL-BUFFER-INDEX) (A-CONSTANT 1252))
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 REPEAT-COUNT) C-PDL-BUFFER-INDEX ERROR-PDL-BUFFER)
	((M-A) DPB M-A (BYTE-FIELD 37 1) A-ZERO)
)
	((PDL-BUFFER-INDEX) (A-CONSTANT 1252))
	((C-PDL-BUFFER-INDEX) A-ONES)		;FIX PDL BUFFER
	((M-A) (A-CONSTANT 1))
(REPEAT 40 
	((PDL-BUFFER-INDEX) (A-CONSTANT 525))
	((C-PDL-BUFFER-INDEX) M-A)
	((PDL-BUFFER-INDEX) (A-CONSTANT 1252))
	((PDL-BUFFER-INDEX) (A-CONSTANT 525))
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 REPEAT-COUNT) C-PDL-BUFFER-INDEX ERROR-PDL-BUFFER)
	((M-A) DPB M-A (BYTE-FIELD 37 1) A-ZERO)
)
	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-GREATER-THAN M-LOOP-COUNT A-ZERO PT0)

	((MD) SETZ)
CLEAR-LEVEL-1-MAP
	((VMA-WRITE-MAP M-B) DPB M-ONES (BYTE-FIELD 1 26.) A-ZERO)	;Clear level-1 map
	((MD) ADD MD (A-CONSTANT 20000))
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 24.) MD CLEAR-LEVEL-1-MAP)

	((MD) SETZ)
CLEAR-LEVEL-2-MAP
	((M-A) (BYTE-FIELD 5 13.) MD)		;What to write in level-1 map
	((VMA-WRITE-MAP) DPB M-A (BYTE-FIELD 5 27.) A-B) ;Make level-1 map point at level-2
	((VMA-WRITE-MAP) DPB M-ONES (BYTE-FIELD 1 25.) A-ZERO)	;Clear level-2 map
	((MD) ADD MD (A-CONSTANT 400))
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 24.) MD CLEAR-LEVEL-2-MAP)

MEMORY-TEST
	((A-MAIN-MEMORY-SIZE) (A-CONSTANT 200000))	;64K FOR NOW
	(CALL LOAD-STRAIGHT-MAP)

;First, the simplest thing.  If this doesnt work, nothing will.
	((M-LOOP-COUNT) (A-CONSTANT 1000))
L0	((MD) A-ZERO)
	((VMA-START-WRITE) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	(NO-OP)		;A FEW NO-OP S TO LET IT AGE A WHILE
	(NO-OP)
	(NO-OP)
	(NO-OP)
	((VMA-START-READ) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	(NO-OP)
	(NO-OP)
	(NO-OP)
	(NO-OP)
	(JUMP-EQUAL MD A-ZERO LE0)
	(JUMP HALT-CONS LE0)
LE0	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-NOT-EQUAL M-LOOP-COUNT A-ZERO L0)

;Same thing, write 1s.
	((M-LOOP-COUNT) (A-CONSTANT 1000))
L1	((MD) A-ONES)
	((VMA-START-WRITE) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	(NO-OP)		;A FEW NO-OP S TO LET IT AGE A WHILE
	(NO-OP)
	(NO-OP)
	(NO-OP)
	((VMA-START-READ) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	(NO-OP)
	(NO-OP)
	(NO-OP)
	(NO-OP)
	(JUMP-EQUAL MD A-ONES LE1)
	(JUMP HALT-CONS LE1)
LE1	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-NOT-EQUAL M-LOOP-COUNT A-ZERO L1)

;Same two things, without the crufty NO-OPs.
	((M-LOOP-COUNT) (A-CONSTANT 1000))
L2	((MD) A-ZERO)
	((VMA-START-WRITE) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	((VMA-START-READ) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	(JUMP-EQUAL MD A-ZERO LE2)
	(JUMP HALT-CONS LE2)
LE2	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-NOT-EQUAL M-LOOP-COUNT A-ZERO L2)
;and 1s again too.
	((M-LOOP-COUNT) (A-CONSTANT 1000))
L3	((MD) A-ONES)
	((VMA-START-WRITE) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	((VMA-START-READ) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	(JUMP-EQUAL MD A-ONES LE3)
	(JUMP HALT-CONS LE3)
LE3	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-NOT-EQUAL M-LOOP-COUNT A-ZERO L3)
;check that there's more than one location out there
	((VMA) (A-CONSTANT 1))
	((MD-START-WRITE) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	((VMA-START-READ) A-ZERO)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	(JUMP-EQUAL MD A-ONES LE4)
	(JUMP HALT-CONS LE4)
LE4
;Do floating bit test.  Within a page first.
	((M-LOOP-COUNT) (A-CONSTANT 100))
L5	((M-A) (A-CONSTANT 1))		;INITIAL DATA TO BE WRITTEN
	((M-B) (A-CONSTANT 400))	;# OF WORDS TO WRITE.  AFTER EACH, DATA IS ROT ED 1
	(CALL FLOAT-BLOCK-WRITE)
	((M-A) (A-CONSTANT 1))
	((M-B) (A-CONSTANT 400))
	(CALL FLOAT-BLOCK-CHECK)
	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-NOT-EQUAL M-LOOP-COUNT A-ZERO L5)
;Same thing, complemented data.
	((M-LOOP-COUNT) (A-CONSTANT 100))
L5C	((M-A) (A-CONSTANT -2))
	((M-B) (A-CONSTANT 400))
	(CALL FLOAT-BLOCK-WRITE)
	((M-A) (A-CONSTANT -2))
	((M-B) (A-CONSTANT 400))
	(CALL FLOAT-BLOCK-CHECK)
	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-NOT-EQUAL M-LOOP-COUNT A-ZERO L5C)
;Same thing, but wipe all of memory this time.
	((M-LOOP-COUNT) (A-CONSTANT 100))
L6	((M-A) (A-CONSTANT 1))		;INITIAL DATA TO BE WRITTEN
	((M-B) A-MAIN-MEMORY-SIZE)	;# OF WORDS TO WRITE.  AFTER EACH, DATA IS ROT ED 1
	(CALL FLOAT-BLOCK-WRITE)
	((M-A) (A-CONSTANT 1))
	((M-B) A-MAIN-MEMORY-SIZE)
	(CALL FLOAT-BLOCK-CHECK)
	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-NOT-EQUAL M-LOOP-COUNT A-ZERO L6)
;Same thing, complemented data.
	((M-LOOP-COUNT) (A-CONSTANT 100))
L6C	((M-A) (A-CONSTANT 1))		;INITIAL DATA TO BE WRITTEN
	((M-B) A-MAIN-MEMORY-SIZE)	;# OF WORDS TO WRITE.  AFTER EACH, DATA IS ROT ED 1
	(CALL FLOAT-BLOCK-WRITE)
	((M-A) (A-CONSTANT 1))
	((M-B) A-MAIN-MEMORY-SIZE)
	(CALL FLOAT-BLOCK-CHECK)
	((M-LOOP-COUNT) SUB M-LOOP-COUNT (A-CONSTANT 1))
	(JUMP-NOT-EQUAL M-LOOP-COUNT A-ZERO L6C)

WIN	(JUMP HALT-CONS WIN)

FLOAT-BLOCK-WRITE
	((VMA) A-ZERO)
FLOAT-BLOCK-WRITE-1
	(POPJ-EQUAL M-B A-ZERO)
	((MD-START-WRITE) M-A)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	((M-1) ADD M-A A-A)		;ROT M-A 1
	((M-A) (BYTE-FIELD 1 31.) M-A A-1)
	((VMA) ADD VMA (A-CONSTANT 1))
	(JUMP-XCT-NEXT FLOAT-BLOCK-WRITE-1)
       ((M-B) SUB M-B (A-CONSTANT 1))

FLOAT-BLOCK-CHECK
	((VMA) A-ZERO)
FLOAT-BLOCK-CHECK-1
	(POPJ-EQUAL M-B A-ZERO)
	((VMA-START-READ) VMA)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
	(JUMP-EQUAL MD A-A FLOAT-BLOCK-CHECK-2)
	(JUMP HALT-CONS FLOAT-BLOCK-CHECK-2)
FLOAT-BLOCK-CHECK-2
	((M-1) ADD M-A A-A)		;ROT M-A 1
	((M-A) (BYTE-FIELD 1 31.) M-A A-1)
	((VMA) ADD VMA (A-CONSTANT 1))
	(JUMP-XCT-NEXT FLOAT-BLOCK-CHECK-1)
       ((M-B) SUB M-B (A-CONSTANT 1))

;--
;;; Now turn on parity checking
;;; Writing 4 in Unibus location 766012, which is at virtual address 1005,
;;; turns on ERROR-STOP-ENABLE.  If we aren't really in a PROM, we write 44
;;; which also turns on (leaves on) PROM-DISABLE.
;	((MD) A-4)			;PROM
;	((MD) DPB M-ONES (BYTE-FIELD 1 5) A-4)	;RAM
;	((VMA-START-WRITE) DPB M-ONES (BYTE-FIELD 1 9) A-5)
;	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)

;;; Divide two numbers.  This routine taken from UCADR 108.
;;; Dividend in M-1, divisor in M-2
;;; Quotient In Q-R, remainder in M-1
;;; Clobbers A-TEM1.

DIV	(JUMP-GREATER-OR-EQUAL-XCT-NEXT M-1 A-ZERO DIV1)
       ((A-TEM1 Q-R) M-1)
	((Q-R) SUB M-ZERO A-TEM1)
DIV1	((M-1) DIVIDE-FIRST-STEP M-ZERO A-2)
DIV1A	(JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R ERROR-DIVIDE-BY-ZERO)
(REPEAT 31. ((M-1) DIVIDE-STEP M-1 A-2))
	((M-1) DIVIDE-LAST-STEP M-1 A-2)
	(JUMP-LESS-OR-EQUAL-XCT-NEXT M-ZERO A-TEM1 DIV2)
       ((M-1) DIVIDE-REMAINDER-CORRECTION-STEP M-1 A-2)
	((M-1) SUB M-ZERO A-1)
DIV2	((A-TEM1) XOR M-2 A-TEM1)
	(POPJ-LESS-OR-EQUAL M-ZERO A-TEM1)
	(POPJ-AFTER-NEXT
	 (A-TEM1) Q-R)
       ((Q-R) SUB M-ZERO A-TEM1)

WIPE-PDL-BUFFER  ;WIPE ENTIRE PDL-BUFFER-POINTER TO WHATS IN M-A
	((PDL-BUFFER-POINTER) (A-CONSTANT 0))
	(JUMP-NOT-EQUAL PDL-BUFFER-POINTER A-ZERO ERROR-PDL-BUFFER-POINTER)
	((C-PDL-BUFFER-POINTER-PUSH) (M-A))
	(JUMP-NOT-EQUAL PDL-BUFFER-POINTER (A-CONSTANT 1) ERROR-PDL-BUFFER-POINTER)
WPB1    ((C-PDL-BUFFER-POINTER-PUSH) (M-A))
	(JUMP-NOT-EQUAL PDL-BUFFER-POINTER A-ZERO WPB1)
	(POPJ)

;Map Stuff
(DEF-DATA-FIELD MAP-READ-FAULT-BIT 1 30.)
(DEF-DATA-FIELD MAP-WRITE-FAULT-BIT 1 31.)
(DEF-DATA-FIELD MAP-PHYSICAL-PAGE-NUMBER 14. 0)
;THREE BITS CURRENTLY UNUSED.
(DEF-DATA-FIELD MAP-META-BITS 3 17.)    	;THE HIGH TWO OF THESE ARE HACKABLE BY
						; DISPATCH INSTRUCTION
(DEF-DATA-FIELD MAP-STATUS-CODE 3 20.)
(DEF-DATA-FIELD MAP-ACCESS-CODE 2 22.)		;NOTE BIT 22 IS IN TWO FIELDS
(DEF-DATA-FIELD MAP-FIRST-LEVEL-MAP 5 24.)	;NOTE NOT THE SAME AS WHERE IT WRITES
(DEF-DATA-FIELD MAP-SECOND-LEVEL-MAP 24. 0)
(DEF-DATA-FIELD MAP-STATUS-CODE-LOW-BIT 1 20.)
(DEF-DATA-FIELD MAP-ACCESS-STATUS-AND-META-BITS 7. 17.)
(DEF-DATA-FIELD MAP-HARDWARE-READ-ACCESS 1 23.)	;HARDWARE PERMITS (AT LEAST) READ ACCESS
						; IF THIS BIT SET.

;FIELDS IN VMA WHEN WRITING MAP.
(DEF-DATA-FIELD MAP-WRITE-SECOND-LEVEL-MAP 24. 0)
(DEF-DATA-FIELD MAP-WRITE-ENABLE-SECOND-LEVEL-WRITE 1 25.)
(DEF-DATA-FIELD MAP-WRITE-ENABLE-FIRST-LEVEL-WRITE 1 26.)
(DEF-DATA-FIELD MAP-WRITE-FIRST-LEVEL-MAP 5 27.) ;NOTE NOT THE SAME AS WHERE IT READS

; DEFINITIONS OF FIELDS IN THE ADDRESS

(DEF-DATA-FIELD VMA-MAP-BLOCK-PART 11. 13.)	;ADDRESS BLOCK OF 32. PAGES
(DEF-DATA-FIELD VMA-PAGE-ADDR-PART 16. 8)	;VIRTUAL PAGE NUMBER
(DEF-DATA-FIELD VMA-PHYS-PAGE-ADDR-PART 14. 8)	;PHYSICAL PAGE NUMBER
(DEF-DATA-FIELD VMA-LOW-BITS 8 0)		;ADDR WITHIN PAGE
(DEF-DATA-FIELD ALL-BUT-VMA-LOW-BITS 24. 8)


LOAD-STRAIGHT-MAP
	((M-A) (A-CONSTANT 200000))	;NUMBER "WIRED" WORDS (64K FOR NOW)
	;FIRST SET ALL LEVEL 1 MAP TO 37
	((VMA) DPB (M-CONSTANT -1) MAP-WRITE-FIRST-LEVEL-MAP 
		   (A-CONSTANT (BYTE-VALUE MAP-WRITE-ENABLE-FIRST-LEVEL-WRITE 1)))
	((MD) DPB (M-CONSTANT -1) (BYTE-FIELD 1 24.) A-ZERO)
INIMAP1	((MD-WRITE-MAP) SUB MD (A-CONSTANT 20000))
	(JUMP-NOT-EQUAL MD A-ZERO INIMAP1)
	;THEN ZERO LAST BLOCK OF LEVEL 2 MAP
	((MD) A-ZERO)
INIMAP2	((VMA-WRITE-MAP) DPB (M-CONSTANT -1) MAP-WRITE-ENABLE-SECOND-LEVEL-WRITE A-ZERO)
	((MD) ADD MD (A-CONSTANT 400))
	(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 13.) MD INIMAP2)
	;NOW SET UP WIRED LEVEL 1 MAP
	((MD) A-ZERO)
	((M-C) DPB (M-CONSTANT -1) MAP-WRITE-ENABLE-FIRST-LEVEL-WRITE A-ZERO)
INIMAP7	((VMA-WRITE-MAP) M-C) 
	((MD) ADD MD (A-CONSTANT 20000))
	(JUMP-LESS-THAN-XCT-NEXT MD A-A INIMAP7)
       ((M-C) ADD M-C (A-CONSTANT (BYTE-VALUE MAP-WRITE-FIRST-LEVEL-MAP 1)))
	;THEN SET UP WIRED LEVEL 2 MAP
	((MD) SETZ)
INIMAP3	((VMA-WRITE-MAP) VMA-PHYS-PAGE-ADDR-PART MD	;SELF-ADDRESS
		(A-CONSTANT (PLUS (BYTE-VALUE MAP-ACCESS-CODE 3)   ;RW
				  (BYTE-VALUE MAP-WRITE-ENABLE-SECOND-LEVEL-WRITE 1))))
	((MD) ADD MD (A-CONSTANT 400))			;NEXT PAGE
	(JUMP-LESS-THAN MD A-A INIMAP3)		;LOOP UNTIL DONE ALL WIRED ADDRESSES
INIM3A	((M-1) (BYTE-FIELD 5 8) MD)		;IF NOT AT EVEN 1ST LVL MAP BOUNDARY...
	(POPJ-EQUAL M-1 A-ZERO)			; INITIALIZE REST OF 2ND LVL BLOCK TO
	((VMA-WRITE-MAP) DPB			; SECOND LVL MAP NOT SET UP.
	   (M-CONSTANT -1) MAP-STATUS-CODE-LOW-BIT 
	   (A-CONSTANT (BYTE-VALUE MAP-WRITE-ENABLE-SECOND-LEVEL-WRITE 1)))
	(JUMP-XCT-NEXT INIM3A)
       ((MD) ADD MD (A-CONSTANT 400))


;PHYSICAL MEMORY REFERENCING.
;THIS WORKS BY TEMPORARILY CLOBBERING LOCATION 0 OF THE SECOND-LEVEL MAP.
;A-TEM1, A-TEM2, AND A-TEM3 ARE USED AS TEMPORARIES.  ARGS ARE IN VMA AND MD.
PHYS-MEM-READ 
	((A-TEM1) VMA)				;SAVE ADDRESS
	((MD) A-ZERO)				;ADDRESS MAP LOCATION 0@2
	((A-TEM3) MAP-WRITE-SECOND-LEVEL-MAP	;SAVE IT (READ & WRITE THE SAME)
		  MEMORY-MAP-DATA
		  (A-CONSTANT (BYTE-VALUE MAP-WRITE-ENABLE-SECOND-LEVEL-WRITE 1)))
	((VMA-WRITE-MAP) VMA-PHYS-PAGE-ADDR-PART VMA
		(A-CONSTANT (PLUS (BYTE-VALUE MAP-WRITE-ENABLE-SECOND-LEVEL-WRITE 1)
				  (BYTE-VALUE MAP-ACCESS-CODE 3))))
	((VMA-START-READ) DPB M-ZERO		;READ, USING LOC WITHIN PAGE ZERO
		ALL-BUT-VMA-LOW-BITS A-TEM1)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)	;FOO, I JUST SET UP THE MAP
	((A-TEM2) READ-MEMORY-DATA)		;GET RESULT TO BE RETURNED
	((MD) A-ZERO)				;RESTORE THE MAP
	((VMA-WRITE-MAP) A-TEM3)
	(POPJ-AFTER-NEXT (VMA) A-TEM1)		;RETURN CORRECT VALUES IN VMA AND MD
       ((MD) A-TEM2)

PHYS-MEM-WRITE 
	((A-TEM1) VMA)				;SAVE ADDRESS
	((A-TEM2) MD)				;AND DATA
	((MD) A-ZERO)				;ADDRESS MAP LOCATION 0@2
	((A-TEM3) MAP-WRITE-SECOND-LEVEL-MAP	;SAVE IT (READ & WRITE THE SAME)
		  MEMORY-MAP-DATA
		  (A-CONSTANT (BYTE-VALUE MAP-WRITE-ENABLE-SECOND-LEVEL-WRITE 1)))
	((VMA-WRITE-MAP) VMA-PHYS-PAGE-ADDR-PART VMA
		(A-CONSTANT (PLUS (BYTE-VALUE MAP-WRITE-ENABLE-SECOND-LEVEL-WRITE 1)
				  (BYTE-VALUE MAP-ACCESS-CODE 3))))
	((MD) A-TEM2)				;RESTORE THE DATA TO BE WRITTEN
	((VMA-START-WRITE) DPB M-ZERO		;WRITE, USING LOC WITHIN PAGE ZERO
		ALL-BUT-VMA-LOW-BITS A-TEM1)
	(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)	;FOO, I JUST SET UP THE MAP
	((MD) A-ZERO)				;RESTORE THE MAP
	((VMA-WRITE-MAP) A-TEM3)
	(POPJ-AFTER-NEXT (VMA) A-TEM1)		;RETURN CORRECT VALUES IN VMA AND MD
       ((MD) A-TEM2)


;;; Determine size of main memory
	((MD) (A-CONSTANT 40))			;Turn off ERROR-STOP-ENABLE
	(CALL-XCT-NEXT PHYS-MEM-WRITE)		;40 is PROM-DISABLE
       ((VMA) (A-CONSTANT 17773005))		;Unibus 766012
	((M-S) SETZ)
MEM-SIZE-LOOP
	((VMA M-S) ADD M-S (A-CONSTANT 40000))	;Memory comes in 16K increments
	(CALL-XCT-NEXT PHYS-MEM-WRITE)
       ((MD) (A-CONSTANT 37))			;Some 1's, some 0's
	(CALL PHYS-MEM-READ)
	(JUMP-EQUAL MD (A-CONSTANT 37) MEM-SIZE-LOOP)
	;M-S now has the first non-existent location
	((MD) (A-CONSTANT 47))			;Turn ERROR-STOP-ENABLE back on
	(CALL-XCT-NEXT PHYS-MEM-WRITE)		;40 is PROM-DISABLE, 3 is FAST speed: temporary
       ((VMA) (A-CONSTANT 17773005))		;Unibus 766012


))