"{ Package: 'jv:libgdbs' }"

Stream subclass:#GDBInternalPipeStream

	instanceVariableNames:'buffer first last accessLock dataAvailable spaceAvailable closed'

	classVariableNames:'DefaultBufferSize'

	poolDictionaries:''

	category:'GDB-Support'

!

!GDBInternalPipeStream class methodsFor:'documentation'!

documentation

"

    not useful on its own, but can be used to talk to a vt100

    terminal view ...

    See example.

"

!

examples

"

                                                                [exBegin]

    |p|

    p := InternalPipeStream new.

    [

        10 timesRepeat:[

            p nextPutLine:'hello'

        ].

    ] fork.

    [

        10 timesRepeat:[

            Transcript showCR:p nextLine

        ].

    ] fork.

                                                                [exEnd]

                                                                [exBegin]

    |userInput elizasOutput top terminal|

    userInput    := InternalPipeStream new.

    elizasOutput := InternalPipeStream new.

    top := StandardSystemView new.

    terminal := VT100TerminalView openOnInput: userInput output:elizasOutput in:top.

    top extent:(terminal preferredExtent).

    top label:'The doctor is in'.

    top iconLabel:'doctor'.

    top open.

    top waitUntilVisible.

    terminal translateNLToCRNL:true.

    terminal inputTranslateCRToNL:true.

    terminal localEcho:true.

    elizasOutput nextPutLine:'Hi, I am Eliza'.

    elizasOutput nextPutLine:'What is your problem ?'.

    elizasOutput nextPutLine:''.

    elizasOutput nextPutAll:'>'.

    [top realized] whileTrue:[

        |line answer matchingRule|

        line := userInput nextLine.

        (#('quit' 'exit' 'end' 'bye') includes:line) ifTrue:[

            top destroy.

            ^ self

        ].

        answer := 'Tell me more.'.

        elizasOutput nextPutLine:answer.

        elizasOutput nextPutAll:'>'.

    ].

                                                                [exEnd]

"

! !

!GDBInternalPipeStream class methodsFor:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    DefaultBufferSize := 1024.

    "Modified: / 07-06-2014 / 00:49:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream class methodsFor:'instance creation'!

new

    ^ self newWithBufferSize: DefaultBufferSize

    "Modified: / 10-06-2014 / 00:26:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

newWithBufferSize: bufferSize

    ^ self basicNew initializeWithBufferSize: bufferSize

    "Created: / 07-06-2014 / 00:48:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'accessing'!

atEnd

    ^ closed and:[ last == 0 ]

    "Modified: / 07-06-2014 / 01:06:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

close

    closed := true.

    "Modified: / 07-06-2014 / 01:02:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

size

    last == 0 ifTrue:[ ^ 0 ].

    last >= first ifTrue:[ 

        ^ last - first + 1 

    ] ifFalse:[ 

        ^ buffer size - first + 1 + last

    ].

    "Modified: / 07-06-2014 / 01:08:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'initialization'!

initializeWithBufferSize: bufferSize

    buffer := String new: bufferSize.

    first := 1.

    last := 0.

    accessLock := Semaphore forMutualExclusion." Plug new respondTo: #critical: with: [ :block | block value ]; yourself."

    dataAvailable := Semaphore new.

    spaceAvailable := Semaphore new.

    closed := false

    "Created: / 07-06-2014 / 00:49:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 11-06-2014 / 23:12:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'non homogenous reading'!

nextAvailableBytes:max into:out startingAt:offset

    | count |

    accessLock critical:[

        last == 0 ifTrue:[ 

            count := 0

        ] ifFalse:[

            last >= first ifTrue:[         

                count := max min: (last - first + 1).    

                out replaceFrom:offset to: offset + count - 1 with: buffer startingAt: first.

                first := first + count.

                first > last ifTrue:[ 

                    first := 1. 

                    last := 0.

                ].

                spaceAvailable signalForAll.

            ] ifFalse:[ 

                "/ Wrap around

                count := max.

                first + count <= buffer size ifTrue:[ 

                    out replaceFrom:offset to: offset + count - 1 with: buffer startingAt: first.

                    first := (first + count) \\ buffer size.

                    spaceAvailable signalForAll.

                ] ifFalse:[ 

                    | rem |

                    count := max min: (buffer size - first) + last.

                    rem := buffer size - first.

                    out replaceFrom: offset to: offset + (buffer size - first) with: buffer startingAt: first.

                    out replaceFrom: offset + (buffer size - first + 1) to:  offset + count with: buffer startingAt: 1.

                    rem == last ifTrue:[ 

                        first := 1.

                        last := 0.

                    ] ifFalse:[

                        first := rem + 1.

                    ].

                ].

            ].

        ].

    ].

    ^ count

    "Modified: / 11-06-2014 / 21:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'non homogenous writing'!

nextPutBytes:count from:bytes startingAt:start

    "Write count bytes from an object starting at index start.

     Return the number of bytes written.

     The object must have non-pointer indexed instvars 

     (i.e. be a ByteArray, String, Float- or DoubleArray).     

     Use with care - non object oriented i/o.

     This is provided for compatibility with externalStream;

     to support binary storage"

    | written write remaining offset space |

    closed ifTrue:[ 

        self class writeErrorSignal signal:'Pipe stream closed'.

    ].

    written := 0.

    remaining := count.

    offset := start.

    space := true.

    [ space and:[remaining > 0] ] whileTrue:[

        accessLock critical:[

            space := ("self hasSpace"last == 0 or:[ ( (last \\ buffer size) + 1) ~~ first]).

            space ifTrue:[

                last == 0 ifTrue:[ 

                    "/ Special case - empty buffer

                    write := remaining min: bytes size.

                    buffer replaceFrom:1 to: write with: bytes startingAt: offset.

                    last := write.

                ] ifFalse:[

                    | lastPlusOne |

                    lastPlusOne := (last \\ buffer size) + 1.

                    first < lastPlusOne ifTrue:[ 

                        write := remaining min: (buffer size - last).

                    ] ifFalse:[

                        write := (first - lastPlusOne + 1) min: remaining.

                    ].

                    buffer replaceFrom: lastPlusOne to: lastPlusOne + write - 1 with: bytes startingAt: offset.

                    last := (last \\ buffer size) + write.

                ].

                remaining := remaining - write.

                written := written + write.

                offset := offset + write.  

                dataAvailable signalForAll.  

            ].

        ].

    ].

    ^ written.

    "Created: / 09-06-2014 / 22:04:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 11-06-2014 / 22:59:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'private'!

contentsSpecies

    ^ buffer class

    "Created: / 09-06-2014 / 21:50:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'private-queries'!

hasData

    ^ last ~~ 0

    "Created: / 11-06-2014 / 21:19:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hasSpace

    ^ last == 0 or:[ ( (last \\ buffer size) + 1) ~~ first]

    "Created: / 11-06-2014 / 21:18:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'reading'!

next

    "return the next element from the stream (might block until something is written)"

    | c |

    [

        accessLock critical:[

            ("self hasData"last ~~ 0) ifTrue:[ 

                c := buffer at: first.

                first == last ifTrue:[ 

                    first := 1.

                    last := 0.

                ] ifFalse:[

                   first := (first \\ buffer size) + 1

                ].

                spaceAvailable signalForAll.

                ^ c

            ] ifFalse:[ 

                closed ifTrue:[ ^ nil ]

            ].

        ].

        dataAvailable wait.

    ] loop.

    "Modified: / 11-06-2014 / 21:38:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'synchronization'!

readWait

    last == 0 ifTrue:[ 

        dataAvailable wait.

    ].

    "Modified: / 07-06-2014 / 01:09:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeWait    

    | hasSpace |

    accessLock critical:[ hasSpace := self hasSpace ].

    hasSpace ifTrue:[ 

        spaceAvailable wait.

    ].

    "Created: / 11-06-2014 / 22:04:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream methodsFor:'writing'!

nextPut:aCharacter

    | done |

    closed ifTrue:[ 

        self class writeErrorSignal signal:'Pipe stream closed'.

        ^ self.

    ].

    done := false.

    [ done ] whileFalse:[

        accessLock critical:[

            ("self hasSpace"last == 0 or:[ ( (last \\ buffer size) + 1) ~~ first]) ifTrue:[

                last := (last \\ buffer size) + 1.

                buffer at: last put: aCharacter.

                done := true.

            ].

        ].

        done ifFalse:[ 

            spaceAvailable wait.

        ].

    ].

    dataAvailable signalForAll.

    "Modified: / 11-06-2014 / 21:49:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nextPutAll:aCollection

    "Put all elements of the argument, aCollection onto the receiver."

    ^ self nextPutAll: aCollection startingAt: 1 to: aCollection size

    "Created: / 09-06-2014 / 21:58:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nextPutAll:aCollection startingAt:firstIndex to: lastIndex

    "Append the elements with index from firstIndex to lastIndex

     of the argument, aCollection,  onto the receiver."

    closed ifTrue:[ 

        self class writeErrorSignal signal:'Pipe stream closed'.

    ].

    (aCollection class == self contentsSpecies) ifTrue:[

        | remaining offset written |

        remaining := lastIndex - firstIndex + 1.

        offset := firstIndex.

        [ remaining > 0 ] whileTrue:[

            written := self nextPutBytes: remaining from: aCollection startingAt: offset.

            remaining := remaining - written.

            offset := offset + written.

            remaining > 0 ifTrue:[ 

                self writeWait.

            ].

        ].

    ] ifFalse:[ 

        super nextPutAll:aCollection startingAt:firstIndex to: lastIndex

    ].

    "Created: / 09-06-2014 / 21:57:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 11-06-2014 / 23:04:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBInternalPipeStream class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !

GDBInternalPipeStream initialize!