comparison src/alloc.c @ 814:a634e3b7acc8

[xemacs-hg @ 2002-04-14 12:41:59 by ben] latest changes TODO.ben-mule-21-5: Update. make-docfile.c: Add basic support for handling ISO 2022 doc strings -- we parse the basic charset designation sequences so we know whether we're in ASCII and have to pay attention to end quotes and such. Reformat code according to coding standards. abbrev.el: Add `global-abbrev-mode', which turns on or off abbrev-mode in all buffers. Added `defining-abbrev-turns-on-abbrev-mode' -- if non-nil, defining an abbrev through an interactive function will automatically turn on abbrev-mode, either globally or locally depending on the command. This is the "what you'd expect" behavior. indent.el: general function for indenting a balanced expression in a mode-correct way. Works similar to indent-region in that a mode can specify a specific command to do the whole operation; if not, figure out the region using forward-sexp and indent each line using indent-according-to-mode. keydefs.el: Removed. Modify M-C-backslash to do indent-region-or-balanced-expression. Make S-Tab just insert a TAB char, like it's meant to do. make-docfile.el: Now that we're using the call-process-in-lisp, we need to load an extra file win32-native.el because we're running a bare temacs. menubar-items.el: Totally redo the Cmds menu so that most used commands appear directly on the menu and less used commands appear in submenus. The old way may have been very pretty, but rather impractical. process.el: Under Windows, don't ever use old-call-process-internal, even in batch mode. We can do processes in batch mode. subr.el: Someone recoded truncate-string-to-width, saying "the FSF version is too complicated and does lots of hard-to-understand stuff" but the resulting recoded version was *totally* wrong! it misunderstood the basic point of this function, which is work in *columns* not chars. i dumped ours and copied the version from FSF 21.1. Also added truncate-string-with-continuation-dots, since this idiom is used often. config.inc.samp, xemacs.mak: Separate out debug and optimize flags. Remove all vestiges of USE_MINIMAL_TAGBITS, USE_INDEXED_LRECORD_IMPLEMENTATION, and GUNG_HO, since those ifdefs have long been removed. Make error-checking support actually work. Some rearrangement of config.inc.samp to make it more logical. Remove callproc.c and ntproc.c from xemacs.mak, no longer used. Make pdump the default. lisp.h: Add support for strong type-checking of Bytecount, Bytebpos, Charcount, Charbpos, and others, by making them classes, overloading the operators to provide integer-like operation and carefully controlling what operations are allowed. Not currently enabled in C++ builds because there are still a number of compile errors, and it won't really work till we merge in my "8-bit-Mule" workspace, in which I make use of the new types Charxpos, Bytexpos, Memxpos, representing a "position" either in a buffer or a string. (This is especially important in the extent code.) abbrev.c, alloc.c, eval.c, buffer.c, buffer.h, editfns.c, fns.c, text.h: Warning fixes, some of them related to new C++ strict type checking of Bytecount, Charbpos, etc. dired.c: Caught an actual error due to strong type checking -- char len being passed when should be byte len. alloc.c, backtrace.h, bytecode.c, bytecode.h, eval.c, sysdep.c: Further optimize Ffuncall: -- process arg list at compiled-function creation time, converting into an array for extra-quick access at funcall time. -- rewrite funcall_compiled_function to use it, and inline this function. -- change the order of check for magic stuff in SPECBIND_FAST_UNSAFE to be faster. -- move the check for need to garbage collect into the allocation code, so only a single flag needs to be checked in funcall. buffer.c, symbols.c: add debug funs to check on mule optimization info in buffers and strings. eval.c, emacs.c, text.c, regex.c, scrollbar-msw.c, search.c: Fix evil crashes due to eistrings not properly reinitialized under pdump. Redo a bit some of the init routines; convert some complex_vars_of() into simple vars_of(), because they didn't need complex processing. callproc.c, emacs.c, event-stream.c, nt.c, process.c, process.h, sysdep.c, sysdep.h, syssignal.h, syswindows.h, ntproc.c: Delete. Hallelujah, praise the Lord, there is no god but Allah!!! fix so that processes can be invoked in bare temacs -- thereby eliminating any need for callproc.c. (currently only eliminated under NT.) remove all crufty and unnecessary old process code in ntproc.c and elsewhere. move non-callproc-specific stuff (mostly environment) into process.c, so callproc.c can be left out under NT. console-tty.c, doc.c, file-coding.c, file-coding.h, lstream.c, lstream.h: fix doc string handling so it works with Japanese, etc docs. change handling of "character mode" so callers don't have to manually set it (quite error-prone). event-msw.c: spacing fixes. lread.c: eliminate unused crufty vintage-19 "FSF defun hack" code. lrecord.h: improve pdump description docs. buffer.c, ntheap.c, unexnt.c, win32.c, emacs.c: Mule-ize some unexec and startup code. It was pseudo-Mule-ized before by simply always calling the ...A versions of functions, but that won't cut it -- eventually we want to be able to run properly even if XEmacs has been installed in a Japanese directory. (The current problem is the timing of the loading of the Unicode tables; this will eventually be fixed.) Go through and fix various other places where the code was not Mule-clean. Provide a function mswindows_get_module_file_name() to get our own name without resort to PATH_MAX and such. Add a big comment in main() about the problem with Unicode table load timing that I just alluded to. emacs.c: When error-checking is enabled (interpreted as "user is developing XEmacs"), don't ask user to "pause to read messages" when a fatal error has occurred, because it will wedge if we are in an inner modal loop (typically when a menu is popped up) and make us unable to get a useful stack trace in the debugger. text.c: Correct update_entirely_ascii_p_flag to actually work. lisp.h, symsinit.h: declarations for above changes.
author ben
date Sun, 14 Apr 2002 12:43:31 +0000
parents 2b676dc88c66
children 6728e641994e
comparison
equal deleted inserted replaced
813:9541922fb765 814:a634e3b7acc8
68 #include "dumper.h" 68 #include "dumper.h"
69 #endif 69 #endif
70 70
71 EXFUN (Fgarbage_collect, 0); 71 EXFUN (Fgarbage_collect, 0);
72 72
73 static void recompute_need_to_garbage_collect (void);
74
73 #if 0 /* this is _way_ too slow to be part of the standard debug options */ 75 #if 0 /* this is _way_ too slow to be part of the standard debug options */
74 #if defined(DEBUG_XEMACS) && defined(MULE) 76 #if defined(DEBUG_XEMACS) && defined(MULE)
75 #define VERIFY_STRING_CHARS_INTEGRITY 77 #define VERIFY_STRING_CHARS_INTEGRITY
76 #endif 78 #endif
77 #endif 79 #endif
88 static Fixnum debug_allocation; 90 static Fixnum debug_allocation;
89 static Fixnum debug_allocation_backtrace_length; 91 static Fixnum debug_allocation_backtrace_length;
90 #endif 92 #endif
91 93
92 /* Number of bytes of consing done since the last gc */ 94 /* Number of bytes of consing done since the last gc */
93 EMACS_INT consing_since_gc; 95 static EMACS_INT consing_since_gc;
94 #define INCREMENT_CONS_COUNTER_1(size) (consing_since_gc += (size)) 96 int need_to_garbage_collect;
97
98 /* Determine now whether we need to garbage collect or not, to make
99 Ffuncall() faster */
100 #define INCREMENT_CONS_COUNTER_1(size) \
101 do \
102 { \
103 consing_since_gc += (size); \
104 recompute_need_to_garbage_collect (); \
105 } while (0)
95 106
96 #define debug_allocation_backtrace() \ 107 #define debug_allocation_backtrace() \
97 do { \ 108 do { \
98 if (debug_allocation_backtrace_length > 0) \ 109 if (debug_allocation_backtrace_length > 0) \
99 debug_short_backtrace (debug_allocation_backtrace_length); \ 110 debug_short_backtrace (debug_allocation_backtrace_length); \
128 139
129 #define DECREMENT_CONS_COUNTER(size) do { \ 140 #define DECREMENT_CONS_COUNTER(size) do { \
130 consing_since_gc -= (size); \ 141 consing_since_gc -= (size); \
131 if (consing_since_gc < 0) \ 142 if (consing_since_gc < 0) \
132 consing_since_gc = 0; \ 143 consing_since_gc = 0; \
144 recompute_need_to_garbage_collect (); \
133 } while (0) 145 } while (0)
134 146
135 /* Number of bytes of consing since gc before another gc should be done. */ 147 /* Number of bytes of consing since gc before another gc should be done. */
136 static EMACS_INT gc_cons_threshold; 148 static EMACS_INT gc_cons_threshold;
137 149
242 /* Force a GC next time eval is called. 254 /* Force a GC next time eval is called.
243 It's better to loop garbage-collecting (we might reclaim enough 255 It's better to loop garbage-collecting (we might reclaim enough
244 to win) than to loop beeping and barfing "Memory exhausted" 256 to win) than to loop beeping and barfing "Memory exhausted"
245 */ 257 */
246 consing_since_gc = gc_cons_threshold + 1; 258 consing_since_gc = gc_cons_threshold + 1;
259 recompute_need_to_garbage_collect ();
247 release_breathing_space (); 260 release_breathing_space ();
248 261
249 /* Flush some histories which might conceivably contain garbalogical 262 /* Flush some histories which might conceivably contain garbalogical
250 inhibitors. */ 263 inhibitors. */
251 if (!NILP (Fboundp (Qvalues))) 264 if (!NILP (Fboundp (Qvalues)))
1454 list2 (intern ("make-byte-code"), make_int (nargs))); 1467 list2 (intern ("make-byte-code"), make_int (nargs)));
1455 1468
1456 /* Check for valid formal parameter list now, to allow us to use 1469 /* Check for valid formal parameter list now, to allow us to use
1457 SPECBIND_FAST_UNSAFE() later in funcall_compiled_function(). */ 1470 SPECBIND_FAST_UNSAFE() later in funcall_compiled_function(). */
1458 { 1471 {
1459 EXTERNAL_LIST_LOOP_3 (symbol, arglist, tail) 1472 EXTERNAL_LIST_LOOP_2 (symbol, arglist)
1460 { 1473 {
1461 CHECK_SYMBOL (symbol); 1474 CHECK_SYMBOL (symbol);
1462 if (EQ (symbol, Qt) || 1475 if (EQ (symbol, Qt) ||
1463 EQ (symbol, Qnil) || 1476 EQ (symbol, Qnil) ||
1464 SYMBOL_IS_KEYWORD (symbol)) 1477 SYMBOL_IS_KEYWORD (symbol))
1467 symbol, arglist); 1480 symbol, arglist);
1468 } 1481 }
1469 } 1482 }
1470 f->arglist = arglist; 1483 f->arglist = arglist;
1471 1484
1485 {
1486 int minargs = 0, maxargs = 0, totalargs = 0;
1487 int optional_p = 0, rest_p = 0, i = 0;
1488 {
1489 LIST_LOOP_2 (arg, arglist)
1490 {
1491 if (EQ (arg, Qand_optional))
1492 optional_p = 1;
1493 else if (EQ (arg, Qand_rest))
1494 rest_p = 1;
1495 else
1496 {
1497 if (rest_p)
1498 {
1499 maxargs = MANY;
1500 totalargs++;
1501 break;
1502 }
1503 if (!optional_p)
1504 minargs++;
1505 maxargs++;
1506 totalargs++;
1507 }
1508 }
1509 }
1510
1511 f->args = xnew_array (Lisp_Object, totalargs);
1512
1513 {
1514 LIST_LOOP_2 (arg, arglist)
1515 {
1516 if (!EQ (arg, Qand_optional) && !EQ (arg, Qand_rest))
1517 f->args[i++] = arg;
1518 }
1519 }
1520
1521 f->max_args = maxargs;
1522 f->min_args = minargs;
1523 f->args_in_array = totalargs;
1524 }
1525
1472 /* `instructions' is a string or a cons (string . int) for a 1526 /* `instructions' is a string or a cons (string . int) for a
1473 lazy-loaded function. */ 1527 lazy-loaded function. */
1474 if (CONSP (instructions)) 1528 if (CONSP (instructions))
1475 { 1529 {
1476 CHECK_STRING (XCAR (instructions)); 1530 CHECK_STRING (XCAR (instructions));
1754 string_plist, 1808 string_plist,
1755 Lisp_String); 1809 Lisp_String);
1756 1810
1757 /* String blocks contain this many useful bytes. */ 1811 /* String blocks contain this many useful bytes. */
1758 #define STRING_CHARS_BLOCK_SIZE \ 1812 #define STRING_CHARS_BLOCK_SIZE \
1759 ((Bytecount) (8192 - MALLOC_OVERHEAD - \ 1813 ((Bytecount) (8192 - MALLOC_OVERHEAD - \
1760 ((2 * sizeof (struct string_chars_block *)) \ 1814 ((2 * sizeof (struct string_chars_block *)) \
1761 + sizeof (EMACS_INT)))) 1815 + sizeof (EMACS_INT))))
1762 /* Block header for small strings. */ 1816 /* Block header for small strings. */
1763 struct string_chars_block 1817 struct string_chars_block
1764 { 1818 {
1765 EMACS_INT pos; 1819 EMACS_INT pos;
1766 struct string_chars_block *next; 1820 struct string_chars_block *next;
1809 current_string_chars_block = first_string_chars_block; 1863 current_string_chars_block = first_string_chars_block;
1810 } 1864 }
1811 1865
1812 static struct string_chars * 1866 static struct string_chars *
1813 allocate_string_chars_struct (Lisp_Object string_it_goes_with, 1867 allocate_string_chars_struct (Lisp_Object string_it_goes_with,
1814 EMACS_INT fullsize) 1868 Bytecount fullsize)
1815 { 1869 {
1816 struct string_chars *s_chars; 1870 struct string_chars *s_chars;
1817 1871
1818 if (fullsize <= 1872 if (fullsize <=
1819 (countof (current_string_chars_block->string_chars) 1873 (countof (current_string_chars_block->string_chars)
1871 1925
1872 Lisp_Object 1926 Lisp_Object
1873 make_uninit_string (Bytecount length) 1927 make_uninit_string (Bytecount length)
1874 { 1928 {
1875 Lisp_String *s; 1929 Lisp_String *s;
1876 EMACS_INT fullsize = STRING_FULLSIZE (length); 1930 Bytecount fullsize = STRING_FULLSIZE (length);
1877 1931
1878 assert (length >= 0 && fullsize > 0); 1932 assert (length >= 0 && fullsize > 0);
1879 1933
1880 /* Allocate the string header */ 1934 /* Allocate the string header */
1881 ALLOCATE_FIXED_TYPE (string, Lisp_String, s); 1935 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
2068 XSET_STRING_ASCII_BEGIN (s, i); 2122 XSET_STRING_ASCII_BEGIN (s, i);
2069 else if (newlen == 1 && i == (Charcount) XSTRING_ASCII_BEGIN (s)) 2123 else if (newlen == 1 && i == (Charcount) XSTRING_ASCII_BEGIN (s))
2070 /* We've extended ascii_begin, and we have to figure out how much by */ 2124 /* We've extended ascii_begin, and we have to figure out how much by */
2071 { 2125 {
2072 Bytecount j; 2126 Bytecount j;
2073 for (j = i + 1; j < XSTRING_LENGTH (s); j++) 2127 for (j = (Bytecount) i + 1; j < XSTRING_LENGTH (s); j++)
2074 { 2128 {
2075 if (!BYTE_ASCII_P (XSTRING_DATA (s)[j])) 2129 if (!BYTE_ASCII_P (XSTRING_DATA (s)[j]))
2076 break; 2130 break;
2077 } 2131 }
2078 XSET_STRING_ASCII_BEGIN (s, min (j, MAX_STRING_ASCII_BEGIN)); 2132 XSET_STRING_ASCII_BEGIN (s, min (j, (Bytecount) MAX_STRING_ASCII_BEGIN));
2079 } 2133 }
2080 } 2134 }
2081 sledgehammer_check_ascii_begin (s); 2135 sledgehammer_check_ascii_begin (s);
2082 } 2136 }
2083 2137
2199 2253
2200 Lisp_Object 2254 Lisp_Object
2201 build_intstring (const Intbyte *str) 2255 build_intstring (const Intbyte *str)
2202 { 2256 {
2203 /* Some strlen's crash and burn if passed null. */ 2257 /* Some strlen's crash and burn if passed null. */
2204 return make_string (str, (str ? qxestrlen (str) : 0)); 2258 return make_string (str, (str ? qxestrlen (str) : (Bytecount) 0));
2205 } 2259 }
2206 2260
2207 Lisp_Object 2261 Lisp_Object
2208 build_string (const CIntbyte *str) 2262 build_string (const CIntbyte *str)
2209 { 2263 {
3739 #ifndef DEBUG_XEMACS 3793 #ifndef DEBUG_XEMACS
3740 /* Allow you to set it really fucking low if you really want ... */ 3794 /* Allow you to set it really fucking low if you really want ... */
3741 if (gc_cons_threshold < 10000) 3795 if (gc_cons_threshold < 10000)
3742 gc_cons_threshold = 10000; 3796 gc_cons_threshold = 10000;
3743 #endif 3797 #endif
3798 recompute_need_to_garbage_collect ();
3744 3799
3745 inhibit_non_essential_printing_operations = 0; 3800 inhibit_non_essential_printing_operations = 0;
3746 gc_in_progress = 0; 3801 gc_in_progress = 0;
3747 3802
3748 run_post_gc_actions (); 3803 run_post_gc_actions ();
3954 { 4009 {
3955 return make_int (total_data_usage ()); 4010 return make_int (total_data_usage ());
3956 } 4011 }
3957 4012
3958 /* True if it's time to garbage collect now. */ 4013 /* True if it's time to garbage collect now. */
3959 int 4014 static void
3960 need_to_garbage_collect (void) 4015 recompute_need_to_garbage_collect (void)
3961 { 4016 {
3962 if (always_gc) 4017 if (always_gc)
3963 return 1; 4018 need_to_garbage_collect = 1;
3964 4019 else
3965 return (consing_since_gc > gc_cons_threshold && 4020 need_to_garbage_collect =
3966 (100 * consing_since_gc) / total_data_usage () >= 4021 (consing_since_gc > gc_cons_threshold
3967 gc_cons_percentage); 4022 #if 0 /* #### implement this better */
4023 &&
4024 (100 * consing_since_gc) / total_data_usage () >=
4025 gc_cons_percentage
4026 #endif /* 0 */
4027 );
3968 } 4028 }
3969 4029
3970 4030
3971 int 4031 int
3972 object_dead_p (Lisp_Object obj) 4032 object_dead_p (Lisp_Object obj)
4167 staticpro_nodump_names = Dynarr_new2 (char_ptr_dynarr, char *); 4227 staticpro_nodump_names = Dynarr_new2 (char_ptr_dynarr, char *);
4168 Dynarr_resize (staticpro_nodump_names, 100); /* ditto */ 4228 Dynarr_resize (staticpro_nodump_names, 100); /* ditto */
4169 #endif 4229 #endif
4170 4230
4171 consing_since_gc = 0; 4231 consing_since_gc = 0;
4232 need_to_garbage_collect = always_gc;
4233
4172 #if 1 4234 #if 1
4173 gc_cons_threshold = 500000; /* XEmacs change */ 4235 gc_cons_threshold = 500000; /* XEmacs change */
4174 #else 4236 #else
4175 gc_cons_threshold = 15000; /* debugging */ 4237 gc_cons_threshold = 15000; /* debugging */
4176 #endif 4238 #endif