1 (in-package "SB-POSIX")
4 "Parse the string INPUT and return a double-precision float,
5 and a secondary value, the number of characters consumed."
6 (flet ((strtod/base-string
(chars offset
)
7 (declare (simple-base-string chars
))
8 ;; On x86, dx arrays are quicker to make than aliens.
9 (sb-int:dx-let
((end (make-array 1 :element-type
'sb-ext
:word
)))
10 (sb-sys:with-pinned-objects
(chars)
11 (let* ((base (sb-sys:sap
+ (sb-sys:vector-sap chars
) offset
))
15 (extern-alien "strtod" (function double
19 (sb-sys:vector-sap end
))
20 (floating-point-overflow () nil
))))
24 (- (aref end
0) (sb-sys:sap-int base
))))))))))
25 (when (typep string
'simple-base-string
)
26 (return-from strtod
(strtod/base-string string
0)))
27 ;; Non-simple base-string with a null terminator in the right place.
28 (when (typep string
'base-string
)
29 (sb-kernel:with-array-data
((data string
) (start) (end) :check-fill-pointer t
)
31 (declare (optimize (sb-c::insert-array-bounds-checks
0)))
32 (schar data
(1+ end
))) #\Nul
)
33 (return-from strtod
(strtod/base-string data start
)))))
34 ;; Short simple non-base string, or base-string w/o a null in the right place
35 (when (typep string
'(or (simple-array character
(*)) base-string
))
36 (let ((length (length string
)))
37 (when (< length
256) ; arbitrary limit to keep stack usage minimal
38 (string-dispatch ((simple-array character
(*)) base-string
) string
39 (sb-int:dx-let
((copy (make-array length
:element-type
'base-char
)))
40 (loop for i below length do
(setf (schar copy i
) (char string i
)))
41 (return-from strtod
(strtod/base-string copy
0)))))))
42 (strtod/base-string
(coerce string
'simple-base-string
) 0))) ; Anything else