view release on metacpan or  search on metacpan

Algorithm-LBFGS.xs  view on Meta::CPAN

/**************************************************************************
 * XS of Algorithm::LBFGS
 * -> by Laye Suen
 **************************************************************************/

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include "lbfgs.h"

/* Macros for debugging */

/* uncomment the line below to enable tracing and timing */
/* #define __ENABLE_TRACING__ */

#ifdef __ENABLE_TRACING__

#include "time.h"

#define TRACE(msg) \
    printf(msg); \
    printf(": %0.10f s\n", 1.0 * (clock() - _c) / CLOCKS_PER_SEC); \
    fflush(stdout); \
    _c = clock()
#define dTRACE clock_t _c = clock()

#else

#define TRACE(msg)
#define dTRACE

#endif

/* Other macros */

#define newSVpv_(x) newSVpv(x, strlen(x))

/**************************************************************************
 * NON-EXPORTED SUBS
 **************************************************************************/

/* Evaluation callback for L-BFGS */
lbfgsfloatval_t lbfgs_evaluation_cb(
    void*                    instance,
    const lbfgsfloatval_t*   x,
    lbfgsfloatval_t*         g,
    const int                n,
    const lbfgsfloatval_t    step)
{
    int i;
    SV *lbfgs_eval, *user_data, *sv_f;
    AV *av_x, *av_g;
    lbfgsfloatval_t f;
    dSP;
    dTRACE;
    /* fetch refs to user evaluation callback and extra data */
    TRACE("lbfgs_evaluation_cb: enter");
    lbfgs_eval = ((SV**)instance)[0];
    user_data = ((SV**)instance)[2];
    /* create an AV av_x from the C array x */
    av_x = newAV();
    av_extend(av_x, n - 1);
    for (i = 0; i < n; i++) av_store(av_x, i, newSVnv(x[i]));
    /* call the user evaluation callback */
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newRV_noinc((SV*)av_x)));
    XPUSHs(sv_2mortal(newSVnv(step)));
    XPUSHs(user_data);
    PUTBACK;