Note the following about the example:
:userpackage. In real user-defined encapsulations, any package can be created and used for the implementation. Of course, do not use the
:exclpackage or any Allegro CL implementation package.
:iodefsmodule is needed at compile-time, to define several of the macros used in the code. Note that the require is compile-time only, as the module is not necessary for normal runtime. However, you can load the module by evaluating
:base-stream argument. That choice of name is arbitrary. The base-stream is obtained from the options argument to each device-open method. It is up to device-open to do any keyword checking that it wants to do. In the examples, the existance of the base-stream keyword it the only thing checked; any other keywords are ignored, as if by
Here are some details about the example:
The class definition for
as superclasses. This ensures that both the input and the output slots
necessary for dual-buffer operation are available, and thus that the
standard string strategy functions will work. No other new slots are
necessary in this class.
The device-open method follows the standard from-scratch style, as described in here. Note that because this is a string-stream, and thus will not be dealing with external-formats, the external-format step is not necessary, and stream-external-format will return :default.
Once the base-stream is determined, buffers, handles, and flags are set up for each direction separately, so that if the base-stream is only open for one direction, the encapsulator will also be open for the same direction only. Buffers are allocated only if not already allocated (which allows reinitialization of the stream if it had been resourced or if change-class had been called on it), and they are allocated according to device-buffer-length (which allows specialization of this stream class for a different default buffer size). Note that no device-buffer-length method is defined; instead the general method defined for simple-stream is used.
The standard string character-strategy functions are used for this stream (note however that a patch is necessary for 6.1 in order for read-line to work correctly -- be sure you have downloaded and installed the patches). install-string-character-strategy will install both input and output functions, regardless of whether the stream is open for both directions or only one. It is the read and write operations which check the validity of each operation on the stream, so that if an operation is performed on the stream in a direction for which the stream is not open, an error will occur.
Since this stream is meant to encapsulate a dual-channel stream, it is possible that the base-stream will be an interactive stream. In Allegro CL, interactive streams are automatically flushed after every format statement, and whenever a pretty-output is printed. This ensures that a prompt will be printed on the output side of the stream before input is waited for on the input side of the stream. The interactive flag is set to the same value of the base-stream, so that the encapsulator will have the same properties.
The device-extend method for this stream class responds to requests made by the strategy functions, and extends the workspace used by the stream. For this encapsulating stream, extension of the workspace is accomplished by filling or flushing the stream's buffer, in a similar manner as is intended with device-read or device-write. Since this stream class is dual-buffered, the direction of the request determines which buffer to use.
There are four actions which device-extend must respond to:
Note that the interactive nature of the base-stream is examined. If the stream is an interactive stream, it would be unfriendly to block after a newline had been read, because usually such a stream (e.g. a terminal stream) is expecting line-by-line processing to occur. Thus, if the stream is interactive, and if a newline appears in the input, the the input action doesn't bother filling the need request.
This is the basic workhorse routine for rot13. The input character is
rotated within the alphabet if it is an alphabetic character, and
leftg alone otherwise. Due to the nature of the rot13 algorithm,
given any character char,
char)) will always return char.
These three functions are provided to explicitly override the actions of the more general string methods. Because this encapsulating stream is intended for dual-channel streams like sockets and files, the concepts of position and length make no sense, and thus these methods do nothing and return nil.
In a workspace-style stream (one which uses device-extend instead of device-read and device-write), the device-write method is used solely as a means of forcing output. It will only be called with a start of 0, the out-pos slot passed as the end argument, and a blocking argument of nil (for force-output) or t (for finish-output). This stream-class implementation also calls device-write from the device-extend method, because it is convenient to do so. See the description of device-extend above.
In order to flush the out-buffer, the characters must be rotated first, after whichwrite-vector is used to send the buffer contents to the base-stream. Since write-vector may return a smaller value than the full amount specified by its start and end arguments, the return value must be examined and the write continued if the first was incomplete.
Here is the source for the example:
;; copyright (c) 1985 Franz Inc, Alameda, Ca. ;; copyright (c) 1986-2002 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are ;; given in confidence by Franz, Inc. pursuant to a written license ;; agreement, and may be stored and used only in accordance with the terms ;; of such license. ;; ;; Restricted Rights Legend ;; ------------------------ ;; Use, duplication, and disclosure of the software, data and information ;; contained herein by any agency, department or entity of the U.S. ;; Government are subject to restrictions of Restricted Rights for ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; Bidirectional (dual channel) rot13 encapsulator (in-package :user) (eval-when (compile) (require :iodefs)) (def-stream-class rot13-bidirectional-stream (string-input-simple-stream string-output-simple-stream) ()) (defmethod device-open ((stream rot13-bidirectional-stream) options) (let ((base-stream (getf options :base-stream))) (if base-stream (with-stream-class (rot13-bidirectional-stream stream) (when (input-stream-p base-stream) (unless (sm excl::buffer stream) (setf (sm excl::buffer stream) (make-string (device-buffer-length stream)))) (setf (sm excl::input-handle stream) base-stream) (add-stream-instance-flags stream :string :input :simple)) (when (output-stream-p base-stream) (unless (sm excl::out-buffer stream) (setf (sm excl::out-buffer stream) (make-string (device-buffer-length stream)))) (setf (sm excl::max-out-pos stream) (length (sm excl::out-buffer stream))) (setf (sm excl::output-handle stream) base-stream) (add-stream-instance-flags stream :string :output :simple)) (install-string-character-strategy stream) (when (interactive-stream-p base-stream) (setf (interactive-stream-p stream) t)) t) (progn (error "rot13-bidirectional-stream needs a :base-stream") nil)))) (defmethod device-extend ((stream rot13-bidirectional-stream) need action) (with-stream-class (rot13-bidirectional-stream stream) (let ((base-stream (or (sm excl::input-handle stream) ; One of these should (sm excl::output-handle stream)))) ; be non-nil (ecase action (:input-check (let* ((buffer (sm excl::buffer stream)) (len (length buffer))) (setf (sm excl::buffpos stream) 0) (when (read-no-hang-p base-stream) (let ((res (read-vector buffer base-stream :start 0 :end len))) (when (<= res 0) (setf (sm excl::buffer-ptr stream) 0) (return-from device-extend nil)) (dotimes (i res) (setf (char buffer i) (rotate-char (char buffer i)))) (setf (sm excl::buffer-ptr stream) res) t)))) (:input (let* ((buffer (sm excl::buffer stream)) (len (length buffer)) (cur 0) (saw-newline nil) (interactive (interactive-stream-p base-stream))) (setf (sm excl::buffpos stream) 0) (loop (let ((res (read-vector buffer base-stream :start cur :end len))) (when (<= res 0) (setf (sm excl::buffer-ptr stream) cur) (return-from device-extend (> cur 0))) (do ((i cur (1+ i)) (j 0 (1+ j))) ((eq j res)) (let ((char (char buffer i))) ;; This hack is to allow *terminal-io* to do something ;; on a per-line basis (when (and (eql #\Newline char) interactive) (setq saw-newline t)) (setf (char buffer i) (rotate-char char)))) (incf cur res) (when (or (>= cur need) saw-newline) (setf (sm excl::buffer-ptr stream) cur) (return t)))))) (:output-check (write-no-hang-p base-stream)) (:output (let ((res (device-write stream (sm excl::out-buffer stream) 0 (sm excl::out-pos stream) t))) (when (> res 0) (setf (sm excl::out-pos stream) 0) t))))))) (defun rotate-char (char) (unless (alpha-char-p char) (return-from rotate-char char)) (let ((code (char-code char))) (cond ((<= #.(char-code #\A) code #.(char-code #\Z)) (code-char (+ #.(char-code #\A) (mod (+ 13 (- code #.(char-code #\A))) 26)))) (t ;; assume ascii; must be lowercase letter (code-char (+ #.(char-code #\a) (mod (+ 13 (- code #.(char-code #\a))) 26))))))) (defmethod device-file-length ((stream rot13-bidirectional-stream)) nil) (defmethod device-file-position ((stream rot13-bidirectional-stream)) nil) (defmethod (setf device-file-position) (new-value (stream rot13-bidirectional-stream)) (declare (ignore new-value)) nil) (defmethod device-write ((stream rot13-bidirectional-stream) buffer start end blocking) (declare (ignore blocking)) (when (and (null buffer) (not (eq start end))) (with-stream-class (rot13-bidirectional-stream) (setq buffer (sm excl::out-buffer stream)))) (with-stream-class (rot13-bidirectional-stream stream) (let ((base-stream (sm excl::output-handle stream))) (if (and base-stream (> end start)) (let ((cur start)) (do ((i start (1+ i))) ((>= i end)) (setf (char buffer i) (rotate-char (char buffer i)))) (loop (let ((res (write-vector buffer base-stream :start cur :end end))) (cond ((< res 0) (return-from device-write res)) ((= res 0) (return-from device-write cur))) (incf cur res) (when (>= cur end) (return-from device-write cur))))) 0)))) ;;;---------------end------------------------
Return to encapsulating streams entry.
|Copyright © 2016 Franz Inc., All Rights Reserved | Privacy Statement||