From: John Wiegley <johnw@gnu.org>
Subject: request for review: Doing direct file I/O in Emacs Lisp
Date: Sun, 09 May 2004 22:59:11 -0700 [thread overview]
Message-ID: <m2d65cx1ow.fsf@Majnun.local> (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))
next reply other threads:[~2004-05-10 5:59 UTC|newest]
Thread overview: 37+ messages / expand[flat|nested] mbox.gz Atom feed top
2004-05-10 5:59 John Wiegley [this message]
2004-05-10 6:52 ` request for review: Doing direct file I/O in Emacs Lisp 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m2d65cx1ow.fsf@Majnun.local \
--to=johnw@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.