guile-user
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: (fcntl fd F_GETLK ...) from Guile


From: Mike Gran
Subject: Re: (fcntl fd F_GETLK ...) from Guile
Date: Sat, 1 Sep 2007 20:34:52 -0700 (PDT)

Kaloian-

--- Kaloian Doganov <address@hidden> 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)));

}

Attachment: getlk.scm.in
Description: 1271041479-getlk.scm.in


reply via email to

[Prev in Thread] Current Thread [Next in Thread]