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

(defvar *symbol-table* (make-hash-table :test 'equal))

(defun add-symbol (symbol val)
  (puthash (string-upcase symbol) val *symbol-table*))

(defun clear-symbols ()
  (clrhash *symbol-table*))

(defun symbol-lookup (symbol)
  (gethash (string-upcase symbol) *symbol-table*))

(defun sim-eval (exp &aux val)
  (cond ((numberp exp) exp)
	((setq val (symbol-lookup exp))
	 val)
	(t nil)))

(defun ra-command-to-address (command)
  (let ((info (assq command ra-commands-to-addresses)))
    (when (null info)
      (ferror 'bad-reg-adr "unknown reg-adr name ~s" command))
    (cdr info)))

(defun ra-address-info (adr)
  (do ((pair ra-addresses-to-commands (cdr pair))
       (old-pair nil pair))
      ((null pair))
    (cond ((> (caar pair) adr)
	   (return (car old-pair))))))


(defun ra-address-to-command (adr)
  (let ((info (ra-address-info adr)))
    (cadr info)))

(defun ra-read (adr)
  (let ((info (ra-address-info adr)))
    (when (null info)
      (ferror 'bad-reg-adr "unknown register base ~o" adr))
    (when (not (fboundp (caddr info)))
      (ferror 'bad-reg-adr "~s is not implemented" (caddr info)))
    (funcall (caddr info) (- adr (car info)))))

(defun ra-write (adr val)
  (let ((info (ra-address-info adr)))
    (when (null info)
      (ferror 'bad-reg-adr "unknown register base ~o" adr))
    (when (not (fboundp (cadddr info)))
      (ferror 'bad-reg-adr "~s is not implemented" (caddr info)))
    (funcall (caddr info) (- adr (car info)) val)))

(defun read-frames (offset)
  (when (>= offset (* *registers-per-frame* *total-frames*))
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-frames *proc*) offset))

(defun read-open (offset)
  (when (>= offset *registers-per-frame*)
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-frames *proc*)
	(+ (* (proc-frame-size *proc*) (proc-open-frame *proc*)) offset)))

(defun write-open (offset val)
  (when (>= offset *registers-per-frame*)
    (ferror 'bad-reg-adr "out of range"))
  (setf (aref (proc-frames *proc*)
	      (+ (* (proc-frame-size *proc*) (proc-open-frame *proc*) offset)))
	val))

(defun read-active (offset)
  (when (>= offset *registers-per-frame*)
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-frames *proc*)
	(+ (* (proc-frame-size *proc*)
	      (proc-active-frame *proc*)) offset)))

(defun write-active (offset val)
  (when (>= offset *registers-per-frame*)
    (ferror 'bad-reg-adr "out of range"))
  (setf (aref (proc-frames *proc*)
	      (+ (* (proc-frame-size *proc*)
		    (proc-active-frame *proc*)) offset))
	val))

(defun read-return (offset)
  (when (>= offset *registers-per-frame*)
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-frames *proc*)
	(+ (* (proc-frame-size *proc*) (proc-return-frame *proc*)) offset)))

(defun write-return (offset val)
  (when (>= offset *registers-per-frame*)
    (ferror 'bad-reg-adr "out of range"))
  (setf (aref (proc-frames *proc*)
	      (+ (* (proc-frame-size *proc*) (proc-return-frame *proc*)) offset))
	val))

(defun read-free-list-ptr (offset)
  (when (not (zerop offset))
    (ferror 'bad-reg-adr "out of range"))
  (proc-frame-free-list-ptr *proc*))

(defun read-free-list (offset)
  (when (>= offset *total-frames*)
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-frame-free-list *proc*) offset))

(defun read-h-open (offset)
  (when (>= offset *total-frames*)
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-h-open *proc*) offset))

(defun read-h-active (offset)
  (when (>= offset *total-frames*)
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-h-active *proc*) offset))

(defun read-h-pc (offset)
  (when (>= offset *total-frames*)
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-h-pc *proc*) offset))