Author Topic: Script BASIC Virtual DLL  (Read 18602 times)

Support

  • Administrator
  • *****
  • Posts: 22
    • View Profile
Script BASIC Virtual DLL
« on: November 03, 2014, 08:00:23 PM »
Viirtual DLL is what I call the DLLC OxygenBasic JIT function(s). Below is an example of calling an ASM string reverse function, a word parsing function and a column align function in O2 BASIC from Script BASIC as an extension module IMPORT.

testo2.sb
Code: Script BASIC
  1. IMPORT O2.inc
  2.  
  3. FOR x = 65 TO 90
  4.   alpha &= CHR(x)
  5. NEXT
  6. PRINT alpha,"\n"
  7. PRINT O2::RevStr(alpha),"\n"
  8. p = 1
  9. Next_Word:
  10.   wd = O2::GetWords("abc(d[xx]+7/6,\"qwerty\")", p)
  11.   IF wd <> "" THEN
  12.     PRINT wd,"\n"
  13.     GOTO Next_Word
  14.   END IF
  15. q = """
  16. Given;;a;;text;;file;;of;;many;;lines,;;where;;fields;;within;;a;;line;;
  17. are;;delineated;;by;;a;;single;;'dollar';;character,;;write;;a;;program
  18. that;;aligns;;each;;column;;of;;fields;;by;;ensuring;;that;;words;;in;;each;;
  19. column;;are;;separated;;by;;at;;least;;one;;space.
  20. Further,;;allow;;for;;each;;word;;in;;a;;column;;to;;be;;either;;left;;
  21. justified,;;right;;justified,;;or;;center;;justified;;within;;its;;column.
  22. """
  23. PRINT O2::ColumnAlign(q, "LLLLCCCRRRRR", ";;", "\n")
  24.  
  25. O2::Done()
  26.  

O2.inc
Code: Script BASIC
  1. MODULE O2
  2.  
  3. include "dllcinc.sb"
  4.  
  5. oxy=dllfile("/scriptbasic/Debugger/modules/oxygen.dll")
  6.  
  7. o2_basic = dllproc( oxy, "o2_basic i =(c*source) " )
  8. o2_exec  = dllproc( oxy, "o2_exec  i =(i call)   " )
  9. o2_error = dllproc( oxy, "o2_error c*=()         " )
  10. o2_errno = dllproc( oxy, "o2_errno i =()         " )
  11. o2_len   = dllproc( oxy, "o2_len   i =()         " )
  12. o2_mode  = dllproc( oxy, "o2_mode     (i mode)   " )
  13.  
  14. dllcall o2_mode,1
  15.  
  16. OPEN "/scriptbasic/Debugger/include/O2.src" FOR INPUT AS #1
  17. src = INPUT(LOF(1), 1)
  18. CLOSE(1)
  19.  
  20. a = oxygen(src)
  21. Finish  = dllproc(a,"Finish ()", dllcald(a,0))
  22. Reverse = dllproc(a,"Reverse (c*value)", dllcald(a,1))
  23. Words   = dllproc(a,"getword c* = (c* strraw, i* start)", dllcald(a,2))
  24. ColAlign   = dllproc(a,"AlignText c* = (c* in, c* ju, C* dl, c* cr)", dllcald(a,3))
  25.  
  26. FUNCTION oxygen(src)
  27.   dllcall o2_basic,src
  28.   IF (dllcall(o2_errno)<> 0) THEN
  29.     dllprnt dllcall(o2_error)
  30.     a = 0
  31.   ELSE
  32.     a = dllcall(o2_exec,0)
  33.   END IF
  34.   oxygen = a
  35. END FUNCTION
  36.  
  37. FUNCTION Done
  38.   rtnval = dllcall(Finish)
  39.   dllfile
  40.   Done = rtnval
  41. END FUNCTION
  42.  
  43. ' SB wrapper functions
  44.  
  45. FUNCTION RevStr(strarg)
  46.   dllcall(Reverse, strarg)
  47.   RevStr = strarg
  48. END FUNCTION
  49.  
  50. FUNCTION GetWords(strarg, longarg)
  51.   GetWords = dllcall(Words, strarg, longarg)
  52. END FUNCTION
  53.  
  54. FUNCTION ColumnAlign(in_str, just_str, dlm_str, eol_str)
  55.   ColumnAlign = dllcall(ColAlign, in_str, just_str, dlm_str, eol_str)
  56. END FUNCTION
  57.  
  58. END MODULE
  59.  

O2.src
Code: OxygenBasic
  1. ' O2 source
  2.  
  3. extern
  4.  
  5. function reverse(char*s)
  6. '=======================
  7.  addr ecx,s
  8.   mov edx,0
  9.  .rlen
  10.   mov al,[ecx]
  11.   cmp al,0
  12.   jz xlen
  13.   inc edx
  14.   inc ecx
  15.   jmp rlen
  16.  .xlen
  17.   ;
  18.   addr ecx,s
  19.   add  edx,ecx
  20.   dec ecx
  21.   ;
  22.  .rswap
  23.   inc ecx
  24.   dec edx
  25.   cmp edx,ecx
  26.   jle xswap
  27.   mov al,[ecx]
  28.   mov ah,[edx]
  29.   mov [ecx],ah
  30.   mov [edx],al
  31.   jmp rswap
  32.  .xswap
  33.   end function
  34.  
  35. function getword(char*ss,sys*b) as char*
  36. '=======================================
  37. if b=0 then b=1
  38. byte s at @ss
  39. byte c,d
  40. sys bb,bc
  41. static char z[128]
  42. a=0
  43. bb=b
  44.  
  45. 'SKIP LEADING SPACES
  46. do
  47.   c=s[b]
  48.   select c
  49.    case 33 to 255,0 : exit do 'SKIP SPACE
  50.  end select
  51.   b++
  52. end do
  53. bc=b
  54.  '
  55. 'QUOTES
  56. select c
  57.  case 34,39
  58.    do
  59.      b+=1
  60.      d=s[b]
  61.      if d=0 or d=c then b+=1 : jmp fwd done
  62.    end do
  63. end select
  64. 'WORDS AND SYMBOLS
  65. do
  66.   c=s[b]
  67.   select c
  68.   case 0 to 32    : exit do
  69.   case 35         : jmp fwd more
  70.   case 33 to 47   : 'symbols
  71.  case 48 to 57   : jmp fwd more 'numbers
  72.  case 58 to 64   : 'symbols
  73.  case 65 to 90   : jmp fwd more 'capitals
  74.  case 95         : jmp fwd more 'underscore
  75.  case 91 to 96   : 'symbols
  76.  case 97 to 122  : jmp fwd more 'lower case
  77.  case 123 to 127 : 'symbols
  78.  case 128 to 255 : jmp fwd more 'higher ascii
  79. end select
  80.  
  81. if b=bc then b++
  82.   exit do
  83.  
  84.   more:
  85.   b++
  86. end do
  87.  
  88. done:
  89.  
  90. if b > bb then
  91.   z=mid ss,bc,b-bc
  92. else
  93.   z = ""
  94. end if
  95. return z
  96.  
  97. end function
  98.  
  99. =================
  100. Class AlignedText
  101. =================
  102.  
  103. indexbase 1
  104.  
  105. string  buf, bufo, pr, cr, tab, jus, dlm
  106. sys     Cols, Rows, ColWidth[0x100], TotWidth, ColPad, ld
  107.  
  108. method SetText(char*s)
  109. ======================
  110. if not len cr then cr=chr(13,10)
  111. tab=chr(9)
  112. if not len jus then jus=string 200,"L"
  113. buf=s
  114. measure
  115. end method
  116.  
  117.  
  118. method measure()
  119. ================
  120. sys a, b, wa, wb, cm, c, cw
  121. a=1 : b=1
  122. Cols=0 : Rows=0 : ColPad=3
  123. ld=len dlm
  124. if not ld then dlm="," : ld=1 'default to comma
  125. do
  126.   wb=b
  127.   a=instr b,buf,cr
  128.   if a=0 then exit do
  129.   cm=0
  130.   c++
  131.   do
  132.     wa=instr wb,buf,dlm
  133.     if wa=0 or wa>a then exit do
  134.     cm++
  135.     if cm>cols then cols=cm
  136.     cw=wa-wb
  137.     if cw > ColWidth[cm] then ColWidth[cm]=cw
  138.     wb=wa+ld
  139.   end do
  140.   b=a+len cr
  141. end do
  142. rows=c
  143. '
  144. c=0
  145. for i=1 to cols
  146.   ColWidth[ i ]+=ColPad
  147.   c+=ColWidth[ i ]
  148. next
  149. TotWidth=c+len cr
  150. 'print ShowMetrics
  151. end method
  152.  
  153.  
  154. method ShowMetrics() as char*
  155. =============================
  156. pr="METRICS:" cr cr
  157. pr+=rows tab cols tab totwidth cr cr
  158. pr+="column" tab "spacing" cr
  159. for i=1 to cols
  160.   pr+=i tab ColWidth[ i ] cr
  161. next
  162. return pr
  163. end method
  164.  
  165.  
  166. method justify(char*j)
  167. ======================
  168. jus=j
  169. end method
  170.  
  171. method delimiter(char*j)
  172. ========================
  173. dlm=j
  174. end method
  175.  
  176. method endofline(char*j)
  177. ========================
  178. cr=j
  179. end method
  180.  
  181.  
  182. method layout() as char*
  183. ========================
  184. sys a, b, wa, wb, wl, cm, lpos, cpos
  185. bufo=space Rows*TotWidth
  186. a=1 : b=1
  187. do
  188.   wb=b
  189.   a=instr(b,buf,cr)
  190.   if a=0 then exit do
  191.   cm=0
  192.   cpos=1
  193.   do
  194.     wa=instr(wb,buf,dlm)
  195.     if wa=0 or wa>a then exit do
  196.     '
  197.    cm++
  198.     '
  199.    'JUSTIFICATION
  200.    '
  201.    wl=wa-wb
  202.     p=lpos+cpos 'default "L" LEFT ALIGN
  203.    '
  204.    select case asc(jus,cm)
  205.       case "R" : p=lpos+cpos+ColWidth[cm]-wl-Colpad
  206.       case "C" : p=lpos+cpos+( ColWidth[cm]-wl-Colpad )*.5
  207.     end select
  208.     '
  209.    mid bufo,p, mid buf,wb,wl
  210.     cpos+=colwidth[cm]
  211.     wb=wa+ld
  212.   end do
  213.   b=a+len cr
  214.   lpos+=TotWidth
  215.   if lpos<len(bufo) then mid bufo,lpos-1,cr
  216. end do
  217. return bufo
  218. end method
  219.  
  220. end class
  221.  
  222. '#recordof AlignedText
  223.  
  224. AlignedText atxt
  225.  
  226. function AlignText(char *in,*ju,*dl,*cr) as char*
  227. =================================================
  228. atxt.justify         ju
  229. atxt.delimiter       dl
  230. atxt.endofline       cr
  231. atxt.SetText         in
  232. return               atxt.layout
  233. end function
  234.  
  235. sub finish()
  236. '===========
  237.  terminate
  238. end sub
  239.  
  240. function link(sys n) as sys
  241. '==========================
  242.  select n
  243.   case 0 : return @finish
  244.   case 1 : return @reverse
  245.   case 2 : return @getword
  246.   case 3 : return @AlignText
  247.   end select
  248. end function
  249.  
  250. end extern
  251.  
  252. addr link
  253.  

Output

C:\scriptbasic\o2dev>scriba testo2.sb
ABCDEFGHIJKLMNOPQRSTUVWXYZ
ZYXWVUTSRQPONMLKJIHGFEDCBA
abc
(
d
[
xx
]
+
7
/
6
,
"qwerty"
)

  Given        a            text         file       of       many        lines,        where   fields   within        a   line
  are          delineated   by           a        single    'dollar'   character,      write        a
  that         aligns       each         column     of       fields        by       ensuring     that    words       in   each
  column       are          separated    by         at       least        one
  Further,     allow        for          each      word        in          a          column       to       be   either   left
  justified,   right        justified,   or       center   justified     within          its

C:\scriptbasic\o2dev>

« Last Edit: November 05, 2014, 09:40:58 PM by support »