register routines

3 files changed, 63 insertions, 23 deletions

diff --git a/NAMESPACE b/NAMESPACE
index f2e6748..65b8827 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,2 +1,2 @@
 exportPattern("^[[:alpha:]]+")
-useDynLib("lossdistrib")
+useDynLib("lossdistrib", .registration=TRUE, .fixes = "C_")
diff --git a/R/distrib.R b/R/distrib.R
index 26b62cc..f8d1c00 100644
--- a/R/distrib.R
+++ b/R/distrib.R
@@ -26,7 +26,7 @@ GHquad <- function(n){
     n <- as.integer(n)
     Z <- double(n)
     w <- double(n)
-    result <- .C("GHquad", n, Z=Z, w=w)
+    result <- .C("C_GHquad", n, Z=Z, w=w)
     result[[1]] <- NULL
     return(result)
 }
@@ -316,34 +316,34 @@ lossdist.prepay.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
 
 lossdistC <- function(p, w, S, N, defaultflag=FALSE){
     ## C version of lossdistrib2, roughly 50 times faster
-    .C("lossdistrib", as.double(p), as.integer(length(p)),
-       as.double(w), as.double(S), as.integer(N), as.integer(N), as.logical(defaultflag), q = double(N))$q
+    .C("C_lossdistrib", as.double(p), as.integer(length(p)),
+       as.double(w), as.double(S), as.integer(N), as.integer(N),
+       as.logical(defaultflag), q = double(N))$q
 }
 
 lossdistCZ <- function(p, w, S, N, defaultflag=FALSE, rho, Z){
     ##S is of size (length(p), length(Z))
-    stopifnot(length(rho)==length(p),
-              length(rho)==length(w),
-              nrow(S)==length(p),
-              ncol(S)==length(Z))
-    .C("lossdistrib_Z", as.double(p), as.integer(length(p)),
-       as.double(w), as.double(S), as.integer(N), as.logical(defaultflag),
-       as.double(rho), as.double(Z), as.integer(length(Z)),
-       q = matrix(0, N, length(Z)))$q
+    stopifnot(length(rho) == length(p),
+              length(rho) == length(w),
+              nrow(S) == length(p),
+              ncol(S) == length(Z))
+    .C("C_lossdistrib_Z", as.double(p), as.integer(length(p)), as.double(w),
+       as.double(S), as.integer(N), as.logical(defaultflag), as.double(rho),
+       as.double(Z), as.integer(length(Z)), q = matrix(0, N, length(Z)))$q
 }
 
 lossdistC.truncated <- function(p, w, S, N, T=N, defaultflag=FALSE){
     ## truncated version of lossdistrib
     ## q[i] is 0 for i>=T
-    .C("lossdistrib_truncated", as.double(p), as.integer(length(p)),
-       as.double(w), as.double(S), as.integer(N), as.integer(T), as.logical(defaultflag),
-       q = double(N))$q
+    .C("C_lossdistrib", as.double(p), as.integer(length(p)),
+       as.double(w), as.double(S), as.integer(N), as.integer(T),
+       as.logical(defaultflag), q = double(N))$q
 }
 
 exp.trunc <- function(p, w, S, N, K){
     ## computes E[(K-L)^+]
     r <- 0
-    .C("exp_trunc", as.double(p), as.integer(length(p)),
+    .C("C_exp_trunc", as.double(p), as.integer(length(p)),
        as.double(w), as.double(S), as.integer(N), as.double(K), res = r)$res
 }
 
@@ -360,13 +360,13 @@ rec.trunc <- function(p, w, S, N, K){
 
 recovdistC <- function(dp, pp, w, S, N){
     ## C version of recovdist
-    .C("recovdist", as.double(dp), as.double(pp), as.integer(length(dp)),
+    .C("C_recovdist", as.double(dp), as.double(pp), as.integer(length(dp)),
        as.double(w), as.double(S), as.integer(N), q = double(N))$q
 }
 
 lossdistC.prepay.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
     ## C version of lossdist.prepay.joint
-    r <- .C("lossdistrib_joint", as.double(dp), as.double(pp), as.integer(length(dp)),
+    r <- .C("C_lossdistrib_joint", as.double(dp), as.double(pp), as.integer(length(dp)),
             as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), q=matrix(0, N, N))$q
     return(r)
 }
@@ -381,7 +381,7 @@ lossdistC.prepay.jointZ <- function(dp, pp, w, S, N, defaultflag = FALSE, rho, Z
     ## Z is a vector of length nZ
     ## w is a vector if length wZ
 
-    r <- .C("lossdistrib_joint_Z", as.double(dp), as.double(pp), as.integer(length(dp)),
+    r <- .C("C_lossdistrib_joint_Z", as.double(dp), as.double(pp), as.integer(length(dp)),
             as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), as.double(rho),
             as.double(Z), as.double(wZ), as.integer(length(Z)), output = matrix(0,N,N))
     return(r$output)
@@ -521,7 +521,7 @@ fit.prob <- function(Z, w, rho, p0){
 
 fit.probC <- function(Z, w, rho, p0){
     stopifnot(length(Z)==length(w))
-    r <- .C("fitprob", as.double(Z), as.double(w), as.integer(length(Z)),
+    r <- .C("C_fitprob", as.double(Z), as.double(w), as.integer(length(Z)),
             as.double(rho), as.double(p0), q = double(1))
     return(r$q)
 }
@@ -538,7 +538,7 @@ stochasticrecov <- function(R, Rtilde, Z, w, rho, porig, pmod){
 }
 
 stochasticrecovC <- function(R, Rtilde, Z, w, rho, porig, pmod){
-    r <- .C("stochasticrecov", as.double(R), as.double(Rtilde), as.double(Z),
+    r <- .C("C_stochasticrecov", as.double(R), as.double(Rtilde), as.double(Z),
             as.double(w), as.integer(length(Z)), as.double(rho), as.double(porig),
             as.double(pmod), q = double(length(Z)))
     return(r$q)
@@ -586,7 +586,7 @@ BClossdistC <- function(defaultprob, issuerweights, recov, rho, Z, w,
     L <- matrix(0, N, ncol(defaultprob))
     R <- matrix(0, N, ncol(defaultprob))
     rho <- rep(rho, length(issuerweights))
-    r <- .C("BCloss_recov_dist", defaultprob, as.integer(nrow(defaultprob)),
+    r <- .C("C_BCloss_recov_dist", defaultprob, as.integer(nrow(defaultprob)),
             as.integer(ncol(defaultprob)), as.double(issuerweights),
             as.double(recov), as.double(Z), as.double(w), as.integer(length(Z)),
             as.double(rho), as.integer(N), as.logical(defaultflag), L=L, R=R)
@@ -601,7 +601,7 @@ BCER <- function(defaultprob, issuerweights, recov, K, rho, Z, w,
     rho <- rep(rho, length(issuerweights))
     ELt <- numeric(ncol(defaultprob))
     ERt <- numeric(ncol(defaultprob))
-    r <- .C("BCloss_recov_trunc", defaultprob, as.integer(nrow(defaultprob)),
+    r <- .C("C_BCloss_recov_trunc", defaultprob, as.integer(nrow(defaultprob)),
             as.integer(ncol(defaultprob)),
             as.double(issuerweights), as.double(recov), as.double(Z), as.double(w),
             as.integer(length(Z)), as.double(rho), as.integer(N), as.double(K),
diff --git a/src/init.c b/src/init.c
new file mode 100644
index 0000000..a208b9e
--- /dev/null
+++ b/src/init.c
@@ -0,0 +1,40 @@
+#include <stdlib.h> // for NULL
+#include <R_ext/Rdynload.h>
+
+/* FIXME:
+   Check these declarations against the C/Fortran source code.
+*/
+
+/* .C calls */
+extern void BCloss_recov_dist(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void BCloss_recov_trunc(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void exp_trunc(void *, void *, void *, void *, void *, void *, void *);
+extern void fitprob(void *, void *, void *, void *, void *, void *);
+extern void GHquad(void *, void *, void *);
+extern void lossdistrib(void *, void *, void *, void *, void *, void *, void *, void *);
+extern void lossdistrib_joint(void *, void *, void *, void *, void *, void *, void *, void *);
+extern void lossdistrib_joint_Z(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void lossdistrib_Z(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void recovdist(void *, void *, void *, void *, void *, void *, void *);
+extern void stochasticrecov(void *, void *, void *, void *, void *, void *, void *, void *, void *);
+
+static const R_CMethodDef CEntries[] = {
+    {"BCloss_recov_dist",     (DL_FUNC) &BCloss_recov_dist,     13},
+    {"BCloss_recov_trunc",    (DL_FUNC) &BCloss_recov_trunc,    14},
+    {"exp_trunc",             (DL_FUNC) &exp_trunc,              7},
+    {"fitprob",               (DL_FUNC) &fitprob,                6},
+    {"GHquad",                (DL_FUNC) &GHquad,                 3},
+    {"lossdistrib",           (DL_FUNC) &lossdistrib,            8},
+    {"lossdistrib_joint",     (DL_FUNC) &lossdistrib_joint,      8},
+    {"lossdistrib_joint_Z",   (DL_FUNC) &lossdistrib_joint_Z,   12},
+    {"lossdistrib_Z",         (DL_FUNC) &lossdistrib_Z,         10},
+    {"recovdist",             (DL_FUNC) &recovdist,              7},
+    {"stochasticrecov",       (DL_FUNC) &stochasticrecov,        9},
+    {NULL, NULL, 0}
+};
+
+void R_init_lossdistrib(DllInfo *dll)
+{
+    R_registerRoutines(dll, CEntries, NULL, NULL, NULL);
+    R_useDynamicSymbols(dll, FALSE);
+}