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 negative-infinity/xmm0: float <- reinterpret n
154   print-float-decimal-approximate screen, negative-infinity, 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 #?   print-int32-decimal 0, v
218 #?   print-string 0, "\n"
219   var n/eax: int <- decimal-digits v, buf
220 #?   dump-digits buf, n, "init"
221   # I suspect we can do without reversing, but we'll follow https://research.swtch.com/ftoa
222   # closely for now.
223   reverse-digits buf, n
224 #?   dump-digits buf, n, "reverse"
225 
226   # loop if e > 0
227   {
228     compare e, 0
229     break-if-<=
230     n <- double-array-of-decimal-digits buf, n
231 #?     dump-digits buf, n, "double"
232     e <- decrement
233     loop
234   }
235 
236   var dp/edx: int <- copy n
237 
238   # loop if e < 0
239   {
240     compare e, 0
241     break-if->=
242     n, dp <- halve-array-of-decimal-digits buf, n, dp
243 #?     print-int32-decimal 0, dp
244 #?     print-string 0, ", "
245 #?     dump-digits buf, n, "halve"
246     e <- increment
247     loop
248   }
249 
250   print-float-buffer screen, buf, n, dp, precision
251 }
252 
253 # store the decimal digits of 'n' into 'buf', units first
254 # n must be positive
255 fn decimal-digits n: int, _buf: (addr array byte) -> _/eax: int {
256   var buf/edi: (addr array byte) <- copy _buf
257   var i/ecx: int <- copy 0
258   var curr/eax: int <- copy n
259   var curr-byte/edx: int <- copy 0
260   {
261     compare curr, 0
262     break-if-=
263     curr, curr-byte <- integer-divide curr, 0xa
264     var dest/ebx: (addr byte) <- index buf, i
265     copy-byte-to *dest, curr-byte
266     i <- increment
267     loop
268   }
269   return i
270 }
271 
272 fn reverse-digits _buf: (addr array byte), n: int {
273   var buf/esi: (addr array byte) <- copy _buf
274   var left/ecx: int <- copy 0
275   var right/edx: int <- copy n
276   right <- decrement
277   {
278     compare left, right
279     break-if->=
280     {
281       var l-a/ecx: (addr byte) <- index buf, left
282       var r-a/edx: (addr byte) <- index buf, right
283       var l/ebx: byte <- copy-byte *l-a
284       var r/eax: byte <- copy-byte *r-a
285       copy-byte-to *l-a, r
286       copy-byte-to *r-a, l
287     }
288     left <- increment
289     right <- decrement
290     loop
291   }
292 }
293 
294 # debug helper
295 fn dump-digits _buf: (addr array byte), count: int, msg: (addr array byte) {
296   var buf/edi: (addr array byte) <- copy _buf
297   var i/ecx: int <- copy 0
298   print-string 0, msg
299   print-string 0, ": "
300   {
301     compare i, count
302     break-if->=
303     var curr/edx: (addr byte) <- index buf, i
304     var curr-byte/eax: byte <- copy-byte *curr
305     var curr-int/eax: int <- copy curr-byte
306     print-int32-decimal 0, curr-int
307     print-string 0, " "
308     break-if-=
309     i <- increment
310     loop
311   }
312   print-string 0, "\n"
313 }
314 
315 fn double-array-of-decimal-digits _buf: (addr array byte), _n: int -> _/eax: int {
316   var buf/edi: (addr array byte) <- copy _buf
317   # initialize delta
318   var delta/edx: int <- copy 0
319   {
320     var curr/ebx: (addr byte) <- index buf, 0
321     var tmp/eax: byte <- copy-byte *curr
322     compare tmp, 5
323     break-if-<
324     delta <- copy 1
325   }
326   # loop
327   var x/eax: int <- copy 0
328   var i/ecx: int <- copy _n
329   i <- decrement
330   {
331     compare i, 0
332     break-if-<=
333     # x += 2*buf[i]
334     {
335       var tmp/ecx: (addr byte) <- index buf, i
336       var tmp2/ecx: byte <- copy-byte *tmp
337       x <- add tmp2
338       x <- add tmp2
339     }
340     # x, buf[i+delta] = x/10, x%10
341     {
342       var dest-index/ecx: int <- copy i
343       dest-index <- add delta
344       var dest/edi: (addr byte) <- index buf, dest-index
345       var next-digit/edx: int <- copy 0
346       x, next-digit <- integer-divide x, 0xa
347       copy-byte-to *dest, next-digit
348     }
349     #
350     i <- decrement
351     loop
352   }
353   # final patch-up
354   var n/eax: int <- copy _n
355   compare delta, 1
356   {
357     break-if-!=
358     var curr/ebx: (addr byte) <- index buf, 0
359     var one/edx: int <- copy 1
360     copy-byte-to *curr, one
361     n <- increment
362   }
363   return n
364 }
365 
366 fn halve-array-of-decimal-digits _buf: (addr array byte), _n: int, _dp: int -> _/eax: int, _/edx: int {
367   var buf/edi: (addr array byte) <- copy _buf
368   var n/eax: int <- copy _n
369   var dp/edx: int <- copy _dp
370   # initialize one side
371   {
372     # if buf[n-1]%2 == 0, break
373     var right-index/ecx: int <- copy n
374     right-index <- decrement
375     var right-a/ecx: (addr byte) <- index buf, right-index
376     var right/ecx: byte <- copy-byte *right-a
377     var right-int/ecx: int <- copy right
378     var remainder/edx: int <- copy 0
379     {
380       var dummy/eax: int <- copy 0
381       dummy, remainder <- integer-divide right-int, 2
382     }
383     compare remainder, 0
384     break-if-=
385     # buf[n] = 0
386     var next-a/ecx: (addr byte) <- index buf, n
387     var zero/edx: byte <- copy 0
388     copy-byte-to *next-a, zero
389     # n++
390     n <- increment
391   }
392   # initialize the other
393   var delta/ebx: int <- copy 0
394   var x/esi: int <- copy 0
395   {
396     # if buf[0] >= 2, break
397     var left/ecx: (addr byte) <- index buf, 0
398     var src/ecx: byte <- copy-byte *left
399     compare src, 2
400     break-if->=
401     # delta, x = 1, buf[0]
402     delta <- copy 1
403     x <- copy src
404     # n--
405     n <- decrement
406     # dp--
407     dp <- decrement
408   }
409   # loop
410   var i/ecx: int <- copy 0
411   {
412     compare i, n
413     break-if->=
414     # x = x*10 + buf[i+delta]
415     {
416       var ten/edx: int <- copy 0xa
417       x <- multiply ten
418       var src-index/edx: int <- copy i
419       src-index <- add delta
420       var src-a/edx: (addr byte) <- index buf, src-index
421       var src/edx: byte <- copy-byte *src-a
422       x <- add src
423     }
424     # buf[i], x = x/2, x%2
425     {
426       var quotient/eax: int <- copy 0
427       var remainder/edx: int <- copy 0
428       quotient, remainder <- integer-divide x, 2
429       x <- copy remainder
430       var dest/edx: (addr byte) <- index buf, i
431       copy-byte-to *dest, quotient
432     }
433     #
434     i <- increment
435     loop
436   }
437   return n, dp
438 }
439 
440 fn print-float-buffer screen: (addr screen), _buf: (addr array byte), n: int, dp: int, precision: int {
441   var buf/edi: (addr array byte) <- copy _buf
442 #?   print-int32-hex 0, dp
443 #?   print-string 0, "\n"
444   {
445     compare dp, 0
446     break-if->=
447     print-float-buffer-in-scientific-notation screen, buf, n, dp, precision
448     return
449   }
450   {
451     var dp2/eax: int <- copy dp
452     compare dp2, precision
453     break-if-<=
454     print-float-buffer-in-scientific-notation screen, buf, n, dp, precision
455     return
456   }
457   {
458     compare dp, 0
459     break-if-!=
460     print-string screen, "0"
461   }
462   var i/eax: int <- copy 0
463   # bounds = min(n, dp+3)
464   var limit/edx: int <- copy dp
465   limit <- add 3
466   {
467     compare limit, n
468     break-if-<=
469     limit <- copy n
470   }
471   {
472     compare i, limit
473     break-if->=
474     # print '.' if necessary
475     compare i, dp
476     {
477       break-if-!=
478       print-string screen, "."
479     }
480     var curr-a/ecx: (addr byte) <- index buf, i
481     var curr/ecx: byte <- copy-byte *curr-a
482     curr <- add 0x30  # '0'
483     var curr-grapheme/ecx: grapheme <- copy curr
484     print-grapheme screen, curr-grapheme
485     i <- increment
486     loop
487   }
488 }
489 
490 fn print-float-buffer-in-scientific-notation screen: (addr screen), _buf: (addr array byte), n: int, dp: int, precision: int {
491   var buf/edi: (addr array byte) <- copy _buf
492   var i/eax: int <- copy 0
493   {
494     compare i, n
495     break-if->=
496     compare i, precision
497     break-if->=
498     compare i, 1
499     {
500       break-if-!=
501       print-string screen, "."
502     }
503     var curr-a/ecx: (addr byte) <- index buf, i
504     var curr/ecx: byte <- copy-byte *curr-a
505     curr <- add 0x30  # '0'
506     var curr-grapheme/ecx: grapheme <- copy curr
507     print-grapheme screen, curr-grapheme
508     #
509     i <- increment
510     loop
511   }
512   print-string screen, "e"
513   decrement dp
514   print-int32-decimal screen, dp
515 }
516 
517 # follows the structure of print-float-decimal-approximate
518 # 'precision' controls the maximum width past which we resort to scientific notation
519 fn float-size in: float, precision: int -> _/eax: int {
520   # - special names
521   var bits/eax: int <- reinterpret in
522   compare bits, 0
523   {
524     break-if-!=
525     return 1  # "0"
526   }
527   compare bits, 0x80000000
528   {
529     break-if-!=
530     return 2  # "-0"
531   }
532   compare bits, 0x7f800000
533   {
534     break-if-!=
535     return 3  # "Inf"
536   }
537   compare bits, 0xff800000
538   {
539     break-if-!=
540     return 4  # "-Inf"
541   }
542   var exponent/ecx: int <- copy bits
543   exponent <- shift-right 0x17  # 23 bits of mantissa
544   exponent <- and 0xff
545   exponent <- subtract 0x7f
546   compare exponent, 0x80
547   {
548     break-if-!=
549     return 3  # "NaN"
550   }
551   # - regular numbers
552   # v = 1.mantissa (in base 2) << 0x17
553   var v/ebx: int <- copy bits
554   v <- and 0x7fffff
555   v <- or 0x00800000  # insert implicit 1
556   # e = exponent - 0x17
557   var e/ecx: int <- copy exponent
558   e <- subtract 0x17  # move decimal place from before mantissa to after
559 
560   # initialize buffer with decimal representation of v
561   var buf-storage: (array byte 0x7f)
562   var buf/edi: (addr array byte) <- address buf-storage
563   var n/eax: int <- decimal-digits v, buf
564   reverse-digits buf, n
565 
566   # loop if e > 0
567   {
568     compare e, 0
569     break-if-<=
570     n <- double-array-of-decimal-digits buf, n
571     e <- decrement
572     loop
573   }
574 
575   var dp/edx: int <- copy n
576 
577   # loop if e < 0
578   {
579     compare e, 0
580     break-if->=
581     n, dp <- halve-array-of-decimal-digits buf, n, dp
582     e <- increment
583     loop
584   }
585 
586   compare dp, 0
587   {
588     break-if->=
589     return 8  # hacky for scientific notation
590   }
591   {
592     var dp2/eax: int <- copy dp
593     compare dp2, precision
594     break-if-<=
595     return 8  # hacky for scientific notation
596   }
597 
598   # result = min(n, dp+3)
599   var result/ecx: int <- copy dp
600   result <- add 3
601   {
602     compare result, n
603     break-if-<=
604     result <- copy n
605   }
606 
607   # account for decimal point
608   compare dp, n
609   {
610     break-if->=
611     result <- increment
612   }
613 
614   # account for sign
615   var sign/edx: int <- reinterpret in
616   sign <- shift-right 0x1f
617   {
618     compare sign, 1
619     break-if-!=
620     result <- increment
621   }
622   return result
623 }
624 
625 ## helper
626 
627 # like check-strings-equal, except array sizes don't have to match
628 fn check-buffer-contains _buf: (addr array byte), _contents: (addr array byte), msg: (addr array byte) {
629   var buf/esi: (addr array byte) <- copy _buf
630   var contents/edi: (addr array byte) <- copy _contents
631   var a/eax: boolean <- string-starts-with? buf, contents
632   check-true a, msg
633   var len/ecx: int <- length contents
634   var len2/eax: int <- length buf
635   compare len, len2
636   break-if-=
637   var c/eax: (addr byte) <- index buf, len
638   var d/eax: byte <- copy-byte *c
639   var e/eax: int <- copy d
640   check-ints-equal e, 0, msg
641 }
642 
643 fn test-check-buffer-contains {
644   var arr: (array byte 4)
645   var a/esi: (addr array byte) <- address arr
646   var b/eax: (addr byte) <- index a, 0
647   var c/ecx: byte <- copy 0x61  # 'a'
648   copy-byte-to *b, c
649   check-buffer-contains a, "a", "F - test-check-buffer-contains"
650   check-buffer-contains "a", "a", "F - test-check-buffer-contains/null"  # no null check when arrays have same length
651 }
652 
653 #? fn main -> _/ebx: int {
654 #?   run-tests
655 #? #?   test-print-float-decimal-approximate-integer
656 #? #?   test-print-float-decimal-approximate-normal
657 #?   return 0
658 #? }