/* Copyright (c) 1997 by Fernando Trias */

#include <stdlib.h>
#include <memory.h>
#include <malloc.h>
#include <errno.h>

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

#include "perldef.h"

#include "hli.h"

#ifdef FRB
#include "hliutils.h"
#endif

#ifdef ADJDIV
#include "adjdiv.h"
#endif

union vsdata {  /* one data item */
      float           pf;
      double          pd;
      int             pi;
      char *          pc;
};
union vpdata {  /* pointers to data items */
      float          *pf;
      double         *pd;
      int            *pi;
      char *         *pc;
};
struct vdata {
    int           typ;
    int           numobs;
    union vpdata  val;
    int          *misary;  /* for strings */
    int          *lenary;  /*  "      "   */
    union {
      float         pf[3]; /* missing data trans. tbls */
      double        pd[3];
      int           pi[3];
      char *        pc[3];
    }             mistt;
};

int             f_status;
char            *version="2.01";

/* misc function declarations */
int             fameinit();
/*
#include "fameperl.h"
*/
#include "fame.xtra"

#include "fame.i"

/* include constants code */
#include "famecons.i"

#ifdef HAS_PROTOTYPE
int Fame_getsize(int typ)
#else
int Fame_getsize(typ)
int typ;
#endif
{
    int sz;
    if (typ >= HDAILY) { typ = HDATE; }

    switch (typ) {
    case HNUMRC:
      sz = sizeof(float);
      break;
    case HBOOLN:
      sz = sizeof(int);
      break;
    case HPRECN:
      sz = sizeof(double);
      break;
    case HUNDFT:
      sz = 0;
      break;
    case HDATE:
      sz = sizeof(int);
      break;
    case HSTRNG:
    case HNAMEL:
      sz = sizeof(char *);
      break;
    default:
      sz = 0;
    }

    return sz;
}

#ifdef HAS_PROTOTYPE
int Fame_allocate(WIN32PREFIX struct vdata *d, int typ, int numobs)
#else
int Fame_allocate(d, typ, numobs)
struct vdata *d;
int typ;
int numobs;
#endif
{
    int sz, i;

    sz = Fame_getsize(typ);
    d->typ = typ;
    if (typ != HNAMEL && typ != HSTRNG) {
      d->val.pf = (float *) malloc(numobs * sz);
    } else {
      d->val.pc = (char **) malloc(numobs * sizeof(char *));
      d->misary = (int *) malloc(numobs * sizeof(int));
      d->lenary = (int *) malloc(numobs * sizeof(int));
      for (i = 0; i < numobs; i++)
        d->val.pc[i] = (char *) malloc(200 * sizeof(char));
        d->misary[i] = HNMVAL;
        d->lenary[i] = 0;
    }
    d->numobs = numobs;
    return 1;
}

#ifdef HAS_PROTOTYPE
int Fame_free(WIN32PREFIX struct vdata *d)
#else
int Fame_free(d)
struct vdata *d;
#endif
{
    int i;

    if (d->typ != HNAMEL && d->typ != HSTRNG) {
      free(d->val.pf);
    } else {
      free(d->misary);
      free(d->lenary);
      for (i = 0; i < d->numobs; i++)
        free(d->val.pc[i]);
      free(d->val.pc);
    }
    return 1;
}

#ifdef HAS_PROTOTYPE
int Fame_readitems(struct vdata *d, int dbkey, char *series, int *range)
#else
int Fame_readitems(d, dbkey, series, range)
struct vdata *d;
int dbkey;
char *series;
int *range;
#endif
{
    int status;
    if (d->typ != HNAMEL && d->typ != HSTRNG) {
      cfmrrng(&status, dbkey, series, range, d->val.pf, HNTMIS, d->mistt.pf);
      f_status = status;
    } else {
      cfmrsts(&status, dbkey, series, range, d->val.pc, d->misary, d->lenary);
      f_status = status;
    }
    return status;
}

#ifdef HAS_PROTOTYPE
int Fame_writeitems(struct vdata *d, int dbkey, char *series, int *range)
#else
int Fame_writeitems(d, dbkey, series, range)
struct vdata *d;
int dbkey;
char *series;
int *range;
#endif
{
    int status;
    if (d->typ != HNAMEL && d->typ != HSTRNG) {
      cfmwrng(&status, dbkey, series, range, d->val.pf, HNTMIS, d->mistt.pf);
      f_status = status;
    } else {
      int i;
      for(i=0; i<d->numobs; i++) {
        d->lenary[i] = strlen(d->val.pc[i]);
        if (memcmp(d->val.pc[i], FSTRNC, HSMLEN)==0)
          d->misary[i] = HNCVAL;
        else if (memcmp(d->val.pc[i], FSTRND, HSMLEN)==0)
          d->misary[i] = HNDVAL;
        else if (memcmp(d->val.pc[i], FSTRNA, HSMLEN)==0)
          d->misary[i] = HNAVAL;
        else
          d->misary[i] = HNMVAL;
      }
      cfmwsts(&status, dbkey, series, range, d->val.pc, d->misary, d->lenary);
      f_status = status;
    }
    return status;
}

/*
   set an item in valary = the value of sv
*/
#ifdef HAS_PROTOTYPE
int Fame_setVAL(WIN32PREFIX SV *sv, int typ, float *valary, int i)
#else
int Fame_setVAL(sv, typ, valary, i)
SV *sv;
int typ;
float *valary;
int i;
#endif
{
    float *pf;
    int *pi;
    double *pd;
    char **pc;
    char *ss;

    if (typ >= HDAILY) { typ = HDATE; }
    
    switch (typ) {
    case HNUMRC:
      pf = (float *) valary;
      break;
    case HBOOLN:
      pi = (int *) valary;
      break;
    case HPRECN:
      pd = (double *) valary;
      break;
    case HDATE:
      pi = (int *) valary;
      break;
    case HNAMEL:
    case HSTRNG:
      pc = (char **) valary;
      break;
    }

    ss = SvPV(sv, na);

    switch (typ) {
    case HNUMRC:
      if (ss[0] == 'N') {
        if (strcmp(ss, "NC") == 0)
          pf[i] = FNUMNC;
        else if (strcmp(ss, "ND") == 0)
          pf[i] = FNUMND;
        else if (strcmp(ss, "NA") == 0)
          pf[i] = FNUMNA;
        else
          pf[i] = (float) SvNV(sv);
      } else
        pf[i] = (float) SvNV(sv);
      break;
    case HBOOLN:
      if (ss[0] == 'N') {
        if (strcmp(ss, "NC") == 0)
          pi[i] = FBOONC;
        else if (strcmp(ss, "ND") == 0)
          pi[i] = FBOOND;
        else if (strcmp(ss, "NA") == 0)
          pi[i] = FBOONA;
        else
          pi[i] = (int) SvIV(sv);
      } else
        pi[i] = (int) SvIV(sv);
      break;
    case HDATE:
      if (ss[0] == 'N') {
        if (strcmp(ss, "NC") == 0)
          pi[i] = FDATNC;
        else if (strcmp(ss, "ND") == 0)
          pi[i] = FDATND;
        else if (strcmp(ss, "NA") == 0)
          pi[i] = FDATNA;
        else
          pi[i] = (int) SvIV(sv);
      } else
        pi[i] = (int) SvIV(sv);
      break;
    case HPRECN:
      if (ss[0] == 'N') {
        if (strcmp(ss, "NC") == 0)
          pd[i] = FPRCNC;
        else if (strcmp(ss, "ND") == 0)
          pd[i] = FPRCND;
        else if (strcmp(ss, "NA") == 0)
          pd[i] = FPRCNA;
        else
          pd[i] = (double) SvNV(sv);
      } else
        pd[i] = (double) SvNV(sv);
      break;
    case HNAMEL:
    case HSTRNG:
      if (ss[0] == 'N') {
        if (strcmp(ss, "NC") == 0)
          memcpy(pc[i], FSTRNC, HSMLEN);
        else if (strcmp(ss, "ND") == 0)
          memcpy(pc[i], FSTRND, HSMLEN);
        else if (strcmp(ss, "NA") == 0)
          memcpy(pc[i], FSTRNA, HSMLEN);
        else
          strcpy(pc[i], (char *) SvPV(sv, na));
      } else
        strcpy(pc[i], (char *) SvPV(sv, na));
      break;
    default:
      return 0;
    }
    return 1;
}


/*
   set an sv = an item in valary
*/
#ifdef HAS_PROTOTYPE
int Fame_setSV(WIN32PREFIX SV *sv, int typ, float *valary, int i)
#else
int Fame_setSV(sv, typ, valary, i)
SV *sv;
int typ;
float *valary;
int i;
#endif
{
    float *pf;
    int *pi;
    double *pd;
    char **pc;
    
    if (typ >= HDAILY) { typ = HDATE; }

    switch (typ) {
    case HNUMRC:
      pf = (float *) valary;
      break;
    case HBOOLN:
      pi = (int *) valary;
      break;
    case HPRECN:
      pd = (double *) valary;
      break;
    case HDATE:
      pi = (int *) valary;
      break;
    case HNAMEL:
    case HSTRNG:
      pc = (char **) valary;
      break;
    }

    switch (typ) {
    case HNUMRC:
      if (pf[i] == FNUMNC) { sv_setpv(sv,"NC"); }
      else if (pf[i] == FNUMND) { sv_setpv(sv,"ND"); }
      else if (pf[i] == FNUMNA) { sv_setpv(sv,"NA"); }
      else { sv_setnv(sv,(double) pf[i]); }
      break;
    case HBOOLN:
      if (pi[i] == FBOONC) { sv_setpv(sv,"NC"); }
      else if (pi[i] == FBOOND) { sv_setpv(sv,"ND"); }
      else if (pi[i] == FBOONA) { sv_setpv(sv,"NA"); }
      else { sv_setiv(sv,(int) pi[i]); }
      break;
    case HDATE:
      if (pi[i] == FDATNC) { sv_setpv(sv,"NC"); }
      else if (pi[i] == FDATND) { sv_setpv(sv,"ND"); }
      else if (pi[i] == FDATNA) { sv_setpv(sv,"NA"); }
      else { sv_setiv(sv,(int) pi[i]); }
      break;
    case HPRECN:
      if (pd[i] == FPRCNC) { sv_setpv(sv,"NC"); }
      else if (pd[i] == FPRCND) { sv_setpv(sv,"ND"); }
      else if (pd[i] == FPRCNA) { sv_setpv(sv,"NA"); }
      else { sv_setnv(sv,(double) pd[i]); }
      break;
    case HNAMEL:
    case HSTRNG:
      if (memcmp(pc[i], FSTRNC, HSMLEN) == 0)
        sv_setpv(sv, "NC");
      else if (memcmp(pc[i], FSTRND, HSMLEN) == 0)
        sv_setpv(sv, "ND");
      else if (memcmp(pc[i], FSTRNA, HSMLEN) == 0)
        sv_setpv(sv, "NA");
      else
        sv_setpv(sv, pc[i]);
      break;
    default:
      return 0;
    }
    return 1;
}

XS(Fame_constant)
{
    dXSARGS;
    if (items != 2) {
        croak("Usage: Fame::HLI::constant(name,arg)");
    }
    {
        char *  name = (char *)SvPV(ST(0),na);
        int     arg = (int)SvIV(ST(1));
        double  RETVAL;
 
        RETVAL = constant(WIN32PASS name, arg);
        ST(0) = sv_newmortal();
        sv_setnv(ST(0), (double)RETVAL);
    }
    XSRETURN(1);
}


XS(Fame_cfmgatt)
{
  dXSARGS;
  if (items != 6)
    croak("Usage: &cfmgatt($status, $dbkey, $objnam, $atttyp, $attnam, $value)");
  else {
    int             retval = 1;
    int             status;
    int             dbkey = (int) SvIV(ST(1));
    char           *objnam = (char *) SvPV(ST(2), na);
    int             atttyp = (int) SvIV(ST(3));
    char           *attnam = (char *) SvPV(ST(4), na);
    char            value[133];

    /* value = (char *) malloc(133 * sizeof(char)); */
    (void) cfmgatt(&status, dbkey, objnam, &atttyp, attnam, value);

    if (!SvREADONLY(ST(0)))
      sv_setiv(ST(0), status);
    if (!SvREADONLY(ST(2)))
      sv_setpv(ST(2), (char *) objnam);
    if (!SvREADONLY(ST(3)))
      sv_setiv(ST(3), atttyp);
    if (!SvREADONLY(ST(4)))
      sv_setpv(ST(4), (char *) attnam);

    Fame_setSV(WIN32PASS ST(5), atttyp, (float *)value, 0);

    free(value);
    ST(0) = sv_newmortal();
    sv_setiv(ST(0), status);
  }
  XSRETURN(1);
}


XS(Fame_cfmsatt)
{
  dXSARGS;
  if (items != 6)
    croak("Usage: &cfmgatt($status, $dbkey, $objnam, $atttyp, $attnam, $value)");
  else {
    int             retval = 1;
    int             status;
    int             dbkey = (int) SvIV(ST(1));
    char           *objnam = (char *) SvPV(ST(2), na);
    int             atttyp = (int) SvIV(ST(3));
    char           *attnam = (char *) SvPV(ST(4), na);
    char           *value;
    char            space[255];
    char           *ss;
    union vsdata    pp;

    Fame_setVAL(WIN32PASS ST(5), atttyp, (float *)&pp, 0);
    (void) cfmsatt(&status, dbkey, objnam, atttyp, attnam, (char *) &pp);

    if (!SvREADONLY(ST(0)))
      sv_setiv(ST(0), status);
    if (!SvREADONLY(ST(2)))
      sv_setpv(ST(2), objnam);
    if (!SvREADONLY(ST(4)))
      sv_setpv(ST(4), attnam);

    ST(0) = sv_newmortal();
    sv_setiv(ST(0), status);
  }
  XSRETURN(1);
}


XS(Fame_famestart)
{
  dXSARGS;
  if (items != 0)
    croak("Usage: &famestart()");
  else {
    int retval;
    cfmini(&retval);
    f_status = retval;
    ST(0) = sv_newmortal();
    sv_setiv(ST(0), retval);
  }
  XSRETURN(1);
}


XS(Fame_famestop)
{
  dXSARGS;
  if (items != 0)
    croak("Usage: &famestop()");
  else {
    int retval;
    cfmfin(&retval);
    f_status = retval;
    ST(0) = sv_newmortal();
    sv_setiv(ST(0), retval);
  }
  XSRETURN(1);
}


XS(Fame_fameopen)
{
  dXSARGS;
  if (items < 1 || items > 2)
    croak("Usage: $dbkey=&fameopen($name [,$mode])");
  else {
    int             retval = 1;
    char           *name = (char *) SvPV(ST(0), na);
    char            name2[1024];
    int             mode;
    int             status;

#ifdef FRB
    char           path[256];

    (void) getdbpath(name, path);
    if (path != NULL && *path != '\n')
      name = path;
    if (name[strlen(name) - 1] == '\n')
      name[strlen(name) - 1] = '\0';
#endif

    if (items == 1)
      mode = HRMODE;
    else
      mode = (int) SvIV(ST(1));
    cfmopdb(&status, &retval, name, mode);
    f_status = status;
    if (status != HSUCC) retval=-1;
    ST(0) = sv_newmortal();
    sv_setiv(ST(0), retval);
  }
  XSRETURN(1);
}


XS(Fame_fameclose)
{
  dXSARGS;
  if (items != 1)
    croak("Usage: &fameclose($dbkey)");
  else {
    int             retval = 1;
    int             dbkey = (int) SvIV(ST(0));
    int             status;

    cfmcldb(&status, dbkey);
    f_status = status;
    if (status != HSUCC)
      retval = 0;
    ST(0) = sv_newmortal();
    sv_setiv(ST(0), retval);
  }
  XSRETURN(1);
}


XS(Fame_famegetinfo)
{
  dXSARGS;
  if (items != 2)
    croak("Usage: @list=&famegetinfo($dbkey,$objnam)");
  else {
    int             retval = 1;
    int             dbkey = (int) SvIV(ST(0));
    char           *objnam = (char *) SvPV(ST(1), na);
    int             p[16], i;
    char           *p1;
    char           *p2;
    int             d1, d2;

    cfmdlen(&p[0], dbkey, objnam, &d1, &d2);
    f_status = p[0];
    if (p[0] != HSUCC) {
      /* croak("Fame error: famegetinfo failed"); */
      XSRETURN_UNDEF;  /* error in reading - prob. doesn't exist */
    }

    d1++;
    d2++;
    p1 = (char *) malloc((d1+1) * sizeof(char));
    p2 = (char *) malloc((d2+1) * sizeof(char));

    for (i = 0; i < d1; i++) {
      p1[i] = ' ';
    }
    p1[d1 - 1] = '\n';
    p1[d1] = 0;

    for (i = 0; i < d2; i++) {
      p2[i] = ' ';
    }
    p2[d2 - 1] = '\n';
    p2[d2] = 0;

    cfmwhat(&p[0], dbkey, objnam, &p[1], &p[2], &p[3], &p[4], &p[5], &p[6],
      &p[7], &p[8], &p[9], &p[10], &p[11], &p[12], &p[13], &p[14], 
      &p[15], p1, p2);
    f_status = p[0];

    if (p[0] != HSUCC) {
      /* croak("Fame error: famegetinfo failed on cfmwhats"); */
      free(p1);
      free(p2);
      XSRETURN_UNDEF;  /* error in reading */
    }

    EXTEND(sp, 17);  /* extend stack by 17 entries */
    for (i = 0; i < 15; i++) {
      ST(i) = sv_newmortal();
      sv_setiv(ST(i), p[i + 1]);
    }
    ST(15) = sv_newmortal();
    sv_setpv(ST(15), p1);
    ST(16) = sv_newmortal();
    sv_setpv(ST(16), p2);
    free(p1);
    free(p2);
  }
  XSRETURN(17);
}


XS(Fame_fameread)
{
  dXSARGS;
  if (items != 6 && items != 5)
    croak("Usage: @list=&fameread($db,$onam,[$r1,r1,r3]|[$syear,$sprd,$eyear,$eprd])");
  else {
    int             retval = 1;
    int             dbkey = (int) SvIV(ST(0));
    char           *series = (char *) SvPV(ST(1), na);

    int             status;
    int             freq, typ, class;
    int             range[3];
    int             numobs = -1;
    float          *valary;
    char          **cv;
    int            *misary;
    int            *lenary;
    float          *mistt;
    int             sz;
    int             i;
    struct vdata    dat;

    freq = famegetfreq(dbkey, series);
    typ = famegettype(dbkey, series);

    class = famegetclass(dbkey, series);
    if (class==HSERIE) {
      if (items == 6) {
        int             syear = (int) SvIV(ST(2));
        int             sprd = (int) SvIV(ST(3));
        int             eyear = (int) SvIV(ST(4));
        int             eprd = (int) SvIV(ST(5));
        cfmsrng(&status, freq, &syear, &sprd, &eyear, &eprd, range, &numobs);
        f_status = status;
        if (status != HSUCC) {
          /* fprintf(stderr,"HLI(%d)",status); */
          /* croak("Fame error: Read failed to set range"); */
          XSRETURN_UNDEF;
        }
      } else {
        range[0] = (int) SvIV(ST(2));
        range[1] = (int) SvIV(ST(3));
        range[2] = (int) SvIV(ST(4));
      }
    } else if (class==HSCALA) { 
      numobs=1;
    }

    Fame_allocate(WIN32PASS &dat, typ, numobs);
    status = Fame_readitems(&dat, dbkey, series, range);

    if (status != HSUCC) {
      Fame_free(WIN32PASS &dat);
      XSRETURN_UNDEF;
    }

    EXTEND(sp, numobs);

    for (i = 0; i < numobs; i++) {
      ST(i) = sv_newmortal();
      Fame_setSV(WIN32PASS ST(i), typ, dat.val.pf, i);
    }

    Fame_free(WIN32PASS &dat);

    if (numobs > 0) { XSRETURN(numobs); } 
    else            { XSRETURN_UNDEF; }
  }
  XSRETURN_UNDEF;
}


XS(Fame_famereadn)
{
  dXSARGS;
  if (items != 10)
    croak("Usage: @list=&famereadn($dbkey,$objnam,$num,$r1,$r2,$r3,$tmiss,$m1,$m2,$m3)");
  else {
    int             retval = 1;
    int             dbkey = (int) SvIV(ST(0));
    char           *series = (char *) SvPV(ST(1), na);
    int             numobs = (int) SvIV(ST(2));
    int             tmiss = (int) SvIV(ST(6));

    int             i;
    int             sz;
    int            *misary;
    int            *lenary;

    int             status;
    int             typ;
    int             syear;
    int             sprd;
    struct vdata    dat;

    int             range[3];

    range[0] = (int) SvIV(ST(3));
    range[1] = (int) SvIV(ST(4));
    range[2] = (int) SvIV(ST(5));

    typ = famegettype(dbkey, series);

    Fame_setVAL(WIN32PASS ST(7), typ, dat.mistt.pf, 0);
    Fame_setVAL(WIN32PASS ST(8), typ, dat.mistt.pf, 1);
    Fame_setVAL(WIN32PASS ST(9), typ, dat.mistt.pf, 2);

    Fame_allocate(WIN32PASS &dat, typ, numobs);
    status = Fame_readitems(&dat, dbkey, series, range);

    if (status != HSUCC) {
      Fame_free(WIN32PASS &dat);
      XSRETURN_UNDEF;
    }

    EXTEND(sp, numobs);

    for (i = 0; i < numobs; i++) {
      ST(i) = sv_newmortal();
      Fame_setSV(WIN32PASS ST(i), typ, dat.val.pf, i);
    }

    Fame_free(WIN32PASS &dat);

    if (numobs > 0) { XSRETURN(numobs); }
    else            { XSRETURN_UNDEF; }
  }
  XSRETURN_UNDEF;
}


XS(Fame_famewrite)
{
  dXSARGS;
  if (items <= 4)
    croak("Usage: &famewrite($dbkey,$objnam,$year,$prd,@list)");
  else {
    int             retval = 1;
    int             dbkey = (int) SvIV(ST(0));
    char           *series = (char *) SvPV(ST(1), na);
    int             year = (int) SvIV(ST(2));
    int             prd = (int) SvIV(ST(3));
    int             eyear = -1;
    int             eprd = -1;

    int             status;
    int             freq;
    int             range[3];
    int             numobs;
    struct vdata    dat;
    float          *mistt;
    int             typ;
    int             sz;
    char           *ss;
    int             i;

    numobs = items - 4;

    freq = famegetfreq(dbkey, series);
    if (f_status != HSUCC) {
      /* croak("Fame error: unsupported data type"); */
      ST(0)=sv_newmortal();
      sv_setiv(ST(0), f_status);
      XSRETURN(1);
    }
    typ = famegettype(dbkey, series);
    cfmsrng(&status, freq, &year, &prd, &eyear, &eprd, range, &numobs);
    f_status = status;

    Fame_allocate(WIN32PASS &dat, typ, numobs);

    for (i = 0; i < numobs; i++) {
      Fame_setVAL(WIN32PASS ST(i+4), typ, dat.val.pf, i);
    }

    f_status = Fame_writeitems(&dat, dbkey, series, range);

    Fame_free(WIN32PASS &dat);

    ST(0)=sv_newmortal();
    sv_setiv(ST(0), status);
  }
  XSRETURN(1);
}

#ifdef ADJDIV

XS(Fame_famecalladj) 
{
  dXSARGS;
  if (items < 7)
    croak("Usage: ($stat,@series) = &famecalladj($call,$ticker,$prc_key,$div_key,$start,$end,$po_flag)");
  else {
    int             retval = 1;
    char           *call = (char *) SvPV(ST(0), na);
    char           *ticker = (char *) SvPV(ST(1), na);
    int             prc_key = (int) SvIV(ST(2));
    int             div_key = (int) SvIV(ST(3));
    int             start = (int) SvIV(ST(4));
    int             end = (int) SvIV(ST(5));
    int             po_flag = (int) SvIV(ST(6));
    int             typ;
    int             numobs;
    int             i;
    struct vdata    dat;
    
    numobs = end-start+1;

    if (strcmp(call, "adjdiv")==0) {
      typ = HNUMRC;
      Fame_allocate(WIN32PASS &dat, typ, numobs);
      retval = adjdiv(ticker, prc_key, div_key, start, end, po_flag, dat.val.pf);
    }
    else if (strcmp(call, "rtnser")==0) {
      typ = HNUMRC;
      Fame_allocate(WIN32PASS &dat, typ, numobs);
      retval = rtnser(ticker, prc_key, div_key, start, end, po_flag, dat.val.pf);
    }
    else if (strcmp(call, "totret")==0) {
      typ = HPRECN;
      Fame_allocate(WIN32PASS &dat, typ, numobs);
      retval = totret(ticker, prc_key, div_key, start, end, po_flag, dat.val.pd);
    }
    else if (strcmp(call, "acp")==0) {
      typ = HNUMRC;
      Fame_allocate(WIN32PASS &dat, typ, numobs);
      retval = acp(ticker, prc_key, div_key, start, end, po_flag, dat.val.pf);
    }
    else {
      ST(0) = sv_newmortal();
      sv_setiv(ST(0), -10);
      Fame_free(WIN32PASS &dat);
      XSRETURN(1);
    }

    EXTEND(sp, numobs + 1);

    ST(0) = sv_newmortal();
    sv_setiv(ST(0), retval);

    for (i = 0; i < numobs; i++) {
      ST(i+1) = sv_newmortal();
    Fame_setSV(WIN32PASS ST(i+1), typ, dat.val.pf, i);
    }

    Fame_free(WIN32PASS &dat);

    XSRETURN(numobs+1);
  }
  XSRETURN_UNDEF;
}

#endif


XS(boot_Fame__HLI)
{
  dXSARGS;
  char           *fn = __FILE__;
  int status;

#include "fameinit.i"

  /* set up constants for the autoloader */
  newXS("Fame::HLI::constant", Fame_constant, fn);

  /* register BEGIN, but it won't call it for some reason, so
     added cfmini below */
  /* newXS("Fame::HLI::BEGIN", Fame_famestart, fn); */
  /* it will, however, call END when terminating */
  /* newXS("Fame::HLI::END", Fame_famestop, fn); */

  newXS("Fame::HLI::famestart", Fame_famestart, fn);
  newXS("Fame::HLI::famestop", Fame_famestop, fn);
  newXS("Fame::HLI::cfmgatt", Fame_cfmgatt, fn);
  newXS("Fame::HLI::cfmsatt", Fame_cfmsatt, fn);
  newXS("Fame::HLI::fameopen", Fame_fameopen, fn);
  newXS("Fame::HLI::fameclose", Fame_fameclose, fn);
  newXS("Fame::HLI::fameread", Fame_fameread, fn);
  newXS("Fame::HLI::famereadn", Fame_famereadn, fn);
  newXS("Fame::HLI::famewrite", Fame_famewrite, fn);
  newXS("Fame::HLI::famegetinfo", Fame_famegetinfo, fn);
#ifdef ADJDIV
  newXS("Fame::HLI::famecalladj", Fame_famecalladj, fn);
#endif

  cfmini(&status);
  if (status != HSUCC) {
    fprintf(stderr, "Fame CHLI not initialized [%d]!\n", status);
    if (getenv("FAME")==NULL) {
      fprintf(stderr, "Please set your FAME environment variable\n");
    }
    errno=status;
    ST(0) = &sv_no;
  } else {
    ST(0) = &sv_yes;
  }
  XSRETURN(1);
}