Mercurial > hg > xemacs-beta
annotate lib-src/profile.c @ 5327:d1b17a33450b
Move the heavy lifting from cl-seq.el to C.
src/ChangeLog addition:
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
Move the heavy lifting from cl-seq.el to C, finally making those
functions first-class XEmacs citizens, with circularity checking,
built-in support for tests other than #'eql, and as much
compatibility with current Common Lisp as Paul Dietz' tests require.
* fns.c (check_eq_nokey, check_eq_key, check_eql_nokey)
(check_eql_key, check_equal_nokey, check_equal_key)
(check_equalp_nokey, check_equalp_key, check_string_match_nokey)
(check_string_match_key, check_other_nokey, check_other_key)
(check_if_nokey, check_if_key, check_match_eq_key)
(check_match_eql_key, check_match_equal_key)
(check_match_equalp_key, check_match_other_key): New. These are
basically to provide function pointers to be used by Lisp
functions that take TEST, TEST-NOT and KEY arguments.
(get_check_match_function_1, get_check_test_function)
(get_check_match_function): These functions work out which of the
previous list of functions to use, given the keywords supplied by
the user.
(count_with_tail): New. This is the bones of #'count.
(list_count_from_end, string_count_from_end): Utility functions
for #'count.
(Fcount): New, moved from cl-seq.el.
(list_position_cons_before): New. The implementation of #'member*,
and important in implementing various other functions.
(FmemberX, Fadjoin, FassocX, FrassocX, Fposition, Ffind)
(FdeleteX, FremoveX, Fdelete_duplicates, Fremove_duplicates)
(Fnsubstitute, Fsubstitute, Fsublis, Fnsublis, Fsubst, Fnsubst)
(Ftree_equal, Fmismatch, Fsearch, Fintersection, Fnintersection)
(Fsubsetp, Fset_difference, Fnset_difference, Fnunion, Funion)
(Fset_exclusive_or, Fnset_exclusive_or): New, moved here from
cl-seq.el.
(position): New. The implementation of #'find and #'position.
(list_delete_duplicates_from_end, subst, sublis, nsublis)
(tree_equal, mismatch_from_end, mismatch_list_list)
(mismatch_list_string, mismatch_list_array)
(mismatch_string_array, mismatch_string_string)
(mismatch_array_array, get_mismatch_func): Helper C functions for
the Lisp-visible functions.
(venn, nvenn): New. The implementation of the main Lisp functions that
treat lists as sets.
lisp/ChangeLog addition:
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Thu, 30 Dec 2010 01:59:52 +0000 |
parents | cd167465bf69 |
children | b9167d522a9a |
rev | line source |
---|---|
428 | 1 /* profile.c --- generate periodic events for profiling of Emacs Lisp code. |
2 Copyright (C) 1992, 1994 Free Software Foundation, Inc. | |
2367 | 3 Copyright (C) 2004 Ben Wing. |
428 | 4 |
5 Author: Boaz Ben-Zvi <boaz@lcs.mit.edu> | |
6 | |
613 | 7 This file is part of XEmacs. |
428 | 8 |
613 | 9 XEmacs is free software; you can redistribute it and/or modify |
428 | 10 it under the terms of the GNU General Public License as published by |
11 the Free Software Foundation; either version 2, or (at your option) | |
12 any later version. | |
13 | |
613 | 14 XEmacs is distributed in the hope that it will be useful, |
428 | 15 but WITHOUT ANY WARRANTY; without even the implied warranty of |
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 GNU General Public License for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
613 | 20 along with XEmacs; see the file COPYING. If not, write to |
5287
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
2367
diff
changeset
|
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
2367
diff
changeset
|
22 Boston, MA 02111-1307, USA. */ |
428 | 23 |
24 /* Synched up with: FSF 19.28. */ | |
25 /* #### Not sure if this is needed for XEmacs. */ | |
26 | |
27 /** | |
28 ** To be run as an emacs process. Input string that starts with: | |
29 ** 'z' -- resets the watch (to zero). | |
30 ** 'p' -- return time (on stdout) as string with format <sec>.<micro-sec> | |
31 ** 'q' -- exit. | |
32 ** | |
33 ** abstraction : a stopwatch | |
34 ** operations: reset_watch, get_time | |
35 */ | |
438 | 36 #include <config.h> |
428 | 37 #include <stdio.h> |
38 #include <stdlib.h> | |
39 #include "../src/systime.h" | |
40 | |
41 static struct timeval TV1, TV2; | |
42 static int watch_not_started = 1; /* flag */ | |
43 static char time_string[30]; | |
44 | |
442 | 45 #ifdef WIN32_NATIVE |
428 | 46 #include <sys/timeb.h> |
47 /* Emulate gettimeofday (Ulrich Leodolter, 1/11/95). */ | |
48 void | |
49 gettimeofday (struct timeval *tv, struct timezone *tz) | |
50 { | |
51 struct _timeb tb; | |
52 _ftime (&tb); | |
53 | |
54 tv->tv_sec = tb.time; | |
55 tv->tv_usec = tb.millitm * 1000L; | |
56 if (tz) | |
57 { | |
58 tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */ | |
59 tz->tz_dsttime = tb.dstflag; /* type of dst correction */ | |
60 } | |
61 } | |
62 #endif | |
63 | |
64 /* Reset the stopwatch to zero. */ | |
65 | |
66 static void | |
67 reset_watch (void) | |
68 { | |
69 EMACS_GET_TIME (TV1); | |
70 watch_not_started = 0; | |
71 } | |
72 | |
73 /* This call returns the time since the last reset_watch call. The time | |
74 is returned as a string with the format <seconds>.<micro-seconds> | |
75 If reset_watch was not called yet, exit. */ | |
76 | |
77 static char * | |
78 get_time (void) | |
79 { | |
80 if (watch_not_started) | |
81 exit (1); /* call reset_watch first ! */ | |
82 EMACS_GET_TIME (TV2); | |
83 if (TV1.tv_usec > TV2.tv_usec) | |
84 { | |
85 TV2.tv_usec += 1000000; | |
86 TV2.tv_sec--; | |
87 } | |
88 sprintf (time_string, "%lu.%06lu", | |
89 (unsigned long) TV2.tv_sec - TV1.tv_sec, | |
90 (unsigned long) TV2.tv_usec - TV1.tv_usec); | |
91 return time_string; | |
92 } | |
93 | |
94 int | |
2367 | 95 main (int argc, char **argv) |
428 | 96 { |
97 int c; | |
98 while ((c = getchar ()) != EOF) | |
99 { | |
100 switch (c) | |
101 { | |
102 case 'z': | |
103 reset_watch (); | |
104 break; | |
105 case 'p': | |
106 puts (get_time ()); | |
107 break; | |
108 case 'q': | |
109 exit (0); | |
110 } | |
111 /* Anything remaining on the line is ignored. */ | |
112 while (c != '\n' && c != EOF) | |
113 c = getchar (); | |
114 } | |
115 return 1; | |
116 } |