Initial commit of OpenSPARC T2 architecture model.

[OpenSPARC-T2-SAM] / obp / obp / dev / serial / ttydriver.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: ttydriver.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
\ id: @(#)ttydriver.fth 3.21 02/10/24
\ purpose: 
\ copyright: Copyright 1996-2002 Sun Microsystems, Inc.  All Rights Reserved
\ copyright: Use is subject to license terms.

headerless

\ The high level serial driver interface.
\ provides all the standard routines and relies upon underlying
\
\   usea, useb			- to switch interfaces
\   inituart			- init current uart
\   ukey?			- can read?
\   ukey			- read single char
\   uemit?			- can transmit?
\   uemit			- write char
\   ubreak?			- break detected?
\   clear-break			- Cleanup after a BREAK
\

: map-in ( offset len -- vaddr )	" map-in" $call-parent ;
: map-out ( vaddr len -- )		" map-out" $call-parent ;

: select-channel ( channel -- )
  \ Point to the correct property name.  Since the property is boolean,
  \ the information is conveyed by its presence, not its value.
  #channels 1 = if
    \ Grover or fiesta platforms
    " rts-dtr-off"
  else
    \ Excal or other sun4s platforms
    dup if  " port-b-rts-dtr-off"  else  " port-a-rts-dtr-off"  then
  then                                  ( channel name$ )
  get-my-property dup 0= if             ( channel prop$ false | channel true )
    nip nip                             ( channel false )
  then                                  ( channel flag )
  is dtr-rts-on?                        ( channel )

  \ Initialize channel
  if useb h# 02 else usea h# 01 then	( mask )
  dup channel-init and			( mask set? )
  if					( mask )
    drop				(  )
  else					( mask )
    channel-init or is channel-init	(  )
    inituart				(  )
  then
;

: (open)   ( arg$ -- okay? )
   \ First time we are opened then we set uartbase and init serial line.
   uartbase 0= if			( arg$ )
     tty-base my-space tty-size map-in	( arg$ va )
     dup is uartbase  0=  if		( arg$ )
       2drop false exit			( 0 )
     then				( arg$ )
   then

   >r >r				(  )
   0 select-channel			(  )
   default-ttya-mode 			( mode$ )
   r> r>				( mode$ arg$ )
   #channels 1- if			( mode$ arg$ )
     ascii ,  left-parse-string  if	( mode$ rem$ adr )
       c@  ascii b  =  if		( mode$ rem$ )
         >r >r				( mode$ )
         2drop			        (  )
         1 select-channel		(  )
         default-ttyb-mode		( mode$ )
         r> r>				( mode$ rem$ )
       then				( mode$ rem$ )
     else				( mode$ rem$ adr )
       drop				( mode$ rem$ )
     then				( mode$ rem$ )
   then					( mode$ rem$ )
   dup if  2swap  then  2drop		( mode$' )

   0 parse-mode ?dup 0= if		(  )
       default-tty-mode 0 parse-mode	( flag )
   then					( flag )
   dup if				( flag )
     opencount 1+ is opencount		(  )
   then
;

headers
external

: open ( -- flag )  my-args (open)  ;

: close  ( -- )
   opencount ?dup if 1- is opencount then
   opencount if exit then		(  )
   uartbase tty-size map-out		(  )
   false to channel-init		(  )
   false to uartbase			(  )
;

: read   ( adr len -- #read )
   ukey? 0=  if  2drop -2  exit  then		( adr len )
   tuck						( len adr len )
   begin  dup 0<>   ukey? 0<>  and  while	( len adr len )
     over  ukey mask-#data and swap c!		( len adr len )
     1 /string					( len adr' len' )
   repeat					( len adr' len' )
   nip -					( #read )
;

: write  ( adr len -- #written )
   tuck  bounds  ?do				( len )
      i c@  uemit				( len )
   loop						( len )
   begin  uemit?  until				( len )
;

: poll-tty  ( -- )
   ttylock @ if  exit  then
   ubreak?  if  clear-break  user-abort  then
   \ Give lower levels chance to work.
   ukey? drop
;

: install-abort  ( -- )  ['] poll-tty d# 10 alarm  ;

: remove-abort   ( -- )  ['] poll-tty     0 alarm  ;

: restore ( -- ) ;