"

 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.

"

Object subclass:#Stream

	instanceVariableNames:'signalAtEnd'

	classVariableNames:'StreamErrorSignal PositionErrorSignal ReadErrorSignal

		WriteErrorSignal EndOfStreamSignal'

	poolDictionaries:''

	category:'Streams'

!

!Stream 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

"

    An abstract class defining common behavior for all stream-like objects.

    See concrete subclasses for more detail.

    Subclasses should (at least) implement:

        #next           (if readable)

        #nextPut:       (if writable)

        #contents

        #atEnd

        #isReadable

        #isWritable

    [Class variables:]

        StreamErrorSignal       <Signal>        parent of all stream errors

        PositionErrorSignal     <Signal>        position attemted on a stream

                                                which does not support positioning

        ReadErrorSignal         <Signal>        raised on read errors

        WriteErrorSignal        <Signal>        raised on write errors

        EndOfStreamSignal       <Signal>        raised at end of stream

    [author:]

        Claus Gittinger

"

! !

!Stream class methodsFor:'initialization'!

initialize

    StreamErrorSignal isNil ifTrue:[

	StreamErrorSignal := ErrorSignal newSignalMayProceed:false.

	StreamErrorSignal nameClass:self message:#streamErrorSignal.

	StreamErrorSignal notifierString:'Stream error'.

	PositionErrorSignal := StreamErrorSignal newSignalMayProceed:true.

	PositionErrorSignal nameClass:self message:#positionErrorSignal.

	PositionErrorSignal notifierString:'stream as no concept of a position'.

	ReadErrorSignal := StreamErrorSignal newSignalMayProceed:false.

	ReadErrorSignal nameClass:self message:#readErrorSignal.

	ReadErrorSignal notifierString:'read error'.

	WriteErrorSignal := StreamErrorSignal newSignalMayProceed:false.

	WriteErrorSignal nameClass:self message:#writeErrorSignal.

	WriteErrorSignal notifierString:'write error'.

	EndOfStreamSignal := StreamErrorSignal newSignalMayProceed:false.

	EndOfStreamSignal nameClass:self message:#endOfStreamSignal.

	EndOfStreamSignal notifierString:'end of stream'.

    ]

! !

!Stream class methodsFor:'instance creation'!

new

    "{ Pragma: +optSpace }"

    "report an error - Streams are created using on:-messages"

    ^ self error:'Streams cannot be created with new'

! !

!Stream class methodsFor:'Signal constants'!

endOfStreamSignal

    "return the signal raised if read past end of stream is attemted"

    ^ EndOfStreamSignal

!

positionErrorSignal

    "return the signal raised if positioning is requested for

     a stream which does not support that kind of operation"

    ^ PositionErrorSignal

!

readErrorSignal

    "return the signal raised on read errors"

    ^ ReadErrorSignal

!

streamErrorSignal

    "return the parent of all stream errors;

     handling this one also handles all other errors.

     Also, this one may be raised for errors not related to read/write

     operations, such as failed ioctls in externalStream etc."

    ^ StreamErrorSignal

!

writeErrorSignal

    "return the signal raised on write errors"

    ^ WriteErrorSignal

! !

!Stream methodsFor:'accessing'!

contents

    "return the entire contents of the stream

     - we do not know here how to do it, it must be redefined in subclass"

    ^ self subclassResponsibility

!

signalAtEnd

    "return signalAtEnd"

    ^ signalAtEnd

    "Created: 5.2.1996 / 18:24:53 / stefan"

!

signalAtEnd:something

    "set signalAtEnd"

    signalAtEnd := something.

    "Created: 5.2.1996 / 18:24:53 / stefan"

! !

!Stream methodsFor:'closing'!

close

    "close the stream - nothing done here.

     Added for compatibility with external streams."

    ^ self

! !

!Stream methodsFor:'enumerating'!

do:aBlock

    "evaluate the argument, aBlock for all remaining elements,

     up to the end of the stream"

    [self atEnd] whileFalse:[

	aBlock value:(self next)

    ]

    "

     |s|

     s := ReadStream on:#(1 2 3 4 5 6 7 8 9).

     s next.

     s next.

     s do:[:element | Transcript showCr:element]

    "

! !

!Stream methodsFor:'error handling'!

pastEnd

    "someone tried to read after the end of the stream.

     if signalAtEnd == true, raise a signal.

     Otherwise return nil."

    signalAtEnd == true ifTrue:[

        ^ EndOfStreamSignal raiseIn:thisContext sender

    ].

    ^ nil

    "Created: 5.2.1996 / 21:56:08 / stefan"

! !

!Stream methodsFor:'misc'!

binary

    "switch to binary mode. ignored here, but added to make

     internalStreams protocol compatible with externStreams."

! !

!Stream methodsFor:'non homogenous reading'!

nextLine

    "for compatibility with externalStreams"

    ^ self upTo:Character cr.

!

nextLongMSB:msbFlag

    "return a signed long (4 bytes) from the stream.

     The receiver must support reading of binary bytes."

    |high uval "{ Class: SmallInteger }"|

    msbFlag ifTrue:[

	"most significant first"

	high := self next.

	uval := self next bitShift:16.

	uval := uval bitOr:(self next bitShift:8).

	uval := uval bitOr:(self next).

	uval := uval bitOr:(high bitShift:24).

    ] ifFalse:[

	"least significant first"

	uval := self next.

	uval := uval bitOr:(self next bitShift:8).

	uval := uval bitOr:(self next bitShift:16).

	uval := uval bitOr:(self next bitShift:24).

    ].

    "change from unsigned 0..FFFFFFFF to signed -80000000..7FFFFFFF"

"/ sorry- for now (2.7), stc cannot compile LargeInteger constants 

"/    uval >= 16r80000000 ifTrue:[

"/	^ uval - 16r100000000 

"/    ].

"/ the following kludges around this

"/ well, new (2.8) can ...

    (uval bitShift:-16) >= 16r8000 ifTrue:[

	^ uval - (16r10000000 bitShift:8)

    ].

    ^ uval

!

nextLongNet

    "return a signed long (4 bytes) in network byte order from the stream.

     The receiver must support reading of binary bytes."

    ^ self nextLongMSB:(Socket networkLongOrderIsMSB)

    "Created: 10.1.1996 / 19:49:28 / cg"

!

nextNumber:n 

    "Return the next n bytes as a positive Integer; bytes are taken msb-first."

    |s 

     val "{ Class: SmallInteger }"

     rep "{ Class: SmallInteger }"|

    "claus: this method is central in binaryStorage -

     therefore it has been tuned a bit (and needs even more tuning)"

    n == 1 ifTrue:[

	^ self next

    ].

    n == 2 ifTrue:[

	val := self next.

	val := (val bitShift:8) + self next.

	^ val

    ].

    n == 3 ifTrue:[

	val := self next.

	val := (val bitShift:8) + self next.

	val := (val bitShift:8) + self next.

	^ val

    ].

    n == 4 ifTrue:[

	val := self next.

	val <= 16r3F ifTrue:[

	    val := (val bitShift:8) + self next.

	    val := (val bitShift:8) + self next.

	    val := (val bitShift:8) + self next.

	    ^ val

	].

	"sorry, but need a largeInteger"

	s := (val bitShift:8) + self next.

	s := (s bitShift:8) + self next.

	s := (s * 256) + self next.

	^ s

    ].

    "

     arbitrary long

    "

    s := 0.

    rep := n.

    rep timesRepeat:[ 

	s := s * 256 + self next

    ].

    ^ s truncated

!

nextShortMSB:msbFlag

    "return a signed short (2 bytes) from the stream.

     The receiver must support reading of binary bytes."

    |uval "{ Class: SmallInteger }"|

    msbFlag ifTrue:[

	"most significant first"

	uval := self next bitShift:8.

	uval := uval bitOr:(self next).

    ] ifFalse:[

	"least significant first"

	uval := self next.

	uval := uval bitOr:(self next bitShift:8).

    ].

    "change from unsigned 0..FFFF to signed -8000..7FFF"

    uval >= 16r8000 ifTrue:[

	^ uval - 16r10000 

    ].

    ^ uval

!

nextShortNet

    "return a signed short (2 bytes) in network byte order from the stream.

     The receiver must support reading of binary bytes."

    ^ self nextShortMSB:(Socket networkShortOrderIsMSB)

    "Modified: 10.1.1996 / 19:48:50 / cg"

    "Created: 10.1.1996 / 19:49:41 / cg"

!

nextUnsignedLongMSB:msbFlag

    "return an unsigned long (4 bytes) from the stream.

     The receiver must support reading of binary bytes."

    |val|

    msbFlag ifTrue:[

	val := self next.

	val := (val bitShift:8) bitOr:(self next).

	val := (val bitShift:8) bitOr:(self next).

	val := (val * 256) + (self next).

	^ val

    ].

    val := self next.

    ^ (val bitShift:24)

      + (self next bitShift:16)

      + (self next bitShift:8)

      + self next

!

nextUnsignedLongNet

    "return an unsigned long (4 bytes) in network byte order from the stream.

     The receiver must support reading of binary bytes."

    ^ self nextUnsignedLongMSB:(Socket networkLongOrderIsMSB)

    "Created: 10.1.1996 / 19:49:02 / cg"

    "Modified: 10.1.1996 / 19:49:50 / cg"

!

nextUnsignedShortMSB:msbFlag

    "return an unsigned short (2 bytes) from the stream.

     The receiver must support reading of binary bytes."

    msbFlag ifTrue:[

	^ (self next bitShift:8) bitOr:(self next)

    ].

    ^ (self next) bitOr:(self next bitShift:8)

!

nextUnsignedShortNet

    "return an unsigned short (2 bytes) in network byte order from the stream.

     The receiver must support reading of binary bytes."

    ^ self nextUnsignedShortMSB:(Socket networkShortOrderIsMSB)

    "Created: 10.1.1996 / 19:50:02 / cg"

!

nextWord

    ^ self nextAlphaNumericWord

! !

!Stream methodsFor:'non homogenous writing'!

nextLongPut:aNumber

    "for ST-80 compatibility:

     Write the argument, aNumber as a long (four bytes). 

     The most significant byte is sent first."

    ^ self nextPutLong:aNumber MSB:true

    "Modified: 10.1.1996 / 19:38:54 / cg"

!

nextNumber:n put:v 

    "Append to the receiver the argument, v, which is a positive Integer,

     as the next n bytes. Bytes are written msb first. 

     Possibly pad with leading zeros.

     The receiver must support writing of binary bytes."

    |vlen "{ Class: SmallInteger }"

     i    "{ Class: SmallInteger }"|

    "claus: this method is central in binaryStorage -

     therefore it has been tuned a bit (and needs even more tuning)"

    v class == SmallInteger ifTrue:[  "- this is a hint to stc"

	n == 1 ifTrue:[

	    (v between:0 and:16rFF) ifTrue:[

		self nextPut:v.

		^ self

	    ].

	].

	n == 2 ifTrue:[

	    (v between:0 and:16rFFFF) ifTrue:[

		self nextPut:(v bitShift:-8).

		self nextPut:(v bitAnd:16rFF).

		^ self

	    ].

	].

	n == 3 ifTrue:[

	    (v between:0 and:16rFFFFFF) ifTrue:[

		self nextPut:((v bitShift:-16) bitAnd:16rFF).

		self nextPut:((v bitShift:-8) bitAnd:16rFF).

		self nextPut:(v bitAnd:16rFF).

		^ self

	    ].

	].

	n == 4 ifTrue:[

	    (v >= 0) ifTrue:[

		self nextPut:((v bitShift:-24) bitAnd:16rFF).

		self nextPut:((v bitShift:-16) bitAnd:16rFF).

		self nextPut:((v bitShift:-8) bitAnd:16rFF).

		self nextPut:(v bitAnd:16rFF).

		^ self

	    ].

	].

    ].

    "

     arbitrary long

    "

    n < (vlen := v digitLength) ifTrue: [

	"

	 the number is too big to be repesented in n bytes

	"

	self error:'number too big'

    ].

    "pad with leading zeros"

    i := n.

    [i > vlen] whileTrue:[

	self nextPut:0. 

	i := i - 1

    ].

    i == 1 ifTrue:[

	^ self nextPut:v

    ].

    [i > 0] whileTrue:[

	self nextPut:(v digitAt:i). 

	i := i - 1

    ]

!

nextPutLong:aNumber MSB:msbFlag

    "Write the argument, aNumber as a long (four bytes). If msbFlag is

     true, data is written most-significant byte first; otherwise least

     first. Returns the receiver on ok, nil on error.

     The receiver must support writing of binary bytes."

    msbFlag ifTrue:[