ScriptBasic Extension Modules written in Oxygen

[JRS]

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

ScriptBasic native attempt

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)

[Charles Pegge]

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.  

[JRS]

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.

[Charles Pegge]

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

Superb cheating  

I get 1 second and 4 seconds.

[JRS]

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.

[Charles Pegge]

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

[JRS]

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.

 

[Charles Pegge]

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

[JRS]

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

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

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

You can do the same with ScriptBasic

I'm happy with 1 and 4.

AND (running O2 under Wine)

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.

[JRS]

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.

[JRS]

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

REF

OOP simulation with mixed arrays

[Charles Pegge]

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

[JRS]

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$

[JRS]

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

[JRS]

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.