1 # print out floats in decimal
  2 # https://research.swtch.com/ftoa
  3 #
  4 # Basic idea:
  5 #   Ignoring sign, floating point numbers are represented as 1.mantissa * 2^exponent
  6 #   Therefore, to print a float in decimal, we need to:
  7 #     - compute its value without decimal point
  8 #     - convert to an array of decimal digits
  9 #     - print out the array while inserting the decimal point appropriately
 10 #
 11 # Basic complication: the computation generates numbers larger than an int can
 12 # hold. We need a way to represent big ints.
 13 #
 14 # Key insight: use a representation for big ints that's close to what we need
 15 # anyway, an array of decimal digits.
 16 #
 17 # Style note: we aren't creating a big int library here. The only operations
 18 # we need are halving and doubling. Following the link above, it seems more
 19 # comprehensible to keep these operations inlined so that we can track the
 20 # position of the decimal point with dispatch.
 21 #
 22 # This approach turns out to be fast enough for most purposes.
 23 # Optimizations, however, get wildly more complex.
 24 
 25 fn test-print-float-decimal-approximate-normal {
 26   var screen-on-stack: screen
 27   var screen/esi: (addr screen) <- address screen-on-stack
 28   initialize-screen screen, 5, 0x20  # 32 columns should be more than enough
 29   # 0.5
 30   var half/xmm0: float <- rational 1, 2
 31   print-float-decimal-approximate screen, half, 3
 32   check-screen-row screen, 1, "0.5 ", "F - test-print-float-decimal-approximate-normal 0.5"
 33   # 0.25
 34   clear-screen screen
 35   var quarter/xmm0: float <- rational 1, 4
 36   print-float-decimal-approximate screen, quarter, 3
 37   check-screen-row screen, 1, "0.25 ", "F - test-print-float-decimal-approximate-normal 0.25"
 38   # 0.75
 39   clear-screen screen
 40   var three-quarters/xmm0: float <- rational 3, 4
 41   print-float-decimal-approximate screen, three-quarters, 3
 42   check-screen-row screen, 1, "0.75 ", "F - test-print-float-decimal-approximate-normal 0.75"
 43   # 0.125
 44   clear-screen screen
 45   var eighth/xmm0: float <- rational 1, 8
 46   print-float-decimal-approximate screen, eighth, 3
 47   check-screen-row screen, 1, "0.125 ", "F - test-print-float-decimal-approximate-normal 0.125"
 48   # 0.0625; start using scientific notation
 49   clear-screen screen
 50   var sixteenth/xmm0: float <- rational 1, 0x10
 51   print-float-decimal-approximate screen, sixteenth, 3
 52   check-screen-row screen, 1, "6.25e-2 ", "F - test-print-float-decimal-approximate-normal 0.0625"
 53   # sqrt(2); truncate floats with lots of digits after the decimal but not too many before
 54   clear-screen screen
 55   var two-f/xmm0: float <- rational 2, 1
 56   var sqrt-2/xmm0: float <- square-root two-f
 57   print-float-decimal-approximate screen, sqrt-2, 3
 58   check-screen-row screen, 1, "1.414 ", "F - test-print-float-decimal-approximate-normal √2"
 59 }
 60 
 61 # print whole integers without decimals
 62 fn test-print-float-decimal-approximate-integer {
 63   var screen-on-stack: screen
 64   var screen/esi: (addr screen) <- address screen-on-stack
 65   initialize-screen screen, 5, 0x20  # 32 columns should be more than enough
 66   # 1
 67   var one-f/xmm0: float <- rational 1, 1
 68   print-float-decimal-approximate screen, one-f, 3
 69   check-screen-row screen, 1, "1 ", "F - test-print-float-decimal-approximate-integer 1"
 70   # 2
 71   clear-screen screen
 72   var two-f/xmm0: float <- rational 2, 1
 73   print-float-decimal-approximate screen, two-f, 3
 74   check-screen-row screen, 1, "2 ", "F - test-print-float-decimal-approximate-integer 2"
 75   # 10
 76   clear-screen screen
 77   var ten-f/xmm0: float <- rational 0xa, 1
 78   print-float-decimal-approximate screen, ten-f, 3
 79   check-screen-row screen, 1, "10 ", "F - test-print-float-decimal-approximate-integer 10"
 80   # -10
 81   clear-screen screen
 82   var minus-ten-f/xmm0: float <- rational -0xa, 1
 83   print-float-decimal-approximate screen, minus-ten-f, 3
 84   check-screen-row screen, 1, "-10 ", "F - test-print-float-decimal-approximate-integer -10"
 85   # 999
 86   clear-screen screen
 87   var minus-ten-f/xmm0: float <- rational 0x3e7, 1
 88   print-float-decimal-approximate screen, minus-ten-f, 3
 89   check-screen-row screen, 1, "999 ", "F - test-print-float-decimal-approximate-integer 1000"
 90   # 1000 - start using scientific notation
 91   clear-screen screen
 92   var minus-ten-f/xmm0: float <- rational 0x3e8, 1
 93   print-float-decimal-approximate screen, minus-ten-f, 3
 94   check-screen-row screen, 1, "1.00e3 ", "F - test-print-float-decimal-approximate-integer 1000"
 95   # 100,000
 96   clear-screen screen
 97   var hundred-thousand/eax: int <- copy 0x186a0
 98   var hundred-thousand-f/xmm0: float <- convert hundred-thousand
 99   print-float-decimal-approximate screen, hundred-thousand-f, 3
100   check-screen-row screen, 1, "1.00e5 ", "F - test-print-float-decimal-approximate-integer 100,000"
101 }
102 
103 fn test-print-float-decimal-approximate-zero {
104   var screen-on-stack: screen
105   var screen/esi: (addr screen) <- address screen-on-stack
106   initialize-screen screen, 5, 0x20  # 32 columns should be more than enough
107   var zero: float
108   print-float-decimal-approximate screen, zero, 3
109   check-screen-row screen, 1, "0 ", "F - test-print-float-decimal-approximate-zero"
110 }
111 
112 fn test-print-float-decimal-approximate-negative-zero {
113   var screen-on-stack: screen
114   var screen/esi: (addr screen) <- address screen-on-stack
115   initialize-screen screen, 5, 0x20  # 32 columns should be more than enough
116   var n: int
117   copy-to n, 0x80000000
118   var negative-zero/xmm0: float <- reinterpret n
119   print-float-decimal-approximate screen, negative-zero, 3
120   check-screen-row screen, 1, "-0 ", "F - test-print-float-decimal-approximate-negative-zero"
121 }
122 
123 fn test-print-float-decimal-approximate-infinity {
124   var screen-on-stack: screen
125   var screen/esi: (addr screen) <- address screen-on-stack
126   initialize-screen screen, 5, 0x20  # 32 columns should be more than enough
127   var n: int
128   #          0|11111111|00000000000000000000000
129   #          0111|1111|1000|0000|0000|0000|0000|0000
130   copy-to n, 0x7f800000
131   var infinity/xmm0: float <- reinterpret n
132   print-float-decimal-approximate screen, infinity, 3
133   check-screen-row screen, 1, "Inf ", "F - test-print-float-decimal-approximate-infinity"
134 }
135 
136 fn test-print-float-decimal-approximate-negative-infinity {
137   var screen-on-stack: screen
138   var screen/esi: (addr screen) <- address screen-on-stack
139   initialize-screen screen, 5, 0x20  # 32 columns should be more than enough
140   var n: int
141   copy-to n, 0xff800000
142   var negative-infinity/xmm0: float <- reinterpret n
143   print-float-decimal-approximate screen, negative-infinity, 3
144   check-screen-row screen, 1, "-Inf ", "F - test-print-float-decimal-approximate-negative-infinity"
145 }
146 
147 fn test-print-float-decimal-approximate-not-a-number {
148   var screen-on-stack: screen
149   var screen/esi: (addr screen) <- address screen-on-stack
150   initialize-screen screen, 5, 0x20  # 32 columns should be more than enough
151   var n: int
152   copy-to n, 0xffffffff  # exponent must be all 1's, and mantissa must be non-zero
153   var nan/xmm0: float <- reinterpret n
154   print-float-decimal-approximate screen, nan, 3
155   check-screen-row screen, 1, "NaN ", "F - test-print-float-decimal-approximate-not-a-number"
156 }
157 
158 # 'precision' controls the maximum width past which we resort to scientific notation
159 fn print-float-decimal-approximate screen: (addr screen), in: float, precision: int {
160   # - special names
161   var bits/eax: int <- reinterpret in
162   compare bits, 0
163   {
164     break-if-!=
165     print-string screen, "0"
166     return
167   }
168   compare bits, 0x80000000
169   {
170     break-if-!=
171     print-string screen, "-0"
172     return
173   }
174   compare bits, 0x7f800000
175   {
176     break-if-!=
177     print-string screen, "Inf"
178     return
179   }
180   compare bits, 0xff800000
181   {
182     break-if-!=
183     print-string screen, "-Inf"
184     return
185   }
186   var exponent/ecx: int <- copy bits
187   exponent <- shift-right 0x17  # 23 bits of mantissa
188   exponent <- and 0xff
189   exponent <- subtract 0x7f
190   compare exponent, 0x80
191   {
192     break-if-!=
193     print-string screen, "NaN"
194     return
195   }
196   # - regular numbers
197   var sign/edx: int <- copy bits
198   sign <- shift-right 0x1f
199   {
200     compare sign, 1
201     break-if-!=
202     print-string screen, "-"
203   }
204 
205   # v = 1.mantissa (in base 2) << 0x17
206   var v/ebx: int <- copy bits
207   v <- and 0x7fffff
208   v <- or 0x00800000  # insert implicit 1
209   # e = exponent - 0x17
210   var e/ecx: int <- copy exponent
211   e <- subtract 0x17  # move decimal place from before mantissa to after
212 
213   # initialize buffer with decimal representation of v
214   # unlike https://research.swtch.com/ftoa, no ascii here
215   var buf-storage: (array byte 0x7f)
216   var buf/edi: (addr array byte) <- address buf-storage
217   var n/eax: int <- decimal-digits v, buf
218   # I suspect we can do without reversing, but we'll follow https://research.swtch.com/ftoa
219   # closely for now.
220   reverse-digits buf, n
221 
222   # loop if e > 0
223   {
224     compare e, 0
225     break-if-<=
226     n <- double-array-of-decimal-digits buf, n
227     e <- decrement
228     loop
229   }
230 
231   var dp/edx: int <- copy n
232 
233   # loop if e < 0
234   {
235     compare e, 0
236     break-if->=
237     n, dp <- halve-array-of-decimal-digits buf, n, dp
238     e <- increment
239     loop
240   }
241 
242   print-float-buffer screen, buf, n, dp, precision
243 }
244 
245 # store the decimal digits of 'n' into 'buf', units first
246 # n must be positive
247 fn decimal-digits n: int, _buf: (addr array byte) -> _/eax: int {
248   var buf/edi: (addr array byte) <- copy _buf
249   var i/ecx: int <- copy 0
250   var curr/eax: int <- copy n
251   var curr-byte/edx: int <- copy 0
252   {
253     compare curr, 0
254     break-if-=
255     curr, curr-byte <- integer-divide curr, 0xa
256     var dest/ebx: (addr byte) <- index buf, i
257     copy-byte-to *dest, curr-byte
258     i <- increment
259     loop
260   }
261   return i
262 }
263 
264 fn reverse-digits _buf: (addr array byte), n: int {
265   var buf/esi: (addr array byte) <- copy _buf
266   var left/ecx: int <- copy 0
267   var right/edx: int <- copy n
268   right <- decrement
269   {
270     compare left, right
271     break-if->=
272     {
273       var l-a/ecx: (addr byte) <- index buf, left
274       var r-a/edx: (addr byte) <- index buf, right
275       var l/ebx: byte <- copy-byte *l-a
276       var r/eax: byte <- copy-byte *r-a
277       copy-byte-to *l-a, r
278       copy-byte-to *r-a, l
279     }
280     left <- increment
281     right <- decrement
282     loop
283   }
284 }
285 
286 # debug helper
287 fn dump-digits _buf: (addr array byte), count: int, msg: (addr array byte) {
288   var buf/edi: (addr array byte) <- copy _buf
289   var i/ecx: int <- copy 0
290   print-string 0, msg
291   print-string 0, ": "
292   {
293     compare i, count
294     break-if->=
295     var curr/edx: (addr byte) <- index buf, i
296     var curr-byte/eax: byte <- copy-byte *curr
297     var curr-int/eax: int <- copy curr-byte
298     print-int32-decimal 0, curr-int
299     print-string 0, " "
300     break-if-=
301     i <- increment
302     loop
303   }
304   print-string 0, "\n"
305 }
306 
307 fn double-array-of-decimal-digits _buf: (addr array byte), _n: int -> _/eax: int {
308   var buf/edi: (addr array byte) <- copy _buf
309   # initialize delta
310   var delta/edx: int <- copy 0
311   {
312     var curr/ebx: (addr byte) <- index buf, 0
313     var tmp/eax: byte <- copy-byte *curr
314     compare tmp, 5
315     break-if-<
316     delta <- copy 1
317   }
318   # loop
319   var x/eax: int <- copy 0
320   var i/ecx: int <- copy _n
321   i <- decrement
322   {
323     compare i, 0
324     break-if-<=
325     # x += 2*buf[i]
326     {
327       var tmp/ecx: (addr byte) <- index buf, i
328       var tmp2/ecx: byte <- copy-byte *tmp
329       x <- add tmp2
330       x <- add tmp2
331     }
332     # x, buf[i+delta] = x/10, x%10
333     {
334       var dest-index/ecx: int <- copy i
335       dest-index <- add delta
336       var dest/edi: (addr byte) <- index buf, dest-index
337       var next-digit/edx: int <- copy 0
338       x, next-digit <- integer-divide x, 0xa
339       copy-byte-to *dest, next-digit
340     }
341     #
342     i <- decrement
343     loop
344   }
345   # final patch-up
346   var n/eax: int <- copy _n
347   compare delta, 1
348   {
349     break-if-!=
350     var curr/ebx: (addr byte) <- index buf, 0
351     var one/edx: int <- copy 1
352     copy-byte-to *curr, one
353     n <- increment
354   }
355   return n
356 }
357 
358 fn halve-array-of-decimal-digits _buf: (addr array byte), _n: int, _dp: int -> _/eax: int, _/edx: int {
359   var buf/edi: (addr array byte) <- copy _buf
360   var n/eax: int <- copy _n
361   var dp/edx: int <- copy _dp
362   # initialize one side
363   {
364     # if buf[n-1]%2 == 0, break
365     var right-index/ecx: int <- copy n
366     right-index <- decrement
367     var right-a/ecx: (addr byte) <- index buf, right-index
368     var right/ecx: byte <- copy-byte *right-a
369     var right-int/ecx: int <- copy right
370     var remainder/edx: int <- copy 0
371     {
372       var dummy/eax: int <- copy 0
373       dummy, remainder <- integer-divide right-int, 2
374     }
375     compare remainder, 0
376     break-if-=
377     # buf[n] = 0
378     var next-a/ecx: (addr byte) <- index buf, n
379     var zero/edx: byte <- copy 0
380     copy-byte-to *next-a, zero
381     # n++
382     n <- increment
383   }
384   # initialize the other
385   var delta/ebx: int <- copy 0
386   var x/esi: int <- copy 0
387   {
388     # if buf[0] >= 2, break
389     var left/ecx: (addr byte) <- index buf, 0
390     var src/ecx: byte <- copy-byte *left
391     compare src, 2
392     break-if->=
393     # delta, x = 1, buf[0]
394     delta <- copy 1
395     x <- copy src
396     # n--
397     n <- decrement
398     # dp--
399     dp <- decrement
400   }
401   # loop
402   var i/ecx: int <- copy 0
403   {
404     compare i, n
405     break-if->=
406     # x = x*10 + buf[i+delta]
407     {
408       var ten/edx: int <- copy 0xa
409       x <- multiply ten
410       var src-index/edx: int <- copy i
411       src-index <- add delta
412       var src-a/edx: (addr byte) <- index buf, src-index
413       var src/edx: byte <- copy-byte *src-a
414       x <- add src
415     }
416     # buf[i], x = x/2, x%2
417     {
418       var quotient/eax: int <- copy 0
419       var remainder/edx: int <- copy 0
420       quotient, remainder <- integer-divide x, 2
421       x <- copy remainder
422       var dest/edx: (addr byte) <- index buf, i
423       copy-byte-to *dest, quotient
424     }
425     #
426     i <- increment
427     loop
428   }
429   return n, dp
430 }
431 
432 fn print-float-buffer screen: (addr screen), _buf: (addr array byte), n: int, dp: int, precision: int {
433   var buf/edi: (addr array byte) <- copy _buf
434 #?   print-int32-hex 0, dp
435 #?   print-string 0, "\n"
436   {
437     compare dp, 0
438     break-if->=
439     print-float-buffer-in-scientific-notation screen, buf, n, dp, precision
440     return
441   }
442   {
443     var dp2/eax: int <- copy dp
444     compare dp2, precision
445     break-if-<=
446     print-float-buffer-in-scientific-notation screen, buf, n, dp, precision
447     return
448   }
449   {
450     compare dp, 0
451     break-if-!=
452     print-string screen, "0"
453   }
454   var i/eax: int <- copy 0
455   # bounds = min(n, dp+3)
456   var limit/edx: int <- copy dp
457   limit <- add 3
458   {
459     compare limit, n
460     break-if-<=
461     limit <- copy n
462   }
463   {
464     compare i, limit
465     break-if->=
466     # print '.' if necessary
467     compare i, dp
468     {
469       break-if-!=
470       print-string screen, "."
471     }
472     var curr-a/ecx: (addr byte) <- index buf, i
473     var curr/ecx: byte <- copy-byte *curr-a
474     curr <- add 0x30  # '0'
475     var curr-grapheme/ecx: grapheme <- copy curr
476     print-grapheme screen, curr-grapheme
477     i <- increment
478     loop
479   }
480 }
481 
482 fn print-float-buffer-in-scientific-notation screen: (addr screen), _buf: (addr array byte), n: int, dp: int, precision: int {
483   var buf/edi: (addr array byte) <- copy _buf
484   var i/eax: int <- copy 0
485   {
486     compare i, n
487     break-if->=
488     compare i, precision
489     break-if->=
490     compare i, 1
491     {
492       break-if-!=
493       print-string screen, "."
494     }
495     var curr-a/ecx: (addr byte) <- index buf, i
496     var curr/ecx: byte <- copy-byte *curr-a
497     curr <- add 0x30  # '0'
498     var curr-grapheme/ecx: grapheme <- copy curr
499     print-grapheme screen, curr-grapheme
500     #
501     i <- increment
502     loop
503   }
504   print-string screen, "e"
505   decrement dp
506   print-int32-decimal screen, dp
507 }
508 
509 # follows the structure of print-float-decimal-approximate
510 # 'precision' controls the maximum width past which we resort to scientific notation
511 fn float-size in: float, precision: int -> _/eax: int {
512   # - special names
513   var bits/eax: int <- reinterpret in
514   compare bits, 0
515   {
516     break-if-!=
517     return 1  # "0"
518   }
519   compare bits, 0x80000000
520   {
521     break-if-!=
522     return 2  # "-0"
523   }
524   compare bits, 0x7f800000
525   {
526     break-if-!=
527     return 3  # "Inf"
528   }
529   compare bits, 0xff800000
530   {
531     break-if-!=
532     return 4  # "-Inf"
533   }
534   var exponent/ecx: int <- copy bits
535   exponent <- shift-right 0x17  # 23 bits of mantissa
536   exponent <- and 0xff
537   exponent <- subtract 0x7f
538   compare exponent, 0x80
539   {
540     break-if-!=
541     return 3  # "NaN"
542   }
543   # - regular numbers
544   # v = 1.mantissa (in base 2) << 0x17
545   var v/ebx: int <- copy bits
546   v <- and 0x7fffff
547   v <- or 0x00800000  # insert implicit 1
548   # e = exponent - 0x17
549   var e/ecx: int <- copy exponent
550   e <- subtract 0x17  # move decimal place from before mantissa to after
551 
552   # initialize buffer with decimal representation of v
553   var buf-storage: (array byte 0x7f)
554   var buf/edi: (addr array byte) <- address buf-storage
555   var n/eax: int <- decimal-digits v, buf
556   reverse-digits buf, n
557 
558   # loop if e > 0
559   {
560     compare e, 0
561     break-if-<=
562     n <- double-array-of-decimal-digits buf, n
563     e <- decrement
564     loop
565   }
566 
567   var dp/edx: int <- copy n
568 
569   # loop if e < 0
570   {
571     compare e, 0
572     break-if->=
573     n, dp <- halve-array-of-decimal-digits buf, n, dp
574     e <- increment
575     loop
576   }
577 
578   compare dp, 0
579   {
580     break-if->=
581     return 8  # hacky for scientific notation
582   }
583   {
584     var dp2/eax: int <- copy dp
585     compare dp2, precision
586     break-if-<=
587     return 8  # hacky for scientific notation
588   }
589 
590   # result = min(n, dp+3)
591   var result/ecx: int <- copy dp
592   result <- add 3
593   {
594     compare result, n
595     break-if-<=
596     result <- copy n
597   }
598 
599   # account for decimal point
600   compare dp, n
601   {
602     break-if->=
603     result <- increment
604   }
605 
606   # account for sign
607   var sign/edx: int <- reinterpret in
608   sign <- shift-right 0x1f
609   {
610     compare sign, 1
611     break-if-!=
612     result <- increment
613   }
614   return result
615 }
616 
617 ## helper
618 
619 # like check-strings-equal, except array sizes don't have to match
620 fn check-buffer-contains _buf: (addr array byte), _contents: (addr array byte), msg: (addr array byte) {
621   var buf/esi: (addr array byte) <- copy _buf
622   var contents/edi: (addr array byte) <- copy _contents
623   var a/eax: boolean <- string-starts-with? buf, contents
624   check-true a, msg
625   var len/ecx: int <- length contents
626   var len2/eax: int <- length buf
627   compare len, len2
628   break-if-=
629   var c/eax: (addr byte) <- index buf, len
630   var d/eax: byte <- copy-byte *c
631   var e/eax: int <- copy d
632   check-ints-equal e, 0, msg
633 }
634 
635 fn test-check-buffer-contains {
636   var arr: (array byte 4)
637   var a/esi: (addr array byte) <- address arr
638   var b/eax: (addr byte) <- index a, 0
639   var c/ecx: byte <- copy 0x61  # 'a'
640   copy-byte-to *b, c
641   check-buffer-contains a, "a", "F - test-check-buffer-contains"
642   check-buffer-contains "a", "a", "F - test-check-buffer-contains/null"  # no null check when arrays have same length
643 }
644 
645 #? fn main -> _/ebx: int {
646 #?   run-tests
647 #? #?   test-print-float-decimal-approximate-integer
648 #? #?   test-print-float-decimal-approximate-normal
649 #?   return 0
650 #? }