From: Taylor R. Campbell <net/mumble/campbell>
Date: Wed, 15 Apr 2009 03:02:48 +0000 (+0000)
Subject: If open(2) fails with EMFILE or ENFILE, trigger a garbage collection
X-Git-Tag: 20090517-FFI~40
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ffcaf734388ce8f1da009dbc689db4970b4724b0;p=mit-scheme.git

If open(2) fails with EMFILE or ENFILE, trigger a garbage collection
to attempt to free up file descriptors, but avoid looping in this
state if there really are too many open file descriptors still
referenced.
---

diff --git a/v7/src/microcode/uxfile.c b/v7/src/microcode/uxfile.c
index 9b8413510..c7c81f206 100644
--- a/v7/src/microcode/uxfile.c
+++ b/v7/src/microcode/uxfile.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: uxfile.c,v 1.18 2009/03/21 07:09:09 riastradh Exp $
+$Id: uxfile.c,v 1.19 2009/04/15 03:02:48 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -68,13 +68,35 @@ OS_open_fd (int fd)
     terminal_open (channel);
   return (channel);
 }
-
+
 static Tchannel
 open_file (const char * filename, int oflag)
 {
+  static bool out_of_files_p = false;
   int fd;
-  STD_UINT_SYSTEM_CALL
-    (syscall_open, fd, (UX_open (filename, oflag, MODE_REG)));
+  while ((fd = (UX_open (filename, oflag, MODE_REG))) < 0)
+    {
+      switch (errno)
+        {
+        case EINTR:
+          deliver_pending_interrupts ();
+          break;
+
+        case EMFILE:
+        case ENFILE:
+          if (!out_of_files_p)
+            {
+              out_of_files_p = true;
+              REQUEST_GC (0);
+              signal_interrupt_from_primitive ();
+            }
+          /* Fall through. */
+
+        default:
+          error_system_call (errno, syscall_open);
+        }
+    }
+  out_of_files_p = false;
 #ifdef SLAVE_PTY_P
   if ((SLAVE_PTY_P (filename)) && (!UX_setup_slave_pty (fd)))
     {