;;;
;;; alcor-2.lisp
;;;
;;; DEC Alcor 2 (21172) chipset emulation.
;;;

(cl:in-package :alcor-2)


;;; Memory map
;;;
;;; 00.0000.0000 - 01.ffff.ffff : RAM space, cached.
;;; 02.0000.0000 - 7f.ffff.ffff : Reserved space, cached.
;;; 80.0000.0000 - 85.7fff.ffff : PCI sparce memory spaces, uncached.
;;; 85.8000.0000 - 85.ffff.ffff : PCI sparce I/O spaces, uncached.
;;; 86.0000.0000 - 86.ffff.ffff : PCI dense memory space, uncached.
;;; 87.0000.0000 - 87.ffff.ffff : PCI config space, CSRs, FlashROM, uncached.
;;; 88.0000.0000 - 8b.ffff.ffff : PCI byte/word space, uncached.
;;;
;;; Addresses 8c.0000.0000 and higher are unmapped. (not generated by CPU?)

;;;; Memory access.

(defvar *memory-image*)

(defun init-memory-system ()
  ;; Minimum memory size is 32 megs (8 megs/DIMM) in bank 0 (of two banks).
  ;; Per as800 service guide, 6.2.2, page 111.

  ;; To make instruction fetch cheaper, memory is stored as an array
  ;; of (unsigned-byte 32) values.  (ash (ash 32 20) -2) => #x800000.
  (setf *memory-image* (make-array #x800000
				   :element-type '(unsigned-byte 32)
				   :initial-element 0))
  (values))

(defun memory-read-long (address)
  (let ((index (ash address -2)))
    (cond ((< index (length *memory-image*))
	   (aref *memory-image* index))
	  (t
	   (error "Memory read long, address #x~X, unmapped" address)))))

(defun memory-write-long (address value)
  (let ((index (ash address -2)))
    (if (< index (length *memory-image*))
	(setf (aref *memory-image* index) value)
	(format t "Memory write long, #x~8,'0X to #x~X unmapped, ignoring~%"
		value address))))


;;;; Control and Status Registers.

(defconstant +csr-cia-ctrl-writable-bit-mask+ #xb33fffff)
(defconstant +csr-cia-ctrl-initial-value+ #x80000000)
(defvar *csr-cia-ctrl* +csr-cia-ctrl-initial-value+)

(defconstant +csr-cfg-writable-bit-mask+ #x00000003)
(defconstant +csr-cfg-initial-value+ #x00000000)
(defvar *csr-cfg* +csr-cfg-initial-value+)

(defun read-csr (address)
  (case address
    (#x00000100 ;; CIA_CTRL
     *csr-cia-ctrl*)
    (#x00000480 ;; CFG
     *csr-cfg*)
    (t (error "Alcor-2 CSR read #x~8,'0X, unknown" address))))

(defun write-csr (address value)
  (case address
    (#x00000100 ;; CIA_CTRL
     (setf *csr-cia-ctrl* (logand +csr-cia-ctrl-writable-bit-mask+ value)))
    (#x00000480 ;; CFG
     (setf *csr-cfg* (logand +csr-cfg-writable-bit-mask+ value)))
    (t (error "Alcor-2 CSR write #x~8,'0X to #x~8,'0X, unknown"
	      value address))))


;;;; PCI configuration.

(defun read-pci-config (address)
  (declare (ignore address)))

(defun write-pci-config (address value)
  (case *csr-cfg*
    (0 ;; Type 0 configuration cycle.
     (format t "PCI config type 0, IDSEL #x~X function #x~X, reg #x~X~%"
	     (ldb (byte 5 16) address)
	     (ldb (byte 3 13) address)
	     (ash (ldb (byte 6 7) address) 2))
     (format t "    data #x~8,'0X size ~D offset ~D~%"
	     value (ldb (byte 2 3) address) (ldb (byte 2 5) address)))
    (1 ;; Type 1 configuration cycle.
     (error "Alcor-2 PCI config write cycle type 1 unimplemented"))
    (t ;; Bogus configuration cycle.
     (error "Alcor-2 PCI config write bogus cycle type ~D" *csr-cfg*))))


;;;; PCI Sparse I/O.

(defun read-pci-sparse-io (address)
  (let ((size (elt '(:byte :word :tribyte :longword)
		   (ldb (byte 2 3) address)))
	(port-address (ldb (byte 25 5) address)))
    (cond
      ((and (eq size :byte)
	    (= port-address #x71))
       ;; "CMOS" RTC data.
       0)
      ((and (eq size :byte)
	    (= (logandc2 port-address #x100) #x2fd))
       ;; COM port status?
       #x6000)
      (t (error "PCI Sparse I/O ~A read from port #x~6,'0X unsupported"
		size port-address)))))

(defun write-pci-sparse-io (address value)
  (let* ((size-bits (ldb (byte 2 3) address))
	 (size (elt '(:byte :word :tribyte :longword) size-bits))
	 (port-address (ldb (byte 25 5) address)))
    (format t "Alcor-2: PCI Sparse I/O ~A write #x~v,'0X to port #x~6,'0X~%"
	    size
	    (* 2 (1+ size-bits))
	    (ldb (byte (* 8 (1+ size-bits)) (* 8 (logand 3 port-address)))
		 value)
	    port-address)))


;;;; CPU interface.

(defun cpu-read-long (address)
  ;; 8740000100.
  (cond
    ((< address #x0200000000)
     (memory-read-long address))
    ((<= #x8580000000 address #x85ffffffff)
     (read-pci-sparse-io (ldb (byte 31 0) address)))
    ((< #x86ffffffff address #x8720000000)
     (read-pci-config (ldb (byte 21 0) address)))
    #+(or)
    ((<= #x8720000000 address #x873fffffff)
     ;; PCI interrupt acknowledge, returns "vector data".
     )
    ((< #x873fffffff address #x8780000000)
     (read-csr (ldb (byte 30 0) address)))
    (t
     (error "Cpu read long from #x~x, unmapped" address))))

(defun cpu-read-quad (address)
  (dpb (cpu-read-long (+ address 4))
       (byte 32 32)
       (cpu-read-long address)))

(defun cpu-write-long (address value)
  (cond
    ((< address #x0200000000)
     (memory-write-long address value))
    ((<= #x8580000000 address #x85ffffffff)
     (write-pci-sparse-io (ldb (byte 31 0) address) value))
    ((< #x86ffffffff address #x8720000000)
     (write-pci-config (ldb (byte 21 0) address) value))
    ((< #x873fffffff address #x8780000000)
     (write-csr (ldb (byte 30 0) address) value))
    (t
     (error "Cpu write long to #x~x, unmapped" address))))

(defun cpu-write-quad (address value)
  (cpu-write-long address (ldb (byte 32 0) value))
  (cpu-write-long (+ address 4) (ldb (byte 32 32) value)))


;;;; Initialization.

(defun init-alcor-2 ()
  (init-memory-system))


;;; EOF
