SECTION "INTERFACE"



GET "LIBHDR"
GET "RINGHDR"



MANIFEST
$(
    repeatcount  =  50
    buffersize   =  256
    buffermask   =  #XFF

    ch.xoff      =  'S' - '@'
    ch.xon       =  'Q' - '@'

    c.scb        =  0
    c.eof        =  1
    c.xoff       =  2
    c.vtp        =  3
    c.cbuffp     =  4
    c.cbuffe     =  5
    c.cbuff      =  6

    c.upb        =  c.cbuff + buffersize/bytesperword


    u.control    =  #X00
    u.status     =  #X00
    u.tx         =  #X01
    u.rx         =  #X01

    u.rdrf       =  #X01
    u.tdre       =  #X02
$)



LET start()  BE
$(
//  Set up the reception request, and wait for calls to come in.

    LET bscb    =  0
    LET cblock  =  VEC c.upb

    rcvopen( 20, 0, @bscb )

    WHILE  bscb = 0  DO  nextco()

    cblock!c.scb     :=  bscb
    cblock!c.eof     :=  FALSE
    cblock!c.xoff    :=  FALSE
    cblock!c.vtp     :=  FALSE
    cblock!c.cbuffp  :=  0
    cblock!c.cbuffe  :=  0

    cocreate( monitor, 200, cblock )

    bscb  :=  0

    $(  //  Loop to wait for OPEN requests.

        WHILE  bscb = 0  DO  nextco()

        handleio( bscb, cblock )

        bscb  :=  0
    $)
    REPEAT
$)



AND monitor( cobase, cblock )  BE
$(
//  Coroutine to monitor the progress of the circular buffer.

    LET scb    =  cblock!c.scb
    LET vtp.i  =  makevtp( scb )
    LET vtp.o  =  result2
    LET cbuff  =  cblock + c.cbuff

    IF  vtp.i = 0  THEN  RETURN

    selectinput( vtp.i )
    selectoutput( vtp.o )

    writes( "MILLIWAYS monitoring circular buffer*N*N" )

    $(  //  Repeat loop to get characters, and then do the monitoring.

        LET x  =  cblock!c.xoff
        LET p  =  cblock!c.cbuffp
        LET e  =  cblock!c.cbuffe

        writef( "xoff:%N  cbuffp:%N  cbuffe:%N*N", x, p, e )

        FOR  i = 0  TO  buffersize-1  DO
        $(
            IF  i = p  THEN  writes( "[p]" )
            IF  i = e  THEN  writes( "[e]" )

            wrch( c( cbuff % i ) )
        $)

        writes( "*N*N" )
        
        IF  rdch() = endstreamch  THEN  BREAK
    $)
    REPEAT

    endread()
$)



AND c( char )  =
    ( "................................ !*"#$%&'()**+,-./0123456789:;<=>?*
      *@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]\^_`abcdefghijklmnopqrstuvwxyz{|}~."
    ) % ((char & #X7F) + 1)


  
AND handleio( bscb, cblock )  BE
$(
    cblock!c.scb     :=  bscb
    cblock!c.eof     :=  FALSE
    cblock!c.xoff    :=  FALSE
    cblock!c.vtp     :=  FALSE
    cblock!c.cbuffp  :=  0
    cblock!c.cbuffe  :=  0

    cocreate( bsp.to.rs232,   200, cblock )
    cocreate( rs232.to.cbuff, 200, cblock )
    cocreate( cbuff.to.bsp,   200, cblock )

    UNTIL  cblock!c.eof  DO  nextco()
$)



AND rs232.to.cbuff( cobase, cblock )  BE
$(
//  This coroutine takes characters from the serial line, and adds them to
//  a circular buffer, which is emptied asynchronously by another coroutine.

    LET scb  =  cblock!c.scb

    selectinput( scb )
    selectoutput( scb )

    $(  //  Main repeat loop.  Wait for a character from the rs232 line, and
        //  then attempt to put it in the curcular buffer.  If the circular
        //  buffer is full, then we must send an XOFF to shut the other
        //  machine up.
        
        LET ch   =  rs232.read( cblock )
        
        IF  bufferfull( cblock )  THEN
        $(
            //  Circular buffer full, so send an XOFF to shut the other end
            //  up, and wait until there is more room.
            
            xoff( cblock )
            
            WHILE  bufferfull( cblock )  DO  nextco()
            
            xon( cblock )
        $)

        addtobuffer( cblock, ch )
    $)
    REPEATUNTIL  cblock!c.eof

    //  When we have finished, we should close the byte stream down, and
    //  finish.

    wrch( ch.closerq )
    
    UNTIL  rdch() = endstreamch  DO  LOOP

    endread()
$)



AND cbuff.to.bsp( cobase, cblock )  BE
$(
//  Coroutine to take characters from the circular buffer, and write them
//  to the byte stream.

    LET scb  =  cblock!c.scb

    selectinput( scb )
    selectoutput( scb )

    $(  //  Repeat loop to wait for characters to appear in the circular
        //  buffer, and then write them down the byte stream.

        WHILE  bufferempty( cblock)  DO  nextco()
        
        //  There are characters in the buffer, and so we should write them
        //  down the byte stream.
        
        UNTIL  bufferempty( cblock )  DO
        $(
            LET ch  =  takefrombuffer( cblock )
            
            WHILE  cblock!c.vtp  DO  nextco()

            wrch( ch )
        $)
        
        //  We should now decide whether to push the data down the byte stream
        //  or not.  We look at the "buffp" field of the control block, and
        //  wait a while, to see if we get some more characters.  If so, we
        //  continue writing the stream, otherwise, we push.
        
        FOR  i = 1  TO  repeatcount  DO
        $(
            UNLESS  bufferempty( cblock )  DO  BREAK
            
            nextco()
        $)
        
        //  If no characters have been forthcoming, then we should push the
        //  data down the byte stream.
        
        IF  bufferempty( cblock )  THEN  wrch( ch.push )
    $)
    REPEATUNTIL  cblock!c.eof
$)

    

AND bsp.to.rs232( cobase, cblock )  BE
$(
//  Take characters from the byte stream, and write them to the rs232 line.
//  We do this until we get end of file on the byte stream, in which case
//  we just set a flag in the "cblock".

    LET scb  =  cblock!c.scb

    selectinput( scb )
    selectoutput( scb )

    $(  //  Repeat loop.  Send a line request down the VTP stream, and wait
        //  for characters to appear.  Handle them when they do.

        cblock!c.vtp  :=  TRUE

        wrch( '!' )

        wrch( vtp.length + 3 )
        wrch( vtp.linerq )
        wrch( 100 )
        wrch( #B0111 )
        
        cblock!c.vtp  :=  FALSE
        
        wrch( ch.push )

        $(  //  Repeat loop to read characters from the VTP stream, until an
            //  "end of input line" is hit.  When this happens, break out, and
            //  submit a new line request.
            
            LET ch  =  rdch()
            
            //  First, check for RESET.
            
            IF  ch = ch.reset  THEN
            $(
                //  Byte stream reset.  Write a denial, and then go back to the
                //  beginning of the loop again.
                
                handlereset( cblock )
                
                BREAK
            $)

            //  And then for end of file.  
            
            IF  ch = endstreamch  THEN
            $(
                //  End of stream.  Set the "eof" flag inthe control block,
                //  and delete our coroutine.
                
                cblock!c.eof  :=  TRUE
                
                codelete( cobase )
            $)
            
            //  Otherwise, look to see if it is a control code, and if so,
            //  handle it.
            
            TEST  ch < vtp.length  THEN
            $(
                //  This is a bog standard character, which must be written
                //  to the rs232 stream.  Wait until the line is free first.
                
                WHILE  cblock!c.xoff  DO  nextco()
                
                rs232.write( cblock, ch )
            $)
            ELSE
            $(
                //  This is a nasty VTP control code, which we should handle
                //  properly.
                
                LET length  =  ch  &  NOT vtp.length
                
                UNLESS  length = 0  DO
                $(
                    //  Read the next character, which is the proper VTP
                    //  control code, and see if we understand it.
                    
                    ch  :=  rdch()

                    SWITCHON  ch  INTO
                    $(
                        CASE vtp.eoil    :  //  End of input line.  Read the
                                            //  reason code, and then decide
                                            //  what to do.
                                            
                                            ch  :=  rdch()
                                            
                                            IF  ch = 2  THEN
                                            $(
                                                //  Logical end of stream, 
                                                //  which should be treated as
                                                //  physical end of stream.
                                                
                                                cblock!c.eof  :=  TRUE
                                                
                                                codelete( cobase )
                                            $)
                                            
                                            BREAK


                        CASE ch.reset    :  //  Byte stream reset, which we
                                            //  should handle.

                                            handlereset( cblock )
                                            BREAK


                        CASE endstreamch :  //  End of stream.  Set the "eof"
                                            //  flag, and finish.
                                            
                                            cblock!c.eof  :=  TRUE
                                            
                                            codelete( cobase )

                        
                        DEFAULT          :  //  Unknown VTP control code.  We
                                            //  should ignore the number of
                                            //  bytes given.
                                            
                                            FOR  i = 1  TO  length-1  DO  rdch()

                                            BREAK
                    $)
                $)
            $)
        $)
        REPEAT
    $)
    REPEAT
$)



AND bufferempty( cblock )  =  cblock!c.cbuffp = cblock!c.cbuffe



AND bufferfull( cblock )  =  ((cblock!c.cbuffp + 1) & buffermask)  =  cblock!c.cbuffe



AND addtobuffer( cblock, ch )  BE
$(
    LET cbuffp  =  cblock!c.cbuffp
    
    (cblock + c.cbuff) % cbuffp  :=  ch
    cblock!c.cbuffp              :=  (cbuffp + 1) & buffermask
$)



AND takefrombuffer( cblock )  =  VALOF
$(
    LET cbuffe  =  cblock!c.cbuffe
    
    cblock!c.cbuffe  :=  (cbuffe + 1) & buffermask
    
    RESULTIS  (cblock + c.cbuff) % cbuffe
$)



AND xon( cblock )  BE
$(
//  Send an XON down the rs232 stream.

    rs232.write( cblock, ch.xon )

    cblock!c.xoff  :=  FALSE
$)



AND xoff( cblock )  BE
$(
//  Send an XOFF down the rs232 stream.

    rs232.write( cblock, ch.xoff )

    cblock!c.xoff  :=  TRUE
$)



AND rs232.read( cblock )  =  sardch()  &  #X7F



AND rs232.write( cblock, ch )  BE  sawrch( ch & #X7F )



AND handlereset( cblock )  BE
$(
//  Send a "deny" reset, and return.

    rdch()

    cblock!c.vtp  :=  TRUE

    wrch( vtp.length + 1 )
    wrch( vtp.denyreset )

    writes( "****** VTP Break" )

    wrch( vtp.length + 2 )
    wrch( vtp.eool )
    wrch( '*N' )

    cblock!c.vtp  :=  FALSE

    wrch( ch.push )
$)


