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

(defun sim-eval (exp)
  (cond ((numberp exp) exp)
	(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 read-open (offset)
  (when (>= offset *registers-per-frame*)
    (ferror 'bad-reg-adr "out of range"))
  (aref (proc-frames *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-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-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-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-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-return-frame *proc*) offset))
	val))