;;;
;;; raven-functional.lisp
;;;
;;; Functional sources and destinations.
;;;

(defun write-functional-destination (address data)
  (case address
    (0 ;; Nop
     )
    (1 ;; Location-counter
     (setf *location-counter* data))
    (3 ;; Micro-stack-pointer
     (setf *microstack-pointer* data))
    (4 ;; Micro-stack-data
     (setf (aref *microstack* (logand *microstack-pointer* #x3f)) data))
    (5 ;; Micro-stack-data-push
     (incf *microstack-pointer*)
     (setf (aref *microstack* (logand *microstack-pointer* #x3f)) data))
    (6 ;; OA-Reg-Low
     (setf *next-micro-instruction* (logior *next-micro-instruction* data)))
    (7 ;; OA-Reg-High
     (setf *next-micro-instruction*
	   (logior *next-micro-instruction*
		   (dpb data (byte 24 32) 0))))
    (#o10 ;; MIB
     (setf *macroinstruction-buffer* data))
    (#o20 ;; VMA
     (setf *virtual-memory-address* data))
    (#o21 ;; VMA-Write-Map-Level-1
     (setf (aref *level-1-map* (ldb (byte 12 13) *memory-data*)) data)
     (setf *virtual-memory-address* data))
    (#o22 ;; VMA-Write-Map-Level-2-Control
     (let* ((map-1 (aref *level-1-map* (ldb (byte 12 13) *memory-data*)))
	    (map-2-address (dpb map-1 (byte 7 5)
				(ldb (byte 5 8) *memory-data*))))
       (setf (aref *level-2-control* map-2-address) data))
     (setf *virtual-memory-address* data))
    (#o23 ;; VMA-Write-Map-Level-2-Address
     (let* ((map-1 (aref *level-1-map* (ldb (byte 12 13) *memory-data*)))
	    (map-2-address (dpb map-1 (byte 7 5)
				(ldb (byte 5 8) *memory-data*))))
       (setf (aref *level-2-address* map-2-address) data))
     (setf *virtual-memory-address* data))
    (#o30 ;; MD
     (setf *memory-data* data))
    (#o40 ;; C-PDL-BUFFER-POINTER
     (setf (aref *pdl-buffer* *pdl-buffer-pointer*) data))
    (#o41 ;; C-PDL-BUFFER-INDEX
     (setf (aref *pdl-buffer* *pdl-buffer-index*) data))
    (#o44 ;; C-PDL-BUFFER-POINTER-PUSH
     (incf *pdl-buffer-pointer*) ;; FIXME: incf or decf?
     (setf (aref *pdl-buffer* *pdl-buffer-pointer*) data))
    (#o45 ;; C-PDL-BUFFER-INDEX-INCREMENT
     (incf *pdl-buffer-index*)
     (setf (aref *pdl-buffer* *pdl-buffer-index*) data))
    (#o50 ;; PDL-BUFFER-POINTER
     (setf *pdl-buffer-pointer* data))
    (#o51 ;; PDL-BUFFER-INDEX
     (setf *pdl-buffer-index* data))
    (t ;; Unhandled or bogus
     (format t "Functional destination #o~o write #x~x.~%" address data))))


(defun read-functional-source (address)
  (case address
    (0 ;; VMA
     *virtual-memory-address*)
    (1 ;; Q-R
     *q-register*)
    (2 ;; MIB-argument-offset-field
     (ldb (byte 6 (* 16 (1- (ldb (byte 1 0) *location-counter*))))
	  *macroinstruction-buffer*))
    (3 ;; Micro-stack-pointer
     *microstack-pointer*)
    (5 ;; Location-counter
     *location-counter*)
    (6 ;; Memory-map-level-2-address
     (let* ((map-1 (aref *level-1-map* (ldb (byte 12 13) *memory-data*)))
	    (map-2-address (dpb map-1 (byte 7 5)
				(ldb (byte 5 8) *memory-data*))))
       (aref *level-2-address* map-2-address)))
    (7 ;; I-Arg
     *dispatch-constant*)
    (#o10 ;; Memory-Map-Level-1
     (aref *level-1-map* (ldb (byte 12 13) *memory-data*)))
    (#o11 ;; Memory-map-level-2-control
     (let* ((map-1 (aref *level-1-map* (ldb (byte 12 13) *memory-data*)))
	    (map-2-address (dpb map-1 (byte 7 5)
				(ldb (byte 5 8) *memory-data*))))
       (aref *level-2-control* map-2-address)))
    (#o12 ;; MIB
     (if (= 1 (ldb (byte 1 0) *location-counter*))
	 *macroinstruction-buffer*
       (logior (ldb (byte 16 16) *macroinstruction-buffer*)
	       (dpb *macroinstruction-buffer* (byte 16 16) 0))))
    (#o13 ;; MIB-branch-offset-field
     (ldb (byte 9 (* 16 (1- (ldb (byte 1 0) *location-counter*))))
	  *macroinstruction-buffer*))
    (#o20 ;; Micro-stack-data
     (aref *microstack* (logand *microstack-pointer* #x3f)))
    (#o21 ;; Micro-stack-data-pop
     (decf *microstack-pointer*)
     (aref *microstack* (logand (+ *microstack-pointer* 1) #x3f)))
    (#o22 ;; MD
     *memory-data*)
    (#o40 ;; C-PDL-BUFFER-POINTER
     (aref *pdl-buffer* *pdl-buffer-pointer*))
    (#o41 ;; C-PDL-BUFFER-INDEX
     (aref *pdl-buffer* *pdl-buffer-index*))
    (#o44 ;; C-PDL-BUFFER-POINTER-POP
     (let ((data (aref *pdl-buffer* *pdl-buffer-pointer*)))
       (decf *pdl-buffer-pointer*) ;; FIXME: decf or incf?
       data))
    (#o45 ;; C-PDL-BUFFER-INDEX-DECREMENT
     (let ((data (aref *pdl-buffer* *pdl-buffer-index*)))
       (decf *pdl-buffer-index*)
       data))
    (#o50 ;; PDL-BUFFER-POINTER
     *pdl-buffer-pointer*)
    (#o51 ;; PDL-BUFFER-INDEX
     *pdl-buffer-index*)
    (t ;; Unhandled or bogus
     (format t "Functional source #o~o read, returning 0.~%" address)
     0)))


;;; EOF
