Commits

Harald Klimach  committed 2378b03

Added the possibility to dump Lua functions into buffers

lua_dump requires a callback function, and is therefore a little more
complicated to use. With this implementation the data is written to a
character pointer, hiding the call back function under the hood.

  • Participants
  • Parent commits 8e70d49

Comments (0)

Files changed (5)

File LuaFortran/dump_lua_fif_module.f90

+!> This module provides a Fortran interface to the Lua dump routine.
+module dump_lua_fif_module
+  use, intrinsic :: iso_c_binding
+
+  implicit none
+
+  interface
+    function dump_lua_toBuf(L, length, ierr) &
+      &        bind(c, name='dump_lua_toBuf')
+      use, intrinsic :: iso_c_binding
+      type(c_ptr), value :: L
+      integer(kind=c_int) :: length
+      integer(kind=c_int) :: ierr
+      type(c_ptr) :: dump_lua_toBuf
+    end function dump_lua_toBuf
+  end interface
+
+end module dump_lua_fif_module

File LuaFortran/flu_binding.f90

 module flu_binding
   use, intrinsic :: iso_c_binding
   use lua_fif
+  use dump_lua_fif_module
 
   implicit none
 
   public :: flu_pushvalue
 
   public :: fluL_loadfile, fluL_newstate, fluL_openlibs, fluL_loadstring
+  public :: fluL_loadbuffer
   public :: flu_copyptr
   public :: flu_register
 
+  public :: flu_dump
+
   interface flu_pushnumber
     module procedure flu_pushreal
     module procedure flu_pushdouble
   end interface flu_pushnumber
 
+  interface flu_dump
+    module procedure flu_dump_toBuf
+  end interface flu_dump
+
+
   ! Interoperable interface required for a function that is callable from Lua.
   abstract interface
     function lua_Function(s) result(val) bind(c)
   end function fluL_loadfile
 
 
+  function fluL_loadbuffer(L, buffer, bufName) result(errcode)
+    type(flu_State) :: L
+    character :: buffer(:)
+    character(len=*), optional :: bufName
+    integer :: errcode
+
+    character(len=33) :: label
+    character(len=3) :: c_mode
+    integer(kind=c_int) :: c_errcode
+    integer(kind=c_size_t) :: nChars
+
+    if (present(bufName)) then
+      label = trim(bufName) // c_null_char
+    else
+      label = 'ScriptBuffer' // c_null_char
+    end if
+    nChars = int(size(buffer),kind=kind(nChars))
+    c_mode = "bt" // c_null_char
+    c_errcode = luaL_loadbufferx(L%state, buffer, nChars, label, c_mode)
+    errcode = c_errcode
+  end function fluL_loadbuffer
+
+
   function fluL_loadstring(L, string) result(errcode)
     type(flu_State) :: L
     character(len=*) :: string
   end function flu_isopen
 
 
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !!! Wrapper implementation for lua_dump !!!
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !> Dump to a buffer and return the pointer to the resulting string.
+  subroutine flu_dump_toBuf(L, buf, length, iError)
+    type(flu_State) :: L
+    character, pointer :: buf(:)
+    integer :: length
+    integer :: iError
+
+    type(c_ptr) :: string_c
+    integer(kind=c_int) :: length_c
+    integer(kind=c_int) :: iErr
+
+    nullify(buf)
+    string_c = dump_lua_toBuf(L%state, length_c, iErr)
+    iError = int(iErr)
+    if (iError == 0) then
+      length = int(length_c)
+      call c_f_pointer(string_c, buf, [length])
+    else
+      length = 0
+    end if
+  end subroutine flu_dump_toBuf
+
 end module flu_binding
-

File LuaFortran/lua_fif.f90

       integer(kind=c_int) :: luaL_loadfilex
     end function luaL_loadfilex
 
+    function luaL_loadbufferx(L, buff, sz, name, mode) bind(c, name="luaL_loadbufferx")
+      use, intrinsic :: iso_c_binding
+      type(c_ptr), value :: L
+      character(kind=c_char), dimension(*) :: buff
+      integer(kind=c_size_t), value :: sz
+      character(kind=c_char), dimension(*) :: name
+      character(kind=c_char), dimension(*) :: mode
+      integer(kind=c_int) :: luaL_loadbufferx
+    end function luaL_loadbufferx
+
     function luaL_loadstring(L, string) bind(c, name="luaL_loadstring")
       use, intrinsic :: iso_c_binding
       type(c_ptr), value :: L

File LuaFortran/wrap_lua_dump.c

+#include <stdlib.h>
+#include "lua.h"
+
+typedef struct
+{
+  int length;
+  int space;
+  char *container;
+} charbuf;
+
+// Writer to use during lua_dump.
+static int buf_writer(lua_State *L, const void* p, size_t sz, void* ud)
+{
+  charbuf *dat;
+  const char *buf;
+  int i;
+
+  dat = ud;
+  buf = p;
+
+  if ( sz + dat->length > dat->space ) {
+    // Increase the size of the buffer, if needed.
+    dat->container = realloc(dat->container, dat->space*2);
+    if (!dat->container) return -10;
+    dat->space = dat->space*2;
+  }
+
+  // Append the data to write into the buffer.
+  for (i=0; i<sz; i++) {
+    dat->container[dat->length + i] = buf[i];
+  }
+  dat->length = dat->length + sz;
+  return 0;
+}
+
+
+// Wrapper around lua_dump to write into a memory buffer.
+// Return Fortran friendly arguments.
+const char* dump_lua_toBuf(lua_State *L, int *length, int *ierr)
+{
+  charbuf dat;
+  char *buf;
+  int i;
+  int errcode;
+  size_t sz;
+
+  dat.length = 0;
+  dat.space = 1024;
+  dat.container = malloc(dat.space);
+
+  errcode = lua_dump(L, buf_writer, &dat);
+
+  (*ierr) = errcode;
+  (*length) = dat.length;
+  sz = dat.length;
+  buf = malloc(dat.length);
+  for (i=0; i<dat.length; i++) {
+    buf[i] = dat.container[i];
+  }
+  free(dat.container);
+  return buf;
+}
     lua_sources = ['external/lua-5.2.1/src/lua.c']
     luac_sources = ['external/lua-5.2.1/src/luac.c']
 
+    wrap_sources = ['LuaFortran/wrap_lua_dump.c']
+
     flu_sources = ['LuaFortran/lua_fif.f90',
+                   'LuaFortran/dump_lua_fif_module.f90',
                    'LuaFortran/lua_parameters.f90',
                    'LuaFortran/flu_binding.f90']
 
         target = 'lua')
 
     bld(
+        features = 'c',
+        source = wrap_sources,
+        use = 'lua',
+        includes = 'external/lua-5.2.1/src',
+        target = 'wrapobjs')
+
+    bld(
         features = 'fc',
         source = flu_sources,
         target = 'fluobjs')
 
     bld(
         features = 'fc fcstlib',
-        use = ['luaobjs', 'fluobjs'],
+        use = ['luaobjs', 'fluobjs', 'wrapobjs'],
         target = 'flu')
 
     bld(
         features = 'fc fcstlib',
         source = aotus_sources,
-        use = ['luaobjs', 'fluobjs'],
+        use = ['luaobjs', 'fluobjs', 'wrapobjs'],
         target = 'aotus')
 
     bld(