\ In addition to the methods defined in the above driver sample,
\ this version defines more methods to initialize, test, and access
\ the serial ports.
\ The new main methods are:
\ - inituarts ( -- )
\ Initializes both serial ports A and B.
\ - open ( -- okay? )
\ Maps in the uart chip. Selects port A on default, then check
\ my-args, if port B was specified, then selects port B instead.
\ - close ( -- )
\ Unmap the uart chip.
\ - selftest ( -- )
\ Performs selftest on both Port A and B.
\ - install-abort ( -- )
\ Sets up alarm to do poll-tty every 10 miliseconds.
\ - remove-abort ( -- )
\ Removes the poll-tty alarm.
fcode-version3
hex
" SUNW,zs" name
my-address 10.0000 + my-space 8 reg
7 encode-int " interrupts" property
" serial" device-type
: >phys-addr ( offset -- phys.lo phys.mid phys.hi )
>r my-address r> 0 d+ my-space
;
: do-map-in ( offset size -- virt ) >r >phys-addr r> " map-in" $call-parent ;
: do-map-out ( virt size -- ) " map-out" $call-parent ;
: /string ( addr len n -- addr+n len-n ) tuck - -rot + swap ;
fload inituarts.fth
fload ttydriver.fth
end0
\----------------------------------------------------------------------------
\ inituarts.fth
hex
headerless
create uart-init-table
\ 9 c, c0 c, \ Master reset channel a (80), channel b (40)
9 c, 2 c, \ Don't respond to intack cycles (02)
4 c, 44 c, \ No parity (00), 1 stop bit (04), x16 clock (40)
3 c, c0 c, \ receive 8 bit characters (c0)
5 c, 60 c, \ transmit 8 bits (60)
e c, 82 c, \ Processor clock is baud rate source (02)
b c, 55 c, \ TRxC = xmit clk (01), enable TRxC (04), Tx clk is baud (10),
\ Rx clk is baud (40)
c c, e c, \ Time constant low
d c, 0 c, \ Time constant high
3 c, c1 c, \ receive 8 bit characters (c0), enable (01)
5 c, 68 c, \ transmit 8 bits (60), enable (08)
e c, 83 c, \ Processor clock is baud rate source (02), Tx enable (01)
0 c, 10 c, \ Reset status bit latches
ff c, ff c, \ Mark end of data
\----------------------------------------------------------------------------
\ ttydriver.fth - Driver for Zilog 8530 SCC (UART) chips.
hex
0 instance value uartbase
create default-mode
\ 0 1 2 3 4 5 6 7
00 c, 00 c, 00 c, c1 c, 44 c, 68 c, 00 c, 00 c,
\ 8 9 a b c d e f
00 c, 02 c, 00 c, 55 c, 0e c, 00 c, 83 c, 00 c,
0 instance value uart \ define uart as an "per-instance" value.
h# ff instance value mask-#data \ mask for #data bits
h# 10 instance buffer: mode-buf
create masks 1f c, 7f c, 3f c, ff c,
\ The following line assumes that A2 selects the channel within the chip
: usea ( -- ) uartbase 4 + to uart ;
: useb ( -- ) uartbase to uart ;
: uctl! ( c -- ) uart rb! ;
: uctl@ ( -- c ) uart rb@ ;
\ The following line assumes that A1 chooses the command vs. data port
: udata! ( c -- ) uart 2 + rb! ;
: udata@ ( -- c ) uart 2 + rb@ ;
\ Write all the initialization sequence to both uarts
: inituart ( -- )
uart-init-table
begin dup c@ ff <> while
dup c@ uctl! dup ca1+ c@ uctl!
/c 2* +
repeat
drop
;
: inituarts ( -- ) usea inituart useb inituart usea ;
\ Test for "break" character received.
: ubreak? ( -- break? ) 10 uctl! uctl@ h# 80 and 0<> ;
\ Clear the break flag
: clear-break ( -- )
begin ubreak? 0= until \ Let break finish
udata@ drop \ Eat the null character
30 uctl! \ Reset errors
;
1 constant RXREADY \ received character available
4 constant TXREADY \ transmit buffer empty
: uemit? ( -- emit? ) uctl@ TXREADY and ;
: uemit ( char -- ) begin uemit? until udata! ;
: ukey? ( -- key? ) uctl@ RXREADY and ;
: ukey ( -- key ) begin ukey? until udata@ ;
: uwrite ( addr len -- #written )
tuck bounds ?do ( len )
i c@ uemit ( len )
loop ( len )
;
: uread ( addr len -- #read ) \ -2 for none available right now
ukey? 0= if 2drop -2 exit then ( addr len )
tuck ( len addr len )
begin dup 0<> ukey? 0<> and while ( len addr len )
over ukey mask-#data and swap c! ( len addr len )
1 /string ( len addr' len' )
repeat ( len addr' len' )
nip - ( #read )
;
: poll-tty ( -- )
ttylock @ if exit then
ubreak? if clear-break user-abort then
;
external
: open ( -- okay? )
phys-addr 8 do-map-in to uartbase
usea
my-args ( arg-str )
ascii , left-parse-string if ( rem addr )
c@ ascii b = if ( rem )
2drop ( )
useb ( )
then ( rem )
else ( rem addr )
drop 2drop ( )
then ( )
true
;
: close ( -- ) uartbase 8 do-map-out ;
headers
: utest ( -- 0 ) h# 7f bl ?do i uemit loop 0 ;
external
: selftest ( -- error? )
open 0= if ." Can't open device" true exit then
my-args if ( addr )
c@ case
ascii a of usea endof
ascii b of useb endof
( default ) ." Bad zs port letter" drop false exit
endcase
else \ No port letter so test both ports.
drop
usea utest
useb utest
or close exit ( fail? )
then
utest ( fail? )
close
;
: read ( addr len -- #read ) uread ;
: write ( addr len -- #written ) uwrite ;
: install-abort ( -- ) ['] poll-tty d# 10 alarm ;
: remove-abort ( -- ) ['] poll-tty 0 alarm ;
\ "seek" might be implemented to select a load file name
\ Implement "load" ( optional )
headers
|