Inline-SLang

 view release on metacpan or  search on metacpan

SLang.xs  view on Meta::CPAN

#
void
_sl_defined_types( )
  PREINIT:
    SLang_Class_Type *_SLclass_get_class( unsigned char ); /* from slclass.c */
    HV *hashref;
    AV *arrayref;
    char *name;
    int i, sflag;

  PPCODE:
    /* create the hash array to store the results in */
    hashref = (HV *) sv_2mortal( (SV *) newHV() );

    /*
     * assume that the max number of types is 256
     * - this is not a great thing to do
     * and the use of _SLclass_get_class() et al 
     * is even worse
     */
    for ( i = 0; i < 256; i++ ) {

SLang.xs  view on Meta::CPAN

void
_sl_isa_datatype( inname )
    char *inname
  PREINIT:
    const char *slformat = "string(%s);typeof(%s)==DataType_Type;";
    char *outname;
    char *slbuffer;
    size_t blen;
    int flag;

  PPCODE:
    /* not bothered anout 2 extra chars due to %s %s in format */
    blen = strlen(slformat)+2*strlen(inname);
    Newz( "", slbuffer, blen, char );
    snprintf( slbuffer, blen, slformat, inname, inname );

    Printf( ("Checking if %s is a valid DataType_Type name\n",inname) );
    Printf( ("S-Lang buffer= [%s]\n", slbuffer) );

    (void) SLang_load_string( slbuffer );

SLang.xs  view on Meta::CPAN

#   whenever the type code changes)
#

void
_guess_sltype( item )
    SV * item
  PREINIT:
    SLtype sltype;
    int slflag;
    SV * out;
  PPCODE:
    sltype = pltype( item, &slflag );

    switch( sltype ) {
      case SLANG_NULL_TYPE:     out = newSVpv( "Null_Type", 0 ); break;
      case SLANG_INT_TYPE:      out = newSVpv( "Integer_Type", 0 ); break;
      case SLANG_DOUBLE_TYPE:   out = newSVpv( "Double_Type", 0 ); break;
      case SLANG_STRING_TYPE:   out = newSVpv( "String_Type", 0 ); break;
      case SLANG_COMPLEX_TYPE:  out = newSVpv( "Complex_Type", 0 ); break;
      case SLANG_DATATYPE_TYPE: out = newSVpv( "DataType_Type", 0 ); break;
      case SLANG_STRUCT_TYPE:   out = newSVpv( "Struct_Type", 0 ); break;

SLang.xs  view on Meta::CPAN

#   a C one
# - note no error checking
#
void
_create_empty_array( SV *in )
  PREINIT:
    int dims[SLARRAY_MAX_DIMS];
    AV *aref;
    SV * out;
    int i, ndim;
  PPCODE:
    aref = (AV *) SvRV( in );
    ndim = 1 + av_len(aref);
    Printf( ("Creating an empty array (%d dim) with size ", ndim) );
    for( i = 0; i < ndim; i++ ) {
      int dsize = SvIV( *av_fetch( aref, i, 0 ) );
      dims[i] = dsize;
      Printf( ("%d ", dsize) );
    }
    Printf( ("\n") );
    out = _create_empty_array( ndim, dims );

SLang.xs  view on Meta::CPAN

#
# Since we installed an error handler that calls Perl's croak on
# an error, rather than printing the messages to STDERR,
# SLang_load_string() no longer returns on error
# 

void
_sl_eval( str )
    char * str

  PPCODE:
    Printf( ("----------------------------------------------------------------------\n") );
    Printf( ("sl_eval: code: %s\n", str ) );
    Printf( ("----------------------------------------------------------------------\n") );

    /*
     * since we have installed an error handler which croak's, 
     * we do not need to check the return value of this function
     */
    (void) SLang_load_string(str);

SLang.xs  view on Meta::CPAN

#undef  NUM_FIXED_ARGS
#define NUM_FIXED_ARGS 1

void
sl_call_function( qualname, ... )
    char * qualname

  PREINIT:
    int i;

  PPCODE:
    Printf( ("sl_call_function called:\n  function: %s\n", qualname ) );

    /*
     * We could remove this check - ie assume that if we've got this
     * far then eveything 'should' be fine
     */
    if ( 1 > SLang_is_defined(qualname) ) {
      croak( "'%s' is not a S-Lang function", qualname );
      XSRETURN_EMPTY;
    }