Import Upstream version 3a1upstream/3a1

1 files changed, 209 insertions, 5 deletions

diff --git a/byte.scm b/byte.scm
index b34816d..b7e12da 100644
--- a/byte.scm
+++ b/byte.scm
@@ -1,15 +1,219 @@
 ;;; "byte.scm" small integers, not necessarily chars.
+; Copyright (c) 2001, 2002, 2003 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
 
-(define (byte-ref str ind) (char->integer (string-ref str ind)))
-(define (byte-set! str ind val) (string-set! str ind (integer->char val)))
+;;@code{(require 'byte)}
+;;@ftindex byte
+;;
+;;@noindent
+;;Some algorithms are expressed in terms of arrays of small integers.
+;;Using Scheme strings to implement these arrays is not portable vis-a-vis
+;;the correspondence between integers and characters and non-ascii
+;;character sets.  These functions abstract the notion of a @dfn{byte}.
+;;@cindex byte
+
+;;@body
+;;@2 must be a valid index of @1.  @0 returns byte @2 of @1 using
+;;zero-origin indexing.
+(define (byte-ref bytes k) (char->integer (string-ref bytes k)))
+
+;;@body
+;;@2 must be a valid index of @1, and @var{byte} must be a small
+;;nonnegative integer.  @0 stores @var{byte} in element @2 of @1 and
+;;returns an unspecified value.  @c <!>
+(define (byte-set! bytes k byte) (string-set! bytes k (integer->char byte)))
+
+;;@args k byte
+;;@args k
+;;@0 returns a newly allocated byte-array of length @1.  If @2 is
+;;given, then all elements of the byte-array are initialized to @2,
+;;otherwise the contents of the byte-array are unspecified.
 (define (make-bytes len . opt)
   (if (null? opt) (make-string len)
       (make-string len (integer->char (car opt)))))
+
+;;@args bytes
+;;@0 returns length of byte-array @1.
 (define bytes-length string-length)
+
+;;@args byte @dots{}
+;;Returns a newly allocated byte-array composed of the small
+;;nonnegative arguments.
+(define (bytes . args) (list->bytes args))
+
+;;@args bytes
+;;@0 returns a newly allocated list of the bytes that make up the
+;;given byte-array.
+(define (bytes->list bts) (map char->integer (string->list bts)))
+
+;;@args bytes
+;;@0 returns a newly allocated byte-array formed from the small
+;;nonnegative integers in the list @1.
+(define (list->bytes lst) (list->string (map integer->char lst)))
+
+;;@noindent
+;;@code{Bytes->list} and @code{list->bytes} are inverses so far as
+;;@code{equal?} is concerned.
+;;@findex equal?
+
+;;@args bytes
+;;Returns a newly allocated copy of the given @1.
+(define bytes-copy string-copy)
+
+;;@body
+;;Reverses the order of byte-array @1.
+(define (bytes-reverse! bytes)
+  (do ((idx 0 (+ 1 idx))
+       (xdi (+ -1 (bytes-length bytes)) (+ -1 xdi)))
+      ((>= idx xdi) bytes)
+    (let ((tmp (byte-ref bytes idx)))
+      (byte-set! bytes idx (byte-ref bytes xdi))
+      (byte-set! bytes xdi tmp))))
+
+;;@body
+;;Returns a newly allocated bytes-array consisting of the elements of
+;;@1 in reverse order.
+(define (bytes-reverse bytes)
+  (bytes-reverse! (bytes-copy bytes)))
+
+;;@noindent
+;;@cindex binary
+;;Input and output of bytes should be with ports opened in @dfn{binary}
+;;mode (@pxref{Input/Output}).  Calling @code{open-file} with @r{'rb} or
+;;@findex open-file
+;;@r{'wb} modes argument will return a binary port if the Scheme
+;;implementation supports it.
+
+;;@args byte port
+;;@args byte
+;;Writes the byte @1 (not an external representation of the byte) to
+;;the given @2 and returns an unspecified value.  The @2 argument may
+;;be omitted, in which case it defaults to the value returned by
+;;@code{current-output-port}.
+;;@findex current-output-port
 (define (write-byte byt . opt) (apply write-char (integer->char byt) opt))
+
+;;@args port
+;;@args
+;;Returns the next byte available from the input @1, updating the @1
+;;to point to the following byte.  If no more bytes are available, an
+;;end-of-file object is returned.  @1 may be omitted, in which case it
+;;defaults to the value returned by @code{current-input-port}.
+;;@findex current-input-port
 (define (read-byte . opt)
   (let ((c (apply read-char opt)))
     (if (eof-object? c) c (char->integer c))))
-(define (bytes . args) (list->bytes args))
-(define (bytes->list bts) (map char->integer (string->list bts)))
-(define (list->bytes lst) (list->string (map integer->char lst)))
+
+;;@noindent
+;;When reading and writing binary numbers with @code{read-bytes} and
+;;@code{write-bytes}, the sign of the length argument determines the
+;;endianness (order) of bytes.  Positive treats them as big-endian,
+;;the first byte input or output is highest order.  Negative treats
+;;them as little-endian, the first byte input or output is the lowest
+;;order.
+;;
+;;@noindent
+;;Once read in, SLIB treats byte sequences as big-endian.  The
+;;multi-byte sequences produced and used by number conversion routines
+;;@pxref{Byte/Number Conversions} are always big-endian.
+
+;;@args n port
+;;@args n
+;;@0 returns a newly allocated bytes-array filled with
+;;@code{(abs @var{n})} bytes read from @2.  If @1 is positive, then
+;;the first byte read is stored at index 0; otherwise the last byte
+;;read is stored at index 0.  Note that the length of the returned
+;;string will be less than @code{(abs @var{n})} if @2 reaches
+;;end-of-file.
+;;
+;;@2 may be omitted, in which case it defaults to the value returned
+;;by @code{current-input-port}.
+(define (read-bytes n . port)
+  (let* ((len (abs n))
+	 (byts (make-bytes len))
+	 (cnt (if (positive? n)
+		  (apply substring-read! byts 0 n port)
+		  (apply substring-read! byts (- n) 0 port))))
+    (if (= cnt len)
+	byts
+	(if (positive? n)
+	    (substring byts 0 cnt)
+	    (substring byts (- len cnt) len)))))
+
+;;@args bytes n port
+;;@args bytes n
+;;@0 writes @code{(abs @var{n})} bytes to output-port @3.  If @2 is
+;;positive, then the first byte written is index 0 of @1; otherwise
+;;the last byte written is index 0 of @1.  @0 returns an unspecified
+;;value.
+;;
+;;@3 may be omitted, in which case it defaults to the value returned
+;;by @code{current-output-port}.
+(define (write-bytes bytes n . port)
+  (if (positive? n)
+      (apply substring-write bytes 0 n port)
+      (apply substring-write bytes (- n) 0 port)))
+
+;;@noindent
+;;@code{substring-read!} and @code{substring-write} provide
+;;lower-level procedures for reading and writing blocks of bytes.  The
+;;relative size of @var{start} and @var{end} determines the order of
+;;writing.
+
+;;@args string start end port
+;;@args string start end
+;;Fills @1 with up to @code{(abs (- @var{start} @var{end}))} bytes
+;;read from @4.  The first byte read is stored at index @1.
+;;@0 returns the number of bytes read.
+;;
+;;@4 may be omitted, in which case it defaults to the value returned
+;;by @code{current-input-port}.
+(define (substring-read! string start end . port)
+  (if (>= end start)
+      (do ((idx start (+ 1 idx)))
+	  ((>= idx end) idx)
+	(let ((byt (apply read-byte port)))
+	  (cond ((eof-object? byt)
+		 (set! idx (+ -1 idx))
+		 (set! end idx))
+		(else (byte-set! string idx byt)))))
+      (do ((idx (+ -1 start) (+ -1 idx))
+	   (cnt 0 (+ 1 cnt)))
+	  ((< idx end) cnt)
+	(let ((byt (apply read-byte port)))
+	  (cond ((eof-object? byt)
+		 (set! idx start)
+		 (set! cnt (+ -1 cnt)))
+		(else (byte-set! string idx byt)))))))
+
+;;@args string start end port
+;;@args string start end
+;;@0 writes @code{(abs (- @var{start} @var{end}))} bytes to
+;;output-port @4.  The first byte written is index @2 of @1.  @0
+;;returns the number of bytes written.
+;;
+;;@4 may be omitted, in which case it defaults to the value returned
+;;by @code{current-output-port}.
+(define (substring-write string start end . port)
+  (if (>= end start)
+      (do ((idx start (+ 1 idx)))
+	  ((>= idx end) (- end start))
+	(apply write-byte (byte-ref string idx) port))
+      (do ((idx (+ -1 start) (+ -1 idx)))
+	  ((< idx end) (- start end))
+	(apply write-byte (byte-ref string idx) port))))