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

Support

  • Administrator
  • *****
  • Posts: 1
    • View Profile
Script BASIC Virtual DLL
« on: November 04, 2014, 04:00:23 am »
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
IMPORT O2.inc

FOR x = 65 TO 90
  alpha &= CHR(x)
NEXT
PRINT alpha,"\n"
PRINT O2::RevStr(alpha),"\n"
p = 1
Next_Word:
  wd = O2::GetWords("abc(d[xx]+7/6,\"qwerty\")", p)
  IF wd <> "" THEN
    PRINT wd,"\n"
    GOTO Next_Word
  END IF
q = """
Given;;a;;text;;file;;of;;many;;lines,;;where;;fields;;within;;a;;line;;
are;;delineated;;by;;a;;single;;'dollar';;character,;;write;;a;;program
that;;aligns;;each;;column;;of;;fields;;by;;ensuring;;that;;words;;in;;each;;
column;;are;;separated;;by;;at;;least;;one;;space.
Further,;;allow;;for;;each;;word;;in;;a;;column;;to;;be;;either;;left;;
justified,;;right;;justified,;;or;;center;;justified;;within;;its;;column.
"
""
PRINT O2::ColumnAlign(q, "LLLLCCCRRRRR", ";;", "\n")

O2::Done()
 
O2.inc
MODULE O2

include "dllcinc.sb"

oxy=dllfile("/scriptbasic/Debugger/modules/oxygen.dll")

o2_basic = dllproc( oxy, "o2_basic i =(c*source) " )
o2_exec  = dllproc( oxy, "o2_exec  i =(i call)   " )
o2_error = dllproc( oxy, "o2_error c*=()         " )
o2_errno = dllproc( oxy, "o2_errno i =()         " )
o2_len   = dllproc( oxy, "o2_len   i =()         " )
o2_mode  = dllproc( oxy, "o2_mode     (i mode)   " )

dllcall o2_mode,1

OPEN "/scriptbasic/Debugger/include/O2.src" FOR INPUT AS #1
src = INPUT(LOF(1), 1)
CLOSE(1)

a = oxygen(src)
Finish  = dllproc(a,"Finish ()", dllcald(a,0))
Reverse = dllproc(a,"Reverse (c*value)", dllcald(a,1))
Words   = dllproc(a,"getword c* = (c* strraw, i* start)", dllcald(a,2))
ColAlign   = dllproc(a,"AlignText c* = (c* in, c* ju, C* dl, c* cr)", dllcald(a,3))

FUNCTION oxygen(src)
  dllcall o2_basic,src
  IF (dllcall(o2_errno)<> 0) THEN
    dllprnt dllcall(o2_error)
    a = 0
  ELSE
    a = dllcall(o2_exec,0)
  END IF
  oxygen = a
END FUNCTION

FUNCTION Done
  rtnval = dllcall(Finish)
  dllfile
  Done = rtnval
END FUNCTION

' SB wrapper functions

FUNCTION RevStr(strarg)
  dllcall(Reverse, strarg)
  RevStr = strarg
END FUNCTION

FUNCTION GetWords(strarg, longarg)
  GetWords = dllcall(Words, strarg, longarg)
END FUNCTION
 
FUNCTION ColumnAlign(in_str, just_str, dlm_str, eol_str)
  ColumnAlign = dllcall(ColAlign, in_str, just_str, dlm_str, eol_str)
END FUNCTION

END MODULE
 
O2.src
' O2 source

extern

function reverse(char*s)
'=======================
 addr ecx,s
  mov edx,0
 .rlen
  mov al,[ecx]
  cmp al,0
  jz xlen
  inc edx
  inc ecx
  jmp rlen
 .xlen
  ;
  addr ecx,s
  add  edx,ecx
  dec ecx
  ;
 .rswap
  inc ecx
  dec edx
  cmp edx,ecx
  jle xswap
  mov al,[ecx]
  mov ah,[edx]
  mov [ecx],ah
  mov [edx],al
  jmp rswap
 .xswap
  end function

function getword(char*ss,sys*b) as char*
'=======================================
if b=0 then b=1
byte s at @ss
byte c,d
sys bb,bc
static char z[128]
a=0
bb=b

'SKIP LEADING SPACES
do
  c=s[b]
  select c
   case 33 to 255,0 : exit do 'SKIP SPACE
 end select
  b++
end do
bc=b
 '
'QUOTES
select c
 case 34,39
   do
     b+=1
     d=s[b]
     if d=0 or d=c then b+=1 : jmp fwd done
   end do
end select
'WORDS AND SYMBOLS
do
  c=s[b]
  select c
  case 0 to 32    : exit do
  case 35         : jmp fwd more
  case 33 to 47   : 'symbols
 case 48 to 57   : jmp fwd more 'numbers
 case 58 to 64   : 'symbols
 case 65 to 90   : jmp fwd more 'capitals
 case 95         : jmp fwd more 'underscore
 case 91 to 96   : 'symbols
 case 97 to 122  : jmp fwd more 'lower case
 case 123 to 127 : 'symbols
 case 128 to 255 : jmp fwd more 'higher ascii
end select

if b=bc then b++
  exit do

  more:
  b++
end do

done:

if b > bb then
  z=mid ss,bc,b-bc
else
  z = ""
end if
return z

end function

=================
Class AlignedText
=================

indexbase 1

string  buf, bufo, pr, cr, tab, jus, dlm
sys     Cols, Rows, ColWidth[0x100], TotWidth, ColPad, ld

method SetText(char*s)
======================
if not len cr then cr=chr(13,10)
tab=chr(9)
if not len jus then jus=string 200,"L"
buf=s
measure
end method


method measure()
================
sys a, b, wa, wb, cm, c, cw
a=1 : b=1
Cols=0 : Rows=0 : ColPad=3
ld=len dlm
if not ld then dlm="," : ld=1 'default to comma
do
  wb=b
  a=instr b,buf,cr
  if a=0 then exit do
  cm=0
  c++
  do
    wa=instr wb,buf,dlm
    if wa=0 or wa>a then exit do
    cm++
    if cm>cols then cols=cm
    cw=wa-wb
    if cw > ColWidth[cm] then ColWidth[cm]=cw
    wb=wa+ld
  end do
  b=a+len cr
end do
rows=c
'
c=0
for i=1 to cols
  ColWidth[ i ]+=ColPad
  c+=ColWidth[ i ]
next
TotWidth=c+len cr
'print ShowMetrics
end method


method ShowMetrics() as char*
=============================
pr="METRICS:" cr cr
pr+=rows tab cols tab totwidth cr cr
pr+="column" tab "spacing" cr
for i=1 to cols
  pr+=i tab ColWidth[ i ] cr
next
return pr
end method


method justify(char*j)
======================
jus=j
end method

method delimiter(char*j)
========================
dlm=j
end method

method endofline(char*j)
========================
cr=j
end method


method layout() as char*
========================
sys a, b, wa, wb, wl, cm, lpos, cpos
bufo=space Rows*TotWidth
a=1 : b=1
do
  wb=b
  a=instr(b,buf,cr)
  if a=0 then exit do
  cm=0
  cpos=1
  do
    wa=instr(wb,buf,dlm)
    if wa=0 or wa>a then exit do
    '
   cm++
    '
   'JUSTIFICATION
   '
   wl=wa-wb
    p=lpos+cpos 'default "L" LEFT ALIGN
   '
   select case asc(jus,cm)
      case "R" : p=lpos+cpos+ColWidth[cm]-wl-Colpad
      case "C" : p=lpos+cpos+( ColWidth[cm]-wl-Colpad )*.5
    end select
    '
   mid bufo,p, mid buf,wb,wl
    cpos+=colwidth[cm]
    wb=wa+ld
  end do
  b=a+len cr
  lpos+=TotWidth
  if lpos<len(bufo) then mid bufo,lpos-1,cr
end do
return bufo
end method

end class

'#recordof AlignedText

AlignedText atxt

function AlignText(char *in,*ju,*dl,*cr) as char*
=================================================
atxt.justify         ju
atxt.delimiter       dl
atxt.endofline       cr
atxt.SetText         in
return               atxt.layout
end function

sub finish()
'===========
 terminate
end sub

function link(sys n) as sys
'==========================
 select n
  case 0 : return @finish
  case 1 : return @reverse
  case 2 : return @getword
  case 3 : return @AlignText
  end select
end function

end extern

addr link
 
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 06, 2014, 05:40:58 am by support »