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

(defvar *registers-per-frame* 16.)
(defvar *total-frames* 256.)


(defconst inst-bitfields
	  '((%%i-opcode 8)
	    (%%i-src-1-offset 5)
	    (%%i-src-1-base 2)
	    (%%i-src-2-offset 5)
	    (%%i-src-2-base 2)
	    (%%i-dest-offset 5)
	    (%%i-dest-base 2)
	    (%%i-immediate 8)
	    (%%i-aluf 8)
	    (%%i-jump-adr 30.)
	    (%%i-jump-n 1)
	    (%%i-jump-cond 6)
	    ))

(defun set-up-inst-bitfields ()
  (let ((pos 0))
    (dolist (field inst-bitfields)
      (putprop (car field) t 'special)
      (putprop (car field) t 'constant)
      (setf (symbol-value (car field)) (byte (cadr field) pos))
      (incf pos (cadr field)))))

(set-up-inst-bitfields)

(defmacro def-sim-const (name val &optional documentation)
  `(progn 'compile
	  (putprop ',name t 'constant)
	  (defconst ,name ,val ,documentation)))

(def-sim-const %i-op-alu 0)
(def-sim-const %i-op-jump 1)
(def-sim-const %i-op-sim 2)
(def-sim-const %i-op-open 3)
(def-sim-const %i-op-tail-recursive-open 4)
(def-sim-const %i-op-call 5)
(def-sim-const %i-op-tail-recursive-call 6)
(def-sim-const %i-op-return 7)

(def-sim-const %i-base-open 0)
(def-sim-const %i-base-active 1)
(def-sim-const %i-base-return 2)
(def-sim-const %i-base-global 3)

(def-sim-const %i-aluf-setz 0)
(def-sim-const %i-aluf-add 1)
(def-sim-const %i-aluf-set1 2)
(def-sim-const %i-aluf-sub 3)
(def-sim-const %i-aluf-src1-minus-1 4)

(def-sim-const %i-jump-cond-unc 0)
(def-sim-const %i-jump-cond-less-than 1)

(defvar *current-regadr*)
(defvar ra-commands-to-addresses)
(defvar ra-addresses-to-commands)

(defmacro def-reg-adr (name command size)
  (let ((o (intern (string-append "RA-" name "-O") 'sim))
	(e (intern (string-append "RA-" name "-E") 'sim))
	(read (intern (string-append "READ-" name) 'sim))
	(write (intern (string-append "WRITE-" name) 'sim)))
    `(progn 'compile
	    (decf *current-regadr* ,size)
	    (defconst ,o *current-regadr*)
	    (defconst ,e (+ *current-regadr* ,size))
	    (push (cons ',command *current-regadr*) ra-commands-to-addresses)
	    (push (list *current-regadr* ',command ',read ',write) ra-addresses-to-commands))))

(progn
  (setq *current-regadr* -1024.)
  (setq ra-commands-to-addresses nil)
  (setq ra-addresses-to-commands nil)
  (def-reg-adr |unused| |u| 1024.)
  (def-reg-adr open o *registers-per-frame*)
  (def-reg-adr active a *registers-per-frame*)
  (def-reg-adr return r *registers-per-frame*)
  (def-reg-adr frames f (* *registers-per-frame* *total-frames*))
  (def-reg-adr h-open ho *total-frames*)
  (def-reg-adr h-active ha *total-frames*)
  (def-reg-adr h-pc hpc *total-frames*)
  (def-reg-adr free-list-ptr flp 1)
  (def-reg-adr free-list fl *total-frames*)
  )