Merge branch 'master' into fix-hashtable-delete

.circleci/config.yml

@@ -6,7 +6,7 @@ references:
       name: Setup TeX
       command: |-
         sudo apt-get update
-        sudo apt-get install -qq -y texlive-latex-base ptex-bin latex2html nkf poppler-utils
+        sudo apt-get install -qq -y texlive-latex-base texlive-binaries texlive-lang-japanese latex2html nkf poppler-utils
   setup-eus: &setup-eus
     run:
       name: Setup EusLisp
@@ -24,7 +24,8 @@ references:
 
 jobs:
   html:
-    machine: true
+    machine:
+      image: ubuntu-2004:2022.07.1
     steps:
       - checkout
       - *setup-tex
@@ -41,19 +42,20 @@ jobs:
           command: |
             mkdir -p /tmp/html
             cp doc/html/*manual*.html /tmp/html
-            cp doc/html/*manual*.png /tmp/html
+            cp doc/html/*manual*.svg /tmp/html
       - store_artifacts:
           path: /tmp/html
       - persist_to_workspace:
           root: doc
           paths:
             - html/manual*.html
             - html/jmanual*.html
-            - html/manual*.png
-            - html/jmanual*.png
+            - html/manual*.svg
+            - html/jmanual*.svg
 
   latex:
-    machine: true
+    machine:
+      image: ubuntu-2004:2022.07.1
     steps:
       - checkout
       - *setup-tex
@@ -73,7 +75,8 @@ jobs:
           root: doc/latex
           paths: manual.pdf
   jlatex:
-    machine: true
+    machine:
+      image: ubuntu-2004:2022.07.1
     steps:
       - checkout
       - *setup-tex
@@ -93,13 +96,11 @@ jobs:
           root: doc/jlatex/
           paths: jmanual.pdf
   rst:
-    machine: true
+    machine:
+      image: ubuntu-2004:2022.07.1
     steps:
       - checkout
       - *setup-tex
-      - run:
-          name: Install Python3
-          command: pyenv global system 3.5.2
       - run:
           name: Install Pandoc
           command: sudo apt-get install -y -qq pandoc
@@ -142,7 +143,7 @@ jobs:
             git diff origin/master --name-only --relative doc
             if [ "`git diff origin/master  --name-only --relative doc`" == "" ]; then echo "No update in doc directory found, exitting... ";  circleci step halt; fi
             echo "Found new commit on doc directory"
-      - run: cd .circleci/ && git clone https://github.com/themadcreator/circle-github-bot.git
+      - run: cd .circleci/ && git clone https://github.com/k-okada/circle-github-bot.git
       - run: cd .circleci/circle-github-bot && npm install
       - run: cd .circleci/circle-github-bot && npm run build
       - run: .circleci/github-pr-update.js

.github/workflows/config.yml

@@ -64,7 +64,7 @@ jobs:
           # sparc64
       fail-fast: false
 
-    runs-on: ubuntu-18.04
+    runs-on: ubuntu-latest
     timeout-minutes: 60
 
     name: linux
@@ -86,12 +86,44 @@ jobs:
           export MAKEFLAGS="-j4"
           if [[ "$QEMU" != "" || "$DOCKER_IMAGE" == *"arm"* ]]; then sudo apt-get update -y -qq; fi
           if [[ "$QEMU" != "" ]]; then sudo apt-get install -y -qq qemu-user-static; ls /usr/bin/qemu-*-static; export QEMU_VOLUME="-v /usr/bin/qemu-$QEMU-static:/usr/bin/qemu-$QEMU-static" ; fi
-          if [[ "$QEMU" != "" ]]; then docker run --rm --privileged multiarch/qemu-user-static:register; fi
+          if [[ "$QEMU" != "" ]]; then docker run --rm --privileged multiarch/qemu-user-static:register --reset; fi
           if [[ "$DOCKER_IMAGE" == *"arm"* ]]; then sudo apt-get install -y -qq qemu-user-static; fi
           if [[ "$DOCKER_IMAGE" == *"arm"* ]]; then git clone http://github.com/euslisp/jskeus ${HOME}/jskeus; fi
           echo "Testing branch $TRAVIS_BRANCH of $REPOSITORY_NAME on $QEMU_VOLUME"
           docker run --rm $QEMU_VOLUME -v $HOME:$HOME -e "QEMU=$QEMU" -e "TRAVIS_OS_NAME=$TRAVIS_OS_NAME" -e "CI_SOURCE_PATH=$CI_SOURCE_PATH" -e "HOME=$HOME" -e "MAKEFLAGS=$MAKEFLAGS" -e "DOCKER_IMAGE=$DOCKER_IMAGE" -t $DOCKER_IMAGE sh -c "cd $CI_SOURCE_PATH; ./.travis.sh"
 
+  debian-unstable:
+    strategy:
+      matrix:
+        include:
+          - DOCKER_IMAGE: amd64/debian:unstable-slim
+            ARCH: Linux64
+          - DOCKER_IMAGE: arm32v7/debian:unstable-slim
+            ARCH: LinuxARM
+          - DOCKER_IMAGE: arm64v8/debian:unstable-slim
+            ARCH: LinuxARM
+
+    runs-on: ubuntu-latest
+    timeout-minutes: 60
+
+    name: debian-unstale
+    steps:
+      - name: Checkout
+        uses: actions/checkout@v2
+      - name: Run test
+        shell: bash
+        run: |
+          export DOCKER_IMAGE=${{matrix.DOCKER_IMAGE}}
+          export ARCH=${{matrix.ARCH}}
+          set -x
+          sudo apt update -qq
+          # Install the qemu packages
+          # This step will execute the registering scripts
+          if [[ "$DOCKER_IMAGE" == *"arm"* ]]; then \
+            sudo apt install -y -qq qemu binfmt-support qemu-user-static; \
+            docker run --rm --privileged multiarch/qemu-user-static --reset -p yes; \
+          fi
+          docker run --rm -v $(pwd):/ws/euslisp -e "ARCH=$ARCH" -t "$DOCKER_IMAGE" bash -c "set -x; set -e; apt update -qq; apt install -y -qq make gcc libgl-dev libglu1-mesa-dev libjpeg-dev libpng-dev libpq-dev libx11-dev libxext-dev; ARCH=$ARCH EUSDIR=/ws/euslisp make -C /ws/euslisp/lisp/ -f Makefile.$ARCH eus0; CC='gcc -Werror' ARCHDIR=$ARCH EUSDIR=/ws/euslisp make -C /ws/euslisp/lisp/image/jpeg; exit 0"
 
   osx:
     runs-on: macos-latest

.travis.sh

@@ -32,6 +32,19 @@ function travis_time_end {
 if [ "$TRAVIS_OS_NAME" == "linux" ]; then 
 
     travis_time_start setup.apt-get_update
+    if [[ "$DOCKER_IMAGE" == *"stretch" || "$DOCKER_IMAGE" == *"jessie" ]] ; then
+        cat /etc/apt/sources.list
+        sed -i [email protected]@archive.debian.org@ /etc/apt/sources.list;
+        sed -i [email protected]@archive.debian.org@ /etc/apt/sources.list;
+        sed -i [email protected]/[email protected]/debian-security@ /etc/apt/sources.list
+        sed -i '/-updates/ s/^#*/#/' /etc/apt/sources.list
+    fi
+    if [[ "$DOCKER_IMAGE" == *"buster" ]] ; then
+        cat /etc/apt/sources.list
+        sed -i '[email protected]/debian [email protected]/debian buster@' /etc/apt/sources.list;
+        sed -i '/-updates/ s/^#*/#/' /etc/apt/sources.list
+        cat /etc/apt/sources.list
+    fi
     if [ ! -e /usr/bin/sudo ] ; then apt-get update && apt-get install -y sudo;  else sudo apt-get update; fi
     travis_time_end
 
@@ -42,7 +55,7 @@ if [ "$TRAVIS_OS_NAME" == "linux" ]; then
     travis_time_end
 
     travis_time_start setup.apt-get_install
-    ret=1; while [ $ret != 0 ]; do sudo apt-get install -qq -y git make gcc g++ libjpeg-dev libxext-dev libx11-dev libgl1-mesa-dev libglu1-mesa-dev libpq-dev libpng-dev xfonts-100dpi xfonts-75dpi pkg-config libbullet-dev && ret=0 || echo "failed, retry"; done # msttcorefonts could not install on 14.04 travis
+    ret=1; while [ $ret != 0 ]; do sudo apt-get install -qq -y --force-yes git make gcc g++ libjpeg-dev libxext-dev libx11-dev libgl1-mesa-dev libglu1-mesa-dev libpq-dev libpng-dev xfonts-100dpi xfonts-75dpi pkg-config libbullet-dev && ret=0 || echo "failed, retry"; done # msttcorefonts could not install on 14.04 travis
     # unset protocol version https://github.com/juju/charm-tools/issues/532
     git config --global --unset protocol.version || echo "OK"
     if [ "`uname -m`" == "x86_64" ] ; then sudo apt-get install -qq -y texlive-latex-base ptex-bin latex2html nkf poppler-utils || echo "ok"; fi # 16.04 does ont have ptex bin
@@ -67,9 +80,9 @@ if [ "$TRAVIS_OS_NAME" == "osx" ]; then
 fi
 
 ### for multiarch compile test
-if [[ "$QEMU" != "" && "$DOCKER_IMAGE" != "arm64v8/ubuntu:"* ]]; then
+if [[ "$QEMU" != "" ]]; then
     travis_time_start install.dpkg-dev
-    apt-get install -qq -y dpkg-dev patchutils
+    apt-get install -qq -y --force-yes dpkg-dev patchutils
     travis_time_end
 
     echo "uname -a : $(uname -a)"
@@ -83,8 +96,8 @@ if [[ "$QEMU" != "" && "$DOCKER_IMAGE" != "arm64v8/ubuntu:"* ]]; then
     git clone http://salsa.debian.org/science-team/euslisp /tmp/euslisp-dfsg
     for file in $(cat /tmp/euslisp-dfsg/debian/patches/series); do
         # skip patches already applied by https://github.com/euslisp/EusLisp/pull/482
-        [[ $file =~ use-rtld-global-loadelf.patch|fix-arm-ldflags.patch|fix-library-not-linked-against-libc.patch|fix-manpage-has-bad-whatis-entry-on-man-pages.patch ]] && continue;
-        # skip patch already applied by https://github.com/euslisp/EusLisp/pull/441
+        [[ $file =~ use-rtld-global-loadelf.patch|fix-arm-ldflags.patch|fix-library-not-linked-against-libc.patch|fix-manpage-has-bad-whatis-entry-on-man-pages.patch|fix-jpegmemcd-compile-error.patch ]] && continue;
+        # skip patch already applied by https://github.com/euslisp/EusLisp/pull/441, https://github.com/euslisp/EusLisp/pull/509
         if [[ $file =~  fix-for-reprotest.patch ]]; then
             filterdiff -p1 -x 'lisp/image/jpeg/makefile' -x 'lisp/comp/comp.l' < /tmp/euslisp-dfsg/debian/patches/$file > /tmp/euslisp-dfsg/debian/patches/$file-fix
             file=$file-fix
@@ -121,6 +134,9 @@ if [[ "$QEMU" != "" && "$DOCKER_IMAGE" != "arm64v8/ubuntu:"* ]]; then
 
         sed -i 's/\(i-max\ [0-9]000\)0*/\1/' $test_l
 
+	# TEST-NAME: test-copy-object-body : extending gcstack 0 -> Segfault
+        if [[ (( "$DOCKER_IMAGE" == "arm64v8/debian:buster" || "$DOCKER_IMAGE" == "arm64v8/ubuntu:focal" ) && $test_l =~ object.l ) ]]; then sed -i 's/dotimes (i 1000)/dotimes (i 10)/' $test_l; fi
+
         eusgl $test_l;
         export TMP_EXIT_STATUS=$?
 

doc/jlatex/Makefile

@@ -25,8 +25,14 @@ distclean: clean
 
 html:
 	rm -f ../html/jmanual*.
-	TRANSPARENT_COLOR="#ffffff" charset="UTF-8" latex2html -dir ../html/ -transparent -local_icons -split +3 -auto_prefix -init_file ../latex/.latex2html-init -iso_language JP -address "This document was generated using the LaTeX2HTML translator on `date` from <a href=\"http://github.com/euslisp/EusLisp.git\">EusLisp</a> version <a href=\"http://github.com/euslisp/EusLisp/commit/`git rev-parse --verify HEAD`\">`git log -1  --oneline`</a>" -html_version="4.0,unicode" jmanual
+	for psfile in fig/*.ps; do ps2eps -f -B $$psfile; done
+	sed -i.eps.bak s/\\.ps/\\.eps/g *.tex
+	(cd ../html; ln -sf ../latex/fig .)
+	TRANSPARENT_COLOR="#ffffff" charset="UTF-8" latex2html -rootdir ../html/ -transparent -local_icons -split +3 -auto_prefix -init_file ../latex/.latex2html-init -iso_language JP -address "This document was generated using the LaTeX2HTML translator on `date` from <a href=\"http://github.com/euslisp/EusLisp.git\">EusLisp</a> version <a href=\"http://github.com/euslisp/EusLisp/commit/`git rev-parse --verify HEAD`\">`git log -1  --oneline`</a>" -html_version="4.0,unicode" jmanual
 	(cd ../html; sed -i 's@"jmanual.css"@"manual.css"@' j*.html)
-	(cd ../html; for imgfile in jmanual-img*.png; do pngtopnm $$imgfile > /tmp/$$imgfile.pnm; pnmtopng -transparent white /tmp/$$imgfile.pnm > $$imgfile; done)
+	sed -i s@HREF=\"../jmanual@HREF=\"jmanual@ ../html/jmanual-node*.html
+	rm ../html/fig
+	for backup in *.eps.bak; do mv $$backup $$(basename $$backup .eps.bak); done
+	#(cd ../html; for imgfile in jmanual-img*.png; do pngtopnm $$imgfile > /tmp/$$imgfile.pnm; pnmtopng -transparent white /tmp/$$imgfile.pnm > $$imgfile; done)
 
 

doc/jlatex/jmatrix.tex

@@ -712,7 +712,7 @@ \subsubsection*{座標系を変更するメソッド}
 
 wrt == :world のとき、 $T \leftarrow AT$
 
-wrt == W (coordinates class) のとき、$T \leftarrow$ $\left( WAW \right)^{-1} T$
+wrt == W (coordinates class) のとき、$T \leftarrow$ $\left( W A W^{-1} \right) T$
 }
 
 \end{refdesc}

doc/jlatex/jsysfunc.tex

@@ -783,7 +783,10 @@ \subsection{\label{UnixProcess}UNIXプロセス}
 \begin{refdesc}
 
 \funcdesc{cd}{\&optional (dir (unix:getenv "HOME"))}{
-現在のディレクトリを変更する。}
+現在のディレクトリを変更する。{\em dir}がsymbolの場合、{\em dir}を評価せずに文字列として扱う。}
+
+\funcdesc{pwd}{}{
+現在のディレクトリを返す。}
 
 \funcdesc{ez}{\&optional key}{
 ezエディターの画面に入る。それからLisp書式を読み込み、

doc/latex/Makefile

@@ -24,9 +24,15 @@ distclean: clean
 	rm -f *.dvi *.pdf
 
 html:
-	rm -f ../html/manual*.{old,html,png,pl} ../html/manual-images.*
-	TRANSPARENT_COLOR="#ffffff" latex2html -dir ../html/ -transparent -local_icons -split +3 -auto_prefix -iso_language JP -address "This document was generated using the LaTeX2HTML translator on `date` from <a href=\"http://github.com/euslisp/EusLisp.git\">EusLisp</a> version <a href=\"http://github.com/euslisp/EusLisp/commit/`git rev-parse --verify HEAD`\">`git log -1  --oneline`</a>" -html_version="4.0,unicode" manual
-	(cd ../html; for imgfile in manual-img*.png; do pngtopnm $$imgfile > /tmp/$$imgfile.pnm; pnmtopng -transparent white /tmp/$$imgfile.pnm > $$imgfile; done)
+	rm -f ../html/manual*.{old,html,png,svg,pl} ../html/manual-images.*
+	for psfile in fig/*.ps; do ps2eps -f -B $$psfile; done
+	sed -i.eps.bak s/\\.ps/\\.eps/g *.tex
+	(cd ../html; ln -sf ../latex/fig .)
+	TRANSPARENT_COLOR="#ffffff" latex2html -rootdir ../html/ -transparent -local_icons -split +3 -auto_prefix -iso_language JP -address "This document was generated using the LaTeX2HTML translator on `date` from <a href=\"http://github.com/euslisp/EusLisp.git\">EusLisp</a> version <a href=\"http://github.com/euslisp/EusLisp/commit/`git rev-parse --verify HEAD`\">`git log -1  --oneline`</a>" -html_version="4.0,unicode" manual
+	rm ../html/fig
+	for backup in *.eps.bak; do mv $$backup $$(basename $$backup .eps.bak); done
+	sed -i s@HREF=\"../manual@HREF=\"manual@ ../html/manual-node*.html
+	#(cd ../html; for imgfile in manual-img*.png; do pngtopnm $$imgfile > /tmp/$$imgfile.pnm; pnmtopng -transparent white /tmp/$$imgfile.pnm > $$imgfile; done)
 
 latex.py:
 	wget https://raw.githubusercontent.com/jobh/latex.py/master/latex.py
@@ -36,7 +42,7 @@ TEXFILES=$(filter-out manual.tex, $(wildcard *.tex))
 RSTFILES=$(TEXFILES:%.tex=%.rst)
 %.rst : %.tex
 	python3 latex.py -2 -L preamble.tex $< > /tmp/tmp_$^
-	pandoc /tmp/tmp_$^ -o $@ -V documentclass=ltjarticle --latex-engine=lualatex
+	pandoc /tmp/tmp_$^ -o $@ -V documentclass=ltjarticle
 	sed -i 's@.. figure:: \(.*\).ps@.. figure:: \1.png@g' $@  # use png for figures
 
 PSFILES=$(wildcard fig/*.ps)
@@ -53,7 +59,7 @@ manual.rst: latex.py $(RSTFILES) $(PNGFILES)
 	sed -i 's@\\part{\(.*\)}@.. toctree:: \1@' /tmp/manual.tex  # convert \part in tex to bypass pandoc
 	sed -i ':a;/^[^%].*\\\\$$/{N;s/\\\\\n//;ba}' /tmp/manual.tex # concatinate title/author multi lines
 	sed -i '/^\\vspace{10mm}$$/d' /tmp/manual.tex # remove vspace{10mm} within title to pass pandoc
-	pandoc --no-wrap -s /tmp/manual.tex -o manual.rst -V documentclass=ltjarticle --latex-engine=lualatex
+	pandoc --wrap=none -s /tmp/manual.tex -o manual.rst -V documentclass=ltjarticle
 	sed -i '[email protected]:: \(.*\)@   \1@' manual.rst # restore ..include for rst
 	sed -i 's@.. toctree:: \(.*\)@.. toctree::\n   :maxdepth: 1\n   :caption: \1@' manual.rst  # restore ..toctree for rst
 	sed -i 's@** Featuring@**\nFeaturing@' manual.rst # add newline before Featuring in title

doc/latex/intro.tex

@@ -283,7 +283,7 @@ \subsection{Revision History}
             Version 9.14 is released, fix assert API. Now message is optional (defmacro assert (pred \&optional message)
             Version 9.15 is released, fix char comparison function (previous version retuns opossite result), support multiple argument at function /=,  add url encode feature (escape-url function), support microsecond add/subtract in interval-time class
             Version 9.16 is released, added make-random-state, fixed bug in lib/llib/unittest.l
-\item[2016] Version 9.17 is released, add trace option in (init-unit-test), enable to read \#f(nan inf)．fix models/doc.
+\item[2016] Version 9.17 is released, add trace option in (init-unit-test), enable to read \#f(nan inf). fix models/doc.
             Version 9.18 is released, support gcc-5.
             Version 9.20 is released, support OSX (gluTessCallback, glGenTexturesEXT), add GL\_COLOR\_ATTACHMENT constants, fix color-image class, (it uses RGB not BGR).
             Version 9.21 is released, fix :trim of hashtab class, enable to compile filename containing -, do not raise error when not found cygpq.dll (Cygwin)

doc/latex/manipulator.tex

@@ -224,9 +224,9 @@ \subsection{
 
 
 \begin{verbatim}
-　(send eta3 :translate #f(0 0 -100))        ;put back the end-effector by 10cm
-　(send eta3 :translate #f(0 0 -100) :world) ;move down the end-effector by 10cm
-　(send eta3 :translate #f(0 0 -100)
+  (send eta3 :translate #f(0 0 -100))        ;put back the end-effector by 10cm
+  (send eta3 :translate #f(0 0 -100) :world) ;move down the end-effector by 10cm
+  (send eta3 :translate #f(0 0 -100)
              (manipulator-base eta3))  ;move down the end-effector with respect 
                                        ;to the coords of the base by 10cm
 \end{verbatim}

doc/latex/matrix.tex

@@ -733,7 +733,7 @@ \subsubsection*{Methods modifying itself}
 
 when wrt == :world, $T \leftarrow AT$
 
-when wrt == W (coordinates class), $T \leftarrow$ $\left( WAW \right)^{-1} T$
+when wrt == W (coordinates class), $T \leftarrow$ $\left( W A W^{-1} \right) T$
 }
 
 \end{refdesc}

doc/latex/sysfunc.tex

@@ -20,7 +20,7 @@ \subsection{Memory Management}
 The expansion occurs either automatically on the fly
 or on user's explicit demand by calling {\bf system:alloc} function.
 When it is managed automatically, free memory size is kept
-about 25\% of total heap size. % by default,
+about 25\% of total heap size.
 This ratio can be changed by setting a value between 0.1 and 0.9 to
 the {\bf sys:*gc-margin*} parameter.
 
@@ -810,7 +810,10 @@ \subsection{\label{UnixProcess}Unix Processes}
 \begin{refdesc}
 
 \funcdesc{cd}{\&optional (dir (unix:getenv "HOME"))}{
-changes the current working directory.}
+changes the current working directory. If {\em dir} is a symbol, {\em dir} is not evaluated and converted to string.}
+
+\funcdesc{pwd}{}{
+gets current working directory.}
 
 \funcdesc{ez}{\&optional key}{
 enters display editor ez, and reads Lisp forms from it, and evaluates

lisp/c/unixcall.c

@@ -87,8 +87,12 @@ extern int errno;
 #include <time.h>
 //extern char *tzname[2];
 #if !Cygwin /* extern timezone */
+#if defined __USE_MISC || defined __USE_XOPEN
+extern long int timezone;
+#else
 extern time_t timezone, altzone;	/*long*/
 #endif
+#endif
 extern int daylight;
 
 extern pointer eussigvec[NSIG];

lisp/geo/geobody.l

@@ -119,7 +119,7 @@
 	;move all vertices with respect to this coordinates
 	;without moving coordinates.
     (let (rotmat)
-	(if (float-vector-p axis) (setq rotmat (rotation rad axis)))
+	(if (float-vector-p axis) (setq rotmat (rotation-matrix rad axis)))
         (dolist (v model-vertices)
 	   (if (float-vector-p axis)
 	       (transform rotmat v v)

lisp/image/jpeg/jpegmemcd.c

@@ -11,8 +11,17 @@
 #include <stdio.h>
 #include "jpeglib.h"
 #include <setjmp.h>
+
+#if JPEG_LIB_VERSION >= 80 || defined(MEM_SRCDST_SUPPORTED)
+#define jpeg_memio_dest(cinfo, outbuffer, outsize) \
+  jpeg_mem_dest((j_compress_ptr)cinfo, (unsigned char **)outbuffer, (unsigned long *)outsize)
+
+#define jpeg_memio_src(cinfo, inbuffer, insize) \
+  jpeg_mem_src((j_decompress_ptr)cinfo, (const unsigned char *)inbuffer, (unsigned long)insize)
+#else
 GLOBAL(void) jpeg_memio_dest (j_compress_ptr cinfo, JOCTET *jpegimgbuf, long *size);
 GLOBAL(void) jpeg_memio_src (j_decompress_ptr cinfo, JOCTET *buf, long size);
+#endif
 
 
 int JPEG_compress(JSAMPLE *image_buffer, long width, long height,

lisp/l/eusstart.l

@@ -349,7 +349,7 @@
                   gc alloc runtime))
 	(setf (symbol-function 'exit) (symbol-function 'unix::exit))    
 ;;
-;(when (substringp "P" (string-upcase *program-name*))
+;(when (substringp "P" (string-upcase (pathname-name *program-name*)))
 	(in-package "SYSTEM")
 	(system::exec-module-init "par" "l/par.l")
 ;;
@@ -368,9 +368,10 @@
 ;; load geometric package
 ;;
 
-(when (or (substringp "G" (string-upcase *program-name*))
-	  (substringp "X" (string-upcase *program-name*))
-	  (substringp "COMP" (string-upcase *program-name*)))
+(when (let ((*program-name* (string-upcase (pathname-name *program-name*))))
+        (or (substringp "G" *program-name*)
+            (substringp "X" *program-name*)
+            (substringp "COMP" *program-name*)))
 ;;	(format t "Loading geometry modules.~%")
 	(sys:alloc 80000)
 	(sys:alloc 50000)