This file is indexed.

/usr/share/common-lisp/source/closure-common/xstream.lisp is in cl-closure-common 20101107-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*-
;;; ---------------------------------------------------------------------------
;;;     Title: Fast streams
;;;   Created: 1999-07-17
;;;    Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;;   License: Lisp-LGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;;  (c) copyright 1999 by Gilbert Baumann

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library 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
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the 
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
;;; Boston, MA  02111-1307  USA.

(in-package :runes)

;;; API
;; 
;; MAKE-XSTREAM cl-stream &key name! speed initial-speed initial-encoding
;;                                                              [function]
;; MAKE-ROD-XSTREAM rod &key name                               [function]
;; CLOSE-XSTREAM xstream                                        [function]
;; XSTREAM-P object                                             [function]
;;
;; READ-RUNE xstream                                               [macro]
;; PEEK-RUNE xstream                                               [macro]
;; FREAD-RUNE xstream                                           [function]
;; FPEEK-RUNE xstream                                           [function]
;; CONSUME-RUNE xstream                                            [macro]
;; UNREAD-RUNE rune xstream                                     [function]
;;
;; XSTREAM-NAME xstream                                         [accessor]
;; XSTREAM-POSITION xstream                                     [function]
;; XSTREAM-LINE-NUMBER xstream                                  [function]
;; XSTREAM-COLUMN-NUMBER xstream                                [function]
;; XSTREAM-PLIST xstream                                        [accessor]
;; XSTREAM-ENCODING xstream                                     [accessor]  <-- be careful here. [*]
;; SET-TO-FULL-SPEED xstream                                    [function]

;; [*] switching the encoding on the fly is only possible when the
;; stream's buffer is empty; therefore to be able to switch the
;; encoding, while some runes are already read, set the stream's speed
;; to 1 initially (via the initial-speed argument for MAKE-XSTREAM)
;; and later set it to full speed. (The encoding of the runes
;; sequence, you fetch off with READ-RUNE is always UTF-16 though).
;; After switching the encoding, SET-TO-FULL-SPEED can be used to bump the
;; speed up to a full buffer length.

;; An encoding is simply something, which provides the DECODE-SEQUENCE
;; method.

;;; Controller protocol
;;
;; READ-OCTECTS sequence os-stream start end -> first-non-written
;; XSTREAM/CLOSE os-stream
;;

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *fast* '(optimize (speed 3) (safety 0))))

;; Let us first define fast fixnum arithmetric get rid of type
;; checks. (After all we know what we do here).

(defmacro fx-op (op &rest xs) 
  `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))))
(defmacro fx-pred (op &rest xs) 
  `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))

(defmacro %+   (&rest xs) `(fx-op + ,@xs))
(defmacro %=  (&rest xs)  `(fx-pred = ,@xs))

(deftype buffer-index ()
  `(unsigned-byte ,(integer-length array-total-size-limit)))

(deftype buffer-byte ()
  #+rune-is-utf-16
  `(unsigned-byte 16)
  #-rune-is-utf-16
  `(unsigned-byte 32))

(deftype octet ()
  `(unsigned-byte 8))

;; The usage of a special marker for EOF is experimental and
;; considered unhygenic.

(defconstant +end+ #xFFFF
  "Special marker inserted into stream buffers to indicate end of buffered data.")

(defvar +null-buffer+ (make-array 0 :element-type 'buffer-byte))
(defvar +null-octet-buffer+ (make-array 0 :element-type 'octet))

(defstruct (xstream 
            (:constructor make-xstream/low)
            (:copier nil)
            (:print-function print-xstream))
  
  ;;; Read buffer
  
  ;; the buffer itself
  (buffer +null-buffer+ 
          :type (simple-array buffer-byte (*)))
  ;; points to the next element of `buffer' containing the next rune
  ;; about to be read.
  (read-ptr      0 :type buffer-index)
  ;; points to the first element of `buffer' not containing a rune to
  ;; be read.
  (fill-ptr      0 :type buffer-index)

  ;;; OS buffer
  
  ;; a scratch pad for READ-SEQUENCE
  (os-buffer +null-octet-buffer+
             :type (simple-array octet (*)))
  
  ;; `os-left-start', `os-left-end' designate a region of os-buffer,
  ;; which still contains some undecoded data. This is needed because
  ;; of the DECODE-SEQUENCE protocol
  (os-left-start 0 :type buffer-index)
  (os-left-end   0 :type buffer-index)
  
  ;; How much to read each time
  (speed         0 :type buffer-index)
  (full-speed    0 :type buffer-index)
  
  ;; Some stream object obeying to a certain protcol
  os-stream

  ;; The external format 
  ;; (some object offering the ENCODING protocol)
  (encoding :utf-8)

  ;;A STREAM-NAME object
  (name nil)
  
  ;; a plist a struct keeps the hack away
  (plist nil)
  
  ;; Stream Position
  (line-number 1 :type integer)         ;current line number
  (line-start  0 :type integer)         ;stream position the current line starts at
  (buffer-start 0 :type integer)        ;stream position the current buffer starts at
  
  ;; There is no need to maintain a column counter for each character
  ;; read, since we can easily compute it from `line-start' and
  ;; `buffer-start'.
  )

(defun print-xstream (self sink depth)
  (declare (ignore depth))
  (format sink "#<~S ~S>" (type-of self) (xstream-name self)))

(defmacro read-rune (input)
  "Read a single rune off the xstream `input'. In case of end of file :EOF 
   is returned."
  `((lambda (input)
      (declare (type xstream input)
               #.*fast*)
      (let ((rp (xstream-read-ptr input)))
        (declare (type buffer-index rp))
        (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
                        rp)))
          (declare (type buffer-byte ch))
          (setf (xstream-read-ptr input) (%+ rp 1))
          (cond ((%= ch +end+)
                 (the (or (member :eof) rune)
                   (xstream-underflow input)))
                ((%= ch #x000A)         ;line break
                 (account-for-line-break input)
                 (code-rune ch))
                (t
                 (code-rune ch))))))
    ,input))

(defmacro peek-rune (input)
  "Peek a single rune off the xstream `input'. In case of end of file :EOF
   is returned."
  `((lambda (input)
      (declare (type xstream input)
               #.*fast*)
      (let ((rp (xstream-read-ptr input)))
        (declare (type buffer-index rp))
        (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
                        rp)))
          (declare (type buffer-byte ch))
          (cond ((%= ch +end+)
                 (prog1
                     (the (or (member :eof) rune) (xstream-underflow input))
                   (setf (xstream-read-ptr input) 0)))
                (t
                 (code-rune ch))))))
    ,input))

(defmacro consume-rune (input)
  "Like READ-RUNE, but does not actually return the read rune."
  `((lambda (input)
      (declare (type xstream input)
               #.*fast*)
      (let ((rp (xstream-read-ptr input)))
        (declare (type buffer-index rp))
        (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
                        rp)))
          (declare (type buffer-byte ch))
          (setf (xstream-read-ptr input) (%+ rp 1))
          (when (%= ch +end+)
            (xstream-underflow input))
          (when (%= ch #x000A)         ;line break
            (account-for-line-break input) )))
      nil)
    ,input))

(definline unread-rune (rune input)
  "Unread the last recently read rune; if there wasn't such a rune, you
   deserve to lose."
  (declare (ignore rune))
  (decf (xstream-read-ptr input))
  (when (rune= (peek-rune input) #/u+000A)   ;was it a line break?
    (unaccount-for-line-break input)))

(defun fread-rune (input)
  (read-rune input))

(defun fpeek-rune (input)
  (peek-rune input))

;;; Line counting

(defun account-for-line-break (input)
  (declare (type xstream input))
  (incf (xstream-line-number input))
  (setf (xstream-line-start input)
    (+ (xstream-buffer-start input) (xstream-read-ptr input))))

(defun unaccount-for-line-break (input)
  ;; incomplete! 
  ;; We better use a traditional lookahead technique or forbid unread-rune.
  (decf (xstream-line-number input)))

;; User API:

(defun xstream-position (input)
  (+ (xstream-buffer-start input) (xstream-read-ptr input)))

;; xstream-line-number is structure accessor

(defun xstream-column-number (input)
  (+ (- (xstream-position input)
        (xstream-line-start input))
     1))

;;; Underflow

(defconstant +default-buffer-size+ 100)

(defmethod xstream-underflow ((input xstream))
  (declare (type xstream input))
  ;; we are about to fill new data into the buffer, so we need to
  ;; adjust buffer-start.
  (incf (xstream-buffer-start input)
        (- (xstream-fill-ptr input) 0))
  (let (n m)
    ;; when there is something left in the os-buffer, we move it to
    ;; the start of the buffer.
    (setf m (- (xstream-os-left-end input) (xstream-os-left-start input)))
    (unless (zerop m)
      (replace (xstream-os-buffer input) (xstream-os-buffer input)
               :start1 0 :end1 m
               :start2 (xstream-os-left-start input)
               :end2 (xstream-os-left-end input))
      ;; then we take care that the buffer is large enough to carry at
      ;; least 100 bytes (a random number)
      ;;
      ;; David: My understanding is that any number of octets large enough
      ;; to record the longest UTF-8 sequence or UTF-16 sequence is okay,
      ;; so 100 is plenty for this purpose.
      (unless (>= (length (xstream-os-buffer input)) 
		  +default-buffer-size+)
        (error "You lost")))
    (setf n
      (read-octets (xstream-os-buffer input) (xstream-os-stream input)
                   m (min (1- (length (xstream-os-buffer input)))
                          (+ m (xstream-speed input)))))
    (cond ((%= n 0)
           (setf (xstream-read-ptr input) 0
                 (xstream-fill-ptr input) n)
           (setf (aref (xstream-buffer input) (xstream-fill-ptr input)) +end+)
           :eof)
          (t
           (multiple-value-bind (fnw fnr) 
               (runes-encoding:decode-sequence
                (xstream-encoding input) 
                (xstream-os-buffer input) 0 n
                (xstream-buffer input) 0 (1- (length (xstream-buffer input)))
                (= n m))
             (setf (xstream-os-left-start input) fnr
                   (xstream-os-left-end input) n
                   (xstream-read-ptr input) 0
                   (xstream-fill-ptr input) fnw)
             (setf (aref (xstream-buffer input) (xstream-fill-ptr input)) +end+)
             (read-rune input))))))

;;; constructor

(defun make-xstream (os-stream &key name
                                    (speed 8192)
                                    (initial-speed 1)
                                    (initial-encoding :guess))
  ;; XXX if initial-speed isn't 1, encoding will me munged up
  (assert (eql initial-speed 1))
  (multiple-value-bind (encoding preread)
      (if (eq initial-encoding :guess)
          (figure-encoding os-stream)
          (values initial-encoding nil))
    (let* ((bufsize (max speed +default-buffer-size+))
	   (osbuf (make-array bufsize :element-type '(unsigned-byte 8))))
      (replace osbuf preread)
      (make-xstream/low
       :buffer (let ((r (make-array bufsize :element-type 'buffer-byte)))
                 (setf (elt r 0) #xFFFF)
                 r)
       :read-ptr 0
       :fill-ptr 0
       :os-buffer osbuf
       :speed initial-speed
       :full-speed speed
       :os-stream os-stream
       :os-left-start 0
       :os-left-end (length preread)
       :encoding encoding
       :name name))))

(defun make-rod-xstream (string &key name)
  (unless (typep string 'simple-array)
    (setf string (coerce string 'simple-string)))
  (let ((n (length string)))
    (let ((buffer (make-array (1+ n) :element-type 'buffer-byte)))
      (declare (type (simple-array buffer-byte (*)) buffer))
      ;; copy the rod
      (do ((i (1- n) (- i 1)))
          ((< i 0))
        (declare (type fixnum i))
        (setf (aref buffer i) (rune-code (%rune string i))))
      (setf (aref buffer n) +end+)
      ;;
      (make-xstream/low :buffer buffer
                        :read-ptr 0
                        :fill-ptr n
                        ;; :os-buffer nil
                        :speed 1
                        :os-stream nil
                        :name name))))

(defmethod figure-encoding ((stream null))
  (values :utf-8 nil))

(defmethod figure-encoding ((stream stream))
  (let ((c0 (read-byte stream nil :eof)))
    (cond ((eq c0 :eof)
           (values :utf-8 nil))
          (t
           (let ((c1 (read-byte stream nil :eof)))
             (cond ((eq c1 :eof)
                    (values :utf-8 (list c0)))
                   (t
                    (cond ((and (= c0 #xFE) (= c1 #xFF)) (values :utf-16-big-endian nil))
                          ((and (= c0 #xFF) (= c1 #xFE)) (values :utf-16-little-endian nil))
                          ((and (= c0 #xEF) (= c1 #xBB))
                           (let ((c2 (read-byte stream nil :eof)))
                             (if (= c2 #xBF)
                                 (values :utf-8 nil)
                                 (values :utf-8 (list c0 c1 c2)))))
                          (t
                           (values :utf-8 (list c0 c1)))))))))))

;;; misc

(defun close-xstream (input)
  (xstream/close (xstream-os-stream input)))

(defun set-to-full-speed (xstream)
  (setf (xstream-speed xstream) (xstream-full-speed xstream)))

;;; controller implementations

(defmethod read-octets (sequence (stream stream) start end)
  (#+CLISP ext:read-byte-sequence
   #-CLISP read-sequence
           sequence stream :start start :end end))

#+cmu
(defmethod read-octets :around (sequence (stream stream) start end)
  ;; CMUCL <= 19a on non-SunOS accidentally triggers EFAULT in read(2)
  ;; if SEQUENCE has been write protected by GC.  Workaround: Touch all pages
  ;; in SEQUENCE and make sure no GC happens between that and the read(2).
  (ext::without-gcing
   (loop for i from start below end
         do (setf (elt sequence i) (elt sequence i)))
   (call-next-method)))

(defmethod read-octets (sequence (stream null) start end)
  (declare (ignore sequence start end))
  0)

(defmethod xstream/close ((stream stream))
  (close stream))

(defmethod xstream/close ((stream null))
  nil)