59 lines
1.8 KiB
C
59 lines
1.8 KiB
C
/* Scheme48/scsh Unix system interface.
|
|
** Routines that require custom C support.
|
|
** Copyright (c) 1995 by David Albertz.
|
|
*/
|
|
|
|
/* File locking routines */
|
|
|
|
#include <sys/types.h>
|
|
#include <unistd.h>
|
|
#include <fcntl.h>
|
|
#include <errno.h>
|
|
|
|
/* Make sure our exports match up w/the implementation: */
|
|
#include "scheme48.h"
|
|
#include "flock1.h"
|
|
|
|
s48_value set_lock(s48_value fd, s48_value cmd, s48_value type,
|
|
s48_value whence, s48_value start, s48_value len)
|
|
{
|
|
struct flock lock;
|
|
int retval;
|
|
lock.l_type = s48_extract_integer (type);
|
|
lock.l_whence = s48_extract_integer (whence);
|
|
lock.l_start = s48_extract_integer (start);
|
|
lock.l_len = s48_extract_integer (len);
|
|
retval = fcntl(s48_extract_fixnum (fd), s48_extract_integer (cmd), &lock);
|
|
if (retval == -1)
|
|
s48_raise_os_error_6 (errno, fd, cmd, type, whence, start, len);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value get_lock(s48_value fd, s48_value cmd, s48_value type,
|
|
s48_value whence, s48_value start, s48_value len)
|
|
{
|
|
struct flock lock;
|
|
int ret;
|
|
lock.l_type = s48_extract_integer (type);
|
|
lock.l_whence = s48_extract_integer (whence);
|
|
lock.l_start = s48_extract_integer (start);
|
|
lock.l_len = s48_extract_integer (len);
|
|
ret = fcntl(s48_extract_fixnum (fd), F_GETLK, &lock);
|
|
if (ret == -1)
|
|
s48_raise_os_error_6 (errno, fd, cmd, type, whence, start, len);
|
|
return
|
|
s48_cons (s48_enter_integer (lock.l_type),
|
|
s48_cons (s48_enter_integer (lock.l_whence),
|
|
s48_cons (s48_enter_integer (lock.l_start),
|
|
s48_cons (s48_enter_integer (lock.l_len),
|
|
s48_cons
|
|
(s48_enter_integer (lock.l_pid),
|
|
S48_NULL)))));
|
|
}
|
|
|
|
void s48_init_flock(void)
|
|
{
|
|
S48_EXPORT_FUNCTION(set_lock);
|
|
S48_EXPORT_FUNCTION(get_lock);
|
|
}
|