Artifact 272df1beb7809c17185f95b95c27a8481f5b2902ea9c1908063baac41faeb972:

• File psl-1983/emode/input-stream.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 7517) [annotate] [blame] [check-ins using] [more...]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Input-Stream.SL (TOPS-20 Version) - File Input Stream Objects
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        29 July 1982
%
% This package is 6.6 times faster than the standard unbuffered I/O.
% (Using message passing, it is only 1.7 times faster.)
%
% Note: this code will only run COMPILED.
%
% See TESTING code at the end of this file for examples of use.
% Be sure to include "(CompileTime (load objects))" at the beginning
% of any file that uses this package.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(BothTimes (load objects jsys))

(defun open-input (file-name)
  (let ((s (make-instance 'input-stream)))
    (=> s open file-name)
    s))

%(CompileTime (setq *pgwd t))

(CompileTime (setq FILE-BUFFER-SIZE (* 5 512)))

(defflavor input-stream ((jfn NIL)	% TOPS-20 file number
			ptr		% "pointer" to next char in buffer
			count		% number of valid chars in buffer
			eof-flag	% T => this bufferfull is the last
			file-name	% full name of actual file
			buffer		% input buffer
			)
  ()
  (gettable-instance-variables file-name)
  )

% Note: The JSYS function can't be used for the 'SIN' JSYS because the function
% handles errors.  The 'SIN' JSYS will report an error on end-of-file if errors
% are being handled.

(CompileTime (put 'sin 'OpenCode '((jsys 42) (move (reg 1) (reg 3)))))
(CompileTime (put 'closf 'OpenCode '((jsys 18) (move (reg 1) (reg 1)))))

(defmethod (input-stream getc) ()

    % Return the next character from the file.  Line termination
    % is represented by a single NEWLINE (LF) character.

    % Note: returns NIL on end of file.

    (if (WLessP ptr count)
        (let ((ch (prog1
		    (igets buffer ptr)
		    (setf ptr (wplus2 ptr 1))
		    )))
	  % Ignore CR's
	  (if (WNEq ch (char CR)) ch (input-stream$getc self))
	  )
	(input-stream$fill-buffer-and-getc self)
	))

% The above function was coded to produce good compiled code
% using the current PSL compiler.  Here's the output.  Note
% that no stack variables are used.  The main path uses 16
% instructions.  There is room for improvement.

%               (*ENTRY INPUT-STREAM$GETC EXPR 1)
% G0002         (MOVE (REG 4) (REG 1))
%               (MOVE (REG T1) (INDEXED (REG 1) 6))
%               (CAMG (REG T1) (INDEXED (REG 1) 5))
%               (JRST G0004)
%               (MOVE (REG 2) (INDEXED (REG 1) 5))
%               (MOVE (REG 1) (INDEXED (REG 1) 4))
%               (AOS (REG 1))
%               (ADJBP (REG 2) "L0010")
%               (LDB (REG 1) (REG 2))
%               (MOVE (REG 3) (REG 1))
%               (MOVE (REG 1) (INDEXED (REG 4) 5))
%               (AOS (REG 1))
%               (MOVEM (REG 1) (INDEXED (REG 4) 5))
%               (MOVE (REG 1) (REG 3))
%               (CAIE (REG 1) 13)
%               (JRST G0001)
%               (MOVE (REG 1) (REG 4))
%               (JRST G0002)
% G0004         (JRST (ENTRY INPUT-STREAM$FILL-BUFFER-AND-GETC))
% G0001         (POPJ (REG ST) 0)
% L0010         (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))

(defmethod (input-stream fill-buffer-and-getc) ()

  % Implementation note: Removing all of this code from GETC improves the
  % quality of the compiled code for GETC.  In particular, the compiler is able
  % to keep SELF in a register, instead of saving it in a stack variable and
  % (excessively) reloading it every time it is needed.  Making this change
  % increased the performance of buffered input from 4X to 6.6X the standard
  % unbuffered input.

  (if eof-flag
      NIL
      (let ((n (sin jfn (jconv buffer) (WDifference 0 #.FILE-BUFFER-SIZE))))
        (if (not (WEQ n 0)) (setf eof-flag T))
        (setf count (WPlus2 #.FILE-BUFFER-SIZE n))
        (setf ptr 0)
        (input-stream$getc self))))

(defmethod (input-stream getc-image) ()

    % Return the next character from the file.  Do not perform
    % any translation.  In particular, return all <CR>s.
    % Returns NIL on end of file.

    (if (WLessP ptr count)
        (prog1
	 (igets buffer ptr)
	 (setf ptr (wplus2 ptr 1))
	 )
	(input-stream$fill-buffer-and-getc-image self)
	))

(defmethod (input-stream fill-buffer-and-getc-image) ()

  (if eof-flag
      NIL
      (let ((n (sin jfn (jconv buffer) (WDifference 0 #.FILE-BUFFER-SIZE))))
        (if (not (WEQ n 0)) (setf eof-flag T))
        (setf count (WPlus2 #.FILE-BUFFER-SIZE n))
        (setf ptr 0)
        (input-stream$getc-image self))))

(defmethod (input-stream empty?) ()
  (null (input-stream$peekc self)))

(defmethod (input-stream peekc) ()

    % Return the next character from the file, but don't advance
    % to the next character.  Returns NIL on end of file.

    (if (WLessP ptr count)
        (let ((ch (igets buffer ptr)))
	  % Ignore CR's
	  (if (WNEq ch (char CR))
	      ch
	      (setf ptr (wplus2 ptr 1))
	      (input-stream$peekc self))
	  )
	(input-stream$fill-buffer-and-peekc self)
	))

(defmethod (input-stream fill-buffer-and-peekc) ()

  (if eof-flag
      NIL
      (let ((n (sin jfn (jconv buffer) (WDifference 0 #.FILE-BUFFER-SIZE))))
        (if (not (WEQ n 0)) (setf eof-flag T))
        (setf count (WPlus2 #.FILE-BUFFER-SIZE n))
        (setf ptr 0)
        (input-stream$peekc self))))

(defmethod (input-stream open) (name-of-file)

  % Open the specified file for input via SELF.  If the file cannot
  % be opened, a Continuable Error is generated.

  (if jfn (input-stream$close self))
  (setf buffer (MkString #.FILE-BUFFER-SIZE (char space)))
  (setf ptr 0)
  (setf count 0)
  (setf eof-flag NIL)
  (setf jfn (Dec20Open name-of-file 
	         (int2sys 2#001000000000000001000000000000000000)
	         (int2sys 2#000111000000000000010000000000000000)
	         ))
  (if (= jfn 0) (setf jfn NIL))
  (if (null jfn)
   (=> self open
       (ContinuableError 0
		         (BldMsg "Unable to Open '%w' for Input." name-of-file)
		         name-of-file))
   (setf file-name (MkString 200 (char space)))
   (jsys1 file-name jfn #.(bits 2 5 8 11 14 35) 0 #.(get 'jsJFNS 'NewNam))
   (setf file-name (recopystringtonull file-name))
   ))

(defmethod (input-stream close) ()
  (if jfn (progn
	    (closf jfn)
	    (setf jfn NIL)
	    (setf buffer NIL)
	    (setf count 0)
	    (setf ptr 0)
	    (setf eof-flag T)
	    )))


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% TESTING CODE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CommentOutCode (progn

(de test-buffered-input (name-of-file)
  (setq s (open-input name-of-file))
  (while (setq ch (input-stream$getc s))
    (WriteChar ch)
    )
  (=> s close)
  (Prin2 "---EOF---")
  NIL
  )

(de time-buffered-input (name-of-file)
  (setq start-time (time))
  (setq s (open-input name-of-file))
  (while (setq ch (input-stream$getc s))
    )
  (=> s close)
  (- (time) start-time)
  )

(de time-buffered-input-1 (name-of-file)
  (setq start-time (time))
  (setq s (open-input name-of-file))
  (while (setq ch (=> s getc))
    )
  (=> s close)
  (- (time) start-time)
  )

(de time-standard-input (name-of-file)
  (setq start-time (time))
  (setq chan (open name-of-file 'INPUT))
  (while (not (= (setq ch (ChannelReadChar chan)) (char EOF)))
    )
  (close chan)
  (- (time) start-time)
  )

(de time-input (name-of-file)
  (list
    (time-buffered-input name-of-file)
    (time-buffered-input-1 name-of-file)
    (time-standard-input name-of-file)
    ))

)) % End CommentOutCode