| ... |
... |
@@ -40,33 +40,31 @@ |
|
40
|
40
|
;;; call, and saves number consing to boot.
|
|
41
|
41
|
;;;
|
|
42
|
42
|
(defmacro def-math-rtn (name num-args)
|
|
43
|
|
- (multiple-value-bind (c-name lisp-name)
|
|
44
|
|
- (if (listp name)
|
|
45
|
|
- (values (first name) (second name))
|
|
46
|
|
- (values name
|
|
47
|
|
- (intern (concatenate 'simple-string
|
|
48
|
|
- "%"
|
|
49
|
|
- (string-upcase name)))))
|
|
50
|
|
- `(progn
|
|
51
|
|
- (declaim (inline ,lisp-name))
|
|
52
|
|
- (export ',lisp-name)
|
|
53
|
|
- (alien:def-alien-routine (,c-name ,lisp-name) double-float
|
|
54
|
|
- ,@(let ((results nil))
|
|
55
|
|
- (dotimes (i num-args (nreverse results))
|
|
56
|
|
- (push (list (intern (format nil "ARG-~D" i))
|
|
57
|
|
- 'double-float)
|
|
58
|
|
- results))))
|
|
59
|
|
- ;; The C99 convention is for the float version to have the same
|
|
60
|
|
- ;; name as the double version but with an "f" appended. We do
|
|
61
|
|
- ;; the same here and append an "F" to the lisp name too.
|
|
62
|
|
- (alien:def-alien-routine (,(concatenate 'string c-name "f")
|
|
63
|
|
- ,(symbolicate lisp-name "F"))
|
|
64
|
|
- single-float
|
|
65
|
|
- ,@(let ((results nil))
|
|
66
|
|
- (dotimes (i num-args (nreverse results))
|
|
67
|
|
- (push (list (intern (format nil "ARG-~D" i))
|
|
68
|
|
- 'single-float)
|
|
69
|
|
- results)))))))
|
|
|
43
|
+ (flet ((def-rtn (c-name lisp-name type)
|
|
|
44
|
+ `(progn
|
|
|
45
|
+ (declaim (inline ,lisp-name))
|
|
|
46
|
+ (export ',lisp-name)
|
|
|
47
|
+ (alien:def-alien-routine (,c-name ,lisp-name) ,type
|
|
|
48
|
+ ,@(let ((results nil))
|
|
|
49
|
+ (dotimes (i num-args (nreverse results))
|
|
|
50
|
+ (push (list (intern (format nil "ARG-~D" i))
|
|
|
51
|
+ type)
|
|
|
52
|
+ results)))))))
|
|
|
53
|
+ (multiple-value-bind (c-name lisp-name)
|
|
|
54
|
+ (if (listp name)
|
|
|
55
|
+ (values (first name) (second name))
|
|
|
56
|
+ (values name
|
|
|
57
|
+ (intern (concatenate 'simple-string
|
|
|
58
|
+ "%"
|
|
|
59
|
+ (string-upcase name)))))
|
|
|
60
|
+ `(progn
|
|
|
61
|
+ ,(def-rtn c-name lisp-name 'double-float)
|
|
|
62
|
+ ;; The C99 convention is for the float version to have the same
|
|
|
63
|
+ ;; name as the double version but with an "f" appended. We do
|
|
|
64
|
+ ;; the same here and append an "F" to the lisp name too.
|
|
|
65
|
+ ,(def-rtn (concatenate 'string c-name "f")
|
|
|
66
|
+ (symbolicate lisp-name "F")
|
|
|
67
|
+ 'single-float)))))
|
|
70
|
68
|
|
|
71
|
69
|
(eval-when (compile load eval)
|
|
72
|
70
|
|