source: project/release/3/fpio/trunk/fpio.scm @ 10558

Last change on this file since 10558 was 10558, checked in by Ivan Raikov, 12 years ago

Import fpio sources in the repository

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(define-extension fpio)
20
21(declare (export fp->string string->fp))
22
23
24#>
25#include <gdtoa.h>
26<#
27
28;; strtord(CONST char *s, char **sp, int rounding, double *d)
29;;      rounding_mode values:
30;;              0 = toward zero
31;;              1 = nearest
32;;              2 = toward +Infinity
33;;              3 = toward -Infinity
34 
35(define strtord 
36  (foreign-lambda* double ((nonnull-c-string s) (integer rounding))
37#<<END
38   
39    char *sp; double n;
40
41    strtord (s, &sp, rounding, &n);
42
43    C_return(n);   
44END
45))
46
47(define dtoa
48  (foreign-lambda* nonnull-c-string ((nonnull-blob b) (number x) (integer ndig) (unsigned-int bufsize))
49#<<END
50
51   double n = x;
52
53   g_dfmt(b, &n, ndig, bufsize);
54
55   C_return(b);
56END
57))
58
59
60(define (fp->string x . rest)
61  (let-optionals rest ((ndig 0 ))
62    (let* ((bufsize (max (+ ndig 20) 1024))
63           (buffer (make-blob bufsize)))
64      (dtoa buffer x ndig bufsize))))
65
66
67(define (string->fp s . rest)
68  (let-optionals rest ((rounding 'toward-zero ))
69      (strtord s (case rounding
70                   ((toward-zero) 0)
71                   ((nearest)     1)
72                   ((toward+Inf)  2)
73                   ((toward-Inf)  3)))))
Note: See TracBrowser for help on using the repository browser.