ScriptBasic Extension Modules written in Oxygen

[Charles Pegge]

Hi John,

I'll rework sbo2 as a proper module, eliminating the need for DYC.

Taking sbo2demo1:
New code

Code: [Select]

module o2
  declare sub     ::message alias "message" lib "sbo2"
end module


send="""
  Greetings from ScriptBasic!
""" & chr$(0)

print o2::message(send)
line input w

Original code

Code: [Select]

module dyc
  declare sub     ::dyc alias "dyc" lib "dyc"
end module



send="""
  Greetings from ScriptBasic!
""" & chr$(0)

bufferlength=1000
receive=space(bufferlength)

replylength=dyc::dyc("ms,i,sbo2.dll,message,ZZL",send,receive,bufferlength)
'print replylength
print left(receive,replylength)
line input w

Both Oxygen.dll and sbo2.dll will go into the \scriptbasic\modules directory.

Charles

[JRS]

Thanks Charles.

Can you show me a header / include list of the functions SB will be able to call?

[Charles Pegge]

Something along the lines of:

Code: [Select]

module o2
  declare sub     ::message alias "message" lib "sbo2"
  declare sub     ::compile alias "compile" lib "sbo2"
  declare sub     ::start alias "start" lib "sbo2"
  declare sub     ::stop alias "stop" lib "sbo2"
  declare sub     ::call alias "call" lib "sbo2"
end module

::message is only used for testing

Charles

[JRS]

What access to O2 variables will SB have if a JIT script is run instead of a O2 function call?

If O2 creates an array as a result, will that be returned as a SB array?

What status or control will SB have over a running O2 script?

[Charles Pegge]

This is what I have so far, John. It combines the original sbo2 techniques and extension module techniques for interacting with ScriptBasic.

ScriptBasic

Code: OxygenBasic

1.  
2. module o2
3.   declare sub  ::message alias "message" lib "sbo2"
4.   declare sub  ::compile alias "compile" lib "sbo2"
5.   declare sub  ::start   alias "start"   lib "sbo2"
6.   declare sub  ::fun     alias "fun"     lib "sbo2"
7. end module
8. '
9. src="""
10.  
11.   function finish (sys s,m,p,r)as sys, export
12.   '==========================================
13.  terminate
14.   end function
15.  
16.   function hello(sys s,m,p,r)as sys, export
17.   '========================================
18.  *r=ReturnString(s," Hello World! ")
19.   end function
20.  
21.   function dims alias "dim" (sys s,m,p,r) as sys, export
22.   '=====================================================
23.  sys     i,b,e,pp,qq,pn,pm
24.   string  t
25.   if p then
26.     pn=*(p+8) >> 2
27.   else
28.     return 0
29.   end if
30.   pm=GetParamPtr(p,2)
31.   b=GetLongParam(s,pm)
32.   pm=GetParamPtr(p,3)
33.   e=GetLongParam(s,pm)
34.   if pn>=4
35.     pm=GetParamPtr(p,4)
36.     t=GetStringParam(s,pm)
37.   else
38.     t=""
39.   end if
40.   pp=CreateArray(s,b,e)
41.   *r=pp
42.   '
43.  'FILL ARRAY
44.  '
45.  e-=b
46.   for i= 0 to e
47.     a=ReturnString s,t
48.     qq=*pp+i*sizeof sys
49.     *qq=a
50.   next
51.   end function
52.   '
53.  '
54.  'FUNCTION MAPPING
55.  '================
56.  '
57.  sys funmap[100]
58.   funmap<=@finish,@hello,@dims
59.   sys returns=@funmap
60.  
61. """
62.  
63. 'FUNCTION ENUMERATION:
64. '---------------------
65.  
66. finish=1
67. hello =2
68. dim   =3
69.  
70. 'TEST
71. '----
72.  
73. ers=o2::compile(src)
74.  
75. if (len(ers)>0) then
76.   print ers
77. else
78.   p=o2::start()
79.   s=o2::fun(hello)
80.   'dim, start, end, fillstring
81.  T=o2::fun(dim,1,10,s)
82.   o2::fun(finish)
83.   print T[1] & T[2] & T[3]
84. end if
85.  
86. line input w
87.  

Charles

[JRS]

Outstanding!

Excuse me while I go find my play clothes. 

[JRS]

Charles,

Are running the 32 or 64 bit version of SB for Windows? The Win 8 announcement was the last straw for me doing any future development under that platform. I'm looking for someone to take some ownership in the SB for Windows version. Do you know of any O2 elves looking for something to do off season? 

I'm almost at the point of only offering SB binaries for 64 bit Linux. Everything else, roll your own.

The O2 connection has renewed my interest in Windows (Wine) and I hope will benefit both projects. You are giving the Windows version of ScriptBasic a needed boost.

John

[Charles Pegge]

I'm running 32 bit SB. I will need to study the 64 bit SB at some point. Are the headers different, or have you got 32/64 header compatibility?
All the pointer members will be 8 bytes wide instead of 4 bytes.

I think windows 8 retains the previous APIs. I presume Metro is for small screen devices.

I've made the interface a bit cleaner (and faster using O2 macros). Here is the reworked dim function:

o2 inside sb

Code: OxygenBasic

1.  
2.   function dims alias "dim" (sys s,m,p,r) as sys, export
3.   '=====================================================
4.  sys     i,b,e,pp,qq,pn
5.   string  t
6.   if p then
7.     pn=ParamCount(p)
8.   else
9.     return 0
10.   end if
11.   GetLongPar(b,s,p,2)
12.   GetLongPar(e,s,p,3)
13.   if pn>=4
14.     GetStringPar(t,s,p,4)
15.   else
16.     t=""
17.   end if
18.   CreateArray(pp,s,b,e)
19.   *r=pp
20.   '
21.  'FILL ARRAY
22.  '
23.  e-=b
24.   for i= 0 to e
25.     a=ReturnString s,t
26.     qq=*pp+i*sizeof sys
27.     *qq=a
28.   next
29.   end function
30.   '
31.  

[JRS]

I believe all that was needed for 64 bit was changing the -m32 to -m64. (MinGW32/64 TDM gcc) Armando may have had me add -fPIC but I can't remember.

ScriptBasic Windows 64

The improvements to the SB02 interface looks great. Is this only on your box or on the site for me to play with?

[Charles Pegge]

I've posted the latest to Oxygen-in-progress.

Run sbo2.o2bas to compile sbo2.dll into \scriptbasic\modules\
also copy oxygen.dll into \scriptbasic\modules\
The test code is sbo2demo2.sb

Charles

[JRS]

It seems to be working here. (Wine)

C:\scriptbasic\test>scriba sbo2demo2.sb
 Hello World!  Hello World!  Hello World!

C:\scriptbasic\test>

I think the direction of using O2 macros to replace the SB C macros keeps the concept of the SB extension API intact. The JIT aspect is candy that makes this all worth doing.

[JRS]

Here is my latest DIM for ScriptBasic. Converting an integer to a string ended up using my-itoa (Google code project) to get it working.

DIM(array_var, #_elements, [base_value,] [step,] [increment_value])

Code: [Select]

DECLARE SUB DIM ALIAS "DIM" LIB "cbx"

DIM(a,10,0,2,10)

FOR x = LBOUND(a) TO UBOUND(a)
  PRINT x," = ",a[x],"\n"
NEXT

jrs@laptop:~/sb/test$ scriba extdim.sb
0 = undef
1 = 0
2 = undef
3 = 10
4 = undef
5 = 20
6 = undef
7 = 30
8 = undef
9 = 40
jrs@laptop:~/sb/test$

Code: [Select]

/* Core Extension Library */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "../../basext.h"

typedef struct _ModuleObject {
  void *HandleArray;
}ModuleObject,*pModuleObject;


int my_itoa(int val, char* buf)
{
    const unsigned int radix = 10;

    char* p;
    unsigned int a;        //every digit
    int len;
    char* b;            //start of the digit char
    char temp;
    unsigned int u;

    p = buf;

    if (val < 0)
    {
        *p++ = '-';
        val = 0 - val;
    }
    u = (unsigned int)val;

    b = p;

    do
    {
        a = u % radix;
        u /= radix;

        *p++ = a + '0';

    } while (u > 0);

    len = (int)(p - buf);

    *p-- = 0;

    //swap
    do
    {
        temp = *p;
        *p = *b;
        *b = temp;
        --p;
        ++b;

    } while (b < p);

    return len;
}


besVERSION_NEGOTIATE
  return (int)INTERFACE_VERSION;
besEND


besSUB_START
  pModuleObject p;

  besMODULEPOINTER = besALLOC(sizeof(ModuleObject));
  if( besMODULEPOINTER == NULL )return 0;

  p = (pModuleObject)besMODULEPOINTER;
  return 0;
besEND


besSUB_FINISH
  pModuleObject p;

  p = (pModuleObject)besMODULEPOINTER;
  if( p == NULL )return 0;
  return 0;
besEND

/* DIM(array, elements, [base_value,] [step,] [increment,]) */

besFUNCTION(DIM)
  VARIABLE Argument;
  unsigned long __refcount_;
  LEFTVALUE Lval;
  int x, e, v, s, i, l;
  char str[16];

  besRETURNVALUE = NULL;

  /* Array varable and number of elements are required */
  if( besARGNR < 2 )return EX_ERROR_TOO_FEW_ARGUMENTS;

  /* Number of elements */
  Argument = besARGUMENT(2);
  besDEREFERENCE(Argument);
  e = (int)LONGVALUE(Argument);

  /* Base value */
  Argument = besARGUMENT(3);
  besDEREFERENCE(Argument);
  if( Argument ){
    v = (int)LONGVALUE(Argument);
  }else v = 0;

  /* Step */
  Argument = besARGUMENT(4);
  besDEREFERENCE(Argument);
  if( Argument ){
    s = (int)LONGVALUE(Argument);
  }else s = 1;

  /* Increment */
  Argument = besARGUMENT(5);
  besDEREFERENCE(Argument);
  if( Argument ){
    i = (int)LONGVALUE(Argument);
  }else i = 0;

  /* Passed variable for array creation */
  Argument = besARGUMENT(1);
  besLEFTVALUE(Argument,Lval);
  besRELEASE(*Lval);
  *Lval = NULL;

  *Lval = besNEWARRAY(0, e-1);
  if( *Lval == NULL )return COMMAND_ERROR_MEMORY_LOW;

  for( x = s - 1; ((unsigned)x) < e; x += s){
    l = my_itoa(v, str);
    ARRAYVALUE(*Lval,x) = besNEWSTRING(l);
    memcpy(STRINGVALUE(ARRAYVALUE(*Lval,x)),str,l);
    v = v + i;
    }

besEND

For grins I tried the old school way to initialize a 1 million element array with a zero in each element.

Code: [Select]

FOR x = 0 to 999999
 a[x] = 0
NEXT

After 20 minutes I aborted the test. It took less than a second with the new DIM().

I wondered how long it would take to assign a million elements if the array was already defined.

Code: [Select]

DECLARE SUB DIM ALIAS "DIM" LIB "cbx"

DIM(a,1000000)

FOR x = LBOUND(a) TO UBOUND(a)
  a[x] = x
NEXT

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

real   0m2.978s
user   0m2.508s
sys   0m0.416s
jrs@laptop:~/sb/test$

 

[JRS]

AIR sent me a different approach to converting an integer to a string. I have adapted his method. (Thanks Armando!)

Code: C

1. /* Core Extension Library */
2.  
3. #include <stdio.h>
4. #include <stdlib.h>
5. #include <string.h>
6. #include "../../basext.h"
7.  
8. typedef struct _ModuleObject {
9.   void *HandleArray;
10. }ModuleObject,*pModuleObject;
11.  
12.  
13. besVERSION_NEGOTIATE
14.   return (int)INTERFACE_VERSION;
15. besEND
16.  
17.  
18. besSUB_START
19.   pModuleObject p;
20.  
21.   besMODULEPOINTER = besALLOC(sizeof(ModuleObject));
22.   if( besMODULEPOINTER == NULL )return 0;
23.  
24.   p = (pModuleObject)besMODULEPOINTER;
25.   return 0;
26. besEND
27.  
28.  
29. besSUB_FINISH
30.   pModuleObject p;
31.  
32.   p = (pModuleObject)besMODULEPOINTER;
33.   if( p == NULL )return 0;
34.   return 0;
35. besEND
36.  
37. /* DIM(array, elements, [base_value,] [step,] [increment,]) */
38.  
39. besFUNCTION(DIM)
40.   VARIABLE Argument;
41.   unsigned long __refcount_;
42.   LEFTVALUE Lval;
43.   int x, e, v, s, i, l;
44.   char buf[16];
45.  
46.   besRETURNVALUE = NULL;
47.  
48.   /* Array varable and number of elements are required */
49.   if( besARGNR < 2 )return EX_ERROR_TOO_FEW_ARGUMENTS;
50.  
51.   /* Number of elements */
52.   Argument = besARGUMENT(2);
53.   besDEREFERENCE(Argument);
54.   e = (int)LONGVALUE(Argument);
55.  
56.   /* Base value */
57.   Argument = besARGUMENT(3);
58.   besDEREFERENCE(Argument);
59.   if( Argument ){
60.     v = (int)LONGVALUE(Argument);
61.   }else v = 0;
62.  
63.   /* Step */
64.   Argument = besARGUMENT(4);
65.   besDEREFERENCE(Argument);
66.   if( Argument ){
67.     s = (int)LONGVALUE(Argument);
68.   }else s = 1;
69.  
70.   /* Increment */
71.   Argument = besARGUMENT(5);
72.   besDEREFERENCE(Argument);
73.   if( Argument ){
74.     i = (int)LONGVALUE(Argument);
75.   }else i = 0;
76.  
77.   /* Passed variable for array creation */
78.   Argument = besARGUMENT(1);
79.   besLEFTVALUE(Argument,Lval);
80.   besRELEASE(*Lval);
81.   *Lval = NULL;
82.  
83.   *Lval = besNEWARRAY(0, e-1);
84.   if( *Lval == NULL )return COMMAND_ERROR_MEMORY_LOW;
85.  
86.   for( x = s - 1; ((unsigned)x) < e; x += s){
87.     l = snprintf(buf,strlen(buf)+1,"%d",v);
88.     ARRAYVALUE(*Lval,x) = besNEWSTRING(l);
89.     memcpy(STRINGVALUE(ARRAYVALUE(*Lval,x)),buf,l);
90.     v = v + i;
91.     }
92.  
93. besEND
94.  

[JRS]

I was wondering if I could assign a number rather then a string representation of it which should make the DIM more efficient. Good News!

Code: C

1.   for( x = s - 1; ((unsigned)x) < e; x += s){
2.     ARRAYVALUE(*Lval,x) = besNEWLONG;
3.     LONGVALUE(ARRAYVALUE(*Lval,x)) = v;
4.     v = v + i;
5.     }
6.  

The test.

Code: [Select]

DECLARE SUB DIM ALIAS "DIM" LIB "cbx"

DIM(a,1000000)

FOR x = 0 TO 999999
  a[x] = x
NEXT

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

real   0m1.797s
user   0m1.612s
sys   0m0.112s
jrs@laptop:~/sb/test$

• Load scriba from disk
• Initialize interpreter
• Load script
• Parse  / tokenize script
• Load shared object from disk
• Call DIM function to allocate and initialize a SB array (1 million elements)
• Update each element with the current iteration value of the FOR/NEXT
• Free all memory and unload shared object
• return to OS

I have attached a Linux 64 bit version and a Win32 version of the CBX (DIM) extension module.

[JRS]

I added a few more functions to the CBX extension module and will attached the shared objects for Win32 and Linux 64. (soon)

CBX Test Program

Code: [Select]

' DIM Test

DECLARE SUB DIM ALIAS "DIM" LIB "cbx"

DIM(a,1000000)

FOR x = 0 TO 999999
  a[x] = x
NEXT

PRINT a[UBOUND(a)],"\n\n"


' Str2File Test

DECLARE SUB Str2File ALIAS "str2file" LIB "cbx"

text = "CBX Text String\n\n"

Str2File("cbxtestfile", text)


' File2Str Test

DECLARE SUB File2str ALIAS "file2str" LIB "cbx"

PRINT File2Str("cbxtestfile")


' VARPTR Test

DECLARE SUB VARPTR ALIAS "varptr" LIB "cbx"

z = "zzz..."
PRINT VARPTR(z),"\n"

jrs@laptop:~/sb/test$ scriba cbxtest.sb
999999

CBX Text String

121797992
jrs@laptop:~/sb/test$


CBX Extension Module

Code: C

1. /* Core Extension Library */
2.  
3. #include <stdio.h>
4. #include <stdlib.h>
5. #include <string.h>
6. #include "../../basext.h"
7.  
8. typedef struct _ModuleObject {
9.   void *HandleArray;
10. }ModuleObject,*pModuleObject;
11.  
12.  
13. besVERSION_NEGOTIATE
14.   return (int)INTERFACE_VERSION;
15. besEND
16.  
17.  
18. besSUB_START
19.   pModuleObject p;
20.  
21.   besMODULEPOINTER = besALLOC(sizeof(ModuleObject));
22.   if( besMODULEPOINTER == NULL )return 0;
23.  
24.   p = (pModuleObject)besMODULEPOINTER;
25.   return 0;
26. besEND
27.  
28.  
29. besSUB_FINISH
30.   pModuleObject p;
31.  
32.   p = (pModuleObject)besMODULEPOINTER;
33.   if( p == NULL )return 0;
34.   return 0;
35. besEND
36.  
37. /* DIM(array, elements, [base_value,] [step,] [increment,]) */
38.  
39. besFUNCTION(DIM)
40.   VARIABLE Argument;
41.   unsigned long __refcount_;
42.   LEFTVALUE Lval;
43.   int x, e, v, s, i, l;
44.  
45.   besRETURNVALUE = NULL;
46.  
47.   /* Array varable and number of elements are required */
48.   if( besARGNR < 2 )return EX_ERROR_TOO_FEW_ARGUMENTS;
49.  
50.   /* Number of elements */
51.   Argument = besARGUMENT(2);
52.   besDEREFERENCE(Argument);
53.   e = (int)LONGVALUE(Argument);
54.  
55.   /* Base value */
56.   Argument = besARGUMENT(3);
57.   besDEREFERENCE(Argument);
58.   if( Argument ){
59.     v = (int)LONGVALUE(Argument);
60.   }else v = 0;
61.  
62.   /* Step */
63.   Argument = besARGUMENT(4);
64.   besDEREFERENCE(Argument);
65.   if( Argument ){
66.     s = (int)LONGVALUE(Argument);
67.   }else s = 1;
68.  
69.   /* Increment */
70.   Argument = besARGUMENT(5);
71.   besDEREFERENCE(Argument);
72.   if( Argument ){
73.     i = (int)LONGVALUE(Argument);
74.   }else i = 0;
75.  
76.   /* Passed variable for array creation */
77.   Argument = besARGUMENT(1);
78.   besLEFTVALUE(Argument,Lval);
79.   besRELEASE(*Lval);
80.   *Lval = NULL;
81.  
82.   *Lval = besNEWARRAY(0, e-1);
83.   if( *Lval == NULL )return COMMAND_ERROR_MEMORY_LOW;
84.  
85.   for( x = s - 1; ((unsigned)x) < e; x += s){
86.     ARRAYVALUE(*Lval,x) = besNEWLONG;
87.     LONGVALUE(ARRAYVALUE(*Lval,x)) = v;
88.     v = v + i;
89.     }
90.  
91. besEND
92.  
93. /* Opens a file, reads it's content and returns it into a new string variable */
94.  
95. besFUNCTION(file2str)
96.   VARIABLE Argument;
97.   char *pszFileName;
98.   unsigned long cbString;
99.   FILE *fp;
100.  
101.   if( besARGNR < 1 )return COMMAND_ERROR_MANDARG;
102.  
103.   Argument = besARGUMENT(1);
104.   besDEREFERENCE(Argument);
105.   Argument = besCONVERT2STRING(Argument);
106.   besCONVERT2ZCHAR(Argument,pszFileName);
107.  
108.   cbString = besHOOK_SIZE(pszFileName);
109.   besRETURNVALUE = besNEWMORTALSTRING(cbString);
110.   if( besRETURNVALUE == NULL ){
111.     besFREE(pszFileName);
112.     return COMMAND_ERROR_MEMORY_LOW;
113.     }
114.  
115.   fp = besHOOK_FOPEN(pszFileName,"rb");
116.   if( fp == NULL ){
117.     besFREE(pszFileName);
118.     return COMMAND_ERROR_FILE_CANNOT_BE_OPENED;
119.     }
120.   besHOOK_FREAD(STRINGVALUE(besRETURNVALUE),1,cbString,fp);
121.   besHOOK_FCLOSE(fp);
122.  
123.   besFREE(pszFileName);
124.  
125. besEND
126.  
127.  
128. besFUNCTION(str2file)
129.   VARIABLE Argument;
130.   unsigned char *pszString;
131.   char *pszFileName;
132.   unsigned long cbString;
133.   FILE *fp;
134.  
135.   if( besARGNR < 2 )return COMMAND_ERROR_MANDARG;
136.  
137.   Argument = besARGUMENT(1);
138.   besDEREFERENCE(Argument);
139.   Argument = besCONVERT2STRING(Argument);
140.   besCONVERT2ZCHAR(Argument,pszFileName);
141.  
142.   Argument = besARGUMENT(2);
143.   besDEREFERENCE(Argument);
144.   Argument = besCONVERT2STRING(Argument);
145.  
146.   pszString = STRINGVALUE(Argument);
147.   cbString = STRLEN(Argument);
148.   fp = besHOOK_FOPEN(pszFileName,"wb");
149.   if( fp == NULL ){
150.     besFREE(pszFileName);
151.     return COMMAND_ERROR_FILE_CANNOT_BE_OPENED;
152.     }
153.   besHOOK_FWRITE(pszString,1,cbString,fp);
154.   besHOOK_FCLOSE(fp);
155.  
156.   besFREE(pszFileName);
157.  
158. besEND
159.  
160. /* Returns a pointer to a ScriptBasic variable */
161.  
162. besFUNCTION(varptr)
163.   VARIABLE ptr;
164.        
165.   if(besARGNR>1) return EX_ERROR_TOO_MANY_ARGUMENTS;
166.   if(besARGNR<1) return EX_ERROR_TOO_FEW_ARGUMENTS;
167.        
168.   besALLOC_RETURN_LONG 
169.  
170.   ptr = besARGUMENT(1);
171.   besDEREFERENCE(ptr);
172.  
173.   LONGVALUE(besRETURNVALUE) = (int)ptr;
174.  
175. besEND
176.  
177.  
178. START_FUNCTION_TABLE(CBX_SLFST)
179.  
180.   EXPORT_MODULE_FUNCTION(versmodu)
181.   EXPORT_MODULE_FUNCTION(bootmodu)
182.   EXPORT_MODULE_FUNCTION(finimodu)
183.   EXPORT_MODULE_FUNCTION(DIM)
184.   EXPORT_MODULE_FUNCTION(file2str)
185.   EXPORT_MODULE_FUNCTION(str2file)
186.   EXPORT_MODULE_FUNCTION(varptr)
187.  
188. END_FUNCTION_TABLE
189.  

I'm going to try and put a small demo together showing how to use the VARPTR function and DYC module to create a PEEK and POKE function.