<short summary of the patch>

TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.

gcl (2.6.12-45) unstable; urgency=high

  * pathnames1.11

Gbp-Pq: Name pathnames1.11

diff --git a/cmpnew/gcl_lfun_list.lsp b/cmpnew/gcl_lfun_list.lsp
index 4b46f923cf403f8ad2e3fb1ab7a2192c21c9e6c2..7673928d3f1ad0271b2890f2c8b3370e9047a853 100755 (executable)
--- a/cmpnew/gcl_lfun_list.lsp
+++ b/cmpnew/gcl_lfun_list.lsp
@@ -144,7 +144,7 @@
 (DEFSYSFUN 'SVREF "Lsvref" '(T T) 'T NIL NIL) 
 (DEFSYSFUN 'APPLY "Lapply" '(T T *) 'T NIL NIL) 
 (DEFSYSFUN 'DECODE-FLOAT "Ldecode_float" '(T) '(VALUES T T T) NIL NIL) 
-(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) 
+;(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL)
 (DEFSYSFUN 'RPLACA "Lrplaca" '(T T) 'T NIL NIL) 
 (DEFSYSFUN 'SYMBOL-PLIST "Lsymbol_plist" '(T) 'T NIL NIL) 
 (DEFSYSFUN 'WRITE-STRING "Lwrite_string" '(T *) 'T NIL NIL) 
@@ -210,7 +210,7 @@
 (DEFSYSFUN 'NSUBLIS "Lnsublis" '(T T *) 'T NIL NIL) 
 (DEFSYSFUN 'CHAR-NOT-EQUAL "Lchar_not_equal" '(T *) 'T NIL T) 
 (DEFSYSFUN 'MACRO-FUNCTION "Lmacro_function" '(T) 'T NIL NIL) 
-(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) 
+;(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL)
 (DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) 
 (DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) 
 (DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) 
@@ -232,7 +232,7 @@
 (DEFSYSFUN 'FLOAT "Lfloat" '(T *) 'T NIL NIL) 
 ;(DEFSYSFUN 'FIRST "Lcar" '(T) 'T NIL NIL) 
 (DEFSYSFUN 'ROUND "Lround" '(T *) '(VALUES T T) NIL NIL) 
-(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) 
+;(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL)
 (DEFSYSFUN 'UPPER-CASE-P "Lupper_case_p" '(T) 'T NIL T) 
 (DEFSYSFUN 'ARRAY-ELEMENT-TYPE "Larray_element_type" '(T) 'T NIL NIL) 
 (DEFSYSFUN 'ADJOIN "Ladjoin" '(T T *) 'T NIL NIL) 

diff --git a/lsp/gcl_arraylib.lsp b/lsp/gcl_arraylib.lsp
index ff0416e9e57157c90f3c60d806d3f3743d9d2120..02a0f5798f83a4e6bef0c4980dacaab2a8ebba5f 100755 (executable)
--- a/lsp/gcl_arraylib.lsp
+++ b/lsp/gcl_arraylib.lsp
@@ -262,8 +262,6 @@
                          (static (staticp array))
                      &aux (fill-pointer (or fill-pointer (when (array-has-fill-pointer-p array) (fill-pointer array)))))
 
-  (declare (ignore element-type))
-
   (let ((x (if initial-contents-supplied-p
               (make-array new-dimensions
                       :adjustable t

diff --git a/lsp/gcl_iolib.lsp b/lsp/gcl_iolib.lsp
index 4453e7227a5c34661d44c7251b1608b043059685..93a7d08bc1a4027bc0692beaaabf48ed49563b6d 100755 (executable)
--- a/lsp/gcl_iolib.lsp
+++ b/lsp/gcl_iolib.lsp
@@ -80,7 +80,7 @@
      0 l)))
 
 (defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream)))
-  (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) b)))
+  (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) (declare (ignore a)) b)))
 
 (defmacro with-input-from-string ((var string &key index (start 0) end) . body)
   (declare (optimize (safety 1)))
@@ -457,10 +457,10 @@
                      if-exists iesp if-does-not-exist idnesp external-format)))
     (when (typep s 'stream) (c-set-stream-object1 s pf) s)))
 
-(defun load-pathname-exists (z)
-  (or (probe-file z)
-      (when *allow-gzipped-file*
-       (when (probe-file (string-concatenate (namestring z) ".gz"))
+(defun load-pathname-exists (z &aux (z (link-expand (namestring z))))
+  (cond ((eq (stat z) :file) z)
+       (*allow-gzipped-file*
+        (when (eq (stat (string-concatenate (namestring z) ".gz")) :file)
          z))))
 
 (defun load-pathname (p print if-does-not-exist external-format

diff --git a/lsp/gcl_listlib.lsp b/lsp/gcl_listlib.lsp
index 88143b73da817f1040ad03b7dd9fbf7e6010d596..21ec205096afbeed5d432c9ac73661f1d7ed35d2 100755 (executable)
--- a/lsp/gcl_listlib.lsp
+++ b/lsp/gcl_listlib.lsp
@@ -180,3 +180,34 @@
 (defmacro nth-value (n expr)
   (declare (optimize (safety 1)))
   `(nth ,n (multiple-value-list ,expr)))
+
+(eval-when (compile eval)
+
+  (defmacro repl-if (tc) `(labels ((l (tr &aux (k (if kf (funcall kf tr) tr)))
+                                      (cond (,tc n)
+                                            ((atom tr) tr)
+                                            ((let* ((ca (car tr))(a (l ca))(cd (cdr tr))(d (l cd)))
+                                               (if (and (eq a ca) (eq d cd)) tr (cons a d)))))))
+                            (declare (ftype (function (t) t) l))
+                            (l tr))))
+
+(defun subst (n o tr &key key test test-not
+               &aux (kf (when key (coerce key 'function)))
+               (tf (when test (coerce test 'function)))
+               (ntf (when test-not (coerce test-not 'function))))
+  (declare (optimize (safety 1)))
+  (check-type key (or null function))
+  (check-type test (or null function))
+  (check-type test-not (or null function))
+  (repl-if (cond (tf (funcall tf o k))(ntf (not (funcall ntf o k)))((eql o k)))))
+
+(defun subst-if (n p tr &key key &aux (kf (when key (coerce key 'function))))
+  (declare (optimize (safety 1)))
+  (check-type p function)
+  (check-type key (or null function))
+  (repl-if (funcall p k)))
+(defun subst-if-not (n p tr &key key &aux (kf (when key (coerce key 'function))))
+  (declare (optimize (safety 1)))
+  (check-type p function)
+  (check-type key (or null function))
+  (repl-if (not (funcall p k)))))

diff --git a/lsp/gcl_truename.lsp b/lsp/gcl_truename.lsp
index e1b39ebe47c975dd5a54587658947542108d15f3..e7a754ea3273346f88a56a0c09666b260074e3e1 100644 (file)
--- a/lsp/gcl_truename.lsp
+++ b/lsp/gcl_truename.lsp
@@ -23,7 +23,8 @@
   (check-type pd pathname-designator)
   (when (wild-pathname-p ns)
     (error 'file-error :pathname pd :format-control "Pathname is wild"))
-  (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns)))
+  (let* ((ns (ensure-dir-string (link-expand ns)))
+        (ppd (if (eq (namestring pd) ns) pd (pathname ns))))
     (unless (or (zerop (length ns)) (stat ns))
       (error 'file-error :pathname ns :format-control "Pathname does not exist"))
     (let* ((d (pathname-directory ppd))

diff --git a/o/list.d b/o/list.d
index 26bbdd341e06c3e59d48e27d5d96d60a707d2978..00701159ae8f16954af9ae1002a6cc255ae08658 100755 (executable)
--- a/o/list.d
+++ b/o/list.d
@@ -528,26 +528,26 @@ object x;
                vs_check_push(x);
 }
 
-/*
-       Subst(new, tree) pushes
-       the result of substituting new in tree
-       onto vs.
-*/
-static void
-subst(new, tree)
-object new, tree;
-{
-       cs_check(new);
-
-       if (TEST(tree))
-               vs_check_push(new);
-       else if (type_of(tree) == t_cons) {
-               subst(new, tree->c.c_car);
-               subst(new, tree->c.c_cdr);
-               stack_cons();
-       } else
-               vs_check_push(tree);
-}
+/* /\* */
+/*     Subst(new, tree) pushes */
+/*     the result of substituting new in tree */
+/*     onto vs. */
+/* *\/ */
+/* static void */
+/* subst(new, tree) */
+/* object new, tree; */
+/* { */
+/*     cs_check(new); */
+
+/*     if (TEST(tree)) */
+/*             vs_check_push(new); */
+/*     else if (type_of(tree) == t_cons) { */
+/*             subst(new, tree->c.c_car); */
+/*             subst(new, tree->c.c_cdr); */
+/*             stack_cons(); */
+/*     } else */
+/*             vs_check_push(tree); */
+/* } */
 
 /* static object */
 /* subst1(object new, object tree) { */
@@ -1153,25 +1153,25 @@ LFD(Lrplacd)()
        vs_popp;
 }
 
-@(defun subst (new old tree &key test test_not key)
-       saveTEST;
-@
-       protectTEST;
-       setupTEST(old, test, test_not, key);
-       subst(new, tree);
-       tree = vs_pop;
-        /* if (kf==identity && */
-       /*     tf==test_eql && */
-       /*     (is_imm_fixnum(item_compared) || */
-       /*      ({enum type tp=type_of(item_compared);tp>t_complex || tp<t_fixnum;}))) */
-       /*   tree=subst1qi(new,tree); */
-       /* else */
-       /*   tree=subst1(new,tree); */
-       restoreTEST;
-       @(return tree)
-@)
-
-PREDICATE(Lsubst,Lsubst_if,Lsubst_if_not, 3)
+/* @(defun subst (new old tree &key test test_not key) */
+/*     saveTEST; */
+/* @ */
+/*     protectTEST; */
+/*     setupTEST(old, test, test_not, key); */
+/*     subst(new, tree); */
+/*     tree = vs_pop; */
+/*         /\* if (kf==identity && *\/ */
+/*     /\*     tf==test_eql && *\/ */
+/*     /\*     (is_imm_fixnum(item_compared) || *\/ */
+/*     /\*      ({enum type tp=type_of(item_compared);tp>t_complex || tp<t_fixnum;}))) *\/ */
+/*     /\*   tree=subst1qi(new,tree); *\/ */
+/*     /\* else *\/ */
+/*     /\*   tree=subst1(new,tree); *\/ */
+/*     restoreTEST; */
+/*     @(return tree) */
+/* @) */
+
+/* PREDICATE(Lsubst,Lsubst_if,Lsubst_if_not, 3) */
 
 
 @(defun nsubst (new old tree &key test test_not key)
@@ -1506,9 +1506,9 @@ gcl_init_list_function()
        make_function("LDIFF", Lldiff);
        make_function("RPLACA", Lrplaca);
        make_function("RPLACD", Lrplacd);
-       make_function("SUBST", Lsubst);
-       make_function("SUBST-IF", Lsubst_if);
-       make_function("SUBST-IF-NOT", Lsubst_if_not);
+       /* make_function("SUBST", Lsubst); */
+       /* make_function("SUBST-IF", Lsubst_if); */
+       /* make_function("SUBST-IF-NOT", Lsubst_if_not); */
        make_function("NSUBST", Lnsubst);
        make_function("NSUBST-IF", Lnsubst_if);
        make_function("NSUBST-IF-NOT", Lnsubst_if_not);