view release on metacpan or  search on metacpan

CL.xs  view on Meta::CPAN

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

/* #include "ppport.h" */

#include <cwb/cl.h>
#include <stdio.h>

/*
  ********* C segment (preamble) **********
*/ 

typedef Attribute * PosAttrib;  /* allows XS to check that attribute pointer belongs to approriate class */
typedef Attribute * StrucAttrib;
typedef Attribute * AlignAttrib;

int last_cl_error = CDA_OK; /* keep track of last error (cdperrno variable) in vectorised functions */
#define CWB_CL_INVALID_ARG 1 /* internal error codes used by the CWB::CL module */

int strict_mode = 0; /* in strict mode, every CL or argument error will cause the interface to croak() */

const char*
cwb_cl_error_message(int error_code) {
  if (error_code == CWB_CL_INVALID_ARG) { 
    return "CWB::CL: invalid argument encountered";
  }
  else {
    return cdperror_string(error_code);
  }
}

void
croak_on_error(int error_code) {
  croak("%s (aborted)", cwb_cl_error_message(error_code));
}

static int
not_here(s)
char *s;
{
  croak("%s not implemented on this architecture", s);
  return -1;
}

static double
constant(name)
char *name;
{
  errno = 0;
  switch (*name) {
  case 'A':
    if (strEQ(name, "ATTAT_FLOAT"))
      return ATTAT_FLOAT;
    if (strEQ(name, "ATTAT_INT"))
      return ATTAT_INT;
    if (strEQ(name, "ATTAT_NONE"))
      return ATTAT_NONE;
    if (strEQ(name, "ATTAT_PAREF"))
      return ATTAT_PAREF;
    if (strEQ(name, "ATTAT_POS"))
      return ATTAT_POS;
    if (strEQ(name, "ATTAT_STRING"))
      return ATTAT_STRING;
    if (strEQ(name, "ATTAT_VAR"))
      return ATTAT_VAR;
    if (strEQ(name, "ATT_ALIGN"))
      return ATT_ALIGN;
    if (strEQ(name, "ATT_ALL"))
      return ATT_ALL;
    if (strEQ(name, "ATT_DYN"))
      return ATT_DYN;
    if (strEQ(name, "ATT_NONE"))
      return ATT_NONE;
    if (strEQ(name, "ATT_POS"))
      return ATT_POS;
    if (strEQ(name, "ATT_REAL"))
      return ATT_REAL;
    if (strEQ(name, "ATT_STRUC"))
      return ATT_STRUC;
    break;
  case 'C':
    if (strEQ(name, "CDA_EALIGN"))
      return CDA_EALIGN;
    if (strEQ(name, "CDA_EARGS"))
      return CDA_EARGS;
    if (strEQ(name, "CDA_EATTTYPE"))
      return CDA_EATTTYPE;
    if (strEQ(name, "CDA_EBADREGEX"))
      return CDA_EBADREGEX;
    if (strEQ(name, "CDA_EBUFFER"))
      return CDA_EBUFFER;
    if (strEQ(name, "CDA_EFSETINV"))
      return CDA_EFSETINV;
    if (strEQ(name, "CDA_EIDORNG"))
      return CDA_EIDORNG;
    if (strEQ(name, "CDA_EIDXORNG"))
      return CDA_EIDXORNG;
    if (strEQ(name, "CDA_ENODATA"))