Kaloian- --- Kaloian Doganov <[EMAIL PROTECTED]> wrote:
> Is there a way to use fcntl's F_GETLK command from Guile? According > to the docs [1], only the following commands are available: > I put together something. I've attached the more important source files here for reference, but, the buildable files are in http://lonelycactus.com/getlk-0.0.tar.gz For me, it does "./configure && make && make install" on Linux, but fails on Cygwin. Cygwin fails because I don't know how to do DLLs. Here's what it does on my machine. Your mileage may vary. bash-3.1$ guile guile> (use-modules (getlk)) guile> (define fd (open-output-file "blammo")) guile> (define lk (fcntl-lk fd F_SETLKW (list F_WRLCK SEEK_SET 0 0 (getpid)))) guile> lk (1 0 0 0 11415) guile> (set! lk (fcntl-lk fd F_SETLK (list F_UNLCK SEEK_SET 0 0 (getpid)))) guile> lk (2 0 0 0 11415) guile> Good luck. -- Mike Gran
#include <config.h>
#include <fcntl.h>
#include <libguile.h>
#include <stdio.h>
#include <unistd.h>
#ifdef DLL_EXPORT
#define API __attribute__ ((dllexport, cdecl))
#else
#define API
#endif
SCM getlk_fcntl_lk_fdes (SCM s_fdes, SCM s_cmd, SCM s_list) API;
void getlk_init_getlk (void) API;
SCM s_f_getlk;
SCM s_f_setlk;
SCM s_f_setlkw;
SCM s_f_rdlck;
SCM s_f_wrlck;
SCM s_f_unlck;
SCM getlk_fcntl_lk_fdes(SCM s_fdes, SCM s_cmd, SCM s_list)
{
int rv;
int fdes;
struct flock lock;
SCM l_type;
SCM l_whence;
SCM l_start;
SCM l_len;
SCM l_pid;
SCM_ASSERT (scm_is_integer(s_fdes),
s_fdes, SCM_ARG1, "fcntl-lk-fdes");
SCM_ASSERT ( scm_is_integer (s_cmd), s_cmd, SCM_ARG2,
"fcntl-lk-fdes");
SCM_ASSERT ( scm_is_true (scm_list_p (s_list)), s_list, SCM_ARG3,
"fcntl-lk-fdes");
fdes = scm_to_int (s_fdes);
l_type = scm_list_ref (s_list, scm_from_int (0));
l_whence = scm_list_ref (s_list, scm_from_int (1));
l_start = scm_list_ref (s_list, scm_from_int (2));
l_len = scm_list_ref (s_list, scm_from_int (3));
l_pid = scm_list_ref (s_list, scm_from_int (4));
lock.l_type = scm_to_short (l_type);
lock.l_whence = scm_to_short (l_whence);
if (SIZEOF_OFF_T == 4)
{
lock.l_start = scm_to_int32 (l_start);
lock.l_len = scm_to_int32 (l_len);
}
else if (SIZEOF_OFF_T == 8)
{
lock.l_start = scm_to_int64 (l_start);
lock.l_len = scm_to_int64 (l_len);
}
else
abort ();
if (SIZEOF_PID_T == 4)
{
lock.l_pid = scm_to_int32 (l_pid);
}
else
abort ();
rv = fcntl (fdes, scm_to_int (s_cmd), &lock);
if (rv == -1)
{
scm_syserror ("fcntl-lk-fdes");
}
l_type = scm_from_short (lock.l_type);
l_whence = scm_from_short (lock.l_whence);
if (SIZEOF_OFF_T == 4)
{
l_start = scm_from_int32 (lock.l_start);
l_len = scm_from_int32 (lock.l_len);
}
else if (SIZEOF_OFF_T == 8)
{
l_start = scm_from_int64 (lock.l_start);
l_len = scm_from_int64 (lock.l_len);
}
else
{
printf ("aborting at %s %d", __FILE__, __LINE__);
abort ();
}
if (SIZEOF_PID_T == 4)
{
l_pid = scm_from_int32 (lock.l_pid);
}
else
{
printf ("aborting at %s %d", __FILE__, __LINE__);
abort ();
}
return scm_list_5 (l_type, l_whence, l_start, l_len, l_pid);
}
void
getlk_init_getlk ()
{
scm_c_define_gsubr ("fcntl-lk-fdes", 3, 0, 0, getlk_fcntl_lk_fdes);
s_f_getlk = scm_permanent_object (scm_c_define ("F_GETLK", scm_from_int
(F_GETLK)));
s_f_setlk = scm_permanent_object (scm_c_define ("F_SETLK", scm_from_int
(F_SETLK)));
s_f_setlkw = scm_permanent_object (scm_c_define ("F_SETLKW", scm_from_int
(F_SETLKW)));
s_f_rdlck = scm_permanent_object (scm_c_define ("F_RDLCK", scm_from_int
(F_RDLCK)));
s_f_wrlck = scm_permanent_object (scm_c_define ("F_WRLCK", scm_from_int
(F_WRLCK)));
s_f_unlck = scm_permanent_object (scm_c_define ("F_UNLCK", scm_from_int
(F_UNLCK)));
}
getlk.scm.in
Description: 1271041479-getlk.scm.in
_______________________________________________ Guile-user mailing list Guile-user@gnu.org http://lists.gnu.org/mailman/listinfo/guile-user
