file layout: moving share/txr/stdlib to stdlib.

This affects run-time also. Txr installations where the
executable is not in directory ending in ${bindir}
will look for stdlib rather than share/txr/stdlib,
relative to the determined installation directory.

* txr.c (sysroot_init): If we detect relative to the short
name, or fall back on the program directory, use stdlib
rather than share/txr/stdlib as the stdlib_path.

* INSTALL: Update some installation notes not to refer to
share/txr/stdlib but stdlib.

* Makefile (STDLIB_SRCS): Refer to stdlib, not
share/txr/stdlib.
(clean): In unconfigured mode, remove the old share/txr/stdlib
entirely.  Remove .tlo files from stdlib.
(install): Install lib materials from stdlib.

* txr.1: Updated documentation under Deployment Directory Structure.

* share/txr/stdlib/{asm,awk,build,cadr}.tl:
Renamed to stdlib/{asm,awk,build,cadr}.tl.

* share/txr/stdlib/{compiler,conv,copy-file,debugger}.tl:
Renamed to stdlib/{compiler,conv,copy-file,debugger}.tl.

* share/txr/stdlib/{defset,doc-lookup,doc-syms,doloop}.tl:
Renamed to stdlib/{defset,doc-lookup,doc-syms,doloop}.tl.

* share/txr/stdlib/{each-prod,error,except,ffi}.tl:
Renamed to stdlib/{each-prod,error,except,ffi}.tl.

* share/txr/stdlib/{getopts,getput,hash,ifa}.tl:
Renamed to stdlib/{getopts,getput,hash,ifa}.tl.

* share/txr/stdlib/{keyparams,match,op,optimize}.tl:
Renamed to stdlib/{keyparams,match,op,optimize}.tl.

* share/txr/stdlib/{package,param,path-test,pic}.tl:
Renamed to stdlib/{package,param,path-test,pic}.tl.

* share/txr/stdlib/{place,pmac,quips,save-exe}.tl:
Renamed to stdlib/{place,pmac,quips,save-exe}.tl.

* share/txr/stdlib/{socket,stream-wrap,struct,tagbody}.tl:
Renamed to stdlib/{socket,stream-wrap,struct,tagbody}.tl.

* share/txr/stdlib/{termios,trace,txr-case,type}.tl:
Renamed to stdlib/{termios,trace,txr-case,type}.tl.

* share/txr/stdlib/{ver,vm-param,with-resources,with-stream}.tl:
Renamed to stdlib/{ver,vm-param,with-resources,with-stream}.tl.

* share/txr/stdlib/yield.tl: Renamed to stdlib/yield.tl.

* share/txr/stdlib/{txr-case,ver}.txr:
Renamed to stdlib/{txr-case,ver}.txr.

* gencadr.txr: Update to stdlib/place.tl.

* genman.txr: Update to stdlib/cadr.tl.

1 files changed, 187 insertions, 0 deletions

diff --git a/stdlib/path-test.tl b/stdlib/path-test.tl
new file mode 100644
index 00000000..fb132f7f
--- /dev/null
+++ b/stdlib/path-test.tl
@@ -0,0 +1,187 @@
+;; Copyright 2015-2021
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright notice, this
+;;    list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright notice,
+;;    this list of conditions and the following disclaimer in the documentation
+;;    and/or other materials provided with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(defun sys:do-path-test (statfun path testfun)
+  [testfun (if (typep path 'stat)
+             path
+             (ignerr [statfun path]))])
+
+(eval-only
+  (defmacro sys:path-test ((sym statfun path) . body)
+    ^[sys:do-path-test ,statfun ,path
+       (lambda (,sym) (when ,sym ,*body))]))
+
+(defun sys:path-test-type (statfun path code)
+  (sys:path-test (s statfun path)
+    (eql (logand s.mode s-ifmt) code)))
+
+(defun sys:path-test-mode (statfun path mask)
+  (sys:path-test (s statfun path)
+    (plusp (logand s.mode mask))))
+
+(defun path-exists-p (path)
+  (sys:path-test (s stat path) t))
+
+(defun path-file-p (path)
+  [sys:path-test-type stat path s-ifreg])
+
+(defun path-dir-p (path)
+  [sys:path-test-type stat path s-ifdir])
+
+(defun path-symlink-p (path)
+  [sys:path-test-type lstat path s-iflnk])
+
+(defun path-blkdev-p (path)
+  [sys:path-test-type stat path s-ifblk])
+
+(defun path-chrdev-p (path)
+  [sys:path-test-type stat path s-ifchr])
+
+(defun path-sock-p (path)
+  [sys:path-test-type stat path s-ifsock])
+
+(defun path-pipe-p (path)
+  [sys:path-test-type stat path s-ififo])
+
+(defun path-setgid-p (path)
+  [sys:path-test-mode stat path s-isgid])
+
+(defun path-setuid-p (path)
+  [sys:path-test-mode stat path s-isuid])
+
+(defun path-sticky-p (path)
+  [sys:path-test-mode stat path s-isvtx])
+
+(defun path-mine-p (path)
+  (sys:path-test (s stat path)
+    (= s.uid (geteuid))))
+
+(defun path-my-group-p (path)
+  (sys:path-test (s stat path)
+    (let ((g s.gid))
+      (or (= g (getegid))
+          (find g (getgroups))))))
+
+;; umask, gmask and omask must test identical permissions
+;; multiple permissions may be tested, but not a combination
+;; of x with any other permission.
+(defun sys:path-access (path umask gmask omask)
+  (sys:path-test (s stat path)
+    (let ((m s.mode)
+          (euid (geteuid)))
+      (cond
+        ((zerop euid) (or (zerop (logand umask s-ixusr))
+                          (plusp (logand m (logior umask gmask omask)))))
+        ((= euid s.uid) (= umask (logand m umask)))
+        ((let ((g s.gid))
+           (or (= g (getegid))
+               (find g (getgroups))))
+         (= gmask (logand m gmask)))
+        (t (= omask (logand m omask)))))))
+
+(defun path-executable-to-me-p (path)
+  (sys:path-access path s-ixusr s-ixgrp s-ixoth))
+
+(defun path-writable-to-me-p (path)
+  (sys:path-access path s-iwusr s-iwgrp s-iwoth))
+
+(defun path-readable-to-me-p (path)
+  (sys:path-access path s-irusr s-irgrp s-iroth))
+
+(defun path-read-writable-to-me-p (path)
+  (sys:path-access path
+                   (logior s-irusr s-iwusr)
+                   (logior s-irgrp s-iwgrp)
+                   (logior s-iroth s-iwoth)))
+
+(defun path-private-to-me-p (path)
+  (sys:path-test (s stat path)
+    (let ((m s.mode)
+          (euid (geteuid)))
+      (mlet ((g (getgrgid s.gid))
+             (name (let ((pw (getpwuid euid)))
+                     (if pw pw.name)))
+             (suname (let ((pw (getpwuid 0)))
+                       (if pw pw.name))))
+        (and (or (zerop s.uid)
+                 (eql euid s.uid))
+             (zerop (logand m s-iwoth))
+             (or (zerop (logand m s-iwgrp))
+                 (null g.mem)
+                 (and (all g.mem (orf (op equal name)
+                                      (op equal suname))))))))))
+
+(defun path-strictly-private-to-me-p (path)
+  (sys:path-test (s stat path)
+    (let ((m s.mode)
+          (euid (geteuid)))
+      (mlet ((g (getgrgid s.gid))
+             (name (let ((pw (getpwuid euid)))
+                     (if pw pw.name)))
+             (suname (let ((pw (getpwuid 0)))
+                       (if pw pw.name))))
+        (and (or (zerop s.uid)
+                 (eql euid s.uid))
+             (zerop (logand m (logior s-iroth s-iwoth)))
+             (or (zerop (logand m (logior s-irgrp s-iwgrp)))
+                 (null g.mem)
+                 (and (all g.mem (orf (op equal name)
+                                      (op equal suname))))))))))
+
+
+(defmacro sys:path-examine ((sym statfun path) . body)
+  ^[sys:do-path-test ,statfun ,path
+     (lambda (,sym) ,*body)])
+
+(defun path-newer (path-0 path-1)
+  (sys:path-examine (s0 stat path-0)
+    (sys:path-examine (s1 stat path-1)
+      (if s0
+        (or (null s1)
+            (let ((mt0 s0.mtime)
+                  (mt1 s1.mtime))
+              (or (> mt0 mt1)
+                  (and (= mt0 mt1)
+                       (> s0.mtime-nsec s1.mtime-nsec)))))))))
+
+(defun path-older (path-0 path-1)
+  (path-newer path-1 path-0))
+
+(defun path-same-object (path-0 path-1)
+  (sys:path-examine (s0 stat path-0)
+    (sys:path-examine (s1 stat path-1)
+      (and s0 s1
+           (eql s0.dev s1.dev)
+           (eql s0.ino s1.ino)))))
+
+(defun path-dir-empty (path)
+  (when (path-dir-p path)
+    (let ((name (if (stringp path) path path.path)))
+      (with-stream (ds (open-directory name))
+        (for (ent) ((set ent (get-line ds)) t) ()
+          (casequal ent
+            (("." ".."))
+            (t (return nil))))))))