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-write-float-decimal-approximate-normal {
 26   var s-storage: (stream byte 0x10)
 27   var s/ecx: (addr stream byte) <- address s-storage
 28   # 0.5
 29   var half/xmm0: float <- rational 1, 2
 30   write-float-decimal-approximate s, half, 3
 31   check-stream-equal s, "0.5", "F - test-write-float-decimal-approximate-normal 0.5"
 32   # 0.25
 33   clear-stream s
 34   var quarter/xmm0: float <- rational 1, 4
 35   write-float-decimal-approximate s, quarter, 3
 36   check-stream-equal s, "0.25", "F - test-write-float-decimal-approximate-normal 0.25"
 37   # 0.75
 38   clear-stream s
 39   var three-quarters/xmm0: float <- rational 3, 4
 40   write-float-decimal-approximate s, three-quarters, 3
 41   check-stream-equal s, "0.75", "F - test-write-float-decimal-approximate-normal 0.75"
 42   # 0.125
 43   clear-stream s
 44   var eighth/xmm0: float <- rational 1, 8
 45   write-float-decimal-approximate s, eighth, 3
 46   check-stream-equal s, "0.125", "F - test-write-float-decimal-approximate-normal 0.125"
 47   # 0.0625; start using scientific notation
 48   clear-stream s
 49   var sixteenth/xmm0: float <- rational 1, 0x10
 50   write-float-decimal-approximate s, sixteenth, 3
 51   check-stream-equal s, "6.25e-2", "F - test-write-float-decimal-approximate-normal 0.0625"
 52   # sqrt(2); truncate floats with lots of digits after the decimal but not too many before
 53   clear-stream s
 54   var two-f/xmm0: float <- rational 2, 1
 55   var sqrt-2/xmm0: float <- square-root two-f
 56   write-float-decimal-approximate s, sqrt-2, 3
 57   check-stream-equal s, "1.414", "F - test-write-float-decimal-approximate-normal √2"
 58 }
 59 
 60 # print whole integers without decimals
 61 fn test-write-float-decimal-approximate-integer {
 62   var s-storage: (stream byte 0x10)
 63   var s/ecx: (addr stream byte) <- address s-storage
 64   # 1
 65   var one-f/xmm0: float <- rational 1, 1
 66   write-float-decimal-approximate s, one-f, 3
 67   check-stream-equal s, "1", "F - test-write-float-decimal-approximate-integer 1"
 68   # 2
 69   clear-stream s
 70   var two-f/xmm0: float <- rational 2, 1
 71   write-float-decimal-approximate s, two-f, 3
 72   check-stream-equal s, "2", "F - test-write-float-decimal-approximate-integer 2"
 73   # 10
 74   clear-stream s
 75   var ten-f/xmm0: float <- rational 0xa, 1
 76   write-float-decimal-approximate s, ten-f, 3
 77   check-stream-equal s, "10", "F - test-write-float-decimal-approximate-integer 10"
 78   # -10
 79   clear-stream s
 80   var minus-ten-f/xmm0: float <- rational -0xa, 1
 81   write-float-decimal-approximate s, minus-ten-f, 3
 82   check-stream-equal s, "-10", "F - test-write-float-decimal-approximate-integer -10"
 83   # 999
 84   clear-stream s
 85   var minus-ten-f/xmm0: float <- rational 0x3e7, 1
 86   write-float-decimal-approximate s, minus-ten-f, 3
 87   check-stream-equal s, "999", "F - test-write-float-decimal-approximate-integer 1000"
 88   # 1000 - start using scientific notation
 89   clear-stream s
 90   var minus-ten-f/xmm0: float <- rational 0x3e8, 1
 91   write-float-decimal-approximate s, minus-ten-f, 3
 92   check-stream-equal s, "1.00e3", "F - test-write-float-decimal-approximate-integer 1000"
 93   # 100,000
 94   clear-stream s
 95   var hundred-thousand/eax: int <- copy 0x186a0
 96   var hundred-thousand-f/xmm0: float <- convert hundred-thousand
 97   write-float-decimal-approximate s, hundred-thousand-f, 3
 98   check-stream-equal s, "1.00e5", "F - test-write-float-decimal-approximate-integer 100,000"
 99 }
100 
101 fn test-write-float-decimal-approximate-zero {
102   var s-storage: (stream byte 0x10)
103   var s/ecx: (addr stream byte) <- address s-storage
104   var zero: float
105   write-float-decimal-approximate s, zero, 3
106   check-stream-equal s, "0", "F - test-write-float-decimal-approximate-zero"
107 }
108 
109 fn test-write-float-decimal-approximate-negative-zero {
110   var s-storage: (stream byte 0x10)
111   var s/ecx: (addr stream byte) <- address s-storage
112   var n: int
113   copy-to n, 0x80000000
114   var negative-zero/xmm0: float <- reinterpret n
115   write-float-decimal-approximate s, negative-zero, 3
116   check-stream-equal s, "-0", "F - test-write-float-decimal-approximate-negative-zero"
117 }
118 
119 fn test-write-float-decimal-approximate-infinity {
120   var s-storage: (stream byte 0x10)
121   var s/ecx: (addr stream byte) <- address s-storage
122   var n: int
123   #          0|11111111|00000000000000000000000
124   #          0111|1111|1000|0000|0000|0000|0000|0000
125   copy-to n, 0x7f800000
126   var infinity/xmm0: float <- reinterpret n
127   write-float-decimal-approximate s, infinity, 3
128   check-stream-equal s, "Inf", "F - test-write-float-decimal-approximate-infinity"
129 }
130 
131 fn test-write-float-decimal-approximate-negative-infinity {
132   var s-storage: (stream byte 0x10)
133   var s/ecx: (addr stream byte) <- address s-storage
134   var n: int
135   copy-to n, 0xff800000
136   var negative-infinity/xmm0: float <- reinterpret n
137   write-float-decimal-approximate s, negative-infinity, 3
138   check-stream-equal s, "-Inf", "F - test-write-float-decimal-approximate-negative-infinity"
139 }
140 
141 fn test-write-float-decimal-approximate-not-a-number {
142   var s-storage: (stream byte 0x10)
143   var s/ecx: (addr stream byte) <- address s-storage
144   var n: int
145   copy-to n, 0xffffffff  # exponent must be all 1's, and mantissa must be non-zero
146   var nan/xmm0: float <- reinterpret n
147   write-float-decimal-approximate s, nan, 3
148   check-stream-equal s, "NaN", "F - test-write-float-decimal-approximate-not-a-number"
149 }
150 
151 fn print-float-decimal-approximate screen: (addr screen), in: float, precision: int {
152   var s-storage: (stream byte 0x10)
153   var s/esi: (addr stream byte) <- address s-storage
154   write-float-decimal-approximate s, in, precision
155   print-stream screen, s
156 }
157 
158 # 'precision' controls the maximum width past which we resort to scientific notation
159 fn write-float-decimal-approximate out: (addr stream byte), in: float, precision: int {
160   # - special names
161   var bits/eax: int <- reinterpret in
162   compare bits, 0
163   {
164     break-if-!=
165     write out, "0"
166     return
167   }
168   compare bits, 0x80000000
169   {
170     break-if-!=
171     write out, "-0"
172     return
173   }
174   compare bits, 0x7f800000
175   {
176     break-if-!=
177     write out, "Inf"
178     return
179   }
180   compare bits, 0xff800000
181   {
182     break-if-!=
183     write out, "-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     write out, "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     append-byte out, 0x2d/minus
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   _write-float-array-of-decimal-digits out, 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 _write-float-array-of-decimal-digits out: (addr stream byte), _buf: (addr array byte), n: int, dp: int, precision: int {
433   var buf/edi: (addr array byte) <- copy _buf
434   {
435     compare dp, 0
436     break-if->=
437     _write-float-array-of-decimal-digits-in-scientific-notation out, buf, n, dp, precision
438     return
439   }
440   {
441     var dp2/eax: int <- copy dp
442     compare dp2, precision
443     break-if-<=
444     _write-float-array-of-decimal-digits-in-scientific-notation out, buf, n, dp, precision
445     return
446   }
447   {
448     compare dp, 0
449     break-if-!=
450     append-byte out, 0x30/0
451   }
452   var i/eax: int <- copy 0
453   # bounds = min(n, dp+3)
454   var limit/edx: int <- copy dp
455   limit <- add 3
456   {
457     compare limit, n
458     break-if-<=
459     limit <- copy n
460   }
461   {
462     compare i, limit
463     break-if->=
464     # print '.' if necessary
465     compare i, dp
466     {
467       break-if-!=
468       append-byte out, 0x2e/decimal-point
469     }
470     var curr-a/ecx: (addr byte) <- index buf, i
471     var curr/ecx: byte <- copy-byte *curr-a
472     var curr-int/ecx: int <- copy curr
473     curr-int <- add 0x30/0
474     append-byte out, curr-int
475     #
476     i <- increment
477     loop
478   }
479 }
480 
481 fn _write-float-array-of-decimal-digits-in-scientific-notation out: (addr stream byte), _buf: (addr array byte), n: int, dp: int, precision: int {
482   var buf/edi: (addr array byte) <- copy _buf
483   var i/eax: int <- copy 0
484   {
485     compare i, n
486     break-if->=
487     compare i, precision
488     break-if->=
489     compare i, 1
490     {
491       break-if-!=
492       append-byte out, 0x2e/decimal-point
493     }
494     var curr-a/ecx: (addr byte) <- index buf, i
495     var curr/ecx: byte <- copy-byte *curr-a
496     var curr-int/ecx: int <- copy curr
497     curr-int <- add 0x30/0
498     append-byte out, curr-int
499     #
500     i <- increment
501     loop
502   }
503   append-byte out, 0x65/e
504   decrement dp
505   write-int32-decimal out, dp
506 }
507 
508 # follows the structure of write-float-decimal-approximate
509 # 'precision' controls the maximum width past which we resort to scientific notation
510 fn float-size in: float, precision: int -> _/eax: int {
511   # - special names
512   var bits/eax: int <- reinterpret in
513   compare bits, 0
514   {
515     break-if-!=
516     return 1  # for "0"
517   }
518   compare bits, 0x80000000
519   {
520     break-if-!=
521     return 2  # for "-0"
522   }
523   compare bits, 0x7f800000
524   {
525     break-if-!=
526     return 3  # for "Inf"
527   }
528   compare bits, 0xff800000
529   {
530     break-if-!=
531     return 4  # for "-Inf"
532   }
533   var exponent/ecx: int <- copy bits
534   exponent <- shift-right 0x17  # 23 bits of mantissa
535   exponent <- and 0xff
536   exponent <- subtract 0x7f
537   compare exponent, 0x80
538   {
539     break-if-!=
540     return 3  # for "NaN"
541   }
542   # - regular numbers
543   # v = 1.mantissa (in base 2) << 0x17
544   var v/ebx: int <- copy bits
545   v <- and 0x7fffff
546   v <- or 0x00800000  # insert implicit 1
547   # e = exponent - 0x17
548   var e/ecx: int <- copy exponent
549   e <- subtract 0x17  # move decimal place from before mantissa to after
550 
551   # initialize buffer with decimal representation of v
552   var buf-storage: (array byte 0x7f)
553   var buf/edi: (addr array byte) <- address buf-storage
554   var n/eax: int <- decimal-digits v, buf
555   reverse-digits buf, n
556 
557   # loop if e > 0
558   {
559     compare e, 0
560     break-if-<=
561     n <- double-array-of-decimal-digits buf, n
562     e <- decrement
563     loop
564   }
565 
566   var dp/edx: int <- copy n
567 
568   # loop if e < 0
569   {
570     compare e, 0
571     break-if->=
572     n, dp <- halve-array-of-decimal-digits buf, n, dp
573     e <- increment
574     loop
575   }
576 
577   compare dp, 0
578   {
579     break-if->=
580     return 8  # hacky for scientific notation
581   }
582   {
583     var dp2/eax: int <- copy dp
584     compare dp2, precision
585     break-if-<=
586     return 8  # hacky for scientific notation
587   }
588 
589   # result = min(n, dp+3)
590   var result/ecx: int <- copy dp
591   result <- add 3
592   {
593     compare result, n
594     break-if-<=
595     result <- copy n
596   }
597 
598   # account for decimal point
599   compare dp, n
600   {
601     break-if->=
602     result <- increment
603   }
604 
605   # account for sign
606   var sign/edx: int <- reinterpret in
607   sign <- shift-right 0x1f
608   {
609     compare sign, 1
610     break-if-!=
611     result <- increment
612   }
613   return result
614 }
615 
616 ## helper
617 
618 # like check-strings-equal, except array sizes don't have to match
619 fn check-buffer-contains _buf: (addr array byte), _contents: (addr array byte), msg: (addr array byte) {
620   var buf/esi: (addr array byte) <- copy _buf
621   var contents/edi: (addr array byte) <- copy _contents
622   var a/eax: boolean <- string-starts-with? buf, contents
623   check a, msg
624   var len/ecx: int <- length contents
625   var len2/eax: int <- length buf
626   compare len, len2
627   break-if-=
628   var c/eax: (addr byte) <- index buf, len
629   var d/eax: byte <- copy-byte *c
630   var e/eax: int <- copy d
631   check-ints-equal e, 0, msg
632 }
633 
634 fn test-check-buffer-contains {
635   var arr: (array byte 4)
636   var a/esi: (addr array byte) <- address arr
637   var b/eax: (addr byte) <- index a, 0
638   var c/ecx: byte <- copy 0x61/a
639   copy-byte-to *b, c
640   check-buffer-contains a, "a", "F - test-check-buffer-contains"
641   check-buffer-contains "a", "a", "F - test-check-buffer-contains/null"  # no null check when arrays have same length
642 }