From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 26 Apr 2017 05:51:31 +0000 (-0700)
Subject: Eliminate "output-octets" instance.
X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~131
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b4d03834ec4e2687a03c4fb92f27c98dc3bbf986;p=mit-scheme.git

Eliminate "output-octets" instance.
---

diff --git a/src/ssp/mod-lisp.scm b/src/ssp/mod-lisp.scm
index c3d349124..a7db288cc 100644
--- a/src/ssp/mod-lisp.scm
+++ b/src/ssp/mod-lisp.scm
@@ -384,26 +384,35 @@ USA.
   (set-status-header response code)
   (set-content-type-header response 'text/html)
   (set-entity response
-	      (call-with-output-octets
-	       (lambda (port)
-		 (write-xml
-		  (let ((message (status-message code)))
-		    (html:html #f
-			       "\n"
-			       (html:head #f
-					  "\n"
-					  (html:title #f code " " message)
-					  "\n")
-			       "\n"
-			       (html:body #f
-					  "\n"
-					  (html:h1 #f message)
-					  "\n"
-					  extra
-					  "\n")
-			       "\n"))
-		  port)
-		 (newline port)))))
+	      (bytevector->string
+	       (call-with-output-bytevector
+		(lambda (port)
+		  (write-xml
+		   (let ((message (status-message code)))
+		     (html:html #f
+				"\n"
+				(html:head #f
+					   "\n"
+					   (html:title #f code " " message)
+					   "\n")
+				"\n"
+				(html:body #f
+					   "\n"
+					   (html:h1 #f message)
+					   "\n"
+					   extra
+					   "\n")
+				"\n"))
+		   port)
+		  (newline port))))))
+
+(define (bytevector->string bv)
+  (let* ((n (bytevector-length bv))
+	 (builder (string-builder)))
+    (do ((i 0 (fix:+ i 1)))
+	((not (fix:< i n)))
+      (builder (integer->char (bytevector-u8-ref bv i))))
+    (builder)))
 
 (define (set-status-header message code)
   (set-header message