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.