From 4173daa3d97fcaf929f7b13a8b90b7c2e229f498 Mon Sep 17 00:00:00 2001
From: Tim Daly <daly@axiom-developer.org>
Date: Sat, 16 May 2015 03:10:15 -0400
Subject: [PATCH] src/interp/vmlisp.lisp revert from broken version

Over-optimization of this file caused build breakage. Revert
the version until fixed.
---
 changelog                       |    2 ++
 patch                           |    4 +++-
 src/axiom-website/patches.html  |    2 ++
 src/interp/vmlisp.lisp.pamphlet |   25 ++++++++-----------------
 4 files changed, 15 insertions(+), 18 deletions(-)

diff --git a/changelog b/changelog
index 80de6d1..5752f72 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,5 @@
+20150515 tpd src/axiom-website/patches.html 20150515.01.tpd.patch 
+20150515 tpd src/interp/vmlisp.lisp revert from broken version
 20150508 tpd src/axiom-website/patches.html 20150508.02.tpd.patch 
 20150508 tpd books/bookvol10.2.pamphlet add more tests
 20150508 tpd books/bookvol10.3.pamphlet add more tests
diff --git a/patch b/patch
index f6661bd..5062994 100644
--- a/patch
+++ b/patch
@@ -1,2 +1,4 @@
-books/bookvol*pamphlet add more test cases
+src/interp/vmlisp.lisp revert from broken version
 
+Over-optimization of this file caused build breakage. Revert
+the version until fixed.
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 17d3de0..ad2651a 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -5058,6 +5058,8 @@ books/bookvol13 add Kama15 reference<br/>
 books/bookvolbib add Robe15 reference<br/>
 <a href="patches/20150508.02.tpd.patch">20150508.02.tpd.patch</a>
 books/bookvol*pamphlet add more test cases<br/>
+<a href="patches/20150515.01.tpd.patch">20150515.01.tpd.patch</a>
+src/interp/vmlisp.lisp revert from broken version<br/>
  </body>
 </html>
 
diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet
index 99d07ba..2854922 100644
--- a/src/interp/vmlisp.lisp.pamphlet
+++ b/src/interp/vmlisp.lisp.pamphlet
@@ -1097,9 +1097,7 @@ can be restored.
 ; 24.0 Printing
 
 \end{chunk}
-\section{The StringImage Fix}
-In GCL 2.5 there is a bug in the write-to-string function.
-It should respect *print-escape* but it does not. That is,
+
 \begin{verbatim}
 
 In GCL 2.4.1:
@@ -1111,12 +1109,8 @@ In GCL 2.5:
 (write-to-string '|a|) ==> "|a|"
 
 \end{verbatim}
-The form2LispString function uses stringimage and fails.
-The princ-to-string function assumes *print-escape* is nil
-and works properly.
 
 \begin{chunk}{*}
-(define-function 'stringimage #'princ-to-string)
 
 (defun |F,PRINT-ONE| (form &optional (stream *standard-output*))
  (declare (ignore stream))
@@ -2979,7 +2973,7 @@ LP  (COND ((NULL X)
 
 (defvar $GENNO 0)
  
-(DEFUN GENVAR () (INTERNL "$" (STRINGIMAGE (SETQ $GENNO (1+ $GENNO)))))
+(DEFUN GENVAR () (INTERNL "$" (princ-to-string (SETQ $GENNO (1+ $GENNO)))))
  
 (DEFUN IS_GENVAR (X)
   (AND (IDENTP X)
@@ -3651,9 +3645,9 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
 (defmacro |assert| (x y) `(IF (NULL ,x) (|error| ,y)))
  
 (defun coerce-failure-msg (val mode)
-   (STRCONC (MAKE-REASONABLE (STRINGIMAGE val))
+   (STRCONC (MAKE-REASONABLE (princ-to-string val))
             " cannot be coerced to mode "
-            (STRINGIMAGE (|devaluate| mode))))
+            (princ-to-string (|devaluate| mode))))
  
 (defmacro |check-subtype| (pred submode val)
    `(|assert| ,pred (coerce-failure-msg ,val ,submode)))
@@ -4104,7 +4098,7 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
           (t (COMP-NEWNAM (CAR X)) (COMP-NEWNAM (CDR X))))))
 
 (defun make-closedfn-name ()
-  (internl $FUNNAME "!" (STRINGIMAGE (LENGTH $CLOSEDFNS))))
+  (internl $FUNNAME "!" (princ-to-string (LENGTH $CLOSEDFNS))))
 
 (DEFUN COMP-TRAN (X)
   "SEXPR<FN. BODY> -> SEXPR"
@@ -4326,7 +4320,7 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
                   (LENGTH2STR min)))))
  
 (DEFUN LENGTH2STR (X &aux XLEN)
-       (cond ( (= 1 (SETQ XLEN (LENGTH (SETQ X (STRINGIMAGE X))))) (STRCONC "0" X))
+       (cond ( (= 1 (SETQ XLEN (LENGTH (SETQ X (princ-to-string X))))) (STRCONC "0" X))
              ( (= 2 XLEN) X)
              ( (subseq x (- XLEN 2)))))
  
@@ -5340,12 +5334,12 @@ o  there is some code at the end of SPECEVAL BOOT that puts "up"
 (REPEAT (IN X '(
   |Polynomial| |UnivariatePoly| |SquareMatrix| |QuotientField|
   )) 
-(setf (get x '|status|) (internl (strconc "status" (stringimage x)))))
+(setf (get x '|status|) (internl (strconc "status" (princ-to-string x)))))
 
 (REPEAT (IN X '(
   |UnivariatePoly| |Matrix| |QuotientField| |Gaussian|
   ))
-(setf (get x '|dataCoerce|) (internl (strconc "coerce" (stringimage x)))))
+(setf (get x '|dataCoerce|) (internl (strconc "coerce" (princ-to-string x)))))
 
 ;; this property is checked for Integers to decide which subdomain to
 ;; choose at compile time.
@@ -5945,9 +5939,6 @@ o  there is some code at the end of SPECEVAL BOOT that puts "up"
 (defun |ToString| (ob)
   (string ob) )
 
-(defun |StringImage| (ob)
-  (format nil "~a" ob) )
-
 (defun |String?| (ob)
   (stringp ob) )
 
-- 
1.7.5.4