3 extern double rcondest_front();
5 extern double unirand(), gamma();
6 extern double normalcdf(), normalquant(), normaldens(), normalrand(),
8 extern double cauchycdf(), cauchyquant(), cauchydens(), cauchyrand();
9 extern double gammacdf(), gammaquant(), gammadens(), gammarand();
10 extern double chisqcdf(), chisqquant(), chisqdens(), chisqrand();
11 extern double betacdf(), betaquant(), betadens(), betarand();
12 extern double tcdf(), tquant(), tdens(), trand();
13 extern double fcdf(), fquant(), fdens(), frand();
14 extern double poissoncdf(), poissonpmf();
15 extern int poissonquant(), poissonrand();
16 extern double binomialcdf(), binomialpmf();
17 extern int binomialquant(), binomialrand();
19 /***************************************************************************/
20 /***************************************************************************/
22 /**** Basic Utilities ****/
24 /***************************************************************************/
25 /***************************************************************************/
27 /***************************************************************************/
29 /** Callback Value Storage **/
31 /***************************************************************************/
33 static int excl_integer_value
;
34 static double excl_double_value
;
36 excl_set_integer_value(x
)
39 excl_integer_value
= x
;
42 excl_set_double_value(x
)
45 excl_double_value
= x
;
48 /***************************************************************************/
50 /** Storage Allocation Functions **/
52 /***************************************************************************/
54 int la_base_allocate(n
, m
)
57 char *p
= calloc(n
, m
);
58 if (p
== nil
) xlfail("allocation failed");
62 int la_base_free_alloc(p
)
65 if (p
) free((char *) p
);
69 int la_mode_size(mode
)
73 case IN
: return(sizeof(int));
74 case RE
: return(sizeof(double));
75 case CX
: return(sizeof(Complex
));
80 /***************************************************************************/
82 /** Callbacks for Internal Storage **/
84 /***************************************************************************/
86 int la_allocate_index
, la_free_alloc_index
;
88 excl_register_la_allocate(f
) int f
; { la_allocate_index
= f
; }
89 excl_register_la_free_alloc(f
) int f
; { la_free_alloc_index
= f
; }
94 lisp_call(la_allocate_index
, n
, m
);
95 return(excl_integer_value
);
101 lisp_call(la_free_alloc_index
, p
);
104 /***************************************************************************/
106 /** Storage Access Functions **/
108 /***************************************************************************/
110 int la_get_integer(p
, i
)
113 return(*(((int *) p
) + i
));
116 double la_get_double(p
, i
)
119 return(*(((double *) p
) + i
));
122 double la_get_complex_real(p
, i
)
125 Complex
*c
= ((Complex
*) p
) + i
;
129 double la_get_complex_imag(p
, i
)
132 Complex
*c
= ((Complex
*) p
) + i
;
136 /***************************************************************************/
138 /** Storage Mutation Functions **/
140 /***************************************************************************/
142 int la_put_integer(p
, i
, x
)
145 *(((int *) p
) + i
) = x
;
149 int la_put_double(p
, i
, x
)
153 *(((double *) p
) + i
) = x
;
157 int la_put_complex(p
, i
, x
, y
)
161 Complex
*c
= ((Complex
*) p
) + i
;
167 /***************************************************************************/
169 /** XLISP internal error message emulation **/
171 /***************************************************************************/
175 static int excl_set_buf_char_index
;
176 excl_register_set_buf_char(f
) int f
; { excl_set_buf_char_index
= f
; }
177 set_buf_char(n
, c
) int n
, c
; { lisp_call(excl_set_buf_char_index
, n
, c
); }
179 static int excl_print_buffer_index
;
180 excl_register_print_buffer(f
) int f
; { excl_print_buffer_index
= f
; }
181 print_buffer(n
, m
) int n
, m
; { lisp_call(excl_print_buffer_index
, n
, m
); }
183 static int bufpos
= 0;
185 static resetbuf() { bufpos
= 0; }
193 for (i
= 0; i
<n
; i
++, bufpos
++) set_buf_char(bufpos
, s
[i
]);
194 set_buf_char(bufpos
, 0);
202 print_buffer(bufpos
, 1);
210 print_buffer(bufpos
, 0);
222 /***************************************************************************/
223 /***************************************************************************/
225 /***** Lisp Interfaces to Linear Algebra Routines ****/
227 /***************************************************************************/
228 /***************************************************************************/
230 excl_chol_decomp_front(x
, y
, z
)
232 { return(chol_decomp_front(x
, y
, z
)); }
234 excl_lu_decomp_front(x
, y
, z
, u
, v
)
236 { return(lu_decomp_front(x
, y
, z
, u
, v
)); }
237 excl_lu_solve_front(x
, y
, z
, u
, v
)
239 { return(lu_solve_front(x
, y
, z
, u
, v
)); }
240 excl_lu_inverse_front(x
, y
, z
, u
, v
, w
)
241 int x
, y
, z
, u
, v
, w
;
242 { return(lu_inverse_front(x
, y
, z
, u
, v
, w
)); }
244 excl_sv_decomp_front(x
, y
, z
, u
, v
)
246 { return(sv_decomp_front(x
, y
, z
, u
, v
)); }
248 excl_qr_decomp_front(x
, y
, z
, u
, v
, w
)
249 int x
, y
, z
, u
, v
, w
;
250 { return(qr_decomp_front(x
, y
, z
, u
, v
, w
)); }
252 double excl_rcondest_front(x
, y
) int x
, y
; { return(rcondest_front(x
, y
)); }
254 excl_make_rotation_front(x
, y
, z
, u
, v
, w
)
257 { return(make_rotation_front(x
, y
, z
, u
, v
, w
)); }
259 excl_eigen_front(x
, y
, z
, u
, v
)
261 { return(eigen_front(x
, y
, z
, u
, v
)); }
263 excl_range_to_rseq(x
, y
, z
, u
)
265 { return(range_to_rseq(x
, y
, z
, u
)); }
266 excl_spline_front(x
, y
, z
, u
, v
, w
, a
)
267 int x
, y
, z
, u
, v
, w
, a
;
268 { return(spline_front(x
, y
, z
, u
, v
, w
, a
)); }
270 excl_kernel_dens_front(x
, y
, z
, u
, v
, w
, a
)
271 int x
, y
, u
, v
, w
, a
;
273 { return(kernel_dens_front(x
, y
, z
, u
, v
, w
, a
)); }
275 excl_kernel_smooth_front(x
, y
, z
, u
, v
, w
, a
, b
)
276 int x
, y
, z
, v
, w
, a
, b
;
278 { return(kernel_smooth_front(x
, y
, z
, u
, v
, w
, a
, b
)); }
280 excl_base_lowess_front(x
, y
, z
, u
, v
, w
, a
, b
, c
)
281 int x
, y
, z
, v
, a
, b
, c
;
283 { return(base_lowess_front(x
, y
, z
, u
, v
, w
, a
, b
, c
)); }
285 excl_fft_front(x
, y
, z
, u
) int x
, y
, z
, u
; { return(fft_front(x
, y
, z
, u
)); }
287 static int excl_maximize_callback_index
;
288 excl_register_maximize_callback(f
) int f
; { excl_maximize_callback_index
= f
; }
289 maximize_callback(n
, px
, pfval
, pgrad
, phess
, pderivs
)
290 int n
, px
, pfval
, pgrad
, phess
, pderivs
;
292 lisp_call(excl_maximize_callback_index
, n
, px
, pfval
, pgrad
, phess
, pderivs
);
295 excl_numgrad_front(x
, y
, z
, u
, v
)
299 return(numgrad_front(x
, y
, z
, u
, v
));
302 excl_numhess_front(x
, y
, z
, u
, v
, w
, a
)
303 int x
, y
, z
, u
, v
, a
;
306 return(numhess_front(x
, y
, z
, u
, v
, w
, a
));
309 excl_minfo_maximize(x
, y
, z
, u
, v
, w
)
310 int x
, y
, z
, u
, v
, w
;
312 return(minfo_maximize(x
, y
, z
, u
, v
, w
));
315 /***************************************************************************/
316 /***************************************************************************/
318 /**** Probability Distributions ****/
320 /***************************************************************************/
321 /***************************************************************************/
323 /* Uniform genrator */
324 static int excl_uni_callback
;
326 excl_register_uni(fun
)
329 excl_uni_callback
= fun
;
334 lisp_call(excl_uni_callback
);
335 return(excl_double_value
);
338 double excl_unirand() { return(unirand()); }
339 double excl_gamma(x
) double x
; { return(gamma(x
)); }
341 double excl_normalcdf(x
) double x
; { return(normalcdf(x
)); }
342 double excl_normalquant(x
) double x
; { return(normalquant(x
)); }
343 double excl_normaldens(x
) double x
; { return(normaldens(x
)); }
344 double excl_normalrand() { return(normalrand()); }
345 double excl_bnormcdf(x
, y
, z
) double x
, y
, z
; { return(bnormcdf(x
, y
, z
)); }
347 double excl_cauchycdf(x
) double x
; { return(cauchycdf(x
)); }
348 double excl_cauchyquant(x
) double x
; { return(cauchyquant(x
)); }
349 double excl_cauchydens(x
) double x
; { return(cauchydens(x
)); }
350 double excl_cauchyrand() { return(cauchyrand()); }
352 double excl_gammacdf(x
, y
) double x
, y
; { return(gammacdf(x
, y
)); }
353 double excl_gammaquant(x
, y
) double x
, y
; { return(gammaquant(x
, y
)); }
354 double excl_gammadens(x
, y
) double x
, y
; { return(gammadens(x
, y
)); }
355 double excl_gammarand(x
) double x
; { return(gammarand(x
)); }
357 double excl_chisqcdf(x
, y
) double x
, y
; { return(chisqcdf(x
, y
)); }
358 double excl_chisqquant(x
, y
) double x
, y
; { return(chisqquant(x
, y
)); }
359 double excl_chisqdens(x
, y
) double x
, y
; { return(chisqdens(x
, y
)); }
360 double excl_chisqrand(x
) double x
; { return(chisqrand(x
)); }
362 double excl_betacdf(x
, y
, z
) double z
, y
, x
; { return(betacdf(x
, y
, z
)); }
363 double excl_betaquant(x
, y
, z
) double z
, y
, x
; { return(betaquant(x
, y
, z
)); }
364 double excl_betadens(x
, y
, z
) double z
, y
, x
; { return(betadens(x
, y
, z
)); }
365 double excl_betarand(x
, y
) double x
, y
; { return(betarand(x
, y
)); }
367 double excl_tcdf(x
, y
) double x
, y
; { return(tcdf(x
, y
)); }
368 double excl_tquant(x
, y
) double x
, y
; { return(tquant(x
, y
)); }
369 double excl_tdens(x
, y
) double x
, y
; { return(tdens(x
, y
)); }
370 double excl_trand(x
) double x
; { return(trand(x
)); }
372 double excl_fcdf(x
, y
, z
) double z
, y
, x
; { return(fcdf(x
, y
, z
)); }
373 double excl_fquant(x
, y
, z
) double z
, y
, x
; { return(fquant(x
, y
, z
)); }
374 double excl_fdens(x
, y
, z
) double z
, y
, x
; { return(fdens(x
, y
, z
)); }
375 double excl_frand(x
, y
) double x
, y
; { return(frand(x
, y
)); }
377 double excl_poissoncdf(x
, y
) double x
, y
; { return(poissoncdf(x
, y
)); }
378 int excl_poissonquant(x
, y
) double x
, y
; { return(poissonquant(x
, y
)); }
379 double excl_poissonpmf(x
, y
) int x
; double y
; { return(poissonpmf(x
, y
)); }
380 int excl_poissonrand(x
) double x
; { return(poissonrand(x
)); }
382 double excl_binomialcdf(x
, y
, z
) double x
, z
; int y
; {return(binomialcdf(x
, y
, z
));}
383 int excl_binomialquant(x
, y
, z
) double x
, z
; int y
; {return(binomialquant(x
, y
, z
)); }
384 double excl_binomialpmf(x
, y
, z
) int x
, y
; double z
; {return(binomialpmf(x
, y
, z
)); }
385 int excl_binomialrand(x
, y
) int x
; double y
; { return(binomialrand(x
, y
)); }