The HP-67 calculator, naturally, has memory into which numbers can be stored. There are 26 of these memory registers. There are registers 0 through 9, secondary registers 0 through 9, registers “A” through “E”, and special register “I”.
The secondary registers are protected, many memory operations can’t touch them until they are swapped with the primary registers. However, the statistical operations use the secondary registers as their accumulator space, so some care has to be taken with them. The registers “A” through “E” are just normal memory, but the indirection register “I” is special. The “I” register can be used to supply integer arguments to certain other operations, like setting display width, referencing memory, or branching in programs. It is unlikely that the user of the calculator would ever use “I” in interactive use of the calculator, but the indirection register is very useful for writing programs on the calculator. The indirection register holds floating-point values, but only the integer value is used for indirection operations.
When the indirection register is used to refer to memory registers, a value on the interval 0-9 references the primary memory 0 through 9. A value on the interval 10-19 references the secondary memory 0 through 9. A value on the interval 20-24 references the registers “A” through “E”, and a value of 25 references the “I” register itself.
Naturally, in a Lisp program, we’re not memory-constrained to the degree that the HP-67 is. We will, therefore, allow any number of memory registers, keyed against a string name. For backwards compatibility, we will still support the “I” register with its ability to modify numbered memory registers, but those numbers will be converted to strings. The user of the calculator will be encouraged not to use pure numeric names for memory registers, to avoid conflicting with the legacy behaviour built into this emulator.
The HP-67 calculator also has 4 flags. These are boolean registers that can be set by certain relational operators, or set directly with commands, and can be used to control flow in a program. We will support an arbitrary number of named flags. The indirection operator also affects flags, when its value lies between 0 and 3, so we will support that behaviour. Further, flags 2 and 3 are test-cleared. If the value is read, it is returned, but the flag is then reset to false.
So, we’ve got some new slots in our stack structure, and some new functions to manipulate the stack. In the C++ code, I found it helpful to order the memory registers with the most-recently-accessed-or-modified first. I think, for this code, I’ll order them by most-recently-modified first, to avoid the values dancing around the display the way they do in the C++ version. Here’s the new Lisp code:
(defstruct (stack) (registers (list 0 0 0 0)) (registers-copy nil) (num-registers 4) (last-x nil) (memory nil) (register-i 0) (flags '(("0" . nil) ("1" . nil) ("2" . nil) ("3" . nil))) (use-rationals-p nil) (complex-allowed-p nil) (error-state nil)) (defun memory-name (name) (etypecase name (string (copy-seq name)) (integer (format nil "~D" name)))) (defun convert-indirection-name (name) (assert (numberp name)) (let ((num (floor name))) (cond ((or (< num 0) (> num 25)) "") ((= num 25) (values t t)) ((> num 19) (subseq "ABCDE" (- num 20) (- num 19))) (t (format nil "~D" num))))) (defun store-memory (stack name val &key indirection) (let (converted use-i-reg) (cond (indirection (multiple-value-bind (c-name special-i-reg) (convert-indirection-name name) (setf use-i-reg special-i-reg converted c-name))) (t (setf converted (memory-name name)))) (cond (use-i-reg (setf (stack-register-i stack) val)) (t (setf (stack-memory stack) (delete-duplicates (push (cons converted val) (stack-memory stack)) :key 'car :test 'string= :from-end t))))) val) (defun recall-memory (stack name &key indirection) (let (converted use-i-reg) (cond (indirection (multiple-value-bind (c-name special-i-reg) (convert-indirection-name name) (setf use-i-reg special-i-reg converted c-name))) (t (setf converted (memory-name name)))) (cond (use-i-reg (stack-register-i stack)) (t (let ((record (assoc converted (stack-memory stack) :test 'string=))) (if record (cdr record) 0)))))) (defun set-flag (stack name &key clear) (let* ((converted (memory-name name)) (record (assoc converted (stack-flags stack) :test 'string=))) (cond (record (setf (cdr record) (not clear))) (t (setf (stack-flags stack) (push (cons converted (not clear)) (stack-flags stack))))))) (defun clear-flag (stack name) (set-flag stack name :clear t)) (defun get-flag (stack name) (let* ((converted (memory-name name)) (record (assoc converted (stack-flags stack) :test 'string=)) (rval (cdr record))) (when (or (string= converted "2") (string= converted "3")) (clear-flag stack name)) rval)) (defun set-i-register (stack value) (setf (stack-register-i stack) value)) (defun swap-primary-secondary (stack) (dotimes (i 10) (let ((val-prim (recall-memory stack i :indirection t)) (val-second (recall-memory stack (+ i 10) :indirection t))) (store-memory stack i val-second :indirection t) (store-memory stack (+ i 10) val-prim :indirection t))))
This code is in the github repository under the tag v2014-10-25.