Removed remaining define-foreign. Flock code is cig-less now.

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 \
+	rm -f scsh/select.c scsh/syscalls.c scsh/tty.c scsh/time.c 
-	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

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);
-}

scsh/flock.scm

@@ -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)
 
-
+(define-stubless-foreign %get-lock/eintr (fd cmd type whence start len) 
-(foreign-source
+  "get_lock")
-  "#include <sys/types.h>"
+(define-retrying-syscall %get-lock %get-lock/eintr)
-  "#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
-				       
 
 ;;; The LOCK record type
 ;;;;;;;;;;;;;;;;;;;;;;;;
@@ -97,40 +67,36 @@
 ;;; The main routines
 ;;;;;;;;;;;;;;;;;;;;;
 
-(define-errno-syscall (lock-region fdes lock)
+(define (lock-region fdes lock)
-  (lambda (fdes lock)
+  (if (not (lock-region/no-block fdes lock))
-    (call-lock-region %set-lock fcntl/set-record-lock 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) 
+  (with-errno-handler
-         => (lambda (errno)
+   ((errno data)
-	      (cond ((or (= errno errno/again) (= errno errno/acces)) #f)
+    ((errno/again errno/acces) #f))
-		    ((= errno errno/intr) (lock-region/no-block fdes lock))
+   (call-lock-region %set-lock fcntl/set-record-lock-no-block fdes lock)
-		    (else (errno-error errno lock-region/no-block fdes lock)))))
+   #t))
-	(else #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)
+  (apply (lambda (type whence start len pid)
-           (call-lock-region %get-lock fcntl/get-record-lock fdes lock)
-    (cond ((not err)
 	   (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))
+	 (call-lock-region %get-lock fcntl/get-record-lock fdes lock)))
-	  (else (errno-error err get-lock-region fdes lock)))))
 
 
-(define-errno-syscall (unlock-region fdes lock)
+(define (unlock-region fdes lock)
-  (lambda (fdes lock)
+  (%set-lock fdes fcntl/set-record-lock lock/release
-    (%set-lock fdes fcntl/set-record-lock lock/release
+	     (lock-region:whence lock)
-	       (lock-region:whence lock)
+	     (lock-region:start lock)
-	       (lock-region:start lock)
+	     (lock-region:len lock)))
-	       (lock-region:len lock))))
 
 
 ;;; Locks with dynamic extent -- with and without sugar

scsh/flock1.c

@@ -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;
+    int retval;
-    lock.l_whence = whence;
+    lock.l_type   = s48_extract_integer (type);
-    lock.l_start  = start;
+    lock.l_whence = s48_extract_integer (whence);
-    lock.l_len    = len;
+    lock.l_start  = s48_extract_integer (start);
-    return(fcntl(fd, cmd, &lock));
+    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,
+s48_value get_lock(s48_value fd, s48_value cmd, s48_value type, 
-	     int *rtype, int *rwhence, int *rstart, int *rlen, int *rpid)
+		   s48_value whence, s48_value start, s48_value len)
 {
     struct flock lock;
     int ret;
-    lock.l_type   = type;
+    lock.l_type   = s48_extract_integer (type);
-    lock.l_whence = whence;
+    lock.l_whence = s48_extract_integer (whence);
-    lock.l_start  = start;
+    lock.l_start  = s48_extract_integer (start);
-    lock.l_len    = len;
+    lock.l_len    = s48_extract_integer (len);
-    ret = fcntl(fd, F_GETLK, &lock);
+    ret = fcntl(s48_extract_fixnum (fd), F_GETLK, &lock);
-    *rtype = lock.l_type;
+    if (ret == -1)
-    *rwhence = lock.l_whence;
+      s48_raise_os_error_6 (errno, fd, cmd, type, whence, start, len);
-    *rstart = lock.l_start;
+    return 
-    *rlen = lock.l_len;
+      s48_cons (s48_enter_integer (lock.l_type), 
-    *rpid = lock.l_pid;
+		s48_cons (s48_enter_integer (lock.l_whence),
-    return(ret);
+			  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);
+}

scsh/flock1.h

@@ -1,5 +1,7 @@
 /* Exports from flock1.c. */
 
-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, 
-int get_lock(int fd, int cmd, int type, int whence, int start, int len,
+		   s48_value whence, s48_value start, s48_value 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);
+void s48_init_flock(void);