annotate lib-src/i.c @ 5157:1fae11d56ad2

redo memory-usage mechanism, add way of dynamically initializing Lisp objects -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-18 Ben Wing <ben@xemacs.org> * diagnose.el (show-memory-usage): Rewrite to take into account API changes in memory-usage functions. src/ChangeLog addition: 2010-03-18 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (disksave_object_finalization_1): * alloc.c (lisp_object_storage_size): * alloc.c (listu): * alloc.c (listn): * alloc.c (Fobject_memory_usage_stats): * alloc.c (compute_memusage_stats_length): * alloc.c (Fobject_memory_usage): * alloc.c (Ftotal_object_memory_usage): * alloc.c (malloced_storage_size): * alloc.c (common_init_alloc_early): * alloc.c (reinit_alloc_objects_early): * alloc.c (reinit_alloc_early): * alloc.c (init_alloc_once_early): * alloc.c (syms_of_alloc): * alloc.c (reinit_vars_of_alloc): * buffer.c: * buffer.c (struct buffer_stats): * buffer.c (compute_buffer_text_usage): * buffer.c (compute_buffer_usage): * buffer.c (buffer_memory_usage): * buffer.c (buffer_objects_create): * buffer.c (syms_of_buffer): * buffer.c (vars_of_buffer): * console-impl.h (struct console_methods): * dynarr.c (Dynarr_memory_usage): * emacs.c (main_1): * events.c (clear_event_resource): * extents.c: * extents.c (compute_buffer_extent_usage): * extents.c (extent_objects_create): * extents.h: * faces.c: * faces.c (compute_face_cachel_usage): * faces.c (face_objects_create): * faces.h: * general-slots.h: * glyphs.c: * glyphs.c (compute_glyph_cachel_usage): * glyphs.c (glyph_objects_create): * glyphs.h: * lisp.h: * lisp.h (struct usage_stats): * lrecord.h: * lrecord.h (enum lrecord_type): * lrecord.h (struct lrecord_implementation): * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): * lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT): * lrecord.h (MAKE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT): * lrecord.h (MAKE_MODULE_LISP_OBJECT): * lrecord.h (INIT_LISP_OBJECT): * lrecord.h (INIT_MODULE_LISP_OBJECT): * lrecord.h (UNDEF_LISP_OBJECT): * lrecord.h (UNDEF_MODULE_LISP_OBJECT): * lrecord.h (DECLARE_LISP_OBJECT): * lrecord.h (DECLARE_MODULE_API_LISP_OBJECT): * lrecord.h (DECLARE_MODULE_LISP_OBJECT): * lstream.c: * lstream.c (syms_of_lstream): * lstream.c (vars_of_lstream): * marker.c: * marker.c (compute_buffer_marker_usage): * mc-alloc.c (mc_alloced_storage_size): * mc-alloc.h: * mule-charset.c: * mule-charset.c (struct charset_stats): * mule-charset.c (compute_charset_usage): * mule-charset.c (charset_memory_usage): * mule-charset.c (mule_charset_objects_create): * mule-charset.c (syms_of_mule_charset): * mule-charset.c (vars_of_mule_charset): * redisplay.c: * redisplay.c (compute_rune_dynarr_usage): * redisplay.c (compute_display_block_dynarr_usage): * redisplay.c (compute_glyph_block_dynarr_usage): * redisplay.c (compute_display_line_dynarr_usage): * redisplay.c (compute_line_start_cache_dynarr_usage): * redisplay.h: * scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage): * scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage): * scrollbar-x.c (x_compute_scrollbar_instance_usage): * scrollbar.c (compute_scrollbar_instance_usage): * scrollbar.h: * symbols.c: * symbols.c (reinit_symbol_objects_early): * symbols.c (init_symbols_once_early): * symbols.c (reinit_symbols_early): * symbols.c (defsymbol_massage_name_1): * symsinit.h: * ui-gtk.c: * ui-gtk.c (emacs_gtk_object_getprop): * ui-gtk.c (emacs_gtk_object_putprop): * ui-gtk.c (ui_gtk_objects_create): * unicode.c (compute_from_unicode_table_size_1): * unicode.c (compute_to_unicode_table_size_1): * unicode.c (compute_from_unicode_table_size): * unicode.c (compute_to_unicode_table_size): * window.c: * window.c (struct window_stats): * window.c (compute_window_mirror_usage): * window.c (compute_window_usage): * window.c (window_memory_usage): * window.c (window_objects_create): * window.c (syms_of_window): * window.c (vars_of_window): * window.h: Redo memory-usage mechanism, make it general; add way of dynamically initializing Lisp object types -- OBJECT_HAS_METHOD(), similar to CONSOLE_HAS_METHOD(). (1) Create OBJECT_HAS_METHOD(), OBJECT_HAS_PROPERTY() etc. for specifying that a Lisp object type has a particular method or property. Call such methods with OBJECT_METH, MAYBE_OBJECT_METH, OBJECT_METH_OR_GIVEN; retrieve properties with OBJECT_PROPERTY. Methods that formerly required a DEFINE_*GENERAL_LISP_OBJECT() to specify them (getprop, putprop, remprop, plist, disksave) now instead use the dynamic-method mechanism. The main benefit of this is that new methods or properties can be added without requiring that the declaration statements of all existing methods be modified. We have to make the `struct lrecord_implementation' non-const, but I don't think this should have any effect on speed -- the only possible method that's really speed-critical is the mark method, and we already extract those out into a separate (non-const) array for increased cache locality. Object methods need to be reinitialized after pdump, so we put them in separate functions such as face_objects_create(), extent_objects_create() and call them appropriately from emacs.c The only current object property (`memusage_stats_list') that objects can specify is a Lisp object and gets staticpro()ed so it only needs to be set during dump time, but because it references symbols that might not exist in a syms_of_() function, we initialize it in vars_of_(). There is also an object property (`num_extra_memusage_stats') that is automatically initialized based on `memusage_stats_list'; we do that in reinit_vars_of_alloc(), which is called after all vars_of_() functions are called. `disksaver' method was renamed `disksave' to correspond with the name normally given to the function (e.g. disksave_lstream()). (2) Generalize the memory-usage mechanism in `buffer-memory-usage', `window-memory-usage', `charset-memory-usage' into an object-type- specific mechanism called by a single function `object-memory-usage'. (Former function `object-memory-usage' renamed to `total-object-memory-usage'). Generalize the mechanism of different "slices" so that we can have different "classes" of memory described and different "slices" onto each class; `t' separates classes, `nil' separates slices. Currently we have three classes defined: the memory of an object itself, non-Lisp-object memory associated with the object (e.g. arrays or dynarrs stored as fields in the object), and Lisp-object memory associated with the object (other internal Lisp objects stored in the object). This isn't completely finished yet and we might need to further separate the "other internal Lisp objects" class into two classes. The memory-usage mechanism uses a `struct usage_stats' (renamed from `struct overhead_stats') to describe a malloc-view onto a set of allocated memory (listing how much was requested and various types of overhead) and a more general `struct generic_usage_stats' (with a `struct usage_stats' in it) to hold all statistics about object memory. `struct generic_usage_stats' contains an array of 32 Bytecounts, which are statistics of unspecified semantics. The intention is that individual types declare a corresponding struct (e.g. `struct window_stats') with the same structure but with specific fields in place of the array, corresponding to specific statistics. The number of such statistics is an object property computed from the list of tags (Lisp symbols describing the statistics) stored in `memusage_stats_list'. The idea here is to allow particular object types to customize the number and semantics of the statistics where completely avoiding consing. This doesn't matter so much yet, but the intention is to have the memory usage of all objects computed at the end of GC, at the same time as other statistics are currently computed. The values for all statistics for a single type would be added up to compute aggregate values for all objects of a specific type. To make this efficient, we can't allow any memory allocation at all. (3) Create some additional functions for creating lists that specify the elements directly as args rather than indirectly through an array: listn() (number of args given), listu() (list terminated by Qunbound). (4) Delete a bit of remaining unused C window_config stuff, also unused lrecord_type_popup_data.
author Ben Wing <ben@xemacs.org>
date Thu, 18 Mar 2010 10:50:06 -0500
parents 49316578f12d
children 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
1 /* I-connector utility
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
2 Copyright (C) 2000 Kirill M. Katsnelson
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 826
diff changeset
3 Copyright (C) 2002, 2003 Ben Wing.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
4
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
5 This file is part of XEmacs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
6
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
10 later version.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
11
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
15 for more details.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
16
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
21
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
22 /* When run with an argument, i treats it as a command line, and pipes
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
23 command stdin, stdout and stderr to its own respective streams. How
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
24 silly it should sound, but windowed program in Win32 cannot do output
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
25 to the console from which it has been started, and should be run using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
26 this utility.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
27
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
28 This utility is for running [tx]emacs as part of make process so that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
29 its output goes to the same console as the rest of the make output
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
30 does. It can be used also when xemacs should be run as a batch
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
31 command ina script, especially when its standart output should be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
32 obtained programmatically. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
33
2993
49316578f12d [xemacs-hg @ 2005-10-14 01:02:29 by ben]
ben
parents: 2426
diff changeset
34 #ifdef HAVE_CONFIG_H
49316578f12d [xemacs-hg @ 2005-10-14 01:02:29 by ben]
ben
parents: 2426
diff changeset
35 # include <config.h>
49316578f12d [xemacs-hg @ 2005-10-14 01:02:29 by ben]
ben
parents: 2426
diff changeset
36 #endif
49316578f12d [xemacs-hg @ 2005-10-14 01:02:29 by ben]
ben
parents: 2426
diff changeset
37
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
38 #include <windows.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
39 #include <stdio.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
40 #include <string.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
41 #include <tchar.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
42
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
43 typedef struct
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
44 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
45 HANDLE source;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
46 HANDLE drain;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
47 } I_connector;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
48
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
49 /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
50 * Make new handle as that pointed to by PH but
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
51 * inheritable, substitute PH with it, and close the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
52 * original one
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
53 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
54 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
55 make_inheritable (HANDLE* ph)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
56 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
57 HANDLE htmp;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
58 DuplicateHandle (GetCurrentProcess(), *ph, GetCurrentProcess(), &htmp,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
59 0, TRUE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
60 *ph = htmp;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
61 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
62
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
63 /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
64 * Worker thread proc. Reads source, pumps into drain,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
65 * till either clogs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
66 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
67 static DWORD CALLBACK
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
68 pump (LPVOID pv_i)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
69 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
70 I_connector* pi = (I_connector*) pv_i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
71 BYTE buffer [256];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
72 DWORD really_read, unused;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
73
2426
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
74 /* I said:
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
75
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
76 [[ The docs for ReadFile claim:
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 826
diff changeset
77
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 826
diff changeset
78 The ReadFile function returns when one of the following is true: a write
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 826
diff changeset
79 operation completes on the write end of the pipe, the number of bytes
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 826
diff changeset
80 requested has been read, or an error occurs.
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 826
diff changeset
81
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 826
diff changeset
82 But this is just not true. ReadFile never seems to block, and unless we
2426
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
83 Sleep(), we will chew up all the CPU time. --ben ]]
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
84
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
85 But in fact
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
86
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
87 [a] this does not appear to be the case any more [maybe a temporary
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
88 bug in some versions of Win2000?]
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
89 [b] it causes data lossage. [#### Why should this be? Seems extremely
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
90 fishy. I tried commenting out the calls to close the standard
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
91 handles at the bottom of the program, but it made no difference.
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
92 Would we need some kind of additional handshaking? If we get
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
93 data loss with the sleep, then we are a race condition waiting
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
94 to happen. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
95 while (ReadFile (pi->source, buffer, sizeof (buffer), &really_read, NULL) &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
96 WriteFile (pi->drain, buffer, really_read, &unused, NULL))
2426
bb3f73fbbda8 [xemacs-hg @ 2004-12-07 00:20:51 by ben]
ben
parents: 1346
diff changeset
97 /* Sleep (100) */ ;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
98
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
99 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
100 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
101
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
102 /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
103 * Launch a pump for the given I-connector
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
104 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
105 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
106 start_pump (I_connector* pi)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
107 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
108 DWORD unused;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
109 HANDLE h_thread = CreateThread (NULL, 0, pump, (void*)pi, 0, &unused);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
110 CloseHandle (h_thread);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
111 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
112
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
113 static HANDLE external_event;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
114
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
115 static BOOL
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
116 ctrl_c_handler (unsigned long type)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
117 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
118 SetEvent (external_event);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
119 return FALSE;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
120 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
121
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
122 /* Skip over the executable name in the given command line. Correctly
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
123 handles quotes in the name. Return NULL upon error. If
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
124 REQUIRE_FOLLOWING is non-zero, it's an error if no argument follows the
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
125 executable name. */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
126
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
127 static LPTSTR
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
128 skip_executable_name (LPTSTR cl, int require_following)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
129 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
130 int ix;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
131
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
132 while (1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
133 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
134 ix = _tcscspn (cl, _T(" \t\""));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
135 if (cl[ix] == '\"')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
136 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
137 cl = _tcschr (cl + ix + 1, '\"');
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
138 if (cl == NULL)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
139 return NULL; /* Unmatched quote */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
140 cl++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
141 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
142 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
143 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
144 cl += ix;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
145 cl += _tcsspn (cl, _T(" \t"));
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
146 if (!require_following)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
147 return cl;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
148 return *cl ? cl : NULL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
149 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
150 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
151 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
152
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
153 /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
154 * Brew coffee and bring snickers
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
155 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
156 void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
157 usage (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
158 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
159 fprintf (stderr,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
160 "\n"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
161 "usage: i command\n"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
162 "i executes the command and reroutes its standard handles to the calling\n"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
163 "console. Good for seeing output of GUI programs that use standard output."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
164 "\n");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
165 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
166
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
167 int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
168 main (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
169 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
170 STARTUPINFO si;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
171 PROCESS_INFORMATION pi;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
172 I_connector I_in, I_out, I_err;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
173 DWORD exit_code;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
174 LPTSTR command = skip_executable_name (GetCommandLine (), 1);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
175
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
176 if (command == NULL)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
177 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
178 usage ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
179 return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
180 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
181
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
182 ZeroMemory (&si, sizeof (si));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
183 si.dwFlags = STARTF_USESTDHANDLES;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
184
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
185 I_in.source = GetStdHandle (STD_INPUT_HANDLE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
186 CreatePipe (&si.hStdInput, &I_in.drain, NULL, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
187 make_inheritable (&si.hStdInput);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
188
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
189 I_out.drain = GetStdHandle (STD_OUTPUT_HANDLE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
190 CreatePipe (&I_out.source, &si.hStdOutput, NULL, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
191 make_inheritable (&si.hStdOutput);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
192
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
193 I_err.drain = GetStdHandle (STD_ERROR_HANDLE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
194 CreatePipe (&I_err.source, &si.hStdError, NULL, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
195 make_inheritable (&si.hStdError);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
196
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
197 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
198 SECURITY_ATTRIBUTES sa;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
199 LPTSTR new_command =
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
200 (LPTSTR) malloc (666 + sizeof (TCHAR) * _tcslen (command));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
201 LPTSTR past_exe;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
202
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
203 if (!new_command)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
204 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
205 _ftprintf (stderr, _T ("Out of memory when launching `%s'\n"),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
206 command);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
207 return 2;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
208 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
209
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
210 past_exe = skip_executable_name (command, 0);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
211 if (!past_exe)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
212 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
213 usage ();
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
214 return 1;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
215 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
216
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
217 /* Since XEmacs isn't a console application, it can't easily be
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
218 terminated using ^C. Therefore, we set up a communication path with
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
219 it so that when a ^C is sent to us (using GenerateConsoleCtrlEvent),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
220 we in turn signals it to commit suicide. (This is cleaner than using
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
221 TerminateProcess()). This makes (e.g.) the "Stop Build" command
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
222 from VC++ correctly terminate XEmacs.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
223
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
224 #### This will cause problems if i.exe is used for commands other
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
225 than XEmacs. We need to make behavior this a command-line
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
226 option. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
227
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
228 /* Create the event as inheritable so that we can use it to communicate
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
229 with the child process */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
230 sa.nLength = sizeof (sa);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
231 sa.bInheritHandle = TRUE;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
232 sa.lpSecurityDescriptor = NULL;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
233 external_event = CreateEvent (&sa, FALSE, FALSE, NULL);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
234 if (!external_event)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
235 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
236 _ftprintf (stderr, _T ("Error %d creating signal event for `%s'\n"),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
237 GetLastError (), command);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
238 return 2;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
239 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
240
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
241 SetConsoleCtrlHandler ((PHANDLER_ROUTINE) ctrl_c_handler, TRUE);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
242 _tcsncpy (new_command, command, past_exe - command);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
243 _stprintf (new_command + (past_exe - command),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
244 /* start with space in case no args past command name */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
245 " -mswindows-termination-handle %d ", (long) external_event);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
246 _tcscat (new_command, past_exe);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
247
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
248 if (CreateProcess (NULL, new_command, NULL, NULL, TRUE, 0,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
249 NULL, NULL, &si, &pi) == 0)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
250 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
251 _ftprintf (stderr, _T("Error %d launching `%s'\n"),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
252 GetLastError (), command);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
253 return 2;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
254 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
255
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
256 CloseHandle (pi.hThread);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
257 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 442
diff changeset
258
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
259
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
260 /* Start pump in each I-connector */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
261 start_pump (&I_in);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
262 start_pump (&I_out);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
263 start_pump (&I_err);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
264
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
265 /* Wait for the process to complete */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
266 WaitForSingleObject (pi.hProcess, INFINITE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
267 GetExitCodeProcess (pi.hProcess, &exit_code);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
268 CloseHandle (pi.hProcess);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
269
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
270 /* Make pump threads eventually die out. Looks rude, I agree */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
271 CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
272 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
273 CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
274
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
275 return exit_code;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
276 }