MathGroup Archive 1999

[Date Index] [Thread Index] [Author Index]

Search the Archive

MathLink Data Types

  • To: mathgroup at smc.vnet.net
  • Subject: [mg20942] MathLink Data Types
  • From: Dave Richardson <dhr at glue.umd.edu>
  • Date: Wed, 1 Dec 1999 01:50:10 -0500 (EST)
  • Organization: University of Maryland
  • Sender: owner-wri-mathgroup at wolfram.com

Hello,

I am working with MathLink, and I have a question.

Is String a valid type?

Here is a basic program I am trying to write to read a string (from
Mathematica) and make a decision based upon it.  Then I want to return a
double based upon this...

Below is: string.cpp ********************************************

#include "mathlink.h"
#include <string.h>

int main(int argc, char *argv[]){
 return MLMain(argc,argv);
}

double whichx(char* sRefrigerant){
 double rx;
 if (strcoll(sRefrigerant, "R134a" ) == 0) rx = 12.;
 else rx = 9;
 return rx;
}

end string.cpp **************************************************

Here is the Template File string.tm *******************************

:Evaluate: BeginPackage[ "StringTest`"]
:Evaluate: WrapProps::usage = "whx("R134a"), returns 12 if the entered
string is R-134a, 9 if not."


:Evaluate: whx::usage = "a number"
:Begin:
:Function: whichx
:Pattern: whx[sRefrigerant]
:Arguments: {sRefrigerant}
:ArgumentTypes: {String}
:ReturnType: Real
:End:


:Evaluate: EndPackage[]

::This is a comment line.

end string.cpp **************************************************


According to the Mathematica book, String is a valid argument type in
Mathematica (Thus the template file), and its equivalent in c (c++) is
the char*.

For some reason, I am not getting a good link, and thus a crash and
burn...

If I change the type to double (In the c++ code and .tm template), I get
a compile/link/run just fine.

Can anyone point to the flaw in my logic here, and direct me around the
problem?

Thanks,

Dave!


See Below for stringtm.cpp
mprep then successfully generates the stringtm.cpp file
********************

/*
 * This file automatically produced by mprep from:
 * string.tm
 * mprep Revision 7 (c) Copyright Wolfram Research, Inc. 1990-1999
 */

#define MPREP_REVISION 7


#include "mathlink.h"

int MLAbort = 0;
int MLDone  = 0;
long MLSpecialCharacter = '\0';
HANDLE MLInstance = (HANDLE)0;
HWND MLIconWindow = (HWND)0;

MLINK stdlink = 0;
MLEnvironment stdenv = 0;
MLYieldFunctionObject stdyielder = 0;
MLMessageHandlerObject stdhandler = 0;

#include <windows.h>
#include <stdlib.h>
#include <string.h>
#if WIN32_MATHLINK && !defined(_fstrncpy)
#       define _fstrncpy strncpy
#endif

#ifndef CALLBACK
#define CALLBACK FAR PASCAL
typedef LONG LRESULT;
typedef unsigned int UINT;
typedef WORD WPARAM;
typedef DWORD LPARAM;
#endif


LRESULT CALLBACK MLEXPORT
IconProcedure( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam);

LRESULT CALLBACK MLEXPORT
IconProcedure( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
 switch( msg){
 case WM_CLOSE:
  MLDone = 1;
  MLAbort = 1;
  break;
 case WM_QUERYOPEN:
  return 0;
 }
 return DefWindowProc( hWnd, msg, wParam, lParam);
}

#define _APISTR(i) #i
#define APISTR(i) _APISTR(i)

HWND MLInitializeIcon( HINSTANCE hInstance, int nCmdShow)
{
 char path_name[260], *icon_name;
 WNDCLASS  wc;
 HMODULE hdll;

 MLInstance = hInstance;
 if( ! nCmdShow) return (HWND)0;
#if WIN16_MATHLINK
 hdll = GetModuleHandle( "ml16i" APISTR(MLINTERFACE));
#else
 hdll = GetModuleHandle( "ml32i" APISTR(MLINTERFACE));
#endif

 (void)GetModuleFileName( hInstance, path_name, sizeof(path_name));
 icon_name = strrchr( path_name, '\\') + 1;
 *strchr( icon_name, '.') = '\0';

 wc.style = 0;
 wc.lpfnWndProc = IconProcedure;
 wc.cbClsExtra = 0;
 wc.cbWndExtra = 0;
 wc.hInstance = hInstance;
 if( hdll)
  wc.hIcon = LoadIcon( hdll, "MLIcon");
 else
  wc.hIcon = LoadIcon( NULL, IDI_APPLICATION);
 wc.hCursor = LoadCursor( NULL, IDC_ARROW);
 wc.hbrBackground = (HBRUSH)GetStockObject( WHITE_BRUSH);
 wc.lpszMenuName =  (LPSTR) 0;
 wc.lpszClassName = "mprepIcon";
 (void)RegisterClass( &wc);

 MLIconWindow = CreateWindow( "mprepIcon", icon_name,
   WS_OVERLAPPEDWINDOW | WS_MINIMIZE, CW_USEDEFAULT,
   CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
   (HWND)0, (HMENU)0, hInstance, (void FAR*)0);

 if( MLIconWindow){
  ShowWindow( MLIconWindow, SW_MINIMIZE);
  UpdateWindow( MLIconWindow);
 }
 return MLIconWindow;
}


#if __BORLANDC__
#pragma argsused
#endif

MLYDEFN( devyield_result, MLDefaultYielder, ( MLINK mlp,
MLYieldParameters yp))
{
 MSG msg;

#if !__BORLANDC__
 mlp = mlp; /* suppress unused warning */
 yp = yp; /* suppress unused warning */
#endif

 if( PeekMessage( &msg, (HWND)0, 0, 0, PM_REMOVE)){
  TranslateMessage( &msg);
  DispatchMessage( &msg);
 }
 return MLDone;
}


/********************************* end header
*********************************/


double whichx P(( kcharp_ct _tp1));

#if MLPROTOTYPES
static int _tr0( MLINK mlp)
#else
static int _tr0(mlp) MLINK mlp;
#endif
{
 int res = 0;
 double _tp0;
 kcharp_ct _tp1;
 if ( ! MLGetString( mlp, &_tp1) ) goto L0;
 if ( ! MLNewPacket(mlp) ) goto L1;

 _tp0 = whichx(_tp1);

 res = MLAbort ?
  MLPutFunction( mlp, "Abort", 0) : MLPutReal( mlp, _tp0);
L1: MLDisownString(mlp, _tp1);

L0: return res;
} /* _tr0 */


static struct func {
 int   f_nargs;
 int   manual;
 int   (*f_func)P((MLINK));
 char  *f_name;
 } _tramps[1] = {
  { 1, 0, _tr0, "whichx" }
  };

static char* evalstrs[] = {
 "BeginPackage[ \"StringTest`\"]",
 (char*)0,
 "WrapProps::usage = \"whx(\"R134a\"), returns 12 if the entered stri",
 "ng is R-134a, 9 if not.\"",
 (char*)0,
 "whx::usage = \"a number\"",
 (char*)0,
 "EndPackage[]",
 (char*)0,
 (char*)0
};
#define CARDOF_EVALSTRS 4

static int _definepattern P(( MLINK, char*, char*, int));

static int _doevalstr P(( MLINK, int));

int  _MLDoCallPacket P(( MLINK, struct func[], int));


#if MLPROTOTYPES
int MLInstall( MLINK mlp)
#else
int MLInstall(mlp) MLINK mlp;
#endif
{
 int _res;
 _res = MLConnect(mlp);
 if (_res) _res = _doevalstr( mlp, 0);
 if (_res) _res = _doevalstr( mlp, 1);
 if (_res) _res = _doevalstr( mlp, 2);
 if (_res) _res = _definepattern(mlp, "whx[sRefrigerant]",
"{sRefrigerant}", 0);
 if (_res) _res = _doevalstr( mlp, 3);
 if (_res) _res = MLPutSymbol( mlp, "End");
 if (_res) _res = MLFlush( mlp);
 return _res;
} /* MLInstall */


#if MLPROTOTYPES
int MLDoCallPacket( MLINK mlp)
#else
int MLDoCallPacket( mlp) MLINK mlp;
#endif
{
 return _MLDoCallPacket( mlp, _tramps, 1);
} /* MLDoCallPacket */

/******************************* begin trailer
********************************/

#ifndef EVALSTRS_AS_BYTESTRINGS
# define EVALSTRS_AS_BYTESTRINGS 1
#endif

#if CARDOF_EVALSTRS
static int  _doevalstr( MLINK mlp, int n)
{
 long bytesleft, charsleft, bytesnow;
#if !EVALSTRS_AS_BYTESTRINGS
 long charsnow;
#endif
 char **s, **p;
 char *t;

 s = evalstrs;
 while( n-- > 0){
  if( *s == 0) break;
  while( *s++ != 0){}
 }
 if( *s == 0) return 0;
 bytesleft = 0;
 charsleft = 0;
 p = s;
 while( *p){
  t = *p; while( *t) ++t;
  bytesnow = t - *p;
  bytesleft += bytesnow;
  charsleft += bytesnow;
#if !EVALSTRS_AS_BYTESTRINGS
  t = *p;
  charsleft -= MLCharacterOffset( &t, t + bytesnow, bytesnow);
  /* assert( t == *p + bytesnow); */
#endif
  ++p;
 }


 MLPutNext( mlp, MLTKSTR);
#if EVALSTRS_AS_BYTESTRINGS
 p = s;
 while( *p){
  t = *p; while( *t) ++t;
  bytesnow = t - *p;
  bytesleft -= bytesnow;
  MLPut8BitCharacters( mlp, bytesleft, (unsigned char*)*p, bytesnow);
  ++p;
 }
#else
 MLPut7BitCount( mlp, charsleft, bytesleft);
 p = s;
 while( *p){
  t = *p; while( *t) ++t;
  bytesnow = t - *p;
  bytesleft -= bytesnow;
  t = *p;
  charsnow = bytesnow - MLCharacterOffset( &t, t + bytesnow, bytesnow);
  /* assert( t == *p + bytesnow); */
  charsleft -= charsnow;
  MLPut7BitCharacters(  mlp, charsleft, *p, bytesnow, charsnow);
  ++p;
 }
#endif
 return MLError( mlp) == MLEOK;
}
#endif /* CARDOF_EVALSTRS */


static int  _definepattern( MLINK mlp, char *patt, char *args, int
func_n)
{
 MLPutFunction( mlp, "DefineExternal", (long)3);
   MLPutString( mlp, patt);
   MLPutString( mlp, args);
   MLPutInteger( mlp, func_n);
 return !MLError(mlp);
} /* _definepattern */


int _MLDoCallPacket( MLINK mlp, struct func functable[], int nfuncs)
{
 long len;
 int n, res = 0;
 struct func* funcp;

 if( ! MLGetInteger( mlp, &n) ||  n < 0 ||  n >= nfuncs) goto L0;
 funcp = &functable[n];

 if( funcp->f_nargs >= 0
 && ( ! MLCheckFunction(mlp, "List", &len)
      || ( !funcp->manual && (len != funcp->f_nargs))
      || (  funcp->manual && (len <  funcp->f_nargs))
    )
 ) goto L0;

 stdlink = mlp;
 res = (*funcp->f_func)( mlp);

L0: if( res == 0)
  res = MLClearError( mlp) && MLPutSymbol( mlp, "$Failed");
 return res && MLEndPacket( mlp) && MLNewPacket( mlp);
} /* _MLDoCallPacket */


mlapi_packet MLAnswer( MLINK mlp)
{
 mlapi_packet pkt = 0;

 while( !MLDone && !MLError(mlp)
 && (pkt = MLNextPacket(mlp), pkt) && pkt == CALLPKT){
  MLAbort = 0;
  if( !MLDoCallPacket(mlp)) pkt = 0;
 }
 MLAbort = 0;
 return pkt;
}



/*
 Module[ { me = $ParentLink},
  $ParentLink = contents of RESUMEPKT;
  Message[ MessageName[$ParentLink, "notfe"], me];
  me]
*/

static int refuse_to_be_a_frontend( MLINK mlp)
{
 int pkt;

 MLPutFunction( mlp, "EvaluatePacket", 1);
   MLPutFunction( mlp, "Module", 2);
     MLPutFunction( mlp, "List", 1);
    MLPutFunction( mlp, "Set", 2);
      MLPutSymbol( mlp, "me");
         MLPutSymbol( mlp, "$ParentLink");
   MLPutFunction( mlp, "CompoundExpression", 3);
     MLPutFunction( mlp, "Set", 2);
       MLPutSymbol( mlp, "$ParentLink");
       MLTransferExpression( mlp, mlp);
     MLPutFunction( mlp, "Message", 2);
       MLPutFunction( mlp, "MessageName", 2);
         MLPutSymbol( mlp, "$ParentLink");
         MLPutString( mlp, "notfe");
       MLPutSymbol( mlp, "me");
     MLPutSymbol( mlp, "me");
 MLEndPacket( mlp);

 while( (pkt = MLNextPacket( mlp), pkt) && pkt != SUSPENDPKT)
  MLNewPacket( mlp);
 MLNewPacket( mlp);
 return MLError( mlp) == MLEOK;
}


int MLEvaluate( MLINK mlp, charp_ct s)
{
 if( MLAbort) return 0;
 return MLPutFunction( mlp, "EvaluatePacket", 1L)
  && MLPutFunction( mlp, "ToExpression", 1L)
  && MLPutString( mlp, s)
  && MLEndPacket( mlp);
}


int MLEvaluateString( MLINK mlp, charp_ct s)
{
 int pkt;
 if( MLAbort) return 0;
 if( MLEvaluate( mlp, s)){
  while( (pkt = MLAnswer( mlp), pkt) && pkt != RETURNPKT)
   MLNewPacket( mlp);
  MLNewPacket( mlp);
 }
 return MLError( mlp) == MLEOK;
} /* MLEvaluateString */


#if __BORLANDC__
#pragma argsused
#endif

MLMDEFN( void, MLDefaultHandler, ( MLINK mlp, unsigned long message,
unsigned long n))
{
#if !__BORLANDC__
 mlp = (MLINK)0; /* suppress unused warning */
 n = 0;          /* suppress unused warning */
#endif

 switch (message){
 case MLTerminateMessage:
  MLDone = 1;
 case MLInterruptMessage:
 case MLAbortMessage:
  MLAbort = 1;
 default:
  return;
 }
}



static int _MLMain( charpp_ct argv, charpp_ct argv_end, charp_ct
commandline)
{
 MLINK mlp;
 long err;

 if( !stdenv)
  stdenv = MLInitialize( (MLParametersPointer)0);
 if( stdenv == (MLEnvironment)0) goto R0;

 if( !stdyielder)
  stdyielder = MLCreateYieldFunction( stdenv,
   NewMLYielderProc( MLDefaultYielder), 0);
 if( !stdhandler)
  stdhandler = MLCreateMessageHandler( stdenv,
   NewMLHandlerProc( MLDefaultHandler), 0);


 mlp = commandline
  ? MLOpenString( stdenv, commandline, &err)
  : MLOpenArgv( stdenv, argv, argv_end, &err);
 if( mlp == (MLINK)0){
  MLAlert( stdenv, MLErrorString( stdenv, err));
  goto R1;
 }

 if( MLIconWindow){
  char textbuf[64];
  int len;
  len = GetWindowText(MLIconWindow, textbuf, sizeof(textbuf)-2);
  strcat( textbuf + len, "(");
  _fstrncpy( textbuf + len + 1, MLName(mlp), sizeof(textbuf) - len - 3);

  textbuf[sizeof(textbuf) - 2] = '\0';
  strcat( textbuf, ")");
  SetWindowText( MLIconWindow, textbuf);
 }

 if( MLInstance){
  if( stdyielder) MLSetYieldFunction( mlp, stdyielder);
  if( stdhandler) MLSetMessageHandler( mlp, stdhandler);
 }

 if( MLInstall( mlp))
  while( MLAnswer( mlp) == RESUMEPKT){
   if( ! refuse_to_be_a_frontend( mlp)) break;
  }

 MLClose( mlp);
R1: MLDeinitialize( stdenv);
 stdenv = (MLEnvironment)0;
R0: return !MLDone;
} /* _MLMain */


int MLMainString( charp_ct commandline)
{
 return _MLMain( (charpp_ct)0, (charpp_ct)0, commandline);
}

int MLMainArgv( char** argv, char** argv_end) /* note not FAR pointers
*/
{
 static char FAR * far_argv[128];
 int count = 0;

 while(argv < argv_end)
  far_argv[count++] = *argv++;

 return _MLMain( far_argv, far_argv + count, (charp_ct)0);

}

int MLMain( int argc, charpp_ct argv)
{
  return _MLMain( argv, argv + argc, (charp_ct)0);
}



end stringtm.cpp **************************************************

--
Dave Richardson
University of Maryland
Department of Mechanical Engineering
Center for Environmental Energy Engineering
(301) 405-8726
dhr at glue.umd.edu




  • Prev by Date: Re: Re: Orderless indexed functions
  • Next by Date: how to suppress the usage message?
  • Previous by thread: Re: Q: smooth 3Dplot with big mesh
  • Next by thread: Re: MathLink Data Types