#include "FCN.h"

SV* mnfunname;
int ene;

void FCN(int* npar,double* grad,double* fval,double* xval,int* iflag,double* futil){

  SV* funname;

  int count,i;
  double* x;

  I32 ax ; 
  
  pdl* pgrad;
  SV* pgradsv;

  pdl* pxval;
  SV* pxvalsv;
  
  dSP;
  ENTER;
  SAVETMPS;

  /* get name of function on the Perl side */
  funname = mnfunname;

  int ndims = 1;
  PDL_Indx pdims[ndims];
  
  pdims[0] = (PDL_Indx) ene;

  PUSHMARK(SP);
  XPUSHs(sv_2mortal(newSVpv("PDL", 0)));
  PUTBACK;
  perl_call_method("initialize", G_SCALAR);
  SPAGAIN;
  pxvalsv = POPs;
  PUTBACK;
  pxval = PDL->SvPDLV(pxvalsv);
 
  PDL->converttype( pxval, PDL_D );
  PDL->children_changesoon(pxval,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED);
  PDL->setdims (pxval,pdims,ndims);
  pxval->state |= PDL_ALLOCATED | PDL_DONTTOUCHDATA;
  PDL->changed(pxval,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED,0);

  PUSHMARK(SP);
  XPUSHs(sv_2mortal(newSVpv("PDL", 0)));
  PUTBACK;
  perl_call_method("initialize", G_SCALAR);
  SPAGAIN;
  pgradsv = POPs;
  PUTBACK;
  pgrad = PDL->SvPDLV(pgradsv);
  
  PDL->converttype( pgrad, PDL_D );
  PDL->children_changesoon(pgrad,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED);
  PDL->setdims (pgrad,pdims,ndims);
  pgrad->state |= PDL_ALLOCATED | PDL_DONTTOUCHDATA;
  PDL->changed(pgrad,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED,0);

  pxval->data = (void *) xval;
  pgrad->data = (void *) grad;  

  PUSHMARK(SP);

  XPUSHs(sv_2mortal(newSViv(*npar)));
  XPUSHs(pgradsv);
  XPUSHs(sv_2mortal(newSVnv(*fval)));
  XPUSHs(pxvalsv);
  XPUSHs(sv_2mortal(newSViv(*iflag)));

  PUTBACK;

  count=call_sv(funname,G_ARRAY);

  SPAGAIN; 
  SP -= count ;
  ax = (SP - PL_stack_base) + 1 ;

  if (count!=2)
    croak("error calling perl function\n");

  pgradsv = ST(1);
  pgrad = PDL->SvPDLV(pgradsv);

  x = (double *) pgrad->data;

  for(i=0;i<ene;i++)
    grad[i] = x[i];

  *fval = SvNV(ST(0));

  PUTBACK;
  FREETMPS;
  LEAVE;

}