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

(defconst *ucode-frame-size* 16.)
(defconst *ucode-n-frames* 256.)

(defstruct (ucode-vector (:type :named-array))
  frames
  frame-bases
  free-list
  free-list-ptr
  h-open
  h-active
  h-pc
  main-memory
  pc
  next-pc
  zero-bit
  carry-bit
  sign-bit
  overflow-bit
  noop-next-bit
  )

(defconst %ucode-vector-frames 0)
(defconst %ucode-vector-frames 1)
(defconst %ucode-vector-frame-bases 2)
(defconst %ucode-vector-free-list 3)
(defconst %ucode-vector-free-list-ptr 4)
(defconst %ucode-vector-h-open 5)
(defconst %ucode-vector-h-active 6)
(defconst %ucode-vector-h-pc 7)
(defconst %ucode-vector-main-memory 8)
(defconst %ucode-vector-pc 9)
(defconst %ucode-vector-next-pc 11.)
(defconst %ucode-vector-zero-bit 12.)
(defconst %ucode-vector-carry-bit 13.)
(defconst %ucode-vector-sign-bit 14.)
(defconst %ucode-vector-overflow-bit 15.)
(defconst %ucode-vector-noop-next-bit 16.)

(micro:define-micro-function %sim-step (vector)
(locality a-mem)
a-sim-vector (0)
a-sim-frames (0)
a-sim-frame-bases (0)
a-sim-free-list (0)
a-sim-free-list-ptr (0)
a-sim-h-open (0)
a-sim-h-active (0)
a-sim-h-pc (0)
a-sim-main-memory (0)
a-sim-pc (0)
a-sim-next-pc (0)
a-sim-zero-bit (0)
a-sim-carry-bit (0)
a-sim-sign-bit (0)
a-sim-overflow-bit (0)
a-sim-noop-next-bit (0)
(locality i-mem)
	((m-a) pdl-pop)
	((a-sim-vector) m-a)
	(call-data-type-not-equal m-a (a-constant (byte-value q-data-type dtp-array-pointer)) trap)
    (error-table sim-error)
	((vma-start-read) m-a)
	(check-page-read)
	(dispatch transport md)
	(call-data-type-not-equal m-a (a-constant (byte-value q-data-type dtp-array-header)) trap)
    (error-table sim-error)
	(call-if-bit-set (lisp-byte si:%%array-long-length-flag) md trap)
    (error-table sim-error)
	((m-tem) ldb (lisp-byte si:%%array-type-field) md)
	(call-not-equal m-tem (a-constant (eval (lsh art-q si:array-type-shift))) trap)
    (error-table sim-error)
	((vma-start-read) m+a+1