/****************************************************************************
 *
 * polroots.c                                               Laurent Bartholdi
 *
 *   @(#)$Id: polroots.c,v 1.6 2008/12/15 16:09:36 gap Exp $
 *
 * Copyright (C) 2007, Laurent Bartholdi
 *
 ****************************************************************************
 *
 * use cpoly to compute the roots of a univariate polynomial
 * 
 ****************************************************************************/

#include "src/compiled.h"

static Obj  GC_fail;

int cpoly(const double *opr, const double *opi, int degree, double *zeror, double *zeroi, double *heap);

#define VAL_FLOAT(obj) (*(double *)ADDR_OBJ(obj))
#define SIZE_FLOAT   sizeof(double)
#ifndef T_FLOAT
#define T_FLOAT T_MACFLOAT
#endif
static inline Obj NEW_FLOAT( double val )
{
  Obj f = NewBag(T_FLOAT,SIZE_FLOAT);
  *(double *)ADDR_OBJ(f) = val;
  return f;
}

/* handler for function 2 */
static Obj  COMPLEX_ROOTS (Obj self, Obj coeffs)
{
  Obj result, t, heap;
  UInt i, degree, numroots;
#define opr ((double *)ADDR_OBJ(heap))
#define opi (opr+degree+1)
#define zeror (opr+2*degree+2)
#define zeroi (opr+3*degree+2)
#define cpolyheap (opr+4*degree+2)

  degree = LEN_PLIST(coeffs)-1;

  heap = NewBag(T_DATOBJ, (14*degree+12)*sizeof(double));

  for (i = 0; i <= degree; i++) {
    opr[degree-i] = VAL_FLOAT(ELM_PLIST(ELM_PLIST(coeffs,i+1),1));
    opi[degree-i] = VAL_FLOAT(ELM_PLIST(ELM_PLIST(coeffs,i+1),2));
  }
  
  numroots = cpoly (opr, opi, degree, zeror, zeroi, cpolyheap);

  if (numroots == -1)
    return GC_fail;

  result = NEW_PLIST(T_PLIST, numroots);
  SET_LEN_PLIST(result, numroots);
  for (i = 1; i <= numroots; i++) {
    t = NEW_PLIST(T_PLIST, 2); SET_LEN_PLIST(t,2);
    SET_ELM_PLIST(t,1, NEW_FLOAT(zeror[i-1]));
    SET_ELM_PLIST(t,2, NEW_FLOAT(zeroi[i-1]));
    SET_ELM_PLIST(result,i, t);
  }

  return result;
}

static StructGVarFunc GVarFuncs [] = {
  { "COMPLEX_ROOTS", 1, "coeffs", COMPLEX_ROOTS, "polroots.c:COMPLEX_ROOTS" },
  { 0 }
};

static Int InitKernel ( StructInitInfo * module )
{
  InitCopyGVar( "fail", &GC_fail );
  InitHdlrFuncsFromTable( GVarFuncs );
  return 0;
}

/* 'InitLibrary' sets up gvars, rnams, functions */
static Int InitLibrary ( StructInitInfo * module )
{
  InitGVarFuncsFromTable( GVarFuncs );
  return 0;
}

static StructInitInfo module = {
 /* type        = */ MODULE_DYNAMIC,
 /* name        = */ "polroots.c",
 /* revision_c  = */ 0,
 /* revision_h  = */ 0,
 /* version     = */ 0,
 /* crc         = */ 0,
 /* initKernel  = */ InitKernel,
 /* initLibrary = */ InitLibrary,
 /* checkInit   = */ 0,
 /* preSave     = */ 0,
 /* postSave    = */ 0,
 /* postRestore = */ 0
};

StructInitInfo * Init__Dynamic ( void )
{
 return &module;
}
/* polroots.c . . . . . . . . . . . . . . . . . . . . . . . . . . ends here */
