ftnlf

Check-in [e31927db4e]
Login
☰Home Timeline Branches Tags Tickets Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Loadable Fortran extensions.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | multi
Files: files | file ages | folders
SHA1:e31927db4ea733b4e7b475ab9a2c3474c8c10b1f
User & Date: vadim 2018-05-07 08:29:04
Context
2018-05-07
08:31
Merge "multi" version. check-in: 524d1fe4c9 user: vadim tags: trunk
08:29
Loadable Fortran extensions. Leaf check-in: e31927db4e user: vadim tags: multi
2018-05-06
21:10
Test modified array. check-in: 7098e49cb7 user: vadim tags: multi
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ftnlf.f90. 

12
13
14
15
16
17
18
19
20
21

22

23
24
25
26
27
28
29
30
31
32
33
34
35
36





37

38
39
40
41
42
43
44


    type(c_ptr) :: L_st

    type(luaFE_FunctionEntry), allocatable :: fx_loaders(:)

contains
    ! Initialization EP
    function ftnlf_init(fname) result(r)
        use, intrinsic :: iso_c_binding, only: c_associated, c_funloc, c_null_ptr
        use ftnlf_fxcore

        character(*), intent(in) :: fname

        logical :: r
        integer(4) :: res
    
        r = .false. ! Default
        ! Create Lua state
        L_st = luaL_newstate()

        if (.not. c_associated(L_st)) then
            write(0,103)
    103     format('Failed to initialize Lua.')
            return
        end if

        ! initialize loaders





        allocate(fx_loaders(1))

        ! Core
        fx_loaders(1)%name = 'FX.Core'
        fx_loaders(1)%f => ldr_fx_core

        ! The 1st stage of initialization
        res = lua_cpcall(L_st, c_funloc(linit1), c_null_ptr)
        r = lcheck(res)








|


>

>

|












>
>
>
>
>
|
>








12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52


    type(c_ptr) :: L_st

    type(luaFE_FunctionEntry), allocatable :: fx_loaders(:)

contains
    ! Initialization EP
    function ftnlf_init(fname, loadlist) result(r)
        use, intrinsic :: iso_c_binding, only: c_associated, c_funloc, c_null_ptr
        use ftnlf_fxcore
        use luaFE
        character(*), intent(in) :: fname
        type(luaFE_FunctionEntry), optional :: loadlist(:)
        logical :: r
        integer(4) :: res, nload
    
        r = .false. ! Default
        ! Create Lua state
        L_st = luaL_newstate()

        if (.not. c_associated(L_st)) then
            write(0,103)
    103     format('Failed to initialize Lua.')
            return
        end if

        ! initialize loaders
        if (present(loadlist)) then
            nload = size(loadlist)
            allocate(fx_loaders(1+nload))
            fx_loaders(2:1+nload) = loadlist
        else
            allocate(fx_loaders(1))
        end if
        ! Core
        fx_loaders(1)%name = 'FX.Core'
        fx_loaders(1)%f => ldr_fx_core

        ! The 1st stage of initialization
        res = lua_cpcall(L_st, c_funloc(linit1), c_null_ptr)
        r = lcheck(res)

Changes to test.f90. 












































1
2
3


4
5

6
7
8
9
10


11
12
13
14
15
16
17
18












































program test
    ! Mockup for ftnlf
    use ftnlf


    implicit none
    

    logical :: r
    real(8) :: fval
    real(8) :: fvals(10), arr_m(1), arr_o(10)
    
    ! Initialize


    r = ftnlf_init('testdb.lua')
    if (.not. r) stop 99

    ! Simplified iface
    r = luafun('', 'tbl1', 'val1', [1.d0,-3.5d0], fval)
    write (*,'(L2,1X,1PE11.4)') r, fval

    r = luafun('', 'tbl1', 'v2', [1.d0,-3.5d0], fval)

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



>
>


>





>
>
|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

module testmod
    ! Test module
    use LuaF
    use LuaFE
    use, intrinsic :: iso_c_binding, only: c_int, c_ptr
    implicit none
    private
    ! Public API: loader function
    public ldr_fx_test

contains
    ! FX.Test module loader
    function ldr_fx_test(L) bind(C) result(r)
        type(c_ptr), value, intent(in) :: L
        integer(c_int) :: r

        ! Pop package name
        call lua_pop(L, 1)

        call lua_newtable(L)
        call luaFE_register(L, 'testfun', l_test)

        r = 1
    end function ldr_fx_test

    function l_test(L) bind(C) result(r)
        type(c_ptr), value, intent(in) :: L
        integer(c_int) :: r

        real(8) :: v

        ! Check 1nd arg
        v = luaL_checknumber(L, 1)
        
        v = v + sqrt(2.d0)

        call lua_pushnumber(L, v)
        
        r = 1
    end function l_test

end module testmod

program test
    ! Mockup for ftnlf
    use ftnlf
    use luaFE, only: luaFE_FunctionEntry
    use testmod
    implicit none
    
    type(luaFE_FunctionEntry) :: ldr(1)
    logical :: r
    real(8) :: fval
    real(8) :: fvals(10), arr_m(1), arr_o(10)
    
    ! Initialize
    ldr(1)%name='FX.Test'
    ldr(1)%f => ldr_fx_test
    r = ftnlf_init('testdb.lua', ldr)
    if (.not. r) stop 99

    ! Simplified iface
    r = luafun('', 'tbl1', 'val1', [1.d0,-3.5d0], fval)
    write (*,'(L2,1X,1PE11.4)') r, fval

    r = luafun('', 'tbl1', 'v2', [1.d0,-3.5d0], fval)

Changes to testdb.lua. 

39
40
41
42
43
44
45
46



47

print(#B)
print(B[1], B[2], B[3])

print(FXC.aunpack(B))

local Z = FXC.array(9000)
print(FXC.aunpack(Z,5))




end









>
>
>


39
40
41
42
43
44
45
46
47
48
49
50

print(#B)
print(B[1], B[2], B[3])

print(FXC.aunpack(B))

local Z = FXC.array(9000)
print(FXC.aunpack(Z,5))

local T = require('FX.Test')
print(T.testfun(-1.4))

end

This page was generated in about 0.032s by Fossil 2.7 [9aa9ba8bd2] 2018-09-22 17:40:11