The temptation is to say that formatting output is simple, just use a format statement with ~F or ~E and the appropriate flags.  In fact, things are more complicated than that.  The difficulty is not just because format is permitted by the standard to round 0.5 up or down at its discretion, while the calculator always rounds 0.5 up for positive numbers and down for negative numbers.  There are more awkward problems than that ahead.

The HP-67 calculator, using BCD arithmetic, always had an internal representation that exactly matched the maximum output precision.  Every number that could be displayed could be exactly represented, and there were no left over representations.  Such is not the case with many modern floating-point platforms, such as the familiar IEEE-754 representation used in many modern computers.  Certain decimal values cannot be exactly represented as floats or double-floats, and this leads to some difficulties when trying to emulate the behaviour of the BCD calculator.  I’ve mentioned before the futility of just “throwing more bits at the problem”, this rarely solves the issue, only hides it in more subtle ways.

Here is an example of how things can go wrong.  If you want to represent a small floating-point number to, say, two decimal places, you might be tempted to scale the number up, round it off, then divide it back down.  Watch what happens when I divide two exact powers of ten in double-precision arithmetic:

CL-USER> (/ 1.d99 1.d97)
99.99999999999999d0

This is not helpful.  In fact, a lot of our manipulations of numbers for display are going to have to be in string form.  We round numbers off like grade-schoolers, looking at the digital representation and tweaking it appropriately, everything being passed around as strings, not as numbers.

So, we now have a new module in the tree, display.lisp.  This allows us to display a passed number, either a double-precision float or a rational, in one of three modes.  FIXED displays the number in fixed-point mode, if it can be represented on the 10-digit display with the desired number of digits after the decimal point.  If a number cannot be so displayed, it will be displayed in scientific notation.  An example of such non-displayable numbers might be 0.001 with 2 digits of precision, which would erroneously display as zero in fixed mode, or 100000000000, which has too many digits to display on the screen.

SCIENTIFIC displays in the familiar scientific notation.  If negative, a ‘-‘ is displayed.  Then comes the mantissa which consists of a non-zero digit followed by a decimal point and 0 or more further digits.  After this is either a space, or a minus sign, depending on whether the exponent is positive or negative.  Finally, a 2-digit exponent.

ENGINEERING is much like SCIENTIFIC, but if the exponent is not a multiple of 3, the next higher multiple of 3 is chosen and the mantissa is adjusted to compensate.  The mantissa will always, then, be at least 1 and less than 1000.

Here are the interesting parts of the file.  First, we need to know whether a fixed-mode display has rounded a number to look like zero.  This function scans a string and returns non-nil if the string contains at least one non-zero digit:

(defun string-contains-non-zero-digit (string)
  (dotimes (i (length string))
    (let ((one-char (char string i)))
      (when (and (digit-char-p one-char)
                 (char/= one-char #\0))
        (return-from string-contains-non-zero-digit t))))
  nil)

Next, we’re going to need to manipulate the components of a scientific-notation string, so we have a function that returns a list of the sign of the number, the mantissa, the sign of the exponent, and the exponent:

(defun break-down-sci-notation (string)
  (let* ((negative (char= (char string 0) #\-))
         (epos (position-if #'(lambda (x)
                                (or (char= x #\e)
                                    (char= x #\d))) string))
         (neg-expt (char= (char string (1+ epos)) #\-))
         (mantissa (subseq string
                           (if negative 1 0)
                           epos))
         (expt (subseq string
                       (if neg-expt
                           (+ 2 epos)
                           (1+ epos)))))
    (when (char= (char expt 0) #\+)
      (setf expt (subseq expt 1)))
    (list (if negative "-" " ")
          mantissa
          (if neg-expt "-" " ")
          expt)))

Our engineering notation code is going to have to be able to shift the decimal point up to two digits to the right, padding with zeroes if there aren’t enough characters after the decimal.  It has to be able to handle a bad case that can appear sometimes.  Normally we expect the format statement with ~E to return a mantissa at least one and strictly less than 10.  However, here is what happens sometimes on SBCL v1.1.14:

CL-USER> (format nil "~,8,2E" 1.0d-6)
"10.00000000d-07"

So, the function to shift decimal points has to notice when the point starts in the wrong place, and shift one digit less, while adjusting the exponent appropriately.  That is the what d-pos does in this code:

(defun shift-char-to-right (string start-pos n-shift
                            &key (padding #\0))
  "Moves the character at start-pos n-shift to the right"
  (let ((workspace (copy-seq string))
        (moved (char string start-pos))
        (pad-len (- (+ 1 start-pos n-shift) (length string))))

    (when (> pad-len 0)
      (setf workspace
            (concatenate 'string
                         workspace
                         (make-sequence 'string
                                        pad-len
                                        :initial-element padding))))
    (dotimes (i n-shift)
      (setf (char workspace (+ i start-pos))
            (char workspace (+ i 1 start-pos)))
      (setf (char workspace (+ i 1 start-pos)) moved))
    workspace))

Here, now, is the code to print numbers in fixed mode:

(defun format-for-printing-fix (val digits-after-decimal
                                &key readable)

  (when (= val 0)
    (return-from format-for-printing-fix
      (format nil "~,vF" digits-after-decimal 0.0d0)))
  
  (let* ((negmult (if (< val 0) -1.0d0 1.0d0))
         (scaleup (expt 10.0d0 digits-after-decimal))
         (magnitude (abs val))
         (rounded (* negmult
                     (floor (+ 0.50000000004d0
                               (* magnitude scaleup)))))
         (first-try (format nil "~,v,vF"
                            digits-after-decimal
                            (- digits-after-decimal)
                            rounded))
         (max-width (+ 1 *digits-in-display*
                       (if (< val 0) 1 0))))

    (let ((overrun (- (length first-try) max-width)))
      (cond
        ((and (> overrun 0)
              (<= overrun digits-after-decimal))
         (format-for-printing-fix val
                                  (- digits-after-decimal
                                     overrun)
                                  :readable readable))
        ((> overrun 0)
         (format-for-printing-sci val digits-after-decimal
                                  :readable readable))
        ((and (/= val 0)
              (not (string-contains-non-zero-digit first-try)))
         (format-for-printing-sci val digits-after-decimal
                                  :readable readable))
        (t
         first-try)))))

The code for scientific mode:

(defun format-for-printing-sci (val digits-after-decimal
                                &key readable)
  (when (= 0 val)
    (return-from format-for-printing-sci
      (if readable
          "0.0d0"
          (format nil "~,vE" digits-after-decimal 0.0d0))))
  
  (let* ((magnitude (abs val))
         (first-try (format nil "~A~,v,2E"
                            (if (< val 0) "-" "")
                            digits-after-decimal
                            magnitude))
         formatted)

    (setf first-try (round-sci-notation-to-digits first-try
                                                  digits-after-decimal))

    (unless readable
      (destructuring-bind (sign mantissa e-sign exponent)
          (break-down-sci-notation first-try)

        (setf formatted
              (format nil "~A~vA~A~A"
                      sign
                      (1+ *digits-in-display*)
                      mantissa
                      e-sign
                      exponent))))

    (if readable
        (values first-try first-try)
        (values formatted first-try))))

The code for engineering mode:

(defun format-for-printing-eng (val digits-after-decimal
                                &key readable)
  (multiple-value-bind (junk parsed)
      (format-for-printing-sci val digits-after-decimal
                               :readable readable)
    (declare (ignore junk))
    (when readable
      (return-from format-for-printing-eng parsed))

    (destructuring-bind (sign mantissa e-sign exponent)
        (break-down-sci-notation parsed)

      (let* ((e-num (read-from-string exponent))
             (man-len (length mantissa))
             (shift-num (mod e-num 3)))
        (when (string= e-sign "-")
          (setf shift-num (mod (- 3 shift-num) 3)))
        (when (and (= man-len 3) (= shift-num 2))
          (setf mantissa (format nil "~A0" mantissa)))

        (dotimes (i shift-num)
          (psetf (char mantissa (1+ i)) (char mantissa (+ 2 i))
                 (char mantissa (+ 2 i)) #\.))

        (when (string= e-sign "-")
          (setf e-num (* -1 e-num)))
        (decf e-num shift-num)

        (format nil "~A~vA~A~2,'0D"
                sign
                (1+ *digits-in-display*)
                mantissa
                e-sign
                (abs e-num))))))

This module, and a few supporting changes, are all available in the git repository with the tag v2014-11-04.

At this point, the indirection code was getting unreasonable.  The case-insensitive label we use for indirection, “(i)”,  was starting to show up in too many places.  There’s no reason that the logic for indirection as applied to memory and flags can’t sit entirely in the memory and flag code.  So, this was pushed back into that module.  For simplicity, the I-register was moved from a special value in the structure to just another memory register, one indexed by the label “(i)”.  A new condition was defined for indirection operations that are attempted with the I-register out of its valid domain.  The HP-67 calculator required that the value in the I-register be from 0 to 25, inclusive, for store operations, and 0 to 3, inclusive, for flag operations.  Operations with invalid I-register will now signal a condition that will cause the calculator to enter an error state.

The memory code now looks like this:

(defun canonicalize-memory-name (stack mem-name)
  (when (integerp mem-name)
    (setf mem-name (format nil "~D" mem-name)))
  (assert (stringp mem-name))
  (cond
    ((string-equal mem-name "(i)")
     (multiple-value-bind (junk int-val str-val)
         (get-i-register stack)
       (declare (ignore junk))
       (cond
         ((and (not *unlimited-indirection*)
               (or (< int-val 0) (> int-val 25)))
          (error (make-condition 'i-register-range-error
                                 :value int-val
                                 :min-allowed 0
                                 :max-allowed 25)))
         ((= int-val 25)
          "(i)")
         ((> int-val 19)
          (subseq "ABCDE"
                  (- int-val 20)
                  (- int-val 19)))
         (t
          str-val))))
    (t
     mem-name)))


(defun store-memory-by-name (stack name val)
  "Does no indirection, just stores under the name."
  (setf (stack-memory stack)
        (delete-duplicates
         (push (cons name val)
               (stack-memory stack))
         :key 'car
         :test 'string=
         :from-end t))
  val)

(defun recall-memory-by-name (stack name)
  "Does no indirection, just recalls from the name."
  (let ((record (assoc name
                       (stack-memory stack)
                       :test 'string=)))
    (if record
        (cdr record)
        0)))


(defun store-memory (stack name val)
  (setf name (canonicalize-memory-name stack name))
  (store-memory-by-name stack name val))


(defun recall-memory (stack name)
  (setf name (canonicalize-memory-name stack name))
  (recall-memory-by-name stack name))

(defun set-i-register (stack value)
  (store-memory-by-name stack "(i)" value))

;; Returns 3 values.  The unmodified value of I, the greatest-integer
;; value, and a string holding the greatest-integer value
(defun get-i-register (stack)
  (let ((rval (recall-memory-by-name stack "(i)")))
    (values
     rval
     (floor rval)
     (format nil "~D" (floor rval)))))

The flag code looks like this:

(defun canonicalize-flag-name (stack flag-name)
  (when (integerp flag-name)
    (setf flag-name (format nil "~D" flag-name)))
  (assert (stringp flag-name))
  (cond
    ((string-equal flag-name "(i)")
     (multiple-value-bind (junk int-val str-val)
         (get-i-register stack)
       (declare (ignore junk))
       (cond
         ((and (not *unlimited-indirection*)
               (or (< int-val 0) (> int-val 3)))
          (error (make-condition 'i-register-range-error
                                 :value int-val
                                 :min-allowed 0
                                 :max-allowed 3)))
         (t
          str-val))))
    (t
     flag-name)))
  

(defun set-flag-by-name (stack name &key clear)
  (let ((record (assoc name (stack-flags stack)
                       :test 'string=)))
    (cond
      (record
       (setf (cdr record) (not clear)))
      (t
       (setf (stack-flags stack)
             (push (cons name (not clear))
                   (stack-flags stack)))))))

(defun get-flag-by-name (stack name)
  (let* ((record (assoc name (stack-flags stack)
                       :test 'string=))
         (rval (cdr record)))
    (when (or (string= name "2")
              (string= name "3"))
      (set-flag-by-name stack name :clear t))
    rval))


(defun set-flag-fcn (stack name &key clear)
  (setf name (canonicalize-flag-name stack name))
  (set-flag-by-name stack name :clear clear))

(defun clear-flag-fcn (stack name)
  (set-flag-fcn stack name :clear t))

(defun get-flag-fcn (stack name)
  (setf name (canonicalize-flag-name stack name))
  (get-flag-by-name stack name))

Both are found in “stack.lisp”.

Several more key operations were coded in “calc1.lisp”.  The statistical operations, some flow-control operations, and a key that affects the way data is presented on the screen of the calculator.

The current code is in the git repository, under the tag v2014-11-02.

At this point, the monolithic file we’ve been working on is getting too large.  It makes sense to break things up into logical units.  It’s also time to stop thinking of this in terms of plugging commands into the REPL, and look at actually compiling and loading the files.  So, I’ve broken the big file into several smaller ones, and created an ASDF control file that looks like this:

(defpackage hp67
  (:use :common-lisp :asdf))

(in-package :hp67)

(defsystem "hp67"
  :description "hp67:  a programmable RPN calculator emulator."
  :version "0.1"
  :author "Christopher Neufeld"
  :licence "GPL v3"
  :components ((:file "stack")
               (:file "modes")
               (:file "key-structs"
                      :depends-on ("stack" "modes"))
               (:file "calc1"
                      :depends-on ("key-structs"))))
           

Now, I can issue the command:

CL-USER> (asdf:oos 'asdf:load-op 'hp67)

This compiles any files whose sources are more recent than the compiled .fasl files, and loads the project.

Now, the define-op-key macro that we were using was building structures at macro expansion time, and loading them into a data structure.  That’s not convenient if we want to compile and load the files.  We could define a make-load-form for the key-struct structures, but there’s no need to do that.  Instead, we change the define-op-key macro to issue code to construct the objects, that code will be executed at load time, rather than at macro expansion time.

Now that we can compile our forms, a few typos have shown up, which are corrected in the latest code.  We also get a large pile of warnings about labels that are not used in the expanded forms.  Warnings like that are annoying, because the can obscure more interesting warnings, so we’re going to change them from labels to macrolet forms.

The code described here is in the git repository under the tag v2014-10-31.

The top row of five keys on the calculator are a bit special.  When in run mode, and there are no program steps defined, they are single-key shortcuts for other operations that are shifted on other keys.  The keys are labelled A through E, and when there is no program defined they invoke the operations 1/x, sqrt(X), Y^X, rolldown, and X<->Y.

As soon as even one program step is defined, or in programming mode, the keys become shortcuts for GOSUB operations.  There are 10 possible targets: A through E, and a through e, the lowercase versions being chosen by the yellow F-shift key.

Defining these keys is a pattern that we can handle with a new macro, define-toprow-key.  This macro creates three new key definitions: one for the shortcut arithmetic operation, and one for each of the two GOSUB operations.

At this point, we notice that the stack roll-down operation isn’t going to fit into our previous design of allowing implicit assignments to X by the forms in the function, because we can’t have any pops or pushes to the stack around that operation.  So, we add a keyword override to disable the implicit X-assignment, and make it part of the form parser.

There are a few changes and bugfixes associated with this latest version, rather than reproducing all the new functions, I’ll just show the new macro.  The rest of the file can be seen in the git repository under the tag v2014-10-29.

Here’s the macro, and its invocation:

(defmacro define-toprow-key ((col letter abbreviation doc
                                  &key implicit-x (updates-last-x t))
                             &body arith-forms)
  `(progn
     (define-op-key
         (:location (make-location
                     :row 1
                     :col ,col
                     :category-1 :ARITHMETIC)
                    :modelist '(:RUN-NO-PROG)
                    :abbreviation ,abbreviation
                    :updates-last-x ,updates-last-x
                    :implicit-x ,implicit-x
                    :documentation ,(format nil
                                            "~S (when no program exists)"
                                            doc))
         ,@arith-forms)
     
     (define-op-key
         (:location (make-location
                     :row 1
                     :col ,col
                     :category-1 :FLOW-CONTROL)
                    :modelist '(:RUN-WITH-PROG)
                    :abbreviation ,(format nil
                                           "GSB-~C"
                                           letter)
                    :implicit-x ,implicit-x
                    :updates-last-x nil
                    :documentation ,(format nil
                                            "Call program label ~C"
                                            letter))
         :RETCODE <- '(:GOSUB ,(format nil "~C" letter))
         X <- X)
                    
     (define-op-key
         (:location (make-location
                     :row 1
                     :col ,col
                     :category-1 :FLOW-CONTROL)
                    :modelist '(:RUN-WITH-PROG)
                    :abbreviation ,(format nil
                                           "GSB-~C"
                                           (char-downcase letter))
                    :implicit-x ,implicit-x
                    :updates-last-x nil
                    :documentation ,(format nil
                                            "Call program label ~C"
                                            (char-downcase letter)))
         :RETCODE <- '(:GOSUB ,(format nil "~C"
                                       (char-downcase letter)))
         X <- X)))
                    


(define-toprow-key (1 #\A "1/x" "Reciprocal")
    X <- (/ 1.0d0 X))

(define-toprow-key (2 #\B "sqrt" "Square root")
    X <- (sqrt (to-double-fp X)))

(define-toprow-key (3 #\C "y^x" "Power")
    X <- (expt Y X))

(define-toprow-key (4 #\D "rolld" "Roll stack down"
                      :implicit-x nil
                      :updates-last-x nil)
  (roll-stack-down))

(define-toprow-key (5 #\E "x<>y" "Exchange X and Y"
                      :updates-last-x nil)
  X <- Y
  Y <- X)

We’ve just talked about memory, flags, and indirection.  Memory and flag operations take an argument, the name of the memory register or flag to be used.  Until now, our operations have drawn all their arguments from the stack, so now we will need to modify the code to allow the possibility of additional user-supplied arguments.

The flags only make sense in the context of a running program.  The flag-test operation allows the program to indicate whether or not the following program step should be skipped.  That means we are going to need to have these operation functions return a code.  We will ask that they return a list, as some return codes might have arguments themselves, such as branching directives that take a target name or address.

The convention will be this: keys that take an argument must declare so in the struct, and that argument will then be represented by the symbol ARG in the forms.  The default return value is ‘(:NORMAL-EXIT).  If a different value is to be returned, it must be explicitly set in the forms with a construct of the form :RETCODE <- (…).  If an error is signaled, the return code will always be set to ‘(:ERROR).

These new requirements require us to modify convert-to-setf-forms, expand-rules, and register-key-structure.  Here is the new code for those functions:

(defun convert-to-setf-forms (rules-list 
                              vars-used 
                              output-varnames
                              return-code-symbol
                              return-code-var)
  (let (rv)
    (do ((pos rules-list (cdr pos)))
        ((not pos) rv)
      (cond
        ((and (eq (second pos) *assign*)
              (eq (first pos) return-code-symbol))
         (append rv `((setf ,return-code-var ,(third pos))))
         (setf pos (cddr pos)))
        ((and (member (first pos) vars-used)
              (eq (second pos) *assign*)
              (third pos))
         (setf rv
               (append rv 
                       `((setf ,(nth (position (first pos)
                                               vars-used)
                                     output-varnames)
                               ,(third pos)))))
         (setf pos (cddr pos)))
        ((listp (first pos))
         (setf rv 
               (append 
                rv 
                (list 
                 (convert-to-setf-forms (first pos)
                                        vars-used
                                        output-varnames
                                        return-code-symbol
                                        return-code-var)))))
        (t
         (setf rv (append rv (list (first pos)))))))))

(defun expand-rules (rules-list &key
                                  update-last-x
                                  op-takes-arg)
  (let* ((varnames '(X Y Z W))
         (stack-var (gensym))
         (state-var (gensym))
         (ret-code-var (gensym))
         (vars-used (get-vars-used rules-list
                                   varnames))
         (vars-assigned (get-vars-assigned rules-list
                                           varnames)))

    ;; If this is an implicit X <- form, make it explicit so the setf
    ;; substitution will work later
    (when (and (= 1 (length vars-assigned))
               (not (member *assign* (get-symbols-in-list
                                      rules-list)))
               (= 1 (length rules-list)))
      (setf rules-list 
            (append (list (first varnames) *assign*)
                    rules-list)))

    ;; We need new symbols to hold the assigned values of the stack
    ;; variables, to avoid side-effects on multiple assignments.
    (let (gensyms-output)
      (dolist (v vars-assigned)
        (declare (ignore v))
        (push (gensym) gensyms-output))

      (setf rules-list 
            (convert-to-setf-forms 
             rules-list vars-assigned gensyms-output
             *rcode* ret-code-var))

      `(lambda ,(if op-takes-arg
                    `(,stack-var ,state-var ARG)
                    `(,stack-var ,state-var))
         (declare (ignorable ,stack-var ,state-var))
         (labels
             ((to-radians (angle)
                (convert-angle-to-radians 
                 angle 
                 (modes-angles ,state-var)))
              (from-radians (angle)
                (convert-angle-from-radians 
                 angle 
                 (modes-angles ,state-var)))

              (set-flag (name)
                (set-flag-fcn ,stack-var name))
              (clear-flag (name)
                (clear-flag-fcn ,stack-var name))
              (get-flag (name)
                (get-flag-fcn ,stack-var name))

              (push-val (val)
                (push-stack ,stack-var val))

              (store-mem (name val)
                (cond
                  ((string-equal name "(i)")
                   (store-memory ,stack-var
                                 (get-i-register ,stack-var)
                                 val
                                 :indirection t))
                  (t
                   (store-memory ,stack-var name val))))
              (recall-mem (name)
                (cond
                  ((string-equal name "(i)")
                   (recall-memory ,stack-var
                                  (get-i-register ,stack-var)
                                  :indirection t))
                  (t
                   (recall-memory ,stack-var name))))

              (to-rational (num)
                (convert-number-to-rational 
                 num 
                 (modes-rational ,state-var)))
              (to-double-fp (num)
                (coerce num 'double-float)))

           ,(when update-last-x
                  `(update-last-x ,stack-var))
           (backup-stack ,stack-var)
           (let (,@(mapcar #'(lambda (x) 
                               `(,x (pop-stack ,stack-var))) 
                           vars-used)
                 ,@(mapcar #'(lambda (x) 
                               (list x 0))
                           gensyms-output)
                   (,ret-code-var '(:NORMAL-EXIT)))

             (handler-case
                 (progn
                   ,@rules-list
                   ,@(mapcar #'(lambda (x)
                                 `(push-stack ,stack-var ,x)) 
                             gensyms-output))

               ((or arithmetic-error simple-error not-real-number) (c)
                 (set-error-state ,stack-var c)
                (setf ,ret-code-var '(:ERROR))
                (recover-stack ,stack-var)))
             ,ret-code-var))))))

(defmacro define-op-key ((&key
                          location
                          (id (make-new-id))
                          (mode :RUN-MODE)
                          abbreviation
                          (updates-last-x t)
                          takes-argument
                          documentation)
                         &body run-mode-forms)
  (register-key-structure
   (make-key-struct :key-location location
                    :key-id id
                    :avail-modes mode
                    :abbrev abbreviation
                    :takes-arg takes-argument
                    :doc-string documentation
                    :run-mode-fcn
                    (eval (expand-rules 
                           `(,@run-mode-forms)
                           :update-last-x updates-last-x
                           :op-takes-arg takes-argument))))
  (values))

Here are some keys defined with the new code:

(define-op-key
    (:location (make-location
                :row 5
                :col 1
                :shift :H-BLACK
                :category-1 :FLAGS)
               :takes-argument t
               :abbreviation "SF"
               :documentation "Sets a flag")
  (set-flag ARG)
  X <- X)

(define-op-key
    (:location (make-location
                :row 6
                :col 1
                :shift :H-BLACK
                :category-1 :FLAGS)
               :takes-argument t
               :abbreviation "CF"
               :documentation "Clears a flag")
  (clear-flag ARG)
  X <- X)

(define-op-key
    (:location (make-location
                :row 7
                :col 1
                :shift :H-BLACK
                :category-1 :FLAGS)
               :takes-argument t
               :abbreviation "F?"
               :documentation "Tests a flag")
  (when (not (get-flag ARG))
    :RETCODE <- '(:SKIP-NEXT-STEP))
  X <- X)

(define-op-key
    (:location (make-location
                :row 3
                :col 3
                :category-1 :MEMORY
                :cateogry-2 :MEMORY-STORE)
               :takes-argument t
               :abbreviation "STO"
               :documentation "Saves a memory register")
  (store-mem ARG X)
  X <- X)

(define-op-key
    (:location (make-location
                :row 3
                :col 4
                :category-1 :MEMORY
                :cateogry-2 :MEMORY-RECALL)
               :takes-argument t
               :abbreviation "RCL"
               :documentation "Saves a memory register")
  (recall-mem ARG))


(define-op-key
    (:location (make-location
                :row 3
                :col 3
                :shift :H-BLACK
                :category-1 :MEMORY
                :cateogry-2 :MEMORY-STORE)
               :abbreviation "STI"
               :documentation "Saves by indirection")
  (store-mem "(i)" X)
  X <- X)

(define-op-key
    (:location (make-location
                :row 3
                :col 4
                :shift :H-BLACK
                :category-1 :MEMORY
                :cateogry-2 :MEMORY-RECALL)
               :abbreviation "RCI"
               :documentation "Recalls by indirection")
  (recall-mem "(i)"))

These changes are checked into the github repository under the tag v2014-10-27.