Note the following about the example:

• The code is set in the :user package. In real user-defined encapsulations, any package can be created and used for the implementation. Of course, do not use the :excl package or any Allegro CL implementation package.
• The :iodefs module 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 (require :iodefs).
• The encapsulatee is specified by the :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 :allow-other-keys.
• The setting of one or both handle slots to the base-stream is what establishes the connection to the "device" (in this case, another stream). Because the encapsulatee is an open stream, the connection made by the setting of handles is what satisfies device-open's requirement to establish the connection.
• One common error that a device-level programmer might make is to forget to return a non-nil value from the device-open method. This will always result in a closed stream, since the shared-initialize :after method on simple-streams always calls device-close if the device-open method returns nil.

Here are some details about the example:

The class definition for rot13-bidirectional-stream has both string-input-simple-stream and string-output-simple-stream 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.

Device-open:

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.

Device-extend:

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:

1. :input -- The :input action reads data into the buffer via read-vector, and then rotates what it has read. Because the bnb nature of read-vector only guarantees that one octet will actually be read, the operation is iterated in a loop until at least the need argument is satisfied.

   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.

2. :input-check -- In order for input to be available, attempts to actually read must be made in non-blocking mode. The :input-check action can be simpler than the :input action, because it never needs more than 1 octet. However, if it is able to read at least one octet, it must rotate whatever it gets and update the buffpos and buffer-ptr slots. The lower-level read is done via read-vector, but since read-vector always reads in bnb mode, the first octet might block. Thus, read-no-hang-p must check for the possibility of blocking before doing the read.
3. :output-check -- Checking whether output is available is relatively trivial, and is implemented using write-no-hang-p.
4. :output -- This stream-class implementation uses device-write for the :output action, because it is convenient to do so. If the device-level programmer were to want to lock out any possibility for specializing the device-write method, or wanted to avoid overhead in the CLOS discrimination for device-write, the guts of the device-write method could be duplicated here, or a non-generic function could be created and called in both places. See the description of device-write for further explanation.

rotate-char:

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, (rotate-char (rotate-char char)) will always return char.

device-file-length, device-file-position, (setf device-file-length):

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.

Device-write:

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.

Return to Tech Corner Archive page. Go to the main Tech Corner page.