85 lines
2.4 KiB
Forth
85 lines
2.4 KiB
Forth
\ *****************************************************************************
|
|
\ * Copyright (c) 2004, 2008 IBM Corporation
|
|
\ * All rights reserved.
|
|
\ * This program and the accompanying materials
|
|
\ * are made available under the terms of the BSD License
|
|
\ * which accompanies this distribution, and is available at
|
|
\ * http://www.opensource.org/licenses/bsd-license.php
|
|
\ *
|
|
\ * Contributors:
|
|
\ * IBM Corporation - initial implementation
|
|
\ ****************************************************************************/
|
|
|
|
|
|
\ National Semiconductor SIO.
|
|
\ See http://www.national.com/pf/PC/PC87417.html for the datasheet.
|
|
|
|
\ We use both serial ports, and the RTC.
|
|
|
|
\ See 3.7.5.
|
|
new-device 3f8 1 set-unit
|
|
|
|
s" serial" 2dup device-name device-type
|
|
|
|
\ Enable this UART.
|
|
3 7 siocfg! 1 30 siocfg!
|
|
|
|
\ 8 bytes of ISA I/O space
|
|
my-unit encode-int rot encode-int+ 8 encode-int+ s" reg" property
|
|
d# 19200 encode-int s" current-speed" property
|
|
44 encode-int 0 encode-int+ s" interrupts" property
|
|
|
|
: open true ;
|
|
: close ;
|
|
: write ( adr len -- actual ) tuck type ;
|
|
: read ( adr len -- actual ) 0= IF drop 0 EXIT THEN
|
|
serial-key? 0= IF 0 swap c! -2 EXIT THEN
|
|
serial-key swap c! 1 ;
|
|
|
|
finish-device
|
|
|
|
|
|
new-device 2f8 1 set-unit
|
|
|
|
s" serial" 2dup device-name device-type
|
|
|
|
\ Enable this UART.
|
|
2 7 siocfg! 1 30 siocfg!
|
|
|
|
\ 8 bytes of ISA I/O space
|
|
my-unit encode-int rot encode-int+ 8 encode-int+ s" reg" property
|
|
d# 19200 encode-int s" current-speed" property
|
|
43 encode-int 0 encode-int+ s" interrupts" property
|
|
|
|
: open true ;
|
|
: close ;
|
|
: write ( adr len -- actual ) tuck type ;
|
|
: read ( adr len -- actual ) 0= IF drop 0 EXIT THEN
|
|
serial-key? 0= IF 0 swap c! -2 EXIT THEN
|
|
serial-key swap c! 1 ;
|
|
|
|
finish-device
|
|
|
|
|
|
|
|
\ See the "Device Support Extensions" OF Recommended Practice document.
|
|
new-device 1070 1 set-unit
|
|
|
|
s" rtc" 2dup device-name device-type
|
|
\ Following is for Linux, to recognize this RTC:
|
|
s" pnpPNP,b00" compatible
|
|
|
|
: rtc! my-space io-c! my-space 1+ io-c! ;
|
|
: rtc@ my-space io-c! my-space 1+ io-c@ ;
|
|
|
|
\ 10 bytes of ISA I/O space, at 1070.
|
|
my-unit encode-int rot encode-int+ 10 encode-int+ s" reg" property
|
|
|
|
: open true ;
|
|
: close ;
|
|
|
|
\ XXX: dummy methods.
|
|
: get-time ( -- sec min hr day mth yr ) 38 22 c 1 1 d# 1973 ;
|
|
: set-time ( sec min hr day mth yr -- ) 3drop 3drop ;
|
|
|
|
finish-device
|