We’re almost done with the back-end that talks to the UI, at least for interactive use.  There is one category of keypresses that we haven’t handled yet, the compound keys.  These are key sequences such as “STO” “+” “2”.  This example takes the value in the X register and adds it to the value in memory register 2, holding the result in register 2.  There are similar compound keys for subtraction, multiplication, and division.

Compound keys are defined in calc1.lisp, with a special location record that includes the abbreviation strings of the two keys that must be pressed, in sequence, to invoke the compound key.  We want to notice when a compound key sequence has been pressed, and substitute the compound key’s abbreviation in the flow.  This is how that is done:

      ;; Look for compound keys
      (dolist (k (get-compound-keys))
        (let* ((location (key-struct-key-location k))
               (ck (location-compound-key location)))
          (when (and (string= abbrev (first ck))
                     (string= arg (second ck)))
            (setf key k)
            (setf arg (funcall fetch-argument-closure
                               (key-struct-abbrev key)))
            (unless arg
              (return-from handle-one-keypress :MISSING-ARGUMENT))
            (return))))

One final step before switching to UI coding is the packaging of symbols.  We create a package called hp-internals that will hold everything we’ve written so far.  Because the functions for this package are defined in multiple .lisp files, I prefer not to use the :export keyword in the defpackage form, but instead have each module that produces exported symbols do the export explicitly with the export function.

Here is the defpackage, in constants.lisp:

(defpackage :HP67-INTERNALS
  (:use :COMMON-LISP)
  )

(in-package :HP67-INTERNALS)

Here is a sample export form, in stack.lisp:

(in-package :HP67-INTERNALS)

(export '(STACK-REGISTERS STACK-MEMORY STACK-PROGRAM-MEMORY
          STACK-ERROR-STATE))

Now, to invoke and test the compound keypresses, we would do something like this:

CL-USER> (import '(hp67-internals:handle-one-keypress 
                   hp67-internals:get-new-stack-object 
                   hp67-internals:get-new-mode-object))
T
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 "8" arg-fcn nil stack mode)
           (handle-one-keypress "sto -" arg-fcn nil stack mode)
           stack)
Argument for sto-:  2

#S(HP67-INTERNALS::STACK
   :REGISTERS (8 0 0 0)
   :REGISTERS-COPY (8 0 0 0)
   :NUM-REGISTERS 4
   :LAST-X 0
   :ASSEMBLER #S(HP67-INTERNALS::TOKEN-ASSEMBLER
                 :MANTISSA-SIGN 1
                 :MANTISSA #<SB-IMPL::STRING-OUTPUT-STREAM {10044FDA53}>
                 :MANTISSA-DIGITS 0
                 :EXPONENT-SIGN 1
                 :EXPONENT #(0 0)
                 :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)
   :MEMORY (("2" . -8))
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)

This code is available in the git repository under the tag v2014-11-20.

In previous HP-67 emulators that I wrote in other languages, the UI was always keyboard-based, and numbers did not have to be assembled from individual number tokens, the user simply typed the number out on the line and that was passed to the program for parsing.

I want to allow for the possibility that this new emulator will have a GUI front end with key-presses that behave like the calculator does, so keys that are used to assemble numbers must be treated in a special manner.

When the engine receives a keypress, it checks to see if the key is a token key before attempting to run the form attached to the key.  If it is a token key, that token is retrieved and handed to the stack object, which now has a token assembler structure that acts on these contents.  It then switches the mode of the program to :NUMERIC-INPUT.  This mode switch has only one noticeable effect: it changes what the CLX key does.  When CLX is pressed in any other context, it clears the X register.  In numeric-input mode, after at least one input token has been seen, it clears the input line but does not touch the X register.

If the ENTER key is pressed and there is no token being assembled, it pushes a copy of X onto the stack.  That code is in stack.lisp.

If a non-token key arrives when tokens have been seen and are being assembled, the in-progress number is immediately completed and pushed onto the stack before the non-token key’s operation is invoked.

Here we see two examples of execution in the current setup. Note that the registers-copy field of the stack holds the contents of the stack before the last operation occurred, so you can see there what the inputs were to the most recent operation.

Assembling a number, pushing it onto the stack.  Starting a second number, but pressing the wrong key, so sending CLX to clear the error and enter the correct key:

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 "1" arg-fcn nil stack mode)
           (handle-one-keypress "2" arg-fcn nil stack mode)
           (handle-one-keypress "." arg-fcn nil stack mode)
           (handle-one-keypress "enter" arg-fcn nil stack mode)
           (handle-one-keypress "3" arg-fcn nil stack mode)
           (handle-one-keypress "clx" arg-fcn nil stack mode)
           (handle-one-keypress "4" arg-fcn nil stack mode)
           (handle-one-keypress "+" arg-fcn nil stack mode)
           stack)
#S(STACK
   :REGISTERS (16 0 0 0)
   :REGISTERS-COPY (4 12 0 0)
   :NUM-REGISTERS 4
   :LAST-X 4
   :ASSEMBLER #S(TOKEN-ASSEMBLER
                 :MANTISSA-SIGN 1
                 :MANTISSA #<SB-IMPL::STRING-OUTPUT-STREAM {1006E13563}>
                 :MANTISSA-DIGITS 0
                 :EXPONENT-SIGN 1
                 :EXPONENT #(0 0)
                 :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)
   :MEMORY NIL
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)

Starting to assemble a number, then pushing the SIN key.  The number that was being assembled is finalized and pushed onto the stack so that SIN operates on it:

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 "3" arg-fcn nil stack mode)
           (handle-one-keypress "0" arg-fcn nil stack mode)
           (handle-one-keypress "." arg-fcn nil stack mode)
           (handle-one-keypress "sin" arg-fcn nil stack mode)
           stack)
#S(STACK
   :REGISTERS (1/2 0 0 0)
   :REGISTERS-COPY (30 0 0 0)
   :NUM-REGISTERS 4
   :LAST-X 30
   :ASSEMBLER #S(TOKEN-ASSEMBLER
                 :MANTISSA-SIGN 1
                 :MANTISSA #<SB-IMPL::STRING-OUTPUT-STREAM {1006CA3C23}>
                 :MANTISSA-DIGITS 0
                 :EXPONENT-SIGN 1
                 :EXPONENT #(0 0)
                 :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)
   :MEMORY NIL
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)

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.