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
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 |