Oxygen Basic

Programming => Example Code => General => Topic started by: Charles Pegge on May 15, 2012, 09:42:58 PM

Title: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 15, 2012, 09:42:58 PM

Further Developments: to the test module:  projects/scriptbasic/mdlt

Parameters can be both passed and returned (pseudo-Byref). It is written entirely in Basic, Assembler  was not required in  this update.

The demo requires a full installation of ScriptBasic. The compiled module must be copied into then modules directory.

Test Script (ScriptBasic)

Code: [Select]


  declare sub trial alias "trial" lib "mdlt"

  a=12345+0.67
  b="HELLO"
  c=8
  d=9

  print "Sent params:    " & b & "  " & a  & "  " & c & "  " & d & "\n"
  print trial(a,b,c,d)
  print "Altered params: " & b & "  " & a  & "  " & c & "  " & d & "\n"
  line input w
Source code for MDLT (OxygenBasic)

Code: [Select]


  'extension module for ScriptBasic

  '23:02 11/05/2011
  '17:25 15/05/2012
  '
  'Charles Pegge


  '#file "mdlt.dll"
  '
  $ dll
  $ Filename "mdlt.dll"
  include  "..\..\inc\RTL32.inc"


  function GetStringParam(sys pst,pm) as string
  '============================================
  sys c,p
  c=*(pst+0xf4)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  zstring pz at *p
  return pz
  end function


  function PutStringParam(sys pst,pm,string s)
  '===========================================
  sys c,p
  c=*(pst+0xf4)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  zstring pz at *p
  pz=s
  end function


  function GetLongParam(sys pst,pm) as long
  '========================================
  sys c,p
  c=*(pst+0xf8)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  return *p
  end function


  function PutLongParam(sys pst,pm, sys v)
  '=======================================
  sys c,p
  c=*(pst+0xf8)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  *p=v
  end function


  function GetDoubleParam(sys pst,pm) as double
  '============================================
  sys c,p
  c=*(pst+0xfc)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  double pd at p
  return pd
  end function


  function PutDoubleParam(sys pst,pm,double d)
  '===========================================
  sys c,p
  c=*(pst+0xfc)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  double pd at p
  pd=d
  end function


  sub ReturnString(sys pst,pRetVal,string s)
  '=========================================
  sys c,p,ls
  ls=len(s)
  c=*(pst+0x0c)
  p=*pst
  p=call c *(p+0x94),ls , *(p+0x8c)
  *pRetVal=p
  copy *p,strptr s,ls
  end sub


  sub ReturnLong(sys pst,pRetVal,Long v)
  '=====================================
  sys c,p
  c=*(pst+0x10)
  p=*pst
  p=call c *(p+0x94), *(p+0x8c)
  *pRetVal=p
  long pv at p
  pv=v
  '
  'mov ecx,pst : mov eax,[ecx] : push [eax+0x8c] : push [eax+0x94] : call [ecx+0x10]
  'mov ecx,pReturnValue : mov [ecx],eax : mov edx,v : mov [eax],edx
  ''
  end sub


  sub ReturnDouble(sys pst,pRetVal,double d)
  '=========================================
  sys c,p
  c=*(pst+0x18)
  p=*pst
  p=call c *(p+0x94), *(p+0x8c)
  *pRetVal=p
  double pd at p
  pd=d
  end sub


  function GetParamPtr(sys pParams, pn) as sys
  '===========================================
  return *(*pParams+pn*4-4) 'pointer to parameter
  end function
 



  function versmodu cdecl (sys Version, pszVariation, ppModuleInternal) as sys export
  '==================================================================================
  'print "Version: " hex version
  return Version
  end function


  function bootmodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
  '===========================================================================================
  'print "Boot!"
  end function



  function finimodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
  '===========================================================================================
  'print "Finish!"
  end function


  function trial cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
  '========================================================================================
  sys    w,pm,pn
  string cr=chr(13)+chr(10)
  '
  sys    v
  string pr
  double d
  '
  if pParameters then
    '
    'HOW MANY ARGUMENTS GIVEN
    '------------------------
    '
    w=*(pParameters+8) >> 2
    '
    'print "No of Arguments given: " w
    '
    'PARAM pn
    '--------
    '
    'pParameters->Value.aValue[(X)-1]
    '
    for pn=1 to w
      '
      'index base 1
      '
      pm=GetParamPtr(pparameters,pn)
      pr+= "As String:  " GetStringParam(pst,pm) + cr +
           "As Long:    " GetLongParam(pst,pm)   + cr +
           "As Double:  " GetDoubleParam(pst,pm) + cr +
      cr
    next
    '
    pm=GetParamPtr(pParameters,1)
    PutDoubleParam(pst,pm,1111.11)
    pm=GetParamPtr(pParameters,2)
    PutStringParam(pst,pm,"hello")
    pm=GetParamPtr(pParameters,3)
    PutLongParam(pst,pm,3)
    pm=GetParamPtr(pParameters,4)
    PutLongParam(pst,pm,4)
    '
  else
    'noparams
  end if
  '
  'ReturnLong(pst,pReturnValue,1234.5)
  'ReturnDouble(pst,pReturnValue,1.234.5)
  ReturnString(pst,pReturnValue,"From Oxygen:"+cr+cr+pr)
  '
  end function


This is included in the latest Oxygen-in-progress.

Charles

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 16, 2012, 10:45:45 AM

WOW!

Thanks Charles for the SB update. I will be sure to give it a try.

Quote

  '23:02 11/05/2011
  '17:25 15/05/2012

Feels like I just got a Birthday present.  ::)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 17, 2012, 12:35:03 AM

Charles,

I thought a SQLite3 extension module using O2 would be a good example. The problem is that I need to return an SB array and an associative array for FetchArray() and FetchHash() in a BYREF argument. Check out the MySQL extension module for a working example written in C.

If we can get the SQLite3 extension module working, IUP would be the next logical step.

John

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 17, 2012, 03:07:15 AM

This is all I know about sqLite so far.

Oxygen

Code: OxygenBasic

1.  
2.   extern lib "sqlite3.dll"
3.  
4.   sys   sqlite3_open (char*name,sys*db)
5.   sys   sqlite3_exec (sys db,char* s, sys p1, sys p2, sys*dberr)
6.   sys   sqlite3_prepare_v2 (sys db, char*s, sys p1, sys*stmt, sys p2)
7.   sys   sqlite3_step (sys n)
8.   char* sqlite3_column_text (sys row, sys col)
9.   sys   sqlite3_close (sys db)
10.   '
11.  end extern
12.   '
13.  sys SQLITE_ROW = 100
14.   sys hdb
15.   sys dberr
16.   sys stmt
17.   '
18.  char *  errmsg
19.   string  cr=chr(13)+chr(10)
20.   string  pr="DataBase Listing:" cr
21.   '
22.  sqlite3_open "testsql",hdb
23.   '
24.  sqlite3_exec hdb, "CREATE TABLE demo(someval INTEGER,  sometxt TEXT);", 0, 0, dberr
25.   sqlite3_exec hdb, "INSERT INTO demo VALUES (123, 'Hello');", 0, 0, dberr
26.  sqlite3_exec hdb, "INSERT INTO demo VALUES (234, 'cruel');", 0, 0, dberr
27.  sqlite3_exec hdb, "INSERT INTO demo VALUES (345, 'world');", 0, 0, dberr
28.  '
29.  result = sqlite3_prepare_v2 hdb, "SELECT * FROM demo;" cr, -1, stmt, 0
30.   '
31.  if dberr then @errmsg=dberr : print errmsg
32.   '
33.  while sqlite3_step(stmt) = SQLITE_ROW
34.     pr+=sqlite3_column_text(stmt, 0) " - " sqlite3_column_text(stmt, 1) cr
35.   wend
36.   '
37.  sqlite3_close hdb
38.  
39.   print pr
40.  

Charles

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 17, 2012, 07:47:25 PM

Here is a ScriptBasic module built around this example:

ScriptBasic Test

Code: [Select]


  declare sub SQLite3_Demo        alias "sqlite3_demo"        lib "sqlite3_mdl"
  declare sub SQLite3_ErrMsg      alias "sqlite3_errmsg"      lib "sqlite3_mdl"
  declare sub SQLite3_Open        alias "sqlite3_open"        lib "sqlite3_mdl"
  declare sub SQLite3_Close       alias "sqlite3_close"       lib "sqlite3_mdl"
  declare sub SQLite3_Exec        alias "sqlite3_exec"        lib "sqlite3_mdl"
  declare sub SQLite3_Prepare_v2  alias "sqlite3_prepare_v2"  lib "sqlite3_mdl"
  declare sub SQLite3_Step        alias "sqlite3_step"        lib "sqlite3_mdl"
  declare sub SQLite3_Column_Text alias "sqlite3_column_text" lib "sqlite3_mdl"

  SQLITE_ROW = 100

  'print SQLite3_Demo()

  hdb=0
  dberr=0
  stmt=0
  pr="DataBase Listing:\n"
  result=0
  '
  sqlite3_open("testsql",hdb)
  '
  sqlite3_exec (hdb, "CREATE TABLE demo(someval INTEGER,  sometxt TEXT);", 0, 0, dberr)
  sqlite3_exec (hdb, "INSERT INTO demo VALUES (123, 'Hello');", 0, 0, dberr)
  sqlite3_exec (hdb, "INSERT INTO demo VALUES (234, 'cruel');", 0, 0, dberr)
  sqlite3_exec (hdb, "INSERT INTO demo VALUES (345, 'world');", 0, 0, dberr)
  '
  result = sqlite3_prepare_v2 (hdb, "SELECT * FROM demo;", -1, stmt, 0)
  '
  if dberr then
    print SQLite3_ErrMsg(dberr) & "\n"
  endif
  '
  while (sqlite3_step(stmt) = SQLITE_ROW)
    pr=pr & sqlite3_column_text(stmt, 0) & " - " & sqlite3_column_text(stmt, 1) & "\n"
  wend
  '
  sqlite3_close(hdb)

  print pr
  line input w

sqlite3_mdl

Code: OxygenBasic

1.  
2.   'extension module for ScriptBasic
3.  
4.   '04:43 18/05/2012
5.  '
6.  'Charles Pegge
7.  
8.  
9.   '#file "sqlite3_mdl.dll"
10.  '
11.  $ dll
12.   $ Filename "sqlite3_mdl.dll"
13.   include  "..\..\inc\RTL32.inc"
14.  
15.  
16.   function GetStringParam(sys pst,pm) as string
17.   '============================================
18.  sys c,p
19.   c=*(pst+0xf4)
20.   p=*pst
21.   p=call c p, pm, *(p+0x8c)
22.   zstring pz at *p
23.   return pz
24.   end function
25.  
26.  
27.   function PutStringParam(sys pst,pm,string s)
28.   '===========================================
29.  sys c,p
30.   c=*(pst+0xf4)
31.   p=*pst
32.   p=call c p, pm, *(p+0x8c)
33.   zstring pz at *p
34.   pz=s
35.   end function
36.  
37.  
38.   function GetLongParam(sys pst,pm) as long
39.   '========================================
40.  sys c,p
41.   c=*(pst+0xf8)
42.   p=*pst
43.   p=call c p, pm, *(p+0x8c)
44.   return *p
45.   end function
46.  
47.  
48.   function PutLongParam(sys pst,pm, sys v)
49.   '=======================================
50.  sys c,p
51.   c=*(pst+0xf8)
52.   p=*pst
53.   p=call c p, pm, *(p+0x8c)
54.   *p=v
55.   end function
56.  
57.  
58.   function GetDoubleParam(sys pst,pm) as double
59.   '============================================
60.  sys c,p
61.   c=*(pst+0xfc)
62.   p=*pst
63.   p=call c p, pm, *(p+0x8c)
64.   double pd at p
65.   return pd
66.   end function
67.  
68.  
69.   function PutDoubleParam(sys pst,pm,double d)
70.   '===========================================
71.  sys c,p
72.   c=*(pst+0xfc)
73.   p=*pst
74.   p=call c p, pm, *(p+0x8c)
75.   double pd at p
76.   pd=d
77.   end function
78.  
79.  
80.   sub ReturnString(sys pst,pRetVal,string s)
81.   '=========================================
82.  sys c,p,ls
83.   ls=len(s)
84.   c=*(pst+0x0c)
85.   p=*pst
86.   p=call c *(p+0x94),ls , *(p+0x8c)
87.   *pRetVal=p
88.   copy *p,strptr s,ls
89.   end sub
90.  
91.  
92.   sub ReturnLong(sys pst,pRetVal,Long v)
93.   '=====================================
94.  sys c,p
95.   c=*(pst+0x10)
96.   p=*pst
97.   p=call c *(p+0x94), *(p+0x8c)
98.   *pRetVal=p
99.   long pv at p
100.   pv=v
101.   '
102.  'mov ecx,pst : mov eax,[ecx] : push [eax+0x8c] : push [eax+0x94] : call [ecx+0x10]
103.  'mov ecx,pReturnValue : mov [ecx],eax : mov edx,v : mov [eax],edx
104.  ''
105.  end sub
106.  
107.  
108.   sub ReturnDouble(sys pst,pRetVal,double d)
109.   '=========================================
110.  sys c,p
111.   c=*(pst+0x18)
112.   p=*pst
113.   p=call c *(p+0x94), *(p+0x8c)
114.   *pRetVal=p
115.   double pd at p
116.   pd=d
117.   end sub
118.  
119.  
120.   function GetParamPtr(sys pParams, pn) as sys
121.   '===========================================
122.  return *(*pParams+pn*4-4) 'pointer to parameter
123.  end function
124.  
125.  
126.  
127.  
128.   function versmodu cdecl (sys Version, pszVariation, ppModuleInternal) as sys export
129.   '==================================================================================
130.  'print "Version: " hex version
131.  return Version
132.   end function
133.  
134.  
135.   function bootmodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
136.   '===========================================================================================
137.  'print "Boot!"
138.  end function
139.  
140.  
141.  
142.   function finimodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
143.   '===========================================================================================
144.  'print "Finish!"
145.  end function
146.  
147.  
148.   function trial cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
149.   '========================================================================================
150.  sys    w,pm,pn
151.   string cr=chr(13)+chr(10)
152.   '
153.  sys    v
154.   string pr
155.   double d
156.   '
157.  if pParameters then
158.     '
159.    'HOW MANY ARGUMENTS GIVEN
160.    '------------------------
161.    '
162.    w=*(pParameters+8) >> 2
163.     '
164.    'print "No of Arguments given: " w
165.    '
166.    'PARAM pn
167.    '--------
168.    '
169.    'pParameters->Value.aValue[(X)-1]
170.    '
171.    for pn=1 to w
172.       '
173.      'index base 1
174.      '
175.      pm=GetParamPtr(pparameters,pn)
176.       pr+= "As String:  " GetStringParam(pst,pm) + cr +
177.            "As Long:    " GetLongParam(pst,pm)   + cr +
178.            "As Double:  " GetDoubleParam(pst,pm) + cr +
179.       cr
180.     next
181.     '
182.    pm=GetParamPtr(pParameters,1)
183.     PutDoubleParam(pst,pm,1111.11)
184.     pm=GetParamPtr(pParameters,2)
185.     PutStringParam(pst,pm,"hello")
186.     pm=GetParamPtr(pParameters,3)
187.     PutLongParam(pst,pm,3)
188.     pm=GetParamPtr(pParameters,4)
189.     PutLongParam(pst,pm,4)
190.     '
191.  else
192.     'noparams
193.  end if
194.   '
195.  'ReturnLong(pst,pReturnValue,1234.5)
196.  'ReturnDouble(pst,pReturnValue,1.234.5)
197.  ReturnString(pst,pReturnValue,"From Oxygen:"+cr+cr+pr)
198.   '
199.  end function
200.  
201.  
202.   '============
203.  
204.  
205.   'needs SQLite3.dll
206.  '
207.  'SQLITE_API int sqlite3_open(
208.  '  const char *filename,   /* Database filename (UTF-8) */
209.  '  sqlite3 **ppDb          /* OUT: SQLite db handle */
210.  ');
211.  '
212.  '
213.  'SQLITE_API int sqlite3_exec(
214.  'sqlite3*,                                  /* An open database */
215.  'const char *sql,                           /* SQL to be evaluated */
216.  'int (*callback)(void*,int,char**,char**),  /* Callback function */
217.  'void *,                                    /* 1st argument to callback */
218.  'char **errmsg                              /* Error msg written here */
219.  ');
220.  '
221.  '
222.  'SQLITE_API int sqlite3_prepare_v2(
223.  '  sqlite3 *db,            /* Database handle */
224.  '  const char *zSql,       /* SQL statement, UTF-8 encoded */
225.  '  int nByte,              /* Maximum length of zSql in bytes. */
226.  '  sqlite3_stmt **ppStmt,  /* OUT: Statement handle */
227.  '  const char **pzTail     /* OUT: Pointer to unused portion of zSql */
228.  ');
229.  '
230.  '
231.  'SQLITE_API int sqlite3_step(sqlite3_stmt*);
232.  '
233.  '
234.  'SQLITE_API const unsigned char *sqlite3_column_text(sqlite3_stmt*, int iCol);
235.  '
236.  '
237.  'SQLITE_API int sqlite3_close(sqlite3 *);
238.  '
239.  '
240.  
241.   extern lib "sqlite3.dll"
242.  
243.   sys   sqlite3_open (char*name,sys*db)
244.   sys   sqlite3_exec (sys db,char* s, sys p1, sys p2, sys*dberr)
245.   sys   sqlite3_prepare_v2 (sys db, char*s, sys p1, sys*stmt, sys p2)
246.   sys   sqlite3_step (sys n)
247.   char* sqlite3_column_text (sys row, sys col)
248.   sys   sqlite3_close (sys db)
249.   '
250.  end extern
251.   '
252.  % SQLITE_ROW = 100
253.  
254.  
255.   function sqlite3_demo cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
256.   '================================================================================================
257.  sys hdb
258.   sys dberr
259.   sys stmt
260.   '
261.  char *  errmsg
262.   string  cr=chr(13)+chr(10)
263.   string  pr="DataBase Listing:" cr
264.   '
265.  sqlite3_open "testsql",hdb
266.   '
267.  sqlite3_exec hdb, "CREATE TABLE demo(someval INTEGER,  sometxt TEXT);", 0, 0, dberr
268.   sqlite3_exec hdb, "INSERT INTO demo VALUES (123, 'Hello');", 0, 0, dberr
269.  sqlite3_exec hdb, "INSERT INTO demo VALUES (234, 'cruel');", 0, 0, dberr
270.  sqlite3_exec hdb, "INSERT INTO demo VALUES (345, 'world');", 0, 0, dberr
271.  '
272.  result = sqlite3_prepare_v2 hdb, "SELECT * FROM demo;" cr, -1, stmt, 0
273.   '
274.  if dberr then @errmsg=dberr : print errmsg
275.   '
276.  while sqlite3_step(stmt) = SQLITE_ROW
277.     pr+=sqlite3_column_text(stmt, 0) " - " sqlite3_column_text(stmt, 1) cr
278.   wend
279.   '
280.  sqlite3_close hdb
281.  
282.   ReturnString(pst,pReturnValue,pr)
283.  
284.   end function
285.  
286.  
287.  
288.   function sqlite3_errmsg cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
289.   '==================================================================================================
290.  sys    dberror
291.   char   errmsg at dberror
292.   sys np,pm
293.   '
294.  if pParameters then
295.     np=*(pParameters+8) >> 2
296.     pm=GetParamPtr(pparameters,1)
297.     dberror=GetLongParam(pst,pm)
298.   else
299.     'noparams
300.  end if
301.   '
302.  ReturnString(pst,pReturnValue,errmsg)
303.   '
304.  end function
305.  
306.  
307.   function sqlite3_open cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
308.   '================================================================================================
309.  string namedb
310.   sys    hdb,rtn
311.   sys np,pm
312.   '
313.  if pParameters then
314.     np=*(pParameters+8) >> 2
315.     pm=GetParamPtr(pparameters,1)
316.     namedb=GetStringParam(pst,pm)
317.     rtn=sqlite3_open namedb,hdb
318.     pm=GetParamPtr(pParameters,2)
319.     PutLongParam(pst,pm,hdb)
320.   else
321.     'noparams
322.  end if
323.   '
324.  ReturnLong(pst,pReturnValue,rtn)
325.   '
326.  end function
327.  
328.  
329.   function sqlite3_close cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
330.   '================================================================================================
331.  sys    hdb,rtn
332.   sys np,pm
333.   '
334.  if pParameters then
335.     np=*(pParameters+8) >> 2
336.     pm=GetParamPtr(pparameters,1)
337.     hdb=GetLongParam(pst,pm)
338.     rtn=sqlite3_close hdb
339.   else
340.     'noparams
341.  end if
342.   '
343.  ReturnLong(pst,pReturnValue,rtn)
344.   '
345.  end function
346.  
347.  
348.   function sqlite3_exec cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
349.   '================================================================================================
350.  sys    hdb,rtn
351.   string instruct
352.   sys    dberr
353.   sys np,pm
354.   '
355.  if pParameters then
356.     np=*(pParameters+8) >> 2
357.     pm=GetParamPtr(pparameters,1)
358.     hdb=GetLongParam(pst,pm)
359.     pm=GetParamPtr(pparameters,2)
360.     instruct=GetStringParam(pst,pm)
361.     rtn=sqlite3_exec hdb, instruct, 0, 0, dberr
362.     pm=GetParamPtr(pParameters,5)
363.     PutLongParam(pst,pm,dberr)  
364.   else
365.     'noparams
366.  end if
367.   '
368.  ReturnLong(pst,pReturnValue,rtn)
369.   '
370.  end function
371.  
372.  
373.  
374.   function sqlite3_prepare_v2 cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
375.   '======================================================================================================
376.  sys    hdb
377.   string instruct
378.   sys    statement
379.   sys    result
380.   sys np,pm
381.   '
382.  if pParameters then
383.     np=*(pParameters+8) >> 2
384.     pm=GetParamPtr(pparameters,1)
385.     hdb=GetLongParam(pst,pm)
386.     pm=GetParamPtr(pparameters,2)
387.     instruct=GetStringParam(pst,pm)
388.     result = sqlite3_prepare_v2 hdb, instruct, -1, statement, 0
389.     pm=GetParamPtr(pparameters,4)
390.     PutLongParam(pst,pm,statement)
391.   else
392.     'noparams
393.  end if
394.   '
395.  ReturnLong(pst,pReturnValue,result)
396.   '
397.  end function
398.  
399.  
400.  
401.   function sqlite3_step cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
402.   '================================================================================================
403.  sys    statement
404.   sys    result
405.   sys np,pm
406.   '
407.  if pParameters then
408.     np=*(pParameters+8) >> 2
409.     pm=GetParamPtr(pparameters,1)
410.     statement=GetLongParam(pst,pm)
411.     result=sqlite3_step(statement)
412.   else
413.     'noparams
414.  end if
415.   '
416.  ReturnLong(pst,pReturnValue,result)
417.   '
418.  end function
419.  
420.  
421.   function sqlite3_column_text cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
422.   '=======================================================================================================
423.  sys    statement
424.   string text
425.   sys    field
426.   sys np,pm
427.   '
428.  if pParameters then
429.     np=*(pParameters+8) >> 2
430.     pm=GetParamPtr(pparameters,1)
431.     statement=GetLongParam(pst,pm)
432.     pm=GetParamPtr(pparameters,2)
433.     field=GetLongParam(pst,pm)
434.     text=sqlite3_column_text(statement, field)
435.   else
436.     'noparams
437.  end if
438.   '
439.  ReturnString(pst,pReturnValue,text)
440.   '
441.  end function
442.  
443.  
444.  

Charles

DLL attached:

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 17, 2012, 09:07:24 PM

This is a very exciting development. Users of ScriptBasic can now use OxygenBasic to create DLL based extension modules. This was traditionally reserved for C programmers due to the heavy use of macros in the SB extension module API.

I'm going to give this a try in my XP VirtualBox. (Wine next ...)

Thank You !!!

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 18, 2012, 12:19:00 PM

Charles,

I really need support for SB arrays in the extension module interface. I also need to be able to pass these arrays back to SB in one of the functions augments. Please look at FetchHash() and FetchArray() in the MySQL extension module and maybe those array support macros could be made into O2 functions.

John

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 18, 2012, 01:47:32 PM

I tried your SQLite3 extension module with SB3 (MinGW32 compiled version) and it worked fine.


C:\scriptbasic\test>scriba sqlite3test.sb
DataBase Listing:
123 - Hello
234 - cruel
345 - world


C:\scriptbasic\test>

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 18, 2012, 02:31:00 PM

Good news, John. I'll investigate arrays now.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 18, 2012, 03:52:04 PM

Thanks!

Could you also look at ReturnPTR as I use that for IUP to pass the control ID.

This is not the same as ReturnLong. (SB long integer)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 19, 2012, 04:08:59 AM

Hi John,
I need to know how you populate a mortal array with values. What macros do you use? I'm stuck here.

PS: Thanks for your IUP code. The macro I am looking for is:

ARRAYVALUE(*Lval,i)

Code: [Select]

 for (i = 0; i < n; i++) {
    ARRAYVALUE(*Lval,i) = besNEWSTRING(strlen(names[i]));
    memcpy(STRINGVALUE(ARRAYVALUE(*Lval,i)), names[i], strlen(names[i]));
    }

PS: Good. I've cracked it for single dimensional arrays :)

You can return the whole array to scriptbasic as a return value

Code: [Select]


  T=trial(a,b,x,y)
  't[1]=123
  print T[0] & T[1] & T[2] & T[3] & T[4]

my mdlt code (Oxygen)

Code: [Select]

 p=CreateArray(pst,pReturnValue,0,16)
  for i=0 to 16
    ReturnString(pst,@a,"Val:"+str(i*10+1))
    q=*p+i*4
    *q=a
  next
  *pReturnValue=p


Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 19, 2012, 07:06:03 AM

Charles,

Here is the INFO IUP function I created to return IUP system status constants in a SB associative array.

Code: [Select]

besFUNCTION(PuiInfo)
  VARIABLE Argument;
  unsigned long __refcount_;
  LEFTVALUE Lval;
  char buffer[1024];
  int i;
  const char *glbvar[] = {
  "SYSTEMLANGUAGE",
  "DRIVER",
  "SYSTEM",
  "SYSTEMLOCALE",
  "COMPUTERNAME",
  "USERNAME",
  "MONITORSINFO",
  "SCREENSIZE",
  "SCREENDEPTH",
  "VIRTUALSCREEN",
  "DLGFGCOLOR",
  "DLGBGCOLOR",
  "DEFAULTFONT",
  "DEFAULTFONTSIZE",
  "TXTFGCOLOR",
  "TXTBGCOLOR"
  };
 
  besRETURNVALUE = NULL;

  Argument = besARGUMENT(1);
  besLEFTVALUE(Argument,Lval);
  besRELEASE(*Lval);
  *Lval = NULL;

  *Lval = besNEWARRAY(0,ELEMENTS(glbvar)*2-1);
  if( *Lval == NULL )return COMMAND_ERROR_MEMORY_LOW;

  for (i =0; i < ELEMENTS(glbvar);i++) {
    ARRAYVALUE(*Lval,2*i) = besNEWSTRING(strlen(glbvar[i]));
    memcpy(STRINGVALUE(ARRAYVALUE(*Lval,2*i)),glbvar[i],strlen(glbvar[i]));
    memset(buffer,0,1024);
    strcpy(buffer, IupGetGlobal(glbvar[i]));
    ARRAYVALUE(*Lval,2*i+1) = besNEWSTRING(strlen(buffer));
    memcpy(STRINGVALUE(ARRAYVALUE(*Lval,2*i+1)),buffer,strlen(buffer));
  }

  besALLOC_RETURN_LONG;
  LONGVALUE(besRETURNVALUE) = -1;
besEND

Here (http://www.scriptbasic.org/forum/index.php/topic,237.msg739.html#msg739) is an example of it working.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 19, 2012, 08:02:35 AM

Quote

You can return the whole array to scriptbasic as a return value.

That is a new feature for SB. The only way to return arrays (element or associative) before was in an BYREF argument.

Nice!

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 19, 2012, 05:38:37 PM

Demo Returning Array of data:

ScriptBasic

Code: [Select]

 declare sub SQLite3_Demo        alias "sqlite3_demo"        lib "sqlite3_mdl"
  declare sub SQLite3_Table       alias "sqlite3_table"       lib "sqlite3_mdl"
  declare sub SQLite3_ErrMsg      alias "sqlite3_errmsg"      lib "sqlite3_mdl"
  declare sub SQLite3_Open        alias "sqlite3_open"        lib "sqlite3_mdl"
  declare sub SQLite3_Close       alias "sqlite3_close"       lib "sqlite3_mdl"
  declare sub SQLite3_Exec        alias "sqlite3_exec"        lib "sqlite3_mdl"
  declare sub SQLite3_Prepare_v2  alias "sqlite3_prepare_v2"  lib "sqlite3_mdl"
  declare sub SQLite3_Step        alias "sqlite3_step"        lib "sqlite3_mdl"
  declare sub SQLite3_Column_Text alias "sqlite3_column_text" lib "sqlite3_mdl"

  SQLITE_ROW = 100
  '
  '
  T=SQLite3_Table()
  e=ubound(t)
  print e & "\n\n"
  for i=0 to e step 2
  print T[i] & " - " & T[i+1] & "\n"
  next
  '
  '
  line input w
Oxygen

Code: [Select]


  function sqlite3_table cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
  '=================================================================================================
  indexbase 1
  sys     b,e,i
  sys     hdb
  sys     dberr
  sys     stmt
  sys     result
  string  s[4000]
  '
  char *  errmsg
  string  cr=chr(13)+chr(10)
  string  pr="DataBase Listing:" cr
  '
  sqlite3_open "testsql",hdb
  '
  sqlite3_exec hdb, "CREATE TABLE demo(someval INTEGER,  sometxt TEXT);", 0, 0, dberr
  sqlite3_exec hdb, "INSERT INTO demo VALUES (123, 'Hello');", 0, 0, dberr
  sqlite3_exec hdb, "INSERT INTO demo VALUES (234, 'cruel');", 0, 0, dberr
  sqlite3_exec hdb, "INSERT INTO demo VALUES (345, 'world');", 0, 0, dberr
  '
  result = sqlite3_prepare_v2 hdb, "SELECT * FROM demo;" cr, -1, stmt, 0
  '
  if dberr then @errmsg=dberr : print errmsg
  '
  '
  'COLLECT ALL DATA
  '
  i=0
  while sqlite3_step(stmt) = SQLITE_ROW
    i++ : s[i]=sqlite3_column_text(stmt, 0)
    i++ : s[i]=sqlite3_column_text(stmt, 1)
    if i>=4000 then exit do
  wend
  '
  sqlite3_close hdb
  '
  '
  'RETURNING ARRAY OF VALUES
  '=========================
  '
  b=0   'CHOOSE LBOUND
  e=i-1 'CHOOSE UBOUND
  '
  'pm=GetParamPtr(pParameters,3)
  'PutLongParam(pst,pm,b) 'PASS BACK LBOUND
  'pm=GetParamPtr(pParameters,4)
  'PutLongParam(pst,pm,e) 'PASS BACK UBOUND
  '
  if e<b then exit function
  '
  p=CreateArray(pst,b,e)
  *pReturnValue=p
  '
  '
  'FILL ARRAY
  '
  for i= 0 to e
    a=ReturnString pst, s[i+1]
    q=*p+i*4
    *q=a
  next
  '
  end function

Charles

PS:
What is besRETURN_PTR used for?
The name of this macro does not seem to match its procedure, not intuitively anyway.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 19, 2012, 06:02:29 PM

That is so cool!

Sorry, that's besRETURN_POINTER().

Code: [Select]

/*
Ihandle *IupSetAttributes(Ihandle *ih, const char *str);  <iup.h>

Defines a set of attributes for an interface element.
*/
besFUNCTION(PuiSetAttributes)
  Ihandle *ih, *sameih;
  const char *attstr;

  besARGUMENTS("pz")
    &ih, &attstr
  besARGEND

  sameih = IupSetAttributes(ih, attstr);
  besRETURN_POINTER(sameih);
besEND


Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 20, 2012, 12:27:05 PM

It might be fun to show an Oxygen assist on this benchmark as a SB extension module call.  8)

ScriptBasic native attempt (http://forum.basicprogramming.org/index.php/topic,2602.0.html)

Update

Actually SB's string concatenation is working fine. It's the REPLACE() function that puts the numbers in the toilet.

Code: [Select]

/**REPLACE
=section string
=title REPLACE(base_string,search_string,replace_string [,number_of_replaces] [,position])
=display REPLACE()

This function replaces one or more occurrences of a sub-string in a string.
T<REPLACE(a,b,c)> searches the string T<a> seeking for occurrences of sub-string T<b>
and replaces each of them with the string T<c>.

The fourth and fifth arguments are optional. The fourth argument specifies the number of
replaces to be performed. If this is missing or is T<undef> then all occurrences of string
T<b> will be replaced. The fifth argument may specify the start position of the operation.
For example the function call

=verbatim
REPLACE("alabama mama", "a","x",3,5)
=noverbatim

will replace only three occurrences of string T<"a"> starting at position 5.
The result is T<"alabxmx mxma">.
*/
COMMAND(REPLACE)
#if NOTIMP_REPLACE
NOTIMPLEMENTED;
#else
  NODE nItem;
  VARIABLE Op1,Op2,Op3,Op4,Op5;
  long lRepetitions;
  long lCalculatedRepetitions;
  int ReplaceAll;
  long l_start,lStart,lLength,lSearchLength,lReplaceLength,lResult;
  char *r,*s,*q,*w;
  int iCase = OPTION("compare")&1;

  /* this is an operator and not a command, therefore we do not have our own mortal list */
  USE_CALLER_MORTALS;

  /* evaluate the parameters */
  nItem = PARAMETERLIST;

  /* this is the base string that we are searching in */
  Op1 = _EVALUATEEXPRESSION(CAR(nItem));
  ASSERTOKE;
  if( memory_IsUndef(Op1) ){
    RESULT = NULL;
    RETURN;
    }
  Op1 = CONVERT2STRING(Op1);
  nItem = CDR(nItem);
  lLength = STRLEN(Op1);
  r = STRINGVALUE(Op1);
  /* this is the string that we search to replace */
  Op2 = _EVALUATEEXPRESSION(CAR(nItem));
  ASSERTOKE;
  if( memory_IsUndef(Op2) ){
    RESULT = NULL;
    RETURN;
    }
  Op2 = CONVERT2STRING(Op2);
  nItem = CDR(nItem);
  lSearchLength = STRLEN(Op2);
  s = STRINGVALUE(Op2);
  /* this is the string that we put into the place of the searched string */
  Op3 = _EVALUATEEXPRESSION(CAR(nItem));
  ASSERTOKE;
  if( memory_IsUndef(Op3) ){
    RESULT = NULL;
    RETURN;
    }
  Op3 = CONVERT2STRING(Op3);
  lReplaceLength = STRLEN(Op3);
  nItem = CDR(nItem);
  w = STRINGVALUE(Op3);

  Op4 = NULL;
  if( nItem ){
    Op4 = EVALUATEEXPRESSION(CAR(nItem));
    nItem = CDR(nItem);
    ASSERTOKE;
    }

  if( memory_IsUndef(Op4) ){
    lRepetitions = 0;
    ReplaceAll = 1;
    }else{
    lRepetitions = GETLONGVALUE(Op4);
    ReplaceAll = 0;
    }
  if( lRepetitions < 0 )lRepetitions = 0;

  Op5 = NULL;
  if( nItem ){
    Op5 = EVALUATEEXPRESSION(CAR(nItem));
    nItem = CDR(nItem);
    ASSERTOKE;
    }

  if( memory_IsUndef(Op5) )
    l_start = 1;
  else{
    l_start = GETLONGVALUE(Op5);
    }
  if( l_start < 1 )l_start = 1;
  lStart = l_start;

  /* first calculate the repeat actions */
  lCalculatedRepetitions = 0;
  while( lStart-1 <= lLength - lSearchLength ){
    if( ! SUBSTRCMP(r+lStart-1,s, lSearchLength,iCase ) ){
      lCalculatedRepetitions++;
      lStart += lSearchLength;
      }else lStart ++;
    }
  if( ! ReplaceAll && lCalculatedRepetitions > lRepetitions )lCalculatedRepetitions = lRepetitions;
  /* calculate the length of the new string */
  lResult = STRLEN(Op1) + lCalculatedRepetitions * (lReplaceLength-lSearchLength);

  /* allocate space for the result */
  RESULT = NEWMORTALSTRING(lResult);
  ASSERTNULL(RESULT)

  /* perform the replacements */
  lStart = l_start;

  q = STRINGVALUE(RESULT);
  if( lStart > 1 ){
    memcpy(q,r,lStart-1);
    q+=lStart-1;
    }
  while( lStart <= lLength ){
    if( lCalculatedRepetitions && ! SUBSTRCMP(r+lStart-1,s, lSearchLength,iCase ) ){
      memcpy(q,w,lReplaceLength);
      q += lReplaceLength;
      lStart += lSearchLength;
      lCalculatedRepetitions--;
      }else{
      *q++ = r[lStart-1];
      lStart ++;
      }
    }
#endif
END

Does O2 have a REPLACE() function and if so, can you wrap it in a SB extension module and let me see if that solves the problem? I'm trying to show how using O2 in critical areas of code can give you compiler like performance and the ease of use of a typeless scripting language.

Update

Never mind. I solved my problem with REPLACE by using the fifth parameter. (start position)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 20, 2012, 10:12:12 PM

Python's performance on this benchmark is very impressive. Even with direct Oxygen I struggled to outperform it:

2.37 seconds for 256k and 9.66 secs for 512 k

Code: OxygenBasic

1.   sub replace(string *t,w,r)
2.   '=========================
3.  '
4.  sys a,b,le,lw,lr
5.   '
6.  lw=len(w)
7.   lr=len(r)
8.   a=1
9.   if lw=lr then
10.     do
11.       a=instr(a,t,w)
12.       if a=0 then exit do
13.       mid(t,a)=r  
14.       a+=lr
15.     end do
16.     exit sub
17.   else
18.     do
19.       a=instr(a,t,w)
20.       if a=0 then exit do
21.       t=left(t,a-1)+r+mid(t,a+lw)
22.       a+=lr
23.     end do
24.   end if
25.   end sub
26.  
27.  
28.   macro Substitute(t,w,r,lr)
29.   '=========================
30.  scope
31.   (
32.   sys a
33.   do
34.     a=instr(a,t,w)
35.     if a=0 then exit do
36.     mid(t,a)=r  
37.     a+=lr
38.   end do
39.   )
40.   end macro
41.  
42.  
43. string tab=chr(9)
44. string cr=chr(13)+chr(10)
45. string pr="Performace:" cr
46. string s ="abcdefgh"+"efghefgh"
47. sys i_max =  1024 / len(s) * 1024 * 4 '4meg
48. quad startcount,endcount,frequency
49.  
50. declare QueryPerformanceCounter   lib "kernel32.dll" (quad *c)
51. declare QueryPerformanceFrequency lib "kernel32.dll" (quad *c)
52. QueryPerformanceCounter startcount
53. QueryPerformanceFrequency frequency
54.  
55. string gstr=""
56. sys i
57. sys twice
58. sys lngth
59. sys endlngth=0x40000 '256k
60. while i < i_max + 1000
61.   i++
62.   gstr+=s
63.   lngth=len(s)*i
64.   'replace(gstr,"efgh","____")
65.  substitute gstr,"efgh","____",4
66.   if lngth>=endlngth then
67.     QueryPerformanceCounter endcount
68.     pr+= str((endcount-startcount)/frequency,3) " sec" tab tab lngth/1024 " KB" cr
69.     if ++twice=2 then exit while
70.     endlngth+=0x40000 'another 256k
71.  end if
72. wend
73.  
74.  
75. print pr cr "Finished" cr
76.  
77.  

Here is the ScriptBasic source code for Replace:

It performs 2 passes of the string. The first pass calculate the size of the new string. The second builds the new string with the substitutions. It looks efficient to me. I think the overhead is in setting up the function and its parameters, in which case an Oxygen module would not confer any significant advantage. It could only provide more specialised forms of replace with less parameters. I suspect Python optimises its replace by detecting that the replace string is the same size as the find string.

in source/command/string.c

Code: C

1.  
2. COMMAND(REPLACE)
3. #if NOTIMP_REPLACE
4. NOTIMPLEMENTED;
5. #else
6.   NODE nItem;
7.   VARIABLE Op1,Op2,Op3,Op4,Op5;
8.   long lRepetitions;
9.   long lCalculatedRepetitions;
10.   int ReplaceAll;
11.   long l_start,lStart,lLength,lSearchLength,lReplaceLength,lResult;
12.   char *r,*s,*q,*w;
13.   int iCase = OPTION("compare")&1;
14.  
15.   /* this is an operator and not a command, therefore we do not have our own mortal list */
16.   USE_CALLER_MORTALS;
17.  
18.   /* evaluate the parameters */
19.   nItem = PARAMETERLIST;
20.  
21.   /* this is the base string that we are searching in */
22.   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
23.   ASSERTOKE;
24.   if( memory_IsUndef(Op1) ){
25.     RESULT = NULL;
26.     RETURN;
27.     }
28.   Op1 = CONVERT2STRING(Op1);
29.   nItem = CDR(nItem);
30.   lLength = STRLEN(Op1);
31.   r = STRINGVALUE(Op1);
32.   /* this is the string that we search to replace */
33.   Op2 = _EVALUATEEXPRESSION(CAR(nItem));
34.   ASSERTOKE;
35.   if( memory_IsUndef(Op2) ){
36.     RESULT = NULL;
37.     RETURN;
38.     }
39.   Op2 = CONVERT2STRING(Op2);
40.   nItem = CDR(nItem);
41.   lSearchLength = STRLEN(Op2);
42.   s = STRINGVALUE(Op2);
43.   /* this is the string that we put into the place of the searched string */
44.   Op3 = _EVALUATEEXPRESSION(CAR(nItem));
45.   ASSERTOKE;
46.   if( memory_IsUndef(Op3) ){
47.     RESULT = NULL;
48.     RETURN;
49.     }
50.   Op3 = CONVERT2STRING(Op3);
51.   lReplaceLength = STRLEN(Op3);
52.   nItem = CDR(nItem);
53.   w = STRINGVALUE(Op3);
54.  
55.   Op4 = NULL;
56.   if( nItem ){
57.     Op4 = EVALUATEEXPRESSION(CAR(nItem));
58.     nItem = CDR(nItem);
59.     ASSERTOKE;
60.     }
61.  
62.   if( memory_IsUndef(Op4) ){
63.     lRepetitions = 0;
64.     ReplaceAll = 1;
65.     }else{
66.     lRepetitions = GETLONGVALUE(Op4);
67.     ReplaceAll = 0;
68.     }
69.   if( lRepetitions < 0 )lRepetitions = 0;
70.  
71.   Op5 = NULL;
72.   if( nItem ){
73.     Op5 = EVALUATEEXPRESSION(CAR(nItem));
74.     nItem = CDR(nItem);
75.     ASSERTOKE;
76.     }
77.  
78.   if( memory_IsUndef(Op5) )
79.     l_start = 1;
80.   else{
81.     l_start = GETLONGVALUE(Op5);
82.     }
83.   if( l_start < 1 )l_start = 1;
84.   lStart = l_start;
85.  
86.   /* first calculate the repeat actions */
87.   lCalculatedRepetitions = 0;
88.   while( lStart-1 <= lLength - lSearchLength ){
89.     if( ! SUBSTRCMP(r+lStart-1,s, lSearchLength,iCase ) ){
90.       lCalculatedRepetitions++;
91.       lStart += lSearchLength;
92.       }else lStart ++;
93.     }
94.   if( ! ReplaceAll && lCalculatedRepetitions > lRepetitions )lCalculatedRepetitions = lRepetitions;
95.   /* calculate the length of the new string */
96.   lResult = STRLEN(Op1) + lCalculatedRepetitions * (lReplaceLength-lSearchLength);
97.  
98.   /* allocate space for the result */
99.   RESULT = NEWMORTALSTRING(lResult);
100.   ASSERTNULL(RESULT)
101.  
102.   /* perform the replacements */
103.   lStart = l_start;
104.  
105.   q = STRINGVALUE(RESULT);
106.   if( lStart > 1 ){
107.     memcpy(q,r,lStart-1);
108.     q+=lStart-1;
109.     }
110.   while( lStart <= lLength ){
111.     if( lCalculatedRepetitions && ! SUBSTRCMP(r+lStart-1,s, lSearchLength,iCase ) ){
112.       memcpy(q,w,lReplaceLength);
113.       q += lReplaceLength;
114.       lStart += lSearchLength;
115.       lCalculatedRepetitions--;
116.       }else{
117.       *q++ = r[lStart-1];
118.       lStart ++;
119.       }
120.     }
121. #endif
122. END
123.  

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 20, 2012, 11:22:19 PM

Code: [Select]

s ="abcdefghefghefgh"
i_max =  1024 / LEN(s) * 1024 * 4

starttime = NOW
PRINT "exec.tm.sec\tstr.length\n"

gstr=""
i=0
c = 0
WHILE ( i < i_max + 1000 )
  i=i+1
  gstr&=s
  lngth=LEN(s)*i
  gstr=REPLACE(gstr,"efgh","____",undef,lngth-11)
  IF(lngth % (1024*256) = 0) THEN
    PRINT INT(NOW -starttime)," sec\t\t",(lngth/1024)," KB\n"
    c+=1
    IF c= 2 THEN GOTO finito
  END IF
WEND

finito:
PRINT "\nFinished\n"

Charles,

Please run this on your box and tell me what you get.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 20, 2012, 11:51:28 PM

gstr=REPLACE(gstr,"efgh","____",undef,lngth-16)

Superb cheating  ;D

I get 1 second and 4 seconds.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 21, 2012, 12:00:45 AM

Quote

Superb cheating

I don't see it that way. Based on the benchmark description (website) and the result of gstr with each iteration being the same as all other entries, SB having a smarter REPLACE shouldn't be a penalty.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 21, 2012, 12:11:29 AM

I frown at the benchmark, not at SB's smart replace :)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 21, 2012, 01:02:40 AM

Quote from: Charles Pegge on May 21, 2012, 12:11:29 AM

I frown at the benchmark, not at SB's smart replace :)

It was vague enough to take advantage where I could and still pass through the checkpoints.

 

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 21, 2012, 03:18:47 AM

If I am allowed to use a concatenation buffer then the times come down to 0.006 and 0.010 seconds, a speed gain factor of 395!

You can do the same with ScriptBasic

Code: OxygenBasic

1.  
2.   macro Substitute(t,w,r,lr,o)
3.   '===========================
4.  scope
5.   sys a=o
6.   sys i,j,g,h,p,q
7.   byte b at p
8.   byte c at q
9.   byte k=asc w
10.   p=strptr(t)+a-1
11.   g=strptr(r)
12.   h=strptr(w)
13.   i=1
14.   do
15.     if b=0 then exit do
16.     if b=k then
17.       i=0
18.       j=p
19.       q=h 'base ptr for w
20.      do   'modified instr loop
21.        i++  'index for w
22.        p++  'ptr for byte b
23.        q++  'ptr for byte c
24.        if i>=lr then
25.           copy j,g,lr 'replace
26.          a+=lr-1
27.           p=j+lr-1
28.           exit do
29.         end if
30.         if not c=b then p=j : exit do 'no match
31.      end do
32.     end if
33.     a++
34.     p++
35.   end do
36.   end scope
37.   end macro
38.  
39.  
40.   macro concat(t,s,ofs,le)
41.   '=======================
42.  mid t,s,ofs
43.   ofs+=le
44.   end macro
45.  
46.  
47. string tab=chr(9)
48. string cr=chr(13)+chr(10)
49. string pr="Performace:" cr
50. string s ="abcdefgh"+"efghefgh"
51. sys i_max =  1024 / len(s) * 1024 * 4 '4meg
52. quad startcount,endcount,frequency
53.  
54. declare QueryPerformanceCounter   lib "kernel32.dll" (quad *c)
55. declare QueryPerformanceFrequency lib "kernel32.dll" (quad *c)
56. QueryPerformanceCounter startcount
57. QueryPerformanceFrequency frequency
58.  
59. string  gstr=nuls 1024*1024 '1meg
60. sys     ofs=1
61. sys     i,a
62. sys     measure
63. sys     lngth
64. sys     le=len(s)
65. sys     endlngth=0x40000 '256k
66. '
67. while i < i_max + 1000
68.   i++
69.   concat gstr,s,ofs,le
70.   lngth=le*i
71.   substitute gstr,"efgh","____",4,lngth-15
72.   if lngth>=endlngth then
73.     QueryPerformanceCounter endcount
74.     pr+= str((endcount-startcount)/frequency,3) " sec" tab tab lngth/1024 " KB" cr
75.     if ++measure=2 then exit while
76.     endlngth+=0x40000 'another 256k
77.  end if
78. wend
79. gstr=left gstr,lngth
80. 'print mid gstr,-64
81. print pr cr "Finished" cr
82.  

Charles

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 21, 2012, 08:26:38 AM

I knew you wouldn't go to bed until you were looking at microseconds.  ;D

Quote

If I am allowed to use a concatenation buffer ...

Oh, that should save on memory reallocation steps. Superb!

Quote

You can do the same with ScriptBasic

I'm happy with 1 and 4.

AND (running O2 under Wine)

(http://files.allbasic.info/O2/o2strbench.png)

Quote from: Peter - BaCon

The string processing capabilities of Scriptbasic are impressive, especially its performance. It outperforms almost every other BASIC including BaCon.

I think this string benchmark confirms that.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 22, 2012, 06:11:20 PM

I gave the O2 SQLite3 SB extension module a try on Wine and it seems to work great. I generated a fresh copy from the IDE.

(http://files.allbasic.info/O2/o2winesqlite3.png)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 22, 2012, 07:54:20 PM

I'm thinking a DIM function for SB would be cool now that you can work with SB arrays at the API level.

Code: [Select]

DIM(array, #elem, [base_value,] [step,] [inc,] [start_elem])

Example:

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

a[100]  undef
a[101]  0
a[102]  undef
a[103]  10
a[104]  undef
a[105]  20
a[106]  undef
a[107]  30
a[108]  undef
a[109]  40

If the array already existed then it would be reused and modified accordingly. (changing LBOUND/UBOUND if needed)

It would be great to have a starting element optional parameter to allow building/initializing segments of an array to be merged into a mixed array structure. (matrix) These old tutorials I did on SB arrays should give you an idea what can be done dynamically.

Mixed Arrays (http://www.scriptbasic.org/forum/index.php/topic,170.0.html)

REF (http://www.scriptbasic.org/forum/index.php/topic,196.0.html)

OOP simulation with mixed arrays (http://www.scriptbasic.org/forum/index.php/topic,175.0.html)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 23, 2012, 10:35:06 PM

The ability to fill arrays would be very useful:

a[1]="one","two",3,4,5
print a[2] 'result: "two"

Also dot syntax to support types and members. This could be implemented internally using the associative array mechanism.

Charles

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 23, 2012, 11:19:08 PM

Quote

a[1]="one","two",3,4,5

Nice.

SPLITA comes in handy for a simulated DIM.

Code: [Select]

s = STRING(5,"0")
SPLITA s BY "" TO a

a[0]  0
...
a[4]  0

OR

Code: [Select]

s = "Hello World,123,.25"

SPLITA s BY "," TO a

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

jrs@laptop:~/sb/test$ scriba dimit.sb
Hello World
123
.25
jrs@laptop:~/sb/test$

AND

Code: [Select]

s = "Hello World,123,.25"

SPLITA s BY "," TO a[100]

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

jrs@laptop:~/sb/test$ scriba dimit.sb
Hello World
123
.25
jrs@laptop:~/sb/test$

Just to mix it up a bit before I head off to bed ...

Code: [Select]

s = "10,20,30.5"

SPLITA s BY "," TO Customer{"Balance"}

FOR x = LBOUND(Customer{"Balance"}) TO UBOUND(Customer{"Balance"})
  PRINT FORMAT("%.2f",Customer{"Balance"}[x]),"\n"
NEXT

jrs@laptop:~/sb/test$ scriba dimit.sb
10.00
20.00
30.50
jrs@laptop:~/sb/test$

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 24, 2012, 01:52:16 PM

Charles,

I'm going to try and build a C version of the DIM() function using the SB extension module macros. SPLITA does most of what I'm after. I'm just looking for a way to quickly populate a single dimension SB array with a few tricks. (base value, step, increment, start element)

What I could really use your help with now that you have the OxygenBasic SB extension interface cracked, is a more elegant way to run O2 scripts / functions JIT to help with critical sections of SB code. The early example of this is using a buffer to communicate and DYC.

John

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 24, 2012, 10:18:45 PM

I was able to get a no frills DIM() extension module working. I'm creating a million element array in this example.

Code: [Select]

DECLARE SUB DIM ALIAS "DIM" LIB "cbx"

DIM(a,1000000)

x = UBOUND(a)
PRINT "UBOUND: ", x, " = ", a[x], "\n"

jrs@laptop:~/sb/test$ time scriba dimtest.sb
UBOUND: 999999 = 0

real   0m0.868s
user   0m0.536s
sys   0m0.288s
jrs@laptop:~/sb/test$


The above includes loading scriba as well.

The same end result using SPLITA.

Code: [Select]

SPLITA STRING(1000000,"0") BY "" TO a

x = UBOUND(a)
PRINT "UBOUND: ", x, " = ", a[x], "\n"

jrs@laptop:~/sb/test$ time scriba sdim.sb
UBOUND: 999999 = 0

real   0m0.899s
user   0m0.596s
sys   0m0.252s
jrs@laptop:~/sb/test$

Code: [Select]

PRINT

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


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


CBX (Core Basic eXtension) module.

Code: [Select]

/* Core Extension Library */

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

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


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


besFUNCTION(DIM)
  VARIABLE Argument;
  unsigned long __refcount_;
  LEFTVALUE Lval;
  int i, e;
  
  besRETURNVALUE = NULL;

  Argument = besARGUMENT(2);
  besDEREFERENCE(Argument);
  e = (int)LONGVALUE(Argument);

  Argument = besARGUMENT(1);
  besLEFTVALUE(Argument,Lval);
  besRELEASE(*Lval);
  *Lval = NULL;

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

  for( i= 0 ; ((unsigned)i) < e ; i++ ){
    ARRAYVALUE(*Lval,i) = besNEWSTRING(1);
    memcpy(STRINGVALUE(ARRAYVALUE(*Lval,i)),"0",1);
    }

besEND

Note: This is only a quick test without the normal error checking that is done in a production extension module.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 24, 2012, 11:31:13 PM

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

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 24, 2012, 11:44:24 PM

Thanks Charles.

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

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 25, 2012, 12:02:17 AM

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

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 25, 2012, 10:54:01 AM

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?

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 25, 2012, 11:36:06 AM

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

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 25, 2012, 11:40:46 AM

Outstanding!

Excuse me while I go find my play clothes.  ;D

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 25, 2012, 10:27:37 PM

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?  :D

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

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 25, 2012, 10:43:13 PM

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.  

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 25, 2012, 11:37:13 PM

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 (http://www.scriptbasic.org/forum/index.php/topic,195.msg496.html#msg496)

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

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 26, 2012, 12:12:07 AM

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

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 26, 2012, 09:03:08 AM

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.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 26, 2012, 10:06:10 PM

Here is my latest DIM for ScriptBasic. Converting an integer to a string ended up using my-itoa (http://code.google.com/p/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$

 :o

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 27, 2012, 09:47:09 AM

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.  

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 27, 2012, 12:39:27 PM

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.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 27, 2012, 06:22:57 PM

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.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 28, 2012, 12:27:00 PM

I have be working with Armando (AIR) on the CBX extension module and will release a Windows 32 DLL and Linux 64 bit shared object. (.so) This is the planned function list as it stands now.

• DIM - Fast way to initialize a single dimension array with a few tricks.
  
• FGET - File to string. (no need to OPEN, read or figure out it's length)
  
• FPUT - String to file. (same applies here as well)
  
• VARPTR - Returns the pointer to any SB variable.
  
• PEEK - Returns a string starting at the address given and the number of bytes requested.
  
• POKE - Assign memory a string  of bytes starting and the address provided.
  

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 28, 2012, 08:47:30 PM

Hi John,

Are you thinking about incorporating any of these into The ScriptBasic core eventually?

I think Dim, Fget and FPut are good candidates.

Charles

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 28, 2012, 08:58:06 PM

I'm still learning how to build extension modules. My next task is to learn how to add functionality to scriba's syntax command table. It shouldn't be too hard once I get the hang of it.

I could statically link CBX into scriba but you would still need to DECLARE the functions. This might be the next step before adding them as keywords in the Basic.  (sbhttpd static links MT and CGI extension modules into it's executable)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 29, 2012, 12:20:29 AM

I have finished the new VARPTR and PEEK functions for the CBX extension module. I'm happy with the flexabilty these two functions offer to the SB programmer. The PEEK function only works with string variables at this time. I don't see POKE being much of job and will post it soon.

Code: [Select]

DECLARE SUB VARPTR ALIAS "varptr" LIB "cbx"
DECLARE SUB PEEK ALIAS "PEEK" LIB "cbx"

a = "JRS"
v = VARPTR(a)

PRINT PEEK(v,2),"\n"
PRINT PEEK(a,2),"\n"

v = VARPTR(MID(a,2))
PRINT PEEK(v,2),"\n"
PRINT PEEK(MID(a,2),2),"\n"
PRINT PEEK(v+1,1),"\n"

jrs@laptop:~/sb/test$ scriba peektest.sb
JR
JR
RS
RS
S
jrs@laptop:~/sb/test$

Code: C

1. besFUNCTION(varptr)  
2.   VARIABLE Argument;
3.   long addr_ptr;
4.  
5.   Argument = besARGUMENT(1);
6.   besDEREFERENCE(Argument);
7.   addr_ptr = (long)LONGVALUE(Argument);
8.  
9.   besRETURN_LONG(addr_ptr);
10. besEND
11.  
12.  
13. besFUNCTION(PEEK)
14.   VARIABLE Argument;
15.   long addr_ptr;
16.   int numbytes;
17.  
18.   Argument = besARGUMENT(1);
19.   besDEREFERENCE(Argument);
20.   addr_ptr = (long)LONGVALUE(Argument);
21.  
22.   Argument = besARGUMENT(2);
23.   besDEREFERENCE(Argument);
24.   numbytes = (int)LONGVALUE(Argument);
25.  
26.   besRETURN_MEM(addr_ptr,numbytes);
27.  
28. besEND
29.  

Quote from: AIR

BTW, be very careful with POINTERS.  A common trap is trying to assign the value of an int to a pointer and vice-versa.  It's fine on a 32bit machine, but will throw errors on a 64bit machine because int's are ALWAYS 32bit.  Safe bet is to replace int with LONG, which is 32bit on those types of systems, and 64bit on 64bit systems (the same rule applies to POINTER).

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 29, 2012, 03:02:46 AM

My next task is to see how VARPTR and PEEK perform outside the ScriptBasic variable environment. In theory, I should be able to pass a variable initialized to 0, get the VARPTR of that numeric variable and pass it to a function that may assign a pointer to a structure. I could then use the pointer assigned with PEEK to retrieve elements of the structure.

I also want to create a test function in the CBX module that create a global char string outside the SB environment and returns the pointer (address) to SB. I will then us PEEK with the returned pointer to access the module global variable. I'll post my test results tomorrow. (bed time)

 

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 29, 2012, 08:06:32 PM

As things turned out, we now have a STRPTR and VARPTR function that works properly with PEEK.

Code: [Select]

DECLARE SUB STRPTR ALIAS "STRPTR" LIB "cbx"
DECLARE SUB VARPTR ALIAS "VARPTR" LIB "cbx"
DECLARE SUB PEEK ALIAS "PEEK" LIB "cbx"

a = "ABC"
v = STRPTR(a)

PRINT PEEK(v,2),"\n"
PRINT PEEK(a,2),"\n"

v = STRPTR(MID(a,2))
PRINT PEEK(v,2),"\n"
PRINT PEEK(MID(a,2),2),"\n"
PRINT PEEK(v+1,1),"\n"

b = 1 + 2
v = VARPTR(b)
PRINT v,"\n"
PRINT PEEK(v,1),"\n"
PRINT ASC(PEEK(v,1)),"\n"

(http://files.allbasic.info/ScriptBasic/sbmem.png)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 29, 2012, 09:57:53 PM

I was testing the VARPTR and STRPTR functions with arrays and it seems to work. I'm still looking at floating point variables. I may need to create a PEEKD function to to deal with them. This library is still in flux as these new functions come online.

@Charles: I should be able to pass SB pointers to your O2 JIT script functions and they be valid in O2. This could save a lot of travel time.

Code: [Select]

DECLARE SUB STRPTR ALIAS "STRPTR" LIB "cbx"
DECLARE SUB VARPTR ALIAS "VARPTR" LIB "cbx"
DECLARE SUB PEEK ALIAS "PEEK" LIB "cbx"

b[1] = "CAT"
v = STRPTR(b[1])
PRINT v,"\n"
PRINT PEEK(v,3),"\n"

b[1] = 1
v = VARPTR(b[1])
PRINT v,"\n"
PRINT PEEK(v,1),"\n"
PRINT ASC(PEEK(v,1)),"\n"

a{"one"} = "SB"
v = STRPTR(a{"one"})
PRINT v,"\n"
PRINT PEEK(v,2),"\n"

jrs@laptop:~/sb/test$ scriba peektest.sb
28895367
CAT
28845048

<unprintable character symbol here>
1
28895401
SB
jrs@laptop:~/sb/test$

I have decided to change the module name to SB3. The idea is that version 3 of ScriptBasic can be prototyped in an extension module and allow users to try these upcoming core features of the next release. I think this will allow others to contribute to the project easier and learn the SB API. (macro mania (http://www.nstarsolutions.com/mm/) - actual product using the name)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 30, 2012, 02:24:11 AM

Hi John,
I don't think passing pointers to O2 would make any difference, since the module would still have to go through the parameter retrieval process to access the pointer itself.

However, my O2-side string access could be improved by offering direct access to the SB string instead of copying it into a new O2 string

GetZstringPar

This is ideal if the string is to be patched but not altered in length.

Code: OxygenBasic

1.  
2.     macro GetZstringPar(v,pst,pp,pn) 'works with char* /zstring*
3.    scope
4.     iopar(pst,pp,pn,0xf4)
5.     @v=*q
6.     end scope
7.     end macro
8.  
9.     macro GetStringPar(v,pst,pp,pn)
10.     scope
11.     iopar(pst,pp,pn,0xf4)
12.     zstring pz at *q
13.     v=pz
14.     end scope
15.     end macro
16.  

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 30, 2012, 01:54:22 PM

I think Peter (BaCon) did a nice job with his implementation of PEEK/POKE. I like the idea of defining the type of data your after. It could be a PITA if the SB user has to untangle a binary representation of a numeric variable getting a series of consecutive bytes. I'm not sure if I'm going to go with an option based setting or create variation functions.

Example:

PEEKB - BYTE
PEEKI - INTEGER
PEEKL - LONG
PEEKD - DOUBLE
PEEKF - FLOAT

PEEK alone assumes a BYTE and supports the length optional parameter. All other variations are one TYPE at a time. I could see down the road adding a template like option to extract complex structures and assign them to meaningful associative/mixed SB arrays.

Comments welcome!

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Aurel on May 30, 2012, 08:56:06 PM

I don't know from where Peter(bacon) get this idea but same thing are implemented in PureBasic.
PEEKB - BYTE
PEEKI - INTEGER
PEEKL - LONG
PEEKD - DOUBLE
PEEKF - FLOAT

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 30, 2012, 10:56:31 PM

I looking for what the preference might be for PEEK & POKE data type handling. Peter used an option setting to determine what type the PEEK or POKE would return or set. As you have mentioned, other Basic languages use the method I posted. I'm leaning towards having separate function variations for PEEK & POKE.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on May 31, 2012, 04:03:03 AM

There is no Peek and Poke in Oxygen. Instead, I have standardised on declarations like:

byte b at p

where sys variable p holds the address. Whenever p is changed then b will contain the byte at the new address.

The advantage is that any type may be specified, and arrays can also be used.

Charles

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on May 31, 2012, 12:27:16 PM

Quote

There is no Peek and Poke in Oxygen. Instead, I have standardised on declarations like:

byte b at p

Code: Text

1. byte b at p
2. integer i at p
3. long l at p
4. double d at p
5. float f at p
6.  

SB is sort of doing the same thing but using variations of the PEEK.

PEEKB - BYTE
PEEKI - INTEGER
PEEKL - LONG
PEEKD - DOUBLE
PEEKF - FLOAT
Posted on: May 30, 2012, 01:54:22 PM

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on June 13, 2012, 11:51:48 AM

Charles,

Armando started working on a cross platform SQLite3 extension module. (C) The SB ext. API (macros) sure makes interfacing to other libraries a breeze. The demo is based on your example (http://www.oxygenbasic.org/forum/index.php?topic=438.msg3227#msg3227) earlier in this thread.

interface.c

Code: [Select]

/*
  FILE   : interface.c
  HEADER : interface.h
  BAS    : sqlite.bas
  AUTHOR : Armando I. Rivera

  DATE:

  CONTENT:
  This is the interface.c file for the ScriptBasic module sqlite3

NTLIBS:
UXLIBS: -lc -ldl -lpthread
DWLIBS: -lsqlite3 -lpthread
ADLIBS: sqlite3.a
*/

/*
TO_BAS:
declare sub     ::OPEN alias "sql3_open"         lib "sqlite"
declare sub     ::CLOSE alias "sql3_close"        lib "sqlite"
declare sub     ::EXECUTE alias "sql3_execute"      lib "sqlite"
declare sub     ::QUERY alias "sql3_query"        lib "sqlite"
declare sub     ::ROW alias "sql3_row"          lib "sqlite"
declare sub     ::ROW_VALUE alias "sql3_row_value"    lib "sqlite"
declare sub     ::COLUMN_COUNT alias "sql3_column_count" lib "sqlite"
declare sub     ::COLUMN_NAME alias "sql3_column_name"  lib "sqlite"
declare sub     ::FINALIZE alias "sql3_finalize"     lib "sqlite"
declare sub     ::VERSION alias "sql3_version"      lib "sqlite"
*/


#include <stdio.h>
#include <string.h>

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

besVERSION_NEGOTIATE
  return (int)INTERFACE_VERSION;
besEND

besSUB_START
  long *p;

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

  p = (long*)besMODULEPOINTER;
  return 0;
besEND

besSUB_FINISH
  long *p;

  p = (long*)besMODULEPOINTER;
  if( p == NULL )return 0;
  return 0;
besEND


besFUNCTION(sql3_open)
     sqlite3 *db;
     const char *fileName;
     int i;

     besARGUMENTS("s")
          &fileName
     besARGEND

     i = sqlite3_open(fileName, &db);
     besRETURN_POINTER(db)
besEND

besFUNCTION(sql3_close)
     sqlite3 *db;
     int i;

     besARGUMENTS("p")
          &db
     besARGEND

     i = sqlite3_close(db);
     besRETURN_LONG(i)
besEND

besFUNCTION(sql3_execute)
    sqlite3 *db;
    char *sqlcmd;
    int ret;

    besARGUMENTS("ps")
        &db,&sqlcmd
    besARGEND
    ret = sqlite3_exec(db,sqlcmd,NULL,NULL,NULL);
    besRETURN_LONG(ret)
besEND

besFUNCTION(sql3_query)
    sqlite3 *db;
    sqlite3_stmt *stmt;
    char *sqlcmd;
    int ret;

    besARGUMENTS("ps")
        &db,&sqlcmd
    besARGEND
    ret = sqlite3_prepare_v2(db,sqlcmd,strlen(sqlcmd)+1,&stmt,NULL);
    besRETURN_POINTER(stmt)
besEND

besFUNCTION(sql3_row)
     sqlite3_stmt *stmt;
     int i;

     besARGUMENTS("p")
          &stmt
     besARGEND

     i = sqlite3_step(stmt);
     besRETURN_LONG(i)

besEND

besFUNCTION(sql3_row_value)
     sqlite3_stmt *stmt;
     const char* cur_column_text;
     int i;

     besARGUMENTS("pi")
          &stmt,&i
     besARGEND

     cur_column_text = sqlite3_column_text(stmt,i);
     besRETURN_STRING(cur_column_text)

besEND

besFUNCTION(sql3_column_count)
     sqlite3_stmt *stmt;
     int i;

     besARGUMENTS("p")
          &stmt
     besARGEND

     i = sqlite3_column_count(stmt);
     besRETURN_LONG(i)

besEND

besFUNCTION(sql3_column_name)
     sqlite3_stmt *stmt;
     const char* cur_column_name;
     int i;

     besARGUMENTS("pi")
          &stmt,&i
     besARGEND

     cur_column_name = sqlite3_column_name(stmt,i);
     besRETURN_STRING(cur_column_name)

besEND

besFUNCTION(sql3_finalize)
     sqlite3_stmt *stmt;
     int i;

     besARGUMENTS("p")
          &stmt
     besARGEND

     i = sqlite3_finalize(stmt);
     besRETURN_LONG(i)
besEND

besFUNCTION(sql3_version)
    const char *ver = sqlite3_libversion();
    besRETURN_STRING(ver)
besEND


START_FUNCTION_TABLE(SQLITE_SLFST)
// Ext. module
  EXPORT_MODULE_FUNCTION(versmodu)
  EXPORT_MODULE_FUNCTION(bootmodu)
  EXPORT_MODULE_FUNCTION(finimodu)

// MOUDLE FUNCTIONS
  EXPORT_MODULE_FUNCTION(sql3_open)
  EXPORT_MODULE_FUNCTION(sql3_close)
  EXPORT_MODULE_FUNCTION(sql3_execute)
  EXPORT_MODULE_FUNCTION(sql3_query)
  EXPORT_MODULE_FUNCTION(sql3_row)
  EXPORT_MODULE_FUNCTION(sql3_row_value)
  EXPORT_MODULE_FUNCTION(sql3_column_count)
  EXPORT_MODULE_FUNCTION(sql3_column_name)
  EXPORT_MODULE_FUNCTION(sql3_finalize)
  EXPORT_MODULE_FUNCTION(sql3_version)
END_FUNCTION_TABLE

sqltest.sb

Code: [Select]

INCLUDE sqlite.bas

hdb=sqlite::open("testsql")
sqlite::execute(hdb,"create table demo (someval integer, sometxt text);")
sqlite::execute(hdb, "INSERT INTO demo VALUES (123,'hello');")
sqlite::execute(hdb, "INSERT INTO demo VALUES (234, 'cruel');")
sqlite::execute(hdb, "INSERT INTO demo VALUES (345, 'world');")

stmt = sqlite::query(hdb,"SELECT * FROM demo;")

while (sqlite::row(stmt) = 100)
    pr = pr & sqlite::row_value(stmt,0) & " - " & sqlite::row_value(stmt,1) & "\n"
wend

sqlite::close(hdb)

print pr

print "SQLite Version: ",sqlite::version(),"\n"

jrs@ip-10-166-185-35:~/tmp$ scriba sqltest.sb
123 - hello
234 - cruel
345 - world
SQLite Version: 3.7.12.1
jrs@ip-10-166-185-35:~/tmp$

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on June 13, 2012, 12:57:23 PM

Thats great, John!

Glut/OpenGL will be more of a challenge :)

Is there a way of launching SB without the console? This would be the preferred behaviour for graphical applications in Windows at least. The only way we could do it last time, was to embed SB in Oxygen.

Charles

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Aurel on June 13, 2012, 01:12:41 PM

Quote

Is there a way of launching SB without the console?

That is the main question which i ask John many times without right
answer ... >:(

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on June 13, 2012, 01:45:55 PM

scribaw (http://www.scriptbasic.org/forum/index.php/topic,242.0.html)

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on June 19, 2012, 09:39:47 PM

I was able to cross compile the ScriptBasic SQLite3 extension module for Android.

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: Charles Pegge on June 20, 2012, 01:06:24 AM

How does the C compiling work John. Do you use GCC for Android?

Title: Re: ScriptBasic Extension Modules written in Oxygen
Post by: JRS on June 20, 2012, 01:33:32 AM

Here is the generated makefile for the Android toolchain version of the extension module.

Code: [Select]


all : /home/jrs/android/scriptbasic/bin/mod/lib/sqlite.a /home/jrs/android/scriptbasic/bin/mod/dll/sqlite.so /home/jrs/android/scriptbasic/bin/texi/mod_sqlite.texi

/home/jrs/android/scriptbasic/bin/mod/lib/sqlite.a : /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/s_interface.o /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/sqlite3.o
arm-linux-androideabi-ar -r /home/jrs/android/scriptbasic/bin/mod/lib/sqlite.a /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/s_interface.o /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/sqlite3.o  

/home/jrs/android/scriptbasic/bin/mod/dll/sqlite.so : /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/interface.o /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/sqlite3.o
arm-linux-androideabi-ld -shared -lc -lm -ldl -o /home/jrs/android/scriptbasic/bin/mod/dll/sqlite.so /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/interface.o /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/sqlite3.o  

/home/jrs/android/scriptbasic/bin/mod/obj/sqlite/interface.o : interface.c sqlite3.h
arm-linux-androideabi-gcc -w -fsigned-char -fPIC -c -o /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/interface.o interface.c

/home/jrs/android/scriptbasic/bin/mod/obj/sqlite/s_interface.o : interface.c sqlite3.h
arm-linux-androideabi-gcc -w -fsigned-char -fPIC -DSTATIC_LINK=1 -c -o /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/s_interface.o interface.c

/home/jrs/android/scriptbasic/bin/mod/obj/sqlite/sqlite3.o : sqlite3.c sqlite3.h
arm-linux-androideabi-gcc -w -fsigned-char -fPIC -c -o /home/jrs/android/scriptbasic/bin/mod/obj/sqlite/sqlite3.o sqlite3.c

/home/jrs/android/scriptbasic/bin/texi/mod_sqlite.texi : manual.texi.jam
perl /home/jrs/android/scriptbasic/jamal.pl manual.texi.jam /home/jrs/android/scriptbasic/bin/texi/mod_sqlite.texi
perl /home/jrs/android/scriptbasic/t2h.pl /home/jrs/android/scriptbasic/bin/texi/mod_sqlite.texi


@James Fuller - Armando has used MBC to generate test interfaces on Android without issues.