From: Mike Gran <spk121@yahoo.com>
To: Kaloian Doganov <kaloian@doganov.org>, guile-user@gnu.org
Subject: Re: (fcntl fd F_GETLK ...) from Guile
Date: Sat, 1 Sep 2007 20:34:52 -0700 (PDT) [thread overview]
Message-ID: <493012.28697.qm@web37913.mail.mud.yahoo.com> (raw)
In-Reply-To: <87zm07c136.fsf@doganov.org>
[-- Attachment #1: Type: text/plain, Size: 899 bytes --]
Kaloian-
--- Kaloian Doganov <kaloian@doganov.org> 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
[-- Attachment #2: 1659791818-getlk.c --]
[-- Type: text/plain, Size: 2993 bytes --]
#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 #3: 1271041479-getlk.scm.in --]
[-- Type: application/octet-stream, Size: 356 bytes --]
;; -*- Mode: scheme -*-
(define-module (getlk)
#:export (fcntl-lk
F_GETLK
F_SETLK
F_SETLKW
F_RDLCK
F_WRLCK
F_UNLCK))
(define (fcntl-lk fdes cmd list)
(if (port? fdes)
(fcntl-lk-fdes (port->fdes fdes) cmd list)
(fcntl-lk-fdes fdes cmd list)))
(load-extension "XXlibdirXX/libguile-getlk" "getlk_init_getlk")
[-- Attachment #4: Type: text/plain, Size: 140 bytes --]
_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user
next prev parent reply other threads:[~2007-09-02 3:34 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2007-08-31 12:58 (fcntl fd F_GETLK ...) from Guile Kaloian Doganov
2007-08-31 23:50 ` Kevin Ryde
2007-09-01 9:53 ` Kaloian Doganov
2007-09-02 0:30 ` Kevin Ryde
2007-09-03 8:10 ` Kaloian Doganov
2007-09-02 3:34 ` Mike Gran [this message]
2007-09-03 8:08 ` Kaloian Doganov
2007-09-03 13:41 ` Mike Gran
2007-09-11 15:00 ` Kaloian Doganov
2007-09-11 16:03 ` Mike Gran
-- strict thread matches above, loose matches on Subject: below --
2007-08-31 14:19 dsmich
2007-09-01 17:58 dsmich
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=493012.28697.qm@web37913.mail.mud.yahoo.com \
--to=spk121@yahoo.com \
--cc=guile-user@gnu.org \
--cc=kaloian@doganov.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).