view test/gdll.ijs @ 0:e0bbaa717f41 draft default tip

lol J
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500
parents
children
line wrap: on
line source

NB. DLL call ------------------------------------------------------------

load'dll'

3 : 0 ''
if. 0=4!:0<'libtsdll' do. 1[lib=: libtsdll return. end.
t=. >IF64{'32';'64'
s=. >(UNAME-:'Darwin'){'.so';'.dylib'
if. IFUNIX do.
 lib=: jpath '~home/dev/j/tsdll/libtsdll',t,s
else.
 if. IF64 do.
  lib=: '\dev\j\p_tsdll\release64\tsdll.dll'
 else.
  lib=: '\dev\j\p_tsdll\release\tsdll.dll'
 end.
end.
lib=: lib,' '
1
)

dcd=: 4 : '(lib,x) cd y'

NB. test integer types
a=: 4 u: +/401 402 403
b=: 4 u: 402 403
('&';(,'&');'a';'bc')=   'cbasic c *c c *c' dcd (,'a');'a';'bc'
(a;(,a);(4 u: 401);b)=   'wbasic w *w w *w' dcd (,4 u: 400);(4 u: 401);4 u: 402 403
(9;(,9);2;3 4)=          'sbasic s *s s *s' dcd (,2);2;3 4
(9;(,9);2;1 ic 3 4)=     'sbasic s *s s *s' dcd (,2);2;1 ic 3 4  NB. shorts in chars
(9;(,9);2;3 4)=          'ibasic i *i i *i' dcd (,2);2;3 4
(9;(,.9);2;,.3 4)=       'ibasic i *i i *i' dcd (,.2);2;,.3 4 NB. allow rank>1
(9;(,9);2;3 4)=          'xbasic x *x x *x' dcd (,2);2;3 4
(2;(,2);1;0 1)=          'ibasic i *i i *i' dcd (,1);1;0 1 NB. boolean promotion to int

NB. declaration (left argument) and parameter (right argument) checking
(0 0 -: cder '') *. (9;(,9);2;3 4) -: 'ibasic i *i i *i' dcd (,2);2;3 4  NB. base working example

'limit error'  -: (lib,'ibasic i *i i *i',2300$' '  ) cd etx (,2);2;3 4
'limit error'  -: ((2300$' '),lib,'ibasic i *i i *i') cd etx (,2);2;3 4

(1 0 -: cder '') *. 'domain error' -: ((1200$'x'),' proc i i i') cd etx 2;3
(1 0 -: cder '') *. 'domain error' -: ('xxxx proc i i i'       ) cd etx 2;3
(1 0 -: cder '') *. 'domain error' -: ('xxxx proc i i i'       ) cd etx 2;3

(2 0 -: cder '') *. 'domain error' -: (lib,(1200$'x'),' i i i' ) cd etx 2;3
(2 0 -: cder '') *. 'domain error' -: (lib,'xxxx i i i'        ) cd etx 2;3
(2 0 -: cder '') *. 'domain error' -: (lib,'xxxx i i i'        ) cd etx 2;3

(4 0 -: cder '') *. 'domain error' -: (lib,'ibasic ',400$'i '  ) cd etx 2;3
(4 0 -: cder '') *. 'domain error' -: 'ibasic i *i i *i' dcd etx (,2);2;3 4;'abcd'
(4 0 -: cder '') *. 'domain error' -: 'ibasic i *i i *i' dcd etx (,2);2

(5 0 -: cder '') *. 'domain error' -: 'ibasic I *i i *i' dcd etx (,2);2;3 4
(5 1 -: cder '') *. 'domain error' -: 'ibasic i *I i *i' dcd etx (,2);2;3 4
(5 2 -: cder '') *. 'domain error' -: 'ibasic i *i I *i' dcd etx (,2);2;3 4
(5 3 -: cder '') *. 'domain error' -: 'ibasic i *i i *I' dcd etx (,2);2;3 4

(6 0 -: cder '') *. 'domain error' -: 'ibasic i *i i *i' dcd etx ('abc');2  ;3 4
(6 1 -: cder '') *. 'domain error' -: 'ibasic i *i i *i' dcd etx (,2)   ;4.5;3 4
(6 2 -: cder '') *. 'domain error' -: 'ibasic i *i i *i' dcd etx (,2)   ;2  ;3j4 5

NB. 'rank error' -: 'ibasic i *i i *i' dcd etx ,:(,2);2;3 4
NB. 'rank error' -: 'ibasic i *i i *i' dcd etx ,.(,2);2;3 4

NB. mema memory
add=: mema 2*IF64{4 8
3 4 memw add,0,2,JINT
(9;(,9);2;<<add)=         'xbasic x *x x *x' dcd (,2);2;<<add
0=memf add

NB. l type is same as x on J64 and and error on J32
3 : 0''
if. IF64 do.
 assert. (9;(,9);2;3 4) =  'xbasic l *l l *l' dcd (,2);2;3 4
else.
 assert. 'domain error'-:  'xbasic l *l l *l' dcd etx (,2);2;3 4 
 assert. 5 0 -: cder ''  NB. error 5, result/arg declaration 0
end.
)

NB. pointer result
address=. 0{::'pc *c' dcd ''
'test'-:memr address,0,_1
address=. 0{::'pc *' dcd ''
'test'-:memr address,0,_1

NB. d and *d results and *d arg
(6.6;3;1.1 2.2 3.3;,6.6)= 'dipdpd d i *d *d' dcd 3;1.1 2.2 3.3;,1.1
(6.6;3;(,.1.1 2.2 3.3);,.6.6)= 'dipdpd d i *d *d' dcd 3;(,.1.1 2.2 3.3);,.1.1

NB. f and *f results and *f arg - convert in place
NB. 1.5 2.4 3.5 doubles convert exactly to floats
(7.5;3;1.5 2.5 3.5;,7.5)= 'fipfpf f i *f *f' dcd 3;1.5 2.5 3.5;,1.1
(7.5;3;(,.1.5 2.5 3.5);,.7.5)= 'fipfpf f i *f *f' dcd 3;(,.1.5 2.5 3.5);,.1.1
(7.5;3;(1 fc 1.5 2.5 3.5);,7.5)= 'fipfpf f i *f *f' dcd 3;(1 fc 1.5 2.5 3.5);,1.1 NB. shorts in chars
(7.5;3;(,.1 fc 1.5 2.5 3.5);,.7.5)= 'fipfpf f i *f *f' dcd 3;(,.(1 fc 1.5 2.5 3.5));,.1.1 NB. shorts in chars

NB. verify that double to float loses bits
6.6~:         0{::'fipfpf f i *f *f' dcd 3;1.1 2.2 3.3;,1.1

NB. alternate (__cdecl) calling convention
(24;23) -: 'altinci + i i'  dcd 23

NB. *j
(1.6;a)= 'complex d i *j' dcd a=.0;,1.6j2.7
(2.7;a)= 'complex d i *j' dcd a=.1;,1.6j2.7

NB. test f and d results and scalars
(<1.5)= 'f f' dcd ''
(<1.5)= 'd d' dcd ''
(3.3;1.1;2.2    )= 'ddd d d d' dcd 1.1;2.2
(6.6;1.1;2.2;3.3)= 'dddd d d d d' dcd 1.1;2.2;3.3
(4;1.5;2.5)= 'fff f f f' dcd 1.5;2.5
z=:'fd d f d f d *f *d' dcd 1.1;1.2;1.3;1.4;(6.6,6.6);7.7,7.7
(1.1;1.2;1.3;1.4;1.2 1.4)= 1 2 3 4 6{z
0.00001>5.0 1.1 1.3-;0 5{z

(+/>yy)=>{.'dx0 d x d'       dcd yy=:12;12.5
(+/>yy)=>{.'dx1 d d x'       dcd yy=:12.5;12
(+/>yy)=>{.'dx2 d x d x'     dcd yy=:12;12.5;13
(+/>yy)=>{.'dx3 d d x d'     dcd yy=:12.5;12;13.6
(+/>yy)=>{.'dx4 d x d x d'   dcd yy=:12;12.5;13;15.4
(+/>yy)=>{.'dx5 d d x d x'   dcd yy=:12.5;12;13.6;7
(+/>yy)=>{.'dx6 d x d x d x' dcd yy=:12;12.5;13;15.4;9
(+/>yy)=>{.'dx7 d d x d x d' dcd yy=:12.5;12;13.6;7;23.7

td=: 16$'d '
(  +/>yy)=>{.z=:('d1 d ',td) dcd yy=:<"0 [ 1.3*?8#10
(<.+/>yy)=>{.z=:('d2 x ',td) dcd yy=:<"0 [ 1.3*?8#10

td1a=: 18$'d '

3 : 0''
try.
 (+/>yy)=>{.z=:('d1a d ',td1a) dcd yy=:<"0 [ 1.3*?9#10
catch.
 *./IF64,IFUNIX,7 0-:cder''
end.
)

td3=: 32$'d x '
(+/>yy)=>{.z=:('d3 d ',td3) dcd yy=:16$12.3;4
td4=: 32$'d i '
(+/>yy)=>{.z=:('d4 d ',td4) dcd yy=:16$12.3;4

xx=:'d5 d d i d i d i d *d *f *x *i'
(+/;yy)=>{.z=: xx dcd yy=:1.1;2;3.3;4;5.5;6;7.7;2.2 3.3;3.3 4.4;23 24;46 47 

tf=: 16$'f '
(<.+/>yy)=<.>{.z=:('f1 f ',tf ) dcd yy=:<"0 [ 1.375*?8#10
(<.+/>yy)=  >{.z=:('f2 x ',tf ) dcd yy=:<"0 [ 1.375*?8#10
tf3=: 32$'f x '
(<.+/>yy)=<.>{.z=:('f3 f ',tf3) dcd yy=:16$12.3;4

NB. test scalar boolean and integer promotion to double
(0;0;0)='ddd d d d' dcd 0;0
(2;1;1)='ddd d d d' dcd 1;1
(5;2;3)='ddd d d d' dcd 2;3
8=3!:0 >'ddd d d d' dcd 2;3

NB. test scalar boolean and integer promotion to float (double then downconverted)
(0;0;0)='fff f f f' dcd 0;0
(2;1;1)='fff f f f' dcd 1;1
(5;2;3)='fff f f f' dcd 2;3
8=3!:0 >'fff f f f' dcd 2;3

NB. test boolean and integer lists promoted to double
'v0 v1 v2 v3 v4 v5'=.(2.2-2.2)+i.6 NB. this works
'v0 v1 v2 v3 v4 v5'=.i.6
(6;0;1;2;3;0 2 4;1 3 5)-:'fd d f d f d *f *d' dcd v0;v1;v2;v3;(3$v4);3$v5

NB. use of > parameter
24        -: 'altinci >+ i i' dcd 23
(>:x)     -: 'altinci >+ i i' dcd ,. x=: 17 ?@$ 1e6
(>:x)     -: 'altinci >+ i i' dcd ,. <"0 x

(+/"1 x)  -: 'ddd > d d d'    dcd x=: 17 2 ?@$ 0
(+/"1 x)  -: 'ddd > d d d'    dcd <"0 x
(+/"1 x)  -: 'ddd > d d d'    dcd x=: 17 2 ?@$ 2
(+/"1 x)  -: 'ddd > d d d'    dcd <"0 x
(+/"1 x)  -: 'ddd > d d d'    dcd x=: 17 2 ?@$ 100
(+/"1 x)  -: 'ddd > d d d'    dcd <"0 x
(+/"1 x)  -: 'ddd > d d d'    dcd x=: (-~0j5)+17 2 ?@$ 0
(+/"1 x)  -: 'ddd > d d d'    dcd <"0 x

(+/"1 x)  -: 'fff > f f f'    dcd x=: 1024 %~ 17 2 ?@$ 1e4
(+/"1 x)  -: 'fff > f f f'    dcd x=: 17 2 ?@$ 2
(+/"1 x)  -: 'fff > f f f'    dcd x=: 17 2 ?@$ 100
(+/"1 x)  -: 'fff > f f f'    dcd x=: (-~0j5)+1024 %~ 17 2 ?@$ 1e4

(+/"1 x) -: 'dx0 > d x d'       dcd x=: 7 2 ?@$ 9 0
(+/"1 x) -: 'dx1 > d d x'       dcd x=: 7 2 ?@$ 0 9
(+/"1 x) -: 'dx2 > d x d x'     dcd x=: 7 3 ?@$ 9 0 9
(+/"1 x) -: 'dx3 > d d x d'     dcd x=: 7 3 ?@$ 0 9 0
(+/"1 x) -: 'dx4 > d x d x d'   dcd x=: 7 4 ?@$ 9 0 9 0
(+/"1 x) -: 'dx5 > d d x d x'   dcd x=: 7 4 ?@$ 0 9 0 9
(+/"1 x) -: 'dx6 > d x d x d x' dcd x=: 7 5 ?@$ 9 0 9 0 9
(+/"1 x) -: 'dx7 > d d x d x d' dcd x=: 7 5 ?@$ 0 9 0 9 0


td=: 16$'d '
(+/"1 x)  -: ('d1 >d ',td) dcd x=: 17 8?@$ 0

(6 0 -: cder '') *. 'domain error' -: 'ddd > d d d' dcd etx 'ab'

NB. space usage

s0=: 7!:0 ''
s1=: 7!:0 ''
yy=: <"0 ] 8 ?.@$ 0
4!:55 ;:'yy'
xx=: lib,'f1 f ',16$'f '
9 = # xx 15!:0 <"0 ]8 ?@$ 0

s0=: 7!:0 ''
9 = # xx 15!:0 <"0 ]8 ?@$ 0
s1=: 7!:0 ''
s0 -: s1

s0=: 7!:0 ''
1 [ 100 (6!:2) 'xx 15!:0 <"0 ]8 ?@$ 0'
s1=: 7!:0 ''
s0 -: s1

s0=: 7!:0 ''
yy=: <"0 ] 8 ?.@$ 0
1 [ 100 (6!:2) 'xx 15!:0 yy'
yy -: <"0 ] 8 ?.@$ 0
4!:55 ;:'yy'
s1=: 7!:0 ''
s0 -: s1


f=: 3 : 0
 if. (9!:12 '') e. 6 do.  NB. do only under Windows
  'ole32.dll CoCreateGuid i *c' 15!:0 y
 else.
  0;16$' '
 end.
)

('';,16) = $&.> x=: f  <16$' '
('';,16) = $&.> x=: f ,<16$' '


NB. 0 procaddress
xbasic_add=: ":>{.'xbasic_add x' dcd ''
(9;(,9);2;3 4) = ('0 ',xbasic_add,' x *x x *x') cd (,2);2;3 4

(2 0 -: cder '') *. 'domain error' -: '0  1e4 x x' cd etx (,2);2;3 4
(2 0 -: cder '') *. 'domain error' -: '0 _1e4 x x' cd etx (,2);2;3 4
(2 0 -: cder '') *. 'domain error' -: '0 abc  x x' cd etx (,2);2;3 4
(2 0 -: cder '') *. 'domain error' -: '0 34aa x x' cd etx (,2);2;3 4

(2 0 -: cder '') *. 'domain error' -: ('0  ',(>IF64{'2333444555';19$'93'),' x x') cd etx (,2);2;3 4
(2 0 -: cder '') *. 'domain error' -: ('0 _',(>IF64{'2333444555';19$'93'),' x x') cd etx (,2);2;3 4

NB. 1 procindex - 0 is objxxx and 1 is objddd
obj_add=:    <>{.'obj_add x' dcd ''
5    = >{.'objxxx x * x x' dcd obj_add;2;3
5.75 = >{.'objddd d * d d' dcd obj_add;2.5;3.25 
5    = >{.'1 0 x * x x'     cd obj_add;2;3
5.75 = >{.'1 1 d * d d'     cd obj_add;2.5;3.25

5    = >{.'1 0 x x x x'     cd (>obj_add);2;3
5    = >{.'1 0 x x x x'     cd (>obj_add),2 3
5    = >{.'1 0 x x x x'     cd (>obj_add),2 3+-~0.5

5.75 = >{.'1 1 d x d d'     cd (>obj_add);2.5;3.25
5.75 = >{.'1 1 d x d d'     cd (>obj_add),2.5 3.25
55   = >{.'1 1 d x d d'     cd (>obj_add),22 33

(2 0 -: cder '') *. 'domain error' -: '1 _10000 x * x x'  cd etx obj_add;2;3
(2 0 -: cder '') *. 'domain error' -: '1 1e2    x * x x'  cd etx obj_add;2;3
(2 0 -: cder '') *. 'domain error' -: '1 abc    x * x x'  cd etx obj_add;2;3
(2 0 -: cder '') *. 'domain error' -: '1 34aa   x * x x'  cd etx obj_add;2;3

(2 0 -: cder '') *. 'domain error' -: ('1 ',(>IF64{'2333444555';19$'93'),' x * x x')  cd etx obj_add;2;3

(5 1 -: cder '') *. 'domain error' -: '1 0      x *d x x' cd etx obj_add;2;3
(5 1 -: cder '') *. 'domain error' -: '1 0      x *x x x' cd etx obj_add;2;3
(5 1 -: cder '') *. 'domain error' -: '1 0      x d  x x' cd etx obj_add;2;3
(5 1 -: cder '') *. 'domain error' -: '1 0      x'        cd etx obj_add;2;3

(6 0 -: cder '') *. 'domain error' -: '1 0      x x  x x' cd etx obj_add   ;2  ;3
(6 0 -: cder '') *. 'domain error' -: '1 0      x *  x x' cd etx (>obj_add);2  ;3
(6 0 -: cder '') *. 'domain error' -: '1 0      x *  x x' cd etx (>obj_add),2   3
(6 1 -: cder '') *. 'domain error' -: '1 0      x *  x x' cd etx obj_add   ;'2';3
(6 2 -: cder '') *. 'domain error' -: '1 0      x *  x x' cd etx obj_add   ;2  ;'3'


4!:55 ;:'a add address b dcd f lib obj_add pc s0 s1 td td1a td3 td4 tf tf3'
4!:55 ;:'v0 v1 v2 v3 v4 v5 x xbasic_add xx yy z'