Turn on DTD checking and differentiate error messages.

While there was a definition for the pre-bigvm case, with 24-bit
pointers, for byteswapped (little-endian) systems, there was no
structure definition for the bigvm case, with 28-bit pointers.

bin/makefile-darwin.aarch64-x

@@ -16,8 +16,8 @@ XFILES = $(OBJECTDIR)xmkicon.o \
 XFLAGS = -I/opt/X11/include -DXWINDOW
 
 # OPTFLAGS is normally -O2.
-OPTFLAGS =  -O2
+OPTFLAGS = -g -O2
-DEBUGFLAGS = # -DDEBUG -DOPTRACE
+DEBUGFLAGS = -DARRAYCHECK -DDTDDEBUG # -DDEBUG -DOPTRACE
 DFLAGS = $(DEBUGFLAGS) $(XFLAGS) -DRELEASE=351
 
 LDFLAGS = -L/opt/X11/lib -lX11 -lm

bin/makefile-darwin.x86_64-x

@@ -17,7 +17,7 @@ XFLAGS = -I/opt/X11/include -DXWINDOW
 
 # OPTFLAGS is normally -O2.
 OPTFLAGS =  -O1 -g
-DEBUGFLAGS = # -DDEBUG -DOPTRACE
+DEBUGFLAGS = -DARRAYCHECK -DDTDDEBUG # -DDEBUG -DOPTRACE
 DFLAGS = $(DEBUGFLAGS) $(XFLAGS) -DRELEASE=351
 
 LDFLAGS = -L/opt/X11/lib -lX11 -lm

inc/adr68k.h

@@ -28,11 +28,19 @@
 */
 /**********************************************************************/
 
+#include <execinfo.h>
 #include <stddef.h>
 #include <stdio.h>
 #include "lispemul.h"
 #include "lspglob.h"
 
+static inline void dobacktrace()
+{
+  void* callstack[128];
+  int i, frames = backtrace(callstack, 128);
+  backtrace_symbols_fd(callstack, frames, 2);
+}
+
 static inline LispPTR LAddrFromNative(void *NAddr)
 {
   if ((uintptr_t)NAddr & 1) {
@@ -48,8 +56,9 @@ static inline DLword *NativeAligned2FromLAddr(LispPTR LAddr)
 
 static inline LispPTR *NativeAligned4FromLAddr(LispPTR LAddr)
 {
-  if (LAddr & 1) {
+  if (LAddr & 1 || LAddr > 0x0FFFFFFF) {
-    printf("Misaligned pointer in NativeAligned4FromLAddr 0x%x\n", LAddr);
+    printf("Misaligned/bad pointer in NativeAligned4FromLAddr 0x%x\n", LAddr);
+    dobacktrace();
   }
   return (void *)(Lisp_world + LAddr);
 }

src/gcfinal.c

@@ -97,6 +97,18 @@ struct buf {
 };
 #endif /* BIGVM */
 #else
+#ifdef BIGVM
+struct buf {
+  LispPTR filepage;
+  LispPTR vmempage;
+  LispPTR buffernext;
+  unsigned sysnext : 28;
+  unsigned unused : 1;
+  unsigned iodirty : 1;
+  unsigned usermapped : 1;
+  unsigned noreference : 1;
+};
+#else
 struct buf {
   LispPTR filepage;
   LispPTR vmempage;
@@ -107,6 +119,7 @@ struct buf {
   unsigned usermapped : 1;
   unsigned noreference : 1;
 };
+#endif /* BIGVM */
 #endif /* BYTESWAP */
 
 /************* The following procedure is common !! **************************/
@@ -143,8 +156,10 @@ LispPTR findptrsbuffer(LispPTR ptr) {
   while (LAddrFromNative(bptr) != NIL) {
     if (ptr == bptr->vmempage)
       return (LAddrFromNative(bptr));
-    else
+    else {
+      if (bptr->sysnext & 0xF0000000) printf("findptrsbuffer: would have failed %p 0x%X\n", bptr, bptr->sysnext);
       bptr = (struct buf *)NativeAligned4FromLAddr(bptr->sysnext);
+    }
   }
   return (NIL);
 }
@@ -192,8 +207,6 @@ LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist) {
   {
     bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
     btrailer = (struct arrayblock *)NativeAligned4FromLAddr(Trailer(base, bbase));
-    bfwd = (struct arrayblock *)NativeAligned4FromLAddr(bbase->fwd);
-    bbwd = (struct arrayblock *)NativeAligned4FromLAddr(bbase->bkwd);
     if (bbase->password != ARRAYBLOCKPASSWORD) {
       printarrayblock(base);
       error("ARRAYBLOCK password wrong\n");
@@ -215,7 +228,10 @@ LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist) {
     } else if (!onfreelist || (bbase->arlen < MINARRAYBLOCKSIZE))
       /* Remaining tests only for free list. */
       return (NIL);
-    else if ((bbwd->fwd != base) || (bfwd->bkwd != base)) {
+
+    bfwd = (struct arrayblock *)NativeAligned4FromLAddr(bbase->fwd);
+    bbwd = (struct arrayblock *)NativeAligned4FromLAddr(bbase->bkwd);
+    if ((bbwd->fwd != base) || (bfwd->bkwd != base)) {
       error("ARRAYBLOCK links fouled\n");
     } else {
       fbl = FreeBlockChainN(bbase->arlen);

src/mkcell.c

@@ -72,7 +72,7 @@ retry:
     if (917505 == *(LispPTR *)ptr) error("N_OP_createcell E0001 error");
     /* replace dtd_free with newcell's top DLword (it may keep next chain)*/
     dtd68k->dtd_free = (*((LispPTR *)ptr)) & POINTERMASK;
-    if (dtd68k->dtd_free & 0x8000001) error("bad entry on free chain.");
+    if (dtd68k->dtd_free & 0x8000001) error("bad entry on free chain(1).");
 
     dtd68k->dtd_oldcnt++;
 
@@ -84,7 +84,7 @@ retry:
     return (tos);
   } else {
     dtd68k->dtd_free = initmdspage(alloc_mdspage(dtd68k->dtd_typeentry), dtd68k->dtd_size, NIL);
-    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain.");
+    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain(2).");
     goto retry;
   }
 
@@ -119,7 +119,7 @@ retry:
 
     /* replace dtd_free with newcell's top DLword (it may keep next chain)*/
     dtd68k->dtd_free = (*((LispPTR *)ptr)) & POINTERMASK;
-    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain.");
+    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain(3).");
 
 #ifdef DTDDEBUG
     if ((dtd68k->dtd_free != 0) && (type != GetTypeNumber(dtd68k->dtd_free)))
@@ -144,7 +144,7 @@ retry:
 
   } else {
     dtd68k->dtd_free = initmdspage(alloc_mdspage(dtd68k->dtd_typeentry), dtd68k->dtd_size, NIL);
-    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain.");
+    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain(4).");
 
 #ifdef DTDDEBUG
     check_dtd_chain(type);