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);