scsh-0.6/scsh/flock1.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);
}