SECTION "INTERFACE"



GET "LIBHDR"
GET "RINGHDR"



MANIFEST
$(
    repeatcount  =  50
    buffersize   =  200

    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" )

    $(  //  Loop to check character I/O

        LET v  =  VEC 10

        rs232.write( cblock, '*C' )

        FOR  i = 1  TO  10  DO  v!i  :=  rs232.read( cblock )

        FOR  i = 1  TO  10  DO  writef( "%X4 ", v!i )
        newline()
    $)
    REPEAT

    $(  //  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
    LET cbuff   =  cblock + c.cbuff
    LET cbuffp  =  cblock!c.cbuffp
    LET cbuffe  =  cblock!c.cbuffe

    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 )
        LET chp  =  cbuffp

        cbuffp  :=  (cbuffp + 1)  REM  buffersize
        
        IF  cbuffp = cbuffe  THEN
        $(
            //  Circular buffer full, so send an XOFF to shut the other end
            //  up, and wait until there is more room.
            
            xoff( cblock )
            
            WHILE  cbuffp = cbuffe  DO
            $(
                nextco()
                
                cbuffe  :=  cblock!c.cbuffe
            $)
            
            xon( cblock )
        $)
        
        cbuff % chp      :=  ch
        cblock!c.cbuffp  :=  cbuffp
    $)
    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
    LET cbuff   =  cblock + c.cbuff
    LET cbuffp  =  cblock!c.cbuffp
    LET cbuffe  =  cblock!c.cbuffe

    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  cbuffp = cbuffe  DO
        $(
            nextco()
            
            cbuffp  :=  cblock!c.cbuffp
        $)
        
        //  There are characters in the buffer, and so we should write them
        //  down the byte stream.
        
        UNTIL  cbuffp = cbuffe  DO
        $(
            LET ch  =  cbuff % cbuffe
            
            cbuffe  :=  (cbuffe + 1)  REM  buffersize
            
            WHILE  cblock!c.vtp  DO  nextco()

            wrch( ch )
        $)
        
        cblock!c.cbuffe  :=  cbuffe
        
        //  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
        $(
            cbuffp  :=  cblock!c.cbuffp
            
            UNLESS  cbuffp = cbuffe  DO  BREAK
            
            nextco()
        $)
        
        //  If no characters have been forthcoming, then we should push the
        //  data down the byte stream.
        
        IF  cbuffp = cbuffe  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( vtp.length + 3 )
        wrch( vtp.linerq )
        wrch( buffersize )
        wrch( #B0111 )
        
        wrch( ch.push )

        cblock!c.vtp  :=  FALSE
        
        $(  //  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 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 )  =  VALOF
$(
//  Read character from rs232 line with timeout.

    WHILE  (readport( #X10 + u.status ) & u.rdrf)  =  0  DO  nextco()

    RESULTIS  readport( #X10 + u.rx )  &  #X7F
$)



AND rs232.write( cblock, ch )  BE
$(
//  Write a chatacter to the rs232 line.

    WHILE  (readport( #X10 + u.status) & u.tdre)  =  0  DO  nextco()

    writeport( #X10 + u.tx, ch & #X7F )
$)



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

    rdch()

    cblock!c.vtp  :=  TRUE

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

    wrch( ch.push )

    cblock!c.vtp  :=  FALSE
$)


