NonPositionableExternalStream.st
author Stefan Vogel <sv@exept.de>
Mon, 22 Jun 2015 11:24:02 +0200
changeset 18494 41f8a86105f0
parent 18398 d08f2a7c9601
child 18403 9a3fc7cc7127
child 18798 0b4860a5c695
permissions -rw-r--r--
class: UnixOperatingSystem changed: #syncFileSystem: disable - defined only in glibc 2.14, but we need to support glibc 2.12

"{ Encoding: utf8 }"

"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

ExternalStream subclass:#NonPositionableExternalStream
	instanceVariableNames:''
	classVariableNames:'StdInStream StdOutStream StdErrorStream'
	poolDictionaries:''
	category:'Streams-External'
!

!NonPositionableExternalStream primitiveDefinitions!
%{

#ifndef _STDIO_H_INCLUDED_
# include <stdio.h>
# define _STDIO_H_INCLUDED_
#endif

#ifndef REMOVE_LATER
# define __win32_stdout()        stdout
# define __win32_stderr()        stderr
# define __win32_stdin()         stdin
#else
    extern FILE *__win32_stdin();
    extern FILE *__win32_stderr();
    extern FILE *__win32_stdout();
#endif

%}

! !

!NonPositionableExternalStream class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    This class provides common protocol for all non-positionable,
    external streams. Concrete subclasses are terminal streams, pipe streams,
    PrinterStreams, Sockets etc.

    There are three special instances of this class, representing stdin,
    stdout and stderr of the smalltalk/X process (see Unix manuals, if you
    dont know what those are used for). These special streams are bound to
    to globals Stdin, Stdout and Stderr at early initialization time
    (see Smalltalk>>initializeStandardStreams).

    The name of this class is a historical leftover - it should be called
    'TTYStream' or similar.

    [author:]
	Claus Gittinger
"
! !

!NonPositionableExternalStream class methodsFor:'instance creation'!

forStderr
    "{ Pragma: +optSpace }"

    "return a NonPositionableExternalStream object for writing to
     Unixes standard error output file descriptor"

    StdErrorStream isNil ifTrue:[
	StdErrorStream := self basicNew initializeForStderr
    ].
    ^ StdErrorStream
!

forStdin
    "{ Pragma: +optSpace }"

    "return a NonPositionableExternalStream object for reading from
     Unixes standard input file descriptor"

    StdInStream isNil ifTrue:[
	StdInStream := self basicNew initializeForStdin
    ].
    ^ StdInStream
!

forStdout
    "{ Pragma: +optSpace }"

    "return a NonPositionableExternalStream object for writing to
     Unixes standard output file descriptor"

    StdOutStream isNil ifTrue:[
	StdOutStream := self basicNew initializeForStdout
    ].
    ^ StdOutStream
!

makePTYPair
    "return an array with two streams - the first one is the master,
     the second the slave of a ptym/ptys pair.
     This is much like a bidirectional pipe, but allows signals &
     control chars to be passed through the connection.
     This is needed to execute a shell in a view.
     This is the higher level equivalent of OperatingSystem>>makePTYPair
     (which returns an array of file-descriptors)."

    |ptyPair master slave|

    ptyPair := OperatingSystem makePTYPair.
    ptyPair notNil ifTrue:[
	master := self forReadWriteToFileDescriptor:(ptyPair at:1).
	master buffered:false.
	slave := self forReadWriteToFileDescriptor:(ptyPair at:2).
	slave buffered:false.
	ptyPair at:1 put:master.
	ptyPair at:2 put:slave.
	^ ptyPair
    ].
    ^ nil

    "
     ExternalStream makePTYPair.
    "

    "Modified: 29.2.1996 / 18:28:36 / cg"
!

makePipe
    "return an array with two streams - the first one for reading,
     the second for writing.
     This is the higher level equivalent of OperatingSystem>>makePipe
     (which returns an array of file-descriptors)."

    |pipe rs ws|

    pipe := OperatingSystem makePipe.
    pipe isNil ifTrue:[
	"/ ok, maybe someone has forgotten to close a stream; enforce finalization and try again
	'makePipe: enforcing finalization to close any open streams' infoPrintCR.
	ObjectMemory garbageCollect; finalize.
	pipe := OperatingSystem makePipe.
    ].

    pipe notNil ifTrue:[
	rs := self forFileDescriptor:(pipe at:1) mode:#readonly buffered:false handleType:#pipeFilePointer.
	ws := self forFileDescriptor:(pipe at:2) mode:#writeonly buffered:false handleType:#pipeFilePointer.
	^ Array with:rs with:ws
    ].
    ^ nil

    "
     |pipe rs ws|

     pipe := NonPositionableExternalStream makePipe.
     rs := pipe at:1.
     ws := pipe at:2.

     'read ...'.
     [
	 1 to:10 do:[:i |
	     Transcript showCR:rs nextLine
	 ].
	 rs close.
     ] forkAt:7.

     'write ...'.
     [
	 1 to:10 do:[:i |
	     ws nextPutAll:'hello world '; nextPutAll:i printString; cr
	 ].
	 ws close.
     ] fork.
    "

    "Modified: 29.2.1996 / 18:28:36 / cg"
! !

!NonPositionableExternalStream methodsFor:'accessing'!

buffered:aBoolean
    "do not allow to change to buffered mode - ignore true here"

    aBoolean ifFalse:[
	super buffered:false.
    ].
! !

!NonPositionableExternalStream methodsFor:'error handling'!

positionError
    "{ Pragma: +optSpace }"

    "notify that this stream has no concept of a position"

    ^ PositionError raiseRequestWith:self

    "
     Stderr positionError
    "
! !

!NonPositionableExternalStream methodsFor:'initialization'!

initialize
    "non-positionable streams do not work well when buffered"

    super initialize.
    buffered := false.
! !

!NonPositionableExternalStream methodsFor:'non homogenous reading'!

nextBytes:count into:anObject startingAt:start
    "read the next count bytes into an object and return the number of
     bytes read or the number of bytes read, if EOF is encountered before.
     An exception is raised if the connection is broken.

     Redefined here to avoid blocking of ST/X when waiting for io.
     Instead only the calling thread will block"

    |remaining offset nRead|

    count == 0 ifTrue:[
	^ 0.
    ].

    remaining := count.
    offset := start.

    [
	nRead := self nextAvailableBytes:remaining into:anObject startingAt:offset.
	nRead == 0 ifTrue:[
	    "atEnd does a readWait"
	    self atEnd not.
	] ifFalse:[
	    remaining := remaining - nRead.
	    offset := offset + nRead.
	    remaining ~~ 0.
	]
    ] whileTrue.

    ^ count - remaining
! !

!NonPositionableExternalStream methodsFor:'positioning'!

position
    "{ Pragma: +optSpace }"

    "catch position - there is none here"

    ^ self positionError
!

position:aPosition
    "{ Pragma: +optSpace }"

    "catch position - there is none here"

    ^ self positionError
!

skip:numberToSkip
    "skip count bytes/characters, return the receiver.
     Re-redefined since PositionableStream redefined it."

    "don't know how to unread ..."
    numberToSkip < 0 ifTrue:[
	PositionError raiseRequest.
	^ self
    ].
    numberToSkip timesRepeat:[self next].

    "Modified: / 30.7.1999 / 12:42:12 / cg"
! !

!NonPositionableExternalStream methodsFor:'printing & storing'!

printOn:aStream
    "{ Pragma: +optSpace }"

    "append a user printed representation of the receiver to aStream.
     The format is suitable for a human - not meant to be read back."

    |myName|

    self == Stdin ifTrue:[
	myName := 'Stdin'.
    ] ifFalse:[
	self == Stdout ifTrue:[
	    myName := 'Stdout'.
	] ifFalse:[
	    self == Stderr ifTrue:[
		myName := 'Stderr'.
	    ]
	]
    ].

    myName notNil ifTrue:[
	aStream nextPutAll:myName.
	^ self
    ].
    super printOn:aStream
!

storeOn:aStream
    "{ Pragma: +optSpace }"

    "append a printed representation of the receiver on aStream, from
     which the receiver can be reconstructed."

    ((self == Stdin)
    or:[self == Stdout
    or:[self == Stderr]]) ifTrue:[
	^ self printOn:aStream
    ].
    super storeOn:aStream
! !

!NonPositionableExternalStream methodsFor:'private'!

handleForStderr
    "{ Pragma: +optSpace }"

    "return a stderr handle"

%{
#ifdef __SCHTEAM__
    return context._RETURN( StandardErrorStream );
#else
# ifdef WIN32
    RETURN ( __MKEXTERNALADDRESS( __win32_stderr() ));
# else
    RETURN ( __MKEXTERNALADDRESS(stderr) );
# endif
#endif
%}
!

handleForStdin
    "{ Pragma: +optSpace }"

    "return a stdin handle"

%{
#ifdef __SCHTEAM__
    return context._RETURN( StandardInputStream );
#else
# ifdef WIN32
    RETURN ( __MKEXTERNALADDRESS( __win32_stdin() ));
# else
    RETURN ( __MKEXTERNALADDRESS(stdin) );
# endif
#endif
%}
!

handleForStdout
    "{ Pragma: +optSpace }"

    "return a stdout handle"

%{
#ifdef __SCHTEAM__
    return context._RETURN( StandardOutputStream );
#else
# ifdef WIN32
    RETURN ( __MKEXTERNALADDRESS( __win32_stdout() ));
# else
    RETURN ( __MKEXTERNALADDRESS(stdout) );
# endif
#endif
%}
!

initializeForStderr
    "{ Pragma: +optSpace }"

    "setup for writing to stderr"

    mode := #readwrite.
    buffered := false.
    handle := self handleForStderr.
    handleType := #filePointer.
    OperatingSystem isMSWINDOWSlike ifTrue:[
	eolMode := #crlf
    ]
!

initializeForStdin
    "{ Pragma: +optSpace }"

    "setup for reading stdin"

    mode := #readonly.
    "/ buffered := true.
    buffered := false.
    handleType := #filePointer.
    handle := self handleForStdin.
!

initializeForStdout
    "{ Pragma: +optSpace }"

    "setup for writing to stdout"

    mode := #readwrite.
    buffered := false.
    handle := self handleForStdout.
    handleType := #filePointer.
    OperatingSystem isMSWINDOWSlike ifTrue:[
	eolMode := #crlf
    ]
!

reOpen
    "{ Pragma: +optSpace }"

    "reopen the stream after an image restart.
     If I am one of the standard streams, reopen is easy"

    (self == StdInStream) ifTrue:[
	^ self initializeForStdin
    ].
    (self == StdOutStream) ifTrue:[
	^ self initializeForStdout
    ].
    (self == StdErrorStream) ifTrue:[
	^ self initializeForStderr
    ].
    ^ super reOpen
! !

!NonPositionableExternalStream methodsFor:'queries'!

atEnd
    "return true, if position is at end"

    (self == StdInStream) ifTrue:[
	OperatingSystem hasConsole ifFalse:[
	    ^ true
	]
    ].

    "first, wait to avoid blocking on the read.
     On end of stream or error, readWait will return"

    self readWait.
    ^ super atEnd.
!

collectionSize
    "we do not know our size"

    ^ self positionError
!

isPositionable
    "return true, if the stream supports positioning (this one is not)"

    ^ false
!

remainingSize
    "we do not know our size"

    ^ self positionError
!

size
    "we do not know our size"

    ^ self positionError
! !

!NonPositionableExternalStream methodsFor:'reading'!

readWait
    "cannot do a readWait (which means possible suspend),
     if the processor is not yet initialized; i.e. if a read is attempted
     during early startup.
     This may happen, for example, if a MiniDebugger is entered, before
     process scheduling has been setup.
     In this case, all I/O operations here will be blocking."

    Smalltalk isInitialized ifFalse:[ ^ false ].
    ^ super readWait
!

next
    "return the next element, if available.
     If nothing is available, this does never raise a read-beyond end signal.
     Instead, nil is returned immediately.

     Redefined, to wait on pipes and sockets"

    self readWait.
    ^ super next
!

nextLine
    "Redefined, to wait on pipes and sockets"

    self readWait.
    ^ super nextLine
!

nextOrNil
    "like #next, this returns the next element, if available.
     If nothing is available, this does never raise a read-beyond end signal.
     Instead, nil is returned immediately.

     Redefined, to wait on pipes and sockets"

    self atEnd ifTrue:[^ nil].
    ^ super nextOrNil
!

peek
    "Redefined, to wait on pipes and sockets"

    self readWait.
    ^ super peek
!

peekOrNil
    "like #peek, this returns the next element, if available.
     If nothing is available, this does never raise a read-beyond end signal.
     Instead, nil is returned immediately.

     Redefined, to wait on pipes and sockets"

    self atEnd ifTrue:[^ nil].
    ^ self peek
! !

!NonPositionableExternalStream methodsFor:'writing'!

nextPutAll:aCollection
    "nextPutBytes handles non-blocking io in receiver"

    self nextPutBytes:aCollection size from:aCollection startingAt:1.
    ^ self.
!

nextPutAll:aCollection startingAt:start to:stop
    "redefined, to wait until stream is writable, to avoid blocking in a write"

    |count|

    count := stop-start+1.
    count ~= (self nextPutBytes:count from:aCollection startingAt:start) ifTrue:[
	"incomplete write"
	self writeError.
    ].
!

nextPutBytes:initialWriteCount from:buffer startingAt:initialOffset
    "redefined, to wait until stream is writable, to avoid blocking in a write"

    |offset remaining wasBlocking|

    offset := initialOffset.
    remaining := initialWriteCount.

    wasBlocking := self blocking:false.
    [remaining ~~ 0] whileTrue:[
	|count|

	count := super nextPutBytes:remaining from:buffer startingAt:offset.

	remaining := remaining - count.
	offset := offset + count.
	remaining ~~ 0 ifTrue:[
	    "Transcript showCR:'writeWait'."
	    self writeWait.
	].
    ].
    wasBlocking ifTrue:[self blocking:true].

    ^ offset - initialOffset.
! !

!NonPositionableExternalStream class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.75 2015-05-24 12:51:37 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.75 2015-05-24 12:51:37 cg Exp $'
! !