Author Topic: Perl Extension Module  (Read 18835 times)

Support

  • Administrator
  • *****
  • Posts: 1
    • View Profile
Perl Extension Module
« on: April 08, 2015, 04:07:07 pm »
I'm done with the Perl extension module in its current form. I see no purpose going through all the work of calling Perl functions from C directly and having to do all the crazy low level stack stuff. The Perl Eval function does everything I need at the moment and works like the TinyScheme extension module.

DECLARE SUB pl_Init ALIAS "pl_Init" LIB "sbperl"
DECLARE SUB pl_Eval ALIAS "pl_Eval" LIB "sbperl"
DECLARE SUB pl_GetInt ALIAS "pl_GetInt" LIB "sbperl"
DECLARE SUB pl_GetDbl ALIAS "pl_GetDbl" LIB "sbperl"
DECLARE SUB pl_GetStr ALIAS "pl_GetStr" LIB "sbperl"
DECLARE SUB pl_Destroy ALIAS "pl_Destroy" LIB "sbperl"

pl_Init

pl_code = """
sub Average{
   # get total number of arguments passed.
   $n = scalar(@_);
   $sum = 0;

   foreach $item (@_){
      $sum += $item;
   }
   $average = $sum / $n;

   return $average;
}
"
""
pl_Eval pl_code
pl_Eval "$num = Average(10, 20, 30);"
PRINT pl_GetInt("num"),"\n"

pl_Destroy
 

jrs@laptop:~/sb/sb22/test$ scriba perlfunc.sb
20
jrs@laptop:~/sb/sb22/test$


Support

  • Administrator
  • *****
  • Posts: 1
    • View Profile
Re: Perl Extension Module
« Reply #1 on: April 08, 2015, 04:09:42 pm »
Here is an example of getting the SB filedesc.sb script file info by calling a Perl function.

DECLARE SUB pl_Init ALIAS "pl_Init" LIB "sbperl"
DECLARE SUB pl_Eval ALIAS "pl_Eval" LIB "sbperl"
DECLARE SUB pl_GetInt ALIAS "pl_GetInt" LIB "sbperl"
DECLARE SUB pl_GetDbl ALIAS "pl_GetDbl" LIB "sbperl"
DECLARE SUB pl_GetStr ALIAS "pl_GetStr" LIB "sbperl"
DECLARE SUB pl_Destroy ALIAS "pl_Destroy" LIB "sbperl"

pl_Init

pl_code = """
my $file = "
filedesc.sb";
my (@description, $size);
if (-e $file)
{
   push @description, 'binary' if (-B _);
   push @description, 'a socket' if (-S _);
   push @description, 'a text file' if (-T _);
   push @description, 'a block special file' if (-b _);
   push @description, 'a character special file' if (-c _);
   push @description, 'a directory' if (-d _);
   push @description, 'executable' if (-x _);
   push @description, (($size = -s _)) ? "
$size bytes" : 'empty';
   print "
$file is ", join(', ',@description),"\n";
}
"
""
pl_Eval pl_code

pl_Destroy
 

jrs@laptop:~/sb/sb22/test$ scriba filedesc.sb
filedesc.sb is a text file, 898 bytes
jrs@laptop:~/sb/sb22/test$ ls -l filedesc.sb
-rw-rw-r-- 1 jrs jrs 898 Apr  8 00:15 filedesc.sb
jrs@laptop:~/sb/sb22/test$


Support

  • Administrator
  • *****
  • Posts: 1
    • View Profile
Re: Perl Extension Module
« Reply #2 on: April 08, 2015, 04:11:33 pm »
Here is the current Script BASIC interface.c (sbperl.so) extension module source.

Perl Embedding API Documentation

/* Perl - Script BASIC extension module

UXLIBS: -lperl

*/


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <math.h>
#include <time.h>
#include "../../basext.h"
#include "cbasic.h"

#include <EXTERN.h>
#include <perl.h>

static PerlInterpreter *my_perl;

/****************************
 Extension Module Functions
****************************/


besVERSION_NEGOTIATE
  RETURN_FUNCTION((int)INTERFACE_VERSION);
besEND

besSUB_START
  DIM AS long PTR p;
  besMODULEPOINTER = besALLOC(sizeof(long));
  IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0);
  p = (long PTR)besMODULEPOINTER;
  RETURN_FUNCTION(0);
besEND

besSUB_FINISH
  DIM AS long PTR p;
  p = (long PTR)besMODULEPOINTER;
  IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0);
  RETURN_FUNCTION(0);
besEND


/****************
 Perl Functions
****************/


besFUNCTION(pl_Init)
  DIM AS char *embedding[] = { "", "-e", "0" };
  my_perl = perl_alloc();
  perl_construct(my_perl);
  perl_parse(my_perl, NULL, 3, embedding, NULL);
  perl_run(my_perl);
  besRETURN_LONG(my_perl);
besEND

besFUNCTION(pl_Eval)
  DIM AS const char PTR cmdstr;
  besARGUMENTS("z")
    AT cmdstr
  besARGEND
  eval_pv(cmdstr, TRUE);
  besRETURNVALUE = NULL;
besEND

besFUNCTION(pl_GetInt)
  DIM AS const char PTR cmdstr;
  DIM AS int rtnval;
  besARGUMENTS("z")
    AT cmdstr
  besARGEND
  rtnval = SvIV(get_sv(cmdstr, FALSE));
  besRETURN_LONG(rtnval);
besEND

besFUNCTION(pl_GetDbl)
  DIM AS const char PTR cmdstr;
  DIM AS double rtnval;
  besARGUMENTS("z")
    AT cmdstr
  besARGEND
  rtnval = SvNV(get_sv(cmdstr, FALSE));
  besRETURN_DOUBLE(rtnval);
besEND

besFUNCTION(pl_GetStr)
  DIM AS const char PTR cmdstr;
  DIM AS char PTR rtnval;
  DIM AS STRLEN n_a;
  besARGUMENTS("z")
    AT cmdstr
  besARGEND
  rtnval = SvPV(get_sv(cmdstr, FALSE), n_a);
  besRETURN_STRING(rtnval);
besEND

besFUNCTION(pl_Destroy)
  perl_destruct(my_perl);
  perl_free(my_perl);
  besRETURNVALUE = NULL;
besEND
 

Support

  • Administrator
  • *****
  • Posts: 1
    • View Profile
Re: Perl Extension Module
« Reply #3 on: April 08, 2015, 05:45:31 pm »
Perl has an console interactive (debugger) mode you can play with.


jrs@laptop:~/sb/sb22/test$ perl -d -e 1

Loading DB routines from perl5db.pl version 1.39_10
Editor support available.

Enter h or 'h h' for help, or 'man perldebug' for more help.

main::(-e:1):   1
  DB<1> h
List/search source lines:               Control script execution:
  l [ln|sub]  List source code            T           Stack trace
  - or .      List previous/current line  s [expr]    Single step [in expr]
  v [line]    View around line            n [expr]    Next, steps over subs
  f filename  View source in file         <CR/Enter>  Repeat last n or s
  /pattern/ ?patt?   Search forw/backw    r           Return from subroutine
  M           Show module versions        c [ln|sub]  Continue until position
Debugger controls:                        L           List break/watch/actions
  o [...]     Set debugger options        t [n] [expr] Toggle trace [max depth] ][trace expr]
  <[<]|{[{]|>[>] [cmd] Do pre/post-prompt b [ln|event|sub] [cnd] Set breakpoint
  ! [N|pat]   Redo a previous command     B ln|*      Delete a/all breakpoints
  H [-num]    Display last num commands   a [ln] cmd  Do cmd before line
  = [a val]   Define/list an alias        A ln|*      Delete a/all actions
  h [db_cmd]  Get help on command         w expr      Add a watch expression
  h h         Complete help page          W expr|*    Delete a/all watch exprs
  |[|]db_cmd  Send output to pager        ![!] syscmd Run cmd in a subprocess
  q or ^D     Quit                        R           Attempt a restart
Data Examination:     expr     Execute perl code, also see: s,n,t expr
  x|m expr       Evals expr in list context, dumps the result or lists methods.
  p expr         Print expression (uses script's current package).
  S [[!]pat]     List subroutine names [not] matching pattern
  V [Pk [Vars]]  List Variables in Package.  Vars can be ~pattern or !pattern.
  X [Vars]       Same as "V current_package [Vars]".  i class inheritance tree.
  y [n [Vars]]   List lexicals in higher scope <n>.  Vars same as V.
  e     Display thread id     E Display all thread ids.
For more help, type h cmd_letter, or run man perldebug for all docs.
  DB<1>

Support

  • Administrator
  • *****
  • Posts: 1
    • View Profile
Re: Perl Extension Module
« Reply #4 on: April 09, 2015, 04:41:40 am »
The following is a Perl example of using regular expression parsing. (regx)

DECLARE SUB pl_Init ALIAS "pl_Init" LIB "sbperl"
DECLARE SUB pl_Eval ALIAS "pl_Eval" LIB "sbperl"
DECLARE SUB pl_GetInt ALIAS "pl_GetInt" LIB "sbperl"
DECLARE SUB pl_GetDbl ALIAS "pl_GetDbl" LIB "sbperl"
DECLARE SUB pl_GetStr ALIAS "pl_GetStr" LIB "sbperl"
DECLARE SUB pl_Destroy ALIAS "pl_Destroy" LIB "sbperl"

pl_Init

pl_code = """
sub test($$)
        {
        my $lookfor = shift;
        my $string = shift;
        print "
\n$lookfor ";
        if($string =~ m/($lookfor)/)
                {
                print "
is in ";
                }
        else
                {
                print "
is NOT in ";
                }
        print "
$string.";
        if(defined($1))
                {
                print "
     <$1>";
                }
        print "
\n";
        }

test("
st.v.", "steve was here");
test("
st.v.", "kitchen stove");
test("
st.v.", "kitchen store");
"
""
PRINTNL

pl_Eval pl_code

pl_Destroy
 
Output


jrs@laptop:~/sb/sb22/test$ time scriba perlmatch.sb


st.v.  is in steve was here.      <steve>

st.v.  is in kitchen stove.      <stove>

st.v.  is NOT in kitchen store.

real   0m0.004s
user   0m0.000s
sys   0m0.004s
jrs@laptop:~/sb/sb22/test$

Support

  • Administrator
  • *****
  • Posts: 1
    • View Profile
Re: Perl Extension Module
« Reply #5 on: April 09, 2015, 06:56:17 am »
Here is the above Perl example using the Script BASIC re (regx) extension module. This example is in 32 Windows XP as re seq faults under 64 bit.  :-\

IMPORT re.bas

SUB test(regx, target)
  IF re::match(target,regx) THEN
    PRINT regx," is in ",target,"      <",re::dollar(0),">\n"
  ELSE
    PRINT regx," is NOT in ",target,"\n"
  END IF
END SUB

test("st.v.", "steve was here")
test("st.v.", "kitchen stove")
test("st.v.", "kitchen store")

PRINTNL  
 
Output


C:\sb22\test>scriba testregx.sb
st.v. is in steve was here      <steve>
st.v. is in kitchen stove      <stove>
st.v. is NOT in kitchen store


C:\sb22\test>
« Last Edit: April 09, 2015, 07:08:00 am by support »