;;;-*-Package:user; Base:8.;  Mode:Lisp-*- 
;;;
;;; (c) Copyright 1984 - Lisp Machine, Inc.
;;;


(DEFUN BYTE (NBITS OVER)	;this definition compatible common lisp
  (DPB OVER 0609 NBITS))	;"Make a byte pointer" 


;;	This file contains descriptions of the proms used in the lambda processor.
;;	it also contains the following functions to aid in their programming

;;we generate a prom array with MAKE-PROM-ARRAY 
;;check for conflicts in logical requirements
;;the function is passed a list of lists.  each list is a specification, except the first
;;list which allows the naming of inputs. other arguments are n and m.
;; the input specifications are of the form (* * * * * * *) where * is matched with
;; an address bit (low bit right) and may be a 1,0,X (dont-care),a keyword,or a variable.
;; A variable
;; allows the state of an input bit to be passed to an output bit...optionally negated.
;; The only keyword is "default" which allows the programmer to specify the behavior in
;; all cases which match a particular predicate and which have not already been matched.
;; the output specification is of the same form

(defun make-prom-array (length width &optional (name 'pa))
  (set name (fillarray (make-array `(,length)) (list (make-list width ':initial-value 'x)))))

(defun print-prom-array (array &optional (stream t))
  (format stream "~%~% adr     data~%")
  (do ((length (first (array-dimensions array)))
       (address 0 (1+ address)))
      (( address length))
    (let ((contents  (aref array address)))
      (format stream "~%~T~7o  ~T~A " address
	      (cond ((numberp contents) contents)
		    (T (reverse contents))))))
  (format stream "~%"))

;;at each address, we go down a list of pairs of lists : an input predicate list
;;and an output specification list.  The input predicate is compared to the address
;; and if true, the associated output spec is combined with the existing output
;;(which starts out as (x x x x...)).  The rules of combination are : x going to anything
;; - no op; 1 going to x rplaca the 1 in, 1 going to 0 signal conflict, 1 going to 1
;;mark as multiply specified, potential source of trouble.  Perhaps the right
;;way to do that is to store a list of the conflicting predicates and output specs ...
;;do that later

(defun inputs-match-predicate (address number-of-address-bits predicate-list)
  (DO* ((VARIABLE-A-LIST '())
	(pred-list predicate-list (cdr pred-list))
	(bit-predicate (first pred-list) (first pred-list))
	(bit 0 (1+ bit))
	(BIT-VALUE (LOGAND 1 ADDRESS)
		   (LOGAND 1 (ASH ADDRESS (- BIT)))))
       ((or (null pred-list)
	    ( bit number-of-address-bits))	;return the alist of symbols and values
	(COND ((NULL VARIABLE-A-LIST) T)	;unless its null, in which case return t
	      (T VARIABLE-A-LIST)))
    (COND ((and  (numberp bit-predicate)
						;if the predicate is a number,
						;and it doesn't match that bit of
						;the address then return nil
		 (not (equal bit-predicate BIT-VALUE)))
	   (RETURN NIL))
	  ((AND (SYMBOLP BIT-PREDICATE)(NOT (EQUAL BIT-PREDICATE 'X)))
	   (SETQ VARIABLE-A-LIST (CONS (CONS BIT-PREDICATE BIT-VALUE) VARIABLE-A-LIST)))
	  ((AND (LISTP BIT-PREDICATE)
		(EQUAL 'NOT (CAR BIT-PREDICATE)))
	   (SETQ VARIABLE-A-LIST (CONS
				   (CONS (CADR BIT-PREDICATE) (logxor 1 BIT-VALUE))
				       VARIABLE-A-LIST))))
    ))

;;this function is given the spec list after each input spec and output spec has been
;;reversed  -- this is so the user can type in specs in high bit to low bit format,
;;and allow high bits to default to don't-care

(defun set-prom-output-specs-at-address (address reversed-spec-list
					 number-of-address-bits
					 prom-array prom-width
					 )
  (aset
    (DO* ((variable-a-list nil nil)		;reset the "pass-through" variable a-list
						;for each predicate/spec pair
	  (no-matchp t)
	  (reversed-spec-list reversed-spec-list (cdr reversed-spec-list))
	  (IN-spec-rlist (first (first reversed-spec-list))
			 (first (first reversed-spec-list)))
	  (out-spec-rlist (second (first reversed-spec-list))
			  (second (first reversed-spec-list)))
	  (output-list (make-list
			 prom-width ':initial-value 'x)))
	 ((null reversed-spec-list)
	  output-list)
      (cond  ((and (equal (first in-spec-rlist) "default")
		   (null (cdr in-spec-rlist)))
	      (setq no-matchp nil)		;should be redundant if proper syntax
						;is followed ...i.e. put your global
						;default last!
	      (setq output-list (add-specs out-spec-rlist output-list
					   in-spec-rlist variable-a-list t)))
						;if we default and have no input predicates,
						;then we add specs as usual except that we
						;lose all conflicts.  note that default
						;should be the last input spec list
						;
						;default appended to a normal input spec
						;has a different meaning...it says "if
						;you haven't matched anything yet, and you
						;match this, then go ahead."
	     ((and (equal (first in-spec-rlist) "default")
		   (equal no-matchp t)
						;if we default but have input predicates
						;and nobody else has matched at that
						;address, then we try to match, and if
						;so add specs as usual
		   
		   (setq variable-a-list (inputs-match-predicate address
								 number-of-address-bits
								 (cdr in-spec-rlist))))
;;	      (format t "~%default at ~d in-spec-rlist = ~a" address in-spec-rlist)
	      
	      (setq no-matchp nil)		;indicates a succesful match at this address
	      
	      (setq output-list (add-specs out-spec-rlist output-list
					   in-spec-rlist variable-a-list)))
	     
	     ((stringp (first in-spec-rlist)))	;ignore other strings than "default"
	     
	     ((setq variable-a-list (inputs-match-predicate address
							    number-of-address-bits
							    in-spec-rlist))
	      
	      (setq no-matchp nil)		;indicates a succesful match at this address
	      
	      (setq output-list (add-specs out-spec-rlist output-list
					   in-spec-rlist variable-a-list)))))
    prom-array address))

(defun add-specs (out-spec-list output-list in-spec-rlist VARIABLE-A-LIST
		  &optional (default-p nil))
  (cond ((null out-spec-list) output-list)
	((null output-list) NIL)
	(T (let* ((ospec (first out-spec-list))
		  (out-spec (cond ((and (not (equal ospec 'x))
					(symbolp ospec))
				   (if (null (cdr (assoc ospec variable-a-list)))
				       (ferror t "no varible named ~A"ospec)
				     (cdr (assoc ospec variable-a-list))))
						;out-spec is replaced with the new
						;value from the a-list if it is a
						;symbol,though if the assoc returns
						;nil we error out
				  (t ospec)))
		  (output (first output-list)))
	     (cond ((equal output 'x)
		    (cons out-spec
			  (add-specs (cdr out-spec-list)
				     (cdr output-list)
				     in-spec-rlist
				     variable-a-list
				     default-p)))
		   ((or (equal output out-spec)
			(equal out-spec 'x)	;if they already agree, or if the
						;out-spec is a "don't care", then
						;output is unchanged
			(equal default-p t))
						;if we are in default mode, conflicts
						;are no-ops; the default loses to the
						;specified state
						;
						;otherwise, we must have a conflict and
						;not be in default mode, so we want to
						;error out
						;
		    
		    
		    (cons output (add-specs (cdr out-spec-list)
					    (cdr output-list)
					    in-spec-rlist
					    variable-a-list
					    default-p)))
		   
		   (T(format t "~% conflict")
		     (format t "~%reversed input spec:~A~%"in-spec-rlist)
		     (format t "~%remaining output specs:~A~%"out-spec-list)
		     (format t "~%remaining output list:~A~%"output-list)
		     (ferror T "conflict")))))))

;;how do we want to pass information of conflicts back up to the top level?
;; ..... well, we dont just now, except for the input spec reversed list. We just
;;error out in a stupid manner

(defun make-prom-array-to-specs (spec-list 
				 prom-name
				 prom-length
				 prom-width
				 &OPTIONAL (REVERSED-IO-P NIL))
  (make-prom-array prom-length prom-width prom-name)
  (DO* ((address 0 (1+ address))
	(reversed-spec-list (COND (REVERSED-IO-P SPEC-LIST)
				  (T (spec-list-reversal spec-list))))
	(number-of-address-bits (haulong (sub1 prom-length))))
       (( address prom-length))
    (set-prom-output-specs-at-address address
				      reversed-spec-list
				      number-of-address-bits
				      (eval prom-name)
				      prom-width))
  
  (print-prom-array (eval prom-name))
)

(defun spec-pair-reversal (spec-pair)
  (list (reverse (first spec-pair))
	(reverse (second spec-pair))))

(defun spec-list-reversal (spec-list)
  (cond ((null spec-list) nil)
	(T (cons (spec-pair-reversal (first spec-list))(spec-list-reversal (cdr spec-list))))
	)) 

;;now we must convert the bit representation into octal numbers, compatible with
;;the functions to write prom files (found in fs:lmio1;promp)
;;we're going to need to increase the size of the array that programmer-read-prom-file
;;uses in the beginning
;;
;;programmer-write-prom-file wants to write octal numbers in the file -trim to 8 bits first
;;

(defun make-output-list-into-number (output-list &optional (default-state 0))
  (DO* ((output-list output-list (cdr output-list))
	(output-number 0)
	(bit-loc 0001 (+ bit-loc 0100))
	(output-bit (first output-list)(first output-list)))
       ((or (null output-list)
	    ( bit-loc 1001))
	output-number)
    (setq output-number
	  (cond ((numberp output-bit)
		 (dpb output-bit bit-loc output-number))
		(T (dpb default-state bit-loc output-number))))))

(defun convert-prom-array-to-numbers (prom-array &OPTIONAL (default-state 0))
  (DO ((prom-length (array-dimension-n 1 prom-array))
       (address 0 (1+ address)))
      (( address prom-length))
    (aset (make-output-list-into-number (aref prom-array address) default-state)
	  prom-array
	  address)))



;;to save the complete specification of the prom in a human readable form, we
;;provide a function which does print-prom-array to a file whos name is based on
;;the name of the prom  (takes the quoted array)

(defun write-prom-doc-file (prom-array)
  (let ((pathname (fs:merge-pathname-defaults
		    (string-append (get-pname prom-array) "-doc")	;name of array
									;plus -doc
		    "fs:lambda-diag;prom-array.text")))	;default pathname as string
    (with-open-file (filestream pathname)
      (print-prom-array prom-array filestream))))


(defun test (prom-array)
  (fs:merge-pathname-defaults
		   (string-append (get-pname prom-array) "-doc")	;name of array
		                  					;plus -doc
		   "fs:lambda-diag;*.text"))	;default pathname as string

(defconst tsp '((x 0 1)(1 0)))

(defconst tsl '(((x 0 1)(1))))
;;	      ((1 1 1)(0 1 1))))

(defconst atsl '(
	       ((1 0 0) (1 0 0 0))
	       ((0 1 0) (0 1 0 0))
	       ((0 1 1) (0 0 1 0))))


(defun make-prom (prom-list &OPTIONAL (REVERSED-IO-P NIL))
  (let ((prom-name (first prom-list))
	(length (second prom-list))
	(width (third prom-list))
	(spec-list (cdddr prom-list)))
  (make-prom-array-to-specs spec-list prom-name length width REVERSED-IO-P)
  (convert-prom-array-to-numbers (symeval prom-name))
  (print-prom-array (symeval prom-name))))


;; RG board:
;;
;;1.slave address proms
;;	these two 2Kx4 proms are found on the RG board, nubus-slave.
;;	with associated logic, they do the first pass decode of the nu-bus
;;      address for the slave port


(defconst hi-adr-spec
	'(hi-adr 2048. 4.
	  ((1 1 1 1 1 1 1 1 1 1 1)	(1 0 0 0))	;poss con reg or con prom
	  ((0 0 0 0 0 0 0 0 0 0 0)	(0 0 1 0))	;poss spy or interrupt
	  ( ("default")			(0 0 0 1))))	;unused location


(defconst low-adr-spec
	'(low-adr 2048. 4.
	  ((0 0 1 x x x x x x x x)	(1 0 0 0))	;poss interrrupt
	  ((0 0 0 0 0 0 x x x x x)	(0 1 0 0))	;poss spy
	  ((1 0 1 1 1 1 1 1 1 1 1)	(0 0 1 0))	;poss con reg
	  ( ("default")			(0 0 0 1))))	;unused unless con prom


;;2.spy decode proms
;;      three 512x8s decode the spy address field along with the spy-read/spy-write bit
;;

(defconst rg-spy-0-spec
	'(rg-spy-0 512. 8.
	  ((x x 0 x x x x x x) 		(1 1 1 1 1 1 1 1))	;spy not selected
	

	  ((x x 1 1 0 1 0 0 0)		(1 x 1 1 1 1 1 0))	;10 = read.tram.adr L
	  ((x x 1 1 0 1 0 0 1)		(1 x 1 1 1 1 0 1))	;11 = read.tram L
	  ((x x 1 1 0 1 0 1 0)		(1 x 1 1 1 0 1 1))	;12 = read.hram L
	  ((x x 1 1 0 1 0 1 1)		(1 x 1 1 0 1 1 1))	;13 = read.hptr L
	  ((x x 1 1 0 1 1 0 0)		(1 x 1 0 1 1 1 1))	;14 = read.pc L
	  ((x x 1 1 0 1 1 0 1)		(1 x 0 1 1 1 1 1))	;15 = read.treg L
	  ((x x 1 x 0 1 0 0 1)		(x 0 x x x x x x))	;11 = read.or.write.tram L
	  ((x x 1 1 0 1 1 1 1)		(0 x 1 1 1 1 1 1))	;17 = read.spy.data L

	  (("default")			(1 1 1 1 1 1 1 1))
	  ))

(defconst rg-spy-1-spec
	'(rg-spy-1 512. 8.
	  ((x x 0 x x x x x x) 		(1 1 1 1 1 1 1 1))	;spy not selected
	

	  ((x x 1 0 0 1 0 0 0)		(1 1 x x 1 1 1 0))	;10 = write.tram.adr L
	  ((x x 1 0 0 1 0 0 1)		(1 1 x x 1 1 0 1))	;11 = write.tram L
	  ((x x 1 0 0 1 0 1 0)		(1 1 x x 1 0 1 1))	;12 = write.hram L
	  ((x x 1 0 0 1 0 1 1)		(1 1 x x 0 1 1 1))	;13 = write.hptr L

	  ((x x 1 1 0 1 1 1 0)		(1 1 1 0 1 1 1 1))	;16 = mfo.enable L
;; that's the only case where mfo.enable L doesn't equal spy.control.mfo L, when
;; we deliberately want a spy-read 16 to read the MFO bus...
;; spy.control.mfo L is on for 0-7, 21, 22, and reads of 17 ...
	  ((x x 1 x 0 0 x x x)		(x x 0 0 x x x x))	;0-7 = rg.spy.control.mfo L
								; and mfo.enable L
	  ((x x 1 1 0 1 1 1 1)		(x x 0 0 x x x x))	;17 = rg.spy.control.mfo L
								; and mfo.enable L
	  ((x x 1 x 1 0 0 0 1)		(x x 0 0 x x x x))	;21 = rg.spy.control.mfo L
								; and mfo.enable L
	  ((x x 1 x 1 0 0 1 0)		(x x 0 0 x x x x))	;22 = rg.spy.control.mfo L
								; and mfo.enable L
	  ((x x 1 x 1 0 0 0 1)		(1 0 x x 1 1 1 1))	;21 = read.parity L
	  ((x x 1 0 0 1 1 1 1)		(0 1 x x 1 1 1 1))	;17 = write.spy.data L

	  (("default")			(1 1 1 1 1 1 1 1))
	  ))

(defconst rg-spy-2-spec
	'(rg-spy-2 512. 8.
	  ((x x 0 x x x x x x) 		(1 1 1 1 1 1 1 1))	;spy not selected
	
	  ((x x 1 1 1 0 0 0 0)		(1 1 1 1 1 1 1 0))	;20 = read.pmr L
	  ((x x 1 0 1 0 0 0 0)		(1 1 1 1 1 1 0 1))	;20 = write.pmr L
	  ((x x 1 1 0 1 1 0 0)		(1 1 1 0 1 0 1 1))	;14 = read.pc L
	  ((x x 1 0 0 1 0 1 0)		(1 1 1 0 0 1 1 1))	;12 = write.hram L
	  ;
	  ;bit 4 is *-spy.use.spy.bus, which is low for all spy selects except for
	  ;reads and writes of the pmr (hence we assert it in the default)
	  ;

	  (("default")			(1 1 1 0 1 1 1 1))
	  ))

;;3.configuration prom
;;	512x8 contains the nubus configuration information for the processor
;;	-- not required for simple operation, but is a nice easy thing to read back
;;	and see if you're winning

;;4.MFO zeros prom
;;	512x8 decodes source address to drive 4-bit blocks of zeroes onto mfo bus,
;;	-- insures that all bits of mfo are driven during source cycle

;;	"wait" bit ignored in all cases (bit 5)

(defconst mfo-zeros-spec
	'(mfo-zeros 512. 8.
	  ((x 0 x x x x x x x)		(1 1 1 1 1 1 1 1))	;not source cycle
	  
	  ((x 1 1 x 0 0 0 0 0)		(0 0 0 0 0 0 1 1))	;interrupt pointer, 8 bits
	  ((x 1 1 x 0 0 0 0 1)		(0 0 0 0 0 0 1 1))	;macro.ir.displacement 8 bits
	  ((x 1 1 0 0 0 0 1 0)		(1 1 1 1 1 1 1 1))	;main.stat.counter 32 bits
	  ((x 1 1 1 0 0 0 1 0)		(1 1 1 1 1 1 1 1))	;aux.stat.counter 32 bits
	  ((x 1 1 x 0 0 0 1 1)		(0 0 0 0 1 1 1 1))	;macro.ir 16 bits
	  ((x 1 1 x 0 0 1 0 0)		(0 0 0 0 1 1 1 1))	;m.i.d. ram 16 bits
	  ((x 1 1 x 0 0 1 0 1)		(1 1 1 1 1 1 1 1))	;spy.reg 32 bits
	  ((x 1 1 0 0 0 1 1 0)		(1 1 1 1 1 1 1 1))	;multiplier.FT 32 bits
	  ((x 1 1 1 0 0 1 1 0)		(1 1 1 1 1 1 1 1))	;multiplier 32 bits
	  ((x 1 1 x 0 0 1 1 1)		(1 1 1 1 1 1 1 1))	;rg.mode.reg 32 bits

	  ((x 1 1 x 0 1 0 0 0)		(0 0 0 0 0 1 1 1))	;disp. const 12 bits 
	  ((x 1 1 x 0 1 0 0 1)		(1 1 0 1 1 1 1 1))	;usp,us 28 bits
	  ((x 1 1 x 0 1 0 1 0)		(1 1 0 1 1 1 1 1))	;usp,us, pop usp 28 bits
	  							;usp:31-24,us: 19-0
	  ((x 1 1 x 0 1 0 1 1)		(0 0 0 0 1 1 1 1))	;cram.adr.map 16 bits
								; (really 12, but bi-dir buf
								;  is 16.)

	  ((x 1 1 x 1 0 0 0 1)		(1 1 1 1 1 1 1 1))	;md 32 bits 
	  ((x 1 1 x 1 0 0 1 0)		(1 1 1 1 1 1 1 1))	;vma 32 bits
	  ((x 1 1 x 1 0 0 1 1)		(0 0 0 0 0 1 1 1))	;level-1-map 12 bits
	  ((x 1 1 x 1 0 1 0 0)		(0 0 0 0 1 1 1 1))	;level-2-map-control 16 bits
	  ((x 1 1 x 1 0 1 0 1)		(0 0 1 1 1 1 1 1))	;level-2-map-page 24 bits
	  ((x 1 1 x 1 0 1 1 0)		(0 1 1 1 1 1 1 1))	;lc 28 bits

	  ((x 1 1 x 1 1 0 0 0)		(0 0 0 0 0 1 1 1))	;pi 12 bits
	  ((x 1 1 x 1 1 0 0 1)		(1 1 1 1 1 1 1 1))	;q 32 bits
	  ((x 1 1 x 1 1 0 1 0)		(0 0 0 0 0 1 1 1))	;pp 12 bits
	  ((x 1 1 x 1 1 1 0 1)		(0 0 0 0 0 0 1 1))	;dp.mode.reg 8 bits
	  ((x 1 1 0 1 1 1 1 0)		(1 1 1 1 1 1 1 1))	;c-pp 32 bits
	  ((x 1 1 1 1 1 1 1 0)		(1 1 1 1 1 1 1 1))	;c-pp-pop 32 bits
	  ((x 1 1 x 1 1 1 1 1)		(1 1 1 1 1 1 1 1))	;c-pi 32 bits

	  ((x 1 x x x x x x x
	      "default")	       	(0 0 0 0 0 0 0 0))	;null source cycle,
	 							;or source m-mem
	  							;drive all zeroes
	  
	  (("default")			(1 1 1 1 1 1 1 1))	;just in case
	))

;;5.Interrupt prom
;;	512x8 used as part of interrupt state machine

;;	this is probably a verbose implementation.  However, the prom
;;	would not have been any smaller if fewer inputs had been used
;;	
;;
;;			inputs   	 ______		outputs
;;					|      |	
;;	8. gnd				|      |	7. 
;;	7. gnd				|      |	6. 
;;	6. gnd				|      |	5. 
;;	5. interrupt.cleared.synced L	|      |	4. 
;;	4. interrupt			|      |	3. 
;;	3. interrupt.found.synced	|      |	2. inhibit.interrupt.pointer
;;	2. clear.interrupt.synced	|      |	1. interrupt.cleared
;;	1. interrupt.selected.and.ready	|      |	0. servicing.interrupt
;;	0. servicing.interrupt.synced  	|      |	
;;					|______|	
;;

(defconst interrupt-spec
	'(interrupt 512. 8.
	  ((x x x 1 0 0 0 x 0) 		(0 0 0 0 0 0 0 0))	;nothing interesting
	
	  ((x x x x 1 x x x x)		(0 0 0 0 0 1 x 1))	;inhibit pointer increment
								;and enter/stay-in servicing
								;mode if interrupt asserted
								;
	  ((x x x x x 1 x x x)		(0 0 0 0 0 1 x 1))	;same for interrupt.found
	  							;.synced
								;
	  ((x x x 1 x x x x 1)		(0 0 0 0 0 1 x 1))	;if we are servicing,
	  							;and we dont see interrupt 
								;.cleared.synced L, then
								;keep going
								;
	  ((x x x 0 0 0 x x 1)		(0 0 0 0 0 0 0 0))	;interrupt.cleared.synced L
	  							;no interrupt,and no
	  							;interrupt.		
	  							;found.synced, so start
								;pointer counting again
								;
								;
	  ((x x x x x x 0 x x)		(0 0 0 0 0 x 0 x))	;not trying to clear interrupt
								;so don't assert interrupt.
								;cleared
								;
	  ((x x x 1 x x 1 1 1)		(0 0 0 0 0 x 0 x))	;trying to clear interrupt
								;but somebody else is
	  							;writing the ram, so don't
	  							;assert interrupt cleared
								;
	  ((x x x 1 x x 1 0 1)		(0 0 0 0 0 x 1 x))	;trying to clear interrupt
								; - succeeds because
								;nobody interfered
								;
								;note that attempts to
								;clear interrupts while
								;no interrupt is being
								;serviced are ignored

	  (("default")			(0 0 0 0 0 0 0 0))
	  ))


;;6. transfer mode prom
;;	512x8 used to handle word,halfword,and byte operations to the rg board
;;	see eco #12 in version 2.1
;;	(also see table 2-2. in the nubus specification)

;;	
;;
;;			inputs   	 ______		outputs
;;					|      |	
;;	8. gnd				|      |	7. 
;;	7. gnd				|      |	6. 
;;	6. gnd				|      |	5. 
;;	5. gnd				|      |	4.write.byte.3.or.read.cycle
;;	4. gnd				|      |	3.write.byte.3 L
;;	3. rg.tm.1.latched		|      |	2.write.byte.2 L
;;	2. rg.tm.0.latched		|      |	1.write.byte.1 L
;;	1. slave.nuadr.1		|      |	0.write.byte.0 L
;;	0. slave.nuadr.0	 	|      |	
;;					|______|	
;;

(defconst tm-spec
	'(tm 512. 8.
	  ((x x x x x 0 x x x) 		(0 0 0 1 1 1 1 1))	;reads

	  ((x x x x x 1 1 1 1) 		(0 0 0 1 0 1 1 1))	;write byte 3
	  ((x x x x x 1 1 1 0) 		(0 0 0 0 1 0 1 1))	;write byte 2
	  ((x x x x x 1 1 0 1) 		(0 0 0 0 1 1 0 1))	;write byte 1
	  ((x x x x x 1 1 0 0) 		(0 0 0 0 1 1 1 0))	;write byte 0

	  ((x x x x x 1 0 1 1) 		(0 0 0 1 0 0 1 1))	;write halfword 1
	  ((x x x x x 1 0 0 1) 		(0 0 0 0 1 1 0 0))	;write halfword 0

	  ((x x x x x 1 0 0 0) 		(0 0 0 1 0 0 0 0))	;write word

	  ((x x x x x 1 0 1 0) 		(0 0 0 0 1 1 1 1))	;write block (NOT supported)
	  (("default")			(0 0 0 0 1 1 1 1))
	  ))


;;******************************************************************************************


;;  CM board:
;;
;;1.spy decode proms
;;      two 512x8s decode the spy address field along with the spy-read/spy-write bit
;;
(defconst cm-spy-0-spec
	'(cm-spy-0 512. 8.
	  ((x x 0 x x x x x x) 		(1 1 1 1 1 1 1 1))	;spy not selected
	
	  ((x x 1 1 0 0 1 0 1)		(1 1 1 1 1 1 1 0))	;05 = read.low.ireg L
	  ((x x 1 1 0 0 1 0 0)		(1 1 1 1 1 1 0 1))	;04 = read.high.ireg L
	  ((x x 1 1 0 0 1 1 1)		(1 1 1 1 1 0 1 1))	;07 = read.low.cram L
	  ((x x 1 1 0 0 1 1 0)		(1 1 1 1 0 1 1 1))	;06 = read.high.cram L
	  ((x x 1 0 0 0 1 0 1)		(1 1 1 0 1 1 1 1))	;05 = write.low.ireg L
	  ((x x 1 0 0 0 1 0 0)		(1 1 0 1 1 1 1 1))	;04 = write.high.ireg L
	  ((x x 1 0 0 0 1 1 1)		(1 0 1 1 1 1 1 1))	;07 = write.low.cram L
	  ((x x 1 0 0 0 1 1 0)		(0 1 1 1 1 1 1 1))	;06 = write.high.cram L

	  (("default")			(1 1 1 1 1 1 1 1))
	  ))

(defconst cm-spy-1-spec
	'(cm-spy-1 512. 8.
	  ((x x 0 x x x x x x) 		(0 1 0 1 1 0 1 1))	;spy not selected
;; spy.use.low.I L is used for reading and writing the low cram and for writing the low ireg
	  ((x x 1 x 0 0 1 1 1)		(0 x 0 1 1 0 x 0))	;07 = spy.use.low.I L
	  ((x x 1 0 0 0 1 0 1)		(0 x 0 1 1 0 x 0))	;05 = spy.use.low.I L
;; spy.use.high.I L is used for reading and writing the high cram and
;; for writing the high ireg
	  ((x x 1 x 0 0 1 1 0)		(0 x 0 1 1 0 0 x))	;06 = spy.use.high.I L
	  ((x x 1 0 0 0 1 0 0)		(0 x 0 1 1 0 0 x))	;04 = spy.use.high.I L
;; spy.drive.pc.to.h.bus L is ALWAYS on (low) unless reading or writing the hram
	  ((x x 1 x 0 1 0 1 0)		(0 x 0 1 1 1 x x))	;12 = drive.pc.to.h.bus L
	  ((x x 1 1 1 0 0 1 0)		(0 x 0 1 0 0 x x))	;22 = read.cram.adr.map L
	  ((x x 1 0 1 0 0 1 0)		(0 x 1 0 1 0 x x))	;22 = write.cram.adr.map L
;; spy.control.mfo L is on for 0-7, 21, 22, and reads of 17 ...
	  ((x x 1 x 0 0 x x x)		(x 0 x x x x x x))	;0-7 = rg.spy.control.mfo L
	  ((x x 1 1 0 1 1 1 1)		(x 0 x x x x x x))	;17 = rg.spy.control.mfo L
	  ((x x 1 x 1 0 0 0 1)		(x 0 x x x x x x))	;21 = rg.spy.control.mfo L
	  ((x x 1 x 1 0 0 1 0)		(x 0 x x x x x x))	;22 = rg.spy.control.mfo L

	  (("default")			(0 1 0 1 1 0 1 1))
	  ))


;;2. subtractor prom
;;	a prom that computes one less than the current address to speed poping the usp.

(defconst sub-prom nil)

(defun make-subtractor-prom ()
  (setq sub-prom (make-array 512.))	            
  (dotimes (address 512.)		 
  	    (aset (cond ((> address 377)
			 (logand 377 (- address 401)))
			(t (logand 377(1- address))))
		  sub-prom
		  address)))


;;(defun make-bit-list (fixnum nbits)
;;  (nreverse (loop for count from 1 to nbits
;;		  for num = fixnum then (ash (abs num) -1)
;;		  collecting (ldb 1 num))))
;;
;;(defconst subtractor-prom-spec
;;		(nconc '(subtractor-prom-0 512. 8.)
;;		       (loop
;;			 for address from 0 to 777
;;			 for sub-addr = 777 then (1- address)
;;			 nconc (list
;;				 (list
;;				   (append '(x) (make-bit-list address 8.))
;;				   (make-bit-list sub-addr 8.))))))
;;
;;3.destination prom
;;	four 512x8s decode 9 bits into destination control signals
;;
;;dest prom 0:	512x8 :
;;
;;		inputs   	 ______		outputs
;;				|      |	
;;   8. no.op.or.no.dest	|      |	7. Uinst.next.dest.seq.2
;;   7. gnd			|      |	6. Uinst.next.dest.seq.1
;;   6. M.dest.adress=0 L	|      |	5. Uinst.next.dest.seq.0
;;   5. Dest.A			|      |	4. -Uinst.Dest.mode
;;   4. Dest.funct.4		|      |	3. Uinst.memory.cycle
;;   3. Dest.funct.3		|      |	2. Uinst.Dest.start.write
;;   2. Dest.funct.2		|      |	1. Uinst.write.A
;;   1. Dest.funct.1		|      |	0. Uinst.write.M
;;   0. Dest.funct.0	   	|      |	
;;				|______|	
;;

(defconst dest-prom-0-spec
	'(dest-prom-0 512. 8.
	  ((1 x x x x x x x x) 		(0 0 0 1 0 0 0 0))	;no.op.or.no.dest
	  ((0 x x 1 x x x x x)		(0 0 1 1 0 0 1 0))    ;dest.a  write.a and
	     						        ;uinst.next.dest.seq.1


;;functional destinations, each with and without a simultaneous m write
;;pdl writes do not need the write.m bit; the write.a bit should be on for
;;any m write

	  ((0 x 1 0 0 0 0 0 0)		(0 1 0 1 0 0 1 1))	;0 = nothing
	  ((0 x 0 0 0 0 0 0 0)		(0 0 0 1 0 0 0 0))	;0 = nothing
	  ((0 x 1 0 0 0 0 0 1)		(0 1 0 1 0 0 1 1))	;1 = uinst.dest.lc
	  ((0 x 0 0 0 0 0 0 1)		(0 0 0 1 0 0 0 0))	;1 = uinst.dest.lc
	  ((0 x 1 0 0 0 0 1 0)		(0 1 0 0 0 0 1 1))    ;2 = interrupt control
	  ((0 x 0 0 0 0 0 1 0)		(0 0 0 0 0 0 0 0))    ;2 = interrupt control
	  ((0 x 1 0 0 0 0 0 1)		(0 1 0 1 0 0 1 1))	;41 = clear interrupt [*]
	  ((0 x 0 0 0 0 0 0 1)		(0 0 0 1 0 0 0 0))	;41 = clear interrupt [*]
	  ((0 x 1 0 0 0 1 0 0)		(0 1 0 1 0 0 1 1))	;4 = statistics counter
	  ((0 x 0 0 0 0 1 0 0)		(0 0 0 1 0 0 0 0))	;4 = statistics counter
	  ((0 x 1 0 0 0 1 0 1)		(0 1 0 1 0 0 1 1))	;5 = m.i.d.ram
	  ((0 x 0 0 0 0 1 0 1)		(0 0 0 1 0 0 0 0))	;5 = m.i.d.ram
	  ((0 x 1 0 0 1 0 0 0)		(1 0 0 1 0 0 1 1))      ;10 = c.pdl.p & m.write
	  ((0 x 0 0 0 1 0 0 0)		(0 1 1 1 0 0 0 0))      ;10 = c.pdl.p & no m.write
	  ((0 x 1 0 0 1 0 0 1)		(1 0 0 1 0 0 1 1))      ;11 = c.pdl.p.count, m.wr
	  ((0 x 0 0 0 1 0 0 1)		(0 1 1 1 0 0 0 0))      ;11 = c.pdl.p.count, no m.wr
	  ((0 x 1 0 0 1 0 1 0)		(1 1 0 1 0 0 1 1))      ;12 = c.pdl.index, m.wr
	  ((0 x 0 0 0 1 0 1 0)		(1 0 1 1 0 0 0 0))      ;12 = c.pdl.index, no m.wr
	  ((0 x 1 0 0 1 0 1 1)		(0 1 0 1 0 0 1 1))	;13 = pp
	  ((0 x 0 0 0 1 0 1 1)		(0 0 0 1 0 0 0 0))	;13 = pp
	  ((0 x 1 0 0 1 0 1 1)		(0 1 0 1 0 0 1 1))	;53 = pi [*]
	  ((0 x 0 0 0 1 0 1 1)		(0 0 0 1 0 0 0 0))	;53 = pi [*]
	  ((0 x 1 0 0 1 1 0 1)		(0 1 0 1 0 0 1 1))	;15 = us.data, push
	  ((0 x 0 0 0 1 1 0 1)		(0 0 0 1 0 0 0 0))	;15 = us.data, push
	  ((0 x 1 0 0 1 1 1 0)		(0 1 0 1 0 0 1 1))	;16 =uinst.dest.low.imod
	  ((0 x 0 0 0 1 1 1 0)		(0 0 0 1 0 0 0 0))	;16 =uinst.dest.low.imod
	  ((0 x 1 0 0 1 1 1 1)		(0 1 0 1 0 0 1 1))	;17 = uinst.dest.high.imod
	  ((0 x 0 0 0 1 1 1 1)		(0 0 0 1 0 0 0 0))	;17 = uinst.dest.high.imod
	  ((0 x 1 0 1 0 0 0 0)		(0 1 0 1 0 0 1 1))	;20 = vma 
	  ((0 x 0 0 1 0 0 0 0)		(0 0 0 1 0 0 0 0))	;20 = vma 
	  ((0 x 1 0 1 0 0 0 1)		(0 1 0 1 1 0 1 1))    ;21 = vma start read
	  ((0 x 0 0 1 0 0 0 1)		(0 0 0 1 1 0 0 0))    ;21 = vma start read
	  ((0 x 1 0 1 0 0 1 0)		(0 1 0 1 1 1 1 1))    ;22 = vma start write
	  ((0 x 0 0 1 0 0 1 0)		(0 0 0 1 1 1 0 0))    ;22 = vma start write
	  ((0 x 1 0 1 0 0 1 1)		(0 1 0 1 0 0 1 1))	;23 = l1.map,adr by md
	  ((0 x 0 0 1 0 0 1 1)		(0 0 0 1 0 0 0 0))	;23 = l1.map,adr by md
	  ((0 x 1 0 1 0 1 0 0)		(0 1 0 1 0 0 1 1))	;24 = l2 map -control bits
	  ((0 x 0 0 1 0 1 0 0)		(0 0 0 1 0 0 0 0))	;24 = l2 map -control bits
	  ((0 x 1 0 1 0 1 0 0)		(0 1 0 1 0 0 1 1))	;64 = l2 map -phys page
	  ((0 x 0 0 1 0 1 0 0)		(0 0 0 1 0 0 0 0))	;64 = l2 map -phys page
	  ((0 x 1 0 1 1 0 0 0)		(0 1 0 1 0 0 1 1))	;30 = md
	  ((0 x 0 0 1 1 0 0 0)		(0 0 0 1 0 0 0 0))	;30 = md
	  ((0 x 1 0 1 1 0 0 1)		(0 1 0 1 1 0 1 1))    ;31 = md start read
	  ((0 x 0 0 1 1 0 0 1)		(0 0 0 1 1 0 0 0))    ;31 = md start read
	  ((0 x 1 0 1 1 0 1 0)		(0 1 0 1 1 1 1 1))    ;32 = md start write
	  ((0 x 0 0 1 1 0 1 0)		(0 0 0 1 1 1 0 0))    ;32 = md start write

	  ((0 x 1 0 1 1 0 1 1)		(1 1 0 1 0 0 1 1))      ;33 = c.pdl.index wr.m, inc
	  ((0 x 0 0 1 1 0 1 1)		(1 0 1 1 0 0 0 0))      ;33 = c.pdl.index  no wr.m,inc
	 
	  ((0 x 1 0 1 1 1 0 0)		(0 1 0 1 0 0 1 1))	;34 = uinst.dest.us
	  ((0 x 0 0 1 1 1 0 0)		(0 0 0 1 0 0 0 0))	;34 = uinst.dest.us
	  ((0 x 1 0 1 1 1 0 1)		(0 1 0 1 0 0 1 1))	;35 = uinst.dest.usp
	  ((0 x 0 0 1 1 1 0 1)		(0 0 0 1 0 0 0 0))	;35 = uinst.dest.usp
	  
	  ((0 x 1 0 1 1 1 1 0)		(1 1 0 1 0 0 1 1))      ;36 = c.pdl.index wr.m, decr.
	  ((0 x 0 0 1 1 1 1 0)		(1 0 1 1 0 0 0 0))      ;36 = c.pdl.index no wr.m,decr
	  ((0 x 1 0 x x x x x
	      "default")		(0 1 0 1 0 0 1 1))    ;write m mem and nothing else
	  (("default")			(0 0 0 1 0 0 0 0))
	  ))

;;
;;
;; dest prom 1:
;;
;;		inputs   	 ______		outputs
;;				|      |	
;;   8. no.op.or.no.dest	|      |	7. Uinst.Dest.LC.or.INT.clr L
;;   7. gnd			|      |	6. Uinst.dest.Low.IMOD
;;   6. M.dest.adress=0 L	|      |	5. Uinst.dest.high.IMOD
;;   5. Dest.A			|      |	4. Uinst.dest.US
;;   4. Dest.funct.4		|      |	3. Slow.dest.seq.1
;;   3. Dest.funct.3		|      |	2. Slow.dest.seq.0
;;   2. Dest.funct.2		|      |	1. Uinst.increment.pdl.index
;;   1. Dest.funct.1		|      |	0. Uinst.increment.pdl.pointer L
;;   0. Dest.funct.0	   	|      |	
;;				|______|	
;;
;;

(defconst dest-prom-1-spec
	'(dest-prom-1 512. 8.
	  ((1 x x x x x x x x) 		(1 0 0 0 0 0 0 1))	;no.op.or.no.dest
	
;;functional destinations

	  ((0 x x 0 0 0 0 0 0)		(1 0 0 0 0 0 0 1))	;0 = nothing
	  ((0 x x 0 0 0 0 0 1)		(0 0 0 0 0 0 0 1))    ;1 = uinst.dest.lc
	  ((0 x x 0 0 0 0 1 0)		(1 0 0 0 0 0 0 1))      ;2 = mode reg
	  ((0 x x 0 0 0 0 1 1)		(0 0 0 0 0 0 0 1))    ;41 = clear interrupt
	  ((0 x x 0 0 0 1 0 0)		(1 0 0 0 0 0 0 1))	;4 = statistics counter
	  ((0 x x 0 0 0 1 0 1)		(1 0 0 0 0 0 0 1))	;5 = m.i.d.ram
	  ((0 x x 0 0 1 0 0 0)		(1 0 0 0 0 0 0 1))	;10 = c.pdl.p 
	  ((0 x x 0 0 1 0 0 1)		(1 0 0 0 0 0 0 0))    ;11 = c.pdl.p.count
	  ((0 x x 0 0 1 0 1 0)		(1 0 0 0 0 0 0 1))	;12 = c.pdl.index, m.wr
	  ((0 x x 0 0 1 0 1 1)		(1 0 0 0 0 0 0 1))	;13 = pp
	  ((0 x x 0 0 1 0 1 1)		(1 0 0 0 0 0 0 1))	;53 = pi
	  ((0 x x 0 0 1 1 0 1)		(1 0 0 1 0 0 0 1))    ;15 = us.data, push
	  ((0 x x 0 0 1 1 1 0)		(1 1 0 0 0 0 0 1))    ;16 = uinst.dest.low.imod
	  ((0 x x 0 0 1 1 1 1)		(1 0 1 0 0 0 0 1))    ;17 = uinst.dest.high.imod

;;slow dest seq = 1
	  ((0 x x 0 1 0 0 0 0)		(1 0 0 0 0 1 0 1))    ;20 = vma
	  ((0 x x 0 1 0 0 0 1)		(1 0 0 0 0 1 0 1))    ;21 = vma start read
	  ((0 x x 0 1 0 0 1 0)		(1 0 0 0 0 1 0 1))    ;22 = vma start write

	  ((0 x x 0 1 0 0 1 1)		(1 0 0 0 0 0 0 1))	;23 = l1.map,adr by md
	  ((0 x x 0 1 0 1 0 0)		(1 0 0 0 0 0 0 1))	;24 = l2 map -control bits
	  ((0 x x 0 1 0 1 0 0)		(1 0 0 0 0 0 0 1))	;64 = l2 map -phys page
;;slow dest seq = 1
	  ((0 x x 0 1 1 0 0 0)		(1 0 0 0 0 1 0 1))    ;30 = md
	  ((0 x x 0 1 1 0 0 1)		(1 0 0 0 0 1 0 1))    ;31 = md start read
	  ((0 x x 0 1 1 0 1 0)		(1 0 0 0 0 1 0 1))    ;32 = md start write

	  ((0 x x 0 1 1 0 1 1)		(1 0 0 0 0 0 1 1))    ;33 = c.pdl.index ,increment 
	  ((0 x x 0 1 1 1 0 0)		(1 0 0 1 0 0 0 1))    ;34 = uinst.dest.us
	  ((0 x x 0 1 1 1 0 1)		(1 0 0 0 0 0 0 1))	;35 = uinst.dest.usp.if.pop
	  ((0 x x 0 1 1 1 1 0)		(1 0 0 0 0 0 0 1))      ;36 = c.pdl.index ,decrement 
	  (("default")			(1 0 0 0 0 0 0 1))
	  ))

;;
;;
;; dest prom 2:
;;
;;		inputs   	 ______		outputs
;;				|      |	
;;   8. no.op.or.no.dest	|      |	7. Uinst.Dest.stat.counter
;;   7. gnd			|      |	6. Uinst.count.pdl.index L
;;   6. M.dest.adress=0 L	|      |	5. Uinst.dest.clobbers.mem.subr
;;   5. Dest.A			|      |	4. nc
;;   4. Dest.funct.4		|      |	3. uinst.dest.vma
;;   3. Dest.funct.3		|      |	2. uinst.dest.md
;;   2. Dest.funct.2		|      |	1. Uinst.dest.load.usp.if.pop L
;;   1. Dest.funct.1		|      |	0. Uinst.dest.pi.or.pp L
;;   0. Dest.funct.0	   	|      |	
;;				|______|	
;;
;;


(defconst dest-prom-2-spec			
	'(dest-prom-2 512. 8.
	  ((1 x x x x x x x x) 		(0 1 0 0 0 0 1 1))	;no.op.or.no.dest
	
;;functional destinations

	  ((0 x x 0 0 0 0 0 0)		(0 1 0 0 0 0 1 1))	;0 = nothing
	  ((0 x x 0 0 0 0 0 1)		(0 1 0 0 0 0 1 1))	;1 = uinst.dest.lc
	  ((0 x x 0 0 0 0 1 0)		(0 1 0 0 0 0 1 1))	;2 = interrupt control
	  ((0 x x 0 0 0 0 1 1)		(0 1 0 0 0 0 1 1))	;3 = clear interrupt
	  ((0 x x 0 0 0 1 0 0)		(1 1 0 0 0 0 1 1))    ;4 = statistics counter
	  ((0 x x 0 0 0 1 0 1)		(0 1 0 0 0 0 1 1))      ;5 = m.i.d.ram
	  ((0 x x 0 0 1 0 0 0)		(0 1 0 0 0 0 1 1))	;10 = c.pdl.p 
	  ((0 x x 0 0 1 0 0 1)		(0 1 0 0 0 0 1 1))	;11 = c.pdl.p.count
	  ((0 x x 0 0 1 0 1 0)		(0 1 0 0 0 0 1 1))	;12 = c.pdl.index
	  ((0 x x 0 0 1 0 1 1)		(0 1 0 0 0 0 1 0))    ;13 = pp
	  ((0 x x 0 0 1 0 1 1)		(0 1 0 0 0 0 1 0))    ;53 = pi
	  ((0 x x 0 0 1 1 0 1)		(0 1 0 0 0 0 1 1))	;15 = us.data, push
	  ((0 x x 0 0 1 1 1 0)		(0 1 0 0 0 0 1 1))	;16 = uinst.dest.low.imod
	  ((0 x x 0 0 1 1 1 1)		(0 1 0 0 0 0 1 1))	;17 = uinst.dest.high.imod
	  ((0 x x 0 1 0 0 0 0)		(0 1 1 0 1 0 1 1))    ;20 = vma 
	  ((0 x x 0 1 0 0 0 1)		(0 1 1 0 1 0 1 1))    ;21 = vma start read
	  ((0 x x 0 1 0 0 1 0)		(0 1 1 0 1 0 1 1))    ;22 = vma start write
	  ((0 x x 0 1 0 0 1 1)		(0 1 1 0 0 0 1 1))	;23 = l1.map,adr by md
	  ((0 x x 0 1 0 1 0 0)		(0 1 1 0 0 0 1 1))	;24 = l2 map -control bits
	  ((0 x x 0 1 0 1 0 0)		(0 1 1 0 0 0 1 1))	;64 = l2 map -phys page
	  ((0 x x 0 1 1 0 0 0)		(0 1 1 0 0 1 1 1))    ;30 = md
	  ((0 x x 0 1 1 0 0 1)		(0 1 1 0 0 1 1 1))    ;31 = md start read
	  ((0 x x 0 1 1 0 1 0)		(0 1 1 0 0 1 1 1))    ;32 = md start write
	  ((0 x x 0 1 1 0 1 1)		(0 0 0 0 0 0 1 1))    ;33 = c.pdl.index, increment
	  ((0 x x 0 1 1 1 0 0)		(0 1 0 0 0 0 1 1))	;34 = uinst.dest us
	  ((0 x x 0 1 1 1 0 1)		(0 1 0 0 0 0 0 1))      ;35 = load.usp.if.pop
	  ((0 x x 0 1 1 1 1 0)		(0 0 0 0 0 0 1 1))    ;36 = c.pdl.index ,decrement 
	  (("default")			(0 1 0 0 0 0 1 1))
	  ))


;;
;; dest prom 3:
;;
;;		inputs   	 ______		outputs
;;				|      |	
;;   8. no.op.or.no.dest	|      |	7. d.multiplier
;;   7. gnd			|      |	6. d.write.cram.adr.map
;;   6. M.dest.adress=0 L	|      |	5. d.write.high.cram L
;;   5. Dest.A			|      |	4. d.write.low.cram L
;;   4. Dest.funct.4		|      |	3. d.write.m.i.d
;;   3. Dest.funct.3		|      |	2. nc
;;   2. Dest.funct.2		|      |	1. d.write.l2.maps
;;   1. Dest.funct.1		|      |	0. d.write.l1.map
;;   0. Dest.funct.0	   	|      |	
;;				|______|	
;;
;;
;;

(defconst dest-prom-3-spec		
	'(dest-prom-3 512. 8.
	  ((1 x x x x x x x x) 		(0 0 1 1 0 0 0 0))	;no.op.or.no.dest
	  ((x 0 x x x x x x x)		(0 0 1 1 0 0 0 0))	;t.new.uinst
	
;;functional destinations

	  ((0 1 x 0 0 0 0 0 0)		(0 0 1 1 0 0 0 0))	;0 = nothing
	  ((0 1 x 0 0 0 0 0 1)		(0 0 1 1 0 0 0 0))	;1 = uinst.dest.lc
	  ((0 1 x 0 0 0 0 1 0)		(0 0 1 1 0 0 0 0))	;2 = interrupt control
	  ((0 1 x 0 0 0 0 0 1)		(0 0 1 1 0 0 0 0))      ;41 = clear interrupt
	  ((0 1 x 0 0 0 1 0 0)		(0 0 1 1 0 0 0 0))	;4 = statistics counter
	  ((0 1 x 0 0 0 1 0 1)		(0 0 1 1 1 0 0 0))    ;5 = m.i.d.ram
	  ((0 1 x 0 0 0 1 1 0)		(0 0 0 1 0 0 0 0))    ;6 = high cram
	  ((0 1 x 0 0 0 1 1 1)		(0 0 1 0 0 0 0 0))    ;7 = low cram
 	  ((0 1 x 0 0 1 0 0 0)		(0 0 1 1 0 0 0 0))	;10 = c.pdl.p 
	  ((0 1 x 0 0 1 0 0 1)		(0 0 1 1 0 0 0 0))	;11 = c.pdl.p.count
	  ((0 1 x 0 0 1 0 1 0)		(0 0 1 1 0 0 0 0))	;12 = c.pdl.index
	  ((0 1 x 0 0 1 0 1 1)		(0 0 1 1 0 0 0 0))	;13 = pp
	  ((0 1 x 0 0 1 0 1 1)		(0 0 1 1 0 0 0 0))	;53 = pi
	  ((0 1 x 0 0 1 1 0 1)		(0 0 1 1 0 0 0 0))	;15 = us.data, push
	  ((0 1 x 0 0 1 1 1 0)		(0 0 1 1 0 0 0 0))	;16 = uinst.dest.low.imod
	  ((0 1 x 0 0 1 1 1 1)		(0 0 1 1 0 0 0 0))	;17 = uinst.dest.high.imod
	  ((0 1 x 0 1 0 0 0 0)		(0 0 1 1 0 0 0 0))	;20 = vma 
	  ((0 1 x 0 1 0 0 0 1)		(0 0 1 1 0 0 0 0))	;21 = vma start read
	  ((0 1 x 0 1 0 0 1 0)		(0 0 1 1 0 0 0 0))	;22 = vma start write
	  ((0 1 x 0 1 0 0 1 1)		(0 0 1 1 0 0 0 1))    ;23 = l1.map,adr by md
	  ((0 1 x 0 1 0 1 0 0)		(0 0 1 1 0 0 1 0))    ;24 = l2 map :control bits
	  ((0 1 x 0 1 0 1 0 0)		(0 0 1 1 0 0 1 0))    ;64 = l2 map :phys page
	  ((0 1 x 0 1 0 1 1 0)		(0 1 1 1 0 0 0 0))    ;26 = cram adr map
	  ((0 1 x 0 1 1 0 0 0)		(0 0 1 1 0 0 0 0))	;30 = md
	  ((0 1 x 0 1 1 0 0 1)		(0 0 1 1 0 0 0 0))	;31 = md start read
	  ((0 1 x 0 1 1 0 1 0)		(0 0 1 1 0 0 0 0))	;32 = md start write
	  ((0 1 x 0 1 1 0 1 1)		(0 0 1 1 0 0 0 0))	;33 = c.pdl.index ,increment 
	  ((0 1 x 0 1 1 1 0 0)		(0 0 1 1 0 0 0 0))	;34 = uinst.dest.us
	  ((0 1 x 0 1 1 1 0 1)		(0 0 1 1 0 0 0 0))	;35 = uinst.dest.usp
	  ((0 1 x 0 1 1 1 1 0)		(0 0 1 1 0 0 0 0))	;36 = c.pdl.index ,decrement
	  ((0 1 x 0 1 1 1 1 1)		(1 0 0 0 0 0 0 0))	;37 = multiplier
	  (("default")			(0 0 1 1 0 0 0 0))
	  ))

;; pc control prom 0
;;	512x8 : generates pc control signals based on conditions which set up early
;;		in the cycle.  These are then combined with late conditions in a series
;;		of a-o-i gates to control npc-select and the stack
;;
;;			inputs   	 ______		outputs
;;					|      |	
;;	8. -need.macro.inst.fetch	|      |	7. pop.if.true
;;	7. us.top.level.flag		|      |	6. pop.if.false
;;	6. no.op			|      |	5. us.or.d.bus.if.true
;;	5. source.us.pop.entire.cycle	|      |	4. us.or.d.bus.if.false
;;	4. uinst.popj.after.next	|      |	3. jump.if.true
;;	3. jump.invert			|      |	2. jump.if.false
;;	2. jump.R			|      |	1. forced.pop
;;	1. jump.P			|      |	0. allow.valid.pop
;;	0. cm.ir.jump		  	|      |	
;;					|______|	
;;

;;;forced.pop 	goes into US.POP AOI. ANDed with ALLOW.FORCED.POP causes US.POP.
;;;	ALLOW.FORCED.POP is  IR.DISPATCH  AND  DISPATCH.R
;;;allow.valid.pop
;;;	ALLOW.VALID.POP goes into US.POP AOI and NPC.SELECT.1 AOI.
;;;	   ANDED with DISPATCH.R, -DISPATCH.P, and CM.IR.DISPATCH causes US.POP
;;;	   above condition OR ALLOW.VALID.POP and UINST.POPJ.AFTER.NEXT and ALLOW.FORCED.POP
;;;		causes -NPC.SELECT.1

;;; some observations:
;;;;  if no us.top.level.flag, -need.macro.inst.fetch is irrelavent
;;;;  if source.us.pop.entire.cycle, we should not have
;;;;      popj.after.next OR (cm.ir.jump AND (jump.R OR jump.P))

(defconst pc-0-spec
	'(pc-0 512. 8.
		      ((x x 0 1 1 x x x x)      (0 0 0 0 0 0 0 0))  ;detect illegal conditions
		      ((x x 0 1 0 x 1 x 1)      (0 0 0 0 0 0 0 0))
		      ((x x 0 1 0 x x 1 1)	(0 0 0 0 0 0 0 0))
	;jump instructions
		;jump invert = 0, no popj.a.n
									;P=0, R=0
		      ((x x 0 0 0 0 0 0 1)	(0 0 0 0 1 0 0 0))	;simple jump
									;
									;P=1, R=0
		      ((x x 0 0 0 0 0 1 1)	(0 0 0 0 1 0 0 0))	;pushj
									;
									;P=0, R=1
		      ((x 0 0 0 0 0 1 0 1)	(1 0 1 0 1 0 0 1))	;popj, no US.TOP
		      ((0 1 0 0 0 0 1 0 1)	(1 0 1 0 1 0 0 1))	;popj
		      ((1 1 0 0 0 0 1 0 1)	(0 0 1 0 0 0 0 1))	;macro ir direct
									;
									;P=1, R=1
		      ((x x 0 0 0 0 1 1 1)	(0 0 0 0 1 0 0 0))	;not used, but
									;defaults to simple
									;jump anyway
			;jump invert = 1
									;P=0, R=0
		      ((x x 0 0 0 1 0 0 1)	(0 0 0 0 0 1 0 0))	;simple jump
									;
									;P=1, R=0
		      ((x x 0 0 0 1 0 1 1)	(0 0 0 0 0 1 0 0))	;pushj
									;
									;P=0, R=1
		      ((x 0 0 0 0 1 1 0 1)	(0 1 0 1 0 1 0 1))	;popj
		      ((0 1 0 0 0 1 1 0 1)	(0 1 0 1 0 1 0 1))	;popj
		      ((1 1 0 0 0 1 1 0 1)	(0 0 0 1 0 0 0 0))	;macro ir direct
									;
									;P=1, R=1
		      ((x x 0 0 0 1 1 1 1)	(0 0 0 0 0 1 0 0))	;not used, but
									;defaults to simple
									;jump
			;jump, uinst.popj.a.n = 1
		      ((x 0 0 0 1 x x x 1)	(0 0 0 0 0 0 1 1))	;force popj
		      ((0 1 0 0 1 x x x 1)	(0 0 0 0 0 0 1 1))	;force popj
		      ((1 1 0 0 1 x x x 1)	(0 0 0 0 0 0 0 0))	;macro.ir.direct
									;
		      ((x x 0 1 0 0 0 0 1)      (0 0 0 0 1 0 1 0))      ;simple jump, pops
		      ((x x 0 1 0 1 0 0 1)      (0 0 0 0 0 1 1 0))      ;simple jump invert,
									; pops stack
									;
	;cm.ir.jump = 0 in the cases of dispatch, byte, or alu instructions
									;
	;no jump, uinst.popj.a.n = 1  but note: it might not really do it if inst is a
	;dispatch that JUMPs or CALLs.
		      ((x 0 0 0 1 x x x 0)	(0 0 0 0 0 0 1 1))	;force popj
		      ((0 1 0 0 1 x x x 0)	(0 0 0 0 0 0 1 1))	;force popj
		      ((1 1 0 0 1 x x x 0)	(0 0 0 0 0 0 0 0))	;macro.ir.direct
									;
									;
       ;if us.top.level.flag and -need.macro.inst.fetch, turn off allow.valid.pop
       ; since dispatch which POPJs wants to do macro.ir.direct.
		      ((1 1 0 0 0 x x x 0)      (0 0 0 0 0 0 0 0))

       ;source.pop=1, (pops stack, but goes to ipc)
		      ((x x 0 1 0 x x x 0)	(0 0 0 0 0 0 1 1))
       ;no.op = 1, nothing regardless of other conditions
		      ((x x 1 x x x x x x)	(0 0 0 0 0 0 0 0))
       ;default ALLOW.VALID.POP allows dispatch which POPJs to work.
		      ((x x x x x x x x x "DEFAULT")
		       				(0 0 0 0 0 0 0 1))	;DEFAULT = ipc
									;
			
						 ))



;; pc control prom 1
;;	512x8 : generates pc control signals based on conditions which set up early
;;		in the cycle.  These are then combined with late conditions in a series
;;		of a-o-i gates to control npc-select and the stack
;;
;;			inputs   	 ______		outputs
;;					|      |	
;;	8. -need.macro.inst.fetch	|      |	7. pushj.if.true
;;	7. us.top.level.flag		|      |	6. pushj.if.false
;;	6. no.op			|      |	5. enable.jump.n.noop.next.if.true
;;	5. source.us.pop.entire.cycle	|      |	4. enable.jump.n.noop.next.if.false
;;	4. uinst.popj.after.next	|      |	3. 
;;	3. jump.invert			|      |	2. illegal.condition
;;	2. jump.R			|      |	1. next.m.i.if.true
;;	1. jump.P			|      |	0. next.m.i.if.false
;;	0. cm.ir.jump		  	|      |	
;;					|______|	
;;


;;; some observations:
;;;;  if no us.top.level.flag, -need.macro.inst.fetch is irrelavent
;;;;  if source.us.pop.entire.cycle, we should not have
;;;;      popj.after.next OR (cm.ir.jump AND (jump.R OR jump.P))
;;;;NOTE: the next.m.i conditions having to do with popj.after.next or with dispatch.return
;;;; are generated by separate terms on the AOI gate.  This guy generates only conditions
;;;; having to do with conditional-POPJ.

(defconst pc-1-spec
	'(pc-1 512. 8.
		      ((x x 0 1 1 x x x x)      (0 0 0 0 0 1 0 0))  ;detect illegal conditions
		      ((x x 0 1 0 x 1 x 1)      (0 0 0 0 0 1 0 0))
		      ((x x 0 1 0 x x 1 1)	(0 0 0 0 0 1 0 0))
									;first, the case
	       								;of jump instructions
									;and not no.op
									;
									;source.pop = 0
									;popj.next = 0
									;
									;jump invert = 0
									;
									;P=0, R=0
		      ((x x 0 0 0 0 0 0 1)	(0 0 1 0 0 0 0 0))	;simple jump
									;
									;P=1, R=0
		      ((x x 0 0 0 0 0 1 1)	(1 0 1 0 0 0 0 0))	;pushj
									;
									;P=0, R=1
		      ((x 0 0 0 0 0 1 0 1)	(0 0 1 0 0 0 0 0))	;popj
		      ((0 1 0 0 0 0 1 0 1)	(0 0 1 0 0 0 1 0))	;popj
		      ((1 1 0 0 0 0 1 0 1)	(0 0 1 0 0 0 1 0))	;macro ir direct
									;
									;P=1, R=1
		      ((x x 0 0 0 0 1 1 1)	(0 0 1 0 0 1 0 0))	;not used, but
									;defaults to simple
									;jump anyway
									;
									;
									;jump invert = 1
									;
									;P=0, R=0
		      ((x x 0 0 0 1 0 0 1)	(0 0 0 1 0 0 0 0))	;simple jump
									;
									;P=1, R=0
		      ((x x 0 0 0 1 0 1 1)	(0 1 0 1 0 0 0 0))	;pushj
									;
									;P=0, R=1
		      ((x 0 0 0 0 1 1 0 1)	(0 0 0 1 0 0 0 0))	;popj
		      ((0 1 0 0 0 1 1 0 1)	(0 0 0 1 0 0 0 1))	;popj
		      ((1 1 0 0 0 1 1 0 1)	(0 0 0 1 0 0 0 1))	;macro ir direct
									;
									;P=1, R=1
		      ((x x 0 0 0 1 1 1 1)	(0 0 0 1 0 1 0 0))	;not used, but
									;defaults to simple
									;jump
									;
									;
									;uinst.popj.a.n = 1
		      ((x 0 0 0 1 0 x x 1)	(0 0 1 0 0 0 0 0))	;force popj
		      ((x 0 0 0 1 1 x x 1)	(0 0 0 1 0 0 0 0))	;force popj
		;see above note re next.macro.inst.
		      ((0 1 0 0 1 0 x x 1)	(0 0 1 0 0 0 0 0))	;force popj
		      ((0 1 0 0 1 1 x x 1)	(0 0 0 1 0 0 0 0))	;force popj
		      ((1 1 0 0 1 0 x x 1)	(0 0 1 0 0 0 0 0))	;macro.ir.direct
		      ((1 1 0 0 1 1 x x 1)	(0 0 0 1 0 0 0 0))	;macro.ir.direct
					 ;next macro.inst, but its generated by other terms
									;
		      ((x x 0 1 0 0 0 0 1)      (0 0 1 0 0 0 0 0))      ;simple jump, pops
		      ((x x 0 1 0 1 0 0 1)      (0 0 0 1 0 0 0 0))      ;simple jump invert,
									; pops stack

	;cm.ir.jump = 0 in the cases of dispatch, byte, or alu instructions
									;
	;no jump, uinst.popj.a.n = 1 but note: it might not really do it if inst is a
	;dispatch that JUMPs or CALLs.
		      ((x 0 0 0 1 x x x 0)	(0 0 0 0 0 0 0 0))	;force popj
		      ((0 1 0 0 1 x x x 0)	(0 0 0 0 0 0 0 0))	;force popj
		      ((1 1 0 0 1 x x x 0)	(0 0 0 0 0 0 0 0))	;macro.ir.direct
					;next.macro.inst, but its generated by other terms.
									;
		      ((x x 0 1 0 x x x 0)	(0 0 0 0 0 0 0 0))	;source.pop = 1
									;uinst.popj = x
									;(pops stack, but
									;goes to ipc)
									;
									;
		      ((x x 1 x x x x x x)	(0 0 0 0 0 0 0 0))	;no.op = 1, regardless
									;of other conditions,
									;get ipc
		      ((x x x x x x x x x "DEFAULT")
		       				(0 0 0 0 0 0 0 0))	;DEFAULT = ipc
									;
			
						 ))

;;******************************************************************************************


;;  MI board
;;
;;1.nu-control prom
;;	2 512x8s : decodes low bits of address to find transaction type
;;  inputs: gnd,nu.ack.at.strt,nutm.0,nuadr.5,nuadr.4,nuadr.3,nuadr.2,nuadr.1,nuadr.0
;;  outputs: nu.block.op, nu.block.op L, nu.word.op, nu.halfword.op, nu.byte.op, nu.idle.op,
;;		unused, unused.
;; note that TM0 and NUADR.n are inverted with respect to the bus.
(defconst nu-control-0-spec			;goes in f11 on version 1
	'(nu-control-0 512. 8.
	   ((x 1 x x x x x x x)		(0 1 0 0 0 1 0 0))	;disable if nu.ack.at.start
	   ((x 0 1 x x x x x x)		(0 1 0 0 1 0 0 0))	;byte operation
	   ((x 0 0 x x x x 1 1)		(0 1 0 1 0 0 0 0))	;halfword 1
	   ((x 0 0 x x x x 1 0)		(1 0 0 0 0 0 0 0))	;block operation
	   ((x 0 0 x x x x 0 1)		(0 1 0 1 0 0 0 0))	;halfword 0
	   ((x 0 0 x x x x 0 0)		(0 1 1 0 0 0 0 0))))	;word operation

(defconst nu-control-1-spec			;goes in f10 on version 1
	'(nu-control-1 512. 8.
	   ((x 1 x a b c d x x)		(1 1 1 1 a b c d))	;disable is nu.ack.at.start
	   ((x 0 1 a b c d x x)		(1 1 1 1 a b c d))	;byte operation
	   ((x 0 0 a b c d 1 1)		(1 1 1 1 a b c d))	;halfword 1
	   ((x 0 0 a b c 0 1 0)		(1 1 1 0 a b c 0))	;block operation 2 long
	   ((x 0 0 a b 0 1 1 0)		(1 1 0 0 a b 0 0))	;block operation 4 long
	   ((x 0 0 a 0 1 1 1 0)		(1 0 0 0 a 0 0 0))	;block operation 8 long
	   ((x 0 0 0 1 1 1 1 0)		(0 0 0 0 0 0 0 0))	;block operation 16 long
	   ((x 0 0 a b c d 0 1)		(1 1 1 1 a b c d))	;halfword 0
	   ((x 0 0 a b c d 0 0)		(1 1 1 1 a b c d))))	;word operation


;;2.spy decode prom
;;      a 512x8 decodes the spy address field along with the spy-read/spy-write bit
;;
(defconst mi-spy-0-spec
	'(mi-spy-0 512. 8.
	  ((x x 0 x x x x x x) 		(0 1 1 1 1 1 1 1))	;spy not selected
	
	  ((x x 1 1 0 0 0 0 1)		(0 1 1 1 1 1 x 0))	;01 = read.csm.adr.and.
	  							; cached.phys.adr L
;; spy.control.mfo L is on for 0-7, 21, 22, and reads of 17 ...
	  ((x x 1 x 0 0 x x x)		(x x x x x x 0 x))	;0-7 = rg.spy.control.mfo L
	  ((x x 1 1 0 1 1 1 1)		(x x x x x x 0 x))	;17 = rg.spy.control.mfo L
	  ((x x 1 x 1 0 0 0 1)		(x x x x x x 0 x))	;21 = rg.spy.control.mfo L
	  ((x x 1 x 1 0 0 1 0)		(x x x x x x 0 x))	;22 = rg.spy.control.mfo L
	  ((x x 1 1 0 0 0 0 0)		(0 1 1 1 1 0 x 1))	;00 = read.csm L
	  ((x x 1 1 0 0 0 1 0)		(0 1 1 1 0 1 x 1))	;02 = read.csm.reg L
	  ((x x 1 1 0 0 0 1 1)		(0 1 1 0 1 1 x 1))	;03 = read.md L
	  ((x x 1 0 0 0 0 0 0)		(0 1 0 1 1 1 x 1))	;00 = write.csm L
	  ((x x 1 0 0 0 0 0 1)		(0 0 1 1 1 1 x 1))	;01 = write.csm.adr L

	  (("default")			(0 1 1 1 1 1 1 1))
	  ))


;;3. nu-encoding prom
;;	512 x 8 : encodes low bits of address during write from lambda

(defconst nu-encode-spec				;goes in e5 on version 1
	'(nu-encode 512. 8.
  ;inputs: packetize pkt.size.1 pkt.size.0 vma.3 vma.2 vma.1 vma.0 phys.1 phys.0
  ;  encoding here is pkt.size 0 -> word op, 1 -> byte ops, 2 -> block 2, 3 -> block 16.
  ;
  ;REMEMBER, the outputs are inverted before reaching the nubus
  ;outputs: encoding.error, encoded.tm.0, encoded.address.<5-0>

	  ((x 0 0 a b c d 0 0)		(0 0 a b c d 0 0))	;word op, no block
	  ((x 0 0 a b c d 0 1)		(0 0 a b c d 0 1))      ;halfword 0
	  ((x 0 0 a b c d 1 0)		(1 0 a b c d 0 0))	;word op,  encoding error
	  ((x 0 0 a b c d 1 1)		(0 0 a b c d 1 1))	;halfword 1
	  ((x 0 1 a b c d e f)		(0 1 a b c d e f))      ;byte op
	  ((1 1 0 a b c d 0 0)		(0 0 a b c 0 1 0))	;block op 2 long
	  ((1 1 0 a b c d 0 1)		(1 0 a b c 0 1 0))	;block op 2 long
	  ((1 1 0 a b c d 1 0)		(1 0 a b c 0 1 0))	;block op 2 long
	  ((1 1 0 a b c d 1 1)		(1 0 a b c 0 1 0))	;block op 2 long
	  ((0 1 0 a b c d 0 0)		(0 0 a b c d 0 0))	;use word instead of block
								; on writes.
	  ((0 1 0 a b c d 0 1)		(1 0 a b c d 0 0))	;word op,  encoding error
	  ((0 1 0 a b c d 1 0)		(1 0 a b c d 0 0))	;word op,  encoding error
	  ((0 1 0 a b c d 1 1)		(1 0 a b c d 0 0))	;word op,  encoding error
	  ((1 1 1 a b c d 0 0)		(0 0 0 1 1 1 1 0))	;block op 16 long
	  ((1 1 1 a b c d 0 1)		(1 0 0 1 1 1 1 0))	;block op, encoding error
	  ((1 1 1 a b c d 1 0)		(1 0 0 1 1 1 1 0))	;block op, encoding error
	  ((1 1 1 a b c d 1 1)		(1 0 0 1 1 1 1 0))	;block op, encoding error
	  ((0 1 1 a b c d 0 0)		(0 0 a b c d 0 0))	;use word instead of block
								; on writes.
	  ((0 1 1 a b c d 0 1)		(1 0 a b c d 0 0))	;word op,  encoding error
	  ((0 1 1 a b c d 1 0)		(1 0 a b c d 0 0))	;word op,  encoding error
	  ((0 1 1 a b c d 1 1)		(1 0 a b c d 0 0))))	;word op,  encoding error

;;******************************************************************************************


;;  DP board
;;
;;1.dispatch masker prom
;;	512x8 : creates DMASK from dispatch length

(defconst dmask-spec		
	'(dmask 512. 8.
	  ((0 0 0 0 0 0 0 0 0)		(0 0 0 0 0 0 0 0))	;0 
	  ((0 0 0 0 0 0 0 0 1)		(0 0 0 0 0 0 0 1))	;1 
	  ((0 0 0 0 0 0 0 1 0)		(0 0 0 0 0 0 1 1))	;2 
	  ((0 0 0 0 0 0 0 1 1)		(0 0 0 0 0 1 1 1))      ;3 
	  ((0 0 0 0 0 0 1 0 0)		(0 0 0 0 1 1 1 1))	;4 
	  ((0 0 0 0 0 0 1 0 1)		(0 0 0 1 1 1 1 1))	;5
	  ((0 0 0 0 0 0 1 1 0)		(0 0 1 1 1 1 1 1))	;6 
	  ((0 0 0 0 0 0 1 1 1)		(0 1 1 1 1 1 1 1))	;7 
	  ((0 0 0 0 0 1 0 0 0)		(1 1 1 1 1 1 1 1))	;10
	  (("default")			(0 0 0 0 0 0 0 0))))	;otherwise,byte width is zero


;;2. alu control prom
;;	512x8 : controls ALUs based on uinst and some saved state
;;
;;		inputs   	 ______		outputs
;;				|      |	
;;	8. divisor.sign		|      |	7. load.divisor.sign
;;	7. q.0			|      |	6. enable.carry.from.uinst
;;	6. dp.uinst.opcode.1	|      |	5. forced.carry
;;	5. dp.uinst.opcode.0	|      |	4. aluf.3
;;	4. ir.alu.control.4	|      |	3. aluf.2
;;	3. ir.alu.control.3	|      |	2. aluf.1
;;	2. ir.alu.control.2	|      |	1. aluf.0
;;	1. ir.alu.control.1	|      |	0. alumode
;;	0. ir.alu.control.0    	|      |	
;;				|______|	
;;



(defconst alu-control-spec
	'(alu-control 512. 8.
		      ((x x 0 0 0 (not b) (not c) d f)
					        (0 0 0 f d b c 1))	;boolean operations
									;control adr 00-17

		      ((x x 0 0 1 1 0 0 1)	(0 1 0 1 0 0 1 0))	;add
		      ((x x 0 0 1 0 1 1 0)	(0 1 0 0 1 1 0 0))	;sub
		      ((x x 0 0 1 1 1 0 0)	(0 1 0 0 0 0 0 0))	;M+1
		      ((x x 0 0 1 1 1 1 1)	(0 1 0 1 1 0 0 0))	;M+M

		      ((x x 1 0 x x x x x)	(0 0 0 0 1 1 0 0))	;sub if jump

		      ((x x 1 1 x x x x x)	(0 0 0 1 1 1 1 1))	;setm if dispatch

		      ((x 1 0 0 1 0 0 0 0)	(0 0 0 1 0 0 1 0))	;mult, q.0     (+)
		      ((x 0 0 0 1 0 0 0 0)	(0 0 0 1 1 1 1 1))	;multiply      (setm)
		      ((x 1 0 0 1 0 0 0 1)	(0 0 1 0 1 1 0 0))	;mult last, q.0 (-)
		      ((x 0 0 0 1 0 0 0 1)	(0 0 0 1 1 1 1 1))	;multiply last (setm)

									;divisor.sign = 0
		      ((0 x 0 0 1 0 0 1 0)	(1 0 1 0 1 1 0 0))	;first step    (-)
		      ((0 0 0 0 1 0 0 1 1)	(0 0 0 1 0 0 1 0))	;step, q.0 =0  (+)
		      ((0 1 0 0 1 0 0 1 1)	(0 0 1 0 1 1 0 0))	;step      =1  (-)
		      ((0 0 0 0 1 0 1 0 0)	(0 0 0 1 0 0 1 0))	;rem-corr, q.0 (+)
		      ((0 1 0 0 1 0 1 0 0)	(0 0 0 1 1 1 1 1))	;rem-corr      (setm)

									;divisor.sign = 1
		      ((1 x 0 0 1 0 0 1 0)	(1 0 0 1 0 0 1 0))	;first step    (+)
		      ((1 0 0 0 1 0 0 1 1)	(0 0 1 0 1 1 0 0))	;step, q.0 =0  (-)
		      ((1 1 0 0 1 0 0 1 1)	(0 0 0 1 0 0 1 0))	;step      =1  (+)
		      ((1 0 0 0 1 0 1 0 0)	(0 0 1 0 1 1 0 0))	;rem-corr, q.0 (-)
		      ((1 1 0 0 1 0 1 0 0)	(0 0 0 1 1 1 1 1))	;rem-corr      (setm)

		      ((x x x x x x x x x "DEFAULT")
		       				(0 0 0 0 0 1 1 1))	;DEFAULT = SETZ
			
						 ))

	  

;;3. output selector control prom

;;	512x8 : controls output selector based on uinst
;;              we really only produce two bits of information out, but these
;;              are replicated for loading purposes
;;
;;		inputs   	 ______		outputs
;;				|      |	
;;   8. gnd			|      |	7. osel.a.0
;;   7. gnd			|      |	6. osel.a.1
;;   6. gnd			|      |	5. osel.b.0
;;   5. gnd			|      |	4. osel.b.1
;;   4. gnd			|      |	3. osel.c.0
;;   3. ir.output.bus.control.1	|      |	2. osel.c.1
;;   2. ir.output.bus.control.0	|      |	1. osel.d.0
;;   1. dp.uinst.opcode.1	|      |	0. osel.d.1
;;   0. dp.uinst.opcode.0   	|      |	
;;				|______|	
;;



(defconst osel-spec
	'(osel 512. 8.
    ;note output bits are in "wrong" order, arithmetically.
		      ((x x x x x 0 0 0 0)	(0 0 0 0 0 0 0 0))	;pass control bits
		      ((x x x x x 1 0 0 0)	(0 1 0 1 0 1 0 1))	;through on ALU 
		      ((x x x x x 0 1 0 0)	(1 0 1 0 1 0 1 0))	;instructions
		      ((x x x x x 1 1 0 0)	(1 1 1 1 1 1 1 1))	;

		      ((x x x x x x x 1 1)      (1 0 1 0 1 0 1 0))      ;dispatch instruction
    ;selects 1 appended with 0 from masker gives 2, alu output.

		      ((x x x x x x x x x "DEFAULT")
		       				(0 0 0 0 0 0 0 0))	;DEFAULT = select on
									;mask bits
			
						 ))


;;4.

;;.masker proms
;;	8 2Kx4s : used as 1Kx32, outputs masking bits based on input of
;;	byte length and offset
;;
;;	special function for making masker proms rather than tryiing to
;;	adapt the general function
;;	
;;	!! the address and data inputs are still reversed in the wiring!!
;;	we fill a masker prom by taking each address, extracting the byte fields,
;;	deposit ones in a field of zeros (specify the mask), and then extract
;;	the bits corresponding to that particular prom.  We then store that
;;	value, bit reversed, at the bit reversed address (again,
;;	the proms are wired 
;;	wrong on version 1.0 of the lambda
;;	and,unfortunately, on version 2.0)
;;
;;	a complication on version 2 is that the high 1k is used for some special
;;	functions: the high 1k is selected by -dp.ir.byte; then a selector changes
;;	masker.address.6 to ir.alu.output.bus.control.2
;;	masker.address.7 to -dp.ir.alu
;;	masker.address.8 to IR.alu.control.5
;;	masker.address.9 to gnd
;;
;;	the desired function is that in all alu instructions we select constant 0s
;;	or constant 1s on the basis of ir.alu.output.bus.control.2
;;	otherwise, we drive 0s

(defun bit-reverse (word word-length)		;this is just to cope with reversed
  (let ((new-word 0))				;data busses. yuck!
    (dotimes (bit word-length)
      (setq new-word
	    (dpb (ldb (byte 1 bit) word)	;take bit from old word
		 (byte 1 (1- (- word-length bit)))	;specify field in new word
		 new-word)))
    new-word))

;; the LOW address bit is tied LOW on the proms to use them as 1k
;; this is the REAL address bit zero. The right thing to do is to
;; write the same thing in even and odd halves of the  proms
;; the other way to look at it is that the HIGH bit of the address
;; paths to the proms is zero.

(defun make-masker-set (&optional (reverse-bits nil))
  (do* ((prom-number 0 (1+ prom-number))
	(starting-bit 0 (+ 4. starting-bit)))
       ((= prom-number 8.))
      (make-masker-prom (intern (format nil "MASK-~d" prom-number))
			starting-bit
			4.
			reverse-bits)))



(defun reverse-prom (prom &optional (prom-width 4.)
				    (prom-length 2048.)
				    (number-of-address-bits 11.)
				    &aux temp)
  (setq temp (make-array prom-length))
  (dotimes (address prom-length)
    (aset (bit-reverse (aref prom address) prom-width)
	  temp
	  (bit-reverse address number-of-address-bits)))
  temp)

;***next time, add output-selector-mask-30 for flushing CDR-CODES.***

(DEFCONST C-MASK-28  36000000000)
(DEFCONST C-MASK-25  37600000000)		;USEFUL FOR ADDITION TO POINTERS
(DEFCONST C-MASK-24  37700000000)
(DEFCONST C-MASK-20  37774000000)
(DEFCONST C-MASK-16  37777600000)
(DEFCONST C-MASK-12  37777770000)
(DEFCONST C-MASK-11  37777774000)		;USEFUL FOR ADDITION TO PDL POINTER OR INDEX
(DEFCONST C-MASK-8   37777777400)
(DEFCONST C-MASK-4   37777777760)

(DEFCONST C-MASK-JADR      30000037777)		;JUMP ADDRESS ON LOW IMOD  16 wide,14 over
(DEFCONST C-MASK-BYTE-POS  37777777700)		;BYTE POSITION ON LOW IMOD 6 wide, 0 over
(DEFCONST C-MASK-BYTE-LEN  37777770077)		;BYTE LENGTH ON LOW IMOD   6 wide, 6 over
(DEFCONST C-MASK-M-SOURCE  37777777600)		;M-SOURCE ON HIGH IMOD     7 wide, 0 over
(DEFCONST C-MASK-A-SOURCE  37776000177)		;A-SOURCE ON HIGH IMOD     12 wide, 7 over

(defun make-masker-prom (name
			 starting-bit
			 &optional (prom-width 4.)(reverse-bits nil)
			 &aux
			 temp
			 )
  (setq temp (make-array 2048.))		;
  (dotimes (address 2048.)			;
    (cond ((< address 1024.)
	   (let* ((bits-wide (1+ (ldb 0505 address)))	;possible widths are from 1 to 32.
		  (bits-over (ldb 0005 address))	
		  (mc1 (ash 37777777777 bits-over))
		  (mc2 (ash 37777777777 (+ bits-over bits-wide)))
		  (mask (logand 37777777777 (logxor mc1 mc2))))
	     (aset (ldb (byte prom-width starting-bit) mask) 
		   temp
		   address)))
	  
	  (t
	   (let ((ir.alu.control.5 (ldb 1001 address))
		 (-dp.ir.alu (ldb 0701 address))
		 (ir.alu.output.bus.control.2 (ldb 0601 address))
		 (q.control.enabled (ldb 0002 address)))
	     
	     (cond ((= 0 -dp.ir.alu)		;if this is an alu instuction, then do 
						;interesting things, but otherwise
						;default to driving 0s
		    
		    (cond ((= 0 q.control.enabled)   ;default state...forced to zero unless
			   			     ;main.uinst.29 is asserted

			   (cond ((and (= 0 ir.alu.control.5)
				       (= 0 ir.alu.output.bus.control.2))
				  (aset 0 temp address))
				 
				 ((and (= 0 ir.alu.control.5)
				       (= 1 ir.alu.output.bus.control.2))
				  (aset 17 temp address))
				 
				 ((and (= 1 ir.alu.control.5)
				       (= 0 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-25)
					 temp
					 address))
				 
				 ((and (= 1 ir.alu.control.5)
				       (= 1 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-11)
					temp
					address))
			   ))

			  ((= 1 q.control.enabled)	;this will have a side effect
			   				;on the q reg.  watch out!
			   
			   (cond ((and (= 0 ir.alu.control.5)
				       (= 0 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-4)
					 temp
					 address))
				 				 
				 ((and (= 0 ir.alu.control.5)
				       (= 1 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-8)
					 temp
					 address))
								 
				 ((and (= 1 ir.alu.control.5)
				       (= 0 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-12)
					 temp
					 address))
				 
				 ((and (= 1 ir.alu.control.5)
				       (= 1 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-16)
					temp
					address)))
			   )

			  ((= 2 q.control.enabled)	;this will have a side effect
			   				;on the q reg.  watch out!
			   
			   (cond ((and (= 0 ir.alu.control.5)
				       (= 0 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-20)
					 temp
					 address))
				 				 
				 ((and (= 0 ir.alu.control.5)
				       (= 1 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-24)
					 temp
					 address))
								 
				 ((and (= 1 ir.alu.control.5)
				       (= 0 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-28)
					 temp
					 address))
				 
				 ((and (= 1 ir.alu.control.5)
				       (= 1 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-JADR)
					temp
					address)))
			   )

			  ((= 3 q.control.enabled)	;this will have a side effect
			   				;on the q reg.  watch out!
			   
			   (cond ((and (= 0 ir.alu.control.5)
				       (= 0 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-BYTE-POS)
					 temp
					 address))
				 				 
				 ((and (= 0 ir.alu.control.5)
				       (= 1 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-BYTE-LEN)
					 temp
					 address))
								 
				 ((and (= 1 ir.alu.control.5)
				       (= 0 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-M-SOURCE)
					 temp
					 address))
				 
				 ((and (= 1 ir.alu.control.5)
				       (= 1 ir.alu.output.bus.control.2))
				  (aset (ldb (byte prom-width starting-bit) C-MASK-A-SOURCE)
					temp
					address)))
			   )))
		   (t
		    (aset 0 temp address))))
	     )))

  (cond (reverse-bits
	   (set name (reverse-prom temp)))
	 (t (set name temp))))

(defun print-masker-prom-array (array)
  (format t "~%~% bits-wide  bits-over     data~%")
  (do ((length (first (array-dimensions array)))
       (address 0 (1+ address)))
      (( address length))
    (let ((contents  (aref array address)))
      (format t "~%~T~7o  ~T~7o  ~T~12o "
	      (ldb 0005 address)
	      (1+ (ldb 0505 address))		;widths are between 1 and 32.
	      contents)))
  (terpri))

(defun print-masker-set ()
  (format t "~%~% bits-wide  bits-over     data~%")
  (do ((length 2048.)
       (address 0 (1+ address)))
      (( address length))
    (let ((contents  (LIST (aref MASK-7 address)
			     (aref MASK-6 address)
			     (aref MASK-5 address)
			     (aref MASK-4 address)
			     (aref MASK-3 address)
			     (aref MASK-2 address)
			     (aref MASK-1 address)
			     (aref MASK-0 address))))
      (format t "~%~T~7o  ~T~7o  ~{ ~T~2,4r~} "
	      (1+ (ldb 0505 address))		;widths are between 1 and 32.
	      (ldb 0005 address)
	      contents)))
  (terpri))