with CONDITION_HANDLING ; use CONDITION_HANDLING ;
with STARLET ; use STARLET ;
with SYSTEM ; use SYSTEM ;

package body TERMINAL_IO is

  -- VAX version of TERMINAL_IO


  subtype TERMINAL_CHARACTERISTICS is UNSIGNED_LONGWORD_ARRAY(1..3) ;

  BYTE_TC : TERMINAL_CHARACTERISTICS ; -- terminal characteristics for
				       -- byte transfer
  CHANNEL : CHANNEL_TYPE ; -- channel attached to terminal
  INPUT : FUNCTION_CODE_TYPE ;
  ORIG_TC : TERMINAL_CHARACTERISTICS ; -- original terminal
				       -- characteristics
  OUTPUT : FUNCTION_CODE_TYPE ;
  TERMINATOR_MASK : UNSIGNED_BYTE_ARRAY(0..31)
                  := (others=>16#FF#) ;
  TERMINATOR_DESC : UNSIGNED_LONGWORD_ARRAY(1..2)
                  := ( TERMINATOR_MASK'SIZE / STORAGE_UNIT,
		       TO_UNSIGNED_LONGWORD(TERMINATOR_MASK'ADDRESS) ) ;



  procedure SMSG ( SSNAM : STRING ; STATUS : COND_VALUE_TYPE ) is
    MSGVEC : UNSIGNED_LONGWORD_ARRAY(1..2) ;
    PMSTAT : COND_VALUE_TYPE ;
  begin
    MSGVEC(1) := 16#000F0001# ;
    MSGVEC(2) := STATUS ;
    PUTMSG(PMSTAT,MSGVEC) ;
  end SMSG ;


  procedure TTY_READ ( C : out BYTE ;
                       GOT_ONE : out BOOLEAN ;
                       RETURN_AFTER : DURATION := 0.0 ) is
    IO_STATUS : COND_VALUE_TYPE ;
    IOSB : IOSB_TYPE ;
    STATUS : COND_VALUE_TYPE ;
  begin
    -- try one time to read; return immediately if no character
    --      available
    -- read one character with all characters acting as terminators and
    --      a timeout of 0
    QIOW( STATUS, CHAN => CHANNEL, FUNC => INPUT, IOSB => IOSB,
          P1 => TO_UNSIGNED_LONGWORD( C'ADDRESS ), P2 => 1, P3 => 0,
	  P4 => TO_UNSIGNED_LONGWORD( TERMINATOR_DESC'ADDRESS ) )
	  ;
    if STATUS /= SS_NORMAL then SMSG("SYS$QIOW INPUT",STATUS) ; end if ;
    IO_STATUS := COND_VALUE_TYPE( IOSB.STATUS ) ;
    if IO_STATUS = SS_TIMEOUT then
      -- read timed out; i.e., no character available this time
      GOT_ONE := FALSE ;
    else
      GOT_ONE := TRUE ;
      -- unless something went wrong, we have a character to return
      if IO_STATUS /= SS_NORMAL then
        SMSG("I/O status",IO_STATUS) ;
      end if ;
    end if;
  end TTY_READ ;


  procedure TTY_WRITE ( C : BYTE ) is
    IO_STATUS : COND_VALUE_TYPE ;
    IOSB : IOSB_TYPE ;
    STATUS : COND_VALUE_TYPE ;
  begin
    QIOW( STATUS, CHAN => CHANNEL, FUNC => OUTPUT, IOSB => IOSB,
          P1 => TO_UNSIGNED_LONGWORD( C'ADDRESS ), P2 => 1 ) ;
    if STATUS /= SS_NORMAL then SMSG("WRITEVBLK",STATUS) ; end if ;
    IO_STATUS := COND_VALUE_TYPE( IOSB.STATUS ) ;
    if IO_STATUS /= SS_NORMAL then
      SMSG("write I/O status",IO_STATUS) ;
    end if ;
  end TTY_WRITE ;


  procedure TTY_WRITE_FLUSH is
  begin
    -- we aren't buffering
    null ;
  end TTY_WRITE_FLUSH ;


  procedure TTY_PREP is
    STATUS : COND_VALUE_TYPE ;
  begin
    -- assign channel to terminal
    ASSIGN(STATUS,"SYS$INPUT",CHANNEL) ;
    if STATUS /= SS_NORMAL then SMSG("SYS$ASSIGN",STATUS) ; end if ;
    -- retrieve original terminal characteristics
    QIOW( STATUS, CHAN => CHANNEL, FUNC => IO_SENSEMODE,
          P1 => TO_UNSIGNED_LONGWORD(ORIG_TC'ADDRESS),
	  P2 => ORIG_TC'SIZE / STORAGE_UNIT ) ;
    if STATUS /= SS_NORMAL then SMSG("IO$_SENSEMODE",STATUS) ; end if ;
    -- in order to achieve 8-bit data transfer we need the effect of
    --      SET TERMINAL /EIGHTBIT /PASTHRU /NOTTSYNC
    BYTE_TC := ORIG_TC ;
    BYTE_TC(2) := BYTE_TC(2) or TT_M_EIGHTBIT ;
    BYTE_TC(2) := BYTE_TC(2) and not TT_M_TTSYNC ;
    BYTE_TC(3) := BYTE_TC(3) or TT2_M_PASTHRU ;
    QIOW( STATUS, CHAN => CHANNEL, FUNC => IO_SETMODE,
          P1 => TO_UNSIGNED_LONGWORD(BYTE_TC'ADDRESS),
	  P2 => BYTE_TC'SIZE / STORAGE_UNIT ) ;
    if STATUS /= SS_NORMAL then SMSG("IO$_SETMODE",STATUS) ; end if ;
    -- set up Input Function & Modifiers
    INPUT := IO_READVBLK or IO_M_NOECHO or IO_M_NOFILTR
                         or IO_M_TRMNOECHO or IO_M_TIMED ;
    -- set up Output Function & Modifiers
    OUTPUT := IO_WRITEVBLK ;
  end TTY_PREP ;


  procedure TTY_RESTORE is
    STATUS : COND_VALUE_TYPE ;
  begin
    -- restore original terminal characteristics
    QIOW( STATUS, CHAN => CHANNEL, FUNC => IO_SETMODE,
          P1 => TO_UNSIGNED_LONGWORD( ORIG_TC'ADDRESS ),
	  P2 => ORIG_TC'SIZE / STORAGE_UNIT ) ;
    if STATUS /= SS_NORMAL then SMSG("IO$_SETMODE 2",STATUS) ; end if ;
  end TTY_RESTORE ;


begin
  TTY_PREP ;
end TERMINAL_IO ;