[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
request for review: Doing direct file I/O in Emacs Lisp
From: |
John Wiegley |
Subject: |
request for review: Doing direct file I/O in Emacs Lisp |
Date: |
Sun, 09 May 2004 22:59:11 -0700 |
User-agent: |
Gnus/5.110002 (No Gnus v0.2) Emacs/21.3.50 (darwin) |
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 address@hidden
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 <address@hidden>
+
+ * 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 <address@hidden>
* 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 @@
}
+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;
+}
+
+
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))
- request for review: Doing direct file I/O in Emacs Lisp,
John Wiegley <=
Re: request for review: Doing direct file I/O in Emacs Lisp, John Wiegley, 2004/05/11
Re: request for review: Doing direct file I/O in Emacs Lisp, Kim F. Storm, 2004/05/10
Re: request for review: Doing direct file I/O in Emacs Lisp, Andreas Schwab, 2004/05/10