From: Joe Marshall Date: Mon, 7 Sep 2009 16:43:33 +0000 (-0700) Subject: Use STRING-HEAD! instead of SET-STRING-MAXIMUM-LENGTH! X-Git-Tag: 20100708-Gtk~339 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fdc3cbad13f566d1666decfaeb3bfc84b5d99f2e;p=mit-scheme.git Use STRING-HEAD! instead of SET-STRING-MAXIMUM-LENGTH! --- diff --git a/src/runtime/input.scm b/src/runtime/input.scm index 18bb21669..d45689614 100644 --- a/src/runtime/input.scm +++ b/src/runtime/input.scm @@ -102,8 +102,7 @@ USA. a) (define-integrable (accum->string a) - (set-string-maximum-length! (car a) (cdr a)) - (car a)) + (string-head! (car a) (cdr a))) (define-integrable (accum-count a) (cdr a)) diff --git a/src/runtime/pgsql.scm b/src/runtime/pgsql.scm index 2840b162a..043e3c63e 100644 --- a/src/runtime/pgsql.scm +++ b/src/runtime/pgsql.scm @@ -298,10 +298,8 @@ USA. (define (escape-pgsql-string string) (guarantee-pgsql-available) - (let* ((escaped (make-string (fix:* 2 (string-length string)))) - (length (pq-escape-string string escaped))) - (set-string-maximum-length! escaped length) - escaped)) + (let ((escaped (make-string (fix:* 2 (string-length string))))) + (string-head! escaped (pq-escape-string string escaped)))) (define (encode-pgsql-bytea bytes) (guarantee-pgsql-available) diff --git a/src/runtime/stringio.scm b/src/runtime/stringio.scm index a43de3381..c8acd063e 100644 --- a/src/runtime/stringio.scm +++ b/src/runtime/stringio.scm @@ -423,10 +423,10 @@ USA. (define (narrow-out/extract-output! port) (let* ((os (port/state port)) - (string (ostate-buffer os))) - (set-string-maximum-length! string (ostate-index os)) + (string (ostate-buffer os)) + (length (ostate-index os))) (reset-buffer! os) - string)) + (string-head! string length))) (define (make-wide-output-type) (make-string-out-type wide-out/write-char @@ -604,11 +604,11 @@ USA. (define (octets-out/extract-output! port) (output-port/flush-output port) (let* ((os (output-octets-port/os port)) - (octets (ostate-buffer os))) - (set-string-maximum-length! octets (ostate-index os)) + (octets (ostate-buffer os)) + (length (ostate-index os))) (set-ostate-buffer! os (make-vector-8b 16)) (set-ostate-index! os 0) - octets)) + (string-head! octets length))) (define (octets-out/position port) (output-port/flush-output port)