'========
'TESTLOG1
'========

/*
$ filenae "t.exe"
uses rtl32
print "helo"
*/



/*
mov eax,-1
'mov al,0
and eax,1
print hex eax
*/

/*
'07:51 21/08/2018
'SET CONDITIONAL
int a,b
byte c
a=0
b=1
a-b
setl byte c
cmp c,0
jz np
print c
.np
*/

/*
'REDEFINING PRIMITIVE
undef int
typedef short int

print sizeof int
int v
#recordof v
*/

/*
'11:36 18/08/2018
'INDIRECT TYPES
string s="helo"
typedef string *pstr
pstr p
@p=@s
'int f(bstring s){print s}
'int f(bstring*s){print s}
int f(pbstr s){print s}
#show f s
#show f p
*/

/*
'11:13 18/08/2018
'INDIRECT TYPES
bstring s="helo"
typedef bstring *pbstr
pbstr p
@p=@s
'int f(bstring s){print s}
'int f(bstring*s){print s}
int f(pbstr s){print s}
#show f s
#show f p
*/


/*
'11:13 18/08/2018
'INDIRECT TYPES
char s[100]="helo"
typedef char *pchar
pchar p
@p=@s
'int f(char*s){print s}
int f(pchar s){print s}
#show f s
#show f p
*/

/*
'03:23 18/08/2018
'INDIRECT TYPES
typedef struct {
  float x,y,z
} vec,*pvec

'sys f(pvec a) nosig {}
'sys f(pvec a) {}
function f1(vec* a) {}
function f2(pvec a) {}
#recordof f1
vec v {1.2.3}
pvec pv
@pv=@v 'ok
#show f2 v 'ok
#show f2 pv 'corrected indirection
*/


/*
'19:03 15/08/2018
'CONVERSIONS
quad a
sys b
short c
'fld1
'fistp qword a
'print a
double f(){}
#show b=f()
*/

/*
$filename "t.exe"
'uses rtl64
uses corewin

extern

#show int foo(double a,b,c,d){}

function cformat(char*f, ...) as string
=======================================
  'restricted to one value only
  indexbase 1
  char od[64]
  #ifdef mode64bit
    sprintf od,f,param[2]
  #else
     sprintf od,f,param[2],param[3]
  #endif
  return od
end function
  
print cformat( "%g" , (2^63)-1 )
'finit
'quad q
'q=d
'print q
'#show sprintf od,"%g", double d : print od
'#show sprintf od,"%lli",  quad q : print od 'converter problem
*/

/*
'int f(extended e,int i){}
'#show f 1,2

quad a=1.5e18
print a
if a>100 then print "ok"
*/



/*
'18:08 08/08/2018
'TEST SELF-COMPILED DLL
uses corewin
'sleep 5000
uses console
string=version
print s
wait
*/


/*
'11:47 02/08/2018
'dword negatives 64bit
$ filename "t.exe"
uses rtl64
uses corewin
% zz -520
extern
function f(byte v){}
'dword zz=-520
'dword zz=-20
int zz =-20
'byte zz=-20
#show sleep zz
#show f zz
print hex zz
*/


/*
'08:36 28/07/2018
'G1 TESTS
int a
#show a
print "ok"

'-----------------------
*/


/*
'asm instruction set
#recordof add
*/


/*
function f(int a,string s){}
int a
bstring b
string s
#show f edi,"Q"
*/

/*
'05:14 22/07/2018
$filename "t.exe"
uses rtl64
mbox "helo"
*/

/*
type vec int x,y,z
extern virtual
class cc
'int f(){}
! f
method g
method h(int a)
end class

'function f(int a,b, string s){}

end
cc c
int *a
wbstring b
string s
vec v
'#show f 1,2,b
#show c.f 1,2,v
*/

/*
'22:30 16/07/2018
'
class mytype

  int a
  int b

  Function myfunc() as int
  return a+b
  End Function

end class

mytype t
t.a=1
t.b=2
print t.myfunc()
*/

/*
'19:26 14/07/2018
'BASIC CALL BY INDEX
sub f1(){print "f1"}
sub f2(){print "f2"}
sys p{@f1,@f2}
int i=1
call p[i]
*/



/*
'02:22 13/07/2018
'function pointer in advance
'! function f(int a)
print @f
function f(int a) callback {}
*/


/*
'02:22 13/07/2018
'http://teragonaudio.com/article/How-to-make-your-own-VST-host.html
'http://ygrabit.steinberg.de/~ygrabit/public_html/vstgui/V2.2/doc/2.0/examples.html

'typedef VstIntPtr (VSTCALLBACK *audioMasterCallback) (
' AEffect* effect,
' VstInt32 opcode,
' VstInt32 index,
' VstIntPtr value,
' void* ptr,
' float opt);

extern cdecl

function HostCallback (
=====================
  AEffect* effect,
  VstInt32 opcode,
  VstInt32 index,
  VstIntPtr value,
  void* ptr,
  float opt
 ) as sys, callback
 ...
end function

end extern

...
'@HostCallback

string vstPath="..." 'specify pathname
sys VST=LoadLibrary(vstPath)
sys p=GetProcAddress(VST,"VSTPluginMain")
sys plugin = call p(@HostCallback)
*/

/*
  '20:16 09/07/2018
  'auto GC using a string
  '
  class obj1 {
  ============
  '
  float fv
  '
  sys constructor(float v) {
    fv=v
  }
  '
  sys destructor() {
  }
  '
  obj1* create(float v) {
    new obj1 g(v)
    return @g
  }
  '
  sys create(int v, string*buf) {
    buf=nuls sizeof obj
    obj1 g at strptr buf
    g.constructor(v)
    return @g
  }
  '
  } 'class
  '
  'TESTS:
  =======
  string b
  'obj1 b at obj1.create(2,b)
  'obj1 b at obj1.create(2)
  'obj1 *b = obj1.create(2)
  '#show let b = obj1* obj1.create(2)
  '#recordof b
*/
  


/*
let a=float 42.0
#recordof a
print a
*/

/*
'19:48 02/07/2018
'MACRO FUNCTION ANY
macro m any (A,B,C)
A=B+C
end macro

string a="a", b="b"
#show wstring s=m(a,b)
print s
*/

/*
'19:46 02/07/2018
'UNICODE FILE I/O
uses corewin

function wGetFile(wstring n) as wstring
======================================
sys f
int e
wstring m="rb"
wbstring s
f=_wfopen n,m         'open for reading binary
if not f then return ""
fseek f,0,2           'end of file
e=ftell f             'get position
fseek f,0,0           'beginning of file
strptr s=getmemory e  'create buffer to fit
fread s,1,e,f         'load buffer
fclose f              'close file
return s
end function


function wGetFile(wstring n,*s)
==============================
s=wGetFile n
end function


function wPutFile(wstring n,s) as int
====================================
sys f
wstring m="wb"
int e=len s
f=_wfopen n,m         'open for writing binary
if not f then return 0
e=fwrite s,1,e*2,f    'save data
fclose f              'close file
return e
end function
'
macro ugetfile (f,s)
===================
#if widthof(s)=2
  wgetfile(f,s)
#else
  getfile(f,s)
#endif
end macro
'
macro uputfile (f,s)
===================
#if widthof(s)=2
  wputfile(f,s)
#else
  putfile(f,s)
#endif
end macro
'
'
'TESTS
======
'
wstring f="t.txt"
wstring s
's=getfile f
ugetfile(f,s)
print s
f="s.txt"
uputfile(f,s)
print "ok"
*/

/*
'14:21 02/07/2018
'PRIOR
function f(){print 1}
macro f()
prior f
end macro
'#recordof f
f
*/


/*
'10:51 30/06/2018
'NUMERAL MEMBER
type vec float 1,x,y,z
vec v
#recordof vec
'print v.1
*/

/*
'10:49 30/06/2018
'DEFAULT ARRAY VALUES?
'int a{1,2,3,4,5}
'print a[3]
'int a{1}
'#recordof a
type series
  int n={1,2,3,4,5,6,7,8,9}
end type
'series s[9]={}
series s[9]={}
#recordof s
s={10}
print s[1].n "   " s[4].n
*/

/*
'11:04 29/06/2018
'STRING LITERAL ALIGNMENT
string s[]={"abc","def"}
'print hex strptr s[1]
'print hex strptr s[2]
print hex strptr "abc"
print hex strptr "abc"
*/

/*
'19:05 27/06/2018
'CLASS RESOLVES INTO A TYPE
class vec
float x,y,z
'method m(){}
end class

#recordof vec_table
*/

/*
'19:00 27/06/2018
'SIMPLIFIED ASSIGN SYNTAX
int a[4]{1,2,3,4}
int a[]{1,2,3,4}
int a{1,2,3,4}
print a[3]
*/

/*
'12:04 26/06/2018
'THE MINIMAL CLASS
*/


/*
'22:18 22/06/2018
'#KEY CATEGORIES
oop
cons
gui
math
gl
midi
aud
com
media
web
dbase
plang
ide
edit
graph
c1..c10 complexity

*/


/*
'17:18 22/06/2018
'CHECK LET
let a=10.
#recordof a
*/

/*
'15:52 21/06/2018
'IMPLICIT-GOTO PROBLEM
'concession to Dartmouth Basic
int i=0
if i then 10.A
print 234
10.A print 123
*/

/*
'17:51 20/06/2018
'TYPECODES
"
void      0x00 '* -1, Used by reference only
sbyte     0x01
byte      0x21
ubyte     0x21
string    0xe1
string2   0xe2
wstring   0xe2
bstring   0xc1
gstr_     0xc1 '* Accept any Bstring width. for core functions only
bstr      0xc1
wbstring  0xc2
char      0xa1
wchar     0xa2
cstr_     0xa1 '* Accept any char width. for core functions only
asciiz    0xa1
zstring   0xa1
wzstring  15 0xa2
asciiz2   15 0xa2
short     15 0x02
long      0x04
wide      0xa2
int       0x04
integer   0x04
float     0x64
single    0x64
double    0x68
extended  0x6A
quad      0x48 '* using FPU on 32 bit systems (was 08), returns data on edx:eax
word      0x22
dword     0x24
ulong     0x24
uint      0x24
any       0x08 '* to be used by reference only
sys       0x08 '* 4/8 depending on 32/64 bit system
bool      0x04 '* MS
boolean   0x01 '* MS
fpu       0x40 '* fast call using fpu registers (not exportable)
signed    0x04
unsigned  0x24
qword     0x28 '* Assembler only
"

'SOME SPECIAL CASES:
print hex typecodeof wide char
'print hex typecodeof signed wide char
'print hex typecodeof signed dword
'print hex typecodeof signed qword
'print hex typecodeof fpu
'print hex typecodeof quad
'print hex typecodeof sys
'print hex typecodeof any
'print hex typecodeof void
'print hex typecodeof qword
'print hex typecodeof cstr_
'print hex typecodeof gstr_
*/


/*
'11:36 20/06/2018
'REDIM REVIEW
def redim
=========
  '
  'redim %1 %2(%3)
  '%1  type of array
  '%2  name of array
  '%3  number of elements
  '
  #ifndef %2_buf
    dim static string %2_buf = ""
    dim static int %2_count
    dim static %1 byref %2
  #endif
  %2_count=%3
  scope
    dim sys %2_qn = len(%2_buf) / sizeof(%2)
    if %2_count > %2_qn 'EXTEND ARRAY
      %2_buf += nuls( sizeof(%2) * (%2_count - %2_qn) )
    elseif %2_count <  %2_qn 'REDUCE ARRAY
      #if (typecodeof(%2)>0xc0)and(typecodeof(%2)<0x100)
        string *%2_str : @%2_str = @%2
        'DISPOSE OF BSTRING AND STRING ELEMENTS
        do
          if %2_qn<=%2_count then exit do
          %2_qn--
          freememory strptr %2_str
          strptr(%2_str) = 0
          @%2_str+=sizeof sys
        loop
      #endif
      %2_buf = left( %2_buf, sizeof(%2) * %2_count )
    end if
    @%2=strptr %2_buf
  end scope
end def
'
'TESTS:
=======
int n=1000
redim string s(n)
s(100)="ABC"
s(101)="abc"
print s(101)
redim string s(200)
'print s(100)
function f()
  n=100
  redim string s(n)
  print s[100]
  s[100]="DEF"
end function
'
f()
print s[100]
print "ok"
'
*/


/*
'08:52 20/06/2018
'TREES
'lists using negative pointers
*/

/*
'21:21 19/06/2018
'STRING AND DYNAMIC ARRAY INTERCHANGE
int v at getmemory 100*sizeof int
v[10]=55
bstring s
'?s=@v
strptr s=@v
'putfile "t.txt",s
'-----------
bstring t=s
int w at strptr t
print w[10]
del s
del t
*/


/*
'21:11 19/06/2018
'OPTIMISING WITH ASSEMBLER
uses console

dim int ar(100*16)

'macro arr(r,c)
'  ar((r)*16+c)
'end macro

int i,j
int *a
int ii
for i=1 to 100
  @a=@ar(i*16)-16 'set pointer address
  addr edi,a
  mov eax,ii
  mov ecx,16
  (
   inc eax
   mov [edi],eax
   add edi,4
   dec ecx
   jg repeat
  )
  ii+=10
  'for j=1 to 16
  '  'arr(i,j)=i*10+j
  '  a=i*10+j
  '  @a+=sizeof int 'ptr next element
  'next
next
'
for i=1 to 10
  @a=@ar(i*16)-16 'set pointer address
  for j=1 to 8
    'print arr(i,j) tab
    print a tab
    @a+=sizeof int 'ptr next element
  next
  print cr
next
wait
*/


/*
'18:21 19/06/2018
type pixel float r,g,b,a
type row pixel x[640]
type img row y[480]
img i
int j=8
#show i.y[j].x[j].r=42.5
print i.y[j].x[8].r
*/

/*
'10:04 19/06/2018
'ANCIENT BASIC / DARTMOUTH / ECMA 55
let a=1
if a then goto 20
print "nok"
20 print "ok"
*/


/*
redim int ArrayK[0]

sub aa()
int t=50
  redim  int ArrayK[t]
  ArrayK (20) = 100
  print ArrayK (20)
end sub

call  aa
print ArrayK (20)
*/

/*
'20:09 18/06/2018
'TRAVERSING 2D ARRAY USING A POINTER
'INSTEAD OF A MACRO

uses console

dim int ar(100*16)

'macro arr(r,c)
'  ar((r)*16+c)
'end macro

int i,j
int *a
for i=1 to 100
  @a=@ar(i*16) 'set pointer address
  for j=1 to 16
    'arr(i,j)=i*10+j
    a=i*10+j
    @a+=sizeof int 'ptr next element
  next
next
'
for i=1 to 10
  @a=@ar(i*16) 'set pointer address
  for j=1 to 8
    'print arr(i,j) tab
    print a tab
    @a+=sizeof int 'ptr next element
  next
  print cr
next
wait
*/

/*
'17:09 18/06/2018
'2D ARRAY USING A TYPE

uses console

type RowType
  int c[16]
end type

dim RowType r[100]
int i,j
for i=1 to 100
  for j=1 to 16
    #show r[i].c[j]=i*10+j
  next
next
'
for i=1 to 10
  for j=1 to 8
    print r[i].c[j] tab
  next
  print cr
next
wait
*/


/*
'2018-06-15T17:40:50
'LISTINGS
int a,b
#show  "t.txt" {
a=1 
b=2
}
*/


/*
'2018-06-15T17:26:41
'MACRO ERROR TRAPPING
macro swap(A,B)
===============
#if typecodeof(A)<>typecodeof(B)
  #error Swap type mismatch: A, B
#else
  typeof(A) C
  C=A
  A=B
  B=C
#endif
end macro

int aa
short bb
swap aa,bb
*/


/*
'2018-06-15T03:43:13
'SWAP BETWEEN DIFFERENT TYPES
uses generics
type vector2 float x,y
type vector3 float x,y,z
vector2 v2
vector3 v3
#show swap v2,v3
*/


/*
'2018-06-15T03:36:31
'SWAP VALUES BETWEEN TYPES
'
  macro Swap(a,b,    c)
  =====================
  typeof(a) c=a
  a=b
  b=c
  end macro

  int a=100
  string s="99"
  swap a,s
  print s
*/

/*
class StackOfPtrs
===========
  '
  sys bu 'buffer pointer
  int bl 'length of buffer
  int bi 'position in buffer
  '
  method constructor()
  ====================
  end method
  '
  method destructor()
  ===================
  freememory bu
  bi=0 : bl=0
  end method
  '
  method push(sys p)
  ==================
  int i=bi+sizeof sys
  if i>bl then 'stretch buffer
    int bo=bu
    int bq=bl
    bl=bl+256
    bu=getmemory bl
    if bo then copy bu,bo,bq : freememory bo
  end if
  sys q at bu+bi
  q=p
  bi=i  
  end method
  '
  method pop() as sys
  ===================
  if bi then
    bi-=sizeof sys
    sys q at bu+bi
    return q
  end if
  end method
  '
end class
'
'TESTS
======
string s={"one","two","three"}
new StackOfPtrs st()
int i
for i=1 to 3
  st.push strptr s[i]
next
bstring t
for i=1 to 4
  strptr t=st.pop
  print t
next
*/

/*
'2018-06-13T21:07:05
'MACROS AND NAMESPACES
namespace xx
'
macro ma(a)
  print a
end macro
'
macro mb(a)
  xx::ma(a)
end macro
'
end namespace

xx::mb("hello")
*/

/*
'2018-06-13T15:03:24
class IntArrayYX
================
  '
  %= si sizeof(int)
  '
  int lboundX 'lower limit X
  int uboundX 'upper limit X
  int lboundY 'lower limit Y
  int uboundY 'upper limit Y
  int width
  sys buf    'data buffer
  int bytes  'sizeof buffer
  '
  method constructor(int ly=0, uy=0, lx=0, ux=0)
  ===============================================
  'ly lbound y lines
  'uy ubound y lines
  'lx lbound x rows
  'ux ubound x rows
  lboundY=ly
  uboundY=uy
  lboundX=lx
  uboundX=ux
  width=(uboundx-lboundx+1)
  bytes=si*(uboundy-lboundy+1)*width
  buf=getmemory bytes
  end method
  '
  method destructor()
  ===================
  freememory buf
  end method
  '
  method vi(int i, j, int v)
  ==========================
  'SET
  'i index
  'v value
  int a at buf+si*( (i-lboundy)*width+(j-lboundx) )
  a=v
  end method
  '
  method vi(int i, j) as int
  ==========================
  'GET
  'i index
  int a at buf+si*( (i-lboundy)*width+(j-lboundx) )
  return a
  end method
  '
  method ptr(int i, j) as sys
  ===========================
  'GET POINTER
  'i index
  return buf+si*( (i-lboundy)*width+(j-lboundx) )
  end method
  '
end class
'
'TESTS
======
new IntArrayYX ia(-10,20,30,40) 'lbound,ubound pairs
print ia.lboundY ", " ia.bytes
ia.vi(-5,31)=42
print ia.vi(-5,31)
del ia
*/

/*
'2018-06-13T09:36:41
class IntArray
==============
  '
  %= si sizeof(int)
  '
  int lbound 'lower limit
  int ubound 'upper limit
  sys buf    'data buffer
  int bytes  'sizeof buffer
  '
  method constructor(int l=0, u=0)
  ================================
  'l lbound
  'u ubound
  lbound=l
  ubound=u
  bytes=si*(ubound-lbound+1)
  buf=getmemory bytes
  end method
  '
  method destructor()
  ===================
  freememory buf
  end method
  '
  method vi(int i,int v)
  ======================
  'SET
  'i index
  'v value
  int a at buf+(i-lbound)*si
  a=v
  end method
  '
  method vi(int i) as int
  =======================
  'GET
  'i index
  int a at buf+(i-lbound)*si
  return a
  end method
  '
  method ptr(int i) as sys
  ========================
  'GET POINTER
  'i index
  return buf+(i-lbound)*si
  end method
  '
  method resize(int n)
  ====================
  'n number of elements
  sys bo=buf
  sys lo=bytes
  n*=si
  bytes=n
  buf=getmemory n
  if bytes then
    if n<lo then lo=n
    copy buf,bo,lo
  end if
  freememory bo
  end method
  '
end class
'
'TESTS
======
new IntArray ia(10,20) 'lbound, ubound
'print ia.lbound ", " ia.bytes
ia.vi(15)=42
print ia.vi(15)
del ia
*/

/*
'2018-06-12T09:47:06
'INDEXBASE TESTS
indexbase 0
int a[0]
print spanof a
indexbase -10
int a[-10]
print spanof a
*/

/*
'2018-06-12T09:42:45
'NAMESPACE TESTS
'goto xx::k
'call xx::f
'call f
'xx::f
namespace xx
function f(){print "ok"}
'call xx::f
'call f
'#show goto k
'.k
class cc
method m(){print "m ok"}
end class
cc c
end namespace xx
'#recordof f
'#show call xx::f(1)
'#show gosub xx::f
int a=xx::f
'xx::cc c
'c.m
xx::c.m
*/


/*
'2018-06-10T11:51:06
'BUFFER (also used in co2)
uses ParseUtil
'TESTS
======
buffer b
b.in "hello "
b.in "World!"
print b.out
print b.out
print "ok"
*/


/*
'2018-06-10T07:19:43
'check mixed type arithmentic 64bit
$filename "t.exe"
uses RTL64
sys a=0x40000000
shl a,2
int b=1
#show a+=b
print hex a
*/


/*
macro MakeLong(lo,hi) { ( (lo) or ( (hi)<<16 ) ) }
byte lo=4
byte hi=8
print hex makelong lo,hi
#recordof makelong
*/



/*
'2018-06-06T12:00:01
'NAMESPACES

int i=1

namespace aa
int i=10
namespace bb
int i=20
namespace

print i + aa::i + bb::i '31

namespace bb
print i '20
namespace
*/



/*
'2018-06-05T15:55:49
'TYPE LOCALISED INSIDE CLASS
============================
'
class cc
========
  '
  sys bu
  '
  type tt
  =======
  float x,y,z
  end type
  '
  method m()
  ==========
  tt*t=bu
  print @t.x
  end method
  '
end class

#recordof cc
*/

/*
'2018-06-04T08:13:10
'NON OOP INTERFACE FOR DLLS
'USING HANDLES

$filename "t.dll"
$dll
uses rtl32
extern

class cc
method mm(){print "ok"}
end class

function create() as sys, export
new cc c
return @c
end function

function destroy(sys h) as sys, export
cc*c=h
del c
end function

declare mm at @cc.mm, export

end extern
*/
'
/*
'TESTS
extern lib "t.dll"
! create
! destroy
! mm

sys a=create()
mm(a)
destroy(a)
*/

/*
'2018-06-04T05:48:15
$filename "t.exe"
'uses rtl64

function f() as string
'print sizeof string
sys p=getmemory 100
bstring s at p+8
'@s=p

'#recordof s
s[1]=1
s[2]=2
'print s[1] s[2]
bstring s at p+12
return s
end function

print f
*/


/*
'2018-05-28T04:09:43
'TRACER UTILITY MACRO
'
uses console
macro tracer(pn)
  color 0x0e
  #ifdef i
    output pn tab i cr
  #else
    output pn cr
  #endif
  color 0x07
end macro

#Insert tracer
function ff(int i=1){
printl "native"
}
function gg(int i=2){ff(0x65)}
#insert 'ending #insert
gg()
printl "ok"
wait
*/


/*
'17:26 25/05/2018
'TRACER UTILITY SUB
'
uses console
sub tracer(string s)
  color 0x0e
  output s cr
  color 0x07
end sub

#Insert tracer
function ff(){
printl "native"}
'#insert 'ending #insert
function gg(){ff}
gg
printl "ok"
wait
*/



/*
'11:05 27/05/2018
'extract table block
int bx,by,ex,ey,sx,sy
int i,j,x,y,yst
bx=5
by=7
ex=10
ey=20
sx=100
sy=1
yst=0
i=0
indexbase 0
for y=by to ey
  for x=bx to ex
    j=x+yst
    r[i]=s[j]
    i++
  next
  yst+=sx
next
*/

/*
'22:28 26/05/2018
'Test indirection
'function f(byref a as int) as int {print a[1]}
'function f(int *a) as int {print a[1]}
function f(int a[]) as int {print a[1]}
int v[100]
v[1]=42
f v
*/

/*
'13:41 26/05/2018
'bstring assignment
bstring s
#show (sys) s=getmemory 32
'#show ?s=getmemory 32
'#show bstring s=getmemory 32
#show strptr s = getmemory 32
*/



/*
'12:52 25/05/2018
'LOW LEVEL CONDITIONAL BLOCKS
int a,b
a-b
{
 jnz exit
 print "ok"
}
*/


/*
'12:26 25/05/2018
'TESTING EXCESS SHIFTS (mdulo 31)
mov eax,-1
mov ecx,31
mov cl,0x70
shr eax,cl
print hex eax
*/

/*
'11:39 24/05/2018
'stack corruption (fixed)
sub f(sys v){ print v }
f -22
print "pgm exit"
*/

/*
'2018-05-23T15:28:42
'empty default function param
string f(int a=5){return "12345"}
print left(f(),2)
*/

/*
'2018-05-22 T 16:22:16
'Test half-float functions
uses Console
uses MathUtil
float f={0,1,2,3,4,5.5,100,0.001,pi(),1/0,-1/0,0/0}
word h[100]
float g[100]
int i,e=12
FloatToHalfFloat @f,@h,e
HalfFloatToFloat @h,@g,e
int i
for i=1 to e
  printl f[i] tab hex(h[i],4) tab g[i]
next
wait
*/

/*
'2018-05-22 T 11:54:28
'GL_ARB_half_float_pixel GL_ARB_half_float_vertex
'https://www.khronos.org/registry/OpenGL/extensions/ARB/ARB_half_float_pixel.txt
'New Tokens
'
'    Accepted by the <type> parameter of DrawPixels, ReadPixels,
'    TexImage1D, TexImage2D, TexImage3D, GetTexImage, TexSubImage1D,
'    TexSubImage2D, TexSubImage3D, GetHistogram, GetMinmax,
'    ConvolutionFilter1D, ConvolutionFilter2D, GetConvolutionFilter,
'    SeparableFilter2D, GetSeparableFilter, ColorTable, ColorSubTable,
'    and GetColorTable:
'
'https://www.khronos.org/registry/OpenGL/extensions/ARB/ARB_half_float_vertex.txt
'New Tokens
'
'    Accepted by the <type> argument of VertexPointer, NormalPointer,
'    ColorPointer, SecondaryColorPointer, FogCoordPointer, TexCoordPointer,
'    and VertexAttribPointer:
'
'        HALF_FLOAT_ARB                                0x140B
'
'declare glGetString lib "opengl32.dll"
'#define GL_VENDOR                         0x1F00
'#define GL_RENDERER                       0x1F01
'#define GL_VERSION                        0x1F02
'#define GL_EXTENSIONS                     0x1F03
'#define GL_SHADING_LANGUAGE_VERSION

uses OpenglSceneFrame

sub initialize(hwnd)
char*z
@z=glGetString GL_EXTENSIONS
mbox z
'putfile "t.txt",z
end sub

sub release(hwnd)
end sub

sub scene(hwnd)
end sub
*/


/*
'2018-05-20 T 08:59:17
'view float bits (exponent bias)
float f=1.0
print hex cast int f
*/

/*
'2018-05-20 T 08:55:54
'word / short return conversions
function f() as word {return -1}

'#show int b=f
'print b
#show int b=1+f()
8/
print b


/*
'2018-05-17 T 23:11:20
'class asm listing
'checking for stack anomalies
#show "t.txt" class cc {
  int a[100]
  sub constructor(){
  'int c
  a={1}
  }
}
*/


/*
'2018-05-17 T 13:25:05
'ext/extended tests
$filename "t.exe"
'uses rtl64
uses console
extended e[100]
print sizeof extended cr '10 (80 bits)
print spanof e cr  '100 elements
print bytesof e cr '1000 bytes
e[1]=pi
e[2]=pi
print e[1] cr e[2] cr
type ee
extended e
dword d
end type
print sizeof ee cr
print recordof ee cr
string s=str 10*pi
print s cr
print len(s) cr
int f(extended e1,extended e2){
print recordof e1 cr
print recordof e2 cr
}
f pi,pi
wait
*/

/*
int a,b,c

int i
'#show i=(a? b:c)
macro iif int(r,a,b,c)
if a then
  print "ok"
  r=b
else
  r=c
  print "nok"
end if
end macro
#recordof iif
i=iif(a,b,c)
*/

/*
'2018-05-16 T 05:12:56
'#endif following macro with empty param
int f(int v=42){print v}
def mm
#ifdef f
f(%3)
#endif
end def

#show mm 1 2  
print "ok"
*/


/*
'2018-05-13 T 17:00:55
'VIRTUAL CLASS
 
extern export

class ObjectX
=============
  '
  bstring *t
  bstring t_buf
  int     t_count
  '
  method constructor()
  redim bstring t(8)
  end method
  '
  method destructor()
  indexbase 1
  int i
  for i=1 to t_count
    del (t[i]) 'del each bstring
  next
  del t_buf
  end method
  '
  method act(string s)
  print t[5]+s
  end method
  '
  method new() as sys
  'STATIC SELF CREATE
  'cannot call own methods
  new ObjectX a
  a.t[5]="Hello "
  return @a
  end method
  '
end class

function CreateObjectX() as sys
===============================
return ObjectX.new
end function

end extern


=======================================


extern virtual
class ObjectXV
  method constructor()
  method destructor()
  method act(string s)
end class
end extern

=======================================

'ObjectXV*bb=CreateObjectX
'ObjectXV bb at CreateObjectX()
ObjectXV*bb : @bb=CreateObjectX
'#recordof bb
bb.act "world"
del bb

*/


/*
'2018-05-12 T 23:29:27
'PEEK INTEGERS
uses console
string t="abcd    efghijklmnopqrstuvwxyz"
indexbase 0
int i
int v at strptr t
int e=(len(t)-1)\4
for i=0 to e
  printl hex v[i]
next
wait
*/

/*
'2018-05-12 T 06:15:57
'PB shrink
'itr wide strings
uses console

function shrink(string s,m=" ") as string
=========================================
indexbase 1
int le=len s
int lm=len m
string t=nuls le
byte bs at strptr s
byte bm at strptr m
byte bt at strptr t
byte b
int c,i,j,k
c=1 'first char shrinkable
while i<le
  i++
  b=bs
  for k=1 to lm 'check with shrink chars
    if bm[k]=bs then 'matched
      if i=le then
        if c>=1 then
          if j then j-- 'remove prev shrink char
        end if
        exit while 'last char shrinkable
      end if
      c++ 'count
      if c>1 then
        @bs++ : continue while 'skip this char
      end if
      b=bm 'to assign first m character
    end if 'matched shrink char
  next 'shrink char check
  if b<>bm then
    c=0 'reset counter
  end if
  bt=b
  j++
  @bs++
  @bt++  
loop
return left t,j
end function
'
'TESTS
======
print shrink ("12  34 , ,  56") cr
print shrink ("12  34 , ,  56"," ") cr
print shrink ("12  34 , ,  56"," ,") cr
print shrink ("12  34 , ,  56",", ") cr
print shrink (",,12  34 , ,  56, , , ",", ") cr
print shrink (",",",,") cr
print shrink (",",",") cr
wait
*/


/*
'2018-05-12 T 04:02:20
'condition+assignment combo
uses console
int foo(){ static int i : return i++}
int a
while ((a:=foo())<100){print a cr}
wait
*/

/*
'2018-05-12 T 03:35:52
'autodim disabled by default
$ filename "t.exe"
use rtl64
#autodim off
use console
use corewin
*/


/*
'2018-05-10 T 06:44:00
'NUMBER TYPE MATCHING PROBLEM
$filename "t.exe"
uses rtl64
sys a,b
#show a=b>>16
*/


/*
'2018-05-10 T 04:37:56
'menus3
'quote
string s=quote """

"hello"

"""

print s
*/


/*
'2018-05-10 T 04:22:21
'investigate 32bit numbers
$filename "t.exe"
uses rtl64
int f(sys b){}
#show f 42
*/


/*
'2018-05-10 T 03:31:36
'Fixed rtl64 getfile f,s
$filename "t.exe"
uses rtl64
string s
getfile "t.txt",s
print left s,1000
*/

/*
'2018-05-09 T 17:20:03
'inkey
uses console
int k
do
  k=inkey 'non-blocking
  if k then print k " "
  sleep 10 'important!
loop
*/


/*
'2018-05-09 T 12:45:19
'gosub / goto conditional

function f()
  int a=42,b=1
  b=1
  gosub xx when b=1 '0
  exit function
  xx:
  print a
  ret
end function
*/

/*
'2018-05-09 T 04:39:25
'loops
uses console
string nextchar
function getchar() as byte {return waitkey():}
'
function GetNextChar() as byte
byte nextchar
'do { nextchar=getchar() } while nextchar=32
'do : nextchar=getchar() : loop while nextchar=32
'do : nextchar=getchar() : loop until nextchar<>32
'do : nextchar=getchar() : exit when nextchar<>32 : loop
'do : nextchar=getchar() : exit if not nextchar=32 : loop
return nextchar
end function

print GetNextChar()

'while ((NextChar = getchar()) == " "){}
wait
*/

/*
class LavaObject
================
 '
 method constructor()
  ...
 end method
 '
 method desstructor()
  ...
 end method
 '
 method act()
  ...
 end method
 '
end class

class DustObject
================
 '
 method constructor()
  ...
 end method
 '
 method desstructor()
  ...
 end method
 '
 method act()
  ...
 end method
 '
end class

class FlameObject
=================
 '
 '
 method constructor()
  ...
 end method
 '
 method desstructor()
  ...
 end method
 '
 method act()
  ...
 end method
 '
 '
end class

class VocanoObject
==================
 '
 lavaObject*lava
 DustObject*dust
 FlameObject*flame
 '
 method constructor()
  new LavaObject a() : @lava=@a
  new DustObject a() : @dust=@a
  new FlameObject a(): @flame=@a
 end method
 '
 method destructor()
  del lava
  del dust
  del flame
 end method
 '
 method act()
  lava.act()
  dust.act()
  flame.act()
 end method
 '
end class
*/


/*
redim int a(0)
#recordof a
*/


/*
int i
float f=floor -5.4
i=f
print i
*/

/*
extended v=1/0
print v+v
print -v-v
print v+100
print v*2
print v/0
print v-v 'qNAN
*/

/*
'2018-05-07 T 17:17:02
'integer division crash
'integer i=1\0
float i=1\0
print i " ok"
*/

/*
'2018-05-07 T 10:27:49
'unary conditional
double v
float v
*/

/*
'2018-05-07 T 16:56:38
'infinit floats
'$filename "t.exe"
'uses rtl64
'print round 1.5
'print -0.1\1
float a=-1/0
'print a
'print 1/a
'print deg atn a
'print -a-a
int i=1/0
print hex i
*/

/*
'2018-05-07 T 10:21:50
'converter issue
float i=4.5
#show i=int i
print i
*/

/*
'2018-05-06 T 14:01:44
'auto string conversions
'int a="0x"+"30"
string a=chr "0x"+"30"
print a
*/

/*
'2018-05-05 T 14:37:59
'
$filename "t.exe"
'uses rtl64
'uses corewin
uses console
int a
do
  a++
  printl a
loop
*/


/*
'2018-05-05 T 14:35:05
type Vector3dUnity
float x=1.0
float y=1.0
float z=1.0
end type

Vector3dUnity v 'initially all 0
v={}            ' v.x=1.0  v.y=1.0  v.z=1.0
v={ y=2.5 }     ' v.x=1.0  v.y=2.5  v.z=1.0
*/

/*
'2018-05-04 T 23:07:31
'default values of types
'using multiassign
'
type matrix4x4
==============
  float v[16]={1,0,0,0, 0,1,0,0, 0,0,1,0,  0,0,0,1}
end type
'
'TESTS
======
#recordof matrix4x4
matrix4x4 m {}
print m.v[1]
print m.v[6]
*/


/*
'2018-05-04 T 03:28:31
'sizeof pointers
def printd print "%1 %2 " %1 %2
'typedef void *pt
type vector float x,y,z
typedef vector *pt
pt p[5]
printd sizeof pt
printd sizeof p
printd bytesof p
printd countof p
printd spanof p
#recordof p
*/

/*
'2018-05-03 T 18:46:20
'default values of types
'
type matrix4x4
==============
  float x1y1=1.0, x1y2=0.0, x1y3=0.0, x1y4=0.0
  float x2y1=0.0, x2y2=1.0, x2y3=0.0, x2y4=0.0
  float x3y1=0.0, x3y2=0.0, x3y3=1.0, x3y4=0.0
  float x4y1=0.0, x4y2=0.0, x4y3=0.0, x4y4=1.0
end type
'
'TESTS
======
#recordof matrix4x4
matrix4x4 m {}
print m.x3y3
m {x1y1=2.0}
print m.x1y1
*/

/*
'2018-05-04 T 02:47:47
'header formats
macro mac any* (
  r,        'return
  x,y,z,    'params
  xx,yy,zz  'temps 
){...}
*/

/*
'2018-05-03 T 17:57:14
'
'compact swap
macro swap(a,b, c){ typeof(a) c=a : a=b : b=c }
'
'single-liner without curly braces
macro swap(a,b, c) typeof(a) c=a : a=b : b=c
'

int a=1,b=2
swap a,b
print a
*/

/*
'2018-05-03 T 17:29:09
'default params
'
macro mm int(r,a=1,b=2,c=4,d=8, s,t)
====================================
r=a+b+c+d
end macro
'
'TESTS
======
'#recordof mm
print mm(10,20,40,80)
print mm
print mm()
print mm(11)
print mm(d=108)
print mm(a=1001,d=108)
*/


/*
'2018-05-03 T 11:26:29
'peeks and pokes
'
macro peeks string(r,v,i,n)
===========================
'r returned string
'v variable being peeked
'i offest from variable's base address
'n number of bytes
r=nuls n
#if typecodeof(v)<=0           'not a variable
'  '                           '
#elseif typecodeof(v)<0x80     'primitive number
  copy strptr(r),@v+i,n        '
#elseif typecodeof(v)<0x100    'string
  copy strptr(r),strptr(v)+i,n '
#else                          'UDTs, Objects etc
  copy strptr(r),@v+i,n        '
#endif
end macro
'
macro pokes (v,i,p)
===================
'v variable being poked
'i offset from variable's base address
'p string containingg bytes to be poked
'
#if typecodeof(v)<=0           'not a variable
  '                            '
#elseif typecodeof(v)<0x80     'primitive number
  copy @v+i,strptr(p),len p    '
#elseif typecodeof(v)<0x100    'string
  copy strptr(v)+i,strptr(p),len p '
#else                          'UDTs, Objects etc
  copy @v+i,strptr(p),len p    '
#endif
end macro
'
'
'TESTS
======
string p,s
s="0123456789"
p=peeks(s,2,4)+peeks(s,8,2)
print p
pokes(s,2,"-")
print s 
*/


/*
'2018-05-03 T 10:28:24
macro mm float*(a,b,c,d)
#show a=(b+c)*d
end macro

float f
f=mm 2,3,4
*/

/*
'2018-05-03 T 05:15:19
'
function StrReverse(string s) as string
=======================================
int le=len s
int j=le
int i
string t=nuls le
byte bs at strptr s
byte bt at strptr t
indexbase 1
for i=1 to le
  bt[j]=bs[i]
  j--
next
return t
end function
'
'TEST:
print StrReverse "1234ABCD" 
*/


/*
macro array3d any*(r, a,z,y,x,  i)
==================================
int i=(z)*z##_span+(y)*y##_span+(x)
@r=@a+i*sizeof typeof a
end macro

xx=640 : x_span=1
yy=480 : y_span=xx
zz=1   : z_span=xx*yy
redim int f[zz*yy*xx]
*/


/*
'2018-05-02 T 15:07:27
%filename "t.exe"
uses rtl64
uses corewin

function StringToHex(string s) as string
========================================
int le=len s
int i,j
string r=nuls le*2
indexbase 1
for i=1 to le
  j++
  mid r,j,hex(asc(s,i),2)
  j++
next
return r
end function


function HexToString(string s) as string
========================================
int le=len s
int i,j
string r=nuls le\2
byte rb at strptr r
indexbase 1
for i=1 to le step 2
  j++
  rb[j]=val "0x"+mid(s,i,2)
next
return r
end function

'TEST
'====
string h=StringToHex "ABCDEF"
string s=HexToString h
print h
print s
*/

/*
'2018-05-02 T 12:11:03
'peek$
string s="0123456789"
string r=nuls 8
copy strptr(r),strptr(s)+1,8
print r 
'
'peek int
string s="0123456789"
int v[2]
copy @v,strptr(s)+1,8
print hex(v[1]) ", " hex(v[2])
*/


/*
'2018-05-02 T 07:30:23
'fixed length string arrays

def fillnull
len(%1)
addr rcx,%1
(
  dec rax
  jl exit
  mov byte [rcx],0
  inc rcx
  repeat
)
end def

def reset
  fillnull %1_buf
end def

macro redim_arraytype(ty,va,y,x)
  'ty type of element
  'va variable name
  'y  row count of elements
  'x  column count of elements
  type va##_type ty s[x]
  redim va##_type va##_var[y]
  def va va##_var[%1].s  'eg: va[29].s
end macro

redim_arraytype char,z,100,256
#recordof z_var_buf
'
z[1]="Hello"
z[2]=" "
z[3]="World"
redim char_type z_var[200]
reset z_var
print z[1] + z[2] + z[3]
*/


'macro zstr256_op(a,b,c)
'  macro ."load"(A,B)
'    B.s
'  end macro
'  macro ."save"(A,B)
'    A.s =
'  end macro
'  macro ."+"(A,B)
'    + B.s
'  end macro
'  macro ."&"(A,B)
'    & B.s
'  end macro
'end macro
'def zz z[%1].s
'#show zz[4]=zz[1]+zz[2]+zz[3]
'print zz[4]


/*
'2018-05-02 T 05:44:29
'char dims
dim a as asciiz*80
dim as asciiz a[80]="Hello World !"
'asciiz a[80]="Hello World !"
'asciiz a[]="Hello World !"
'asciiz a="Hello World !"
print a
#recordof a
*/

/*
'2018-05-01 T 23:46:36
'ARRAY OF ZSTRINGS
indexbase 0
typedef char *pchar
char s[25600] 'static char buffer
pchar ps[100] 'array of char pointers
int i,j
for i=0 to 99
  @ps[i]=@s[j] 'map positions in char buffer
  j+=256 'stride 
next
'
'TEST:
copy @ps[2],"Helo",4
copy @ps[3],"Wrld",4
copy @ps[4]," !",2
print ps[2] " " ps[3] ps[4] 'Helo Wrld !
*/


/*
'2018-05-01 T 15:02:56
'string chain
'
  function Flatten(string s[], int n) as string
  =============================================
  'FORMAT:
  'first 8 bytes: str count
  'packed ole strings:
  ' length field
  ' byte content
  '
  indexbase 1
  string bu   'buffer
  int lu      'buffer length
  int le      'string element length
  int ii=8    'offset in buffer
  int i       'iterator
  int*bp      'pointer for buffer
  int*ls      'pointer for strin element
  for i=1 to n
    le=len s[i]+4
    if ii+le>lu then
      bu+=nuls le+0x1000 'expand buffer
      lu=len bu
    end if
    @ls=strptr(s[i])-4 'include length field
    @bp=strptr(bu)+ii  'position in buffer
    copy @bp,@ls,le 
    ii+=le
  next
  mid bu,1,str n 'count
  return left bu,ii
  end function

  'TESTS
  ======
  string s[100]
  for i=1 to 100 : s[i]="#" i*100 : next
  string t=Flatten(s[],100)
  'DECODE AND EXTRACT STRINGS
  int d = t 'str length a start of t
  redim string da(d)
  int j=8
  int *pt
  int *le
  int *sp
  @pt=strptr t 
  for i=1 to 1
    @le=@pt+j
    da[i]=nuls le
print le
    @sp=@le+4
    @ps=strptr da[i]
    copy @ps,@sp,le
    j+=4+le
print da[i]
  next
  print da[99] '#9900
*/


/*
'2018-04-30 T 21:19:28

  function FlatTable(string s[], int n) as string
  ===============================================
  'FORMAT:
  'number of strings
  'length of char data block
  'for each string:
  '  length of string in bytes
  '  offset of first string character
  'char data block
  '
  indexbase 1
  string bt       'to hold the table
  string bu       'to hold the char data
  int *bd         'dynamic table
  int lu          'length of char data buffer
  int di=2        'index for the table elements
  int offs=8+n*8  'base offset to the char data
  int ii          'offset to the char data
  int i           'iterator etc
  bt=nuls 8+n*8   'create table buffer
  @bd=strptr bt   'map table to its buffer
  for i=1 to n
    le=len s[i]
    if ii+le+2>lu then
      bu+=nuls le+0x1000 'expand buffer
      lu=len bu
    end if       
    mid bu,ii+1,s[i]
    di++
    bd[di]=le 'data length
    di++
    bd[di]=ii+offs 'char index (base 0)
    ii+=le+2 'next position, allowing 2 null bytes
  next
  bd[1]=n   'count of elements
  i=8+n*8   'length of table
  bd[2]=ii  'length of data block
  return left(bt,i)+left(bu,ii)
  end function

  'TESTS
  ======
  string s[100]
  for i=1 to 100 : s[i]="#" i*100 : next
  string t=FlatTable(s[],100)
  'DECODE AND EXTRACT STRINGS
  int d at strptr t
  redim string da(d)
  int j=2
  int le
  for i=1 to d
    j++ : le=d[j]
    j++ : da[i]=mid t,d[j]+1,le
  next
  print da[99] '#9900
*/


/*
  '2018-04-30 T 05:53:20
  'test string util
  'problem: getfile f,t
  $ filename "t.exe"
  uses rtl64
  uses console
  uses StringUtil

  new TextArray a
  a.load "t.txt"
  for i=1 to 10
    printl i tab a.line i
  next
  printl "Line 5: " + a.line 5
  printl "Lines in s.txt:  " + a.lastline
  del a
  wait
*/



/*
'2018-04-30 T 03:43:30
'negative 32bit const
'looping console test bed
$ filename "t.exe"
uses rtl64
uses corewin
uses console
string f
do
  print cr "filename "
  f=ltrim rtrim input
  if not f then exit do
  dword a=GetFileAttributes f
  dword n=-1'INVALID_FILE_ATTRIBUTES
  'if a=n then
  if a=dword -1 then
    print "invalid file/folder name" cr
  else
    print "attrib code " a cr
  end if
  'invalid=-1 folders=16 files=32
loop
*/


/*
'2018-04-28 T 10:10:21
'check underscore limit

class cc
 method f(_
  int a,_ 'A
  int b,_ 'B
  int c,_ 'C
  int d,_ 'D
  int e,_ 'E
  int f,_ 'F
  int g,_ 'G
  int h _ 'H
 )
  print a b c d e f g h 'SUM
 end method
end class

#recordof cc
cc c
c.f 1,2,3,4,5,6,7,8
*/

/*
'2018-04-28 T 04:25:54
%* ResetNum %1=0  :
%* ResetStr %1="" :
int a,b,c,d
string s,t,u,v
#show ResetNum a,b,c,d
#show ResetStr s,t,u,v
*/

/*
'2018-04-28 T 09:38:15
'string coupling problem
int    a,b,c,d
float  f,g,h,i
string s,t,u,v
'#show a=b=c=d=0
'#show f=g=h=i=0
w="xyz"
#show s=t=u=v=w
mid s,2,"Q"
print u
*/


/*
'2018-04-28 T 04:26:37
'2018-03-02 T 10:32:21
'on macro
'on j goto/gosub

'%*' 'THIS MACRO REPEATS WHEN COMMA ENCOUNTERED
'%0' 'REST OF LINE OR PARAM BLOCK ,B,C,D, ....

%* CollectPtrs @%1,

def on
scope
  indexbase 1
  static int c%1
   'SINGLE SHOT TABLE BUILDER
  if not c%1
    static sys t%1={CollectPtrs %0}
    c%1=countof t%1
  end if
  if %1>0 and %1<=c%1
    %2 t%1[%1] 'gosub ti[i] / goto t[i]
  end if
end scope
end def
'
'TEST
int j=4
(
  on j goto aa,bb,cc
  print "no goto"
  exit
  aa:
  print "aa"
  exit
  bb:
  print "bb"
  exit
  cc:
  print "cc"
  exit
)
*/


/*
use corewin

'https://msdn.microsoft.com/en-us/library/windows/desktop/gg258117(v=vs.85).aspx
'selected File Attribute Constants
% FILE_ATTRIBUTE_ARCHIVE          0x20
% FILE_ATTRIBUTE_DEVICE           0x40
% FILE_ATTRIBUTE_DIRECTORY        0x10
% FILE_ATTRIBUTE_HIDDEN           0x2
% FILE_ATTRIBUTE_NORMAL           0x80
% FILE_ATTRIBUTE_READONLY         0x1
% FILE_ATTRIBUTE_SYSTEM           0x4
% FILE_ATTRIBUTE_TEMPORARY        0x100


  function GetFileList(string filter, sys*count,optional dirq) as string
  ======================================================================
  '
' sys xyz
  '
  macro appendList(s,w,i,  ls,lw) '(string *s,w, sys *i)
    sys ls=len s
    sys lw=len w
    if i+lw>ls
      s+=nuls 1024 '+lw
    end if
    mid s,i+1,w
    i+=lw
  end macro 
  '
  WIN32_FIND_DATA f
  sys    a,e,h,fi
  string flist
  string cr=chr(13,10)
  '
  h=FindFirstFile filter, @f
  count=0
  if h>0 then
    do
      a=0
      if f.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY
        if dirq then a=1
        if asc(f.cFileName)=46 then  a=0 '.' ' ..'
      else 'NOT A DIRECTORY
        if not dirq then a=1
      end if
      if a then
        count++
        appendlist flist, f.cFileName+cr, fi
      end if
      e=FindNextFile h, @f
      if e=0 then
        e=GetLastError() 'should be 18 when no more files
        exit do
      end if
    end do
    FindClose h
  end if
  return left (flist,fi)
  '
  end function


int c
print getFileList "*.txt",c
print "list count " c
*/

/*
uses console
uses timeutil
string s=timestr
printl left s,10
printl mid s,12
printl mid s,12,8
printl left s,19
wait
*/

/*
'Calc Future Date
'2018-04-23 T 17:29:42
uses timeutil
SYSTEMTIME ti,tj
ti={2018,04,01,23} '2018 April Monday 23
sys d=CalcDay ti
d+=90 'days from this date
CalcDate tj,d
print left(TimeStr(ti),10)+chr(13,10)+
  left(TimeStr(tj),10)+" weekday: "+tj.wDayofWeek
*/

/*
uses TimeUtil
SYSTEMTIME ti,tj
ti.wYear=2018
ti.wMonth=4
ti.wDay=24
ti.wHour=11
ti.wMinute=15
ti.wSecond=30
'
'friday=5
sys d
d=CalcUnixTimeStamp ti,0
'd+=86401
'd+=3661
'd+=65
print d
CalcUnixDateTime tj,d
print "DateTimes:"+chr(13,10)+ 
timeStr(ti)  chr(13,10) +
timeStr(tj)  chr(13,10) +
tj.wDayOfWeek
*/

/*
'2018-04-26 T 04:38:26
uses corewin

function FileExists(char*fi) as int
===================================
WIN32_FIND_DATA fd
sys h
h=FindFirstFile fi,fd
if h>0 then
  FindClose h
  return 1
end if
end function

print FileExists("t.o2bas")
print FileExists("ChrisC")
*/


/*
uses TimeUtil
SYSTEMTIME ti,tj
ti.wYear=1582
ti.wMonth=10
ti.wDay=15
'friday=5
int d
d=CalcDay ti
'd+=365
'print d
CalcDate tj,d
'print "DateTimes:"+chr(13,10)+ 
'timeStr(ti)  chr(13,10) +
'timeStr(tj)  chr(13,10) +
'tj.wDayOfWeek
print "Dates:"+chr(13,10)+ 
ti.wYear "-" ti.wMonth "-" ti.wDay chr(13,10) +
tj.wYear "-" tj.wMonth "-" tj.wDay chr(13,10) +
tj.wDayOfWeek
*/

/*
uses TimeUtil
SYSTEMTIME ti,tj
ti.wYear=1585 '1582
ti.wMonth=10 '10
ti.wDay=15 '15
int d
d=GregorianDay ti
'd-=730
'print d
GregorianDate tj,d
print "Dates:"+chr(13,10)+ 
ti.wYear "-" ti.wMonth "-" ti.wDay chr(13,10) +
tj.wYear "-" tj.wMonth "-" tj.wDay chr(13,10) +
tj.wDayOfWeek
*/

/*
'2018-04-20 T 14:03:31
uses timeutil

SYSTEMTIME t
GetLocalTime t
s=timestr
'print t.wDay ", " t.wDayOfWeek
int tyy,tmm,tde,thh,tmi,tss
tyy=t.wYear
tmm=t.wMonth
tde=t.wDay
thh=t.wHour
tmi=t.wMinute
tss=t.wSecond
'tyy=mid(s,1,4)  'year
'tmm=mid(s,6,2)  'month
'tde=mid(s,9,2)  'day rebase 0
'thh=mid(s,12,2) 'hours
'tmi=mid(s,15,2) 'mins
'tss=mid(s,18,2) 'secs

'print s chr(13,10) +
tyy "/" tmm "/" tde "T" thh ":" tmi ":" tss 
tyy=t.wYear
'print tyy
print hex(UnixTimeStamp(),8)
*/


/*
'2018-04-20 T 11:48:43
'fix compind type multiassign
type point        float x,y
type pointcart    float x,y
type pointpolar   float r,a
type line         point p1,p2
type boundingrect point p1,p2
line a[10]
#recordof line
#show a={{-1,2,3,4}}


/*
use sysutil
double aa,bb,cc
function faa(){}
*/


/*
'2018-04-16 T 13:21:04
'ternary expreesion in a function
'#show int a =(1>2 ? 3 : 4 )

macro iif int(R, A,B,C)
if A then R=B else R=C
end macro

function f(int a){print a}

#show f iif(1<2,3,4)
*/


/*
'2018-04-08 T 11:32:36
'EXPLICIT GARBAGE COLLECTION

def free freememory

int g(bstr *s){}

int f(){
bstring a,b,c,d
string s,t
'#show freeb 2,byval a, byval b
'#show pushes a,b,c,d
'push 4
'#show push a : push b : push c : push d : push 4
'call freeb
'#show del a
'#show a=mid b,1,2
'#show sbr a
'sbr a
i=1
#show g s
#show free a[i] : free b : free c : free d
}
f
*/

/*
'2018-04-05 T 14:03:26
'REDEF function names
function g(int i){}
def g f
function f(int i){}
#show g 1
*/

/*
'2018-04-03 T 23:39:49
'FIND LOWEST NUMBER EXACTLY DIVISIBLE BY 1..N
double i,m,n,mx
mx=1e16 : n=10
for m=n to mx
 for i=2 to n-1
  if mod(m,i) then exit for
 next
 if i>=n then print m : exit for
next
*/

/*
'2018-03-29 T 16:58:51
'INSTRANY INSTREVANY
'InstrAny / InstrevAny
uses parseutil
s="abcdefghijklmnopqrstuvwxyz"
'a=instrany(8,s,"mkg")
a=instrevany(-1,s,"mkg")
print mid s,a,4
*/

/*
'2018-03-29 T 09:30:02
'QUAD NUMBERS
%filename "t.exe"
uses rtl64
#show mov rdx,0x1234678ABC
*/

/*
%filename "t.exe"
uses rtl64
'uses corewin
'uint a=-512
function f(...){}
'#show a=(dword) -1
'print ( (-1 and 0xefffffff))
% TTN_NEEDTEXT uint -520
'#recordof TTN_NEEDTEXT
#show sys b=TTN_NEEDTEXT
print hex b
*/

/*
'2018-03-28 T 13:08:46
'EQUATES / SIGNED EXTENSION PROBLEM
%filename "t.exe"
uses rtl64
uses corewin
uint a=-512
#show print hex a
'#show messagebox 0,"","",a
*/


/*
'2017-09-11 T 12:13:35
'2018-03-28 T 11:03:11
'FILTERING AND SORTING
%filename "t.exe"
'uses rtl64
uses generics
uses console

'CREATE SOME DATA
=================
string dat={"a2","a1","a","b","c","d","e","f","g","h","i","j"}
int ct = CountOf dat
int cf 'Count of Filtered Data

'CALLBACK MACROS FOR FILTERING AND INDEXING

macro filter(accept,i)
======================
if asc(dat[i])<=0x65 then accept=1
end macro

macro compare(swap,a,b)
=======================
if dat[a]<dat[b] then swap=1 'DESCENDING ORDER
end macro

'
NewSortIndex idx,ct,cf,filter,compare


'SHOW RESULTS
=============
print "RAW DATA" cr
ListArray dat,print,ct
printl
print "FILTERED AND INDEXED DATA" cr
ListArray dat,print,cf,idx
printl
print "INDEX USED" cr
ListArray idx,print,cf

NewSortedData(sd,dat,idx,cf)
printl
print "SORTED DATA" cr
ListArray sd,print,cf
wait
'DelSortIndex idx
'DelSortedData sd
'SHOW RESULTS
=============
print "RAW DATA" cr
ListArray dat,print,ct
printl
print "FILTERED AND INDEXED DATA" cr
ListArray dat,print,cf,idx
printl
print "INDEX USED" cr
ListArray idx,print,cf

NewSortedData(sd,dat,idx,cf)
printl
print "SORTED DATA" cr
ListArray sd,print,cf
wait
DelSortIndex idx
DelSortedData sd
*/


/*
'2018-03-28 T 10:40:53
'COMPOUND CONDITIONAL
int a,b,c,d
#show while a>b and c<d {}
*/


/*
'2018-03-26 T 19:23:08
'STRING ASSIGNMENT
'STRING COMPARE
string ,a,b
#show a=b
#show if a=b {}
*/


/*
'2018-03-26 T 16:29:31
'STRING BVVAL TO BYREF
'STRING BYREF TO BYVAL
'STRING BYREF TO BYREF
'STRING BYVAL TO BYVAL
int f(string *s){mid s,4,"ABC"}
int g(string *s){f s : print s}
string s="1234567890"
#show g s
*/

/*
'2018-03-26 T 16:23:27
'STRING PATCH
int f(string s){mid s,4,"ABC"}
s="1234567890"
f s
print s
*/

/*
'2018-03-26 T 16:21:44
'ANY DIRECT
function f(any x){}
bstring s
'char s=" "
'#show f s
type vec float x,y,z
vec v
#show f v
*/


/*
'2018-03-26 T 16:22:34
'READDATA
uses console
int lenw
function endline(string s, int*i)
=================================
int a
do
  a=asc(s,i)
  select a
  case 0,13,10 : exit do
  end select
  i++
loop
end function

function readdata(string s, sys *i) as string
=============================================
sys a,b
string w1,w2
do
  select asc(s,i)
  case 0 : exit do
  case 13,39 : endline(s,i) : i+=2 : continue do 'SKIP LINE
  end select
  b=i : endline(s,i)
  w1=mid(s,b, i-b)
  i+=2
  a=instr(w1,chr(39))          'SIMPLISTIC DETECT COMMENT
  if a then
    w1=left(w1,a-1)            'TRIM OFF COMMENT
  end if
  w2+=w1                       'APPEND LINES
  if asc(s,i)<>32 then exit do 'OTHERWISE ADD INDENTED LINE (NO TABS)
  w2+=chr(13,10)
loop
lenw=len(w2)
return w2
end function

string d="
'comment line
ABC 'comment
 indent 1'comment
 indent 2
'comment line 2
DEF"
'print d
lenw=1
int i=1
string t
while lenw
 t=readdata d,i
 if lenw then printl t
wend 
wait
*/



/*
'2018-03-24 T 21:29:07
'ARRAY SCAN FUNCTIONALITY
int a={2,4,6,8,1,3,5,7,9} 'data fortesting
int i,j
j=0
for i=1 to countof a
  if a[i]<2 then j=i : exit for
next
print j '5'
*/

/*
'2018-03-24 T 18:57:54
$ filename "dlg_one1.exe"


$ filename "t.exe"
'uses rtl32
uses rtl64

'% review

uses winutil
uses dialogs
'namespace

# autodim off

% DS_MODALFRAME=128


#ifndef IDC_STATIC
#define IDC_STATIC (-1)
#endif

#define IDR_MYMENU      101
#define IDD_ABOUT       102
#define ID_FILE_EXIT    40001
#define ID_HELP_ABOUT   40002


declare sub initMenu(sys hWnd)


MainWindow 240, 120,WS_OVERLAPPEDWINDOW


function DialogProc(sys hDlg, Message, wParam, lParam) as bool callback

  select case Message
 
    case WM_INITDIALOG
      return true

    case WM_COMMAND
       select case loword(wParam)
         case IDOK
            EndDialog( hDlg, null)
            MessageBox(null, "Dialog exited with IDOK.", "Notice",
                       MB_OK or MB_ICONINFORMATION)                   
         case IDCANCEL
            EndDialog( hDlg, null )
            MessageBox(null, "Dialog exited with IDCANCEL.", "Notice",
                       MB_OK or MB_ICONINFORMATION)
       end select
     
    case WM_CLOSE
       EndDialog( hDlg, null )
               
  end select

  return 0
end function   


function WndProc(sys hwnd, Message, wParam, lParam) as sys callback

    select Message
        case WM_CREATE
           initMenu(hwnd)
           SetWindowText (hWnd, "The title of my window")
       
        case WM_COMMAND

            select loword(wParam)                           
            case ID_HELP_ABOUT               
               sys lpdt
               dyn::init(lpdt) '1024

               Dialog( 4,  0, 0, 239, 66, "My About Box", lpdt,
                       DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU or DS_SETFONT,
                       8, "MS Sans Serif" )
               DEFPUSHBUTTON   "OK", IDOK, 174, 18, 50, 14, 0, WS_EX_LEFT
               PUSHBUTTON      "Cancel", IDCANCEL, 174, 35, 50, 14, 0, WS_EX_LEFT
               GROUPBOX        "About this program...", IDC_STATIC, 7, 7, 225, 52, 0, WS_EX_LEFT
               CTEXT           "An example program showing how to use" cr "Dialog Boxes" cr+cr  "by theForger", IDC_STATIC, 16, 18, 144, 33, SS_CENTER, WS_EX_LEFT

               CreateModalDialog( hWnd, @DialogProc, 0, lpdt )
               
            case ID_FILE_EXIT               
               SendMessage(hWnd, WM_CLOSE,0,0)               
            end select
       
        case WM_CLOSE
            DestroyWindow(hwnd)
       
        case WM_DESTROY
            PostQuitMessage(0)
       
        case else
            return DefWindowProc(hwnd, Message, wParam, lParam)
   
    end select
   
    return 0
end function


==================================

sub initMenu(sys hWnd)

   sys hMenu, hMenuPopup
   hMenu = CreateMenu
   hMenuPopup = CreateMenu
   AppendMenu hMenu,      MF_POPUP,     hMenuPopup,       "&File"
   AppendMenu hMenuPopup, MF_STRING,    ID_FILE_EXIT,     "E&xit"

   hMenuPopup = CreateMenu
   AppendMenu hMenu,      MF_POPUP,     hMenuPopup,       "&Help"
   AppendMenu hMenuPopup, MF_STRING,    ID_HELP_ABOUT,    "&About..."

   if SetMenu( hWnd, hMenu ) = 0 then
     mbox "SetMenu hMenu failed!"
   end if

end sub
*/



/*
'2018-03-23 T 18:25:04
'REPLACE / REPLACE ANY
'
sub replace(byref s as string,byval w as string, byval r as string)
'==================================================================
  '
  dim as sys a,lw,lr
  '
  lw=len(w) : if lw=0 then exit sub
  lr=len(r)
  do
    a=instr(a+1,s,w)
    if a=0 then
      exit do
    else
      s=left(s,a-1)+r+mid(s,a+lw)
    end if
    a=lr+a-1
  loop
end sub


sub replaceAny(byref s as string,byval w as string, byval r as string)
'=====================================================================
  '
  dim as sys a,b,c,i,j,lw,lr,ls
  dim as string ch
  '
  lw=len(w) : if lw=0 then exit sub
  lr=len(r)
  ls=len(s)
  i=1
  do
    if i>lw then exit do
    b=asc(w,i)
    ch=mid(r,i,1)
    j=1
    do
      if j>ls then exit do
      a=asc(s,j)
      if a=b then mid(s,j)=ch
      j+=1
    loop
    i+=1
  loop
end sub

s="abcdefabcdef"
replace s,"abc","ABC"
print s 'ABCdefABCdef'

replaceAny s,"fed","FED"
print s 'ABCDEFABCDEF'
*/

/*
'2018-03-23 T 18:24:41
#lookahead
#recordof f
type vector float x,y,z
int f(float v){}
function f(int v) {}
function f(vector*v) {}
*/

/*
'2018-03-23 T 04:22:03
float a{1,2,3.5}
print a[3]
*/

/*
'2018-03-22 T 17:04:05
'FIX MULTIASSIGN WITH UNPROTO CALLS
$filename "t.exe"
uses rtl64
uses corewin
type vec sys x,y,z
vec a
'#recordof a
string s
#show a={4,3,LoadIcon(0, IDI_APPLICATION)}
*/

/*
  uses corewin

  sys wndproc(sys hwnd,wmsg,wparam,lparam) callback {}

  sys hinst,hicon,hcursor,hbrbackround,hiconsm

  type WNDCLASSEX
  int cbSize        = sizeof WNDCLASSEX
  int Style         = CS_HREDRAW or CS_VREDRAW
  sys lpfnwndproc   = @wndproc
  int cbClsextra    = 0
  int cbWndExtra    = 0
  sys hInstance     = hinst
  sys hIcon         = LoadIcon(0, IDI_APPLICATION)
  sys hCursor       = LoadCursor(0,IDC_ARROW)
  sys hbrBackground = GetStockObject(WHITE_BRUSH)
  sys lpszMenuName  = 0
  sys lpszClassName = strptr "wins"
  sys hIconSm       = hiconsm
  end type

'#recordof WNDCLASSEX

#show WNDCLASSEX ww{}
*/


/*
'2018-03-22 T 10:42:52
'MEMBER PADDING 32BIT/64BIT
$filename "t.exe"
'uses rtl64
type TBBUTTON
  int       iBitmap
  int       idCommand
  byte      fsState
  byte      fsStyle
'#ifdef mode64bit 
'  byte      bReserved[6]
'#else 
'  byte      bReserved[2]
'#endif
  sys       dwData   
  sys       iString
end type
#recordof "T.TXT"  TBBUTTON
*/

/*
'2018-03-22 T 06:15:58
int f(...){}

double v
string v
char* v
extended v
#show call f v

*/

/*
'2018-03-22 T 06:01:10
'@ strptr
'int f(...){} 'itr variadic
s=" "
#show call f 1, " ", s
*/

/*
'2018-03-22 T 05:25:18
'TRIM WHITE SPACE
uses console
string s=nuls(1) cr tab " q " cr tab nuls(1)
's=ltrim rtrim s
printl len s
s=ltrim s
printl len s
s=rtrim s
printl len s
wait
*/

/*
'2018-03-22 T 01:22:56
'64bit data
sys p=@mydata
print hex *(p+4)
end
mydata:
'dd 0x0405060708 0x00010203
o2 hq0102030405060708
*/

/*
'2018-03-22 T 01:23:24
'decompose to make work
int i1,i2
i1="&H" + MID(value1, loopit, 1)
i2="&H" + MID(value2, loopit, 1)
insXor=i1 xor i2
' insXor = VAL("&H" + MID(value1, loopit, 1))   XOR   VAL("&H" + MID(value2, loopit, 1))
*/

         
/*
'2018-03-21 T 22:13:42
'to trap 64bit /32bit assin to pointer
*/

/*
'2018-03-21 T 21:38:35
'STRING ADDRESS
char s[1]
char*s
bstring s
string s
#show a=@s
*/

/*
'2018-03-21 T 21:09:01
'RANDOM
uses corewin
uses chaos
seed=GetTickCount
single fr
int ir
fr=rnd() 'float values between -1.0 and 1.0
ir=irnd(1,1000) '32bit integer values between 1 and 1000
print fr chr(13,10) ir
*/

/*
'2018-03-21 T 17:51:23
'IMPLICIT POINTERS
int f(...){}
typedef float*pfloat
type vector float x,y,z
end
'float v
'float*v
'pfloat v
'vector v
'char*v
'bstring v
'string v
'#show f v
'#show f strptr v
'#show f strptr "A"
'#show f cast vector v
vector*v
#show f @@v
*/

/*
'2018-03-21 T 14:07:03
'extracting keyword lists
uses OpenglSceneFrame

function vectorX(float x,y,z)
vector vectorA, vectorB
'#list vector
end function 
*/

/*
'2018-03-21 T 13:53:35
'PARAM CONVERSION
int f(...){}

'#show f  double 3
'#show f convert double 3.5
'itr cdecl stack adjust
*/

/*
'2018-03-21 T 12:22:48
'TYPE DEFAULT VALUES
type tt
 float x=1.5,y=2.5,z=3.5
end type
'#recordof tt

#show tt a{z=4, y=8}
*/


/*
'POINTER DEMO
sys Sgp1
Sgp1 =@somelabel
dim Amm AS LONG
amm=1
Amm = *(Sgp1+Amm)
print hex Amm '302
end

somelabel:
db 01 02 03 00 00
*/

/*
'2018-03-21 T 05:50:15
long tempnum = "0x"+"5E65A486"
print hex tempnum
*/

/*
'2018-03-20 T 15:03:54
'compact multiassign
int a {1,2,3,4,5}
print a[3]
*/

/*
'2018-03-20 T 13:35:12
'collecting type default values
class tt {
  int x()=0
  sys a=43
  string s="Q"
  b(100) as float
}
#recordof tt
*/


/*
'2018-03-20 T 12:36:25
%filename "t.exe"
uses RTL64
any t
t=42
#recordof t

/*
'2018-03-20 T 06:23:55
'
%filename "t.exe"
uses RTL64

FUNCTION mystr() AS STRING
    LOCAL mlabnum  AS SYS
    LOCAL Secnum  AS SYS
    LOCAL string ThdSt
    local mrbx as sys

    def codeptr @ %1

    mlabnum = CODEPTR(mainlab)
    mov mrbx,rbx

    ThdSt = nuls 19
    Secnum = STRPTR(ThdSt)

     MOV rsi, mlabnum
     MOV rdi, Secnum
     MOV rcx, 19
     REP MOVSB

    mlabnum = CODEPTR(seclab)

     MOV rsi, Secnum
     MOV rbx, 19
     MOV rdi, mlabnum
     ADD rsi, rbx
     ADD rdi, rbx
     NEG rbx

  dest1:
     MOVZX AL, [rdi+rbx]
     XOR [rsi+rbx], AL
     ADD rbx, 1
     JZ dest2
     MOVZX AL,[rdi+rbx]
     XOR [rsi+rbx], AL
     ADD rbx, 1
     JZ dest2
     MOVZX AL,[rdi+rbx]
     XOR [rsi+rbx], AL
     ADD rbx, 1
     JZ dest2
     MOVZX AL,[rdi+rbx]
     XOR [rsi+rbx], AL
     ADD rbx, 1
     JNZ dest1

  dest2:

    mov rbx,mrbx

    FUNCTION = ThdSt
    EXIT FUNCTION

  NOP
  NOP

  mainlab:
     DB 212,84,249,14,51,10,51,105,185,124,111,140,101,116,200,44
     DB 255,120,28,0

  NOP
  NOP
  seclab:
     DB 128,60,144,125,19,99,64,73,214,4,22,235,0,26,138,77
     DB 140,17,127,0

END FUNCTION

print mystr           
*/

/*
addr eax,bt
print hex [eax]
end
bt:
o2 00 01 02 03
*/

/*
'2018-03-19 T 02:06:02
'test new strptr
'o2expl.bas o2expr.bas o2tran.bas
string s="Q"
sys a
'#show a=strptr s + 42
'#show a=21+strptr s + 42
'#show a=1+strptr "Q"+10 'itr
char c[7]
bstring b="!!"
'#show a=strptr c
'#show a=2+strptr b
char*pc
'#show pc=s
'#show pc=b
'#show pc=12
#show pc="12"
print pc
*/


/*
'2018-03-17 T 17:02:18
'MessageBoxIndirect
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms645402(v=vs.85).aspx
%filename "t.exe"
uses rtl64
uses corewin
'
typedef dword DWORD, UINT
typedef sys   HWND,HINSTANCE,DWORD_PTR,MSGBOXCALLBACK
typedef char *LPCTSTR
'
typedef struct {
  UINT           cbSize;
  HWND           hwndOwner;
  HINSTANCE      hInstance;
  LPCTSTR        lpszText;
  LPCTSTR        lpszCaption;
  DWORD          dwStyle;
  LPCTSTR        lpszIcon;
  DWORD_PTR      dwContextHelpId;
  MSGBOXCALLBACK lpfnMsgBoxCallback;
  DWORD          dwLanguageId;
} MSGBOXPARAMS, *PMSGBOXPARAMS;

MSGBOXPARAMS mbp
double d
with mbp.
  cbSize=sizeof MSGBOXPARAMS
  hwndOwner=null 'hWnd
  hInstance=GetModuleHandle(null)
  lpszText="text"
  lpszCaption="caption"
  dwStyle=3 'Yes/No/Cancel
  #show lpszIcon= 200
  dwContextHelpId=null
  lpfnMsgBoxCallback=null
  dwLanguageId=0 'LANG_NEUTRAL
end with     '

int a
a=MessageBoxIndirect mbp
print a
'6 yes
'7 no
'2 cancel
*/

/*
'2018-03-16 T 13:40:23
'loadfile/savefile
'
'type vector float x,y,z
'string v_buf=getfile "t.bin"
'vector v at strptr v_buf
'
uses corewin

function LoadData(string name, any*data, int e)
===============================================
sys f
f=fopen name,"r"    'open for reading
e=fread @data,1,e,f 'load data
fclose f            'close file
return e
end function


function SaveData(string name, any*data, int e)
===============================================
sys f
f=fopen name,"w"      'open for writing
e=fwrite @data,1,e,f  'save data
fclose f              'close file
return e
end function

'TEST
=====
float v[100],w[100]
for i=1 to 100 : v[i]=i*1.5 : next
SaveFile "t.bin",v,bytesof v
LoadFile "t.bin",w,bytesof v
print w[51] '76.5
*/


/*
'2018-03-15 T 10:03:22
'msvcrt val/str
'http://www.cplusplus.com/reference/cstdio/scanf/
'http://www.cplusplus.com/reference/cstdio/printf/
% filename "t.exe"
'use rtl64
use msvcrt
'
quad a
string idata="0xA0DD7CBFF9FED839"
string odata=nuls 32
'
sscanf(idata,"%llx",@a) 'hexadecimal input to 64bit
sprintf(odata,"%llu",a)'64bit unsigned decimal output
'sprintf(odata,"%lli",a)'64bit signed decimal output
print idata chr(13,10) odata
*/

/*
'2018-03-15 T 06:22:15
'quadval macros
% filename "t.exe"
use rtl64
sys a
string s
% QuadHexNum o2 48 b8 hq %1
'a=QuadHexNum 012346789abcdef
a=QuadHexNum A0DD7CBFF9FED839
s="&h"+hex a
'print s
'print a
a=val s

print hex a

function StrQuadNum(sys a) as string
====================================
string s=space 64
addr rdi,s
add rdi,63
mov rax,a
mov rcx,10
(
  xor rdx,rdx
  div rcx
  add rdx,48
  mov [rdi],dl
  dec rdi
  or rax,rax
  jnz repeat 
)
sys e=rdi+2
e-=strptr s
return mid s,e
end function

'a=999999
s=StrQuadNum a

print s
'print hex val s
*/


/*
'2018-03-15 T 03:43:16
'hex input
% filename "t.exe"
use rtl64

'print val "&h5E65A486"
'print val "&hA0DD7CBFF9FED839" 'overflow
'
'64bit hex number literals
==========================
int a[2]
a={&hF9FED839,&hA0DD7CBF} 'lower & upper dwords
print hex cast(sys) a

'mov rax,&hA0DD7CBF
'shl rax,32
'add rax,&hF9FED839 'anomaly 
'mov a,rax
'
'64bit hex number from string
=============================
string sa="A0DD7CBFF9FED839"
sys a,b
a=val "&h"+mid(sa,1,8)
shl a,32 'shift to upper dword
b=val "&h"+mid(sa,9,16)
a+=b
print hex a
*/

/*
'2018-03-14 T 11:34:15
'READING WHOLE FILE
% filename "t.exe"
'use rtl64
use corewin
string s
sys e,f
'EQUIVALENT TO: S=GETFILE "T.TXT"
f=fopen "t.txt","r" 'open for reading
print f             'file handle or null
fseek f,0,2         'end of file
e=ftell f           'get position
print e             'length of file
fseek f,0,0         'beginning of file
s=nuls e            'create buffer to fit
fread s,1,e,f       'load buffer
fclose f            'close file
'
print s
print cast(wstring) s
'
*/


/*
'2018-03-14 T 04:10:15
'UNICODE LOADING AND DISPLAY
% filename "t.exe"
'use rtl64
use corewin
wstring ws
ws=(wstring) getfile "t.txt"
messageboxW 0,ws,"",0
'
'EXAMINE UNICODING
'little endian / BOM 0XFEFF
word ww at strptr ws
string t
for i=1 to 512
  t+=hex(ww[i],4)+"  "
next
print t
*/
  

/*
'2018-03-13 T 17:50:35
'more noproto checks
int f(float a,b,c) nosig {}
int f(float *a,b,c) nosig {}
'#recordof f
int v
'#show f float v+1.,2.,3.
#show f @v,2.,3.
*/


/*
'2018-03-13 T 11:46:42
'type setting for params
$filename "t.exe"
'uses rtl64
extern
function f (int i) external, nosig {}
'function g (float*f) {}
'function g cdecl () nosig {}
function g () nosig {}
type vector float x,y,z
int i
int*j=@i
vector v
'#show f float i
'#show f  v
#show g  @vector {1,2,j+33}
'#show g vector {1,2,j+33}
*/

/*
'2018-03-13 T 07:47:19
'random access read/write
'https://docs.microsoft.com/en-gb/cpp/c-runtime-library/file-handling
'
$filename "t.exe"
uses rtl64
uses corewin
'
'EXAMPLE RECORD
type xyzlabel
  float x,y,z
  wchar s[64]
end type
'
sys hf
int le
dim xyzlabel ww
'
'PUT SOME DATA INTO RECORD
ww={ 1.5 , 2.5 , 3.5 , "labelled point in space" }

hf=fopen "t.txt","w" 'CREATING / WRITING
if hf
  int fd=_fileno hf
  'print _filelength fd  
  fseek hf,sizeof(ww)*10,0 'POSITION 11TH RECORD
  le=fwrite @ww,sizeof ww,1,hf
  fclose hf
  print "written: " ww.x " , " ww.y " , " ww.z "  " ww.s
end if
'
'
dim xyzlabel rr 'BLANK RECORD TO RECEIVE DATA
'
hf=fopen "t.txt","r+" 'READING AND WRITING

if hf
  int fd=_fileno hf
  'a=_SetMode fd,0x8000 '_o_binary
  print _filelength fd  
  fseek hf,sizeof(rr)*10,0 '11TH RECORD IN FILE
  le=fread @rr,sizeof rr, 1, hf
  fclose hf
  print "read " rr.x " , " rr.y " , " rr.z "  " rr.s
end if
*/


/*
'2018-03-13 T 01:25:31
'binary mode
'$filename "t.exe"
'uses rtl64
uses corewin
sys f
int le
f=fopen "t.txt","r"
print f
if f
  char s[512]
  int n=_fileno f
  print n
  print _filelength n  
  fseek f,-20,2
  le=fread strptr(s),1,256,f
  print left(s,le)
  fclose f
end if
*/


/*
'2018-03-12 T 19:16:09
'file demo
https://msdn.microsoft.com/en-us/library/634ca0c2.aspx
$filename "t.exe"
uses rtl64
uses corewin
sys f
int le
f=fopen "t.txt","r"
print f
char s[512]
le=fread strptr(s),1,256,f
print left(s,le)
fclose f
*/

/*
'2018-03-12 T 19:05:45
wstring russian = "??????, ??????"
wstring caption = "Nice to meet you"

MessageBoxW null, russian, caption ,0
*/

/*
'2018-03-12 T 11:07:15
'test corewin
uses corewin
'#unique enable
'#autodim off
'end
'#recordof do
'while 0
'wend
'do
' exit do
'end do
print @fopen
print @sinC
print "ok"
*/

/*
'name mangling / clean
function f alias "_f@0" () export {print 123}
call f
#recordof f
*

/*
function "f-g " () export {print 123}
call "f-g "
int "a "=42
#recordof "t.txt" "a "
print "a "
*/


/*
'2018-03-11 T 17:55:05
'c-style prototype overlay
uses corewin
'Create protype with default values for MessageBox
int messagebox(
  sys hwnd=0,
  char*text="",
  char*title="OxygenBasic",
  int mode=0 
) at @messagebox
'
'TEST
messagebox
a=messagebox text="helo", mode=2
print a
*/


/*
'2018-03-11 T 15:55:30
'prototype overlay
uses corewin
'Create protype with default values for MessageBox
! messagebox(
  sys hwnd=0,
  char*text="",
  char*title="OxygenBasic",
  int mode=0 
) as int, at @messagebox
'
'TEST
messagebox
a=messagebox text="helo", mode=1
print a
*/


/*
'2018-03-11 T 11:42:25
'protptype overlay
int f(){print 123}
! f() at @f
#recordof f
f
*/

/*
'2018-03-11 T 11:16:47
function f(){print 123}
sys p=@f
! g() as sys, at @f
edi=0
g
#recordof g
*/

/*
'2018-03-10 T 15:53:37
uses CoreWin
wstring a="ok"
wstring t="check.."
messageboxW 0,a,t,0
*/


/*
'2018-03-10 T 12:42:46
'extract dll procedure names
'create unprototyped omniheader
uses console
'
'kernel/user/gdi/oleaut/Comctl/Comdlg/shell
string ff="xxx"
string fi=ff+"32.dll"
string fo=ff+".inc"
sys hl=loadlibrary fi
if not hl then
  printl "Unable to find " fi 
  goto done
end if
printl "filename " fi
sys  ps=hl
sys  *ph
word *pw
char*pc
'
@ph=ps+0x3c
@pw=ps+ph+0x18
'printl "magic: " hex pw
pcoff=ps+ph
int*sh
if pw=0x10b then
  printl "32 bit"
  @ph=pcoff+0x78 'offset data here
  @sh=pcoff+0xf8
else
  printl "64 bit"
  @ph=pcoff+0x88
  @sh=pcoff+0x108
end if
printl "Offset of export section header table " hex ph
int*pl
'@pl=@ph+4
'printl "Length of export section header table " hex pl 
'
sys pa    'returned from GetProcAddress
sys pt    'address of string
int*px    'RVA names list
int*pq    'count of names
int*pn    'dereferencer
word*dn   'ordinal table entry
sys fn    'function address
string fs 'number string
int oo    'name list and function list strider
string bb 'output buffer
string ss 'composed declaration line
'
@px=ps+ph+0x0c       'RVA of name of table
@pc=ps+px            'name of table
@pq=ps+ph+0x18       'number of names
@px=ps+ph+0x20       'offset of names list
printl pc            'print name of table
bb=nuls pq*100       'allow 100 bytes each record
word*pb              'buffer position / and white space patcher
int le               'length of string
@pb=strptr bb        'set to start of buffer
ss="extern lib "+qu+fi+qu+cr
le=len(ss)
@pc=strptr ss
copy @pb,@pc, le 'patch in
@pb+=le          '
'
for i=1 to pq        'each function in the export table
  @pn=ps+px+oo       'address of function name
  @pc=ps+pn          'function name
  ss="! "+pc
  if right(ss,1)="A"
    le=len(ss)
    'create alias
    ss=left(ss,le-1)+" "+qu+pc+qu
  end if
  @pc=strptr ss
  le=len ss
  oo+=4            'stride for next entry
  copy @pb,@pc, le 'patch in function name
  @pb+=le          '
  pb=0x0a0d        'patch in crlf
  @pb+=2           '
next
ss="end extern"+cr
le=len(ss)
@pc=strptr ss
copy @pb,@pc, le 'patch in
@pb+=le          '
le=@pb-strptr bb 'length of list
putfile fo, left bb,le
printl "saved as " fo
freelibrary hl
done:
wait
*/


/*
'2018-03-10 T 12:03:45
'testing symbol pane
case capital
uses generics
uses minwin
*/

/*
'2018-03-10 T 10:37:48
'no comma macros
macro dimm(a)
def d print "%1 %2(%3)"
'def d print "<%0>"
d a
end macro
dimm float v (4)
*/

/*
'2018-03-10 T 10:21:41
'need to optimise
sys a,e
#show if a<0 and a<-1 then
elseif a>=e then
end if
*/


/*
'2018-03-09 T 15:50:43
'implementing a jump table
'
'jumps based on ascii byte
'sparse table
int a=66
(
  static sys tbl[256]
  if not tbl then 'once only
    indexbase 0
    sys p=@caseElse
    for i=0 to 255 : tbl[i]=p : next
    tbl[65]={@caseA, @caseB, @caseC}
  end if
  '
  if a<0 then 'lower boundary
    a=0
  elseif a>255 'upper boundary
    a=0
  end if
  jmp tbl[a]
  '
  caseA:
    print "AA"
    exit
  caseB:
    print "BB"
    exit
  caseC:
    print "CC"
    exit
  caseElse:
    print "??"
)
*/

/*
2018-03-09 T 14:14:23
'measure clock speed
Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As QUAD) As Long
quad q
QueryPerformanceFrequency q
print "CPU Clock Speed " str(q/1e6) " GHz"
*/

/*
'2018-03-09 T 13:41:33
'macros for aligned var space
'
def alignment
=============
'%1 alignment %2 type %3 name %5  (mem resource)
'AllocateStack m(256)
'alignment 16 vector v at m
'DisallocateStack m
%2 %3 at (%5)
@%3=(@%3+%1-1) and -%1
end def

def AllocateStack
=================
'AllocateStack m(16)
sys %1=rsp : sub rsp,%2
end def

def DisallocateStack
====================
'DisallocateStack m
mov rsp,%1
end def
*/

/*
'2018-03-09 T 11:58:00
'ALIGNMENT
'alignment for simd
function f()
int a[0x100] 'some stack memory
sys b
b=(@a+16) and -16 'align up 16 bytes
mov rdi,b
xorps xmm0,[rdi] 'must be aligned, otherwise crash
print hex b
end function
f
*/


/*
'2018-03-08 T 17:14:45
function f cdecl () nosig {print 123}
single v
'#show f cast double v
'itr add esp,4

! g cdecl (double v,double a) at @f
! g cdecl (double v, byval EXTENDED a) at @f
#show g 1,2
extended v,w
'#recordof v
'#recordof w
*/


/*
'2018-03-09 T 07:48:23
'declaration format
!* f(char*,string,double)
#recordof f
*/

/*
'2018-03-08 T 17:34:33
'https://en.wikipedia.org/wiki/Time_Stamp_Counter
'https://msdn.microsoft.com/en-us/library/windows/desktop/dn553408(v=vs.85).aspx
'
'64bit debug:
'remove pushad and popad (invalid in 64bit mode)
'use rdi as pointer

$ filename "GetCpuSpeed_64.exe"
'use rtl64
use minwin


' This program will obtain the  CPU's speed

Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As QUAD) As Long
Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As QUAD) As Long

'=====================================
FUNCTION CpuSpeed() AS STRING
 LOCAL Count0    AS QUAD
 LOCAL Count1    AS QUAD
 LOCAL Count2    AS QUAD
 LOCAL Freq      AS QUAD
 LOCAL NewCount  AS QUAD
 LOCAL CpuFreq   AS DWORD

 QueryPerformanceFrequency(Freq)
 Freq = Freq \ 10
 rdtsc 'db &h0f, &h31
 lea rdi,Count1
 mov [rdi+4], edx
 mov [rdi], eax
 QueryPerformanceCounter(Count0)
 NewCount = Count0 + Freq
 WHILE (Count0 < NewCount)
   QueryPerformanceCounter(Count0)
 WEND
 rdtsc 'db &h0f, &h31
 lea rdi,Count2
 mov [rdi+4], edx
 mov [rdi], eax
 CpuFreq = (Count2 - Count1) \ 100000
 IF CpuFreq > 1000 THEN
   FUNCTION =    str(CpuFreq / 1000 ) + " giga hertz"
 ELSE
   FUNCTION =   str(CpuFreq ) + " mega hertz"
 END IF

END FUNCTION



'====================
'print CpuSpeed
*/


/*
'2018-03-08 T 09:04:44
'unprototyped clear view
    $ filename "GetHDDSerial_64.exe"
    'use rtl64
    use minwin
     
'beware line break after alias
% hiwrd hiword
% lowrd loword
% bycopy

! GetVolumeInformation "GetVolumeInformationA" Lib "kernel32.dll"
' 1 buffer lpRootPathName
' 2 buffer lpVolumeNameBuffer 
' 3 length nVolumeNameSize 
' 4 long*  lpVolumeSerialNumber 
' 5 long*  lpMaximumComponentLength
' 6 long*  lpFileSystemFlags 
' 7 buffer lpFileSystemNameBuffer
' 8 length nFileSystemNameSize
' R bool

'BOOL WINAPI GetVolumeInformation(
'  _In_opt_  LPCTSTR lpRootPathName,
'  _Out_opt_ LPTSTR  lpVolumeNameBuffer,
'  _In_      DWORD   nVolumeNameSize,
'  _Out_opt_ LPDWORD lpVolumeSerialNumber,
'  _Out_opt_ LPDWORD lpMaximumComponentLength,
'  _Out_opt_ LPDWORD lpFileSystemFlags,
'  _Out_opt_ LPTSTR  lpFileSystemNameBuffer,
'  _In_      DWORD   nFileSystemNameSize
');
     
    '==========================================
    ' Obtain the Hard Drive Serial number
    function DriveSerialNumber(string Drive) as string
    dword HWord
    dword LWord
    long  lpVolumeSerialNumber
    long  lpMaximumComponentLength
    long  lpFileSystemFlags
    '
    IF GetVolumeInformation (
       Drive,
       null,
       0,
       @lpVolumeSerialNumber,
       @lpMaximumComponentLength, 
       @lpFileSystemFlags,
       null,
       0 
    ) THEN
        HWord = HIWRD(lpVolumeSerialNumber)
        LWord = LOWRD(lpVolumeSerialNumber)
        return RIGHT$("0000"+HEX$(HWord), 4)  + RIGHT$("0000"+HEX$(LWord), 4)
    ELSE
        return "Cannot Read Drive.."
    END IF
     
    END FUNCTION

     
     
    '===================================
        string  Dsn , dDrive 
        dDrive = "c:\"
        Dsn = DriveSerialNumber(dDrive)
        print  Dsn
*/

/*
'2018-03-08 T 07:32:02
'Karen / debug
    $ filename "GetHDDSerial_64.exe"
    use rtl64
    use minwin
     
'beware line break after alias
% hiwrd hiword
% lowrd loword
% bycopy

    DECLARE FUNCTION GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (
      ByVal lpRootPathName As String,
      ByVal lpVolumeNameBuffer As String, 
      ByVal nVolumeNameSize As Long, 
      ByRef lpVolumeSerialNumber As Long, 
      ByRef lpMaximumComponentLength As Long,
      ByRef lpFileSystemFlags As Long, 
      ByVal lpFileSystemNameBuffer As String,
      ByVal nFileSystemNameSize As Long) As Long
     
    '==========================================
    ' Obtain the Hard Drive Serial number
    FUNCTION DriveSerialNumber(Drive AS STRING) AS STRING
    LOCAL HWord AS DWORD
    LOCAL LWord AS DWORD
    LOCAL Volname AS  STRING 
    LOCAL VolBuffer AS  STRING  
    LOCAL lpVolumeSerialNumber AS LONG
    LOCAL lpMaximumComponentLength AS LONG
    LOCAL lpFileSystemFlags AS LONG
    LOCAL FileSysBuffer AS STRING 
    IF GetVolumeInformation (
         Drive,
         null, 'VolBuffer,
         0,    'len(VolBuffer),
         lpVolumeSerialNumber,
         lpMaximumComponentLength, 
         lpFileSystemFlags,
         null,'FilesysBuffer,
         0    'len(FilesysBuffer)
        ) <> 0 THEN
        HWord = HIWRD(lpVolumeSerialNumber)
        LWord = LOWRD(lpVolumeSerialNumber)
        FUNCTION = RIGHT$("0000000"+HEX$(HWord), 4)  + RIGHT$("0000000"+HEX$(LWord), 4)
    ELSE
        FUNCTION = "Cannot Read Drive.."
    END IF
     
    END FUNCTION

     
     
    '===================================
        DIM AS STRING  Dsn , dDrive 
         dDrive = "c:\"
         Dsn = DriveSerialNumber(dDrive)
         print  Dsn
*/

/*
'2018-03-07 T 19:35:19
'direct string / asm operation
$ filename "GetCpuMfc_64.exe"
'use rtl64

'===============================================================
' CPUMfc - Returns manufacturer name string of CPU
FUNCTION CPUMfc () AS STRING

'dim AS STRING* 12  IID

 sys IID=getmemory 12
 push rbx
 xor rax,rax
 cpuid
 mov rdi,IID
 mov [rdi+00],ebx
 mov [rdi+04],edx
 mov [rdi+08],ecx
 pop rbx
 IID
 return
 'FUNCTION = IID
END FUNCTION       
'----------------------------------
print CPUMfc
*/

/*
'2018-03-06 T 19:00:58
'extract dll procedure names
uses console
'string fi="c:\windows\system32\kernel32.dll"
string fi="kernel32.dll"
sys hl=loadlibrary fi
if not hl then goto done
printl "filename " fi
sys  ps=hl
sys  *ph
word *pw
char*pc
'
@ph=ps+0x3c
printl "coff addr " hex ph
@pw=ps+ph
printl "coff sig: " hex pw
@pw=ps+ph+0x6
printl "no of sections: " hex pw
int ns=pw
@pw=ps+ph+0x18
printl "magic: " hex pw
pcoff=ps+ph
int*sh
if pw=0x10b then
  printl "32 bit"
  @ph=pcoff+0x78 'offset data here
  @sh=pcoff+0xf8
else
  printl "64 bit"
  @ph=pcoff+0x88
  @sh=pcoff+0x108
end if
printl "Offset of export section header table " hex ph
int*pl
@pl=@ph+4
printl "Length of export section header table " hex pl 
'
sys pa    'returned from GetProcAddress
sys pt    'address of string
int*px    'RVA names list
int*pf    'RVA function list
int*po    'RVA ordinals list
int*pq    'count of names
int*pn    'dereferencer
word*dn   'ordinal table entry
sys fn    'function address
string fs 'number string
int oo    'name list and function list strider
int ho    'ordinal list strider
string bb 'output buffer
'
@px=ps+ph+0x0c       'RVA of name of table
@pc=ps+px            'name of table
@pq=ps+ph+0x18       'number of names
@pf=ps+ph+0x1C       'offset of functions list
@px=ps+ph+0x20       'offset of names list
@po=ps+ph+0x24       'offset of ordinals list
printl pc            'print name of table
bb=nuls pq*100       'allow 100 bytes each record
word*pb              'buffer position / and white space patcher
int le               'length of string
@pb=strptr bb        'set to start of buffer
for i=1 to pq        'each function in the export table
  @pn=ps+px+oo       'address of function name
  @pc=ps+pn          'function name
  @dn=ps+po+ho       'ordinal lookup
  '@pn=ps+pf+oo      'without ordinal
  @pn=ps+pf+dn*4     'apply ordinal
  fn=ps+pn           'function address
  oo+=4 : ho+=2      'stride for next entry
  pa=getprocaddress ps,pc
  if pa<>fn then     'make anomaly record 
    le=len pc        '
    copy @pb,@pc, le 'patch in function name
    @pb+=le          '
    pb=0x2020        'patch in 2 spaces
    @pb+=2           '
    fs=hex fn        'hexadecimal function address
    le=len fs        '
    pt=strptr fs     '
    copy @pb,pt,le   'patch in function address
    @pb+=le          '
    pb=0x2020        'patch in 2 spaces
    @pb+=2           '
    fs=hex pa        'hexadecimal function address
    le=len fs        '
    pt=strptr fs     '
    copy @pb,pt,le   'patch in function address
    @pb+=le          '
    pb=0x0a0d        'patch in crlf
    @pb+=2           '
  end if
next
le=@pb-strptr bb 'length of list
string fo="t.txt"
putfile fo, left bb,le
printl "saved as " fo
bb=""
'a=getprocaddress ps,"GetModuleHandleA" 
'75E04FB0
'a=getprocaddress ps,"AddAtomA" 
''75E32CE0
'printl hex a
'int*pv
'for i=0 to ns-1
'  @pc=@sh+40*i+0x00 'virt name
'  @pv=@sh+40*i+0x0c 'virt data offset
'  @ph=@sh+40*i+0x14 'raw data offset
'  @pl=@sh+40*i+0x10 'raw data length
'  printl " section header "  pc "  " hex(pv) "  " hex(ph) " " hex(pl) 
'next
freelibrary hl
done:
wait
*/


/*
'2018-03-07 T 11:55:43
'Assembler assist
'
def movv
  push rax
  mov rax%2%3
  mov %1%2rax
  pop rax
end def

#ifndef mode64bit
  sys r8,r9,r10,r11,r12,r13,r14,r15
#endif


sys a,b
#show movv a,b 'mov variable to variable
*/


/*
'2018-03-07 T 06:20:24
'cpu serial numbers
'$filename "t.exe"
'uses rtl64

def hiwrd hiword
def lowrd loword

'===============================================================
'  GetCpuSerial - Returns serial no on Intel CPU
'  http://www.garybeene.com/powerbasic/thread_014065.htm
'  However it is not in the same format as those obtained by C#
FUNCTION GetCpuSerial()  AS STRING
LOCAL t AS DWORD, m AS DWORD, b AS DWORD

local sys mrbx=rbx 'save rbx for global refs

mov eax,1
cpuid
mov t,eax
mov eax,3
cpuid
mov m,edx
mov b,ecx

mov rbx,mrbx 'restore rbx for lobal refs

function=hex$(t,8) & hex$(m,8) & hex$(b,8)

'FUNCTION = HEX$(HIWRD(t),4) &  HEX$(LOWRD(t),4) &  HEX$(HIWRD(m),4) &  _
'HEX$(LOWRD(m),4) &  HEX$(HIWRD(b),4) &  HEX$(LOWRD(b),4)

END FUNCTION

print GetCpuSerial
*/


/*
'2018-03-05 T 09:09:37
'casting with strings
end
typedef float*pfloat
string s="    "
float f
#show f = (float**)  s
*/

/*
'2018-03-05 T 05:26:49
'mks mkq etc
int v
float f
double d
macro mkg bstring(a,b)
a=nuls sizeof b
copy a,@b,sizeof b
end macro
'
'TEST
int v
float f
double d
#show bstring s=mkg(v)
#show bstring s=mkg(d)
*/

/*
'2018-03-05 T 04:37:21
'cvs cvq etc
bstring s="    "
int v
float f
double d
macro cvg any* (a,b) @a=strptr b
#show v=cvg(s)
#show f=cvg(s)
#show d=cvg(s) 
print "ok"
*/

/*
'2018-03-05 T 01:42:51
'
'LATE BINDING TO DLL
====================

'BASIC WITH PROTOTYPE
'! ptr MessageBox (sys hwnd,char*msg,*title,int mode) as int
'C STYLE
'int (*MessageBox) (sys hwnd,char*text,char*title,int mode)
'BASIC UNPROTOTYPED
!* MessageBox
'
sys u32=LoadLibrary "user32.dll"
@MessageBox=GetProcAddress  u32, "MessageBoxA"
'
'USE LIKE ANY OTHER FUNCTION CALL
MessageBox 0,"helo","greet",0
'EXPLICIT CALL
call MessageBox 0,"helo","greet",1
*/


/*
'USING MACRO FUNCTIONS
'2D ARRAY WITH BOUNDARY CLIPPING
indexbase 0
int pix[800*600]
'
'SINGLE-LINE MACRO FUNCTION
'macro pix2d(x,y) pix(y*800+x)
'
'MULTI-LINE MACRO RETURNING A UNIQUE VARIABLE
'
macro pix2d int* (v,x,y,  vv)
=============================
  'v  pixel pointer supporting read/write
  'x  horizontal coordinate
  'y  vertical coodinate
  'vv sink pixel
  if x>=0 and x<800 and y>=0 and y<600
    @v=@pix(y*800+x)
  else
    int vv=0xffffffff 'value when out of bounds
    @v=@vv
  end if
end macro
'
'TEST
pix2d(1,20)=0xaabbccdd
print hex pix2d(1,20)
print hex pix2d(800,10)
*/

/*
'2018-03-02 T 16:33:46
'implementing asc() as both statement function
'
  macro asc ubyte* (a, s="",i=1)
  ==============================
  'a   ascii code return
  's   string input
  'i   character index expression
  '
  @a=_asc_(strptr(s),len(s),i)
  end macro
  '
  function _asc_(sys pt,int le,i) as ubyte*
  =========================================
  'le  string length
  'pt  string pointer
  'si  sink location for out of bounds ascii
  'oo  character offset position
  static int si
  sys oo=(i)-1
  if oo<-1 then oo+=le+1 'offset from right
  if oo>=le or oo<0 or pt=0 then
    return @si 'sink
  else
    return pt+oo 'success
  end if
  end function

'#recordof _asc_
'TEST
=====
bstring s="1234"
asc(s)=65
asc(s,2)=66
asc(s,-2)=67
print s ", " asc(s,-1) 'ABC4, 52
print asc(s,1000)     '0
del s
*/


/*
'2018-03-01 T 17:57:17
'#rest
'$*
'suporting on n goto etc
'
macro mm(a,b,#rest, rep)
========================
%* rep @%1
int a[b]={ rep #rest}
end macro
'
'#recordof mm
int a,b,c,d,e
mm va,10, a,b,c,d,e
*/

/*
'2018-03-01 T 17:24:59
'autodim / generic / swap var
#autodim off
'uses stringutil
uses generics
macro compare(cp,a,b){if a>b then cp=1}
int index[200]
int i
for i=1 to 100 : index[i]=i : next
MergeSort index,100, compare
*/

/*
'2018-03-01 T 11:57:36
'on j goto aa,bb,cc
int j=2
scope
  indexbase 1
  static int jc
  if not jc
    static sys jtbl={@aa,@bb,@cc}
    jc=countof jtbl
  end if
  if j>0 and j<=jc
    goto jtbl[j]
  end if
end scope

print "no goto"
end
aa:
print "a"
bb:
print "b"
cc:
*/


/*
'2018-02-28 T 19:15:26
'bstring length and terminators
$filename "t.exe"
uses rtl64
sys a=getmemory 16
byte b at a
print b[-3]
print b[18]
freememory a
*/

/*
'2018-02-27 T 18:09:04
'GLSL style notation
'
type vector4d float x,y,z,w

macro vec4 vector4d (x=0,y=0,z=0,w=0,   vv)
===========================================
#var vv
vv={x,y,z,w}
end macro
'
'TEST
float f=vec4(1,2,3).y
print f
*/


/*
'2018-02-22 T 13:26:53
'implementing mid() as both statement function
'
  macro mid (s="",i=1, m=0, n=-1)
  ===============================
  's   main string input
  'i   character index expression
  'm   1 length of midstring
  'm   2 string to be patched in
  'n   length of string
  '
  #if typecodeof(m)<0x80 'INTEGER OR FLOAT
    cast string _mid_(s, len(s), widthof(s), i, convert int m, null) 'mid function
  #else 'ASSUME M IS A STRING
    _mid_(s, len(s), widthof(s), i, n, m) 'mid statement
  #endif
  end macro
 
  function _ltrim_ (sys sp=0, le=0) as string
  ===========================================
  'sp  main string pointer
  'le  length of midstring
  byte b at (sp)
  sys rs
  le++
  do
    le--
    if le<=0 then exit do
    select b
    case 33 to 255 : exit do
    end select
    @b++
  loop
  rs=getmemory le
  copy rs,@b,le
  return rs
  end function
  
  function _rtrim_ (sys sp=0, le=0) as string
  ===========================================
  'sp  main string pointer
  'le  length of midstring
  byte b at (sp+le-1)
  sys rs
  le++
  do
    le--
    if le<=0 then exit do
    select b
    case 33 to 255 : exit do
    end select
    @b--
  loop
  rs=getmemory le
  copy rs,sp,le
  return rs
  end function
  
  '
  macro left (s="", le=0)
  =======================
  's   main string input
  'le  length of midstring
  cast string _mid_(s, len(s), widthof(s), 1, le) 'mid function
  end macro
  '
  macro right (s="", le=0)
  ========================
  's   main string input
  'le  length of midstring
  cast string _mid_(s, len(s), widthof(s), -le, le) 'mid function
  end macro
  '
  function _mid_(sys sp=0, int le=0, wi=1, i=0, lm=0, sys mp=0) as sys, nosig
  ===========================================================================
  'sp   string pointer
  'le   string length
  'wi   width of chars
  'i    character index expression
  'lm   length of midstring
  'mp   string pointer to be patched in when mid is a statement
  '
  'oo   character offset position
  '
  sys oo=i*wi-wi
  '
  le*=wi : lm*=wi           'scale by character width
  if lm<=0 then lm=le-lm    'length adustment <=0
  if oo<-wi then oo+=le+wi  'offset from right
  if oo+lm>le then lm=le-oo 'clip length
  if oo>=le or oo<0 or sp=0 then lm=0 'exclusions
  if mp=0 then
    mp=getmemory lm  
    copy mp,sp+oo,lm 'MID FUNCTION
  elseif sp<>0 then
    copy sp+oo,mp,lm 'MID STATEMENT
  end if
  return mp
  end function


'TEST
=====
'sys f(){return getmemory 32}
'#show string a= cast string f
'print widthof a
'
'wstring a=chr(32,32)
'print widthof a
'print len a
'sys b=strptr(a)-4
'print *b
*/


/*
'2018-02-27 T 17:55:55
'implementing asc() as both statement function
'
  macro asc ubyte* (ac, s="",i=1)
  ===============================
  'ac  ascii code return
  's   string input
  'i   character index expression
  '
  @ac=_asc_(s,len(s),i)
  end macro
  '
  function _asc_(char*s,int le,i) as ubyte*
  =========================================
  'le  string length
  'si  sink location for out of bounds ascii
  'pt  string pointer
  'oo  character offset position
  static int si
  sys oo=(i)-1
  sys pt=strptr s
  if oo<-1 then oo+=le+1 'offset from right
  if oo>=le or oo<0 or pt=0 then
    return @si 'sink
  else
    return pt+oo 'success
  end if
  end function

'#recordof _asc_
'TEST
=====
string s="1234"
asc(s)=65
asc(s,2)=66
asc(s,-2)=67
print s ", " asc(s,-1) 'ABC4, 52
print asc(s,1000)     '0
*/

/*
'2018-02-23 T 09:14:27
'generic operations for type conversion etc

  type vector2d float x,y
  '
  type vector3d float x,y,z
  '
  macro cvt_op (a,b,  le,cd)
  ==========================
  int le=sizeof a
  if le>sizeof b then le=sizeof b
  copy @a,@b,le
  '#if match typeof(a), typeof(b)
  '  'identical type
  '#elseif typecodeof(a)<0x100 and typecodeof(b)<0x100
  '  'primitive types
  '#else
  '  #if leftmatch "vector",typeof a
  '    cd=1
  '  #endif
  '  #if leftmatch "vector",typeof b
  '    cd or=16
  '  #endif
  '  if cd=17 then copy @a.@b,le
  '#endif
  end macro
  '
  macro str_op string (a,b)
  =========================
  #if match typeof(b), "vector2d"
    a=b.x ", " b.y
  #elseif match typeof(b), "vector3d"
    a=b.x ", " b.y ", " b.z
  #else
    a= "str "#b#""
  #endif
  end macro

  macro vector2d_op
  =================
  '
  macro ."load"(acc,a)
    acc.x=a.x
    acc.y=a.y
  end macro
  '
  macro ."+"(acc,a)
    acc.x+=a.x
    acc.y+=a.y
  end macro
  '
  macro ."save"(a,acc)
    a.x=acc.x
    a.y=acc.y
  end macro

  end macro

  macro vector3d_op
  =================
  '
  macro ."load"(acc,a)
    acc.x=a.x
    acc.y=a.y
    acc.z=a.z
  end macro
  '
  macro ."+"(acc,a)
    acc.x+=a.x
    acc.y+=a.y
    acc.z+=a.z
  end macro
  '
  macro ."save"(a,acc)
    a.x=acc.x
    a.y=acc.y
    a.z=acc.z
  end macro

  end macro
'
'TEST
'====
'
int a
float v
vector2d v2d
vector3d v3d
'
'#show a=convert int v2d
'print str(v3d)
'str(v2d)
'#show v2d=cvt(a)
'v3d+=cvt(a)
'v3d= v3d+cvt(a)
'v3d=v3d+v3d
'v2d=v2d+cvt(v2d)
'v2d=v2d+cvt(v3d)
'#show v2d=v2d+cvt(v2d)+cvt(v3d)+cvt(4)+cvt(4.5)
*/




/*
'2018-02-26 T 20:03:08
'negative length todo (PB)
s="1234678"
'print left(s,-2)
print mid(s,1,-2)
*/

/*
'2018-02-26 T 09:59:19
#case capital 'beware X Y capitalised members
uses console
wait
*/

/*
'2018-02-26 T 20:04:15
def varptr @ %1
def codeptr @ %1
function f(){}
sys lparam
lparam=codeptr(f)
sys*a
#show varptr(a)=codeptr(f)
*/

/*
'2018-02-26 T 20:04:33
uses console
int a[100]
a[1]={
{asc("O"),4, 1 | 16},
{asc("P"),4, 1 | 16}
}
for i=1 to 6
printl a[i]
next
wait
*/


/*
'2018-02-26 T 00:51:16
'assigmnet operator
int a,b=1,c
a := b
print b
*/


/*
'2018-02-26 T 01:21:00
'ternary
int a,b,c,d,e
#show a=(b>c?d:e)
*/


/*
'2018-02-25 T 07:06:47
'new macro #var
macro m(a : b=1,c=2,d)
'#returnvar r
r=a+b
end macro
#recordof m

'#show float a=m(1,2)
'print a
*/




/*
'2018-02-25 T 20:20:09
'quad test
$ filename "t.exe"
using rtl64
#show quad f(){return 1}
#show quad a=f
*/

/*
'2018-02-25 T 20:15:34
$ filename "t.exe"
using rtl64
uses console
print "helo"
wait
*/

/*

'2018-02-25 T 19:47:53
'ITR QWORD
$ filename "t.exe"
'using rtl64

FUNCTION CRepFNV32(BYVAL dwOffset AS SYS, BYVAL dwLen AS SYS, _
      BYVAL offset_basis AS SYS) AS QUAD
    ' Exits function if string len = 0 otherwise can GPF   Aug 1 2017
      IF dwLen = 0 THEN
         FUNCTION = 0
         EXIT FUNCTION
      END IF
extern cdecl
'#REGISTER NONE
sys mrbx
mov mrbx,rbx 'save ebx register, all globals use it, ebp is used by all locals
'
mov rsi, dwOffset      ;esi = ptr to buffer
mov rcx, dwLen         ;ecx = length of buffer (counter)
mov rax, offset_basis  ;set to 0 for FNV-0, or 2166136261 for FNV-1
mov rdi, &h01000193    ;FNV_32_PRIME = 16777619
xor rbx, rbx           ;ebx = 0
nextbyte:
mul rdi                ;eax = eax * FNV_32_PRIME
mov bl, [rsi]          ;bl = byte from esi
xor rax, rbx           ;al = al xor bl
inc rsi                ;esi = esi + 1 (buffer pos)
dec rcx                ;ecx = ecx - 1 (counter)
jnz nextbyte           ;if ecx is 0, jmp to NextByte
mov FUNCTION, rax      ;else, function = eax
'
mov rbx,mrbx 'retore ebx register
'
END FUNCTION
print "ok"
*/

/*
macro mm() db 0x90,0x90
#show mm
mm
print "ok"
'*/


/*
'class cc
'  int a
'  method op."+" (int a,b){}
'  method op."-" (int a,b){}
'end class
'#recordof cc

#show function op."+" (int a,b){}
#recordof op."+"
#show op."+" 1,2
*/


/*
'2018-02-25 T 02:21:08
'writing to byval string
'function f(string s){s="ok"}
function f(string s){
a=strptr(s)
mov eax,a : mov byte [eax],81
mid(s,2,"R")
print s
}
#show f"ok"
*/

/*
'2018-02-24 T 11:51:02
'goto loops
100 b=0
200 b=b+1
300 goto 200 if b<10
400 print b
*/


/*
'2018-02-24 T 02:22:52
'short-format procedures
'BASIC STYLE
'
'#byval
class GetSetter
  dim as int v_1
  dim as string v_2
  method v1() as int     {return v_1}
  method v1(v as int)    {v_1=v}
  method v2() as string  {return v_2}
  method v2(v as string) {v_2=v}
end class
'#recordof GetSetter
'
GetSetter g
#show g.v1=42
print g.v1 '42'
'
'C STYLE
class GetSetter
  int    v_1
  string v_2
  int    v1()         {return v_1}
  sub    v1(int v)    {v_1=v}
  string v2()         {return v_2}
  sub    v2(string v) {v_2=v}
end class
'#recordof getSetter
'
GetSetter g
g.v1=42
print g.v1 '42'
*/

/*
'2018-02-24 T 01:35:54
'pseudo-variables and procedures
int f(){}
int f(int v){}
int f(int v,w){}
int f(int v,w,x){}
#recordof f
f
f=1
f(1,2)
f(1)=2
f(1,2)=3
f(1)=2,3
'
'with mid statement:
string s="abcd"
mid s,1,"A"
mid(s,2,"B")
mid(s,3)="C"
print s
*/

/*
'2018-02-23 T 21:16:29
'static methods and properties
'all static properties are private
'keywords public private and protected are ignored
'
class counter
  static int c
  int mp(){return c}
  int cp(){return ++c}
end class

'method that only use static properties may be
'called directly from the class
print counter.cp '1
print counter.cp '2
print counter.mp '2
*/


/*
'2018-02-23 T 09:12:43
'macro function
macro mm(a,  r)
#return int r
r=a+100
end macro

print mm(1)+mm(2) '203'
*/


/*
'2018-02-23 T 09:08:41
'operators and conversion
type vector2d float x,y
type vector3d float x,y,z

macro cast2d vector2d (a,  r)
  #return r
  #if match typeof(a), "vector3d"
    'print "convert 3d to 2d"
    '#recordof r
    '#recordof a
    a.x=r.x
    'a.r=a.y
    ': r.y=a.y
    'r={a.x,a.y}
  #elseif typecodeof(a)<0x100 'primitive
    r.x=a : r.y=0.0
  #endif   
end macro
'#recordof cast2d

macro vector2d_op(a,b)
  macro ."load"(a)
    vector2d acc={a.x,a.y}
  end macro
  macro ."+"(a)
    acc.x+=a.x : acc.y+=a.y
  end macro
  macro ."save"(a)
    a={acc.x,acc.y}
  end macro
  macro ."str" string (a,b)
    a=str(b.x) ", " str(b.y)
  end macro
end macro

dim as vector2d v2d={1,2}
dim as vector3d v3d={10,20,30}
dim as int a
'
v=cast2d(v3d)
'print typeof(v) 'vector2d'
v2d+=v
'v2d=cast2d(v3d)
print str(v2d) '11,12'
'#show v.x=0.0
*/




/*
'2018-02-21 T 08:11:46
'end of express
print 1 
*/

/*
'2018-02-21 T 06:00:24
'conditional goto / gosub
int a
100: a++
goto 100 when a<3
print a
*/

/*
'2018-02-21 T 05:56:58
'mixed strins and byte arithmetic
sbyte a=1,b=2,c=3,d=4
a=127
b=127
a=128
b=128
#show print "X " a+b
*/

/*
'2018-02-20 T 12:03:12
'decomposed for .. next

i=... '_for
e=... 'to
s=... 'next
do '._for
  exit when not i<=e
  ...
  ._next
  i+=s
loop
,_end_for
*/


/*
'2018-02-20 T 01:27:07
'exit and continue
a=0
do
  exit do
  '#show exit when a<=42
  #show exit if a<=42
  '#show continue while a<>0
  '#show continue when a<>0
  '#show continue until a=0
  '#show repeat until a=0
end do
print "ok"
*/



/*
int b
do
  b++
#show continue when b<3
exit do
loop until b>=3
print b
*/

/*
'2018-02-19 T 19:06:34
'macrify while (do and if)
int b
'#show while b<3 {b++}
while b<3 : b++ : wend
print b
*/


/*
'2018-02-19 T 16:57:44
'new do { } while when until till
int b
'do {b++} while b<3
'do {b++} when b<3
'do {b++} until b>=3
'do {exit do}
do
  b++
'loop when b<3
loop until b>=3
print b
*/

/*
$filename "t.exe"
uses RTL64

extern lib "user32.dll"
...
#ifdef mode64bit
  ! GetWindowLongPtr "GetWindowLongPtrA"
#else
  ! GetWindowLongPtr "GetWindowLongA"
#endif
...
end extern

print @GetWindowLongPtr
*/

/*
$filename "t.exe"
uses RTL64
a=loadlibrary "user32.dll"
print a ",  " getprocaddress a,"GetWindowLongA"
print a ",  " getprocaddress a,"GetWindowLongW"
print a ",  " getprocaddress a,"GetWindowLongPtrA"
print a ",  " getprocaddress a,"GetWindowLongPtrW"
*/




/*
'2018-02-19 T 09:50:42
'test unprototyped function calls
'extern lib x
! f ! g
#recordof g
#show f 1.0
'function f(float v) as int,nosig {print v}
int f(float v) nosig {print v}
#show f 2.0
'#recordof f
*/

/*
'2018-02-19 T 07:18:07
'Type tolerance
'Passing composite types byref
$ filename "t.exe"
uses rtl64
type vector2d float x,y,z
type vector3d float x,y,z
function f1d(float*v) as int {}
function f2d(vector2d*v) as int {}
function f3d(vector3d*v) as int {}
vector2d v
#show sys a=f1d v
vector3d v
#show sys a=f1d v
int v
#show sys a=f1d v
'float v
'#show sys a=f2d v
'vector3d v
'#show sys a=f2d v
*/


/*
'2018-02-18 T 14:06:28
$ filename "t.exe"
uses rtl64
function f() as int {}
#show sys a=f
*/


/*
'2018-02-17 T 21:35:15
'Iteration review
type xx float x,y,z
xx x
int e,i,j
for i=1 to sizeof(x)*2 step i+=sizeof(float)
  'exit for
  j++
next
print "ok" j
*/

/*
'2018-02-17 T 19:03:38
'test MemberArray and MemberRedim
uses generics
class bb
  float x,y,z
  method constructor()
    print "construct"
  end method
  method destructor()
    print "destruct"
  end method
end class
'
class cc
  MemberArray bb mm
  method Members(int n)
    MemberRedim bb mm(n)
  end method
  method constructor()
    Members 3
  end method
  method destructor()
    Members 0
  end method
end class

'#recordof cc
new cc c
del c
*/


/*
'2018-02-16 T 19:03:29
'&bug
sys h1=16
sys c=1
a= & h1  (& h1)
'print a
print &h1 + 1
print  str(&   h1) ", " + str(& h1)
print  str(& h1) ", " + str(@ h1)
*/


/*
'2018-02-16 T 02:51:41
'typedef void vd, *pvd
typedef struct ihandle_ ihandle
'#recordof ihandle
ihandle* g(){return getmemory 128}
#show ihandle* v=g()
'#recordof v
'print typeof v
'void f(void*v){}
void f(ihandle* v){}
#show f v
print @v
*/

/*
'2018-02-16 T 01:44:30
void* f(){}
'#recordof f
#show void*a=f()
*/

/*
'2018-02-15 T 18:10:12
'assigning memory directly to void*
end
#show void*v=getmemory 100
*/

/*
'2018-02-15 T 13:53:31
'void* tests
'end
typedef void *lpvoid
'void*v
float*v
'lpvoid v
@v=getmemory 1024
v=7
function f(void**v){(float) v = 42}
#show f v
print v
freememory @v
'#recordof v
*/

/*
'2018-02-15 T 12:03:16
'any** calling
class cc { float f[100] }
sys f(any**v){
cc c at @v 'void** requires 'at v'
#show print c.f[2]
}
new cc c
#show c.f[2]=5.5
#show f c
del c
*/


/*
'2018-02-15 T 09:06:51
'#show function f (fpu a,b,c) as float {faddp : faddp : return }
'#show v=f 1,2,3

'2018-02-15 T 09:39:20
'void type indirection vs other pointers
'void v
typedef void  *lpvoid
lpvoid v[100]
'#recordof v
int i=1
'#show v[i]=42
*/


/*
'2018-02-15 T 11:30:58
'indirect arrays / array of pointers
int i=1
typedef float *lpfloat
lpfloat f[100]
'#recordof f
float fa
#show @f[i]=@fa
#show f[i]=pi
print f[i]
*/


/*
'2018-02-14 T 21:07:06
#ifdef null
  print "ok"
#endif
#recordof null
*/

/*
'2018-02-14 T 18:53:24
'using null in metaprogramming
macro m(a=null)
#if a=null
print "ok"
#endif
end macro
m
*/

/*
'2018-02-14 T 13:22:09
'James
function foo (long v, optional string os) as string
	print os
	return "long " v
end function

function foo (double v, optional string os ) as string
	print os
	return "double " v
end function

function foo (string v, optional string os) as string
	print os
	return "string " v
end function

long l=42
double d=42.5
string s="43"

print foo (l,"l")
print foo (d,"d")
print foo (s,"s")
*/


/*
'2018-02-14 T 13:05:50
class cc
method m(int a,b, optional c=4,d) {}
end class

#recordof cc
*/

/*
'2018-02-14 T 13:04:30
'optional / default param review
'function e(float a,optional b,c=30,d=40){print "default"}
function f(float a, optional int b,c,d){print "optional"}
function f(int a,b,c,d){print "match"}
#recordof f
#show f 1,2,3,4
'#show f 100.0
#show f 1,2
'#show f
*/

/*
'2018-02-14 T 05:04:00
'overloading with optional params (using macro)
macro fm(a,b=null,c=null,d=null) f(a,b,c,d)
function f(int a,b,int c,d){print "ints"}
function f(float a,b,int c,d){print "floats"}
function f(double a,b,c,d){print "doubles"}
function f(string a,b,int c,d){print "strings"}
float v
fm 1
fm v
#show fm 1.0,1.0,2.0,4.0
fm "ok"
*/

/*
'2018-02-13 T 11:03:14
'void candidate
void v[100],w
#recordof v
*/

/*
'2018-02-13 T 09:13:46
'void* converted to sys
void* x[100]
#recordof x
*/


/*
'2018-02-13 T 08:39:32
'test hex and str
$ filename "t.exe"
uses rtl64
uses console
printl hex 0xabcd
printl hex 0xabcd,7
printl pi
printl str(pi(),5)
pause
*/

/*
'2018-02-13 T 05:34:05
'param spill
$ filename "t.exe"
uses rtl64
extern
#show int f(fpu v, int d){print d}
#show f 1.0,2
*/

/*
'2018-02-12 T 16:26:38
'decimal places
$ filename "t.exe"
uses rtl32
double a=pi
string s=str(a,5)
print s
*/

/*
void w
byte b
#show w=b
*/

/*
function f(void* v){}
'int v
'void w
void*v=getmemory 100
'#recordof w
#show f v
*/

/*
'2018-02-12 T 10:50:28
'macro prototypes without commas
macro m(a b,c,:,,d){print a+b+c+d}
macro m(a b c d){print a+b+c+d}
macro m(a=42, b=1, c=2, d=3, e,f,g){print a+b+c+d}
#recordof m
'm 1,2,3,4
m 1
*/

/*
'2018-02-12 T 06:19:55
'voids in classes replaced
class cc
method m(void*v) as void* {}
end class
'
#recordof cc
*/

/*
'2018-02-12 T 05:35:02
'replace void signature
#show sys f(void*v){}
'function f(void*v)as void ptr {}
void* v
'#recordof v
#show v=f 1
#recordof f
*/

/*
'2018-02-12 T 03:44:23
'void* conversion to sys
void* a[100]
#recordof a
'#recordof void
'print spanof a
#show print a[10]
*/

/*
'2018-02-11 T 20:27:14
'void*
#show void* pVague = getmemory 1024
'print hex pVague
'#show freememory pVague
#show pVague
'#recordof pVague
*/

/*
'2018-02-11 T 20:20:23
'hibyte and lobyte
int a=0xaabbccdd
print hex(hibyte(a)) " . " hex(lobyte(a))
*/

/*
'2018-02-10 T 13:30:43
'#noinit behaviour
'#show int f(int a,b,c,d){#noinit}
#show string f(int a,b,c,d){#noinit}
*/

/*
'2018-02-09 T 10:48:37
'64bit string to char call
%filename "t.exe"
uses rtl64
extern
function f(char*s){print s}
end extern
string t="ok1"
#show f t
*/

/*
'2018-02-09 T 10:15:55
'64bit internal/external vector call
%filename "t.exe"
uses rtl64
function f(inta,b,c,d) external {print 1 2 3 4}
extern
!* g(int a,b,c,d) 'external
end extern
@g=@f
'end
'print "ok"
g 1,2,3,4
*/

/*
'2018-02-08 T 09:45:57
'test 64bit autoconvert
%filename "t.exe"
uses rtl64
string s
float v
'#show s=v
'#show v=s
'#show s=s s s
'#show string f(int v){return "ok" v }
'print f 5
#show int f(string s){return s}
print f "55"
*/

/*
'2018-02-05 T 11:41:05
'functions param test
int f(int a,b,c,d){}
int g(int a,b,c,d){}
int h(string a, int b,c,d){}
int j(float a, int b,c,d){}
int z(char* a, int b,c,d){}
'
int i
float a
string s
char c[10]
'#show f(a,2,3,4)
'#show j(1,2,3,4)
'#show j(i,2,3,4)
'#show b=f(1+a,2,3,4)
'#show g f(1+a,2,3,4),20,30,40
'#show print "X " 1
'#show b=f("1",2,3,4)
'#show f("1",2,3,4)
'#show f(s,2,3,4)
'#show h("1",2,3,4)
'#show h(1,2,3,4)
'#show z(1.0,2,3,4)
'#show z(1,2,3,4)
'#show z(a,2,3,4)
'#show h(c,2,3,4)
'#show j(c,2,3,4)
'
string s,t,u
'
'#show print s
'#show print s t u
'#show print 1 2 3
'#show print 1.0 2.0 3.0
'#show a=1.0 2.0 3.0
'#show s=1.0 2.0 3.0
'#show print "ok " 1 2 3
*/

/*
'2018-02-03 T 12:45:30
'USING MACRO FUNCTIONS
'2D ARRAY WITH BOUNDARY CLIPPING
indexbase 0
int pix[800*600]
'
'SINGLE-LINE MACRO FUNCTION
'macro pix2d(x,y) pix(y*800+x)
'
'MULTI-LINE MACRO RETURNING A UNIQUE VARIABLE
macro pix2d int (x,y,  v,vv)
  #return *v 'pointer supports reading and writing in pix
  if x>=0 and x<800 and y>=0 and y<600
    @v=@pix(y*800+x)
  else 
    int vv=0xffffffff 'value when out of bounds
    @v=@vv
  end if
end macro
'
'TEST
pix2d(1,20)=0xaabbccdd
print hex pix2d(1,20)
print hex pix2d(800,10)
*/

/*
'2018-02-03 T 11:27:35
'trig lookup table
single sinv[361]
indexbase 0
int i
single a,n
'print spanof sinv
for i=0 to 360
  sinv(i)=sin(rad(i))
next
'indexing with radians
a=pi
double f=1/(2*pi)
i=frac(a*f)*360
if i<0 then i+=360
print i
*/


/*
'2018-02-01 T 18:39:40
'int int problem
dim int int
'#recordof int
'print typeof int
'#show int int
'#show dim as int int
*/

/*
'2018-02-01 T 17:57:35
'macro function inside conditional block
macro X int()
#return t
...
t=0
end macro
'
#show while X : wend
*/


/*
'2018-01-31 T 12:10:21
'indexing review
indexbase 0
int v[100],i,j=1,k
'#show v[i*2]
'#show v[i]
'#show v[i+2]
'#show v[i+j]
'#show k=v[v[i+j]]+42
'#show v[v[i+j]]=k+42
'#show v[v[i+j]+k]=k+42
*/

/*
'2018-01-31 T 10:59:21
#show int f(){}
*/

/*
#show print chr(65,66)
*/

/*
int i
int v[100]
#show a=v[i+13]
*/

/*
'2018-01-29 T 20:26:25
'test a=,b=,b=
macro m(a,b,c,d="ok",  e,f,g)
#ifndef b
  print d
#else
  print b
#endif
end macro
#recordof m
m 1,2
*/

/*
'2018-01-29 T 16:41:25
'tests for local workspace
#show void f(){int a}
*/

/*
'2018-01-28 T 11:54:59
'end' inside a function
#show int f(){print "ok" : end : print "nok" }
#show end
*/

/*
'2018-01-28 T 11:42:42
'new _end_ labels replacing _exit_
#show function f(){}
*/

/*
'2018-01-28 T 10:18:49
'assembler followed by statement
a=0
do
cmp a,2 : jz fwd _exit_do:print a++
end do
*/

/*
'2018-01-28 T 10:13:49
'while then
a=0
b=2
while a<b then print a++ : wend
*/

/*
'2018-01-27 T 11:41:35
'HIGHER CONDITIONALS
type tt int a,b,c
macro tt_op(a)
  macro ."load"(a)
    tt acc
    bool cond
    acc.a=a.a
  end macro
  macro ."save"(a)
    #if match(typeof(a),"bool")
      a=cond
    #else
      a.a=acc.a
    #endif
  end macro
  macro ."==" bool(a)
    if acc.a=a.a then cond=1 else cond=0
  end macro
end macro

tt x,y,z
int i,j
'z.a=1
'#show i=y==z

'if i<>j
'#show elseif y==z
'#show elseif not y==z
'print "ok"
'end if

'#show while y==z
'print "ok"
'exit while
'end while

if y==z then print "ok"
*/


/*
'2018-01-26 T 17:49:23
'DEMO DLL
% filename "t.dll"
uses rtl32

function greet(s as char) as long, export
print "hello "'+s
return 42
end function
*/
/*
declare function greet lib "t.dll" (s as char) as long
a=greet("Chris")
print a
*/

/*
function f(sys a,b,c=4,d)
end function
#recordof f
*/

/*
'2018-01-26 T 11:38:09
'macro default test
'macro init(tpl,b)
'if tpl then freememory tpl
'#ifdef b
'  tpl=getmemory(b)
'#else
'  int b=1024
'  tpl=getmemory(b)
'#endif 
'end macro
macro init(tpl= ,  b=1024)
'itr trap missing params?
if tpl then freememory tpl
tpl=getmemory(b)
end macro
#recordof init
sys a
#show init 
freememory a
*/


/*
'macro default parameters
'2018-01-24 T 16:38:25
macro m(
a=4,
b="ok",
c,
d
)
print a+","+b
end macro
'#recordof m
m(b="nok",a=8)
m
m 8
*/

/*
'mixed default params
'2018-01-24 T 10:02:39
'int f(int i=45,j){}
int f(int i=45,*j){} 'j null
#show f(i=90)
*/

/*
'default null: null addresses
'2018-01-24 T 09:55:55
'int f(optional int *i){print @i} '0
'int f(int *i=null){print @i} '0
int f(int *i=0){print @i} '<>0
f
*/

/*
'2018-01-24 T 09:54:22
'elseif coding
int a,b
if a>b
#show elseif a<b
end if
*/


/*
'2018-01-16 T 11:25:37
'macro function tests
macro m(a  r)
r=a+a
#return int r
end macro

int a,b,c
'
'print m(1)
'#show b=m(1)
'#show a<b
'#show if a<b {}
'#show b=3<5
'#show b=8+m(1)+16
#show if m(1)
'#show if not m(1)<9 then 
int v=101
#show end if
*/


/*
'2018-01-16 T 16:56:19
'default param test
string f(*a=1,int b=2, string c="ok"){return (a*b)+c}
#recordof f
print f( a=10, c="X" )
*/

/*
'2018-01-16 T 11:12:13
'extended dim statement
function f
    local as int
  
    twopi          = PI()*2,
    torus_major    = 1.5,
    torus_minor    = 0.5,
    torus_major_res= 32,
    torus_minor_res= 32
#recordof torus_minor
end function
*/


/*
'2018-01-09 T 16:56:39
'macro functions returning a variable
'no type passed
macro sum float (a,b,  m)
  #return m
  m=a+b
end macro
'
int w=10,x=100
#show int v=1+sum(w,x)+2
print v
*/


/*
'2018-01-08 T 12:02:42
'macro functions returning a variable
macro sum(typ,a,b,  m)
  m=a+b
  #return typ m
end macro
'
int w=10,x=100
#show int v=1+sum(int,w,x)+2
print v
*/




/*
def literal "%1"
macro m(
s,  'ok
aa, 'ok
bb  'ok
)
#show print literal(s)
#show print k##s
#show print s##k
#show print k##s##k
#show print "<"#s#">"
end macro
'
m t
*/


/*
'2018-01-08 T 18:03:51
'pb example port
'MACRO FUNCTION HowDidIGetHere
'  MACROTEMP i, a
'  DIM i AS LONG, a$
'  FOR i = CALLSTKCOUNT TO 1 STEP -1
'    A$ = A$ + CALLSTK$(i) + ", "
'  NEXT
'END MACRO = RTRIM$(A$, ANY ", "
'
macro HowDidIGetHere string(    i,A)
#{
  int i
  FOR i = CALLSTKCOUNT TO 1 STEP -1
    A$ = A$ + CALLSTK$(i) + ", "
  NEXT
  A$ = RTRIM$(A$, ANY ", "
} A
end macro
*/

/*
'2018-01-08 T 13:55:07
'loading datasets
macro m(a,b)
int a=b
end macro

#show m a,{1,2,3,4}
#recordof a
*/


/*
'2018-01-08 T 10:02:46
'literal and match type
string t
int t
float t
'
def literal "%1"
'
macro types(s)
#if match (typeof(s),"string")
  print literal(s) " is string"
#elseif match (typeof(s),"int")
  print literal(s) " is int"
#else
  print literal(s) " " typeof(s) " not accepted"
#endif
end macro
'
types t
*/

/*
'2018-01-08 T 09:24:54
'optional params in macro
[code]
macro init(tpl,b)
#ifdef b
  tpl=getmemory(b)
#else
  tpl=getmemory(1024)
#endif
end macro

sys v,w
#show init(v)
#show init(v,2048)
[/code]
sys v,w
#show init(v)
#show init(v,2048)
*/


/*
'2018-01-06 T 10:52:50
'use of macro
macro limit(a,b)
  if a>b then goto done
end macro

int x=1
do
  limit(x,10)
  x+=3
end do
  
Done:
PRINT"Exited GOSUB without a RETURN stack error.\n"
*/ 

/*
'2018-01-06 T 09:21:13
'test string naked expr
string a,b
#show a+b
*/


/*
'2018-01-06 T 04:13:31
'naked expressions
int a=4,b=10
#show a+b
a=eax
#show a
print a
*/

/*
'gosub drop thru
'2018-01-05 T 23:25:53
function f()
int a
a=142
gosub checka
exit function
'
checka:
if a>=0 and a<100 then ret 
print "error: a is out of range"
end function
f
print "ok"
*/

/*
'2018-01-05 T 23:15:43
'early ret
int a=5,b=10
gosub sumif
print a
end

sumif:
if a<=5 then ret
a+=b
ret
*/

/*
'STANDARD TUTORIAL FORMAT
'2018-01-05 T 16:25:30
uses console
'
'EXPRESSIONS
'
'a sequence of variables, operators and functions
'
'examples:
'  a+b
'  a+b/c
'  (a+b)/c
'  str( a+b/c )
'
'  expressions are used in statements:
'  print a+b
'  c=a+b
'  if a+b>0 then c=0
dim a,b,c
a=5
b=10
c=100
cls
print "sum: "+a+b+cr
pause
*/


/*
'2018-01-05 T 11:59:04
'2 level reference
class obj { int x,y,z }
int create(obj a**) { @a=getmemory sizeof(a) }
obj byref a
#show create a
*/


/*
'2018-01-05 T 12:00:48
'^ as power operator
a=2^4
print a
*/


/*
'2018-01-04 T 07:06:15
'gosub / call in expression
int a=1+call ff()+2
print a '45
end

ff:
=42
ret
*/

/*
'2018-01-04 T 06:49:48
'function overhead
int a
#show function f() as int
return 42
end function

#show gosub ff
end

ff:
#show =42
ret
*/


/*
'2018-01-03 T 21:16:44
int a,b
a=1
b=3
#show a &&= b
print a
*/

/*
'2018-01-03 T 10:46:46
for i=1 to 3
#show   continue for
  print i
#show next
*/


/*
'2018-01-02 T 14:47:35
use generics
long *vv
setbufmem vv,8
print len(vv_buf)
redimarray double s(100)
print len(s_buf)
*/

/*
'2018-01-02 T 12:59:03
int i,j

for i=1 to 3
if j then print i : exit for
if i=2 then j++ continue for
next
*/

/*
'2018-01-02 T 09:45:18
do
  exit
  break
  #show continue
loop
print "ok"
*/

/*
#show while 1
  while 1
    exit 1
  wend
  print "level 1"
  exit 1
wend
print "ok"
*/

/*
while 0
#show break
wend

int a
select a
case 0
case 1
#show break
end select
*/


/*
'2017-12-31 T 16:26:56
'default do
#show while 0
#show  continue 'do
#show wend
*/

/*
#show bstring s
#show s="ok"
*/

/*
mov eax,0xaaa
popcnt ecx,eax
print ecx '6
'
'popcnt emulation:
xor ecx,ecx
mov eax,0xaaa
mov esi,32
(
 dec esi
 jl exit
 shl eax
 jnc bitnotset
   inc ecx
 bitnotset:
 repeat
)
print ecx
*/

/*
'2017-12-30 T 14:18:23
'FPU type
string f(fpu a, int b){}

string s,wr
#show wr= f 1,2
*/

/*
'2017-12-30 T 11:58:33
'revoke fpu, cpu and leaf calling conventions
function f cpu(a,c)
return a+c
end function
'#show int c=f 1,2
*/


/*
'2017-12-30 T 11:13:27
boolean a,b
'#recordof b
'#show byte c=a and b
'#recordof c
#show if not a {}
*/

/*
'2017-12-29 T 10:35:23
'proc pointers/vectors
'int (f)()
!* f() as int
sys a
#show @f=a
*/

/*
'2017-12-28 T 17:13:04
'logical operations && || ^^
sbyte a=1,b=4
#show c= a && b
print c "  " typeof c
*/


/*
'2017-12-27 T 05:32:47
'itr interference
string s,t
s="x"
t=""
float s=1,t=2
#show if (t)and(s) {print "Q"}
'#show if s+s {}
*/

/*
'2017-12-26 T 13:32:00
float a,b,c
'#show if     a {}
'#show if not a {}
'#show float b=not a
'#show c = a and b
'#show if (a>b)and(c=0) {}
'#show if c {}
'#show if (c) {} 'itr
'int a,b,c
'string a,b,c
'#show if (a<>3) and (b=4) {}
'#show if (a) and (b) {} 'itr not strings
'#show if a {}
'#show if (a>b)and(a>c) {}
a=1
b=0
#show if (a) and (b) {print "Q"} else {print "N"}
*/

/*
'2017-12-26 T 13:04:35
dim a as sys
dim b at a as double
#recordof b
&/

/*
'uses console
const a=13
const a=14
int b[a]
#recordof b
'waitkey
*/

/*
const as long ttrue=1-3
#recordof ttrue
print ttrue
*/

/*
'128 bit logic
'2017-12-24 T 12:02:25
indexbase 0
int a={1,2,3,4,5,6,7,8}
movups xmm0,a[0]
movups xmm1,a[4]
andps  xmm0,xmm1  'and
'andnps xmm0,xmm1 'and not
'orps   xmm0,xmm1 'or
'xorps  xmm0,xmm1 'xor
movups a[0],xmm0
print a[0]
*/


'2017-12-24 T 11:46:09
'! SetWindowPos   lib "user32.dll"(hwnd as int,hWndInsertAfter as int,x as int,y as int,cx as int,cy as int,wFlags as int) as int

/*
'2017-12-23 T 20:11:13
'int a
'#show b=not a

type point int x,y
point p={10,20}
point q
#show q=p
print q.y
'#recordof p
*/

/*
'2017-12-22 T 16:38:54
a=0xaaa
'popcnt eax,a
lzcnt eax,a
print eax
*/


/*
'2017-12-21 T 23:47:45
function f(a as long)
#show int b=a[2]
end function
*/

/*
'2017-12-20 T 10:58:18
type i128 int i1,i2,i3,i4
macro i128_op(a, p)
  macro .ops(p,a)
    ac.i1 p a.i1
    ac.i2 p a.i2
    ac.i3 p a.i3
    ac.i4 p a.i4
  end macro
  macro ."save"(a)
    i128 ac
    a.i1=ac.i1
    a.i2=ac.i2
    a.i3=ac.i3
    a.i4=ac.i4
  end macro
  macro ."load"(a)
    dim i128 ac
    i128_op.ops(=,a)
  end macro
  macro ."and"(a)
    i128_op.ops(and=,a)
  end macro
  macro ."or"(a)
    i128_op.ops(or=,a)
  end macro   
  macro ."xor"(a)
    i128_op.ops(xor=,a)
  end macro   
  macro ."not"(a)
    i128_op.ops(=not,a)
  end macro   
end macro
dim u,v,w,x as i128
#show u=v and (w or x)
*/


/*
'2017-12-20 T 10:49:49
#unique on
int aaa
'#undef aaa
int aaa
'print aaa
*/

/*
'2017-12-18 T 21:11:20
type i128 int i1,i2,i3,i4
macro i128_op(a,b,c)
  macro ."copy"(a,b)
    a.i1=b.i1
    a.i2=b.i2
    a.i3=b.i3
    a.i4=b.i4
  end macro
  macro ."and"(a,b,c)
    a.i1=b.i1 and c.i1
    a.i2=b.i2 and c.i2
    a.i3=b.i3 and c.i3
    a.i4=b.i4 and c.i4
  end macro
  macro ."or"(a,b,c)
    a.i1=b.i1 or c.i1
    a.i2=b.i2 or c.i2
    a.i3=b.i3 or c.i3
    a.i4=b.i4 or c.i4
  end macro
end macro
dim u,v,w as i128
#show u=v and     w
*/

/*
'2017-12-18 T 21:11:48
'register model
type i64 int i,j
macro i64_op(a)
   macro ."load"(a)
    mov eax,a.i
    mov edx,a.j
  end macro
   macro ."save"(a)
    mov a.i,eax
    mov a.j,edx
  end macro
  macro ."+"(a)
    add eax,a.i
    adc edx,a.j
  end macro
  macro ."-"(a)
    sub eax,a.i
    sbb edx,a.j
  end macro
  macro ."="(a)
    (
      cmp eax,a.i
      jnz exit
      cmp edx,a.j
      jnz exit
      mov _bool_,1
    )
  end macro
end macro

dim i64 u,v,w,x
'#show u=v+w+x
#show if v>w
end if
*/


/*
int f(int *a,*b) {}
int a,b
#show f(a)=b
*/


'2017-12-14 T 09:57:58
'dim inside types (no longer static)
/*
global b[10]
static a=4
#recordof a


class cc
dim a as int
dim as int b
end class

#recordof cc
*/

/*
'2017-12-05 T 17:56:36
'addr resolution for line nune number
#show goto 100
100
#show addr eax,100
*/

/*
'2017-12-04 T 10:27:56
use console
'
macro xx_op(a,b,c,d)
====================
  macro ."load"(a,b)
  print "load" cr
  end macro
  macro ."save"(a,b)
  print "save" cr
  end macro
 macro ."neg"(a,b)
  print "neg" cr
  end macro
  macro ."+"(a,b,c)
  print "+" cr
  end macro
  macro ."-"(a,b,c)
  print "-" cr
  end macro
end macro

type xx
  int i,j
end type

xx a,b,c,d

#show a=b+c-d

waitkey
*/


/*
'
sbyte s
byte b
b=255
s=b
#show string t= hex s
print t
*/

/*
'2017-11-24 T 03:55:38
print hypot 1,1 'no brackets
*/


/*
'2017-11-22 T 10:44:06
'generics
macro FillBytes(name,count,value)
=================================
addr rsi,name
mov rcx,count
(
 dec rcx
 jl exit
 mov byte [rsi],value
 inc rsi
 repeat
)
end macro

int a
fillbytes a,sizeof a,0x12
print hex a
*/


/*
a=2
(
dec a
jnz exit
print "ok"
repeat
)
*/

/*
use minwin
%= WM_FINISH = WM_USER+0x100 '1280
'#define WM_FINISH WM_USER+100h '1280
print hex wm_finish
*/


/*
'2017-11-14 T 10:25:45
'fix universal block structure inside functions
function f()
(
)
print "ok"
end function
*/

/*
sbyte b=255
print b
*/


/*
'2017-11-11 T 13:40:45
indexbase 0
int d[100]
int x,y,z,l
'#show if x+y+z =d[l]+d[l]
'#show if d[l]=d[x]+d[y]+d[z]
#show if d[x]+d[y]=d[l] {} '-d[l]
'#show d[l]=d[x]+d[y]+d[z]
'#show d[l]=x+y+z
*/


/*
'binary log
'2017-10-27 T 12:23:29
'MAKR TABLE OF ROOTS AND INVERSE ROOTS
indexbase 0
double lgt[32]
double igt[32]
double lg at @lgt
double ig at @igt
double d
int i
d=2
for i=0 to 31
  lg=sqr(d)
  d=lg
  ig=1/d
  @lg+=8
  @ig+=8
next

'INTEGER PART
int c,i
double a,n,nn
'n=12345678
nn=3
n=nn
while n>=2
  n*=0.5 : c++
wend
'print n "  " c
dword f,b=0x80000000
for i=0 to 31
  a=igt[i]*n
  if a>=1 then
    n=a : f or= b
    if n=1 then exit for
  end if 
  shr b 
next
double ff=f/0x100000000
print c "." mid(ff,3) "
" log2(nn)
*/

/*
'2017-10-23 T 04:15:17
'Recovering remainder after integer division
dword a,b=199,c=100,d
#show a=b\c+d
d=edx
print "result " a " remainder " d '1  99
*/


/*
'2017-10-20 T 14:28:04
int a=0x8fffffff
int b=3
int c=0
mov eax,a
clc
sbb eax,b
mov c,eax
jb nn
  print hex c
nn:
*/

/*
indexbase 1
int a[256]
a[32]=3
addr edi,a
test byte [edi+124],1
(
 jz exit
 print 1
)
*/

/*
'2017-10-19 T 06:04:24
mov edx,0
mov eax,1
int a=1,d=0
clc
rcr a,1
'pushf
add d,0
'popf
rcr d,1
print hex(d,8)
*/

/*
int a=4
cmp a,5
jg nok
print a
nok:
*/

/*
'2017-10-18 T 10:41:43
int a=3
test a,1
(
 jz exit
 add a,10
)
print a
*/

/*
'2017-10-16 T 16:57:38
'resoved macro override conflict
%a 100
#show int a,b
#recordof a
*/

/*
'2017-10-13 T 15:43:55
extended a,b,c,p,q
#show p=a+sin(p)
*/


/*
'2017-10-12 T 11:03:25
'timings
use minwin
use console
t1=GetTickCount
mov esi,1e8
int i=0x33123456
(
 mov ecx,3
 mov eax,i
 xor edx,edx
 div ecx
 'mul ecx
 dec esi
 jnz repeat
)
t2=GetTickCount
print ( (t2-t1)/100  " nanoseconds per loop" cr )
waitkey
'results: HP laptop
'without div .5
'div reg 3.5


/*
'http://www.rosettacode.org/wiki/Arbitrary-precision_integers_(included)
'http://www.rosettacode.org/wiki/Arbitrary-precision_integers_(included)#Pure_C

$ filename "Arbitr_Prec.exe"
'include "$/inc/RTL32.inc"

include "$/inc/console.inc"

'Use Windows functions
! GetTickCount lib "kernel32.dll" () as sys

' return = a * b
' Handling of negatives and zeros is not here, since not needed.
function str_mult(string a,b) as string

    string r ' result
   
    int ax = 0, bx = 0, rx = 0, al, bl
    int carry, n
    int an, bn, rn, t 'auxiliary

    al = len(a) : bl = len(b)   
    r = stringbytes (al+bl,48) 'FILL 0000..
    byte aa at strptr a
    byte bb at strptr b
    byte rr at strptr r
    indexbase 1
    macro midval(b,i){ b[i]-48 } 'ASCII TO DIGIT VALUE
       
    ' grade-school method of multiplication
    for ax = al to 1 step -1
        carry = 0
        for bx = bl to 1 step -1
           rx = ax + bx
           an=midval(aa,ax)
           bn=midval(bb,bx)
           rn=midval(rr,rx)                   
           n=an * bn + rn + carry
           rr[rx]=mod(n,10)+48
           carry = n \ 10             
        next bx
        rx--       
        'int t=midval(r,rx) + carry
        rr[rx]+=carry 'FINAL CARRY
    next ax

    ' omit possible first place - zero
    if rr[1]=48 then return mid(r,2)   
    return r
end function

a="4225678345671239269412376809064563457830987094214727890460503258124429509352125309123467889090967803"
b="9034098905607687535809534264324877930963452357175890408065643678402109067842097453251206046098340056"

ans1="38175196118078646234796018047078508876075927016257021775208337789644882612626336290568135391711676360295755214293161291134825045621348587392814424177752560047244220841334894056033458232344500841216968"
ans2=str_mult(a,b)
printl ans1
printl ans2
waitkey


function str_exp(int b, int n) as string
  string res, a

  res="1"
  a=str(b)

  if n=0 then return res
 
  while n > 0
    if n and 1 then 'mod(n,2)=1 then 
      res = str_mult(res, a)
    end if
    n = n >> 1 '\= 2
    if n=0 then exit while   
    a = str_mult(a, a)
  wend

  return res
end function


for z=3 to 3 '4
for x=2 to 3
for y=1 to 2
   z1=str_exp(x,y)
   printl z1
   z2=str_exp(z,z1)
   printl z2

   t1=GetTickCount()
   printl "Calculatating 5^" z "^" x "^" y " which is 5^" z2 & cr

   z3=str_exp(5,z2)
   t2=(GetTickCount()-t1)/1000
   printl "Length for result of 5^" z "^" x "^" y " is " len(z3)
   printl "First 20 digits: " left(z3,20)
   printl "Last 20 digits:  " mid(z3,-20)
   printl "This took " str(t2,3) " seconds"
   printl
next y
next x
next z

printl "Enter ..." : waitkey
*/


/*
GCC compiled:
Length of 5^4^3^2 is 183231
First 20 digits:  62060698786608744707
Last 20 digits:   92256259918212890625
This took xxx seconds
*/

/*
class cc
constructpr (){}
end class
*/

/*
'2017-10-10 T 04:30:03
class cc
char s[256]
int m(){
#recordof this
}
void constructor(){s="ok"}
void release(){del this}
end class
cc f(){new cc c : return @c}
'#show s=f 'copy
#show cc *s=f 'transfer pointer
print s.s
#recordof s
*/

/*
'2017-10-09 T 14:15:24
use com/comutil
GUID g
'#show refiid r = guidval(g,"{839DDCA3-9B4E-41E4-B053-892BD2A11EE7}")
'#show GUID* r = guidval(g,"{839DDCA3-9B4E-41E4-B053-892BD2A11EE7}")
'#show GUID r = (GUID) guidval(g,"{839DDCA3-9B4E-41E4-B053-892BD2A11EE7}")
'#show GUID r=g
int fg(GUID*a){
}
'
'int g(){
'#show f GUID {}
'}
'
'macro guidbin(s) byval guidval(guid{},s) 
'#recordof guidbin
'#show fg (guidbin("{839DDCA3-9B4E-41E4-B053-892BD2A11EE7}"))
#show guid*a=guidbin("{839DDCA3-9B4E-41E4-B053-892BD2A11EE7}")
'#show guid a=guidbin("{839DDCA3-9B4E-41E4-B053-892BD2A11EE7}")
'#recordof a
#show guid b=a

print guidtxt a
*/

/*
'2017-10-08 T 10:38:09
type D3DGAMMARAMP WORD red[256],green[256],blue[256]
#recordof D3DGAMMARAMP
*/

/*
'2017-10-08 T 10:15:46
function f(char *s)
a=(byte) s*10
print a
end function

f "abc"
*/

/*
'2017-10-08 T 10:15:37
macro D3DPS_VERSION(Major,Minor) 
 (0xFFFF0000 OR (Major<<8) OR Minor) 
end macro
#define D3DPS_VERSION(Major,Minor) (0xFFFF0000 OR (Major<<8) OR Minor)
#recordof D3DPS_VERSION
print hex D3DPS_VERSION (2,1)
*/

/*
'2017-10-07 T 17:41:53
type t long type, s
#recordof t
*/


/*
'2017-10-07 T 16:55:56
type D3DCOLOR_BGRA_STRUCT BYTE blue , green , red , alpha

' // Size = 4 bytes
union D3DCOLOR_BGRA_UNION DWORD color , D3DCOLOR_BGRA_STRUCT

#recordof D3DCOLOR_BGRA_UNION
*/

/*
extern

'2017-10-02 T 16:18:41
class aa
'int ma(){}
double a1,a2
end class

'end extern

class bb
'int mb(){}
'has aa a1
has aa
'has aa
has aa a1,a2
int b,c
end class

#recordof bb

end extern
*/


/*
'2017-09-24 T 01:29:27
function f(int a,b) as int
end function

int a,b
f _
a,
b
*/



/*
'2017-09-24 T 01:29:18
uses generics
uses console
'undef minmax
'sys minmax
'dim sys minmax
'dim minmax as sys
var sys minmax
extern
sub main()
end sub
main()
waitkey()
*/


/*
function f(int a,b) as int
end function

int a,b,c,d
f a*b+c,9
print (a*42)+1
*/

/*
string s
int i,j
if len(s)>1 and i<4
end if
'if j>1 and len(s)<4
'end if
'if i (1)>2 and i<4
'end if
*/

/*
s="
qwerty"
print typeof s
*/

/*
'2017-09-21 T 03:14:12
'COPY TEST
%filename "z.exe"
uses rtl32
string a="0000000A",b="1234567"
copy strptr a, strptr b, 7
print a
*/

/*
'2017-09-21 T 03:08:07
'CHAR* TESTS
'function f() as char*
'static string s="ok"
'return s
'end function
'
'print f
'#recordof f

class cc
function f() as char*
static string s="ok"
return s
end function
end class

cc c
print typeof c.f
'#recordof cc
*/

/*
indexbase 0
int a[100],b[100]
int i,j,k
int f(){}
int f(int v){}
float g
'#show b=a[4]
'#show b=a[i]
'#show b=a[i+4]
'#show b=a[i+j]
'#show b=a[i+j+k]
'#show b[i+j]=a
'#show b=a[b[i]]
'#show b=a[b[i]+1]
'#show b=a[b[i+1]]
'#show b=a[b[i+1]+j]
'#show b=a[b[i+j]+4]
'#show a=b(f)
*/

/*
%b=2
int j
int k[20/b]
#recordof k
*/


/*
'2017-09-18 T 09:14:45
'RECORD CHANGES
class cc
 int*a[100]
int* m(){}
end class
#recordof cc
*/


/*
'2017-09-17 T 07:51:41
'COND CHANGES
int a,b
float d
byte b

function f() as float {}

#show while f
exit do
wend
*/


/*
%a - 1 : % b 2 :
def c 1 : def e 2
#recordof c
*/


/*
'2017-09-15 T 04:49:07
'byte a
string a
#show if a then
endif

#show if a=42 then
endif
*/

/*
'2017-09-13 T 20:34:07
'function with no params or brackets
function f() as float
return 1
end function
'#recordof f
#show if f then print "ok"
*/

/*
'2017-09-13 T 19:45:52
'NEW CONDITIONALS
float a
string s
#show while s
  exit do
wend

#show if a then a++
*/

/*
'2017-09-12 T 20:08:51
'TEST ARRAY INDEXING
'double a[100]
class aa
double a,b,c[4],d
end class
aa a[100]
double b
sys i=10,J=2
#show b=a[i].c[J]
*/


/*
'2017-09-09 T 16:41:06
'ENCOUNTERS
include generics
include console
'
int idx={11,12,1,2,3,4,5,6,7,8,9,10}
'
macro compare(a,b)
if a<b then
  swap a,b
end if
end macro
'
encounters idx, countof idx, compare
listArray idx,print
printl countof idx
waitkey
*/


/*
'2017-09-09 T 16:29:27
'NO PRECEDENCE TEST
sys a,b,c,d
#show #noprec a= b-1 * c + d
*/

/*
'2017-09-09 T 10:55:56
'SHELL SORT
'ROLAND
    'applying indexbase 1
    macro shell_sort(a,d,  cc,df,i,ig,gap,lim)  'd=1 ascending, else descending  
    scope
      indexbase 1
      int cc=countof a  
      int i, ig, df, gap
     
      'Determine starting gap
      int lim = cc\3  'Donald E. Knuth, Vaughan R. Pratt
      i=1
      do
        if i>lim then i=(i-1)\3 : exit do
        i*=3 +1
      end do
     
      gap=i
    '  gap=cc \ 2  'Donald L. Shell
      
      while gap>0
         do
           df=true          'done flag
           for i=1 to cc-gap
              ig=i+gap
              if d=1 then   'ascending  
                if a[i]>a[ig] then
                  swap a[i],a[ig] : df=false
                end if
              else          'descending
                if a[i]<a[ig] then  
                  swap a[i],a[ig] : df=false 
                end if 
              end if  
           next
           if df=true then exit do
         end do 
    '     gap \= 2       'Shell
         gap=(gap-1)\3  'Knuth, Pratt
      wend
    end scope
    end macro
     
    ==========================================
     
    int array1[] = {30,5,24,11,26,20,4,23,9,25,6,28,15,27,7,22,10,3,1,13,21,29,17,2,19,8,16,14,12,18}
    double array2[] = {4.5,65.5,2,-31.5,0,99,2.5,83,782.5,1}
    string array3[] = {lcase("Oxygen"),"is","a","nice","and","powerful","programming","language"}
     
    print_array(array1)
    shell_sort(array1, 0)
    print_array(array1) 
    shell_sort(array1, 1)
    print_array(array1) 
    printl
     
    print_array(array2)
    shell_sort(array2, 0)
    print_array(array2)
    shell_sort(array2, 1)
    print_array(array2)
    printl
     
    print_array(array3)
    shell_sort(array3, 0)
    print_array(array3)
    shell_sort(array3, 1)
    print_array(array3)
    printl
     
    ==========================================
     
    'Use Windows functions
    ! GetTickCount lib "kernel32.dll" () as sys
     
    ! rand  lib "msvcrt.dll" cdecl () as int
    ! srand lib "msvcrt.dll" cdecl (int seed)
     
    int array4[1000000]
    'double array4[1000000]
     
    srand(GetTickCount)   'Randomize
     
    for x=1 to 1000000 : array4[x]=rand()/2.5 : next
    'print_array(array4)
    printl "Sorting " countof array4 " items of type: " typeof array4 " in ascending order with ShellSort:" cr
    t1=GetTickCount()
    shell_sort(array4, 1)
    t2=GetTickCount
    'print_array(array4)
    printl "Elapsed Time: " (t2-t1)/1000
    printl
    printl "Now sorting the sorted array in descending order with ShellSort:" cr
    t1=GetTickCount()
    shell_sort(array4, 0)
    t2=GetTickCount
    'print_array(array4)
    printl "Elapsed Time: " (t2-t1)/1000
     
     
    printl "Enter ..." : waitkey
     
*/



/*
'2017-09-07 T 12:48:05
'POLYMORPHIC BUBBLE SORT USING MACROS

include console

macro swap(a,b,  c)
typeof a c
c=a
a=b
b=c
end macro
 
macro bubble_sort(a,d,  cc,u,i)  'd=1 ascending, else descending 
scope
  indexbase 1
  int cc=countof(a)-1
  int u=1   'unsorted
  int i
  while u
    u=false
    for i=1 to cc
       if d=1 then   'ascending 
         if a[i]>a[i+1] then
           swap a[i],a[i+1] : u=true
         end if 
       else          'descending
         if a[i]<a[i+1] then
           swap a[i],a[i+1] : u=true
         end if   
       end if 
    next
    cc-- 'FINAL ELEMENT IS FIXED
  wend
end scope
end macro

macro list(a,  i)
scope
  indexbase 1
  int i
  for i=1 to countof a
    print a[i] "  "
  next
  print chr(13,10)
end scope
end macro

int a[]={1.25,2,3,4,5,6,7,8,9,10,"ten"}
bubble_sort(a,0)
print "int:     " : list a
float a[]={1.25,2,3,4,5,6,7,8,9,10,"ten"}
bubble_sort(a,0)
print "double:  " : list a
string a[]={1.25,2,3,4,5,6,7,8,9,10,"ten"}
bubble_sort(a,0)
print "string:  " : list a

waitkey
*/


/*
'2017-09-07 T 08:21:34
'HIGHER TYPE INCOMPATIBILITY
class aa
int i
end class

class bb
int i
end class
aa a
'aa b
bb b
#show a=b
*/


/*
'2017-09-07 T 08:17:22
'CHECK META CONCATENATION
%= ss "abc " + version + " def"
#recordof ss
*/

/*
'2017-09-07 T 00:33:00
'META LANGUAGE TESTS / STRONG TYPING WITH TYPEOF
typedef int glint
glint g
float i

'#if typecodeof i < 0x60
'print "integer"
'#elseif  typecodeof i < &h80
'print "floating point"
'#endif
'
#if match(typeof g, "glint")
print typeof g
#endif
*/


/*
'2017-09-06 T 18:51:15
'TESTING #LIST FACILITY
include consoleG

BeginScript

function main()
print "helo"
end function

EndScript
*/


/*
'2017-09-05 T 22:43:49
'TESTING EXTENDED F2 #LIST SYMBOLS
'include rtl64
namespace win
include minwin
namespace app
include parseutil
include generics
namespace
clusoword:
int i=0xffffffff
int j
j=loword i
print hex j
*/


/*
'2017-09-05 T 01:38:11
'PROTOTYPE WITH ARRAY PARAM
typedef int glint
typedef double gldouble
extern
int a[5]=42
int f(glint a, glint b,gldouble c,gldouble d,glint e[4])
end extern

f 0,0,0,0,1

#recordof f
int f(glint a,glint b,gldouble c,gldouble d,glint e[4]){}
print "ok"
*/


/*
'2017-09-03 T 03:10:48
'TEST SIMPLIFIED LET
a=40+2
s="ok"
print typeof(s) " " s a
*/


/*
'2017-09-01 T 10:30:10
'UNIQUE WITH SCOPE AND NAMESPACE
'STRICT NAME CONTROL
'
#unique on
#autodim off
include minwin
'include minwin 'ERROR
include once minwin
include generics
namespace app
include console
print  "ok"
int i
'int i 'ERROR
scope
  int i
  'int i 'ERROR
end scope
namespace
int i
scope
  int i
  'int i 'ERROR
  scope
    int i
  end scope
end scope
print "ok"
*/


/*
'2017-08-31 T 13:47:18
include generics
include console
int i
for i=1 to 10
  appendbuffer buf,  i tab i*10 cr  , lbuf
next
print left buf,lbuf
del buf
waitkey
*/


/*
'2017-08-31 T 13:47:18
include generics
include console
class cc
  'int a,b,c,d
  int m1(){print "m1" cr}
  int m2(int v){print "m2" tab v*10 cr}
end class
redimArray cc c(5)
applyMethodToArray c,m1()
applyMethodToArray c,m2(5)
'applyMethodToArray c,destructor()
waitkey
*/

/*
type color float r,g,b,a
color c1={1,2,3,4}
let c2=c1
print c2.b
*/

/*
include <generics>
type color float r,g,b,a
color c1,c2
c1={.2, .3, .4, 1.0}
swap c1,c2
print c2.b
*/

/*
'include     <RTL64.inc>
'print version

'2017-08-29 T 11:48:49
'generics
imacro memberOf(v,i,k, a,b,m)
int a,b
string s
m=v##_members
k=" "+str(i)+" "
a=instr(m,k)
if a then
  b=a+len(k)
  a=instr(b,m," ")
  k=mid(m,b,a-b)
else
  k=""
end if
end macro
  
def vv_members " 1 .a  2 .b  3 .c "
class vv
  float a,b,c
end class

string s,t
int i
for i=1 to 10
  memberOf vv,i,s
  if s then t+=s+chr(13,10) else exit for
next
print t
*/


/*
'2017-08-29 T 09:33:56
'generics
include <generics>
'
macro f(a)  a*=10
'
redimArray float v[100]
v={1,2,3,4,5}
applyToArray v,f,4
redimArray float v[8]
listArray v, print
*/

 
/*
'2017-08-28 T 14:05:09
'LET TESTS
'#show let a,b,c,d=1
'#show let a,b,c,d=1.0
'#show let a,b,c,d=1.0/2
'#show let a,b,c,d=pi()
'print typeof(a) "  " a " " d
type color float r,g,b,a
let p,q = color {.5,.5,.5,1}
'dim color p = {.5,.5,.5,1}
'#recordof q
'#show print q.g
va = float {1,2,3,4.5}
print va[4]
*/


/*
'2017-08-28 T 13:51:00
'TEST LOW LEVEL FUNCTION
int a,b=42
copy @a,@b,4
print a
*/

/*
'2017-08-26 T 09:50:46
'DEF, UNRESOLVED PARAMS
'%3 42
'print 3
def m
#if ndef %1
  print "missing term 1"
#else
  print "%1"
#endif
end def
int a=42
m 
m 43
*/


/*
'2017-08-25 T 21:03:40
'DEFAULT INCLUDEPATH
include <minwin.inc>
*/


/*
'2017-08-25 T 16:28:26
'NULL
int a=null
'print null
'print a
b=null
#recordof b
print b
*/

/*
'2017-08-23 T 15:18:45
'APPLY FUNCTION TO ARRAY
function add1(int *v)
v+=1
end function

macro madd1(v)
v+=1
end macro

def stride
@%1+=sizeof %1
end def

macro applyToArray(v,f,  w,n)
int n = countof v
typeof v *w = @v
while n--
  f w 'w as array member address
  stride w
wend
end macro

macro ListArray(v,f,   c,n,w,s,b,os,ls,lb)
int c
int n=countof v
typeof v *w = @v
string s,b
int os,ls,lb
while n--
  c++
  s = c  chr(9)  w  chr(13,10) : ls=len(s)
  if os+ls>lb then
    b+=nuls(0x1000) : lb=len(b)
  end if
  mid(b,os+1,s) : os+=ls 
  stride w
wend
f left b,os
b="" : s=""
end macro

float v={10.5,20,30,40,50}
applyToArray v, madd1
ListArray    v, print
*/


/*
'2017-08-25 T 07:16:00
'infer type from literal
macro m(a,b,c,d)
typeof a d
d=a+b+c
#recordof d
end macro
#recordof m
#show m 1,2,3
*/

/*
'2017-08-24 T 14:22:37
'BINDING VARIABLES
int p
bind p {
double a[10],b[10],c,d
}

'#recordof a
'#recordof b
'#recordof c
i=3
function f()
#show double v=b[i]
end function
print "ok"
*/


/*
'2017-08-23 T 13:16:20
'FIX INDIRECT VARIABLES WITH COMPOUND OPERANDS
type tt sys q,r,s
tt *p
#show sys v at p.s
'#recordof p
'#recordof v
int f(){
#show int w=@v
#show int w=v
#show int w=*v
}
*/


/*
const float c =1/3
#recordof c
d=c
print d
*/

/*
sys a[16]
'#recordof a
const float a=1/3+1/5
#recordof a
*/

/*
'2017-08-23 T 10:04:00
'CHAT 'AT' COUPLING
int a at @ecx
#recordof a
int f(int a,b,c){
#recordof param
}
*/


/*
'2017-08-21 T 20:06:51
'STATIC METHOD USING STATIC VARIABLE
class cc
static int i
method m() {++i : print i}
end class

cc.m
*/

/*
'2017-08-21 T 18:27:21
'STATIC MEMBERS EXCLUDED FROM TABLE
'BUT TRANSFERRED TO METHODS BLOCK
class cc
static int i
int j
int m1(){i++:print i}
int m2(){i++:print i}
end class
'
class dd
cc c1
cc c2
end class
#recordof dd
dd c
c.c1.m1
c.c2.m2
*/

/*
'2017-08-21 T 13:10:10
'PRECALC MACRO
%  a 1/3
%= b 1/3
#recordof a
#recordof b
*/

/*
'2017-08-21 T 12:35:21
'%%N RESTRICTED ESCAPE RULES
%a 33
def m
 %%a 32
 print "%%1"
 'print %1
end def

'm "ok"
m
print a
*/

/*
'2017-08-21 T 12:07:46
'GENERIC OOP
'requires extern classes

def interface
  sys constructor()
  sys destructor()
  sys act()
  sys state()
end def

def virtualise
  sys %1Buffer={%2}
  extern virtual
  class %1
    has interface
  end class
  end extern
  %1 %1Object at @%1Buffer
  sys %1Count=spanof %1Buffer
end def

def iterate
scope
  indexbase 1
  int i
  for i=1 to %1Count
    %1Object.%2
  next
end scope
end def
'
'Virtualise controls {@c1,@c2,@c3}
'iterate controls act
*/

/*
'2017-08-20 T 10:51:40
'INNER CALLBACK TEST
class cc {
sys v
function act() as sys
  function x() as sys callback
  print "callback ok"
  end function
print v
return @x
end function
}

#recordof cc
cc c
sys p=c.act
call p
*/

/*
'2017-08-20 T 06:59:44
'WITHOUT USING EXTERN VIRTUAL OBJECTS / COMMON INTERFACE
class cc {
sys v
sys act(){print v}
}
cc c : c.v=55
sys v={@cc.act,@c}
indexbase 0
int n=0
i=n*2 : j=i+1
call v[i] v[j]
*/

/*
;2017-08-19 T 04:20:09
'DEMO DIRECT CALL
extern
class aa
int m1(){m2}
int m2(){}
end class

class bb
has aa
int m3(){
#show m1
}
end class
end extern
*/

/*
2017-08-18 T 13:18:53
function f(int*a=null)
print @a
end function
f
*/

/*
2017-08-18 T 13:18:09
function sumTo(int *a,b,c)
a=b+c
end function

int a
SumTo(a)=1,2
print a
*/

/*
'2017-08-16 T 17:43:35
'TABLE OBJECTS / CELL OBJECTS
'need hash storage
'supporting associative arrays and sparse arrays

type tableCell
sys table_ref
int OffsX
int OffsY
int typ 'sys,double,string,cellObject,tableObject
int siz
sys ref
sys tags 
end type

extern virtual
class cellObject
method constructor()
method destructor()
method act()
method getState() as sys
method setState(sys p)
end class
end extern 

class tableObject
int x
int y
tableCell*c
method SetCell(sys p){...}
method  GetCell() as sys {...}
method copyCell() as sys {...}
end class

#recordof tableObject
*/

/*
'2017-08-12 T 09:39:53
'QUOTE
skip (
/*
s=quote //
'a
//
print s
*/


/*
class cc
int i=3
void constructor(int n) {i+=n}
end class

int k=10
#show new cc c(k) : '(k)
print c.i
del c
*/


/*
'2017-08-10 T 08:56:42
type pix
byte r=128,g=128,b=128,a=255
=
int c=2
end type

type pix byte r=128,g=128,b=128,a=255, = int c '=1

#recordof pix
#recordof pix_init
string s=nuls 256
pix p[32] at strptr s
for i=1 to 32
  with p[i].
    pix_init
  end with
next
'#recordof p
print p[32].a
*/

/*
'2017-08-09 T 22:35:00
type pix byte r,g,b,a = int c
#recordof pix
*/

/*
'2017-08-09 T 16:23:49
type tt
int a,b,c
float f,g
string s[4]={"a","b","c","d"}
end type
#recordof tt
#show tt t[100]
print t[50].s[2]
*/

/*
'2017-08-08 T 13:27:02
'INHERITABLE INITIAL VALUES
class cc
float f=1.5,g=2.5
int c=(serial++)
int m(int a=4,b=8)
end class

class dd
cc
cc ca
end class


int serial=1
'#recordof cc
'#recordof dd
dd d[5]
float s=d[4].c
print s
*/

/*
function arshift( int d, c) 
   mov   eax, d     'dest
   mov   cl, c     'count
   sar   eax, cl   'SAR shift arithmetic right 
end function

int b=arshift( 16,2)
print b
*/


/*
'2017-08-07 T 12:06:07

int a=-16
mov cl,2
sar a,cl 'SAR shift arithmetic right
print a

int a=-16
int b= not(not(a)>>2)
print b

int a=-16
int b 
b= ( a>=0 ? a>>2 : not(not(a)>>2) )
print b
*/


/*
'LET CONVERT
'2017-07-08 T 21:32:37
#show s=convert string (1234 + .5)
print s " : " typeof s
*/

/*
'2017-07-05 T 18:45:18
'DISASSOCIATION OF OBJECT AND CLASS
class ca
int v
method n(){print "N" : v--}
method m(){print "M" : v++}
end class

ca c
'#show addr rcx,c : ca.m
def ApplyTo addr rcx,%1
#show ApplyTo c : ca.m
print c.v
*/


/*
'2017-07-05 T 17:11:39
'ACCESS TO BASE STATICS VIA DIRECT CLASS ACCESS
class cb
static int a,b,c
end class

class ca
has cb b1
method n(){inc cb.b}
method m(){inc cb.b}
end class
cb.b=2
#show ca.m
ca c
#show c.m
print cb.b
*/


/*
'2017-07-07 T 11:59:37
'CALLING VIRTUAL METHOD
extern
class cu
method m1(int w){print "M1:" w}
method m2(int w){print "M2:" w}
end class
end extern

extern virtual
class cv
method m1(int w)
method m2(int w)
end class
end extern

new cu u
cv*v=@u

class ca
static cv*cv1
method m(int w){
@cv1=@v
cv1.m2 w
}
end class

function f()
ca a
a.m 3
a.cv1.m2 5
end function
f
del v
'#recordof ca
print "ok"
*/


/*
'2017-07-03 T 11:46:04
'KEYWORD CASES
'THIS WILL WORK FOR 3 OR 4 CHAR KEYWORDS
string func="SQR"
float res=2, result
int*p=strptr func
   select P
       case "SIN" : result=sin(res)
       case "SQR" : result=sqr(res)
   end select

   print result
*/

/*
'2017-07-03 T 07:42:28
'CASE FILTERING
string func
float res,result
   select asc func
       case "S"
         if func="SIN" then
           result =sin(res)
         elseif func="SQR" then
           result =sqr(res)
         end if
         ...
       case "T"
       case ....
   end select
*/

/*
'2017-06-30 T 07:29:27
'MEMBERS.METHOD()

class ca
int v
method act(){members.act : print "act A"}
method constructor(){}
method destructor(){}
end class

class cb
int v
method act(){members.act : print "act B"}
method constructor(){}
method destructor(){}
end class

'FLAT MEMBERS
class cc
has ca ca1,ca2
has cb cb1,cb2
method act(){members.act}
method constructor(){members.constructor}
method destructor(){members.destructor}
end class

new cc c
c.act
del c

'POINTERED MEMBERS
class cd
has ca *ca1,*ca2
has cb *cb1,*cb2
method act(){
  ca1.act
  ca2.act
  cb1.act
  cb2.act
}
method constructor(){
  new ca a : @ca1=@a
  new ca a : @ca2=@a
  new cb a : @cb1=@a
  new cb a : @cb2=@a
}
method destructor(){
  del ca1
  del ca2
  del cb1
  del cb2
}
end class

'new cd c
'c.act
'del c
'print 123

'#recordof cc
'#recordof cd
*/



/*
'2017-06-28 T 04:27:51
class cc
int a
end class
cc c
del c 'trigger error?
#show let d=c
*/


/*
'2017-06-27 T 05:41:44
#if 0
print 0
#else
print 1
#endif
*/

/*
'2017-06-27 T 05:41:56
extern

class ca
method act(){print "act A"}
method constructor(){}
method destructor(){}
end class

class cb
method act(){print "act B"}
method constructor(){}
method destructor(){}
end class

def flat
  %1 %2
  #ifdef %1.___
  ? %2 = @%1_table
  #endif
end def

flat ca a1
flat ca a2
flat cb b1

extern virtual
class interface {int act() }
end extern

typedef interface * pinterface

pinterface ic[100]
i=2
@ic={@a1,@b1,@a2}
ic[i].act
*/


/*
'2017-06-26 T 08:23:31
'MEMBERS
class ca
int a
int act(){}
end class

class cb
int a
method act(){}
end class

class cm
has ca ca1,ca2
has cb cb1,cb2
int act(){
#show members.act
}
end class
print "ok"  
*/

/*
'2017-06-28 T 04:33:46
'ARRAY OF VIRTUAL OBJECTS
'
extern

'typical interface
'method act(){print "act"}
'...

class ca
method act(){print "act A"}
method constructor(){}
method destructor(){}
end class

class cb
method act(){print "act B"}
method constructor(){}
method destructor(){}
end class

extern virtual

class interface
  method act()
end class

end extern


new ca a1
new cb b1

typedef interface * pinterface
indexbase 1
pinterface vc[100]
@vc={@a1,@b1}

vc[1].act
vc[2].act
...
del a1
del b1
*/


/*
'2017-06-22 T 09:23:02
'array with cons in asm
indexbase 0
int a[100]
'print spanof a
mov a,3
%= i 16+16
#show mov a[32],5
#show mov a[i],5
*/


/*
'2017-06-22 T 09:02:13
'#byval
'#byref
#byval
int f(v as sys){}
#recordof f
*/

/*
'2017-06-21 T 16:14:14
dim as integer ptr p1
dim as integer ptr p2
dim a as integer
a=99
@p1=@a
(
   mov eax,@p1
	mov @p2,eax
)
print p2
*/

/*
'2017-06-21 T 15:18:03
dim as int ptr a
#recordof a
dim as int byref a
#recordof a
*/

/*
'2017-06-21 T 11:32:46
#cpointer on
int*p
int*q
'#show p=q
'#show mov eax,p
#show p++
#cpointer off
*/

/*
'2017-06-21 T 10:33:14
int*p
#show addr p
#show addr @p
*/

/*
'2017-06-21 T 10:33:27
'include "minwin.inc"
extern lib "kernel32.dll"
! Sleep
end extern

push 100
call Sleep
#recordof sleep
*/


/*
'https://en.wikipedia.org/wiki/BMP_file_format
typedef dword rgbquad
typedef struct tagBITMAPINFOHEADER {
  DWORD biSize;          'bytes in structure=40
  LONG  biWidth;         'width in pixels
  LONG  biHeight;        'height in pixels
  WORD  biPlanes;        'planes=1
  WORD  biBitCount;      'bit count per pixel = 24 / 32
  DWORD biCompression;   'compressiond and jpeg/png flags
  DWORD biSizeImage;     'bytes in image 0 for rgb uncompressed
  LONG  biXPelsPerMeter; 'not in DIB
  LONG  biYPelsPerMeter; 'not in DIB
  DWORD biClrUsed;       'color in color table=0
  DWORD biClrImportant;  'all colors=0
} BITMAPINFOHEADER, *PBITMAPINFOHEADER;

typedef struct tagBITMAPINFO {
  BITMAPINFOHEADER bmiHeader;
  RGBQUAD          bmiColors[1];
} BITMAPINFO, *PBITMAPINFO;
extern lib "GDI32.dll"

'HBITMAP CreateDIBSection(
'  _In_        HDC        hdc,
'  _In_  const BITMAPINFO *pbmi,
'  _In_        UINT       iUsage,
'  _Out_       VOID       **ppvBits,
'  _In_        HANDLE     hSection,
'  _In_        DWORD      dwOffset
');

sys CreateDIBSection(sys hdc, BITMAPINFO *pbmi,
 dword usage, sys * ppvbits,
 sys hsection, int dwoffset )

sys GdiFlush()

end extern

'gdiflush 'ok

function f(sys **n)
static int v[1000]={4,5,6}
@n=@v 'return base address for coupling
end function

sys *b

f b
'f byval @@b
'print b '4
int i=3
b[i] *= 100
print b[i] '600
*/


/*
'2017-05-26 T 09:43:22
'SINGLE LINER CLASSES
'type t {float f,g,h }
'class t {float f,g,h }
'class cc { int a,b,c : int m(int v){return v*3} }
class cc { int a,b,c : int ma(int u){} : int mb(int v){ return v} }
'class cc { int a,b,c : int ma(){} : int mb(int v){ return v} }
'class cc { void constructor(){print 1} : void destructor(){print 2} }
'new cc c
'del c
#recordof cc
*/



'2017-06-02 T 18:46:57
'basic

/*
'2017-06-02 T 18:38:24
'basic
function foo(int v) as int
  foo=v*3
end function
print foo(14) '42
*/



/*
'2017-05-31 T 21:31:12
'revoke: exposed writestate #ifexist #ifnexist basic o2h asm #basic #asm Data Dataspace
'revoke: o2_get, o2_put and o2_assemble
*/


/*
#lookahead
ff
int ff(){print 11}
'function ff()
'print 123
'end function
'function gg()
'print 123
'end function
#recordof ff
*/


/*
'2017-05-30 T 21:39:09
include     "RTL64.inc"
print 1234
*/


/*
'2017-05-30 T 17:46:01
#compact
'include "minwin.inc"
'include "parseutil.inc"
'include "dirutil.inc"
'include "winutil.inc"
'include "sysutil.inc"
include "oxideutil.inc"
function f() as string
string s="99abc"
return left s,2
end function
'f
int c
print getfilelist ("*.*",c)
*/

/*
'2017-05-29 T 12:15:16
'POLYMORPHS AND DEFAULT PARAMS
'AVOID USING BOTH TOGETHER
int f(a=0,b=0,c=0) {print "=:  " a "," b}
int f(int a)   {print 1} 'NEVER ACCESSED
int f(int a,b) {print "2:  " a "," b}
'#recordof f
int i=1000
f
f i
f i,i
f a=10
f b=20
f 100,200
*/

/*
'2017-05-29 T 11:11:33
'CAPTURING DATA
function strinstr(string s, k, int *i, m=0 ) as string
int f=instr(i,s,k)
if not f then
  if m then
    f=i
    byte b at f-1+strptr s
    do
      select b
      case 0 to 32 : exit do
      case ",",";",":" : exit do
      end select
      @b++ : f++
    end do
  else
    f=1+len s
  end if
end if
function=mid(s,i,f-i) : i=f
end function

string s=" 01:02:03 04 "
int i=1
print ltrim strinstr(s,":",i) : i++
print ltrim strinstr(s,":",i) : i++
print ltrim strinstr(s,":",i,1) : i++
print ltrim strinstr(s,":",i,0) : i++
*/

/*
'2017-05-29 T 10:51:15
'DISPLAY PARSED DATA
include "parseutil.inc"
buffer pr
string s=version
int i=1
pr.in s cr cr
pr.in "Release: " tab getword(s,i) cr
pr.in "Date:    " tab getword(s,i) cr
stepword(s,i)
pr.in "Time:    " tab getword(s,i) cr
print pr.out
*/

/*
'2017-05-29 T 00:38:27
'ABSTRACTION:
'CLASS CREATOR
def CreateVectorClass
=====================
'
type %1 {%2 %3}
'
class %1Object
  indexbase 1
  %1 *v
  string v_buf
  int    max(int q)        { redim %1 v[q] }
  int    max()             { return len(v_buf)/sizeof v }
  int    set(int n, %2 %3) { v[n]= {%3} }
  int    set(int n, %2 *w) { copy @v[n],@w, sizeof v }
  int    get(int n, %2 *w) { copy @w,@v[n], sizeof v }
  int    get(int n, %1 *w) { w=v[n]}
  %2*    loc(int n)        { return @v[n] }
  int    clear()           { v_buf="" }
end class
'
end def
'
CreateVectorClass Vector2f float {x,y} 'NAME TYPE MEMBERS
#recordof Vector2f
#recordof Vector2fObject
*/

/*
'2017-05-26 T 15:36:17
'CLASS WITH CONTAINER 'ITR USING REDIM
def dynamic %1 *%2 : string %2_buf 'itr static members
type vector float x,y,z
'
class vectorobject
  indexbase 1
  'has dynamic vector v
  dynamic vector v
  '
  int    max(int q){ redim vector v[q] }
  int    max(){ return len(v_buf)/sizeof(vector) }
  int    set(int n, float x,y,z) { v[n]= {x,y,z} }
  int    set(int n, float *w) { copy @v[n],@w,sizeof v }
  int    get(int n, float *x,*y,*z) { vector w at @v[n] : x=w.x : y=w.y : z=w.z }
  int    get(int n, vector*w) { w=v[n]}
  float* loc(int n) { return @v[n] }
  void   clear() { v_buf="" }
end class
'
#recordof vectorobject
vectorobject v
float x,y,z
v.max 100
v.set 3, 10,20,30
'float x,y,z : v.get 3,x,y,z : print y
'float f at v.loc 3 : print f[2]
'vector p at v.loc 3 : print p.y
vector p : v.get 3,p : print p.y
*/


/*
'2017-05-26 T 16:24:24
'DATESTAMPER
% filename   "OxyDateTimeStamper.exe"
includepath  "$\inc\"
include      "RTL32.inc"
include      "TimeUtil.inc"
string s=getfile("oxygen.bas")
if len s then
  int    a=instr(s,"datetimestamp")
  if a then
    a=instr(a,s,chr(34))-1
    string d=chr(34)+TimeStr()+chr(34)
    b=instr(a,s,chr(13))
    s=left(s,a)+d+mid(s,b)
    putfile "oxygen.bas",s
  end if
end if
*/

/*
'2017-05-26 T 12:01:25
'EXTERN CLASS INHERITING INTERNAL CLASS METHODS
'require internal (sys) offset to 'This' before calling
type vector {float x,y,z}
class TBN { vector t,b,n : int m(){print n.z} }
extern
class TBNx {TBN}
end extern
'#recordof TBNx
TBNx v
v.n.z=5
#show v.m
*/

/*
'SINGLE LINER TYPES
type vector2f float x,y = float u,v = float i,a
type vector3f float x,y,z = float u,v,w = float r,g,b
'type vector4f vector , union uu { float s, float a }
type vector4f float x,y,z,w = float u,v,s,t = float r,g,b,a
type vector float x,y,z
type TBN vector t,b,n
'#recordof vector4f
#recordof TBN
*/

/*
'2017-05-26 T 10:59:41
'PARAMETER TYPE FLEXIBILITY
indexbase 0
type vector float x,y,z
'class vector float x,y,z 'MUST NOT BE EXTERN
sub pr(float*v){print v[2]}
sub prv(vector*v){print v.z}
'vector v={10,20,30} : pr v
'pr vector { {10,20,30} }
'prv  vector { {10,20,30} }
'prv  float { {10,20,30} } 'REJECTED
prv  cast(vector) float { {10,20,30} } 'OK
*/

/*
'2017-05-25 T 11:43:18
'PRIVATE FUNCTION
class cc
function f{}
int m(){}
end class
#recordof cc
*/

/*
'2017-05-25 T 03:53:26
'COLON SEPARATORS IN TYPES

type rgb byte r : byte g : byte b : = : int c
#recordof rgb

class bclass
float v
end class

class aclass
	int a : int b
   bclass c : bclass d
	method constructor() : print "C" : end method
	method destructor() : print "D" : end method
end class
new aclass o
del o
#recordof aclass
*/

/*
'2017-05-23 T 14:12:14
'DETECT DATASET {...}
def display print "%1"
def macparam "%1"
'
macro ma(cc,n)
'display (cc)
if instr(macparam(cc),"{") then
  display(cc)
else
  print "ok"
end if
end macro
'ma int {}, 6
ma int {1,2,3}, 6
'ma int (1,2,3), 6
*/

/*
'2017-05-23 T 09:14:46
'DOT QUOTE NOTATION
class cc
int "v"
method m     () {print "M"}
method "+/-" () {print `"+/-"`}
end class
'#recordof cc
cc c
'c.m
'c."+/-"
print c."v"
*/

/*
'2017-05-22 T 12:34:09
redim float f[0]
redim float f[100]
f[40]=2.5
redim float f[50]
'#show f[40]=f[40]+f[1]
#show f[40]+=f[1]
print f[40]
*/

/*
'2017-05-22 T 10:04:48
'
sys j=@AA
int i=1
#show jmp j[i]
AA:
print "ok"
*/

/*
'2017-05-22 T 10:00:40
'IIF NOTATION
float f=42
'#show int i=1+?f
#show int i=(f<4 ? 10 : 20 )
print i '20
*/

/*
'16:44 21/05/2017
'call primitive
extern lib "kernel32.dll"
! Sleep ( int ms)
end extern
push 1000
#show call @sleep 'sleep 1000
'#recordof sleep
print "ok"
*/

/*
'16:40 21/05/2017
'CONFINE ARRAY INDEX PRECEDENCE 
int q[40]
int i
#show q(i) = q(i) or q(i+1)
*/

/*
int SetPixel(int x,y,r,g,b){}
int newx,newy
int xy[2]
xy(1) = newx
xy(2) = newy 
SetPixel xy(1)*40+275,xy(2)*40+50, 0,210,55
*/

/*
int a:int b
'#recordof a
'#recordof b
function f(){print "F"}
' g:f
'f: f
'g: : f
 f : f
*/

/*
'2017-05-20 T 16:20:53
'DEL BUG
class aclass
	method constructor() : print "C" : end method
	method destructor() : print "D" : end method
end class
'#recordof aclass
new aclass aa
#recordof aa
del aa
*/

/*
'2017-05-19 T 16:53:10
'INDIRECT INFINITE RECURSION TEST
macro m()
a=1
n
end macro

macro n()
a=1
m
end macro
m
*/

/*
'2017-05-19 T 11:27:08
'default udt copy / using udt operators / recursion protection
macro cc_op(out,a,b,c)
  macro ."load"(out,a)
  end macro
  macro ."save"(out,a)
  'out=a 'RECURSION DETECTOR TEST
  'out.a=a.a
  'out.b=a.b
  'out.c=a.c
  'out.d=a.d
  copy @out, @a, sizeof cc
  end macro
end macro

class cc
int a,b,c,d
end class

cc c={1,2,3,4}
#show cc d=c
print d.b '2
*/


/*
'2017-05-19 T 11:14:16
'int mul3(sys v)=v*3
function mul3(sys v) as int = v*3
int mul3(sys v) {mul3 = v*3}
print mul3 4
's="abc" : mid(s,2)="B"
'print s
*/

/*
'2017-05-18 T 18:53:44
function mul3(v as float) as float 
mul3=v*3
end function

print mul3 14   '42
*/

/*
'2017-05-18 T 16:43:36
'NAMED RETURN
'class c
int f(sys a) {
  return 42
  #show f 3
  #show f=42
}
'end class
*/

/*
'2017-05-18 T 16:34:31
type rgb byte r,g,b
function f (any* a){
rgb c at @a
print c.b
}
!* p
@p=@f
sys i
rgb u,*c
u={10,20,30}
@c=@u
#show p c
'#recordof p
*/

/*
'2017-05-17 T 19:58:21
include "parseutil.inc"
include "console.inc"
string text = "
$color {
0x000000,0x800000,0x008000,0x808000,0x0000C4,0x800080,0x004080,0xC4C4C4,
0x808080,0xFF0000,0x00FF00,0xFFFF00,0x0000FF,0xFF00FF,0x00FFFF,0xFFFFFF,
0xA4A4A4,0xFFA080,0xA0FFA0,0xFFFFA0,0xA0A0FF,0xFFA0FF,0xA0FFFF,0xD4D4D4,
0xB4B4B4,0xFFDCBC,0xDCFFDC,0xFFFFDC,0xDCDCFF,0xFFDCFF,0xDCFFFF,0xE4E4E4
}
"

'string text = "$color [0x000000,0x800000,0x008000,0x808000,0x0000C4,0x800080,0x004080,0xC4C4C4]"

int color[32]
int n=8
string w=ExtractData (text,"$color ")
print "text w ="
'printl w

n=0
split(w,color,32, n)
printl n
printl "0X" hex color[32]
printl "Enter ..." : waitkey

*/

/*
'2017-05-17 T 19:33:31
'ASSIGN BY COPYING
type pixel byte r,g,b,a
pixel p,q
p={1,2,3,4}
q={10,20,30,40}
int i=1
p[i]=q[i]
print p.b
*/

/*
'2017-05-17 T 11:43:37
'aurel

TYPE FOR_STACK_TYPE
   vari AS LONG
   Target AS LONG
   Location AS LONG
End TYPE

Dim Ftos AS LONG
Dim Gtos AS LONG

Dim FStack[256] AS FOR_STACK_TYPE


Declare SUB fpush(i as FOR_STACK_TYPE)
Declare SUB fPop(i AS FOR_STACK_TYPE)





SUB fPush(i AS FOR_STACK_TYPE)
   If ftos > 256 THEN
       print "SB_TOO_MNY_FOR"
     Else
        copy @FStack[ftos], @i, sizeof(FOR_STACK_TYPE)
        ftos++
   End If
END SUB

SUB fPop(i AS FOR_STACK_TYPE)
   ftos = ftos - 1
   If ftos < 0 THEN
       print "SB_NEXT_WO_FOR"
     Else
       copy @i, @FStack[ftos], sizeof(FOR_STACK_TYPE)
   End If
END SUB
*/


/*
'2017-05-16 T 23:39:00
'reading in array of data from string
include parseutil.inc
int d[100],n
string s="
$datc {100,200,300}
$dat {10,20,
` 30`,40,50}
"

string w=ExtractData (s,"$dat ")
split(w,d,100,n)

print n "  " d[3] '5  30
*/



/*
'2017-05-15 T 06:36:41
'print version
scope int i
for i=1 to 10
next
print i
end scope
*/

/*
'2017-05-12 T 20:05:05
#show for i=1 to 10
next
print i
*/

/*
class tt { sys a,b,c,d }
tt t[9]
i=2
't[i].a=t[i].a+1
t[i].a+=1
print t[2].a
*/

/*
'2017-05-06 T 14:34:08
include MinWin.inc
RECT r
'GetWindowRect 0,r
'print r.right ", " r.bottom
GetSystemMetrics i
*/

/*
'TIMESTAMP BASED ON ISO 8601
'2017-05-04 T 21:22:44
include "sysutil.inc"
print timestr
*/

/*
'2017.05.04 21:06:59
'light year
double f=1e12
print 3600*24*365.25*2.99792e8/f " trillion metres"
*/

/*
'2017.05.04 21:06:12
include "sysutil.inc"
print timestr
*/


/*
'2017.05.04 12:37:16
include "sysutil.inc"
int c
print "FILES>" cr GetFileList("*.*",c,0) cr c
print "FOLDERS>" cr GetFileList("*.*",c,1) cr c
*/


/*
'00:51 22/04/2017
int a,b,c,d=4,e=5
#show d=(b=c? d : e)
print d
*/


/*
'18:01 17/04/2017

  type vector
  float x,y,z
  end type

  macro vector_op(a,b,c,d)
  macro ."load" (a,b)
  end macro
  '
  macro ."save" (a,b)
  a.x=b.x
  end macro
  '
  macro ."str" string(a,b)
  a=str(b.x)+", "+str(b.y)+", "+str(b.z)  
  end macro

  macro ."+" (a,b,c)
  a.x = c.x + c.x
  end macro

  macro ."=" bool (a,b,c)
  if b.x=c.x then a=1  
  end macro

  macro ."<" bool (a,b,c)
  if b.x<c.x then a=1  
  end macro

end macro

'#recordof vector_op


vector v={10,20,30}
vector va,vb,vc,vd
'print v.y
'print v.str()+"<>"+v.str()
'print str(v) + "--" + str(v)
'#show vector."load" v
'#show v1=v2
'#show va=vb+vc+vd
'#show vector_op."+" (v1,v2,v3)
'#show v1.x=v2.x+v3.x
int i=1,j=0
'#show if va[i]<vb[i] then 
'#show if va[i+j*20]=vb[i+j*20] then 
'#show if va[i]=vb[i] then 
'#show if va[1]=vb[1] then 
'#show if not va=vb then
'#show "s.txt" if (va<vb) and (vc=vd) or (va=vc) then
'#show "s.txt" if va<vb and vc=vd or va=vc then
'#show "s.txt" if va=vb and ((vc<vd) or (va=vc)) then
'#show "s.txt" if va=vb and not((vc<vd) or (va<vc)) then
'  mbox "ok 1"
'else
'  mbox "ok 0"
'end if
va.x=1
vb.x=2
vc.x=3
vd.x=4
#show "s.txt" va=(vb<vc ? vb : vd )
print va.x
*/

/*
'11:59 21/04/2017
'CND = RULE
's=space 100
'mid(s,2)="abc"
'print ">>" s
sys a={1,2,3,4,5}
print a[4]
*/

/*
'11:32 16/04/2017
'MEMBERS
class cc
int    v
float  f
string s
method init(int n=16){ this={10,2.5,"ok"} : print n }
end class
class dd
has cc c,e
'has cc e
method init(){members.init()}
end class
#recordof dd
dd d
d.init
print d.e.f " " d.e.s
*/


/*
'12:11 15/04/2017
function f(float *a,int n){print a[2] " " n}
'#show int a={10,20,30}
'#show float a={10,20,30}
'#show f int{10,20,30},countof()
#show f float{10.,20.,30.},countof()
'print a[4]
*/

/*
'16:34 13/04/2017
'09:21 10/04/2017
'MACRO OPERATIONS

type testmac float v

macro testmac_op(a,b,c,d)
  macro ."load"(a)
    'print "load " ""#a#"" 
  end macro
  macro ."save"(a,b)
    'print "save " ""#a#", " ""#b#""
    a.v=b.v
  end macro
  macro ."+"(a,b,c)
    'print "+ " ""#a#", " ""#b#", " ""#c#""
    a.v=b.v+c.v
  end macro
  macro ."*"(a,b,c)
    print "* " ""#a#", " ""#b#", " ""#c#""
    a.v=b.v*c.v
  end macro
  macro ."=" bool (a,b,c)
    'print "cond= " ""#a#", " ""#b#", " ""#c#""
    if b.v=c.v then a=1 else a=0
  end macro
  macro ."str" string (a,b)
    'print "str b = " str b.v
    a=str b.v
  end macro
  macro ."square" (a,b)
    a.v=b.v*b.v
    'print "square b = " str a.v
  end macro
end macro

testmac m1,m2,m3
'm1=m2+(m3*m4)

m1.v=0.5
'string s=" "+m1.str() 'DOT NOTATION
'print  s " ok"

'#show m2=m1.square()
'print m2.v
'm2=m1+m1.square()
'print m2.v
'testmac m1,m2
'sys a=-1
'#show if m1=m2 then
'  a=1
'else
'  a=255
'end if
'print a

'11:38 11/04/2017
testmac m1,m2,m3,m4
m3.v=.25
'#recordof testmac_op
m1=m2[1]+m3+m4
string s=m1.v
'#show s=str(m1)
'#show s=m1.str()
'mid (s,1)="!"
print s
*/

/*
'04:14 14/04/2017
'include "console.inc"
'include "parseutil.inc"
'color 1  'getnval wr,1
sub f(sys a,b){}
'def m f 1,
'#recordof m
'm 2
'call f 1,2
call f(1,2)
#recordof f
*/

/*
'00:31 14/04/2017
bstring s
frees ?s
'?s=0
*/




/*
'REFACTOR IDENTYPE
'08:11 13/04/2017
cpu f(a,b,c){return a+b+c}
print f 1,2,3
#SHOW STRING S=STR( 10)
PRINT S
mbox str 13
*/

/*
'05:36 13/04/2017
'REFACTOR IDENTYPE
declare Function ImageList_Create Lib "comctl32.dll" (byval cx as int,byval cy as int,byval flags as int,byval cInitial as int,byval cGrow as int) as sys
#recordof ImageList_Create
'hImageList = ImageList_Create(20, 20, ILC_MASK OR ILC_COLOR8, 1, 0)

declare function f(byval cx as int,byval cy as int)
#recordof f 
function f(byval cx as int,byval cy as int)
print "Q"
end function
*/

/*
'#show          function f cpu (a,b,c,d) 'params are passed in reisters: ecx,edx,esi,edi
'string s
'print "ok"
'#show          return a*b+c*d
'#show          end function

'#show a=f 1,2,3,4
'print a '14
'
'#show sub f(string s){}
'#show string f(){return}
'#show sub f  cpu (a) {print "" : return a}
'#show sub f  cpu (a) {string s : return a}
'#show sub f () { #noinit : sys a,b,c : static string s[40] : } 

'#show function f  fpu (a) { #noinit on : fmul st0 : sys bb }

'23:05 07/04/2017
'include     "RTL32.inc"
'include     "RTL64.inc"
'#show function f  fpu (a,b) { fmulp st1 }
'print f 3,4
'#show function f  cpu (a,b) { return a*b }
'print f 3,4

'23:01 07/04/2017
'double v
'#show fld qword v
'#show fstp qword v

'06:34 08/04/2017
'#show void cpu f(a,b){return a*b}
'#show void fpu f(a,b){fmulp st1}
'cpu g(a,b){return a*b}
'fpu f(a,b){fmulp st1}
'#recordof g

'10:49 08/04/2017
class cc
method g(sys a,b)
'method c cpu (a,b)
void cpu c(a,b)
method f fpu (a,b)
'void fpu f(sys a,b)
'
double x,y,z
end class

methods of cc
method g(sys a,b){}
'#show method c cpu (a,b){y=a*b}
#show void cpu c(a,b){y=a*b}
method f fpu (a,b){fmulp st1 : fstp qword y }
'void fpu f(sys a,b){fmulp st1}
end methods

#recordof cc
cc c
'#recordof c
'itr max 3 params edx esi edi, beware arrays(esi) and indirects(edi)
#show c.c 2,3
print c.y
*/


/*
'08:16 06/04/2017
'CPU/FPU OPTIMISED FUNCTIONS
fpu a,b
'#recordof a
'#recordof b


'#show function f cpu (a,b,c){return a+b+c}

#show function f fpu (a,b,c){fmulp st1 : faddp st1}
'#recordof f
float a=10,b=20,c=30
'#show a=f 1., 2., 3.
'#show a=f 1, 2, 3
#show a=f a,b,c+c
print a
*/

'#show function f (float a,b,c) as quad  { return a+b+c }
'#show quad a=f (1., 2., 3.)

'#show function f (float a,b,c) as fpu  { return a+b*c }
'#show a=f (1., 2., 3.)

'#show function f leaf (a,b,c) as sys  { return a+b+c }
'#show a=f 1,2,3

'#show function f pascal (a,b,c) as sys  { return a+b*c }
'#show a=f 1,2,3
'print a
'*/


/*
'05:49 06/04/2017
#show function f cpu (a,b,c) as cpu  { return a+b+c }
#show function f cpu (a,b,c)  { return a+b*c }
#show aa=f (1,2,3)
#recordof aa
*/

/*
'05:46 06/04/2017
function f() as fpu
return 40.25
end function

'#recordof a
double a=f
'print a
*/

/*
'15:33 05/04/2017
short long n
'#recordof n
long short n
'#recordof n
long long n
'#recordof n
wide float n
'#recordof n
short short n
'#recordof n
short short int n
'#recordof n
wide short n
'#recordof n
qword x=42
'#recordof x
'#show x=x*x
any a=42.6
'print a '43
'#recordof a
function f(any*a)
double d at @a : print d
end function
'f 42.5
function f(void*a)
double d at @a : print d
end function
'f 42.5
'sys a
bool a=66
'#recordof a
'print a
*/


/*
'15:01 05/04/2017
'WIDE STRINGS
          wchar w="world"
          wchar buf[1024]
          buf=w
          print buf
*/


/*
'14:54 05/04/2017
char w="world"
          char buf[1024]
buf=w
print "hello "+buf
*/

/*
'11:25 04/04/2017
#show [ebx+0x1000]=[ebx+0x1000]
*/

/*
'00:28 03/04/2017
'PROC RECORDS
include "minwin.inc"
'#recordof sleep
'#recordof freememory
'#recordof print
'sleep 1000
'print "ok m"
sys aa,bb
aa=@sleep
'print aa
extern
#show ! sleep lib "kernel32.dll" alias "Sleep" (int ms=100), link bb
! sleep  (int ms=200) extern, at aa
'!* sleep  (int ms=200) extern
end extern
'print "link bb " bb
PRINT [EBX+0X1084]
'@sleep=aa

function sleep(int ms,n) {print "ok s"}

#recordof sleep

sleep 1000
print "ok p"
sleep 1000,2000
print "link bb " bb
*/

/*
'05:10 02/04/2017
#preprocess start
includepath "$\inc\"
#unique on
include "minwin.inc"
#preprocess stop
*/

/*
'11:46 01/04/2017
'PREPROCESS SCOPED AND NAMESPACE
#preprocess 'scoped
'namespace nn
#define q 1
scope
#define q 2
print q
end scope
print q
'namespace
'print nn::q
type tt
  dword q
  q as dword
end type
#preprocess stop
#recordof tt
*/


/*
'06:46 01/04/2017
'ENUMERATION
enum ee {a=1,b,c,d}
ee aa
'#recordof aa
'print typeof aa
'print typeof ee
aa=c
'print aa 
bb=aa+8
'#recordof bb
'print bb '11
type tt
  ee e
  short i
end type
#recordof tt
*/

/*
'00:51 01/04/2017
'MACRES -18
%q 32
$q 33
def q 34
#define q 35
'enum ee {a,b,c,d,q,w}
'#recordof q
  def forever 0xffffffff
#recordof forever
print forever
*/

/*
'00:00 01/04/2017
'LABELS
#unique on
.foo
'.foo
'foo:
#recordof foo
*/

/*
'23:02 31/03/2017
'SIMD TYPE
'sys b
'itr alignment
simd a[20]
#recordof a
#show movups xmm0,a[2]
'movaps xmm0,a
print hex ebx
*/

/*
'12:33 31/03/2017
'REFACTOR AUTO STRING/NUMBER CONVERSIONS
'#RECORDOF STRING
'23:25 28/03/2017
'TEST TRGN AUTOCONVERT
'print 100*100 "ok"
'print "OK" 100*100
'print ( "xx" + str(100*200) + "ok" + str(200*400) )
'print 100+200+400 + "ok"
'print 100+200+400 "ok"
'print 100+200+400 "ok" 1 2 3 4
'print 100+200+400 +"ok"+ 1 2 3 4
'print ">>" +100+200+400 +"ok"+ 1 2 3 4
'print 4+str(1)+str(2)
'print "x"+str(4)
'print 1 2 3
'sys a=32+10
'string a=32+10
'string a=sin(1)
'string a=len("QQQ")
'string a= 32+1+len("qq")
'string a= 32+1+len("qq") "units"
'string a= ">>" 32+1+len("qq") " units"
'string a= ">>" + ucase("qq") " units"
'string a= ">>" 32+1 + ucase("qq") " units"
string a= ">>" 32+1+"" ucase("qq") " units"
'string a= str(32+1) " units"
'string a= ">>"  str(32+1) " units"
'string a= ">>" str(len("qq")) " units"
'string a= ">>" str(32+1+len("qq")) " units"
print a
*/

/*
'12:35 31/03/2017
'ASSIGN TYPE MACO ME,5 (intrinsic o2decl.bas)
sys v
'#recordof v
'#recordof ax
'#recordof rax
'#recordof st3
'#recordof xmm2
'#recordof typeof
'#recordof strptr
'#recordof or
'#recordof mid
'#recordof str
'#recordof sin
'#recordof ucase
'#recordof val
'string g() {}
'function g() as string {}
'string s=g
'#recordof g
*/

/*
'23:23 28/03/2017
'EXTENDED CONVERT
include "minwin.inc"
float f=2.5
#show sleep convert int ( f*1000 )
print f
*/

/*
'11:01 28/03/2017
print asc "¬"
*/

/*
'10:05 27/03/2017
a=0x55
b=not(a)
b=not a
print hex b
*/


/*
'TERNARY OPERATORS
'http://www.oxygenbasic.org/forum/index.php?topic=1440.msg15414;topicseen#msg15414
*/

/*
'11:17 26/03/2017
type cc float r,g,b,a
type mm cc amb,diff,tran,tran, float shi
#recordof mm
*/

/*
'17:09 25/03/2017
'CUSTOMISED QUOTE MARKS
print quote /\/\ '''"""```hello world! /\/\
print quote !!! quote /\/\ '''"""```hello world! /\/\ !!!
*/

/*
'16:52 25/03/2017
'VIEW MACRO
sys a=1, b=2
def view {print quote _/\_ %1 == _/\_ %1}
view a
view { a }
view { a+b }
view { a+b " units " }
*/

/*
'16:31 25/03/2017
'REDIM USAGE
redim double d(0)
sys f(sys n){ redim double d(n) : d(n)=7.5 }
f 100
def view {print " %1 == " %1}
view (d[100])
*/

/*
'12:34 25/03/2017
'MIN TYPEDEF
typedef struct _xx { int a,b,c,d } xx, *pxx, **ppxx
'#recordof _xx
'#recordof xx
'#recordof pxx
'SETTING UP POINTERS
xx v    : v={10,20,30,40}
pxx  p  : @p=@v
ppxx pp : @@pp=@@p
'pp={100,200,300,400}
print pp.c
*/

/*
'12:17 25/03/2017
'MIN TYPES
type color { float r,g,b,a }
type material { color ambient,diffuse,specular : float shininess }
#recordof material
*/

/*
'12:04 25/03/2017
'MIN CLASSES
class bb { int a : int m2(int i){return i*2} }
class cc { has bb : int ii : int m3(int i){return i*3} : int m4(int i){return i*4} }
dim cc c
#recordof cc
print c.m4 5 '20
*/

/*
12:04 25/03/2017
NAMES
oxpad
oxypad
minoxide
*/

/*
'20:21 23/03/2017
'MULTIASSIGN HIGHER TYPES
type vector float x,y,z
type material vector amb,diff,spec
'#recordof material
vector v1,v2,v3
material m[400]
'#show v1={1,2,3}
'#show m[1]={v1[1],v2,v3}
'#show "s.txt" m[1]={v1[1],v2,v3.x}
float w[100]
'#show w={v1[1],v2,v3}
'#show "s.txt" w={v1[1],v2,v3,2.5,3.5}
float f
vector v
'#show "s.txt" m={f,f,f,f,f,f,f,f,f}
'#show "s.txt" m={1,2,3,4,5,6,7,8,9}
'#show "s.txt" m={{1,2,3},{4,5,6},{7,8,9}}
'#show "s.txt" m={{v,v,v},{v,v,v},{v,v,v}}
'#show "s.txt" m={ m[2],m[3],m[4] }
'#show "s.txt" m={ {m[2]},{m[3]},{m[4]} }

extern

class vectorobject
has vector v
private float p
method m(){}
end class

class materialobject
has vectorobject amb,dif,spec
end class

'#recordof materialobject
materialobject m
'#show "s.txt" m={ v1,v2,v3 }
vectorobject o1,o2,o3
'#show "s.txt" m={ o1,o2,o3 }
'#show w={o1,o2,o3}
'#show w={m,m,m}
'#show m={f,v1}
'#show m={v1,f}
end extern
*/

/*
'16:05 23/03/2017
'LOCAL LATE BINDING WITH DECLARATION IN SHARED SPACE
!* Sleep(int ms)
sys k32
function f()
  k32=loadlibrary "kernel32.dll"
  bind k32,Sleep
end function
f
Sleep 2000
print "ok"
*/

/*
'09:10 23/03/2017
'UPDATED BIND
sys a=loadlibrary "kernel32.dll"
bind a (
 Sleep Sleep (int ms)
 GetProcAddress
)
print @sleep
sleep 100
*/

/*
'09:09 23/03/2017
'LATE BINDING
sys a=loadlibrary "kernel32.dll"
'! sleep (int ms) at getprocaddress a,"Sleep"
'!* sleep()
!* sleep : @sleep=getprocaddress a,"Sleep"
if @sleep then sleep 1000
print @sleep
#recordof sleep
*/

/*
'20:37 22/03/2017
'SHORT FORM INNER FUNCTIONS SHARING VARIABLES
int f(){
  int a=2,b=3
  'int g {return a+b}
  'void g {=a+b}
  'function g as int {return a+b}
  'function g as int = a+b
  'sub g {=a+b}
  'function  g as int = a+b
  return g
}
print f
*/

/*
'15:51 22/03/2017
'NAMESPACE AND SHORT FORM FUNCTIONS
namespace nn
'sys f(sys a) { return a * 10 }
sys f(sys a) = a _
* 10 
'function f(sys a) as int = a * 10 
sys f(a) = a*100
#show float f(a=0.0) = a*100
print f 2
namespace
print nn::f 3
*/

/*
'13:23 22/03/2017
'SHORT FORM FUNCTIONS INCL C STYLE
function f(sys a) as sys = _
 a*3
sys f(sys a)  = a _
*3
print f 3
*/

/*
'10:09 22/03/2017
'DOTTED MACRO TERMS
macro m(a,b,c)
a.x=b.x
a.y=b.y
a.z=b.z
a=b
end macro
#recordof m
*/

/*
sys a,b=1,c=2,d=3
a= _
b + _
c _ 
+ d

print a
*/

/*
'TWORD CHAR SKIPPING TESTS
'04:35 20/03/2017
print$$ "q" 1234%
_ 
print ( str$(123, _ 'REM
_
_
'
 1) )
'" world"
*/

/*
'16/03/2017
extern lib "oxygen.dll"
include "oxygenapi.inc"
print version 'o2_version
end extern
*/

/*
'10:18 19/03/2017
int f(int v=1) {return v*2}
'v= f f f 1 +f 1
'v=f()+f (v=8)
print f v=8
*/

/*
'09:31 19/03/2017
sys a,b,c
c=-1
#show a=b=c=42
print a
*/

/*
'PLAIN MACRO
'20:15 14/03/2017
macro m(a,b)
  a=b
  a=b
end macro

string s=" "
'#show sys aa[100] at strptr s
sys aa,bb,cc,dd,bb=2
'#recordof aa
#show m(aa,bb)
*/

/*
'08:40 14/03/2017
'DECOMPOSITION
'#show int f(int v) { return v*3 }
sys a,b

macro m int (a,v)
  a=v*3
end macro

'#show sys b = m(4)
#show"s.txt" sys b = (a>b? 42: 86)
*/


/*
'IRND TEST
'01:20 11/03/2017
include "chaos.inc"
include "ParseUtil.inc"
include "console.inc"

macro tabulateNumbers(e,s,n)
============================
  scope
    static int c,d
    static double v=e
    if c=0 then s.in d tab 'data counter
    c++ : d++
    s.in tab
    if v>=0 then s.in " "  'leading space
    s.in v
    if c=n then c=0 : s.in cr 'complete row
  end scope
end macro

buffer s
int min=-1000, max=1000, quant=100
s.in "random numbers, range: "  min " to " max cr cr
for i=1 to quant
  tabulateNumbers irnd(min,max), s, 10 'value,buffer,columns
next
print s.out
pause
*/

/*
'LTRIM
'21:00 10/03/2017
s=chr(9)+"     ok"
print ">>"+ltrim(s)
*/

/*
'VARIADIC MACRO WITH OWN TEMP VARIABLES
'16:54 10/03/2017
macro m( a, b, c, ...  :  d, e, f )
dim sys d=1,e=2,f=3
print a+b+c+(d*e*f)
end macro
m 1,2,3, 10, 20, 30
#recordof m
*/

/*
'MACRO OPTIONAL TERMS / POLYMORPHISM
macro m(a,b,c)
a=b
#ifdef c
 a+=c
 'print "defined"
#else
  'print "not defined"
#endif
end macro
sys v
m (v,1,)
print v
m (v,1,2)
print v
#recordof m
*/

/*
'DEL STRING AND DEL BSTRING FOR EXPLICITLY CLEARING STRING MEMORY ALLOCATIONS
'08:19 10/03/2017
'single b="hello"
class cc
  int constructor(){}
  int destructor(){}
end class
 cc b
'string b="hello"
'bstring b="hello"
zstring *b="hello"
#show del b
'#show delstring s
'#show delbstring b
'#if typecodeof(b)>0x100
'  #error Not a string
'#elseif typecodeof(b)>0xe0
'   print "string!"
'#elseif typecodeof(b)>0xc0
'  print "bstring!"
'#elseif typecodeof(b)>0xa0
'  print "zstring!"
'#else
'  #error Not a string
'#endif
'print c
*/

/*
'STATIC AS GLOBAL
'05:40 10/03/2017
'static sys a
global sys a
#recordof a
*/

/*
'MACROS RETURNING VARIABLES
'05:31 08/03/2017
'
macro foo string (a,b)
  a=b+b

end macro
'TEST
print foo("ok") + foo("ko")
*/

/*
'COMPOUND TYPES
type foo
  double d
end type
'
macro foo_op(a,b)
  macro ."bah" string (a,b)
  a="<<BAH>>" b.d  
  end macro
end macro

''TEST
foo f={1},g={2}
print bah(f)+bah(g)
*/


/*
'linked list
'20:00 06/03/2017
'storage
'11:38 07/03/2017
'
include "parseutil.inc"
'include "storageUtil.inc"

def UseStorageClasses {
=======================

type linkedunit
  sys last
  sys typ
  sys hash
  string nam
  union
    string  ss
    sys     ii
    float   ff
    double  dd
    quad    qq
  end union
end type

'#recordof linkedunit


class linkedlist
================
  '
  string bu
  linkedunit *u, *uu
  sys max
  sys pos
  def su  {sizeof(linkedunit)}
  '
  method last() as sys
    sys p=pos/su
    return p-1
  end method
  '
  method add(string n,s, sys *p) as sys
    if pos+su > max then 'buffering
      bu+=nuls 0x4000 : max+=0x4000
      @u=strptr bu
    end if
    @uu=@u+pos
    uu.last=p
    uu.typ=1
    uu.nam=n
    uu.ss=s
    p=pos/su
    pos+=su
    return -1
  end method
  '
  method find(string f, int*p) as sys
  if p<0 then return 0  
  do
    @uu=p*su+@u
    if f=uu.nam then return -1
    p=uu.last
    if p<0 then exit do 'otherwise check previous
  end do
  end method
  '
  method out(string n,*s, int*f) as sys
    if find n,f then s=uu.ss : return -1
    s=""
  end method
  '
  method in(string n,s, int *f) as sys
    if find n,f then uu.ss=s : uu.typ=1 : return -1
  end method
  '
end class


class ScopedStorage
===================
  '
  has linkedList li
  int sc[0x4000] 'supports 64 scope levels each 256 ints (1024 bytes) ascii-based entries
  int scopeoffset
  '
  macro locator(p) {int p at @sc+asc(n,1)*4+scopeoffset}
  '
  method init()
  int *p=@sc
  int i
  for i=1 to 0x4000
    p=-1
    @p+=4
  next
  end method
  '
  method add(string n,s) as sys
    locator p
    li.add n,s,p 'new link p is now set in the sc table
  end method
  '
  method find(string n, int *f) as sys
    locator p
    f=p
    return li.find n,f
  end method
  '
  method in(string n,*s) as sys
    locator p
    int sq=p
    return li.in n,s,q
  end method
  '
  method out(string n,*s) as sys
    locator p
    int q=p
    return li.out n,s,q
  end method
  '
  method newScope()
    int *p,*q
    @p=@sc+scopeoffset
    p=li.pos
    @q=@p+0x400
    copy @q,@p,0x400
    scopeoffset+=0x400
  end method
  '
  method endScope()
    if scopeoffset then scopeoffset-=0x400
    int p at @sc+scopeoffset
    li.pos=p
  end method
  '
end class

} 'UseStorageClasses

UseStorageClasses

scopedStorage st 
st.init
st.newscope
print st.scopeoffset
string s
int i
st.add "qq","qwerty"
i=st.out "qq",s
'print i cm s
i=st.in "qq","asdf"
i=st.out "qq",s
'print i cm s
st.add "qqe","zxcv"
i=st.out "qq",s
'print i cm s
i=st.out "qqe",s
print i cm s
st.endscope
i=st.out "qqe",s
print i cm s
*/



/*
'TEST BUFFER to print multiple items
'10:58 06/03/2017
include "parseutil.inc"
buffer pr
pr.in "hello" cr
pr.in "world" cr
int i
for i = 1 to 7
pr.in i tab chr(i+64) cr
next
print pr.out
*/

/*
'test pcharblocks
'22:59 05/03/2017
uses ParseUtil

macro CreateTextArray(s,argn,argc,argv)
=======================================
  'ARRAY OF READ-ONLY STRINGS
  'argn max number of args    
  sys     argc 'arg count
  pchar * argv
  scope
    indexbase 1
    string t=s  'buffer containing args
    sys    na=1           'new arg flag
    byte   b at strptr t  'source bytes
    sys    i=1,j,k
    sys    argp[argn] 'arg pointer table
    @@argv=@argp
    while argc<argn
      select b
      case 0 
        exit while
      case 1 to 32, 44
        na=1 : b=0 'nullify spaces and delimiters
      case symbolquote
        j=instr(i+1,s,chr(b))
        k=@b
        if j then b=0 : @b=k+j-i : b=0 : i=j : k+=1
        if na then argc++ : argp[argc]=k
      case else
        if na then argc++ : argp[argc]=@b : na=0
      end select
      @b++
      i++
    wend
  end scope
end macro
'
CreateTextArray "one, two ` three 3` ",10,argc,argv
print argc ":  " argv[3]
*/


/*
'test argc,argv
'20:57 05/03/2017
include "sysutil.inc"
CreateArgv
CreateMainCall

int main(int argc, char**argv) {
for i=1 to argc
  print argv[i]
next
}
*/

/*
'string splitting and legacy data reading
'07:48 05/03/2017
'
'% SymbolTerm     44,58,59
% SymbolQuote    34,96
% SymbolComment  39
'% SymbolEndLine  13,10,11,12
'% SymbolEndState 0
include "parseutil.inc"
'
string s=quote <>text<>
data 1,2,3,4,a,b
data c,d,e,"f",""
data `g`,`"h"`,"`i`",",","end",'comment
<>text<>
'
'print s
'
string d[1000]
'redim string d[1000]
'float d[1000]
dim int j=0
'split s,d,1000,j
read s,d,1000,j
'
string t
join d,j,"",cr,t
'join d,j,qu,qu+cm+" ",t
print t
*/

/*
'def block data test
'23:04 04/03/2017
def dataInput 'fun type data
scope
%2 _tmp={%3}
%1(_tmp,countof(tmp))
end scope
end def
'
function f(float*v, int c) as int
print v[3] " " c
end function
'
dataInput f float {1,2,3,4,5}
*/


/*
'redim objects

class cc
  sys v
  method m(sys v) as sys
  return v*2
  end method
end class

redim cc c [100]

c[7].v=5
'print c[7].v
print c[7].m( 4)

*/


/*
'check higher math with arrays
'11:56 04/03/2017
type vector {float x,y,z}
include mathvector.inc
vector a[10], b[10]
sys i=2
a[1]={1,2,3}
a[2]={4,5,6}
'print str(a) 'must use brackets with higher functions
'print str(a[i].y)
print str(a[i])
'print str(a(i))
*/


/*
'class factory 2 and let syntax
'09:02 04/03/2017
class cc
sys v
method m(sys n) as cc*
cc * c = getmemory sizeof cc
c.v=n
return @c
end method
end class


cc* f(sys n) {
cc * c = getmemory sizeof cc
c.v=n
return @c
}

macro d(c,n) {
cc*c : @c= (sys) cc.m(n)
c.m(n)
}

'cc*c=cc.m(42)
'let c=cc.m 42
'let c=f(21)
d(c,10)
print c.v
*/

/*
'check argc arv
sys main(int argc, char**argv)
{
  print argv[2]
}

typedef char*pchar
pchar args[10]
'char *args[10]
print spanof args
'?args={strptr("one"),strptr("two"),strptr("three")}
args[1]="one"
args[2]="two"
args[3]="three"
main 3,args
*/

/*
'class byref tests

class mind
  bstring memory
  method store(string s)
    memory+=s
  end method
  method constructor()
    memory=""
  end method
  method destructor()
    frees memory
  end method
  method show() as string
    return memory
  end method
end class

class person
  has mind
end class

new person p

p.store "Q "
p.store "W "
print p.show

del p
*/


/*
'core right redef
sys right
#recordof right
dim sys right
#recordof right
*/

/*
'right core macro
a=3
'macro right(s,i) {mid(s,-(i))}
print right ("hello "+"world", a)
*/

/*
'include "dynamic.inc"
'TESTING CORE REDIM
redim string s(100)
s(10)="hello"
print s(10)
redim string s(200)
print s(10)
redim string s(0)
redim string s(50)
print s(10)
*/

/*
s=getfile "td.dll"
print len s

a=loadlibrary "td.dll"
print a
freelibrary a
*/

/*
macro m(a)
((a>>16) and 0xffff)
end macro

function g(int a,b) extern
end function

function f(sys lparam) as sys
sys i,j
      #show MoveWindow(hiword(lParam), hiword(lParam), true)
end function

sys b,c
*/


/*
do
print 11
  exit do
loop
*/

/*
type vector float x,y
'#show float f={1,2,3,4}
#show vector v={1,2,3,4}
*/

/*
'crc32
    unsigned long   crc32_table[256]; // CRC-32 LUT
     
    unsigned long crc32(char* data, int dataLen) {
      if (0 == crc32_table[1]) init_crc32_table(); // init LUT once only
     
      // Be sure to use unsigned variables,
      // because negative values introduce high bits
      // where zero bits are required.
     
      unsigned long ulCRC = 0xffffffff;
      unsigned char* buffer = (unsigned char*)data;
     
      // Perform the algorithm on each byte in the
      // data stream using the lookup table values.
     
      while (dataLen--)
        ulCRC = (ulCRC >> 8) ^ crc32_table[(ulCRC & 0xff) ^ *buffer++];
     
      return ulCRC ^ 0xffffffff;
    }


    // Call this function only once to initialize the CRC table.
    void init_crc32_table(void) {
      // This is the official polynomial used by CRC-32
      // in PKZip, WinZip, Ethernet, and Win PE headers.
     
      unsigned long ulPolynomial = 0x04c11db7;
     
      register int i;
      for (i = 0; i <= 0xff; i++) {
        crc32_table[i] = reflect(i, 8) << 24;
     
        register int j;
        for (j = 0; j < 8; j++)
          crc32_table[i] = 
            (crc32_table[i] << 1) ^ (crc32_table[i] & (1 << 31) ? ulPolynomial : 0);
        crc32_table[i] = reflect(crc32_table[i], 32);
      }
    }

    
    // Reflection is a requirement for the official CRC-32 standard.
    // You can create CRCs without it, but they won't conform to the standard.
    unsigned long reflect(unsigned long ref, char ch) {
      unsigned long value = 0;
     
      register int i;
      for (i = 1; i < (ch + 1); i++) {
        if (ref & 1)
          value |= 1 << (ch - i);
        ref >>= 1;
      }
      return value;
    }
*/

/*

indexbase 0

  int reflect(int r,n)
  {
  xor edx,edx
  mov cl,n
  .ri
   dec cl
   jl fwd ni
   mov eax,r
   and eax,1
   jz fwd nd
    mov eax,1
    shl eax,cl
    or edx,eax
   .nd
   shr r,1
   jmp ri
  .ni
  mov eax,edx
  return
  }

  'print hex ( reflect (0x2,32), 8)

  'http://wiki.osdev.org/CRC32
  'https://www.lammertbies.nl/comm/info/crc-calculation.html

  int t[0x100]
  void init_crc32_table(int*t)
  {
  'int a,i,j
  'int i
  % Polynomial = 0x04c11db7
  'for i=0 to 255
  '  t=reflect(i,8)
    '
   addr esi,t
   xor edi,edi
   .ri
    cmp edi,255
    jg ni
    'push esi
    'reflect i,8
    'pop esi
    'inc i
    'shl eax,24
    'reflect8
    mov ecx,8
    xor eax,eax
    mov edx,edi
    .rf8
     shl dl,1
     rcr eax,1
     dec ecx
    jg rf8
    '
    mov ecx,8
    .rj
     dec ecx
     jl fwd nj
     shl eax,1
     jnc rj
     xor eax,Polynomial
     jmp rj
    .nj
    'push esi
    'reflect eax,32
    'pop esi
    '
    'reflect32
    mov ecx,32
    mov edx,eax
    xor eax,eax
    '
    .rf32
     shl edx,1
     rcr eax,1
     dec ecx
    jg rf32
    '
    mov [esi],eax
    add esi,4
    inc edi
    jmp ri
    .ni
    '
    't=t<<24
    'for j=0 to 7
    '  a=t and 0x80000000
    '  t=t<<1
    '  if a then t xor= Polynomial
    'next
  '  t = reflect(t, 32)
  '  @t+=4
  'next
  }

  init_crc32_table t

  'def v +", "+mid(hex(t[%1],8),-8)
  'print "crctable... " v 0 v 1 v 2 v 255

  int crc32(sys p,le)
  {
   mov ecx,le
   mov esi,p
   mov eax,0xffffffff
   addr edi,t
   .ri
    dec ecx
    jl fwd xi
    mov edx,eax
    xor dl,[esi]
    and edx,0xff
    shr eax,8
    xor eax,[edi+edx*4]
    inc esi
    jmp ri
   .xi
   not eax
   return
   '
   'byte b at p
   'int v
   'byte i
   'int crc=0xffffffff
   'while le
   '  le--
   '  i=crc xor b
   '  v=t[i]
   '  crc=(crc>>8) xor v
   '  @b++
   'end while
   'return not(crc)
  }

  'string s="A" 'crc32 should be: D3D99E8B
  'string s="a" 'crc32 should be: E8B7BE43
  string s="123456789" 'crc32 should be: CBF43926
  print hex crc32 strptr s, len s

  'mov eax,-1
  'xor edx,edx
  'shl eax,1
  'rcr edx,1
  'print hex edx


*/
 
  
  
     

/*
dim shared xx as sys
#recordof xx
*/

/*
a=2
do while a>0
print a
a--
'wend
loop
*/

/*
a=2
.aa
dec a
jz ex
loop aa
.ex
print a
*/

'o2scm.o2bas

/*
function f(...) as quad
double d at param
#show return d
end function

double d
#show quad q=f @d
*/

/*
function f(double d)
end function

double d
quad q
#show f q
*/

/*
'double d=-1 / 0 // 7
#show quad d=0x1000000000000000
mbox str d
mbox hex d
*/

/*
function f(char* s) as char*
print "in: " s
t="ok"
return t
end function

print f "Q"
*/


/*
  enum TOKS 
  {
    TOK_EOF    = -1,
    TOK_LPAREN =  0,
    TOK_RPAREN,
    TOK_DOT,
    TOK_ATOM,
    TOK_QUOTE,
    TOK_COMMENT,
    TOK_DQUOTE,
    TOK_BQUOTE,
    TOK_COMMA,
    TOK_ATMARK,
    TOK_SHARP
  }
print " " & tok_eof
print ">> " & TOK_EOF " " TOK_LPAREN " " TOK_RPAREN " " TOK_DOT  " " TOK_ATOM
*/

'
''c comment stripping
'd=5
'string s=str(d) /* to something */
'string s=str(d) // to something
's=str(d) // to something
'

/*
sys main(string *s)
{
 print s
}

bstring s[4]
s[1]="AA"
s[4]="DD"
'print s[4]
main s
*/



/*
typedef char*pchar
i=1
'sys main(sys argc,char**argv)
sys main(sys argc,pchar*argv)
{
  #recordof argv
  print argv[i] "  " argv[i+1]
}

char a="AA"
char b="BB"
'pchar s[2]
char*s[2]
s[1]=a
s[2]="CC"
print s[2]
main 1,s
*/

/*
enum v7_err {
  V7_OK,
  V7_SYNTAX_ERROR,
  V7_EXEC_EXCEPTION,
  V7_AST_TOO_LARGE,
  V7_INTERNAL_ERROR,
};

'WARN_UNUSED_RESULT
typedef quad uint64_t
typedef uint64_t v7_val_t
'v7_val_t v
'#recordof v
struct v7{}
'#recordof v7

% V7_ENABLE__Proxy
struct prop_iter_ctx {
#if V7_ENABLE__Proxy
  struct prop_iter_proxy_ctx *proxy_ctx;
#endif
  struct v7_property *cur_prop;

  unsigned init : 1;
  'int init : 1
};


struct v7* v7_create(void);
'sys v7_create(void)
struct v7_property;

'enum en  (*v7_cfunction_t)(struct v7* v7, v7_val_t *res);
'sys (v7_cfunction_t)(struct v7 *v7, v7_val_t *res);
'sys (v7_cfunction_t)(struct v7 *v7, v7_val_t *res);
enum v7_err(v7_cfunction_t)(struct v7 *v7, v7_val_t *res);
enum v7_err v7_init_prop_iter_ctx(struct v7 *v7, v7_val_t obj,
                                  struct prop_iter_ctx *ctx);
'typedef enum v7_err(v7_cfunction_t)(struct v7 *v7, v7_val_t *res);
'enum v{aa,bb,cc}
'typedef enum v{aa,bb,cc} aa
'typedef enum v7_err (v7_cfunction_t)();
'typedef enum v7_err (f)() x;
'typedef sys (f)(sys i);
'int (*v7_cfunction_t)( v7*v7, quad*res ) 
'#recordof v7_cfunction_t
'sys f(struct st*st,enum n n)
*/

/*
 include "minwin.inc"
  %% fontA     "Arial",FW_NORMAL,1 // FW_SEMIBOLD
  %% fontB     "Courier New",FW_NORMAL,1

  sub BuildFont (sys hWnd,hDC,hRC, base=1024, string name="Arial", int weight=FW_NORMAL, chset=DEFAULT_CHARSET)
  end sub

  sys a
  ''BuildFont 1,2,3,"X",400,1
  ''a=BuildFont 1,2,3,fontA
  BuildFont (1,2,3,fontA)
*/

/*
'QUAD ISSUES

'sys i
'#show quad a=i
'#show i=a

'extern
quad f(quad v){
#show return v
#show }
'#recordof f
'end extern

quad a=0xf000,d
d=f(a)
print hex d
*/

/*
'neo
'end neo

a=1
b=2
c=3
a=(b<c? 10/2 :20/2)
print a
*/

/*
union u
  string s
  double d
end union

#recordof u
*/


/*
'V7 header reading:

% V7_STACK_SIZE
'% V7_FREEZE
typedef int size_t


struct v7_create_opts {
  size_t object_arena_size;
  size_t function_arena_size;
  size_t property_arena_size;
#ifdef V7_STACK_SIZE
  void *c_stack_base;
#endif
#ifdef V7_FREEZE
  // if not NULL, dump JS heap after init 
  char *freeze_file;
#endif
};

#recordof v7_create_opts
*/

/*
enum v7_err {
  V7_OK,
  V7_SYNTAX_ERROR,
  V7_EXEC_EXCEPTION,
  V7_AST_TOO_LARGE,
  V7_INTERNAL_ERROR,
};
print V7_EXEC_EXCEPTION
*/

/*
'problem with then
'include "minwin.inc"
sys a,b
'a=val("2") 'then
'sleep 0+0 'then

function messagebox(sys n,string s,t,sys m)
print s
end function

MessageBox 0,"X","Blinding Error",0 ' then terminate app?
'd
*/


/*
'trouble with union..end union
'fix 16:22 25/10/2016
type SbData
  typ as dword
  siz as dword
  union 
    dbl as double
    lng as sys
    str as char*
    gen as sys
  end union
end type

#recordof sbdata
*/


/*
'#show sys p=@float{1,2,3,4}

function fsynthtexture(int h,any*p, int n)
end function
macro synthtexture(n,d)
  static sys n
  if not n then
    fsynthtexture(n,d,bytesof)
  end if
end macro

#show synthtexture imgn, word{1,2,3,4}
*/


/*
'iif
sys a,b=10,c=3,d=4,e=5,f=6,g=100
print b+(c>d ? e : f)+g
*/

/*
'higher type iif
type noodle string s

macro noodle_op(a,b,c,d)

  macro ."copy"(a,b)
    a.s=b.s
  end macro

  macro ."+"(a,b,c)
    a.s=b.s+c.s
  end macro

  macro ."str" string (a,b)
    a=b.s
  end macro

  macro ."left" string (a,b,c)
  a=left(b.s,c)
  end macro

end macro

sys a=1,b=2
noodle m,n,p
m={"abc"}
p={"xyz"}
'n=m+m '( a>b ? m : p )
n=((a>(a+0)) ? m+m : p )
'print str(n)
'print left(n,2)
print n.s
*/



/*
'high level iif
sys a,b=1,c=2,d=3,e=4,f=10,g=100
#show a= g+(b>c ? d : e) + f
print a
*/

/*
include     "console.inc"
include     "sysutil.inc"
CreateArgv
CreateMainCall


function main cdecl (int argc,cstring*argv) as int
================================================
  printl "Arguments " argc
  printl "List:"
  for i=1 to argc
    printl argv[i]
  next
end function

waitkey
*/




/*
'IIF
float f=1.5,g=2.5
sys a=1,b=2
float c
'#show c=f<g
'print hex c
'#show c=(f>g ? a+10 : b+10)
'print c

sys c
'#show = f>g ? c=a+10 : c=b+10

'char s[80]
string s

'#show = s="ok"
'print s

's = f>g ? "f>g" : "f<=g"
'print s
'#show s = (f>g ? "f>g" : "f<=g") + " ok"

's = "I know that "+ (f>g ? "f>g" : "f<=g") + " ok"
'print s


float f=1.5,g=2.5
string f=1.5,g=2.5
'#show print "I know that "+ (f>g ? "f<g" ) + " ,ok!"
'#show print "I know that "+ (f>g ? "f>g" : "f<=g") + " ,ok!"
'print ( (f>g ? "f>g" : "f<=g") ) '+ " ok" )
'print 100 + (f>g ? 10 : 20 ) + 1000

'string s
'= f>g  ? s="I know that f>g"  : s="I know that f<=g" : print s
'= f==g ? s="I know that f==g" : s="I know that f<>g" : print s
*/

'sys d=45
'#show print 4 or ?d

/*
'CHECK HIGHER TYPE CONDITIONALS

include "MathVector.inc"
include     "console.inc"

vector u,v={0,2,0},w={0,3,0}

'u=v
'u=v+w
'u=-(v+w)*v
u=v
print(u)
u+=v+vector{10,10,10}+w
print (u)


'print u.x "," u.y "," u.z
'print(u)
'print(v+w)
'print str(v)
'print str(v*w)
'print ">>"+str(v)
'print str ( v) + " << " + str(v*w)



'if v>w then
'  print "greater"
'elseif v<w then
'  print "less"
'elseif  v=w then
'  print "equal"
'elseif not v<>w then
'  print "equal"
'end if


'while v<w
'  print "while v<w"
'  exit while
'end while


waitkey



'namespaces
'
'namespace qq
'
'sys aa=-1,bb,cc
'
'lab:
'
'function f(sys n)
'print "qq::f" n
'end function
'
''#recordof f
'
'namespace
'
'function f(sys n)
'print "root::f" n
'end function
'
'qq::f(7)
'#show f 5
'print qq::aa
'#show print hex @qq::lab


'sys v=7
'sys n=2
'
''Testing attribute n in v
''if (v and n) ...
''Setting a attribute n in v
''v or=n

''clearing attribute n in v
'sys v=7
'sys n=2
'v and= not(n)
'print hex v



'int f(int a=200/3){return a}
'
'#recordof f
'print f




'const sys a=-&hff
'print a

'const string s="ok"
'print s



'const as long MAX_KEYWORDS = 13, MAX_SYMTAB = 100, MAX_CODE = 1000, MAX_STACK = 1000
'print MAX_SYMTAB

'dim as string s
'#recordof s

'typedef short short sh
'sh b
'#recordof sh
'#recordof b


'typedef long long
'#recordof long


'typedef long ulong
'typedef unsigned long ulong
'#recordof ulong
'ulong u=-1
''print u
'int 
'ulong
'#recordof ulong



'includepath "$\inc\"
'% filename  "t.exe"
'include     "RTL64.inc"
'quad s
'int i
'i=0xaa
'#show s=i
'print hex s


'mov cl,-1
'movsx ecx,cl
''print ecx
'mov eax,ecx
'cwd
'print edx


'wchar*p
'wchar wp="12345"
'@p=@wp
'print p
'print cast(wchar) p



'#case capital
'typedef unsigned long ULONG
''ULONG i=-2
'sys i=-2
''print ( (ULONG) i )
'print ( (unsigned long short) i )
'print i

'sub f(char*c,sys i)
'print c[i]
'end sub
'
'push 1
'push 2
'call f#char#sys
'
'f "abc",3


'includepath "$\inc\"
'% filename  "t.exe"
'include     "RTL64.inc"
''
'mov ecx,-1
'movsxd rdx,ecx
'mov rdx,ecx
'print hex(rdx)

'short s
's=-257
'int i
'i=s
'print s
'print i

'sys s
'movsx word eax,s
'movsx word eax,ax


'byte b=255
'int i
'mov eax,0x10000
'mov al,b
'movzx eax,al
'mov i,eax
'print i

'int i
'byte b=255
'#show i=b
'print i

'dword i
'sbyte b=-1
'#show i=b
'print i

'long long signed char c
'#recordof c

'signed short wide char c
'#recordof c

'unsigned short short short qword c
'#recordof c

'unsigned short a
'#recordof a

'signed char c
'c=-2
'print c
'unsigned char c
'c=-2
'print c


'signed byte
'sbyte b
'b=-1
'#show int c=b
'#show short c=b
'#recordof b
'#show print b
'#show int i=c
'print c

'signed word w
'w=-2
'#recordof w
'print w

'unsigned short int w
'w=-2
'#recordof w
'print w


'signed char as byte
'signed char   a
'unsigned char b
'#recordof a
'#recordof b
'a=-2 : print a
'b=257 : print b


'LEXI TESTS
'    or    ax,&hc00 ; code it for truncating
'or    ax,&hc00
'print  &     o111

'sys v=4
'function f() as sys {return 43}
'print str -f()

'waitkey


'ELEMENT SIZE / DIRECT/INDIRECT CHAR
class cc
sys a
union {
byte *b
char *c
}
char d[100]
sys e
method m()
  d="abcdefg"
  c="abcdefg"
  'print b[3]
  'print c
end method
end class
'#recordof cc

cc c[100]
c[2].m
i=2
j=1
print c[i].c[j]
j=2
'p=@c[i].d[j]
'print hex *p
*/

/*
'CALLING BASE METHODS
extern
class aa
sys a
method m()
print "aa"
end method
end class

class bb
sys a
method m()
a+=1
print "bb"
end method
end class

'#recordof bb

class cc
has bb 'from bb
method n()
m
print a
end method
end class
#recordof cc
'end extern

cc c
c.n
*/

/*
'MEMBERS FEATURE
class bb
sys a
method init(sys w)
sys v=3
print w
a=w*10
end method
end class

class cc
'bb b1,b2,b3
bb b3[3]

method init()
indexbase 0
i=4
members.init(123)
print i
print b3[0].a
end method

end class

'#recordof cc
cc c
c.init
*/


/*
'------

  $filename "Banking.exe"

'include "$/inc/RTL32.inc"
'include "$/inc/RTL64.inc"

% TryAttachConsole
include "$/inc/console.inc"

SetConsoleTitle "Bank Transactions"

class account

  static int count    'class variable

  'data encapsulation - information hiding
  protected ' or private 
  ' Attributes
  int account_num     'instance variables
  double balance

  public

  ' initialize
  method constructor(int number)
    count += 1
    account_num = number
    balance = 0.00
  end method
  
  method destructor()
  end method

  ' method for secure access
  method get_account_num() as int
    return account_num
  end method

  ' method for secure access
  method get_balance() as double
    return balance
  end method

  '
  method pay_in(double amount)
    balance += amount
    printl "Payed in: " str(amount) & " Euro"
  end method

  method pay_out(double amount)
    balance -= amount
    printl "Payed out: " str(amount) & " Euro"
  end method
    
  method statement_of_account()
    printl "Account Number: " & account_num & " Balance: " & str(balance,2) & " Euro"
  end method
  
  method same_account_num(account *a,*b) as int
    sys aa=a.get_account_num
    sys bb=b.get_account_num
    if aa=bb then return -1
  end method

  method transfer(double amount, account *account_A, *account_Z)
    account_A.statement_of_account()
    account_Z.statement_of_account()
    account_A.pay_out(amount)
    account_Z.pay_in(amount)
    printl "From Account Number: " & account_A.get_account_num()
    print " transferred " & amount & " Euro"
    print " to Account Number: " & account_Z.get_account_num() & cr
    account_A.statement_of_account()
    account_Z.statement_of_account()
  end method

end class

' --> Inheritance
class savings_account

  has account
  
  private
  double rate_percent' ' additional attribute

  public
  
  ' constructor of class savings_account
  method constructor(int number, double interest)
// Java:    super(number)' uses constructor of superclass account

    count += 1            'not equivalent
    account_num = number
'    balance = 0.00
 
    rate_percent = interest
  end method

  method destructor()
  end method

  ' new methods for accessing attribute rate_percent
  method get_rate_percent() as double
    return rate_percent'
  end method

  method set_rate_percent(double interest)
    rate_percent = interest'
  end method
  
  ' new method
  method pay_interest()
    double interest_payable = (rate_percent * balance)/100)
    printl "Interest payable: " & str(interest_payable,2)
    balance += interest_payable ' uses inherited attributes
  end method

end class



' Access class variable via class name
printl "Number of Accounts: " & account.count
new account my_account(1234567)   ' new instance of type account
printl "Account Number: " & my_account.get_account_num() ' read access
print " Balance: " & my_account.get_balance() & " Euro"
printl "Number of Accounts: " & account.count
new account your_account(2357666) ' new instance of type account
your_account.statement_of_account()
printl "Number of Accounts: " & account.count

' Assigning (coupling by reference)
account our_account at @your_account
'equiv: account *our_account : @our_account = @your_account
printl "Account Number: " & our_account.get_account_num() ' read access
print " Balance: " & our_account.get_balance() & " Euro"
our_account.statement_of_account()
printl "Number of Accounts: " & account.count
printl


if account.same_account_num(my_account, your_account) then
  printl "My account and your account are identical."
else 
  printl "My account and your account are different."
end if

if account.same_account_num(our_account, your_account) then
  printl "Our account and your account are identical."
else 
  printl "Our account and your account are different."
end if


my_account.pay_in(2000.00)
my_account.statement_of_account()
printl

your_account.pay_in(100.00)
your_account.statement_of_account()
printl

our_account.pay_in(200.00)
our_account.statement_of_account()
printl

'transfer some money
account.transfer(30.00, my_account, your_account)
printl

' Inheritance

new savings_account my_savings_account(4444990, 5.2)

'each instance of class savings_account has 3 attributes
printl "Account Number: " & my_savings_account.get_account_num() 'inherited attribute
print " Balance: " & my_savings_account.get_balance() &" Euro"'  'inherited attribute
printl "Rate Percent: " & str(my_savings_account.get_rate_percent(),2)' ' new declared attribute
printl "Number of Accounts: " & account.count

'method pay_in(amount), pay_out(amount) and statement_of_account() can be used
my_savings_account.pay_in(250.00)  'inherited methods
my_savings_account.statement_of_account()'
my_savings_account.pay_out(10.00)'
my_savings_account.statement_of_account()

'instances of class savings_account can use the method pay_interest()
my_savings_account.pay_interest()' ' new method
my_savings_account.statement_of_account()'

printl cr & "Hit Enter ... " : waitkey

del my_account
del your_account 'alias our_account
del my_savings_account

*/

'------

/*
'ACCESSING THE BASE CLASS BY SPECIFIED NAME
class bb
  private static sys counter

  method constructor()
  counter++
  end method

  method destructor()
  end method

  method CounterVal() as int
  return counter
  end method
end class

class cc
  has bb bbase 'give a name to the base class bb

  method constructor()
  bbase.constructor()
  end method

  method destructor()
  bbase.destructor()
  end method
end class

new cc c
print c.bbase.counterVal()
'print bb.counter
del c
*/


/*
'MEMBER CONSTRUCTORS
'extern

class caa
{
sys aa
method constructor(){print "Constructor caa"}
method destructor(){print "Destructor caa"}
}

class cbb
{
from caa
has caa pa,pb
method constructor()
{
 BaseConstructor()
 MemberConstructors()
 print "Constructor cbb"
}
method destructor()
{
 BaseDestructor()
 MemberDestructors()
 print "Destructor cbb"
}

}

'#recordof caa
#recordof cbb

new cbb c
del c
end extern
*/


/*
'roland / share accounts

$filename "Banking.exe"

'include "$/inc/RTL32.inc"
'include "$/inc/RTL64.inc"

% TryAttachConsole
include "$/inc/console.inc"

SetConsoleTitle "Bank Transactions"

class account

  static int count    'class variable

  'data encapsulation - information hiding
  private 'or protected  
  ' Attributes
  int account_num     'instance variables
  double balance

  public

  ' initialize
  method constructor(int number)
    count += 1
    account_num = number
    balance = 0.00
  end method
  
  method destructor()
  end method

  ' method for secure access
  method get_account_num() as int
    return account_num
  end method

  ' method for secure access
  method get_balance() as double
    return balance
  end method

  '
  method pay_in(double amount)
    balance += amount
    printl "Payed in: " str(amount) & " Euro"
  end method

  method pay_out(double amount)
    balance -= amount
    printl "Payed out: " str(amount) & " Euro"
  end method
    
  method statement_of_account()
    printl "Account Number: " & account_num & " Balance: " & str(balance) & " Euro"
  end method
  
  method same_account_num(account *a,*b) as int
    sys aa=a.get_account_num
    sys bb=b.get_account_num
    if aa=bb then return -1
  end method

  method transfer(double amount, account *account_A, *account_Z)
    account_A.statement_of_account()
    account_Z.statement_of_account()
    account_A.pay_out(amount)
    account_Z.pay_in(amount)
    printl "From Account Number: " & account_A.get_account_num()
    print " transferred " & amount & " Euro"
    print " to Account Number: " & account_Z.get_account_num() & cr
    account_A.statement_of_account()
    account_Z.statement_of_account()
  end method

end class


' Access class variable via class name
printl "Number of Accounts: " & account.count
new account my_account(1234567)   ' new instance of type account
printl "Account Number: " & my_account.get_account_num() ' read access
print " Balance: " & my_account.get_balance() & " Euro"
printl "Number of Accounts: " & account.count
new account your_account(2357666) ' new instance of type account
your_account.statement_of_account()
printl "Number of Accounts: " & account.count

' Assigning (coupling by reference)

account our_account at @your_account
'equiv: account *our_account : @our_account = @your_account
printl "Account Number: " & our_account.get_account_num() ' read access
print " Balance: " & our_account.get_balance() & " Euro"
our_account.statement_of_account()
printl "Number of Accounts: " & account.count

printl


if account.same_account_num(my_account,your_account) then
  printl "My account and your account are identical."
else 
  printl "My account and your account are different."
end if

if account.same_account_num(our_account,your_account) then
  printl "Our account and your account are identical."
else 
  printl "Our account and your account are different."
end if



my_account.pay_in(2000.00)
my_account.statement_of_account()
printl()

your_account.pay_in(100.00)
your_account.statement_of_account()
printl

our_account.pay_in(200.00)
our_account.statement_of_account()  'should be 300
printl

'do it

account.transfer(30.00, my_account, your_account)

printl cr & "Hit Enter ... " : waitkey

del my_account
del your_account 'alias our_account
*/


/*
'share parent locals
function f(sys a)
  sys b=100
  function g as sys
    sys c=1000
    return a+b+c
  end function
  return g
end function
print f 12
*/

/*
'Roland

$filename "Banking.exe"
 
'include "$/inc/RTL32.inc"
'include "$/inc/RTL64.inc"5. 
% TryAttachConsole

include "$/inc/console.inc"
 
SetConsoleTitle "Bank Transactions"
 
class account
'data encapsulation - information hiding
private 'or protected

' Attributes
int account_num
double balance

public

' methods for secure access

method get_account_num() as int
return account_num
end method

method set_account_num(int number)
account_num = number
end method

' methods for secure access
method get_balance() as double
return balance
end method

method set_balance(double amount)
balance = amount
end method

method pay_out(double amount)
balance -= amount
printl "Payed out: " str(amount) & " Euro"
end method

method cancel_account()
if balance>0
  pay_out balance
  printl "Account closed"
  balance=0
  account_num=0
elseif balance<0
  printl "Please pay: " str(-balance) & " Euro " & "before cancelling account"
else 'balance=0
  printl "Account closed"
  account_num=0
end if
end method


method pay_in(double amount)
balance += amount
printl "Payed in: " str(amount) & " Euro"
end method

method statement_of_account()
printl "Account Number: " & account_num & " Balance: " & str(balance) & " Euro"
end method
 
end class

account my_account ' new instance of type account


account my_account ' new instance of type account
'my_account.account_num = 1234567
'my_account.balance = 100.00
'printl "Account Number: " & my_account.account_num & " Balance: " & my_account.balance
my_account.set_account_num(1234567) 
' write access via method63.my_account.set_balance(100.00)
printl "Account Number: " & my_account.get_account_num() ' read access
print " Balance: " & my_account.get_balance() & " Euro"

my_account.pay_out(600.00)
my_account.statement_of_account()69.printl()

account your_account ' new instance of type account

'your_account.account_num = 2357666
'your_account.balance = 1000.00
your_account.set_account_num(2357666) ' write access via method
your_account.set_balance(1000.00)

your_account.statement_of_account()
your_account.pay_out(300.00)
your_account.pay_in(100.00)
your_account.statement_of_account()

your_account.cancel_account

printl cr & "Hit Enter ... " : waitkey
*/


/*
'Roland
$filename "Hello.exe"
'include "$/inc/RTL32.inc"
'include "$/inc/RTL64.inc"
% TryAttachConsole
include "$/inc/console.inc"
SetConsoleTitle "Say Hello and Goodbye"
' Object-oriented

class entity

  to_whom as string
  what_prop as string

  method greet() as string
  method = "Hello "
  if what_prop then method += what_prop & " "
  if to_whom then method += to_whom
  end method

  method say_goodbye() as string
  method = "Goodbye "
  if what_prop then method += what_prop & " "
  if to_whom then method += to_whom
  end method

end class

'TEST

entity we
printl we.greet()
printl we.say_goodbye()
we.to_whom = "World"
printl we.greet()
printl we.say_goodbye()

entity I
I.to_whom = "Susanne"
I.what_prop = "beautiful"
printl I.greet()

I.to_whom = "Kate"
I.what_prop = "cruel"
printl I.say_goodbye()

printl cr & "Hit Enter ... " : waitkey
*/

/*
'relative codebase
o2 b9 ga _code_
o2 b9 ga _main
print hex ecx
*/


/*
'codebase

.fgh
addr ecx,_code_
print hex ecx '.text equiv
print hex ebx '.bss
*/


/*
'fb syntax
type tt
declare function f(sys v) as sys
end type
'#recordof tt

function f(sys v) as sys,label
print v
return v*2
end function
tt t
@t.f=@f
f 3
*/

/*
'pseudo assign
'property set / property get
class cc
sys vv

method v(sys vl)
vv=vl
end method

method v() as sys
return vv
end method

end class

cc c
#show c.v=3
print c.v
*/


/*
'CHECK OSG ARRAYS
indexbase 0
sys a[100]
a[a[99]]=a[4]
*/

/*
function f(double*v, sys n) as sys
print "fp "v[3] "  count: " n
end function

function f(sys*v, sys n) as sys
print "int " v[3] "  count: " n
end function

'#show f  sys {2,4,6.5,8} , countof

'let a=double{10,20,30.5,40}
double a={10,20,30.5,40}
print a[3] "  " countof
*/


/*
sys a,b,c,d,e
a=b+((c*d))+e

function f(sys a,b,c)
end function

'a=f((b+1)*10,c*100, (d+3)*1000)
*/

/*
type vector float x,y,z

macro vector_op(a,b,c)
  '
  macro ."copy"(a,b)
  a.x=b.x
  a.y=b.y
  a.z=b.z
  end macro
  '
  macro ."+"(a,b,c)
  vector a
  a.x=b.x+c.x
  a.y=b.y+c.y
  a.z=b.z+c.z
  end macro
  '
  macro ."-"(a,b,c)
  vector a
  a.x=b.x-c.x
  a.y=b.y-c.y
  a.z=b.z-c.z
  end macro
  '
  macro ."mm"(a,b)
  vector a
  a={b.x*2,b.y*2,b.z*2}
  'a.m(b)
  end macro
  '
end macro

'class vector
'float x,y,z
'method m(vector *v) as vector*
'  this={v.x*2, v.y*2, v.z*2}
'  return @this
'end method
'end class
'
'class cc
'vector *v
'end class

'#recordof cc

type vector float x,y,z

vector u,v,w
'v={1,2,3}
'u=v+mm(v)
'print u.x "  " u.y "  " u.z

v={1,2,3}
w={10,100,1000}
u=mm(v)+(v+w)
print u.x "  " u.y "  " u.z

'vector a,b,c,d
'#show a=b+c '-d
*/


/*
%c=66
print chr(65,13,10,66)
*/


/*
'debug
float f (float v){return v*2}
float a=0
a=f 3.0 + .5
print a
*/

/*
'debug
function f()
print "ok"
end function: print f
'f
't=@f
'call t
*/

/*
#show let a={1.0,2,3,4,5}
*/


/*
dim as sys a,b,c,d,e
sys f(sys x,y,z){}
sys g(sys *d){}
'a=b+(c*d)
'a=((d*e))
'a=(b*c)+(d*e)
'a=b+(c+(d*e) )
'a=f(a+b,c+d,d+e)
'a=b+(c+(d*e))+(e+a)+f(a+b,c+d,d+e)
'a=f a+b,c+d,d+e
'a=f(a+b,c+d,d+e)+(c*d)
'a=b+f(a+b,c+d,d+e)+(c*d)
'a=f(a+b,c+d,d+e)
'a=g({1,2,3,4,5})
'a=g({1,b+(c*d),3,4,5})

'a=sin(b*c+4)
'a=sin((b*c)+4)+(c*d)
a=20+(sin(b*2)+10)+(c*d)
*/


/*
sys a(){}
sys a

#show a/=a
*/

/*
'POINTER ASSIGNMENT
zstring z="ok"
zstring *y
y=z
*/


/*
'MACRO ASSIGNMENT PROBLEM
def a ({10,20})
#recordof a
#show sys b[2]=a
*/

/*
sys a
'#show a=-(1-2*3) 'ok  5
'#show a=-1+2*3   'ok  5
'#show a=1-2*3    'ok -5
'#show a=-1-2*3   'ok -7
'#show a=-a-a     'ok  0
'#show --a        'ok -1
'#show ++a        'ok  1
print a
*/


/*
'negative case literal
a=-42
b=42
select a
case -42
print "ok"
end select
*/


/*
function f()
print "root"
end function

sys a

namespace qq

sys a

function f()
print "qq"
end function
'#recordof f
'#show f()

class cc
  method m()
  print "m"
  end method
end class

type vec float x,y,z

'#recordof cc

namespace


'f(0)
'#show call qq::f
'#show call qq::f()
'qq::f()
'qq::a=1
'print a "  " qq::a
'namespace qq : f()
namespace
'qq::f()


'dim as qq::cc c
'qq::cc c
'c.m

class ee
qq::cc 
end class

ee e
e.m
#recordof ee

'qq::vec v
'dim qq::vec v
'dim as qq::vec v
'float f
'#show f=v.x
'#show f=v.y
*/

/*
sys i=4
sys a=0
root::jj:
jj:
a++
namespace qq
jj:
a++
i--
if i>0 then goto jj
'if i>0 then goto qq::jj
'if i>0 then goto root::jj
namespace
print a
*/

/*
jmp fwd jj
namespace qq
#show goto qq::jj
jj:
print "ok"
namespace
jj:
print "done"
jj:
namespace ss
*/

/*
namespace qq
'#show goto nex
'#show goto qq::nex
'jmp fwd qq::nex
#show jnz nex
nex:
print "ok"
namespace
*/

/*
sys n
'print getFileList "*.*",n,0
print getFileList "*",n,1
*/


/*
sys i=1
namespace AA
sys i=2
namespace BB
sys i=3
namespace CC
sys i=4
print aa::i '2
print bb::i '3
print i     '4
namespace
print i     '1
namespace AA
print i     '2
*/


/*
const float a=4.5,b=4.6
const string s=" text"

print b s
*/

/*
'const   float a= 45.5/2
const   a as float = (-(45.5/2))
'#recordof a
'#define a -(45)/2
'%=       a = -(45/2)
#recordof a
'def     a -45
'macro   a -45
print a
*/

/*
function f()
print "ok" 4+8
end function
f
*/


/*
print version
*/

/*
'strptr param bug - fixed 09:00 14/04/2016
sys sptr(string s){ return strptr s }
*/


/*
'test safe call macro

function f(sys a,b) as sys
return a+b
end function

def safe
  pushad
     { %1 }
  popad
end def

safe {
 print f (1,2)
 }
*/


/*
'TEST FLOAT LOGIC
float a=2,b=4,c,d
d=a and b and c
print d
*/


/*
Type RECTF
   single x 
   single y 
   single w 
   single h 
End Type

'sys g
'sys h

'sys g()
'sys h()

'declare function g() as sys
'declare function h() as sys

! g() as sys
! h() as sys

'#lookahead

sys x,y
rectf r
#recordof h

function f(sys a,b,c,d)
print a " " b " " c " " d
end function


'f g,h,g,h

r={x,y,g,h}

print r.w "  " r.h

function g() as sys
return 10
end function

function h() as sys
return 20
end function
*/


/*
macro iifType(typ, ...)
  function iif(bool testVal, typ ifTrue, ifFalse) as typ
    if testVal then return ifTrue
    return ifFalse
  end function
end macro

iifType sys,float,double,string


'r="A"
's="B"
't="B"

s=4
t=5

r = iif ( (s<=t), "true","false" )
printl r
waitkey
*/

/*
function f(sys n,string * s[])
s="AA"
for i=1 to n
printl i "  " s[i]
next
end function

string t={"A","B","C"}
string*pt=@t
f 3,pt
waitkey
*/


/*
macro f(A,B,C)
if A then B else C
end macro

f( 1<>1, {
  printl "B"
},
{
printl "C"

} )
waitkey
*/

/*
macro aaa(f,...)
function f(...) as sys
return 1
end function
end macro

aaa f1,f2
#show f2 1,2,3,4
*/


/*
  CreateArgv
  typedef char * cstring
  cstring s at @argv

  'for i=1 to argc
  '  'printl arga[i]
  '  'printl s[i]
  'next
*/



/*
typedef struct t {
 union u { single f, double d } uu
 struct s { single f, double d } ss
 struct p *qq
} tt

#recordof t
*/

/*
float a=2,b=2,c,d
int i=2,j=3,k
'int d
'#show if not i+j {}
'#show if not (i+j) {}
'#show if not (i) {}
'#show if not a {}
'#show if not(a) {}
'#show if a {}
'#show if i + j {}
'#show if i or j {}
#show if a + b / c {}
'#show if a or b {}
'#show d=a and b
'#show d=b and (b xor b)
'#show d=not(a)
'#show d=3 and 4
'#show d=i or j
'#show d=4+(i or j)
'#show k=4+(a or b)
'#show d = (a>0)
'#show d = (a>0)and(b>0)
'#show if (a and b) then d=1 else d=0
printl d
printl k
waitkey
*/

/*
int x, y, j, k
float a,b

a = 0
b = -1

x = (a <> 0)    ' (1) expect 0  got 0
y = (b <> 0)    ' (2) expect -1 got -1
j = (x and y)   ' (3) expect 0  got 0
k = (a and b)   ' (4) expect 0  got 0

printl "x: " x " y: " y " j: " j " k: " k

a = 0
b = -1

x = (a and b)                                   ' (5) expect 0 got: 0
y = (a <> 0) and (b <> 0)                       ' (6) expect 0 got: 0
if (a and b) then j = -1 else j = 0             ' (7) expect 0 got: 0
if (a <> 0) and (b <> 0) then k = -1 else k = 0 ' (8) expect 0 got: 0

printl "x: " x " y: " y " j: " j " k: " k

'------------------------------------------
printl

float a, b, x, y, j, k, y1, y2

a = 0
b = -1

x = (a <> 0)    ' (1) expect 0  got 0
y = (b <> 0)    ' (2) expect -1 got -1
j = (x and y)   ' (3) expect 0  got 0
k = (a and b)   ' (4) expect 0  got 0

printl "x: " x " y: " y " j: " j " k: " k

a = 0
b = -1

x = (a and b)                                   ' (5) expect 0 got: 0
y1 = (a <> 0) : y2 = (b <> 0) 
y = (y1 and y2)                                 ' (6) expect 0 got: 0
if x then j = -1 else j = 0                     ' (7) expect 0 got: 0
if (a <> 0) and (b <> 0) then k = -1 else k = 0 ' (8) expect 0 got: 0

printl "x: " x " y: " y " j: " j " k: " k

waitkey
*/


/*
function showint(...)
indexbase 1
sys i
for i=1 to 8
  printl i "  " param(i)
next
printl ""
end function

showint edi,esi,ebp,esp,ebx,edx,ecx,eax


function show(...)
indexbase 1
sys i
for i=1 to 8
  printl i "  " param(i)
next
printl ""
end function

#show show edi,esi,ebp,esp,ebx,edx,ecx,eax


show 1,2,3,4,5,6,7,8
printl
eax=0 : push eax
ecx=1 : push ecx
edx=2 : push edx
ebx=3 : push ebx
      : push esp
      : push ebp
esi=6 : push esi
edi=7 : push edi
call _mem
call show
add esp,32

waitkey
*/

/*
s="hello"
printl hex(ebx)
int a=42
mov ebx,0
call _mem
printl hex(ebx)
addr ebx,bssdata
printl hex(ebx)
printl a
waitkey
*/



/*
scope

call transfer
call check
print hex eax
end

'----->

.bss
----

.storage1

o2 $1000 '4k static space

.data
-----

.data1
db 01 02 03 04

.code
-----

.transfer
call _mem
addr esi data1
addr edi storage1
mov eax,[esi]
mov [edi],eax
ret

.check
addr esi,storage1
mov eax,[esi]
ret

end scope


*/


/*
'http://www.jose.it-berater.org/smfforum/index.php?topic=5094.msg21598;topicseen#msg21598
function oo()
a=4
function ii
a=5
end function
ii
printl a
waitkey
end function
oo
*/

/*
class vec
float x,y,z
end class

class vv
  static vec  'float x,y,z
  method show
  print x
  end method
end class

vv.x=34
print vv.x 'property
vv.show    'method
waitkey
*/


/*
sub swap( byref a as sys, byref b as sys )
    iEcx = a
    iEax = b
    a = iEax
    b = iEcx
end sub

v1=10
v2=20

swap v1, v2
print  v1 & " " & v2  'correct


sub swop( byref a as sys, byref b as sys )
    'sys c=a
    'a=b
    'b=a
    addr esi,a
    addr edi,b
    mov  ecx,[esi]
    mov  edx,[edi]
    mov  [esi],edx
    mov  [edi],ecx
    'mov   
    'mov Ecx, a
    'mov Eax, b
    'mov a, Eax
    'mov b, Ecx
end sub


v1=10
v2=20

printl
swop v1, v2
print  v1 & " " & v2  'odd

waitkey
*/

/*
typedef word uint16

'type n int x,y,z

'typedef struct _nn
'{
'int x,y,z
'} nn

typedef struct nn{}

typedef struct SDL_Rect
{
Uint16 x
Uint16 y
Uint16 w
Uint16 h
struct nn *n;
Uint16 z

} SDL_Rect

#recordof nn
#recordof SDL_Rect
*/

/*
printl true
printl false
printl str true
printl str not(true)
*/

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms221069(v=vs.85).aspx

/*
FUNCTION Trim(string Main$="" ) As String
   String res$=""
   res$ = Rtrim(Main$)
     Return Ltrim(res$) ' this exit with garbage char "F"
End FUNCTION
string z="  abc def  "
'z=""
print ">" & mid(trim(z),5,2) & "<" 'result: >abc def<
print len z
'char z[]="  abc def  "
'z=""
'print len trim("  abc def  ")
'print ">" & trim(z) & "<" 'result: >abc def<
'print len z
*/


/*
%num 7
static bstring tbBmp = news num*sizeof(int)
#show frees tbBmp
#show freememory tbBmp
#show freememory @tbBmp
*/

/*
indexbase 0
sys i
sys be=256
byte b at getmemory be

for i=0 to be-1
...
next
print i
...
freememory @b
*/





/*
packed typedef struct _ty
{
 byte b
 int  i,j
} ty

#recordof _ty
*/


/*
function f(sys i, string s) label
printl s
printl i
end function

p=@f

string t="abcd"
call p len(t)\2, t
waitkey
*/






/*
typedef char *pchar
function f(pchar*v)
bstring s
sys i=1
s=v[i]
print s
end function
*/



/*
  macro CreateArgv
  ================
  sys    argv[64], argc
  string arga[64]
  string args="one two three four five" ' GetCommandLine
  scope
    indexbase 0
    sys i=1
    do
      arga[argc]=unquote getword args,i
      if ascb=0 then exit do
      argv[argc]=strptr arga[argc]
      argc++
    end do
  end scope
  end macro

  CreateArgv


  function main(sys argc,*argv)
  for i=1 to argc
    char c at argv[i]
    printl c
  next
  end function

 'main argc, argv
  main argc, byval @argv

  waitkey
*/
/*
library "kernel32.dll"
! GetCommandLine alias "GetCommandLineA"  () as char*
! GetEnvironmentStrings alias "GetEnvironmentStringsA" () as sys
! FreeEnvironmentStrings alias "FreeEnvironmentStringsA"  (sys p)
! GetEnvironmentVariable alias "GetEnvironmentVariableA" (char*var,*buf,sys n) as sys
library ""

indexbase 1
sys p=GetEnvironmentStrings()
sys k
string s=nuls 8000
byte b at  (p)
byte r  at  strptr s
byte rb at  strptr s
do
  select b
  case 0 : r=13 : @r++ : r=10 : @r++ : k++
           if b[2]=0 then exit do
  case 1 to 255 : r=b : @r++
  end select
  @b++
end do


printl left s,@r-@rb
printl "count:" tab k
printl "length:"tab @r-@rb
FreeEnvironmentStrings(p)

string v=nuls 256
GetEnvironmentVariable "ComSpec",v,len v
printl rtrim v

waitkey
*/