Removed remaining define-foreign. Flock code is cig-less now.
This commit is contained in:
mainzelm
parent
fa78232f3d
commit
1a60632db8
12
Makefile.in
12
Makefile.in
|
|
@ -117,7 +117,7 @@ SCSHOBJS = \
|
|||
scsh/cstuff.o \
|
||||
scsh/dirstuff1.o \
|
||||
scsh/fdports1.o \
|
||||
scsh/flock.o scsh/flock1.o \
|
||||
scsh/flock1.o \
|
||||
scsh/machine/stdio_dep.o \
|
||||
scsh/machine/time_dep1.o \
|
||||
scsh/signals1.o \
|
||||
|
|
@ -136,7 +136,7 @@ SCSHOBJS = \
|
|||
scsh/regexp/libregex.a
|
||||
|
||||
SCSH_INITIALIZERS = s48_init_syslog s48_init_userinfo s48_init_sighandlers \
|
||||
s48_init_re_low s48_init_syscalls2 s48_init_network
|
||||
s48_init_re_low s48_init_syscalls2 s48_init_network s48_init_flock
|
||||
|
||||
UNIX_OBJS = c/unix/misc.o c/unix/io.o c/unix/fd-io.o c/unix/event.o
|
||||
|
||||
|
|
@ -161,7 +161,7 @@ enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH) $(LIBSCSHVM)
|
|||
|
||||
# Files generated by cig need their init functions called.
|
||||
|
||||
CIGGEDINIT = s48_init_flock s48_init_select \
|
||||
CIGGEDINIT = s48_init_select \
|
||||
s48_init_syscalls s48_init_tty s48_init_time
|
||||
|
||||
# --------------------
|
||||
|
|
@ -225,9 +225,9 @@ ADDITIONAL_INITIALIZER = s48_init_additional_inits
|
|||
scsh/dirstuff1.o: scsh/dirstuff1.h
|
||||
scsh/userinfo1.o: scsh/userinfo1.h
|
||||
scsh/network1o: scsh/network1.h
|
||||
scsh/flock1.o: scsh/flock1.h
|
||||
|
||||
scsh/fdports1.o scsh/fdports.o: scsh/fdports1.h
|
||||
scsh/flock1.o scsh/flock.o: scsh/flock1.h
|
||||
scsh/select1.o scsh/select.o: scsh/select1.h
|
||||
scsh/syscalls1.o scsh/syscalls.o: scsh/syscalls1.h
|
||||
scsh/time1.o scsh/time.o: scsh/time1.h
|
||||
|
|
@ -420,8 +420,7 @@ clean-cig:
|
|||
-rm -f cig/*.o $(CIG) $(CIG).image $(LIBCIG)
|
||||
|
||||
clean-scm2c:
|
||||
rm -f scsh/flock.c \
|
||||
scsh/select.c scsh/syscalls.c scsh/tty.c scsh/time.c
|
||||
rm -f scsh/select.c scsh/syscalls.c scsh/tty.c scsh/time.c
|
||||
|
||||
distclean: clean
|
||||
rm -f Makefile config.log config.status c/sysdep.h config.cache \
|
||||
|
|
@ -786,7 +785,6 @@ SCHEME =scsh/awk.scm \
|
|||
# Explicitly giving the .o/.c dependency also makes it go.
|
||||
############################################################
|
||||
cig/libcig.c: cig/libcig.scm
|
||||
scsh/flock.c: scsh/flock.scm
|
||||
scsh/jcontrol2.c: scsh/jcontrol2.scm
|
||||
scsh/select.c: scsh/select.scm
|
||||
scsh/syscalls.c: scsh/syscalls.scm
|
||||
|
|
|
|||
67
scsh/flock.c
67
scsh/flock.c
|
|
@ -1,67 +0,0 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h> /* For malloc. */
|
||||
#include "libcig.h"
|
||||
|
||||
#include <sys/types.h>
|
||||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
|
||||
extern int errno;
|
||||
|
||||
/* Make sure foreign-function stubs interface to the C funs correctly: */
|
||||
#include "flock1.h"
|
||||
|
||||
#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)
|
||||
|
||||
s48_value df_set_lock(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6)
|
||||
{
|
||||
extern int set_lock(int , int , int , int , int , int );
|
||||
s48_value ret1 = S48_FALSE;
|
||||
S48_DECLARE_GC_PROTECT(1);
|
||||
int r1;
|
||||
|
||||
|
||||
|
||||
S48_GC_PROTECT_1(ret1);
|
||||
r1 = set_lock(s48_extract_integer(g1), s48_extract_integer(g2), s48_extract_integer(g3), s48_extract_integer(g4), s48_extract_integer(g5), s48_extract_integer(g6));
|
||||
ret1 = errno_or_false(r1);
|
||||
S48_GC_UNPROTECT();
|
||||
return ret1;
|
||||
}
|
||||
|
||||
s48_value df_get_lock(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value mv_vec)
|
||||
{
|
||||
extern int get_lock(int , int , int , int , int , int , int *, int *, int *, int *, int *);
|
||||
s48_value ret1 = S48_FALSE;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
int r1;
|
||||
int r2 = 0;
|
||||
int r3 = 0;
|
||||
int r4 = 0;
|
||||
int r5 = 0;
|
||||
int r6 = 0;
|
||||
|
||||
|
||||
|
||||
S48_GC_PROTECT_2(mv_vec,ret1);
|
||||
r1 = get_lock(s48_extract_integer(g1), s48_extract_integer(g2), s48_extract_integer(g3), s48_extract_integer(g4), s48_extract_integer(g5), s48_extract_integer(g6), &r2, &r3, &r4, &r5, &r6);
|
||||
ret1 = errno_or_false(r1);
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_integer(r3));
|
||||
S48_VECTOR_SET(mv_vec,2,s48_enter_integer(r4));
|
||||
S48_VECTOR_SET(mv_vec,3,s48_enter_integer(r5));
|
||||
S48_VECTOR_SET(mv_vec,4,s48_enter_integer(r6));
|
||||
S48_GC_UNPROTECT();
|
||||
return ret1;
|
||||
}
|
||||
|
||||
void s48_init_flock(void)
|
||||
{
|
||||
S48_EXPORT_FUNCTION(df_set_lock);
|
||||
S48_EXPORT_FUNCTION(df_get_lock);
|
||||
}
|
||||
|
|
@ -8,43 +8,13 @@
|
|||
;;; C syscall interface
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(foreign-init-name "flock")
|
||||
(define-stubless-foreign %set-lock/eintr (fd cmd type whence start len)
|
||||
"set_lock")
|
||||
(define-retrying-syscall %set-lock %set-lock/eintr)
|
||||
|
||||
|
||||
(foreign-source
|
||||
"#include <sys/types.h>"
|
||||
"#include <unistd.h>"
|
||||
"#include <fcntl.h>"
|
||||
""
|
||||
"extern int errno;"
|
||||
""
|
||||
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
|
||||
"#include \"flock1.h\""
|
||||
""
|
||||
"#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)"
|
||||
"" "")
|
||||
|
||||
(define-foreign %set-lock (set_lock (integer fd)
|
||||
(integer cmd)
|
||||
(integer type)
|
||||
(integer whence)
|
||||
(integer start)
|
||||
(integer len))
|
||||
(to-scheme integer errno_or_false))
|
||||
|
||||
(define-foreign %get-lock (get_lock (integer fd)
|
||||
(integer cmd)
|
||||
(integer type)
|
||||
(integer whence)
|
||||
(integer start)
|
||||
(integer len))
|
||||
(to-scheme integer errno_or_false)
|
||||
integer ; lock type
|
||||
integer ; whence
|
||||
integer ; start
|
||||
integer ; len
|
||||
integer) ; pid
|
||||
|
||||
(define-stubless-foreign %get-lock/eintr (fd cmd type whence start len)
|
||||
"get_lock")
|
||||
(define-retrying-syscall %get-lock %get-lock/eintr)
|
||||
|
||||
;;; The LOCK record type
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -97,40 +67,36 @@
|
|||
;;; The main routines
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-errno-syscall (lock-region fdes lock)
|
||||
(lambda (fdes lock)
|
||||
(call-lock-region %set-lock fcntl/set-record-lock fdes lock)))
|
||||
(define (lock-region fdes lock)
|
||||
(if (not (lock-region/no-block fdes lock))
|
||||
(begin
|
||||
(relinquish-timeslice)
|
||||
(lock-region fdes lock))))
|
||||
|
||||
;;; Return true/false indicating success/failure.
|
||||
|
||||
(define (lock-region/no-block fdes lock)
|
||||
(cond ((call-lock-region %set-lock fcntl/set-record-lock-no-block fdes lock)
|
||||
=> (lambda (errno)
|
||||
(cond ((or (= errno errno/again) (= errno errno/acces)) #f)
|
||||
((= errno errno/intr) (lock-region/no-block fdes lock))
|
||||
(else (errno-error errno lock-region/no-block fdes lock)))))
|
||||
(else #t)))
|
||||
|
||||
(with-errno-handler
|
||||
((errno data)
|
||||
((errno/again errno/acces) #f))
|
||||
(call-lock-region %set-lock fcntl/set-record-lock-no-block fdes lock)
|
||||
#t))
|
||||
|
||||
;;; Return first lock that conflicts w/LOCK; if none, return #f.
|
||||
|
||||
(define (get-lock-region fdes lock)
|
||||
(receive (err type whence start len pid)
|
||||
(call-lock-region %get-lock fcntl/get-record-lock fdes lock)
|
||||
(cond ((not err)
|
||||
(apply (lambda (type whence start len pid)
|
||||
(and (not (= type lock/release))
|
||||
(make-%lock-region (= type lock/write) start len whence
|
||||
(pid->proc pid 'create))))
|
||||
((= err errno/intr) (get-lock-region fdes lock))
|
||||
(else (errno-error err get-lock-region fdes lock)))))
|
||||
(call-lock-region %get-lock fcntl/get-record-lock fdes lock)))
|
||||
|
||||
|
||||
(define-errno-syscall (unlock-region fdes lock)
|
||||
(lambda (fdes lock)
|
||||
(%set-lock fdes fcntl/set-record-lock lock/release
|
||||
(lock-region:whence lock)
|
||||
(lock-region:start lock)
|
||||
(lock-region:len lock))))
|
||||
(define (unlock-region fdes lock)
|
||||
(%set-lock fdes fcntl/set-record-lock lock/release
|
||||
(lock-region:whence lock)
|
||||
(lock-region:start lock)
|
||||
(lock-region:len lock)))
|
||||
|
||||
|
||||
;;; Locks with dynamic extent -- with and without sugar
|
||||
|
|
|
|||
|
|
@ -8,34 +8,51 @@
|
|||
#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"
|
||||
|
||||
int set_lock(int fd, int cmd, int type, int whence, int start, int len)
|
||||
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;
|
||||
lock.l_type = type;
|
||||
lock.l_whence = whence;
|
||||
lock.l_start = start;
|
||||
lock.l_len = len;
|
||||
return(fcntl(fd, cmd, &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;
|
||||
}
|
||||
|
||||
int get_lock(int fd, int cmd, int type, int whence, int start, int len,
|
||||
int *rtype, int *rwhence, int *rstart, int *rlen, int *rpid)
|
||||
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 = type;
|
||||
lock.l_whence = whence;
|
||||
lock.l_start = start;
|
||||
lock.l_len = len;
|
||||
ret = fcntl(fd, F_GETLK, &lock);
|
||||
*rtype = lock.l_type;
|
||||
*rwhence = lock.l_whence;
|
||||
*rstart = lock.l_start;
|
||||
*rlen = lock.l_len;
|
||||
*rpid = lock.l_pid;
|
||||
return(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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,7 @@
|
|||
/* Exports from flock1.c. */
|
||||
|
||||
int set_lock(int fd, int cmd, int type, int whence, int start, int len);
|
||||
int get_lock(int fd, int cmd, int type, int whence, int start, int len,
|
||||
int *rtype, int *rwhence, int *rstart, int *rlen, int *rpid);
|
||||
s48_value set_lock(s48_value fd, s48_value cmd, s48_value type,
|
||||
s48_value whence, s48_value start, s48_value len);
|
||||
s48_value get_lock(s48_value fd, s48_value cmd, s48_value type,
|
||||
s48_value whence, s48_value start, s48_value len);
|
||||
void s48_init_flock(void);
|
||||
|
|
|
|||
Loading…
Reference in New Issue