Now, as we start to work on the behaviour of the number keys, it becomes clear that there are some problems with the way this has been laid out, and we’ll have to back up and change some things.

If you are typing in a number on the keypad, and then hit a function key, such as ‘+’, there is an implied press of the ENTER key before the ‘+’.  However, our tokens have been set up to return their results when the function was called.  If we call the operation on ‘+’, and it doesn’t hand back a token, it’s too late to perform the ENTER operation.  We have to know whether or not a key is a token key before we call its associated function.

We can also make some changes to the modal keys.  We had CHS, EEX, and CLX as behaving differently when pressed while a number was being input as when pressed before number construction begins.  However, we can make EEX consistent by changing its behaviour in the number assembly code, we don’t have to define two logical key structures for it.  Similarly, CLX could be implemented as a non-token key, by first pushing the number being assembled onto the stack, and then replacing it with zero.  That leaves only CHS to behave differently.

To work towards this, we’ll have some code that puts together a number based on tokens it receives.  We call this the token assembler structure, and the associated functions are here:

(defstruct (token-assembler)
  (mantissa-sign        1)
  (mantissa             (make-string-output-stream))
  (mantissa-digits      0)
  (exponent-sign        1)
  (exponent             (make-array 2))
  (exponent-digits      0)

  (translation          '((:0 . "0") (:1 . "1") (:2 . "2")
                          (:3 . "3") (:4 . "4") (:5 . "5")
                          (:6 . "6") (:7 . "7") (:8 . "8")
                          (:9 . "9") (:DOT . ".") (:EEX . "d")
                          (:ENTER . :ENTER) (:CLX . :CLX)
                          (:CHS . :CHS)))

  (seen-dot             nil)
  (seen-expt            nil)
  (finalized            nil))


(defun produce-result (assembler)
  (let ((s (make-string-output-stream))
        (e-digs (token-assembler-exponent-digits assembler)))
    (when (= (token-assembler-mantissa-sign assembler) -1)
      (format s "-"))
    (format s "~A" (get-output-stream-string (token-assembler-mantissa assembler)))
    (format s "d")
    (when (= (token-assembler-exponent-sign assembler) -1)
      (format s "-"))
    (cond
      ((= e-digs 0) (format s "0"))
      (t
       (dotimes (i e-digs)
         (format s (aref (token-assembler-exponent assembler) i)))))
    (get-output-stream-string s)))
      

(defun add-token (assembler token)
  (when (eq token :CLX)
    (return-from add-token :RESET))
  (when (eq token :ENTER)
    (return-from add-token :FINALIZE))
  (if (token-assembler-seen-expt assembler)
      (add-token-to-exponent assembler token)
      (add-token-to-mantissa assembler token))
  :CONSTRUCTING)

(defun add-token-to-exponent (assembler token)
  (with-slots ((sign exponent-sign)
               (exp exponent)
               (exp-n exponent-digits)
               (table translation))
      assembler
    (let ((val (cdr (assoc token table))))
      (ecase token
        ((:0 :1 :2 :3 :4 :5 :6 :7 :8 :9)
         (cond
           ((= exp-n 2)
            (setf (aref exp 0) (aref exp 1))
            (setf (aref exp 1) val))
           (t
            (setf (aref exp exp-n) val)
            (incf exp-n))))
        ((:DOT :EEX)
         ;; do nothing
         )
        (:CHS
         (setf sign (* -1 sign)))))))


(defun add-token-to-mantissa (assembler token)
  (with-slots ((sign mantissa-sign)
               (mant mantissa)
               (mant-n mantissa-digits)
               (seen-dot seen-dot)
               (seen-expt seen-expt)
               (table translation))
      assembler
    (let ((val (cdr (assoc token table))))
      (ecase token
        ((:0 :1 :2 :3 :4 :5 :6 :7 :8 :9)
         (when (< mant-n *digits-in-display*)
           (format mant "~A" val)
           (incf mant-n)))
        (:DOT
         (unless seen-dot
           (setf seen-dot t)
           (format mant ".")))
        (:EEX
         (when (= mant-n 0)
           (format mant "1")
           (incf mant-n))
         (setf seen-expt t))
        (:CHS
         (setf sign (* -1 sign)))))))

When I write code from the bottom up, I tend to be surprised by how suddenly it all comes together at the end.  We now write a simple wrapper function, and have some basic calculator behaviour.  No real UI yet, but enough for basic testing.

We’ll write a function that takes the abbreviation string for a keypress, the stack and mode, and closures for unusual behaviour.  We will also allow it to take in numeric values as strings, and interpret those as requests to push those numbers onto the stack.  Note that we haven’t finished setting up the numeric key tokens yet, so we can’t actually handle single-digit numbers in this test code, they’ll get interpreted as keypresses, and won’t do what we want.  With that restriction, though, there is enough here for basic testing.

We parse the passed string for the abbreviation, and look up the key by its mode.  That lookup is a bit complicated because :RUN-MODE-NO-PROG is actually a logical sub-mode of :RUN-MODE, but with higher priority, but that’s not difficult to code.

We look for a numeric string and push it onto the stack if found.  We check to see if an argument is needed and not supplied, and if so we invoke the callback closure to obtain the argument.  Then, we call the function associated with the keypress, check for errors, and return to the caller.  Here is the code to do that, in a new file called engine.lisp:

(defun handle-one-keypress (key-string
                            fetch-argument-closure
                            check-for-interrupt-closure
                            stack mode)

  (declare (ignorable check-for-interrupt-closure))

  (labels
      ((matching-key-struct (abbrev mode ks)
         (and (string= abbrev (key-struct-abbrev ks))
              (member mode (key-struct-avail-modes ks))))

       (matching-key-fallback (abbrev mode ks)
         (when (eq mode :RUN-MODE-NO-PROG)
           (matching-key-struct abbrev :RUN-MODE ks))))

  (let* ((current-mode (modes-run/prog mode))
         (all-keys (get-keys))
         (tokenized (tokenize key-string))
         (abbrev (first tokenized))
         (arg (second tokenized))
         (key (car (or (member-if
                        #'(lambda (x)
                            (matching-key-struct abbrev
                                                 current-mode
                                                 x))
                        all-keys)
                       (member-if
                        #'(lambda (x)
                            (matching-key-fallback abbrev
                                                   current-mode
                                                   x))
                        all-keys)))))

    (unless key
      (let ((data (read-from-string key-string)))
        (typecase data
          (double-float
           (push-stack stack data :DOUBLE-FLOAT)
           (return-from handle-one-keypress :NORMAL-EXIT))
          (single-float
           (format t "Cannot handle single-precision floats")
           (return-from handle-one-keypress :ERROR))
          (rational
           (push-stack stack data :RATIONAL)
           (return-from handle-one-keypress :NORMAL-EXIT))
          (t
           (return-from handle-one-keypress :UNKNOWN-COMMAND)))))
           
    (when (and (key-struct-takes-arg key)
               (not arg))
      (setf arg (funcall fetch-argument-closure abbrev))
      (unless arg
        (return-from handle-one-keypress :MISSING-ARGUMENT)))

    (if (key-struct-takes-arg key)
        (funcall (key-struct-run-mode-fcn key)
                 stack mode arg)
        (funcall (key-struct-run-mode-fcn key)
                 stack mode))

    (if (stack-error-state stack)
        :ERROR
        :NORMAL-EXIT))))

Here are some examples of using this code to perform calculations.  In the first case, we add two numbers.  In the second, we multiple them, and in the third case we store the second number into a memory register.  The STO operation takes an argument, so it calls the closure to obtain its argument, and then continues:

CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "10" arg-fcn nil stack mode)
           (handle-one-keypress "20" arg-fcn nil stack mode)
           (handle-one-keypress "+" arg-fcn nil stack mode)
           stack)
#S(STACK
   :REGISTERS (30 0 0 0)
   :REGISTERS-COPY (20 10 0 0)
   :NUM-REGISTERS 4
   :LAST-X 20
   :MEMORY NIL
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)
CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "10" arg-fcn nil stack mode)
           (handle-one-keypress "20" arg-fcn nil stack mode)
           (handle-one-keypress "*" arg-fcn nil stack mode)
           stack)
#S(STACK
   :REGISTERS (200 0 0 0)
   :REGISTERS-COPY (20 10 0 0)
   :NUM-REGISTERS 4
   :LAST-X 20
   :MEMORY NIL
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)
CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "10" arg-fcn nil stack mode)
           (handle-one-keypress "20" arg-fcn nil stack mode)
           (handle-one-keypress "sto" arg-fcn nil stack mode)
           stack)
Argument for sto:  3

#S(STACK
   :REGISTERS (20 10 0 0)
   :REGISTERS-COPY (20 10 0 0)
   :NUM-REGISTERS 4
   :LAST-X 0
   :MEMORY (("3" . 20))
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)

Now, we put in the rest of the keypress definitions, and adjust our associated data structures in support of these.  At this point, we notice that certain keys have different behaviours depending on the context in which they are pressed.  For instance, the EEX key either puts an exponent on a number that is being constructed, or it starts a new number of the form 1E+<…>.  Similarly, the CHS key either changes the sign of the number in the X register, or introduces a – sign in a number being constructed through the keypad.  The 5 buttons at the top of the calculator call functions in program space, but if there are no defined program steps, they call certain defined short-cuts.  There are also certain operations that don’t do anything in interactive mode, but have their effects only when inside a running program, such as the conditional instruction skip operators.

To cover these cases, we define several modes in which the calculator can find itself.  There’s NUMERIC-INPUT mode, in which keypresses construct a number.  RUN-MODE, the normal interactive mode when the calculator is responding to keypresses.  RUN-MODE-NO-PROG, a specialized form of RUN-MODE when there are no program steps defined.  PROGRAM-EXECUTION, when the calculator is running a program.  PROGRAMMING-MODE, when the calculator is recording a program from the keyboard.

Keypresses can return a normal exit code, or they can pass back directives to the calculator.  These include flow-control directives like GOTO, GOSUB, RETURN-FROM-SUBROUTINE, SKIP-NEXT-STEP, BACk-STEP, SINGLE-STEP, and RUN-STOP.  Also card reader/writer directives with CARD-OPERATION.  There are display directives like PAUSE-1-SECOND, REVIEW-REGISTERS, PAUSE-5-SECONDS, and DISPLAY-STACK.  There is the DELETE-CURRENT-STEP code that tells the calculator to delete a step in the program.  Then there’s TOKEN, which starts or continues the input of a number.  Any keypress that follows that is not TOKEN will implicitly end the input of the number and cause the calculator to behave as if ENTER had been pressed before the next non-TOKEN keypress is handled.

There is also an ERROR return code, which a keypress can send if an illegal operation occurs, such as division by zero or overflow.

With all this, we’re about ready to begin coding the state machine that will execute program steps.  That’s what we’ll begin doing next.

Meanwhile, the code at this point is found in the git repository under the tag v2014-11-12.

Over the past few posts we’ve discussed the realization that we should be using rational numbers for most operations.  To that end, we wrote code to render a rational as a printable string in any one of the three output modes of the calculator.

We have rewritten some of the stack/memory code so that only rational numbers to 10 digits of precision are stored there.  To truncate the rationals at 10 digits, they are parsed as printable 10-digit scientific-notation strings, then the strings are parsed back into exact rational equivalents.

As mentioned earlier, rational numbers are fine for many purposes, but if a function that requires floating point numbers, like sqrt or log, receives a rational number, that number is promoted to a single-precision float.  Single-precision floats generally have less than 10 digits of precision internally, so this is a lossy operation that must not be permitted.  To avoid this, the stack and memory operations can optionally convert the number they return to a double-precision float before handing it to the caller.  The calling environment must explicitly declare whether it will be requesting doubles or rationals.  The parsing code in key-structs.lisp can either set all its stores and recalls to rationals, or all to doubles; the syntax does not permit the mixing of those two modes.  Therefore, if a rational is requested, and a single-precision or double-precision float is later pushed or stored, an error will be raised, one that is not caught by the handlers in the key forms, as this is a programming bug that must be fixed.  In this way, we catch all operations that convert rationals to single-precision floats.

We’ve also written a function to retrieve the parsed form associated with a defined key, for debugging perusal.  Reading over the forms produced for the keys we’ve defined so far, some parsing errors were found and the code was corrected.

Here are the two new conditions used by the code that protects against single-precision float errors:

(define-condition invalid-float-arrived (error)
  ((val         :initarg value
                :reader get-val))
  (:documentation "A floating-point number was pushed when rationals were promised.  This is a coding bug and should be fixed.")
  (:report (lambda (c s)
             (format s "The float value ~A was encountered."
                     (get-val c)))))

(define-condition single-precision-float (error)
  ((val         :initarg value
                :reader get-val))
  (:documentation "A single-precision floating-point number was seen.  This is below the promised precision of the calculator, and is a programming bug.")
  (:report (lambda (c s)
             (format s "The single-precision float value ~A was encountered."
                     (get-val c)))))

Here is the function that is used by stack and memory store operations to validate the passed value:

(defun fix-input-val (val rflag)
  (when (eq rflag :DOUBLE-FLOAT)
    (when (eq (type-of val) 'single-float)
      (error (make-condition 'single-precision-float
                             :value val)))
         (setf val (rational val)))

  (unless (rationalp val)
    (error (make-condition 'invalid-float-arrived
                           :value val)))

  (round-to-ultimate-precision val))

Here is the function used by stack and memory retrieve operations to convert to double-precision floats if desired:

(defun fix-output-val (val rflag)
  (if (eq rflag :DOUBLE-FLOAT)
      (coerce val 'double-float)
      val))

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

The HP-67 calculator has some specialized behaviour when displaying numbers in fixed mode.  Numbers less than 1 always have a leading zero before the decimal, leaving 9 digits of precision for the remainder of the value.  If asked to display 0.001 to two digits of precision in fixed mode, the calculator will display the number in scientific notation instead, as that value rounds to a visual representation of zero.  If asked to display 1234567890.123 to two digits of precision, it will display only 1234567890, as the display has only ten digits.

So, now we need functions to display a rational number in either scientific or fixed mode.  The scientific mode is fairly simple, as we can use the long division code we wrote earlier to produce a sequence of digits, and we know the exponent on the total.  Fixed mode is more complicated, because of the automatic conversion to scientific notation.

A number that is too wide to fit in the 10 digits of the display must be at least 10^10-(1/2).  With the rounding rules, that number will round up to an 11 digit number.  A number that is too small to fit in the number of digits of precision requested must be smaller than 10^-d / 2.  With the rounding rules, that number will round up to 1 in the last digit displayed after the decimal.  In between these values, the magnitude of the number (the power of 10 represented by the most significant non-zero digit) and the precision after the decimal point will, together, determine how many digits total must be displayed.

The temptation is to find the base-10 logarithm of the rational number, take the floor function on that, and you have the magnitude of the rational.  However, this is not safe.  Rational numbers are promoted to single-precision floats, and cannot generally be exactly represented.  Sometimes, the error introduced in the conversion from rational to float can cause a number to cross to a different magnitude, as seen in this example:

CL-USER> (log (/ 1000001 10) 10.d0)
5.000000276521525d0
CL-USER> (log (/ 10000001 10) 10.d0)
6.000000083320534d0
CL-USER> (log (/ 100000001 10) 10.d0)
6.999999890119543d0

So, for safety, after the magnitude is determined with the logarithm, it is verified using purely rational arithmetic, and adjusted if necessary.

The next thing of interest is rounding numbers to lower precision.  It is easier to write the code to produce a certain fixed precision, then successively round the number to the desired precision later.  However, successive rounding has a major issue in the case of the number 0.44445.  If you were to round this successively, you might first get 0.4445, then 0.445, then 0.45, then 0.5.  This sequence is clearly incorrect.  When performing successive rounding, when the digit you’re eliminating is 5, you have to know how you got that 5 digit, whether it was from rounding down, or rounding up.  If it came from rounding down or was exact, then the 5 causes a rounding up of the next-higher-precision number.  If it came from rounding up, then the 5 causes no rounding up.  The long division function has been modified to return that information in a third entry in the returned list, and a new function that understands this format, round-long-division-result, has been written to make use of it.

With these changes, we now are ready to display any rational number in either fixed or scientific notation, in a way that exactly matches the HP-67’s behaviour.

The current code is checked into the git repository under the tag v2014-11-08.