Mercurial > hg > xemacs-beta
comparison src/alloc.c @ 278:90d73dddcdc4 r21-0b37
Import from CVS: tag r21-0b37
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:31:29 +0200 |
parents | ca9a9ec9c1c1 |
children | 7df0dd720c89 |
comparison
equal
deleted
inserted
replaced
277:cfdf3ff11843 | 278:90d73dddcdc4 |
---|---|
39 */ | 39 */ |
40 | 40 |
41 #include <config.h> | 41 #include <config.h> |
42 #include "lisp.h" | 42 #include "lisp.h" |
43 | 43 |
44 #ifndef standalone | |
45 #include "backtrace.h" | 44 #include "backtrace.h" |
46 #include "buffer.h" | 45 #include "buffer.h" |
47 #include "bytecode.h" | 46 #include "bytecode.h" |
48 #include "chartab.h" | 47 #include "chartab.h" |
49 #include "device.h" | 48 #include "device.h" |
54 #include "glyphs.h" | 53 #include "glyphs.h" |
55 #include "redisplay.h" | 54 #include "redisplay.h" |
56 #include "specifier.h" | 55 #include "specifier.h" |
57 #include "sysfile.h" | 56 #include "sysfile.h" |
58 #include "window.h" | 57 #include "window.h" |
59 #endif | |
60 | 58 |
61 #ifdef DOUG_LEA_MALLOC | 59 #ifdef DOUG_LEA_MALLOC |
62 #include <malloc.h> | 60 #include <malloc.h> |
63 #endif | 61 #endif |
64 | 62 |
369 to win) than to loop beeping and barfing "Memory exhausted" | 367 to win) than to loop beeping and barfing "Memory exhausted" |
370 */ | 368 */ |
371 consing_since_gc = gc_cons_threshold + 1; | 369 consing_since_gc = gc_cons_threshold + 1; |
372 release_breathing_space (); | 370 release_breathing_space (); |
373 | 371 |
374 #ifndef standalone | 372 /* Flush some histories which might conceivably contain garbalogical |
375 /* Flush some histories which might conceivably contain | 373 inhibitors. */ |
376 * garbalogical inhibitors */ | |
377 if (!NILP (Fboundp (Qvalues))) | 374 if (!NILP (Fboundp (Qvalues))) |
378 Fset (Qvalues, Qnil); | 375 Fset (Qvalues, Qnil); |
379 Vcommand_history = Qnil; | 376 Vcommand_history = Qnil; |
380 #endif | |
381 | 377 |
382 error ("Memory exhausted"); | 378 error ("Memory exhausted"); |
383 } | 379 } |
384 | 380 |
385 /* like malloc and realloc but check for no memory left, and block input. */ | 381 /* like malloc and realloc but check for no memory left, and block input. */ |
2361 for (j = 0; j < len; j++) | 2357 for (j = 0; j < len; j++) |
2362 ptr[k++] = str[j]; | 2358 ptr[k++] = str[j]; |
2363 } | 2359 } |
2364 } | 2360 } |
2365 return val; | 2361 return val; |
2362 } | |
2363 | |
2364 DEFUN ("string", Fstring, 0, MANY, 0, /* | |
2365 Concatenate all the argument characters and make the result a string. | |
2366 */ | |
2367 (int nargs, Lisp_Object *args)) | |
2368 { | |
2369 Bufbyte *storage = alloca_array (Bufbyte, nargs * MAX_EMCHAR_LEN); | |
2370 Bufbyte *p = storage; | |
2371 | |
2372 for (; nargs; nargs--, args++) | |
2373 { | |
2374 Lisp_Object lisp_char = *args; | |
2375 CHECK_CHAR_COERCE_INT (lisp_char); | |
2376 p += set_charptr_emchar (p, XCHAR (lisp_char)); | |
2377 } | |
2378 return make_string (storage, p - storage); | |
2366 } | 2379 } |
2367 | 2380 |
2368 /* Take some raw memory, which MUST already be in internal format, | 2381 /* Take some raw memory, which MUST already be in internal format, |
2369 and package it up into a Lisp string. */ | 2382 and package it up into a Lisp string. */ |
2370 Lisp_Object | 2383 Lisp_Object |
3070 } | 3083 } |
3071 clear_message (); | 3084 clear_message (); |
3072 | 3085 |
3073 if (rc < 0) { | 3086 if (rc < 0) { |
3074 unlink("SATISFIED"); | 3087 unlink("SATISFIED"); |
3075 /* Current build process on NT does */ | |
3076 /* not know how to restart itself. */ | |
3077 /* --marcpa */ | |
3078 #ifndef WINDOWSNT | |
3079 fatal ("Pure size adjusted, Don't Panic! I will restart the `make'"); | 3088 fatal ("Pure size adjusted, Don't Panic! I will restart the `make'"); |
3080 #endif | |
3081 } else if (pure_lossage && die_if_pure_storage_exceeded) { | 3089 } else if (pure_lossage && die_if_pure_storage_exceeded) { |
3082 fatal ("Pure storage exhausted"); | 3090 fatal ("Pure storage exhausted"); |
3083 } | 3091 } |
3084 } | 3092 } |
3085 | 3093 |
3897 #define ADDITIONAL_FREE_symbol(ptr) | 3905 #define ADDITIONAL_FREE_symbol(ptr) |
3898 | 3906 |
3899 SWEEP_FIXED_TYPE_BLOCK (symbol, struct Lisp_Symbol); | 3907 SWEEP_FIXED_TYPE_BLOCK (symbol, struct Lisp_Symbol); |
3900 } | 3908 } |
3901 | 3909 |
3902 | |
3903 #ifndef standalone | |
3904 | |
3905 static void | 3910 static void |
3906 sweep_extents (void) | 3911 sweep_extents (void) |
3907 { | 3912 { |
3908 #define MARKED_extent_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) | 3913 #define MARKED_extent_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) |
3909 #define UNMARK_extent(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3914 #define UNMARK_extent(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
3949 | 3954 |
3950 #ifndef ALLOC_NO_POOLS | 3955 #ifndef ALLOC_NO_POOLS |
3951 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, struct Lisp_Marker, ptr); | 3956 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, struct Lisp_Marker, ptr); |
3952 #endif /* ALLOC_NO_POOLS */ | 3957 #endif /* ALLOC_NO_POOLS */ |
3953 } | 3958 } |
3954 | |
3955 #endif /* not standalone */ | |
3956 | |
3957 | 3959 |
3958 | 3960 |
3959 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) | 3961 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) |
3960 | 3962 |
3961 static void | 3963 static void |
5008 init_symbol_alloc (); | 5010 init_symbol_alloc (); |
5009 init_compiled_function_alloc (); | 5011 init_compiled_function_alloc (); |
5010 #ifdef LISP_FLOAT_TYPE | 5012 #ifdef LISP_FLOAT_TYPE |
5011 init_float_alloc (); | 5013 init_float_alloc (); |
5012 #endif /* LISP_FLOAT_TYPE */ | 5014 #endif /* LISP_FLOAT_TYPE */ |
5013 #ifndef standalone | |
5014 init_marker_alloc (); | 5015 init_marker_alloc (); |
5015 init_extent_alloc (); | 5016 init_extent_alloc (); |
5016 init_event_alloc (); | 5017 init_event_alloc (); |
5017 #endif | 5018 |
5018 ignore_malloc_warnings = 0; | 5019 ignore_malloc_warnings = 0; |
5019 staticidx = 0; | 5020 staticidx = 0; |
5020 consing_since_gc = 0; | 5021 consing_since_gc = 0; |
5021 #if 1 | 5022 #if 1 |
5022 gc_cons_threshold = 500000; /* XEmacs change */ | 5023 gc_cons_threshold = 500000; /* XEmacs change */ |
5065 DEFSUBR (Fmake_byte_code); | 5066 DEFSUBR (Fmake_byte_code); |
5066 DEFSUBR (Fmake_list); | 5067 DEFSUBR (Fmake_list); |
5067 DEFSUBR (Fmake_vector); | 5068 DEFSUBR (Fmake_vector); |
5068 DEFSUBR (Fmake_bit_vector); | 5069 DEFSUBR (Fmake_bit_vector); |
5069 DEFSUBR (Fmake_string); | 5070 DEFSUBR (Fmake_string); |
5071 DEFSUBR (Fstring); | |
5070 DEFSUBR (Fmake_symbol); | 5072 DEFSUBR (Fmake_symbol); |
5071 DEFSUBR (Fmake_marker); | 5073 DEFSUBR (Fmake_marker); |
5072 DEFSUBR (Fpurecopy); | 5074 DEFSUBR (Fpurecopy); |
5073 DEFSUBR (Fgarbage_collect); | 5075 DEFSUBR (Fgarbage_collect); |
5074 DEFSUBR (Fmemory_limit); | 5076 DEFSUBR (Fmemory_limit); |