- /* Check that the object pointed to is consistent with the pointer
- * low tag. */
- switch (LowtagOf((lispobj)pointer)) {
- case type_FunctionPointer:
- /* Start_addr should be the enclosing code object, or a closure
- * header. */
- switch (TypeOf(*start_addr)) {
- case type_CodeHeader:
- /* This case is probably caught above. */
- break;
- case type_ClosureHeader:
- case type_FuncallableInstanceHeader:
- case type_ByteCodeFunction:
- case type_ByteCodeClosure:
- if ((int)pointer != ((int)start_addr+type_FunctionPointer)) {
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wf2: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
- }
- break;
- default:
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wf3: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
- }
- break;
- case type_ListPointer:
- if ((int)pointer != ((int)start_addr+type_ListPointer)) {
- if (pointer_filter_verbose)
- fprintf(stderr,"*Wl1: %x %x %x\n", pointer, start_addr, *start_addr);
- return 0;
- }
- /* Is it plausible cons? */
- if((Pointerp(start_addr[0])
- || ((start_addr[0] & 3) == 0) /* fixnum */
- || (TypeOf(start_addr[0]) == type_BaseChar)
- || (TypeOf(start_addr[0]) == type_UnboundMarker))
- && (Pointerp(start_addr[1])
- || ((start_addr[1] & 3) == 0) /* fixnum */
- || (TypeOf(start_addr[1]) == type_BaseChar)
- || (TypeOf(start_addr[1]) == type_UnboundMarker))) {
- break;
- } else {
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wl2: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
- }
- case type_InstancePointer:
- if ((int)pointer != ((int)start_addr+type_InstancePointer)) {
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wi1: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
- }
- if (TypeOf(start_addr[0]) != type_InstanceHeader) {
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wi2: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
- }
- break;
- case type_OtherPointer:
- if ((int)pointer != ((int)start_addr+type_OtherPointer)) {
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo1: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
- }
- /* Is it plausible? Not a cons. X should check the headers. */
- if(Pointerp(start_addr[0]) || ((start_addr[0] & 3) == 0)) {
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo2: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
- }
- switch (TypeOf(start_addr[0])) {
- case type_UnboundMarker:
- case type_BaseChar:
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo3: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
-
- /* only pointed to by function pointers? */
- case type_ClosureHeader:
- case type_FuncallableInstanceHeader:
- case type_ByteCodeFunction:
- case type_ByteCodeClosure:
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo4: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
-
- case type_InstanceHeader:
- if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo5: %x %x %x\n", pointer, start_addr, *start_addr);
- }
- return 0;
-
- /* the valid other immediate pointer objects */
- case type_SimpleVector:
- case type_Ratio:
- case type_Complex:
-#ifdef type_ComplexSingleFloat
- case type_ComplexSingleFloat:
-#endif
-#ifdef type_ComplexDoubleFloat
- case type_ComplexDoubleFloat:
-#endif
-#ifdef type_ComplexLongFloat
- case type_ComplexLongFloat:
-#endif
- case type_SimpleArray:
- case type_ComplexString:
- case type_ComplexBitVector:
- case type_ComplexVector:
- case type_ComplexArray:
- case type_ValueCellHeader:
- case type_SymbolHeader:
- case type_Fdefn:
- case type_CodeHeader:
- case type_Bignum:
- case type_SingleFloat:
- case type_DoubleFloat:
-#ifdef type_LongFloat
- case type_LongFloat:
-#endif
- case type_SimpleString:
- case type_SimpleBitVector:
- case type_SimpleArrayUnsignedByte2:
- case type_SimpleArrayUnsignedByte4:
- case type_SimpleArrayUnsignedByte8:
- case type_SimpleArrayUnsignedByte16:
- case type_SimpleArrayUnsignedByte32:
-#ifdef type_SimpleArraySignedByte8
- case type_SimpleArraySignedByte8:
-#endif
-#ifdef type_SimpleArraySignedByte16
- case type_SimpleArraySignedByte16:
-#endif
-#ifdef type_SimpleArraySignedByte30
- case type_SimpleArraySignedByte30:
-#endif
-#ifdef type_SimpleArraySignedByte32
- case type_SimpleArraySignedByte32:
-#endif
- case type_SimpleArraySingleFloat:
- case type_SimpleArrayDoubleFloat:
-#ifdef type_SimpleArrayLongFloat
- case type_SimpleArrayLongFloat:
-#endif
-#ifdef type_SimpleArrayComplexSingleFloat
- case type_SimpleArrayComplexSingleFloat:
-#endif
-#ifdef type_SimpleArrayComplexDoubleFloat
- case type_SimpleArrayComplexDoubleFloat:
-#endif
-#ifdef type_SimpleArrayComplexLongFloat
- case type_SimpleArrayComplexLongFloat:
-#endif
- case type_Sap:
- case type_WeakPointer:
- break;
+ /* Check that the object pointed to is consistent with the pointer
+ * low tag. */
+ switch (lowtag_of((lispobj)pointer)) {
+ case FUN_POINTER_LOWTAG:
+ /* Start_addr should be the enclosing code object, or a closure
+ * header. */
+ switch (widetag_of(*start_addr)) {
+ case CODE_HEADER_WIDETAG:
+ /* This case is probably caught above. */
+ break;
+ case CLOSURE_HEADER_WIDETAG:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
+ if ((long)pointer != ((long)start_addr+FUN_POINTER_LOWTAG)) {
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wf2: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;
+ }
+ break;
+ default:
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wf3: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;
+ }
+ break;
+ case LIST_POINTER_LOWTAG:
+ if ((long)pointer != ((long)start_addr+LIST_POINTER_LOWTAG)) {
+ if (pointer_filter_verbose)
+ fprintf(stderr,"*Wl1: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ return 0;
+ }
+ /* Is it plausible cons? */
+ if ((is_lisp_pointer(start_addr[0])
+ || ((start_addr[0] & FIXNUM_TAG_MASK) == 0) /* fixnum */
+ || (widetag_of(start_addr[0]) == CHARACTER_WIDETAG)
+#if N_WORD_BITS == 64
+ || (widetag_of(start_addr[0]) == SINGLE_FLOAT_WIDETAG)
+#endif
+ || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
+ && (is_lisp_pointer(start_addr[1])
+ || ((start_addr[1] & FIXNUM_TAG_MASK) == 0) /* fixnum */
+ || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG)
+#if N_WORD_BITS == 64
+ || (widetag_of(start_addr[1]) == SINGLE_FLOAT_WIDETAG)
+#endif
+ || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) {
+ break;
+ } else {
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wl2: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;
+ }
+ case INSTANCE_POINTER_LOWTAG:
+ if ((long)pointer != ((long)start_addr+INSTANCE_POINTER_LOWTAG)) {
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wi1: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;
+ }
+ if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) {
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wi2: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;
+ }
+ break;
+ case OTHER_POINTER_LOWTAG:
+ if ((long)pointer != ((long)start_addr+OTHER_POINTER_LOWTAG)) {
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wo1: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;
+ }
+ /* Is it plausible? Not a cons. XXX should check the headers. */
+ if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & FIXNUM_TAG_MASK) == 0)) {
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wo2: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;
+ }
+ switch (widetag_of(start_addr[0])) {
+ case UNBOUND_MARKER_WIDETAG:
+ case CHARACTER_WIDETAG:
+#if N_WORD_BITS == 64
+ case SINGLE_FLOAT_WIDETAG:
+#endif
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wo3: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;
+
+ /* only pointed to by function pointers? */
+ case CLOSURE_HEADER_WIDETAG:
+ case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
+ if (pointer_filter_verbose) {
+ fprintf(stderr,"*Wo4: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
+ }
+ return 0;