Now, we start to define the stack object.  It will be a structure that holds the current stack as a list, the defined length of the stack, and the last-X register.  It will also have flags to indicate whether we are forcing rational numbers, whether complex numbers are allowed, and a flag that indicates the stack is in an error state.

If a complex number is passed to the stack when they are no allowed, it should raise a condition, so we’ll also define that.  Then, we have a few stack manipulation functions.

The HP-67 calculator had a 4-register stack, so we’ll default to that, but allow the flexibility to make it longer, or even unlimited.  When the HP-67 calculator popped an item from the stack, the deepest element was duplicated.  That is, the empty space created was not filled with a zero, but kept the value that used to be there.  We will replicate this behaviour, except in the case of unlimited stack depth.  In that case, newly-introduced elements will be zero.

Stack operations will be forbidden if the stack is in an error state.

So, the first version of these components is as follows:

(define-condition not-real-number (error)
  ((val         :initarg value
                :reader get-val))
  (:documentation "Complex number encountered in real-only mode.")
  (:report (lambda (c s)
             (format s "The complex value ~A was encountered."
                     (get-val c)))))

(defstruct (stack)
  (registers            (list 0 0 0 0))
  (num-registers        4)
  (last-x               nil)

  (use-rationals-p      nil)
  (complex-allowed-p    nil)
  (error-state          nil))


(defun trim-list-to-length (list num)
  (assert (<= num (length list)))
  (dotimes (i (1- num))
    (setf list (cdr list)))
  (setf (cdr list) '()))


(defun set-stack-size (stack num)
  "Changes the size of the stack.  Size 0 means unlimited."
  (assert (and (integerp num)
               (>= num 0)))
  (when (and (/= num 0)
             (/= (stack-num-registers stack) num))
    (let ((num-new-entries (- num
                              (length (stack-registers stack)))))
      (cond
        ((> num-new-entries 0)
         (setf (stack-registers stack)
               (append (stack-registers stack)
                       (make-sequence 'list
                                      num-new-entries
                                      :initial-element 0))))
        (t
         (trim-list-to-length (stack-registers stack) num)))))

  (setf (stack-num-registers stack) num))


(defun pop-stack (stack)
  "Returns the first element from the stack."
  (unless (stack-error-state stack)
    (let (rv)
      (cond
        ((and (= 0 (stack-num-registers stack))
              (null stack))
         (setf rv 0))
        (t
         (let ((previous-contents (stack-registers stack)))
           (setf rv (pop previous-contents))
           (when (/= (stack-num-registers stack) 0)
             (setf (stack-registers stack)
                   (append previous-contents (last previous-contents)))))))
      (if (stack-use-rationals-p stack)
          (rational rv)
          rv))))


(defun push-stack (stack val)
  "Pushes an element on the stack."
  (assert (numberp val))
  (unless (stack-error-state stack)
    (when (and (complexp val)
               (not (stack-complex-allowed-p stack)))
      (error (make-condition 'not-real-number
                             :value val)))
    (when (stack-use-rationals-p stack)
      (setf val (rational val)))

    (push val (stack-registers stack))
    (when (/= 0 (stack-num-registers stack))
      (trim-list-to-length (stack-registers stack)
                           (stack-num-registers stack))))
  val)