Tag Archives: programming

The HP67 emulator, first version of expander

Now, I’ll produce the first version of the expander function.  This takes in a list of rules associated with a keypress, and converts them into a Lisp form.  This function will later be called in a macro to define the key operations.  We’ll be using backticks again, since we’re producing code, and that’s the way to make it readable in the source.

Now, at this point an introductory text usually goes through a few iterations, first making a simple version, then adding in gensyms, condition handlers, labels, and so on.  I’m just going to reproduce the whole thing up front and describe it.  Note that we may decide to change or augment this function in the future if we discover something that needs it.

So, here’s the current version of the expander:
calc1.lisp

;; This is going to change a basic rules list into explicit pops,
;; pushes, and exception handling
(defun expand-rules (rules-list)
  (let* ((varnames '(X Y Z W))
         (stack-var (gensym))
         (state-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 '<- (get-symbols-in-list
                                 rules-list)))
               (= 1 (length rules-list)))
      (setf rules-list 
            (append (list (first varnames) '<-)
                    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))

      `(lambda (,stack-var ,state-var)
         (declare (ignorable ,stack-var ,state-var))
         (labels
             ((to-radians (angle)
                (convert-angle-to-radians 
                 angle 
                 (get-angle-state ,state-var)))
              (from-radians (angle)
                (convert-angle-from-radians 
                 angle 
                 (get-angle-state ,state-var)))
              (to-rational (num)
                (convert-number-to-rational 
                 num 
                 (get-rational-state ,state-var)))
              (to-double-fp (num)
                (coerce num 'double-float)))

           (let (,@(mapcar #'(lambda (x) 
                               `(,x (pop-stack ,stack-var))) 
                           vars-used)
                 ,@(mapcar #'(lambda (x) 
                               (list x 0))
                           gensyms-output))
             (handler-case
                 (progn
                   ,@rules-list)
               ((or arithmetic-error simple-error) (c)
                 (set-error-state ,stack-var c)
                ,@(mapcar #'(lambda (x)
                              `(setf ,x 0)) 
                          gensyms-output)))

             ,@(mapcar #'(lambda (x)
                           `(push-stack ,stack-var ,x)) 
                       gensyms-output)))))))

The object returned is a lambda form of two arguments, a stack variable and a state variable.  This will allow us to funcall the form stored in a slot, with the appropriate arguments.

We know that some functions might need state information.  One example of this is the operation of converting an angle to radians so that it can be used in a trigonometric operation.  If the current state of the calculator is set to radians, this does nothing, but if it’s set to degrees or gradians, it has to do a conversion.  I don’t want to clutter the invocation in keypresses with the state variable, it should be invisible when defining keys, so I create a labels form to do the appropriate thing with the correct arguments behind the scenes, leaving the form in the keypress definition as simply:

X <- (sin (to-radians X))   or   X <- (from-radians (asin X))

I also have helper functions to convert between rationals and double-precision floats, optionally controlled by the state variable.

Next, the used variables are popped from the stack, and the assigned variables in their own symbols are initialized to zero.  The rules are then executed in a handler-case.  The purpose for this is to allow the calculator to behave well if a function domain error is encountered (such as division by zero), or an assert failure.  In the event of such an error, the stack is informed of the error and supplied with the condition that was signaled, and the output registers are set to zero.  Execution then finished when the output registers are pushed back onto the stack.

Here is a sample of the generated output when run on our rectangular-to-polar forms:
*slime-repl sbcl*

CL-USER> (expand-rules '(X <- (sqrt (+ (* X X) (* Y Y)))
                         Y <- (atan Y X)))
(LAMBDA (#:G939 #:G940)
  (DECLARE (IGNORABLE #:G939 #:G940))
  (LABELS ((TO-RADIANS (ANGLE)
             (CONVERT-ANGLE-TO-RADIANS ANGLE
              (GET-ANGLE-STATE #:G940)))
           (FROM-RADIANS (ANGLE)
             (CONVERT-ANGLE-FROM-RADIANS ANGLE
              (GET-ANGLE-STATE #:G940)))
           (TO-RATIONAL (NUM)
             (CONVERT-NUMBER-TO-RATIONAL NUM
              (GET-RATIONAL-STATE #:G940)))
           (TO-DOUBLE-FP (NUM)
             (COERCE NUM 'DOUBLE-FLOAT)))
    (LET ((X (POP-STACK #:G939))
          (Y (POP-STACK #:G939))
          (#:G942 0)
          (#:G941 0))
      (HANDLER-CASE
       (PROGN
        (SETF #:G941 (SQRT (+ (* X X) (* Y Y))))
        (SETF #:G942 (ATAN Y X)))
       ((OR ARITHMETIC-ERROR SIMPLE-ERROR) (C)
        (SET-ERROR-STATE #:G939 C) (SETF #:G942 0)
        (SETF #:G941 0)))
      (PUSH-STACK #:G939 #:G942)
      (PUSH-STACK #:G939 #:G941))))

The HP67 emulator, internals and modes

At this point, it’s probably a good idea to talk about modes and calculator internals.  The HP-67 calculator supports several modes that modify behaviour.  Examples are programming mode vs. run mode, output in fixed, scientific, or engineering notation, and angular measures in radians, degrees, or gradians.  It is the angle measures that concern us.  The Lisp programming language, naturally, performs trigonometric operations in radians.  We will need to give the programmer an opportunity to account for other angular units when defining the operations that are associated with a keypress.  Our final form will need to account for this mode.  Our macro will define labels in scope to convert to and from radians according to the currently active mode.

Next, we come to the issue of floating-point roundoff.  The HP-67 calculator was actually implemented using BCD arithmetic internally.  It used a 56-bit register for 14 BCD digits.  10 digits formed the mantissa, 2 formed the exponent, and the remaining two digits recorded the signs of the mantissa and of the exponent.

BCD representations are uncommon now, outside of embedded applications and calculators.  The advantage is that every decimal representation that can be displayed can be exactly represented by the internal state of the calculator, which would not be the case if the internal representation were made using the common binary IEEE-754 representation.

If you use the HP-67 calculator to add .8 to itself 10 times, the result is exactly 8.00.  If you do the same thing at the REPL in SBCL, using single-precision floats, the result is 8.0000009536743.  We’d like our emulator to give the correct answer whenever possible.  A common approach is to throw more bits at the problem, and make use of double-precision floats, but we will avoid that whenever possible.  So, what can we do?  Well, Lisp has the concept of rationals, numeric representations that consist of a ratio of integers.  These are ideal for most uses, we can perform our arithmetic with rationals, and then, if necessary, pare the precision of the result down to the appropriate size for our emulator, exactly the way the calculator would do it.  For instance, if we were computing the ratio (/ 1 5), we would store it internally as that rational, with no loss of precision.  We would convert (/ 1 7) to its 10-digit rational form, 1428571429/10000000000.  If we were computing the square root of 2, which is an irrational number, we would express it as a double-precision number with 10 significant digits, and then convert it to a rational representation.  It would be stored as 707106781/500000000.  For simple arithmetic, we would have exact representations whenever possible.

There is some difficulty in trying to ensure that you work only with rational numbers in Lisp.  Arithmetic operations can take rationals and produce rationals, but most other functions do not.  In SBCL, the following output occurs when you compare two numbers that are mathematically equal:
*slime-repl sbcl*

CL-USER> (< (/ 1 3) (sqrt (/ 1 9)))
T

The further difficulty is that if a Lisp function requires a floating-point argument and it receives a rational, it promotes it to a single-precision float.  This behaviour is explicitly outlined in the CLHS.  Single-precision floats are entirely inappropriate when dealing with 10-digit numbers, so this would give us significant problems.

We will, therefore, provide another labels form to force intermediate values to 10-digit rational representations, and our key definition will include an option to pop values from the stack as double-precision floating-point numbers rather than as rationals.

This rational number representation will be a new mode, selectable by the user if desired.  In most applications, double-precision numbers are probably enough, but when doing accounting-style calculations (remember: money isn’t a floating-point number, it’s integer pennies) it is probably desirable to use rational representations.

The HP67 emulator, converting from the domain-specific language

OK, so now we’ve defined our domain-specific language (DSL), and we’ve written a function to retrieve symbols in a tree.  Now, we need a few more functions.

First, we will need something that tells us which variables are used in the forms, so that we know how to pop the stack.  So, we locate the deepest stack variable used, and declare that all variables up to and including that one are used.  That function is here:
calc1.lisp

(defun get-vars-used (rules-list varnames)
  (let ((symbols-used (get-symbols-in-list rules-list))
        (vlen (length varnames)))
    (dotimes (i vlen)
      (let ((check (nth (- vlen i 1) varnames)))
        (when (member check symbols-used)
          (return-from get-vars-used 
            (subseq varnames 0 (- vlen i))))))))

with sample output:
*slime-repl sbcl*
CL-USER> (get-vars-used '(X <- (sqrt (+ (* X X) (* Y Y)))
                          Y <- (atan Y X))
                        '(X Y Z W))
(X Y)

Next, we’ll need a list of variables assigned.  We look for the special ‘<- symbol in all depths of the tree and collect the variables assigned.  If there are no <- symbols, it’s an implicit assignment to X, so we return that variable name alone.  This function is here:
calc1.lisp
(defun get-vars-assigned (rules-list varnames)
  (let ((rv '()))
    (labels
        ((worker (rl)
           (do ((v rl (cdr v)))
               ((not v) rv)
             (cond
               ((listp (first v))
                (setf rv (append rv (worker (first v)))))
               ((and (symbolp (first v))
                     (eq (second v) '<-))
                (push (first v) rv))))))

      (setf rv (worker rules-list))

      (remove-if #'(lambda (x)
                     (not (member x varnames))) rv)
      (if (not rv)
          (list (first varnames))
          (delete-duplicates rv)))))

with sample output:
*slime-repl sbcl*
CL-USER> (get-vars-assigned '(X <- (sqrt (+ (* X X) (* Y Y)))
                              Y <- (atan Y X))
                            '(X Y Z W))
(Y X)

Our third helpful function will convert <- assignments to proper setf forms, and in so doing will convert the syntax back to proper Lisp.  The following function will do that, but it also changes the names of the targets of the setf.  That is, assignment is made to a different symbol, so that the values of X, Y, Z, W are not overwritten.  This is necessary if you look at one of the forms we want to be able to process:

X <- (sqrt (+ (* X X) (* Y Y)))   Y <- (atan Y X)

If these assignments were done serially, the changed value of X would be used to compute Y, and the wrong answer would be produced.  If we try to do it with a psetf, we will be severely limiting our permitted structures, as we will require exactly one assignment execution, happening simultaneously, and the programmer may not want to be bound by that.  So, by assigning the new values to new symbols, and pushing those back onto the stack, we can ensure that we have full flexibility of syntax.  Here, then, is the function that converts to a list of setf forms:
calc1.lisp

(defun convert-to-setf-forms (rules-list 
                              vars-used 
                              output-varnames)
  (let (rv)
    (do ((pos rules-list (cdr pos)))
        ((not pos) rv)
      (cond
        ((and (member (first pos) vars-used)
              (eq (second pos) '<-)
              (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)))))
        (t
         (setf rv (append rv (list (first pos)))))))))

with sample output:
*slime-repl sbcl*
CL-USER> (convert-to-setf-forms '(X <- (sqrt (+ (* X X) (* Y Y)))
                                  Y <- (atan Y X))
                                '(X Y)
                                '(X-OUT Y-OUT))
((SETF X-OUT (SQRT (+ (* X X) (* Y Y)))) (SETF Y-OUT (ATAN Y X)))

You’ll notice the use of a backtick in the convert-to-setf-forms function.  If you are new to Lisp, you can be forgiven for thinking that backticks are “the things that make macros”, but that’s not what they are.  The backtick is the intermediate construct between single-quoted lists and lists built with the list function.  Single-quoted lists are literal collections of symbols, no interpretation of the internal structure beyond the list layout itself is performed: no functions are called and no variables are replaced.  The list function is a function, and as such it evaluates all of its arguments.  Bare symbols are converted to their value, or called as functions, depending on the syntax in which they appear.  The backtick allows the programmer to build lists where some elements are evaluated, and some are not.  It’s possible to do the same with the list function, but it’s much less convenient, and much less readable.  Consider, for instance, these two forms, which do the same thing:
*slime-repl sbcl*
CL-USER> (let ((aval 20) (bval 10)) 
           `(let ((a ,aval)
                  (b ,bval))
              (when (> a b)
                (format t "A is greater than B~%"))))
(LET ((A 20) (B 10))
  (WHEN (> A B) (FORMAT T "A is greater than B~%")))

*slime-repl sbcl*

CL-USER> (let ((aval 20) (bval 10))
           (list 'let (list (list 'a aval)
                            (list 'b bval))
                 (list 'when (list '> 'a 'b)
                       (list 'format t "A is greater than B~%"))))
(LET ((A 20) (B 10))
  (WHEN (> A B) (FORMAT T "A is greater than B~%")))

The form built from the backticks is much easier to interpret and modify.  There is nothing about backticks that declares that they must appear in macros, it’s merely that they are almost always necessary for readable macros, but the function contexts where backticks are helpful are less common.  The programmer will find the backtick of considerable use when building Lisp code in a function, as we are doing here.

The HP67 emulator and a tiny domain-specific language

Now, we’ll talk a bit about domain-specific languages.  The Lisp language, with its macros and natural ability to parse its own syntax, is well-suited to creating a domain-specific language.  This is a novel programming language designed to simplify certain aspects of the problem.  It is for the convenience of the programmer, and usually not for the user, so it’s not likely that the aim is to do away entirely with Lisp syntax, it’s to make the Lisp programmer’s job easier and to simplify the reading of the code.

So, this HP67 emulator is going to need to have data structures to represent keys, and associated operations.  Let’s consider first some basic mathematical operations, we’re not going to talk about things like memory registers or programming mode.

The HP67 has a four-number stack.  The most-recently-added value to the stack is called the X value, and is the value that is usually displayed on the screen of the calculator.  Beyond that is the Y register, then two more values that are not usually given a name, but which I will call Z and W. EDIT #1 2014-10-09: In fact, the manual for the HP-67 calculator calls these X, Y, Z, and T. We will use W instead of T because of the practical difficulties of using T in Lisp forms.

Let’s look at the sort of operations we will want to implement.  There’s the addition operator, which consumes X and Y and pushes the sum X+Y onto the stack.  There’s the sine function, which consumes X and replaces it with its sine, in the appropriate angular units.  There’s the rectangular-to-polar function, which consumes X and Y and pushes the angle as Y and the radius as X.  A simple notation for this might be:

X <- (+ Y X)

X <- (sin X)

X <- (sqrt (* X X) (* Y Y))    Y <- (atan Y X)

These representations are easily read, and we’d like to make use of them in the definitions of our keys, but we’d also like to allow the possibility that the programmer wants to use a full Lisp form, such as this, for factorials of positive integers:
calc1.lisp

(let ((n X)
      (rv X))
  (assert (and (integerp X) (> X 0)))
  (dotimes (i (1- n))
    (setf rv (* rv (- n i 1))))
  X <- rv)

So, we’re going to write some code that permits these to appear, as written above.  While X, Y, Z, W will be considered reserved names for purposes of Lisp forms written in the key operation, anything else will be allowed.  Also, for functions that only push a single X value onto the stack, we will allow the programmer to omit the “X <-” construct, so the key’s definition can simply say:

(+ Y X)

if the programmer prefers that.  I’ll show how we do that in upcoming posts.

A Lisp project: HP67 emulator

When I was in CÉGEP, my parents gave me a calculator as a birthday present.  An HP-67, it is a programmable RPN calculator.  I used it constantly, though it eventually had to retire because I could no longer get replacement battery packs for it, and it couldn’t run off the mains without a working battery pack.  Still, I got about 15 years of use out of it.  I’ve always preferred RPN calculators, and when I use infix calculators I have to be very careful not to lose my partial results.

I also tend to write HP-67 emulators.  I started with a CDA (classic desk accessory) version for my Apple ][GS.  I probably still have the sources on my old Apple ][GS, but it’s boxed up in the basement.  I did, though, find them still on comp.sources.apple2, more than 20 years after I posted them, so I’ve pulled them out and put them into an archive here.  It was compiled with ORCA/C and ORCA/M, the C compiler and assembler commonly used for development on the Apple ][GS.

A few years later, I decided to learn C++, and used the HP-67 emulator as my practice problem.  The resulting program, hp67, is one I still use frequently today.  Its sources and screenshots are available here.  It used to ship with redhat, but I don’t think it’s packaged anymore.

The emulators I wrote are programmable, though it’s now many years since I’ve invoked the programmable mode in hp67.  The programming mode in the HP-67 is mostly a keypress recorder, but with simple flow control.  The mode supports goto, gosub, and conditional operators that skip over the next program step when the condition is not met.  Together, these operations allow the calculator to be programmed to perform more complex, repetitive operations.

Now, I’m going to start doing some development of an hp-67 emulator in Lisp, just to provide some real examples of some of the Lisp features I’ve been describing in these pages.  I’ll probably put the sources on github later, for easier access.

We’ll be making use of handlers, macros, a tiny domain-specific language, and other features.  I’m an engine writer, I don’t like doing user interface stuff, and have little experience with it, so I’ll be writing my code from the engine outward, but with an eye to plugging in different front-ends.  The C++ version of the calculator is an interactive, ncurses-based program, but I may aim for a stream-processing calculator and for a proper GUI version, we’ll see what happens when we get to the front-end.