ftnlf

Check-in [44d39185ec]
Login

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

Overview
Comment:Allocate zero-length FA once and store it as upvalue.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:44d39185ecde207238990f6c8387cecac7f6fa4d
User & Date: vadim 2018-05-21 11:37:23
Context
2018-05-22
08:53
Fix error in diagnostics. check-in: f5dfc99988 user: vadim tags: trunk
2018-05-21
11:37
Allocate zero-length FA once and store it as upvalue. check-in: 44d39185ec user: vadim tags: trunk
11:09
Remove cross-calls to FX.Core API functions. check-in: c16754483f user: vadim tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ftnlf_fxcore.f90.

164
165
166
167
168
169
170



171
172
173

174
175
176
177
178
179
180
181





182
183
184
185




186
187
188
189
190
191
192
193
        
        ! Check args
        s = luaL_checkinteger(L, 1)
        if (s < 0) then
            r = luaL_argerror(L, 1, F_C_STR('negative length'))
        end if




        ! Allocate Lua userdata
        ud = lua_newuserdata(L, 8*s)
        

        ! Associate Fortran array with ptr
        call c_f_pointer(ud, arr, [s])
        
        ! Fill the array
        arr = 0.d0

        ! Disassociate
        arr => NULL()






        ! Set metatable
        rl = newmt(L, mt_FA)
        r = lua_setmetatable(L, -2)




        
        ! Return userdata
        r = 1
    end function l_fa_new

    ! Pack numeric arguments into existing or new Fortran array
    ! Usage: v = apack(arg1, arg2, ...., argn, arr, ix)
    ! n >= 0







>
>
>
|
|
|
>
|
|
|
|
|

|
|
>
>
>
>
>

|
|
|
>
>
>
>
|







164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
        
        ! Check args
        s = luaL_checkinteger(L, 1)
        if (s < 0) then
            r = luaL_argerror(L, 1, F_C_STR('negative length'))
        end if

        ! Create new UD if length is non-zero or 
        ! zero UD isn't created and stored yet
        if (s /= 0 .or. lua_isnil(L, lua_upvalueindex(1))) then
            ! Allocate Lua userdata
            ud = lua_newuserdata(L, 8*s)

            if (s /= 0) then
                ! Associate Fortran array with ptr
                call c_f_pointer(ud, arr, [s])

                ! Fill the array
                arr = 0.d0

                ! Disassociate
                arr => NULL()
            else
                ! Store upvalue
                call lua_pushvalue(L, -1)
                call lua_replace(L, lua_upvalueindex(1))
            end if

            ! Set metatable
            rl = newmt(L, mt_FA)
            r = lua_setmetatable(L, -2)
        else
            ! Take upvalue with zero userdata
            call lua_pushvalue(L, lua_upvalueindex(1))
        end if

        ! Return userdata
        r = 1
    end function l_fa_new

    ! Pack numeric arguments into existing or new Fortran array
    ! Usage: v = apack(arg1, arg2, ...., argn, arr, ix)
    ! n >= 0

Changes to testfx.lua.

74
75
76
77
78
79
80

81
82

83
84
85




end
print('Special test of packt/2')
A = FXC.apackt({},nil,6)
for k = 1, #A do
   print(A[k])
end


local X = FXC.apackt({})
print('#[]=',#X)


local X = FXC.apack(nil,nil)
print('#[]=',#X)











>


>

|
|
>
>
>
>
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
end
print('Special test of packt/2')
A = FXC.apackt({},nil,6)
for k = 1, #A do
   print(A[k])
end

print('Zero-length arrays test')
local X = FXC.apackt({})
print('#[]=',#X)
print(X,getmetatable(X))

local X1 = FXC.apack(nil,nil)
print('#[]=',#X1)
print(X1,getmetatable(X1))

local Z = FXC.array(0)
print(Z,getmetatable(Z))