BASIC Developer & Support Resources > Scripting Languages

Building a ScriptBasic extension module

(1/11) > >>

John:
Up till now, I have been using GTK-Server (Linux) and DYC (Windows/Wine) to interface with shared objects APIs. (when a SB extension module didn't already exist) I tried to use the GSL library and ran into calling method issues with GTK-Server. My test using gcc with the GSL library worked fine. I now have a reason to bite the bullet and create a GSL extension module in C. I thought I would share the learning experience and make a tutorial out of the project.

This is a call to the trial example extension module which prints the the type and value of the passed arguments. A second call is made to show returning a value. Notice the extensive use of macro functions to ease the complexity of creating tightly coupled interfaces to the core scripting language.


--- Code: ---DECLARE SUB VarType ALIAS "pprint" LIB "trial"
DECLARE SUB ModPtr ALIAS "trial" LIB "trial"

a=1
b="two"
c[0]=0.3
VarType(a,b,c)
mp = ModPtr()
PRINT "Module Pointer = ",mp,"\n"

--- End code ---


--- Code: ---#include <stdio.h>

#include "../../basext.h"

besVERSION_NEGOTIATE

  printf("The function bootmodu was started and the requested version is %d\n",Version);
  printf("The variation is: %s\n",pszVariation);
  printf("We are returning accepted version %d\n",(int)INTERFACE_VERSION);
  return (int)INTERFACE_VERSION;

besEND

besSUB_START
  long *pL;

  besMODULEPOINTER = besALLOC(sizeof(long));
  if( besMODULEPOINTER == NULL )return 0;
  pL = (long *)besMODULEPOINTER;
  *pL = 0L;

  printf("The function bootmodu was started.\n");

besEND

besSUB_FINISH
  printf("The function finimodu was started.\n");
besEND


besFUNCTION(pprint)
  int i;
  int slen;
  char *s;
  VARIABLE Argument;

  printf("The number of arguments is: %ld\n",besARGNR);

  for( i=1 ; i <= besARGNR ; i++ ){
    Argument = besARGUMENT(i);
    besDEREFERENCE(Argument);
redo:
    switch( slen=TYPE(Argument) ){
      case VTYPE_LONG:
        printf("This is a long: %ld\n",LONGVALUE(Argument));
        break;
      case VTYPE_DOUBLE:
        printf("This is a double: %lf\n",DOUBLEVALUE(Argument));
        break;
      case VTYPE_STRING:
        printf("This is a string ");
        s = STRINGVALUE(Argument);
        slen = STRLEN(Argument);
        while( slen -- )
            putc(((int)*s++),stdout);
        printf("\n");
        break;
      case VTYPE_ARRAY:
        printf("ARRAY@#%08X\n",LONGVALUE(Argument));
        printf("ARRAY LOW INDEX: %ld\n",ARRAYLOW(Argument));
        printf("ARRAY HIGH INDEX: %ld\n",ARRAYHIGH(Argument));
        printf("The first element of the array is:\n");
        Argument = ARRAYVALUE(Argument,ARRAYLOW(Argument));
        goto redo;
        break;
      }
    }
besEND

esFUNCTION(trial)
  long *pL;

  printf("Function trial was started...\n");
  pL = (long *)besMODULEPOINTER;
  (*pL)++;
  besRETURNVALUE = besNEWMORTALLONG;
  LONGVALUE(besRETURNVALUE) = *pL;

  printf("Module directory is %s\n",besCONFIG("module"));
  printf("dll extension is %s\n",besCONFIG("dll"));
  printf("include directory is %s\n",besCONFIG("include"));

besEND

--- End code ---

jrs@laptop:~/sb/test$ scriba ext_pprint.sb
The function bootmodu was started and the requested version is 11
The variation is: STANDARD
We are returning accepted version 11
The function bootmodu was started.
The number of arguments is: 3
This is a long: 1
This is a string two
ARRAY@#0076A328
ARRAY LOW INDEX: 0
ARRAY HIGH INDEX: 0
The first element of the array is:
This is a double: 0.300000
Function trial was started...
Module directory is /usr/local/lib/scriba/
dll extension is .so
include directory is /usr/share/scriba/include/
Module Pointer = 1
The function finimodu was started.
jrs@laptop:~/sb/test$

In the next installment, I plan to have some of the GSL functions wrapped as an extension module along with a few test scripts.

John:
I was able to get the framework and first GSL function to work as a ScriptBasic extension module.


--- Code: Text ---DECLARE SUB besselJ0 ALIAS "sf_bessel_J0" LIB "gsl" PRINT FORMAT("J0(%g) = %.48g", 5, besselJ0(5.0)),"\n" 

--- Code: Text ---/*    GNU Scientific Library   Based on GSL 1.15   Interface By: John Spikowski */ #include <stdio.h>#include "../../basext.h"#include <gsl/gsl_sf_bessel.h>      besVERSION_NEGOTIATE    return (int)INTERFACE_VERSION;besEND besSUB_START besEND besSUB_FINISH besEND besFUNCTION(sf_bessel_J0)  VARIABLE Argument;  double x;   if(besARGNR>1) return EX_ERROR_TOO_MANY_ARGUMENTS;  if(besARGNR<1) return EX_ERROR_TOO_FEW_ARGUMENTS;   Argument = besARGUMENT(1);  besDEREFERENCE(Argument);   x = DOUBLEVALUE(Argument);  double y = gsl_sf_bessel_J0 (x);   besRETURNVALUE = besNEWMORTALDOUBLE;  DOUBLEVALUE(besRETURNVALUE) = y; besEND 
jrs@laptop:~/sb/test/gsl$ scriba bj0.sb
J0(5) = -0.177596771314338264247112419980112463235855102539
jrs@laptop:~/sb/test/gsl$

gsl.so compiled to a 3405 byte 64 bit shared object.  

When I finish building the GSL function wrappers, I will put this within a ScriptBasic MODULE.


--- Code: ---IMPORT GSL.bas

PRINT FORMAT("J0(%g) = %.16g", 5, GSL::sf_bessel_J0(5.0)),"\n"

--- End code ---

John:
I was able to tighten the code up a bit.


--- Code: ---besFUNCTION(sf_bessel_J0)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_sf_bessel_J0 (DOUBLEVALUE(Argument)));

besEND

--- End code ---

John:
This is the Elementary Functions from the GSL library.


--- Code: ---/*

   GNU Scientific Library
   Based on GSL 1.15
   Interface By: John Spikowski

*/

#include <stdio.h>
#include "../../basext.h"
#include <gsl/gsl_math.h>
      
besVERSION_NEGOTIATE
    return (int)INTERFACE_VERSION;
besEND

besSUB_START

besEND

besSUB_FINISH

besEND

/* Elementary Functions */

besFUNCTION(_log1p)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_log1p(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_expm1)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_expm1(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_hypot)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);
  double x = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(2);
  besDEREFERENCE(Argument);
  double y = DOUBLEVALUE(Argument);

  besRETURN_DOUBLE(gsl_hypot(x, y));
besEND


besFUNCTION(_hypot3)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);
  double x = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(2);
  besDEREFERENCE(Argument);
  double y = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(3);
  besDEREFERENCE(Argument);
  double z = DOUBLEVALUE(Argument);

  besRETURN_DOUBLE(gsl_hypot3(x, y, z));
besEND


besFUNCTION(_acosh)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_acosh(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_asinh)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_asinh(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_atanh)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_atanh(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_ldexp)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);
  double x = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(2);
  besDEREFERENCE(Argument);
  int y = LONGVALUE(Argument);

  besRETURN_DOUBLE(gsl_ldexp(x, y));
besEND

--- End code ---

I had to add the _ to the function names as the compiler complained of conflicting types.

interface.c:27:1: error: conflicting types for ‘log1p’
interface.c:37:1: error: conflicting types for ‘expm1’
interface.c:47:1: error: conflicting types for ‘hypot’
interface.c:78:1: error: conflicting types for ‘acosh’
interface.c:88:1: error: conflicting types for ‘asinh’
interface.c:98:1: error: conflicting types for ‘atanh’
interface.c:108:1: error: conflicting types for ‘ldexp’

This is my first test of the extension module and added a compare with the built in SB log function.


--- Quote ---This function computes the value of \log(1+x) in a way that is accurate for small x. It provides an alternative to the BSD math function log1p(x).
--- End quote ---


--- Code: ---DECLARE SUB log1p ALIAS "_log1p" LIB "gsl"

PRINT FORMAT("%.32g", log1p(34.0)),"\n"

PRINT FORMAT("%.32g", log (1 + 34.0)),"\n"

--- End code ---

jrs@laptop:~/sb/test/gsl$ scriba emath.sb
3.5553480614894135136694330867613
3.5553480614894135136694330867613
jrs@laptop:~/sb/test/gsl$


--- Quote ---The ldexp() functions multiply x by 2 to the power n.
--- End quote ---


--- Code: ---DECLARE SUB ldexp ALIAS "_ldexp" LIB "gsl"

PRINT FORMAT("%g",ldexp(12.5,2)),"\n"

--- End code ---

jrs@laptop:~/sb/test/gsl$ scriba emath.sb
50

John:
The last function in the Elementary set required the second argument to pass a SB variable (undef is fine) and the function would assign the value along with providing it's normal return value.


--- Code: ---besFUNCTION(_frexp)
  VARIABLE Argument;
  LEFTVALUE Lval;
  unsigned long __refcount_;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);
  double x = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(2);
  besLEFTVALUE(Argument,Lval);
  besRELEASE(*Lval);
  *Lval = besNEWLONG;

  besRETURN_DOUBLE(gsl_frexp(x, *Lval));
besEND

--- End code ---


--- Quote ---Function: double gsl_frexp (double x, int * e)

This function splits the number x into its normalized fraction f and exponent e, such that x = f * 2^e and 0.5 <= f < 1. The function returns f and stores the exponent in e. If x is zero, both f and e are set to zero. This function provides an alternative to the standard math function frexp(x, e).

--- End quote ---


--- Code: ---DECLARE SUB frexp ALIAS "_frexp" LIB "gsl"

x = 16.4
fraction = frexp(x, e)

PRINT FORMAT("%g",fraction),"\n"
PRINT e,"\n"

--- End code ---

jrs@laptop:~/sb/test/gsl$ scriba emath.sb
0.5125
5


--- Quote from: SBDevDocs ---A left value is a special expression that a value can be assigned, and therefore they usually stand on the left side of the assignment operator. That is the reason for the name.
--- End quote ---

I have attached the gsl.so ScriptBasic 64 bit GSL extension module containing the Elementary Functions of the library. Put the extracted file in your /usr/local/lib/scriba directory or where ever you have your SB modules located and referenced in the basic.conf file.


Current gsl.so (interface.c) source as of this post.


--- Code: ---/*
   GNU Scientific Library
   Based on GSL 1.15
   Interface By: John Spikowski
   Version 0.01
*/

#include <stdio.h>
#include "../../basext.h"
#include <gsl/gsl_math.h>
     
besVERSION_NEGOTIATE
    return (int)INTERFACE_VERSION;
besEND

besSUB_START

besEND

besSUB_FINISH

besEND

/* Elementary Functions */

besFUNCTION(_log1p)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_log1p(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_expm1)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_expm1(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_hypot)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);
  double x = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(2);
  besDEREFERENCE(Argument);
  double y = DOUBLEVALUE(Argument);

  besRETURN_DOUBLE(gsl_hypot(x, y));
besEND


besFUNCTION(_hypot3)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);
  double x = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(2);
  besDEREFERENCE(Argument);
  double y = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(3);
  besDEREFERENCE(Argument);
  double z = DOUBLEVALUE(Argument);

  besRETURN_DOUBLE(gsl_hypot3(x, y, z));
besEND


besFUNCTION(_acosh)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_acosh(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_asinh)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_asinh(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_atanh)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);

  besRETURN_DOUBLE(gsl_atanh(DOUBLEVALUE(Argument)));
besEND


besFUNCTION(_ldexp)
  VARIABLE Argument;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);
  double x = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(2);
  besDEREFERENCE(Argument);
  int y = LONGVALUE(Argument);

  besRETURN_DOUBLE(gsl_ldexp(x, y));
besEND

besFUNCTION(_frexp)
  VARIABLE Argument;
  LEFTVALUE Lval;
  unsigned long __refcount_;

  Argument = besARGUMENT(1);
  besDEREFERENCE(Argument);
  double x = DOUBLEVALUE(Argument);
  Argument = besARGUMENT(2);
  besLEFTVALUE(Argument,Lval);
  besRELEASE(*Lval);
  *Lval = besNEWLONG;

  besRETURN_DOUBLE(gsl_frexp(x, *Lval));
besEND

--- End code ---

Navigation

[0] Message Index

[#] Next page

Go to full version