comparison src/alloc.c @ 5471:00e79bbbe48f

Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Mon, 14 Feb 2011 22:43:46 +0100
parents 8d29f1c4bb98 22c4e67a2e69
children 4dee0387b9de
comparison
equal deleted inserted replaced
5470:0af042a0c116 5471:00e79bbbe48f
1424 { 1424 {
1425 /* This cannot GC. */ 1425 /* This cannot GC. */
1426 return Fcons (obj0, Fcons (obj1, obj2)); 1426 return Fcons (obj0, Fcons (obj1, obj2));
1427 } 1427 }
1428 1428
1429 Lisp_Object 1429 DEFUN ("acons", Facons, 3, 3, 0, /*
1430 acons (Lisp_Object key, Lisp_Object value, Lisp_Object alist) 1430 Return a new alist created by prepending (KEY . VALUE) to ALIST.
1431 */
1432 (key, value, alist))
1431 { 1433 {
1432 return Fcons (Fcons (key, value), alist); 1434 return Fcons (Fcons (key, value), alist);
1433 } 1435 }
1434 1436
1435 Lisp_Object 1437 Lisp_Object
4193 stats_list = OBJECT_PROPERTY (object, memusage_stats_list); 4195 stats_list = OBJECT_PROPERTY (object, memusage_stats_list);
4194 4196
4195 xzero (object_stats); 4197 xzero (object_stats);
4196 lisp_object_storage_size (object, &object_stats); 4198 lisp_object_storage_size (object, &object_stats);
4197 4199
4198 val = acons (Qobject_actually_requested, 4200 val = Facons (Qobject_actually_requested,
4199 make_int (object_stats.was_requested), val); 4201 make_int (object_stats.was_requested), val);
4200 val = acons (Qobject_malloc_overhead, 4202 val = Facons (Qobject_malloc_overhead,
4201 make_int (object_stats.malloc_overhead), val); 4203 make_int (object_stats.malloc_overhead), val);
4202 assert (!object_stats.dynarr_overhead); 4204 assert (!object_stats.dynarr_overhead);
4203 assert (!object_stats.gap_overhead); 4205 assert (!object_stats.gap_overhead);
4204 4206
4205 if (!NILP (stats_list)) 4207 if (!NILP (stats_list))
4206 { 4208 {
4207 xzero (gustats); 4209 xzero (gustats);
4208 MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats)); 4210 MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats));
4209 4211
4210 val = Fcons (Qt, val); 4212 val = Fcons (Qt, val);
4211 val = acons (Qother_memory_actually_requested, 4213 val = Facons (Qother_memory_actually_requested,
4212 make_int (gustats.u.was_requested), val); 4214 make_int (gustats.u.was_requested), val);
4213 val = acons (Qother_memory_malloc_overhead, 4215 val = Facons (Qother_memory_malloc_overhead,
4214 make_int (gustats.u.malloc_overhead), val); 4216 make_int (gustats.u.malloc_overhead), val);
4215 if (gustats.u.dynarr_overhead) 4217 if (gustats.u.dynarr_overhead)
4216 val = acons (Qother_memory_dynarr_overhead, 4218 val = Facons (Qother_memory_dynarr_overhead,
4217 make_int (gustats.u.dynarr_overhead), val); 4219 make_int (gustats.u.dynarr_overhead), val);
4218 if (gustats.u.gap_overhead) 4220 if (gustats.u.gap_overhead)
4219 val = acons (Qother_memory_gap_overhead, 4221 val = Facons (Qother_memory_gap_overhead,
4220 make_int (gustats.u.gap_overhead), val); 4222 make_int (gustats.u.gap_overhead), val);
4221 val = Fcons (Qnil, val); 4223 val = Fcons (Qnil, val);
4222 4224
4223 i = 0; 4225 i = 0;
4224 { 4226 {
4225 LIST_LOOP_2 (item, stats_list) 4227 LIST_LOOP_2 (item, stats_list)
4226 { 4228 {
4227 if (NILP (item) || EQ (item, Qt)) 4229 if (NILP (item) || EQ (item, Qt))
4228 val = Fcons (item, val); 4230 val = Fcons (item, val);
4229 else 4231 else
4230 { 4232 {
4231 val = acons (item, make_int (gustats.othervals[i]), val); 4233 val = Facons (item, make_int (gustats.othervals[i]), val);
4232 i++; 4234 i++;
4233 } 4235 }
4234 } 4236 }
4235 } 4237 }
4236 } 4238 }
5697 DEFSYMBOL (Qother_memory_gap_overhead); 5699 DEFSYMBOL (Qother_memory_gap_overhead);
5698 #endif /* MEMORY_USAGE_STATS */ 5700 #endif /* MEMORY_USAGE_STATS */
5699 5701
5700 DEFSUBR (Fcons); 5702 DEFSUBR (Fcons);
5701 DEFSUBR (Flist); 5703 DEFSUBR (Flist);
5704 DEFSUBR (Facons);
5702 DEFSUBR (Fvector); 5705 DEFSUBR (Fvector);
5703 DEFSUBR (Fbit_vector); 5706 DEFSUBR (Fbit_vector);
5704 DEFSUBR (Fmake_byte_code); 5707 DEFSUBR (Fmake_byte_code);
5705 DEFSUBR (Fmake_list); 5708 DEFSUBR (Fmake_list);
5706 DEFSUBR (Fmake_vector); 5709 DEFSUBR (Fmake_vector);