unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* request for review: Doing direct file I/O in Emacs Lisp
@ 2004-05-10  5:59 John Wiegley
  2004-05-10  6:52 ` Kim F. Storm
                   ` (4 more replies)
  0 siblings, 5 replies; 37+ messages in thread
From: John Wiegley @ 2004-05-10  5:59 UTC (permalink / raw)


The following patch implements a file-handle interface for Emacs Lisp,
which allows files to be directly opened and read/written to without
an intervening buffer.  Eshell can now use this, for example, to
greatly speed up output redirection (by several orders of magnitude).

It is a simple interface that reads in strings, given a length, and
writes strings by examining their length:

  (let ((handle (file-handle-open "/tmp/some-file" "w")))
    (file-handle-write handle "Test data\n")
    (file-handle-close handle)

    (setq handle (file-handle-open "/tmp/some-file" "r"))
    (message (file-handle-read handle 128))
    (file-handle-close handle))

Please post comments here, or mail them to johnw@gnu.org.

Thanks,
  John

----------------------------------------------------------------------
Index: src/ChangeLog
===================================================================
RCS file: /cvsroot/emacs/emacs/src/ChangeLog,v
retrieving revision 1.3671
diff -w -U3 -r1.3671 ChangeLog
--- src/ChangeLog	10 May 2004 04:15:14 -0000	1.3671
+++ src/ChangeLog	10 May 2004 05:51:30 -0000
@@ -3,6 +3,26 @@
 	* fns.c (count_combining): Delete it.
 	(concat): Don't check combining bytes.
 
+2004-05-09  John Wiegley  <johnw@gnu.org>
+
+	* lisp.h (enum pvec_type): Added PVEC_FILE_HANDLE type.  Added
+	Lisp_File_Handle structure, and several macros for dealing with
+	these types.
+
+	* fileio.c: Implemented several new functions: file-handle-p,
+	file-handle-open, file-handle-close, file-handle-read,
+	file-handle-write.
+	(syms_of_fileio): Declare these routines to the lisp interpretor.
+
+	* data.c: Added global Qfile_handle.
+	(Ftype_of): Check for file handles.
+	(syms_of_data): Intern the symbol "file-handle".
+	(syms_of_data): Setup the variable Qfile_handle.
+
+	* alloc.c (enum mem_type): Added MEM_TYPE_FILE_HANDLE.
+	(allocate_file_handle): New routine for allocating file handle
+	objects.
+
 2004-05-09  Jason Rumney  <jasonr@gnu.org>
 
 	* w32fns.c (Vw32_ansi_code_page): New Lisp variable.
Index: src/alloc.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/alloc.c,v
retrieving revision 1.333
diff -w -U3 -r1.333 alloc.c
--- src/alloc.c	26 Apr 2004 21:42:49 -0000	1.333
+++ src/alloc.c	10 May 2004 05:51:35 -0000
@@ -291,6 +291,7 @@
   MEM_TYPE_VECTOR,
   MEM_TYPE_PROCESS,
   MEM_TYPE_HASH_TABLE,
+  MEM_TYPE_FILE_HANDLE,
   MEM_TYPE_FRAME,
   MEM_TYPE_WINDOW
 };
@@ -2558,6 +2559,21 @@
     v->contents[i] = Qnil;
 
   return (struct Lisp_Hash_Table *) v;
+}
+
+
+struct Lisp_File_Handle *
+allocate_file_handle ()
+{
+  EMACS_INT len = VECSIZE (struct Lisp_File_Handle);
+  struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FILE_HANDLE);
+  EMACS_INT i;
+
+  for (i = 0; i < len; ++i)
+    v->contents[i] = Qnil;
+  v->size = len;
+
+  return (struct Lisp_File_Handle *) v;
 }
 
 
Index: src/data.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/data.c,v
retrieving revision 1.239
diff -w -U3 -r1.239 data.c
--- src/data.c	9 May 2004 00:49:06 -0000	1.239
+++ src/data.c	10 May 2004 05:51:49 -0000
@@ -93,7 +93,7 @@
 static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
 Lisp_Object Qprocess;
 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
-static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
+static Lisp_Object Qchar_table, Qbool_vector, Qhash_table, Qfile_handle;
 static Lisp_Object Qsubrp, Qmany, Qunevalled;
 
 static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object));
@@ -243,6 +243,8 @@
 	return Qframe;
       if (GC_HASH_TABLE_P (object))
 	return Qhash_table;
+      if (GC_FILE_HANDLEP (object))
+	return Qfile_handle;
       return Qvector;
 
     case Lisp_Float:
@@ -3227,6 +3229,7 @@
   Qchar_table = intern ("char-table");
   Qbool_vector = intern ("bool-vector");
   Qhash_table = intern ("hash-table");
+  Qfile_handle = intern ("file-handle");
 
   staticpro (&Qinteger);
   staticpro (&Qsymbol);
@@ -3246,6 +3249,7 @@
   staticpro (&Qchar_table);
   staticpro (&Qbool_vector);
   staticpro (&Qhash_table);
+  staticpro (&Qfile_handle);
 
   defsubr (&Sindirect_variable);
   defsubr (&Sinteractive_form);
Index: src/fileio.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/fileio.c,v
retrieving revision 1.503
diff -w -U3 -r1.503 fileio.c
--- src/fileio.c	4 May 2004 19:23:31 -0000	1.503
+++ src/fileio.c	10 May 2004 05:51:50 -0000
@@ -6365,6 +6365,152 @@
 }
 
 \f
+DEFUN ("file-handle-p", Ffile_handle_p, Sfile_handle_p, 1, 1, 0,
+       doc: /* Return t if OBJECT is a direct file handle.  */)
+     (object)
+     Lisp_Object object;
+{
+  if (FILE_HANDLEP (object))
+    return Qt;
+  return Qnil;
+}
+
+
+DEFUN ("file-handle-open", Ffile_handle_open, Sfile_handle_open,
+       2, 2, 0,
+       doc: /* Open a file handle for direct reading/writing. */)
+     (path, mode)
+     Lisp_Object path, mode;
+{
+  FILE *stream;
+  Lisp_Object handle, lispstream;
+  struct Lisp_File_Handle *lh;
+
+  if (! STRINGP (path) || ! STRINGP (mode))
+    return Qnil;
+
+  if (! Ffile_exists_p (path))
+    return Qnil;
+
+  stream = fopen(SDATA (path), SDATA (mode));
+  if (! stream)
+    return Qnil;
+
+  lh = allocate_file_handle ();
+
+  /* Arrange to close that file whether or not we get an error.
+     Also reset auto_saving to 0.  */
+  lispstream = Fcons (Qnil, Qnil);
+  XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16);
+  XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff);
+
+  lh->handle = lispstream;
+
+  XSETFILE_HANDLE (handle, lh);
+  xassert (FILE_HANDLEP (handle));
+  xassert (XFILE_HANDLE (handle) == lh);
+
+  return handle;
+}
+
+DEFUN ("file-handle-close", Ffile_handle_close, Sfile_handle_close,
+       1, 1, 0,
+       doc: /* Close a direct file handle. */)
+     (handle)
+     Lisp_Object handle;
+{
+  FILE *stream;
+  Lisp_Object lispstream;
+  struct Lisp_File_Handle *lh;
+
+  if (! FILE_HANDLEP (handle))
+    return Qnil;
+
+  lh = XFILE_HANDLE(handle);
+
+  lispstream = lh->handle;
+  if (! CONSP(lispstream))
+    return Qnil;
+
+  stream = (FILE *) (XFASTINT (XCAR (lispstream)) << 16 |
+		     XFASTINT (XCDR (lispstream)));
+  lh->handle = Qnil;
+  if (! stream)
+    return Qnil;
+
+  fclose(stream);
+
+  return Qt;
+}
+
+DEFUN ("file-handle-read", Ffile_handle_read, Sfile_handle_read,
+       2, 2, 0,
+       doc: /* Close a direct file handle. */)
+     (handle, length)
+     Lisp_Object handle, length;
+{
+  FILE *stream;
+  Lisp_Object lispstream, data;
+  struct Lisp_File_Handle *lh;
+  unsigned char *buf;
+  int read;
+
+  if (! FILE_HANDLEP (handle))
+    return Qnil;
+
+  lh = XFILE_HANDLE(handle);
+
+  lispstream = lh->handle;
+  if (! CONSP(lispstream))
+    return Qnil;
+
+  stream = (FILE *) (XFASTINT (XCAR (lispstream)) << 16 |
+		     XFASTINT (XCDR (lispstream)));
+  if (! stream)
+    return Qnil;
+
+  buf = (unsigned char *) alloca (XFASTINT (length));
+  data = make_string (buf, XFASTINT (length));
+  read = fread(SDATA (data), 1, XFASTINT (length), stream);
+  if (read != XFASTINT (length))
+    return Fsubstring (data, make_number (0), make_number (read));
+
+  return data;
+}
+
+DEFUN ("file-handle-write", Ffile_handle_write, Sfile_handle_write,
+       2, 2, 0,
+       doc: /* Close a direct file handle. */)
+     (handle, data)
+     Lisp_Object handle, data;
+{
+  FILE *stream;
+  Lisp_Object lispstream;
+  struct Lisp_File_Handle *lh;
+  int wrote;
+
+  if (! FILE_HANDLEP (handle))
+    return Qnil;
+
+  lh = XFILE_HANDLE(handle);
+
+  lispstream = lh->handle;
+  if (! CONSP(lispstream))
+    return Qnil;
+
+  stream = (FILE *) (XFASTINT (XCAR (lispstream)) << 16 |
+		     XFASTINT (XCDR (lispstream)));
+  if (! stream)
+    return Qnil;
+
+  wrote = fwrite(SDATA (data), 1, SCHARS (data), stream);
+  if (wrote != SCHARS (data))
+    return Qnil;
+
+  return Qt;
+}
+
+\f
 void
 init_fileio_once ()
 {
@@ -6678,6 +6824,12 @@
 
   defsubr (&Sread_file_name_internal);
   defsubr (&Sread_file_name);
+
+  defsubr (&Sfile_handle_p);
+  defsubr (&Sfile_handle_open);
+  defsubr (&Sfile_handle_close);
+  defsubr (&Sfile_handle_read);
+  defsubr (&Sfile_handle_write);
 
 #ifdef unix
   defsubr (&Sunix_sync);
Index: src/lisp.h
===================================================================
RCS file: /cvsroot/emacs/emacs/src/lisp.h,v
retrieving revision 1.489
diff -w -U3 -r1.489 lisp.h
--- src/lisp.h	26 Apr 2004 21:26:17 -0000	1.489
+++ src/lisp.h	10 May 2004 05:51:54 -0000
@@ -267,7 +267,8 @@
   PVEC_BOOL_VECTOR = 0x10000,
   PVEC_BUFFER = 0x20000,
   PVEC_HASH_TABLE = 0x40000,
-  PVEC_TYPE_MASK = 0x7fe00
+  PVEC_FILE_HANDLE = 0x80000,
+  PVEC_TYPE_MASK = 0xffe00
 
 #if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
 	 GDB.  It doesn't work on OS Alpha.  Moved to a variable in
@@ -513,6 +514,16 @@
 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
 #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
 
+struct Lisp_File_Handle
+  {
+    EMACS_INT size;
+    struct Lisp_Vector *v_next;
+    Lisp_Object handle;
+};
+
+#define XSETFILE_HANDLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FILE_HANDLE))
+#define XFILE_HANDLE(a) ((struct Lisp_File_Handle *) XPNTR (a))
+
 /* Convenience macros for dealing with Lisp arrays.  */
 
 #define AREF(ARRAY, IDX)	XVECTOR ((ARRAY))->contents[IDX]
@@ -1421,6 +1432,8 @@
 #define GC_BOOL_VECTOR_P(x) GC_PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
 #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
 #define GC_FRAMEP(x) GC_PSEUDOVECTORP (x, PVEC_FRAME)
+#define FILE_HANDLEP(x) PSEUDOVECTORP (x, PVEC_FILE_HANDLE)
+#define GC_FILE_HANDLEP(x) GC_PSEUDOVECTORP (x, PVEC_FILE_HANDLE)
 
 #define SUB_CHAR_TABLE_P(x) (CHAR_TABLE_P (x) && NILP (XCHAR_TABLE (x)->top))
 
@@ -2447,6 +2460,7 @@
 extern struct Lisp_Vector *allocate_vector P_ ((EMACS_INT));
 extern struct Lisp_Vector *allocate_other_vector P_ ((EMACS_INT));
 extern struct Lisp_Hash_Table *allocate_hash_table P_ ((void));
+extern struct Lisp_File_Handle *allocate_file_handle P_ ((void));
 extern struct window *allocate_window P_ ((void));
 extern struct frame *allocate_frame P_ ((void));
 extern struct Lisp_Process *allocate_process P_ ((void));
Index: src/print.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/print.c,v
retrieving revision 1.199
diff -w -U3 -r1.199 print.c
--- src/print.c	26 Apr 2004 21:56:26 -0000	1.199
+++ src/print.c	10 May 2004 05:51:57 -0000
@@ -1872,6 +1872,10 @@
 	  strout (buf, -1, -1, printcharfun, 0);
 	  PRINTCHAR ('>');
 	}
+      else if (FILE_HANDLEP (obj))
+	{
+	  strout ("#<file-handle>", -1, -1, printcharfun, 0);
+	}
       else if (BUFFERP (obj))
 	{
 	  if (NILP (XBUFFER (obj)->name))
Index: lisp/eshell/esh-io.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/eshell/esh-io.el,v
retrieving revision 1.8
diff -w -U3 -r1.8 esh-io.el
--- lisp/eshell/esh-io.el	1 Sep 2003 15:45:23 -0000	1.8
+++ lisp/eshell/esh-io.el	10 May 2004 05:51:57 -0000
@@ -260,6 +260,10 @@
 
    ;; If we were redirecting to a file, save the file and close the
    ;; buffer.
+   ((and (fboundp 'file-handle-p)
+	 (file-handle-p target))
+    (file-handle-close target))
+
    ((markerp target)
     (let ((buf (marker-buffer target)))
       (when buf                         ; somebody's already killed it!
@@ -337,6 +341,11 @@
 	 (if (nth 2 redir)
 	     (funcall (nth 1 redir) mode)
 	   (nth 1 redir))
+       (if (fboundp 'file-handle-open)
+	   (cond ((eq mode 'overwrite)
+		  (file-handle-open target "w"))
+		 ((eq mode 'append)
+		  (file-handle-open target "a")))
        (let* ((exists (get-file-buffer target))
 	      (buf (find-file-noselect target t)))
 	 (with-current-buffer buf
@@ -348,7 +357,7 @@
 		  (erase-buffer))
 		 ((eq mode 'append)
 		  (goto-char (point-max))))
-	   (point-marker))))))
+	     (point-marker)))))))
    ((or (bufferp target)
 	(and (boundp 'eshell-buffer-shorthand)
 	     (symbol-value 'eshell-buffer-shorthand)
@@ -461,6 +470,11 @@
   "Insert OBJECT into TARGET.
 Returns what was actually sent, or nil if nothing was sent."
   (cond
+   ((and (fboundp 'file-handle-p)
+	 (file-handle-p target))
+    (setq object (eshell-stringify object))
+    (file-handle-write target object))
+
    ((functionp target)
     (funcall target object))

^ permalink raw reply	[flat|nested] 37+ messages in thread

end of thread, other threads:[~2004-05-17 11:04 UTC | newest]

Thread overview: 37+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-05-10  5:59 request for review: Doing direct file I/O in Emacs Lisp John Wiegley
2004-05-10  6:52 ` Kim F. Storm
2004-05-10  8:27 ` David Kastrup
2004-05-10 14:21   ` Stefan Monnier
2004-05-10 15:59     ` David Kastrup
2004-05-10 16:36       ` Stefan Monnier
2004-05-10 17:00         ` David Kastrup
2004-05-10 17:22           ` Stefan Monnier
2004-05-11  9:23   ` John Wiegley
2004-05-11 10:22     ` David Kastrup
2004-05-10  9:38 ` Andreas Schwab
2004-05-10 11:29   ` Eli Zaretskii
2004-05-10 11:23     ` Andreas Schwab
2004-05-10 15:04       ` Eli Zaretskii
2004-05-10 14:19 ` Stefan Monnier
2004-05-10 17:46   ` Oliver Scholz
2004-05-10 18:21     ` Stefan Monnier
2004-05-10 22:40       ` Oliver Scholz
2004-05-11 12:22     ` Richard Stallman
2004-05-10 17:54 ` Richard Stallman
2004-05-11  9:20   ` John Wiegley
2004-05-12 19:41     ` Richard Stallman
2004-05-13  7:59       ` Kai Grossjohann
2004-05-14  9:21         ` Richard Stallman
2004-05-14 10:42           ` Kai Grossjohann
2004-05-15  8:53             ` Richard Stallman
2004-05-15 16:27               ` Kai Grossjohann
2004-05-16 13:20                 ` Richard Stallman
2004-05-14 21:43           ` John Wiegley
2004-05-15 18:33             ` Richard Stallman
2004-05-15 21:36               ` John Wiegley
2004-05-15 22:13                 ` David Kastrup
2004-05-16  6:41                   ` Eli Zaretskii
2004-05-16 17:46                     ` David Kastrup
2004-05-17 11:04                 ` Richard Stallman
2004-05-13 22:50       ` John Wiegley
2004-05-14 21:02         ` Richard Stallman

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).