unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
From: Mark H Weaver <mhw@netris.org>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: 35350@debbugs.gnu.org
Subject: bug#35350: Some compile output still leaks through with --verbosity=1
Date: Fri, 26 Apr 2019 15:09:24 -0400	[thread overview]
Message-ID: <87k1fgh9c0.fsf@netris.org> (raw)
In-Reply-To: <87imv5jai5.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Tue, 23 Apr 2019 12:12:34 +0200")

[-- Attachment #1: Type: text/plain, Size: 2456 bytes --]

Hi Ludovic,

Thanks for investigating this.

Ludovic Courtès <ludo@gnu.org> writes:

> The third read(2) call here ends on a partial UTF-8 sequence for LEFT
> SINGLE QUOTATION MARK (we get the first two bytes of a three byte
> sequence.)
>
> What happens is that ‘process-stderr’ in (guix store) gets that byte
> string from the daemon, passes it through ‘read-maybe-utf8-string’,
> which replaces the last two bytes with REPLACEMENT CHARACTER, which is
> itself a 3-byte sequence.

It seems to me that what's needed here is to save the UTF-8 decoder
state between calls to 'process-stderr'.  Coincidentally, I also needed
something like this a week ago, when I tried implementing R6RS custom
textual input/output ports on top of R6RS custom binary input/output
ports.

To meet these needs, I've implemented a fairly efficient, purely
functional UTF-8 decoder in Scheme that accepts a decoder state and an
arbitrary range from a bytevector, and returns a new decoder state.
There's a macro that allows arbitrary actions to be performed when a
code point (or maximal subpart in the case of errors) is found.

This macro is then used to implement a decoder (utf8->string!) that
writes into an arbitrary range of an existing string.  Of course, it's
not purely functional, but it avoids heap allocation when compiled with
Guile.  On my Thinkpad X200, it can process around 10 megabytes per
second.

The state is represented as an exact integer between 0 and #xF48FBF
inclusive, which are simply the bytes that have been seen so far in the
current code sequence, in big-endian order, or 0 for the start state.
For example, #xF48FBF represents the state where the bytes (F4 8F BF)
have been read.  The state is always either 0 or a proper prefix of a
valid UTF-8 byte sequence.

I also plan to implement an optimized C version of 'utf8->string!' and
add it to Guile, in order to implement fast custom textual ports.  The
precise name and API is not yet finalized.  At present, 'utf8->string!'
always replaces maximal subparts with the substitution character in case
of errors, but I intend to eventually support other error modes as well.

What would you think about using this code to replace the uses of
'read-maybe-utf8-string', and storing the UTF-8 decoder state in the
<store-connection> object?  Would we need to store multiple states in
case of (max-jobs > 1)?

      Regards
        Mark


[-- Attachment #2: UTF-8 decoder implementation --]
[-- Type: text/plain, Size: 8589 bytes --]

;;; Copyright © 2019 Mark H Weaver <mhw@netris.org>
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (rnrs bytevectors)
             ;; the following modules are only needed for the test.
             ;;(srfi srfi-1)
             ;;(ice-9 iconv)
             )

;; Well-formed UTF-8 sequences
;; ===========================
;; 00..7F
;; C2..DF   80..BF
;; E0      *A0..BF   80..BF
;; E1..EC   80..BF   80..BF
;; ED       80..9F*  80..BF
;; EE..EF   80..BF   80..BF
;; F0      *90..BF   80..BF   80..BF
;; F1..F3   80..BF   80..BF   80..BF
;; F4       80..8F*  80..BF   80..BF

;; UTF-8 Decoder states
;; ====================
;;  0                 start state
;;  C2     .. DF      got 1/2 bytes
;;  E0     .. EF      got 1/3 bytes
;;  F0     .. F4      got 1/4 bytes
;;  E0A0   .. ED9F    got 2/3 bytes (range 1)
;;  EE80   .. EFBF    got 2/3 bytes (range 2)
;;  F090   .. F48F    got 2/4 bytes
;;  F09080 .. F48FBF  got 3/4 bytes

(define-syntax-rule (utf8-decode ((j init-expr) ...)
                                 (i continue)
                                 (output (code-point) e1 e1* ...)
                                 (error (maximal-subpart) e2 e2* ...)
                                 state-expr bv-expr start-expr end-expr)
  ;; The start state is 0.

  ;; When 'error' is called with arguments (state i j ...), 'state'
  ;; contains the bytes of the "maximal subpart of an ill-formed
  ;; subsequence" as defined in The Unicode Standard section 3.9,
  ;; i.e. the bytes which are being represented by this error report
  ;; and which are not being converted.  'i' is the bytevector index
  ;; immediately following this maximal subpart, i.e. the index where
  ;; decoding should resume.  'j ...' are the user-provided seeds.

  ;; the decoder returns the values: (new-state bv-pos j ...)
  (let ((bv   bv-expr)
        (end  end-expr))
    (define (output code-point i j ...)
      e1 e1* ...)

    (define (error maximal-subpart i j ...)
      e2 e2* ...)
    
    (define (continue i j ...)
      (if (< i end)
          (let ((byte (bytevector-u8-ref bv i)))
            (cond ((<= byte #x7F)       (output byte (+ i 1) j ...))
                  ((<= #xC2 byte #xF4)  (got-1 byte (+ i 1) j ...))
                  (else                 (error byte (+ i 1) j ...))))
          (values 0 i j ...)))

    (define (got-1 state i j ...)
      (if (< i end)
          (let ((byte (bytevector-u8-ref bv i)))
            (cond ((not (<= #x80 byte #xBF))
                   (error state i j ...))
                  ((<= state #xDF)
                   (output (logior (ash (logand state #x1F) 6)
                                   (logand byte #x3F))
                           (+ i 1) j ...))
                  (else
                   (let ((state^ (logior (ash state 8) byte)))
                     (cond ((or (<= #xE0A0 state^ #xED9F)
                                (<= #xEE80 state^ #xEFBF))
                            (got-2/3 state^ (+ i 1) j ...))
                           ((<= #xF090 state^ #xF48F)
                            (got-2/4 state^ (+ i 1) j ...))
                           (else
                            (error state i j ...)))))))
          (values state i j ...)))

    (define (got-2/3 state i j ...)
      (if (< i end)
          (let ((byte (bytevector-u8-ref bv i)))
            (if (<= #x80 byte #xBF)
                (output (logior (ash (logand state #xF00) 4)
                                (ash (logand state #x3F) 6)
                                (logand byte #x3F))
                        (+ i 1) j ...)
                (error state i j ...)))
          (values state i j ...)))

    (define (got-2/4 state i j ...)
      (if (< i end)
          (let ((byte (bytevector-u8-ref bv i)))
            (if (<= #x80 byte #xBF)
                (got-3/4 (logior (ash state 8) byte) (+ i 1) j ...)
                (error state i j ...)))
          (values state i j ...)))

    (define (got-3/4 state i j ...)
      (if (< i end)
          (let ((byte (bytevector-u8-ref bv i)))
            (if (<= #x80 byte #xBF)
                (output (logior (ash (logand state #x70000) 2)
                                (ash (logand state #x3F00) 4)
                                (ash (logand state #x3F) 6)
                                (logand byte #x3F))
                        (+ i 1) j ...)
                (error state i j ...)))
          (values state i j ...)))

    (define (enter state i j ...)
      (cond ((zero? state)      (continue i j ...))
            ((<= state #xF4)    (got-1 state i j ...))
            ((<= state #xEFBF)  (got-2/3 state i j ...))
            ((<= state #xF48F)  (got-2/4 state i j ...))
            (else               (got-3/4 state i j ...))))

    (enter state-expr start-expr init-expr ...)))

;; Returns three values: (new-state source-pos target-pos)
(define (utf8->string! state source source-start source-end
                       target target-start target-end)
  (utf8-decode ((j target-start))
               (i continue)
               (output (code-point)
                       (string-set! target j (integer->char code-point))
                       (if (< (+ j 1) target-end)
                           (continue i (+ j 1))
                           (values 0 i (+ j 1))))
               (error (maximal-subpart)
                      (output #xFFFD i j)) ;TODO: support other error handlers
               state source source-start source-end))

;; Another experimental primitive, slower than the ones above.
(define* (utf8-fold* out err seed state bv
                     #:optional (start 0) (end (bytevector-length bv)))
  (utf8-decode ((j seed))
               (i continue)
               (output (code-point)
                       (out code-point i j continue))
               (error (maximal-subpart)
                      (err maximal-subpart i j continue))
               state bv start end))

;; Another experimental primitive, slower than the ones above.
(define* (utf8-fold out err seed state bv
                    #:optional (start 0) (end (bytevector-length bv)))
  (utf8-fold* (lambda (code-point i j continue)
                (continue i (out code-point i j)))
              (lambda (maximal-subpart i j continue)
                (call-with-values (lambda () (err maximal-subpart i j))
                  (lambda (continue? j^)
                    (if continue?
                        (continue i j^)
                        (values 0 i j^)))))
              seed state bv start end))

;; A not-so-quick test of all valid characters.
;; TODO: Tests of strictness and error handling.
#;
(let ()
  (define ss (string-tabulate (lambda (i)
                                (if (< i #xD800)
                                    (integer->char i)
                                    (integer->char (+ i #x800))))
                              (- #x110000 #x800)))
  (define bv (string->utf8 ss))
  (define bv-len (bytevector-length bv))
  (define slen (* 2 (string-length ss)))
  (define s (make-string slen))
  (every (lambda (incr)
           (string-fill! s #\a)
           (call-with-values
               (lambda ()
                 (let loop ((state 0) (i 0) (j 0))
                   (if (< i bv-len)
                       (call-with-values
                           (lambda ()
                             (utf8->string! state bv i (min bv-len
                                                            (+ i incr))
                                            s j slen))
                         loop)
                       (values state i j))))
             (lambda (state i j)
               (and (= i bv-len)
                    (= j (string-length ss))
                    (string=? ss (substring s 0 j))))))
         (iota 5 1)))

  reply	other threads:[~2019-04-26 19:12 UTC|newest]

Thread overview: 13+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2019-04-20 23:53 bug#35350: Some compile output still leaks through with --verbosity=1 Mark H Weaver
2019-04-21 20:15 ` Ludovic Courtès
2019-04-22 23:52   ` Mark H Weaver
2019-04-23  8:45     ` Mark H Weaver
2019-04-23 10:12     ` Ludovic Courtès
2019-04-26 19:09       ` Mark H Weaver [this message]
2019-04-27  0:45         ` Mark H Weaver
2019-04-27  7:56           ` Mark H Weaver
2019-04-27 16:36         ` Ludovic Courtès
2019-04-30 20:26           ` Mark H Weaver
2019-05-04  9:33             ` Ludovic Courtès
2019-05-04 18:53               ` Mark H Weaver
2021-09-20  5:44                 ` Sarah Morgensen

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87k1fgh9c0.fsf@netris.org \
    --to=mhw@netris.org \
    --cc=35350@debbugs.gnu.org \
    --cc=ludo@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).