X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=buff-input.lisp;h=36ff2276527c3faa6ec0616937e76f3b1f7ff8d2;hp=fe3f3115146a40d10e2e1b0a748f61f8e53d91cb;hb=14d0c045792f76bbc92f4d3304a608603d0b7524;hpb=5e5cc3c20a925d8af5de153a118fdaf0792dd7e2 diff --git a/buff-input.lisp b/buff-input.lisp index fe3f311..36ff227 100644 --- a/buff-input.lisp +++ b/buff-input.lisp @@ -7,17 +7,19 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: buff-input.lisp,v 1.1 2002/10/06 13:21:47 kevin Exp $ +;;;; $Id: buff-input.lisp,v 1.8 2003/05/06 01:50:04 kevin Exp $ ;;;; -;;;; This file, part of Genutils, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; -;;;; Genutils users are granted the rights to distribute and use this software -;;;; as governed by the terms of the GNU General Public License. +;;;; KMRCL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package :genutils) +(in-package :kmrcl) -(declaim (optimize (speed 3) (safety 0) (space 0) (debug 0))) +(eval-when (:compile-toplevel) + (declaim (optimize (speed 3) (safety 0) (space 0) (debug 0)))) (defconstant +max-field+ 10000) (defconstant +max-fields-per-line+ 20) @@ -38,17 +40,18 @@ (setf (aref bufs i) (make-array max-field-len :element-type 'character :fill-pointer 0 :adjustable nil))) bufs)) -(defun read-buffered-fields (fields strm &optional (field-delim +field-delim+)) +(defun read-buffered-fields (fields strm &optional (field-delim +field-delim+) + (eof 'eof)) "Read a line from a stream into a field buffers" (declare (type base-char field-delim) (type vector fields)) (setf (fill-pointer fields) 0) (do ((ifield 0 (1+ ifield)) (linedone nil) - (eof nil)) - (linedone (if eof 'eof fields)) + (is-eof nil)) + (linedone (if is-eof eof fields)) (declare (type fixnum ifield) - (type boolean linedone eof)) + (type boolean linedone is-eof)) (let ((field (aref fields ifield))) (declare (type base-string field)) (do ((ipos 0) @@ -73,7 +76,7 @@ (setf (fill-pointer fields) ifield) (setq fielddone t) (setq linedone t) - (setq eof t)) + (setq is-eof t)) (t (setf (char field ipos) rc) (incf ipos))))))) @@ -86,9 +89,6 @@ (buffers) (field-lengths)) -(defmethod print-object ((f field-buffers) s) - (format s "#<~d>~%" (field-buffers-nfields f))) - (defun make-fields-buffer2 (&optional (max-fields +max-fields-per-line+) (max-field-len +max-field+)) (let ((bufs (make-array max-fields :element-type 'vector :fill-pointer nil :adjustable nil)) @@ -102,16 +102,17 @@ bufstruct)) -(defun read-buffered-fields2 (fields strm &optional (field-delim +field-delim+)) +(defun read-buffered-fields2 (fields strm &optional (field-delim +field-delim+) + (eof 'eof)) "Read a line from a stream into a field buffers" (declare (character field-delim)) (setf (field-buffers-nfields fields) 0) (do ((ifield 0 (1+ ifield)) (linedone nil) - (eof nil)) - (linedone (if eof 'eof fields)) + (is-eof nil)) + (linedone (if is-eof eof fields)) (declare (fixnum ifield) - (t linedone eof)) + (t linedone is-eof)) (let ((field (aref (field-buffers-buffers fields) ifield))) (declare (simple-string field)) (do ((ipos 0) @@ -136,7 +137,7 @@ (setf (field-buffers-nfields fields) ifield) (setq fielddone t) (setq linedone t) - (setq eof t)) + (setq is-eof t)) (t (setf (char field ipos) rc) (incf ipos))))))) @@ -152,17 +153,18 @@ (let ((linebuffer (make-array +max-line+ :element-type 'character :fill-pointer 0))) - (defun read-buffered-line (strm) + (defun read-buffered-line (strm eof) "Read a line from astream into a vector buffer" + (declare (optimize (speed 3) (space 0) (safety 0))) (let ((pos 0) (done nil)) - (declare (fixnum pos) (t done)) + (declare (fixnum pos) (boolean done)) (setf (fill-pointer linebuffer) 0) (do ((c (read-char strm nil +eof-char+) (read-char strm nil +eof-char+))) (done (progn (unless (eql c +eof-char+) (unread-char c strm)) - (if (eql c +eof-char+) 'eof linebuffer))) + (if (eql c +eof-char+) eof linebuffer))) (declare (character c)) (cond ((char= c #\Newline)