Re: File IO info

[Bill St. Clair <bill>]

   From: co19c461@serc.3m.com (Paul L. Krueger)
   Subject: File IO info
   To: info-macl@cambridge.apple.com
   Date: Tue, 11 Sep 90 17:39:29 CDT
   X-Mailer: ELM [version 2.2 PL10]
   
   I have written routines to read and show picts from pict files.  These
   work correctly but are quite slow for some kinds of picts (although they
   seem pretty reasonable for others).  The reason is that I need to read
   the pict file as a binary file and CL only has read-byte defined.
   Consequently I have to create a loop to read each byte and put it into
   the buffer specified by the draw-pict routine.  It would be nice to have
   something like FSRead where I could just specify how many bytes to read
   and where to put them.  I've considered going to the low-level file
   routines but was hoping to use as much as possible of what ACL already
   does.  Inspecting an open binary file shows a field called CCL::FBLOCK
   which I was hoping might be a pointer to a ParamBlockRec but it doesn't
   seem to be (or I've done something wrong with the record definition).
   
   I need to know a couple of things.  Can I make use of FBLOCK in some way
   to accomplish what I need to, and if so what kinds of problems might I
   create for Lisp's file management?  Any help is appreciated.
   Paul Krueger (plkrueger@serc.3m.com)
   

I snapped awake at 4:00 this morning with the answer to your problem
in my head.  Since it was useless to try to sleep through the
resounding noise of the idea, I got up and coded it.  It's based on a
concept that I added to MACL 2.0 last week.  The version here just
does character I/O, but you can always use CHAR-CODE to get a byte.
It timed at about 5 times faster than READ-CHAR on my IIcx.  The code
is also in our anonymous FTP directory:

   cambridge.apple.com
   /pub/MACL/CONTRIB/fast-file-io.lisp

If this is not fast enough for you, it's possible to use the
ParamBlockRec's in the FBLOCK to do the I/O directly to your buffer
(though it won't be as easy as the code below, and I won't have time
to do it until October sometime).

Enjoy!

Bill

---------------------------------------------------------------------------

; fast-file-io.lisp
; for MACL 1.3 (should work for 1.2.2 as well, modulo magic numbers)
;
; Bill St. Clair
; Apple Computer, Inc.
; bill@cambridge.apple.com
;
; This implements a concept that will be fully supported in MACL 2.0
;
; (ask stream (stream-reader))
; returns two values: a function and an argument.
; Calling the function on the argument is the same as calling
; READ-CHAR on the stream, except it's faster.
;
; (ask stream (stream-writer))
; returns two values: a function and an argument.
; Calling the function on the argument and a character is the same as calling
; WRITE-CHAR on the stream and the character, except it's faster.
;
; There is an example of use at the bottom of this file.


; Will load successfully in any package that uses LISP & CCL (e.g. USER or CCL)
(export '(stream-reader stream-writer))


; I have tested this code in MACL 1.3.2 & 1.3.1.
; If you are running a different version of MACL, you may need to change the
; values of the parameters *FILE-TYI-SUBPRIM* and *FILE-TYO-SUBPRIM* below.

; MACL file I/O keeps a parameter block in the CCL::FBLOCK variable of
; a CCL::*FILE-STREAM* instance.  The FBLOCK is passed to a subprim to
; do I/O.  Disassembly shows the subprim number (look for the last
; number in the disassembly):
#|
? (disassemble (ask ccl::*file-stream* #'stream-tyi))

(10 MOVEQ 0 D0)
(12 JSR_SUBPRIM $FNENTRY0)
(16 VPUSH 'CCL::FBLOCK)
(20 JSR_SUBPRIM $SYMEVAL)
(24 SET_NARGS 1)
(26 JSR_SUBPRIM $QNSLIDE)
(30 JMP_SUBPRIM 6626)                 ; <===*** here
|#

(defparameter *file-tyi-subprim* 6626)

#|
? (disassemble (ask ccl::*file-stream* #'stream-tyo))
(10 MOVEQ 4 D0)
(12 JSR_SUBPRIM $FNENTRY)
(16 VPUSH 'CCL::DIRECTION)
(20 JSR_SUBPRIM $SYMEVAL)
(24 VPOP D7)
(26 CMP.L ':OUTPUT D7)
(30 BNE.S (LABEL 70))
(32 MOVE.L (VSP 4) D7)
(36 CMP.L '#\Newline D7)
(40 BNE.S (LABEL 48))
(42 MOVEQ 0 D7)
(44 BSET TREG D7)
(46 BRA.S (LABEL 62))
((LABEL 48) VPUSH 'CCL::COLUMN)
(52 JSR_SUBPRIM $SYMEVAL)
(56 VPOP D7)
(58 JSR_SUBPRIM $ADD1ACC)
((LABEL 62) MOVE.L 'CCL::COLUMN A0)
(66 JSR_SUBPRIM $QSETQSYM)
((LABEL 70) VPUSH 'CCL::FBLOCK)
(74 JSR_SUBPRIM $SYMEVAL)
(78 VPUSH (VSP 8))
(82 SET_NARGS 2)
(84 JSR_SUBPRIM $QNSLIDE)
(88 JMP_SUBPRIM 6634)                 ; <===*** here
|#

(defparameter *file-tyo-subprim* 6634)

; These low-level functions are patched below to jump directly to
; the subprimitives.
; Note that since FILE-STREAM-TYO does not maintain the CCL::COLUMN
; variable, you can't use it for pretty printing to a file.
; You can probably figure it out if you need to do that (I have faith).
(defun file-stream-tyi (fblock)
  fblock)

(defun file-stream-tyo (fblock char)
  (declare (ignore fblock))
  char)

; The patcher.
(defun make-subprim-call (function subprim-number)
  (if (symbolp function) (setq function (symbol-function function)))
  (check-type function compiled-function)
  (check-type subprim-number fixnum)
  (let ((addr (%ptr-to-int function)))
    (%put-word addr #x4eed)    ; jmp_subprim = jmp xxx(a5)
    (%put-word (+ addr 2) subprim-number)
    function))

; Do the magic.
; Remember to disassemble and check *file-tyi-subprim* & *file-tyo-subprim*
; for the correct values.
(make-subprim-call #'file-stream-tyi *file-tyi-subprim*)
(make-subprim-call #'file-stream-tyo *file-tyo-subprim*)

; And the interface for users.
; Note that it won't return the optimized version if stream-tyi is shadowed.
(defobfun (stream-reader ccl::*file-stream*) ()
  (let ((stream-tyi #'stream-tyi))
    (if (eq stream-tyi (ask ccl::*file-stream* #'stream-tyi))
      (values #'file-stream-tyi (objvar ccl::fblock))
      (values stream-tyi (self)))))

(defobfun (stream-writer ccl::*file-stream*) ()
  (let ((stream-tyo #'stream-tyo))
    (if (eq stream-tyo (ask ccl::*file-stream* #'stream-tyo))
      (values #'file-stream-tyo (objvar ccl::fblock))
      (values stream-tyo (self)))))

; Some defaults so code will work for other streams.
(defobfun (stream-reader ccl::*stream*) ()
  (values #'stream-tyi (self)))

(defobfun (stream-writer ccl::*stream*) ()
  (values #'stream-tyo (self)))

#|
; Test it
(defun slow-copy-stream (from to)
  (loop (let ((char (read-char from nil)))
          (if char (write-char char to) (return)))))

(defun fast-copy-stream (reader reader-arg writer writer-arg)
  (loop (let ((char (funcall reader reader-arg)))
          (if char (funcall writer writer-arg char) (return)))))

(defun slow-copy-file (input-file &optional (output-file "temp.tmp"))
  (with-open-file (input-stream input-file :direction :input)
    (with-open-file (output-stream output-file 
                                   :direction :output
                                   :if-exists :supersede)
      (time
       (slow-copy-stream input-stream output-stream)))))

(defun fast-copy-file (input-file &optional (output-file "temp.tmp"))
  (with-open-file (input-stream input-file :direction :input)
    (with-open-file (output-stream output-file 
                                   :direction :output
                                   :if-exists :supersede)
      (multiple-value-bind (reader reader-arg)
                           (ask input-stream (stream-reader))
        (multiple-value-bind (writer writer-arg)
                             (ask output-stream (stream-writer))
          (time
           (fast-copy-stream reader reader-arg writer writer-arg)))))))

; I ran these on a IIcx
(slow-copy-file "ccl;fast-file-io.lisp")
;(SLOW-COPY-STREAM INPUT-STREAM OUTPUT-STREAM) took 163 ticks (2.717 seconds) to run.
(fast-copy-file "ccl;fast-file-io.lisp")
;(FAST-COPY-STREAM READER READER-ARG WRITER WRITER-ARG) took 29 ticks (0.483 seconds) to run.

|#