Assignments embedded in if-condition are not a good idea.

The forward and backward pointers in an array block only contain
    valid pointer values when the block is free therefore avoid
    producing native addresses from these fields if the block is in use.

Add comments regarding the operation of the array block merging code
    Array block merging will produce a single block if possible,
    otherwise it will produce two blocks with one as large as possible
    and the other no less than the minimum block size.

Rewrite the checks in array block merge forward to minimize unnecessary field accesses

CMakeLists.txt

@@ -18,7 +18,7 @@ ENDIF()
 
 find_program(
     CLANG_TIDY_EXE
-    NAMES "clang-tidy" "clang-tidy13" "clang-tidy12" "clang-tidy11" "clang-tidy10"
+    NAMES "clang-tidy" "clang-tidy16" "clang-tidy15" "clang-tidy14" "clang-tidy13" "clang-tidy12" "clang-tidy11" "clang-tidy10"
     DOC "Path to clang-tidy executable"
 )
 
@@ -41,6 +41,10 @@ SET(MAIKO_DEFINITIONS
     "-DRELEASE=351"
 )
 
+SET(MAIKO_INIT_DEFINITIONS
+    "-DRELEASE=351" "-DINIT" "-DNOVERSION"
+)
+
 OPTION(MAIKO_DISPLAY_X11 "Use X11 for display." ON)
 OPTION(MAIKO_DISPLAY_SDL "Use SDL for display." OFF)
 
@@ -454,6 +458,18 @@ IF(MAIKO_DISPLAY_X11)
   TARGET_COMPILE_DEFINITIONS(ldex PUBLIC ${MAIKO_DEFINITIONS} ${MAIKO_DISPLAY_X11_DEFINITIONS})
   TARGET_INCLUDE_DIRECTORIES(ldex PUBLIC inc)
   TARGET_LINK_LIBRARIES(ldex ${MAIKO_LIBRARIES} ${MAIKO_DISPLAY_X11_LIBRARIES})
+
+  ADD_EXECUTABLE(ldeinit
+    src/main.c
+    vdate.c
+    ${MAIKO_SRCS}
+    ${MAIKO_HDRS}
+    ${MAIKO_DISPLAY_X11_SRCS}
+    ${MAIKO_DISPLAY_X11_HDRS}
+  )
+  TARGET_COMPILE_DEFINITIONS(ldeinit PUBLIC ${MAIKO_INIT_DEFINITIONS} ${MAIKO_DISPLAY_X11_DEFINITIONS})
+  TARGET_INCLUDE_DIRECTORIES(ldeinit PUBLIC inc)
+  TARGET_LINK_LIBRARIES(ldeinit ${MAIKO_LIBRARIES} ${MAIKO_DISPLAY_X11_LIBRARIES})
 ENDIF()
 
 IF(MAIKO_DISPLAY_SDL)

README.md

@@ -4,7 +4,7 @@ Maiko is the implementation of the Medley Interlisp virtual machine, for a
 byte-coded Lisp instruction set and some low-level functions for
 connecting with Lisp for access to display (via X11) and disk etc.
 
-For an overview, see [Medley Interlisp Introduction](https://github.com/Interlisp/medley/wiki/Medley-Interlisp-Introduction).
+For an overview, see [Medley Interlisp Introduction](https://interlisp.org/medley/using/docs/medley/).
 
 See [the Medley repository](https://github.com/Interlisp/medley) for
 * [Issues](https://github.com/Interlisp/medley/issues) (note that maiko issues are there too)

bin/machinetype

@@ -9,7 +9,8 @@
 #									#
 #########################################################################
 
-os=${LDEARCH:-`./config.guess`}
+SCRIPTPATH="$( cd "$(dirname "$0")" >/dev/null 2>&1 ; pwd -P )"
+os=${LDEARCH:-`$SCRIPTPATH/config.guess`}
 # o/s switch block
 case "$os" in
         m68k-*)		      echo m68k ;;

bin/makefile-darwin.aarch64-x

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

bin/makefile-init-linux.aarch64

@@ -0,0 +1,29 @@
+# Options for Linux, aarch64 processor, X windows, for INIT processing
+
+CC = gcc $(GCC_CFLAGS)
+#CC = clang $(CLANG_CFLAGS)
+
+XFILES = $(OBJECTDIR)xmkicon.o \
+	$(OBJECTDIR)xbbt.o \
+	$(OBJECTDIR)dspif.o \
+	$(OBJECTDIR)xinit.o \
+	$(OBJECTDIR)xscroll.o \
+	$(OBJECTDIR)xcursor.o \
+	$(OBJECTDIR)xlspwin.o \
+	$(OBJECTDIR)xrdopt.o \
+	$(OBJECTDIR)xwinman.o
+
+
+XFLAGS = -DXWINDOW
+
+# OPTFLAGS is normally -O2, for INIT we want unoptimized in case we need to debug it
+OPTFLAGS =  -O0 -g
+DEBUGFLAGS =
+DFLAGS = $(DEBUGFLAGS) $(XFLAGS) -DRELEASE=351 -DNOVERSION -DINIT
+
+LDFLAGS = -L/usr/X11/lib -lX11 -lc -lm
+LDELDFLAGS =  -L/usr/X11/lib -lX11 -lc -lm
+
+OBJECTDIR = ../$(RELEASENAME)/
+
+default	: ../$(OSARCHNAME)/ldeinit

bin/makefile-init-linux.x86_64

@@ -1,7 +1,7 @@
 # Options for Linux, x86 processor, X windows, for INIT processing
 
-#CC = gcc -m64 $(GCC_CFLAGS)
-CC = clang -m64 $(CLANG_CFLAGS)
+CC = gcc $(GCC_CFLAGS)
+#CC = clang $(CLANG_CFLAGS)
 
 XFILES = $(OBJECTDIR)xmkicon.o \
 	$(OBJECTDIR)xbbt.o \

bin/makefile-init-openbsd.x86_64

@@ -0,0 +1,27 @@
+# Options for OpenBSD, Intel x86_64 and X-Window
+
+CC = clang -m64 $(CLANG_CFLAGS)
+
+XFILES = $(OBJECTDIR)xmkicon.o \
+	$(OBJECTDIR)xbbt.o \
+	$(OBJECTDIR)dspif.o \
+	$(OBJECTDIR)xinit.o \
+	$(OBJECTDIR)xscroll.o \
+	$(OBJECTDIR)xcursor.o \
+	$(OBJECTDIR)xlspwin.o \
+	$(OBJECTDIR)xrdopt.o \
+	$(OBJECTDIR)xwinman.o
+
+
+XFLAGS = -I/usr/X11R6/include -DXWINDOW
+
+# OPTFLAGS is normally -O2.
+OPTFLAGS =  -O2 -g3
+DFLAGS = $(XFLAGS) -DRELEASE=351 -DNOVERSION -DINIT
+
+LDFLAGS = -L/usr/X11R6/lib -lX11 -lc -lm
+LDELDFLAGS =  -L/usr/X11R6/lib -lX11 -lc -lm
+
+OBJECTDIR = ../$(RELEASENAME)/
+
+default	: ../$(OSARCHNAME)/ldeinit

bin/makefile-linux.aarch64-x

@@ -1,4 +1,4 @@
-# Options for Linux, ARMv7 and X-Window
+# Options for Linux, aarch64 and X-Window
 
 CC = gcc $(GCC_CFLAGS)
 #CC = clang $(CLANG_CFLAGS)

bin/osversion

@@ -1,5 +1,6 @@
 #!/bin/sh
-os=${LDEARCH:-`./config.guess`}
+SCRIPTPATH="$( cd "$(dirname "$0")" >/dev/null 2>&1 ; pwd -P )"
+os=${LDEARCH:-`$SCRIPTPATH/config.guess`}
 case "$os" in
         m68k-*-amigaos)		echo amigaos ;;
         sparc-sun-sunos*)	echo sunos4 ;;

inc/adr68k.h

@@ -28,19 +28,11 @@
 */
 /**********************************************************************/
 
-#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) {
@@ -56,9 +48,8 @@ static inline DLword *NativeAligned2FromLAddr(LispPTR LAddr)
 
 static inline LispPTR *NativeAligned4FromLAddr(LispPTR LAddr)
 {
-  if (LAddr & 1 || LAddr > 0x0FFFFFFF) {
-    printf("Misaligned/bad pointer in NativeAligned4FromLAddr 0x%x\n", LAddr);
-    dobacktrace();
+  if (LAddr & 1) {
+    printf("Misaligned pointer in NativeAligned4FromLAddr 0x%x\n", LAddr);
   }
   return (void *)(Lisp_world + LAddr);
 }

src/dir.c

@@ -2150,7 +2150,8 @@ LispPTR COM_next_file(LispPTR *args)
   propp = gfsp->propp;
 
   dfp = &FinfoArray[finfoid];
-  if (dfp->head == (FINFO *)0 || (fp = dfp->next) == (FINFO *)0) return (SMALLP_MINUSONE);
+  fp = dfp->next;
+  if (dfp->head == NULL || fp == NULL) return (SMALLP_MINUSONE);
   dfp->next = fp->next;
 
   laddr = gfsp->name;

src/gcfinal.c

@@ -156,10 +156,8 @@ LispPTR findptrsbuffer(LispPTR ptr) {
   while (LAddrFromNative(bptr) != NIL) {
     if (ptr == bptr->vmempage)
       return (LAddrFromNative(bptr));
-    else {
-      if (bptr->sysnext & 0xF0000000) printf("findptrsbuffer: would have failed %p 0x%X\n", bptr, bptr->sysnext);
+    else
       bptr = (struct buf *)NativeAligned4FromLAddr(bptr->sysnext);
-    }
   }
   return (NIL);
 }
@@ -226,9 +224,8 @@ LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist) {
       printarrayblock(base);
       error("ARRAYBLOCK Trailer INUSE bit set wrong\n");
     } else if (!onfreelist || (bbase->arlen < MINARRAYBLOCKSIZE))
-      /* Remaining tests only for free list. */
       return (NIL);
-
+    /* Remaining tests only for free list. */
     bfwd = (struct arrayblock *)NativeAligned4FromLAddr(bbase->fwd);
     bbwd = (struct arrayblock *)NativeAligned4FromLAddr(bbase->bkwd);
     if ((bbwd->fwd != base) || (bfwd->bkwd != base)) {
@@ -353,7 +350,6 @@ LispPTR makefreearrayblock(LispPTR block, DLword length) {
 /*									*/
 /*									*/
 /************************************************************************/
-
 LispPTR arrayblockmerger(LispPTR base, LispPTR nbase) {
   DLword arlens, narlens, secondbite, minblocksize, shaveback;
   struct arrayblock *bbase, *bnbase;
@@ -362,12 +358,23 @@ LispPTR arrayblockmerger(LispPTR base, LispPTR nbase) {
   arlens = bbase->arlen;
   narlens = bnbase->arlen;
   secondbite = MAXARRAYBLOCKSIZE - arlens;
-  if (narlens > secondbite) {
+  /* There are three cases for merging the blocks
+   * (1) the total size of the two blocks is less than max:
+   *     merge into a single block
+   * (2) creating a max size block leaves a viable leftover block:
+   *     move the boundary to make a max block and a leftover block
+   * (3) creating a max size block leaves a non-viable leftover block
+   *     move the boundary to make a big block and a minimum size leftover block
+   */
+  if (base + (2 * arlens) != nbase) {
+    error("Attempt to merge non-adjacent blocks in array space\n");
+  }
+  if (narlens > secondbite) { /* (2) or (3) */
     arlens = MAXARRAYBLOCKSIZE;
     narlens = narlens - secondbite;
     minblocksize =
         ((*Hunk_word == ATOM_T) ? (ARRAYBLOCKOVERHEADCELLS + MAXCELLSPERHUNK) : MINARRAYBLOCKSIZE);
-    if (narlens < minblocksize) {
+    if (narlens < minblocksize) { /* (3) */
       shaveback = narlens - minblocksize;
       narlens = minblocksize;
       arlens += shaveback;
@@ -391,10 +398,10 @@ LispPTR mergebackward(LispPTR base) {
   LispPTR pbase;
   struct arrayblock *ptrailer;
 
-  ptrailer = (struct arrayblock *)NativeAligned4FromLAddr(base - ARRAYBLOCKTRAILERWORDS);
   if (base == NIL)
     return (NIL);
-  else if ((*ArrayMerging_word == NIL) ||
+  ptrailer = (struct arrayblock *)NativeAligned4FromLAddr(base - ARRAYBLOCKTRAILERWORDS);
+  if ((*ArrayMerging_word == NIL) ||
            ((base == *ArraySpace_word) || ((base == *ArraySpace2_word) || (ptrailer->inuse == T))))
     return (linkblock(base));
   pbase = base - 2 * ptrailer->arlen;
@@ -414,16 +421,18 @@ LispPTR mergebackward(LispPTR base) {
 LispPTR mergeforward(LispPTR base) {
   LispPTR nbase, nbinuse;
   struct arrayblock *bbase, *bnbase;
+  if (*ArrayMerging_word == NIL) return NIL;
+  if (base == NIL) return NIL;
+  if (checkarrayblock(base, T, T)) return NIL;
+
   bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
   nbase = base + 2 * (bbase->arlen);
+  if (nbase == *ArrayFrLst_word || nbase == *ArrayFrLst2_word) return NIL;
+
   bnbase = (struct arrayblock *)NativeAligned4FromLAddr(nbase);
-  if ((*ArrayMerging_word == NIL) ||
-      ((base == NIL) ||
-       (checkarrayblock(base, T, T) ||
-        ((nbase == *ArrayFrLst_word) ||
-         ((nbase == *ArrayFrLst2_word) ||
-          (checkarrayblock(nbase, (!(nbinuse = bnbase->inuse)), NIL) || nbinuse))))))
-    return (NIL);
+  nbinuse = bnbase->inuse;
+  if (checkarrayblock(nbase, !nbinuse, NIL)) return NIL;
+  if (nbinuse) return (NIL);
   deleteblock(nbase);
   deleteblock(base);
   return (arrayblockmerger(base, nbase));

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(1).");
+    if (dtd68k->dtd_free & 0x8000001) error("bad entry on free chain.");
 
     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(2).");
+    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain.");
     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(3).");
+    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain.");
 
 #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(4).");
+    if (dtd68k->dtd_free & 0x8000000) error("bad entry on free chain.");
 
 #ifdef DTDDEBUG
     check_dtd_chain(type);

src/vmemsave.c

@@ -531,5 +531,5 @@ void lisp_finish(void) {
 #ifdef DOS
   exit_host_filesystem();
 #endif /* DOS */
-  exit(1);
+  exit(0);
 }

src/xwinman.c

@@ -188,6 +188,7 @@ void process_Xevents(DspInterface dsp)
     XNextEvent(dsp->display_id, &report);
     if (report.xany.window == dsp->DisplayWindow) /* Try the most important window first. */
       switch (report.type) {
+#ifndef INIT
         case MotionNotify:
           *CLastUserActionCell68k = MiscStats->secondstmp;
           *EmCursorX68K = (*((DLword *)EmMouseX68K)) =
@@ -235,6 +236,7 @@ void process_Xevents(DspInterface dsp)
           break;
         case EnterNotify: Mouse_Included = TRUE; break;
         case LeaveNotify: Mouse_Included = FALSE; break;
+#endif
         case Expose:
           (dsp->bitblt_to_screen)(dsp, 0, report.xexpose.x + dsp->Visible.x,
                                   report.xexpose.y + dsp->Visible.y, report.xexpose.width,