mclglue.lsp

   1 ;;;; mclglue -- Interface to C library
   2 ;;;;
   3 ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for
   4 ;;;; unrestricted use.
   5
   6 (require :ff)
   7 ;(require :traps)
   8
   9 (in-package ls-basics)
  10
  11 (import '(ccl:def-logical-directory ccl:ff-load ccl:deffcfun ccl:defccallable))
  12
  13 (def-logical-directory "mclslib;" "mcls;lib:")
  14 (def-logical-directory "clib;" "ccl;:mpw:libraries:clibraries:")
  15 (def-logical-directory "mpwlib;" "ccl;:mpw:libraries:libraries:")
  16
  17 (defvar mcls-libs '("mclslib;clib.o"
  18                     "clib;CRuntime.o"
  19                     "mpwlib;Interface.o"
  20                     "clib;StdCLib.o"
  21                     "clib;CSANELib.o"
  22                     "clib;Math.o"
  23                     "clib;CInterface.o"))
  24 (defvar mcls-libs-881 '("mclslib;clib.o"
  25                         "clib;CLib881.o"
  26                         "mpwlib;Interface.o"
  27                         "clib;StdCLib.o"
  28                         "clib;CSANELib881.o"
  29                         "clib;Math881.o"
  30                         "clib;CInterface.o"))
  31
  32 (ff-load "mclslib;mclglue.c.o"
  33          :ffenv-name 'mcls1
  34          :replace t
  35          :libraries mcls-libs)
  36
  37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39 ;;;;
  40 ;;;;                           Basic Utilities
  41 ;;;;
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44
  45 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46 ;;;;
  47 ;;;;                     Callback Support Functions
  48 ;;;;
  49 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  50
  51 (deffcfun (ccl-store-integer "ccl_store_integer") (fixnum) :novalue)
  52 (deffcfun (ccl-store-double "ccl_store_double") (float) :novalue)
  53 (deffcfun (ccl-store-ptr "ccl_store_ptr") ((t :ptr)) :novalue)
  54
  55 ;;;;
  56 ;;;;                  Lisp-Managed Calloc/Free
  57 ;;;;
  58
  59 #|
  60 (defccallable lisp-new-ptr ((n :long) (:result :void))
  61   (ccl-store-ptr (ccl:_NewPtr :d0 n :a0)))
  62 (deffcfun (register-new-ptr "register_new_ptr") ((t :ptr)) :novalue)
  63 (register-new-ptr lisp-new-ptr)
  64
  65 (defccallable lisp-free-ptr ((p :ptr) (:result :void))
  66   (ccl:_DisposPtr :a0 p :d0))
  67 (deffcfun (register-free-ptr "register_free_ptr") ((t :ptr)) :novalue)
  68 (register-free-ptr lisp-free-ptr)
  69 |#
  70 ;;;;
  71 ;;;;                Storage Allocation Functions
  72 ;;;;
  73
  74 (defun null-ptr-p (p) (ccl:%null-ptr-p p))
  75 (defun ptr-eq (p q) (= (ccl:%ptr-to-int p) (ccl:%ptr-to-int q)))
  76
  77 (deffcfun (ccl-la-base-allocate "la_base_allocate") (fixnum fixnum) :ptr)
  78 (defun la-base-allocate (n m) (ccl-la-base-allocate n m))
  79
  80 (deffcfun (ccl-la-base-free-alloc "la_base_free_alloc") ((t :ptr)) :novalue)
  81 (defun la-base-free (p) (ccl-la-base-free-alloc p))
  82
  83 (deffcfun (ccl-la-mode-size "la_mode_size") (fixnum) :long)
  84 (defun la-mode-size (mode) (ccl-la-mode-size mode))
  85
  86 ;;;;
  87 ;;;;             Callbacks for Internal Storage
  88 ;;;;
  89
  90 (defccallable lisp-la-allocate ((n :long) (m :long) (:result :void))
  91   (ccl-store-ptr (la-allocate n m)))
  92 (deffcfun (register-la-allocate "register_la_allocate") ((t :ptr)) :novalue)
  93 (register-la-allocate lisp-la-allocate)
  94 (deffcfun (la "la_allocate") (fixnum fixnum) :ptr)
  95
  96 (defccallable lisp-la-free-alloc ((p :ptr) (:result :void)) (la-free p))
  97 (deffcfun (register-la-free-alloc "register_la_free_alloc") ((t :ptr)) :novalue)
  98 (register-la-free-alloc lisp-la-free-alloc)
  99 (deffcfun (lf "la_free_alloc") ((t :ptr)) :novalue)
 100
 101 ;;;;
 102 ;;;;                Storage Access Functions
 103 ;;;;
 104
 105 (deffcfun (ccl-la-get-integer "la_get_integer") ((t :ptr) fixnum) :long)
 106 (defun la-get-integer (p i) (ccl-la-get-integer p i))
 107
 108 (deffcfun (ccl-la-get-double "la_get_double") ((t :ptr) fixnum) :float)
 109 (defun la-get-double (p i) (ccl-la-get-double p i))
 110
 111 (deffcfun (ccl-la-get-complex-real "la_get_complex_real") ((t :ptr) fixnum) :float)
 112 (defun la-get-complex-real (p i) (ccl-la-get-complex-real p i))
 113
 114 (deffcfun (ccl-la-get-complex-imag "la_get_complex_imag") ((t :ptr) fixnum) :float)
 115 (defun la-get-complex-imag (p i) (ccl-la-get-complex-imag p i))
 116
 117 (defun la-get-complex (p i)
 118   (complex (la-get-complex-real p i) (la-get-complex-imag p i)))
 119
 120 (deffcfun (ccl-la-get-pointer "la_get_pointer") ((t :ptr) fixnum) :ptr)
 121 (defun la-get-pointer (p i) (ccl-la-get-pointer p i))
 122
 123 ;;;;
 124 ;;;;                Storage Mutation Functions
 125 ;;;;
 126
 127 (deffcfun (ccl-la-put-integer "la_put_integer") ((t :ptr) fixnum fixnum) :novalue)
 128 (defun la-put-integer (p i x) (ccl-la-put-integer p i x))
 129
 130 (deffcfun (ccl-la-put-double "la_put_double") ((t :ptr) fixnum float) :novalue)
 131 (defun la-put-double (p i x) (ccl-la-put-double p i (float x)))
 132
 133 (deffcfun (ccl-la-put-complex "la_put_complex") ((t :ptr) fixnum float float) :novalue)
 134 (defun la-put-complex (p i x y) (ccl-la-put-complex p i (float x) (float y)))
 135
 136 (deffcfun (ccl-la-put-pointer "la_put_pointer") ((t :ptr) fixnum (t :ptr)) :novalue)
 137 (defun la-put-pointer (p i q) (ccl-la-put-pointer p i q))
 138
 139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 140 ;;;;
 141 ;;;;                 XLISP Internal Error Message Emulation
 142 ;;;;
 143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 144
 145 (defvar *buf* (make-string 1000))
 146
 147 (defun set-buf-char (i c) (setf (elt *buf* i) (code-char c)))
 148
 149 (defun get-buf (&optional (n (position (code-char 0) *buf*)))
 150   (subseq *buf* 0 n))
 151
 152 (deffcfun (register-set-buf-char "register_set_buf_char") ((t :ptr)) :novalue)
 153 (defccallable ccl-set-buf-char ((n :long) (c :long) (:result :long))
 154   (set-buf-char n c))
 155 (register-set-buf-char ccl-set-buf-char)
 156
 157 (deffcfun (register-print-buffer "register_print_buffer") ((t :ptr)) :novalue)
 158 (defccallable ccl-print-buffer ((n :long) (type :long) (:result :long))
 159   (case type
 160     (0 (princ (get-buf n)))
 161     (1 (error (get-buf n))))
 162   n)
 163 (register-print-buffer ccl-print-buffer)
 164
 165 (deffcfun (stdputstr "stdputstr") ((string :by-reference)) :novalue)
 166 (deffcfun (xlfail "xlfail") ((string :by-reference)) :novalue)
 167
 168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 169 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 170 ;;;;
 171 ;;;;             Lisp Interfaces to Linear Algebra Routines
 172 ;;;;
 173 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 174 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 175
 176 ;;;;
 177 ;;;; Cholesky Decomposition
 178 ;;;;
 179
 180 (deffcfun (ccl-chol-decomp-front "ccl_chol_decomp_front")
 181   ((t :ptr) fixnum (t :ptr))
 182   :long)
 183 (defun chol-decomp-front (x y z) (ccl-chol-decomp-front x y z))
 184
 185 ;;;;
 186 ;;;; LU Decomposition
 187 ;;;;
 188
 189 (deffcfun (ccl-lu-decomp-front "ccl_lu_decomp_front")
 190   ((t :ptr) fixnum (t :ptr) fixnum (t :ptr))
 191   :long)
 192 (defun lu-decomp-front (x y z u v) (ccl-lu-decomp-front x y z u v))
 193
 194 (deffcfun (ccl-lu-solve-front "ccl_lu_solve_front")
 195   ((t :ptr) fixnum (t :ptr) (t :ptr) fixnum)
 196   :long)
 197 (defun lu-solve-front (x y z u v) (ccl-lu-solve-front x y z u v))
 198
 199 (deffcfun (ccl-lu-inverse-front "ccl_lu_inverse_front")
 200   ((t :ptr) fixnum (t :ptr) (t :ptr) fixnum (t :ptr))
 201   :long)
 202 (defun lu-inverse-front (x y z u v w) (ccl-lu-inverse-front x y z u v w))
 203
 204 ;;;;
 205 ;;;; SV Decomposition
 206 ;;;;
 207
 208 (deffcfun (ccl-sv-decomp-front "ccl_sv_decomp_front")
 209   ((t :ptr) fixnum fixnum (t :ptr) (t :ptr))
 210   :long)
 211 (defun sv-decomp-front (x y z u v) (ccl-sv-decomp-front x y z u v))
 212
 213 ;;;;
 214 ;;;; QR Decomposition
 215 ;;;;
 216
 217 (deffcfun (ccl-qr-decomp-front "ccl_qr_decomp_front")
 218   ((t :ptr) fixnum fixnum (t :ptr) (t :ptr) fixnum)
 219   :long)
 220 (defun qr-decomp-front (x y z u v w) (ccl-qr-decomp-front x y z u v w))
 221
 222 ;;;;
 223 ;;;; Estimate of Condition Number for Lower Triangular Matrix
 224 ;;;;
 225
 226 (deffcfun (ccl-rcondest-front "ccl_rcondest_front") ((t :ptr) fixnum) :float)
 227 (defun rcondest-front (x y) (ccl-rcondest-front x y))
 228
 229 ;;;;
 230 ;;;; Make Rotation Matrix
 231 ;;;;
 232
 233 (deffcfun (ccl-make-rotation-front "ccl_make_rotation_front")
 234   (fixnum (t :ptr) (t :ptr) (t :ptr) fixnum float)
 235   :long)
 236 (defun make-rotation-front (x y z u v w)
 237   (ccl-make-rotation-front x y z u v (float w)))
 238
 239 ;;;;
 240 ;;;; Eigenvalues and Eigenvectors
 241 ;;;;
 242
 243 (deffcfun (ccl-eigen-front "ccl_eigen_front")
 244   ((t :ptr) fixnum (t :ptr) (t :ptr) (t :ptr))
 245   :long)
 246 (defun eigen-front (x y z u v) (ccl-eigen-front x y z u v))
 247
 248 ;;;;
 249 ;;;; Spline Interpolation
 250 ;;;;
 251
 252 (deffcfun (ccl-range-to-rseq "ccl_range_to_rseq")
 253   (fixnum (t :ptr) fixnum (t :ptr))
 254   :long)
 255 (defun la-range-to-rseq (x y z u) (ccl-range-to-rseq x y z u))
 256
 257 (deffcfun (ccl-spline-front "ccl_spline_front")
 258   (fixnum (t :ptr) (t :ptr) fixnum (t :ptr) (t :ptr) (t :ptr))
 259   :long)
 260 (defun spline-front (x y z u v w a) (ccl-spline-front x y z u v w a))
 261
 262 ;;;;
 263 ;;;; Kernel Density Estimators and Smoothers
 264 ;;;;
 265
 266 (deffcfun (ccl-kernel-dens-front "ccl_kernel_dens_front")
 267   ((t :ptr) fixnum float (t :ptr) (t :ptr) fixnum fixnum)
 268   :long)
 269 (defun kernel-dens-front (x y z u v w a)
 270   (ccl-kernel-dens-front x y (float z) u v w a))
 271
 272 (deffcfun (ccl-kernel-smooth-front "ccl_kernel_smooth_front")
 273   ((t :ptr) (t :ptr) fixnum float (t :ptr) (t :ptr) fixnum fixnum)
 274   :long)
 275 (defun kernel-smooth-front (x y z u v w a b)
 276   (ccl-kernel-smooth-front x y z (float u) v w a b))
 277
 278 ;;;;
 279 ;;;; Lowess Smoother Interface
 280 ;;;;
 281
 282 (deffcfun (ccl-base-lowess-front "ccl_base_lowess_front")
 283   ((t :ptr) (t :ptr) fixnum float fixnum float (t :ptr) (t :ptr) (t :ptr))
 284   :long)
 285 (defun base-lowess-front (x y z u v w a b c)
 286   (ccl-base-lowess-front x y z (float u) v (float w) a b c))
 287
 288 ;;;;
 289 ;;;; FFT
 290 ;;;;
 291
 292 (deffcfun (ccl-fft-front "ccl_fft_front") (fixnum (t :ptr) (t :ptr) fixnum) :long)
 293 (defun fft-front (x y z u) (ccl-fft-front x y z u))
 294
 295 ;;;;
 296 ;;;; Maximization and Numerical Derivatives
 297 ;;;;
 298
 299 (defccallable ccl-maximize-callback ((n :long)
 300                                      (px :ptr)
 301                                      (pfval :ptr)
 302                                      (pgrad :ptr)
 303                                      (phess :ptr)
 304                                      (pderivs :ptr)
 305                                      (:result :void))
 306   (maximize-callback n px pfval pgrad phess pderivs))
 307 (deffcfun (register-maximize-callback "register_maximize_callback")
 308                                       ((t :ptr))
 309                                       :novalue)
 310 (register-maximize-callback ccl-maximize-callback)
 311
 312 (deffcfun (ccl-numgrad-front "ccl_numgrad_front")
 313   (fixnum (t :ptr) (t :ptr) float (t :ptr))
 314   :long)
 315 (defun numgrad-front (x y z u v) (ccl-numgrad-front x y z (float u) v))
 316
 317 (deffcfun (ccl-numhess-front "ccl_numhess_front")
 318   (fixnum (t :ptr) (t :ptr) (t :ptr) (t :ptr) float (t :ptr))
 319   :long)
 320 (defun numhess-front (x y z u v w a) (ccl-numhess-front x y z u v (float w) a))
 321
 322 (deffcfun (ccl-minfo-maximize "ccl_minfo_maximize")
 323   ((t :ptr) (t :ptr) (t :ptr) (t :ptr) (t :ptr) fixnum)
 324   :long)
 325 (defun base-minfo-maximize (x y z u v w) (ccl-minfo-maximize x y z u v w))
 326
 327 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 329 ;;;;
 330 ;;;;                     Probability Distributions
 331 ;;;;
 332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 333 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 334
 335
 336 ;;;;
 337 ;;;; C-callable uniform generator
 338 ;;;;
 339
 340 (deffcfun (register-uni "register_uni") ((t :ptr)) :novalue)
 341 (defccallable ccl-uni ((:result :long)) (ccl-store-double (random 1.0)) 0)
 342 (register-uni ccl-uni)
 343
 344 (defun one-uniform-rand () (random 1.0))
 345
 346 ;;;;
 347 ;;;; Log-gamma function
 348 ;;;;
 349
 350 (deffcfun (ccl-base-log-gamma "ccl_gamma") (float) :float)
 351 (defun base-log-gamma (x) (ccl-base-log-gamma (float x)))
 352
 353 ;;;;
 354 ;;;; Normal distribution
 355 ;;;;
 356
 357 (deffcfun (ccl-base-normal-cdf "ccl_normalcdf") (float) :float)
 358 (defun base-normal-cdf (x) (ccl-base-normal-cdf (float x)))
 359 (deffcfun (ccl-base-normal-quant "ccl_normalquant") (float) :float)
 360 (defun base-normal-quant (x) (ccl-base-normal-quant (float x)))
 361 (deffcfun (ccl-base-normal-dens "ccl_normaldens") (float) :float)
 362 (defun base-normal-dens (x) (ccl-base-normal-dens (float x)))
 363 (deffcfun (one-normal-rand "ccl_normalrand") () :float)
 364 (deffcfun (ccl-base-bivnorm-cdf "ccl_bnormcdf") (float float float) :float)
 365 (defun base-bivnorm-cdf (x y z) (ccl-base-bivnorm-cdf (float x) (float y) (float z)))
 366
 367 ;;;;
 368 ;;;; Cauchy distribution
 369 ;;;;
 370
 371 (deffcfun (ccl-base-cauchy-cdf "ccl_cauchycdf") (float) :float)
 372 (defun base-cauchy-cdf (x) (ccl-base-cauchy-cdf (float x)))
 373 (deffcfun (ccl-base-cauchy-quant "ccl_cauchyquant") (float) :float)
 374 (defun base-cauchy-quant (x) (ccl-base-cauchy-quant (float x)))
 375 (deffcfun (ccl-base-cauchy-dens "ccl_cauchydens") (float) :float)
 376 (defun base-cauchy-dens (x) (ccl-base-cauchy-dens (float x)))
 377 (deffcfun (one-cauchy-rand "ccl_cauchyrand") () :float)
 378
 379 ;;;;
 380 ;;;; Gamma distribution
 381 ;;;;
 382
 383 (deffcfun (ccl-base-gamma-cdf "ccl_gammacdf") (float float) :float)
 384 (defun base-gamma-cdf (x y) (ccl-base-gamma-cdf (float x) (float y)))
 385 (deffcfun (ccl-base-gamma-quant "ccl_gammaquant") (float float) :float)
 386 (defun base-gamma-quant (x y) (ccl-base-gamma-quant (float x) (float y)))
 387 (deffcfun (ccl-base-gamma-dens "ccl_gammadens") (float float) :float)
 388 (defun base-gamma-dens (x y) (ccl-base-gamma-dens (float x) (float y)))
 389 (deffcfun (ccl-gamma-rand "ccl_gammarand") (float) :float)
 390 (defun one-gamma-rand (x) (ccl-gamma-rand (float x)))
 391
 392 ;;;;
 393 ;;;; Chi-square distribution
 394 ;;;;
 395
 396 (deffcfun (ccl-base-chisq-cdf "ccl_chisqcdf") (float float) :float)
 397 (defun base-chisq-cdf (x y) (ccl-base-chisq-cdf (float x) (float y)))
 398 (deffcfun (ccl-base-chisq-quant "ccl_chisqquant") (float float) :float)
 399 (defun base-chisq-quant (x y) (ccl-base-chisq-quant (float x) (float y)))
 400 (deffcfun (ccl-base-chisq-dens "ccl_chisqdens") (float float) :float)
 401 (defun base-chisq-dens (x y) (ccl-base-chisq-dens (float x) (float y)))
 402 (deffcfun (ccl-chisq-rand "ccl_chisqrand") (float) :float)
 403 (defun one-chisq-rand (x) (ccl-chisq-rand (float x)))
 404
 405 ;;;;
 406 ;;;; Beta distribution
 407 ;;;;
 408
 409 (deffcfun (ccl-base-beta-cdf "ccl_betacdf") (float float float) :float)
 410 (defun base-beta-cdf (x y z) (ccl-base-beta-cdf (float x) (float y) (float z)))
 411 (deffcfun (ccl-base-beta-quant "ccl_betaquant") (float float float) :float)
 412 (defun base-beta-quant (x y z) (ccl-base-beta-quant (float x) (float y) (float z)))
 413 (deffcfun (ccl-base-beta-dens "ccl_betadens") (float float float) :float)
 414 (defun base-beta-dens (x y z) (ccl-base-beta-dens (float x) (float y) (float z)))
 415 (deffcfun (ccl-beta-rand "ccl_betarand") (float float) :float)
 416 (defun one-beta-rand (x y) (ccl-beta-rand (float x) (float y)))
 417
 418 ;;;;
 419 ;;;; t distribution
 420 ;;;;
 421
 422 (deffcfun (ccl-base-t-cdf "ccl_tcdf") (float float) :float)
 423 (defun base-t-cdf (x y) (ccl-base-t-cdf (float x) (float y)))
 424 (deffcfun (ccl-base-t-quant "ccl_tquant") (float float) :float)
 425 (defun base-t-quant (x y) (ccl-base-t-quant (float x) (float y)))
 426 (deffcfun (ccl-base-t-dens "ccl_tdens") (float float) :float)
 427 (defun base-t-dens (x y) (ccl-base-t-dens (float x) (float y)))
 428 (deffcfun (ccl-t-rand "ccl_trand") (float) :float)
 429 (defun one-t-rand (x) (ccl-t-rand (float x)))
 430
 431 ;;;;
 432 ;;;; F distribution
 433 ;;;;
 434
 435 (deffcfun (ccl-base-f-cdf "ccl_fcdf") (float float float) :float)
 436 (defun base-f-cdf (x y z) (ccl-base-f-cdf (float x) (float y) (float z)))
 437 (deffcfun (ccl-base-f-quant "ccl_fquant") (float float float) :float)
 438 (defun base-f-quant (x y z) (ccl-base-f-quant (float x) (float y) (float z)))
 439 (deffcfun (ccl-base-f-dens "ccl_fdens") (float float float) :float)
 440 (defun base-f-dens (x y z) (ccl-base-f-dens (float x) (float y) (float z)))
 441 (deffcfun (ccl-f-rand "ccl_frand") (float float) :float)
 442 (defun one-f-rand (x y) (ccl-f-rand (float x) (float y)))
 443
 444 ;;;;
 445 ;;;; Poisson distribution
 446 ;;;;
 447
 448 (deffcfun (ccl-base-poisson-cdf "ccl_poissoncdf") (float float) :float)
 449 (defun base-poisson-cdf (x y) (ccl-base-poisson-cdf (float x) (float y)))
 450 (deffcfun (ccl-base-poisson-quant "ccl_poissonquant") (float float) :long)
 451 (defun base-poisson-quant (x y) (ccl-base-poisson-quant (float x) (float y)))
 452 (deffcfun (ccl-base-poisson-pmf "ccl_poissonpmf") (fixnum float) :float)
 453 (defun base-poisson-pmf (x y) (ccl-base-poisson-pmf x (float y)))
 454 (deffcfun (ccl-poisson-rand "ccl_poissonrand") (float) :long)
 455 (defun one-poisson-rand (x) (ccl-poisson-rand (float x)))
 456
 457 ;;;;
 458 ;;;; Binomial distribution
 459 ;;;;
 460
 461 (deffcfun (ccl-base-binomial-cdf "ccl_binomialcdf") (float fixnum float) :float)
 462 (defun base-binomial-cdf (x y z) (ccl-base-binomial-cdf (float x) y (float z)))
 463 (deffcfun (ccl-base-binomial-quant "ccl_binomialquant") (float fixnum float) :long)
 464 (defun base-binomial-quant (x y z) (ccl-base-binomial-quant (float x) y (float z)))
 465 (deffcfun (ccl-base-binomial-pmf "ccl_binomialpmf") (fixnum fixnum float) :float)
 466 (defun base-binomial-pmf (x y z) (ccl-base-binomial-pmf x y (float z)))
 467 (deffcfun (ccl-binomial-rand "ccl_binomialrand") (fixnum float) :long)
 468 (defun one-binomial-rand (x y) (ccl-binomial-rand x (float y)))