;;; -*- Mode:LISP; Package:SIM; Readtable:CL; Base:10 -*-

(defsubst read-register (name)
  (micro:%read-a-mem (get name 'micro:a-mem-adr)))

(defsubst write-register (name val)
  (micro:%write-a-mem (get name 'micro:a-mem-adr) val))

(defconst *main-memory-pages* 1024.)
(defvar *main-memory-end*)

(defun make-structures ()
  ;;frames + functional registers
  (let ((array (si:make-wireable-array (+ (truncate 4096. si:page-size) 1) 'art-32b nil)))
    (write-register 'micro:a-sim-frames (+ (si:%pointer-unsigned array)
					   (si:array-data-offset array))))
  (let ((array (si:make-wireable-array (* 4 *main-memory-pages*) 'art-32b nil)))
    (write-register 'micro:a-sim-main-memory (+ (si:%pointer-unsigned array)
						(si:array-data-offset array))))
  (setq *main-memory-end* (* *main-memory-pages* si:page-size))
  )

(defun reset-registers ()
  (write-register 'micro:m-sim-src-1-ptr 0)
  (write-register 'micro:m-sim-src-2-ptr 0)
  (write-register 'micro:m-sim-dest-ptr 0)
  (write-register 'micro:m-sim-last-src-1 0)
  (write-register 'micro:m-sim-last-aluf 0)
  (write-register 'micro:m-sim-inst-0 0)
  (write-register 'micro:m-sim-inst-1 0)
  (write-register 'micro:m-sim-inst-2 0)
  (write-register 'micro:m-open-frame 0)
  (write-register 'micro:m-active-frame 0)
  (write-register 'micro:m-return-frame 0)

 (write-register 'micro:a-sim-pc 0)
 (write-register 'micro:a-sim-next-pc 0)
 (write-register 'micro:a-sim-noop-next-bit 0)
 (write-register 'micro:a-sim-last-src-2 0)
 (write-register 'micro:a-sim-last-result 0)

 (write-register 'micro:a-sim-src-ptrs-valid 0)
 )

(defflavor ucode-sim
	 (
	  )
	 ()
  :settable-instance-variables)

(defmethod (ucode-sim :read-main-mem) (adr)
  (when (or (< adr 0)
	    (>= adr *main-memory-end*))
    (ferror nil "bad adr"))
  (let* ((real-adr (si:%make-pointer-unsigned (+ (* 4 adr) (read-register 'micro:a-sim-main-memory))))
	 (real-adr+1 (+ real-adr 1))
	 (real-adr+2 (+ real-adr 2)))
    (+ (%p-ldb (byte 16. 0) real-adr)
       (dpb (%p-ldb (byte 16. 16.) real-adr) (byte 16. 16.) 0)
       (dpb (%p-ldb (byte 16. 0) real-adr+1) (byte 16. 32.) 0)
       (dpb (%p-ldb (byte 16. 16.) real-adr+1) (byte 16. 48.) 0)
       (dpb (%p-ldb (byte 16. 0) real-adr+2) (byte 16. 64.) 0)
       (dpb (%p-ldb (byte 16. 16.) real-adr+2) (byte 16. 80.) 0))))

(defmethod (ucode-sim :write-main-mem) (adr val)
  (when (or (< adr 0)
	    (>= adr *main-memory-end*))
    (ferror nil "bad adr"))
  (let* ((real-adr (si:%make-pointer-unsigned (+ (* 4 adr) (read-register 'micro:a-sim-main-memory))))
	 (real-adr+1 (+ real-adr 1))
	 (real-adr+2 (+ real-adr 2)))
    (%p-dpb (ldb (byte 16. 0) val) (byte 16. 0) real-adr)
    (%p-dpb (ldb (byte 16. 16.) val) (byte 16. 16.) real-adr)
    (%p-dpb (ldb (byte 16. 32.) val) (byte 16. 0) real-adr+1)
    (%p-dpb (ldb (byte 16. 48.) val) (byte 16. 16.) real-adr+1)
    (%p-dpb (ldb (byte 16. 64.) val) (byte 16. 0) real-adr+2)
    (%p-dpb (ldb (byte 16. 80.) val) (byte 16. 16.) real-adr+2))
  val)