Mailing List Archive

Modules/parametere/stack - help (fwd)
maybe there is enough rope for a comp.lang.perl.guts noosegroup. :-)

------- start of forwarded message -------
Path: csnews!boulder!agate!news.ucdavis.edu!library.ucla.edu!nnrp.info.ucla.edu!info.ucla.edu!psgrain!nntp.teleport.com!nntp.teleport.com!not-for-mail
From: jmcx2@teleport.com (J Carrasquer)
Newsgroups: comp.lang.perl.misc
Subject: Modules/parametere/stack - help
Date: 20 Dec 1995 09:55:20 -0800
Organization: Teleport - Portland's Public Access (503) 220-1016
Lines: 300
Message-ID: <4b9im8$1ld@julie.teleport.com>
NNTP-Posting-Host: julie.teleport.com

To anybody who knows the answers:

I am adding a perl interface into an existing C shared library. I started working
with perl only last week, so please bear with me. Overall, it's going pretty
smoothly (90/99 interface functions working), but I've run into a couple of datatypes
that I'm having trouble with. Specifically, the problems are in the calls that require
address of (char**) or (uint*) in the parameter list. Passing data between the
C-code generated by xsubpp and my shared lib is working as expected, but I can't get it
processed through the stack correctly with either of the following typemap approaches.

typedef char** ArrayOfString;
typedef unsigned int * ArrayOfUnsignedInt;

typemap 1
---------
ArrayOfString T_PACKED
ArrayOfUnsignedInt OPAQUEPTR

typemap 2
---------
ArrayOfString T_PTROBJ
ArrayOfUnsignedInt T_PTROBJ


I have tried several methods for deferencing the data, but I think that I must
be missing something pretty fundamental here. I have included perl driver,
the XS source code (with header and typemap info at top) and the xsubpp C-code
for each typemap. Any insight that you can provide is appreciated. I am using
Perl 5.001m.

Thanks in advance,

James Carrasquer
jmcx2@teleport.com

--------------------------------------------------------------------------------
### Perl Program
--------------------------------------------------------------------------------

#!/usr/local/bin/perl

use DynaLoader
DynaLoader::dl_load_file( "my_shared_library.sl" );

use JMC;

$ValueCount = 2;
$ValueArray = [ 0, 1 ];
$exit_status = JMC::jmc_SetValues( $ValueCount, $ValueArray ); ## passes addresses to C func, not values

$exit_status = JMC::jmc_GetValues( $ValueCount, $ValueArray );

JMC::jmc_GetMessageText( $MessageLineCount, $MessageText );

--------------------------------------------------------------------------------
### XS Source
--------------------------------------------------------------------------------

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

/* Typemap entries for the typedef statements that follow:
*
* TYPEMAP_1
* MyString T_PTR
* ArrayOfString T_PACKED
* ArrayOfUnsignedInt T_OPAQUEPTR
*
* TYPEMAP_2
* MyString T_PTR
* ArrayOfString T_PTROBJ
* ArrayOfUnsignedInt T_PTROBJ
*/

typedef char * MyString;
typedef MyString * ArrayOfString;
typedef unsigned int * ArrayOfUnsignedInt;
typedef unsigned int Boolean;

/* C function prototypes */
extern void jmc_GetMessageText( unsigned int *, ArrayOfString * );
extern Boolean jmc_GetValues( unsigned int *, ArrayOfUnsignedInt * );
extern Boolean jmc_SetValues( unsigned int, ArrayOfUnsignedInt );

#ifdef TYPEMAP_1
/* This macro and function are used to resolve code that is generated by xsubpp */
/* when the typemap is TYPEMAP_1.

#define XS_pack_ArrayOfString(i,v) i=jmc_load_AV((unsigned int)SvIV(ST(0)),v)

SV* jmc_load_AV( unsigned int count, char **ptr )
{
int i;
SV *sv, *rv;
AV *av;

av = newAV();
for ( i=0; i < count; i++ )
{
sv = newSVpv( ptr[i], 0 );
av_push( av, sv );
}
rv = newRV( (SV*) av );
return( rv );
}
#endif /* TYPEMAP_! */

MODULE = JMC PACKAGE = JMC
void
jmc_GetMessageText(MessageLineCount,MessageText)
unsigned int &MessageLineCount = NO_INIT
ArrayOfString &MessageText = NO_INIT
CODE:
jmc_GetMessageText( &MessageLineCount, &MessageText );
OUTPUT:
MessageLineCount
MessageText

MODULE = JMC PACKAGE = JMC
Boolean
jmc_GetValues(ValueCount,ValueArray)
unsigned int &ValueCount = NO_INIT
ArrayOfUnsignedInt &ValueArray = NO_INIT
CODE:
RETVAL = jmc_GetValues( &ValueCount, &ValueArray );
OUTPUT:
ValueCount
ValueArray
RETVAL

MODULE = JMC PACKAGE = JMC
Boolean
jmc_SetValues(ValueCount,ValueArray)
unsigned int ValueCount
ArrayOfUnsignedInt ValueArray
CODE:
RETVAL = jmc_SetValues( ValueCount, ValueArray );
OUTPUT:
RETVAL

--------------------------------------------------------------------------------
### C Source - TYPEMAP_1 - just the code generated by xsubpp
--------------------------------------------------------------------------------
/*
* This file was generated automatically by xsubpp version 1.9 from the
* contents of jmc.xs. Don't edit this file, edit jmc.xs instead.
*
* ANY CHANGES MADE HERE WILL BE LOST!
*
*/

XS(XS_JMC_jmc_GetMessageText)
{
dXSARGS;
if (items != 2) {
croak("Usage: JMC::jmc_GetMessageText(MessageLineCount,MessageText)");
}
{
unsigned int MessageLineCount;
ArrayOfString MessageText;
jmc_GetMessageText( &MessageLineCount, &MessageText );

sv_setiv(ST(0), (IV)MessageLineCount);
XS_pack_ArrayOfString(ST(1), MessageText);
}
XSRETURN(1);
}

XS(XS_JMC_jmc_GetValues)
{
dXSARGS;
if (items != 2) {
croak("Usage: JMC::jmc_GetValues(ValueCount,ValueArray)");
}
{
unsigned int ValueCount;
ArrayOfUnsignedInt ValueArray;
Boolean RETVAL;
RETVAL = jmc_GetValues( &ValueCount, &ValueArray );

sv_setiv(ST(0), (IV)ValueCount);
sv_setpvn(ST(1), (char *)ValueArray, sizeof(*ValueArray)), XFree((char *)ValueArray);
ST(0) = sv_newmortal();
sv_setiv(ST(0), (IV)RETVAL);
}
XSRETURN(1);
}

XS(XS_JMC_jmc_SetValues)
{
dXSARGS;
if (items != 2) {
croak("Usage: JMC::jmc_SetValues(ValueCount,ValueArray)");
}
{
unsigned int ValueCount = (unsigned int)SvIV(ST(0));
ArrayOfUnsignedInt ValueArray = (ArrayOfUnsignedInt)SvPV(ST(1),na);
Boolean RETVAL;
RETVAL = jmc_SetValues( ValueCount, ValueArray );

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

XS(boot_JMC)
{
dXSARGS;
char* file = __FILE__;

newXS("JMC::jmc_GetMessageText", XS_JMC_jmc_GetMessageText, file);
newXS("JMC::jmc_GetValues", XS_JMC_jmc_GetValues, file);
newXS("JMC::jmc_SetValues", XS_JMC_jmc_SetValues, file);
ST(0) = &sv_yes;
XSRETURN(1);
}

--------------------------------------------------------------------------------
### C Source - TYPEMAP_2 - just the code generated by xsubpp
--------------------------------------------------------------------------------

XS(XS_JMC_jmc_Message_GetText)
{
dXSARGS;
if (items != 2) {
croak("Usage: JMC::jmc_GetMessageText(MessageLineCount,MessageText)");
}
{
unsigned int MessageLineCount;
ArrayOfString MessageText;
jmc_GetMessageText( &MessageLineCount, &MessageText );

sv_setiv(ST(0), (IV)MessageLineCount);
sv_setref_pv(ST(1), "ArrayOfString", (void*)MessageText);
}
XSRETURN(1);
}

XS(XS_JMC_jmcGetValues)
{
dXSARGS;
if (items != 2) {
croak("Usage: JMC::jmc_GetValues(ValueCount,ValueArray)");
}
{
unsigned int ValueCount;
ArrayOfUnsignedInt ValueArray;
Boolean RETVAL;
RETVAL = jmc_GetValues( &ValueCount, &ValueArray );

sv_setiv(ST(1), (IV)ValueCount);
sv_setref_pv(ST(2), "ArrayOfUnsignedInt", (void*)ValueArray);
ST(0) = sv_newmortal();
sv_setiv(ST(0), (IV)RETVAL);
}
XSRETURN(1);
}

XS(XS_JMC_jmc_SetValues)
{
dXSARGS;
if (items != 2) {
croak("Usage: JMC::jmc_SetValues(ValueCount,ValueArray)");
}
{
unsigned int ValueCount = (unsigned int)SvIV(ST(1));
ArrayOfUnsignedInt ValueArray;
Boolean RETVAL;

if ( 1 || sv_isa(ST(2), "ArrayOfIndex")) {
IV tmp = SvIV((SV*)SvRV(ST(2)));
ValueArray = (ArrayOfUnsignedInt) tmp;
}
else
croak("Port is not of type ArrayOfIndex");

RETVAL = jmc_SetValues( ValueCount, ValueArray );

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

XS(boot_JMC)
{
dXSARGS;
char* file = __FILE__;

newXS("JMC::jmc_GetMessageText", XS_JMC_jmc_GetMessageText, file);
newXS("JMC::jmc_GetValues", XS_JMC_jmc_GetValues, file);
newXS("JMC::jmc_SetValues", XS_JMC_jmc_SetValues, file);
ST(0) = &sv_yes;
XSRETURN(1);
}
--
jmcx2@teleport.COM Public Access User --- Not affiliated with Teleport
Public Access UNIX and Internet at (503) 220-1016 (2400-14400, N81)
------- end of forwarded message -------

--
Tom Christiansen Perl Consultant, Gamer, Hiker tchrist@mox.perl.com

Hey, I had to let awk be better at *something*... :-)
--Larry Wall in <1991Nov7.200504.25280@netlabs.com>1