# HG changeset patch # User Kim F. Storm # Date 1131578052 0 # Node ID 25bf8ea8284338ccea0d0695ba135ebe30a866ad # Parent 2acb0afcc57a5360464bf18c36c3e4540141877e (valid_lisp_object_p): New function to validate that an object is really a valid Lisp_Object. diff -r 2acb0afcc57a -r 25bf8ea82843 src/alloc.c --- a/src/alloc.c Wed Nov 09 23:13:56 2005 +0000 +++ b/src/alloc.c Wed Nov 09 23:14:12 2005 +0000 @@ -4484,10 +4484,79 @@ #endif } - #endif /* GC_MARK_STACK != 0 */ + +/* Return 1 if OBJ is a valid lisp object. + Return 0 if OBJ is NOT a valid lisp object. + Return -1 if we cannot validate OBJ. +*/ + +int +valid_lisp_object_p (obj) + Lisp_Object obj; +{ +#if !GC_MARK_STACK + /* Cannot determine this. */ + return -1; +#else + void *p; + struct mem_node *m; + + if (INTEGERP (obj)) + return 1; + + p = (void *) XPNTR (obj); + + if (PURE_POINTER_P (p)) + return 1; + + m = mem_find (p); + + if (m == MEM_NIL) + return 0; + + switch (m->type) + { + case MEM_TYPE_NON_LISP: + return 0; + + case MEM_TYPE_BUFFER: + return live_buffer_p (m, p); + + case MEM_TYPE_CONS: + return live_cons_p (m, p); + + case MEM_TYPE_STRING: + return live_string_p (m, p); + + case MEM_TYPE_MISC: + return live_misc_p (m, p); + + case MEM_TYPE_SYMBOL: + return live_symbol_p (m, p); + + case MEM_TYPE_FLOAT: + return live_float_p (m, p); + + case MEM_TYPE_VECTOR: + case MEM_TYPE_PROCESS: + case MEM_TYPE_HASH_TABLE: + case MEM_TYPE_FRAME: + case MEM_TYPE_WINDOW: + return live_vector_p (m, p); + + default: + break; + } + + return 0; +#endif +} + + + /*********************************************************************** Pure Storage Management @@ -4967,7 +5036,7 @@ total += total_floats * sizeof (struct Lisp_Float); total += total_intervals * sizeof (struct interval); total += total_strings * sizeof (struct Lisp_String); - + gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage); } else