source: project/release/4/fpio/trunk/fpio.scm @ 14394

Last change on this file since 14394 was 14394, checked in by Ivan Raikov, 11 years ago

fpio ported to Chicken 4

File size: 1.6 KB
Line 
1
2;;
3;; Conversion of floating-point numbers between IEEE binary
4;; representation and decimal string representation.
5;;
6;; Based on the gdtoa library by David M. Gay
7;;
8
9;;
10;; This Chicken extension was written by Ivan Raikov.
11;;
12;; Permission to use, copy, modify, and distribute this software and
13;; its documentation for any purpose and without fee is hereby
14;; granted, provided that the above copyright notice appear in all
15;; copies and that both that the copyright notice and this permission
16;; notice appear in supporting documentation.
17;;
18
19(module fpio
20
21 (export fp->string string->fp)
22                   
23 (import scheme chicken data-structures  )
24
25
26(define (fp->string x . rest)
27  (let-optionals rest ((ndig 0 ))
28    (let* ((bufsize (max (+ ndig 20) 1024))
29           (buffer (make-blob bufsize)))
30      (dtoa buffer x ndig bufsize))))
31
32
33(define (string->fp s . rest)
34  (let-optionals rest ((rounding 'toward-zero ))
35      (strtord s (case rounding
36                   ((toward-zero) 0)
37                   ((nearest)     1)
38                   ((toward+Inf)  2)
39                   ((toward-Inf)  3)))))
40
41#>
42#include <gdtoa.h>
43<#
44
45;; strtord(CONST char *s, char **sp, int rounding, double *d)
46;;      rounding_mode values:
47;;              0 = toward zero
48;;              1 = nearest
49;;              2 = toward +Infinity
50;;              3 = toward -Infinity
51 
52(define strtord 
53  (foreign-lambda* double ((nonnull-c-string s) (integer rounding))
54#<<END
55   
56    char *sp; double n;
57
58    strtord (s, &sp, rounding, &n);
59
60    C_return(n);   
61END
62))
63
64(define dtoa
65  (foreign-lambda* nonnull-c-string ((nonnull-blob b) (number x) (integer ndig) (unsigned-int bufsize))
66#<<END
67
68   double n = x;
69
70   g_dfmt(b, &n, ndig, bufsize);
71
72   C_return(b);
73END
74))
75
76
77)
Note: See TracBrowser for help on using the repository browser.